diff --git a/.gitattributes b/.gitattributes index ecc29e0c3b..671fced565 100644 --- a/.gitattributes +++ b/.gitattributes @@ -673,7 +673,7 @@ ide/fpcygwin.pas svneol=native#text/plain ide/fpdebug.pas svneol=native#text/plain ide/fpdesk.pas svneol=native#text/plain ide/fpdpansi.pas svneol=native#text/plain -ide/fpevalw.pas svneol=native#text/x-pascal +ide/fpevalw.pas svneol=native#text/plain ide/fphelp.pas svneol=native#text/plain ide/fpide.pas svneol=native#text/plain ide/fpini.pas svneol=native#text/plain @@ -5440,7 +5440,7 @@ rtl/amiga/timerd.inc svneol=native#text/plain rtl/amiga/tthread.inc svneol=native#text/plain rtl/amiga/varutils.pp svneol=native#text/plain rtl/arm/arm.inc svneol=native#text/plain -rtl/arm/divide.inc svneol=native#text/x-pascal +rtl/arm/divide.inc svneol=native#text/plain rtl/arm/int64p.inc svneol=native#text/plain rtl/arm/makefile.cpu svneol=native#text/plain rtl/arm/math.inc svneol=native#text/plain @@ -5500,7 +5500,7 @@ rtl/beos/unixsock.inc svneol=native#text/plain rtl/beos/unxconst.inc svneol=native#text/plain rtl/beos/unxfunc.inc svneol=native#text/plain rtl/beos/unxsockh.inc svneol=native#text/plain -rtl/bsd/bsd.pas -text +rtl/bsd/bsd.pas -text svneol=unset#text/plain rtl/bsd/bunxfunch.inc svneol=native#text/plain rtl/bsd/bunxsysc.inc svneol=native#text/plain rtl/bsd/clocale.inc svneol=native#text/plain @@ -5528,7 +5528,7 @@ rtl/darwin/Makefile.fpc svneol=native#text/plain rtl/darwin/arm/sighnd.inc svneol=native#text/plain rtl/darwin/console.pp svneol=native#text/plain rtl/darwin/errno.inc svneol=native#text/plain -rtl/darwin/errnostr.inc -text +rtl/darwin/errnostr.inc svneol=native#text/plain rtl/darwin/extres_multiarch.inc svneol=native#text/plain rtl/darwin/i386/sig_cpu.inc svneol=native#text/plain rtl/darwin/i386/sighnd.inc svneol=native#text/plain @@ -5594,8 +5594,8 @@ rtl/freebsd/buildrtl.lpi svneol=native#text/plain rtl/freebsd/buildrtl.pp svneol=native#text/plain rtl/freebsd/console.pp svneol=native#text/plain rtl/freebsd/errno.inc svneol=native#text/plain -rtl/freebsd/errnostr.inc -text -rtl/freebsd/freebsd.pas -text +rtl/freebsd/errnostr.inc svneol=native#text/plain +rtl/freebsd/freebsd.pas -text svneol=unset#text/plain rtl/freebsd/i386/bsyscall.inc svneol=native#text/plain rtl/freebsd/i386/cprt0.as svneol=native#text/plain rtl/freebsd/i386/gprt0.as svneol=native#text/plain @@ -5617,7 +5617,7 @@ rtl/freebsd/sysnr.inc svneol=native#text/plain rtl/freebsd/termio.pp svneol=native#text/plain rtl/freebsd/termios.inc svneol=native#text/plain rtl/freebsd/termiosproc.inc svneol=native#text/plain -rtl/freebsd/ucontexth.inc -text svneol=unset#text/plain +rtl/freebsd/ucontexth.inc svneol=native#text/plain rtl/freebsd/unixsock.inc svneol=native#text/plain rtl/freebsd/unxconst.inc svneol=native#text/plain rtl/freebsd/unxfunc.inc svneol=native#text/plain @@ -5851,7 +5851,7 @@ rtl/linux/buildrtl.lpi svneol=native#text/plain rtl/linux/buildrtl.pp svneol=native#text/plain rtl/linux/bunxsysc.inc svneol=native#text/plain rtl/linux/errno.inc svneol=native#text/plain -rtl/linux/errnostr.inc -text +rtl/linux/errnostr.inc svneol=native#text/plain rtl/linux/fpcylix.pp svneol=native#text/plain rtl/linux/fpmake.inc svneol=native#text/plain rtl/linux/gpm.pp svneol=native#text/plain @@ -5878,7 +5878,7 @@ rtl/linux/i386/sysnr.inc svneol=native#text/plain rtl/linux/ipccall.inc svneol=native#text/plain rtl/linux/ipcsys.inc svneol=native#text/plain rtl/linux/linux.pp svneol=native#text/plain -rtl/linux/linuxvcs.pp -text +rtl/linux/linuxvcs.pp svneol=native#text/plain rtl/linux/m68k/bsyscall.inc svneol=native#text/plain rtl/linux/m68k/cprt0.as svneol=native#text/plain rtl/linux/m68k/cprt21.as svneol=native#text/plain @@ -5970,7 +5970,7 @@ rtl/linux/x86_64/stat.inc svneol=native#text/plain rtl/linux/x86_64/syscall.inc svneol=native#text/plain rtl/linux/x86_64/syscallh.inc svneol=native#text/plain rtl/linux/x86_64/sysnr.inc svneol=native#text/plain -rtl/m68k/int64p.inc -text +rtl/m68k/int64p.inc svneol=native#text/plain rtl/m68k/lowmath.inc svneol=native#text/plain rtl/m68k/m68k.inc svneol=native#text/plain rtl/m68k/makefile.cpu svneol=native#text/plain @@ -6000,12 +6000,12 @@ rtl/macos/system.pp svneol=native#text/plain rtl/macos/sysutils.pp svneol=native#text/plain rtl/morphos/Makefile svneol=native#text/plain rtl/morphos/Makefile.fpc svneol=native#text/plain -rtl/morphos/aboxlib.pas -text +rtl/morphos/aboxlib.pas -text svneol=unset#text/plain rtl/morphos/ahi.pas svneol=native#text/plain rtl/morphos/asl.pas svneol=native#text/plain rtl/morphos/classes.pp svneol=native#text/plain rtl/morphos/clipboard.pas svneol=native#text/plain -rtl/morphos/datatypes.pas -text +rtl/morphos/datatypes.pas -text svneol=unset#text/plain rtl/morphos/dos.pp svneol=native#text/plain rtl/morphos/doslib.pp svneol=native#text/plain rtl/morphos/doslibd.inc svneol=native#text/plain @@ -6024,8 +6024,8 @@ rtl/morphos/keymap.pas svneol=native#text/plain rtl/morphos/kvm.pp svneol=native#text/plain rtl/morphos/layers.pas svneol=native#text/plain rtl/morphos/mouse.pp svneol=native#text/plain -rtl/morphos/mui.pas -text -rtl/morphos/muihelper.pas -text +rtl/morphos/mui.pas -text svneol=unset#text/plain +rtl/morphos/muihelper.pas -text svneol=unset#text/plain rtl/morphos/prt0.as svneol=native#text/plain rtl/morphos/sockets.pp svneol=native#text/plain rtl/morphos/sysdir.inc svneol=native#text/plain @@ -6038,7 +6038,7 @@ rtl/morphos/sysutils.pp svneol=native#text/plain rtl/morphos/timer.pp svneol=native#text/plain rtl/morphos/timerd.inc svneol=native#text/plain rtl/morphos/timerf.inc svneol=native#text/plain -rtl/morphos/tinygl.pp -text +rtl/morphos/tinygl.pp svneol=native#text/plain rtl/morphos/tthread.inc svneol=native#text/plain rtl/morphos/utild1.inc svneol=native#text/plain rtl/morphos/utild2.inc svneol=native#text/plain @@ -6061,7 +6061,7 @@ rtl/nds/prt07.as svneol=native#text/plain rtl/nds/prt09.as svneol=native#text/plain rtl/nds/sysdir.inc svneol=native#text/plain rtl/nds/sysfile.inc svneol=native#text/plain -rtl/nds/sysheap.inc svneol=native#text/x-pascal +rtl/nds/sysheap.inc svneol=native#text/plain rtl/nds/sysos.inc svneol=native#text/plain rtl/nds/sysosh.inc svneol=native#text/plain rtl/nds/system.pp svneol=native#text/plain @@ -6072,7 +6072,7 @@ rtl/nds/varutils.pp svneol=native#text/plain rtl/netbsd/Makefile svneol=native#text/plain rtl/netbsd/Makefile.fpc svneol=native#text/plain rtl/netbsd/errno.inc svneol=native#text/plain -rtl/netbsd/errnostr.inc -text +rtl/netbsd/errnostr.inc svneol=native#text/plain rtl/netbsd/i386/bsyscall.inc svneol=native#text/plain rtl/netbsd/i386/cprt0.as svneol=native#text/plain rtl/netbsd/i386/prt0.as svneol=native#text/plain @@ -6473,7 +6473,7 @@ rtl/symbian/Makefile svneol=native#text/plain rtl/symbian/Makefile.fpc svneol=native#text/plain rtl/symbian/bindings/pbeexe.cpp -text rtl/symbian/buildrtl.pp svneol=native#text/plain -rtl/symbian/symbian.pas -text +rtl/symbian/symbian.pas -text svneol=unset#text/plain rtl/symbian/symbianinc/e32def.inc svneol=native#text/plain rtl/symbian/symbianinc/e32err.inc svneol=native#text/plain rtl/symbian/symbianinc/e32std.inc svneol=native#text/plain @@ -6483,8 +6483,8 @@ rtl/symbian/sysheap.inc svneol=native#text/plain rtl/symbian/sysos.inc svneol=native#text/plain rtl/symbian/sysosh.inc svneol=native#text/plain rtl/symbian/system.pp svneol=native#text/plain -rtl/symbian/uiq.pas -text -rtl/symbian/uiqclasses.pas -text +rtl/symbian/uiq.pas -text svneol=unset#text/plain +rtl/symbian/uiqclasses.pas -text svneol=unset#text/plain rtl/symbian/uiqinc/qikapplication.inc svneol=native#text/plain rtl/symbian/uiqinc/qikapplicationoo.inc svneol=native#text/plain rtl/ucmaps/8859-1.txt svneol=native#text/plain @@ -6535,7 +6535,7 @@ rtl/unix/bunxovl.inc svneol=native#text/plain rtl/unix/bunxovlh.inc svneol=native#text/plain rtl/unix/classes.pp svneol=native#text/plain rtl/unix/clocale.pp svneol=native#text/plain -rtl/unix/convert.inc -text +rtl/unix/convert.inc svneol=native#text/plain rtl/unix/crt.pp svneol=native#text/plain rtl/unix/cthreads.pp svneol=native#text/plain rtl/unix/ctypes.inc svneol=native#text/plain @@ -6588,11 +6588,11 @@ rtl/watcom/classes.pp svneol=native#text/plain rtl/watcom/crt.pp svneol=native#text/plain rtl/watcom/dos.pp svneol=native#text/plain rtl/watcom/prt0.as -text -rtl/watcom/sysdir.inc -text -rtl/watcom/sysfile.inc -text -rtl/watcom/sysheap.inc -text -rtl/watcom/sysos.inc -text -rtl/watcom/sysosh.inc -text +rtl/watcom/sysdir.inc svneol=native#text/plain +rtl/watcom/sysfile.inc svneol=native#text/plain +rtl/watcom/sysheap.inc svneol=native#text/plain +rtl/watcom/sysos.inc svneol=native#text/plain +rtl/watcom/sysosh.inc svneol=native#text/plain rtl/watcom/system.pp svneol=native#text/plain rtl/watcom/sysutils.pp svneol=native#text/plain rtl/watcom/varutils.pp svneol=native#text/plain @@ -6682,7 +6682,7 @@ rtl/wince/wininc/makefile.inc svneol=native#text/plain rtl/wince/wininc/messages.inc svneol=native#text/plain rtl/wince/wininc/redef.inc svneol=native#text/plain rtl/wince/wininc/struct.inc svneol=native#text/plain -rtl/wince/winres.inc -text +rtl/wince/winres.inc svneol=native#text/plain rtl/wince/winsock.pp svneol=native#text/plain rtl/wince/winsock2.pp svneol=native#text/plain rtl/x86_64/int64p.inc svneol=native#text/plain @@ -6701,7 +6701,7 @@ tests/MPWMake -text tests/Makefile svneol=native#text/plain tests/Makefile.fpc svneol=native#text/plain tests/bench/bansi1.inc svneol=native#text/plain -tests/bench/bansi1.pp -text +tests/bench/bansi1.pp svneol=native#text/plain tests/bench/bansi1mt.pp svneol=native#text/plain tests/bench/blists1.inc svneol=native#text/plain tests/bench/blists1.pp svneol=native#text/plain @@ -6772,7 +6772,7 @@ tests/bench/shootout/src/knucleotide.lpi svneol=native#text/plain tests/bench/shootout/src/knucleotide.pp svneol=native#text/plain tests/bench/shootout/src/mandelbrot.pp svneol=native#text/plain tests/bench/shootout/src/message.pp svneol=native#text/plain -tests/bench/shootout/src/meteorshower.pp svneol=native#text/x-pascal +tests/bench/shootout/src/meteorshower.pp svneol=native#text/plain tests/bench/shootout/src/n_body.pp svneol=native#text/plain tests/bench/shootout/src/nsieve.pp svneol=native#text/plain tests/bench/shootout/src/partialsums.pp svneol=native#text/plain @@ -6782,9 +6782,9 @@ tests/bench/shootout/src/regexdna.pp svneol=native#text/plain tests/bench/shootout/src/simple_hash.pp svneol=native#text/plain tests/bench/shootout/src/spectralnorm.pp svneol=native#text/plain tests/bench/shootout/src/sumcol.pp svneol=native#text/plain -tests/bench/shootout/src/thread_ring.pp svneol=native#text/pascal +tests/bench/shootout/src/thread_ring.pp svneol=native#text/plain tests/bench/shortbench.pp svneol=native#text/plain -tests/bench/stream.pp svneol=native#text/x-pascal +tests/bench/stream.pp svneol=native#text/plain tests/bench/timer.pas svneol=native#text/plain tests/bench/whet.pas svneol=native#text/plain tests/dbdigest.cfg.example -text @@ -6988,9 +6988,9 @@ tests/tbf/tb0195.pp svneol=native#text/plain tests/tbf/tb0196.pp svneol=native#text/plain tests/tbf/tb0197.pp svneol=native#text/plain tests/tbf/tb0198.pp svneol=native#text/plain -tests/tbf/tb0199.pp -text -tests/tbf/tb0199a.pp -text -tests/tbf/tb0200.pp svneol=native#text/x-pascal +tests/tbf/tb0199.pp svneol=native#text/plain +tests/tbf/tb0199a.pp svneol=native#text/plain +tests/tbf/tb0200.pp svneol=native#text/plain tests/tbf/tb0201.pp svneol=native#text/plain tests/tbf/tb0202.pp svneol=native#text/plain tests/tbf/tb0203.pp svneol=native#text/plain @@ -7533,15 +7533,15 @@ tests/tbs/tb0520.pp svneol=native#text/plain tests/tbs/tb0521.pp svneol=native#text/plain tests/tbs/tb0522.pp svneol=native#text/plain tests/tbs/tb0523.pp svneol=native#text/plain -tests/tbs/tb0524.pp svneol=native#text/x-pascal +tests/tbs/tb0524.pp svneol=native#text/plain tests/tbs/tb0525.pp svneol=native#text/plain tests/tbs/tb0526.pp svneol=native#text/plain tests/tbs/tb0527.pp svneol=native#text/plain -tests/tbs/tb0528.pp svneol=native#text/x-pascal +tests/tbs/tb0528.pp svneol=native#text/plain tests/tbs/tb0529.pp svneol=native#text/plain tests/tbs/tb0530.pp svneol=native#text/plain tests/tbs/tb0531.pp svneol=native#text/plain -tests/tbs/tb0532.pp svneol=native#text/x-pascal +tests/tbs/tb0532.pp svneol=native#text/plain tests/tbs/tb0533.pp svneol=native#text/plain tests/tbs/tb0534.pp svneol=native#text/plain tests/tbs/tb0535.pp svneol=native#text/plain @@ -7549,7 +7549,7 @@ tests/tbs/tb0536.pp svneol=native#text/plain tests/tbs/tb0537.pp svneol=native#text/plain tests/tbs/tb0538.pp svneol=native#text/plain tests/tbs/tb0539.pp svneol=native#text/plain -tests/tbs/tb0540.pp svneol=native#text/x-pascal +tests/tbs/tb0540.pp svneol=native#text/plain tests/tbs/tb0541.pp svneol=native#text/plain tests/tbs/tb0542.pp svneol=native#text/plain tests/tbs/tb0543.pp svneol=native#text/plain @@ -7728,7 +7728,7 @@ tests/test/cg/taddset4.pp svneol=native#text/plain tests/test/cg/tadint64.pp svneol=native#text/plain tests/test/cg/tassign1.pp svneol=native#text/plain tests/test/cg/tassign2.pp svneol=native#text/plain -tests/test/cg/tautom.pp svneol=native#text/x-pascal +tests/test/cg/tautom.pp svneol=native#text/plain tests/test/cg/tcalcla1.pp svneol=native#text/plain tests/test/cg/tcalcon1.pp svneol=native#text/plain tests/test/cg/tcalcst1.pp svneol=native#text/plain @@ -7742,8 +7742,8 @@ tests/test/cg/tcalcst8.pp svneol=native#text/plain tests/test/cg/tcalcst9.pp svneol=native#text/plain tests/test/cg/tcalext.pp svneol=native#text/plain tests/test/cg/tcalext2.pp svneol=native#text/plain -tests/test/cg/tcalext3.pp -text -tests/test/cg/tcalext4.pp -text +tests/test/cg/tcalext3.pp svneol=native#text/plain +tests/test/cg/tcalext4.pp svneol=native#text/plain tests/test/cg/tcalext5.pp svneol=native#text/plain tests/test/cg/tcalfun1.pp svneol=native#text/plain tests/test/cg/tcalfun2.pp svneol=native#text/plain @@ -7770,7 +7770,7 @@ tests/test/cg/tcalpvr6.pp svneol=native#text/plain tests/test/cg/tcalpvr7.pp svneol=native#text/plain tests/test/cg/tcalpvr8.pp svneol=native#text/plain tests/test/cg/tcalval1.pp svneol=native#text/plain -tests/test/cg/tcalval10.pp -text +tests/test/cg/tcalval10.pp svneol=native#text/plain tests/test/cg/tcalval2.pp svneol=native#text/plain tests/test/cg/tcalval3.pp svneol=native#text/plain tests/test/cg/tcalval4.pp svneol=native#text/plain @@ -7808,7 +7808,7 @@ tests/test/cg/tdivz1.pp svneol=native#text/plain tests/test/cg/tdivz2.pp svneol=native#text/plain tests/test/cg/texit.pp svneol=native#text/plain tests/test/cg/tfor.pp svneol=native#text/plain -tests/test/cg/tformfnc.pp -text +tests/test/cg/tformfnc.pp svneol=native#text/plain tests/test/cg/tfuncret.pp svneol=native#text/plain tests/test/cg/tin.pp svneol=native#text/plain tests/test/cg/tincdec.pp svneol=native#text/plain @@ -8081,15 +8081,15 @@ tests/test/taddstr1.pp svneol=native#text/plain tests/test/talign.pp svneol=native#text/plain tests/test/talign1.pp svneol=native#text/plain tests/test/talign2.pp svneol=native#text/plain -tests/test/targ1a.pp -text -tests/test/targ1b.pp -text +tests/test/targ1a.pp svneol=native#text/plain +tests/test/targ1b.pp svneol=native#text/plain tests/test/tarray1.pp svneol=native#text/plain tests/test/tarray2.pp svneol=native#text/plain tests/test/tarray3.pp svneol=native#text/plain tests/test/tarray4.pp svneol=native#text/plain tests/test/tarray5.pp svneol=native#text/plain tests/test/tarray6.pp svneol=native#text/plain -tests/test/tarray7.pp svneol=native#text/x-pascal +tests/test/tarray7.pp svneol=native#text/plain tests/test/tasmread.pp svneol=native#text/plain tests/test/tasout.pp svneol=native#text/plain tests/test/tbopr.pp svneol=native#text/plain @@ -8184,7 +8184,7 @@ tests/test/tinline10.pp svneol=native#text/plain tests/test/tinline2.pp svneol=native#text/plain tests/test/tinline3.pp svneol=native#text/plain tests/test/tinline4.pp svneol=native#text/plain -tests/test/tinline5.pp -text +tests/test/tinline5.pp svneol=native#text/plain tests/test/tinline6.pp svneol=native#text/plain tests/test/tinline7.pp svneol=native#text/plain tests/test/tinline8.pp svneol=native#text/plain @@ -8311,9 +8311,9 @@ tests/test/trange3.pp svneol=native#text/plain tests/test/trange4.pp svneol=native#text/plain tests/test/trange5.pp svneol=native#text/plain tests/test/trangeob.pp svneol=native#text/plain -tests/test/trecreg.pp -text +tests/test/trecreg.pp svneol=native#text/plain tests/test/trecreg2.pp svneol=native#text/plain -tests/test/trecreg3.pp -text +tests/test/trecreg3.pp svneol=native#text/plain tests/test/trecreg4.pp svneol=native#text/plain tests/test/tresstr.pp svneol=native#text/plain tests/test/trox1.pp svneol=native#text/plain @@ -8360,7 +8360,7 @@ tests/test/tstring8.pp svneol=native#text/plain tests/test/tstring9.pp svneol=native#text/plain tests/test/tstrreal1.pp svneol=native#text/plain tests/test/tstrreal2.pp svneol=native#text/plain -tests/test/tstrreal3.pp -text +tests/test/tstrreal3.pp svneol=native#text/plain tests/test/tsubdecl.pp svneol=native#text/plain tests/test/tunaligned1.pp svneol=native#text/plain tests/test/tunistr1.pp svneol=native#text/plain @@ -8373,8 +8373,8 @@ tests/test/tunit1.pp svneol=native#text/plain tests/test/tunit2.pp svneol=native#text/plain tests/test/tunit3.pp svneol=native#text/plain tests/test/tunroll1.pp svneol=native#text/plain -tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8 -tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8 +tests/test/tutf81.pp svneol=native#text/plain +tests/test/tutf82.pp svneol=native#text/plain tests/test/tvarset1.pp svneol=native#text/plain tests/test/tweaklib1.pp svneol=native#text/plain tests/test/tweaklib2.pp svneol=native#text/plain @@ -8498,7 +8498,7 @@ tests/test/units/system/trandom.pp svneol=native#text/plain tests/test/units/system/trdtxt01.pp svneol=native#text/plain tests/test/units/system/trdtxt02.pp svneol=native#text/plain tests/test/units/system/trdtxt03.pp svneol=native#text/plain -tests/test/units/system/tres.pp -text +tests/test/units/system/tres.pp svneol=native#text/plain tests/test/units/system/tres1.rc -text tests/test/units/system/tres1.res -text tests/test/units/system/tres1.txt -text @@ -8523,13 +8523,13 @@ tests/test/units/system/tstring.pp svneol=native#text/plain tests/test/units/system/ttrig.pas svneol=native#text/plain tests/test/units/system/ttrunc.pp svneol=native#text/plain tests/test/units/system/tval.inc svneol=native#text/plain -tests/test/units/system/tval.pp -text -tests/test/units/system/tval1.pp -text -tests/test/units/system/tval2.pp -text -tests/test/units/system/tval3.pp -text -tests/test/units/system/tval4.pp -text +tests/test/units/system/tval.pp svneol=native#text/plain +tests/test/units/system/tval1.pp svneol=native#text/plain +tests/test/units/system/tval2.pp svneol=native#text/plain +tests/test/units/system/tval3.pp svneol=native#text/plain +tests/test/units/system/tval4.pp svneol=native#text/plain tests/test/units/system/tval5.pp svneol=native#text/plain -tests/test/units/system/tvalc.pp -text +tests/test/units/system/tvalc.pp svneol=native#text/plain tests/test/units/sysutils/tastrcmp.pp svneol=native#text/plain tests/test/units/sysutils/tastrcmp1.pp svneol=native#text/plain tests/test/units/sysutils/texec1.pp svneol=native#text/plain @@ -8538,7 +8538,7 @@ tests/test/units/sysutils/textractquote.pp svneol=native#text/plain tests/test/units/sysutils/tfile1.pp svneol=native#text/plain tests/test/units/sysutils/tfile2.pp svneol=native#text/plain tests/test/units/sysutils/tfilename.pp svneol=native#text/plain -tests/test/units/sysutils/tfloattostr.pp -text +tests/test/units/sysutils/tfloattostr.pp svneol=native#text/plain tests/test/units/sysutils/tlocale.pp svneol=native#text/plain tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain @@ -8776,7 +8776,7 @@ tests/webtbf/tw4554c.pp svneol=native#text/plain tests/webtbf/tw4554d.pp svneol=native#text/plain tests/webtbf/tw4569a.pp svneol=native#text/plain tests/webtbf/tw4569b.pp svneol=native#text/plain -tests/webtbf/tw4619a.pp -text svneol=unset#text/plain +tests/webtbf/tw4619a.pp svneol=native#text/plain tests/webtbf/tw4619b.pp svneol=native#text/plain tests/webtbf/tw4647.pp svneol=native#text/plain tests/webtbf/tw4651.pp svneol=native#text/plain @@ -8792,7 +8792,7 @@ tests/webtbf/tw4781b.pp svneol=native#text/plain tests/webtbf/tw4893d.pp svneol=native#text/plain tests/webtbf/tw4893e.pp svneol=native#text/plain tests/webtbf/tw4911.pp svneol=native#text/plain -tests/webtbf/tw4913.pp -text +tests/webtbf/tw4913.pp svneol=native#text/plain tests/webtbf/tw5896a.pp svneol=native#text/plain tests/webtbf/tw6036b.pp svneol=native#text/plain tests/webtbf/tw6420.pp svneol=native#text/plain @@ -8802,7 +8802,7 @@ tests/webtbf/tw6796.pp svneol=native#text/plain tests/webtbf/tw6797a.pp svneol=native#text/plain tests/webtbf/tw6797b.pp svneol=native#text/plain tests/webtbf/tw6922.pp svneol=native#text/plain -tests/webtbf/tw6957.pp -text +tests/webtbf/tw6957.pp svneol=native#text/plain tests/webtbf/tw6970.pp svneol=native#text/plain tests/webtbf/tw7070.pp svneol=native#text/plain tests/webtbf/tw7322.pp svneol=native#text/plain @@ -8832,7 +8832,7 @@ tests/webtbf/tw8465a.pp svneol=native#text/plain tests/webtbf/tw8528.pp svneol=native#text/plain tests/webtbf/tw8583.pp svneol=native#text/plain tests/webtbf/tw8588.pp svneol=native#text/plain -tests/webtbf/tw8591.pp -text +tests/webtbf/tw8591.pp svneol=native#text/plain tests/webtbf/tw8717.pp svneol=native#text/plain tests/webtbf/tw8738.pas svneol=native#text/plain tests/webtbf/tw8777a.pp svneol=native#text/plain @@ -9838,7 +9838,7 @@ tests/webtbs/tw5001.pp svneol=native#text/plain tests/webtbs/tw5015.pp svneol=native#text/plain tests/webtbs/tw5023.pp svneol=native#text/plain tests/webtbs/tw5036.pp svneol=native#text/plain -tests/webtbs/tw5082.pp -text svneol=unset#text/plain +tests/webtbs/tw5082.pp svneol=native#text/plain tests/webtbs/tw5086.pp svneol=native#text/plain tests/webtbs/tw5094.pp svneol=native#text/plain tests/webtbs/tw5100.pp svneol=native#text/plain @@ -9857,7 +9857,7 @@ tests/webtbs/tw6451a.pp svneol=native#text/plain tests/webtbs/tw6451b.pp svneol=native#text/plain tests/webtbs/tw6491.pp svneol=native#text/plain tests/webtbs/tw6493.pp svneol=native#text/plain -tests/webtbs/tw6525.pp -text +tests/webtbs/tw6525.pp svneol=native#text/plain tests/webtbs/tw6543.pp svneol=native#text/plain tests/webtbs/tw6586a.pp svneol=native#text/plain tests/webtbs/tw6586b.pp svneol=native#text/plain @@ -9870,7 +9870,7 @@ tests/webtbs/tw6690.pp svneol=native#text/plain tests/webtbs/tw6700.pp svneol=native#text/plain tests/webtbs/tw6727.pp svneol=native#text/plain tests/webtbs/tw6735.pp svneol=native#text/plain -tests/webtbs/tw6737.pp -text +tests/webtbs/tw6737.pp svneol=native#text/plain tests/webtbs/tw6742.pp svneol=native#text/plain tests/webtbs/tw6767.pp svneol=native#text/plain tests/webtbs/tw6769.pp svneol=native#text/plain @@ -9961,7 +9961,7 @@ tests/webtbs/tw8156.pp svneol=native#text/plain tests/webtbs/tw8171.pp svneol=native#text/plain tests/webtbs/tw8172.pp svneol=native#text/plain tests/webtbs/tw8177.pp svneol=native#text/plain -tests/webtbs/tw8177a.pp -text +tests/webtbs/tw8177a.pp svneol=native#text/plain tests/webtbs/tw8180.pp svneol=native#text/plain tests/webtbs/tw8183.pp svneol=native#text/plain tests/webtbs/tw8187.pp svneol=native#text/plain @@ -10062,12 +10062,12 @@ tests/webtbs/tw9190.pp svneol=native#text/plain tests/webtbs/tw9209.pp svneol=native#text/plain tests/webtbs/tw9221.pp svneol=native#text/plain tests/webtbs/tw9233.pp svneol=native#text/plain -tests/webtbs/tw9261.pp svneol=native#text/x-pascal +tests/webtbs/tw9261.pp svneol=native#text/plain tests/webtbs/tw9278.pp svneol=native#text/plain -tests/webtbs/tw9299.pp -text -tests/webtbs/tw9306a.pp -text -tests/webtbs/tw9306b.pp -text -tests/webtbs/tw9309.pp -text +tests/webtbs/tw9299.pp svneol=native#text/plain +tests/webtbs/tw9306a.pp svneol=native#text/plain +tests/webtbs/tw9306b.pp svneol=native#text/plain +tests/webtbs/tw9309.pp svneol=native#text/plain tests/webtbs/tw9327.pp svneol=native#text/plain tests/webtbs/tw9347.pp svneol=native#text/plain tests/webtbs/tw9347a.pp svneol=native#text/plain @@ -10083,7 +10083,7 @@ tests/webtbs/tw9551a.pp svneol=native#text/plain tests/webtbs/tw9601.pp svneol=native#text/plain tests/webtbs/tw9667.pp svneol=native#text/plain tests/webtbs/tw9672.pp svneol=native#text/plain -tests/webtbs/tw9673.pp -text +tests/webtbs/tw9673.pp svneol=native#text/plain tests/webtbs/tw9695.pp svneol=native#text/plain tests/webtbs/tw9704.pp svneol=native#text/plain tests/webtbs/tw9766.pp svneol=native#text/plain @@ -10092,7 +10092,7 @@ tests/webtbs/tw9894.pp svneol=native#text/plain tests/webtbs/tw9894a.pp svneol=native#text/plain tests/webtbs/tw9897.pp svneol=native#text/plain tests/webtbs/tw9918.pp svneol=native#text/plain -tests/webtbs/tw9919.pp -text +tests/webtbs/tw9919.pp svneol=native#text/plain tests/webtbs/tw9985.pp svneol=native#text/plain tests/webtbs/tw9985a.pp svneol=native#text/plain tests/webtbs/ub1873.pp svneol=native#text/plain diff --git a/rtl/netbsd/errnostr.inc b/rtl/netbsd/errnostr.inc index 4dc1f7660c..3686d9bcab 100644 --- a/rtl/netbsd/errnostr.inc +++ b/rtl/netbsd/errnostr.inc @@ -1,123 +1,123 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2005 by Ales Katona - - Contains BSD specific errors for error.pp in rtl/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. - - **********************************************************************} - -{$warning FIX ME, I'am from FreeBSD } -const - sys_errn=93; - 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 } - 'Resource deadlock avoided', { EDEADLK was 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 temporarily unavailable', { EAGAIN } - 'Operation now in progress', { EINPROGRESS } - 'Operation already in progress', { EALREADY } -// ipc/network software -- argument errors - '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', { EOPNOTSUPP } - 'Protocol family not supported', { EPFNOSUPPORT } - 'Address family not supported by protocol family', { EAFNOSUPPORT } - 'Address already in use', { EADDRINUSE } - 'Can''t assign requested address', { EADDRNOTAVAIL } -// ipc/network software -- operational errors - 'Network is down', { ENETDOWN } - 'Network is unreachable', { ENETUNREACH } - 'Network dropped connection on reset', { ENETRESET } - 'Software caused connection abort', { ECONNABORTED } - 'Connection reset by peer', { ECONNRESET } - 'No buffer space available', { ENOBUFS } - 'Socket is already connected', { EISCONN } - 'Socket is not connected', { ENOTCONN } - 'Can''t send after socket shutdown', { ESHUTDOWN } - 'Too many references: can''t splice', { ETOOMANYREFS } - 'Operation timed out', { ETIMEDOUT } - 'Connection refused', { ECONNREFUSED } - 'Too many levels of symbolic links', { ELOOP } - 'File name too long', { ENAMETOOLONG } - 'Host is down', { EHOSTDOWN } - 'No route to host', { EHOSTUNREACH } - 'Directory not empty', { ENOTEMPTY } - 'Too many processes', { EPROCLIM } - 'Too many users', { EUSERS } - 'Disc quota exceeded', { EDQUOT } -// Network File System - 'Stale NFS file handle', { ESTALE } - 'Too many levels of remote in path', { EREMOTE } - 'RPC struct is bad', { EBADRPC } - 'RPC version wrong', { ERPCMISMATCH } - 'RPC prog. not avail', { EPROGUNAVAIL } - 'Program version wrong', { EPROGMISMATCH } - 'Bad procedure for program', { EPROCUNAVAIL } - 'No locks available', { ENOLCK } - 'Function not implemented', { ENOSYS } - 'Inappropriate file type or format', { EFTYPE } - 'Authentication error', { EAUTH } - 'Need authenticator', { ENEEDAUTH } - 'Identifier removed', { EIDRM } - 'No message of desired type', { ENOMSG } - 'Value too large to be stored in data type', { EOVERFLOW } - 'Operation canceled', { ECANCELED } - 'Illegal byte sequence', { EILSEQ } - 'Attribute not found', { ENOATTR } - 'Programming error', { EDOOFUS } - 'Bad message', { EBADMSG } - 'Multihop attempted', { EMULTIHOP } - 'Link has been severed', { ENOLINK } - 'Protocol error' { EPROTO } -); - +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2005 by Ales Katona + + Contains BSD specific errors for error.pp in rtl/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. + + **********************************************************************} + +{$warning FIX ME, I'am from FreeBSD } +const + sys_errn=93; + 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 } + 'Resource deadlock avoided', { EDEADLK was 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 temporarily unavailable', { EAGAIN } + 'Operation now in progress', { EINPROGRESS } + 'Operation already in progress', { EALREADY } +// ipc/network software -- argument errors + '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', { EOPNOTSUPP } + 'Protocol family not supported', { EPFNOSUPPORT } + 'Address family not supported by protocol family', { EAFNOSUPPORT } + 'Address already in use', { EADDRINUSE } + 'Can''t assign requested address', { EADDRNOTAVAIL } +// ipc/network software -- operational errors + 'Network is down', { ENETDOWN } + 'Network is unreachable', { ENETUNREACH } + 'Network dropped connection on reset', { ENETRESET } + 'Software caused connection abort', { ECONNABORTED } + 'Connection reset by peer', { ECONNRESET } + 'No buffer space available', { ENOBUFS } + 'Socket is already connected', { EISCONN } + 'Socket is not connected', { ENOTCONN } + 'Can''t send after socket shutdown', { ESHUTDOWN } + 'Too many references: can''t splice', { ETOOMANYREFS } + 'Operation timed out', { ETIMEDOUT } + 'Connection refused', { ECONNREFUSED } + 'Too many levels of symbolic links', { ELOOP } + 'File name too long', { ENAMETOOLONG } + 'Host is down', { EHOSTDOWN } + 'No route to host', { EHOSTUNREACH } + 'Directory not empty', { ENOTEMPTY } + 'Too many processes', { EPROCLIM } + 'Too many users', { EUSERS } + 'Disc quota exceeded', { EDQUOT } +// Network File System + 'Stale NFS file handle', { ESTALE } + 'Too many levels of remote in path', { EREMOTE } + 'RPC struct is bad', { EBADRPC } + 'RPC version wrong', { ERPCMISMATCH } + 'RPC prog. not avail', { EPROGUNAVAIL } + 'Program version wrong', { EPROGMISMATCH } + 'Bad procedure for program', { EPROCUNAVAIL } + 'No locks available', { ENOLCK } + 'Function not implemented', { ENOSYS } + 'Inappropriate file type or format', { EFTYPE } + 'Authentication error', { EAUTH } + 'Need authenticator', { ENEEDAUTH } + 'Identifier removed', { EIDRM } + 'No message of desired type', { ENOMSG } + 'Value too large to be stored in data type', { EOVERFLOW } + 'Operation canceled', { ECANCELED } + 'Illegal byte sequence', { EILSEQ } + 'Attribute not found', { ENOATTR } + 'Programming error', { EDOOFUS } + 'Bad message', { EBADMSG } + 'Multihop attempted', { EMULTIHOP } + 'Link has been severed', { ENOLINK } + 'Protocol error' { EPROTO } +); + diff --git a/rtl/watcom/sysdir.inc b/rtl/watcom/sysdir.inc index 40d2ef51d4..612a1d7cef 100644 --- a/rtl/watcom/sysdir.inc +++ b/rtl/watcom/sysdir.inc @@ -1,128 +1,128 @@ -{***************************************************************************** - 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; - DoDirSeparators(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] in AllowDirectorySeparators then - temp[i]:=DirectorySeparator; - 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; - +{***************************************************************************** + 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; + DoDirSeparators(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] in AllowDirectorySeparators then + temp[i]:=DirectorySeparator; + 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; + diff --git a/rtl/watcom/sysfile.inc b/rtl/watcom/sysfile.inc index fc428f4177..66d1ae35d0 100644 --- a/rtl/watcom/sysfile.inc +++ b/rtl/watcom/sysfile.inc @@ -1,429 +1,429 @@ - { 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 do_close(handle : longint); -var - regs : trealregs; -begin - if Handle<=4 then - exit; - regs.realebx:=handle; - if handle 0 then - GetInOutRes(lo(regs.realeax)); -end; - -procedure do_erase(p : pchar); -var - regs : trealregs; -begin - DoDirSeparators(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 - DoDirSeparators(p1); - DoDirSeparators(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) 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) 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 - DoDirSeparators(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) 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; - + { 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 do_close(handle : longint); +var + regs : trealregs; +begin + if Handle<=4 then + exit; + regs.realebx:=handle; + if handle 0 then + GetInOutRes(lo(regs.realeax)); +end; + +procedure do_erase(p : pchar); +var + regs : trealregs; +begin + DoDirSeparators(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 + DoDirSeparators(p1); + DoDirSeparators(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) 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) 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 + DoDirSeparators(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) 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; + diff --git a/rtl/watcom/sysheap.inc b/rtl/watcom/sysheap.inc index bd76520356..5ed91c3cf8 100644 --- a/rtl/watcom/sysheap.inc +++ b/rtl/watcom/sysheap.inc @@ -1,30 +1,30 @@ -{***************************************************************************** - 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; - +{***************************************************************************** + 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; + diff --git a/rtl/watcom/sysos.inc b/rtl/watcom/sysos.inc index 1f8045742e..65c9c9e9c8 100644 --- a/rtl/watcom/sysos.inc +++ b/rtl/watcom/sysos.inc @@ -1,157 +1,157 @@ -{***************************************************************************** - Watcom Helpers -*****************************************************************************} -const - carryflag = 1; - -type - tseginfo=packed record - offset : pointer; - segment : word; - end; - -var - old_int00 : tseginfo;cvar; - old_int75 : tseginfo;cvar; - - -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; - - -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 (sourcedseg) 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 nil then begin - PResSize^:=SizeofResource(HINSTANCE, hRes); - if PResSize^ = 0 then - Fail('SizeofResource failed.'); - end; - Result:=LockResource(gRes); - if Result = nil then - Fail('LockResource failed.'); -end; - -procedure DoTest; -var - s: string; - p: PChar; - sz: longint; -begin - p:=GetResource('TestFile', 'FILE', @sz); - SetString(s, p, sz); - if s <> 'test file.' then - Fail('Invalid resource loaded.'); - writeln(s); - - p:=GetResource('Test', 'TEXT', @sz); - SetString(s, p, sz); - if s <> 'Another test file.' then - Fail('Invalid resource loaded.'); - writeln(s); -end; - -begin - writeln('Resources test.'); - DoTest; - writeln('Done.'); -end. +{ Test for resources support. } + +{%TARGET=win32,win64,wince,linux,freebsd,darwin,netbsd,openbsd,solaris} + +{$mode objfpc} + +{$R tres1.res} + +procedure Fail(const Msg: string); +begin + writeln(Msg); + Halt(1); +end; + +function GetResource(ResourceName, ResourceType: PChar; PResSize: PLongInt = nil): pointer; +var + hRes: TFPResourceHandle; + gRes: TFPResourceHGLOBAL; +begin + hRes:=FindResource(HINSTANCE, ResourceName, ResourceType); + if hRes = 0 then + Fail('FindResource failed.'); + gRes:=LoadResource(HINSTANCE, hRes); + if gRes = 0 then + Fail('LoadResource failed.'); + if PResSize <> nil then begin + PResSize^:=SizeofResource(HINSTANCE, hRes); + if PResSize^ = 0 then + Fail('SizeofResource failed.'); + end; + Result:=LockResource(gRes); + if Result = nil then + Fail('LockResource failed.'); +end; + +procedure DoTest; +var + s: string; + p: PChar; + sz: longint; +begin + p:=GetResource('TestFile', 'FILE', @sz); + SetString(s, p, sz); + if s <> 'test file.' then + Fail('Invalid resource loaded.'); + writeln(s); + + p:=GetResource('Test', 'TEXT', @sz); + SetString(s, p, sz); + if s <> 'Another test file.' then + Fail('Invalid resource loaded.'); + writeln(s); +end; + +begin + writeln('Resources test.'); + DoTest; + writeln('Done.'); +end. diff --git a/tests/test/units/system/tval.pp b/tests/test/units/system/tval.pp index e18c2db1c8..a2ccb722ec 100644 --- a/tests/test/units/system/tval.pp +++ b/tests/test/units/system/tval.pp @@ -1,31 +1,31 @@ - -program TestVal; - -uses - { longint type, short string } - tval1, - { dword type, short string } - tval2, - { int64 type, short string } - tval3, - { uint64 type, short string } - tval4, - { common variables and functions } - tvalc; - - - -begin - if (paramcount>0) and - (paramstr(1)='verbose') then - silent:=false; - TestAllVal1; - TestAllVal2; - TestAllVal3; - TestAllVal4; - if HasErrors then - begin - Writeln('Test tval failed'); - Halt(1); - end; -end. + +program TestVal; + +uses + { longint type, short string } + tval1, + { dword type, short string } + tval2, + { int64 type, short string } + tval3, + { uint64 type, short string } + tval4, + { common variables and functions } + tvalc; + + + +begin + if (paramcount>0) and + (paramstr(1)='verbose') then + silent:=false; + TestAllVal1; + TestAllVal2; + TestAllVal3; + TestAllVal4; + if HasErrors then + begin + Writeln('Test tval failed'); + Halt(1); + end; +end. diff --git a/tests/test/units/system/tval1.pp b/tests/test/units/system/tval1.pp index 435e015085..4ef714d826 100644 --- a/tests/test/units/system/tval1.pp +++ b/tests/test/units/system/tval1.pp @@ -1,27 +1,27 @@ - -unit tval1; - -{$mode fpc} - -interface - -function TestAllVal1 : boolean; - -implementation - -uses - tvalc; - -type - IntegerType = longint; - -{$i tval.inc} - - -function TestAllVal1 : boolean; -begin - Writeln('Test val for longint type'); - TestAllVal1:=TestAll; -end; - -end. + +unit tval1; + +{$mode fpc} + +interface + +function TestAllVal1 : boolean; + +implementation + +uses + tvalc; + +type + IntegerType = longint; + +{$i tval.inc} + + +function TestAllVal1 : boolean; +begin + Writeln('Test val for longint type'); + TestAllVal1:=TestAll; +end; + +end. diff --git a/tests/test/units/system/tval2.pp b/tests/test/units/system/tval2.pp index 5bf2f48d7e..4e7284e9e3 100644 --- a/tests/test/units/system/tval2.pp +++ b/tests/test/units/system/tval2.pp @@ -1,27 +1,27 @@ - -unit tval2; - -{$mode fpc} - -interface - -function TestAllval2 : boolean; - -implementation - -uses - tvalc; - -type - IntegerType = dword; - -{$i tval.inc} - - -function TestAllval2 : boolean; -begin - Writeln('Test val for dword type'); - TestAllval2:=TestAll; -end; - -end. + +unit tval2; + +{$mode fpc} + +interface + +function TestAllval2 : boolean; + +implementation + +uses + tvalc; + +type + IntegerType = dword; + +{$i tval.inc} + + +function TestAllval2 : boolean; +begin + Writeln('Test val for dword type'); + TestAllval2:=TestAll; +end; + +end. diff --git a/tests/test/units/system/tval3.pp b/tests/test/units/system/tval3.pp index 6913560e82..4114408a65 100644 --- a/tests/test/units/system/tval3.pp +++ b/tests/test/units/system/tval3.pp @@ -1,27 +1,27 @@ - -unit tval3; - -{$mode fpc} - -interface - -function TestAllval3 : boolean; - -implementation - -uses - tvalc; - -type - IntegerType = int64; - -{$i tval.inc} - - -function TestAllval3 : boolean; -begin - Writeln('Test val for int64 type'); - TestAllval3:=TestAll; -end; - -end. + +unit tval3; + +{$mode fpc} + +interface + +function TestAllval3 : boolean; + +implementation + +uses + tvalc; + +type + IntegerType = int64; + +{$i tval.inc} + + +function TestAllval3 : boolean; +begin + Writeln('Test val for int64 type'); + TestAllval3:=TestAll; +end; + +end. diff --git a/tests/test/units/system/tval4.pp b/tests/test/units/system/tval4.pp index 70f57eca6d..e0646e77e1 100644 --- a/tests/test/units/system/tval4.pp +++ b/tests/test/units/system/tval4.pp @@ -1,27 +1,27 @@ - -unit tval4; - -{$mode fpc} - -interface - -function TestAllval4 : boolean; - -implementation - -uses - tvalc; - -type - IntegerType = qword; - -{$i tval.inc} - - -function TestAllval4 : boolean; -begin - Writeln('Test val for qword type'); - TestAllval4:=TestAll; -end; - -end. + +unit tval4; + +{$mode fpc} + +interface + +function TestAllval4 : boolean; + +implementation + +uses + tvalc; + +type + IntegerType = qword; + +{$i tval.inc} + + +function TestAllval4 : boolean; +begin + Writeln('Test val for qword type'); + TestAllval4:=TestAll; +end; + +end. diff --git a/tests/test/units/system/tvalc.pp b/tests/test/units/system/tvalc.pp index 16b7397ec1..54e9a2e6ca 100644 --- a/tests/test/units/system/tvalc.pp +++ b/tests/test/units/system/tvalc.pp @@ -1,63 +1,63 @@ -unit tvalc; - -interface -const - HasErrors : boolean = false; - Silent : boolean = true; - CheckVal : boolean = true; - SuccessCount : longint = 0; - FailCount : longint = 0; - -type - TCharSet = set of char; -const - ValidNumeralsBase2 : TCHarSet = ['0'..'1']; - ValidNumeralsBase8 : TCHarSet = ['0'..'7']; - ValidNumeralsBase10 : TCHarSet = ['0'..'9']; - ValidNumeralsBase16 : TCHarSet = ['0'..'9','a'..'f','A'..'F']; - SpecialCharsFirst : TCharSet = [' ',#9,'x','X','$','&','%','+','-']; - SpecialCharsSecond : TCharSet = [#0]; - -type - - ValTestType = - (ValShouldFail, - ValShouldSucceed, - ValShouldSucceedAfterRemovingTrail); - - -function Display(const s : string) : string; - -implementation - -function Display(const s : string) : string; -var - res,ordval : string; - i : longint; - quoted : boolean; -begin - res:='"'; - quoted:=false; - for i:=1 to length(s) do - if ord(s[i])<32 then - begin - if quoted then - res:=res+''''; - str(ord(s[i]),ordval); - res:=res+'#'+ordval; - quoted:=false; - end - else - begin - if not quoted then - res:=res+''''; - quoted:=true; - res:=res+s[i]; - end; - if quoted then - res:=res+''''; - res:=res+'"'; - Display:=res; -end; - -end. +unit tvalc; + +interface +const + HasErrors : boolean = false; + Silent : boolean = true; + CheckVal : boolean = true; + SuccessCount : longint = 0; + FailCount : longint = 0; + +type + TCharSet = set of char; +const + ValidNumeralsBase2 : TCHarSet = ['0'..'1']; + ValidNumeralsBase8 : TCHarSet = ['0'..'7']; + ValidNumeralsBase10 : TCHarSet = ['0'..'9']; + ValidNumeralsBase16 : TCHarSet = ['0'..'9','a'..'f','A'..'F']; + SpecialCharsFirst : TCharSet = [' ',#9,'x','X','$','&','%','+','-']; + SpecialCharsSecond : TCharSet = [#0]; + +type + + ValTestType = + (ValShouldFail, + ValShouldSucceed, + ValShouldSucceedAfterRemovingTrail); + + +function Display(const s : string) : string; + +implementation + +function Display(const s : string) : string; +var + res,ordval : string; + i : longint; + quoted : boolean; +begin + res:='"'; + quoted:=false; + for i:=1 to length(s) do + if ord(s[i])<32 then + begin + if quoted then + res:=res+''''; + str(ord(s[i]),ordval); + res:=res+'#'+ordval; + quoted:=false; + end + else + begin + if not quoted then + res:=res+''''; + quoted:=true; + res:=res+s[i]; + end; + if quoted then + res:=res+''''; + res:=res+'"'; + Display:=res; +end; + +end. diff --git a/tests/test/units/sysutils/tfloattostr.pp b/tests/test/units/sysutils/tfloattostr.pp index ae5d2b9df5..2808e6851a 100644 --- a/tests/test/units/sysutils/tfloattostr.pp +++ b/tests/test/units/sysutils/tfloattostr.pp @@ -1,56 +1,56 @@ -{ Test for FloatToStr and CurrToStr functions. } - -uses sysutils; - -const - MaxCurrency : currency = 922337203685477.5807; - MinCurrency : currency = -922337203685477.5807; - -var - ErrCount: longint; - -procedure CheckResult(const s, ref: string); -begin - if s <> ref then - begin - writeln('Got : ', s); - writeln('Should be: ', ref); - Inc(ErrCount); - end; -end; - -var - e: extended; - d: double; - s: single; - c: currency; -begin - e:=1234567890123.4; - d:=12345.12345; - s:=12345.12; - c:=12345.1234; - CheckResult(FloatToStrF(e,ffExponent,15,1), '1'+DecimalSeparator+'23456789012340E+12'); - CheckResult(FloatToStrF(d,ffExponent,11,0), '1'+DecimalSeparator+'2345123450E+4'); - CheckResult(FloatToStrF(s,ffExponent,8,0), '1'+DecimalSeparator+'2345120E+4'); - CheckResult(FloatToStrF(s,ffExponent,8,7), '1'+DecimalSeparator+'2345120E+0004'); - CheckResult(FloatToStrF(e,ffExponent,8,3), '1'+DecimalSeparator+'2345679E+012'); - CheckResult(FloatToStrF(c,ffExponent,10,0), '1'+DecimalSeparator+'234512340E+4'); - CheckResult(FloatToStrF(c,ffExponent,11,2), '1'+DecimalSeparator+'2345123400E+04'); - CheckResult(FloatToStrF(c,ffExponent,10,4), '1'+DecimalSeparator+'234512340E+0004'); - CheckResult(FloatToStrF(-12345.12345,ffExponent,11,0), '-1'+DecimalSeparator+'2345123450E+4'); - CheckResult(FloatToStrF(-0.00000123,ffGeneral,15,0), '-1'+DecimalSeparator+'23E-6'); - CheckResult(FloatToStrF(-12345.12345,ffGeneral,7,0), '-12345'+DecimalSeparator+'12'); - CheckResult(CurrToStr(-12345.1234), '-12345'+DecimalSeparator+'1234'); - CheckResult(CurrToStr(MaxCurrency), '922337203685477'+DecimalSeparator+'5807'); - CheckResult(CurrToStr(MinCurrency), '-922337203685477'+DecimalSeparator+'5807'); - NegCurrFormat:=8; - CheckResult(FloatToStrF(-12345.1234,ffCurrency,19,4), '-12' + ThousandSeparator + '345'+DecimalSeparator+'1234 ' + CurrencyString); - CheckResult(FloatToStrF(MinCurrency,ffCurrency,19,4), '-922' + ThousandSeparator + '337' + ThousandSeparator + '203' + ThousandSeparator + '685' + ThousandSeparator + '477'+DecimalSeparator+'5807 ' + CurrencyString); - if ErrCount > 0 then - begin - writeln('Test failed. Errors: ', ErrCount); - Halt(1); - end - else - writeln('Test completed.'); -end. +{ Test for FloatToStr and CurrToStr functions. } + +uses sysutils; + +const + MaxCurrency : currency = 922337203685477.5807; + MinCurrency : currency = -922337203685477.5807; + +var + ErrCount: longint; + +procedure CheckResult(const s, ref: string); +begin + if s <> ref then + begin + writeln('Got : ', s); + writeln('Should be: ', ref); + Inc(ErrCount); + end; +end; + +var + e: extended; + d: double; + s: single; + c: currency; +begin + e:=1234567890123.4; + d:=12345.12345; + s:=12345.12; + c:=12345.1234; + CheckResult(FloatToStrF(e,ffExponent,15,1), '1'+DecimalSeparator+'23456789012340E+12'); + CheckResult(FloatToStrF(d,ffExponent,11,0), '1'+DecimalSeparator+'2345123450E+4'); + CheckResult(FloatToStrF(s,ffExponent,8,0), '1'+DecimalSeparator+'2345120E+4'); + CheckResult(FloatToStrF(s,ffExponent,8,7), '1'+DecimalSeparator+'2345120E+0004'); + CheckResult(FloatToStrF(e,ffExponent,8,3), '1'+DecimalSeparator+'2345679E+012'); + CheckResult(FloatToStrF(c,ffExponent,10,0), '1'+DecimalSeparator+'234512340E+4'); + CheckResult(FloatToStrF(c,ffExponent,11,2), '1'+DecimalSeparator+'2345123400E+04'); + CheckResult(FloatToStrF(c,ffExponent,10,4), '1'+DecimalSeparator+'234512340E+0004'); + CheckResult(FloatToStrF(-12345.12345,ffExponent,11,0), '-1'+DecimalSeparator+'2345123450E+4'); + CheckResult(FloatToStrF(-0.00000123,ffGeneral,15,0), '-1'+DecimalSeparator+'23E-6'); + CheckResult(FloatToStrF(-12345.12345,ffGeneral,7,0), '-12345'+DecimalSeparator+'12'); + CheckResult(CurrToStr(-12345.1234), '-12345'+DecimalSeparator+'1234'); + CheckResult(CurrToStr(MaxCurrency), '922337203685477'+DecimalSeparator+'5807'); + CheckResult(CurrToStr(MinCurrency), '-922337203685477'+DecimalSeparator+'5807'); + NegCurrFormat:=8; + CheckResult(FloatToStrF(-12345.1234,ffCurrency,19,4), '-12' + ThousandSeparator + '345'+DecimalSeparator+'1234 ' + CurrencyString); + CheckResult(FloatToStrF(MinCurrency,ffCurrency,19,4), '-922' + ThousandSeparator + '337' + ThousandSeparator + '203' + ThousandSeparator + '685' + ThousandSeparator + '477'+DecimalSeparator+'5807 ' + CurrencyString); + if ErrCount > 0 then + begin + writeln('Test failed. Errors: ', ErrCount); + Halt(1); + end + else + writeln('Test completed.'); +end. diff --git a/tests/webtbf/tw6957.pp b/tests/webtbf/tw6957.pp index 8687847e44..bbac031e46 100644 --- a/tests/webtbf/tw6957.pp +++ b/tests/webtbf/tw6957.pp @@ -1,19 +1,19 @@ -{ %fail } - -{$IFDEF FPC} - {$MODE TP} -{$ENDIF FPC} -unit tw6957; - -interface - -function tw6957: boolean; - -implementation - -function tw6957: boolean; -begin - tw6957 := true; -end; - -end. +{ %fail } + +{$IFDEF FPC} + {$MODE TP} +{$ENDIF FPC} +unit tw6957; + +interface + +function tw6957: boolean; + +implementation + +function tw6957: boolean; +begin + tw6957 := true; +end; + +end. diff --git a/tests/webtbs/tw5082.pp b/tests/webtbs/tw5082.pp index 8cc3dd8931..df90a12c6e 100644 --- a/tests/webtbs/tw5082.pp +++ b/tests/webtbs/tw5082.pp @@ -1,54 +1,54 @@ -{ Source provided for Free Pascal Bug Report 5082 } -{ Submitted by "Martin Schreiber" on 2006-05-01 } -{ e-mail: } -program storedfalse; -{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif} -{$ifdef mswindows}{$apptype console}{$endif} -uses - {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif} - sysutils,classes; - -type - ttestclass1 = class(tcomponent) - private - fprop1: real; - public - property prop1: real read fprop1 write fprop1 stored false; - end; - - ttestclass2 = class(ttestclass1) - published - property prop1; - end; - -var - testclass2: ttestclass2; - stream1,stream2: tmemorystream; - str1: string; - -begin - testclass2:= ttestclass2.create(nil); - testclass2.prop1:= 1; - stream1:= tmemorystream.create; - try - stream1.writecomponent(testclass2); - stream2:= tmemorystream.create; - try - stream1.position:= 0; - objectbinarytotext(stream1,stream2); - stream2.position:= 0; - setlength(str1,stream2.size); - move(stream2.memory^,str1[1],length(str1)); - write(str1); - finally - stream2.free; - end; - finally - stream1.free; - end; - if pos('prop1',str1)<>0 then - begin - writeln('error'); - halt(1); - end; -end. +{ Source provided for Free Pascal Bug Report 5082 } +{ Submitted by "Martin Schreiber" on 2006-05-01 } +{ e-mail: } +program storedfalse; +{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif} +{$ifdef mswindows}{$apptype console}{$endif} +uses + {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif} + sysutils,classes; + +type + ttestclass1 = class(tcomponent) + private + fprop1: real; + public + property prop1: real read fprop1 write fprop1 stored false; + end; + + ttestclass2 = class(ttestclass1) + published + property prop1; + end; + +var + testclass2: ttestclass2; + stream1,stream2: tmemorystream; + str1: string; + +begin + testclass2:= ttestclass2.create(nil); + testclass2.prop1:= 1; + stream1:= tmemorystream.create; + try + stream1.writecomponent(testclass2); + stream2:= tmemorystream.create; + try + stream1.position:= 0; + objectbinarytotext(stream1,stream2); + stream2.position:= 0; + setlength(str1,stream2.size); + move(stream2.memory^,str1[1],length(str1)); + write(str1); + finally + stream2.free; + end; + finally + stream1.free; + end; + if pos('prop1',str1)<>0 then + begin + writeln('error'); + halt(1); + end; +end. diff --git a/tests/webtbs/tw8177a.pp b/tests/webtbs/tw8177a.pp index 7c7872f109..638fbaabf1 100644 --- a/tests/webtbs/tw8177a.pp +++ b/tests/webtbs/tw8177a.pp @@ -1,30 +1,30 @@ - - -var - S : string; - i : longint; - err : word; -begin - S:=''; - val(S,i,err); - if err=0 then - begin - Writeln('Error: empty string is a valid input for val function'); - Halt(1); - end - else - begin - Writeln('Correct: empty string is a not valid input for val function'); - end; - S:=#0; - val(S,i,err); - if err=0 then - begin - Writeln('Error: #0 string is a valid input for val function'); - Halt(1); - end - else - begin - Writeln('Correct: #0 string is a not valid input for val function'); - end; + + +var + S : string; + i : longint; + err : word; +begin + S:=''; + val(S,i,err); + if err=0 then + begin + Writeln('Error: empty string is a valid input for val function'); + Halt(1); + end + else + begin + Writeln('Correct: empty string is a not valid input for val function'); + end; + S:=#0; + val(S,i,err); + if err=0 then + begin + Writeln('Error: #0 string is a valid input for val function'); + Halt(1); + end + else + begin + Writeln('Correct: #0 string is a not valid input for val function'); + end; end. \ No newline at end of file