From cd292568d775d55d9abb51e962882ecda12c03a9 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 12 Apr 2011 01:13:42 +0200 Subject: [PATCH] big repo cleanup --- {rod => compiler}/ast.nim | 0 {rod => compiler}/astalgo.nim | 0 {rod => compiler}/bitsets.nim | 0 {rod => compiler}/c2nim/c2nim.cfg | 2 +- {rod => compiler}/c2nim/c2nim.nim | 0 {rod => compiler}/c2nim/clex.nim | 0 {rod => compiler}/c2nim/cparse.nim | 0 {rod => compiler}/c2nim/cpp.nim | 0 {rod => compiler}/c2nim/tests/systest.c | 0 {rod => compiler}/c2nim/tests/systest2.c | 0 {rod => compiler}/ccgexprs.nim | 0 {rod => compiler}/ccgstmts.nim | 0 {rod => compiler}/ccgtypes.nim | 0 {rod => compiler}/ccgutils.nim | 0 {rod => compiler}/cgen.nim | 0 {rod => compiler}/cgmeth.nim | 0 {rod => compiler}/charsets.nim | 0 {rod => compiler}/commands.nim | 0 {rod => compiler}/condsyms.nim | 0 {rod => compiler}/crc.nim | 0 {rod => compiler}/depends.nim | 0 {rod => compiler}/docgen.nim | 0 {rod => compiler}/ecmasgen.nim | 0 {rod => compiler}/evals.nim | 0 {rod => compiler}/extccomp.nim | 0 {rod => compiler}/filters.nim | 0 {rod => compiler}/highlite.nim | 0 {rod => compiler}/idents.nim | 0 {rod => compiler}/importer.nim | 0 {rod => compiler}/lexbase.nim | 0 {rod => compiler}/lists.nim | 0 {rod => compiler}/llstream.nim | 0 {rod => compiler}/llvmgen.nim | 0 {rod => compiler}/llvmtype.nim | 0 {rod => compiler}/lookups.nim | 0 {rod => compiler}/magicsys.nim | 0 {rod => compiler}/main.nim | 0 {rod => compiler}/msgs.nim | 0 {rod => compiler}/nhashes.nim | 0 {rod => compiler}/nimconf.nim | 0 {rod => compiler}/nimrod.cfg | 0 {rod => compiler}/nimrod.dot | 0 {rod => compiler}/nimrod.ini | 18 +- {rod => compiler}/nimrod.nim | 0 {rod => compiler}/nimsets.nim | 0 {rod => compiler}/nstrtabs.nim | 0 {rod => compiler}/nversion.nim | 0 {rod => compiler}/options.nim | 0 {rod => compiler}/parsecfg.nim | 0 {rod => compiler}/pas2nim/pas2nim.cfg | 2 +- {rod => compiler}/pas2nim/pas2nim.nim | 0 {rod => compiler}/pas2nim/paslex.nim | 0 {rod => compiler}/pas2nim/pasparse.nim | 0 {rod => compiler}/passaux.nim | 0 {rod => compiler}/passes.nim | 0 {rod => compiler}/pbraces.nim | 0 {rod => compiler}/pendx.nim | 0 {rod => compiler}/platform.nim | 0 {rod => compiler}/pnimsyn.nim | 0 {rod => compiler}/pragmas.nim | 0 {rod => compiler}/procfind.nim | 0 {rod => compiler}/ptmplsyn.nim | 0 {rod => compiler}/readme.txt | 0 {rod => compiler}/rnimsyn.nim | 0 {rod => compiler}/rodread.nim | 0 {rod => compiler}/rodutils.nim | 0 {rod => compiler}/rodwrite.nim | 0 {rod => compiler}/ropes.nim | 0 {rod => compiler}/rst.nim | 0 {rod => compiler}/scanner.nim | 0 {rod => compiler}/sem.nim | 0 {rod => compiler}/semcall.nim | 0 {rod => compiler}/semdata.nim | 0 {rod => compiler}/semexprs.nim | 0 {rod => compiler}/semfold.nim | 0 {rod => compiler}/semgnrc.nim | 0 {rod => compiler}/seminst.nim | 0 {rod => compiler}/semstmts.nim | 0 {rod => compiler}/semtempl.nim | 0 {rod => compiler}/semtypes.nim | 0 {rod => compiler}/semtypinst.nim | 0 {rod => compiler}/sigmatch.nim | 0 {rod => compiler}/suggest.nim | 0 {rod => compiler}/syntaxes.nim | 0 {rod => compiler}/tccgen.nim | 0 {rod => compiler}/transf.nim | 0 {rod => compiler}/trees.nim | 0 {rod => compiler}/treetab.nim | 0 {rod => compiler}/types.nim | 0 {rod => compiler}/wordrecg.nim | 0 data/ast.yml | 274 --- data/magic.yml | 254 --- data/messages.yml | 273 --- data/pas_keyw.yml | 26 - data/readme.txt | 2 - diff/empty.txt | 1 - doc/intern.txt | 17 +- koch.nim | 35 +- lib/impure/zipfiles.nim | 4 +- llvm/llvm.pas | 1034 --------- llvm/llvm_orig.nim | 1569 -------------- nim/ast.pas | 1436 ------------- nim/astalgo.pas | 1294 ------------ nim/bitsets.pas | 123 -- nim/ccgexprs.pas | 2318 -------------------- nim/ccgstmts.pas | 989 --------- nim/ccgtypes.pas | 1082 ---------- nim/ccgutils.pas | 188 -- nim/cgen.pas | 1270 ----------- nim/cgmeth.pas | 269 --- nim/charsets.pas | 56 - nim/commands.pas | 588 ------ nim/condsyms.pas | 152 -- nim/config.inc | 62 - nim/crc.pas | 227 -- nim/depends.pas | 97 - nim/docgen.pas | 1176 ----------- nim/ecmasgen.pas | 1902 ----------------- nim/evals.pas | 1414 ------------- nim/extccomp.pas | 676 ------ nim/filters.pas | 137 -- nim/hashtest.pas | 10 - nim/highlite.pas | 743 ------- nim/idents.pas | 170 -- nim/importer.pas | 180 -- nim/interact.pas | 22 - nim/lexbase.pas | 232 -- nim/lists.pas | 165 -- nim/llstream.pas | 257 --- nim/llvmdata.pas | 139 -- nim/llvmdyn.pas | 443 ---- nim/llvmstat.pas | 445 ---- nim/lookups.pas | 307 --- nim/magicsys.pas | 277 --- nim/main.pas | 423 ---- nim/msgs.pas | 893 -------- nim/nhashes.pas | 225 -- nim/nimconf.pas | 361 ---- nim/nimrod.pas | 126 -- nim/nimsets.pas | 259 --- nim/nmath.pas | 68 - nim/nos.pas | 620 ------ nim/nstrtabs.pas | 294 --- nim/nsystem.pas | 657 ------ nim/ntime.pas | 107 - nim/nversion.pas | 42 - nim/options.pas | 291 --- nim/osproc.pas | 58 - nim/parsecfg.pas | 424 ---- nim/parseopt.pas | 153 -- nim/paslex.pas | 738 ------- nim/pasparse.pas | 1998 ------------------ nim/passaux.pas | 77 - nim/passes.pas | 215 -- nim/pbraces.pas | 1484 ------------- nim/pendx.pas | 36 - nim/platform.pas | 662 ------ nim/pnimsyn.pas | 1802 ---------------- nim/pragmas.pas | 627 ------ nim/procfind.pas | 120 -- nim/ptmplsyn.pas | 222 -- nim/readme.txt | 4 - nim/rnimsyn.pas | 1458 ------------- nim/rodread.pas | 1137 ---------- nim/rodwrite.pas | 612 ------ nim/ropes.pas | 635 ------ nim/rst.pas | 2184 ------------------- nim/scanner.pas | 1036 --------- nim/sem.pas | 280 --- nim/semdata.pas | 266 --- nim/semexprs.pas | 1426 ------------- nim/semfold.pas | 578 ----- nim/semgnrc.pas | 287 --- nim/seminst.pas | 365 ---- nim/semstmts.pas | 1116 ---------- nim/semtempl.pas | 270 --- nim/semtypes.pas | 874 -------- nim/sigmatch.pas | 964 --------- nim/strutils.pas | 755 ------- nim/syntaxes.pas | 234 --- nim/tigen.pas | 47 - nim/transf.pas | 964 --------- nim/transtmp.pas | 149 -- nim/trees.pas | 214 -- nim/treetab.pas | 189 -- nim/types.pas | 1295 ------------ nim/wordrecg.pas | 220 -- nimlib/copying.txt | 29 - nimlib/lgpl.txt | 502 ----- nimlib/nimbase.h | 425 ---- nimlib/posix/posix.nim | 2444 ---------------------- nimlib/pure/cgi.nim | 375 ---- nimlib/pure/complex.nim | 106 - nimlib/pure/dynlib.nim | 84 - nimlib/pure/hashes.nim | 97 - nimlib/pure/hashtabs.nim | 163 -- nimlib/pure/lexbase.nim | 166 -- nimlib/pure/logging.nim | 146 -- nimlib/pure/macros.nim | 249 --- nimlib/pure/math.nim | 249 --- nimlib/pure/md5.nim | 245 --- nimlib/pure/os.nim | 1147 ---------- nimlib/pure/osproc.nim | 543 ----- nimlib/pure/parsecfg.nim | 352 ---- nimlib/pure/parsecsv.nim | 178 -- nimlib/pure/parseopt.nim | 152 -- nimlib/pure/parsesql.nim | 1345 ------------ nimlib/pure/parsexml.nim | 635 ------ nimlib/pure/pegs.nim | 1365 ------------ nimlib/pure/re.nim | 354 ---- nimlib/pure/regexprs.nim | 177 -- nimlib/pure/streams.nim | 245 --- nimlib/pure/strtabs.nim | 198 -- nimlib/pure/strutils.nim | 973 --------- nimlib/pure/terminal.nim | 310 --- nimlib/pure/times.nim | 307 --- nimlib/pure/unicode.nim | 1178 ----------- nimlib/pure/variants.nim | 181 -- nimlib/pure/xmlgen.nim | 406 ---- nimlib/readme.txt | 2 - nimlib/system.nim | 1531 -------------- nimlib/system/alloc.nim | 596 ------ nimlib/system/ansi_c.nim | 105 - nimlib/system/arithm.nim | 316 --- nimlib/system/assign.nim | 120 -- nimlib/system/cellsets.nim | 196 -- nimlib/system/cntbits.nim | 12 - nimlib/system/debugger.nim | 500 ----- nimlib/system/dyncalls.nim | 127 -- nimlib/system/ecmasys.nim | 531 ----- nimlib/system/excpt.nim | 285 --- nimlib/system/gc.nim | 647 ------ nimlib/system/hti.nim | 58 - nimlib/system/mm.nim | 189 -- nimlib/system/profiler.nim | 61 - nimlib/system/repr.nim | 249 --- nimlib/system/sets.nim | 28 - nimlib/system/sysio.nim | 184 -- nimlib/system/sysstr.nim | 289 --- nimlib/windows/winlean.nim | 192 -- obj/empty.txt | 1 - rod/expandimportc.nim | 73 - rod/hashtest.nim | 5 - rod/noprefix2.nim | 15 - rod/tigen.nim | 33 - rod/transtmp.nim | 111 - 246 files changed, 28 insertions(+), 74652 deletions(-) rename {rod => compiler}/ast.nim (100%) rename {rod => compiler}/astalgo.nim (100%) rename {rod => compiler}/bitsets.nim (100%) rename {rod => compiler}/c2nim/c2nim.cfg (59%) rename {rod => compiler}/c2nim/c2nim.nim (100%) rename {rod => compiler}/c2nim/clex.nim (100%) rename {rod => compiler}/c2nim/cparse.nim (100%) rename {rod => compiler}/c2nim/cpp.nim (100%) rename {rod => compiler}/c2nim/tests/systest.c (100%) rename {rod => compiler}/c2nim/tests/systest2.c (100%) rename {rod => compiler}/ccgexprs.nim (100%) rename {rod => compiler}/ccgstmts.nim (100%) rename {rod => compiler}/ccgtypes.nim (100%) rename {rod => compiler}/ccgutils.nim (100%) rename {rod => compiler}/cgen.nim (100%) rename {rod => compiler}/cgmeth.nim (100%) rename {rod => compiler}/charsets.nim (100%) rename {rod => compiler}/commands.nim (100%) rename {rod => compiler}/condsyms.nim (100%) rename {rod => compiler}/crc.nim (100%) rename {rod => compiler}/depends.nim (100%) rename {rod => compiler}/docgen.nim (100%) rename {rod => compiler}/ecmasgen.nim (100%) rename {rod => compiler}/evals.nim (100%) rename {rod => compiler}/extccomp.nim (100%) rename {rod => compiler}/filters.nim (100%) rename {rod => compiler}/highlite.nim (100%) rename {rod => compiler}/idents.nim (100%) rename {rod => compiler}/importer.nim (100%) rename {rod => compiler}/lexbase.nim (100%) rename {rod => compiler}/lists.nim (100%) rename {rod => compiler}/llstream.nim (100%) rename {rod => compiler}/llvmgen.nim (100%) rename {rod => compiler}/llvmtype.nim (100%) rename {rod => compiler}/lookups.nim (100%) rename {rod => compiler}/magicsys.nim (100%) rename {rod => compiler}/main.nim (100%) rename {rod => compiler}/msgs.nim (100%) rename {rod => compiler}/nhashes.nim (100%) rename {rod => compiler}/nimconf.nim (100%) rename {rod => compiler}/nimrod.cfg (100%) rename {rod => compiler}/nimrod.dot (100%) rename {rod => compiler}/nimrod.ini (92%) rename {rod => compiler}/nimrod.nim (100%) rename {rod => compiler}/nimsets.nim (100%) rename {rod => compiler}/nstrtabs.nim (100%) rename {rod => compiler}/nversion.nim (100%) rename {rod => compiler}/options.nim (100%) rename {rod => compiler}/parsecfg.nim (100%) rename {rod => compiler}/pas2nim/pas2nim.cfg (59%) rename {rod => compiler}/pas2nim/pas2nim.nim (100%) rename {rod => compiler}/pas2nim/paslex.nim (100%) rename {rod => compiler}/pas2nim/pasparse.nim (100%) rename {rod => compiler}/passaux.nim (100%) rename {rod => compiler}/passes.nim (100%) rename {rod => compiler}/pbraces.nim (100%) rename {rod => compiler}/pendx.nim (100%) rename {rod => compiler}/platform.nim (100%) rename {rod => compiler}/pnimsyn.nim (100%) rename {rod => compiler}/pragmas.nim (100%) rename {rod => compiler}/procfind.nim (100%) rename {rod => compiler}/ptmplsyn.nim (100%) rename {rod => compiler}/readme.txt (100%) rename {rod => compiler}/rnimsyn.nim (100%) rename {rod => compiler}/rodread.nim (100%) rename {rod => compiler}/rodutils.nim (100%) rename {rod => compiler}/rodwrite.nim (100%) rename {rod => compiler}/ropes.nim (100%) rename {rod => compiler}/rst.nim (100%) rename {rod => compiler}/scanner.nim (100%) rename {rod => compiler}/sem.nim (100%) rename {rod => compiler}/semcall.nim (100%) rename {rod => compiler}/semdata.nim (100%) rename {rod => compiler}/semexprs.nim (100%) rename {rod => compiler}/semfold.nim (100%) rename {rod => compiler}/semgnrc.nim (100%) rename {rod => compiler}/seminst.nim (100%) rename {rod => compiler}/semstmts.nim (100%) rename {rod => compiler}/semtempl.nim (100%) rename {rod => compiler}/semtypes.nim (100%) rename {rod => compiler}/semtypinst.nim (100%) rename {rod => compiler}/sigmatch.nim (100%) rename {rod => compiler}/suggest.nim (100%) rename {rod => compiler}/syntaxes.nim (100%) rename {rod => compiler}/tccgen.nim (100%) rename {rod => compiler}/transf.nim (100%) rename {rod => compiler}/trees.nim (100%) rename {rod => compiler}/treetab.nim (100%) rename {rod => compiler}/types.nim (100%) rename {rod => compiler}/wordrecg.nim (100%) delete mode 100755 data/ast.yml delete mode 100755 data/magic.yml delete mode 100755 data/messages.yml delete mode 100755 data/pas_keyw.yml delete mode 100755 data/readme.txt delete mode 100755 diff/empty.txt delete mode 100755 llvm/llvm.pas delete mode 100755 llvm/llvm_orig.nim delete mode 100755 nim/ast.pas delete mode 100755 nim/astalgo.pas delete mode 100755 nim/bitsets.pas delete mode 100755 nim/ccgexprs.pas delete mode 100755 nim/ccgstmts.pas delete mode 100755 nim/ccgtypes.pas delete mode 100755 nim/ccgutils.pas delete mode 100755 nim/cgen.pas delete mode 100755 nim/cgmeth.pas delete mode 100755 nim/charsets.pas delete mode 100755 nim/commands.pas delete mode 100755 nim/condsyms.pas delete mode 100755 nim/config.inc delete mode 100755 nim/crc.pas delete mode 100755 nim/depends.pas delete mode 100755 nim/docgen.pas delete mode 100755 nim/ecmasgen.pas delete mode 100755 nim/evals.pas delete mode 100755 nim/extccomp.pas delete mode 100755 nim/filters.pas delete mode 100755 nim/hashtest.pas delete mode 100755 nim/highlite.pas delete mode 100755 nim/idents.pas delete mode 100755 nim/importer.pas delete mode 100755 nim/interact.pas delete mode 100755 nim/lexbase.pas delete mode 100755 nim/lists.pas delete mode 100755 nim/llstream.pas delete mode 100755 nim/llvmdata.pas delete mode 100755 nim/llvmdyn.pas delete mode 100755 nim/llvmstat.pas delete mode 100755 nim/lookups.pas delete mode 100755 nim/magicsys.pas delete mode 100755 nim/main.pas delete mode 100755 nim/msgs.pas delete mode 100755 nim/nhashes.pas delete mode 100755 nim/nimconf.pas delete mode 100755 nim/nimrod.pas delete mode 100755 nim/nimsets.pas delete mode 100755 nim/nmath.pas delete mode 100755 nim/nos.pas delete mode 100755 nim/nstrtabs.pas delete mode 100755 nim/nsystem.pas delete mode 100755 nim/ntime.pas delete mode 100755 nim/nversion.pas delete mode 100755 nim/options.pas delete mode 100755 nim/osproc.pas delete mode 100755 nim/parsecfg.pas delete mode 100755 nim/parseopt.pas delete mode 100755 nim/paslex.pas delete mode 100755 nim/pasparse.pas delete mode 100755 nim/passaux.pas delete mode 100755 nim/passes.pas delete mode 100755 nim/pbraces.pas delete mode 100755 nim/pendx.pas delete mode 100755 nim/platform.pas delete mode 100755 nim/pnimsyn.pas delete mode 100755 nim/pragmas.pas delete mode 100755 nim/procfind.pas delete mode 100755 nim/ptmplsyn.pas delete mode 100755 nim/readme.txt delete mode 100755 nim/rnimsyn.pas delete mode 100755 nim/rodread.pas delete mode 100755 nim/rodwrite.pas delete mode 100755 nim/ropes.pas delete mode 100755 nim/rst.pas delete mode 100755 nim/scanner.pas delete mode 100755 nim/sem.pas delete mode 100755 nim/semdata.pas delete mode 100755 nim/semexprs.pas delete mode 100755 nim/semfold.pas delete mode 100755 nim/semgnrc.pas delete mode 100755 nim/seminst.pas delete mode 100755 nim/semstmts.pas delete mode 100755 nim/semtempl.pas delete mode 100755 nim/semtypes.pas delete mode 100755 nim/sigmatch.pas delete mode 100755 nim/strutils.pas delete mode 100755 nim/syntaxes.pas delete mode 100755 nim/tigen.pas delete mode 100755 nim/transf.pas delete mode 100755 nim/transtmp.pas delete mode 100755 nim/trees.pas delete mode 100755 nim/treetab.pas delete mode 100755 nim/types.pas delete mode 100755 nim/wordrecg.pas delete mode 100755 nimlib/copying.txt delete mode 100755 nimlib/lgpl.txt delete mode 100755 nimlib/nimbase.h delete mode 100755 nimlib/posix/posix.nim delete mode 100755 nimlib/pure/cgi.nim delete mode 100755 nimlib/pure/complex.nim delete mode 100755 nimlib/pure/dynlib.nim delete mode 100755 nimlib/pure/hashes.nim delete mode 100755 nimlib/pure/hashtabs.nim delete mode 100755 nimlib/pure/lexbase.nim delete mode 100755 nimlib/pure/logging.nim delete mode 100755 nimlib/pure/macros.nim delete mode 100755 nimlib/pure/math.nim delete mode 100755 nimlib/pure/md5.nim delete mode 100755 nimlib/pure/os.nim delete mode 100755 nimlib/pure/osproc.nim delete mode 100755 nimlib/pure/parsecfg.nim delete mode 100755 nimlib/pure/parsecsv.nim delete mode 100755 nimlib/pure/parseopt.nim delete mode 100755 nimlib/pure/parsesql.nim delete mode 100755 nimlib/pure/parsexml.nim delete mode 100755 nimlib/pure/pegs.nim delete mode 100755 nimlib/pure/re.nim delete mode 100755 nimlib/pure/regexprs.nim delete mode 100755 nimlib/pure/streams.nim delete mode 100755 nimlib/pure/strtabs.nim delete mode 100755 nimlib/pure/strutils.nim delete mode 100755 nimlib/pure/terminal.nim delete mode 100755 nimlib/pure/times.nim delete mode 100755 nimlib/pure/unicode.nim delete mode 100755 nimlib/pure/variants.nim delete mode 100755 nimlib/pure/xmlgen.nim delete mode 100755 nimlib/readme.txt delete mode 100755 nimlib/system.nim delete mode 100755 nimlib/system/alloc.nim delete mode 100755 nimlib/system/ansi_c.nim delete mode 100755 nimlib/system/arithm.nim delete mode 100755 nimlib/system/assign.nim delete mode 100755 nimlib/system/cellsets.nim delete mode 100755 nimlib/system/cntbits.nim delete mode 100755 nimlib/system/debugger.nim delete mode 100755 nimlib/system/dyncalls.nim delete mode 100755 nimlib/system/ecmasys.nim delete mode 100755 nimlib/system/excpt.nim delete mode 100755 nimlib/system/gc.nim delete mode 100755 nimlib/system/hti.nim delete mode 100755 nimlib/system/mm.nim delete mode 100755 nimlib/system/profiler.nim delete mode 100755 nimlib/system/repr.nim delete mode 100755 nimlib/system/sets.nim delete mode 100755 nimlib/system/sysio.nim delete mode 100755 nimlib/system/sysstr.nim delete mode 100755 nimlib/windows/winlean.nim delete mode 100755 obj/empty.txt delete mode 100755 rod/expandimportc.nim delete mode 100755 rod/hashtest.nim delete mode 100755 rod/noprefix2.nim delete mode 100755 rod/tigen.nim delete mode 100755 rod/transtmp.nim diff --git a/rod/ast.nim b/compiler/ast.nim similarity index 100% rename from rod/ast.nim rename to compiler/ast.nim diff --git a/rod/astalgo.nim b/compiler/astalgo.nim similarity index 100% rename from rod/astalgo.nim rename to compiler/astalgo.nim diff --git a/rod/bitsets.nim b/compiler/bitsets.nim similarity index 100% rename from rod/bitsets.nim rename to compiler/bitsets.nim diff --git a/rod/c2nim/c2nim.cfg b/compiler/c2nim/c2nim.cfg similarity index 59% rename from rod/c2nim/c2nim.cfg rename to compiler/c2nim/c2nim.cfg index 789e6ec7f0..cfeda63ed6 100755 --- a/rod/c2nim/c2nim.cfg +++ b/compiler/c2nim/c2nim.cfg @@ -1,4 +1,4 @@ # Use the modules of the compiler -path: "$nimrod/rod" +path: "$nimrod/compiler" diff --git a/rod/c2nim/c2nim.nim b/compiler/c2nim/c2nim.nim similarity index 100% rename from rod/c2nim/c2nim.nim rename to compiler/c2nim/c2nim.nim diff --git a/rod/c2nim/clex.nim b/compiler/c2nim/clex.nim similarity index 100% rename from rod/c2nim/clex.nim rename to compiler/c2nim/clex.nim diff --git a/rod/c2nim/cparse.nim b/compiler/c2nim/cparse.nim similarity index 100% rename from rod/c2nim/cparse.nim rename to compiler/c2nim/cparse.nim diff --git a/rod/c2nim/cpp.nim b/compiler/c2nim/cpp.nim similarity index 100% rename from rod/c2nim/cpp.nim rename to compiler/c2nim/cpp.nim diff --git a/rod/c2nim/tests/systest.c b/compiler/c2nim/tests/systest.c similarity index 100% rename from rod/c2nim/tests/systest.c rename to compiler/c2nim/tests/systest.c diff --git a/rod/c2nim/tests/systest2.c b/compiler/c2nim/tests/systest2.c similarity index 100% rename from rod/c2nim/tests/systest2.c rename to compiler/c2nim/tests/systest2.c diff --git a/rod/ccgexprs.nim b/compiler/ccgexprs.nim similarity index 100% rename from rod/ccgexprs.nim rename to compiler/ccgexprs.nim diff --git a/rod/ccgstmts.nim b/compiler/ccgstmts.nim similarity index 100% rename from rod/ccgstmts.nim rename to compiler/ccgstmts.nim diff --git a/rod/ccgtypes.nim b/compiler/ccgtypes.nim similarity index 100% rename from rod/ccgtypes.nim rename to compiler/ccgtypes.nim diff --git a/rod/ccgutils.nim b/compiler/ccgutils.nim similarity index 100% rename from rod/ccgutils.nim rename to compiler/ccgutils.nim diff --git a/rod/cgen.nim b/compiler/cgen.nim similarity index 100% rename from rod/cgen.nim rename to compiler/cgen.nim diff --git a/rod/cgmeth.nim b/compiler/cgmeth.nim similarity index 100% rename from rod/cgmeth.nim rename to compiler/cgmeth.nim diff --git a/rod/charsets.nim b/compiler/charsets.nim similarity index 100% rename from rod/charsets.nim rename to compiler/charsets.nim diff --git a/rod/commands.nim b/compiler/commands.nim similarity index 100% rename from rod/commands.nim rename to compiler/commands.nim diff --git a/rod/condsyms.nim b/compiler/condsyms.nim similarity index 100% rename from rod/condsyms.nim rename to compiler/condsyms.nim diff --git a/rod/crc.nim b/compiler/crc.nim similarity index 100% rename from rod/crc.nim rename to compiler/crc.nim diff --git a/rod/depends.nim b/compiler/depends.nim similarity index 100% rename from rod/depends.nim rename to compiler/depends.nim diff --git a/rod/docgen.nim b/compiler/docgen.nim similarity index 100% rename from rod/docgen.nim rename to compiler/docgen.nim diff --git a/rod/ecmasgen.nim b/compiler/ecmasgen.nim similarity index 100% rename from rod/ecmasgen.nim rename to compiler/ecmasgen.nim diff --git a/rod/evals.nim b/compiler/evals.nim similarity index 100% rename from rod/evals.nim rename to compiler/evals.nim diff --git a/rod/extccomp.nim b/compiler/extccomp.nim similarity index 100% rename from rod/extccomp.nim rename to compiler/extccomp.nim diff --git a/rod/filters.nim b/compiler/filters.nim similarity index 100% rename from rod/filters.nim rename to compiler/filters.nim diff --git a/rod/highlite.nim b/compiler/highlite.nim similarity index 100% rename from rod/highlite.nim rename to compiler/highlite.nim diff --git a/rod/idents.nim b/compiler/idents.nim similarity index 100% rename from rod/idents.nim rename to compiler/idents.nim diff --git a/rod/importer.nim b/compiler/importer.nim similarity index 100% rename from rod/importer.nim rename to compiler/importer.nim diff --git a/rod/lexbase.nim b/compiler/lexbase.nim similarity index 100% rename from rod/lexbase.nim rename to compiler/lexbase.nim diff --git a/rod/lists.nim b/compiler/lists.nim similarity index 100% rename from rod/lists.nim rename to compiler/lists.nim diff --git a/rod/llstream.nim b/compiler/llstream.nim similarity index 100% rename from rod/llstream.nim rename to compiler/llstream.nim diff --git a/rod/llvmgen.nim b/compiler/llvmgen.nim similarity index 100% rename from rod/llvmgen.nim rename to compiler/llvmgen.nim diff --git a/rod/llvmtype.nim b/compiler/llvmtype.nim similarity index 100% rename from rod/llvmtype.nim rename to compiler/llvmtype.nim diff --git a/rod/lookups.nim b/compiler/lookups.nim similarity index 100% rename from rod/lookups.nim rename to compiler/lookups.nim diff --git a/rod/magicsys.nim b/compiler/magicsys.nim similarity index 100% rename from rod/magicsys.nim rename to compiler/magicsys.nim diff --git a/rod/main.nim b/compiler/main.nim similarity index 100% rename from rod/main.nim rename to compiler/main.nim diff --git a/rod/msgs.nim b/compiler/msgs.nim similarity index 100% rename from rod/msgs.nim rename to compiler/msgs.nim diff --git a/rod/nhashes.nim b/compiler/nhashes.nim similarity index 100% rename from rod/nhashes.nim rename to compiler/nhashes.nim diff --git a/rod/nimconf.nim b/compiler/nimconf.nim similarity index 100% rename from rod/nimconf.nim rename to compiler/nimconf.nim diff --git a/rod/nimrod.cfg b/compiler/nimrod.cfg similarity index 100% rename from rod/nimrod.cfg rename to compiler/nimrod.cfg diff --git a/rod/nimrod.dot b/compiler/nimrod.dot similarity index 100% rename from rod/nimrod.dot rename to compiler/nimrod.dot diff --git a/rod/nimrod.ini b/compiler/nimrod.ini similarity index 92% rename from rod/nimrod.ini rename to compiler/nimrod.ini index 7a396d0cae..3a88fd5215 100755 --- a/rod/nimrod.ini +++ b/compiler/nimrod.ini @@ -46,18 +46,12 @@ Files: "icons/koch.ico" Files: "icons/koch.rc" Files: "icons/koch.res" -Files: "rod/readme.txt" -Files: "rod/nimrod.ini" -Files: "rod/nimrod.cfg" -Files: "rod/*.nim" +Files: "compiler/readme.txt" +Files: "compiler/nimrod.ini" +Files: "compiler/nimrod.cfg" +Files: "compiler/*.nim" Files: "build/empty.txt" Files: "bin/empty.txt" -Files: "nim/*.*" - -Files: "data/*.yml" -Files: "data/*.txt" -Files: "obj/*.txt" -Files: "diff/*.txt" [Lib] Files: "lib/nimbase.h;lib/cycle.h" @@ -116,11 +110,11 @@ Files: "examples/*.tmpl" Files: "bin/nimrod.exe" Files: "bin/c2nim.exe" Files: "bin/niminst.exe" -Files: "deps/*.dll" +Files: "dist/*.dll" Files: "koch.exe" Files: "dist/mingw" Files: "start.bat" -BinPath: r"bin;dist\mingw\bin;deps" +BinPath: r"bin;dist\mingw\bin;dist" InnoSetup: "Yes" [UnixBin] diff --git a/rod/nimrod.nim b/compiler/nimrod.nim similarity index 100% rename from rod/nimrod.nim rename to compiler/nimrod.nim diff --git a/rod/nimsets.nim b/compiler/nimsets.nim similarity index 100% rename from rod/nimsets.nim rename to compiler/nimsets.nim diff --git a/rod/nstrtabs.nim b/compiler/nstrtabs.nim similarity index 100% rename from rod/nstrtabs.nim rename to compiler/nstrtabs.nim diff --git a/rod/nversion.nim b/compiler/nversion.nim similarity index 100% rename from rod/nversion.nim rename to compiler/nversion.nim diff --git a/rod/options.nim b/compiler/options.nim similarity index 100% rename from rod/options.nim rename to compiler/options.nim diff --git a/rod/parsecfg.nim b/compiler/parsecfg.nim similarity index 100% rename from rod/parsecfg.nim rename to compiler/parsecfg.nim diff --git a/rod/pas2nim/pas2nim.cfg b/compiler/pas2nim/pas2nim.cfg similarity index 59% rename from rod/pas2nim/pas2nim.cfg rename to compiler/pas2nim/pas2nim.cfg index 789e6ec7f0..cfeda63ed6 100755 --- a/rod/pas2nim/pas2nim.cfg +++ b/compiler/pas2nim/pas2nim.cfg @@ -1,4 +1,4 @@ # Use the modules of the compiler -path: "$nimrod/rod" +path: "$nimrod/compiler" diff --git a/rod/pas2nim/pas2nim.nim b/compiler/pas2nim/pas2nim.nim similarity index 100% rename from rod/pas2nim/pas2nim.nim rename to compiler/pas2nim/pas2nim.nim diff --git a/rod/pas2nim/paslex.nim b/compiler/pas2nim/paslex.nim similarity index 100% rename from rod/pas2nim/paslex.nim rename to compiler/pas2nim/paslex.nim diff --git a/rod/pas2nim/pasparse.nim b/compiler/pas2nim/pasparse.nim similarity index 100% rename from rod/pas2nim/pasparse.nim rename to compiler/pas2nim/pasparse.nim diff --git a/rod/passaux.nim b/compiler/passaux.nim similarity index 100% rename from rod/passaux.nim rename to compiler/passaux.nim diff --git a/rod/passes.nim b/compiler/passes.nim similarity index 100% rename from rod/passes.nim rename to compiler/passes.nim diff --git a/rod/pbraces.nim b/compiler/pbraces.nim similarity index 100% rename from rod/pbraces.nim rename to compiler/pbraces.nim diff --git a/rod/pendx.nim b/compiler/pendx.nim similarity index 100% rename from rod/pendx.nim rename to compiler/pendx.nim diff --git a/rod/platform.nim b/compiler/platform.nim similarity index 100% rename from rod/platform.nim rename to compiler/platform.nim diff --git a/rod/pnimsyn.nim b/compiler/pnimsyn.nim similarity index 100% rename from rod/pnimsyn.nim rename to compiler/pnimsyn.nim diff --git a/rod/pragmas.nim b/compiler/pragmas.nim similarity index 100% rename from rod/pragmas.nim rename to compiler/pragmas.nim diff --git a/rod/procfind.nim b/compiler/procfind.nim similarity index 100% rename from rod/procfind.nim rename to compiler/procfind.nim diff --git a/rod/ptmplsyn.nim b/compiler/ptmplsyn.nim similarity index 100% rename from rod/ptmplsyn.nim rename to compiler/ptmplsyn.nim diff --git a/rod/readme.txt b/compiler/readme.txt similarity index 100% rename from rod/readme.txt rename to compiler/readme.txt diff --git a/rod/rnimsyn.nim b/compiler/rnimsyn.nim similarity index 100% rename from rod/rnimsyn.nim rename to compiler/rnimsyn.nim diff --git a/rod/rodread.nim b/compiler/rodread.nim similarity index 100% rename from rod/rodread.nim rename to compiler/rodread.nim diff --git a/rod/rodutils.nim b/compiler/rodutils.nim similarity index 100% rename from rod/rodutils.nim rename to compiler/rodutils.nim diff --git a/rod/rodwrite.nim b/compiler/rodwrite.nim similarity index 100% rename from rod/rodwrite.nim rename to compiler/rodwrite.nim diff --git a/rod/ropes.nim b/compiler/ropes.nim similarity index 100% rename from rod/ropes.nim rename to compiler/ropes.nim diff --git a/rod/rst.nim b/compiler/rst.nim similarity index 100% rename from rod/rst.nim rename to compiler/rst.nim diff --git a/rod/scanner.nim b/compiler/scanner.nim similarity index 100% rename from rod/scanner.nim rename to compiler/scanner.nim diff --git a/rod/sem.nim b/compiler/sem.nim similarity index 100% rename from rod/sem.nim rename to compiler/sem.nim diff --git a/rod/semcall.nim b/compiler/semcall.nim similarity index 100% rename from rod/semcall.nim rename to compiler/semcall.nim diff --git a/rod/semdata.nim b/compiler/semdata.nim similarity index 100% rename from rod/semdata.nim rename to compiler/semdata.nim diff --git a/rod/semexprs.nim b/compiler/semexprs.nim similarity index 100% rename from rod/semexprs.nim rename to compiler/semexprs.nim diff --git a/rod/semfold.nim b/compiler/semfold.nim similarity index 100% rename from rod/semfold.nim rename to compiler/semfold.nim diff --git a/rod/semgnrc.nim b/compiler/semgnrc.nim similarity index 100% rename from rod/semgnrc.nim rename to compiler/semgnrc.nim diff --git a/rod/seminst.nim b/compiler/seminst.nim similarity index 100% rename from rod/seminst.nim rename to compiler/seminst.nim diff --git a/rod/semstmts.nim b/compiler/semstmts.nim similarity index 100% rename from rod/semstmts.nim rename to compiler/semstmts.nim diff --git a/rod/semtempl.nim b/compiler/semtempl.nim similarity index 100% rename from rod/semtempl.nim rename to compiler/semtempl.nim diff --git a/rod/semtypes.nim b/compiler/semtypes.nim similarity index 100% rename from rod/semtypes.nim rename to compiler/semtypes.nim diff --git a/rod/semtypinst.nim b/compiler/semtypinst.nim similarity index 100% rename from rod/semtypinst.nim rename to compiler/semtypinst.nim diff --git a/rod/sigmatch.nim b/compiler/sigmatch.nim similarity index 100% rename from rod/sigmatch.nim rename to compiler/sigmatch.nim diff --git a/rod/suggest.nim b/compiler/suggest.nim similarity index 100% rename from rod/suggest.nim rename to compiler/suggest.nim diff --git a/rod/syntaxes.nim b/compiler/syntaxes.nim similarity index 100% rename from rod/syntaxes.nim rename to compiler/syntaxes.nim diff --git a/rod/tccgen.nim b/compiler/tccgen.nim similarity index 100% rename from rod/tccgen.nim rename to compiler/tccgen.nim diff --git a/rod/transf.nim b/compiler/transf.nim similarity index 100% rename from rod/transf.nim rename to compiler/transf.nim diff --git a/rod/trees.nim b/compiler/trees.nim similarity index 100% rename from rod/trees.nim rename to compiler/trees.nim diff --git a/rod/treetab.nim b/compiler/treetab.nim similarity index 100% rename from rod/treetab.nim rename to compiler/treetab.nim diff --git a/rod/types.nim b/compiler/types.nim similarity index 100% rename from rod/types.nim rename to compiler/types.nim diff --git a/rod/wordrecg.nim b/compiler/wordrecg.nim similarity index 100% rename from rod/wordrecg.nim rename to compiler/wordrecg.nim diff --git a/data/ast.yml b/data/ast.yml deleted file mode 100755 index f27b09a186..0000000000 --- a/data/ast.yml +++ /dev/null @@ -1,274 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -{ -'SymFlag': [ # already 30 flags! - 'sfUsed', # read access of sym (for warnings) or simply used - 'sfStar', # symbol has * visibility - 'sfMinus', # symbol has - visibility - 'sfInInterface', # symbol is in interface section declared - 'sfFromGeneric', # symbol is instantiation of a generic; this is needed - # for symbol file generation; such symbols should always - # be written into the ROD file - 'sfGlobal', # symbol is at global scope - - 'sfForward', # symbol is forward directed - 'sfImportc', # symbol is external; imported - 'sfExportc', # symbol is exported (under a specified name) - 'sfVolatile', # variable is volatile - 'sfRegister', # variable should be placed in a register - 'sfPure', # object is "pure" that means it has no type-information - - 'sfResult', # variable is 'result' in proc - 'sfNoSideEffect', # proc has no side effects - 'sfSideEffect', # proc may have side effects; cannot prove it has none - 'sfMainModule', # module is the main module - 'sfSystemModule', # module is the system module - 'sfNoReturn', # proc never returns (an exit proc) - 'sfAddrTaken', # the variable's address is taken (ex- or implicitely) - 'sfCompilerProc', # proc is a compiler proc, that is a C proc that is - # needed for the code generator - 'sfProcvar', # proc can be passed to a proc var - 'sfDiscriminant', # field is a discriminant in a record/object - 'sfDeprecated', # symbol is deprecated - 'sfInClosure', # variable is accessed by a closure - 'sfTypeCheck', # wether macro parameters should be type checked - 'sfCompileTime', # proc can be evaluated at compile time - 'sfThreadVar', # variable is a thread variable - 'sfMerge', # proc can be merged with itself - 'sfDeadCodeElim', # dead code elimination for the module is turned on - 'sfBorrow' # proc is borrowed -], - -'TypeFlag': [ - 'tfVarargs', # procedure has C styled varargs - 'tfNoSideEffect', # procedure type does not allow side effects - 'tfFinal', # is the object final? - 'tfAcyclic', # type is acyclic (for GC optimization) - 'tfEnumHasWholes' # enum cannot be mapped into a range -], - -'TypeKind': [ # order is important! - # Don't forget to change hti.nim if you make a change here - 'tyNone', 'tyBool', 'tyChar', - 'tyEmpty', 'tyArrayConstr', 'tyNil', 'tyExpr', 'tyStmt', 'tyTypeDesc', - 'tyGenericInvokation', # ``T[a, b]`` for types to invoke - 'tyGenericBody', # ``T[a, b, body]`` last parameter is the body - 'tyGenericInst', # ``T[a, b, realInstance]`` instantiated generic type - 'tyGenericParam', # ``a`` in the example - 'tyDistinct', - 'tyEnum', - 'tyOrdinal', - 'tyArray', - 'tyObject', - 'tyTuple', - 'tySet', - 'tyRange', - 'tyPtr', 'tyRef', - 'tyVar', - 'tySequence', - 'tyProc', - 'tyPointer', 'tyOpenArray', - 'tyString', 'tyCString', 'tyForward', - # numerical types: - 'tyInt', 'tyInt8', 'tyInt16', 'tyInt32', 'tyInt64', # signed integers - 'tyFloat', 'tyFloat32', 'tyFloat64', 'tyFloat128' -], - -'NodeFlag': [ # keep this number under 16 for performance reasons! - 'nfNone', - 'nfBase2', # nfBase10 is default, so not needed - 'nfBase8', - 'nfBase16', - 'nfAllConst', # used to mark complex expressions constant - 'nfTransf', # node has been transformed - 'nfSem', # node has been checked for semantics -], - -'NodeKind': [ # these are pure nodes - # order is extremely important, because ranges are used to check whether - # a node belongs to a certain class - 'nkNone', # unknown node kind: indicates an error - - # Expressions: - # Atoms: - 'nkEmpty', # the node is empty - 'nkIdent', # node is an identifier - 'nkSym', # node is a symbol - 'nkType', # node is used for its typ field - - 'nkCharLit', # a character literal '' - - 'nkIntLit', # an integer literal - 'nkInt8Lit', - 'nkInt16Lit', - 'nkInt32Lit', - 'nkInt64Lit', - 'nkFloatLit', # a floating point literal - 'nkFloat32Lit', - 'nkFloat64Lit', - 'nkStrLit', # a string literal "" - 'nkRStrLit', # a raw string literal r"" - 'nkTripleStrLit', # a triple string literal """ - 'nkMetaNode', # difficult to explan; represents itself - # (used for macros) - 'nkNilLit', # the nil literal - # end of atoms - 'nkDotCall', # used to temporarily flag a nkCall node; this is used - # for transforming ``s.len`` to ``len(s)`` - 'nkCommand', # a call like ``p 2, 4`` without parenthesis - 'nkCall', # a call like p(x, y) or an operation like +(a, b) - 'nkCallStrLit', # a call with a string literal - # x"abc" has two sons: nkIdent, nkRStrLit - # x"""abc""" has two sons: nkIdent, nkTripleStrLit - 'nkExprEqExpr', # a named parameter with equals: ''expr = expr'' - 'nkExprColonExpr', # a named parameter with colon: ''expr: expr'' - 'nkIdentDefs', # a definition like `a, b: typeDesc = expr` - # either typeDesc or expr may be nil; used in - # formal parameters, var statements, etc. - 'nkVarTuple', # a ``var (a, b) = expr`` construct - 'nkInfix', # a call like (a + b) - 'nkPrefix', # a call like !a - 'nkPostfix', # something like a! (also used for visibility) - 'nkPar', # syntactic (); may be a tuple constructor - 'nkCurly', # syntactic {} - 'nkBracket', # syntactic [] - 'nkBracketExpr', # an expression like a[i..j, k] - 'nkPragmaExpr', # an expression like a{.pragmas.} - 'nkRange', # an expression like i..j - 'nkDotExpr', # a.b - 'nkCheckedFieldExpr', # a.b, but b is a field that needs to be checked - 'nkDerefExpr', # a^ - 'nkIfExpr', # if as an expression - 'nkElifExpr', - 'nkElseExpr', - 'nkLambda', # lambda expression - 'nkAccQuoted', # `a` as a node - - 'nkTableConstr', # a table constructor {expr: expr} - 'nkBind', # ``bind expr`` node - 'nkSymChoice', # symbol choice node - 'nkHiddenStdConv', # an implicit standard type conversion - 'nkHiddenSubConv', # an implicit type conversion from a subtype - # to a supertype - 'nkHiddenCallConv', # an implicit type conversion via a type converter - 'nkConv', # a type conversion - 'nkCast', # a type cast - 'nkAddr', # a addr expression - 'nkHiddenAddr', # implicit address operator - 'nkHiddenDeref', # implicit ^ operator - 'nkObjDownConv', # down conversion between object types - 'nkObjUpConv', # up conversion between object types - 'nkChckRangeF', # range check for floats - 'nkChckRange64', # range check for 64 bit ints - 'nkChckRange', # range check for ints - 'nkStringToCString', # string to cstring - 'nkCStringToString', # cstring to string - 'nkPassAsOpenArray', # thing is passed as an open array - # end of expressions - - 'nkAsgn', # a = b - 'nkFastAsgn', # internal node for a fast ``a = b`` (no string copy) - 'nkGenericParams', # generic parameters - 'nkFormalParams', # formal parameters - 'nkOfInherit', # inherited from symbol - - 'nkModule', # the syntax tree of a module - 'nkProcDef', # a proc - 'nkMethodDef', # a method - 'nkConverterDef', # a converter - 'nkMacroDef', # a macro - 'nkTemplateDef', # a template - 'nkIteratorDef', # an iterator - - 'nkOfBranch', # used inside case statements for (cond, action)-pairs - 'nkElifBranch', # used in if statements - 'nkExceptBranch', # an except section - 'nkElse', # an else part - 'nkMacroStmt', # a macro statement - 'nkAsmStmt', # an assembler block - 'nkPragma', # a pragma statement - 'nkIfStmt', # an if statement - 'nkWhenStmt', # a when statement - 'nkForStmt', # a for statement - 'nkWhileStmt', # a while statement - 'nkCaseStmt', # a case statement - 'nkVarSection', # a var section - 'nkConstSection', # a const section - 'nkConstDef', # a const definition - 'nkTypeSection', # a type section (consists of type definitions) - 'nkTypeDef', # a type definition - 'nkYieldStmt', # the yield statement as a tree - 'nkTryStmt', # a try statement - 'nkFinally', # a finally section - 'nkRaiseStmt', # a raise statement - 'nkReturnStmt', # a return statement - 'nkBreakStmt', # a break statement - 'nkContinueStmt', # a continue statement - 'nkBlockStmt', # a block statement - 'nkDiscardStmt', # a discard statement - 'nkStmtList', # a list of statements - 'nkImportStmt', # an import statement - 'nkFromStmt', # a from * import statement - 'nkIncludeStmt', # an include statement - 'nkCommentStmt', # a comment statement - 'nkStmtListExpr', # a statement list followed by an expr; this is used - # to allow powerful multi-line templates - 'nkBlockExpr', # a statement block ending in an expr; this is used - # to allowe powerful multi-line templates that open a - # temporary scope - 'nkStmtListType', # a statement list ending in a type; for macros - 'nkBlockType', # a statement block ending in a type; for macros - - # types as syntactic trees: - 'nkTypeOfExpr', - 'nkObjectTy', - 'nkTupleTy', - 'nkRecList', # list of object parts - 'nkRecCase', # case section of object - 'nkRecWhen', # when section of object - 'nkRefTy', - 'nkPtrTy', - 'nkVarTy', - 'nkDistinctTy', # distinct type - 'nkProcTy', - 'nkEnumTy', - 'nkEnumFieldDef', # `ident = expr` in an enumeration - 'nkReturnToken', # token used for interpretation -], - -'SymKind': [ - # the different symbols (start with the prefix sk); - # order is important for the documentation generator! - 'skUnknown', # unknown symbol: used for parsing assembler blocks - # and first phase symbol lookup in generics - 'skConditional', # symbol for the preprocessor (may become obsolete) - 'skDynLib', # symbol represents a dynamic library; this is used - # internally; it does not exist in Nimrod code - 'skParam', # a parameter - 'skGenericParam', # a generic parameter; eq in ``proc x[eq=`==`]()`` - 'skTemp', # a temporary variable (introduced by compiler) - 'skType', # a type - 'skConst', # a constant - 'skVar', # a variable - 'skProc', # a proc - 'skMethod', # a method - 'skIterator', # an iterator - 'skConverter', # a type converter - 'skMacro', # a macro - 'skTemplate', # a template - 'skField', # a field in a record or object - 'skEnumField', # an identifier in an enum - 'skForVar', # a for loop variable - 'skModule', # module identifier - 'skLabel', # a label (for block statement) - 'skStub' # symbol is a stub and not yet loaded from the ROD - # file (it is loaded on demand, which may mean: never) -] -} diff --git a/data/magic.yml b/data/magic.yml deleted file mode 100755 index 857a240881..0000000000 --- a/data/magic.yml +++ /dev/null @@ -1,254 +0,0 @@ -# All the magics of the system module: -# order has been changed! -[ -'None', -'Defined', -'DefinedInScope', -'Low', -'High', -'SizeOf', -'Is', -'Echo', -'Succ', -'Pred', -'Inc', -'Dec', -'Ord', - -'New', -'NewFinalize', -'NewSeq', -'LengthOpenArray', -'LengthStr', -'LengthArray', -'LengthSeq', -'Incl', -'Excl', -'Card', -'Chr', -'GCref', -'GCunref', - -# binary arithmetic with and without overflow checking: -'AddI', -'SubI', -'MulI', -'DivI', -'ModI', -'AddI64', -'SubI64', -'MulI64', -'DivI64', -'ModI64', - -# other binary arithmetic operators: -'ShrI', -'ShlI', -'BitandI', -'BitorI', -'BitxorI', -'MinI', -'MaxI', -'ShrI64', -'ShlI64', -'BitandI64', -'BitorI64', -'BitxorI64', -'MinI64', -'MaxI64', -'AddF64', -'SubF64', -'MulF64', -'DivF64', -'MinF64', -'MaxF64', -'AddU', -'SubU', -'MulU', -'DivU', -'ModU', -'AddU64', -'SubU64', -'MulU64', -'DivU64', -'ModU64', - -# comparison operators: -'EqI', -'LeI', -'LtI', -'EqI64', -'LeI64', -'LtI64', -'EqF64', -'LeF64', -'LtF64', -'LeU', -'LtU', -'LeU64', -'LtU64', -'EqEnum', -'LeEnum', -'LtEnum', -'EqCh', -'LeCh', -'LtCh', -'EqB', -'LeB', -'LtB', -'EqRef', -'EqProc', -'EqUntracedRef', -'LePtr', -'LtPtr', -'EqCString', -'Xor', - -# unary arithmetic with and without overflow checking: -'UnaryMinusI', -'UnaryMinusI64', -'AbsI', -'AbsI64', - -# other unary operations: -'Not', -'UnaryPlusI', -'BitnotI', -'UnaryPlusI64', -'BitnotI64', -'UnaryPlusF64', -'UnaryMinusF64', -'AbsF64', -'Ze8ToI', -'Ze8ToI64', -'Ze16ToI', -'Ze16ToI64', -'Ze32ToI64', -'ZeIToI64', - -'ToU8', -'ToU16', -'ToU32', -'ToFloat', -'ToBiggestFloat', -'ToInt', -'ToBiggestInt', - -'CharToStr', -'BoolToStr', -'IntToStr', # $ for ints -'Int64ToStr', -'FloatToStr', -'CStrToStr', -'StrToStr', -'EnumToStr', - -# special ones: -'And', -'Or', -'EqStr', -'LeStr', -'LtStr', -'EqSet', -'LeSet', -'LtSet', -'MulSet', -'PlusSet', -'MinusSet', -'SymDiffSet', -'ConStrStr', -'ConArrArr', -'ConArrT', -'ConTArr', -'ConTT', -'Slice', -'AppendStrCh', -'AppendStrStr', -'AppendSeqElem', -'InRange', -'InSet', -'Repr', -'Exit', -'SetLengthStr', -'SetLengthSeq', -'Assert', -'Swap', -'IsNil', -'ArrToSeq', -'CopyStr', -'CopyStrLast', -'NewString', - -# magic types: -'Array', -'OpenArray', -'Range', -'Set', -'Seq', -'Ordinal', -'Int', -'Int8', -'Int16', -'Int32', -'Int64', -'Float', -'Float32', -'Float64', -'Bool', -'Char', -'String', -'Cstring', -'Pointer', -'EmptySet', -'IntSetBaseType', -'Nil', -'Expr', -'Stmt', -'TypeDesc', - -# magic constants: -'IsMainModule', -'CompileDate', -'CompileTime', -'NimrodVersion', -'NimrodMajor', -'NimrodMinor', -'NimrodPatch', -'CpuEndian', -'HostOS', -'HostCPU', -'NaN', -'Inf', -'NegInf', - -# magics for modifying the AST (macro support) -'NLen', -'NChild', -'NSetChild', -'NAdd', -'NAddMultiple', -'NDel', -'NKind', -'NIntVal', -'NFloatVal', -'NSymbol', -'NIdent', -'NGetType', -'NStrVal', -'NSetIntVal', -'NSetFloatVal', -'NSetSymbol', -'NSetIdent', -'NSetType', -'NSetStrVal', -'NNewNimNode', -'NCopyNimNode', -'NCopyNimTree', -'StrToIdent', -'IdentToStr', -'EqIdent', -'EqNimrodNode', -'NHint', -'NWarning', -'NError' -] diff --git a/data/messages.yml b/data/messages.yml deleted file mode 100755 index 51ec2b088a..0000000000 --- a/data/messages.yml +++ /dev/null @@ -1,273 +0,0 @@ -# This file contains all the messages of the Nimrod compiler -# (c) 2009 Andreas Rumpf - -[ -# fatal errors: -{'errUnknown': 'unknown error'}, -{'errIllFormedAstX': 'illformed AST: $1'}, -{'errCannotOpenFile': "cannot open '$1'"}, -{'errInternal': 'internal error: $1'}, - -# other errors: -{'errGenerated': '$1'}, -{'errXCompilerDoesNotSupportCpp': "'$1' compiler does not support C++"}, - -# errors: -{'errStringLiteralExpected': 'string literal expected'}, -{'errIntLiteralExpected': 'integer literal expected'}, -{'errInvalidCharacterConstant': 'invalid character constant'}, -{'errClosingTripleQuoteExpected': - 'closing """ expected, but end of file reached'}, -{'errClosingQuoteExpected': 'closing " expected'}, -{'errTabulatorsAreNotAllowed': 'tabulators are not allowed'}, -{'errInvalidToken': 'invalid token: $1'}, -{'errLineTooLong': 'line too long'}, -{'errInvalidNumber': '$1 is not a valid number'}, -{'errNumberOutOfRange': 'number $1 out of valid range'}, -{'errNnotAllowedInCharacter': '\\n not allowed in character literal'}, -{'errClosingBracketExpected': "closing ']' expected, but end of file reached"}, -{'errMissingFinalQuote': "missing final '"}, -{'errIdentifierExpected': "identifier expected, but found '$1'"}, -{'errOperatorExpected': "operator expected, but found '$1'"}, -{'errTokenExpected': "'$1' expected"}, -{'errStringAfterIncludeExpected': "string after 'include' expected"}, -{'errRecursiveDependencyX': "recursive dependency: '$1'"}, -{'errOnOrOffExpected': "'on' or 'off' expected"}, -{'errNoneSpeedOrSizeExpected': "'none', 'speed' or 'size' expected"}, -{'errInvalidPragma': 'invalid pragma'}, -{'errUnknownPragma': "unknown pragma: '$1'"}, -{'errInvalidDirectiveX': "invalid directive: '$1'"}, -{'errAtPopWithoutPush': "'pop' without a 'push' pragma"}, -{'errEmptyAsm': 'empty asm statement'}, -{'errInvalidIndentation': 'invalid indentation'}, -{'errExceptionExpected': 'exception expected'}, -{'errExceptionAlreadyHandled': 'exception already handled'}, -{'errYieldNotAllowedHere': "'yield' only allowed in a loop of an iterator"}, -{'errInvalidNumberOfYieldExpr': "invalid number of 'yield' expresions"}, -{'errCannotReturnExpr': 'current routine cannot return an expression'}, -{'errAttemptToRedefine': "attempt to redefine '$1'"}, -{'errStmtInvalidAfterReturn': - "statement not allowed after 'return', 'break' or 'raise'"}, -{'errStmtExpected': 'statement expected'}, -{'errInvalidLabel': "'$1' is no label"}, -{'errInvalidCmdLineOption': "invalid command line option: '$1'"}, -{'errCmdLineArgExpected': "argument for command line option expected: '$1'"}, -{'errCmdLineNoArgExpected': "invalid argument for command line option: '$1'"}, -{'errInvalidVarSubstitution': "invalid variable substitution in '$1'"}, -{'errUnknownVar': "unknown variable: '$1'"}, -{'errUnknownCcompiler': "unknown C compiler: '$1'"}, -{'errOnOrOffExpectedButXFound': "'on' or 'off' expected, but '$1' found"}, -{'errNoneBoehmRefcExpectedButXFound': - "'none', 'boehm' or 'refc' expected, but '$1' found"}, -{'errNoneSpeedOrSizeExpectedButXFound': - "'none', 'speed' or 'size' expected, but '$1' found"}, -{'errGuiConsoleOrLibExpectedButXFound': - "'gui', 'console' or 'lib' expected, but '$1' found"}, -{'errUnknownOS': "unknown OS: '$1'"}, -{'errUnknownCPU': "unknown CPU: '$1'"}, -{'errGenOutExpectedButXFound': - "'c', 'c++' or 'yaml' expected, but '$1' found"}, -{'errArgsNeedRunOption': - "arguments can only be given if the '--run' option is selected"}, -{'errInvalidMultipleAsgn': 'multiple assignment is not allowed'}, -{'errColonOrEqualsExpected': "':' or '=' expected, but found '$1'"}, -{'errExprExpected': "expression expected, but found '$1'"}, -{'errUndeclaredIdentifier': "undeclared identifier: '$1'"}, -{'errUseQualifier': "ambiguous identifier: '$1' -- use a qualifier"}, -{'errTypeExpected': 'type expected'}, -{'errSystemNeeds': "system module needs '$1'"}, -{'errExecutionOfProgramFailed': 'execution of an external program failed'}, -{'errNotOverloadable': "overloaded '$1' leads to ambiguous calls"}, -{'errInvalidArgForX': "invalid argument for '$1'"}, -{'errStmtHasNoEffect': 'statement has no effect'}, -{'errXExpectsTypeOrValue': "'$1' expects a type or value"}, -{'errXExpectsArrayType': "'$1' expects an array type"}, -{'errIteratorCannotBeInstantiated': - "'$1' cannot be instantiated because its body has not been compiled yet"}, -{'errExprXAmbiguous': "expression '$1' ambiguous in this context"}, -{'errConstantDivisionByZero': 'constant division by zero'}, -{'errOrdinalTypeExpected': 'ordinal type expected'}, -{'errOrdinalOrFloatTypeExpected': 'ordinal or float type expected'}, -{'errOverOrUnderflow': 'over- or underflow'}, -{'errCannotEvalXBecauseIncompletelyDefined': - "cannot evalutate '$1' because type is not defined completely"}, -{'errChrExpectsRange0_255': "'chr' expects an int in the range 0..255"}, -{'errDynlibRequiresExportc': "'dynlib' requires 'exportc'"}, -{'errUndeclaredFieldX': "undeclared field: '$1'"}, -{'errNilAccess': 'attempt to access a nil address'}, -{'errIndexOutOfBounds': 'index out of bounds'}, -{'errIndexTypesDoNotMatch': 'index types do not match'}, -{'errBracketsInvalidForType': "'[]' operator invalid for this type"}, -{'errValueOutOfSetBounds': 'value out of set bounds'}, -{'errFieldInitTwice': "field initialized twice: '$1'"}, -{'errFieldNotInit': "field '$1' not initialized"}, -{'errExprXCannotBeCalled': "expression '$1' cannot be called"}, -{'errExprHasNoType': 'expression has no type'}, -{'errExprXHasNoType': "expression '$1' has no type (or is ambiguous)"}, -{'errCastNotInSafeMode': "'cast' not allowed in safe mode"}, -{'errExprCannotBeCastedToX': 'expression cannot be casted to $1'}, -{'errCommaOrParRiExpected': "',' or ')' expected"}, -{'errCurlyLeOrParLeExpected': "'{' or '(' expected"}, -{'errSectionExpected': "section ('type', 'proc', etc.) expected"}, -{'errRangeExpected': 'range expected'}, -{'errAttemptToRedefineX': "attempt to redefine '$1'"}, -{'errMagicOnlyInSystem': "'magic' only allowed in system module"}, -{'errPowerOfTwoExpected': 'power of two expected'}, -{'errStringMayNotBeEmpty': 'string literal may not be empty'}, -{'errCallConvExpected': 'calling convention expected'}, -{'errProcOnlyOneCallConv': 'a proc can only have one calling convention'}, -{'errSymbolMustBeImported': "symbol must be imported if 'lib' pragma is used"}, -{'errExprMustBeBool': "expression must be of type 'bool'"}, -{'errConstExprExpected': 'constant expression expected'}, -{'errDuplicateCaseLabel': 'duplicate case label'}, -{'errRangeIsEmpty': 'range is empty'}, -{'errSelectorMustBeOfCertainTypes': - 'selector must be of an ordinal type, real or string'}, -{'errSelectorMustBeOrdinal': - 'selector must be of an ordinal type'}, -{'errOrdXMustNotBeNegative': 'ord($1) must not be negative'}, -{'errLenXinvalid': 'len($1) must be less than 32768'}, -{'errWrongNumberOfVariables': 'wrong number of variables'}, -{'errExprCannotBeRaised': 'only objects can be raised'}, -{'errBreakOnlyInLoop': "'break' only allowed in loop construct"}, -{'errTypeXhasUnknownSize': "type '$1' has unknown size"}, -{'errConstNeedsConstExpr': - 'a constant can only be initialized with a constant expression'}, -{'errConstNeedsValue': 'a constant needs a value'}, -{'errResultCannotBeOpenArray': 'the result type cannot be on open array'}, -{'errSizeTooBig': "computing the type's size produced an overflow"}, -{'errSetTooBig': 'set is too large'}, -{'errBaseTypeMustBeOrdinal': 'base type of a set must be an ordinal'}, -{'errInheritanceOnlyWithNonFinalObjects': - 'inheritance only works with non-final objects'}, -{'errInheritanceOnlyWithEnums': 'inheritance only works with an enum'}, -{'errIllegalRecursionInTypeX': "illegal recursion in type '$1'"}, -{'errCannotInstantiateX': "cannot instantiate: '$1'"}, -{'errExprHasNoAddress': "expression has no address"}, -{'errVarForOutParamNeeded': - "for a 'var' type a variable needs to be passed"}, -{'errPureTypeMismatch': 'type mismatch'}, -{'errTypeMismatch': 'type mismatch: got ('}, -{'errButExpected': 'but expected one of: '}, -{'errButExpectedX': "but expected '$1'"}, -{'errAmbiguousCallXYZ': 'ambiguous call; both $1 and $2 match for: $3'}, -{'errWrongNumberOfArguments': 'wrong number of arguments'}, -{'errXCannotBePassedToProcVar': "'$1' cannot be passed to a procvar"}, -{'errXCannotBeInParamDecl': '$1 cannot be declared in parameter declaration'}, -{'errPragmaOnlyInHeaderOfProc': - 'pragmas are only in the header of a proc allowed'}, -{'errImplOfXNotAllowed': "implementation of '$1' is not allowed"}, -{'errImplOfXexpected': "implementation of '$1' expected"}, -{'errNoSymbolToBorrowFromFound': "no symbol to borrow from found"}, -{'errDiscardValue': 'value returned by statement has to be discarded'}, -{'errInvalidDiscard': 'statement returns no value that can be discarded'}, -{'errIllegalConvFromXtoY': 'conversion from $1 to $2 is invalid'}, -{'errCannotBindXTwice': "cannot bind parameter '$1' twice"}, -{'errInvalidOrderInEnumX': "invalid order in enum '$1'"}, -{'errEnumXHasWholes': "enum '$1' has wholes"}, -{'errExceptExpected': "'except' or 'finally' expected"}, -{'errInvalidTry': "after catch all 'except' or 'finally' no section may follow"}, -{'errOptionExpected': "option expected, but found '$1'"}, -{'errXisNoLabel': "'$1' is not a label"}, -{'errNotAllCasesCovered': 'not all cases are covered'}, -{'errUnkownSubstitionVar': "unknown substitution variable: '$1'"}, -{'errComplexStmtRequiresInd': 'complex statement requires indentation'}, -{'errXisNotCallable': "'$1' is not callable"}, -{'errNoPragmasAllowedForX': 'no pragmas allowed for $1'}, -{'errNoGenericParamsAllowedForX': 'no generic parameters allowed for $1'}, -{'errInvalidParamKindX': "invalid param kind: '$1'"}, -{'errDefaultArgumentInvalid': 'default argument invalid'}, -{'errNamedParamHasToBeIdent': 'named parameter has to be an identifier'}, -{'errNoReturnTypeForX': 'no return type for $1 allowed'}, -{'errConvNeedsOneArg': 'a type conversion needs exactly one argument'}, -{'errInvalidPragmaX': 'invalid pragma: $1'}, -{'errXNotAllowedHere': '$1 not allowed here'}, -{'errInvalidControlFlowX': 'invalid control flow: $1'}, -{'errATypeHasNoValue': 'a type has no value'}, -{'errXisNoType': "invalid type: '$1'"}, -{'errCircumNeedsPointer': "'^' needs a pointer or reference type"}, -{'errInvalidExpression': 'invalid expression'}, -{'errInvalidExpressionX': "invalid expression: '$1'"}, -{'errEnumHasNoValueX': "enum has no value '$1'"}, -{'errNamedExprExpected': 'named expression expected'}, -{'errNamedExprNotAllowed': 'named expression not allowed here'}, -{'errXExpectsOneTypeParam': "'$1' expects one type parameter"}, -{'errArrayExpectsTwoTypeParams': 'array expects two type parameters'}, -{'errInvalidVisibilityX': "invalid visibility: '$1'"}, -{'errInitHereNotAllowed': 'initialization not allowed here'}, -{'errXCannotBeAssignedTo': "'$1' cannot be assigned to"}, -{'errIteratorNotAllowed': - "iterators can only be defined at the module's top level"}, -{'errXNeedsReturnType': '$1 needs a return type'}, -{'errInvalidCommandX': "invalid command: '$1'"}, -{'errXOnlyAtModuleScope': "'$1' is only allowed at top level"}, -{'errTemplateInstantiationTooNested': 'template/macro instantiation too nested'}, -{'errInstantiationFrom': 'instantiation from here'}, -{'errInvalidIndexValueForTuple': 'invalid index value for tuple subscript'}, -{'errCommandExpectsFilename': 'command expects a filename argument'}, -{'errXExpected': "'$1' expected"}, -{'errInvalidSectionStart': 'invalid section start'}, -{'errGridTableNotImplemented': 'grid table is not implemented'}, -{'errGeneralParseError': 'general parse error'}, -{'errNewSectionExpected': 'new section expected'}, -{'errWhitespaceExpected': "whitespace expected, got '$1'"}, -{'errXisNoValidIndexFile': "'$1' is no valid index file"}, -{'errCannotRenderX': "cannot render reStructuredText element '$1'"}, -{'errVarVarTypeNotAllowed': "type 'var var' is not allowed"}, -{'errIsExpectsTwoArguments': "'is' expects two arguments"}, -{'errIsExpectsObjectTypes': "'is' expects object types"}, -{'errXcanNeverBeOfThisSubtype': "'$1' can never be of this subtype"}, -{'errTooManyIterations': "interpretation requires too many iterations"}, -{'errCannotInterpretNodeX': "cannot interpret node kind '$1'"}, -{'errFieldXNotFound': "field '$1' cannot be found"}, -{'errInvalidConversionFromTypeX': "invalid conversion from type '$1'"}, -{'errAssertionFailed': "assertion failed"}, -{'errCannotGenerateCodeForX': "cannot generate code for '$1'"}, -{'errXRequiresOneArgument': "$1 requires one parameter"}, -{'errUnhandledExceptionX': "unhandled exception: $1"}, -{'errCyclicTree': "macro returned a cyclic abstract syntax tree"}, -{'errXisNoMacroOrTemplate': "'$1' is no macro or template"}, -{'errXhasSideEffects': "'$1' can have side effects"}, -{'errIteratorExpected': "iterator within for loop context expected"}, - -# user error message: -{'errUser': '$1'}, - -# warnings: -{'warnCannotOpenFile': "cannot open '$1'"}, -{'warnOctalEscape': - 'octal escape sequences do not exist; leading zero is ignored'}, -{'warnXIsNeverRead': "'$1' is never read"}, -{'warnXmightNotBeenInit': "'$1' might not have been initialized"}, -{'warnCannotWriteMO2': "cannot write file '$1'"}, -{'warnCannotReadMO2': "cannot read file '$1'"}, -{'warnDeprecated': "'$1' is deprecated"}, -{'warnSmallLshouldNotBeUsed': - "'l' should not be used as an identifier; may look like '1' (one)"}, -{'warnUnknownMagic': "unknown magic '$1' might crash the compiler"}, -{'warnRedefinitionOfLabel': "redefinition of label '$1'"}, -{'warnUnknownSubstitutionX': "unknown substitution '$1'"}, -{'warnLanguageXNotSupported': "language '$1' not supported"}, -{'warnCommentXIgnored': "comment '$1' ignored"}, -{'warnXisPassedToProcVar': "'$1' is passed to a procvar; deprecated"}, - -# user warning message: -{'warnUser': '$1'}, - -# hints: -{'hintSuccess': 'operation successful'}, -{'hintSuccessX': 'operation successful ($1 lines compiled; $2 sec total)'}, -{'hintLineTooLong': 'line too long'}, -{'hintXDeclaredButNotUsed': "'$1' is declared but not used"}, -{'hintConvToBaseNotNeeded': 'conversion to base object is not needed'}, -{'hintConvFromXtoItselfNotNeeded': 'conversion from $1 to itself is pointless'}, -{'hintExprAlwaysX': "expression evaluates always to '$1'"}, -{'hintQuitCalled': "quit() called"}, -{'hintProcessing': "$1"}, -{'hintCodeBegin': "generated code listing:"}, -{'hintCodeEnd': "end of listing"}, -{'hintConf': "used config file '$1'"}, - -# user hint message: -{'hintUser': '$1'} -] diff --git a/data/pas_keyw.yml b/data/pas_keyw.yml deleted file mode 100755 index 7f2d269600..0000000000 --- a/data/pas_keyw.yml +++ /dev/null @@ -1,26 +0,0 @@ -# Object Pascal keywords for the Pascal scanner that is part of the -# Nimrod distribution -# (c) Andreas Rumpf 2007 -[ - "and", "array", "as", "asm", - "begin", - "case", "class", "const", "constructor", - "destructor", "div", "do", "downto", - "else", "end", "except", "exports", - "finalization", "finally", "for", "function", - "goto", - "if", "implementation", "in", "inherited", "initialization", "inline", - "interface", "is", - "label", "library", - "mod", - "nil", "not", - "object", "of", "or", "out", - "packed", "procedure", "program", "property", - "raise", "record", "repeat", "resourcestring", - "set", "shl", "shr", - "then", "threadvar", "to", "try", "type", - "unit", "until", "uses", - "var", - "while", "with", - "xor" -] diff --git a/data/readme.txt b/data/readme.txt deleted file mode 100755 index 91bc41dce1..0000000000 --- a/data/readme.txt +++ /dev/null @@ -1,2 +0,0 @@ -The files in this directory used to be required for building Nimrod. Now they -are only used for the documentation. diff --git a/diff/empty.txt b/diff/empty.txt deleted file mode 100755 index 20f9a91e35..0000000000 --- a/diff/empty.txt +++ /dev/null @@ -1 +0,0 @@ -This file keeps several tools from deleting this subdirectory. diff --git a/doc/intern.txt b/doc/intern.txt index c347a498c5..7fee87a932 100755 --- a/doc/intern.txt +++ b/doc/intern.txt @@ -21,22 +21,17 @@ Path Purpose ============ ============================================== ``bin`` generated binary files ``build`` generated C code for the installation -``nim`` Pascal sources of the Nimrod compiler; this - has been used for bootstrapping, but new - development is done with the Nimrod version. -``rod`` Nimrod sources of the Nimrod compiler; - automatically generated from the Pascal - version. -``data`` data files that are used for generating source - code; not used anymore +``compiler`` the Nimrod compiler itself; note that this + code has been translated from a bootstrapping + version written in Pascal, so the code is **not** + a poster child of good Nimrod code +``config`` configuration files for Nimrod +``dist`` additional packages for the distribution ``doc`` the documentation; it is a bunch of reStructuredText files -``dist`` additional packages for the distribution -``config`` configuration files for Nimrod ``lib`` the Nimrod library; ``rod`` depends on it! ``web`` website of Nimrod; generated by ``koch.py`` from the ``*.txt`` and ``*.tmpl`` files -``obj`` generated ``*.obj`` files ============ ============================================== diff --git a/koch.nim b/koch.nim index 0f9b42beca..c54a5155c5 100755 --- a/koch.nim +++ b/koch.nim @@ -52,11 +52,11 @@ proc tryExec(cmd: string): bool = result = execShellCmd(cmd) == 0 proc csource(args: string) = - exec("nimrod cc $1 -r tools/niminst --var:version=$2 csource rod/nimrod $1" % + exec("nimrod cc $1 -r tools/niminst --var:version=$2 csource compiler/nimrod $1" % [args, NimrodVersion]) proc zip(args: string) = - exec("nimrod cc -r tools/niminst --var:version=$# zip rod/nimrod" % + exec("nimrod cc -r tools/niminst --var:version=$# zip compiler/nimrod" % NimrodVersion) proc buildTool(toolname, args: string) = @@ -66,8 +66,9 @@ proc buildTool(toolname, args: string) = proc inno(args: string) = # make sure we have generated the c2nim and niminst executables: buildTool("tools/niminst", args) - buildTool("rod/c2nim/c2nim", args) - exec("tools" / "niminst --var:version=$# inno rod/nimrod" % NimrodVersion) + buildTool("compiler/c2nim/c2nim", args) + exec("tools" / "niminst --var:version=$# inno compiler/nimrod" % + NimrodVersion) proc install(args: string) = exec("sh ./build.sh") @@ -87,18 +88,6 @@ proc gitAux(dir: string) = proc git = gitAux("build") -# -------------- nim ---------------------------------------------------------- - -proc compileNimCmd(args: string): string = - var cwd = getCurrentDir() - result = ("fpc -Cs16777216 -gl -bl -Crtoi -Sgidh -vw -Se1 $4 -o\"$1\" " & - "-FU\"$2\" \"$3\"") % [cwd / "bin" / "nim".exe, - cwd / "obj", - cwd / "nim" / "nimrod.pas", - args] - -proc nim(args: string) = exec(compileNimCmd(args)) - # -------------- boot --------------------------------------------------------- const @@ -117,14 +106,15 @@ proc findStartNimrod: string = if ExistsFile(result): return for dir in split(getEnv("PATH"), PathSep): if ExistsFile(dir / nimrod): return nimrod - result = "bin" / "nim".exe - if ExistsFile(result): return when defined(Posix): const buildScript = "build.sh" if ExistsFile(buildScript): if tryExec("./" & buildScript): return "bin" / nimrod + else: + const buildScript = "build.bat" + if ExistsFile(buildScript): + if tryExec(buildScript): return "bin" / nimrod - if tryExec(compileNimCmd("")): return echo("Found no nimrod compiler and every attempt to build one failed!") quit("FAILURE") @@ -132,7 +122,7 @@ proc safeRemove(filename: string) = if existsFile(filename): removeFile(filename) proc thVersion(i: int): string = - result = ("rod" / "nimrod" & $i).exe + result = ("compiler" / "nimrod" & $i).exe proc copyExe(source, dest: string) = safeRemove(dest) @@ -140,13 +130,13 @@ proc copyExe(source, dest: string) = inclFilePermissions(dest, {fpUserExec}) proc boot(args: string) = - var output = "rod" / "nimrod".exe + var output = "compiler" / "nimrod".exe var finalDest = "bin" / "nimrod".exe copyExe(findStartNimrod(), 0.thVersion) for i in 0..2: echo "iteration: ", i+1 - exec i.thVersion & " cc $# $# rod" / "nimrod.nim" % [bootOptions, args] + exec i.thVersion & " cc $# $# compiler" / "nimrod.nim" % [bootOptions, args] if sameFileContent(output, i.thVersion): copyExe(output, finalDest) echo "executables are equal: SUCCESS!" @@ -214,7 +204,6 @@ of cmdArgument: of "zip": zip(op.cmdLineRest) of "inno": inno(op.cmdLineRest) of "install": install(op.cmdLineRest) - of "nim": nim(op.cmdLineRest) of "git": git() else: showHelp() of cmdEnd: showHelp() diff --git a/lib/impure/zipfiles.nim b/lib/impure/zipfiles.nim index 09bf8f7cc5..c60847d48a 100755 --- a/lib/impure/zipfiles.nim +++ b/lib/impure/zipfiles.nim @@ -58,8 +58,8 @@ proc addFile*(z: var TZipArchive, dest, src: string) = assert(z.mode != fmRead) var zipsrc = zip_source_file(z.w, src, 0, -1) if zipsrc == nil: - echo("Dest: " & dest) - echo("Src: " & src) + #echo("Dest: " & dest) + #echo("Src: " & src) zipError(z) if zip_add(z.w, dest, zipsrc) < 0'i32: zip_source_free(zipsrc) diff --git a/llvm/llvm.pas b/llvm/llvm.pas deleted file mode 100755 index ad1398b836..0000000000 --- a/llvm/llvm.pas +++ /dev/null @@ -1,1034 +0,0 @@ -unit llvm; - -interface - -const - libname=''; {Setup as you need} - -type - Pdword = ^dword; - PLLVMBasicBlockRef = ^LLVMBasicBlockRef; - PLLVMExecutionEngineRef = ^LLVMExecutionEngineRef; - PLLVMGenericValueRef = ^LLVMGenericValueRef; - PLLVMMemoryBufferRef = ^LLVMMemoryBufferRef; - PLLVMModuleProviderRef = ^LLVMModuleProviderRef; - PLLVMModuleRef = ^LLVMModuleRef; - PLLVMTypeRef = ^LLVMTypeRef; - PLLVMValueRef = ^LLVMValueRef; - -{ Core.h } -{ Opaque types. } -{* - * The top-level container for all LLVM global data. See the LLVMContext class. - } -type - - LLVMContextRef = LLVMOpaqueContext; -{* - * The top-level container for all other LLVM Intermediate Representation (IR) - * objects. See the llvm::Module class. - } - - LLVMModuleRef = LLVMOpaqueModule; -{* - * Each value in the LLVM IR has a type, an LLVMTypeRef. See the llvm::Type - * class. - } - - LLVMTypeRef = LLVMOpaqueType; -{* - * When building recursive types using LLVMRefineType, LLVMTypeRef values may - * become invalid; use LLVMTypeHandleRef to resolve this problem. See the - * llvm::AbstractTypeHolder class. - } - - LLVMTypeHandleRef = LLVMOpaqueTypeHandle; - - LLVMValueRef = LLVMOpaqueValue; - - LLVMBasicBlockRef = LLVMOpaqueBasicBlock; - - LLVMBuilderRef = LLVMOpaqueBuilder; -{ Used to provide a module to JIT or interpreter. - * See the llvm::ModuleProvider class. - } - - LLVMModuleProviderRef = LLVMOpaqueModuleProvider; -{ Used to provide a module to JIT or interpreter. - * See the llvm::MemoryBuffer class. - } - - LLVMMemoryBufferRef = LLVMOpaqueMemoryBuffer; -{* See the llvm::PassManagerBase class. } - - LLVMPassManagerRef = LLVMOpaquePassManager; -{* - * Used to iterate through the uses of a Value, allowing access to all Values - * that use this Value. See the llvm::Use and llvm::value_use_iterator classes. - } - - LLVMUseIteratorRef = LLVMOpaqueUseIterator; - - LLVMAttribute = (LLVMZExtAttribute := 1 shl 0,LLVMSExtAttribute := 1 shl 1, - LLVMNoReturnAttribute := 1 shl 2,LLVMInRegAttribute := 1 shl 3, - LLVMStructRetAttribute := 1 shl 4,LLVMNoUnwindAttribute := 1 shl 5, - LLVMNoAliasAttribute := 1 shl 6,LLVMByValAttribute := 1 shl 7, - LLVMNestAttribute := 1 shl 8,LLVMReadNoneAttribute := 1 shl 9, - LLVMReadOnlyAttribute := 1 shl 10,LLVMNoInlineAttribute := 1 shl 11, - LLVMAlwaysInlineAttribute := 1 shl 12,LLVMOptimizeForSizeAttribute := 1 shl 13, - LLVMStackProtectAttribute := 1 shl 14,LLVMStackProtectReqAttribute := 1 shl 15, - LLVMNoCaptureAttribute := 1 shl 21,LLVMNoRedZoneAttribute := 1 shl 22, - LLVMNoImplicitFloatAttribute := 1 shl 23,LLVMNakedAttribute := 1 shl 24, - LLVMInlineHintAttribute := 1 shl 25); - - LLVMOpcode = (LLVMRet := 1,LLVMBr := 2,LLVMSwitch := 3, - LLVMInvoke := 4,LLVMUnwind := 5,LLVMUnreachable := 6, - LLVMAdd := 7,LLVMFAdd := 8,LLVMSub := 9, - LLVMFSub := 10,LLVMMul := 11,LLVMFMul := 12, - LLVMUDiv := 13,LLVMSDiv := 14,LLVMFDiv := 15, - LLVMURem := 16,LLVMSRem := 17,LLVMFRem := 18, - LLVMShl := 19,LLVMLShr := 20,LLVMAShr := 21, - LLVMAnd := 22,LLVMOr := 23,LLVMXor := 24, - LLVMMalloc := 25,LLVMFree := 26,LLVMAlloca := 27, - LLVMLoad := 28,LLVMStore := 29,LLVMGetElementPtr := 30, - LLVMTrunk := 31,LLVMZExt := 32,LLVMSExt := 33, - LLVMFPToUI := 34,LLVMFPToSI := 35,LLVMUIToFP := 36, - LLVMSIToFP := 37,LLVMFPTrunc := 38,LLVMFPExt := 39, - LLVMPtrToInt := 40,LLVMIntToPtr := 41, - LLVMBitCast := 42,LLVMICmp := 43,LLVMFCmp := 44, - LLVMPHI := 45,LLVMCall := 46,LLVMSelect := 47, - LLVMVAArg := 50,LLVMExtractElement := 51, - LLVMInsertElement := 52,LLVMShuffleVector := 53, - LLVMExtractValue := 54,LLVMInsertValue := 55 - ); -{*< type with no size } -{*< 32 bit floating point type } -{*< 64 bit floating point type } -{*< 80 bit floating point type (X87) } -{*< 128 bit floating point type (112-bit mantissa) } -{*< 128 bit floating point type (two 64-bits) } -{*< Labels } -{*< Arbitrary bit width integers } -{*< Functions } -{*< Structures } -{*< Arrays } -{*< Pointers } -{*< Opaque: type with unknown structure } -{*< SIMD 'packed' format, or other vector type } -{*< Metadata } - - LLVMTypeKind = (LLVMVoidTypeKind,LLVMFloatTypeKind,LLVMDoubleTypeKind, - LLVMX86_FP80TypeKind,LLVMFP128TypeKind, - LLVMPPC_FP128TypeKind,LLVMLabelTypeKind, - LLVMIntegerTypeKind,LLVMFunctionTypeKind, - LLVMStructTypeKind,LLVMArrayTypeKind,LLVMPointerTypeKind, - LLVMOpaqueTypeKind,LLVMVectorTypeKind, - LLVMMetadataTypeKind); -{*< Externally visible function } -{*< Keep one copy of function when linking (inline) } -{*< Same, but only replaced by something - equivalent. } -{*< Keep one copy of function when linking (weak) } -{*< Same, but only replaced by something - equivalent. } -{*< Special purpose, only applies to global arrays } -{*< Rename collisions when linking (static - functions) } -{*< Like Internal, but omit from symbol table } -{*< Function to be imported from DLL } -{*< Function to be accessible from DLL } -{*< ExternalWeak linkage description } -{*< Stand-in functions for streaming fns from - bitcode } -{*< Tentative definitions } -{*< Like Private, but linker removes. } - - LLVMLinkage = (LLVMExternalLinkage,LLVMAvailableExternallyLinkage, - LLVMLinkOnceAnyLinkage,LLVMLinkOnceODRLinkage, - LLVMWeakAnyLinkage,LLVMWeakODRLinkage, - LLVMAppendingLinkage,LLVMInternalLinkage, - LLVMPrivateLinkage,LLVMDLLImportLinkage, - LLVMDLLExportLinkage,LLVMExternalWeakLinkage, - LLVMGhostLinkage,LLVMCommonLinkage,LLVMLinkerPrivateLinkage - ); -{*< The GV is visible } -{*< The GV is hidden } -{*< The GV is protected } - - LLVMVisibility = (LLVMDefaultVisibility,LLVMHiddenVisibility, - LLVMProtectedVisibility); - - LLVMCallConv = (LLVMCCallConv := 0,LLVMFastCallConv := 8, - LLVMColdCallConv := 9,LLVMX86StdcallCallConv := 64, - LLVMX86FastcallCallConv := 65); -{*< equal } -{*< not equal } -{*< unsigned greater than } -{*< unsigned greater or equal } -{*< unsigned less than } -{*< unsigned less or equal } -{*< signed greater than } -{*< signed greater or equal } -{*< signed less than } -{*< signed less or equal } - - LLVMIntPredicate = (LLVMIntEQ := 32,LLVMIntNE,LLVMIntUGT,LLVMIntUGE, - LLVMIntULT,LLVMIntULE,LLVMIntSGT,LLVMIntSGE, - LLVMIntSLT,LLVMIntSLE); -{*< Always false (always folded) } -{*< True if ordered and equal } -{*< True if ordered and greater than } -{*< True if ordered and greater than or equal } -{*< True if ordered and less than } -{*< True if ordered and less than or equal } -{*< True if ordered and operands are unequal } -{*< True if ordered (no nans) } -{*< True if unordered: isnan(X) | isnan(Y) } -{*< True if unordered or equal } -{*< True if unordered or greater than } -{*< True if unordered, greater than, or equal } -{*< True if unordered or less than } -{*< True if unordered, less than, or equal } -{*< True if unordered or not equal } -{*< Always true (always folded) } - - LLVMRealPredicate = (LLVMRealPredicateFalse,LLVMRealOEQ,LLVMRealOGT, - LLVMRealOGE,LLVMRealOLT,LLVMRealOLE,LLVMRealONE, - LLVMRealORD,LLVMRealUNO,LLVMRealUEQ,LLVMRealUGT, - LLVMRealUGE,LLVMRealULT,LLVMRealULE,LLVMRealUNE, - LLVMRealPredicateTrue); -{===-- Error handling ----------------------------------------------------=== } - -procedure LLVMDisposeMessage(Message:pchar);cdecl;external libname name 'LLVMDisposeMessage'; -{===-- Modules -----------------------------------------------------------=== } -{ Create and destroy contexts. } -function LLVMContextCreate:LLVMContextRef;cdecl;external libname name 'LLVMContextCreate'; -function LLVMGetGlobalContext:LLVMContextRef;cdecl;external libname name 'LLVMGetGlobalContext'; -procedure LLVMContextDispose(C:LLVMContextRef);cdecl;external libname name 'LLVMContextDispose'; -{ Create and destroy modules. }{* See llvm::Module::Module. } -function LLVMModuleCreateWithName(ModuleID:pchar):LLVMModuleRef;cdecl;external libname name 'LLVMModuleCreateWithName'; -function LLVMModuleCreateWithNameInContext(ModuleID:pchar; C:LLVMContextRef):LLVMModuleRef;cdecl;external libname name 'LLVMModuleCreateWithNameInContext'; -{* See llvm::Module::~Module. } -procedure LLVMDisposeModule(M:LLVMModuleRef);cdecl;external libname name 'LLVMDisposeModule'; -{* Data layout. See Module::getDataLayout. } -function LLVMGetDataLayout(M:LLVMModuleRef):pchar;cdecl;external libname name 'LLVMGetDataLayout'; -procedure LLVMSetDataLayout(M:LLVMModuleRef; Triple:pchar);cdecl;external libname name 'LLVMSetDataLayout'; -{* Target triple. See Module::getTargetTriple. } -function LLVMGetTarget(M:LLVMModuleRef):pchar;cdecl;external libname name 'LLVMGetTarget'; -procedure LLVMSetTarget(M:LLVMModuleRef; Triple:pchar);cdecl;external libname name 'LLVMSetTarget'; -{* See Module::addTypeName. } -function LLVMAddTypeName(M:LLVMModuleRef; Name:pchar; Ty:LLVMTypeRef):longint;cdecl;external libname name 'LLVMAddTypeName'; -procedure LLVMDeleteTypeName(M:LLVMModuleRef; Name:pchar);cdecl;external libname name 'LLVMDeleteTypeName'; -function LLVMGetTypeByName(M:LLVMModuleRef; Name:pchar):LLVMTypeRef;cdecl;external libname name 'LLVMGetTypeByName'; -{* See Module::dump. } -procedure LLVMDumpModule(M:LLVMModuleRef);cdecl;external libname name 'LLVMDumpModule'; -{===-- Types -------------------------------------------------------------=== } -{ LLVM types conform to the following hierarchy: - * - * types: - * integer type - * real type - * function type - * sequence types: - * array type - * pointer type - * vector type - * void type - * label type - * opaque type - } -{* See llvm::LLVMTypeKind::getTypeID. } -function LLVMGetTypeKind(Ty:LLVMTypeRef):LLVMTypeKind;cdecl;external libname name 'LLVMGetTypeKind'; -{* See llvm::LLVMType::getContext. } -function LLVMGetTypeContext(Ty:LLVMTypeRef):LLVMContextRef;cdecl;external libname name 'LLVMGetTypeContext'; -{ Operations on integer types } -function LLVMInt1TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMInt1TypeInContext'; -function LLVMInt8TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMInt8TypeInContext'; -function LLVMInt16TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMInt16TypeInContext'; -function LLVMInt32TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMInt32TypeInContext'; -function LLVMInt64TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMInt64TypeInContext'; -function LLVMIntTypeInContext(C:LLVMContextRef; NumBits:dword):LLVMTypeRef;cdecl;external libname name 'LLVMIntTypeInContext'; -function LLVMInt1Type:LLVMTypeRef;cdecl;external libname name 'LLVMInt1Type'; -function LLVMInt8Type:LLVMTypeRef;cdecl;external libname name 'LLVMInt8Type'; -function LLVMInt16Type:LLVMTypeRef;cdecl;external libname name 'LLVMInt16Type'; -function LLVMInt32Type:LLVMTypeRef;cdecl;external libname name 'LLVMInt32Type'; -function LLVMInt64Type:LLVMTypeRef;cdecl;external libname name 'LLVMInt64Type'; -function LLVMIntType(NumBits:dword):LLVMTypeRef;cdecl;external libname name 'LLVMIntType'; -function LLVMGetIntTypeWidth(IntegerTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMGetIntTypeWidth'; -{ Operations on real types } -function LLVMFloatTypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMFloatTypeInContext'; -function LLVMDoubleTypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMDoubleTypeInContext'; -function LLVMX86FP80TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMX86FP80TypeInContext'; -function LLVMFP128TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMFP128TypeInContext'; -function LLVMPPCFP128TypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMPPCFP128TypeInContext'; -function LLVMFloatType:LLVMTypeRef;cdecl;external libname name 'LLVMFloatType'; -function LLVMDoubleType:LLVMTypeRef;cdecl;external libname name 'LLVMDoubleType'; -function LLVMX86FP80Type:LLVMTypeRef;cdecl;external libname name 'LLVMX86FP80Type'; -function LLVMFP128Type:LLVMTypeRef;cdecl;external libname name 'LLVMFP128Type'; -function LLVMPPCFP128Type:LLVMTypeRef;cdecl;external libname name 'LLVMPPCFP128Type'; -{ Operations on function types } -function LLVMFunctionType(ReturnType:LLVMTypeRef; ParamTypes:pLLVMTypeRef; ParamCount:dword; IsVarArg:longint):LLVMTypeRef;cdecl;external libname name 'LLVMFunctionType'; -function LLVMIsFunctionVarArg(FunctionTy:LLVMTypeRef):longint;cdecl;external libname name 'LLVMIsFunctionVarArg'; -function LLVMGetReturnType(FunctionTy:LLVMTypeRef):LLVMTypeRef;cdecl;external libname name 'LLVMGetReturnType'; -function LLVMCountParamTypes(FunctionTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMCountParamTypes'; -procedure LLVMGetParamTypes(FunctionTy:LLVMTypeRef; Dest:pLLVMTypeRef);cdecl;external libname name 'LLVMGetParamTypes'; -{ Operations on struct types } -function LLVMStructTypeInContext(C:LLVMContextRef; ElementTypes:pLLVMTypeRef; - ElementCount:dword; - isPacked:longint):LLVMTypeRef;cdecl;external libname name 'LLVMStructTypeInContext'; -function LLVMStructType(ElementTypes:pLLVMTypeRef; ElementCount:dword; - isPacked:longint):LLVMTypeRef;cdecl;external libname name 'LLVMStructType'; -function LLVMCountStructElementTypes(StructTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMCountStructElementTypes'; -procedure LLVMGetStructElementTypes(StructTy:LLVMTypeRef; Dest:pLLVMTypeRef);cdecl;external libname name 'LLVMGetStructElementTypes'; -function LLVMIsPackedStruct(StructTy:LLVMTypeRef):longint;cdecl;external libname name 'LLVMIsPackedStruct'; -{ Operations on array, pointer, and vector types (sequence types) } -function LLVMArrayType(ElementType:LLVMTypeRef; ElementCount:dword):LLVMTypeRef;cdecl;external libname name 'LLVMArrayType'; -function LLVMPointerType(ElementType:LLVMTypeRef; AddressSpace:dword):LLVMTypeRef;cdecl;external libname name 'LLVMPointerType'; -function LLVMVectorType(ElementType:LLVMTypeRef; ElementCount:dword):LLVMTypeRef;cdecl;external libname name 'LLVMVectorType'; -function LLVMGetElementType(Ty:LLVMTypeRef):LLVMTypeRef;cdecl;external libname name 'LLVMGetElementType'; -function LLVMGetArrayLength(ArrayTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMGetArrayLength'; -function LLVMGetPointerAddressSpace(PointerTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMGetPointerAddressSpace'; -function LLVMGetVectorSize(VectorTy:LLVMTypeRef):dword;cdecl;external libname name 'LLVMGetVectorSize'; -{ Operations on other types } -function LLVMVoidTypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMVoidTypeInContext'; -function LLVMLabelTypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMLabelTypeInContext'; -function LLVMOpaqueTypeInContext(C:LLVMContextRef):LLVMTypeRef;cdecl;external libname name 'LLVMOpaqueTypeInContext'; -function LLVMVoidType:LLVMTypeRef;cdecl;external libname name 'LLVMVoidType'; -function LLVMLabelType:LLVMTypeRef;cdecl;external libname name 'LLVMLabelType'; -function LLVMOpaqueType:LLVMTypeRef;cdecl;external libname name 'LLVMOpaqueType'; -{ Operations on type handles } -function LLVMCreateTypeHandle(PotentiallyAbstractTy:LLVMTypeRef):LLVMTypeHandleRef;cdecl;external libname name 'LLVMCreateTypeHandle'; -procedure LLVMRefineType(AbstractTy:LLVMTypeRef; ConcreteTy:LLVMTypeRef);cdecl;external libname name 'LLVMRefineType'; -function LLVMResolveTypeHandle(TypeHandle:LLVMTypeHandleRef):LLVMTypeRef;cdecl;external libname name 'LLVMResolveTypeHandle'; -procedure LLVMDisposeTypeHandle(TypeHandle:LLVMTypeHandleRef);cdecl;external libname name 'LLVMDisposeTypeHandle'; -{ Operations on all values } -function LLVMTypeOf(Val:LLVMValueRef):LLVMTypeRef;cdecl;external libname name 'LLVMTypeOf'; -function LLVMGetValueName(Val:LLVMValueRef):pchar;cdecl;external libname name 'LLVMGetValueName'; -procedure LLVMSetValueName(Val:LLVMValueRef; Name:pchar);cdecl;external libname name 'LLVMSetValueName'; -procedure LLVMDumpValue(Val:LLVMValueRef);cdecl;external libname name 'LLVMDumpValue'; -procedure LLVMReplaceAllUsesWith(OldVal:LLVMValueRef; NewVal:LLVMValueRef);cdecl;external libname name 'LLVMReplaceAllUsesWith'; -{ Conversion functions. Return the input value if it is an instance of the - specified class, otherwise NULL. See llvm::dyn_cast_or_null<>. } -function LLVMIsAArgument(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAArgument'; -function LLVMIsABasicBlock(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsABasicBlock'; -function LLVMIsAInlineAsm(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAInlineAsm'; -function LLVMIsAUser(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUser'; -function LLVMIsAConstant(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstant'; -function LLVMIsAConstantAggregateZero(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantAggregateZero'; -function LLVMIsAConstantArray(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantArray'; -function LLVMIsAConstantExpr(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantExpr'; -function LLVMIsAConstantFP(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantFP'; -function LLVMIsAConstantInt(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantInt'; -function LLVMIsAConstantPointerNull(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantPointerNull'; -function LLVMIsAConstantStruct(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantStruct'; -function LLVMIsAConstantVector(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAConstantVector'; -function LLVMIsAGlobalValue(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAGlobalValue'; -function LLVMIsAFunction(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFunction'; -function LLVMIsAGlobalAlias(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAGlobalAlias'; -function LLVMIsAGlobalVariable(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAGlobalVariable'; -function LLVMIsAUndefValue(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUndefValue'; -function LLVMIsAInstruction(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAInstruction'; -function LLVMIsABinaryOperator(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsABinaryOperator'; -function LLVMIsACallInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsACallInst'; -function LLVMIsAIntrinsicInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAIntrinsicInst'; -function LLVMIsADbgInfoIntrinsic(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgInfoIntrinsic'; -function LLVMIsADbgDeclareInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgDeclareInst'; -function LLVMIsADbgFuncStartInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgFuncStartInst'; -function LLVMIsADbgRegionEndInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgRegionEndInst'; -function LLVMIsADbgRegionStartInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgRegionStartInst'; -function LLVMIsADbgStopPointInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsADbgStopPointInst'; -function LLVMIsAEHSelectorInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAEHSelectorInst'; -function LLVMIsAMemIntrinsic(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAMemIntrinsic'; -function LLVMIsAMemCpyInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAMemCpyInst'; -function LLVMIsAMemMoveInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAMemMoveInst'; -function LLVMIsAMemSetInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAMemSetInst'; -function LLVMIsACmpInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsACmpInst'; -function LLVMIsAFCmpInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFCmpInst'; -function LLVMIsAICmpInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAICmpInst'; -function LLVMIsAExtractElementInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAExtractElementInst'; -function LLVMIsAGetElementPtrInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAGetElementPtrInst'; -function LLVMIsAInsertElementInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAInsertElementInst'; -function LLVMIsAInsertValueInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAInsertValueInst'; -function LLVMIsAPHINode(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAPHINode'; -function LLVMIsASelectInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsASelectInst'; -function LLVMIsAShuffleVectorInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAShuffleVectorInst'; -function LLVMIsAStoreInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAStoreInst'; -function LLVMIsATerminatorInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsATerminatorInst'; -function LLVMIsABranchInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsABranchInst'; -function LLVMIsAInvokeInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAInvokeInst'; -function LLVMIsAReturnInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAReturnInst'; -function LLVMIsASwitchInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsASwitchInst'; -function LLVMIsAUnreachableInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUnreachableInst'; -function LLVMIsAUnwindInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUnwindInst'; -function LLVMIsAUnaryInstruction(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUnaryInstruction'; -function LLVMIsAAllocationInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAAllocationInst'; -function LLVMIsAAllocaInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAAllocaInst'; -function LLVMIsACastInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsACastInst'; -function LLVMIsABitCastInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsABitCastInst'; -function LLVMIsAFPExtInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFPExtInst'; -function LLVMIsAFPToSIInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFPToSIInst'; -function LLVMIsAFPToUIInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFPToUIInst'; -function LLVMIsAFPTruncInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFPTruncInst'; -function LLVMIsAIntToPtrInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAIntToPtrInst'; -function LLVMIsAPtrToIntInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAPtrToIntInst'; -function LLVMIsASExtInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsASExtInst'; -function LLVMIsASIToFPInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsASIToFPInst'; -function LLVMIsATruncInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsATruncInst'; -function LLVMIsAUIToFPInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAUIToFPInst'; -function LLVMIsAZExtInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAZExtInst'; -function LLVMIsAExtractValueInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAExtractValueInst'; -function LLVMIsAFreeInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAFreeInst'; -function LLVMIsALoadInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsALoadInst'; -function LLVMIsAVAArgInst(Val:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMIsAVAArgInst'; -{ Operations on Uses } -function LLVMGetFirstUse(Val:LLVMValueRef):LLVMUseIteratorRef;cdecl;external libname name 'LLVMGetFirstUse'; -function LLVMGetNextUse(U:LLVMUseIteratorRef):LLVMUseIteratorRef;cdecl;external libname name 'LLVMGetNextUse'; -function LLVMGetUser(U:LLVMUseIteratorRef):LLVMValueRef;cdecl;external libname name 'LLVMGetUser'; -function LLVMGetUsedValue(U:LLVMUseIteratorRef):LLVMValueRef;cdecl;external libname name 'LLVMGetUsedValue'; -{ Operations on Users } -function LLVMGetOperand(Val:LLVMValueRef; Index:dword):LLVMValueRef;cdecl;external libname name 'LLVMGetOperand'; -{ Operations on constants of any type } -function LLVMConstNull(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstNull'; -{ all zeroes } -function LLVMConstAllOnes(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstAllOnes'; -{ only for int/vector } -function LLVMGetUndef(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMGetUndef'; -function LLVMIsConstant(Val:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsConstant'; -function LLVMIsNull(Val:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsNull'; -function LLVMIsUndef(Val:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsUndef'; -function LLVMConstPointerNull(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstPointerNull'; -{ Operations on scalar constants } -function LLVMConstInt(IntTy:LLVMTypeRef; N:qword; SignExtend:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstInt'; -function LLVMConstIntOfString(IntTy:LLVMTypeRef; Text:pchar; Radix:uint8_t):LLVMValueRef;cdecl;external libname name 'LLVMConstIntOfString'; -function LLVMConstIntOfStringAndSize(IntTy:LLVMTypeRef; Text:pchar; SLen:dword; Radix:uint8_t):LLVMValueRef;cdecl;external libname name 'LLVMConstIntOfStringAndSize'; -function LLVMConstReal(RealTy:LLVMTypeRef; N:double):LLVMValueRef;cdecl;external libname name 'LLVMConstReal'; -function LLVMConstRealOfString(RealTy:LLVMTypeRef; Text:pchar):LLVMValueRef;cdecl;external libname name 'LLVMConstRealOfString'; -function LLVMConstRealOfStringAndSize(RealTy:LLVMTypeRef; Text:pchar; SLen:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstRealOfStringAndSize'; -function LLVMConstIntGetZExtValue(ConstantVal:LLVMValueRef):qword;cdecl;external libname name 'LLVMConstIntGetZExtValue'; -function LLVMConstIntGetSExtValue(ConstantVal:LLVMValueRef):int64;cdecl;external libname name 'LLVMConstIntGetSExtValue'; -{ Operations on composite constants } -function LLVMConstStringInContext(C:LLVMContextRef; Str:pchar; Length:dword; DontNullTerminate:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstStringInContext'; -function LLVMConstStructInContext(C:LLVMContextRef; - ConstantVals:pLLVMValueRef; Count:dword; isPacked:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstStructInContext'; -function LLVMConstString(Str:pchar; Length:dword; DontNullTerminate:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstString'; -function LLVMConstArray(ElementTy:LLVMTypeRef; ConstantVals:pLLVMValueRef; Length:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstArray'; -function LLVMConstStruct(ConstantVals:pLLVMValueRef; Count:dword; isPacked:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstStruct'; -function LLVMConstVector(ScalarConstantVals:pLLVMValueRef; Size:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstVector'; -{ Constant expressions } -function LLVMGetConstOpcode(ConstantVal:LLVMValueRef):LLVMOpcode;cdecl;external libname name 'LLVMGetConstOpcode'; -function LLVMAlignOf(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMAlignOf'; -function LLVMSizeOf(Ty:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMSizeOf'; -function LLVMConstNeg(ConstantVal:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstNeg'; -function LLVMConstFNeg(ConstantVal:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFNeg'; -function LLVMConstNot(ConstantVal:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstNot'; -function LLVMConstAdd(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstAdd'; -function LLVMConstNSWAdd(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstNSWAdd'; -function LLVMConstFAdd(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFAdd'; -function LLVMConstSub(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSub'; -function LLVMConstFSub(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFSub'; -function LLVMConstMul(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstMul'; -function LLVMConstFMul(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFMul'; -function LLVMConstUDiv(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstUDiv'; -function LLVMConstSDiv(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSDiv'; -function LLVMConstExactSDiv(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstExactSDiv'; -function LLVMConstFDiv(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFDiv'; -function LLVMConstURem(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstURem'; -function LLVMConstSRem(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSRem'; -function LLVMConstFRem(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFRem'; -function LLVMConstAnd(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstAnd'; -function LLVMConstOr(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstOr'; -function LLVMConstXor(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstXor'; -function LLVMConstICmp(Predicate:LLVMIntPredicate; LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstICmp'; -function LLVMConstFCmp(Predicate:LLVMRealPredicate; LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFCmp'; -function LLVMConstShl(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstShl'; -function LLVMConstLShr(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstLShr'; -function LLVMConstAShr(LHSConstant:LLVMValueRef; RHSConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstAShr'; -function LLVMConstGEP(ConstantVal:LLVMValueRef; ConstantIndices:pLLVMValueRef; NumIndices:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstGEP'; -function LLVMConstInBoundsGEP(ConstantVal:LLVMValueRef; ConstantIndices:pLLVMValueRef; NumIndices:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstInBoundsGEP'; -function LLVMConstTrunc(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstTrunc'; -function LLVMConstSExt(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSExt'; -function LLVMConstZExt(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstZExt'; -function LLVMConstFPTrunc(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFPTrunc'; -function LLVMConstFPExt(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFPExt'; -function LLVMConstUIToFP(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstUIToFP'; -function LLVMConstSIToFP(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSIToFP'; -function LLVMConstFPToUI(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFPToUI'; -function LLVMConstFPToSI(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFPToSI'; -function LLVMConstPtrToInt(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstPtrToInt'; -function LLVMConstIntToPtr(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstIntToPtr'; -function LLVMConstBitCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstBitCast'; -function LLVMConstZExtOrBitCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstZExtOrBitCast'; -function LLVMConstSExtOrBitCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSExtOrBitCast'; -function LLVMConstTruncOrBitCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstTruncOrBitCast'; -function LLVMConstPointerCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstPointerCast'; -function LLVMConstIntCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef; isSigned:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstIntCast'; -function LLVMConstFPCast(ConstantVal:LLVMValueRef; ToType:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMConstFPCast'; -function LLVMConstSelect(ConstantCondition:LLVMValueRef; ConstantIfTrue:LLVMValueRef; ConstantIfFalse:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstSelect'; -function LLVMConstExtractElement(VectorConstant:LLVMValueRef; IndexConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstExtractElement'; -function LLVMConstInsertElement(VectorConstant:LLVMValueRef; ElementValueConstant:LLVMValueRef; IndexConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstInsertElement'; -function LLVMConstShuffleVector(VectorAConstant:LLVMValueRef; VectorBConstant:LLVMValueRef; MaskConstant:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMConstShuffleVector'; -function LLVMConstExtractValue(AggConstant:LLVMValueRef; IdxList:pdword; NumIdx:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstExtractValue'; -function LLVMConstInsertValue(AggConstant:LLVMValueRef; ElementValueConstant:LLVMValueRef; IdxList:pdword; NumIdx:dword):LLVMValueRef;cdecl;external libname name 'LLVMConstInsertValue'; - -function LLVMConstInlineAsm(Ty:LLVMTypeRef; AsmString:pchar; Constraints:pchar; HasSideEffects:longint):LLVMValueRef;cdecl;external libname name 'LLVMConstInlineAsm'; -{ Operations on global variables, functions, and aliases (globals) } -function LLVMGetGlobalParent(Global:LLVMValueRef):LLVMModuleRef;cdecl;external libname name 'LLVMGetGlobalParent'; -function LLVMIsDeclaration(Global:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsDeclaration'; -function LLVMGetLinkage(Global:LLVMValueRef):LLVMLinkage;cdecl;external libname name 'LLVMGetLinkage'; -procedure LLVMSetLinkage(Global:LLVMValueRef; Linkage:LLVMLinkage);cdecl;external libname name 'LLVMSetLinkage'; -function LLVMGetSection(Global:LLVMValueRef):pchar;cdecl;external libname name 'LLVMGetSection'; -procedure LLVMSetSection(Global:LLVMValueRef; Section:pchar);cdecl;external libname name 'LLVMSetSection'; -function LLVMGetVisibility(Global:LLVMValueRef):LLVMVisibility;cdecl;external libname name 'LLVMGetVisibility'; -procedure LLVMSetVisibility(Global:LLVMValueRef; Viz:LLVMVisibility);cdecl;external libname name 'LLVMSetVisibility'; -function LLVMGetAlignment(Global:LLVMValueRef):dword;cdecl;external libname name 'LLVMGetAlignment'; -procedure LLVMSetAlignment(Global:LLVMValueRef; Bytes:dword);cdecl;external libname name 'LLVMSetAlignment'; -{ Operations on global variables } - -function LLVMAddGlobal(M:LLVMModuleRef; Ty:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMAddGlobal'; - -function LLVMGetNamedGlobal(M:LLVMModuleRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMGetNamedGlobal'; -function LLVMGetFirstGlobal(M:LLVMModuleRef):LLVMValueRef;cdecl;external libname name 'LLVMGetFirstGlobal'; -function LLVMGetLastGlobal(M:LLVMModuleRef):LLVMValueRef;cdecl;external libname name 'LLVMGetLastGlobal'; -function LLVMGetNextGlobal(GlobalVar:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetNextGlobal'; -function LLVMGetPreviousGlobal(GlobalVar:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetPreviousGlobal'; -procedure LLVMDeleteGlobal(GlobalVar:LLVMValueRef);cdecl;external libname name 'LLVMDeleteGlobal'; -function LLVMGetInitializer(GlobalVar:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetInitializer'; -procedure LLVMSetInitializer(GlobalVar:LLVMValueRef; ConstantVal:LLVMValueRef);cdecl;external libname name 'LLVMSetInitializer'; -function LLVMIsThreadLocal(GlobalVar:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsThreadLocal'; -procedure LLVMSetThreadLocal(GlobalVar:LLVMValueRef; IsThreadLocal:longint);cdecl;external libname name 'LLVMSetThreadLocal'; -function LLVMIsGlobalConstant(GlobalVar:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsGlobalConstant'; -procedure LLVMSetGlobalConstant(GlobalVar:LLVMValueRef; IsConstant:longint);cdecl;external libname name 'LLVMSetGlobalConstant'; -{ Operations on aliases } -function LLVMAddAlias(M:LLVMModuleRef; Ty:LLVMTypeRef; Aliasee:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMAddAlias'; -{ Operations on functions } -function LLVMAddFunction(M:LLVMModuleRef; Name:pchar; FunctionTy:LLVMTypeRef):LLVMValueRef;cdecl;external libname name 'LLVMAddFunction'; -function LLVMGetNamedFunction(M:LLVMModuleRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMGetNamedFunction'; -function LLVMGetFirstFunction(M:LLVMModuleRef):LLVMValueRef;cdecl;external libname name 'LLVMGetFirstFunction'; -function LLVMGetLastFunction(M:LLVMModuleRef):LLVMValueRef;cdecl;external libname name 'LLVMGetLastFunction'; -function LLVMGetNextFunction(Fn:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetNextFunction'; -function LLVMGetPreviousFunction(Fn:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetPreviousFunction'; -procedure LLVMDeleteFunction(Fn:LLVMValueRef);cdecl;external libname name 'LLVMDeleteFunction'; -function LLVMGetIntrinsicID(Fn:LLVMValueRef):dword;cdecl;external libname name 'LLVMGetIntrinsicID'; -function LLVMGetFunctionCallConv(Fn:LLVMValueRef):dword;cdecl;external libname name 'LLVMGetFunctionCallConv'; -procedure LLVMSetFunctionCallConv(Fn:LLVMValueRef; CC:dword);cdecl;external libname name 'LLVMSetFunctionCallConv'; -function LLVMGetGC(Fn:LLVMValueRef):pchar;cdecl;external libname name 'LLVMGetGC'; -procedure LLVMSetGC(Fn:LLVMValueRef; Name:pchar);cdecl;external libname name 'LLVMSetGC'; -procedure LLVMAddFunctionAttr(Fn:LLVMValueRef; PA:LLVMAttribute);cdecl;external libname name 'LLVMAddFunctionAttr'; -function LLVMGetFunctionAttr(Fn:LLVMValueRef):LLVMAttribute;cdecl;external libname name 'LLVMGetFunctionAttr'; -procedure LLVMRemoveFunctionAttr(Fn:LLVMValueRef; PA:LLVMAttribute);cdecl;external libname name 'LLVMRemoveFunctionAttr'; -{ Operations on parameters } -function LLVMCountParams(Fn:LLVMValueRef):dword;cdecl;external libname name 'LLVMCountParams'; -procedure LLVMGetParams(Fn:LLVMValueRef; Params:pLLVMValueRef);cdecl;external libname name 'LLVMGetParams'; -function LLVMGetParam(Fn:LLVMValueRef; Index:dword):LLVMValueRef;cdecl;external libname name 'LLVMGetParam'; -function LLVMGetParamParent(Inst:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetParamParent'; -function LLVMGetFirstParam(Fn:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetFirstParam'; -function LLVMGetLastParam(Fn:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetLastParam'; -function LLVMGetNextParam(Arg:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetNextParam'; -function LLVMGetPreviousParam(Arg:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetPreviousParam'; -procedure LLVMAddAttribute(Arg:LLVMValueRef; PA:LLVMAttribute);cdecl;external libname name 'LLVMAddAttribute'; -procedure LLVMRemoveAttribute(Arg:LLVMValueRef; PA:LLVMAttribute);cdecl;external libname name 'LLVMRemoveAttribute'; -function LLVMGetAttribute(Arg:LLVMValueRef):LLVMAttribute;cdecl;external libname name 'LLVMGetAttribute'; -procedure LLVMSetParamAlignment(Arg:LLVMValueRef; align:dword);cdecl;external libname name 'LLVMSetParamAlignment'; -{ Operations on basic blocks } -function LLVMBasicBlockAsValue(BB:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMBasicBlockAsValue'; -function LLVMValueIsBasicBlock(Val:LLVMValueRef):longint;cdecl;external libname name 'LLVMValueIsBasicBlock'; -function LLVMValueAsBasicBlock(Val:LLVMValueRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMValueAsBasicBlock'; -function LLVMGetBasicBlockParent(BB:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMGetBasicBlockParent'; -function LLVMCountBasicBlocks(Fn:LLVMValueRef):dword;cdecl;external libname name 'LLVMCountBasicBlocks'; -procedure LLVMGetBasicBlocks(Fn:LLVMValueRef; BasicBlocks:pLLVMBasicBlockRef);cdecl;external libname name 'LLVMGetBasicBlocks'; -function LLVMGetFirstBasicBlock(Fn:LLVMValueRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetFirstBasicBlock'; -function LLVMGetLastBasicBlock(Fn:LLVMValueRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetLastBasicBlock'; -function LLVMGetNextBasicBlock(BB:LLVMBasicBlockRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetNextBasicBlock'; -function LLVMGetPreviousBasicBlock(BB:LLVMBasicBlockRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetPreviousBasicBlock'; -function LLVMGetEntryBasicBlock(Fn:LLVMValueRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetEntryBasicBlock'; -function LLVMAppendBasicBlockInContext(C:LLVMContextRef; Fn:LLVMValueRef; Name:pchar):LLVMBasicBlockRef;cdecl;external libname name 'LLVMAppendBasicBlockInContext'; -function LLVMInsertBasicBlockInContext(C:LLVMContextRef; BB:LLVMBasicBlockRef; Name:pchar):LLVMBasicBlockRef;cdecl;external libname name 'LLVMInsertBasicBlockInContext'; -function LLVMAppendBasicBlock(Fn:LLVMValueRef; Name:pchar):LLVMBasicBlockRef;cdecl;external libname name 'LLVMAppendBasicBlock'; -function LLVMInsertBasicBlock(InsertBeforeBB:LLVMBasicBlockRef; Name:pchar):LLVMBasicBlockRef;cdecl;external libname name 'LLVMInsertBasicBlock'; -procedure LLVMDeleteBasicBlock(BB:LLVMBasicBlockRef);cdecl;external libname name 'LLVMDeleteBasicBlock'; -{ Operations on instructions } -function LLVMGetInstructionParent(Inst:LLVMValueRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetInstructionParent'; -function LLVMGetFirstInstruction(BB:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMGetFirstInstruction'; -function LLVMGetLastInstruction(BB:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMGetLastInstruction'; -function LLVMGetNextInstruction(Inst:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetNextInstruction'; -function LLVMGetPreviousInstruction(Inst:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMGetPreviousInstruction'; -{ Operations on call sites } -procedure LLVMSetInstructionCallConv(Instr:LLVMValueRef; CC:dword);cdecl;external libname name 'LLVMSetInstructionCallConv'; -function LLVMGetInstructionCallConv(Instr:LLVMValueRef):dword;cdecl;external libname name 'LLVMGetInstructionCallConv'; -procedure LLVMAddInstrAttribute(Instr:LLVMValueRef; index:dword; para3:LLVMAttribute);cdecl;external libname name 'LLVMAddInstrAttribute'; -procedure LLVMRemoveInstrAttribute(Instr:LLVMValueRef; index:dword; para3:LLVMAttribute);cdecl;external libname name 'LLVMRemoveInstrAttribute'; -procedure LLVMSetInstrParamAlignment(Instr:LLVMValueRef; index:dword; align:dword);cdecl;external libname name 'LLVMSetInstrParamAlignment'; -{ Operations on call instructions (only) } -function LLVMIsTailCall(CallInst:LLVMValueRef):longint;cdecl;external libname name 'LLVMIsTailCall'; -procedure LLVMSetTailCall(CallInst:LLVMValueRef; IsTailCall:longint);cdecl;external libname name 'LLVMSetTailCall'; -{ Operations on phi nodes } -procedure LLVMAddIncoming(PhiNode:LLVMValueRef; IncomingValues:pLLVMValueRef; IncomingBlocks:pLLVMBasicBlockRef; Count:dword);cdecl;external libname name 'LLVMAddIncoming'; -function LLVMCountIncoming(PhiNode:LLVMValueRef):dword;cdecl;external libname name 'LLVMCountIncoming'; -function LLVMGetIncomingValue(PhiNode:LLVMValueRef; Index:dword):LLVMValueRef;cdecl;external libname name 'LLVMGetIncomingValue'; -function LLVMGetIncomingBlock(PhiNode:LLVMValueRef; Index:dword):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetIncomingBlock'; -{===-- Instruction builders ----------------------------------------------=== } -{ An instruction builder represents a point within a basic block, and is the - * exclusive means of building instructions using the C interface. - } -function LLVMCreateBuilderInContext(C:LLVMContextRef):LLVMBuilderRef;cdecl;external libname name 'LLVMCreateBuilderInContext'; -function LLVMCreateBuilder:LLVMBuilderRef;cdecl;external libname name 'LLVMCreateBuilder'; -procedure LLVMPositionBuilder(Builder:LLVMBuilderRef; Block:LLVMBasicBlockRef; Instr:LLVMValueRef);cdecl;external libname name 'LLVMPositionBuilder'; -procedure LLVMPositionBuilderBefore(Builder:LLVMBuilderRef; Instr:LLVMValueRef);cdecl;external libname name 'LLVMPositionBuilderBefore'; -procedure LLVMPositionBuilderAtEnd(Builder:LLVMBuilderRef; Block:LLVMBasicBlockRef);cdecl;external libname name 'LLVMPositionBuilderAtEnd'; -function LLVMGetInsertBlock(Builder:LLVMBuilderRef):LLVMBasicBlockRef;cdecl;external libname name 'LLVMGetInsertBlock'; -procedure LLVMClearInsertionPosition(Builder:LLVMBuilderRef);cdecl;external libname name 'LLVMClearInsertionPosition'; -procedure LLVMInsertIntoBuilder(Builder:LLVMBuilderRef; Instr:LLVMValueRef);cdecl;external libname name 'LLVMInsertIntoBuilder'; -procedure LLVMInsertIntoBuilderWithName(Builder:LLVMBuilderRef; Instr:LLVMValueRef; Name:pchar);cdecl;external libname name 'LLVMInsertIntoBuilderWithName'; -procedure LLVMDisposeBuilder(Builder:LLVMBuilderRef);cdecl;external libname name 'LLVMDisposeBuilder'; -{ Terminators } -function LLVMBuildRetVoid(para1:LLVMBuilderRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildRetVoid'; -function LLVMBuildRet(para1:LLVMBuilderRef; V:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildRet'; -function LLVMBuildAggregateRet(para1:LLVMBuilderRef; RetVals:pLLVMValueRef; N:dword):LLVMValueRef;cdecl;external libname name 'LLVMBuildAggregateRet'; -function LLVMBuildBr(para1:LLVMBuilderRef; Dest:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildBr'; -function LLVMBuildCondBr(para1:LLVMBuilderRef; Cond:LLVMValueRef; - ThenBranch:LLVMBasicBlockRef; ElseBranch:LLVMBasicBlockRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildCondBr'; -function LLVMBuildSwitch(para1:LLVMBuilderRef; V:LLVMValueRef; ElseBranch:LLVMBasicBlockRef; NumCases:dword):LLVMValueRef;cdecl;external libname name 'LLVMBuildSwitch'; -function LLVMBuildInvoke(para1:LLVMBuilderRef; Fn:LLVMValueRef; Args:pLLVMValueRef; NumArgs:dword; ThenBranch:LLVMBasicBlockRef; - Catch:LLVMBasicBlockRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildInvoke'; -function LLVMBuildUnwind(para1:LLVMBuilderRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildUnwind'; -function LLVMBuildUnreachable(para1:LLVMBuilderRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildUnreachable'; -{ Add a case to the switch instruction } -procedure LLVMAddCase(Switch:LLVMValueRef; OnVal:LLVMValueRef; Dest:LLVMBasicBlockRef);cdecl;external libname name 'LLVMAddCase'; -{ Arithmetic } -function LLVMBuildAdd(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildAdd'; -function LLVMBuildNSWAdd(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildNSWAdd'; -function LLVMBuildFAdd(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFAdd'; -function LLVMBuildSub(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSub'; -function LLVMBuildFSub(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFSub'; -function LLVMBuildMul(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildMul'; -function LLVMBuildFMul(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFMul'; -function LLVMBuildUDiv(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildUDiv'; -function LLVMBuildSDiv(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSDiv'; -function LLVMBuildExactSDiv(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildExactSDiv'; -function LLVMBuildFDiv(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFDiv'; -function LLVMBuildURem(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildURem'; -function LLVMBuildSRem(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSRem'; -function LLVMBuildFRem(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFRem'; -function LLVMBuildShl(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildShl'; -function LLVMBuildLShr(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildLShr'; -function LLVMBuildAShr(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildAShr'; -function LLVMBuildAnd(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildAnd'; -function LLVMBuildOr(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildOr'; -function LLVMBuildXor(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildXor'; -function LLVMBuildNeg(para1:LLVMBuilderRef; V:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildNeg'; -function LLVMBuildFNeg(para1:LLVMBuilderRef; V:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFNeg'; -function LLVMBuildNot(para1:LLVMBuilderRef; V:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildNot'; -{ Memory } -function LLVMBuildMalloc(para1:LLVMBuilderRef; Ty:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildMalloc'; -function LLVMBuildArrayMalloc(para1:LLVMBuilderRef; Ty:LLVMTypeRef; Val:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildArrayMalloc'; -function LLVMBuildAlloca(para1:LLVMBuilderRef; Ty:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildAlloca'; -function LLVMBuildArrayAlloca(para1:LLVMBuilderRef; Ty:LLVMTypeRef; Val:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildArrayAlloca'; -function LLVMBuildFree(para1:LLVMBuilderRef; PointerVal:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildFree'; -function LLVMBuildLoad(para1:LLVMBuilderRef; PointerVal:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildLoad'; -function LLVMBuildStore(para1:LLVMBuilderRef; Val:LLVMValueRef; Ptr:LLVMValueRef):LLVMValueRef;cdecl;external libname name 'LLVMBuildStore'; -function LLVMBuildGEP(B:LLVMBuilderRef; Pointer:LLVMValueRef; Indices:pLLVMValueRef; NumIndices:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildGEP'; -function LLVMBuildInBoundsGEP(B:LLVMBuilderRef; Pointer:LLVMValueRef; Indices:pLLVMValueRef; NumIndices:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildInBoundsGEP'; -function LLVMBuildStructGEP(B:LLVMBuilderRef; Pointer:LLVMValueRef; Idx:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildStructGEP'; -function LLVMBuildGlobalString(B:LLVMBuilderRef; Str:pchar; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildGlobalString'; -function LLVMBuildGlobalStringPtr(B:LLVMBuilderRef; Str:pchar; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildGlobalStringPtr'; -{ Casts } -function LLVMBuildTrunc(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildTrunc'; -function LLVMBuildZExt(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildZExt'; -function LLVMBuildSExt(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSExt'; -function LLVMBuildFPToUI(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFPToUI'; -function LLVMBuildFPToSI(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFPToSI'; -function LLVMBuildUIToFP(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildUIToFP'; -function LLVMBuildSIToFP(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSIToFP'; -function LLVMBuildFPTrunc(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFPTrunc'; -function LLVMBuildFPExt(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFPExt'; -function LLVMBuildPtrToInt(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildPtrToInt'; -function LLVMBuildIntToPtr(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildIntToPtr'; -function LLVMBuildBitCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildBitCast'; -function LLVMBuildZExtOrBitCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildZExtOrBitCast'; -function LLVMBuildSExtOrBitCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSExtOrBitCast'; -function LLVMBuildTruncOrBitCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildTruncOrBitCast'; -function LLVMBuildPointerCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildPointerCast'; -function LLVMBuildIntCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildIntCast'; -function LLVMBuildFPCast(para1:LLVMBuilderRef; Val:LLVMValueRef; DestTy:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFPCast'; -{ Comparisons } -function LLVMBuildICmp(para1:LLVMBuilderRef; Op:LLVMIntPredicate; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildICmp'; -function LLVMBuildFCmp(para1:LLVMBuilderRef; Op:LLVMRealPredicate; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildFCmp'; -{ Miscellaneous instructions } -function LLVMBuildPhi(para1:LLVMBuilderRef; Ty:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildPhi'; -function LLVMBuildCall(para1:LLVMBuilderRef; Fn:LLVMValueRef; Args:pLLVMValueRef; NumArgs:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildCall'; -function LLVMBuildSelect(para1:LLVMBuilderRef; Cond:LLVMValueRef; ThenBranch:LLVMValueRef; ElseBranch:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildSelect'; -function LLVMBuildVAArg(para1:LLVMBuilderRef; List:LLVMValueRef; Ty:LLVMTypeRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildVAArg'; -function LLVMBuildExtractElement(para1:LLVMBuilderRef; VecVal:LLVMValueRef; Index:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildExtractElement'; -function LLVMBuildInsertElement(para1:LLVMBuilderRef; VecVal:LLVMValueRef; EltVal:LLVMValueRef; Index:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildInsertElement'; -function LLVMBuildShuffleVector(para1:LLVMBuilderRef; V1:LLVMValueRef; V2:LLVMValueRef; Mask:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildShuffleVector'; -function LLVMBuildExtractValue(para1:LLVMBuilderRef; AggVal:LLVMValueRef; Index:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildExtractValue'; -function LLVMBuildInsertValue(para1:LLVMBuilderRef; AggVal:LLVMValueRef; EltVal:LLVMValueRef; Index:dword; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildInsertValue'; -function LLVMBuildIsNull(para1:LLVMBuilderRef; Val:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildIsNull'; -function LLVMBuildIsNotNull(para1:LLVMBuilderRef; Val:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildIsNotNull'; -function LLVMBuildPtrDiff(para1:LLVMBuilderRef; LHS:LLVMValueRef; RHS:LLVMValueRef; Name:pchar):LLVMValueRef;cdecl;external libname name 'LLVMBuildPtrDiff'; -{===-- Module providers --------------------------------------------------=== } -{ Encapsulates the module M in a module provider, taking ownership of the - * module. - * See the constructor llvm::ExistingModuleProvider::ExistingModuleProvider. - } -function LLVMCreateModuleProviderForExistingModule(M:LLVMModuleRef):LLVMModuleProviderRef;cdecl;external libname name 'LLVMCreateModuleProviderForExistingModule'; -{ Destroys the module provider MP as well as the contained module. - * See the destructor llvm::ModuleProvider::~ModuleProvider. - } -procedure LLVMDisposeModuleProvider(MP:LLVMModuleProviderRef);cdecl;external libname name 'LLVMDisposeModuleProvider'; -{===-- Memory buffers ----------------------------------------------------=== } -function LLVMCreateMemoryBufferWithContentsOfFile(Path:pchar; OutMemBuf:pLLVMMemoryBufferRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMCreateMemoryBufferWithContentsOfFile'; -function LLVMCreateMemoryBufferWithSTDIN(OutMemBuf:pLLVMMemoryBufferRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMCreateMemoryBufferWithSTDIN'; -procedure LLVMDisposeMemoryBuffer(MemBuf:LLVMMemoryBufferRef);cdecl;external libname name 'LLVMDisposeMemoryBuffer'; -{===-- Pass Managers -----------------------------------------------------=== } -{* Constructs a new whole-module pass pipeline. This type of pipeline is - suitable for link-time optimization and whole-module transformations. - See llvm::PassManager::PassManager. } -function LLVMCreatePassManager:LLVMPassManagerRef;cdecl;external libname name 'LLVMCreatePassManager'; -{* Constructs a new function-by-function pass pipeline over the module - provider. It does not take ownership of the module provider. This type of - pipeline is suitable for code generation and JIT compilation tasks. - See llvm::FunctionPassManager::FunctionPassManager. } -function LLVMCreateFunctionPassManager(MP:LLVMModuleProviderRef):LLVMPassManagerRef;cdecl;external libname name 'LLVMCreateFunctionPassManager'; -{* Initializes, executes on the provided module, and finalizes all of the - passes scheduled in the pass manager. Returns 1 if any of the passes - modified the module, 0 otherwise. See llvm::PassManager::run(Module&). } -function LLVMRunPassManager(PM:LLVMPassManagerRef; M:LLVMModuleRef):longint;cdecl;external libname name 'LLVMRunPassManager'; -{* Initializes all of the function passes scheduled in the function pass - manager. Returns 1 if any of the passes modified the module, 0 otherwise. - See llvm::FunctionPassManager::doInitialization. } -function LLVMInitializeFunctionPassManager(FPM:LLVMPassManagerRef):longint;cdecl;external libname name 'LLVMInitializeFunctionPassManager'; -{* Executes all of the function passes scheduled in the function pass manager - on the provided function. Returns 1 if any of the passes modified the - function, false otherwise. - See llvm::FunctionPassManager::run(Function&). } -function LLVMRunFunctionPassManager(FPM:LLVMPassManagerRef; F:LLVMValueRef):longint;cdecl;external libname name 'LLVMRunFunctionPassManager'; -{* Finalizes all of the function passes scheduled in in the function pass - manager. Returns 1 if any of the passes modified the module, 0 otherwise. - See llvm::FunctionPassManager::doFinalization. } -function LLVMFinalizeFunctionPassManager(FPM:LLVMPassManagerRef):longint;cdecl;external libname name 'LLVMFinalizeFunctionPassManager'; -{* Frees the memory of a pass pipeline. For function pipelines, does not free - the module provider. - See llvm::PassManagerBase::~PassManagerBase. } -procedure LLVMDisposePassManager(PM:LLVMPassManagerRef);cdecl;external libname name 'LLVMDisposePassManager'; -{ Analysis.h } -{ verifier will print to stderr and abort() } -{ verifier will print to stderr and return 1 } -{ verifier will just return 1 } -type - - LLVMVerifierFailureAction = (LLVMAbortProcessAction,LLVMPrintMessageAction, - LLVMReturnStatusAction); -{ Verifies that a module is valid, taking the specified action if not. - Optionally returns a human-readable description of any invalid constructs. - OutMessage must be disposed with LLVMDisposeMessage. } - -function LLVMVerifyModule(M:LLVMModuleRef; Action:LLVMVerifierFailureAction; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMVerifyModule'; -{ Verifies that a single function is valid, taking the specified action. Useful - for debugging. } -function LLVMVerifyFunction(Fn:LLVMValueRef; Action:LLVMVerifierFailureAction):longint;cdecl;external libname name 'LLVMVerifyFunction'; -{ Open up a ghostview window that displays the CFG of the current function. - Useful for debugging. } -procedure LLVMViewFunctionCFG(Fn:LLVMValueRef);cdecl;external libname name 'LLVMViewFunctionCFG'; -procedure LLVMViewFunctionCFGOnly(Fn:LLVMValueRef);cdecl;external libname name 'LLVMViewFunctionCFGOnly'; -{ BitReader.h } -{ Builds a module from the bitcode in the specified memory buffer, returning a - reference to the module via the OutModule parameter. Returns 0 on success. - Optionally returns a human-readable error message via OutMessage. }function LLVMParseBitcode(MemBuf:LLVMMemoryBufferRef; OutModule:pLLVMModuleRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMParseBitcode'; -function LLVMParseBitcodeInContext(ContextRef:LLVMContextRef; MemBuf:LLVMMemoryBufferRef; OutModule:pLLVMModuleRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMParseBitcodeInContext'; -{ Reads a module from the specified path, returning via the OutMP parameter - a module provider which performs lazy deserialization. Returns 0 on success. - Optionally returns a human-readable error message via OutMessage. }function LLVMGetBitcodeModuleProvider(MemBuf:LLVMMemoryBufferRef; OutMP:pLLVMModuleProviderRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMGetBitcodeModuleProvider'; -function LLVMGetBitcodeModuleProviderInContext(ContextRef:LLVMContextRef; MemBuf:LLVMMemoryBufferRef; OutMP:pLLVMModuleProviderRef; OutMessage:Ppchar):longint;cdecl;external libname name 'LLVMGetBitcodeModuleProviderInContext'; -{ BitWriter.h } -{===-- Operations on modules ---------------------------------------------=== } -{ Writes a module to an open file descriptor. Returns 0 on success. - Closes the Handle. Use dup first if this is not what you want. }function LLVMWriteBitcodeToFileHandle(M:LLVMModuleRef; Handle:longint):longint;cdecl;external libname name 'LLVMWriteBitcodeToFileHandle'; -{ Writes a module to the specified path. Returns 0 on success. }function LLVMWriteBitcodeToFile(M:LLVMModuleRef; Path:pchar):longint;cdecl;external libname name 'LLVMWriteBitcodeToFile'; -{ Target.h } - -const - LLVMBigEndian = 0; - LLVMLittleEndian = 1; -type - - LLVMByteOrdering = longint; - - LLVMTargetDataRef = LLVMOpaqueTargetData; - - LLVMStructLayoutRef = LLVMStructLayout; -{===-- Target Data -------------------------------------------------------=== } -{* Creates target data from a target layout string. - See the constructor llvm::TargetData::TargetData. } - -function LLVMCreateTargetData(StringRep:pchar):LLVMTargetDataRef;cdecl;external libname name 'LLVMCreateTargetData'; -{* Adds target data information to a pass manager. This does not take ownership - of the target data. - See the method llvm::PassManagerBase::add. } -procedure LLVMAddTargetData(para1:LLVMTargetDataRef; para2:LLVMPassManagerRef);cdecl;external libname name 'LLVMAddTargetData'; -{* Converts target data to a target layout string. The string must be disposed - with LLVMDisposeMessage. - See the constructor llvm::TargetData::TargetData. } -function LLVMCopyStringRepOfTargetData(para1:LLVMTargetDataRef):pchar;cdecl;external libname name 'LLVMCopyStringRepOfTargetData'; -{* Returns the byte order of a target, either LLVMBigEndian or - LLVMLittleEndian. - See the method llvm::TargetData::isLittleEndian. } -function LLVMByteOrder(para1:LLVMTargetDataRef):LLVMByteOrdering;cdecl;external libname name 'LLVMByteOrder'; -{* Returns the pointer size in bytes for a target. - See the method llvm::TargetData::getPointerSize. } -function LLVMPointerSize(para1:LLVMTargetDataRef):dword;cdecl;external libname name 'LLVMPointerSize'; -{* Returns the integer type that is the same size as a pointer on a target. - See the method llvm::TargetData::getIntPtrType. } -function LLVMIntPtrType(para1:LLVMTargetDataRef):LLVMTypeRef;cdecl;external libname name 'LLVMIntPtrType'; -{* Computes the size of a type in bytes for a target. - See the method llvm::TargetData::getTypeSizeInBits. } -function LLVMSizeOfTypeInBits(para1:LLVMTargetDataRef; para2:LLVMTypeRef):qword;cdecl;external libname name 'LLVMSizeOfTypeInBits'; -{* Computes the storage size of a type in bytes for a target. - See the method llvm::TargetData::getTypeStoreSize. } -function LLVMStoreSizeOfType(para1:LLVMTargetDataRef; para2:LLVMTypeRef):qword;cdecl;external libname name 'LLVMStoreSizeOfType'; -{* Computes the ABI size of a type in bytes for a target. - See the method llvm::TargetData::getTypeAllocSize. } -function LLVMABISizeOfType(para1:LLVMTargetDataRef; para2:LLVMTypeRef):qword;cdecl;external libname name 'LLVMABISizeOfType'; -{* Computes the ABI alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. } -function LLVMABIAlignmentOfType(para1:LLVMTargetDataRef; para2:LLVMTypeRef):dword;cdecl;external libname name 'LLVMABIAlignmentOfType'; -{* Computes the call frame alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. } -function LLVMCallFrameAlignmentOfType(para1:LLVMTargetDataRef; para2:LLVMTypeRef):dword;cdecl;external libname name 'LLVMCallFrameAlignmentOfType'; -{* Computes the preferred alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. } -function LLVMPreferredAlignmentOfType(para1:LLVMTargetDataRef; para2:LLVMTypeRef):dword;cdecl;external libname name 'LLVMPreferredAlignmentOfType'; -{* Computes the preferred alignment of a global variable in bytes for a target. - See the method llvm::TargetData::getPreferredAlignment. } -function LLVMPreferredAlignmentOfGlobal(para1:LLVMTargetDataRef; GlobalVar:LLVMValueRef):dword;cdecl;external libname name 'LLVMPreferredAlignmentOfGlobal'; -{* Computes the structure element that contains the byte offset for a target. - See the method llvm::StructLayout::getElementContainingOffset. } -function LLVMElementAtOffset(para1:LLVMTargetDataRef; StructTy:LLVMTypeRef; Offset:qword):dword;cdecl;external libname name 'LLVMElementAtOffset'; -{* Computes the byte offset of the indexed struct element for a target. - See the method llvm::StructLayout::getElementContainingOffset. } -function LLVMOffsetOfElement(para1:LLVMTargetDataRef; StructTy:LLVMTypeRef; Element:dword):qword;cdecl;external libname name 'LLVMOffsetOfElement'; -{* Struct layouts are speculatively cached. If a TargetDataRef is alive when - types are being refined and removed, this method must be called whenever a - struct type is removed to avoid a dangling pointer in this cache. - See the method llvm::TargetData::InvalidateStructLayoutInfo. } -procedure LLVMInvalidateStructLayout(para1:LLVMTargetDataRef; StructTy:LLVMTypeRef);cdecl;external libname name 'LLVMInvalidateStructLayout'; -{* Deallocates a TargetData. - See the destructor llvm::TargetData::~TargetData. } -procedure LLVMDisposeTargetData(para1:LLVMTargetDataRef);cdecl;external libname name 'LLVMDisposeTargetData'; -{ ExecutionEngine.h } -procedure LLVMLinkInJIT;cdecl;external libname name 'LLVMLinkInJIT'; -procedure LLVMLinkInInterpreter;cdecl;external libname name 'LLVMLinkInInterpreter'; -type - - LLVMGenericValueRef = LLVMOpaqueGenericValue; - - LLVMExecutionEngineRef = LLVMOpaqueExecutionEngine; -{===-- Operations on generic values --------------------------------------=== } - -function LLVMCreateGenericValueOfInt(Ty:LLVMTypeRef; N:qword; IsSigned:longint):LLVMGenericValueRef;cdecl;external libname name 'LLVMCreateGenericValueOfInt'; -function LLVMCreateGenericValueOfPointer(P:pointer):LLVMGenericValueRef;cdecl;external libname name 'LLVMCreateGenericValueOfPointer'; -function LLVMCreateGenericValueOfFloat(Ty:LLVMTypeRef; N:double):LLVMGenericValueRef;cdecl;external libname name 'LLVMCreateGenericValueOfFloat'; -function LLVMGenericValueIntWidth(GenValRef:LLVMGenericValueRef):dword;cdecl;external libname name 'LLVMGenericValueIntWidth'; -function LLVMGenericValueToInt(GenVal:LLVMGenericValueRef; IsSigned:longint):qword;cdecl;external libname name 'LLVMGenericValueToInt'; -function LLVMGenericValueToPointer(GenVal:LLVMGenericValueRef):pointer;cdecl;external libname name 'LLVMGenericValueToPointer'; -function LLVMGenericValueToFloat(TyRef:LLVMTypeRef; GenVal:LLVMGenericValueRef):double;cdecl;external libname name 'LLVMGenericValueToFloat'; -procedure LLVMDisposeGenericValue(GenVal:LLVMGenericValueRef);cdecl;external libname name 'LLVMDisposeGenericValue'; -{===-- Operations on execution engines -----------------------------------=== } -function LLVMCreateExecutionEngine(OutEE:pLLVMExecutionEngineRef; MP:LLVMModuleProviderRef; OutError:Ppchar):longint;cdecl;external libname name 'LLVMCreateExecutionEngine'; -function LLVMCreateInterpreter(OutInterp:pLLVMExecutionEngineRef; MP:LLVMModuleProviderRef; OutError:Ppchar):longint;cdecl;external libname name 'LLVMCreateInterpreter'; -function LLVMCreateJITCompiler(OutJIT:pLLVMExecutionEngineRef; MP:LLVMModuleProviderRef; OptLevel:dword; OutError:Ppchar):longint;cdecl;external libname name 'LLVMCreateJITCompiler'; -procedure LLVMDisposeExecutionEngine(EE:LLVMExecutionEngineRef);cdecl;external libname name 'LLVMDisposeExecutionEngine'; -procedure LLVMRunStaticConstructors(EE:LLVMExecutionEngineRef);cdecl;external libname name 'LLVMRunStaticConstructors'; -procedure LLVMRunStaticDestructors(EE:LLVMExecutionEngineRef);cdecl;external libname name 'LLVMRunStaticDestructors'; -(* Const before declarator ignored *) -(* Const before declarator ignored *) -function LLVMRunFunctionAsMain(EE:LLVMExecutionEngineRef; F:LLVMValueRef; ArgC:dword; ArgV:Ppchar; EnvP:Ppchar):longint;cdecl;external libname name 'LLVMRunFunctionAsMain'; -function LLVMRunFunction(EE:LLVMExecutionEngineRef; F:LLVMValueRef; NumArgs:dword; Args:pLLVMGenericValueRef):LLVMGenericValueRef;cdecl;external libname name 'LLVMRunFunction'; -procedure LLVMFreeMachineCodeForFunction(EE:LLVMExecutionEngineRef; F:LLVMValueRef);cdecl;external libname name 'LLVMFreeMachineCodeForFunction'; -procedure LLVMAddModuleProvider(EE:LLVMExecutionEngineRef; MP:LLVMModuleProviderRef);cdecl;external libname name 'LLVMAddModuleProvider'; -function LLVMRemoveModuleProvider(EE:LLVMExecutionEngineRef; MP:LLVMModuleProviderRef; OutMod:pLLVMModuleRef; OutError:Ppchar):longint;cdecl;external libname name 'LLVMRemoveModuleProvider'; -function LLVMFindFunction(EE:LLVMExecutionEngineRef; Name:pchar; OutFn:pLLVMValueRef):longint;cdecl;external libname name 'LLVMFindFunction'; -function LLVMGetExecutionEngineTargetData(EE:LLVMExecutionEngineRef):LLVMTargetDataRef;cdecl;external libname name 'LLVMGetExecutionEngineTargetData'; -procedure LLVMAddGlobalMapping(EE:LLVMExecutionEngineRef; Global:LLVMValueRef; Addr:pointer);cdecl;external libname name 'LLVMAddGlobalMapping'; -function LLVMGetPointerToGlobal(EE:LLVMExecutionEngineRef; Global:LLVMValueRef):pointer;cdecl;external libname name 'LLVMGetPointerToGlobal'; -{ LinkTimeOptimizer.h } -{/ This provides a dummy type for pointers to the LTO object. } -type - - llvm_lto_t = pointer; -{/ This provides a C-visible enumerator to manage status codes. } -{/ This should map exactly onto the C++ enumerator LTOStatus. } -{ Added C-specific error codes } - - llvm_lto_status = (LLVM_LTO_UNKNOWN,LLVM_LTO_OPT_SUCCESS, - LLVM_LTO_READ_SUCCESS,LLVM_LTO_READ_FAILURE, - LLVM_LTO_WRITE_FAILURE,LLVM_LTO_NO_TARGET, - LLVM_LTO_NO_WORK,LLVM_LTO_MODULE_MERGE_FAILURE, - LLVM_LTO_ASM_FAILURE,LLVM_LTO_NULL_OBJECT - ); - llvm_lto_status_t = llvm_lto_status; -{/ This provides C interface to initialize link time optimizer. This allows } -{/ linker to use dlopen() interface to dynamically load LinkTimeOptimizer. } -{/ extern "C" helps, because dlopen() interface uses name to find the symbol. } - -function llvm_create_optimizer:llvm_lto_t;cdecl;external libname name 'llvm_create_optimizer'; -procedure llvm_destroy_optimizer(lto:llvm_lto_t);cdecl;external libname name 'llvm_destroy_optimizer'; -function llvm_read_object_file(lto:llvm_lto_t; input_filename:pchar):llvm_lto_status_t;cdecl;external libname name 'llvm_read_object_file'; -function llvm_optimize_modules(lto:llvm_lto_t; output_filename:pchar):llvm_lto_status_t;cdecl;external libname name 'llvm_optimize_modules'; -{ lto.h } - -const - LTO_API_VERSION = 3; -{ log2 of alignment } -type - - lto_symbol_attributes = (LTO_SYMBOL_ALIGNMENT_MASK := $0000001F,LTO_SYMBOL_PERMISSIONS_MASK := $000000E0, - LTO_SYMBOL_PERMISSIONS_CODE := $000000A0,LTO_SYMBOL_PERMISSIONS_DATA := $000000C0, - LTO_SYMBOL_PERMISSIONS_RODATA := $00000080,LTO_SYMBOL_DEFINITION_MASK := $00000700, - LTO_SYMBOL_DEFINITION_REGULAR := $00000100,LTO_SYMBOL_DEFINITION_TENTATIVE := $00000200, - LTO_SYMBOL_DEFINITION_WEAK := $00000300,LTO_SYMBOL_DEFINITION_UNDEFINED := $00000400, - LTO_SYMBOL_DEFINITION_WEAKUNDEF := $00000500, - LTO_SYMBOL_SCOPE_MASK := $00003800,LTO_SYMBOL_SCOPE_INTERNAL := $00000800, - LTO_SYMBOL_SCOPE_HIDDEN := $00001000,LTO_SYMBOL_SCOPE_PROTECTED := $00002000, - LTO_SYMBOL_SCOPE_DEFAULT := $00001800); - - lto_debug_model = (LTO_DEBUG_MODEL_NONE := 0,LTO_DEBUG_MODEL_DWARF := 1 - ); - - lto_codegen_model = (LTO_CODEGEN_PIC_MODEL_STATIC := 0,LTO_CODEGEN_PIC_MODEL_DYNAMIC := 1, - LTO_CODEGEN_PIC_MODEL_DYNAMIC_NO_PIC := 2 - ); -{* opaque reference to a loaded object module } - - lto_module_t = LTOModule; -{* opaque reference to a code generator } - - lto_code_gen_t = LTOCodeGenerator; -{* - * Returns a printable string. - } - -function lto_get_version:pchar;cdecl;external libname name 'lto_get_version'; -{* - * Returns the last error string or NULL if last operation was sucessful. - } -function lto_get_error_message:pchar;cdecl;external libname name 'lto_get_error_message'; -{* - * Checks if a file is a loadable object file. - } -function lto_module_is_object_file(path:pchar):bool;cdecl;external libname name 'lto_module_is_object_file'; -{* - * Checks if a file is a loadable object compiled for requested target. - } -function lto_module_is_object_file_for_target(path:pchar; target_triple_prefix:pchar):bool;cdecl;external libname name 'lto_module_is_object_file_for_target'; -{* - * Checks if a buffer is a loadable object file. - } -function lto_module_is_object_file_in_memory(mem:pointer; length:size_t):bool;cdecl;external libname name 'lto_module_is_object_file_in_memory'; -{* - * Checks if a buffer is a loadable object compiled for requested target. - } -function lto_module_is_object_file_in_memory_for_target(mem:pointer; length:size_t; target_triple_prefix:pchar):bool;cdecl;external libname name 'lto_module_is_object_file_in_memory_for_target'; -{* - * Loads an object file from disk. - * Returns NULL on error (check lto_get_error_message() for details). - } -function lto_module_create(path:pchar):lto_module_t;cdecl;external libname name 'lto_module_create'; -{* - * Loads an object file from memory. - * Returns NULL on error (check lto_get_error_message() for details). - } -function lto_module_create_from_memory(mem:pointer; length:size_t):lto_module_t;cdecl;external libname name 'lto_module_create_from_memory'; -{* - * Frees all memory internally allocated by the module. - * Upon return the lto_module_t is no longer valid. - } -procedure lto_module_dispose(module:lto_module_t);cdecl;external libname name 'lto_module_dispose'; -{* - * Returns triple string which the object module was compiled under. - } -function lto_module_get_target_triple(module:lto_module_t):pchar;cdecl;external libname name 'lto_module_get_target_triple'; -{* - * Returns the number of symbols in the object module. - } -function lto_module_get_num_symbols(module:lto_module_t):dword;cdecl;external libname name 'lto_module_get_num_symbols'; -{* - * Returns the name of the ith symbol in the object module. - } -function lto_module_get_symbol_name(module:lto_module_t; index:dword):pchar;cdecl;external libname name 'lto_module_get_symbol_name'; -{* - * Returns the attributes of the ith symbol in the object module. - } -function lto_module_get_symbol_attribute(module:lto_module_t; index:dword):lto_symbol_attributes;cdecl;external libname name 'lto_module_get_symbol_attribute'; -{* - * Instantiates a code generator. - * Returns NULL on error (check lto_get_error_message() for details). - } -function lto_codegen_create:lto_code_gen_t;cdecl;external libname name 'lto_codegen_create'; -{* - * Frees all code generator and all memory it internally allocated. - * Upon return the lto_code_gen_t is no longer valid. - } -procedure lto_codegen_dispose(para1:lto_code_gen_t);cdecl;external libname name 'lto_codegen_dispose'; -{* - * Add an object module to the set of modules for which code will be generated. - * Returns true on error (check lto_get_error_message() for details). - } -function lto_codegen_add_module(cg:lto_code_gen_t; module:lto_module_t):bool;cdecl;external libname name 'lto_codegen_add_module'; -{* - * Sets if debug info should be generated. - * Returns true on error (check lto_get_error_message() for details). - } -function lto_codegen_set_debug_model(cg:lto_code_gen_t; para2:lto_debug_model):bool;cdecl;external libname name 'lto_codegen_set_debug_model'; -{* - * Sets which PIC code model to generated. - * Returns true on error (check lto_get_error_message() for details). - } -function lto_codegen_set_pic_model(cg:lto_code_gen_t; - para2: lto_codegen_model): bool; -cdecl;external libname name 'lto_codegen_set_pic_model'; -{* - * Sets the location of the "gcc" to run. If not set, libLTO will search for - * "gcc" on the path. - } -procedure lto_codegen_set_gcc_path(cg:lto_code_gen_t; path:pchar); -cdecl;external libname name 'lto_codegen_set_gcc_path'; -{* - * Sets the location of the assembler tool to run. If not set, libLTO - * will use gcc to invoke the assembler. - } -procedure lto_codegen_set_assembler_path(cg:lto_code_gen_t; path:pchar); -cdecl;external libname name 'lto_codegen_set_assembler_path'; -{* - * Adds to a list of all global symbols that must exist in the final - * generated code. If a function is not listed, it might be - * inlined into every usage and optimized away. - } -procedure lto_codegen_add_must_preserve_symbol(cg:lto_code_gen_t; symbol:pchar); -cdecl;external libname name 'lto_codegen_add_must_preserve_symbol'; -{* - * Writes a new object file at the specified path that contains the - * merged contents of all modules added so far. - * Returns true on error (check lto_get_error_message() for details). - } -function lto_codegen_write_merged_modules(cg:lto_code_gen_t; path:pchar):bool; -cdecl;external libname name 'lto_codegen_write_merged_modules'; -{* - * Generates code for all added modules into one native object file. - * On sucess returns a pointer to a generated mach-o/ELF buffer and - * length set to the buffer size. The buffer is owned by the - * lto_code_gen_t and will be freed when lto_codegen_dispose() - * is called, or lto_codegen_compile() is called again. - * On failure, returns NULL (check lto_get_error_message() for details). - } -function lto_codegen_compile(cg:lto_code_gen_t; var length: int): pointer; -cdecl; external libname name 'lto_codegen_compile'; -{* - * Sets options to help debug codegen bugs. - } -procedure lto_codegen_debug_options(cg: lto_code_gen_t; para2: Pchar); -cdecl;external libname name 'lto_codegen_debug_options'; - -implementation - -end. diff --git a/llvm/llvm_orig.nim b/llvm/llvm_orig.nim deleted file mode 100755 index 8e09f9c688..0000000000 --- a/llvm/llvm_orig.nim +++ /dev/null @@ -1,1569 +0,0 @@ - -const - libname* = "" #Setup as you need - -type - PLLVMBasicBlockRef* = ptr LLVMBasicBlockRef - PLLVMExecutionEngineRef* = ptr LLVMExecutionEngineRef - PLLVMGenericValueRef* = ptr LLVMGenericValueRef - PLLVMMemoryBufferRef* = ptr LLVMMemoryBufferRef - PLLVMModuleProviderRef* = ptr LLVMModuleProviderRef - PLLVMModuleRef* = ptr LLVMModuleRef - PLLVMTypeRef* = ptr LLVMTypeRef - PLLVMValueRef* = ptr LLVMValueRef # Core.h - # Opaque types. - #* - # * The top-level container for all LLVM global data. See the LLVMContext class. - # - -type - LLVMContextRef* = LLVMOpaqueContext #* - # * The top-level container for all other LLVM Intermediate Representation (IR) - # * objects. See the llvm::Module class. - # - LLVMModuleRef* = LLVMOpaqueModule #* - # * Each value in the LLVM IR has a type, an LLVMTypeRef. See the llvm::Type - # * class. - # - LLVMTypeRef* = LLVMOpaqueType #* - # * When building recursive types using LLVMRefineType, LLVMTypeRef values may - # * become invalid; use LLVMTypeHandleRef to resolve this problem. See the - # * llvm::AbstractTypeHolder class. - # - LLVMTypeHandleRef* = LLVMOpaqueTypeHandle - LLVMValueRef* = LLVMOpaqueValue - LLVMBasicBlockRef* = LLVMOpaqueBasicBlock - LLVMBuilderRef* = LLVMOpaqueBuilder # Used to provide a module to JIT or interpreter. - # * See the llvm::ModuleProvider class. - # - LLVMModuleProviderRef* = LLVMOpaqueModuleProvider # Used to provide a module to JIT or interpreter. - # * See the llvm::MemoryBuffer class. - # - LLVMMemoryBufferRef* = LLVMOpaqueMemoryBuffer #* See the llvm::PassManagerBase class. - LLVMPassManagerRef* = LLVMOpaquePassManager #* - # * Used to iterate through the uses of a Value, allowing access to all Values - # * that use this Value. See the llvm::Use and llvm::value_use_iterator classes. - # - LLVMUseIteratorRef* = LLVMOpaqueUseIterator - LLVMAttribute* = enum - LLVMZExtAttribute = 1 shl 0, LLVMSExtAttribute = 1 shl 1, - LLVMNoReturnAttribute = 1 shl 2, LLVMInRegAttribute = 1 shl 3, - LLVMStructRetAttribute = 1 shl 4, LLVMNoUnwindAttribute = 1 shl 5, - LLVMNoAliasAttribute = 1 shl 6, LLVMByValAttribute = 1 shl 7, - LLVMNestAttribute = 1 shl 8, LLVMReadNoneAttribute = 1 shl 9, - LLVMReadOnlyAttribute = 1 shl 10, LLVMNoInlineAttribute = 1 shl 11, - LLVMAlwaysInlineAttribute = 1 shl 12, - LLVMOptimizeForSizeAttribute = 1 shl 13, - LLVMStackProtectAttribute = 1 shl 14, - LLVMStackProtectReqAttribute = 1 shl 15, LLVMNoCaptureAttribute = 1 shl - 21, LLVMNoRedZoneAttribute = 1 shl 22, - LLVMNoImplicitFloatAttribute = 1 shl 23, LLVMNakedAttribute = 1 shl 24, - LLVMInlineHintAttribute = 1 shl 25 - LLVMOpcode* = enum #*< type with no size - #*< 32 bit floating point type - #*< 64 bit floating point type - #*< 80 bit floating point type (X87) - #*< 128 bit floating point type (112-bit mantissa) - #*< 128 bit floating point type (two 64-bits) - #*< Labels - #*< Arbitrary bit width integers - #*< Functions - #*< Structures - #*< Arrays - #*< Pointers - #*< Opaque: type with unknown structure - #*< SIMD 'packed' format, or other vector type - #*< Metadata - LLVMRet = 1, LLVMBr = 2, LLVMSwitch = 3, LLVMInvoke = 4, LLVMUnwind = 5, - LLVMUnreachable = 6, LLVMAdd = 7, LLVMFAdd = 8, LLVMSub = 9, LLVMFSub = 10, - LLVMMul = 11, LLVMFMul = 12, LLVMUDiv = 13, LLVMSDiv = 14, LLVMFDiv = 15, - LLVMURem = 16, LLVMSRem = 17, LLVMFRem = 18, LLVMShl = 19, LLVMLShr = 20, - LLVMAShr = 21, LLVMAnd = 22, LLVMOr = 23, LLVMXor = 24, LLVMMalloc = 25, - LLVMFree = 26, LLVMAlloca = 27, LLVMLoad = 28, LLVMStore = 29, - LLVMGetElementPtr = 30, LLVMTrunk = 31, LLVMZExt = 32, LLVMSExt = 33, - LLVMFPToUI = 34, LLVMFPToSI = 35, LLVMUIToFP = 36, LLVMSIToFP = 37, - LLVMFPTrunc = 38, LLVMFPExt = 39, LLVMPtrToInt = 40, LLVMIntToPtr = 41, - LLVMBitCast = 42, LLVMICmp = 43, LLVMFCmp = 44, LLVMPHI = 45, LLVMCall = 46, - LLVMSelect = 47, LLVMVAArg = 50, LLVMExtractElement = 51, - LLVMInsertElement = 52, LLVMShuffleVector = 53, LLVMExtractValue = 54, - LLVMInsertValue = 55 - LLVMTypeKind* = enum #*< Externally visible function - #*< Keep one copy of function when linking (inline) - #*< Same, but only replaced by something - # equivalent. - #*< Keep one copy of function when linking (weak) - #*< Same, but only replaced by something - # equivalent. - #*< Special purpose, only applies to global arrays - #*< Rename collisions when linking (static - # functions) - #*< Like Internal, but omit from symbol table - #*< Function to be imported from DLL - #*< Function to be accessible from DLL - #*< ExternalWeak linkage description - #*< Stand-in functions for streaming fns from - # bitcode - #*< Tentative definitions - #*< Like Private, but linker removes. - LLVMVoidTypeKind, LLVMFloatTypeKind, LLVMDoubleTypeKind, - LLVMX86_FP80TypeKind, LLVMFP128TypeKind, LLVMPPC_FP128TypeKind, - LLVMLabelTypeKind, LLVMIntegerTypeKind, LLVMFunctionTypeKind, - LLVMStructTypeKind, LLVMArrayTypeKind, LLVMPointerTypeKind, - LLVMOpaqueTypeKind, LLVMVectorTypeKind, LLVMMetadataTypeKind - LLVMLinkage* = enum #*< The GV is visible - #*< The GV is hidden - #*< The GV is protected - LLVMExternalLinkage, LLVMAvailableExternallyLinkage, LLVMLinkOnceAnyLinkage, - LLVMLinkOnceODRLinkage, LLVMWeakAnyLinkage, LLVMWeakODRLinkage, - LLVMAppendingLinkage, LLVMInternalLinkage, LLVMPrivateLinkage, - LLVMDLLImportLinkage, LLVMDLLExportLinkage, LLVMExternalWeakLinkage, - LLVMGhostLinkage, LLVMCommonLinkage, LLVMLinkerPrivateLinkage - LLVMVisibility* = enum - LLVMDefaultVisibility, LLVMHiddenVisibility, LLVMProtectedVisibility - LLVMCallConv* = enum #*< equal - #*< not equal - #*< unsigned greater than - #*< unsigned greater or equal - #*< unsigned less than - #*< unsigned less or equal - #*< signed greater than - #*< signed greater or equal - #*< signed less than - #*< signed less or equal - LLVMCCallConv = 0, LLVMFastCallConv = 8, LLVMColdCallConv = 9, - LLVMX86StdcallCallConv = 64, LLVMX86FastcallCallConv = 65 - LLVMIntPredicate* = enum #*< Always false (always folded) - #*< True if ordered and equal - #*< True if ordered and greater than - #*< True if ordered and greater than or equal - #*< True if ordered and less than - #*< True if ordered and less than or equal - #*< True if ordered and operands are unequal - #*< True if ordered (no nans) - #*< True if unordered: isnan(X) | isnan(Y) - #*< True if unordered or equal - #*< True if unordered or greater than - #*< True if unordered, greater than, or equal - #*< True if unordered or less than - #*< True if unordered, less than, or equal - #*< True if unordered or not equal - #*< Always true (always folded) - LLVMIntEQ = 32, LLVMIntNE, LLVMIntUGT, LLVMIntUGE, LLVMIntULT, LLVMIntULE, - LLVMIntSGT, LLVMIntSGE, LLVMIntSLT, LLVMIntSLE - LLVMRealPredicate* = enum #===-- Error handling ----------------------------------------------------=== - LLVMRealPredicateFalse, LLVMRealOEQ, LLVMRealOGT, LLVMRealOGE, LLVMRealOLT, - LLVMRealOLE, LLVMRealONE, LLVMRealORD, LLVMRealUNO, LLVMRealUEQ, - LLVMRealUGT, LLVMRealUGE, LLVMRealULT, LLVMRealULE, LLVMRealUNE, - LLVMRealPredicateTrue - -proc LLVMDisposeMessage*(Message: cstring){.cdecl, dynlib: libname, - importc: "LLVMDisposeMessage".} - #===-- Modules -----------------------------------------------------------=== - # Create and destroy contexts. -proc LLVMContextCreate*(): LLVMContextRef{.cdecl, dynlib: libname, - importc: "LLVMContextCreate".} -proc LLVMGetGlobalContext*(): LLVMContextRef{.cdecl, dynlib: libname, - importc: "LLVMGetGlobalContext".} -proc LLVMContextDispose*(C: LLVMContextRef){.cdecl, dynlib: libname, - importc: "LLVMContextDispose".} - # Create and destroy modules. - #* See llvm::Module::Module. -proc LLVMModuleCreateWithName*(ModuleID: cstring): LLVMModuleRef{.cdecl, - dynlib: libname, importc: "LLVMModuleCreateWithName".} -proc LLVMModuleCreateWithNameInContext*(ModuleID: cstring, C: LLVMContextRef): LLVMModuleRef{. - cdecl, dynlib: libname, importc: "LLVMModuleCreateWithNameInContext".} - #* See llvm::Module::~Module. -proc LLVMDisposeModule*(M: LLVMModuleRef){.cdecl, dynlib: libname, - importc: "LLVMDisposeModule".} - #* Data layout. See Module::getDataLayout. -proc LLVMGetDataLayout*(M: LLVMModuleRef): cstring{.cdecl, dynlib: libname, - importc: "LLVMGetDataLayout".} -proc LLVMSetDataLayout*(M: LLVMModuleRef, Triple: cstring){.cdecl, - dynlib: libname, importc: "LLVMSetDataLayout".} - #* Target triple. See Module::getTargetTriple. -proc LLVMGetTarget*(M: LLVMModuleRef): cstring{.cdecl, dynlib: libname, - importc: "LLVMGetTarget".} -proc LLVMSetTarget*(M: LLVMModuleRef, Triple: cstring){.cdecl, dynlib: libname, - importc: "LLVMSetTarget".} - #* See Module::addTypeName. -proc LLVMAddTypeName*(M: LLVMModuleRef, Name: cstring, Ty: LLVMTypeRef): int32{. - cdecl, dynlib: libname, importc: "LLVMAddTypeName".} -proc LLVMDeleteTypeName*(M: LLVMModuleRef, Name: cstring){.cdecl, - dynlib: libname, importc: "LLVMDeleteTypeName".} -proc LLVMGetTypeByName*(M: LLVMModuleRef, Name: cstring): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMGetTypeByName".} - #* See Module::dump. -proc LLVMDumpModule*(M: LLVMModuleRef){.cdecl, dynlib: libname, - importc: "LLVMDumpModule".} - #===-- Types -------------------------------------------------------------=== - # LLVM types conform to the following hierarchy: - # * - # * types: - # * integer type - # * real type - # * function type - # * sequence types: - # * array type - # * pointer type - # * vector type - # * void type - # * label type - # * opaque type - # - #* See llvm::LLVMTypeKind::getTypeID. -proc LLVMGetTypeKind*(Ty: LLVMTypeRef): LLVMTypeKind{.cdecl, dynlib: libname, - importc: "LLVMGetTypeKind".} - #* See llvm::LLVMType::getContext. -proc LLVMGetTypeContext*(Ty: LLVMTypeRef): LLVMContextRef{.cdecl, - dynlib: libname, importc: "LLVMGetTypeContext".} - # Operations on integer types -proc LLVMInt1TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMInt1TypeInContext".} -proc LLVMInt8TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMInt8TypeInContext".} -proc LLVMInt16TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMInt16TypeInContext".} -proc LLVMInt32TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMInt32TypeInContext".} -proc LLVMInt64TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMInt64TypeInContext".} -proc LLVMIntTypeInContext*(C: LLVMContextRef, NumBits: dword): LLVMTypeRef{. - cdecl, dynlib: libname, importc: "LLVMIntTypeInContext".} -proc LLVMInt1Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMInt1Type".} -proc LLVMInt8Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMInt8Type".} -proc LLVMInt16Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMInt16Type".} -proc LLVMInt32Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMInt32Type".} -proc LLVMInt64Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMInt64Type".} -proc LLVMIntType*(NumBits: dword): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMIntType".} -proc LLVMGetIntTypeWidth*(IntegerTy: LLVMTypeRef): dword{.cdecl, - dynlib: libname, importc: "LLVMGetIntTypeWidth".} - # Operations on real types -proc LLVMFloatTypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMFloatTypeInContext".} -proc LLVMDoubleTypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMDoubleTypeInContext".} -proc LLVMX86FP80TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMX86FP80TypeInContext".} -proc LLVMFP128TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMFP128TypeInContext".} -proc LLVMPPCFP128TypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMPPCFP128TypeInContext".} -proc LLVMFloatType*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMFloatType".} -proc LLVMDoubleType*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMDoubleType".} -proc LLVMX86FP80Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMX86FP80Type".} -proc LLVMFP128Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMFP128Type".} -proc LLVMPPCFP128Type*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMPPCFP128Type".} - # Operations on function types -proc LLVMFunctionType*(ReturnType: LLVMTypeRef, ParamTypes: pLLVMTypeRef, - ParamCount: dword, IsVarArg: int32): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMFunctionType".} -proc LLVMIsFunctionVarArg*(FunctionTy: LLVMTypeRef): int32{.cdecl, - dynlib: libname, importc: "LLVMIsFunctionVarArg".} -proc LLVMGetReturnType*(FunctionTy: LLVMTypeRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMGetReturnType".} -proc LLVMCountParamTypes*(FunctionTy: LLVMTypeRef): dword{.cdecl, - dynlib: libname, importc: "LLVMCountParamTypes".} -proc LLVMGetParamTypes*(FunctionTy: LLVMTypeRef, Dest: pLLVMTypeRef){.cdecl, - dynlib: libname, importc: "LLVMGetParamTypes".} - # Operations on struct types -proc LLVMStructTypeInContext*(C: LLVMContextRef, ElementTypes: pLLVMTypeRef, - ElementCount: dword, isPacked: int32): LLVMTypeRef{. - cdecl, dynlib: libname, importc: "LLVMStructTypeInContext".} -proc LLVMStructType*(ElementTypes: pLLVMTypeRef, ElementCount: dword, - isPacked: int32): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMStructType".} -proc LLVMCountStructElementTypes*(StructTy: LLVMTypeRef): dword{.cdecl, - dynlib: libname, importc: "LLVMCountStructElementTypes".} -proc LLVMGetStructElementTypes*(StructTy: LLVMTypeRef, Dest: pLLVMTypeRef){. - cdecl, dynlib: libname, importc: "LLVMGetStructElementTypes".} -proc LLVMIsPackedStruct*(StructTy: LLVMTypeRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsPackedStruct".} - # Operations on array, pointer, and vector types (sequence types) -proc LLVMArrayType*(ElementType: LLVMTypeRef, ElementCount: dword): LLVMTypeRef{. - cdecl, dynlib: libname, importc: "LLVMArrayType".} -proc LLVMPointerType*(ElementType: LLVMTypeRef, AddressSpace: dword): LLVMTypeRef{. - cdecl, dynlib: libname, importc: "LLVMPointerType".} -proc LLVMVectorType*(ElementType: LLVMTypeRef, ElementCount: dword): LLVMTypeRef{. - cdecl, dynlib: libname, importc: "LLVMVectorType".} -proc LLVMGetElementType*(Ty: LLVMTypeRef): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMGetElementType".} -proc LLVMGetArrayLength*(ArrayTy: LLVMTypeRef): dword{.cdecl, dynlib: libname, - importc: "LLVMGetArrayLength".} -proc LLVMGetPointerAddressSpace*(PointerTy: LLVMTypeRef): dword{.cdecl, - dynlib: libname, importc: "LLVMGetPointerAddressSpace".} -proc LLVMGetVectorSize*(VectorTy: LLVMTypeRef): dword{.cdecl, dynlib: libname, - importc: "LLVMGetVectorSize".} - # Operations on other types -proc LLVMVoidTypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMVoidTypeInContext".} -proc LLVMLabelTypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMLabelTypeInContext".} -proc LLVMOpaqueTypeInContext*(C: LLVMContextRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMOpaqueTypeInContext".} -proc LLVMVoidType*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMVoidType".} -proc LLVMLabelType*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMLabelType".} -proc LLVMOpaqueType*(): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMOpaqueType".} - # Operations on type handles -proc LLVMCreateTypeHandle*(PotentiallyAbstractTy: LLVMTypeRef): LLVMTypeHandleRef{. - cdecl, dynlib: libname, importc: "LLVMCreateTypeHandle".} -proc LLVMRefineType*(AbstractTy: LLVMTypeRef, ConcreteTy: LLVMTypeRef){.cdecl, - dynlib: libname, importc: "LLVMRefineType".} -proc LLVMResolveTypeHandle*(TypeHandle: LLVMTypeHandleRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMResolveTypeHandle".} -proc LLVMDisposeTypeHandle*(TypeHandle: LLVMTypeHandleRef){.cdecl, - dynlib: libname, importc: "LLVMDisposeTypeHandle".} - # Operations on all values -proc LLVMTypeOf*(Val: LLVMValueRef): LLVMTypeRef{.cdecl, dynlib: libname, - importc: "LLVMTypeOf".} -proc LLVMGetValueName*(Val: LLVMValueRef): cstring{.cdecl, dynlib: libname, - importc: "LLVMGetValueName".} -proc LLVMSetValueName*(Val: LLVMValueRef, Name: cstring){.cdecl, - dynlib: libname, importc: "LLVMSetValueName".} -proc LLVMDumpValue*(Val: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMDumpValue".} -proc LLVMReplaceAllUsesWith*(OldVal: LLVMValueRef, NewVal: LLVMValueRef){.cdecl, - dynlib: libname, importc: "LLVMReplaceAllUsesWith".} - # Conversion functions. Return the input value if it is an instance of the - # specified class, otherwise NULL. See llvm::dyn_cast_or_null<>. -proc LLVMIsAArgument*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAArgument".} -proc LLVMIsABasicBlock*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsABasicBlock".} -proc LLVMIsAInlineAsm*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAInlineAsm".} -proc LLVMIsAUser*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAUser".} -proc LLVMIsAConstant*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAConstant".} -proc LLVMIsAConstantAggregateZero*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantAggregateZero".} -proc LLVMIsAConstantArray*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantArray".} -proc LLVMIsAConstantExpr*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantExpr".} -proc LLVMIsAConstantFP*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantFP".} -proc LLVMIsAConstantInt*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantInt".} -proc LLVMIsAConstantPointerNull*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantPointerNull".} -proc LLVMIsAConstantStruct*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantStruct".} -proc LLVMIsAConstantVector*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAConstantVector".} -proc LLVMIsAGlobalValue*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAGlobalValue".} -proc LLVMIsAFunction*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAFunction".} -proc LLVMIsAGlobalAlias*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAGlobalAlias".} -proc LLVMIsAGlobalVariable*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAGlobalVariable".} -proc LLVMIsAUndefValue*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAUndefValue".} -proc LLVMIsAInstruction*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAInstruction".} -proc LLVMIsABinaryOperator*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsABinaryOperator".} -proc LLVMIsACallInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsACallInst".} -proc LLVMIsAIntrinsicInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAIntrinsicInst".} -proc LLVMIsADbgInfoIntrinsic*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgInfoIntrinsic".} -proc LLVMIsADbgDeclareInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgDeclareInst".} -proc LLVMIsADbgFuncStartInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgFuncStartInst".} -proc LLVMIsADbgRegionEndInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgRegionEndInst".} -proc LLVMIsADbgRegionStartInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgRegionStartInst".} -proc LLVMIsADbgStopPointInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsADbgStopPointInst".} -proc LLVMIsAEHSelectorInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAEHSelectorInst".} -proc LLVMIsAMemIntrinsic*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAMemIntrinsic".} -proc LLVMIsAMemCpyInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAMemCpyInst".} -proc LLVMIsAMemMoveInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAMemMoveInst".} -proc LLVMIsAMemSetInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAMemSetInst".} -proc LLVMIsACmpInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsACmpInst".} -proc LLVMIsAFCmpInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAFCmpInst".} -proc LLVMIsAICmpInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAICmpInst".} -proc LLVMIsAExtractElementInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAExtractElementInst".} -proc LLVMIsAGetElementPtrInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAGetElementPtrInst".} -proc LLVMIsAInsertElementInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAInsertElementInst".} -proc LLVMIsAInsertValueInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAInsertValueInst".} -proc LLVMIsAPHINode*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAPHINode".} -proc LLVMIsASelectInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsASelectInst".} -proc LLVMIsAShuffleVectorInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAShuffleVectorInst".} -proc LLVMIsAStoreInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAStoreInst".} -proc LLVMIsATerminatorInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsATerminatorInst".} -proc LLVMIsABranchInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsABranchInst".} -proc LLVMIsAInvokeInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAInvokeInst".} -proc LLVMIsAReturnInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAReturnInst".} -proc LLVMIsASwitchInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsASwitchInst".} -proc LLVMIsAUnreachableInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAUnreachableInst".} -proc LLVMIsAUnwindInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAUnwindInst".} -proc LLVMIsAUnaryInstruction*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAUnaryInstruction".} -proc LLVMIsAAllocationInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAAllocationInst".} -proc LLVMIsAAllocaInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAAllocaInst".} -proc LLVMIsACastInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsACastInst".} -proc LLVMIsABitCastInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsABitCastInst".} -proc LLVMIsAFPExtInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAFPExtInst".} -proc LLVMIsAFPToSIInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAFPToSIInst".} -proc LLVMIsAFPToUIInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAFPToUIInst".} -proc LLVMIsAFPTruncInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAFPTruncInst".} -proc LLVMIsAIntToPtrInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAIntToPtrInst".} -proc LLVMIsAPtrToIntInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAPtrToIntInst".} -proc LLVMIsASExtInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsASExtInst".} -proc LLVMIsASIToFPInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsASIToFPInst".} -proc LLVMIsATruncInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsATruncInst".} -proc LLVMIsAUIToFPInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAUIToFPInst".} -proc LLVMIsAZExtInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAZExtInst".} -proc LLVMIsAExtractValueInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMIsAExtractValueInst".} -proc LLVMIsAFreeInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAFreeInst".} -proc LLVMIsALoadInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsALoadInst".} -proc LLVMIsAVAArgInst*(Val: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMIsAVAArgInst".} - # Operations on Uses -proc LLVMGetFirstUse*(Val: LLVMValueRef): LLVMUseIteratorRef{.cdecl, - dynlib: libname, importc: "LLVMGetFirstUse".} -proc LLVMGetNextUse*(U: LLVMUseIteratorRef): LLVMUseIteratorRef{.cdecl, - dynlib: libname, importc: "LLVMGetNextUse".} -proc LLVMGetUser*(U: LLVMUseIteratorRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetUser".} -proc LLVMGetUsedValue*(U: LLVMUseIteratorRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetUsedValue".} - # Operations on Users -proc LLVMGetOperand*(Val: LLVMValueRef, Index: dword): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetOperand".} - # Operations on constants of any type -proc LLVMConstNull*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstNull".} - # all zeroes -proc LLVMConstAllOnes*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstAllOnes".} - # only for int/vector -proc LLVMGetUndef*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetUndef".} -proc LLVMIsConstant*(Val: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsConstant".} -proc LLVMIsNull*(Val: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsNull".} -proc LLVMIsUndef*(Val: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsUndef".} -proc LLVMConstPointerNull*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstPointerNull".} - # Operations on scalar constants -proc LLVMConstInt*(IntTy: LLVMTypeRef, N: qword, SignExtend: int32): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstInt".} -proc LLVMConstIntOfString*(IntTy: LLVMTypeRef, Text: cstring, Radix: uint8_t): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstIntOfString".} -proc LLVMConstIntOfStringAndSize*(IntTy: LLVMTypeRef, Text: cstring, - SLen: dword, Radix: uint8_t): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstIntOfStringAndSize".} -proc LLVMConstReal*(RealTy: LLVMTypeRef, N: float64): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstReal".} -proc LLVMConstRealOfString*(RealTy: LLVMTypeRef, Text: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstRealOfString".} -proc LLVMConstRealOfStringAndSize*(RealTy: LLVMTypeRef, Text: cstring, - SLen: dword): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstRealOfStringAndSize".} -proc LLVMConstIntGetZExtValue*(ConstantVal: LLVMValueRef): qword{.cdecl, - dynlib: libname, importc: "LLVMConstIntGetZExtValue".} -proc LLVMConstIntGetSExtValue*(ConstantVal: LLVMValueRef): int64{.cdecl, - dynlib: libname, importc: "LLVMConstIntGetSExtValue".} - # Operations on composite constants -proc LLVMConstStringInContext*(C: LLVMContextRef, Str: cstring, len: dword, - DontNullTerminate: int32): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstStringInContext".} -proc LLVMConstStructInContext*(C: LLVMContextRef, ConstantVals: pLLVMValueRef, - Count: dword, isPacked: int32): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstStructInContext".} -proc LLVMConstString*(Str: cstring, len: dword, DontNullTerminate: int32): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstString".} -proc LLVMConstArray*(ElementTy: LLVMTypeRef, ConstantVals: pLLVMValueRef, - len: dword): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstArray".} -proc LLVMConstStruct*(ConstantVals: pLLVMValueRef, Count: dword, isPacked: int32): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstStruct".} -proc LLVMConstVector*(ScalarConstantVals: pLLVMValueRef, Size: dword): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstVector".} - # Constant expressions -proc LLVMGetConstOpcode*(ConstantVal: LLVMValueRef): LLVMOpcode{.cdecl, - dynlib: libname, importc: "LLVMGetConstOpcode".} -proc LLVMAlignOf*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMAlignOf".} -proc LLVMSizeOf*(Ty: LLVMTypeRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMSizeOf".} -proc LLVMConstNeg*(ConstantVal: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstNeg".} -proc LLVMConstFNeg*(ConstantVal: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstFNeg".} -proc LLVMConstNot*(ConstantVal: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstNot".} -proc LLVMConstAdd*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstAdd".} -proc LLVMConstNSWAdd*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstNSWAdd".} -proc LLVMConstFAdd*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFAdd".} -proc LLVMConstSub*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSub".} -proc LLVMConstFSub*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFSub".} -proc LLVMConstMul*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstMul".} -proc LLVMConstFMul*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFMul".} -proc LLVMConstUDiv*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstUDiv".} -proc LLVMConstSDiv*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSDiv".} -proc LLVMConstExactSDiv*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstExactSDiv".} -proc LLVMConstFDiv*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFDiv".} -proc LLVMConstURem*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstURem".} -proc LLVMConstSRem*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSRem".} -proc LLVMConstFRem*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFRem".} -proc LLVMConstAnd*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstAnd".} -proc LLVMConstOr*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstOr".} -proc LLVMConstXor*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstXor".} -proc LLVMConstICmp*(Predicate: LLVMIntPredicate, LHSConstant: LLVMValueRef, - RHSConstant: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstICmp".} -proc LLVMConstFCmp*(Predicate: LLVMRealPredicate, LHSConstant: LLVMValueRef, - RHSConstant: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstFCmp".} -proc LLVMConstShl*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstShl".} -proc LLVMConstLShr*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstLShr".} -proc LLVMConstAShr*(LHSConstant: LLVMValueRef, RHSConstant: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstAShr".} -proc LLVMConstGEP*(ConstantVal: LLVMValueRef, ConstantIndices: pLLVMValueRef, - NumIndices: dword): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstGEP".} -proc LLVMConstInBoundsGEP*(ConstantVal: LLVMValueRef, - ConstantIndices: pLLVMValueRef, NumIndices: dword): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstInBoundsGEP".} -proc LLVMConstTrunc*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstTrunc".} -proc LLVMConstSExt*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSExt".} -proc LLVMConstZExt*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstZExt".} -proc LLVMConstFPTrunc*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFPTrunc".} -proc LLVMConstFPExt*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFPExt".} -proc LLVMConstUIToFP*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstUIToFP".} -proc LLVMConstSIToFP*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSIToFP".} -proc LLVMConstFPToUI*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFPToUI".} -proc LLVMConstFPToSI*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFPToSI".} -proc LLVMConstPtrToInt*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstPtrToInt".} -proc LLVMConstIntToPtr*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstIntToPtr".} -proc LLVMConstBitCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstBitCast".} -proc LLVMConstZExtOrBitCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstZExtOrBitCast".} -proc LLVMConstSExtOrBitCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstSExtOrBitCast".} -proc LLVMConstTruncOrBitCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstTruncOrBitCast".} -proc LLVMConstPointerCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstPointerCast".} -proc LLVMConstIntCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef, - isSigned: dword): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstIntCast".} -proc LLVMConstFPCast*(ConstantVal: LLVMValueRef, ToType: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstFPCast".} -proc LLVMConstSelect*(ConstantCondition: LLVMValueRef, - ConstantIfTrue: LLVMValueRef, - ConstantIfFalse: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstSelect".} -proc LLVMConstExtractElement*(VectorConstant: LLVMValueRef, - IndexConstant: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstExtractElement".} -proc LLVMConstInsertElement*(VectorConstant: LLVMValueRef, - ElementValueConstant: LLVMValueRef, - IndexConstant: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstInsertElement".} -proc LLVMConstShuffleVector*(VectorAConstant: LLVMValueRef, - VectorBConstant: LLVMValueRef, - MaskConstant: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstShuffleVector".} -proc LLVMConstExtractValue*(AggConstant: LLVMValueRef, IdxList: pdword, - NumIdx: dword): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMConstExtractValue".} -proc LLVMConstInsertValue*(AggConstant: LLVMValueRef, - ElementValueConstant: LLVMValueRef, IdxList: pdword, - NumIdx: dword): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMConstInsertValue".} -proc LLVMConstInlineAsm*(Ty: LLVMTypeRef, AsmString: cstring, - Constraints: cstring, HasSideEffects: int32): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMConstInlineAsm".} - # Operations on global variables, functions, and aliases (globals) -proc LLVMGetGlobalParent*(Global: LLVMValueRef): LLVMModuleRef{.cdecl, - dynlib: libname, importc: "LLVMGetGlobalParent".} -proc LLVMIsDeclaration*(Global: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsDeclaration".} -proc LLVMGetLinkage*(Global: LLVMValueRef): LLVMLinkage{.cdecl, dynlib: libname, - importc: "LLVMGetLinkage".} -proc LLVMSetLinkage*(Global: LLVMValueRef, Linkage: LLVMLinkage){.cdecl, - dynlib: libname, importc: "LLVMSetLinkage".} -proc LLVMGetSection*(Global: LLVMValueRef): cstring{.cdecl, dynlib: libname, - importc: "LLVMGetSection".} -proc LLVMSetSection*(Global: LLVMValueRef, Section: cstring){.cdecl, - dynlib: libname, importc: "LLVMSetSection".} -proc LLVMGetVisibility*(Global: LLVMValueRef): LLVMVisibility{.cdecl, - dynlib: libname, importc: "LLVMGetVisibility".} -proc LLVMSetVisibility*(Global: LLVMValueRef, Viz: LLVMVisibility){.cdecl, - dynlib: libname, importc: "LLVMSetVisibility".} -proc LLVMGetAlignment*(Global: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMGetAlignment".} -proc LLVMSetAlignment*(Global: LLVMValueRef, Bytes: dword){.cdecl, - dynlib: libname, importc: "LLVMSetAlignment".} - # Operations on global variables -proc LLVMAddGlobal*(M: LLVMModuleRef, Ty: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMAddGlobal".} -proc LLVMGetNamedGlobal*(M: LLVMModuleRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetNamedGlobal".} -proc LLVMGetFirstGlobal*(M: LLVMModuleRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetFirstGlobal".} -proc LLVMGetLastGlobal*(M: LLVMModuleRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetLastGlobal".} -proc LLVMGetNextGlobal*(GlobalVar: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetNextGlobal".} -proc LLVMGetPreviousGlobal*(GlobalVar: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetPreviousGlobal".} -proc LLVMDeleteGlobal*(GlobalVar: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMDeleteGlobal".} -proc LLVMGetInitializer*(GlobalVar: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetInitializer".} -proc LLVMSetInitializer*(GlobalVar: LLVMValueRef, ConstantVal: LLVMValueRef){. - cdecl, dynlib: libname, importc: "LLVMSetInitializer".} -proc LLVMIsThreadLocal*(GlobalVar: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsThreadLocal".} -proc LLVMSetThreadLocal*(GlobalVar: LLVMValueRef, IsThreadLocal: int32){.cdecl, - dynlib: libname, importc: "LLVMSetThreadLocal".} -proc LLVMIsGlobalConstant*(GlobalVar: LLVMValueRef): int32{.cdecl, - dynlib: libname, importc: "LLVMIsGlobalConstant".} -proc LLVMSetGlobalConstant*(GlobalVar: LLVMValueRef, IsConstant: int32){.cdecl, - dynlib: libname, importc: "LLVMSetGlobalConstant".} - # Operations on aliases -proc LLVMAddAlias*(M: LLVMModuleRef, Ty: LLVMTypeRef, Aliasee: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMAddAlias".} - # Operations on functions -proc LLVMAddFunction*(M: LLVMModuleRef, Name: cstring, FunctionTy: LLVMTypeRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMAddFunction".} -proc LLVMGetNamedFunction*(M: LLVMModuleRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMGetNamedFunction".} -proc LLVMGetFirstFunction*(M: LLVMModuleRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetFirstFunction".} -proc LLVMGetLastFunction*(M: LLVMModuleRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetLastFunction".} -proc LLVMGetNextFunction*(Fn: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetNextFunction".} -proc LLVMGetPreviousFunction*(Fn: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetPreviousFunction".} -proc LLVMDeleteFunction*(Fn: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMDeleteFunction".} -proc LLVMGetIntrinsicID*(Fn: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMGetIntrinsicID".} -proc LLVMGetFunctionCallConv*(Fn: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMGetFunctionCallConv".} -proc LLVMSetFunctionCallConv*(Fn: LLVMValueRef, CC: dword){.cdecl, - dynlib: libname, importc: "LLVMSetFunctionCallConv".} -proc LLVMGetGC*(Fn: LLVMValueRef): cstring{.cdecl, dynlib: libname, - importc: "LLVMGetGC".} -proc LLVMSetGC*(Fn: LLVMValueRef, Name: cstring){.cdecl, dynlib: libname, - importc: "LLVMSetGC".} -proc LLVMAddFunctionAttr*(Fn: LLVMValueRef, PA: LLVMAttribute){.cdecl, - dynlib: libname, importc: "LLVMAddFunctionAttr".} -proc LLVMGetFunctionAttr*(Fn: LLVMValueRef): LLVMAttribute{.cdecl, - dynlib: libname, importc: "LLVMGetFunctionAttr".} -proc LLVMRemoveFunctionAttr*(Fn: LLVMValueRef, PA: LLVMAttribute){.cdecl, - dynlib: libname, importc: "LLVMRemoveFunctionAttr".} - # Operations on parameters -proc LLVMCountParams*(Fn: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMCountParams".} -proc LLVMGetParams*(Fn: LLVMValueRef, Params: pLLVMValueRef){.cdecl, - dynlib: libname, importc: "LLVMGetParams".} -proc LLVMGetParam*(Fn: LLVMValueRef, Index: dword): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetParam".} -proc LLVMGetParamParent*(Inst: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetParamParent".} -proc LLVMGetFirstParam*(Fn: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetFirstParam".} -proc LLVMGetLastParam*(Fn: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetLastParam".} -proc LLVMGetNextParam*(Arg: LLVMValueRef): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMGetNextParam".} -proc LLVMGetPreviousParam*(Arg: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetPreviousParam".} -proc LLVMAddAttribute*(Arg: LLVMValueRef, PA: LLVMAttribute){.cdecl, - dynlib: libname, importc: "LLVMAddAttribute".} -proc LLVMRemoveAttribute*(Arg: LLVMValueRef, PA: LLVMAttribute){.cdecl, - dynlib: libname, importc: "LLVMRemoveAttribute".} -proc LLVMGetAttribute*(Arg: LLVMValueRef): LLVMAttribute{.cdecl, - dynlib: libname, importc: "LLVMGetAttribute".} -proc LLVMSetParamAlignment*(Arg: LLVMValueRef, align: dword){.cdecl, - dynlib: libname, importc: "LLVMSetParamAlignment".} - # Operations on basic blocks -proc LLVMBasicBlockAsValue*(BB: LLVMBasicBlockRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBasicBlockAsValue".} -proc LLVMValueIsBasicBlock*(Val: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMValueIsBasicBlock".} -proc LLVMValueAsBasicBlock*(Val: LLVMValueRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMValueAsBasicBlock".} -proc LLVMGetBasicBlockParent*(BB: LLVMBasicBlockRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetBasicBlockParent".} -proc LLVMCountBasicBlocks*(Fn: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMCountBasicBlocks".} -proc LLVMGetBasicBlocks*(Fn: LLVMValueRef, BasicBlocks: pLLVMBasicBlockRef){. - cdecl, dynlib: libname, importc: "LLVMGetBasicBlocks".} -proc LLVMGetFirstBasicBlock*(Fn: LLVMValueRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetFirstBasicBlock".} -proc LLVMGetLastBasicBlock*(Fn: LLVMValueRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetLastBasicBlock".} -proc LLVMGetNextBasicBlock*(BB: LLVMBasicBlockRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetNextBasicBlock".} -proc LLVMGetPreviousBasicBlock*(BB: LLVMBasicBlockRef): LLVMBasicBlockRef{. - cdecl, dynlib: libname, importc: "LLVMGetPreviousBasicBlock".} -proc LLVMGetEntryBasicBlock*(Fn: LLVMValueRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetEntryBasicBlock".} -proc LLVMAppendBasicBlockInContext*(C: LLVMContextRef, Fn: LLVMValueRef, - Name: cstring): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMAppendBasicBlockInContext".} -proc LLVMInsertBasicBlockInContext*(C: LLVMContextRef, BB: LLVMBasicBlockRef, - Name: cstring): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMInsertBasicBlockInContext".} -proc LLVMAppendBasicBlock*(Fn: LLVMValueRef, Name: cstring): LLVMBasicBlockRef{. - cdecl, dynlib: libname, importc: "LLVMAppendBasicBlock".} -proc LLVMInsertBasicBlock*(InsertBeforeBB: LLVMBasicBlockRef, Name: cstring): LLVMBasicBlockRef{. - cdecl, dynlib: libname, importc: "LLVMInsertBasicBlock".} -proc LLVMDeleteBasicBlock*(BB: LLVMBasicBlockRef){.cdecl, dynlib: libname, - importc: "LLVMDeleteBasicBlock".} - # Operations on instructions -proc LLVMGetInstructionParent*(Inst: LLVMValueRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetInstructionParent".} -proc LLVMGetFirstInstruction*(BB: LLVMBasicBlockRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetFirstInstruction".} -proc LLVMGetLastInstruction*(BB: LLVMBasicBlockRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetLastInstruction".} -proc LLVMGetNextInstruction*(Inst: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetNextInstruction".} -proc LLVMGetPreviousInstruction*(Inst: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMGetPreviousInstruction".} - # Operations on call sites -proc LLVMSetInstructionCallConv*(Instr: LLVMValueRef, CC: dword){.cdecl, - dynlib: libname, importc: "LLVMSetInstructionCallConv".} -proc LLVMGetInstructionCallConv*(Instr: LLVMValueRef): dword{.cdecl, - dynlib: libname, importc: "LLVMGetInstructionCallConv".} -proc LLVMAddInstrAttribute*(Instr: LLVMValueRef, index: dword, - para3: LLVMAttribute){.cdecl, dynlib: libname, - importc: "LLVMAddInstrAttribute".} -proc LLVMRemoveInstrAttribute*(Instr: LLVMValueRef, index: dword, - para3: LLVMAttribute){.cdecl, dynlib: libname, - importc: "LLVMRemoveInstrAttribute".} -proc LLVMSetInstrParamAlignment*(Instr: LLVMValueRef, index: dword, align: dword){. - cdecl, dynlib: libname, importc: "LLVMSetInstrParamAlignment".} - # Operations on call instructions (only) -proc LLVMIsTailCall*(CallInst: LLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMIsTailCall".} -proc LLVMSetTailCall*(CallInst: LLVMValueRef, IsTailCall: int32){.cdecl, - dynlib: libname, importc: "LLVMSetTailCall".} - # Operations on phi nodes -proc LLVMAddIncoming*(PhiNode: LLVMValueRef, IncomingValues: pLLVMValueRef, - IncomingBlocks: pLLVMBasicBlockRef, Count: dword){.cdecl, - dynlib: libname, importc: "LLVMAddIncoming".} -proc LLVMCountIncoming*(PhiNode: LLVMValueRef): dword{.cdecl, dynlib: libname, - importc: "LLVMCountIncoming".} -proc LLVMGetIncomingValue*(PhiNode: LLVMValueRef, Index: dword): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMGetIncomingValue".} -proc LLVMGetIncomingBlock*(PhiNode: LLVMValueRef, Index: dword): LLVMBasicBlockRef{. - cdecl, dynlib: libname, importc: "LLVMGetIncomingBlock".} - #===-- Instruction builders ----------------------------------------------=== - # An instruction builder represents a point within a basic block, and is the - # * exclusive means of building instructions using the C interface. - # -proc LLVMCreateBuilderInContext*(C: LLVMContextRef): LLVMBuilderRef{.cdecl, - dynlib: libname, importc: "LLVMCreateBuilderInContext".} -proc LLVMCreateBuilder*(): LLVMBuilderRef{.cdecl, dynlib: libname, - importc: "LLVMCreateBuilder".} -proc LLVMPositionBuilder*(Builder: LLVMBuilderRef, theBlock: LLVMBasicBlockRef, - Instr: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMPositionBuilder".} -proc LLVMPositionBuilderBefore*(Builder: LLVMBuilderRef, Instr: LLVMValueRef){. - cdecl, dynlib: libname, importc: "LLVMPositionBuilderBefore".} -proc LLVMPositionBuilderAtEnd*(Builder: LLVMBuilderRef, theBlock: LLVMBasicBlockRef){. - cdecl, dynlib: libname, importc: "LLVMPositionBuilderAtEnd".} -proc LLVMGetInsertBlock*(Builder: LLVMBuilderRef): LLVMBasicBlockRef{.cdecl, - dynlib: libname, importc: "LLVMGetInsertBlock".} -proc LLVMClearInsertionPosition*(Builder: LLVMBuilderRef){.cdecl, - dynlib: libname, importc: "LLVMClearInsertionPosition".} -proc LLVMInsertIntoBuilder*(Builder: LLVMBuilderRef, Instr: LLVMValueRef){. - cdecl, dynlib: libname, importc: "LLVMInsertIntoBuilder".} -proc LLVMInsertIntoBuilderWithName*(Builder: LLVMBuilderRef, - Instr: LLVMValueRef, Name: cstring){.cdecl, - dynlib: libname, importc: "LLVMInsertIntoBuilderWithName".} -proc LLVMDisposeBuilder*(Builder: LLVMBuilderRef){.cdecl, dynlib: libname, - importc: "LLVMDisposeBuilder".} - # Terminators -proc LLVMBuildRetVoid*(para1: LLVMBuilderRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildRetVoid".} -proc LLVMBuildRet*(para1: LLVMBuilderRef, V: LLVMValueRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildRet".} -proc LLVMBuildAggregateRet*(para1: LLVMBuilderRef, RetVals: pLLVMValueRef, - N: dword): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildAggregateRet".} -proc LLVMBuildBr*(para1: LLVMBuilderRef, Dest: LLVMBasicBlockRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildBr".} -proc LLVMBuildCondBr*(para1: LLVMBuilderRef, Cond: LLVMValueRef, - ThenBranch: LLVMBasicBlockRef, - ElseBranch: LLVMBasicBlockRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildCondBr".} -proc LLVMBuildSwitch*(para1: LLVMBuilderRef, V: LLVMValueRef, - ElseBranch: LLVMBasicBlockRef, NumCases: dword): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildSwitch".} -proc LLVMBuildInvoke*(para1: LLVMBuilderRef, Fn: LLVMValueRef, - Args: pLLVMValueRef, NumArgs: dword, - ThenBranch: LLVMBasicBlockRef, Catch: LLVMBasicBlockRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildInvoke".} -proc LLVMBuildUnwind*(para1: LLVMBuilderRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildUnwind".} -proc LLVMBuildUnreachable*(para1: LLVMBuilderRef): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildUnreachable".} - # Add a case to the switch instruction -proc LLVMAddCase*(Switch: LLVMValueRef, OnVal: LLVMValueRef, - Dest: LLVMBasicBlockRef){.cdecl, dynlib: libname, - importc: "LLVMAddCase".} - # Arithmetic -proc LLVMBuildAdd*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildAdd".} -proc LLVMBuildNSWAdd*(para1: LLVMBuilderRef, LHS: LLVMValueRef, - RHS: LLVMValueRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildNSWAdd".} -proc LLVMBuildFAdd*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildFAdd".} -proc LLVMBuildSub*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildSub".} -proc LLVMBuildFSub*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildFSub".} -proc LLVMBuildMul*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildMul".} -proc LLVMBuildFMul*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildFMul".} -proc LLVMBuildUDiv*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildUDiv".} -proc LLVMBuildSDiv*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildSDiv".} -proc LLVMBuildExactSDiv*(para1: LLVMBuilderRef, LHS: LLVMValueRef, - RHS: LLVMValueRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildExactSDiv".} -proc LLVMBuildFDiv*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildFDiv".} -proc LLVMBuildURem*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildURem".} -proc LLVMBuildSRem*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildSRem".} -proc LLVMBuildFRem*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildFRem".} -proc LLVMBuildShl*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildShl".} -proc LLVMBuildLShr*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildLShr".} -proc LLVMBuildAShr*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildAShr".} -proc LLVMBuildAnd*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildAnd".} -proc LLVMBuildOr*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildOr".} -proc LLVMBuildXor*(para1: LLVMBuilderRef, LHS: LLVMValueRef, RHS: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildXor".} -proc LLVMBuildNeg*(para1: LLVMBuilderRef, V: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildNeg".} -proc LLVMBuildFNeg*(para1: LLVMBuilderRef, V: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildFNeg".} -proc LLVMBuildNot*(para1: LLVMBuilderRef, V: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildNot".} - # Memory -proc LLVMBuildMalloc*(para1: LLVMBuilderRef, Ty: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildMalloc".} -proc LLVMBuildArrayMalloc*(para1: LLVMBuilderRef, Ty: LLVMTypeRef, - Val: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildArrayMalloc".} -proc LLVMBuildAlloca*(para1: LLVMBuilderRef, Ty: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildAlloca".} -proc LLVMBuildArrayAlloca*(para1: LLVMBuilderRef, Ty: LLVMTypeRef, - Val: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildArrayAlloca".} -proc LLVMBuildFree*(para1: LLVMBuilderRef, PointerVal: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildFree".} -proc LLVMBuildLoad*(para1: LLVMBuilderRef, PointerVal: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildLoad".} -proc LLVMBuildStore*(para1: LLVMBuilderRef, Val: LLVMValueRef, - thePtr: LLVMValueRef): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildStore".} -proc LLVMBuildGEP*(B: LLVMBuilderRef, Pointer: LLVMValueRef, - Indices: pLLVMValueRef, NumIndices: dword, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildGEP".} -proc LLVMBuildInBoundsGEP*(B: LLVMBuilderRef, Pointer: LLVMValueRef, - Indices: pLLVMValueRef, NumIndices: dword, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildInBoundsGEP".} -proc LLVMBuildStructGEP*(B: LLVMBuilderRef, Pointer: LLVMValueRef, Idx: dword, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildStructGEP".} -proc LLVMBuildGlobalString*(B: LLVMBuilderRef, Str: cstring, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildGlobalString".} -proc LLVMBuildGlobalStringPtr*(B: LLVMBuilderRef, Str: cstring, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildGlobalStringPtr".} - # Casts -proc LLVMBuildTrunc*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildTrunc".} -proc LLVMBuildZExt*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildZExt".} -proc LLVMBuildSExt*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildSExt".} -proc LLVMBuildFPToUI*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildFPToUI".} -proc LLVMBuildFPToSI*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildFPToSI".} -proc LLVMBuildUIToFP*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildUIToFP".} -proc LLVMBuildSIToFP*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildSIToFP".} -proc LLVMBuildFPTrunc*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildFPTrunc".} -proc LLVMBuildFPExt*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildFPExt".} -proc LLVMBuildPtrToInt*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildPtrToInt".} -proc LLVMBuildIntToPtr*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildIntToPtr".} -proc LLVMBuildBitCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildBitCast".} -proc LLVMBuildZExtOrBitCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildZExtOrBitCast".} -proc LLVMBuildSExtOrBitCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildSExtOrBitCast".} -proc LLVMBuildTruncOrBitCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildTruncOrBitCast".} -proc LLVMBuildPointerCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildPointerCast".} -proc LLVMBuildIntCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildIntCast".} -proc LLVMBuildFPCast*(para1: LLVMBuilderRef, Val: LLVMValueRef, - DestTy: LLVMTypeRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildFPCast".} - # Comparisons -proc LLVMBuildICmp*(para1: LLVMBuilderRef, Op: LLVMIntPredicate, - LHS: LLVMValueRef, RHS: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildICmp".} -proc LLVMBuildFCmp*(para1: LLVMBuilderRef, Op: LLVMRealPredicate, - LHS: LLVMValueRef, RHS: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildFCmp".} - # Miscellaneous instructions -proc LLVMBuildPhi*(para1: LLVMBuilderRef, Ty: LLVMTypeRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildPhi".} -proc LLVMBuildCall*(para1: LLVMBuilderRef, Fn: LLVMValueRef, - Args: pLLVMValueRef, NumArgs: dword, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildCall".} -proc LLVMBuildSelect*(para1: LLVMBuilderRef, Cond: LLVMValueRef, - ThenBranch: LLVMValueRef, ElseBranch: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildSelect".} -proc LLVMBuildVAArg*(para1: LLVMBuilderRef, List: LLVMValueRef, Ty: LLVMTypeRef, - Name: cstring): LLVMValueRef{.cdecl, dynlib: libname, - importc: "LLVMBuildVAArg".} -proc LLVMBuildExtractElement*(para1: LLVMBuilderRef, VecVal: LLVMValueRef, - Index: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildExtractElement".} -proc LLVMBuildInsertElement*(para1: LLVMBuilderRef, VecVal: LLVMValueRef, - EltVal: LLVMValueRef, Index: LLVMValueRef, - Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildInsertElement".} -proc LLVMBuildShuffleVector*(para1: LLVMBuilderRef, V1: LLVMValueRef, - V2: LLVMValueRef, Mask: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildShuffleVector".} -proc LLVMBuildExtractValue*(para1: LLVMBuilderRef, AggVal: LLVMValueRef, - Index: dword, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildExtractValue".} -proc LLVMBuildInsertValue*(para1: LLVMBuilderRef, AggVal: LLVMValueRef, - EltVal: LLVMValueRef, Index: dword, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildInsertValue".} -proc LLVMBuildIsNull*(para1: LLVMBuilderRef, Val: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildIsNull".} -proc LLVMBuildIsNotNull*(para1: LLVMBuilderRef, Val: LLVMValueRef, Name: cstring): LLVMValueRef{. - cdecl, dynlib: libname, importc: "LLVMBuildIsNotNull".} -proc LLVMBuildPtrDiff*(para1: LLVMBuilderRef, LHS: LLVMValueRef, - RHS: LLVMValueRef, Name: cstring): LLVMValueRef{.cdecl, - dynlib: libname, importc: "LLVMBuildPtrDiff".} - #===-- Module providers --------------------------------------------------=== - # Encapsulates the module M in a module provider, taking ownership of the - # * module. - # * See the constructor llvm::ExistingModuleProvider::ExistingModuleProvider. - # -proc LLVMCreateModuleProviderForExistingModule*(M: LLVMModuleRef): LLVMModuleProviderRef{. - cdecl, dynlib: libname, importc: "LLVMCreateModuleProviderForExistingModule".} - # Destroys the module provider MP as well as the contained module. - # * See the destructor llvm::ModuleProvider::~ModuleProvider. - # -proc LLVMDisposeModuleProvider*(MP: LLVMModuleProviderRef){.cdecl, - dynlib: libname, importc: "LLVMDisposeModuleProvider".} - #===-- Memory buffers ----------------------------------------------------=== -proc LLVMCreateMemoryBufferWithContentsOfFile*(Path: cstring, - OutMemBuf: pLLVMMemoryBufferRef, OutMessage: Ppchar): int32{.cdecl, - dynlib: libname, importc: "LLVMCreateMemoryBufferWithContentsOfFile".} -proc LLVMCreateMemoryBufferWithSTDIN*(OutMemBuf: pLLVMMemoryBufferRef, - OutMessage: Ppchar): int32{.cdecl, - dynlib: libname, importc: "LLVMCreateMemoryBufferWithSTDIN".} -proc LLVMDisposeMemoryBuffer*(MemBuf: LLVMMemoryBufferRef){.cdecl, - dynlib: libname, importc: "LLVMDisposeMemoryBuffer".} - #===-- Pass Managers -----------------------------------------------------=== - #* Constructs a new whole-module pass pipeline. This type of pipeline is - # suitable for link-time optimization and whole-module transformations. - # See llvm::PassManager::PassManager. -proc LLVMCreatePassManager*(): LLVMPassManagerRef{.cdecl, dynlib: libname, - importc: "LLVMCreatePassManager".} - #* Constructs a new function-by-function pass pipeline over the module - # provider. It does not take ownership of the module provider. This type of - # pipeline is suitable for code generation and JIT compilation tasks. - # See llvm::FunctionPassManager::FunctionPassManager. -proc LLVMCreateFunctionPassManager*(MP: LLVMModuleProviderRef): LLVMPassManagerRef{. - cdecl, dynlib: libname, importc: "LLVMCreateFunctionPassManager".} - #* Initializes, executes on the provided module, and finalizes all of the - # passes scheduled in the pass manager. Returns 1 if any of the passes - # modified the module, 0 otherwise. See llvm::PassManager::run(Module&). -proc LLVMRunPassManager*(PM: LLVMPassManagerRef, M: LLVMModuleRef): int32{. - cdecl, dynlib: libname, importc: "LLVMRunPassManager".} - #* Initializes all of the function passes scheduled in the function pass - # manager. Returns 1 if any of the passes modified the module, 0 otherwise. - # See llvm::FunctionPassManager::doInitialization. -proc LLVMInitializeFunctionPassManager*(FPM: LLVMPassManagerRef): int32{.cdecl, - dynlib: libname, importc: "LLVMInitializeFunctionPassManager".} - #* Executes all of the function passes scheduled in the function pass manager - # on the provided function. Returns 1 if any of the passes modified the - # function, false otherwise. - # See llvm::FunctionPassManager::run(Function&). -proc LLVMRunFunctionPassManager*(FPM: LLVMPassManagerRef, F: LLVMValueRef): int32{. - cdecl, dynlib: libname, importc: "LLVMRunFunctionPassManager".} - #* Finalizes all of the function passes scheduled in in the function pass - # manager. Returns 1 if any of the passes modified the module, 0 otherwise. - # See llvm::FunctionPassManager::doFinalization. -proc LLVMFinalizeFunctionPassManager*(FPM: LLVMPassManagerRef): int32{.cdecl, - dynlib: libname, importc: "LLVMFinalizeFunctionPassManager".} - #* Frees the memory of a pass pipeline. For function pipelines, does not free - # the module provider. - # See llvm::PassManagerBase::~PassManagerBase. -proc LLVMDisposePassManager*(PM: LLVMPassManagerRef){.cdecl, dynlib: libname, - importc: "LLVMDisposePassManager".} - # Analysis.h - # verifier will print to stderr and abort() - # verifier will print to stderr and return 1 - # verifier will just return 1 -type - LLVMVerifierFailureAction* = enum # Verifies that a module is valid, taking the specified action if not. - # Optionally returns a human-readable description of any invalid constructs. - # OutMessage must be disposed with LLVMDisposeMessage. - LLVMAbortProcessAction, LLVMPrintMessageAction, LLVMReturnStatusAction - -proc LLVMVerifyModule*(M: LLVMModuleRef, Action: LLVMVerifierFailureAction, - OutMessage: Ppchar): int32{.cdecl, dynlib: libname, - importc: "LLVMVerifyModule".} - # Verifies that a single function is valid, taking the specified action. Useful - # for debugging. -proc LLVMVerifyFunction*(Fn: LLVMValueRef, Action: LLVMVerifierFailureAction): int32{. - cdecl, dynlib: libname, importc: "LLVMVerifyFunction".} - # Open up a ghostview window that displays the CFG of the current function. - # Useful for debugging. -proc LLVMViewFunctionCFG*(Fn: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMViewFunctionCFG".} -proc LLVMViewFunctionCFGOnly*(Fn: LLVMValueRef){.cdecl, dynlib: libname, - importc: "LLVMViewFunctionCFGOnly".} - # BitReader.h - # Builds a module from the bitcode in the specified memory buffer, returning a - # reference to the module via the OutModule parameter. Returns 0 on success. - # Optionally returns a human-readable error message via OutMessage. -proc LLVMParseBitcode*(MemBuf: LLVMMemoryBufferRef, OutModule: pLLVMModuleRef, - OutMessage: Ppchar): int32{.cdecl, dynlib: libname, - importc: "LLVMParseBitcode".} -proc LLVMParseBitcodeInContext*(ContextRef: LLVMContextRef, - MemBuf: LLVMMemoryBufferRef, - OutModule: pLLVMModuleRef, OutMessage: Ppchar): int32{. - cdecl, dynlib: libname, importc: "LLVMParseBitcodeInContext".} - # Reads a module from the specified path, returning via the OutMP parameter - # a module provider which performs lazy deserialization. Returns 0 on success. - # Optionally returns a human-readable error message via OutMessage. -proc LLVMGetBitcodeModuleProvider*(MemBuf: LLVMMemoryBufferRef, - OutMP: pLLVMModuleProviderRef, - OutMessage: Ppchar): int32{.cdecl, - dynlib: libname, importc: "LLVMGetBitcodeModuleProvider".} -proc LLVMGetBitcodeModuleProviderInContext*(ContextRef: LLVMContextRef, - MemBuf: LLVMMemoryBufferRef, OutMP: pLLVMModuleProviderRef, - OutMessage: Ppchar): int32{.cdecl, dynlib: libname, importc: "LLVMGetBitcodeModuleProviderInContext".} - # BitWriter.h - #===-- Operations on modules ---------------------------------------------=== - # Writes a module to an open file descriptor. Returns 0 on success. - # Closes the Handle. Use dup first if this is not what you want. -proc LLVMWriteBitcodeToFileHandle*(M: LLVMModuleRef, Handle: int32): int32{. - cdecl, dynlib: libname, importc: "LLVMWriteBitcodeToFileHandle".} - # Writes a module to the specified path. Returns 0 on success. -proc LLVMWriteBitcodeToFile*(M: LLVMModuleRef, Path: cstring): int32{.cdecl, - dynlib: libname, importc: "LLVMWriteBitcodeToFile".} - # Target.h -const - LLVMBigEndian* = 0 - LLVMLittleEndian* = 1 - -type - LLVMByteOrdering* = int32 - LLVMTargetDataRef* = LLVMOpaqueTargetData - LLVMStructLayoutRef* = LLVMStructLayout #===-- Target Data -------------------------------------------------------=== - #* Creates target data from a target layout string. - # See the constructor llvm::TargetData::TargetData. - -proc LLVMCreateTargetData*(StringRep: cstring): LLVMTargetDataRef{.cdecl, - dynlib: libname, importc: "LLVMCreateTargetData".} - #* Adds target data information to a pass manager. This does not take ownership - # of the target data. - # See the method llvm::PassManagerBase::add. -proc LLVMAddTargetData*(para1: LLVMTargetDataRef, para2: LLVMPassManagerRef){. - cdecl, dynlib: libname, importc: "LLVMAddTargetData".} - #* Converts target data to a target layout string. The string must be disposed - # with LLVMDisposeMessage. - # See the constructor llvm::TargetData::TargetData. -proc LLVMCopyStringRepOfTargetData*(para1: LLVMTargetDataRef): cstring{.cdecl, - dynlib: libname, importc: "LLVMCopyStringRepOfTargetData".} - #* Returns the byte order of a target, either LLVMBigEndian or - # LLVMLittleEndian. - # See the method llvm::TargetData::isLittleEndian. -proc LLVMByteOrder*(para1: LLVMTargetDataRef): LLVMByteOrdering{.cdecl, - dynlib: libname, importc: "LLVMByteOrder".} - #* Returns the pointer size in bytes for a target. - # See the method llvm::TargetData::getPointerSize. -proc LLVMPointerSize*(para1: LLVMTargetDataRef): dword{.cdecl, dynlib: libname, - importc: "LLVMPointerSize".} - #* Returns the integer type that is the same size as a pointer on a target. - # See the method llvm::TargetData::getIntPtrType. -proc LLVMIntPtrType*(para1: LLVMTargetDataRef): LLVMTypeRef{.cdecl, - dynlib: libname, importc: "LLVMIntPtrType".} - #* Computes the size of a type in bytes for a target. - # See the method llvm::TargetData::getTypeSizeInBits. -proc LLVMSizeOfTypeInBits*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): qword{. - cdecl, dynlib: libname, importc: "LLVMSizeOfTypeInBits".} - #* Computes the storage size of a type in bytes for a target. - # See the method llvm::TargetData::getTypeStoreSize. -proc LLVMStoreSizeOfType*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): qword{. - cdecl, dynlib: libname, importc: "LLVMStoreSizeOfType".} - #* Computes the ABI size of a type in bytes for a target. - # See the method llvm::TargetData::getTypeAllocSize. -proc LLVMABISizeOfType*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): qword{. - cdecl, dynlib: libname, importc: "LLVMABISizeOfType".} - #* Computes the ABI alignment of a type in bytes for a target. - # See the method llvm::TargetData::getTypeABISize. -proc LLVMABIAlignmentOfType*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): dword{. - cdecl, dynlib: libname, importc: "LLVMABIAlignmentOfType".} - #* Computes the call frame alignment of a type in bytes for a target. - # See the method llvm::TargetData::getTypeABISize. -proc LLVMCallFrameAlignmentOfType*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): dword{. - cdecl, dynlib: libname, importc: "LLVMCallFrameAlignmentOfType".} - #* Computes the preferred alignment of a type in bytes for a target. - # See the method llvm::TargetData::getTypeABISize. -proc LLVMPreferredAlignmentOfType*(para1: LLVMTargetDataRef, para2: LLVMTypeRef): dword{. - cdecl, dynlib: libname, importc: "LLVMPreferredAlignmentOfType".} - #* Computes the preferred alignment of a global variable in bytes for a target. - # See the method llvm::TargetData::getPreferredAlignment. -proc LLVMPreferredAlignmentOfGlobal*(para1: LLVMTargetDataRef, - GlobalVar: LLVMValueRef): dword{.cdecl, - dynlib: libname, importc: "LLVMPreferredAlignmentOfGlobal".} - #* Computes the structure element that contains the byte offset for a target. - # See the method llvm::StructLayout::getElementContainingOffset. -proc LLVMElementAtOffset*(para1: LLVMTargetDataRef, StructTy: LLVMTypeRef, - Offset: qword): dword{.cdecl, dynlib: libname, - importc: "LLVMElementAtOffset".} - #* Computes the byte offset of the indexed struct element for a target. - # See the method llvm::StructLayout::getElementContainingOffset. -proc LLVMOffsetOfElement*(para1: LLVMTargetDataRef, StructTy: LLVMTypeRef, - Element: dword): qword{.cdecl, dynlib: libname, - importc: "LLVMOffsetOfElement".} - #* Struct layouts are speculatively cached. If a TargetDataRef is alive when - # types are being refined and removed, this method must be called whenever a - # struct type is removed to avoid a dangling pointer in this cache. - # See the method llvm::TargetData::InvalidateStructLayoutInfo. -proc LLVMInvalidateStructLayout*(para1: LLVMTargetDataRef, StructTy: LLVMTypeRef){. - cdecl, dynlib: libname, importc: "LLVMInvalidateStructLayout".} - #* Deallocates a TargetData. - # See the destructor llvm::TargetData::~TargetData. -proc LLVMDisposeTargetData*(para1: LLVMTargetDataRef){.cdecl, dynlib: libname, - importc: "LLVMDisposeTargetData".} - # ExecutionEngine.h -proc LLVMLinkInJIT*(){.cdecl, dynlib: libname, importc: "LLVMLinkInJIT".} -proc LLVMLinkInInterpreter*(){.cdecl, dynlib: libname, - importc: "LLVMLinkInInterpreter".} -type - LLVMGenericValueRef* = LLVMOpaqueGenericValue - LLVMExecutionEngineRef* = LLVMOpaqueExecutionEngine #===-- Operations on generic values --------------------------------------=== - -proc LLVMCreateGenericValueOfInt*(Ty: LLVMTypeRef, N: qword, IsSigned: int32): LLVMGenericValueRef{. - cdecl, dynlib: libname, importc: "LLVMCreateGenericValueOfInt".} -proc LLVMCreateGenericValueOfPointer*(P: pointer): LLVMGenericValueRef{.cdecl, - dynlib: libname, importc: "LLVMCreateGenericValueOfPointer".} -proc LLVMCreateGenericValueOfFloat*(Ty: LLVMTypeRef, N: float64): LLVMGenericValueRef{. - cdecl, dynlib: libname, importc: "LLVMCreateGenericValueOfFloat".} -proc LLVMGenericValueIntWidth*(GenValRef: LLVMGenericValueRef): dword{.cdecl, - dynlib: libname, importc: "LLVMGenericValueIntWidth".} -proc LLVMGenericValueToInt*(GenVal: LLVMGenericValueRef, IsSigned: int32): qword{. - cdecl, dynlib: libname, importc: "LLVMGenericValueToInt".} -proc LLVMGenericValueToPointer*(GenVal: LLVMGenericValueRef): pointer{.cdecl, - dynlib: libname, importc: "LLVMGenericValueToPointer".} -proc LLVMGenericValueToFloat*(TyRef: LLVMTypeRef, GenVal: LLVMGenericValueRef): float64{. - cdecl, dynlib: libname, importc: "LLVMGenericValueToFloat".} -proc LLVMDisposeGenericValue*(GenVal: LLVMGenericValueRef){.cdecl, - dynlib: libname, importc: "LLVMDisposeGenericValue".} - #===-- Operations on execution engines -----------------------------------=== -proc LLVMCreateExecutionEngine*(OutEE: pLLVMExecutionEngineRef, - MP: LLVMModuleProviderRef, OutError: Ppchar): int32{. - cdecl, dynlib: libname, importc: "LLVMCreateExecutionEngine".} -proc LLVMCreateInterpreter*(OutInterp: pLLVMExecutionEngineRef, - MP: LLVMModuleProviderRef, OutError: Ppchar): int32{. - cdecl, dynlib: libname, importc: "LLVMCreateInterpreter".} -proc LLVMCreateJITCompiler*(OutJIT: pLLVMExecutionEngineRef, - MP: LLVMModuleProviderRef, OptLevel: dword, - OutError: Ppchar): int32{.cdecl, dynlib: libname, - importc: "LLVMCreateJITCompiler".} -proc LLVMDisposeExecutionEngine*(EE: LLVMExecutionEngineRef){.cdecl, - dynlib: libname, importc: "LLVMDisposeExecutionEngine".} -proc LLVMRunStaticConstructors*(EE: LLVMExecutionEngineRef){.cdecl, - dynlib: libname, importc: "LLVMRunStaticConstructors".} -proc LLVMRunStaticDestructors*(EE: LLVMExecutionEngineRef){.cdecl, - dynlib: libname, importc: "LLVMRunStaticDestructors".} - # Const before declarator ignored - # Const before declarator ignored -proc LLVMRunFunctionAsMain*(EE: LLVMExecutionEngineRef, F: LLVMValueRef, - ArgC: dword, ArgV: Ppchar, EnvP: Ppchar): int32{. - cdecl, dynlib: libname, importc: "LLVMRunFunctionAsMain".} -proc LLVMRunFunction*(EE: LLVMExecutionEngineRef, F: LLVMValueRef, - NumArgs: dword, Args: pLLVMGenericValueRef): LLVMGenericValueRef{. - cdecl, dynlib: libname, importc: "LLVMRunFunction".} -proc LLVMFreeMachineCodeForFunction*(EE: LLVMExecutionEngineRef, F: LLVMValueRef){. - cdecl, dynlib: libname, importc: "LLVMFreeMachineCodeForFunction".} -proc LLVMAddModuleProvider*(EE: LLVMExecutionEngineRef, - MP: LLVMModuleProviderRef){.cdecl, dynlib: libname, - importc: "LLVMAddModuleProvider".} -proc LLVMRemoveModuleProvider*(EE: LLVMExecutionEngineRef, - MP: LLVMModuleProviderRef, - OutMod: pLLVMModuleRef, OutError: Ppchar): int32{. - cdecl, dynlib: libname, importc: "LLVMRemoveModuleProvider".} -proc LLVMFindFunction*(EE: LLVMExecutionEngineRef, Name: cstring, - OutFn: pLLVMValueRef): int32{.cdecl, dynlib: libname, - importc: "LLVMFindFunction".} -proc LLVMGetExecutionEngineTargetData*(EE: LLVMExecutionEngineRef): LLVMTargetDataRef{. - cdecl, dynlib: libname, importc: "LLVMGetExecutionEngineTargetData".} -proc LLVMAddGlobalMapping*(EE: LLVMExecutionEngineRef, Global: LLVMValueRef, - theAddr: pointer){.cdecl, dynlib: libname, - importc: "LLVMAddGlobalMapping".} -proc LLVMGetPointerToGlobal*(EE: LLVMExecutionEngineRef, Global: LLVMValueRef): pointer{. - cdecl, dynlib: libname, importc: "LLVMGetPointerToGlobal".} - # LinkTimeOptimizer.h - #/ This provides a dummy type for pointers to the LTO object. -type - llvm_lto_t* = pointer #/ This provides a C-visible enumerator to manage status codes. - #/ This should map exactly onto the C++ enumerator LTOStatus. - # Added C-specific error codes - llvm_lto_status* = enum - LLVM_LTO_UNKNOWN, LLVM_LTO_OPT_SUCCESS, LLVM_LTO_READ_SUCCESS, - LLVM_LTO_READ_FAILURE, LLVM_LTO_WRITE_FAILURE, LLVM_LTO_NO_TARGET, - LLVM_LTO_NO_WORK, LLVM_LTO_MODULE_MERGE_FAILURE, LLVM_LTO_ASM_FAILURE, - LLVM_LTO_NULL_OBJECT - llvm_lto_status_t* = llvm_lto_status #/ This provides C interface to initialize link time optimizer. This allows - #/ linker to use dlopen() interface to dynamically load LinkTimeOptimizer. - #/ extern "C" helps, because dlopen() interface uses name to find the symbol. - -proc llvm_create_optimizer*(): llvm_lto_t{.cdecl, dynlib: libname, - importc: "llvm_create_optimizer".} -proc llvm_destroy_optimizer*(lto: llvm_lto_t){.cdecl, dynlib: libname, - importc: "llvm_destroy_optimizer".} -proc llvm_read_object_file*(lto: llvm_lto_t, input_filename: cstring): llvm_lto_status_t{. - cdecl, dynlib: libname, importc: "llvm_read_object_file".} -proc llvm_optimize_modules*(lto: llvm_lto_t, output_filename: cstring): llvm_lto_status_t{. - cdecl, dynlib: libname, importc: "llvm_optimize_modules".} - # lto.h -const - LTO_API_VERSION* = 3 # log2 of alignment - -type - lto_symbol_attributes* = enum - LTO_SYMBOL_ALIGNMENT_MASK = 0x0000001F, - LTO_SYMBOL_PERMISSIONS_MASK = 0x000000E0, - LTO_SYMBOL_PERMISSIONS_CODE = 0x000000A0, - LTO_SYMBOL_PERMISSIONS_DATA = 0x000000C0, - LTO_SYMBOL_PERMISSIONS_RODATA = 0x00000080, - LTO_SYMBOL_DEFINITION_MASK = 0x00000700, - LTO_SYMBOL_DEFINITION_REGULAR = 0x00000100, - LTO_SYMBOL_DEFINITION_TENTATIVE = 0x00000200, - LTO_SYMBOL_DEFINITION_WEAK = 0x00000300, - LTO_SYMBOL_DEFINITION_UNDEFINED = 0x00000400, - LTO_SYMBOL_DEFINITION_WEAKUNDEF = 0x00000500, - LTO_SYMBOL_SCOPE_MASK = 0x00003800, LTO_SYMBOL_SCOPE_INTERNAL = 0x00000800, - LTO_SYMBOL_SCOPE_HIDDEN = 0x00001000, - LTO_SYMBOL_SCOPE_PROTECTED = 0x00002000, - LTO_SYMBOL_SCOPE_DEFAULT = 0x00001800 - lto_debug_model* = enum - LTO_DEBUG_MODEL_NONE = 0, LTO_DEBUG_MODEL_DWARF = 1 - lto_codegen_model* = enum #* opaque reference to a loaded object module - LTO_CODEGEN_PIC_MODEL_STATIC = 0, LTO_CODEGEN_PIC_MODEL_DYNAMIC = 1, - LTO_CODEGEN_PIC_MODEL_DYNAMIC_NO_PIC = 2 - lto_module_t* = LTOModule #* opaque reference to a code generator - lto_code_gen_t* = LTOCodeGenerator #* - # * Returns a printable string. - # - -proc lto_get_version*(): cstring{.cdecl, dynlib: libname, - importc: "lto_get_version".} - #* - # * Returns the last error string or NULL if last operation was sucessful. - # -proc lto_get_error_message*(): cstring{.cdecl, dynlib: libname, - importc: "lto_get_error_message".} - #* - # * Checks if a file is a loadable object file. - # -proc lto_module_is_object_file*(path: cstring): bool{.cdecl, dynlib: libname, - importc: "lto_module_is_object_file".} - #* - # * Checks if a file is a loadable object compiled for requested target. - # -proc lto_module_is_object_file_for_target*(path: cstring, - target_triple_prefix: cstring): bool{.cdecl, dynlib: libname, - importc: "lto_module_is_object_file_for_target".} - #* - # * Checks if a buffer is a loadable object file. - # -proc lto_module_is_object_file_in_memory*(mem: pointer, len: size_t): bool{. - cdecl, dynlib: libname, importc: "lto_module_is_object_file_in_memory".} - #* - # * Checks if a buffer is a loadable object compiled for requested target. - # -proc lto_module_is_object_file_in_memory_for_target*(mem: pointer, len: size_t, - target_triple_prefix: cstring): bool{.cdecl, dynlib: libname, - importc: "lto_module_is_object_file_in_memory_for_target".} - #* - # * Loads an object file from disk. - # * Returns NULL on error (check lto_get_error_message() for details). - # -proc lto_module_create*(path: cstring): lto_module_t{.cdecl, dynlib: libname, - importc: "lto_module_create".} - #* - # * Loads an object file from memory. - # * Returns NULL on error (check lto_get_error_message() for details). - # -proc lto_module_create_from_memory*(mem: pointer, len: size_t): lto_module_t{. - cdecl, dynlib: libname, importc: "lto_module_create_from_memory".} - #* - # * Frees all memory internally allocated by the module. - # * Upon return the lto_module_t is no longer valid. - # -proc lto_module_dispose*(module: lto_module_t){.cdecl, dynlib: libname, - importc: "lto_module_dispose".} - #* - # * Returns triple string which the object module was compiled under. - # -proc lto_module_get_target_triple*(module: lto_module_t): cstring{.cdecl, - dynlib: libname, importc: "lto_module_get_target_triple".} - #* - # * Returns the number of symbols in the object module. - # -proc lto_module_get_num_symbols*(module: lto_module_t): dword{.cdecl, - dynlib: libname, importc: "lto_module_get_num_symbols".} - #* - # * Returns the name of the ith symbol in the object module. - # -proc lto_module_get_symbol_name*(module: lto_module_t, index: dword): cstring{. - cdecl, dynlib: libname, importc: "lto_module_get_symbol_name".} - #* - # * Returns the attributes of the ith symbol in the object module. - # -proc lto_module_get_symbol_attribute*(module: lto_module_t, index: dword): lto_symbol_attributes{. - cdecl, dynlib: libname, importc: "lto_module_get_symbol_attribute".} - #* - # * Instantiates a code generator. - # * Returns NULL on error (check lto_get_error_message() for details). - # -proc lto_codegen_create*(): lto_code_gen_t{.cdecl, dynlib: libname, - importc: "lto_codegen_create".} - #* - # * Frees all code generator and all memory it internally allocated. - # * Upon return the lto_code_gen_t is no longer valid. - # -proc lto_codegen_dispose*(para1: lto_code_gen_t){.cdecl, dynlib: libname, - importc: "lto_codegen_dispose".} - #* - # * Add an object module to the set of modules for which code will be generated. - # * Returns true on error (check lto_get_error_message() for details). - # -proc lto_codegen_add_module*(cg: lto_code_gen_t, module: lto_module_t): bool{. - cdecl, dynlib: libname, importc: "lto_codegen_add_module".} - #* - # * Sets if debug info should be generated. - # * Returns true on error (check lto_get_error_message() for details). - # -proc lto_codegen_set_debug_model*(cg: lto_code_gen_t, para2: lto_debug_model): bool{. - cdecl, dynlib: libname, importc: "lto_codegen_set_debug_model".} - #* - # * Sets which PIC code model to generated. - # * Returns true on error (check lto_get_error_message() for details). - # -proc lto_codegen_set_pic_model*(cg: lto_code_gen_t, para2: lto_codegen_model): bool{. - cdecl, dynlib: libname, importc: "lto_codegen_set_pic_model".} - #* - # * Sets the location of the "gcc" to run. If not set, libLTO will search for - # * "gcc" on the path. - # -proc lto_codegen_set_gcc_path*(cg: lto_code_gen_t, path: cstring){.cdecl, - dynlib: libname, importc: "lto_codegen_set_gcc_path".} - #* - # * Sets the location of the assembler tool to run. If not set, libLTO - # * will use gcc to invoke the assembler. - # -proc lto_codegen_set_assembler_path*(cg: lto_code_gen_t, path: cstring){.cdecl, - dynlib: libname, importc: "lto_codegen_set_assembler_path".} - #* - # * Adds to a list of all global symbols that must exist in the final - # * generated code. If a function is not listed, it might be - # * inlined into every usage and optimized away. - # -proc lto_codegen_add_must_preserve_symbol*(cg: lto_code_gen_t, symbol: cstring){. - cdecl, dynlib: libname, importc: "lto_codegen_add_must_preserve_symbol".} - #* - # * Writes a new object file at the specified path that contains the - # * merged contents of all modules added so far. - # * Returns true on error (check lto_get_error_message() for details). - # -proc lto_codegen_write_merged_modules*(cg: lto_code_gen_t, path: cstring): bool{. - cdecl, dynlib: libname, importc: "lto_codegen_write_merged_modules".} - #* - # * Generates code for all added modules into one native object file. - # * On sucess returns a pointer to a generated mach-o/ELF buffer and - # * length set to the buffer size. The buffer is owned by the - # * lto_code_gen_t and will be freed when lto_codegen_dispose() - # * is called, or lto_codegen_compile() is called again. - # * On failure, returns NULL (check lto_get_error_message() for details). - # -proc lto_codegen_compile*(cg: lto_code_gen_t, len: var int): pointer{.cdecl, - dynlib: libname, importc: "lto_codegen_compile".} - #* - # * Sets options to help debug codegen bugs. - # -proc lto_codegen_debug_options*(cg: lto_code_gen_t, para2: cstring){.cdecl, - dynlib: libname, importc: "lto_codegen_debug_options".} -# implementation diff --git a/nim/ast.pas b/nim/ast.pas deleted file mode 100755 index 0079d755cf..0000000000 --- a/nim/ast.pas +++ /dev/null @@ -1,1436 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ast; - -// abstract syntax tree + symbol table - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, msgs, nhashes, - nversion, options, strutils, crc, ropes, idents, lists; - -const - ImportTablePos = 0; - ModuleTablePos = 1; - -type - TCallingConvention = ( - ccDefault, // proc has no explicit calling convention - ccStdCall, // procedure is stdcall - ccCDecl, // cdecl - ccSafeCall, // safecall - ccSysCall, // system call - ccInline, // proc should be inlined - ccNoInline, // proc should not be inlined - ccFastCall, // fastcall (pass parameters in registers) - ccClosure, // proc has a closure - ccNoConvention // needed for generating proper C procs sometimes - ); - -const - CallingConvToStr: array [TCallingConvention] of string = ( - '', 'stdcall', 'cdecl', 'safecall', 'syscall', 'inline', 'noinline', - 'fastcall', 'closure', 'noconv'); - -(*[[[cog -def toEnum(name, elems, prefixlen=0): - body = "" - strs = "" - prefix = "" - counter = 0 - for e in elems: - if counter % 4 == 0: prefix = "\n " - else: prefix = "" - body = body + prefix + e + ', ' - strs = strs + prefix + "'%s', " % e[prefixlen:] - counter = counter + 1 - - return ("type\n T%s = (%s);\n T%ss = set of T%s;\n" - % (name, body[:-2], name, name), - "const\n %sToStr: array [T%s] of string = (%s);\n" - % (name, name, strs[:-2])) - -enums = eval(open("data/ast.yml").read()) -for key, val in enums.items(): - (a, b) = toEnum(key, val) - cog.out(a) - cog.out(b) -]]]*) -type - TNodeKind = ( - nkNone, nkEmpty, nkIdent, nkSym, - nkType, nkCharLit, nkIntLit, nkInt8Lit, - nkInt16Lit, nkInt32Lit, nkInt64Lit, nkFloatLit, - nkFloat32Lit, nkFloat64Lit, nkStrLit, nkRStrLit, - nkTripleStrLit, nkMetaNode, nkNilLit, nkDotCall, - nkCommand, nkCall, nkCallStrLit, nkExprEqExpr, - nkExprColonExpr, nkIdentDefs, nkVarTuple, nkInfix, - nkPrefix, nkPostfix, nkPar, nkCurly, - nkBracket, nkBracketExpr, nkPragmaExpr, nkRange, - nkDotExpr, nkCheckedFieldExpr, nkDerefExpr, nkIfExpr, - nkElifExpr, nkElseExpr, nkLambda, nkAccQuoted, - nkTableConstr, nkBind, nkSymChoice, nkHiddenStdConv, - nkHiddenSubConv, nkHiddenCallConv, nkConv, nkCast, - nkAddr, nkHiddenAddr, nkHiddenDeref, nkObjDownConv, - nkObjUpConv, nkChckRangeF, nkChckRange64, nkChckRange, - nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkAsgn, - nkFastAsgn, nkGenericParams, nkFormalParams, nkOfInherit, - nkModule, nkProcDef, nkMethodDef, nkConverterDef, - nkMacroDef, nkTemplateDef, nkIteratorDef, nkOfBranch, - nkElifBranch, nkExceptBranch, nkElse, nkMacroStmt, - nkAsmStmt, nkPragma, nkIfStmt, nkWhenStmt, - nkForStmt, nkWhileStmt, nkCaseStmt, nkVarSection, - nkConstSection, nkConstDef, nkTypeSection, nkTypeDef, - nkYieldStmt, nkTryStmt, nkFinally, nkRaiseStmt, - nkReturnStmt, nkBreakStmt, nkContinueStmt, nkBlockStmt, - nkDiscardStmt, nkStmtList, nkImportStmt, nkFromStmt, - nkIncludeStmt, nkCommentStmt, nkStmtListExpr, nkBlockExpr, - nkStmtListType, nkBlockType, nkTypeOfExpr, nkObjectTy, - nkTupleTy, nkRecList, nkRecCase, nkRecWhen, - nkRefTy, nkPtrTy, nkVarTy, nkDistinctTy, - nkProcTy, nkEnumTy, nkEnumFieldDef, nkReturnToken); - TNodeKinds = set of TNodeKind; -const - NodeKindToStr: array [TNodeKind] of string = ( - 'nkNone', 'nkEmpty', 'nkIdent', 'nkSym', - 'nkType', 'nkCharLit', 'nkIntLit', 'nkInt8Lit', - 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', 'nkFloatLit', - 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', 'nkRStrLit', - 'nkTripleStrLit', 'nkMetaNode', 'nkNilLit', 'nkDotCall', - 'nkCommand', 'nkCall', 'nkCallStrLit', 'nkExprEqExpr', - 'nkExprColonExpr', 'nkIdentDefs', 'nkVarTuple', 'nkInfix', - 'nkPrefix', 'nkPostfix', 'nkPar', 'nkCurly', - 'nkBracket', 'nkBracketExpr', 'nkPragmaExpr', 'nkRange', - 'nkDotExpr', 'nkCheckedFieldExpr', 'nkDerefExpr', 'nkIfExpr', - 'nkElifExpr', 'nkElseExpr', 'nkLambda', 'nkAccQuoted', - 'nkTableConstr', 'nkBind', 'nkSymChoice', 'nkHiddenStdConv', - 'nkHiddenSubConv', 'nkHiddenCallConv', 'nkConv', 'nkCast', - 'nkAddr', 'nkHiddenAddr', 'nkHiddenDeref', 'nkObjDownConv', - 'nkObjUpConv', 'nkChckRangeF', 'nkChckRange64', 'nkChckRange', - 'nkStringToCString', 'nkCStringToString', 'nkPassAsOpenArray', 'nkAsgn', - 'nkFastAsgn', 'nkGenericParams', 'nkFormalParams', 'nkOfInherit', - 'nkModule', 'nkProcDef', 'nkMethodDef', 'nkConverterDef', - 'nkMacroDef', 'nkTemplateDef', 'nkIteratorDef', 'nkOfBranch', - 'nkElifBranch', 'nkExceptBranch', 'nkElse', 'nkMacroStmt', - 'nkAsmStmt', 'nkPragma', 'nkIfStmt', 'nkWhenStmt', - 'nkForStmt', 'nkWhileStmt', 'nkCaseStmt', 'nkVarSection', - 'nkConstSection', 'nkConstDef', 'nkTypeSection', 'nkTypeDef', - 'nkYieldStmt', 'nkTryStmt', 'nkFinally', 'nkRaiseStmt', - 'nkReturnStmt', 'nkBreakStmt', 'nkContinueStmt', 'nkBlockStmt', - 'nkDiscardStmt', 'nkStmtList', 'nkImportStmt', 'nkFromStmt', - 'nkIncludeStmt', 'nkCommentStmt', 'nkStmtListExpr', 'nkBlockExpr', - 'nkStmtListType', 'nkBlockType', 'nkTypeOfExpr', 'nkObjectTy', - 'nkTupleTy', 'nkRecList', 'nkRecCase', 'nkRecWhen', - 'nkRefTy', 'nkPtrTy', 'nkVarTy', 'nkDistinctTy', - 'nkProcTy', 'nkEnumTy', 'nkEnumFieldDef', 'nkReturnToken'); -type - TSymFlag = ( - sfUsed, sfStar, sfMinus, sfInInterface, - sfFromGeneric, sfGlobal, sfForward, sfImportc, - sfExportc, sfVolatile, sfRegister, sfPure, - sfResult, sfNoSideEffect, sfSideEffect, sfMainModule, - sfSystemModule, sfNoReturn, sfAddrTaken, sfCompilerProc, - sfProcvar, sfDiscriminant, sfDeprecated, sfInClosure, - sfTypeCheck, sfCompileTime, sfThreadVar, sfMerge, - sfDeadCodeElim, sfBorrow); - TSymFlags = set of TSymFlag; -const - SymFlagToStr: array [TSymFlag] of string = ( - 'sfUsed', 'sfStar', 'sfMinus', 'sfInInterface', - 'sfFromGeneric', 'sfGlobal', 'sfForward', 'sfImportc', - 'sfExportc', 'sfVolatile', 'sfRegister', 'sfPure', - 'sfResult', 'sfNoSideEffect', 'sfSideEffect', 'sfMainModule', - 'sfSystemModule', 'sfNoReturn', 'sfAddrTaken', 'sfCompilerProc', - 'sfProcvar', 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', - 'sfTypeCheck', 'sfCompileTime', 'sfThreadVar', 'sfMerge', - 'sfDeadCodeElim', 'sfBorrow'); -type - TTypeKind = ( - tyNone, tyBool, tyChar, tyEmpty, - tyArrayConstr, tyNil, tyExpr, tyStmt, - tyTypeDesc, tyGenericInvokation, tyGenericBody, tyGenericInst, - tyGenericParam, tyDistinct, tyEnum, tyOrdinal, - tyArray, tyObject, tyTuple, tySet, - tyRange, tyPtr, tyRef, tyVar, - tySequence, tyProc, tyPointer, tyOpenArray, - tyString, tyCString, tyForward, tyInt, - tyInt8, tyInt16, tyInt32, tyInt64, - tyFloat, tyFloat32, tyFloat64, tyFloat128); - TTypeKinds = set of TTypeKind; -const - TypeKindToStr: array [TTypeKind] of string = ( - 'tyNone', 'tyBool', 'tyChar', 'tyEmpty', - 'tyArrayConstr', 'tyNil', 'tyExpr', 'tyStmt', - 'tyTypeDesc', 'tyGenericInvokation', 'tyGenericBody', 'tyGenericInst', - 'tyGenericParam', 'tyDistinct', 'tyEnum', 'tyOrdinal', - 'tyArray', 'tyObject', 'tyTuple', 'tySet', - 'tyRange', 'tyPtr', 'tyRef', 'tyVar', - 'tySequence', 'tyProc', 'tyPointer', 'tyOpenArray', - 'tyString', 'tyCString', 'tyForward', 'tyInt', - 'tyInt8', 'tyInt16', 'tyInt32', 'tyInt64', - 'tyFloat', 'tyFloat32', 'tyFloat64', 'tyFloat128'); -type - TNodeFlag = ( - nfNone, nfBase2, nfBase8, nfBase16, - nfAllConst, nfTransf, nfSem); - TNodeFlags = set of TNodeFlag; -const - NodeFlagToStr: array [TNodeFlag] of string = ( - 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', - 'nfAllConst', 'nfTransf', 'nfSem'); -type - TTypeFlag = ( - tfVarargs, tfNoSideEffect, tfFinal, tfAcyclic, - tfEnumHasWholes); - TTypeFlags = set of TTypeFlag; -const - TypeFlagToStr: array [TTypeFlag] of string = ( - 'tfVarargs', 'tfNoSideEffect', 'tfFinal', 'tfAcyclic', - 'tfEnumHasWholes'); -type - TSymKind = ( - skUnknown, skConditional, skDynLib, skParam, - skGenericParam, skTemp, skType, skConst, - skVar, skProc, skMethod, skIterator, - skConverter, skMacro, skTemplate, skField, - skEnumField, skForVar, skModule, skLabel, - skStub); - TSymKinds = set of TSymKind; -const - SymKindToStr: array [TSymKind] of string = ( - 'skUnknown', 'skConditional', 'skDynLib', 'skParam', - 'skGenericParam', 'skTemp', 'skType', 'skConst', - 'skVar', 'skProc', 'skMethod', 'skIterator', - 'skConverter', 'skMacro', 'skTemplate', 'skField', - 'skEnumField', 'skForVar', 'skModule', 'skLabel', - 'skStub'); -{[[[end]]]} - -type - // symbols that require compiler magic: - TMagic = ( - //[[[cog - //magics = eval(open("data/magic.yml").read()) - //for i in range(0, len(magics)-1): - // cog.out("m" + magics[i] + ", ") - // if (i+1) % 6 == 0: cog.outl("") - //cog.outl("m" + magics[-1]) - //]]] - mNone, mDefined, mDefinedInScope, mLow, mHigh, mSizeOf, - mIs, mEcho, mSucc, mPred, mInc, mDec, - mOrd, mNew, mNewFinalize, mNewSeq, mLengthOpenArray, mLengthStr, - mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, - mGCref, mGCunref, mAddI, mSubI, mMulI, mDivI, - mModI, mAddI64, mSubI64, mMulI64, mDivI64, mModI64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, - mMaxI, mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, - mMinI64, mMaxI64, mAddF64, mSubF64, mMulF64, mDivF64, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, mDivU, - mModU, mAddU64, mSubU64, mMulU64, mDivU64, mModU64, - mEqI, mLeI, mLtI, mEqI64, mLeI64, mLtI64, - mEqF64, mLeF64, mLtF64, mLeU, mLtU, mLeU64, - mLtU64, mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, - mLtCh, mEqB, mLeB, mLtB, mEqRef, mEqProc, - mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, - mUnaryMinusI64, mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, - mUnaryPlusI64, mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, - mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, - mToU16, mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, - mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, - mStrToStr, mEnumToStr, mAnd, mOr, mEqStr, mLeStr, - mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, - mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, mConTArr, - mConTT, mSlice, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mInRange, - mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mAssert, - mSwap, mIsNil, mArrToSeq, mCopyStr, mCopyStrLast, mNewString, - mArray, mOpenArray, mRange, mSet, mSeq, mOrdinal, - mInt, mInt8, mInt16, mInt32, mInt64, mFloat, - mFloat32, mFloat64, mBool, mChar, mString, mCstring, - mPointer, mEmptySet, mIntSetBaseType, mNil, mExpr, mStmt, - mTypeDesc, mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, mNimrodMajor, - mNimrodMinor, mNimrodPatch, mCpuEndian, mHostOS, mHostCPU, mNaN, - mInf, mNegInf, mNLen, mNChild, mNSetChild, mNAdd, - mNAddMultiple, mNDel, mNKind, mNIntVal, mNFloatVal, mNSymbol, - mNIdent, mNGetType, mNStrVal, mNSetIntVal, mNSetFloatVal, mNSetSymbol, - mNSetIdent, mNSetType, mNSetStrVal, mNNewNimNode, mNCopyNimNode, mNCopyNimTree, - mStrToIdent, mIdentToStr, mEqIdent, mEqNimrodNode, mNHint, mNWarning, - mNError - //[[[end]]] - ); - -type - PNode = ^TNode; - PNodePtr = ^{@ptr}PNode; - TNodeSeq = array of PNode; - - PType = ^TType; - PSym = ^TSym; - - TNode = {@ignore} record - typ: PType; - strVal: string; - comment: string; - sons: TNodeSeq; // else! - info: TLineInfo; - flags: TNodeFlags; - case Kind: TNodeKind of - nkCharLit, nkIntLit, nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit: - (intVal: biggestInt); - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - (floatVal: biggestFloat); - nkSym: (sym: PSym); - nkIdent: (ident: PIdent); - nkMetaNode: (nodePtr: PNodePtr); - end; - {@emit - record // on a 32bit machine, this takes 32 bytes - typ: PType; - comment: string; - info: TLineInfo; - flags: TNodeFlags; - case Kind: TNodeKind of - nkCharLit..nkInt64Lit: - (intVal: biggestInt); - nkFloatLit..nkFloat64Lit: - (floatVal: biggestFloat); - nkStrLit..nkTripleStrLit: - (strVal: string); - nkSym: (sym: PSym); - nkIdent: (ident: PIdent); - nkMetaNode: (nodePtr: PNodePtr); - else (sons: TNodeSeq); - end acyclic; } - - TSymSeq = array of PSym; - TStrTable = object // a table[PIdent] of PSym - counter: int; - data: TSymSeq; - end; - -// -------------- backend information ------------------------------- - - TLocKind = ( - locNone, // no location - locTemp, // temporary location - locLocalVar, // location is a local variable - locGlobalVar, // location is a global variable - locParam, // location is a parameter - locField, // location is a record field - locArrayElem, // location is an array element - locExpr, // "location" is really an expression - locProc, // location is a proc (an address of a procedure) - locData, // location is a constant - locCall, // location is a call expression - locOther // location is something other - ); - - TLocFlag = ( - lfIndirect, // backend introduced a pointer - lfParamCopy, // backend introduced a parameter copy (LLVM) - lfNoDeepCopy, // no need for a deep copy - lfNoDecl, // do not declare it in C - lfDynamicLib, // link symbol to dynamic library - lfExportLib, // export symbol for dynamic library generation - lfHeader // include header file for symbol - ); - - TStorageLoc = ( - OnUnknown, // location is unknown (stack, heap or static) - OnStack, // location is on hardware stack - OnHeap // location is on heap or global (reference counting needed) - ); - - TLocFlags = set of TLocFlag; - TLoc = record - k: TLocKind; // kind of location - s: TStorageLoc; - flags: TLocFlags; // location's flags - t: PType; // type of location - r: PRope; // rope value of location (code generators) - a: int; // location's "address", i.e. slot for temporaries - end; - -// ---------------- end of backend information ------------------------------ - TLibKind = (libHeader, libDynamic); - TLib = object(lists.TListEntry) // also misused for headers! - kind: TLibKind; - generated: bool; - // needed for the backends: - name: PRope; - path: string; - end; - PLib = ^TLib; - - TSym = object(TIdObj) // symbols are identical iff they have the same - // id! - kind: TSymKind; - magic: TMagic; - typ: PType; - name: PIdent; - info: TLineInfo; - owner: PSym; - flags: TSymFlags; - tab: TStrTable; // interface table for modules - ast: PNode; // syntax tree of proc, iterator, etc.: - // the whole proc including header; this is used - // for easy generation of proper error messages - // for variant record fields the discriminant - // expression - options: TOptions; - position: int; // used for many different things: - // for enum fields its position; - // for fields its offset - // for parameters its position - // for a conditional: - // 1 iff the symbol is defined, else 0 - // (or not in symbol table) - offset: int; // offset of record field - loc: TLoc; - annex: PLib; // additional fields (seldom used, so we use a - // reference to another object to safe space) - end; - - TTypeSeq = array of PType; - TType = object(TIdObj) // types are identical iff they have the - // same id; there may be multiple copies of a type - // in memory! - kind: TTypeKind; // kind of type - sons: TTypeSeq; // base types, etc. - n: PNode; // node for types: - // for range types a nkRange node - // for record types a nkRecord node - // for enum types a list of symbols - // else: unused - flags: TTypeFlags; // flags of the type - callConv: TCallingConvention; // for procs - owner: PSym; // the 'owner' of the type - sym: PSym; // types have the sym associated with them - // it is used for converting types to strings - size: BiggestInt; // the size of the type in bytes - // -1 means that the size is unkwown - align: int; // the type's alignment requirements - containerID: int; // used for type checking of generics - loc: TLoc; - end; - - TPair = record - key, val: PObject; - end; - TPairSeq = array of TPair; - - TTable = record // the same as table[PObject] of PObject - counter: int; - data: TPairSeq; - end; - - TIdPair = record - key: PIdObj; - val: PObject; - end; - TIdPairSeq = array of TIdPair; - - TIdTable = record // the same as table[PIdent] of PObject - counter: int; - data: TIdPairSeq; - end; - - TIdNodePair = record - key: PIdObj; - val: PNode; - end; - TIdNodePairSeq = array of TIdNodePair; - - TIdNodeTable = record // the same as table[PIdObj] of PNode - counter: int; - data: TIdNodePairSeq; - end; - - TNodePair = record - h: THash; // because it is expensive to compute! - key: PNode; - val: int; - end; - TNodePairSeq = array of TNodePair; - - TNodeTable = record // the same as table[PNode] of int; - // nodes are compared by structure! - counter: int; - data: TNodePairSeq; - end; - - TObjectSeq = array of PObject; - - TObjectSet = record - counter: int; - data: TObjectSeq; - end; - -const - OverloadableSyms = {@set}[skProc, skMethod, skIterator, skConverter, - skModule]; - -const // "MagicToStr" array: - MagicToStr: array [TMagic] of string = ( - //[[[cog - //for i in range(0, len(magics)-1): - // cog.out("'%s', " % magics[i]) - // if (i+1) % 6 == 0: cog.outl("") - //cog.outl("'%s'" % magics[-1]) - //]]] - 'None', 'Defined', 'DefinedInScope', 'Low', 'High', 'SizeOf', - 'Is', 'Echo', 'Succ', 'Pred', 'Inc', 'Dec', - 'Ord', 'New', 'NewFinalize', 'NewSeq', 'LengthOpenArray', 'LengthStr', - 'LengthArray', 'LengthSeq', 'Incl', 'Excl', 'Card', 'Chr', - 'GCref', 'GCunref', 'AddI', 'SubI', 'MulI', 'DivI', - 'ModI', 'AddI64', 'SubI64', 'MulI64', 'DivI64', 'ModI64', - 'ShrI', 'ShlI', 'BitandI', 'BitorI', 'BitxorI', 'MinI', - 'MaxI', 'ShrI64', 'ShlI64', 'BitandI64', 'BitorI64', 'BitxorI64', - 'MinI64', 'MaxI64', 'AddF64', 'SubF64', 'MulF64', 'DivF64', - 'MinF64', 'MaxF64', 'AddU', 'SubU', 'MulU', 'DivU', - 'ModU', 'AddU64', 'SubU64', 'MulU64', 'DivU64', 'ModU64', - 'EqI', 'LeI', 'LtI', 'EqI64', 'LeI64', 'LtI64', - 'EqF64', 'LeF64', 'LtF64', 'LeU', 'LtU', 'LeU64', - 'LtU64', 'EqEnum', 'LeEnum', 'LtEnum', 'EqCh', 'LeCh', - 'LtCh', 'EqB', 'LeB', 'LtB', 'EqRef', 'EqProc', - 'EqUntracedRef', 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', - 'UnaryMinusI64', 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', - 'UnaryPlusI64', 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', 'Ze8ToI', - 'Ze8ToI64', 'Ze16ToI', 'Ze16ToI64', 'Ze32ToI64', 'ZeIToI64', 'ToU8', - 'ToU16', 'ToU32', 'ToFloat', 'ToBiggestFloat', 'ToInt', 'ToBiggestInt', - 'CharToStr', 'BoolToStr', 'IntToStr', 'Int64ToStr', 'FloatToStr', 'CStrToStr', - 'StrToStr', 'EnumToStr', 'And', 'Or', 'EqStr', 'LeStr', - 'LtStr', 'EqSet', 'LeSet', 'LtSet', 'MulSet', 'PlusSet', - 'MinusSet', 'SymDiffSet', 'ConStrStr', 'ConArrArr', 'ConArrT', 'ConTArr', - 'ConTT', 'Slice', 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', 'InRange', - 'InSet', 'Repr', 'Exit', 'SetLengthStr', 'SetLengthSeq', 'Assert', - 'Swap', 'IsNil', 'ArrToSeq', 'CopyStr', 'CopyStrLast', 'NewString', - 'Array', 'OpenArray', 'Range', 'Set', 'Seq', 'Ordinal', - 'Int', 'Int8', 'Int16', 'Int32', 'Int64', 'Float', - 'Float32', 'Float64', 'Bool', 'Char', 'String', 'Cstring', - 'Pointer', 'EmptySet', 'IntSetBaseType', 'Nil', 'Expr', 'Stmt', - 'TypeDesc', 'IsMainModule', 'CompileDate', 'CompileTime', 'NimrodVersion', 'NimrodMajor', - 'NimrodMinor', 'NimrodPatch', 'CpuEndian', 'HostOS', 'HostCPU', 'NaN', - 'Inf', 'NegInf', 'NLen', 'NChild', 'NSetChild', 'NAdd', - 'NAddMultiple', 'NDel', 'NKind', 'NIntVal', 'NFloatVal', 'NSymbol', - 'NIdent', 'NGetType', 'NStrVal', 'NSetIntVal', 'NSetFloatVal', 'NSetSymbol', - 'NSetIdent', 'NSetType', 'NSetStrVal', 'NNewNimNode', 'NCopyNimNode', 'NCopyNimTree', - 'StrToIdent', 'IdentToStr', 'EqIdent', 'EqNimrodNode', 'NHint', 'NWarning', - 'NError' - //[[[end]]] - ); - -const - GenericTypes: TTypeKinds = {@set}[ - tyGenericInvokation, - tyGenericBody, - tyGenericParam - ]; - - StructuralEquivTypes: TTypeKinds = {@set}[ - tyArrayConstr, tyNil, tyTuple, - tyArray, - tySet, - tyRange, - tyPtr, tyRef, - tyVar, - tySequence, - tyProc, tyOpenArray - ]; - - ConcreteTypes: TTypeKinds = {@set}[ - // types of the expr that may occur in:: - // var x = expr - tyBool, tyChar, tyEnum, tyArray, tyObject, tySet, tyTuple, - tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, - tyPointer, tyOpenArray, - tyString, tyCString, - tyInt..tyInt64, - tyFloat..tyFloat128 - ]; - ConstantDataTypes: TTypeKinds = {@set}[tyArray, tySet, tyTuple]; - ExportableSymKinds = {@set}[skVar, skConst, skProc, skMethod, skType, - skIterator, skMacro, skTemplate, skConverter, - skStub]; - PersistentNodeFlags: TNodeFlags = {@set}[ - nfBase2, nfBase8, nfBase16, nfAllConst]; - namePos = 0; - genericParamsPos = 1; - paramsPos = 2; - pragmasPos = 3; - codePos = 4; - resultPos = 5; - dispatcherPos = 6; - -var - gId: int; - -function getID: int; -procedure setID(id: int); -procedure IDsynchronizationPoint(idRange: int); - -// creator procs: -function NewSym(symKind: TSymKind; Name: PIdent; owner: PSym): PSym; - -function NewType(kind: TTypeKind; owner: PSym): PType; overload; - -function newNode(kind: TNodeKind): PNode; -function newIntNode(kind: TNodeKind; const intVal: BiggestInt): PNode; -function newIntTypeNode(kind: TNodeKind; const intVal: BiggestInt; - typ: PType): PNode; -function newFloatNode(kind: TNodeKind; const floatVal: BiggestFloat): PNode; -function newStrNode(kind: TNodeKind; const strVal: string): PNode; -function newIdentNode(ident: PIdent; const info: TLineInfo): PNode; -function newSymNode(sym: PSym): PNode; -function newNodeI(kind: TNodeKind; const info: TLineInfo): PNode; -function newNodeIT(kind: TNodeKind; const info: TLineInfo; typ: PType): PNode; - -procedure initStrTable(out x: TStrTable); -procedure initTable(out x: TTable); -procedure initIdTable(out x: TIdTable); -procedure initObjectSet(out x: TObjectSet); -procedure initIdNodeTable(out x: TIdNodeTable); -procedure initNodeTable(out x: TNodeTable); - -// copy procs: -function copyType(t: PType; owner: PSym; keepId: bool): PType; -function copySym(s: PSym; keepId: bool = false): PSym; -procedure assignType(dest, src: PType); - -procedure copyStrTable(out dest: TStrTable; const src: TStrTable); -procedure copyTable(out dest: TTable; const src: TTable); -procedure copyObjectSet(out dest: TObjectSet; const src: TObjectSet); -procedure copyIdTable(var dest: TIdTable; const src: TIdTable); - -function sonsLen(n: PNode): int; overload; -function sonsLen(n: PType): int; overload; - -function lastSon(n: PNode): PNode; overload; -function lastSon(n: PType): PType; overload; -procedure newSons(father: PNode; len: int); overload; -procedure newSons(father: PType; len: int); overload; - -procedure addSon(father, son: PNode); overload; -procedure addSon(father, son: PType); overload; - -procedure addSonIfNotNil(father, n: PNode); -procedure delSon(father: PNode; idx: int); -function hasSonWith(n: PNode; kind: TNodeKind): boolean; -function hasSubnodeWith(n: PNode; kind: TNodeKind): boolean; -procedure replaceSons(n: PNode; oldKind, newKind: TNodeKind); -function sonsNotNil(n: PNode): bool; // for assertions - -function copyNode(src: PNode): PNode; -// does not copy its sons! - -function copyTree(src: PNode): PNode; -// does copy its sons! - -procedure discardSons(father: PNode); - -const // for all kind of hash tables: - GrowthFactor = 2; // must be power of 2, > 0 - StartSize = 8; // must be power of 2, > 0 - -function SameValue(a, b: PNode): Boolean; // a, b are literals -function leValue(a, b: PNode): Boolean; // a <= b? a, b are literals - -function ValueToString(a: PNode): string; - -// ------------- efficient integer sets ------------------------------------- -{@ignore} -type - TBitScalar = int32; // FPC produces wrong code for ``int`` -{@emit -type - TBitScalar = int; } - -const - InitIntSetSize = 8; // must be a power of two! - TrunkShift = 9; - BitsPerTrunk = 1 shl TrunkShift; - // needs to be a power of 2 and divisible by 64 - TrunkMask = BitsPerTrunk-1; - IntsPerTrunk = BitsPerTrunk div (sizeof(TBitScalar)*8); - IntShift = 5+ord(sizeof(TBitScalar)=8); // 5 or 6, depending on int width - IntMask = 1 shl IntShift -1; - -type - PTrunk = ^TTrunk; - TTrunk = record - next: PTrunk; // all nodes are connected with this pointer - key: int; // start address at bit 0 - bits: array [0..IntsPerTrunk-1] of TBitScalar; // a bit vector - end; - TTrunkSeq = array of PTrunk; - TIntSet = record - counter, max: int; - head: PTrunk; - data: TTrunkSeq; - end; - -function IntSetContains(const s: TIntSet; key: int): bool; -procedure IntSetIncl(var s: TIntSet; key: int); -procedure IntSetExcl(var s: TIntSet; key: int); -procedure IntSetInit(var s: TIntSet); - -function IntSetContainsOrIncl(var s: TIntSet; key: int): bool; - - -const - debugIds = false; - -procedure registerID(id: PIdObj); - -implementation - -var - usedIds: TIntSet; - -procedure registerID(id: PIdObj); -begin - if debugIDs then - if (id.id = -1) or IntSetContainsOrIncl(usedIds, id.id) then - InternalError('ID already used: ' + toString(id.id)); -end; - -function getID: int; -begin - result := gId; - inc(gId) -end; - -procedure setId(id: int); -begin - gId := max(gId, id+1); -end; - -procedure IDsynchronizationPoint(idRange: int); -begin - gId := (gId div IdRange +1) * IdRange + 1; -end; - -function leValue(a, b: PNode): Boolean; // a <= b? -begin - result := false; - case a.kind of - nkCharLit..nkInt64Lit: - if b.kind in [nkCharLit..nkInt64Lit] then - result := a.intVal <= b.intVal; - nkFloatLit..nkFloat64Lit: - if b.kind in [nkFloatLit..nkFloat64Lit] then - result := a.floatVal <= b.floatVal; - nkStrLit..nkTripleStrLit: begin - if b.kind in [nkStrLit..nkTripleStrLit] then - result := a.strVal <= b.strVal; - end - else InternalError(a.info, 'leValue'); - end -end; - -function SameValue(a, b: PNode): Boolean; -begin - result := false; - case a.kind of - nkCharLit..nkInt64Lit: - if b.kind in [nkCharLit..nkInt64Lit] then - result := a.intVal = b.intVal; - nkFloatLit..nkFloat64Lit: - if b.kind in [nkFloatLit..nkFloat64Lit] then - result := a.floatVal = b.floatVal; - nkStrLit..nkTripleStrLit: begin - if b.kind in [nkStrLit..nkTripleStrLit] then - result := a.strVal = b.strVal; - end - else InternalError(a.info, 'SameValue'); - end -end; - -function ValueToString(a: PNode): string; -begin - case a.kind of - nkCharLit..nkInt64Lit: - result := ToString(a.intVal); - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - result := toStringF(a.floatVal); - nkStrLit..nkTripleStrLit: - result := a.strVal; - else begin - InternalError(a.info, 'valueToString'); - result := '' - end - end -end; - -procedure copyStrTable(out dest: TStrTable; const src: TStrTable); -var - i: int; -begin - dest.counter := src.counter; -{@emit - if isNil(src.data) then exit; -} - setLength(dest.data, length(src.data)); - for i := 0 to high(src.data) do - dest.data[i] := src.data[i]; -end; - -procedure copyIdTable(var dest: TIdTable; const src: TIdTable); -var - i: int; -begin - dest.counter := src.counter; -{@emit - if isNil(src.data) then exit; -} -{@ignore} - setLength(dest.data, length(src.data)); -{@emit - newSeq(dest.data, length(src.data)); } - for i := 0 to high(src.data) do - dest.data[i] := src.data[i]; -end; - -procedure copyTable(out dest: TTable; const src: TTable); -var - i: int; -begin - dest.counter := src.counter; -{@emit - if isNil(src.data) then exit; -} - setLength(dest.data, length(src.data)); - for i := 0 to high(src.data) do - dest.data[i] := src.data[i]; -end; - -procedure copyObjectSet(out dest: TObjectSet; const src: TObjectSet); -var - i: int; -begin - dest.counter := src.counter; -{@emit - if isNil(src.data) then exit; -} - setLength(dest.data, length(src.data)); - for i := 0 to high(src.data) do - dest.data[i] := src.data[i]; -end; - -procedure discardSons(father: PNode); -begin - father.sons := nil; -end; - -function newNode(kind: TNodeKind): PNode; -begin - new(result); -{@ignore} - FillChar(result^, sizeof(result^), 0); -{@emit} - result.kind := kind; - //result.info := UnknownLineInfo(); inlined: - result.info.fileIndex := int32(-1); - result.info.col := int16(-1); - result.info.line := int16(-1); -end; - -function newIntNode(kind: TNodeKind; const intVal: BiggestInt): PNode; -begin - result := newNode(kind); - result.intVal := intVal -end; - -function newIntTypeNode(kind: TNodeKind; const intVal: BiggestInt; - typ: PType): PNode; -begin - result := newIntNode(kind, intVal); - result.typ := typ; -end; - -function newFloatNode(kind: TNodeKind; const floatVal: BiggestFloat): PNode; -begin - result := newNode(kind); - result.floatVal := floatVal -end; - -function newStrNode(kind: TNodeKind; const strVal: string): PNode; -begin - result := newNode(kind); - result.strVal := strVal -end; - -function newIdentNode(ident: PIdent; const info: TLineInfo): PNode; -begin - result := newNode(nkIdent); - result.ident := ident; - result.info := info; -end; - -function newSymNode(sym: PSym): PNode; -begin - result := newNode(nkSym); - result.sym := sym; - result.typ := sym.typ; - result.info := sym.info; -end; - -function newNodeI(kind: TNodeKind; const info: TLineInfo): PNode; -begin - result := newNode(kind); - result.info := info; -end; - -function newNodeIT(kind: TNodeKind; const info: TLineInfo; typ: PType): PNode; -begin - result := newNode(kind); - result.info := info; - result.typ := typ; -end; - -function NewType(kind: TTypeKind; owner: PSym): PType; overload; -begin - new(result); -{@ignore} - FillChar(result^, sizeof(result^), 0); -{@emit} - result.kind := kind; - result.owner := owner; - result.size := -1; - result.align := 2; // default alignment - result.id := getID(); - if debugIds then RegisterId(result); - //if result.id < 2000 then - // MessageOut(typeKindToStr[kind] +{&} ' has id: ' +{&} toString(result.id)); -end; - -procedure assignType(dest, src: PType); -var - i: int; -begin - dest.kind := src.kind; - dest.flags := src.flags; - dest.callConv := src.callConv; - dest.n := src.n; - dest.size := src.size; - dest.align := src.align; - dest.containerID := src.containerID; - newSons(dest, sonsLen(src)); - for i := 0 to sonsLen(src)-1 do - dest.sons[i] := src.sons[i]; -end; - -function copyType(t: PType; owner: PSym; keepId: bool): PType; -begin - result := newType(t.Kind, owner); - assignType(result, t); - if keepId then result.id := t.id - else begin - result.id := getID(); - if debugIds then RegisterId(result); - end; - result.sym := t.sym; - // backend-info should not be copied -end; - -function copySym(s: PSym; keepId: bool = false): PSym; -begin - result := newSym(s.kind, s.name, s.owner); - result.ast := nil; // BUGFIX; was: s.ast which made problems - result.info := s.info; - result.typ := s.typ; - if keepId then result.id := s.id - else begin - result.id := getID(); - if debugIds then RegisterId(result); - end; - result.flags := s.flags; - result.magic := s.magic; - copyStrTable(result.tab, s.tab); - result.options := s.options; - result.position := s.position; - result.loc := s.loc; - result.annex := s.annex; // BUGFIX -end; - -function NewSym(symKind: TSymKind; Name: PIdent; owner: PSym): PSym; -// generates a symbol and initializes the hash field too -begin - new(result); -{@ignore} - FillChar(result^, sizeof(result^), 0); -{@emit} - result.Name := Name; - result.Kind := symKind; - result.flags := {@set}[]; - result.info := UnknownLineInfo(); - result.options := gOptions; - result.owner := owner; - result.offset := -1; - result.id := getID(); - if debugIds then RegisterId(result); - //if result.id < 2000 then - // MessageOut(name.s +{&} ' has id: ' +{&} toString(result.id)); -end; - -procedure initStrTable(out x: TStrTable); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -procedure initTable(out x: TTable); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -procedure initIdTable(out x: TIdTable); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -procedure initObjectSet(out x: TObjectSet); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -procedure initIdNodeTable(out x: TIdNodeTable); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -procedure initNodeTable(out x: TNodeTable); -begin - x.counter := 0; -{@emit - newSeq(x.data, startSize); } -{@ignore} - setLength(x.data, startSize); - fillChar(x.data[0], length(x.data)*sizeof(x.data[0]), 0); -{@emit} -end; - -function sonsLen(n: PType): int; -begin -{@ignore} - result := length(n.sons); -{@emit - if isNil(n.sons) then result := 0 - else result := length(n.sons); } -end; - -procedure newSons(father: PType; len: int); -var - i, L: int; -begin -{@emit - if isNil(father.sons) then father.sons := @[]; } - L := length(father.sons); - setLength(father.sons, L + len); -{@ignore} - for i := L to L+len-1 do father.sons[i] := nil // needed for FPC -{@emit} -end; - -procedure addSon(father, son: PType); -var - L: int; -begin -{@ignore} - L := length(father.sons); - setLength(father.sons, L+1); - father.sons[L] := son; -{@emit - if isNil(father.sons) then father.sons := @[]; } -{@emit add(father.sons, son); } - assert((father.kind <> tyGenericInvokation) or (son.kind <> tyGenericInst)); -end; - -function sonsLen(n: PNode): int; -begin -{@ignore} - result := length(n.sons); -{@emit - if isNil(n.sons) then result := 0 - else result := length(n.sons); } -end; - -procedure newSons(father: PNode; len: int); -var - i, L: int; -begin -{@emit - if isNil(father.sons) then father.sons := @[]; } - L := length(father.sons); - setLength(father.sons, L + len); -{@ignore} - for i := L to L+len-1 do father.sons[i] := nil // needed for FPC -{@emit} -end; - -procedure addSon(father, son: PNode); -var - L: int; -begin -{@ignore} - L := length(father.sons); - setLength(father.sons, L+1); - father.sons[L] := son; -{@emit - if isNil(father.sons) then father.sons := @[]; } -{@emit add(father.sons, son); } -end; - -procedure delSon(father: PNode; idx: int); -var - len, i: int; -begin -{@emit - if isNil(father.sons) then exit; } - len := sonsLen(father); - for i := idx to len-2 do - father.sons[i] := father.sons[i+1]; - setLength(father.sons, len-1); -end; - -function copyNode(src: PNode): PNode; -// does not copy its sons! -begin - if src = nil then begin result := nil; exit end; - result := newNode(src.kind); - result.info := src.info; - result.typ := src.typ; - result.flags := src.flags * PersistentNodeFlags; - case src.Kind of - nkCharLit..nkInt64Lit: - result.intVal := src.intVal; - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - result.floatVal := src.floatVal; - nkSym: - result.sym := src.sym; - nkIdent: - result.ident := src.ident; - nkStrLit..nkTripleStrLit: - result.strVal := src.strVal; - nkMetaNode: - result.nodePtr := src.nodePtr; - else begin end; - end; -end; - -function copyTree(src: PNode): PNode; -// copy a whole syntax tree; performs deep copying -var - i: int; -begin - if src = nil then begin result := nil; exit end; - result := newNode(src.kind); - result.info := src.info; - result.typ := src.typ; - result.flags := src.flags * PersistentNodeFlags; - case src.Kind of - nkCharLit..nkInt64Lit: - result.intVal := src.intVal; - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - result.floatVal := src.floatVal; - nkSym: - result.sym := src.sym; - nkIdent: - result.ident := src.ident; - nkStrLit..nkTripleStrLit: - result.strVal := src.strVal; - nkMetaNode: - result.nodePtr := src.nodePtr; - else begin - result.sons := nil; - newSons(result, sonsLen(src)); - for i := 0 to sonsLen(src)-1 do - result.sons[i] := copyTree(src.sons[i]); - end; - end -end; - -function lastSon(n: PNode): PNode; -begin - result := n.sons[sonsLen(n)-1]; -end; - -function lastSon(n: PType): PType; -begin - result := n.sons[sonsLen(n)-1]; -end; - -function hasSonWith(n: PNode; kind: TNodeKind): boolean; -var - i: int; -begin - for i := 0 to sonsLen(n)-1 do begin - if (n.sons[i] <> nil) and (n.sons[i].kind = kind) then begin - result := true; exit - end - end; - result := false -end; - -function hasSubnodeWith(n: PNode; kind: TNodeKind): boolean; -var - i: int; -begin - case n.kind of - nkEmpty..nkNilLit: result := n.kind = kind; - else begin - for i := 0 to sonsLen(n)-1 do begin - if (n.sons[i] <> nil) and (n.sons[i].kind = kind) - or hasSubnodeWith(n.sons[i], kind) then begin - result := true; exit - end - end; - result := false - end - end -end; - -procedure replaceSons(n: PNode; oldKind, newKind: TNodeKind); -var - i: int; -begin - for i := 0 to sonsLen(n)-1 do - if n.sons[i].kind = oldKind then n.sons[i].kind := newKind -end; - -function sonsNotNil(n: PNode): bool; -var - i: int; -begin - for i := 0 to sonsLen(n)-1 do - if n.sons[i] = nil then begin result := false; exit end; - result := true -end; - -procedure addSonIfNotNil(father, n: PNode); -begin - if n <> nil then addSon(father, n) -end; - -// ---------------- efficient integer sets ---------------------------------- -// Same algorithm as the one the GC uses - -function mustRehash(len, counter: int): bool; -begin - assert(len > counter); - result := (len * 2 < counter * 3) or (len-counter < 4); -end; - -function nextTry(h, maxHash: THash): THash; -begin - result := ((5*h) + 1) and maxHash; - // For any initial h in range(maxHash), repeating that maxHash times - // generates each int in range(maxHash) exactly once (see any text on - // random-number generation for proof). -end; - -procedure IntSetInit(var s: TIntSet); -begin -{@ignore} - fillChar(s, sizeof(s), 0); -{@emit} -{@ignore} - setLength(s.data, InitIntSetSize); - fillChar(s.data[0], length(s.data)*sizeof(s.data[0]), 0); -{@emit - newSeq(s.data, InitIntSetSize); } - s.max := InitIntSetSize-1; - s.counter := 0; - s.head := nil -end; - -function IntSetGet(const t: TIntSet; key: int): PTrunk; -var - h: int; -begin - h := key and t.max; - while t.data[h] <> nil do begin - if t.data[h].key = key then begin - result := t.data[h]; exit - end; - h := nextTry(h, t.max) - end; - result := nil -end; - -procedure IntSetRawInsert(const t: TIntSet; var data: TTrunkSeq; desc: PTrunk); -var - h: int; -begin - h := desc.key and t.max; - while data[h] <> nil do begin - assert(data[h] <> desc); - h := nextTry(h, t.max) - end; - assert(data[h] = nil); - data[h] := desc -end; - -procedure IntSetEnlarge(var t: TIntSet); -var - n: TTrunkSeq; - i, oldMax: int; -begin - oldMax := t.max; - t.max := ((t.max+1)*2)-1; -{@ignore} - setLength(n, t.max + 1); - fillChar(n[0], length(n)*sizeof(n[0]), 0); -{@emit - newSeq(n, t.max+1); } - for i := 0 to oldmax do - if t.data[i] <> nil then - IntSetRawInsert(t, n, t.data[i]); -{@ignore} - t.data := n; -{@emit - swap(t.data, n); } -end; - -function IntSetPut(var t: TIntSet; key: int): PTrunk; -var - h: int; -begin - h := key and t.max; - while t.data[h] <> nil do begin - if t.data[h].key = key then begin - result := t.data[h]; exit - end; - h := nextTry(h, t.max) - end; - - if mustRehash(t.max+1, t.counter) then IntSetEnlarge(t); - inc(t.counter); - h := key and t.max; - while t.data[h] <> nil do h := nextTry(h, t.max); - assert(t.data[h] = nil); - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.next := t.head; - result.key := key; - t.head := result; - t.data[h] := result; -end; - -// ---------- slightly higher level procs ---------------------------------- - -function IntSetContains(const s: TIntSet; key: int): bool; -var - u: TBitScalar; - t: PTrunk; -begin - t := IntSetGet(s, shru(key, TrunkShift)); - if t <> nil then begin - u := key and TrunkMask; - result := (t.bits[shru(u, IntShift)] and shlu(1, u and IntMask)) <> 0 - end - else - result := false -end; - -procedure IntSetIncl(var s: TIntSet; key: int); -var - u: TBitScalar; - t: PTrunk; -begin - t := IntSetPut(s, shru(key, TrunkShift)); - u := key and TrunkMask; - t.bits[shru(u, IntShift)] := t.bits[shru(u, IntShift)] - or shlu(1, u and IntMask); -end; - -procedure IntSetExcl(var s: TIntSet; key: int); -var - u: TBitScalar; - t: PTrunk; -begin - t := IntSetGet(s, shru(key, TrunkShift)); - if t <> nil then begin - u := key and TrunkMask; - t.bits[shru(u, IntShift)] := t.bits[shru(u, IntShift)] - and not shlu(1, u and IntMask); - end -end; - -function IntSetContainsOrIncl(var s: TIntSet; key: int): bool; -var - u: TBitScalar; - t: PTrunk; -begin - t := IntSetGet(s, shru(key, TrunkShift)); - if t <> nil then begin - u := key and TrunkMask; - result := (t.bits[shru(u, IntShift)] and shlu(1, u and IntMask)) <> 0; - if not result then - t.bits[shru(u, IntShift)] := t.bits[shru(u, IntShift)] - or shlu(1, u and IntMask); - end - else begin - IntSetIncl(s, key); - result := false - end -end; -(* -procedure IntSetDebug(const s: TIntSet); -var - it: PTrunk; - i, j: int; -begin - it := s.head; - while it <> nil do begin - for i := 0 to high(it.bits) do - for j := 0 to BitsPerInt-1 do begin - if (it.bits[j] and (1 shl j)) <> 0 then - MessageOut('Contains key: ' + toString(it.key + i * BitsPerInt + j)); - end; - it := it.next - end -end;*) - -initialization - if debugIDs then IntSetInit(usedIds); -end. diff --git a/nim/astalgo.pas b/nim/astalgo.pas deleted file mode 100755 index 7c1f3ec0bb..0000000000 --- a/nim/astalgo.pas +++ /dev/null @@ -1,1294 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit astalgo; - -// Algorithms for the abstract syntax tree: hash tables, lists -// and sets of nodes are supported. Efficiency is important as -// the data structures here are used in the whole compiler. - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, nhashes, charsets, strutils, options, msgs, ropes, idents; - -function hashNode(p: PObject): THash; - -function treeToYaml(n: PNode; indent: int = 0; maxRecDepth: int = -1): PRope; -// Convert a tree into its YAML representation; this is used by the -// YAML code generator and it is invaluable for debugging purposes. -// If maxRecDepht <> -1 then it won't print the whole graph. - -function typeToYaml(n: PType; indent: int = 0; maxRecDepth: int = -1): PRope; -function symToYaml(n: PSym; indent: int = 0; maxRecDepth: int = -1): PRope; -function optionsToStr(flags: TOptions): PRope; -function lineInfoToStr(const info: TLineInfo): PRope; - -// ----------------------- node sets: --------------------------------------- - -function ObjectSetContains(const t: TObjectSet; obj: PObject): Boolean; -// returns true whether n is in t - -procedure ObjectSetIncl(var t: TObjectSet; obj: PObject); -// include an element n in the table t - -function ObjectSetContainsOrIncl(var t: TObjectSet; obj: PObject): Boolean; - -// more are not needed ... - -// ----------------------- (key, val)-Hashtables ---------------------------- - -procedure TablePut(var t: TTable; key, val: PObject); -function TableGet(const t: TTable; key: PObject): PObject; - -type - TCmpProc = function (key, closure: PObject): Boolean; - // should return true if found -function TableSearch(const t: TTable; key, closure: PObject; - comparator: TCmpProc): PObject; -// return val as soon as comparator returns true; if this never happens, -// nil is returned - -// ----------------------- str table ----------------------------------------- - -function StrTableContains(const t: TStrTable; n: PSym): Boolean; -procedure StrTableAdd(var t: TStrTable; n: PSym); -function StrTableGet(const t: TStrTable; name: PIdent): PSym; -function StrTableIncl(var t: TStrTable; n: PSym): Boolean; -// returns true if n is already in the string table - -// the iterator scheme: -type - TTabIter = record // consider all fields here private - h: THash; // current hash - end; - -function InitTabIter(out ti: TTabIter; const tab: TStrTable): PSym; -function NextIter(var ti: TTabIter; const tab: TStrTable): PSym; -// usage: -// var i: TTabIter; s: PSym; -// s := InitTabIter(i, table); -// while s <> nil do begin -// ... -// s := NextIter(i, table); -// end; - - -type - TIdentIter = record // iterator over all syms with the same identifier - h: THash; // current hash - name: PIdent; - end; - -function InitIdentIter(out ti: TIdentIter; const tab: TStrTable; - s: PIdent): PSym; -function NextIdentIter(var ti: TIdentIter; const tab: TStrTable): PSym; - -// -------------- symbol table ---------------------------------------------- - -// Each TParser object (which represents a module being compiled) has its own -// symbol table. A symbol table is organized as a stack of str tables. The -// stack represents the different scopes. -// Stack pointer: -// 0 imported symbols from other modules -// 1 module level -// 2 proc level -// 3 nested statements -// ... -// - -type - TSymTab = record - tos: Natural; // top of stack - stack: array of TStrTable; - end; - -procedure InitSymTab(out tab: TSymTab); -procedure DeinitSymTab(var tab: TSymTab); - -function SymTabGet(const tab: TSymTab; s: PIdent): PSym; -function SymTabLocalGet(const tab: TSymTab; s: PIdent): PSym; - -procedure SymTabAdd(var tab: TSymTab; e: PSym); -procedure SymTabAddAt(var tab: TSymTab; e: PSym; at: Natural); - -function SymTabAddUnique(var tab: TSymTab; e: PSym): TResult; -function SymTabAddUniqueAt(var tab: TSymTab; e: PSym; at: Natural): TResult; -procedure OpenScope(var tab: TSymTab); -procedure RawCloseScope(var tab: TSymTab); // the real "closeScope" adds some -// checks in parsobj - - -// these are for debugging only: -procedure debug(n: PSym); overload; -procedure debug(n: PType); overload; -procedure debug(n: PNode); overload; - -// --------------------------- ident tables ---------------------------------- - -function IdTableGet(const t: TIdTable; key: PIdObj): PObject; overload; -function IdTableGet(const t: TIdTable; key: int): PObject; overload; -procedure IdTablePut(var t: TIdTable; key: PIdObj; val: PObject); - -function IdTableHasObjectAsKey(const t: TIdTable; key: PIdObj): bool; -// checks if `t` contains the `key` (compared by the pointer value, not only -// `key`'s id) - -function IdNodeTableGet(const t: TIdNodeTable; key: PIdObj): PNode; -procedure IdNodeTablePut(var t: TIdNodeTable; key: PIdObj; val: PNode); - -procedure writeIdNodeTable(const t: TIdNodeTable); - -// --------------------------------------------------------------------------- -function getSymFromList(list: PNode; ident: PIdent; start: int = 0): PSym; -function lookupInRecord(n: PNode; field: PIdent): PSym; - -function getModule(s: PSym): PSym; - -function mustRehash(len, counter: int): bool; -function nextTry(h, maxHash: THash): THash; - -// ------------- table[int, int] --------------------------------------------- -const - InvalidKey = low(int); - -type - TIIPair = record - key, val: int; - end; - TIIPairSeq = array of TIIPair; - TIITable = record // table[int, int] - counter: int; - data: TIIPairSeq; - end; - -procedure initIITable(out x: TIITable); -function IITableGet(const t: TIITable; key: int): int; -procedure IITablePut(var t: TIITable; key, val: int); - -implementation - -function lookupInRecord(n: PNode; field: PIdent): PSym; -var - i: int; -begin - result := nil; - case n.kind of - nkRecList: begin - for i := 0 to sonsLen(n)-1 do begin - result := lookupInRecord(n.sons[i], field); - if result <> nil then exit - end - end; - nkRecCase: begin - if (n.sons[0].kind <> nkSym) then InternalError(n.info, 'lookupInRecord'); - result := lookupInRecord(n.sons[0], field); - if result <> nil then exit; - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkOfBranch, nkElse: begin - result := lookupInRecord(lastSon(n.sons[i]), field); - if result <> nil then exit; - end; - else internalError(n.info, 'lookupInRecord(record case branch)'); - end - end - end; - nkSym: begin - if n.sym.name.id = field.id then result := n.sym; - end; - else internalError(n.info, 'lookupInRecord()'); - end; -end; - -function getModule(s: PSym): PSym; -begin - result := s; - assert((result.kind = skModule) or (result.owner <> result)); - while (result <> nil) and (result.kind <> skModule) do result := result.owner; -end; - -function getSymFromList(list: PNode; ident: PIdent; start: int = 0): PSym; -var - i: int; -begin - for i := start to sonsLen(list)-1 do begin - if list.sons[i].kind <> nkSym then - InternalError(list.info, 'getSymFromList'); - result := list.sons[i].sym; - if result.name.id = ident.id then exit - end; - result := nil -end; - -// ---------------------- helpers -------------------------------------------- - -function hashNode(p: PObject): THash; -begin - result := hashPtr({@cast}pointer(p)) -end; - -function mustRehash(len, counter: int): bool; -begin - assert(len > counter); - result := (len * 2 < counter * 3) or (len-counter < 4); -end; - -// --------------------------------------------------------------------------- - -// convert a node to a string; this is used for YAML code generation and -// debugging: - -function spaces(x: int): PRope; // returns x spaces -begin - result := toRope(repeatChar(x)) -end; - -function toYamlChar(c: Char): string; -begin - case c of - #0..#31, #128..#255: result := '\u' + strutils.toHex(ord(c), 4); - '''', '"', '\': result := '\' + c; - else result := c + '' - end; -end; - -function makeYamlString(const s: string): PRope; -// We have to split long strings into many ropes. Otherwise -// this could trigger InternalError(111). See the ropes module for -// further information. -const - MaxLineLength = 64; -var - i: int; - res: string; -begin - result := nil; - res := '"' + ''; - for i := strStart to length(s)+strStart-1 do begin - if (i-strStart+1) mod MaxLineLength = 0 then begin - addChar(res, '"'); - add(res, nl); - app(result, toRope(res)); - res := '"'+''; // reset - end; - add(res, toYamlChar(s[i])); - end; - addChar(res, '"'); - app(result, toRope(res)); -end; - -function symFlagsToStr(flags: TSymFlags): PRope; -var - x: TSymFlag; -begin - if flags = [] then - result := toRope('[]') - else begin - result := nil; - for x := low(TSymFlag) to high(TSymFlag) do - if x in flags then begin - if result <> nil then app(result, ', '); - app(result, makeYamlString(symFlagToStr[x])); - end; - result := con('['+'', con(result, ']'+'')) - end -end; - -function optionsToStr(flags: TOptions): PRope; -var - x: TOption; -begin - if flags = [] then - result := toRope('[]') - else begin - result := nil; - for x := low(TOption) to high(TOption) do - if x in flags then begin - if result <> nil then app(result, ', '); - app(result, makeYamlString(optionToStr[x])); - end; - result := con('['+'', con(result, ']'+'')) - end -end; - -function typeFlagsToStr(flags: TTypeFlags): PRope; -var - x: TTypeFlag; -begin - if flags = [] then - result := toRope('[]') - else begin - result := nil; - for x := low(TTypeFlag) to high(TTypeFlag) do - if x in flags then begin - if result <> nil then app(result, ', '); - app(result, makeYamlString(typeFlagToStr[x])); - end; - result := con('['+'', con(result, ']'+'')) - end -end; - -function lineInfoToStr(const info: TLineInfo): PRope; -begin - result := ropef('[$1, $2, $3]', [makeYamlString(toFilename(info)), - toRope(toLinenumber(info)), toRope(toColumn(info))]); -end; - -function treeToYamlAux(n: PNode; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; -forward; - -function symToYamlAux(n: PSym; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; forward; -function typeToYamlAux(n: PType; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; forward; - -function strTableToYaml(const n: TStrTable; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; -var - istr: PRope; - mycount, i: int; -begin - istr := spaces(indent+2); - result := toRope('['+''); - mycount := 0; - for i := 0 to high(n.data) do - if n.data[i] <> nil then begin - if mycount > 0 then app(result, ','+''); - appf(result, '$n$1$2', - [istr, symToYamlAux(n.data[i], marker, indent+2, maxRecDepth-1)]); - inc(mycount) - end; - if mycount > 0 then appf(result, '$n$1', [spaces(indent)]); - app(result, ']'+''); - assert(mycount = n.counter); -end; - -function ropeConstr(indent: int; const c: array of PRope): PRope; -// array of (name, value) pairs -var - istr: PRope; - i: int; -begin - istr := spaces(indent+2); - result := toRope('{'+''); - i := 0; - while i <= high(c) do begin - if i > 0 then app(result, ','+''); - appf(result, '$n$1"$2": $3', [istr, c[i], c[i+1]]); - inc(i, 2) - end; - appf(result, '$n$1}', [spaces(indent)]); -end; - -function symToYamlAux(n: PSym; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; -var - ast: PRope; -begin - if n = nil then - result := toRope('null') - else if IntSetContainsOrIncl(marker, n.id) then - result := ropef('"$1 @$2"', [ - toRope(n.name.s), - toRope(strutils.toHex({@cast}TAddress(n), sizeof(n)*2))]) - else begin - ast := treeToYamlAux(n.ast, marker, indent+2, maxRecDepth-1); - result := ropeConstr(indent, [ - toRope('kind'), makeYamlString(symKindToStr[n.kind]), - toRope('name'), makeYamlString(n.name.s), - toRope('typ'), typeToYamlAux(n.typ, marker, indent+2, maxRecDepth-1), - toRope('info'), lineInfoToStr(n.info), - toRope('flags'), symFlagsToStr(n.flags), - toRope('magic'), makeYamlString(MagicToStr[n.magic]), - toRope('ast'), ast, - toRope('options'), optionsToStr(n.options), - toRope('position'), toRope(n.position) - ]); - end - // YYY: backend info? -end; - -function typeToYamlAux(n: PType; var marker: TIntSet; - indent: int; maxRecDepth: int): PRope; -var - i: int; -begin - if n = nil then - result := toRope('null') - else if intSetContainsOrIncl(marker, n.id) then - result := ropef('"$1 @$2"', [ - toRope(typeKindToStr[n.kind]), - toRope(strutils.toHex({@cast}TAddress(n), sizeof(n)*2))]) - else begin - if sonsLen(n) > 0 then begin - result := toRope('['+''); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(result, ','+''); - appf(result, '$n$1$2', - [spaces(indent+4), - typeToYamlAux(n.sons[i], marker, indent + 4, maxRecDepth-1)]); - end; - appf(result, '$n$1]', [spaces(indent+2)]); - end - else - result := toRope('null'); - result := ropeConstr(indent, [ - toRope('kind'), makeYamlString(typeKindToStr[n.kind]), - toRope('sym'), symToYamlAux(n.sym, marker, indent+2, maxRecDepth-1), - toRope('n'+''), treeToYamlAux(n.n, marker, indent+2, maxRecDepth-1), - toRope('flags'), typeFlagsToStr(n.flags), - toRope('callconv'), makeYamlString(CallingConvToStr[n.callConv]), - toRope('size'), toRope(n.size), - toRope('align'), toRope(n.align), - toRope('sons'), result - ]); - end -end; - -function treeToYamlAux(n: PNode; var marker: TIntSet; indent: int; - maxRecDepth: int): PRope; -var - istr: PRope; - i: int; -begin - if n = nil then - result := toRope('null') - else begin - istr := spaces(indent+2); - result := ropef('{$n$1"kind": $2', - [istr, makeYamlString(nodeKindToStr[n.kind])]); - if maxRecDepth <> 0 then begin - appf(result, ',$n$1"info": $2', - [istr, lineInfoToStr(n.info)]); - case n.kind of - nkCharLit..nkInt64Lit: - appf(result, ',$n$1"intVal": $2', [istr, toRope(n.intVal)]); - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ',$n$1"floatVal": $2', [istr, toRopeF(n.floatVal)]); - nkStrLit..nkTripleStrLit: - appf(result, ',$n$1"strVal": $2', [istr, makeYamlString(n.strVal)]); - nkSym: - appf(result, ',$n$1"sym": $2', - [istr, symToYamlAux(n.sym, marker, indent+2, maxRecDepth)]); - - nkIdent: begin - if n.ident <> nil then - appf(result, ',$n$1"ident": $2', - [istr, makeYamlString(n.ident.s)]) - else - appf(result, ',$n$1"ident": null', [istr]) - end - else begin - if sonsLen(n) > 0 then begin - appf(result, ',$n$1"sons": [', [istr]); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(result, ','+''); - appf(result, '$n$1$2', - [spaces(indent+4), - treeToYamlAux(n.sons[i], marker, indent + 4, maxRecDepth-1)]); - end; - appf(result, '$n$1]', [istr]); - end - end - end; - appf(result, ',$n$1"typ": $2', - [istr, typeToYamlAux(n.typ, marker, indent+2, maxRecDepth)]); - end; - appf(result, '$n$1}', [spaces(indent)]); - end -end; - -function treeToYaml(n: PNode; indent: int = 0; maxRecDepth: int = -1): PRope; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := treeToYamlAux(n, marker, indent, maxRecDepth) -end; - -function typeToYaml(n: PType; indent: int = 0; maxRecDepth: int = -1): PRope; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := typeToYamlAux(n, marker, indent, maxRecDepth) -end; - -function symToYaml(n: PSym; indent: int = 0; maxRecDepth: int = -1): PRope; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := symToYamlAux(n, marker, indent, maxRecDepth) -end; - -// these are for debugging only: -function debugType(n: PType): PRope; -var - i: int; -begin - if n = nil then - result := toRope('null') - else begin - result := toRope(typeKindToStr[n.kind]); - if n.sym <> nil then begin - app(result, ' '+''); - app(result, n.sym.name.s); - end; - if (n.kind <> tyString) and (sonsLen(n) > 0) then begin - app(result, '('+''); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(result, ', '); - if n.sons[i] = nil then app(result, 'null') - else app(result, debugType(n.sons[i])); - // app(result, typeKindToStr[n.sons[i].kind]); - end; - app(result, ')'+''); - end - end -end; - -function debugTree(n: PNode; indent: int; maxRecDepth: int): PRope; -var - istr: PRope; - i: int; -begin - if n = nil then - result := toRope('null') - else begin - istr := spaces(indent+2); - result := ropef('{$n$1"kind": $2', - [istr, makeYamlString(nodeKindToStr[n.kind])]); - if maxRecDepth <> 0 then begin - case n.kind of - nkCharLit..nkInt64Lit: - appf(result, ',$n$1"intVal": $2', [istr, toRope(n.intVal)]); - nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ',$n$1"floatVal": $2', - [istr, toRopeF(n.floatVal)]); - nkStrLit..nkTripleStrLit: - appf(result, ',$n$1"strVal": $2', - [istr, makeYamlString(n.strVal)]); - nkSym: - appf(result, ',$n$1"sym": $2_$3', - [istr, toRope(n.sym.name.s), toRope(n.sym.id)]); - - nkIdent: begin - if n.ident <> nil then - appf(result, ',$n$1"ident": $2', - [istr, makeYamlString(n.ident.s)]) - else - appf(result, ',$n$1"ident": null', [istr]) - end - else begin - if sonsLen(n) > 0 then begin - appf(result, ',$n$1"sons": [', [istr]); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(result, ','+''); - appf(result, '$n$1$2', - [spaces(indent+4), - debugTree(n.sons[i], indent + 4, maxRecDepth-1)]); - end; - appf(result, '$n$1]', [istr]); - end - end - end; - end; - appf(result, '$n$1}', [spaces(indent)]); - end -end; - -procedure debug(n: PSym); overload; -begin - writeln(output, ropeToStr(ropef('$1_$2', [toRope(n.name.s), toRope(n.id)]))); -end; - -procedure debug(n: PType); overload; -begin - writeln(output, ropeToStr(debugType(n))); -end; - -procedure debug(n: PNode); overload; -begin - writeln(output, ropeToStr(debugTree(n, 0, 100))); -end; - -// -------------------- node sets -------------------------------------------- - -{@ignore} -const - EmptySeq = nil; -{@emit -const - EmptySeq = @[]; -} - -function nextTry(h, maxHash: THash): THash; -begin - result := ((5*h) + 1) and maxHash; - // For any initial h in range(maxHash), repeating that maxHash times - // generates each int in range(maxHash) exactly once (see any text on - // random-number generation for proof). -end; - -function objectSetContains(const t: TObjectSet; obj: PObject): Boolean; -// returns true whether n is in t -var - h: THash; -begin - h := hashNode(obj) and high(t.data); // start with real hash value - while t.data[h] <> nil do begin - if (t.data[h] = obj) then begin - result := true; exit - end; - h := nextTry(h, high(t.data)) - end; - result := false -end; - -procedure objectSetRawInsert(var data: TObjectSeq; obj: PObject); -var - h: THash; -begin - h := HashNode(obj) and high(data); - while data[h] <> nil do begin - assert(data[h] <> obj); - h := nextTry(h, high(data)) - end; - assert(data[h] = nil); - data[h] := obj; -end; - -procedure objectSetEnlarge(var t: TObjectSet); -var - n: TObjectSeq; - i: int; -begin -{@ignore} - n := emptySeq; - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); -{@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i] <> nil then objectSetRawInsert(n, t.data[i]); -{@ignore} - t.data := n; -{@emit - swap(t.data, n); -} -end; - -procedure objectSetIncl(var t: TObjectSet; obj: PObject); -begin - if mustRehash(length(t.data), t.counter) then objectSetEnlarge(t); - objectSetRawInsert(t.data, obj); - inc(t.counter); -end; - -function objectSetContainsOrIncl(var t: TObjectSet; obj: PObject): Boolean; -// returns true if obj is already in the string table: -var - h: THash; - it: PObject; -begin - h := HashNode(obj) and high(t.data); - repeat - it := t.data[h]; - if it = nil then break; - if it = obj then begin - result := true; exit // found it - end; - h := nextTry(h, high(t.data)) - until false; - if mustRehash(length(t.data), t.counter) then begin - objectSetEnlarge(t); - objectSetRawInsert(t.data, obj); - end - else begin - assert(t.data[h] = nil); - t.data[h] := obj; - end; - inc(t.counter); - result := false -end; - -// --------------------------- node tables ----------------------------------- - -function TableRawGet(const t: TTable; key: PObject): int; -var - h: THash; -begin - h := hashNode(key) and high(t.data); // start with real hash value - while t.data[h].key <> nil do begin - if (t.data[h].key = key) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function TableSearch(const t: TTable; key, closure: PObject; - comparator: TCmpProc): PObject; -var - h: THash; -begin - h := hashNode(key) and high(t.data); // start with real hash value - while t.data[h].key <> nil do begin - if (t.data[h].key = key) then - if comparator(t.data[h].val, closure) then begin // BUGFIX 1 - result := t.data[h].val; exit - end; - h := nextTry(h, high(t.data)) - end; - result := nil -end; - -function TableGet(const t: TTable; key: PObject): PObject; -var - index: int; -begin - index := TableRawGet(t, key); - if index >= 0 then result := t.data[index].val - else result := nil -end; - -procedure TableRawInsert(var data: TPairSeq; key, val: PObject); -var - h: THash; -begin - h := HashNode(key) and high(data); - while data[h].key <> nil do begin - assert(data[h].key <> key); - h := nextTry(h, high(data)) - end; - assert(data[h].key = nil); - data[h].key := key; - data[h].val := val; -end; - -procedure TableEnlarge(var t: TTable); -var - n: TPairSeq; - i: int; -begin -{@ignore} - n := emptySeq; - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); -{@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i].key <> nil then - TableRawInsert(n, t.data[i].key, t.data[i].val); -{@ignore} - t.data := n; -{@emit - swap(t.data, n); -} -end; - -procedure TablePut(var t: TTable; key, val: PObject); -var - index: int; -begin - index := TableRawGet(t, key); - if index >= 0 then - t.data[index].val := val - else begin - if mustRehash(length(t.data), t.counter) then TableEnlarge(t); - TableRawInsert(t.data, key, val); - inc(t.counter) - end; -end; - -// ----------------------- string tables ------------------------------------ - -function StrTableContains(const t: TStrTable; n: PSym): Boolean; -var - h: THash; -begin - h := n.name.h and high(t.data); // start with real hash value - while t.data[h] <> nil do begin - if (t.data[h] = n) then begin - result := true; exit - end; - h := nextTry(h, high(t.data)) - end; - result := false -end; - -procedure StrTableRawInsert(var data: TSymSeq; n: PSym); -var - h: THash; -begin - h := n.name.h and high(data); - while data[h] <> nil do begin - if data[h] = n then - InternalError(n.info, 'StrTableRawInsert: ' + n.name.s); - h := nextTry(h, high(data)) - end; - assert(data[h] = nil); - data[h] := n; -end; - -procedure StrTableEnlarge(var t: TStrTable); -var - n: TSymSeq; - i: int; -begin -{@ignore} - n := emptySeq; - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); -{@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i] <> nil then StrTableRawInsert(n, t.data[i]); -{@ignore} - t.data := n; -{@emit - swap(t.data, n); -} -end; - -procedure StrTableAdd(var t: TStrTable; n: PSym); -begin - if mustRehash(length(t.data), t.counter) then StrTableEnlarge(t); - StrTableRawInsert(t.data, n); - inc(t.counter); -end; - -function StrTableIncl(var t: TStrTable; n: PSym): Boolean; -// returns true if n is already in the string table: -var - h: THash; - it: PSym; -begin - h := n.name.h and high(t.data); - repeat - it := t.data[h]; - if it = nil then break; - if it.name.id = n.name.id then begin - result := true; exit // found it - end; - h := nextTry(h, high(t.data)) - until false; - if mustRehash(length(t.data), t.counter) then begin - StrTableEnlarge(t); - StrTableRawInsert(t.data, n); - end - else begin - assert(t.data[h] = nil); - t.data[h] := n; - end; - inc(t.counter); - result := false -end; - -function StrTableGet(const t: TStrTable; name: PIdent): PSym; -var - h: THash; -begin - h := name.h and high(t.data); - repeat - result := t.data[h]; - if result = nil then break; - if result.name.id = name.id then - break; - h := nextTry(h, high(t.data)) - until false; -end; - -// iterators: - -function InitIdentIter(out ti: TIdentIter; const tab: TStrTable; - s: PIdent): PSym; -begin - ti.h := s.h; - ti.name := s; - if tab.Counter = 0 then result := nil - else result := NextIdentIter(ti, tab) -end; - -function NextIdentIter(var ti: TIdentIter; const tab: TStrTable): PSym; -var - h, start: THash; -begin - h := ti.h and high(tab.data); - start := h; - result := tab.data[h]; - while (result <> nil) do begin - if result.Name.id = ti.name.id then break; - h := nextTry(h, high(tab.data)); - if h = start then begin - result := nil; - break - end; - result := tab.data[h] - end; - ti.h := nextTry(h, high(tab.data)) -end; - -function InitTabIter(out ti: TTabIter; const tab: TStrTable): PSym; -begin - ti.h := 0; // we start by zero ... - if tab.counter = 0 then result := nil // FIX 1: removed endless loop - else result := NextIter(ti, tab) -end; - -function NextIter(var ti: TTabIter; const tab: TStrTable): PSym; -begin - result := nil; - while (ti.h <= high(tab.data)) do begin - result := tab.data[ti.h]; - Inc(ti.h); // ... and increment by one always - if result <> nil then break - end; -end; - -// ------------------- symbol table ------------------------------------------ - -procedure InitSymTab(out tab: TSymTab); -begin - tab.tos := 0; - tab.stack := EmptySeq; -end; - -procedure DeinitSymTab(var tab: TSymTab); -begin - tab.stack := nil; -end; - -function SymTabLocalGet(const tab: TSymTab; s: PIdent): PSym; -begin - result := StrTableGet(tab.stack[tab.tos-1], s) -end; - -function SymTabGet(const tab: TSymTab; s: PIdent): PSym; -var - i: int; -begin - for i := tab.tos-1 downto 0 do begin - result := StrTableGet(tab.stack[i], s); - if result <> nil then exit - end; - result := nil -end; - -procedure SymTabAddAt(var tab: TSymTab; e: PSym; at: Natural); -begin - StrTableAdd(tab.stack[at], e); -end; - -procedure SymTabAdd(var tab: TSymTab; e: PSym); -begin - StrTableAdd(tab.stack[tab.tos-1], e) -end; - -function SymTabAddUniqueAt(var tab: TSymTab; e: PSym; at: Natural): TResult; -begin - if StrTableGet(tab.stack[at], e.name) <> nil then begin - result := Failure; - end - else begin - StrTableAdd(tab.stack[at], e); - result := Success - end -end; - -function SymTabAddUnique(var tab: TSymTab; e: PSym): TResult; -begin - result := SymTabAddUniqueAt(tab, e, tab.tos-1) -end; - -procedure OpenScope(var tab: TSymTab); -begin - if tab.tos >= length(tab.stack) then - SetLength(tab.stack, tab.tos + 1); - initStrTable(tab.stack[tab.tos]); - Inc(tab.tos) -end; - -procedure RawCloseScope(var tab: TSymTab); -begin - Dec(tab.tos); - //tab.stack[tab.tos] := nil; -end; - -// --------------------------- ident tables ---------------------------------- - -function hasEmptySlot(const data: TIdPairSeq): bool; -var - h: THash; -begin - for h := 0 to high(data) do - if data[h].key = nil then begin result := true; exit end; - result := false -end; - -function IdTableRawGet(const t: TIdTable; key: int): int; -var - h: THash; -begin - h := key and high(t.data); // start with real hash value - while t.data[h].key <> nil do begin - if (t.data[h].key.id = key) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function IdTableHasObjectAsKey(const t: TIdTable; key: PIdObj): bool; -var - index: int; -begin - index := IdTableRawGet(t, key.id); - if index >= 0 then result := t.data[index].key = key - else result := false -end; - -function IdTableGet(const t: TIdTable; key: PIdObj): PObject; -var - index: int; -begin - index := IdTableRawGet(t, key.id); - if index >= 0 then result := t.data[index].val - else result := nil -end; - -function IdTableGet(const t: TIdTable; key: int): PObject; -var - index: int; -begin - index := IdTableRawGet(t, key); - if index >= 0 then result := t.data[index].val - else result := nil -end; - -procedure IdTableRawInsert(var data: TIdPairSeq; - key: PIdObj; val: PObject); -var - h: THash; -begin - h := key.id and high(data); - while data[h].key <> nil do begin - assert(data[h].key.id <> key.id); - h := nextTry(h, high(data)) - end; - assert(data[h].key = nil); - data[h].key := key; - data[h].val := val; -end; - -procedure IdTablePut(var t: TIdTable; key: PIdObj; val: PObject); -var - index, i: int; - n: TIdPairSeq; -begin - index := IdTableRawGet(t, key.id); - if index >= 0 then begin - assert(t.data[index].key <> nil); - t.data[index].val := val - end - else begin - if mustRehash(length(t.data), t.counter) then begin - {@ignore} - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); - {@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i].key <> nil then - IdTableRawInsert(n, t.data[i].key, t.data[i].val); - assert(hasEmptySlot(n)); - {@ignore} - t.data := n; - {@emit - swap(t.data, n); - } - end; - IdTableRawInsert(t.data, key, val); - inc(t.counter) - end; -end; - - -procedure writeIdNodeTable(const t: TIdNodeTable); -var - h: THash; -begin -{@ignore} - write('{'+''); - for h := 0 to high(t.data) do - if t.data[h].key <> nil then begin - write(t.data[h].key.id : 5); - end; - writeln('}'+''); -{@emit} -end; - -function IdNodeTableRawGet(const t: TIdNodeTable; key: PIdObj): int; -var - h: THash; -begin - h := key.id and high(t.data); // start with real hash value - while t.data[h].key <> nil do begin - if (t.data[h].key.id = key.id) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function IdNodeTableGet(const t: TIdNodeTable; key: PIdObj): PNode; -var - index: int; -begin - index := IdNodeTableRawGet(t, key); - if index >= 0 then result := t.data[index].val - else result := nil -end; - -procedure IdNodeTableRawInsert(var data: TIdNodePairSeq; - key: PIdObj; val: PNode); -var - h: THash; -begin - h := key.id and high(data); - while data[h].key <> nil do begin - assert(data[h].key.id <> key.id); - h := nextTry(h, high(data)) - end; - assert(data[h].key = nil); - data[h].key := key; - data[h].val := val; -end; - -procedure IdNodeTablePut(var t: TIdNodeTable; key: PIdObj; val: PNode); -var - index, i: int; - n: TIdNodePairSeq; -begin - index := IdNodeTableRawGet(t, key); - if index >= 0 then begin - assert(t.data[index].key <> nil); - t.data[index].val := val - end - else begin - if mustRehash(length(t.data), t.counter) then begin - {@ignore} - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); - {@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i].key <> nil then - IdNodeTableRawInsert(n, t.data[i].key, t.data[i].val); - {@ignore} - t.data := n; - {@emit - swap(t.data, n); - } - end; - IdNodeTableRawInsert(t.data, key, val); - inc(t.counter) - end; -end; - -// ------------- int-to-int-mapping ------------------------------------------ - -procedure initIITable(out x: TIITable); -var - i: int; -begin - x.counter := 0; -{@ignore} - setLength(x.data, startSize); -{@emit - newSeq(x.data, startSize); } - for i := 0 to startSize-1 do x.data[i].key := InvalidKey; -end; - -function IITableRawGet(const t: TIITable; key: int): int; -var - h: THash; -begin - h := key and high(t.data); // start with real hash value - while t.data[h].key <> InvalidKey do begin - if (t.data[h].key = key) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function IITableGet(const t: TIITable; key: int): int; -var - index: int; -begin - index := IITableRawGet(t, key); - if index >= 0 then result := t.data[index].val - else result := InvalidKey -end; - -procedure IITableRawInsert(var data: TIIPairSeq; - key, val: int); -var - h: THash; -begin - h := key and high(data); - while data[h].key <> InvalidKey do begin - assert(data[h].key <> key); - h := nextTry(h, high(data)) - end; - assert(data[h].key = InvalidKey); - data[h].key := key; - data[h].val := val; -end; - -procedure IITablePut(var t: TIITable; key, val: int); -var - index, i: int; - n: TIIPairSeq; -begin - index := IITableRawGet(t, key); - if index >= 0 then begin - assert(t.data[index].key <> InvalidKey); - t.data[index].val := val - end - else begin - if mustRehash(length(t.data), t.counter) then begin - {@ignore} - setLength(n, length(t.data) * growthFactor); - {@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(n) do n[i].key := InvalidKey; - for i := 0 to high(t.data) do - if t.data[i].key <> InvalidKey then - IITableRawInsert(n, t.data[i].key, t.data[i].val); - {@ignore} - t.data := n; - {@emit - swap(t.data, n); } - end; - IITableRawInsert(t.data, key, val); - inc(t.counter) - end; -end; - -end. diff --git a/nim/bitsets.pas b/nim/bitsets.pas deleted file mode 100755 index 78c6d1f364..0000000000 --- a/nim/bitsets.pas +++ /dev/null @@ -1,123 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit bitsets; - -// this unit handles Nimrod sets; it implements bit sets -// the code here should be reused in the Nimrod standard library - -interface - -{$include 'config.inc'} - -{@ignore} -uses - nsystem; -{@emit} - -type - TBitSet = array of Byte; // we use byte here to avoid issues with - // cross-compiling; uint would be more efficient - // however - -const - ElemSize = sizeof(Byte) * 8; - -procedure BitSetInit(out b: TBitSet; len: int); -procedure BitSetUnion(var x: TBitSet; const y: TBitSet); -procedure BitSetDiff(var x: TBitSet; const y: TBitSet); -procedure BitSetSymDiff(var x: TBitSet; const y: TBitSet); -procedure BitSetIntersect(var x: TBitSet; const y: TBitSet); -procedure BitSetIncl(var x: TBitSet; const elem: BiggestInt); -procedure BitSetExcl(var x: TBitSet; const elem: BiggestInt); - -function BitSetIn(const x: TBitSet; const e: BiggestInt): Boolean; -function BitSetEquals(const x, y: TBitSet): Boolean; -function BitSetContains(const x, y: TBitSet): Boolean; - -implementation - -function BitSetIn(const x: TBitSet; const e: BiggestInt): Boolean; -begin - result := (x[int(e div ElemSize)] and toU8(int(1 shl (e mod ElemSize)))) <> toU8(0) -end; - -procedure BitSetIncl(var x: TBitSet; const elem: BiggestInt); -begin - assert(elem >= 0); - x[int(elem div ElemSize)] := x[int(elem div ElemSize)] or - toU8(int(1 shl (elem mod ElemSize))) -end; - -procedure BitSetExcl(var x: TBitSet; const elem: BiggestInt); -begin - x[int(elem div ElemSize)] := x[int(elem div ElemSize)] and - not toU8(int(1 shl (elem mod ElemSize))) -end; - -procedure BitSetInit(out b: TBitSet; len: int); -begin -{@ignore} - setLength(b, len); - fillChar(b[0], length(b)*sizeof(b[0]), 0); -{@emit - newSeq(b, len); -} -end; - -procedure BitSetUnion(var x: TBitSet; const y: TBitSet); -var - i: int; -begin - for i := 0 to high(x) do x[i] := x[i] or y[i] -end; - -procedure BitSetDiff(var x: TBitSet; const y: TBitSet); -var - i: int; -begin - for i := 0 to high(x) do x[i] := x[i] and not y[i] -end; - -procedure BitSetSymDiff(var x: TBitSet; const y: TBitSet); -var - i: int; -begin - for i := 0 to high(x) do x[i] := x[i] xor y[i] -end; - -procedure BitSetIntersect(var x: TBitSet; const y: TBitSet); -var - i: int; -begin - for i := 0 to high(x) do x[i] := x[i] and y[i] -end; - -function BitSetEquals(const x, y: TBitSet): Boolean; -var - i: int; -begin - for i := 0 to high(x) do - if x[i] <> y[i] then begin - result := false; exit; - end; - result := true -end; - -function BitSetContains(const x, y: TBitSet): Boolean; -var - i: int; -begin - for i := 0 to high(x) do - if (x[i] and not y[i]) <> byte(0) then begin - result := false; exit; - end; - result := true -end; - -end. diff --git a/nim/ccgexprs.pas b/nim/ccgexprs.pas deleted file mode 100755 index a5789487af..0000000000 --- a/nim/ccgexprs.pas +++ /dev/null @@ -1,2318 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// -------------------------- constant expressions ------------------------ - -function intLiteral(i: biggestInt): PRope; -begin - if (i > low(int32)) and (i <= high(int32)) then - result := toRope(i) - else if i = low(int32) then - // Nimrod has the same bug for the same reasons :-) - result := toRope('(-2147483647 -1)') - else if i > low(int64) then - result := ropef('IL64($1)', [toRope(i)]) - else - result := toRope('(IL64(-9223372036854775807) - IL64(1))') -end; - -function int32Literal(i: Int): PRope; -begin - if i = int(low(int32)) then - // Nimrod has the same bug for the same reasons :-) - result := toRope('(-2147483647 -1)') - else - result := toRope(i) -end; - -function genHexLiteral(v: PNode): PRope; -// hex literals are unsigned in C -// so we don't generate hex literals any longer. -begin - if not (v.kind in [nkIntLit..nkInt64Lit]) then - internalError(v.info, 'genHexLiteral'); - result := intLiteral(v.intVal) -end; - -function getStrLit(m: BModule; const s: string): PRope; -begin - useMagic(m, 'TGenericSeq'); - result := con('TMP', toRope(getID())); - appf(m.s[cfsData], 'STRING_LITERAL($1, $2, $3);$n', - [result, makeCString(s), ToRope(length(s))]); -end; - -function genLiteral(p: BProc; v: PNode; ty: PType): PRope; overload; -var - f: biggestFloat; - id: int; -begin - if ty = nil then internalError(v.info, 'genLiteral: ty is nil'); - case v.kind of - nkCharLit..nkInt64Lit: begin - case skipTypes(ty, abstractVarRange).kind of - tyChar, tyInt64, tyNil: result := intLiteral(v.intVal); - tyInt8: - result := ropef('((NI8) $1)', [intLiteral(biggestInt(int8(v.intVal)))]); - tyInt16: - result := ropef('((NI16) $1)', [intLiteral(biggestInt(int16(v.intVal)))]); - tyInt32: - result := ropef('((NI32) $1)', [intLiteral(biggestInt(int32(v.intVal)))]); - tyInt: begin - if (v.intVal >= low(int32)) and (v.intVal <= high(int32)) then - result := int32Literal(int32(v.intVal)) - else - result := intLiteral(v.intVal); - end; - tyBool: begin - if v.intVal <> 0 then result := toRope('NIM_TRUE') - else result := toRope('NIM_FALSE'); - end; - else - result := ropef('(($1) $2)', [getTypeDesc(p.module, - skipTypes(ty, abstractVarRange)), intLiteral(v.intVal)]) - end - end; - nkNilLit: - result := toRope('0'+''); - nkStrLit..nkTripleStrLit: begin - if skipTypes(ty, abstractVarRange).kind = tyString then begin - id := NodeTableTestOrSet(p.module.dataCache, v, gid); - if id = gid then begin - // string literal not found in the cache: - useMagic(p.module, 'NimStringDesc'); - result := ropef('((NimStringDesc*) &$1)', - [getStrLit(p.module, v.strVal)]) - end - else - result := ropef('((NimStringDesc*) &TMP$1)', - [toRope(id)]); - end - else - result := makeCString(v.strVal) - end; - nkFloatLit..nkFloat64Lit: begin - f := v.floatVal; - if f <> f then // NAN - result := toRope('NAN') - else if f = 0.0 then - result := toRopeF(f) - else if f = 0.5 * f then - if f > 0.0 then result := toRope('INF') - else result := toRope('-INF') - else - result := toRopeF(f); - end - else begin - InternalError(v.info, 'genLiteral(' +{&} nodeKindToStr[v.kind] +{&} ')'); - result := nil - end - end -end; - -function genLiteral(p: BProc; v: PNode): PRope; overload; -begin - result := genLiteral(p, v, v.typ) -end; - -function bitSetToWord(const s: TBitSet; size: int): BiggestInt; -var - j: int; -begin - result := 0; - if CPU[platform.hostCPU].endian = CPU[targetCPU].endian then begin - for j := 0 to size-1 do - if j < length(s) then - result := result or shlu(Ze64(s[j]), j * 8) - end - else begin - for j := 0 to size-1 do - if j < length(s) then - result := result or shlu(Ze64(s[j]), (Size-1-j) * 8) - end -end; - -function genRawSetData(const cs: TBitSet; size: int): PRope; -var - frmt: TFormatStr; - i: int; -begin - if size > 8 then begin - result := toRope('{' + tnl); - for i := 0 to size-1 do begin - if i < size-1 then begin // not last iteration? - if (i + 1) mod 8 = 0 then frmt := '0x$1,$n' - else frmt := '0x$1, ' - end - else frmt := '0x$1}$n'; - appf(result, frmt, [toRope(toHex(Ze64(cs[i]), 2))]) - end - end - else - result := intLiteral(bitSetToWord(cs, size)) - // result := toRope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) -end; - -function genSetNode(p: BProc; n: PNode): PRope; -var - cs: TBitSet; - size, id: int; -begin - size := int(getSize(n.typ)); - toBitSet(n, cs); - if size > 8 then begin - id := NodeTableTestOrSet(p.module.dataCache, n, gid); - result := con('TMP', toRope(id)); - if id = gid then begin - // not found in cache: - inc(gid); - appf(p.module.s[cfsData], - 'static NIM_CONST $1 $2 = $3;', - [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) - end - end - else - result := genRawSetData(cs, size) -end; - -// --------------------------- assignment generator ----------------------- - -function getStorageLoc(n: PNode): TStorageLoc; -begin - case n.kind of - nkSym: begin - case n.sym.kind of - skParam, skForVar, skTemp: result := OnStack; - skVar: begin - if sfGlobal in n.sym.flags then result := OnHeap - else result := OnStack - end; - else result := OnUnknown; - end - end; - //nkHiddenAddr, nkAddr: - nkDerefExpr, nkHiddenDeref: - case n.sons[0].typ.kind of - tyVar: result := OnUnknown; - tyPtr: result := OnStack; - tyRef: result := OnHeap; - else InternalError(n.info, 'getStorageLoc'); - end; - nkBracketExpr, nkDotExpr, nkObjDownConv, nkObjUpConv: - result := getStorageLoc(n.sons[0]); - else result := OnUnknown; - end -end; - -function rdLoc(const a: TLoc): PRope; // 'read' location (deref if indirect) -begin - result := a.r; - if lfIndirect in a.flags then result := ropef('(*$1)', [result]) -end; - -function addrLoc(const a: TLoc): PRope; -begin - result := a.r; - if not (lfIndirect in a.flags) then result := con('&'+'', result) -end; - -function rdCharLoc(const a: TLoc): PRope; -// read a location that may need a char-cast: -begin - result := rdLoc(a); - if skipTypes(a.t, abstractRange).kind = tyChar then - result := ropef('((NU8)($1))', [result]) -end; - -type - TAssignmentFlag = (needToCopy, needForSubtypeCheck, - afDestIsNil, afDestIsNotNil, - afSrcIsNil, afSrcIsNotNil); - TAssignmentFlags = set of TAssignmentFlag; - -procedure genRefAssign(p: BProc; const dest, src: TLoc; - flags: TAssignmentFlags); -begin - if (dest.s = OnStack) or not (optRefcGC in gGlobalOptions) then - // location is on hardware stack - appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]) - else if dest.s = OnHeap then begin // location is on heap - // now the writer barrier is inlined for performance: - (* - if afSrcIsNotNil in flags then begin - UseMagic(p.module, 'nimGCref'); - appf(p.s[cpsStmts], 'nimGCref($1);$n', [rdLoc(src)]); - end - else if not (afSrcIsNil in flags) then begin - UseMagic(p.module, 'nimGCref'); - appf(p.s[cpsStmts], 'if ($1) nimGCref($1);$n', [rdLoc(src)]); - end; - if afDestIsNotNil in flags then begin - UseMagic(p.module, 'nimGCunref'); - appf(p.s[cpsStmts], 'nimGCunref($1);$n', [rdLoc(dest)]); - end - else if not (afDestIsNil in flags) then begin - UseMagic(p.module, 'nimGCunref'); - appf(p.s[cpsStmts], 'if ($1) nimGCunref($1);$n', [rdLoc(dest)]); - end; - appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); *) - if canFormAcycle(dest.t) then begin - UseMagic(p.module, 'asgnRef'); - appf(p.s[cpsStmts], 'asgnRef((void**) $1, $2);$n', - [addrLoc(dest), rdLoc(src)]) - end - else begin - UseMagic(p.module, 'asgnRefNoCycle'); - appf(p.s[cpsStmts], 'asgnRefNoCycle((void**) $1, $2);$n', - [addrLoc(dest), rdLoc(src)]) - end - end - else begin - UseMagic(p.module, 'unsureAsgnRef'); - appf(p.s[cpsStmts], 'unsureAsgnRef((void**) $1, $2);$n', - [addrLoc(dest), rdLoc(src)]) - end -end; - -procedure genAssignment(p: BProc; const dest, src: TLoc; - flags: TAssignmentFlags); overload; - // This function replaces all other methods for generating - // the assignment operation in C. -var - ty: PType; -begin; - ty := skipTypes(dest.t, abstractVarRange); - case ty.kind of - tyRef: - genRefAssign(p, dest, src, flags); - tySequence: begin - if not (needToCopy in flags) then - genRefAssign(p, dest, src, flags) - else begin - useMagic(p.module, 'genericSeqAssign'); // BUGFIX - appf(p.s[cpsStmts], 'genericSeqAssign($1, $2, $3);$n', - [addrLoc(dest), rdLoc(src), genTypeInfo(p.module, dest.t)]) - end - end; - tyString: begin - if not (needToCopy in flags) then - genRefAssign(p, dest, src, flags) - else begin - useMagic(p.module, 'copyString'); - if (dest.s = OnStack) or not (optRefcGC in gGlobalOptions) then - appf(p.s[cpsStmts], '$1 = copyString($2);$n', - [rdLoc(dest), rdLoc(src)]) - else if dest.s = OnHeap then begin - useMagic(p.module, 'asgnRefNoCycle'); - useMagic(p.module, 'copyString'); // BUGFIX - appf(p.s[cpsStmts], 'asgnRefNoCycle((void**) $1, copyString($2));$n', - [addrLoc(dest), rdLoc(src)]) - end - else begin - useMagic(p.module, 'unsureAsgnRef'); - useMagic(p.module, 'copyString'); // BUGFIX - appf(p.s[cpsStmts], - 'unsureAsgnRef((void**) $1, copyString($2));$n', - [addrLoc(dest), rdLoc(src)]) - end - end - end; - - tyTuple: - if needsComplexAssignment(dest.t) then begin - useMagic(p.module, 'genericAssign'); - appf(p.s[cpsStmts], - 'genericAssign((void*)$1, (void*)$2, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - end - else - appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); - tyArray, tyArrayConstr: - if needsComplexAssignment(dest.t) then begin - useMagic(p.module, 'genericAssign'); - appf(p.s[cpsStmts], - 'genericAssign((void*)$1, (void*)$2, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - end - else - appf(p.s[cpsStmts], - 'memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1));$n', - [rdLoc(dest), rdLoc(src)]); - tyObject: - // XXX: check for subtyping? - if needsComplexAssignment(dest.t) then begin - useMagic(p.module, 'genericAssign'); - appf(p.s[cpsStmts], - 'genericAssign((void*)$1, (void*)$2, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - end - else - appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); - tyOpenArray: begin - // open arrays are always on the stack - really? What if a sequence is - // passed to an open array? - if needsComplexAssignment(dest.t) then begin - useMagic(p.module, 'genericAssignOpenArray'); - appf(p.s[cpsStmts],// XXX: is this correct for arrays? - 'genericAssignOpenArray((void*)$1, (void*)$2, $1Len0, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) - end - else - appf(p.s[cpsStmts], - 'memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len0);$n', - [rdLoc(dest), rdLoc(src)]); - end; - tySet: - if mapType(ty) = ctArray then - appf(p.s[cpsStmts], 'memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n', - [rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))]) - else - appf(p.s[cpsStmts], '$1 = $2;$n', - [rdLoc(dest), rdLoc(src)]); - tyPtr, tyPointer, tyChar, tyBool, tyProc, tyEnum, - tyCString, tyInt..tyFloat128, tyRange: - appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); - else - InternalError('genAssignment(' + typeKindToStr[ty.kind] + ')') - end -end; - -// ------------------------------ expressions ----------------------------- - -procedure expr(p: BProc; e: PNode; var d: TLoc); forward; - -procedure initLocExpr(p: BProc; e: PNode; var result: TLoc); -begin - initLoc(result, locNone, getUniqueType(e.typ), OnUnknown); - expr(p, e, result) -end; - -procedure getDestLoc(p: BProc; var d: TLoc; typ: PType); -begin - if d.k = locNone then getTemp(p, typ, d) -end; - -procedure putLocIntoDest(p: BProc; var d: TLoc; const s: TLoc); -begin - if d.k <> locNone then // need to generate an assignment here - if lfNoDeepCopy in d.flags then - genAssignment(p, d, s, {@set}[]) - else - genAssignment(p, d, s, {@set}[needToCopy]) - else - d := s // ``d`` is free, so fill it with ``s`` -end; - -procedure putIntoDest(p: BProc; var d: TLoc; t: PType; r: PRope); -var - a: TLoc; -begin - if d.k <> locNone then begin // need to generate an assignment here - initLoc(a, locExpr, getUniqueType(t), OnUnknown); - a.r := r; - if lfNoDeepCopy in d.flags then - genAssignment(p, d, a, {@set}[]) - else - genAssignment(p, d, a, {@set}[needToCopy]) - end - else begin // we cannot call initLoc() here as that would overwrite - // the flags field! - d.k := locExpr; - d.t := getUniqueType(t); - d.r := r; - d.a := -1 - end -end; - -procedure binaryStmt(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a, b: TLoc; -begin - if (d.k <> locNone) then InternalError(e.info, 'binaryStmt'); - if magic <> '' then useMagic(p.module, magic); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - appf(p.s[cpsStmts], frmt, [rdLoc(a), rdLoc(b)]); -end; - -procedure unaryStmt(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a: TLoc; -begin - if (d.k <> locNone) then InternalError(e.info, 'unaryStmt'); - if magic <> '' then useMagic(p.module, magic); - InitLocExpr(p, e.sons[1], a); - appf(p.s[cpsStmts], frmt, [rdLoc(a)]); -end; - -procedure binaryStmtChar(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a, b: TLoc; -begin - if (d.k <> locNone) then InternalError(e.info, 'binaryStmtChar'); - if magic <> '' then useMagic(p.module, magic); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - appf(p.s[cpsStmts], frmt, [rdCharLoc(a), rdCharLoc(b)]); -end; - -procedure binaryExpr(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a, b: TLoc; -begin - if magic <> '' then useMagic(p.module, magic); - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdLoc(b)])); -end; - -procedure binaryExprChar(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a, b: TLoc; -begin - if magic <> '' then useMagic(p.module, magic); - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a), rdCharLoc(b)])); -end; - -procedure unaryExpr(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a: TLoc; -begin - if magic <> '' then useMagic(p.module, magic); - InitLocExpr(p, e.sons[1], a); - putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a)])); -end; - -procedure unaryExprChar(p: BProc; e: PNode; var d: TLoc; - const magic, frmt: string); -var - a: TLoc; -begin - if magic <> '' then useMagic(p.module, magic); - InitLocExpr(p, e.sons[1], a); - putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a)])); -end; - -procedure binaryArithOverflow(p: BProc; e: PNode; var d: TLoc; m: TMagic); -const - prc: array [mAddi..mModi64] of string = ( - 'addInt', 'subInt', 'mulInt', 'divInt', 'modInt', - 'addInt64', 'subInt64', 'mulInt64', 'divInt64', 'modInt64' - ); - opr: array [mAddi..mModi64] of string = ( - '+'+'', '-'+'', '*'+'', '/'+'', '%'+'', - '+'+'', '-'+'', '*'+'', '/'+'', '%'+'' - ); -var - a, b: TLoc; - t: PType; -begin - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - t := skipTypes(e.typ, abstractRange); - if getSize(t) >= platform.IntSize then begin - if optOverflowCheck in p.options then begin - useMagic(p.module, prc[m]); - putIntoDest(p, d, e.typ, ropef('$1($2, $3)', - [toRope(prc[m]), rdLoc(a), rdLoc(b)])); - end - else - putIntoDest(p, d, e.typ, ropef('(NI$4)($2 $1 $3)', - [toRope(opr[m]), rdLoc(a), rdLoc(b), toRope(getSize(t)*8)])); - end - else begin - if optOverflowCheck in p.options then begin - useMagic(p.module, 'raiseOverflow'); - if (m = mModI) or (m = mDivI) then begin - useMagic(p.module, 'raiseDivByZero'); - appf(p.s[cpsStmts], 'if (!$1) raiseDivByZero();$n', [rdLoc(b)]); - end; - a.r := ropef('((NI)($2) $1 (NI)($3))', - [toRope(opr[m]), rdLoc(a), rdLoc(b)]); - if d.k = locNone then getTemp(p, getSysType(tyInt), d); - genAssignment(p, d, a, {@set}[]); - appf(p.s[cpsStmts], 'if ($1 < $2 || $1 > $3) raiseOverflow();$n', - [rdLoc(d), intLiteral(firstOrd(t)), intLiteral(lastOrd(t))]); - d.t := e.typ; - d.r := ropef('(NI$1)($2)', [toRope(getSize(t)*8), rdLoc(d)]); - end - else - putIntoDest(p, d, e.typ, ropef('(NI$4)($2 $1 $3)', - [toRope(opr[m]), rdLoc(a), rdLoc(b), toRope(getSize(t)*8)])); - end -end; - -procedure unaryArithOverflow(p: BProc; e: PNode; var d: TLoc; m: TMagic); -const - opr: array [mUnaryMinusI..mAbsI64] of string = ( - '((NI$2)-($1))', // UnaryMinusI - '-($1)', // UnaryMinusI64 - '(NI$2)abs($1)', // AbsI - '($1 > 0? ($1) : -($1))' // AbsI64 - ); -var - a: TLoc; - t: PType; -begin - assert(e.sons[1].typ <> nil); - InitLocExpr(p, e.sons[1], a); - t := skipTypes(e.typ, abstractRange); - if optOverflowCheck in p.options then begin - useMagic(p.module, 'raiseOverflow'); - appf(p.s[cpsStmts], 'if ($1 == $2) raiseOverflow();$n', - [rdLoc(a), intLiteral(firstOrd(t))]); - end; - putIntoDest(p, d, e.typ, ropef(opr[m], [rdLoc(a), toRope(getSize(t)*8)])); -end; - -procedure binaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); -const - binArithTab: array [mShrI..mXor] of string = ( - '(NI$3)((NU$3)($1) >> (NU$3)($2))', // ShrI - '(NI$3)((NU$3)($1) << (NU$3)($2))', // ShlI - '(NI$3)($1 & $2)', // BitandI - '(NI$3)($1 | $2)', // BitorI - '(NI$3)($1 ^ $2)', // BitxorI - '(($1 <= $2) ? $1 : $2)', // MinI - '(($1 >= $2) ? $1 : $2)', // MaxI - '(NI64)((NU64)($1) >> (NU64)($2))', // ShrI64 - '(NI64)((NU64)($1) << (NU64)($2))', // ShlI64 - '($1 & $2)', // BitandI64 - '($1 | $2)', // BitorI64 - '($1 ^ $2)', // BitxorI64 - '(($1 <= $2) ? $1 : $2)', // MinI64 - '(($1 >= $2) ? $1 : $2)', // MaxI64 - - '($1 + $2)', // AddF64 - '($1 - $2)', // SubF64 - '($1 * $2)', // MulF64 - '($1 / $2)', // DivF64 - '(($1 <= $2) ? $1 : $2)', // MinF64 - '(($1 >= $2) ? $1 : $2)', // MaxF64 - - '(NI$3)((NU$3)($1) + (NU$3)($2))', // AddU - '(NI$3)((NU$3)($1) - (NU$3)($2))', // SubU - '(NI$3)((NU$3)($1) * (NU$3)($2))', // MulU - '(NI$3)((NU$3)($1) / (NU$3)($2))', // DivU - '(NI$3)((NU$3)($1) % (NU$3)($2))', // ModU - '(NI64)((NU64)($1) + (NU64)($2))', // AddU64 - '(NI64)((NU64)($1) - (NU64)($2))', // SubU64 - '(NI64)((NU64)($1) * (NU64)($2))', // MulU64 - '(NI64)((NU64)($1) / (NU64)($2))', // DivU64 - '(NI64)((NU64)($1) % (NU64)($2))', // ModU64 - - '($1 == $2)', // EqI - '($1 <= $2)', // LeI - '($1 < $2)', // LtI - '($1 == $2)', // EqI64 - '($1 <= $2)', // LeI64 - '($1 < $2)', // LtI64 - '($1 == $2)', // EqF64 - '($1 <= $2)', // LeF64 - '($1 < $2)', // LtF64 - - '((NU$3)($1) <= (NU$3)($2))', // LeU - '((NU$3)($1) < (NU$3)($2))', // LtU - '((NU64)($1) <= (NU64)($2))', // LeU64 - '((NU64)($1) < (NU64)($2))', // LtU64 - - '($1 == $2)', // EqEnum - '($1 <= $2)', // LeEnum - '($1 < $2)', // LtEnum - '((NU8)($1) == (NU8)($2))', // EqCh - '((NU8)($1) <= (NU8)($2))', // LeCh - '((NU8)($1) < (NU8)($2))', // LtCh - '($1 == $2)', // EqB - '($1 <= $2)', // LeB - '($1 < $2)', // LtB - - '($1 == $2)', // EqRef - '($1 == $2)', // EqProc - '($1 == $2)', // EqPtr - '($1 <= $2)', // LePtr - '($1 < $2)', // LtPtr - '($1 == $2)', // EqCString - - '($1 != $2)' // Xor - ); -var - a, b: TLoc; - s: biggestInt; -begin - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - // BUGFIX: cannot use result-type here, as it may be a boolean - s := max(getSize(a.t), getSize(b.t))*8; - putIntoDest(p, d, e.typ, ropef(binArithTab[op], - [rdLoc(a), rdLoc(b), toRope(s)])); -end; - -procedure unaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); -const - unArithTab: array [mNot..mToBiggestInt] of string = ( - '!($1)', // Not - '$1', // UnaryPlusI - '(NI$2)((NU$2) ~($1))', // BitnotI - '$1', // UnaryPlusI64 - '~($1)', // BitnotI64 - '$1', // UnaryPlusF64 - '-($1)', // UnaryMinusF64 - '($1 > 0? ($1) : -($1))', // AbsF64; BUGFIX: fabs() makes problems - // for Tiny C, so we don't use it - '((NI)(NU)(NU8)($1))', // mZe8ToI - '((NI64)(NU64)(NU8)($1))', // mZe8ToI64 - '((NI)(NU)(NU16)($1))', // mZe16ToI - '((NI64)(NU64)(NU16)($1))', // mZe16ToI64 - '((NI64)(NU64)(NU32)($1))', // mZe32ToI64 - '((NI64)(NU64)(NU)($1))', // mZeIToI64 - - '((NI8)(NU8)(NU)($1))', // ToU8 - '((NI16)(NU16)(NU)($1))', // ToU16 - '((NI32)(NU32)(NU64)($1))', // ToU32 - - '((double) ($1))', // ToFloat - '((double) ($1))', // ToBiggestFloat - 'float64ToInt32($1)', // ToInt XXX: this is not correct! - 'float64ToInt64($1)' // ToBiggestInt - ); -var - a: TLoc; - t: PType; -begin - assert(e.sons[1].typ <> nil); - InitLocExpr(p, e.sons[1], a); - t := skipTypes(e.typ, abstractRange); - putIntoDest(p, d, e.typ, ropef(unArithTab[op], - [rdLoc(a), toRope(getSize(t)*8)])); -end; - -procedure genDeref(p: BProc; e: PNode; var d: TLoc); -var - a: TLoc; -begin - if mapType(e.sons[0].typ) = ctArray then - expr(p, e.sons[0], d) - else begin - initLocExpr(p, e.sons[0], a); - case skipTypes(a.t, abstractInst).kind of - tyRef: d.s := OnHeap; - tyVar: d.s := OnUnknown; - tyPtr: d.s := OnUnknown; // BUGFIX! - else InternalError(e.info, 'genDeref ' + typekindToStr[a.t.kind]); - end; - putIntoDest(p, d, a.t.sons[0], ropef('(*$1)', [rdLoc(a)])); - end -end; - -procedure genAddr(p: BProc; e: PNode; var d: TLoc); -var - a: TLoc; -begin - if mapType(e.sons[0].typ) = ctArray then - expr(p, e.sons[0], d) - else begin - InitLocExpr(p, e.sons[0], a); - putIntoDest(p, d, e.typ, addrLoc(a)); - end -end; - -function genRecordFieldAux(p: BProc; e: PNode; var d, a: TLoc): PType; -begin - initLocExpr(p, e.sons[0], a); - if (e.sons[1].kind <> nkSym) then InternalError(e.info, 'genRecordFieldAux'); - if d.k = locNone then d.s := a.s; - {@discard} getTypeDesc(p.module, a.t); // fill the record's fields.loc - result := getUniqueType(a.t); -end; - -procedure genRecordField(p: BProc; e: PNode; var d: TLoc); -var - a: TLoc; - f, field: PSym; - ty: PType; - r: PRope; -begin - ty := genRecordFieldAux(p, e, d, a); - r := rdLoc(a); - f := e.sons[1].sym; - field := nil; - while ty <> nil do begin - if not (ty.kind in [tyTuple, tyObject]) then - InternalError(e.info, 'genRecordField'); - field := lookupInRecord(ty.n, f.name); - if field <> nil then break; - if gCmd <> cmdCompileToCpp then app(r, '.Sup'); - ty := GetUniqueType(ty.sons[0]); - end; - if field = nil then InternalError(e.info, 'genRecordField'); - if field.loc.r = nil then InternalError(e.info, 'genRecordField'); - appf(r, '.$1', [field.loc.r]); - putIntoDest(p, d, field.typ, r); -end; - -procedure genTupleElem(p: BProc; e: PNode; var d: TLoc); -var - a: TLoc; - field: PSym; - ty: PType; - r: PRope; - i: int; -begin - initLocExpr(p, e.sons[0], a); - if d.k = locNone then d.s := a.s; - {@discard} getTypeDesc(p.module, a.t); // fill the record's fields.loc - ty := getUniqueType(a.t); - r := rdLoc(a); - case e.sons[1].kind of - nkIntLit..nkInt64Lit: i := int(e.sons[1].intVal); - else internalError(e.info, 'genTupleElem'); - end; - if ty.n <> nil then begin - field := ty.n.sons[i].sym; - if field = nil then InternalError(e.info, 'genTupleElem'); - if field.loc.r = nil then InternalError(e.info, 'genTupleElem'); - appf(r, '.$1', [field.loc.r]); - end - else - appf(r, '.Field$1', [toRope(i)]); - putIntoDest(p, d, ty.sons[i], r); -end; - -procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); forward; - -procedure genCheckedRecordField(p: BProc; e: PNode; var d: TLoc); -var - a, u, v, test: TLoc; - f, field, op: PSym; - ty: PType; - r, strLit: PRope; - i, id: int; - it: PNode; -begin - if optFieldCheck in p.options then begin - useMagic(p.module, 'raiseFieldError'); - useMagic(p.module, 'NimStringDesc'); - ty := genRecordFieldAux(p, e.sons[0], d, a); - r := rdLoc(a); - f := e.sons[0].sons[1].sym; - field := nil; - while ty <> nil do begin - assert(ty.kind in [tyTuple, tyObject]); - field := lookupInRecord(ty.n, f.name); - if field <> nil then break; - if gCmd <> cmdCompileToCpp then app(r, '.Sup'); - ty := getUniqueType(ty.sons[0]) - end; - if field = nil then InternalError(e.info, 'genCheckedRecordField'); - if field.loc.r = nil then InternalError(e.info, 'genCheckedRecordField'); - // generate the checks: - for i := 1 to sonsLen(e)-1 do begin - it := e.sons[i]; - assert(it.kind = nkCall); - assert(it.sons[0].kind = nkSym); - op := it.sons[0].sym; - if op.magic = mNot then it := it.sons[1]; - assert(it.sons[2].kind = nkSym); - initLoc(test, locNone, it.typ, OnStack); - InitLocExpr(p, it.sons[1], u); - initLoc(v, locExpr, it.sons[2].typ, OnUnknown); - v.r := ropef('$1.$2', [r, it.sons[2].sym.loc.r]); - genInExprAux(p, it, u, v, test); - - id := NodeTableTestOrSet(p.module.dataCache, - newStrNode(nkStrLit, field.name.s), gid); - if id = gid then - strLit := getStrLit(p.module, field.name.s) - else - strLit := con('TMP', toRope(id)); - if op.magic = mNot then - appf(p.s[cpsStmts], - 'if ($1) raiseFieldError(((NimStringDesc*) &$2));$n', - [rdLoc(test), strLit]) - else - appf(p.s[cpsStmts], - 'if (!($1)) raiseFieldError(((NimStringDesc*) &$2));$n', - [rdLoc(test), strLit]) - end; - appf(r, '.$1', [field.loc.r]); - putIntoDest(p, d, field.typ, r); - end - else - genRecordField(p, e.sons[0], d) -end; - -procedure genArrayElem(p: BProc; e: PNode; var d: TLoc); -var - a, b: TLoc; - ty: PType; - first: PRope; -begin - initLocExpr(p, e.sons[0], a); - initLocExpr(p, e.sons[1], b); - ty := skipTypes(skipTypes(a.t, abstractVarRange), abstractPtrs); - first := intLiteral(firstOrd(ty)); - // emit range check: - if (optBoundsCheck in p.options) then begin - if not isConstExpr(e.sons[1]) then begin - // semantic pass has already checked for const index expressions - useMagic(p.module, 'raiseIndexError'); - if firstOrd(ty) = 0 then begin - if (firstOrd(b.t) < firstOrd(ty)) or (lastOrd(b.t) > lastOrd(ty)) then - appf(p.s[cpsStmts], - 'if ((NU)($1) > (NU)($2)) raiseIndexError();$n', - [rdCharLoc(b), intLiteral(lastOrd(ty))]) - end - else - appf(p.s[cpsStmts], - 'if ($1 < $2 || $1 > $3) raiseIndexError();$n', - [rdCharLoc(b), first, intLiteral(lastOrd(ty))]) - end; - end; - if d.k = locNone then d.s := a.s; - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), ropef('$1[($2)-$3]', - [rdLoc(a), rdCharLoc(b), first])); -end; - -procedure genCStringElem(p: BProc; e: PNode; var d: TLoc); -var - a, b: TLoc; - ty: PType; -begin - initLocExpr(p, e.sons[0], a); - initLocExpr(p, e.sons[1], b); - ty := skipTypes(a.t, abstractVarRange); - if d.k = locNone then d.s := a.s; - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), ropef('$1[$2]', - [rdLoc(a), rdCharLoc(b)])); -end; - -procedure genOpenArrayElem(p: BProc; e: PNode; var d: TLoc); -var - a, b: TLoc; -begin - initLocExpr(p, e.sons[0], a); - initLocExpr(p, e.sons[1], b); - // emit range check: - if (optBoundsCheck in p.options) then begin - useMagic(p.module, 'raiseIndexError'); - appf(p.s[cpsStmts], - 'if ((NU)($1) >= (NU)($2Len0)) raiseIndexError();$n', [rdLoc(b), rdLoc(a)]) - // BUGFIX: ``>=`` and not ``>``! - end; - if d.k = locNone then d.s := a.s; - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), ropef('$1[$2]', - [rdLoc(a), rdCharLoc(b)])); -end; - -procedure genSeqElem(p: BPRoc; e: PNode; var d: TLoc); -var - a, b: TLoc; - ty: PType; -begin - initLocExpr(p, e.sons[0], a); - initLocExpr(p, e.sons[1], b); - ty := skipTypes(a.t, abstractVarRange); - if ty.kind in [tyRef, tyPtr] then - ty := skipTypes(ty.sons[0], abstractVarRange); - // emit range check: - if (optBoundsCheck in p.options) then begin - useMagic(p.module, 'raiseIndexError'); - if ty.kind = tyString then - appf(p.s[cpsStmts], - 'if ((NU)($1) > (NU)($2->Sup.len)) raiseIndexError();$n', - [rdLoc(b), rdLoc(a)]) - else - appf(p.s[cpsStmts], - 'if ((NU)($1) >= (NU)($2->Sup.len)) raiseIndexError();$n', - [rdLoc(b), rdLoc(a)]) - end; - if d.k = locNone then d.s := OnHeap; - if skipTypes(a.t, abstractVar).kind in [tyRef, tyPtr] then - a.r := ropef('(*$1)', [a.r]); - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), - ropef('$1->data[$2]', [rdLoc(a), rdCharLoc(b)])); -end; - -procedure genAndOr(p: BProc; e: PNode; var d: TLoc; m: TMagic); -// how to generate code? -// 'expr1 and expr2' becomes: -// result = expr1 -// fjmp result, end -// result = expr2 -// end: -// ... (result computed) -// BUGFIX: -// a = b or a -// used to generate: -// a = b -// if a: goto end -// a = a -// end: -// now it generates: -// tmp = b -// if tmp: goto end -// tmp = a -// end: -// a = tmp -var - L: TLabel; - tmp: TLoc; -begin - getTemp(p, e.typ, tmp); // force it into a temp! - expr(p, e.sons[1], tmp); - L := getLabel(p); - if m = mOr then - appf(p.s[cpsStmts], 'if ($1) goto $2;$n', [rdLoc(tmp), L]) - else // mAnd: - appf(p.s[cpsStmts], 'if (!($1)) goto $2;$n', [rdLoc(tmp), L]); - expr(p, e.sons[2], tmp); - fixLabel(p, L); - if d.k = locNone then - d := tmp - else - genAssignment(p, d, tmp, {@set}[]); // no need for deep copying -end; - -procedure genIfExpr(p: BProc; n: PNode; var d: TLoc); -(* - if (!expr1) goto L1; - thenPart - goto LEnd - L1: - if (!expr2) goto L2; - thenPart2 - goto LEnd - L2: - elsePart - Lend: -*) -var - i: int; - it: PNode; - a, tmp: TLoc; - Lend, Lelse: TLabel; -begin - getTemp(p, n.typ, tmp); // force it into a temp! - Lend := getLabel(p); - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - case it.kind of - nkElifExpr: begin - initLocExpr(p, it.sons[0], a); - Lelse := getLabel(p); - appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); - expr(p, it.sons[1], tmp); - appf(p.s[cpsStmts], 'goto $1;$n', [Lend]); - fixLabel(p, Lelse); - end; - nkElseExpr: begin - expr(p, it.sons[0], tmp); - end; - else internalError(n.info, 'genIfExpr()'); - end - end; - fixLabel(p, Lend); - if d.k = locNone then - d := tmp - else - genAssignment(p, d, tmp, {@set}[]); // no need for deep copying -end; - -procedure genEcho(p: BProc; n: PNode); -var - i: int; - a: TLoc; -begin - useMagic(p.module, 'rawEcho'); - useMagic(p.module, 'rawEchoNL'); - for i := 1 to sonsLen(n)-1 do begin - initLocExpr(p, n.sons[i], a); - appf(p.s[cpsStmts], 'rawEcho($1);$n', [rdLoc(a)]); - end; - app(p.s[cpsStmts], 'rawEchoNL();' + tnl); -end; - -procedure genCall(p: BProc; t: PNode; var d: TLoc); -var - param: PSym; - invalidRetType: bool; - typ: PType; - pl: PRope; // parameter list - op, list, a: TLoc; - len, i: int; -begin - // this is a hotspot in the compiler - initLocExpr(p, t.sons[0], op); - pl := con(op.r, '('+''); - //typ := getUniqueType(t.sons[0].typ); - typ := t.sons[0].typ; // getUniqueType() is too expensive here! - assert(typ.kind = tyProc); - invalidRetType := isInvalidReturnType(typ.sons[0]); - len := sonsLen(t); - for i := 1 to len-1 do begin - initLocExpr(p, t.sons[i], a); // generate expression for param - assert(sonsLen(typ) = sonsLen(typ.n)); - if (i < sonsLen(typ)) then begin - assert(typ.n.sons[i].kind = nkSym); - param := typ.n.sons[i].sym; - if ccgIntroducedPtr(param) then app(pl, addrLoc(a)) - else app(pl, rdLoc(a)); - end - else - app(pl, rdLoc(a)); - if (i < len-1) or (invalidRetType and (typ.sons[0] <> nil)) then - app(pl, ', ') - end; - if (typ.sons[0] <> nil) and invalidRetType then begin - // XXX (detected by pegs module 64bit): p(result, result) is not - // correct here. Thus we always allocate a temporary: - if d.k = locNone then getTemp(p, typ.sons[0], d); - app(pl, addrLoc(d)); - end; - app(pl, ')'+''); - if (typ.sons[0] <> nil) and not invalidRetType then begin - if d.k = locNone then getTemp(p, typ.sons[0], d); - assert(d.t <> nil); - // generate an assignment to d: - initLoc(list, locCall, nil, OnUnknown); - list.r := pl; - genAssignment(p, d, list, {@set}[]) // no need for deep copying - end - else begin - app(p.s[cpsStmts], pl); - app(p.s[cpsStmts], ';' + tnl) - end -end; - -procedure genStrConcat(p: BProc; e: PNode; var d: TLoc); -// -// s = 'hallo ' & name & ' how do you feel?' & 'z' -// -// -// { -// string tmp0; -// ... -// tmp0 = rawNewString(6 + 17 + 1 + s2->len); -// // we cannot generate s = rawNewString(...) here, because -// // ``s`` may be used on the right side of the expression -// appendString(tmp0, strlit_1); -// appendString(tmp0, name); -// appendString(tmp0, strlit_2); -// appendChar(tmp0, 'z'); -// asgn(s, tmp0); -// } -var - a, tmp: TLoc; - appends, lens: PRope; - L, i: int; -begin - useMagic(p.module, 'rawNewString'); - getTemp(p, e.typ, tmp); - L := 0; - appends := nil; - lens := nil; - for i := 0 to sonsLen(e)-2 do begin - // compute the length expression: - initLocExpr(p, e.sons[i+1], a); - if skipTypes(e.sons[i+1].Typ, abstractVarRange).kind = tyChar then begin - Inc(L); - useMagic(p.module, 'appendChar'); - appf(appends, 'appendChar($1, $2);$n', [tmp.r, rdLoc(a)]) - end - else begin - if e.sons[i+1].kind in [nkStrLit..nkTripleStrLit] then // string literal? - Inc(L, length(e.sons[i+1].strVal)) - else - appf(lens, '$1->Sup.len + ', [rdLoc(a)]); - useMagic(p.module, 'appendString'); - appf(appends, 'appendString($1, $2);$n', [tmp.r, rdLoc(a)]) - end - end; - appf(p.s[cpsStmts], '$1 = rawNewString($2$3);$n', - [tmp.r, lens, toRope(L)]); - app(p.s[cpsStmts], appends); - if d.k = locNone then - d := tmp - else - genAssignment(p, d, tmp, {@set}[]); // no need for deep copying -end; - -procedure genStrAppend(p: BProc; e: PNode; var d: TLoc); -// -// s &= 'hallo ' & name & ' how do you feel?' & 'z' -// // BUG: what if s is on the left side too? -// -// { -// s = resizeString(s, 6 + 17 + 1 + name->len); -// appendString(s, strlit_1); -// appendString(s, name); -// appendString(s, strlit_2); -// appendChar(s, 'z'); -// } -var - a, dest: TLoc; - L, i: int; - appends, lens: PRope; -begin - assert(d.k = locNone); - useMagic(p.module, 'resizeString'); - L := 0; - appends := nil; - lens := nil; - initLocExpr(p, e.sons[1], dest); - for i := 0 to sonsLen(e)-3 do begin - // compute the length expression: - initLocExpr(p, e.sons[i+2], a); - if skipTypes(e.sons[i+2].Typ, abstractVarRange).kind = tyChar then begin - Inc(L); - useMagic(p.module, 'appendChar'); - appf(appends, 'appendChar($1, $2);$n', - [rdLoc(dest), rdLoc(a)]) - end - else begin - if e.sons[i+2].kind in [nkStrLit..nkTripleStrLit] then // string literal? - Inc(L, length(e.sons[i+2].strVal)) - else - appf(lens, '$1->Sup.len + ', [rdLoc(a)]); - useMagic(p.module, 'appendString'); - appf(appends, 'appendString($1, $2);$n', - [rdLoc(dest), rdLoc(a)]) - end - end; - appf(p.s[cpsStmts], '$1 = resizeString($1, $2$3);$n', - [rdLoc(dest), lens, toRope(L)]); - app(p.s[cpsStmts], appends); -end; - -procedure genSeqElemAppend(p: BProc; e: PNode; var d: TLoc); -// seq &= x --> -// seq = (typeof seq) incrSeq(&seq->Sup, sizeof(x)); -// seq->data[seq->len-1] = x; -var - a, b, dest: TLoc; -begin - useMagic(p.module, 'incrSeq'); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - appf(p.s[cpsStmts], - '$1 = ($2) incrSeq(&($1)->Sup, sizeof($3));$n', - [rdLoc(a), getTypeDesc(p.module, skipTypes(e.sons[1].typ, abstractVar)), - getTypeDesc(p.module, skipTypes(e.sons[2].Typ, abstractVar))]); - initLoc(dest, locExpr, b.t, OnHeap); - dest.r := ropef('$1->data[$1->Sup.len-1]', [rdLoc(a)]); - genAssignment(p, dest, b, {@set}[needToCopy, afDestIsNil]); -end; - -procedure genObjectInit(p: BProc; t: PType; const a: TLoc; takeAddr: bool); -var - r: PRope; - s: PType; -begin - case analyseObjectWithTypeField(t) of - frNone: begin end; - frHeader: begin - r := rdLoc(a); - if not takeAddr then r := ropef('(*$1)', [r]); - s := t; - while (s.kind = tyObject) and (s.sons[0] <> nil) do begin - app(r, '.Sup'); - s := skipTypes(s.sons[0], abstractInst); - end; - appf(p.s[cpsStmts], '$1.m_type = $2;$n', [r, genTypeInfo(p.module, t)]) - end; - frEmbedded: begin - // worst case for performance: - useMagic(p.module, 'objectInit'); - if takeAddr then r := addrLoc(a) - else r := rdLoc(a); - appf(p.s[cpsStmts], 'objectInit($1, $2);$n', [r, genTypeInfo(p.module, t)]) - end - end -end; - -procedure genNew(p: BProc; e: PNode); -var - a, b: TLoc; - reftype, bt: PType; -begin - useMagic(p.module, 'newObj'); - refType := skipTypes(e.sons[1].typ, abstractVarRange); - InitLocExpr(p, e.sons[1], a); - initLoc(b, locExpr, a.t, OnHeap); - b.r := ropef('($1) newObj($2, sizeof($3))', - [getTypeDesc(p.module, reftype), genTypeInfo(p.module, refType), - getTypeDesc(p.module, skipTypes(reftype.sons[0], abstractRange))]); - genAssignment(p, a, b, {@set}[]); - // set the object type: - bt := skipTypes(refType.sons[0], abstractRange); - genObjectInit(p, bt, a, false); -end; - -procedure genNewSeq(p: BProc; e: PNode); -var - a, b, c: TLoc; - seqtype: PType; -begin - useMagic(p.module, 'newSeq'); - seqType := skipTypes(e.sons[1].typ, abstractVarRange); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - initLoc(c, locExpr, a.t, OnHeap); - c.r := ropef('($1) newSeq($2, $3)', - [getTypeDesc(p.module, seqtype), - genTypeInfo(p.module, seqType), - rdLoc(b)]); - genAssignment(p, a, c, {@set}[]); -end; - -procedure genIs(p: BProc; x: PNode; typ: PType; var d: TLoc); overload; -var - a: TLoc; - dest, t: PType; - r, nilcheck: PRope; -begin - initLocExpr(p, x, a); - dest := skipTypes(typ, abstractPtrs); - useMagic(p.module, 'isObj'); - r := rdLoc(a); - nilCheck := nil; - t := skipTypes(a.t, abstractInst); - while t.kind in [tyVar, tyPtr, tyRef] do begin - if t.kind <> tyVar then nilCheck := r; - r := ropef('(*$1)', [r]); - t := skipTypes(t.sons[0], abstractInst) - end; - if gCmd <> cmdCompileToCpp then - while (t.kind = tyObject) and (t.sons[0] <> nil) do begin - app(r, '.Sup'); - t := skipTypes(t.sons[0], abstractInst) - end; - if nilCheck <> nil then - r := ropef('(($1) && isObj($2.m_type, $3))', - [nilCheck, r, genTypeInfo(p.module, dest)]) - else - r := ropef('isObj($1.m_type, $2)', - [r, genTypeInfo(p.module, dest)]); - putIntoDest(p, d, getSysType(tyBool), r); -end; - -procedure genIs(p: BProc; n: PNode; var d: TLoc); overload; -begin - genIs(p, n.sons[1], n.sons[2].typ, d); -end; - -procedure genNewFinalize(p: BProc; e: PNode); -var - a, b, f: TLoc; - refType, bt: PType; - ti: PRope; - oldModule: BModule; -begin - useMagic(p.module, 'newObj'); - refType := skipTypes(e.sons[1].typ, abstractVarRange); - InitLocExpr(p, e.sons[1], a); - - // This is a little hack: - // XXX this is also a bug, if the finalizer expression produces side-effects - oldModule := p.module; - p.module := gNimDat; - InitLocExpr(p, e.sons[2], f); - p.module := oldModule; - - initLoc(b, locExpr, a.t, OnHeap); - ti := genTypeInfo(p.module, refType); - - appf(gNimDat.s[cfsTypeInit3], '$1->finalizer = (void*)$2;$n', [ - ti, rdLoc(f)]); - b.r := ropef('($1) newObj($2, sizeof($3))', - [getTypeDesc(p.module, refType), ti, - getTypeDesc(p.module, skipTypes(reftype.sons[0], abstractRange))]); - genAssignment(p, a, b, {@set}[]); - // set the object type: - bt := skipTypes(refType.sons[0], abstractRange); - genObjectInit(p, bt, a, false); -end; - -procedure genRepr(p: BProc; e: PNode; var d: TLoc); -var - a: TLoc; - t: PType; -begin - InitLocExpr(p, e.sons[1], a); - t := skipTypes(e.sons[1].typ, abstractVarRange); - case t.kind of - tyInt..tyInt64: begin - UseMagic(p.module, 'reprInt'); - putIntoDest(p, d, e.typ, ropef('reprInt($1)', [rdLoc(a)])) - end; - tyFloat..tyFloat128: begin - UseMagic(p.module, 'reprFloat'); - putIntoDest(p, d, e.typ, ropef('reprFloat($1)', [rdLoc(a)])) - end; - tyBool: begin - UseMagic(p.module, 'reprBool'); - putIntoDest(p, d, e.typ, ropef('reprBool($1)', [rdLoc(a)])) - end; - tyChar: begin - UseMagic(p.module, 'reprChar'); - putIntoDest(p, d, e.typ, ropef('reprChar($1)', [rdLoc(a)])) - end; - tyEnum, tyOrdinal: begin - UseMagic(p.module, 'reprEnum'); - putIntoDest(p, d, e.typ, - ropef('reprEnum($1, $2)', [rdLoc(a), genTypeInfo(p.module, t)])) - end; - tyString: begin - UseMagic(p.module, 'reprStr'); - putIntoDest(p, d, e.typ, ropef('reprStr($1)', [rdLoc(a)])) - end; - tySet: begin - useMagic(p.module, 'reprSet'); - putIntoDest(p, d, e.typ, ropef('reprSet($1, $2)', - [rdLoc(a), genTypeInfo(p.module, t)])) - end; - tyOpenArray: begin - useMagic(p.module, 'reprOpenArray'); - case a.t.kind of - tyOpenArray: - putIntoDest(p, d, e.typ, ropef('$1, $1Len0', [rdLoc(a)])); - tyString, tySequence: - putIntoDest(p, d, e.typ, ropef('$1->data, $1->Sup.len', [rdLoc(a)])); - tyArray, tyArrayConstr: - putIntoDest(p, d, e.typ, ropef('$1, $2', - [rdLoc(a), toRope(lengthOrd(a.t))])); - else InternalError(e.sons[0].info, 'genRepr()') - end; - putIntoDest(p, d, e.typ, ropef('reprOpenArray($1, $2)', - [rdLoc(d), genTypeInfo(p.module, elemType(t))])) - end; - tyCString, tyArray, tyArrayConstr, - tyRef, tyPtr, tyPointer, tyNil, tySequence: begin - useMagic(p.module, 'reprAny'); - putIntoDest(p, d, e.typ, ropef('reprAny($1, $2)', - [rdLoc(a), genTypeInfo(p.module, t)])) - end - else begin - useMagic(p.module, 'reprAny'); - putIntoDest(p, d, e.typ, ropef('reprAny($1, $2)', - [addrLoc(a), genTypeInfo(p.module, t)])) - end - end; -end; - -procedure genDollar(p: BProc; n: PNode; var d: TLoc; const magic, frmt: string); -var - a: TLoc; -begin - InitLocExpr(p, n.sons[1], a); - UseMagic(p.module, magic); - a.r := ropef(frmt, [rdLoc(a)]); - if d.k = locNone then getTemp(p, n.typ, d); - genAssignment(p, d, a, {@set}[]); -end; - -procedure genArrayLen(p: BProc; e: PNode; var d: TLoc; op: TMagic); -var - typ: PType; -begin - typ := skipTypes(e.sons[1].Typ, abstractPtrs); - case typ.kind of - tyOpenArray: begin - while e.sons[1].kind = nkPassAsOpenArray do - e.sons[1] := e.sons[1].sons[0]; - if op = mHigh then - unaryExpr(p, e, d, '', '($1Len0-1)') - else - unaryExpr(p, e, d, '', '$1Len0'); - end; - tyCstring: - if op = mHigh then - unaryExpr(p, e, d, '', '(strlen($1)-1)') - else - unaryExpr(p, e, d, '', 'strlen($1)'); - tyString, tySequence: - if op = mHigh then - unaryExpr(p, e, d, '', '($1->Sup.len-1)') - else - unaryExpr(p, e, d, '', '$1->Sup.len'); - tyArray, tyArrayConstr: begin - // YYY: length(sideeffect) is optimized away incorrectly? - if op = mHigh then - putIntoDest(p, d, e.typ, toRope(lastOrd(Typ))) - else - putIntoDest(p, d, e.typ, toRope(lengthOrd(typ))) - end - else - InternalError(e.info, 'genArrayLen()') - end -end; - -procedure genSetLengthSeq(p: BProc; e: PNode; var d: TLoc); -var - a, b: TLoc; - t: PType; -begin - assert(d.k = locNone); - useMagic(p.module, 'setLengthSeq'); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - t := skipTypes(e.sons[1].typ, abstractVar); - appf(p.s[cpsStmts], - '$1 = ($3) setLengthSeq(&($1)->Sup, sizeof($4), $2);$n', - [rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), - getTypeDesc(p.module, t.sons[0])]); -end; - -procedure genSetLengthStr(p: BProc; e: PNode; var d: TLoc); -begin - binaryStmt(p, e, d, 'setLengthStr', '$1 = setLengthStr($1, $2);$n') -end; - -procedure genSwap(p: BProc; e: PNode; var d: TLoc); - // swap(a, b) --> - // temp = a - // a = b - // b = temp -var - a, b, tmp: TLoc; -begin - getTemp(p, skipTypes(e.sons[1].typ, abstractVar), tmp); - InitLocExpr(p, e.sons[1], a); // eval a - InitLocExpr(p, e.sons[2], b); // eval b - genAssignment(p, tmp, a, {@set}[]); - genAssignment(p, a, b, {@set}[]); - genAssignment(p, b, tmp, {@set}[]); -end; - -// -------------------- set operations ------------------------------------ - -function rdSetElemLoc(const a: TLoc; setType: PType): PRope; -// read a location of an set element; it may need a substraction operation -// before the set operation -begin - result := rdCharLoc(a); - assert(setType.kind = tySet); - if (firstOrd(setType) <> 0) then - result := ropef('($1-$2)', [result, toRope(firstOrd(setType))]) -end; - -function fewCmps(s: PNode): bool; -// this function estimates whether it is better to emit code -// for constructing the set or generating a bunch of comparisons directly -begin - if s.kind <> nkCurly then InternalError(s.info, 'fewCmps'); - if (getSize(s.typ) <= platform.intSize) and (nfAllConst in s.flags) then - result := false // it is better to emit the set generation code - else if elemType(s.typ).Kind in [tyInt, tyInt16..tyInt64] then - result := true // better not emit the set if int is basetype! - else - result := sonsLen(s) <= 8 // 8 seems to be a good value -end; - -procedure binaryExprIn(p: BProc; e: PNode; var a, b, d: TLoc; - const frmt: string); -begin - putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])); -end; - -procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); -begin - case int(getSize(skipTypes(e.sons[1].typ, abstractVar))) of - 1: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&7)))!=0)'); - 2: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&15)))!=0)'); - 4: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&31)))!=0)'); - 8: binaryExprIn(p, e, a, b, d, '(($1 &(IL64(1)<<(($2)&IL64(63))))!=0)'); - else binaryExprIn(p, e, a, b, d, '(($1[$2/8] &(1<<($2%8)))!=0)'); - end -end; - -procedure binaryStmtInExcl(p: BProc; e: PNode; var d: TLoc; const frmt: string); -var - a, b: TLoc; -begin - assert(d.k = locNone); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - appf(p.s[cpsStmts], frmt, [rdLoc(a), rdSetElemLoc(b, a.t)]); -end; - -procedure genInOp(p: BProc; e: PNode; var d: TLoc); -var - a, b, x, y: TLoc; - len, i: int; -begin - if (e.sons[1].Kind = nkCurly) and fewCmps(e.sons[1]) then begin - // a set constructor but not a constant set: - // do not emit the set, but generate a bunch of comparisons - initLocExpr(p, e.sons[2], a); - initLoc(b, locExpr, e.typ, OnUnknown); - b.r := toRope('('+''); - len := sonsLen(e.sons[1]); - for i := 0 to len-1 do begin - if e.sons[1].sons[i].Kind = nkRange then begin - InitLocExpr(p, e.sons[1].sons[i].sons[0], x); - InitLocExpr(p, e.sons[1].sons[i].sons[1], y); - appf(b.r, '$1 >= $2 && $1 <= $3', - [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) - end - else begin - InitLocExpr(p, e.sons[1].sons[i], x); - appf(b.r, '$1 == $2', [rdCharLoc(a), rdCharLoc(x)]) - end; - if i < len - 1 then app(b.r, ' || ') - end; - app(b.r, ')'+''); - putIntoDest(p, d, e.typ, b.r); - end - else begin - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - genInExprAux(p, e, a, b, d); - end -end; - -procedure genSetOp(p: BProc; e: PNode; var d: TLoc; op: TMagic); -const - lookupOpr: array [mLeSet..mSymDiffSet] of string = ( - 'for ($1 = 0; $1 < $2; $1++) { $n' + - ' $3 = (($4[$1] & ~ $5[$1]) == 0);$n' + - ' if (!$3) break;}$n', - 'for ($1 = 0; $1 < $2; $1++) { $n' + - ' $3 = (($4[$1] & ~ $5[$1]) == 0);$n' + - ' if (!$3) break;}$n' + - 'if ($3) $3 = (memcmp($4, $5, $2) != 0);$n', - '&'+'', '|'+'', '& ~', '^'+''); -var - size: int; - setType: PType; - a, b, i: TLoc; - ts: string; -begin - setType := skipTypes(e.sons[1].Typ, abstractVar); - size := int(getSize(setType)); - case size of - 1, 2, 4, 8: begin - case op of - mIncl: begin - ts := 'NI' + toString(size*8); - binaryStmtInExcl(p, e, d, - '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&} ts +{&} - ')*8)));$n'); - end; - mExcl: begin - ts := 'NI' + toString(size*8); - binaryStmtInExcl(p, e, d, - '$1 &= ~(1 << ((' +{&} ts +{&} ')($2) % (sizeof(' +{&} ts +{&} - ')*8)));$n'); - end; - mCard: begin - if size <= 4 then - unaryExprChar(p, e, d, 'countBits32', 'countBits32($1)') - else - unaryExprChar(p, e, d, 'countBits64', 'countBits64($1)'); - end; - mLtSet: binaryExprChar(p, e, d, '', '(($1 & ~ $2 ==0)&&($1 != $2))'); - mLeSet: binaryExprChar(p, e, d, '', '(($1 & ~ $2)==0)'); - mEqSet: binaryExpr(p, e, d, '', '($1 == $2)'); - mMulSet: binaryExpr(p, e, d, '', '($1 & $2)'); - mPlusSet: binaryExpr(p, e, d, '', '($1 | $2)'); - mMinusSet: binaryExpr(p, e, d, '', '($1 & ~ $2)'); - mSymDiffSet: binaryExpr(p, e, d, '', '($1 ^ $2)'); - mInSet: genInOp(p, e, d); - else internalError(e.info, 'genSetOp()') - end - end - else begin - case op of - mIncl: binaryStmtInExcl(p, e, d, '$1[$2/8] |=(1<<($2%8));$n'); - mExcl: binaryStmtInExcl(p, e, d, '$1[$2/8] &= ~(1<<($2%8));$n'); - mCard: unaryExprChar(p, e, d, 'cardSet', - 'cardSet($1, ' + ToString(size) + ')'); - mLtSet, mLeSet: begin - getTemp(p, getSysType(tyInt), i); // our counter - initLocExpr(p, e.sons[1], a); - initLocExpr(p, e.sons[2], b); - if d.k = locNone then getTemp(p, a.t, d); - appf(p.s[cpsStmts], lookupOpr[op], [rdLoc(i), toRope(size), - rdLoc(d), rdLoc(a), rdLoc(b)]); - end; - mEqSet: - binaryExprChar(p, e, d, '', - '(memcmp($1, $2, ' + ToString(size) + ')==0)'); - mMulSet, mPlusSet, mMinusSet, mSymDiffSet: begin - // we inline the simple for loop for better code generation: - getTemp(p, getSysType(tyInt), i); // our counter - initLocExpr(p, e.sons[1], a); - initLocExpr(p, e.sons[2], b); - if d.k = locNone then getTemp(p, a.t, d); - appf(p.s[cpsStmts], - 'for ($1 = 0; $1 < $2; $1++) $n' + - ' $3[$1] = $4[$1] $6 $5[$1];$n', [rdLoc(i), toRope(size), - rdLoc(d), rdLoc(a), rdLoc(b), toRope(lookupOpr[op])]); - end; - mInSet: genInOp(p, e, d); - else internalError(e.info, 'genSetOp') - end - end - end -end; - -// --------------------- end of set operations ---------------------------- - -procedure genOrd(p: BProc; e: PNode; var d: TLoc); -begin - unaryExprChar(p, e, d, '', '$1'); -end; - -procedure genCast(p: BProc; e: PNode; var d: TLoc); -const - ValueTypes = {@set}[tyTuple, tyObject, tyArray, tyOpenArray, tyArrayConstr]; -// we use whatever C gives us. Except if we have a value-type, we -// need to go through its address: -var - a: TLoc; -begin - InitLocExpr(p, e.sons[1], a); - if (skipTypes(e.typ, abstractRange).kind in ValueTypes) - and not (lfIndirect in a.flags) then - putIntoDest(p, d, e.typ, ropef('(*($1*) ($2))', - [getTypeDesc(p.module, e.typ), addrLoc(a)])) - else - putIntoDest(p, d, e.typ, ropef('(($1) ($2))', - [getTypeDesc(p.module, e.typ), rdCharLoc(a)])); -end; - -procedure genRangeChck(p: BProc; n: PNode; var d: TLoc; const magic: string); -var - a: TLoc; - dest: PType; -begin - dest := skipTypes(n.typ, abstractVar); - if not (optRangeCheck in p.options) then begin - InitLocExpr(p, n.sons[0], a); - putIntoDest(p, d, n.typ, ropef('(($1) ($2))', - [getTypeDesc(p.module, dest), rdCharLoc(a)])); - end - else begin - InitLocExpr(p, n.sons[0], a); - useMagic(p.module, magic); - putIntoDest(p, d, dest, - ropef('(($1)$5($2, $3, $4))', - [getTypeDesc(p.module, dest), - rdCharLoc(a), genLiteral(p, n.sons[1], dest), - genLiteral(p, n.sons[2], dest), - toRope(magic)])); - end -end; - -procedure genConv(p: BProc; e: PNode; var d: TLoc); -begin - genCast(p, e, d) -end; - -procedure passToOpenArray(p: BProc; n: PNode; var d: TLoc); -var - a: TLoc; - dest: PType; -begin - while n.sons[0].kind = nkPassAsOpenArray do - n.sons[0] := n.sons[0].sons[0]; // BUGFIX - dest := skipTypes(n.typ, abstractVar); - case skipTypes(n.sons[0].typ, abstractVar).kind of - tyOpenArray: begin - initLocExpr(p, n.sons[0], a); - putIntoDest(p, d, dest, ropef('$1, $1Len0', [rdLoc(a)])); - end; - tyString, tySequence: begin - initLocExpr(p, n.sons[0], a); - putIntoDest(p, d, dest, ropef('$1->data, $1->Sup.len', [rdLoc(a)])); - end; - tyArray, tyArrayConstr: begin - initLocExpr(p, n.sons[0], a); - putIntoDest(p, d, dest, ropef('$1, $2', - [rdLoc(a), toRope(lengthOrd(a.t))])); - end - else InternalError(n.sons[0].info, 'passToOpenArray: ' + typeToString(a.t)) - end -end; - -procedure convStrToCStr(p: BProc; n: PNode; var d: TLoc); -var - a: TLoc; -begin - initLocExpr(p, n.sons[0], a); - putIntoDest(p, d, skipTypes(n.typ, abstractVar), - ropef('$1->data', [rdLoc(a)])); -end; - -procedure convCStrToStr(p: BProc; n: PNode; var d: TLoc); -var - a: TLoc; -begin - useMagic(p.module, 'cstrToNimstr'); - initLocExpr(p, n.sons[0], a); - putIntoDest(p, d, skipTypes(n.typ, abstractVar), - ropef('cstrToNimstr($1)', [rdLoc(a)])); -end; - -procedure genStrEquals(p: BProc; e: PNode; var d: TLoc); -var - a, b: PNode; - x: TLoc; -begin - a := e.sons[1]; - b := e.sons[2]; - if (a.kind = nkNilLit) or (b.kind = nkNilLit) then - binaryExpr(p, e, d, '', '($1 == $2)') - else if (a.kind in [nkStrLit..nkTripleStrLit]) and (a.strVal = '') then begin - initLocExpr(p, e.sons[2], x); - putIntoDest(p, d, e.typ, ropef('(($1) && ($1)->Sup.len == 0)', [rdLoc(x)])); - end - else if (b.kind in [nkStrLit..nkTripleStrLit]) and (b.strVal = '') then begin - initLocExpr(p, e.sons[1], x); - putIntoDest(p, d, e.typ, ropef('(($1) && ($1)->Sup.len == 0)', [rdLoc(x)])); - end - else - binaryExpr(p, e, d, 'eqStrings', 'eqStrings($1, $2)'); -end; - -procedure genSeqConstr(p: BProc; t: PNode; var d: TLoc); -var - newSeq, arr: TLoc; - i: int; -begin - useMagic(p.module, 'newSeq'); - if d.k = locNone then getTemp(p, t.typ, d); - // generate call to newSeq before adding the elements per hand: - - initLoc(newSeq, locExpr, t.typ, OnHeap); - newSeq.r := ropef('($1) newSeq($2, $3)', - [getTypeDesc(p.module, t.typ), - genTypeInfo(p.module, t.typ), intLiteral(sonsLen(t))]); - genAssignment(p, d, newSeq, {@set}[afSrcIsNotNil]); - for i := 0 to sonsLen(t)-1 do begin - initLoc(arr, locExpr, elemType(skipTypes(t.typ, abstractInst)), OnHeap); - arr.r := ropef('$1->data[$2]', [rdLoc(d), intLiteral(i)]); - arr.s := OnHeap; // we know that sequences are on the heap - expr(p, t.sons[i], arr) - end -end; - -procedure genArrToSeq(p: BProc; t: PNode; var d: TLoc); -var - newSeq, elem, a, arr: TLoc; - L, i: int; -begin - if t.kind = nkBracket then begin - t.sons[1].typ := t.typ; - genSeqConstr(p, t.sons[1], d); - exit - end; - useMagic(p.module, 'newSeq'); - if d.k = locNone then getTemp(p, t.typ, d); - // generate call to newSeq before adding the elements per hand: - L := int(lengthOrd(t.sons[1].typ)); - initLoc(newSeq, locExpr, t.typ, OnHeap); - newSeq.r := ropef('($1) newSeq($2, $3)', - [getTypeDesc(p.module, t.typ), - genTypeInfo(p.module, t.typ), intLiteral(L)]); - genAssignment(p, d, newSeq, {@set}[afSrcIsNotNil]); - initLocExpr(p, t.sons[1], a); - for i := 0 to L-1 do begin - initLoc(elem, locExpr, elemType(skipTypes(t.typ, abstractInst)), OnHeap); - elem.r := ropef('$1->data[$2]', [rdLoc(d), intLiteral(i)]); - elem.s := OnHeap; // we know that sequences are on the heap - initLoc(arr, locExpr, elemType(skipTypes(t.sons[1].typ, abstractInst)), a.s); - arr.r := ropef('$1[$2]', [rdLoc(a), intLiteral(i)]); - genAssignment(p, elem, arr, {@set}[afDestIsNil, needToCopy]); - end -end; - -procedure genMagicExpr(p: BProc; e: PNode; var d: TLoc; op: TMagic); -var - line, filen: PRope; -begin - case op of - mOr, mAnd: genAndOr(p, e, d, op); - mNot..mToBiggestInt: unaryArith(p, e, d, op); - mUnaryMinusI..mAbsI64: unaryArithOverflow(p, e, d, op); - mShrI..mXor: binaryArith(p, e, d, op); - mAddi..mModi64: binaryArithOverflow(p, e, d, op); - mRepr: genRepr(p, e, d); - mSwap: genSwap(p, e, d); - mPred: begin // XXX: range checking? - if not (optOverflowCheck in p.Options) then - binaryExpr(p, e, d, '', '$1 - $2') - else - binaryExpr(p, e, d, 'subInt', 'subInt($1, $2)') - end; - mSucc: begin // XXX: range checking? - if not (optOverflowCheck in p.Options) then - binaryExpr(p, e, d, '', '$1 + $2') - else - binaryExpr(p, e, d, 'addInt', 'addInt($1, $2)') - end; - mInc: begin - if not (optOverflowCheck in p.Options) then - binaryStmt(p, e, d, '', '$1 += $2;$n') - else if skipTypes(e.sons[1].typ, abstractVar).kind = tyInt64 then - binaryStmt(p, e, d, 'addInt64', '$1 = addInt64($1, $2);$n') - else - binaryStmt(p, e, d, 'addInt', '$1 = addInt($1, $2);$n') - end; - ast.mDec: begin - if not (optOverflowCheck in p.Options) then - binaryStmt(p, e, d, '', '$1 -= $2;$n') - else if skipTypes(e.sons[1].typ, abstractVar).kind = tyInt64 then - binaryStmt(p, e, d, 'subInt64', '$1 = subInt64($1, $2);$n') - else - binaryStmt(p, e, d, 'subInt', '$1 = subInt($1, $2);$n') - end; - mConStrStr: genStrConcat(p, e, d); - mAppendStrCh: binaryStmt(p, e, d, 'addChar', '$1 = addChar($1, $2);$n'); - mAppendStrStr: genStrAppend(p, e, d); - mAppendSeqElem: genSeqElemAppend(p, e, d); - mEqStr: genStrEquals(p, e, d); - mLeStr: binaryExpr(p, e, d, 'cmpStrings', '(cmpStrings($1, $2) <= 0)'); - mLtStr: binaryExpr(p, e, d, 'cmpStrings', '(cmpStrings($1, $2) < 0)'); - mIsNil: unaryExpr(p, e, d, '', '$1 == 0'); - mIntToStr: genDollar(p, e, d, 'nimIntToStr', 'nimIntToStr($1)'); - mInt64ToStr: genDollar(p, e, d, 'nimInt64ToStr', 'nimInt64ToStr($1)'); - mBoolToStr: genDollar(p, e, d, 'nimBoolToStr', 'nimBoolToStr($1)'); - mCharToStr: genDollar(p, e, d, 'nimCharToStr', 'nimCharToStr($1)'); - mFloatToStr: genDollar(p, e, d, 'nimFloatToStr', 'nimFloatToStr($1)'); - mCStrToStr: genDollar(p, e, d, 'cstrToNimstr', 'cstrToNimstr($1)'); - mStrToStr: expr(p, e.sons[1], d); - mEnumToStr: genRepr(p, e, d); - mAssert: begin - if (optAssert in p.Options) then begin - useMagic(p.module, 'internalAssert'); - expr(p, e.sons[1], d); - line := toRope(toLinenumber(e.info)); - filen := makeCString(ToFilename(e.info)); - appf(p.s[cpsStmts], 'internalAssert($1, $2, $3);$n', - [filen, line, rdLoc(d)]) - end - end; - mIs: genIs(p, e, d); - mNew: genNew(p, e); - mNewFinalize: genNewFinalize(p, e); - mNewSeq: genNewSeq(p, e); - mSizeOf: - putIntoDest(p, d, e.typ, - ropef('((NI)sizeof($1))', [getTypeDesc(p.module, e.sons[1].typ)])); - mChr: genCast(p, e, d); // expr(p, e.sons[1], d); - mOrd: genOrd(p, e, d); - mLengthArray, mHigh, mLengthStr, mLengthSeq, mLengthOpenArray: - genArrayLen(p, e, d, op); - mGCref: unaryStmt(p, e, d, 'nimGCref', 'nimGCref($1);$n'); - mGCunref: unaryStmt(p, e, d, 'nimGCunref', 'nimGCunref($1);$n'); - mSetLengthStr: genSetLengthStr(p, e, d); - mSetLengthSeq: genSetLengthSeq(p, e, d); - mIncl, mExcl, mCard, mLtSet, mLeSet, mEqSet, mMulSet, mPlusSet, - mMinusSet, mInSet: genSetOp(p, e, d, op); - mNewString, mCopyStr, mCopyStrLast, mExit: genCall(p, e, d); - mEcho: genEcho(p, e); - mArrToSeq: genArrToSeq(p, e, d); - mNLen..mNError: - liMessage(e.info, errCannotGenerateCodeForX, e.sons[0].sym.name.s); - else internalError(e.info, 'genMagicExpr: ' + magicToStr[op]); - end -end; - -function genConstExpr(p: BProc; n: PNode): PRope; forward; - -function handleConstExpr(p: BProc; n: PNode; var d: TLoc): bool; -var - id: int; - t: PType; -begin - if (nfAllConst in n.flags) and (d.k = locNone) - and (sonsLen(n) > 0) then begin - t := getUniqueType(n.typ); - {@discard} getTypeDesc(p.module, t); // so that any fields are initialized - id := NodeTableTestOrSet(p.module.dataCache, n, gid); - fillLoc(d, locData, t, con('TMP', toRope(id)), OnHeap); - if id = gid then begin - // expression not found in the cache: - inc(gid); - appf(p.module.s[cfsData], 'NIM_CONST $1 $2 = $3;$n', - [getTypeDesc(p.module, t), d.r, genConstExpr(p, n)]); - end; - result := true - end - else - result := false -end; - -procedure genSetConstr(p: BProc; e: PNode; var d: TLoc); -// example: { a..b, c, d, e, f..g } -// we have to emit an expression of the form: -// memset(tmp, 0, sizeof(tmp)); inclRange(tmp, a, b); incl(tmp, c); -// incl(tmp, d); incl(tmp, e); inclRange(tmp, f, g); -var - a, b, idx: TLoc; - i: int; - ts: string; -begin - if nfAllConst in e.flags then - putIntoDest(p, d, e.typ, genSetNode(p, e)) - else begin - if d.k = locNone then getTemp(p, e.typ, d); - if getSize(e.typ) > 8 then begin // big set: - appf(p.s[cpsStmts], 'memset($1, 0, sizeof($1));$n', [rdLoc(d)]); - for i := 0 to sonsLen(e)-1 do begin - if e.sons[i].kind = nkRange then begin - getTemp(p, getSysType(tyInt), idx); // our counter - initLocExpr(p, e.sons[i].sons[0], a); - initLocExpr(p, e.sons[i].sons[1], b); - appf(p.s[cpsStmts], - 'for ($1 = $3; $1 <= $4; $1++) $n' + - '$2[$1/8] |=(1<<($1%8));$n', - [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), - rdSetElemLoc(b, e.typ)]); - end - else begin - initLocExpr(p, e.sons[i], a); - appf(p.s[cpsStmts], '$1[$2/8] |=(1<<($2%8));$n', - [rdLoc(d), rdSetElemLoc(a, e.typ)]); - end - end - end - else begin // small set - ts := 'NI' + toString(getSize(e.typ)*8); - appf(p.s[cpsStmts], '$1 = 0;$n', [rdLoc(d)]); - for i := 0 to sonsLen(e) - 1 do begin - if e.sons[i].kind = nkRange then begin - getTemp(p, getSysType(tyInt), idx); // our counter - initLocExpr(p, e.sons[i].sons[0], a); - initLocExpr(p, e.sons[i].sons[1], b); - appf(p.s[cpsStmts], - 'for ($1 = $3; $1 <= $4; $1++) $n' +{&} - '$2 |=(1<<((' +{&} ts +{&} ')($1)%(sizeof(' +{&}ts+{&}')*8)));$n', - [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), - rdSetElemLoc(b, e.typ)]); - end - else begin - initLocExpr(p, e.sons[i], a); - appf(p.s[cpsStmts], - '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&}ts+{&} - ')*8)));$n', - [rdLoc(d), rdSetElemLoc(a, e.typ)]); - end - end - end - end -end; - -procedure genTupleConstr(p: BProc; n: PNode; var d: TLoc); -var - i: int; - rec: TLoc; - it: PNode; - t: PType; -begin - if not handleConstExpr(p, n, d) then begin - t := getUniqueType(n.typ); - {@discard} getTypeDesc(p.module, t); // so that any fields are initialized - if d.k = locNone then getTemp(p, t, d); - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it.kind = nkExprColonExpr then begin - initLoc(rec, locExpr, it.sons[1].typ, d.s); - if (t.n.sons[i].kind <> nkSym) then - InternalError(n.info, 'genTupleConstr'); - rec.r := ropef('$1.$2', [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]); - expr(p, it.sons[1], rec); - end - else if t.n = nil then begin - initLoc(rec, locExpr, it.typ, d.s); - rec.r := ropef('$1.Field$2', [rdLoc(d), toRope(i)]); - expr(p, it, rec); - end - else begin - initLoc(rec, locExpr, it.typ, d.s); - if (t.n.sons[i].kind <> nkSym) then - InternalError(n.info, 'genTupleConstr: 2'); - rec.r := ropef('$1.$2', [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]); - expr(p, it, rec); - end - end - end -end; - -procedure genArrayConstr(p: BProc; n: PNode; var d: TLoc); -var - arr: TLoc; - i: int; -begin - if not handleConstExpr(p, n, d) then begin - if d.k = locNone then getTemp(p, n.typ, d); - for i := 0 to sonsLen(n)-1 do begin - initLoc(arr, locExpr, elemType(skipTypes(n.typ, abstractInst)), d.s); - arr.r := ropef('$1[$2]', [rdLoc(d), intLiteral(i)]); - expr(p, n.sons[i], arr) - end - end -end; - -procedure genComplexConst(p: BProc; sym: PSym; var d: TLoc); -begin - genConstPrototype(p.module, sym); - assert((sym.loc.r <> nil) and (sym.loc.t <> nil)); - putLocIntoDest(p, d, sym.loc) -end; - -procedure genStmtListExpr(p: BProc; n: PNode; var d: TLoc); -var - len, i: int; -begin - len := sonsLen(n); - for i := 0 to len-2 do genStmts(p, n.sons[i]); - if len > 0 then expr(p, n.sons[len-1], d); -end; - -procedure upConv(p: BProc; n: PNode; var d: TLoc); -var - a: TLoc; - dest, t: PType; - r, nilCheck: PRope; -begin - initLocExpr(p, n.sons[0], a); - dest := skipTypes(n.typ, abstractPtrs); - if (optObjCheck in p.options) and not (isPureObject(dest)) then begin - useMagic(p.module, 'chckObj'); - r := rdLoc(a); - nilCheck := nil; - t := skipTypes(a.t, abstractInst); - while t.kind in [tyVar, tyPtr, tyRef] do begin - if t.kind <> tyVar then nilCheck := r; - r := ropef('(*$1)', [r]); - t := skipTypes(t.sons[0], abstractInst) - end; - if gCmd <> cmdCompileToCpp then - while (t.kind = tyObject) and (t.sons[0] <> nil) do begin - app(r, '.Sup'); - t := skipTypes(t.sons[0], abstractInst); - end; - if nilCheck <> nil then - appf(p.s[cpsStmts], 'if ($1) chckObj($2.m_type, $3);$n', - [nilCheck, r, genTypeInfo(p.module, dest)]) - else - appf(p.s[cpsStmts], 'chckObj($1.m_type, $2);$n', - [r, genTypeInfo(p.module, dest)]); - end; - if n.sons[0].typ.kind <> tyObject then - putIntoDest(p, d, n.typ, ropef('(($1) ($2))', - [getTypeDesc(p.module, n.typ), rdLoc(a)])) - else - putIntoDest(p, d, n.typ, ropef('(*($1*) ($2))', - [getTypeDesc(p.module, dest), addrLoc(a)])); -end; - -procedure downConv(p: BProc; n: PNode; var d: TLoc); -var - a: TLoc; - dest, src: PType; - i: int; - r: PRope; -begin - if gCmd = cmdCompileToCpp then - expr(p, n.sons[0], d) // downcast does C++ for us - else begin - dest := skipTypes(n.typ, abstractPtrs); - src := skipTypes(n.sons[0].typ, abstractPtrs); - initLocExpr(p, n.sons[0], a); - r := rdLoc(a); - if skipTypes(n.sons[0].typ, abstractInst).kind in [tyRef, tyPtr, tyVar] - then begin - app(r, '->Sup'); - for i := 2 to abs(inheritanceDiff(dest, src)) do app(r, '.Sup'); - r := con('&'+'', r); - end - else - for i := 1 to abs(inheritanceDiff(dest, src)) do app(r, '.Sup'); - putIntoDest(p, d, n.typ, r); - end -end; - -procedure genBlock(p: BProc; t: PNode; var d: TLoc); forward; - -procedure expr(p: BProc; e: PNode; var d: TLoc); -var - sym: PSym; - ty: PType; -begin - case e.kind of - nkSym: begin - sym := e.sym; - case sym.Kind of - skMethod: begin - if sym.ast.sons[codePos] = nil then begin - // we cannot produce code for the dispatcher yet: - fillProcLoc(sym); - genProcPrototype(p.module, sym); - end - else - genProc(p.module, sym); - putLocIntoDest(p, d, sym.loc); - end; - skProc, skConverter: begin - genProc(p.module, sym); - if ((sym.loc.r = nil) or (sym.loc.t = nil)) then - InternalError(e.info, 'expr: proc not init ' + sym.name.s); - putLocIntoDest(p, d, sym.loc); - end; - skConst: - if isSimpleConst(sym.typ) then - putIntoDest(p, d, e.typ, genLiteral(p, sym.ast, sym.typ)) - else - genComplexConst(p, sym, d); - skEnumField: putIntoDest(p, d, e.typ, toRope(sym.position)); - skVar: begin - if (sfGlobal in sym.flags) then genVarPrototype(p.module, sym); - if ((sym.loc.r = nil) or (sym.loc.t = nil)) then - InternalError(e.info, 'expr: var not init ' + sym.name.s); - putLocIntoDest(p, d, sym.loc); - end; - skForVar, skTemp: begin - if ((sym.loc.r = nil) or (sym.loc.t = nil)) then - InternalError(e.info, 'expr: temp not init ' + sym.name.s); - putLocIntoDest(p, d, sym.loc) - end; - skParam: begin - if ((sym.loc.r = nil) or (sym.loc.t = nil)) then - InternalError(e.info, 'expr: param not init ' + sym.name.s); - putLocIntoDest(p, d, sym.loc) - end - else - InternalError(e.info, 'expr(' +{&} symKindToStr[sym.kind] +{&} - '); unknown symbol') - end - end; - //nkQualified: expr(p, e.sons[1], d); - nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, - nkFloatLit..nkFloat64Lit, nkNilLit, nkCharLit: begin - putIntoDest(p, d, e.typ, genLiteral(p, e)); - end; - nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit: begin - if (e.sons[0].kind = nkSym) and - (e.sons[0].sym.magic <> mNone) then - genMagicExpr(p, e, d, e.sons[0].sym.magic) - else - genCall(p, e, d) - end; - nkCurly: genSetConstr(p, e, d); - nkBracket: - if (skipTypes(e.typ, abstractVarRange).kind = tySequence) then - genSeqConstr(p, e, d) - else - genArrayConstr(p, e, d); - nkPar: - genTupleConstr(p, e, d); - nkCast: genCast(p, e, d); - nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, e, d); - nkHiddenAddr, nkAddr: genAddr(p, e, d); - nkBracketExpr: begin - ty := skipTypes(e.sons[0].typ, abstractVarRange); - if ty.kind in [tyRef, tyPtr] then - ty := skipTypes(ty.sons[0], abstractVarRange); - case ty.kind of - tyArray, tyArrayConstr: genArrayElem(p, e, d); - tyOpenArray: genOpenArrayElem(p, e, d); - tySequence, tyString: genSeqElem(p, e, d); - tyCString: genCStringElem(p, e, d); - tyTuple: genTupleElem(p, e, d); - else InternalError(e.info, - 'expr(nkBracketExpr, ' + typeKindToStr[ty.kind] + ')'); - end - end; - nkDerefExpr, nkHiddenDeref: genDeref(p, e, d); - nkDotExpr: genRecordField(p, e, d); - nkCheckedFieldExpr: genCheckedRecordField(p, e, d); - nkBlockExpr: genBlock(p, e, d); - nkStmtListExpr: genStmtListExpr(p, e, d); - nkIfExpr: genIfExpr(p, e, d); - nkObjDownConv: downConv(p, e, d); - nkObjUpConv: upConv(p, e, d); - nkChckRangeF: genRangeChck(p, e, d, 'chckRangeF'); - nkChckRange64: genRangeChck(p, e, d, 'chckRange64'); - nkChckRange: genRangeChck(p, e, d, 'chckRange'); - nkStringToCString: convStrToCStr(p, e, d); - nkCStringToString: convCStrToStr(p, e, d); - nkPassAsOpenArray: passToOpenArray(p, e, d); - else - InternalError(e.info, 'expr(' +{&} nodeKindToStr[e.kind] +{&} - '); unknown node kind') - end -end; - -// ---------------------- generation of complex constants --------------------- - -function genNamedConstExpr(p: BProc; n: PNode): PRope; -begin - if n.kind = nkExprColonExpr then - result := genConstExpr(p, n.sons[1]) - else - result := genConstExpr(p, n); -end; - -function genConstSimpleList(p: BProc; n: PNode): PRope; -var - len, i: int; -begin - len := sonsLen(n); - result := toRope('{'+''); - for i := 0 to len - 2 do - appf(result, '$1,$n', [genNamedConstExpr(p, n.sons[i])]); - if len > 0 then app(result, genNamedConstExpr(p, n.sons[len-1])); - app(result, '}' + tnl) -end; - -function genConstExpr(p: BProc; n: PNode): PRope; -var - cs: TBitSet; - d: TLoc; -begin - case n.Kind of - nkHiddenStdConv, nkHiddenSubConv: result := genConstExpr(p, n.sons[1]); - nkCurly: begin - toBitSet(n, cs); - result := genRawSetData(cs, int(getSize(n.typ))) - end; - nkBracket, nkPar: begin - // XXX: tySequence! - result := genConstSimpleList(p, n); - end - else begin - // result := genLiteral(p, n) - initLocExpr(p, n, d); - result := rdLoc(d) - end - end -end; diff --git a/nim/ccgstmts.pas b/nim/ccgstmts.pas deleted file mode 100755 index d31f0e5bda..0000000000 --- a/nim/ccgstmts.pas +++ /dev/null @@ -1,989 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -const - RangeExpandLimit = 256; // do not generate ranges - // over 'RangeExpandLimit' elements - -procedure genLineDir(p: BProc; t: PNode); -var - line: int; -begin - line := toLinenumber(t.info); // BUGFIX - if line < 0 then line := 0; // negative numbers are not allowed in #line - if optLineDir in p.Options then - appff(p.s[cpsStmts], - '#line $2 "$1"$n', - '; line $2 "$1"$n', - [toRope(toFilename(t.info)), toRope(line)]); - if ([optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb]) and - ((p.prc = nil) or not (sfPure in p.prc.flags)) then begin - useMagic(p.module, 'endb'); // new: endb support - appff(p.s[cpsStmts], 'endb($1);$n', - 'call void @endb(%NI $1)$n', - [toRope(line)]) - end - else if ([optLineTrace, optStackTrace] * p.Options = - [optLineTrace, optStackTrace]) and ((p.prc = nil) or - not (sfPure in p.prc.flags)) then begin - inc(p.labels); - appff(p.s[cpsStmts], 'F.line = $1;$n', - '%LOC$2 = getelementptr %TF %F, %NI 2$n' + - 'store %NI $1, %NI* %LOC$2$n', - [toRope(line), toRope(p.labels)]) - end -end; - -procedure finishTryStmt(p: BProc; howMany: int); -var - i: int; -begin - for i := 1 to howMany do begin - inc(p.labels, 3); - appff(p.s[cpsStmts], 'excHandler = excHandler->prev;$n', - '%LOC$1 = load %TSafePoint** @excHandler$n' + - '%LOC$2 = getelementptr %TSafePoint* %LOC$1, %NI 0$n' + - '%LOC$3 = load %TSafePoint** %LOC$2$n' + - 'store %TSafePoint* %LOC$3, %TSafePoint** @excHandler$n', - [toRope(p.labels), toRope(p.labels-1), toRope(p.labels-2)]); - end -end; - -procedure genReturnStmt(p: BProc; t: PNode); -begin - p.beforeRetNeeded := true; - genLineDir(p, t); - if (t.sons[0] <> nil) then genStmts(p, t.sons[0]); - finishTryStmt(p, p.nestedTryStmts); - appff(p.s[cpsStmts], 'goto BeforeRet;$n', 'br label %BeforeRet$n', []) -end; - -procedure initVariable(p: BProc; v: PSym); -begin - if containsGarbageCollectedRef(v.typ) or (v.ast = nil) then - // Language change: always initialize variables if v.ast == nil! - if not (skipTypes(v.typ, abstractVarRange).Kind in [tyArray, - tyArrayConstr, tySet, tyTuple, tyObject]) then begin - if gCmd = cmdCompileToLLVM then - appf(p.s[cpsStmts], 'store $2 0, $2* $1$n', - [addrLoc(v.loc), getTypeDesc(p.module, v.loc.t)]) - else - appf(p.s[cpsStmts], '$1 = 0;$n', [rdLoc(v.loc)]) - end - else begin - if gCmd = cmdCompileToLLVM then begin - app(p.module.s[cfsProcHeaders], - 'declare void @llvm.memset.i32(i8*, i8, i32, i32)' + tnl); - inc(p.labels, 2); - appf(p.s[cpsStmts], - '%LOC$3 = getelementptr $2* null, %NI 1$n' + - '%LOC$4 = cast $2* %LOC$3 to i32$n' + - 'call void @llvm.memset.i32(i8* $1, i8 0, i32 %LOC$4, i32 0)$n', - [addrLoc(v.loc), getTypeDesc(p.module, v.loc.t), - toRope(p.labels), toRope(p.labels-1)]) - end - else - appf(p.s[cpsStmts], 'memset((void*)$1, 0, sizeof($2));$n', - [addrLoc(v.loc), rdLoc(v.loc)]) - end -end; - -procedure genVarTuple(p: BProc; n: PNode); -var - i, L: int; - v: PSym; - tup, field: TLoc; - t: PType; -begin - if n.kind <> nkVarTuple then InternalError(n.info, 'genVarTuple'); - L := sonsLen(n); - genLineDir(p, n); - initLocExpr(p, n.sons[L-1], tup); - t := tup.t; - for i := 0 to L-3 do begin - v := n.sons[i].sym; - if sfGlobal in v.flags then - assignGlobalVar(p, v) - else begin - assignLocalVar(p, v); - initVariable(p, v) - end; - // generate assignment: - initLoc(field, locExpr, t.sons[i], tup.s); - if t.n = nil then begin - field.r := ropef('$1.Field$2', [rdLoc(tup), toRope(i)]); - end - else begin - if (t.n.sons[i].kind <> nkSym) then - InternalError(n.info, 'genVarTuple'); - field.r := ropef('$1.$2', [rdLoc(tup), - mangleRecFieldName(t.n.sons[i].sym, t)]); - end; - putLocIntoDest(p, v.loc, field); - genObjectInit(p, v.typ, v.loc, true); - end -end; - -procedure genVarStmt(p: BProc; n: PNode); -var - i: int; - v: PSym; - a: PNode; -begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if a.kind = nkIdentDefs then begin - assert(a.sons[0].kind = nkSym); - v := a.sons[0].sym; - if sfGlobal in v.flags then - assignGlobalVar(p, v) - else begin - assignLocalVar(p, v); - initVariable(p, v) // XXX: this is not required if a.sons[2] != nil, - // unless it is a GC'ed pointer - end; - // generate assignment: - if a.sons[2] <> nil then begin - genLineDir(p, a); - expr(p, a.sons[2], v.loc); - end; - genObjectInit(p, v.typ, v.loc, true); // correct position - end - else - genVarTuple(p, a); - end -end; - -procedure genConstStmt(p: BProc; t: PNode); -var - c: PSym; - i: int; -begin - for i := 0 to sonsLen(t)-1 do begin - if t.sons[i].kind = nkCommentStmt then continue; - if t.sons[i].kind <> nkConstDef then InternalError(t.info, 'genConstStmt'); - c := t.sons[i].sons[0].sym; - // This can happen for forward consts: - if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and - not (lfNoDecl in c.loc.flags) then begin - // generate the data: - fillLoc(c.loc, locData, c.typ, mangleName(c), OnUnknown); - if sfImportc in c.flags then - appf(p.module.s[cfsData], 'extern NIM_CONST $1 $2;$n', - [getTypeDesc(p.module, c.typ), c.loc.r]) - else - appf(p.module.s[cfsData], 'NIM_CONST $1 $2 = $3;$n', - [getTypeDesc(p.module, c.typ), c.loc.r, - genConstExpr(p, c.ast)]) - end - end -end; - -procedure genIfStmt(p: BProc; n: PNode); -(* - if (!expr1) goto L1; - thenPart - goto LEnd - L1: - if (!expr2) goto L2; - thenPart2 - goto LEnd - L2: - elsePart - Lend: -*) -var - i: int; - it: PNode; - a: TLoc; - Lend, Lelse: TLabel; -begin - genLineDir(p, n); - Lend := getLabel(p); - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - case it.kind of - nkElifBranch: begin - initLocExpr(p, it.sons[0], a); - Lelse := getLabel(p); - inc(p.labels); - appff(p.s[cpsStmts], 'if (!$1) goto $2;$n', - 'br i1 $1, label %LOC$3, label %$2$n' + - 'LOC$3: $n', - [rdLoc(a), Lelse, toRope(p.labels)]); - genStmts(p, it.sons[1]); - if sonsLen(n) > 1 then - appff(p.s[cpsStmts], 'goto $1;$n', 'br label %$1$n', [Lend]); - fixLabel(p, Lelse); - end; - nkElse: begin - genStmts(p, it.sons[0]); - end; - else internalError(n.info, 'genIfStmt()'); - end - end; - if sonsLen(n) > 1 then - fixLabel(p, Lend); -end; - -procedure genWhileStmt(p: BProc; t: PNode); -// we don't generate labels here as for example GCC would produce -// significantly worse code -var - a: TLoc; - Labl: TLabel; - len: int; -begin - genLineDir(p, t); - assert(sonsLen(t) = 2); - inc(p.labels); - Labl := con('LA', toRope(p.labels)); - len := length(p.blocks); - setLength(p.blocks, len+1); - p.blocks[len].id := -p.labels; // negative because it isn't used yet - p.blocks[len].nestedTryStmts := p.nestedTryStmts; - app(p.s[cpsStmts], 'while (1) {' + tnl); - initLocExpr(p, t.sons[0], a); - if (t.sons[0].kind <> nkIntLit) or (t.sons[0].intVal = 0) then begin - p.blocks[len].id := abs(p.blocks[len].id); - appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Labl]); - end; - genStmts(p, t.sons[1]); - if p.blocks[len].id > 0 then - appf(p.s[cpsStmts], '} $1: ;$n', [Labl]) - else - app(p.s[cpsStmts], '}'+tnl); - setLength(p.blocks, length(p.blocks)-1) -end; - -procedure genBlock(p: BProc; t: PNode; var d: TLoc); -var - idx: int; - sym: PSym; -begin - inc(p.labels); - idx := length(p.blocks); - if t.sons[0] <> nil then begin // named block? - assert(t.sons[0].kind = nkSym); - sym := t.sons[0].sym; - sym.loc.k := locOther; - sym.loc.a := idx - end; - setLength(p.blocks, idx+1); - p.blocks[idx].id := -p.labels; // negative because it isn't used yet - p.blocks[idx].nestedTryStmts := p.nestedTryStmts; - if t.kind = nkBlockExpr then genStmtListExpr(p, t.sons[1], d) - else genStmts(p, t.sons[1]); - if p.blocks[idx].id > 0 then // label has been used: - appf(p.s[cpsStmts], 'LA$1: ;$n', [toRope(p.blocks[idx].id)]); - setLength(p.blocks, idx) -end; - -// try: -// while: -// try: -// if ...: -// break # we need to finish only one try statement here! -// finally: - -procedure genBreakStmt(p: BProc; t: PNode); -var - idx: int; - sym: PSym; -begin - genLineDir(p, t); - idx := length(p.blocks)-1; - if t.sons[0] <> nil then begin // named break? - assert(t.sons[0].kind = nkSym); - sym := t.sons[0].sym; - assert(sym.loc.k = locOther); - idx := sym.loc.a - end; - p.blocks[idx].id := abs(p.blocks[idx].id); // label is used - finishTryStmt(p, p.nestedTryStmts - p.blocks[idx].nestedTryStmts); - appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.blocks[idx].id)]) -end; - -procedure genAsmStmt(p: BProc; t: PNode); -var - i: int; - sym: PSym; - r, s: PRope; - a: TLoc; -begin - genLineDir(p, t); - assert(t.kind = nkAsmStmt); - s := nil; - for i := 0 to sonsLen(t) - 1 do begin - case t.sons[i].Kind of - nkStrLit..nkTripleStrLit: app(s, t.sons[i].strVal); - nkSym: begin - sym := t.sons[i].sym; - if sym.kind in [skProc, skMethod] then begin - initLocExpr(p, t.sons[i], a); - app(s, rdLoc(a)); - end - else begin - r := sym.loc.r; - if r = nil then begin // if no name has already been given, - // it doesn't matter much: - r := mangleName(sym); - sym.loc.r := r; // but be consequent! - end; - app(s, r) - end - end - else - InternalError(t.sons[i].info, 'genAsmStmt()') - end - end; - appf(p.s[cpsStmts], CC[ccompiler].asmStmtFrmt, [s]); -end; - -function getRaiseFrmt(p: BProc): string; -begin - if gCmd = cmdCompileToCpp then - result := 'throw nimException($1, $2);$n' - else begin - useMagic(p.module, 'E_Base'); - result := 'raiseException((E_Base*)$1, $2);$n' - end -end; - -procedure genRaiseStmt(p: BProc; t: PNode); -var - e: PRope; - a: TLoc; - typ: PType; -begin - genLineDir(p, t); - if t.sons[0] <> nil then begin - if gCmd <> cmdCompileToCpp then useMagic(p.module, 'raiseException'); - InitLocExpr(p, t.sons[0], a); - e := rdLoc(a); - typ := t.sons[0].typ; - while typ.kind in [tyVar, tyRef, tyPtr] do typ := typ.sons[0]; - appf(p.s[cpsStmts], getRaiseFrmt(p), - [e, makeCString(typ.sym.name.s)]) - end - else begin - // reraise the last exception: - if gCmd = cmdCompileToCpp then - app(p.s[cpsStmts], 'throw;' + tnl) - else begin - useMagic(p.module, 'reraiseException'); - app(p.s[cpsStmts], 'reraiseException();' + tnl) - end - end -end; - -// ---------------- case statement generation ----------------------------- - -const - stringCaseThreshold = 100000; - // above X strings a hash-switch for strings is generated - // this version sets it too high to avoid hashing, because this has not - // been tested for a long time - // XXX test and enable this optimization! - -procedure genCaseGenericBranch(p: BProc; b: PNode; const e: TLoc; - const rangeFormat, eqFormat: TFormatStr; - labl: TLabel); -var - len, i: int; - x, y: TLoc; -begin - len := sonsLen(b); - for i := 0 to len - 2 do begin - if b.sons[i].kind = nkRange then begin - initLocExpr(p, b.sons[i].sons[0], x); - initLocExpr(p, b.sons[i].sons[1], y); - appf(p.s[cpsStmts], rangeFormat, - [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) - end - else begin - initLocExpr(p, b.sons[i], x); - appf(p.s[cpsStmts], eqFormat, - [rdCharLoc(e), rdCharLoc(x), labl]) - end - end -end; - -procedure genCaseSecondPass(p: BProc; t: PNode; labId: int); -var - Lend: TLabel; - i, len: int; -begin - Lend := getLabel(p); - for i := 1 to sonsLen(t) - 1 do begin - appf(p.s[cpsStmts], 'LA$1: ;$n', [toRope(labId+i)]); - if t.sons[i].kind = nkOfBranch then begin - len := sonsLen(t.sons[i]); - genStmts(p, t.sons[i].sons[len-1]); - appf(p.s[cpsStmts], 'goto $1;$n', [Lend]) - end - else // else statement - genStmts(p, t.sons[i].sons[0]) - end; - fixLabel(p, Lend); -end; - -procedure genCaseGeneric(p: BProc; t: PNode; const rangeFormat, - eqFormat: TFormatStr); - // generate a C-if statement for a Nimrod case statement -var - a: TLoc; - i, labId: int; -begin - initLocExpr(p, t.sons[0], a); - // fist pass: gnerate ifs+goto: - labId := p.labels; - for i := 1 to sonsLen(t) - 1 do begin - inc(p.labels); - if t.sons[i].kind = nkOfBranch then - genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat, - con('LA', toRope(p.labels))) - else - // else statement - appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.labels)]); - end; - // second pass: generate statements - genCaseSecondPass(p, t, labId); -end; - -{@ignore} -{$ifopt Q+} { we need Q- here! } - {$define Q_on} - {$Q-} -{$endif} - -{$ifopt R+} - {$define R_on} - {$R-} -{$endif} -{@emit} -function hashString(const s: string): biggestInt; -var - a: int32; - b: int64; - i: int; -begin - if CPU[targetCPU].bit = 64 then begin // we have to use the same bitwidth - // as the target CPU - b := 0; - for i := 0 to Length(s)-1 do begin - b := b +{%} Ord(s[i]); - b := b +{%} shlu(b, 10); - b := b xor shru(b, 6) - end; - b := b +{%} shlu(b, 3); - b := b xor shru(b, 11); - b := b +{%} shlu(b, 15); - result := b - end - else begin - a := 0; - for i := 0 to Length(s)-1 do begin - a := a +{%} int32(Ord(s[i])); - a := a +{%} shlu(a, int32(10)); - a := a xor shru(a, int32(6)); - end; - a := a +{%} shlu(a, int32(3)); - a := a xor shru(a, int32(11)); - a := a +{%} shlu(a, int32(15)); - result := a - end -end; -{@ignore} -{$ifdef Q_on} - {$undef Q_on} - {$Q+} -{$endif} - -{$ifdef R_on} - {$undef R_on} - {$R+} -{$endif} -{@emit} - -type - TRopeSeq = array of PRope; - -procedure genCaseStringBranch(p: BProc; b: PNode; const e: TLoc; - labl: TLabel; var branches: TRopeSeq); -var - len, i, j: int; - x: TLoc; -begin - len := sonsLen(b); - for i := 0 to len - 2 do begin - assert(b.sons[i].kind <> nkRange); - initLocExpr(p, b.sons[i], x); - assert(b.sons[i].kind in [nkStrLit..nkTripleStrLit]); - j := int(hashString(b.sons[i].strVal) and high(branches)); - appf(branches[j], 'if (eqStrings($1, $2)) goto $3;$n', - [rdLoc(e), rdLoc(x), labl]) - end -end; - -procedure genStringCase(p: BProc; t: PNode); -var - strings, i, j, bitMask, labId: int; - a: TLoc; - branches: TRopeSeq; -begin - useMagic(p.module, 'eqStrings'); - // count how many constant strings there are in the case: - strings := 0; - for i := 1 to sonsLen(t)-1 do - if t.sons[i].kind = nkOfBranch then inc(strings, sonsLen(t.sons[i])-1); - if strings > stringCaseThreshold then begin - useMagic(p.module, 'hashString'); - bitMask := nmath.nextPowerOfTwo(strings)-1; - {@ignore} - setLength(branches, bitMask+1); - {@emit newSeq(branches, bitMask+1);} - initLocExpr(p, t.sons[0], a); - // fist pass: gnerate ifs+goto: - labId := p.labels; - for i := 1 to sonsLen(t) - 1 do begin - inc(p.labels); - if t.sons[i].kind = nkOfBranch then - genCaseStringBranch(p, t.sons[i], a, con('LA', toRope(p.labels)), - branches) - else begin - // else statement: nothing to do yet - // but we reserved a label, which we use later - end - end; - // second pass: generate switch statement based on hash of string: - appf(p.s[cpsStmts], 'switch (hashString($1) & $2) {$n', - [rdLoc(a), toRope(bitMask)]); - for j := 0 to high(branches) do - if branches[j] <> nil then - appf(p.s[cpsStmts], 'case $1: $n$2break;$n', - [intLiteral(j), branches[j]]); - app(p.s[cpsStmts], '}' + tnl); - // else statement: - if t.sons[sonsLen(t)-1].kind <> nkOfBranch then - appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.labels)]); - // third pass: generate statements - genCaseSecondPass(p, t, labId); - end - else - genCaseGeneric(p, t, '', 'if (eqStrings($1, $2)) goto $3;$n') -end; - -function branchHasTooBigRange(b: PNode): bool; -var - i: int; -begin - for i := 0 to sonsLen(b)-2 do begin // last son is block - if (b.sons[i].Kind = nkRange) and - (b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > - RangeExpandLimit) then begin - result := true; exit - end; - end; - result := false -end; - -procedure genOrdinalCase(p: BProc; t: PNode); -// We analyse if we have a too big switch range. If this is the case, -// we generate an ordinary if statement and rely on the C compiler -// to produce good code. -var - canGenerateSwitch, hasDefault: bool; - i, j, len: int; - a: TLoc; - v: PNode; -begin - canGenerateSwitch := true; - if not (hasSwitchRange in CC[ccompiler].props) then - // if the C compiler supports switch ranges, no analysis is necessary - for i := 1 to sonsLen(t)-1 do - if (t.sons[i].kind = nkOfBranch) and branchHasTooBigRange(t.sons[i]) then - begin - canGenerateSwitch := false; - break - end; - if canGenerateSwitch then begin - initLocExpr(p, t.sons[0], a); - appf(p.s[cpsStmts], 'switch ($1) {$n', [rdCharLoc(a)]); - hasDefault := false; - for i := 1 to sonsLen(t)-1 do begin - if t.sons[i].kind = nkOfBranch then begin - len := sonsLen(t.sons[i]); - for j := 0 to len-2 do begin - if t.sons[i].sons[j].kind = nkRange then begin // a range - if hasSwitchRange in CC[ccompiler].props then - appf(p.s[cpsStmts], 'case $1 ... $2:$n', - [genLiteral(p, t.sons[i].sons[j].sons[0]), - genLiteral(p, t.sons[i].sons[j].sons[1])]) - else begin - v := copyNode(t.sons[i].sons[j].sons[0]); - while (v.intVal <= t.sons[i].sons[j].sons[1].intVal) do begin - appf(p.s[cpsStmts], 'case $1:$n', [genLiteral(p, v)]); - Inc(v.intVal) - end - end; - end - else - appf(p.s[cpsStmts], 'case $1:$n', - [genLiteral(p, t.sons[i].sons[j])]); - end; - genStmts(p, t.sons[i].sons[len-1]) - end - else begin // else part of case statement: - app(p.s[cpsStmts], 'default:' + tnl); - genStmts(p, t.sons[i].sons[0]); - hasDefault := true; - end; - app(p.s[cpsStmts], 'break;' + tnl); - end; - if (hasAssume in CC[ccompiler].props) and not hasDefault then - app(p.s[cpsStmts], 'default: __assume(0);' + tnl); - app(p.s[cpsStmts], '}' + tnl); - end - else - genCaseGeneric(p, t, - 'if ($1 >= $2 && $1 <= $3) goto $4;$n', - 'if ($1 == $2) goto $3;$n') -end; - -procedure genCaseStmt(p: BProc; t: PNode); -begin - genLineDir(p, t); - case skipTypes(t.sons[0].typ, abstractVarRange).kind of - tyString: genStringCase(p, t); - tyFloat..tyFloat128: - genCaseGeneric(p, t, 'if ($1 >= $2 && $1 <= $3) goto $4;$n', - 'if ($1 == $2) goto $3;$n'); - // ordinal type: generate a switch statement - else genOrdinalCase(p, t) - end -end; - -// ----------------------- end of case statement generation --------------- - -function hasGeneralExceptSection(t: PNode): bool; -var - len, i, blen: int; -begin - len := sonsLen(t); - i := 1; - while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin - blen := sonsLen(t.sons[i]); - if blen = 1 then begin result := true; exit end; - inc(i) - end; - result := false -end; - -procedure genTryStmtCpp(p: BProc; t: PNode); - // code to generate: -(* - bool tmpRethrow = false; - try - { - myDiv(4, 9); - } catch (NimException& tmp) { - tmpRethrow = true; - switch (tmp.exc) - { - case DIVIDE_BY_ZERO: - tmpRethrow = false; - printf('Division by Zero\n'); - break; - default: // used for general except! - generalExceptPart(); - tmpRethrow = false; - } - } - excHandler = excHandler->prev; // we handled the exception - finallyPart(); - if (tmpRethrow) throw; *) -var - rethrowFlag: PRope; - exc: PRope; - i, len, blen, j: int; -begin - genLineDir(p, t); - rethrowFlag := nil; - exc := getTempName(); - if not hasGeneralExceptSection(t) then begin - rethrowFlag := getTempName(); - appf(p.s[cpsLocals], 'volatile NIM_BOOL $1 = NIM_FALSE;$n', - [rethrowFlag]) - end; - if optStackTrace in p.Options then - app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl); - app(p.s[cpsStmts], 'try {' + tnl); - inc(p.nestedTryStmts); - genStmts(p, t.sons[0]); - len := sonsLen(t); - if t.sons[1].kind = nkExceptBranch then begin - appf(p.s[cpsStmts], '} catch (NimException& $1) {$n', [exc]); - if rethrowFlag <> nil then - appf(p.s[cpsStmts], '$1 = NIM_TRUE;$n', [rethrowFlag]); - appf(p.s[cpsStmts], 'if ($1.sp.exc) {$n', [exc]) - end; // XXX: this is not correct! - i := 1; - while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin - blen := sonsLen(t.sons[i]); - if blen = 1 then begin // general except section: - app(p.s[cpsStmts], 'default: ' + tnl); - genStmts(p, t.sons[i].sons[0]) - end - else begin - for j := 0 to blen - 2 do begin - assert(t.sons[i].sons[j].kind = nkType); - appf(p.s[cpsStmts], 'case $1:$n', - [toRope(t.sons[i].sons[j].typ.id)]) - end; - genStmts(p, t.sons[i].sons[blen - 1]) - end; - // code to clear the exception: - if rethrowFlag <> nil then - appf(p.s[cpsStmts], '$1 = NIM_FALSE; ', [rethrowFlag]); - app(p.s[cpsStmts], 'break;' + tnl); - inc(i); - end; - if t.sons[1].kind = nkExceptBranch then // BUGFIX - app(p.s[cpsStmts], '}}' + tnl); // end of catch-switch statement - dec(p.nestedTryStmts); - app(p.s[cpsStmts], 'excHandler = excHandler->prev;' + tnl); - if (i < len) and (t.sons[i].kind = nkFinally) then begin - genStmts(p, t.sons[i].sons[0]); - if rethrowFlag <> nil then - appf(p.s[cpsStmts], 'if ($1) { throw; }$n', [rethrowFlag]) - end -end; - -procedure genTryStmt(p: BProc; t: PNode); - // code to generate: -(* - sp.prev = excHandler; - excHandler = &sp; - sp.status = setjmp(sp.context); - if (sp.status == 0) { - myDiv(4, 9); - } else { - /* except DivisionByZero: */ - if (sp.status == DivisionByZero) { - printf('Division by Zero\n'); - - /* longjmp(excHandler->context, RangeError); /* raise rangeError */ - sp.status = RangeError; /* if raise; else 0 */ - } - } - /* finally: */ - printf('fin!\n'); - if (sp.status != 0) - longjmp(excHandler->context, sp.status); - excHandler = excHandler->prev; /* deactivate this safe point */ *) -var - i, j, len, blen: int; - safePoint, orExpr: PRope; -begin - genLineDir(p, t); - - safePoint := getTempName(); - useMagic(p.module, 'TSafePoint'); - useMagic(p.module, 'E_Base'); - useMagic(p.module, 'excHandler'); - appf(p.s[cpsLocals], 'TSafePoint $1;$n', [safePoint]); - appf(p.s[cpsStmts], '$1.prev = excHandler;$n' + - 'excHandler = &$1;$n' + - '$1.status = setjmp($1.context);$n', - [safePoint]); - if optStackTrace in p.Options then - app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl); - appf(p.s[cpsStmts], 'if ($1.status == 0) {$n', [safePoint]); - len := sonsLen(t); - inc(p.nestedTryStmts); - genStmts(p, t.sons[0]); - app(p.s[cpsStmts], '} else {' + tnl); - i := 1; - while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin - blen := sonsLen(t.sons[i]); - if blen = 1 then begin - // general except section: - if i > 1 then app(p.s[cpsStmts], 'else {' + tnl); - genStmts(p, t.sons[i].sons[0]); - appf(p.s[cpsStmts], '$1.status = 0;$n', [safePoint]); - if i > 1 then app(p.s[cpsStmts], '}' + tnl); - end - else begin - orExpr := nil; - for j := 0 to blen - 2 do begin - assert(t.sons[i].sons[j].kind = nkType); - if orExpr <> nil then app(orExpr, '||'); - appf(orExpr, '($1.exc->Sup.m_type == $2)', - [safePoint, genTypeInfo(p.module, t.sons[i].sons[j].typ)]) - end; - if i > 1 then app(p.s[cpsStmts], 'else '); - appf(p.s[cpsStmts], 'if ($1) {$n', [orExpr]); - genStmts(p, t.sons[i].sons[blen - 1]); - // code to clear the exception: - appf(p.s[cpsStmts], '$1.status = 0;}$n', [safePoint]); - end; - inc(i) - end; - app(p.s[cpsStmts], '}' + tnl); // end of if statement - finishTryStmt(p, p.nestedTryStmts); - dec(p.nestedTryStmts); - if (i < len) and (t.sons[i].kind = nkFinally) then begin - genStmts(p, t.sons[i].sons[0]); - useMagic(p.module, 'raiseException'); - appf(p.s[cpsStmts], 'if ($1.status != 0) { ' + - 'raiseException($1.exc, $1.exc->name); }$n', [safePoint]) - end -end; - -var - breakPointId: int = 0; - gBreakpoints: PRope; // later the breakpoints are inserted into the main proc - -procedure genBreakPoint(p: BProc; t: PNode); -var - name: string; -begin - if optEndb in p.Options then begin - if t.kind = nkExprColonExpr then begin - assert(t.sons[1].kind in [nkStrLit..nkTripleStrLit]); - name := normalize(t.sons[1].strVal) - end - else begin - inc(breakPointId); - name := 'bp' + toString(breakPointId) - end; - genLineDir(p, t); // BUGFIX - appf(gBreakpoints, - 'dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n', - [toRope(toLinenumber(t.info)), makeCString(toFilename(t.info)), - makeCString(name)]) - end -end; - -procedure genPragma(p: BProc; n: PNode); -var - i: int; - it, key: PNode; -begin - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it.kind = nkExprColonExpr then begin - key := it.sons[0]; - end - else begin - key := it; - end; - if key.kind = nkIdent then - case whichKeyword(key.ident) of - wBreakpoint: genBreakPoint(p, it); - wDeadCodeElim: begin - if not (optDeadCodeElim in gGlobalOptions) then begin - // we need to keep track of ``deadCodeElim`` pragma - if (sfDeadCodeElim in p.module.module.flags) then - addPendingModule(p.module) - end - end - else begin end - end - end -end; - -procedure genAsgn(p: BProc; e: PNode); -var - a: TLoc; -begin - genLineDir(p, e); // BUGFIX - InitLocExpr(p, e.sons[0], a); - assert(a.t <> nil); - expr(p, e.sons[1], a); -end; - -procedure genFastAsgn(p: BProc; e: PNode); -var - a: TLoc; -begin - genLineDir(p, e); // BUGFIX - InitLocExpr(p, e.sons[0], a); - include(a.flags, lfNoDeepCopy); - assert(a.t <> nil); - expr(p, e.sons[1], a); -end; - -procedure genStmts(p: BProc; t: PNode); -var - a: TLoc; - i: int; - prc: PSym; -begin - //assert(t <> nil); - if inCheckpoint(t.info) then - MessageOut(renderTree(t)); - case t.kind of - nkEmpty: begin end; // nothing to do! - nkStmtList: begin - for i := 0 to sonsLen(t)-1 do genStmts(p, t.sons[i]); - end; - nkBlockStmt: genBlock(p, t, a); - nkIfStmt: genIfStmt(p, t); - nkWhileStmt: genWhileStmt(p, t); - nkVarSection: genVarStmt(p, t); - nkConstSection: genConstStmt(p, t); - nkForStmt: internalError(t.info, 'for statement not eliminated'); - nkCaseStmt: genCaseStmt(p, t); - nkReturnStmt: genReturnStmt(p, t); - nkBreakStmt: genBreakStmt(p, t); - nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit: begin - genLineDir(p, t); - initLocExpr(p, t, a); - end; - nkAsgn: genAsgn(p, t); - nkFastAsgn: genFastAsgn(p, t); - nkDiscardStmt: begin - genLineDir(p, t); - initLocExpr(p, t.sons[0], a); - end; - nkAsmStmt: genAsmStmt(p, t); - nkTryStmt: begin - if gCmd = cmdCompileToCpp then genTryStmtCpp(p, t) - else genTryStmt(p, t); - end; - nkRaiseStmt: genRaiseStmt(p, t); - nkTypeSection: begin - // we have to emit the type information for object types here to support - // separate compilation: - genTypeSection(p.module, t); - end; - nkCommentStmt, nkNilLit, nkIteratorDef, nkIncludeStmt, nkImportStmt, - nkFromStmt, nkTemplateDef, nkMacroDef: begin end; - nkPragma: genPragma(p, t); - nkProcDef, nkMethodDef, nkConverterDef: begin - if (t.sons[genericParamsPos] = nil) then begin - prc := t.sons[namePos].sym; - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in getModule(prc).flags) - or ([sfExportc, sfCompilerProc] * prc.flags = [sfExportc]) - or (prc.kind = skMethod) then begin - if (t.sons[codePos] <> nil) or (lfDynamicLib in prc.loc.flags) then begin - genProc(p.module, prc) - end - end - end - end; - else - internalError(t.info, 'genStmts(' +{&} nodeKindToStr[t.kind] +{&} ')') - end -end; diff --git a/nim/ccgtypes.pas b/nim/ccgtypes.pas deleted file mode 100755 index 1c07fe5c75..0000000000 --- a/nim/ccgtypes.pas +++ /dev/null @@ -1,1082 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -//var -// newDummyVar: int; // just to check the symbol file mechanism - -// ------------------------- Name Mangling -------------------------------- - -function mangle(const name: string): string; -var - i: int; -begin - case name[strStart] of - 'a'..'z': begin - result := ''; - addChar(result, chr(ord(name[strStart]) - ord('a') + ord('A'))); - end; - '0'..'9', 'A'..'Z': begin - result := ''; - addChar(result, name[strStart]); - end; - else - result := 'HEX' + toHex(ord(name[strStart]), 2); - end; - for i := strStart+1 to length(name) + strStart-1 do begin - case name[i] of - 'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a'))); - '_': begin end; - 'a'..'z', '0'..'9': addChar(result, name[i]); - else begin - add(result, 'HEX'); - add(result, toHex(ord(name[i]), 2)) - end - end - end -end; - -function mangleName(s: PSym): PRope; -begin - result := s.loc.r; - if result = nil then begin - if gCmd = cmdCompileToLLVM then begin - case s.kind of - skProc, skMethod, skConverter, skConst: result := toRope('@'+''); - skVar: begin - if (sfGlobal in s.flags) then result := toRope('@'+'') - else result := toRope('%'+''); - end; - skForVar, skTemp, skParam, skType, skEnumField, skModule: - result := toRope('%'+''); - else InternalError(s.info, 'mangleName'); - end; - end; - app(result, toRope(mangle(s.name.s))); - app(result, '_'+''); - app(result, toRope(s.id)); - if optGenMapping in gGlobalOptions then - if s.owner <> nil then - appf(gMapping, 'r"$1.$2": $3$n', - [toRope(s.owner.Name.s), toRope(s.name.s), result]); - s.loc.r := result; - end -end; - -function getTypeName(typ: PType): PRope; -begin - if (typ.sym <> nil) and ([sfImportc, sfExportc] * typ.sym.flags <> []) - and (gCmd <> cmdCompileToLLVM) then - result := typ.sym.loc.r - else begin - if typ.loc.r = nil then - typ.loc.r := ropeff('TY$1', '%TY$1', [toRope(typ.id)]); - result := typ.loc.r - end; - if result = nil then InternalError('getTypeName: ' + typeKindToStr[typ.kind]); -end; - -// ----------------------------- other helpers ---------------------------- -(* -function getSizeof(m: BModule; var labels: int; - var body: PRope; typ: PType): PRope; -begin - if (gCmd <> cmdCompileToLLVM) then - result := ropef('sizeof($1)', getTypeDesc(m, typ)) - else begin - inc(labels, 2); - result := ropef('%UOC$1', [toRope(labels)]); - appf(body, '%UOC$1 = getelementptr $3* null, %NI 1$n' + - '$2 = cast $3* %UOC$1 to i32$n', - [toRope(labels-1), result, getTypeDesc(m, typ)]); - end -end; *) - -// ------------------------------ C type generator ------------------------ - -function mapType(typ: PType): TCTypeKind; -begin - case typ.kind of - tyNone: result := ctVoid; - tyBool: result := ctBool; - tyChar: result := ctChar; - tySet: begin - case int(getSize(typ)) of - 1: result := ctInt8; - 2: result := ctInt16; - 4: result := ctInt32; - 8: result := ctInt64; - else result := ctArray - end - end; - tyOpenArray, tyArrayConstr, tyArray: result := ctArray; - tyObject, tyTuple: result := ctStruct; - tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal: - result := mapType(lastSon(typ)); - tyEnum: begin - if firstOrd(typ) < 0 then - result := ctInt32 - else begin - case int(getSize(typ)) of - 1: result := ctUInt8; - 2: result := ctUInt16; - 4: result := ctInt32; - 8: result := ctInt64; - else internalError('mapType'); - end - end - end; - tyRange: result := mapType(typ.sons[0]); - tyPtr, tyVar, tyRef: begin - case typ.sons[0].kind of - tyOpenArray, tyArrayConstr, tyArray: result := ctArray; - else result := ctPtr - end - end; - tyPointer: result := ctPtr; - tySequence: result := ctNimSeq; - tyProc: result := ctProc; - tyString: result := ctNimStr; - tyCString: result := ctCString; - tyInt..tyFloat128: - result := TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)); - else InternalError('mapType'); - end -end; - -function mapReturnType(typ: PType): TCTypeKind; -begin - if skipTypes(typ, abstractInst).kind = tyArray then result := ctPtr - else result := mapType(typ) -end; - -function getTypeDescAux(m: BModule; typ: PType; - var check: TIntSet): PRope; forward; - -function needsComplexAssignment(typ: PType): bool; -begin - result := containsGarbageCollectedRef(typ); -end; - -function isInvalidReturnType(rettype: PType): bool; -begin - // Arrays and sets cannot be returned by a C procedure, because C is - // such a poor programming language. - // We exclude records with refs too. This enhances efficiency and - // is necessary for proper code generation of assignments. - if rettype = nil then - result := true - else begin - case mapType(rettype) of - ctArray: - result := not (skipTypes(rettype, abstractInst).kind in [tyVar, tyRef, tyPtr]); - ctStruct: - result := needsComplexAssignment(skipTypes(rettype, abstractInst)); - else result := false; - end - end -end; - -const - CallingConvToStr: array [TCallingConvention] of string = ('N_NIMCALL', - 'N_STDCALL', 'N_CDECL', 'N_SAFECALL', 'N_SYSCALL', - // this is probably not correct for all platforms, - // but one can //define it to what you want so there will no problem - 'N_INLINE', 'N_NOINLINE', 'N_FASTCALL', 'N_CLOSURE', 'N_NOCONV'); - - CallingConvToStrLLVM: array [TCallingConvention] of string = ('fastcc $1', - 'stdcall $1', 'ccc $1', 'safecall $1', 'syscall $1', - '$1 alwaysinline', '$1 noinline', 'fastcc $1', 'ccc $1', '$1'); - -function CacheGetType(const tab: TIdTable; key: PType): PRope; -begin - // returns nil if we need to declare this type - // since types are now unique via the ``GetUniqueType`` mechanism, this slow - // linear search is not necessary anymore: - result := PRope(IdTableGet(tab, key)) -end; - -function getTempName(): PRope; -begin - result := ropeff('TMP$1', '%TMP$1', [toRope(gId)]); - inc(gId); -end; - -function getGlobalTempName(): PRope; -begin - result := ropeff('TMP$1', '@TMP$1', [toRope(gId)]); - inc(gId); -end; - -function ccgIntroducedPtr(s: PSym): bool; -var - pt: PType; -begin - pt := s.typ; - assert(not (sfResult in s.flags)); - case pt.Kind of - tyObject: begin - // XXX quick hack floatSize*2 for the pegs module under 64bit - if (optByRef in s.options) or (getSize(pt) > platform.floatSize*2) then - result := true // requested anyway - else if (tfFinal in pt.flags) and (pt.sons[0] = nil) then - result := false // no need, because no subtyping possible - else - result := true; // ordinary objects are always passed by reference, - // otherwise casting doesn't work - end; - tyTuple: - result := (getSize(pt) > platform.floatSize) or (optByRef in s.options); - else - result := false - end -end; - -procedure fillResult(param: PSym); -begin - fillLoc(param.loc, locParam, param.typ, ropeff('Result', '%Result', []), - OnStack); - if (mapReturnType(param.typ) <> ctArray) - and IsInvalidReturnType(param.typ) then - begin - include(param.loc.flags, lfIndirect); - param.loc.s := OnUnknown - end -end; - -procedure genProcParams(m: BModule; t: PType; out rettype, params: PRope; - var check: TIntSet); -var - i, j: int; - param: PSym; - arr: PType; -begin - params := nil; - if (t.sons[0] = nil) or isInvalidReturnType(t.sons[0]) then - // C cannot return arrays (what a poor language...) - rettype := toRope('void') - else - rettype := getTypeDescAux(m, t.sons[0], check); - for i := 1 to sonsLen(t.n)-1 do begin - if t.n.sons[i].kind <> nkSym then InternalError(t.n.info, 'genProcParams'); - param := t.n.sons[i].sym; - fillLoc(param.loc, locParam, param.typ, mangleName(param), OnStack); - app(params, getTypeDescAux(m, param.typ, check)); - if ccgIntroducedPtr(param) then begin - app(params, '*'+''); - include(param.loc.flags, lfIndirect); - param.loc.s := OnUnknown; - end; - app(params, ' '+''); - app(params, param.loc.r); - // declare the len field for open arrays: - arr := param.typ; - if arr.kind = tyVar then arr := arr.sons[0]; - j := 0; - while arr.Kind = tyOpenArray do begin // need to pass hidden parameter: - appff(params, ', NI $1Len$2', ', @NI $1Len$2', [param.loc.r, toRope(j)]); - inc(j); - arr := arr.sons[0] - end; - if i < sonsLen(t.n)-1 then app(params, ', '); - end; - if (t.sons[0] <> nil) and isInvalidReturnType(t.sons[0]) then begin - if params <> nil then app(params, ', '); - arr := t.sons[0]; - app(params, getTypeDescAux(m, arr, check)); - if (mapReturnType(t.sons[0]) <> ctArray) or (gCmd = cmdCompileToLLVM) then - app(params, '*'+''); - appff(params, ' Result', ' @Result', []); - end; - if t.callConv = ccClosure then begin - if params <> nil then app(params, ', '); - app(params, 'void* ClPart') - end; - if tfVarargs in t.flags then begin - if params <> nil then app(params, ', '); - app(params, '...') - end; - if (params = nil) and (gCmd <> cmdCompileToLLVM) then - app(params, 'void)') - else - app(params, ')'+''); - params := con('('+'', params); -end; - -function isImportedType(t: PType): bool; -begin - result := (t.sym <> nil) and (sfImportc in t.sym.flags) -end; - -function typeNameOrLiteral(t: PType; const literal: string): PRope; -begin - if (t.sym <> nil) and (sfImportc in t.sym.flags) and - (t.sym.magic = mNone) then - result := getTypeName(t) - else - result := toRope(literal) -end; - -function getSimpleTypeDesc(m: BModule; typ: PType): PRope; -const - NumericalTypeToStr: array [tyInt..tyFloat128] of string = ( - 'NI', 'NI8', 'NI16', 'NI32', 'NI64', 'NF', 'NF32', 'NF64', 'NF128'); -begin - case typ.Kind of - tyPointer: result := typeNameOrLiteral(typ, 'void*'); - tyEnum: begin - if firstOrd(typ) < 0 then - result := typeNameOrLiteral(typ, 'NI32') - else begin - case int(getSize(typ)) of - 1: result := typeNameOrLiteral(typ, 'NU8'); - 2: result := typeNameOrLiteral(typ, 'NU16'); - 4: result := typeNameOrLiteral(typ, 'NI32'); - 8: result := typeNameOrLiteral(typ, 'NI64'); - else begin - internalError(typ.sym.info, - 'getSimpleTypeDesc: ' + toString(getSize(typ))); - result := nil - end - end - end - end; - tyString: begin - useMagic(m, 'NimStringDesc'); - result := typeNameOrLiteral(typ, 'NimStringDesc*'); - end; - tyCstring: result := typeNameOrLiteral(typ, 'NCSTRING'); - tyBool: result := typeNameOrLiteral(typ, 'NIM_BOOL'); - tyChar: result := typeNameOrLiteral(typ, 'NIM_CHAR'); - tyNil: result := typeNameOrLiteral(typ, '0'+''); - tyInt..tyFloat128: - result := typeNameOrLiteral(typ, NumericalTypeToStr[typ.Kind]); - tyRange: result := getSimpleTypeDesc(m, typ.sons[0]); - else result := nil; - end -end; - -function getTypePre(m: BModule; typ: PType): PRope; -begin - if typ = nil then - result := toRope('void') - else begin - result := getSimpleTypeDesc(m, typ); - if result = nil then - result := CacheGetType(m.typeCache, typ) - end -end; - -function getForwardStructFormat(): string; -begin - if gCmd = cmdCompileToCpp then result := 'struct $1;$n' - else result := 'typedef struct $1 $1;$n' -end; - -function getTypeForward(m: BModule; typ: PType): PRope; -begin - result := CacheGetType(m.forwTypeCache, typ); - if result <> nil then exit; - result := getTypePre(m, typ); - if result <> nil then exit; - case typ.kind of - tySequence, tyTuple, tyObject: begin - result := getTypeName(typ); - if not isImportedType(typ) then - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); - IdTablePut(m.forwTypeCache, typ, result) - end - else - InternalError('getTypeForward(' + typeKindToStr[typ.kind] + ')') - end -end; - -function mangleRecFieldName(field: PSym; rectype: PType): PRope; -begin - if (rectype.sym <> nil) - and ([sfImportc, sfExportc] * rectype.sym.flags <> []) then - result := field.loc.r - else - result := toRope(mangle(field.name.s)); - if result = nil then InternalError(field.info, 'mangleRecFieldName'); -end; - -function genRecordFieldsAux(m: BModule; n: PNode; accessExpr: PRope; - rectype: PType; var check: TIntSet): PRope; -var - i: int; - ae, uname, sname, a: PRope; - k: PNode; - field: PSym; -begin - result := nil; - case n.kind of - nkRecList: begin - for i := 0 to sonsLen(n)-1 do begin - app(result, genRecordFieldsAux(m, n.sons[i], accessExpr, - rectype, check)); - end - end; - nkRecCase: begin - if (n.sons[0].kind <> nkSym) then - InternalError(n.info, 'genRecordFieldsAux'); - app(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)); - uname := toRope(mangle(n.sons[0].sym.name.s)+ 'U'); - if accessExpr <> nil then ae := ropef('$1.$2', [accessExpr, uname]) - else ae := uname; - app(result, 'union {'+tnl); - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkOfBranch, nkElse: begin - k := lastSon(n.sons[i]); - if k.kind <> nkSym then begin - sname := con('S'+'', toRope(i)); - a := genRecordFieldsAux(m, k, ropef('$1.$2', [ae, sname]), - rectype, check); - if a <> nil then begin - app(result, 'struct {'); - app(result, a); - appf(result, '} $1;$n', [sname]); - end - end - else app(result, genRecordFieldsAux(m, k, ae, rectype, check)); - end; - else internalError('genRecordFieldsAux(record case branch)'); - end; - end; - appf(result, '} $1;$n', [uname]) - end; - nkSym: begin - field := n.sym; - assert(field.ast = nil); - sname := mangleRecFieldName(field, rectype); - if accessExpr <> nil then ae := ropef('$1.$2', [accessExpr, sname]) - else ae := sname; - fillLoc(field.loc, locField, field.typ, ae, OnUnknown); - appf(result, '$1 $2;$n', [getTypeDescAux(m, field.loc.t, check), sname]) - end; - else internalError(n.info, 'genRecordFieldsAux()'); - end -end; - -function getRecordFields(m: BModule; typ: PType; var check: TIntSet): PRope; -begin - result := genRecordFieldsAux(m, typ.n, nil, typ, check); -end; - -function getRecordDesc(m: BModule; typ: PType; name: PRope; - var check: TIntSet): PRope; -var - desc: PRope; - hasField: bool; -begin - // declare the record: - hasField := false; - if typ.kind = tyObject then begin - useMagic(m, 'TNimType'); - if typ.sons[0] = nil then begin - if (typ.sym <> nil) and (sfPure in typ.sym.flags) - or (tfFinal in typ.flags) then - result := ropef('struct $1 {$n', [name]) - else begin - result := ropef('struct $1 {$nTNimType* m_type;$n', [name]); - hasField := true - end - end - else if gCmd = cmdCompileToCpp then begin - result := ropef('struct $1 : public $2 {$n', - [name, getTypeDescAux(m, typ.sons[0], check)]); - hasField := true - end - else begin - result := ropef('struct $1 {$n $2 Sup;$n', - [name, getTypeDescAux(m, typ.sons[0], check)]); - hasField := true - end - end - else - result := ropef('struct $1 {$n', [name]); - desc := getRecordFields(m, typ, check); - if (desc = nil) and not hasField then - // no fields in struct are not valid in C, so generate a dummy: - appf(result, 'char dummy;$n', []) - else - app(result, desc); - app(result, '};' + tnl); -end; - -function getTupleDesc(m: BModule; typ: PType; name: PRope; - var check: TIntSet): PRope; -var - desc: PRope; - i: int; -begin - result := ropef('struct $1 {$n', [name]); - desc := nil; - for i := 0 to sonsLen(typ)-1 do - appf(desc, '$1 Field$2;$n', - [getTypeDescAux(m, typ.sons[i], check), toRope(i)]); - if (desc = nil) then app(result, 'char dummy;' + tnl) - else app(result, desc); - app(result, '};' + tnl); -end; - -procedure pushType(m: BModule; typ: PType); -var - L: int; -begin - L := length(m.typeStack); - setLength(m.typeStack, L+1); - m.typeStack[L] := typ; -end; - -function getTypeDescAux(m: BModule; typ: PType; var check: TIntSet): PRope; -// returns only the type's name -var - name, rettype, desc, recdesc: PRope; - n: biggestInt; - t, et: PType; -begin - t := getUniqueType(typ); - if t = nil then InternalError('getTypeDescAux: t == nil'); - if t.sym <> nil then useHeader(m, t.sym); - result := getTypePre(m, t); - if result <> nil then exit; - if IntSetContainsOrIncl(check, t.id) then begin - InternalError('cannot generate C type for: ' + typeToString(typ)); - // XXX: this BUG is hard to fix -> we need to introduce helper structs, - // but determining when this needs to be done is hard. We should split - // C type generation into an analysis and a code generation phase somehow. - end; - case t.Kind of - tyRef, tyPtr, tyVar: begin - et := getUniqueType(t.sons[0]); - if et.kind in [tyArrayConstr, tyArray, tyOpenArray] then - et := getUniqueType(elemType(et)); - case et.Kind of - tyObject, tyTuple: begin - // no restriction! We have a forward declaration for structs - name := getTypeForward(m, et); - result := con(name, '*'+''); - IdTablePut(m.typeCache, t, result); - pushType(m, et); - end; - tySequence: begin - // no restriction! We have a forward declaration for structs - name := getTypeForward(m, et); - result := con(name, '**'); - IdTablePut(m.typeCache, t, result); - pushType(m, et); - end; - else begin - // else we have a strong dependency :-( - result := con(getTypeDescAux(m, et, check), '*'+''); - IdTablePut(m.typeCache, t, result) - end - end - end; - tyOpenArray: begin - et := getUniqueType(t.sons[0]); - result := con(getTypeDescAux(m, et, check), '*'+''); - IdTablePut(m.typeCache, t, result) - end; - tyProc: begin - result := getTypeName(t); - IdTablePut(m.typeCache, t, result); - genProcParams(m, t, rettype, desc, check); - if not isImportedType(t) then begin - if t.callConv <> ccClosure then - appf(m.s[cfsTypes], 'typedef $1_PTR($2, $3) $4;$n', - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) - else // procedure vars may need a closure! - appf(m.s[cfsTypes], 'typedef struct $1 {$n' + - 'N_CDECL_PTR($2, PrcPart) $3;$n' + - 'void* ClPart;$n};$n', - [result, rettype, desc]); - end - end; - tySequence: begin - // we cannot use getTypeForward here because then t would be associated - // with the name of the struct, not with the pointer to the struct: - result := CacheGetType(m.forwTypeCache, t); - if result = nil then begin - result := getTypeName(t); - if not isImportedType(t) then - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); - IdTablePut(m.forwTypeCache, t, result); - end; - assert(CacheGetType(m.typeCache, t) = nil); - IdTablePut(m.typeCache, t, con(result, '*'+'')); - if not isImportedType(t) then begin - useMagic(m, 'TGenericSeq'); - if skipTypes(t.sons[0], abstractInst).kind <> tyEmpty then - appf(m.s[cfsSeqTypes], - 'struct $2 {$n' + - ' TGenericSeq Sup;$n' + - ' $1 data[SEQ_DECL_SIZE];$n' + - '};$n', [getTypeDescAux(m, t.sons[0], check), result]) - else - result := toRope('TGenericSeq') - end; - app(result, '*'+''); - end; - tyArrayConstr, tyArray: begin - n := lengthOrd(t); - if n <= 0 then n := 1; // make an array of at least one element - result := getTypeName(t); - IdTablePut(m.typeCache, t, result); - if not isImportedType(t) then - appf(m.s[cfsTypes], 'typedef $1 $2[$3];$n', - [getTypeDescAux(m, t.sons[1], check), result, ToRope(n)]) - end; - tyObject, tyTuple: begin - result := CacheGetType(m.forwTypeCache, t); - if result = nil then begin - result := getTypeName(t); - if not isImportedType(t) then - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); - IdTablePut(m.forwTypeCache, t, result) - end; - IdTablePut(m.typeCache, t, result); - // always call for sideeffects: - if t.n <> nil then - recdesc := getRecordDesc(m, t, result, check) - else - recdesc := getTupleDesc(m, t, result, check); - if not isImportedType(t) then app(m.s[cfsTypes], recdesc); - end; - tySet: begin - case int(getSize(t)) of - 1: result := toRope('NU8'); - 2: result := toRope('NU16'); - 4: result := toRope('NU32'); - 8: result := toRope('NU64'); - else begin - result := getTypeName(t); - IdTablePut(m.typeCache, t, result); - if not isImportedType(t) then - appf(m.s[cfsTypes], 'typedef NU8 $1[$2];$n', - [result, toRope(getSize(t))]) - end - end - end; - tyGenericInst, tyDistinct, tyOrdinal: - result := getTypeDescAux(m, lastSon(t), check); - else begin - InternalError('getTypeDescAux(' + typeKindToStr[t.kind] + ')'); - result := nil - end - end -end; - -function getTypeDesc(m: BModule; typ: PType): PRope; overload; -var - check: TIntSet; -begin - IntSetInit(check); - result := getTypeDescAux(m, typ, check); -end; - -function getTypeDesc(m: BModule; const magic: string): PRope; overload; -var - sym: PSym; -begin - sym := magicsys.getCompilerProc(magic); - if sym <> nil then - result := getTypeDesc(m, sym.typ) - else begin - rawMessage(errSystemNeeds, magic); - result := nil - end -end; - -procedure finishTypeDescriptions(m: BModule); -var - i: int; -begin - i := 0; - while i < length(m.typeStack) do begin - {@discard} getTypeDesc(m, m.typeStack[i]); - inc(i); - end; -end; - -function genProcHeader(m: BModule; prc: PSym): PRope; -var - rettype, params: PRope; - check: TIntSet; -begin - // using static is needed for inline procs - if (prc.typ.callConv = ccInline) then - result := toRope('static ') - else - result := nil; - IntSetInit(check); - fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), OnUnknown); - genProcParams(m, prc.typ, rettype, params, check); - appf(result, '$1($2, $3)$4', - [toRope(CallingConvToStr[prc.typ.callConv]), - rettype, prc.loc.r, params]) -end; - -// ----------------------- type information ---------------------------------- - -function genTypeInfo(m: BModule; typ: PType): PRope; forward; - -function getNimNode(m: BModule): PRope; -begin - result := ropef('$1[$2]', [m.typeNodesName, toRope(m.typeNodes)]); - inc(m.typeNodes); -end; - -function getNimType(m: BModule): PRope; -begin - result := ropef('$1[$2]', [m.nimTypesName, toRope(m.nimTypes)]); - inc(m.nimTypes); -end; - -procedure allocMemTI(m: BModule; typ: PType; name: PRope); -var - tmp: PRope; -begin - tmp := getNimType(m); - appf(m.s[cfsTypeInit2], '$2 = &$1;$n', [tmp, name]); -end; - -procedure genTypeInfoAuxBase(m: BModule; typ: PType; name, base: PRope); -var - nimtypeKind, flags: int; -begin - allocMemTI(m, typ, name); - if (typ.kind = tyObject) and (tfFinal in typ.flags) - and (typ.sons[0] = nil) then - nimtypeKind := ord(high(TTypeKind))+1 // tyPureObject - else - nimtypeKind := ord(typ.kind); - appf(m.s[cfsTypeInit3], - '$1->size = sizeof($2);$n' + - '$1->kind = $3;$n' + - '$1->base = $4;$n', [ - name, getTypeDesc(m, typ), toRope(nimtypeKind), base]); - // compute type flags for GC optimization - flags := 0; - if not containsGarbageCollectedRef(typ) then flags := flags or 1; - if not canFormAcycle(typ) then flags := flags or 2; - //else MessageOut('can contain a cycle: ' + typeToString(typ)); - if flags <> 0 then - appf(m.s[cfsTypeInit3], '$1->flags = $2;$n', [name, toRope(flags)]); - appf(m.s[cfsVars], 'TNimType* $1; /* $2 */$n', - [name, toRope(typeToString(typ))]); -end; - -procedure genTypeInfoAux(m: BModule; typ: PType; name: PRope); -var - base: PRope; -begin - if (sonsLen(typ) > 0) and (typ.sons[0] <> nil) then - base := genTypeInfo(m, typ.sons[0]) - else - base := toRope('0'+''); - genTypeInfoAuxBase(m, typ, name, base); -end; - -procedure genObjectFields(m: BModule; typ: PType; n: PNode; expr: PRope); -var - tmp, tmp2: PRope; - len, i, j, x, y: int; - field: PSym; - b: PNode; -begin - case n.kind of - nkRecList: begin - len := sonsLen(n); - if len = 1 then // generates more compact code! - genObjectFields(m, typ, n.sons[0], expr) - else if len > 0 then begin - tmp := getTempName(); - appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', - [tmp, toRope(len)]); - for i := 0 to len-1 do begin - tmp2 := getNimNode(m); - appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(i), tmp2]); - genObjectFields(m, typ, n.sons[i], tmp2); - end; - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n', [ - expr, toRope(len), tmp]); - end - else - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2;$n', [expr, toRope(len)]); - end; - nkRecCase: begin - len := sonsLen(n); - assert(n.sons[0].kind = nkSym); - field := n.sons[0].sym; - tmp := getTempName(); - useMagic(m, 'chckNil'); - appf(m.s[cfsTypeInit3], '$1.kind = 3;$n' + - '$1.offset = offsetof($2, $3);$n' + - '$1.typ = $4;$n' + - 'chckNil($1.typ);$n' + - '$1.name = $5;$n' + - '$1.sons = &$6[0];$n' + - '$1.len = $7;$n', - [expr, getTypeDesc(m, typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s), tmp, - toRope(lengthOrd(field.typ))]); - appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', - [tmp, toRope(lengthOrd(field.typ)+1)]); - for i := 1 to len-1 do begin - b := n.sons[i]; // branch - tmp2 := getNimNode(m); - genObjectFields(m, typ, lastSon(b), tmp2); - case b.kind of - nkOfBranch: begin - if sonsLen(b) < 2 then - internalError(b.info, 'genObjectFields; nkOfBranch broken'); - for j := 0 to sonsLen(b)-2 do begin - if b.sons[j].kind = nkRange then begin - x := int(getOrdValue(b.sons[j].sons[0])); - y := int(getOrdValue(b.sons[j].sons[1])); - while x <= y do begin - appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(x), tmp2]); - inc(x); - end; - end - else - appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) - end - end; - nkElse: begin - appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(lengthOrd(field.typ)), tmp2]); - end - else - internalError(n.info, 'genObjectFields(nkRecCase)'); - end - end - end; - nkSym: begin - field := n.sym; - useMagic(m, 'chckNil'); - appf(m.s[cfsTypeInit3], '$1.kind = 1;$n' + - '$1.offset = offsetof($2, $3);$n' + - '$1.typ = $4;$n' + - 'chckNil($1.typ);$n' + - '$1.name = $5;$n', - [expr, getTypeDesc(m, typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s)]); - end; - else internalError(n.info, 'genObjectFields'); - end -end; - -procedure genObjectInfo(m: BModule; typ: PType; name: PRope); -var - tmp: PRope; -begin - if typ.kind = tyObject then genTypeInfoAux(m, typ, name) - else genTypeInfoAuxBase(m, typ, name, toRope('0'+'')); - tmp := getNimNode(m); - genObjectFields(m, typ, typ.n, tmp); - appf(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); -end; - -procedure genTupleInfo(m: BModule; typ: PType; name: PRope); -var - tmp, expr, tmp2: PRope; - i, len: int; - a: PType; -begin - genTypeInfoAuxBase(m, typ, name, toRope('0'+'')); - expr := getNimNode(m); - len := sonsLen(typ); - if len > 0 then begin - tmp := getTempName(); - appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', [tmp, toRope(len)]); - for i := 0 to len-1 do begin - a := typ.sons[i]; - tmp2 := getNimNode(m); - appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(i), tmp2]); - useMagic(m, 'chckNil'); - appf(m.s[cfsTypeInit3], '$1.kind = 1;$n' + - '$1.offset = offsetof($2, Field$3);$n' + - '$1.typ = $4;$n' + - 'chckNil($1.typ);$n' + - '$1.name = "Field$3";$n', - [tmp2, getTypeDesc(m, typ), toRope(i), - genTypeInfo(m, a)]); - end; - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n', [ - expr, toRope(len), tmp]); - end - else - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2;$n', [expr, toRope(len)]); - appf(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); -end; - -procedure genEnumInfo(m: BModule; typ: PType; name: PRope); -var - nodePtrs, elemNode, enumNames, enumArray, counter, specialCases: PRope; - len, i, firstNimNode: int; - field: PSym; -begin - // Type information for enumerations is quite heavy, so we do some - // optimizations here: The ``typ`` field is never set, as it is redundant - // anyway. We generate a cstring array and a loop over it. Exceptional - // positions will be reset after the loop. - genTypeInfoAux(m, typ, name); - nodePtrs := getTempName(); - len := sonsLen(typ.n); - appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', - [nodePtrs, toRope(len)]); - enumNames := nil; - specialCases := nil; - firstNimNode := m.typeNodes; - for i := 0 to len-1 do begin - assert(typ.n.sons[i].kind = nkSym); - field := typ.n.sons[i].sym; - elemNode := getNimNode(m); - app(enumNames, makeCString(field.name.s)); - if i < len-1 then app(enumNames, ', '+tnl); - if field.position <> i then - appf(specialCases, '$1.offset = $2;$n', [elemNode, toRope(field.position)]); - end; - enumArray := getTempName(); - counter := getTempName(); - appf(m.s[cfsTypeInit1], 'NI $1;$n', [counter]); - appf(m.s[cfsTypeInit1], 'static char* NIM_CONST $1[$2] = {$n$3};$n', - [enumArray, toRope(len), enumNames]); - appf(m.s[cfsTypeInit3], 'for ($1 = 0; $1 < $2; $1++) {$n' + - '$3[$1+$4].kind = 1;$n' + - '$3[$1+$4].offset = $1;$n' + - '$3[$1+$4].name = $5[$1];$n' + - '$6[$1] = &$3[$1+$4];$n' + - '}$n', - [counter, toRope(len), m.typeNodesName, toRope(firstNimNode), - enumArray, nodePtrs]); - app(m.s[cfsTypeInit3], specialCases); - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4->node = &$1;$n', [ - getNimNode(m), toRope(len), nodePtrs, name]); -end; - -procedure genSetInfo(m: BModule; typ: PType; name: PRope); -var - tmp: PRope; -begin - assert(typ.sons[0] <> nil); - genTypeInfoAux(m, typ, name); - tmp := getNimNode(m); - appf(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 0;$n' + - '$3->node = &$1;$n', [tmp, toRope(firstOrd(typ)), name]); -end; - -procedure genArrayInfo(m: BModule; typ: PType; name: PRope); -begin - genTypeInfoAuxBase(m, typ, name, genTypeInfo(m, typ.sons[1])); -end; - -var - gToTypeInfoId: TIiTable; - -(* // this does not work any longer thanks to separate compilation: -function getTypeInfoName(t: PType): PRope; -begin - result := ropef('NTI$1', [toRope(t.id)]); -end;*) - -function genTypeInfo(m: BModule; typ: PType): PRope; -var - t: PType; - id: int; - dataGenerated: bool; -begin - t := getUniqueType(typ); - id := IiTableGet(gToTypeInfoId, t.id); - if id = invalidKey then begin - dataGenerated := false; - id := t.id; // getID(); - IiTablePut(gToTypeInfoId, t.id, id); - end - else - dataGenerated := true; - result := ropef('NTI$1', [toRope(id)]); - if not IntSetContainsOrIncl(m.typeInfoMarker, id) then begin - // declare type information structures: - useMagic(m, 'TNimType'); - useMagic(m, 'TNimNode'); - appf(m.s[cfsVars], 'extern TNimType* $1; /* $2 */$n', - [result, toRope(typeToString(t))]); - end; - if dataGenerated then exit; - case t.kind of - tyEmpty: result := toRope('0'+''); - tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, - tyInt..tyFloat128, tyVar: - genTypeInfoAuxBase(gNimDat, t, result, toRope('0'+'')); - tyRef, tyPtr, tySequence, tyRange: genTypeInfoAux(gNimDat, t, result); - tyArrayConstr, tyArray: genArrayInfo(gNimDat, t, result); - tySet: genSetInfo(gNimDat, t, result); - tyEnum: genEnumInfo(gNimDat, t, result); - tyObject: genObjectInfo(gNimDat, t, result); - tyTuple: begin - if t.n <> nil then genObjectInfo(gNimDat, t, result) - else genTupleInfo(gNimDat, t, result); - end; - else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')'); - end -end; - -procedure genTypeSection(m: BModule; n: PNode); -begin -end; - -(* -procedure genTypeSection(m: BModule; n: PNode); -var - i: int; - a: PNode; - t: PType; -begin - if not (optDeadCodeElim in gGlobalOptions) then begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.sons[0].kind <> nkSym) then InternalError(a.info, 'genTypeSection'); - t := a.sons[0].sym.typ; - if (a.sons[2] = nil) - or not (a.sons[2].kind in [nkSym, nkIdent, nkAccQuoted]) then - if t <> nil then - case t.kind of - tyEnum, tyBool: begin - useMagic(m, 'TNimType'); - useMagic(m, 'TNimNode'); - genEnumInfo(m, t, ropef('NTI$1', [toRope(t.id)])); - end; - tyObject: begin - if not isPureObject(t) then begin - useMagic(m, 'TNimType'); - useMagic(m, 'TNimNode'); - genObjectInfo(m, t, ropef('NTI$1', [toRope(t.id)])); - end - end - else begin end - end - end - end -end; -*) diff --git a/nim/ccgutils.pas b/nim/ccgutils.pas deleted file mode 100755 index da6b8774f6..0000000000 --- a/nim/ccgutils.pas +++ /dev/null @@ -1,188 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ccgutils; - -interface - -{$include 'config.inc'} - -// This module declares some helpers for the C code generator. - -uses - charsets, nsystem, - ast, astalgo, ropes, lists, nhashes, strutils, types, msgs; - -function toCChar(c: Char): string; -function makeCString(const s: string): PRope; -function makeLLVMString(const s: string): PRope; - -function TableGetType(const tab: TIdTable; key: PType): PObject; -function GetUniqueType(key: PType): PType; - -implementation - -var - gTypeTable: array [TTypeKind] of TIdTable; - -procedure initTypeTables(); -var - i: TTypeKind; -begin - for i := low(TTypeKind) to high(TTypeKind) do - InitIdTable(gTypeTable[i]); -end; - -function GetUniqueType(key: PType): PType; -var - t: PType; - h: THash; - k: TTypeKind; -begin - // this is a hotspot in the compiler! - result := key; - if key = nil then exit; - k := key.kind; - case k of - tyObject, tyEnum: begin - result := PType(IdTableGet(gTypeTable[k], key)); - if result = nil then begin - IdTablePut(gTypeTable[k], key, key); - result := key; - end - end; - tyGenericInst, tyDistinct, tyOrdinal: - result := GetUniqueType(lastSon(key)); - tyProc: begin end; - else begin - // we have to do a slow linear search because types may need - // to be compared by their structure: - if IdTableHasObjectAsKey(gTypeTable[k], key) then exit; - for h := 0 to high(gTypeTable[k].data) do begin - t := PType(gTypeTable[k].data[h].key); - if (t <> nil) and sameType(t, key) then begin result := t; exit end - end; - IdTablePut(gTypeTable[k], key, key); - end; - end; - (* - case key.Kind of - tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyProc, tyAnyEnum: begin end; - tyNone, tyForward: - InternalError('GetUniqueType: ' + typeToString(key)); - tyGenericParam, tyGeneric, tyAbstract, tySequence, - tyOpenArray, tySet, tyVar, tyRef, tyPtr, tyArrayConstr, - tyArray, tyTuple, tyRange: begin - // we have to do a slow linear search because types may need - // to be compared by their structure: - if IdTableHasObjectAsKey(gTypeTable, key) then exit; - for h := 0 to high(gTypeTable.data) do begin - t := PType(gTypeTable.data[h].key); - if (t <> nil) and sameType(t, key) then begin result := t; exit end - end; - IdTablePut(gTypeTable, key, key); - end; - tyObject, tyEnum: begin - result := PType(IdTableGet(gTypeTable, key)); - if result = nil then begin - IdTablePut(gTypeTable, key, key); - result := key; - end - end; - tyGenericInst, tyAbstract: result := GetUniqueType(lastSon(key)); - end; *) -end; - -function TableGetType(const tab: TIdTable; key: PType): PObject; -var - t: PType; - h: THash; -begin // returns nil if we need to declare this type - result := IdTableGet(tab, key); - if (result = nil) and (tab.counter > 0) then begin - // we have to do a slow linear search because types may need - // to be compared by their structure: - for h := 0 to high(tab.data) do begin - t := PType(tab.data[h].key); - if t <> nil then begin - if sameType(t, key) then begin - result := tab.data[h].val; - exit - end - end - end - end -end; - -function toCChar(c: Char): string; -begin - case c of - #0..#31, #128..#255: result := '\' + toOctal(c); - '''', '"', '\': result := '\' + c; - else result := {@ignore} c {@emit toString(c)} - end; -end; - -function makeCString(const s: string): PRope; -// BUGFIX: We have to split long strings into many ropes. Otherwise -// this could trigger an InternalError(). See the ropes module for -// further information. -const - MaxLineLength = 64; -var - i: int; - res: string; -begin - result := nil; - res := '"'+''; - for i := strStart to length(s)+strStart-1 do begin - if (i-strStart+1) mod MaxLineLength = 0 then begin - add(res, '"'); - add(res, nl); - app(result, toRope(res)); - // reset: - setLength(res, 1); - res[strStart] := '"'; - end; - add(res, toCChar(s[i])); - end; - addChar(res, '"'); - app(result, toRope(res)); -end; - -function makeLLVMString(const s: string): PRope; -const - MaxLineLength = 64; -var - i: int; - res: string; -begin - result := nil; - res := 'c"'; - for i := strStart to length(s)+strStart-1 do begin - if (i-strStart+1) mod MaxLineLength = 0 then begin - app(result, toRope(res)); - setLength(res, 0); - end; - case s[i] of - #0..#31, #128..#255, '"', '\': begin - addChar(res, '\'); - add(res, toHex(ord(s[i]), 2)); - end - else - addChar(res, s[i]) - end; - end; - add(res, '\00"'); - app(result, toRope(res)); -end; - -begin - InitTypeTables(); -end. diff --git a/nim/cgen.pas b/nim/cgen.pas deleted file mode 100755 index 83c34241a2..0000000000 --- a/nim/cgen.pas +++ /dev/null @@ -1,1270 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit cgen; - -// This is the new C code generator; much cleaner and faster -// than the old one. It also generates better code. - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, strutils, nhashes, trees, platform, magicsys, - extccomp, options, nversion, nimsets, msgs, crc, bitsets, idents, - lists, types, ccgutils, nos, ntime, ropes, nmath, passes, rodread, - wordrecg, rnimsyn, treetab, cgmeth; - -function cgenPass(): TPass; - -implementation - -type - TLabel = PRope; // for the C generator a label is just a rope - - TCFileSection = ( // the sections a generated C file consists of - cfsHeaders, // section for C include file headers - cfsForwardTypes, // section for C forward typedefs - cfsTypes, // section for C typedefs - cfsSeqTypes, // section for sequence types only - // this is needed for strange type generation - // reasons - cfsFieldInfo, // section for field information - cfsTypeInfo, // section for type information - cfsProcHeaders, // section for C procs prototypes - cfsData, // section for C constant data - cfsVars, // section for C variable declarations - cfsProcs, // section for C procs that are not inline - cfsTypeInit1, // section 1 for declarations of type information - cfsTypeInit2, // section 2 for initialization of type information - cfsTypeInit3, // section 3 for initialization of type information - cfsDebugInit, // section for initialization of debug information - cfsDynLibInit, // section for initialization of dynamic library binding - cfsDynLibDeinit // section for deinitialization of dynamic libraries - ); - - TCTypeKind = ( // describes the type kind of a C type - ctVoid, - ctChar, - ctBool, - ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, - ctInt, ctInt8, ctInt16, ctInt32, ctInt64, - ctFloat, ctFloat32, ctFloat64, ctFloat128, - ctArray, - ctStruct, - ctPtr, - ctNimStr, - ctNimSeq, - ctProc, - ctCString - ); - - TCFileSections = array [TCFileSection] of PRope; - // TCFileSections represents a generated C file - TCProcSection = ( // the sections a generated C proc consists of - cpsLocals, // section of local variables for C proc - cpsInit, // section for initialization of variables for C proc - cpsStmts // section of local statements for C proc - ); - - TCProcSections = array [TCProcSection] of PRope; - // TCProcSections represents a generated C proc - - BModule = ^TCGen; - BProc = ^TCProc; - - TBlock = record - id: int; // the ID of the label; positive means that it - // has been used (i.e. the label should be emitted) - nestedTryStmts: int; // how many try statements is it nested into - end; - - TCProc = record // represents C proc that is currently generated - s: TCProcSections; // the procs sections; short name for readability - prc: PSym; // the Nimrod proc that this C proc belongs to - BeforeRetNeeded: bool; // true iff 'BeforeRet' label for proc is needed - nestedTryStmts: Natural; // in how many nested try statements we are - // (the vars must be volatile then) - labels: Natural; // for generating unique labels in the C proc - blocks: array of TBlock; // nested blocks - options: TOptions; // options that should be used for code - // generation; this is the same as prc.options - // unless prc == nil - frameLen: int; // current length of frame descriptor - sendClosure: PType; // closure record type that we pass - receiveClosure: PType; // closure record type that we get - module: BModule; // used to prevent excessive parameter passing - end; - TTypeSeq = array of PType; - TCGen = object(TPassContext) // represents a C source file - module: PSym; - filename: string; - s: TCFileSections; // sections of the C file - cfilename: string; // filename of the module (including path, - // without extension) - typeCache: TIdTable; // cache the generated types - forwTypeCache: TIdTable; // cache for forward declarations of types - declaredThings: TIntSet; // things we have declared in this .c file - declaredProtos: TIntSet; // prototypes we have declared in this .c file - headerFiles: TLinkedList; // needed headers to include - typeInfoMarker: TIntSet; // needed for generating type information - initProc: BProc; // code for init procedure - typeStack: TTypeSeq; // used for type generation - dataCache: TNodeTable; - forwardedProcs: TSymSeq; // keep forwarded procs here - typeNodes, nimTypes: int;// used for type info generation - typeNodesName, nimTypesName: PRope; // used for type info generation - labels: natural; // for generating unique module-scope names - end; - -var - mainModProcs, mainModInit: PRope; // parts of the main module - gMapping: PRope; // the generated mapping file (if requested) - gProcProfile: Natural; // proc profile counter - gGeneratedSyms: TIntSet; // set of ID's of generated symbols - gPendingModules: array of BModule = {@ignore} nil {@emit @[]}; - // list of modules that are not finished with code generation - gForwardedProcsCounter: int = 0; - gNimDat: BModule; // generated global data - -function ropeff(const cformat, llvmformat: string; - const args: array of PRope): PRope; -begin - if gCmd = cmdCompileToLLVM then - result := ropef(llvmformat, args) - else - result := ropef(cformat, args) -end; - -procedure appff(var dest: PRope; const cformat, llvmformat: string; - const args: array of PRope); -begin - if gCmd = cmdCompileToLLVM then - appf(dest, llvmformat, args) - else - appf(dest, cformat, args); -end; - -procedure addForwardedProc(m: BModule; prc: PSym); -var - L: int; -begin - L := length(m.forwardedProcs); - setLength(m.forwardedProcs, L+1); - m.forwardedProcs[L] := prc; - inc(gForwardedProcsCounter); -end; - -procedure addPendingModule(m: BModule); -var - L, i: int; -begin - for i := 0 to high(gPendingModules) do - if gPendingModules[i] = m then - InternalError('module already pending: ' + m.module.name.s); - L := length(gPendingModules); - setLength(gPendingModules, L+1); - gPendingModules[L] := m; -end; - -function findPendingModule(m: BModule; s: PSym): BModule; -var - ms: PSym; - i: int; -begin - ms := getModule(s); - if ms.id = m.module.id then begin - result := m; exit - end; - for i := 0 to high(gPendingModules) do begin - result := gPendingModules[i]; - if result.module.id = ms.id then exit; - end; - InternalError(s.info, 'no pending module found for: ' + s.name.s); -end; - -procedure initLoc(var result: TLoc; k: TLocKind; typ: PType; s: TStorageLoc); -begin - result.k := k; - result.s := s; - result.t := GetUniqueType(typ); - result.r := nil; - result.a := -1; - result.flags := {@set}[] -end; - -procedure fillLoc(var a: TLoc; k: TLocKind; typ: PType; r: PRope; - s: TStorageLoc); -begin - // fills the loc if it is not already initialized - if a.k = locNone then begin - a.k := k; - a.t := getUniqueType(typ); - a.a := -1; - a.s := s; - if a.r = nil then a.r := r; - end -end; - -function newProc(prc: PSym; module: BModule): BProc; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.prc := prc; - result.module := module; - if prc <> nil then - result.options := prc.options - else - result.options := gOptions; -{@ignore} - setLength(result.blocks, 0); -{@emit - result.blocks := @[];} -end; - -function isSimpleConst(typ: PType): bool; -begin - result := not (skipTypes(typ, abstractVar).kind in [tyTuple, tyObject, - tyArray, tyArrayConstr, tySet, tySequence]) -end; - -procedure useHeader(m: BModule; sym: PSym); -begin - if lfHeader in sym.loc.Flags then begin - assert(sym.annex <> nil); - {@discard} lists.IncludeStr(m.headerFiles, sym.annex.path) - end -end; - -procedure UseMagic(m: BModule; const name: string); forward; - -{$include 'ccgtypes.pas'} - -// ------------------------------ Manager of temporaries ------------------ - -procedure getTemp(p: BProc; t: PType; var result: TLoc); -begin - inc(p.labels); - if gCmd = cmdCompileToLLVM then - result.r := con('%LOC', toRope(p.labels)) - else begin - result.r := con('LOC', toRope(p.labels)); - appf(p.s[cpsLocals], '$1 $2;$n', [getTypeDesc(p.module, t), result.r]); - end; - result.k := locTemp; - result.a := -1; - result.t := getUniqueType(t); - result.s := OnStack; - result.flags := {@set}[]; -end; - -// -------------------------- Variable manager ---------------------------- - -function cstringLit(p: BProc; var r: PRope; const s: string): PRope; overload; -begin - if gCmd = cmdCompileToLLVM then begin - inc(p.module.labels); - inc(p.labels); - result := ropef('%LOC$1', [toRope(p.labels)]); - appf(p.module.s[cfsData], '@C$1 = private constant [$2 x i8] $3$n', [ - toRope(p.module.labels), toRope(length(s)), makeLLVMString(s)]); - appf(r, '$1 = getelementptr [$2 x i8]* @C$3, %NI 0, %NI 0$n', - [result, toRope(length(s)), toRope(p.module.labels)]); - end - else - result := makeCString(s) -end; - -function cstringLit(m: BModule; var r: PRope; const s: string): PRope; overload; -begin - if gCmd = cmdCompileToLLVM then begin - inc(m.labels, 2); - result := ropef('%MOC$1', [toRope(m.labels-1)]); - appf(m.s[cfsData], '@MOC$1 = private constant [$2 x i8] $3$n', [ - toRope(m.labels), toRope(length(s)), makeLLVMString(s)]); - appf(r, '$1 = getelementptr [$2 x i8]* @MOC$3, %NI 0, %NI 0$n', - [result, toRope(length(s)), toRope(m.labels)]); - end - else - result := makeCString(s) -end; - -procedure allocParam(p: BProc; s: PSym); -var - tmp: PRope; -begin - assert(s.kind = skParam); - if not (lfParamCopy in s.loc.flags) then begin - inc(p.labels); - tmp := con('%LOC', toRope(p.labels)); - include(s.loc.flags, lfParamCopy); - include(s.loc.flags, lfIndirect); - appf(p.s[cpsInit], - '$1 = alloca $3$n' + - 'store $3 $2, $3* $1$n', [tmp, s.loc.r, getTypeDesc(p.module, s.loc.t)]); - s.loc.r := tmp - end; -end; - -procedure localDebugInfo(p: BProc; s: PSym); -var - name, a: PRope; -begin - if [optStackTrace, optEndb] * p.options <> [optStackTrace, optEndb] then exit; - if gCmd = cmdCompileToLLVM then begin - // "address" is the 0th field - // "typ" is the 1rst field - // "name" is the 2nd field - name := cstringLit(p, p.s[cpsInit], normalize(s.name.s)); - if (s.kind = skParam) and not ccgIntroducedPtr(s) then allocParam(p, s); - inc(p.labels, 3); - appf(p.s[cpsInit], - '%LOC$6 = getelementptr %TF* %F, %NI 0, $1, %NI 0$n' + - '%LOC$7 = getelementptr %TF* %F, %NI 0, $1, %NI 1$n' + - '%LOC$8 = getelementptr %TF* %F, %NI 0, $1, %NI 2$n' + - 'store i8* $2, i8** %LOC$6$n' + - 'store $3* $4, $3** %LOC$7$n' + - 'store i8* $5, i8** %LOC$8$n', - [toRope(p.frameLen), s.loc.r, getTypeDesc(p.module, 'TNimType'), - genTypeInfo(p.module, s.loc.t), name, toRope(p.labels), - toRope(p.labels-1), toRope(p.labels-2)]) - end - else begin - a := con('&'+'', s.loc.r); - if (s.kind = skParam) and ccgIntroducedPtr(s) then a := s.loc.r; - appf(p.s[cpsInit], - 'F.s[$1].address = (void*)$3; F.s[$1].typ = $4; F.s[$1].name = $2;$n', - [toRope(p.frameLen), makeCString(normalize(s.name.s)), a, - genTypeInfo(p.module, s.loc.t)]); - end; - inc(p.frameLen); -end; - -procedure assignLocalVar(p: BProc; s: PSym); -begin - //assert(s.loc.k == locNone) // not yet assigned - // this need not be fullfilled for inline procs; they are regenerated - // for each module that uses them! - if s.loc.k = locNone then - fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack); - if gCmd = cmdCompileToLLVM then begin - appf(p.s[cpsLocals], '$1 = alloca $2$n', - [s.loc.r, getTypeDesc(p.module, s.loc.t)]); - include(s.loc.flags, lfIndirect); - end - else begin - app(p.s[cpsLocals], getTypeDesc(p.module, s.loc.t)); - if sfRegister in s.flags then - app(p.s[cpsLocals], ' register'); - if (sfVolatile in s.flags) or (p.nestedTryStmts > 0) then - app(p.s[cpsLocals], ' volatile'); - - appf(p.s[cpsLocals], ' $1;$n', [s.loc.r]); - end; - // if debugging we need a new slot for the local variable: - localDebugInfo(p, s); -end; - -procedure assignGlobalVar(p: BProc; s: PSym); -begin - if s.loc.k = locNone then - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap); - if gCmd = cmdCompileToLLVM then begin - appf(p.module.s[cfsVars], '$1 = linkonce global $2 zeroinitializer$n', - [s.loc.r, getTypeDesc(p.module, s.loc.t)]); - include(s.loc.flags, lfIndirect); - end - else begin - useHeader(p.module, s); - if lfNoDecl in s.loc.flags then exit; - if sfImportc in s.flags then app(p.module.s[cfsVars], 'extern '); - app(p.module.s[cfsVars], getTypeDesc(p.module, s.loc.t)); - if sfRegister in s.flags then app(p.module.s[cfsVars], ' register'); - if sfVolatile in s.flags then app(p.module.s[cfsVars], ' volatile'); - if sfThreadVar in s.flags then app(p.module.s[cfsVars], ' NIM_THREADVAR'); - appf(p.module.s[cfsVars], ' $1;$n', [s.loc.r]); - end; - if [optStackTrace, optEndb] * p.module.module.options = - [optStackTrace, optEndb] then begin - useMagic(p.module, 'dbgRegisterGlobal'); - appff(p.module.s[cfsDebugInit], - 'dbgRegisterGlobal($1, &$2, $3);$n', - 'call void @dbgRegisterGlobal(i8* $1, i8* $2, $4* $3)$n', - [cstringLit(p, p.module.s[cfsDebugInit], - normalize(s.owner.name.s + '.' +{&} s.name.s)), - s.loc.r, - genTypeInfo(p.module, s.typ), - getTypeDesc(p.module, 'TNimType')]); - end; -end; - -function iff(cond: bool; the, els: PRope): PRope; -begin - if cond then result := the else result := els -end; - -procedure assignParam(p: BProc; s: PSym); -begin - assert(s.loc.r <> nil); - if (sfAddrTaken in s.flags) and (gCmd = cmdCompileToLLVM) then - allocParam(p, s); - localDebugInfo(p, s); -end; - -procedure fillProcLoc(sym: PSym); -begin - if sym.loc.k = locNone then - fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack); -end; - -// -------------------------- label manager ------------------------------- - -// note that a label is a location too -function getLabel(p: BProc): TLabel; -begin - inc(p.labels); - result := con('LA', toRope(p.labels)) -end; - -procedure fixLabel(p: BProc; labl: TLabel); -begin - appf(p.s[cpsStmts], '$1: ;$n', [labl]) -end; - -procedure genVarPrototype(m: BModule; sym: PSym); forward; -procedure genConstPrototype(m: BModule; sym: PSym); forward; -procedure genProc(m: BModule; prc: PSym); forward; -procedure genStmts(p: BProc; t: PNode); forward; -procedure genProcPrototype(m: BModule; sym: PSym); forward; - -{$include 'ccgexprs.pas'} -{$include 'ccgstmts.pas'} - -// ----------------------------- dynamic library handling ----------------- - -// We don't finalize dynamic libs as this does the OS for us. - -procedure libCandidates(const s: string; var dest: TStringSeq); -var - prefix, suffix: string; - le, ri, i, L: int; - temp: TStringSeq; -begin - le := strutils.find(s, '('); - ri := strutils.find(s, ')'); - if (le >= strStart) and (ri > le) then begin - prefix := ncopy(s, strStart, le-1); - suffix := ncopy(s, ri+1); - temp := split(ncopy(s, le+1, ri-1), {@set}['|']); - for i := 0 to high(temp) do - libCandidates(prefix +{&} temp[i] +{&} suffix, dest); - end - else begin - {@ignore} - L := length(dest); - setLength(dest, L+1); - dest[L] := s; - {@emit add(dest, s);} - end -end; - -procedure loadDynamicLib(m: BModule; lib: PLib); -var - tmp, loadlib: PRope; - s: TStringSeq; - i: int; -begin - assert(lib <> nil); - if not lib.generated then begin - lib.generated := true; - tmp := getGlobalTempName(); - assert(lib.name = nil); - lib.name := tmp; - // BUGFIX: useMagic has awful side-effects - appff(m.s[cfsVars], 'static void* $1;$n', - '$1 = linkonce global i8* zeroinitializer$n', [tmp]); - {@ignore} s := nil; {@emit s := @[];} - libCandidates(lib.path, s); - loadlib := nil; - for i := 0 to high(s) do begin - inc(m.labels); - if i > 0 then app(loadlib, '||'); - appff(loadlib, - '($1 = nimLoadLibrary((NimStringDesc*) &$2))$n', - '%MOC$4 = call i8* @nimLoadLibrary($3 $2)$n' + - 'store i8* %MOC$4, i8** $1$n', - [tmp, getStrLit(m, s[i]), getTypeDesc(m, getSysType(tyString)), - toRope(m.labels)]); - end; - appff(m.s[cfsDynLibInit], - 'if (!($1)) nimLoadLibraryError((NimStringDesc*) &$2);$n', - 'XXX too implement', - [loadlib, getStrLit(m, lib.path)]); - //appf(m.s[cfsDynLibDeinit], - // 'if ($1 != NIM_NIL) nimUnloadLibrary($1);$n', [tmp]); - useMagic(m, 'nimLoadLibrary'); - useMagic(m, 'nimUnloadLibrary'); - useMagic(m, 'NimStringDesc'); - useMagic(m, 'nimLoadLibraryError'); - end; - if lib.name = nil then InternalError('loadDynamicLib'); -end; - -procedure SymInDynamicLib(m: BModule; sym: PSym); -var - lib: PLib; - extname, tmp: PRope; -begin - lib := sym.annex; - extname := sym.loc.r; - loadDynamicLib(m, lib); - useMagic(m, 'nimGetProcAddr'); - if gCmd = cmdCompileToLLVM then include(sym.loc.flags, lfIndirect); - - tmp := ropeff('Dl_$1', '@Dl_$1', [toRope(sym.id)]); - sym.loc.r := tmp; // from now on we only need the internal name - sym.typ.sym := nil; // generate a new name - inc(m.labels, 2); - appff(m.s[cfsDynLibInit], - '$1 = ($2) nimGetProcAddr($3, $4);$n', - '%MOC$5 = load i8* $3$n' + - '%MOC$6 = call $2 @nimGetProcAddr(i8* %MOC$5, i8* $4)$n' + - 'store $2 %MOC$6, $2* $1$n', - [tmp, getTypeDesc(m, sym.typ), lib.name, - cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname)), - toRope(m.labels), toRope(m.labels-1)]); - - appff(m.s[cfsVars], - '$2 $1;$n', - '$1 = linkonce global $2 zeroinitializer$n', - [sym.loc.r, getTypeDesc(m, sym.loc.t)]); -end; - -// ----------------------------- sections --------------------------------- - -procedure UseMagic(m: BModule; const name: string); -var - sym: PSym; -begin - sym := magicsys.getCompilerProc(name); - if sym <> nil then - case sym.kind of - skProc, skMethod, skConverter: genProc(m, sym); - skVar: genVarPrototype(m, sym); - skType: {@discard} getTypeDesc(m, sym.typ); - else InternalError('useMagic: ' + name) - end - else if not (sfSystemModule in m.module.flags) then - rawMessage(errSystemNeeds, name); // don't be too picky here -end; - -procedure generateHeaders(m: BModule); -var - it: PStrEntry; -begin - app(m.s[cfsHeaders], '#include "nimbase.h"' +{&} tnl +{&} tnl); - it := PStrEntry(m.headerFiles.head); - while it <> nil do begin - if not (it.data[strStart] in ['"', '<']) then - appf(m.s[cfsHeaders], - '#include "$1"$n', [toRope(it.data)]) - else - appf(m.s[cfsHeaders], '#include $1$n', [toRope(it.data)]); - it := PStrEntry(it.Next) - end -end; - -procedure getFrameDecl(p: BProc); -var - slots: PRope; -begin - if p.frameLen > 0 then begin - useMagic(p.module, 'TVarSlot'); - slots := ropeff(' TVarSlot s[$1];$n', - ', [$1 x %TVarSlot]', [toRope(p.frameLen)]) - end - else - slots := nil; - appff(p.s[cpsLocals], - 'volatile struct {TFrame* prev;' + - 'NCSTRING procname;NI line;NCSTRING filename;' + - 'NI len;$n$1} F;$n', - '%TF = type {%TFrame*, i8*, %NI, %NI$1}$n' + - '%F = alloca %TF$n', - [slots]); - inc(p.labels); - prepend(p.s[cpsInit], ropeff('F.len = $1;$n', - '%LOC$2 = getelementptr %TF %F, %NI 4$n' + - 'store %NI $1, %NI* %LOC$2$n', - [toRope(p.frameLen), toRope(p.labels)])) -end; - -function retIsNotVoid(s: PSym): bool; -begin - result := (s.typ.sons[0] <> nil) and not isInvalidReturnType(s.typ.sons[0]) -end; - -function initFrame(p: BProc; procname, filename: PRope): PRope; -begin - inc(p.labels, 5); - result := ropeff( - 'F.procname = $1;$n' + - 'F.prev = framePtr;$n' + - 'F.filename = $2;$n' + - 'F.line = 0;$n' + - 'framePtr = (TFrame*)&F;$n', - - '%LOC$3 = getelementptr %TF %F, %NI 1$n' + - '%LOC$4 = getelementptr %TF %F, %NI 0$n' + - '%LOC$5 = getelementptr %TF %F, %NI 3$n' + - '%LOC$6 = getelementptr %TF %F, %NI 2$n' + - - 'store i8* $1, i8** %LOC$3$n' + - 'store %TFrame* @framePtr, %TFrame** %LOC$4$n' + - 'store i8* $2, i8** %LOC$5$n' + - 'store %NI 0, %NI* %LOC$6$n' + - - '%LOC$7 = bitcast %TF* %F to %TFrame*$n' + - 'store %TFrame* %LOC$7, %TFrame** @framePtr$n', - [procname, filename, toRope(p.labels), toRope(p.labels-1), - toRope(p.labels-2), toRope(p.labels-3), toRope(p.labels-4)]); -end; - -function deinitFrame(p: BProc): PRope; -begin - inc(p.labels, 3); - result := ropeff('framePtr = framePtr->prev;$n', - - '%LOC$1 = load %TFrame* @framePtr$n' + - '%LOC$2 = getelementptr %TFrame* %LOC$1, %NI 0$n' + - '%LOC$3 = load %TFrame** %LOC$2$n' + - 'store %TFrame* $LOC$3, %TFrame** @framePtr', [ - toRope(p.labels), toRope(p.labels-1), toRope(p.labels-2)]) -end; - -procedure genProcAux(m: BModule; prc: PSym); -var - p: BProc; - generatedProc, header, returnStmt, procname, filename: PRope; - i: int; - res, param: PSym; -begin - p := newProc(prc, m); - header := genProcHeader(m, prc); - if (gCmd <> cmdCompileToLLVM) and (lfExportLib in prc.loc.flags) then - header := con('N_LIB_EXPORT ', header); - returnStmt := nil; - assert(prc.ast <> nil); - - if not (sfPure in prc.flags) and (prc.typ.sons[0] <> nil) then begin - res := prc.ast.sons[resultPos].sym; // get result symbol - if not isInvalidReturnType(prc.typ.sons[0]) then begin - // declare the result symbol: - assignLocalVar(p, res); - assert(res.loc.r <> nil); - returnStmt := ropeff('return $1;$n', 'ret $1$n', [rdLoc(res.loc)]); - end - else begin - fillResult(res); - assignParam(p, res); - if skipTypes(res.typ, abstractInst).kind = tyArray then begin - include(res.loc.flags, lfIndirect); - res.loc.s := OnUnknown; - end; - end; - initVariable(p, res); - genObjectInit(p, res.typ, res.loc, true); - end; - for i := 1 to sonsLen(prc.typ.n)-1 do begin - param := prc.typ.n.sons[i].sym; - assignParam(p, param) - end; - - genStmts(p, prc.ast.sons[codePos]); // modifies p.locals, p.init, etc. - if sfPure in prc.flags then - generatedProc := ropeff('$1 {$n$2$3$4}$n', 'define $1 {$n$2$3$4}$n', - [header, p.s[cpsLocals], p.s[cpsInit], p.s[cpsStmts]]) - else begin - generatedProc := ropeff('$1 {$n', 'define $1 {$n', [header]); - if optStackTrace in prc.options then begin - getFrameDecl(p); - app(generatedProc, p.s[cpsLocals]); - procname := CStringLit(p, generatedProc, - prc.owner.name.s +{&} '.' +{&} prc.name.s); - filename := CStringLit(p, generatedProc, toFilename(prc.info)); - app(generatedProc, initFrame(p, procname, filename)); - end - else - app(generatedProc, p.s[cpsLocals]); - if (optProfiler in prc.options) and (gCmd <> cmdCompileToLLVM) then begin - if gProcProfile >= 64*1024 then // XXX: hard coded value! - InternalError(prc.info, 'too many procedures for profiling'); - useMagic(m, 'profileData'); - app(p.s[cpsLocals], 'ticks NIM_profilingStart;'+tnl); - if prc.loc.a < 0 then begin - appf(m.s[cfsDebugInit], 'profileData[$1].procname = $2;$n', - [toRope(gProcProfile), - makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s)]); - prc.loc.a := gProcProfile; - inc(gProcProfile); - end; - prepend(p.s[cpsInit], toRope('NIM_profilingStart = getticks();' + tnl)); - end; - app(generatedProc, p.s[cpsInit]); - app(generatedProc, p.s[cpsStmts]); - if p.beforeRetNeeded then - app(generatedProc, 'BeforeRet: ;' + tnl); - if optStackTrace in prc.options then - app(generatedProc, deinitFrame(p)); - if (optProfiler in prc.options) and (gCmd <> cmdCompileToLLVM) then - appf(generatedProc, - 'profileData[$1].total += elapsed(getticks(), NIM_profilingStart);$n', - [toRope(prc.loc.a)]); - app(generatedProc, returnStmt); - app(generatedProc, '}' + tnl); - end; - app(m.s[cfsProcs], generatedProc); - //if prc.kind = skMethod then addMethodToCompile(gNimDat, prc); -end; - -procedure genProcPrototype(m: BModule; sym: PSym); -begin - useHeader(m, sym); - if (lfNoDecl in sym.loc.Flags) then exit; - if lfDynamicLib in sym.loc.Flags then begin - if (sym.owner.id <> m.module.id) and - not intSetContainsOrIncl(m.declaredThings, sym.id) then begin - appff(m.s[cfsVars], 'extern $1 Dl_$2;$n', - '@Dl_$2 = linkonce global $1 zeroinitializer$n', - [getTypeDesc(m, sym.loc.t), toRope(sym.id)]); - if gCmd = cmdCompileToLLVM then include(sym.loc.flags, lfIndirect); - end - end - else begin - if not IntSetContainsOrIncl(m.declaredProtos, sym.id) then begin - appf(m.s[cfsProcHeaders], '$1;$n', [genProcHeader(m, sym)]); - end - end -end; - -procedure genProcNoForward(m: BModule; prc: PSym); -begin - fillProcLoc(prc); - useHeader(m, prc); - genProcPrototype(m, prc); - if (lfNoDecl in prc.loc.Flags) then exit; - if prc.typ.callConv = ccInline then begin - // We add inline procs to the calling module to enable C based inlining. - // This also means that a check with ``gGeneratedSyms`` is wrong, we need - // a check for ``m.declaredThings``. - if not intSetContainsOrIncl(m.declaredThings, prc.id) then - genProcAux(m, prc); - end - else if lfDynamicLib in prc.loc.flags then begin - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id) then - SymInDynamicLib(findPendingModule(m, prc), prc); - end - else if not (sfImportc in prc.flags) then begin - if not IntSetContainsOrIncl(gGeneratedSyms, prc.id) then - genProcAux(findPendingModule(m, prc), prc); - end -end; - -procedure genProc(m: BModule; prc: PSym); -begin - if sfBorrow in prc.flags then exit; - fillProcLoc(prc); - if [sfForward, sfFromGeneric] * prc.flags <> [] then - addForwardedProc(m, prc) - else - genProcNoForward(m, prc) -end; - -procedure genVarPrototype(m: BModule; sym: PSym); -begin - assert(sfGlobal in sym.flags); - useHeader(m, sym); - fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap); - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id) then - exit; - if sym.owner.id <> m.module.id then begin - // else we already have the symbol generated! - assert(sym.loc.r <> nil); - if gCmd = cmdCompileToLLVM then begin - include(sym.loc.flags, lfIndirect); - appf(m.s[cfsVars], '$1 = linkonce global $2 zeroinitializer$n', - [sym.loc.r, getTypeDesc(m, sym.loc.t)]); - end - else begin - app(m.s[cfsVars], 'extern '); - app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)); - if sfRegister in sym.flags then - app(m.s[cfsVars], ' register'); - if sfVolatile in sym.flags then - app(m.s[cfsVars], ' volatile'); - if sfThreadVar in sym.flags then - app(m.s[cfsVars], ' NIM_THREADVAR'); - appf(m.s[cfsVars], ' $1;$n', [sym.loc.r]) - end - end -end; - -procedure genConstPrototype(m: BModule; sym: PSym); -begin - useHeader(m, sym); - if sym.loc.k = locNone then - fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown); - if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(m.declaredThings, sym.id) then - exit; - if sym.owner.id <> m.module.id then begin - // else we already have the symbol generated! - assert(sym.loc.r <> nil); - appff(m.s[cfsData], - 'extern NIM_CONST $1 $2;$n', - '$1 = linkonce constant $2 zeroinitializer', - [getTypeDesc(m, sym.loc.t), sym.loc.r]) - end -end; - -function getFileHeader(const cfilenoext: string): PRope; -begin - if optCompileOnly in gGlobalOptions then - result := ropeff( - '/* Generated by Nimrod Compiler v$1 */$n' + - '/* (c) 2009 Andreas Rumpf */$n', - '; Generated by Nimrod Compiler v$1$n' + - '; (c) 2009 Andreas Rumpf$n', - [toRope(versionAsString)]) - else - result := ropeff( - '/* Generated by Nimrod Compiler v$1 */$n' + - '/* (c) 2009 Andreas Rumpf */$n' + - '/* Compiled for: $2, $3, $4 */$n' + - '/* Command for C compiler:$n $5 */$n', - '; Generated by Nimrod Compiler v$1$n' + - '; (c) 2009 Andreas Rumpf$n' + - '; Compiled for: $2, $3, $4$n' + - '; Command for LLVM compiler:$n $5$n', - [toRope(versionAsString), toRope(platform.OS[targetOS].name), - toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.ccompiler].name), - toRope(getCompileCFileCmd(cfilenoext))]); - case platform.CPU[targetCPU].intSize of - 16: appff(result, '$ntypedef short int NI;$n' + - 'typedef unsigned short int NU;$n', - '$n%NI = type i16$n', []); - 32: appff(result, '$ntypedef long int NI;$n' + - 'typedef unsigned long int NU;$n', - '$n%NI = type i32$n', []); - 64: appff(result, '$ntypedef long long int NI;$n' + - 'typedef unsigned long long int NU;$n', - '$n%NI = type i64$n', []); - else begin end - end -end; - -procedure genMainProc(m: BModule); -const - CommonMainBody = - ' setStackBottom(dummy);$n' + - ' nim__datInit();$n' + - ' systemInit();$n' + - '$1' + - '$2'; - CommonMainBodyLLVM = - ' %MOC$3 = bitcast [8 x %NI]* %dummy to i8*$n' + - ' call void @setStackBottom(i8* %MOC$3)$n' + - ' call void @nim__datInit()$n' + - ' call void systemInit()$n' + - '$1' + - '$2'; - PosixNimMain = - 'int cmdCount;$n' + - 'char** cmdLine;$n' + - 'char** gEnv;$n' + - 'N_CDECL(void, NimMain)(void) {$n' + - ' int dummy[8];$n' +{&} - CommonMainBody +{&} - '}$n'; - PosixCMain = - 'int main(int argc, char** args, char** env) {$n' + - ' cmdLine = args;$n' + - ' cmdCount = argc;$n' + - ' gEnv = env;$n' + - ' NimMain();$n' + - ' return 0;$n' + - '}$n'; - PosixNimMainLLVM = - '@cmdCount = linkonce i32$n' + - '@cmdLine = linkonce i8**$n' + - '@gEnv = linkonce i8**$n' + - 'define void @NimMain(void) {$n' + - ' %dummy = alloca [8 x %NI]$n' +{&} - CommonMainBodyLLVM +{&} - '}$n'; - PosixCMainLLVM = - 'define i32 @main(i32 %argc, i8** %args, i8** %env) {$n' + - ' store i8** %args, i8*** @cmdLine$n' + - ' store i32 %argc, i32* @cmdCount$n' + - ' store i8** %env, i8*** @gEnv$n' + - ' call void @NimMain()$n' + - ' ret i32 0$n' + - '}$n'; - WinNimMain = - 'N_CDECL(void, NimMain)(void) {$n' + - ' int dummy[8];$n' +{&} - CommonMainBody +{&} - '}$n'; - WinCMain = - 'N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $n' + - ' HINSTANCE hPrevInstance, $n' + - ' LPSTR lpCmdLine, int nCmdShow) {$n' + - ' NimMain();$n' + - ' return 0;$n' + - '}$n'; - WinNimMainLLVM = - 'define void @NimMain(void) {$n' + - ' %dummy = alloca [8 x %NI]$n' +{&} - CommonMainBodyLLVM +{&} - '}$n'; - WinCMainLLVM = - 'define stdcall i32 @WinMain(i32 %hCurInstance, $n' + - ' i32 %hPrevInstance, $n' + - ' i8* %lpCmdLine, i32 %nCmdShow) {$n' + - ' call void @NimMain()$n' + - ' ret i32 0$n' + - '}$n'; - WinNimDllMain = - 'N_LIB_EXPORT N_CDECL(void, NimMain)(void) {$n' + - ' int dummy[8];$n' +{&} - CommonMainBody +{&} - '}$n'; - WinCDllMain = - 'BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $n' + - ' LPVOID lpvReserved) {$n' + - ' NimMain();$n' + - ' return 1;$n' + - '}$n'; - WinNimDllMainLLVM = WinNimMainLLVM; - WinCDllMainLLVM = - 'define stdcall i32 @DllMain(i32 %hinstDLL, i32 %fwdreason, $n' + - ' i8* %lpvReserved) {$n' + - ' call void @NimMain()$n' + - ' ret i32 1$n' + - '}$n'; -var - nimMain, otherMain: TFormatStr; -begin - useMagic(m, 'setStackBottom'); - if (platform.targetOS = osWindows) and - (gGlobalOptions * [optGenGuiApp, optGenDynLib] <> []) then begin - if optGenGuiApp in gGlobalOptions then begin - if gCmd = cmdCompileToLLVM then begin - nimMain := WinNimMainLLVM; - otherMain := WinCMainLLVM - end - else begin - nimMain := WinNimMain; - otherMain := WinCMain; - end - end - else begin - if gCmd = cmdCompileToLLVM then begin - nimMain := WinNimDllMainLLVM; - otherMain := WinCDllMainLLVM; - end - else begin - nimMain := WinNimDllMain; - otherMain := WinCDllMain; - end - end; - {@discard} lists.IncludeStr(m.headerFiles, '') - end - else begin - if gCmd = cmdCompileToLLVM then begin - nimMain := PosixNimMainLLVM; - otherMain := PosixCMainLLVM; - end - else begin - nimMain := PosixNimMain; - otherMain := PosixCMain; - end - end; - if gBreakpoints <> nil then useMagic(m, 'dbgRegisterBreakpoint'); - inc(m.labels); - appf(m.s[cfsProcs], nimMain, [gBreakpoints, mainModInit, toRope(m.labels)]); - if not (optNoMain in gGlobalOptions) then - appf(m.s[cfsProcs], otherMain, []); -end; - -function getInitName(m: PSym): PRope; -begin - result := ropeff('$1Init', '@$1Init', [toRope(m.name.s)]); -end; - -procedure registerModuleToMain(m: PSym); -var - initname: PRope; -begin - initname := getInitName(m); - appff(mainModProcs, 'N_NOINLINE(void, $1)(void);$n', - 'declare void $1() noinline$n', [initname]); - if not (sfSystemModule in m.flags) then - appff(mainModInit, '$1();$n', 'call void ()* $1$n', [initname]); -end; - -procedure genInitCode(m: BModule); -var - initname, prc, procname, filename: PRope; -begin - if optProfiler in m.initProc.options then begin - // This does not really belong here, but there is no good place for this - // code. I don't want to put this to the proc generation as the - // ``IncludeStr`` call is quite slow. - {@discard} lists.IncludeStr(m.headerFiles, ''); - end; - initname := getInitName(m.module); - prc := ropeff('N_NOINLINE(void, $1)(void) {$n', - 'define void $1() noinline {$n', [initname]); - if m.typeNodes > 0 then begin - useMagic(m, 'TNimNode'); - appff(m.s[cfsTypeInit1], 'static TNimNode $1[$2];$n', - '$1 = private alloca [$2 x @TNimNode]$n', - [m.typeNodesName, toRope(m.typeNodes)]); - end; - if m.nimTypes > 0 then begin - useMagic(m, 'TNimType'); - appff(m.s[cfsTypeInit1], 'static TNimType $1[$2];$n', - '$1 = private alloca [$2 x @TNimType]$n', - [m.nimTypesName, toRope(m.nimTypes)]); - end; - if optStackTrace in m.initProc.options then begin - getFrameDecl(m.initProc); - app(prc, m.initProc.s[cpsLocals]); - app(prc, m.s[cfsTypeInit1]); - - procname := CStringLit(m.initProc, prc, 'module ' +{&} m.module.name.s); - filename := CStringLit(m.initProc, prc, toFilename(m.module.info)); - app(prc, initFrame(m.initProc, procname, filename)); - end - else begin - app(prc, m.initProc.s[cpsLocals]); - app(prc, m.s[cfsTypeInit1]); - end; - app(prc, m.s[cfsTypeInit2]); - app(prc, m.s[cfsTypeInit3]); - app(prc, m.s[cfsDebugInit]); - app(prc, m.s[cfsDynLibInit]); - app(prc, m.initProc.s[cpsInit]); - app(prc, m.initProc.s[cpsStmts]); - if optStackTrace in m.initProc.options then - app(prc, deinitFrame(m.initProc)); - app(prc, '}' +{&} tnl +{&} tnl); - app(m.s[cfsProcs], prc) -end; - -function genModule(m: BModule; const cfilenoext: string): PRope; -var - i: TCFileSection; -begin - result := getFileHeader(cfilenoext); - generateHeaders(m); - for i := low(TCFileSection) to cfsProcs do app(result, m.s[i]) -end; - -function rawNewModule(module: PSym; const filename: string): BModule; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - InitLinkedList(result.headerFiles); - intSetInit(result.declaredThings); - intSetInit(result.declaredProtos); - result.cfilename := filename; - result.filename := filename; - initIdTable(result.typeCache); - initIdTable(result.forwTypeCache); - result.module := module; - intSetInit(result.typeInfoMarker); - result.initProc := newProc(nil, result); - result.initProc.options := gOptions; - initNodeTable(result.dataCache); -{@emit result.typeStack := @[];} -{@emit result.forwardedProcs := @[];} - result.typeNodesName := getTempName(); - result.nimTypesName := getTempName(); -end; - -function newModule(module: PSym; const filename: string): BModule; -begin - result := rawNewModule(module, filename); - if (optDeadCodeElim in gGlobalOptions) then begin - if (sfDeadCodeElim in module.flags) then - InternalError('added pending module twice: ' + filename); - addPendingModule(result) - end; -end; - -procedure registerTypeInfoModule(); -const - moduleName = 'nim__dat'; -var - s: PSym; -begin - s := NewSym(skModule, getIdent(moduleName), nil); - gNimDat := rawNewModule(s, joinPath(options.projectPath, moduleName)+'.nim'); - addPendingModule(gNimDat); - appff(mainModProcs, 'N_NOINLINE(void, $1)(void);$n', - 'declare void $1() noinline$n', [getInitName(s)]); -end; - -function myOpen(module: PSym; const filename: string): PPassContext; -begin - if gNimDat = nil then registerTypeInfoModule(); - result := newModule(module, filename); -end; - -function myOpenCached(module: PSym; const filename: string; - rd: PRodReader): PPassContext; -var - cfile, cfilenoext, objFile: string; -begin - if gNimDat = nil then registerTypeInfoModule(); - //MessageOut('cgen.myOpenCached has been called ' + filename); - cfile := changeFileExt(completeCFilePath(filename), cExt); - cfilenoext := changeFileExt(cfile, ''); - addFileToLink(cfilenoext); - registerModuleToMain(module); - // XXX: this cannot be right here, initalization has to be appended during - // the ``myClose`` call - result := nil; -end; - -function shouldRecompile(code: PRope; const cfile, cfilenoext: string): bool; -var - objFile: string; -begin - result := true; - if not (optForceFullMake in gGlobalOptions) then begin - objFile := toObjFile(cfilenoext); - if writeRopeIfNotEqual(code, cfile) then exit; - if ExistsFile(objFile) and nos.FileNewer(objFile, cfile) then - result := false - end - else - writeRope(code, cfile); -end; - -function myProcess(b: PPassContext; n: PNode): PNode; -var - m: BModule; -begin - result := n; - if b = nil then exit; - m := BModule(b); - m.initProc.options := gOptions; - genStmts(m.initProc, n); -end; - -procedure finishModule(m: BModule); -var - i: int; - prc: PSym; -begin - i := 0; - while i <= high(m.forwardedProcs) do begin - // Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use - // a ``for`` loop here - prc := m.forwardedProcs[i]; - if sfForward in prc.flags then InternalError(prc.info, 'still forwarded'); - genProcNoForward(m, prc); - inc(i); - end; - assert(gForwardedProcsCounter >= i); - dec(gForwardedProcsCounter, i); - setLength(m.forwardedProcs, 0); -end; - -procedure writeModule(m: BModule); -var - cfile, cfilenoext: string; - code: PRope; -begin - // generate code for the init statements of the module: - genInitCode(m); - finishTypeDescriptions(m); - - cfile := completeCFilePath(m.cfilename); - cfilenoext := changeFileExt(cfile, ''); - if sfMainModule in m.module.flags then begin - // generate main file: - app(m.s[cfsProcHeaders], mainModProcs); - end; - code := genModule(m, cfilenoext); - if shouldRecompile(code, changeFileExt(cfile, cExt), cfilenoext) then begin - addFileToCompile(cfilenoext); - end; - addFileToLink(cfilenoext); -end; - -function myClose(b: PPassContext; n: PNode): PNode; -var - m: BModule; - i: int; - disp: PNode; -begin - result := n; - if b = nil then exit; - m := BModule(b); - if n <> nil then begin - m.initProc.options := gOptions; - genStmts(m.initProc, n); - end; - registerModuleToMain(m.module); - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags) then - finishModule(m); - if sfMainModule in m.module.flags then begin - disp := generateMethodDispatchers(); - for i := 0 to sonsLen(disp)-1 do genProcAux(gNimDat, disp.sons[i].sym); - genMainProc(m); - // we need to process the transitive closure because recursive module - // deps are allowed (and the system module is processed in the wrong - // order anyway) - while gForwardedProcsCounter > 0 do - for i := 0 to high(gPendingModules) do - finishModule(gPendingModules[i]); - for i := 0 to high(gPendingModules) do writeModule(gPendingModules[i]); - setLength(gPendingModules, 0); - end; - if not (optDeadCodeElim in gGlobalOptions) and - not (sfDeadCodeElim in m.module.flags) then - writeModule(m); - if sfMainModule in m.module.flags then - writeMapping(gMapping); -end; - -function cgenPass(): TPass; -begin - initPass(result); - result.open := myOpen; - result.openCached := myOpenCached; - result.process := myProcess; - result.close := myClose; -end; - -initialization - InitIiTable(gToTypeInfoId); - IntSetInit(gGeneratedSyms); -end. diff --git a/nim/cgmeth.pas b/nim/cgmeth.pas deleted file mode 100755 index 6b9335c4c7..0000000000 --- a/nim/cgmeth.pas +++ /dev/null @@ -1,269 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit cgmeth; - -// This module implements code generation for multi methods. - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, - options, ast, astalgo, msgs, idents, rnimsyn, types, magicsys; - -procedure methodDef(s: PSym); -function methodCall(n: PNode): PNode; -function generateMethodDispatchers(): PNode; - -implementation - -const - skipPtrs = {@set}[tyVar, tyPtr, tyRef, tyGenericInst]; - -function genConv(n: PNode; d: PType; downcast: bool): PNode; -var - dest, source: PType; - diff: int; -begin - dest := skipTypes(d, abstractPtrs); - source := skipTypes(n.typ, abstractPtrs); - if (source.kind = tyObject) and (dest.kind = tyObject) then begin - diff := inheritanceDiff(dest, source); - if diff = high(int) then InternalError(n.info, 'cgmeth.genConv'); - if diff < 0 then begin - result := newNodeIT(nkObjUpConv, n.info, d); - addSon(result, n); - if downCast then - InternalError(n.info, 'cgmeth.genConv: no upcast allowed'); - end - else if diff > 0 then begin - result := newNodeIT(nkObjDownConv, n.info, d); - addSon(result, n); - if not downCast then - InternalError(n.info, 'cgmeth.genConv: no downcast allowed'); - end - else result := n - end - else result := n -end; - -function methodCall(n: PNode): PNode; -var - disp: PSym; - i: int; -begin - result := n; - disp := lastSon(result.sons[0].sym.ast).sym; - result.sons[0].sym := disp; - for i := 1 to sonsLen(result)-1 do - result.sons[i] := genConv(result.sons[i], disp.typ.sons[i], true) -end; - -var - gMethods: array of TSymSeq; - -function sameMethodBucket(a, b: PSym): bool; -var - i: int; - aa, bb: PType; -begin - result := false; - if a.name.id <> b.name.id then exit; - if sonsLen(a.typ) <> sonsLen(b.typ) then exit; - // check for return type: - if not sameTypeOrNil(a.typ.sons[0], b.typ.sons[0]) then exit; - for i := 1 to sonsLen(a.typ)-1 do begin - aa := a.typ.sons[i]; - bb := b.typ.sons[i]; - while true do begin - aa := skipTypes(aa, {@set}[tyGenericInst]); - bb := skipTypes(bb, {@set}[tyGenericInst]); - if (aa.kind = bb.kind) and (aa.kind in [tyVar, tyPtr, tyRef]) then begin - aa := aa.sons[0]; - bb := bb.sons[0]; - end - else - break - end; - if sameType(aa, bb) - or (aa.kind = tyObject) and (bb.kind = tyObject) - and (inheritanceDiff(bb, aa) < 0) then begin end - else exit; - end; - result := true -end; - -procedure methodDef(s: PSym); -var - i, L, q: int; - disp: PSym; -begin - L := length(gMethods); - for i := 0 to L-1 do begin - if sameMethodBucket(gMethods[i][0], s) then begin - {@ignore} - q := length(gMethods[i]); - setLength(gMethods[i], q+1); - gMethods[i][q] := s; - {@emit - add(gMethods[i], s); - } - // store a symbol to the dispatcher: - addSon(s.ast, lastSon(gMethods[i][0].ast)); - exit - end - end; -{@ignore} - setLength(gMethods, L+1); - setLength(gMethods[L], 1); - gMethods[L][0] := s; -{@emit - add(gMethods, @[s]); -} - // create a new dispatcher: - disp := copySym(s); - disp.typ := copyType(disp.typ, disp.typ.owner, false); - if disp.typ.callConv = ccInline then disp.typ.callConv := ccDefault; - disp.ast := copyTree(s.ast); - disp.ast.sons[codePos] := nil; - if s.typ.sons[0] <> nil then - disp.ast.sons[resultPos].sym := copySym(s.ast.sons[resultPos].sym); - addSon(s.ast, newSymNode(disp)); -end; - -function relevantCol(methods: TSymSeq; col: int): bool; -var - t: PType; - i: int; -begin - // returns true iff the position is relevant - t := methods[0].typ.sons[col]; - result := false; - if skipTypes(t, skipPtrs).kind = tyObject then - for i := 1 to high(methods) do - if not SameType(methods[i].typ.sons[col], t) then begin - result := true; exit - end -end; - -function cmpSignatures(a, b: PSym; const relevantCols: TIntSet): int; -var - col, d: int; - aa, bb: PType; -begin - result := 0; - for col := 1 to sonsLen(a.typ)-1 do - if intSetContains(relevantCols, col) then begin - aa := skipTypes(a.typ.sons[col], skipPtrs); - bb := skipTypes(b.typ.sons[col], skipPtrs); - d := inheritanceDiff(aa, bb); - if (d <> high(int)) then begin - result := d; exit - end - end -end; - -procedure sortBucket(var a: TSymSeq; const relevantCols: TIntSet); -// we use shellsort here; fast and simple -var - N, i, j, h: int; - v: PSym; -begin - N := length(a); - h := 1; repeat h := 3*h+1; until h > N; - repeat - h := h div 3; - for i := h to N-1 do begin - v := a[i]; j := i; - while cmpSignatures(a[j-h], v, relevantCols) >= 0 do begin - a[j] := a[j-h]; j := j - h; - if j < h then break - end; - a[j] := v; - end; - until h = 1 -end; - -function genDispatcher(methods: TSymSeq; const relevantCols: TIntSet): PSym; -var - disp, cond, call, ret, a, isn: PNode; - base, curr, ands, iss: PSym; - meth, col, paramLen: int; -begin - base := lastSon(methods[0].ast).sym; - result := base; - paramLen := sonsLen(base.typ); - disp := newNodeI(nkIfStmt, base.info); - ands := getSysSym('and'); - iss := getSysSym('is'); - for meth := 0 to high(methods) do begin - curr := methods[meth]; - // generate condition: - cond := nil; - for col := 1 to paramLen-1 do begin - if IntSetContains(relevantCols, col) then begin - isn := newNodeIT(nkCall, base.info, getSysType(tyBool)); - addSon(isn, newSymNode(iss)); - addSon(isn, newSymNode(base.typ.n.sons[col].sym)); - addSon(isn, newNodeIT(nkType, base.info, curr.typ.sons[col])); - if cond <> nil then begin - a := newNodeIT(nkCall, base.info, getSysType(tyBool)); - addSon(a, newSymNode(ands)); - addSon(a, cond); - addSon(a, isn); - cond := a - end - else - cond := isn - end - end; - // generate action: - call := newNodeI(nkCall, base.info); - addSon(call, newSymNode(curr)); - for col := 1 to paramLen-1 do begin - addSon(call, genConv(newSymNode(base.typ.n.sons[col].sym), - curr.typ.sons[col], false)); - end; - if base.typ.sons[0] <> nil then begin - a := newNodeI(nkAsgn, base.info); - addSon(a, newSymNode(base.ast.sons[resultPos].sym)); - addSon(a, call); - ret := newNodeI(nkReturnStmt, base.info); - addSon(ret, a); - end - else - ret := call; - a := newNodeI(nkElifBranch, base.info); - addSon(a, cond); - addSon(a, ret); - addSon(disp, a); - end; - result.ast.sons[codePos] := disp; -end; - -function generateMethodDispatchers(): PNode; -var - bucket, col: int; - relevantCols: TIntSet; -begin - result := newNode(nkStmtList); - for bucket := 0 to length(gMethods)-1 do begin - IntSetInit(relevantCols); - for col := 1 to sonsLen(gMethods[bucket][0].typ)-1 do - if relevantCol(gMethods[bucket], col) then IntSetIncl(relevantCols, col); - sortBucket(gMethods[bucket], relevantCols); - addSon(result, newSymNode(genDispatcher(gMethods[bucket], relevantCols))); - end -end; - -initialization - {@emit gMethods := @[]; } -end. diff --git a/nim/charsets.pas b/nim/charsets.pas deleted file mode 100755 index a5f14450fd..0000000000 --- a/nim/charsets.pas +++ /dev/null @@ -1,56 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit charsets; - -interface - -const - CharSize = SizeOf(Char); - Lrz = ' '; - Apo = ''''; - Tabulator = #9; - ESC = #27; - CR = #13; - FF = #12; - LF = #10; - BEL = #7; - BACKSPACE = #8; - VT = #11; -{$ifdef macos} - DirSep = ':'; - NL = CR + ''; - FirstNLchar = CR; - PathSep = ';'; // XXX: is this correct? -{$else} - {$ifdef unix} - DirSep = '/'; - NL = LF + ''; - FirstNLchar = LF; - PathSep = ':'; - {$else} // windows, dos - DirSep = '\'; - NL = CR + LF; - FirstNLchar = CR; - DriveSeparator = ':'; - PathSep = ';'; - {$endif} -{$endif} - UpLetters = ['A'..'Z', #192..#222]; - DownLetters = ['a'..'z', #223..#255]; - Numbers = ['0'..'9']; - Letters = UpLetters + DownLetters; - -type - TCharSet = set of Char; - PCharSet = ^TCharSet; - -implementation - -end. diff --git a/nim/commands.pas b/nim/commands.pas deleted file mode 100755 index 19f79fb4a3..0000000000 --- a/nim/commands.pas +++ /dev/null @@ -1,588 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit commands; - -// This module handles the parsing of command line arguments. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, nos, msgs, options, nversion, condsyms, strutils, extccomp, - platform, lists, wordrecg; - -procedure writeCommandLineUsage; - -type - TCmdLinePass = ( - passCmd1, // first pass over the command line - passCmd2, // second pass over the command line - passPP // preprocessor called ProcessCommand() - ); - -procedure ProcessCommand(const switch: string; pass: TCmdLinePass); -procedure processSwitch(const switch, arg: string; pass: TCmdlinePass; - const info: TLineInfo); - -implementation - -{@ignore} -const -{$ifdef fpc} - compileDate = {$I %date%}; -{$else} - compileDate = '2009-0-0'; -{$endif} -{@emit} - -const - HelpMessage = 'Nimrod Compiler Version $1 (' +{&} - compileDate +{&} ') [$2: $3]' +{&} nl +{&} - 'Copyright (c) 2004-2009 by Andreas Rumpf' +{&} nl; - -const - Usage = '' -//[[[cog -//from string import replace -//def f(x): return "+{&} '" + replace(x, "'", "''")[:-1] + "' +{&} nl" -//for line in open("data/basicopt.txt").readlines(): -// cog.outl(f(line)) -//]]] -+{&} 'Usage::' +{&} nl -+{&} ' nimrod command [options] inputfile [arguments]' +{&} nl -+{&} 'Command::' +{&} nl -+{&} ' compile, c compile project with default code generator (C)' +{&} nl -+{&} ' compileToC, cc compile project with C code generator' +{&} nl -+{&} ' doc generate the documentation for inputfile' +{&} nl -+{&} ' rst2html converts a reStructuredText file to HTML' +{&} nl -+{&} ' rst2tex converts a reStructuredText file to TeX' +{&} nl -+{&} 'Arguments:' +{&} nl -+{&} ' arguments are passed to the program being run (if --run option is selected)' +{&} nl -+{&} 'Options:' +{&} nl -+{&} ' -p, --path:PATH add path to search paths' +{&} nl -+{&} ' -o, --out:FILE set the output filename' +{&} nl -+{&} ' -d, --define:SYMBOL define a conditional symbol' +{&} nl -+{&} ' -u, --undef:SYMBOL undefine a conditional symbol' +{&} nl -+{&} ' -f, --forceBuild force rebuilding of all modules' +{&} nl -+{&} ' --symbolFiles:on|off use symbol files to speed up compilation (buggy!)' +{&} nl -+{&} ' --stackTrace:on|off code generation for stack trace ON|OFF' +{&} nl -+{&} ' --lineTrace:on|off code generation for line trace ON|OFF' +{&} nl -+{&} ' --debugger:on|off turn Embedded Nimrod Debugger ON|OFF' +{&} nl -+{&} ' -x, --checks:on|off code generation for all runtime checks ON|OFF' +{&} nl -+{&} ' --objChecks:on|off code generation for obj conversion checks ON|OFF' +{&} nl -+{&} ' --fieldChecks:on|off code generation for case variant fields ON|OFF' +{&} nl -+{&} ' --rangeChecks:on|off code generation for range checks ON|OFF' +{&} nl -+{&} ' --boundChecks:on|off code generation for bound checks ON|OFF' +{&} nl -+{&} ' --overflowChecks:on|off code generation for over-/underflow checks ON|OFF' +{&} nl -+{&} ' -a, --assertions:on|off code generation for assertions ON|OFF' +{&} nl -+{&} ' --deadCodeElim:on|off whole program dead code elimination ON|OFF' +{&} nl -+{&} ' --opt:none|speed|size optimize not at all or for speed|size' +{&} nl -+{&} ' --app:console|gui|lib generate a console|GUI application|dynamic library' +{&} nl -+{&} ' -r, --run run the compiled program with given arguments' +{&} nl -+{&} ' --advanced show advanced command line switches' +{&} nl -+{&} ' -h, --help show this help' +{&} nl -//[[[end]]] - ; - - AdvancedUsage = '' -//[[[cog -//for line in open("data/advopt.txt").readlines(): -// cog.outl(f(line)) -//]]] -+{&} 'Advanced commands::' +{&} nl -+{&} ' pas convert a Pascal file to Nimrod syntax' +{&} nl -+{&} ' pretty pretty print the inputfile' +{&} nl -+{&} ' genDepend generate a DOT file containing the' +{&} nl -+{&} ' module dependency graph' +{&} nl -+{&} ' listDef list all defined conditionals and exit' +{&} nl -+{&} ' check checks the project for syntax and semantic' +{&} nl -+{&} ' parse parses a single file (for debugging Nimrod)' +{&} nl -+{&} 'Advanced options:' +{&} nl -+{&} ' -w, --warnings:on|off warnings ON|OFF' +{&} nl -+{&} ' --warning[X]:on|off specific warning X ON|OFF' +{&} nl -+{&} ' --hints:on|off hints ON|OFF' +{&} nl -+{&} ' --hint[X]:on|off specific hint X ON|OFF' +{&} nl -+{&} ' --lib:PATH set the system library path' +{&} nl -+{&} ' -c, --compileOnly compile only; do not assemble or link' +{&} nl -+{&} ' --noLinking compile but do not link' +{&} nl -+{&} ' --noMain do not generate a main procedure' +{&} nl -+{&} ' --genScript generate a compile script (in the ''nimcache''' +{&} nl -+{&} ' subdirectory named ''compile_$project$scriptext'')' +{&} nl -+{&} ' --os:SYMBOL set the target operating system (cross-compilation)' +{&} nl -+{&} ' --cpu:SYMBOL set the target processor (cross-compilation)' +{&} nl -+{&} ' --debuginfo enables debug information' +{&} nl -+{&} ' -t, --passc:OPTION pass an option to the C compiler' +{&} nl -+{&} ' -l, --passl:OPTION pass an option to the linker' +{&} nl -+{&} ' --genMapping generate a mapping file containing' +{&} nl -+{&} ' (Nimrod, mangled) identifier pairs' +{&} nl -+{&} ' --lineDir:on|off generation of #line directive ON|OFF' +{&} nl -+{&} ' --checkpoints:on|off turn on|off checkpoints; for debugging Nimrod' +{&} nl -+{&} ' --skipCfg do not read the general configuration file' +{&} nl -+{&} ' --skipProjCfg do not read the project''s configuration file' +{&} nl -+{&} ' --gc:refc|boehm|none use Nimrod''s native GC|Boehm GC|no GC' +{&} nl -+{&} ' --index:FILE use FILE to generate a documenation index file' +{&} nl -+{&} ' --putenv:key=value set an environment variable' +{&} nl -+{&} ' --listCmd list the commands used to execute external programs' +{&} nl -+{&} ' --parallelBuild=0|1|... perform a parallel build' +{&} nl -+{&} ' value = number of processors (0 for auto-detect)' +{&} nl -+{&} ' --verbosity:0|1|2|3 set Nimrod''s verbosity level (0 is default)' +{&} nl -+{&} ' -v, --version show detailed version information' +{&} nl -//[[[end]]] - ; - -function getCommandLineDesc: string; -begin - result := format(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, cpu[platform.hostCPU].name]) +{&} Usage -end; - -var - helpWritten: boolean; // BUGFIX 19 - versionWritten: boolean; - advHelpWritten: boolean; - -procedure HelpOnError(pass: TCmdLinePass); -begin - if (pass = passCmd1) and not helpWritten then begin - // BUGFIX 19 - MessageOut(getCommandLineDesc()); - helpWritten := true; - halt(0); - end -end; - -procedure writeAdvancedUsage(pass: TCmdLinePass); -begin - if (pass = passCmd1) and not advHelpWritten then begin - // BUGFIX 19 - MessageOut(format(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name]) +{&} - AdvancedUsage); - advHelpWritten := true; - helpWritten := true; - halt(0); - end -end; - -procedure writeVersionInfo(pass: TCmdLinePass); -begin - if (pass = passCmd1) and not versionWritten then begin - versionWritten := true; - helpWritten := true; - messageOut(format(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name])); - halt(0); - end -end; - -procedure writeCommandLineUsage; -begin - if not helpWritten then begin - messageOut(getCommandLineDesc()); - helpWritten := true - end -end; - -procedure InvalidCmdLineOption(pass: TCmdLinePass; const switch: string; - const info: TLineInfo); -begin - liMessage(info, errInvalidCmdLineOption, switch) -end; - -procedure splitSwitch(const switch: string; out cmd, arg: string; - pass: TCmdLinePass; const info: TLineInfo); -var - i: int; -begin - cmd := ''; - i := strStart; - if (i < length(switch)+strStart) and (switch[i] = '-') then inc(i); - if (i < length(switch)+strStart) and (switch[i] = '-') then inc(i); - while i < length(switch) + strStart do begin - case switch[i] of - 'a'..'z', 'A'..'Z', '0'..'9', '_', '.': - addChar(cmd, switch[i]); - else break; - end; - inc(i); - end; - if i >= length(switch) + strStart then - arg := '' - else if switch[i] in [':', '=', '['] then - arg := ncopy(switch, i + 1) - else - InvalidCmdLineOption(pass, switch, info) -end; - -procedure ProcessOnOffSwitch(const op: TOptions; const arg: string; - pass: TCmdlinePass; const info: TLineInfo); -begin - case whichKeyword(arg) of - wOn: gOptions := gOptions + op; - wOff: gOptions := gOptions - op; - else liMessage(info, errOnOrOffExpectedButXFound, arg) - end -end; - -procedure ProcessOnOffSwitchG(const op: TGlobalOptions; const arg: string; - pass: TCmdlinePass; const info: TLineInfo); -begin - case whichKeyword(arg) of - wOn: gGlobalOptions := gGlobalOptions + op; - wOff: gGlobalOptions := gGlobalOptions - op; - else liMessage(info, errOnOrOffExpectedButXFound, arg) - end -end; - -procedure ExpectArg(const switch, arg: string; pass: TCmdLinePass; - const info: TLineInfo); -begin - if (arg = '') then - liMessage(info, errCmdLineArgExpected, switch) -end; - -procedure ExpectNoArg(const switch, arg: string; pass: TCmdLinePass; - const info: TLineInfo); -begin - if (arg <> '') then - liMessage(info, errCmdLineNoArgExpected, switch) -end; - -procedure ProcessSpecificNote(const arg: string; state: TSpecialWord; - pass: TCmdlinePass; const info: TLineInfo); -var - i, x: int; - n: TNoteKind; - id: string; -begin - id := ''; - // arg = "X]:on|off" - i := strStart; - n := hintMin; - while (i < length(arg)+strStart) and (arg[i] <> ']') do begin - addChar(id, arg[i]); - inc(i) - end; - if (i < length(arg)+strStart) and (arg[i] = ']') then - inc(i) - else - InvalidCmdLineOption(pass, arg, info); - if (i < length(arg)+strStart) and (arg[i] in [':', '=']) then - inc(i) - else - InvalidCmdLineOption(pass, arg, info); - if state = wHint then begin - x := findStr(msgs.HintsToStr, id); - if x >= 0 then - n := TNoteKind(x + ord(hintMin)) - else - InvalidCmdLineOption(pass, arg, info) - end - else begin - x := findStr(msgs.WarningsToStr, id); - if x >= 0 then - n := TNoteKind(x + ord(warnMin)) - else - InvalidCmdLineOption(pass, arg, info) - end; - case whichKeyword(ncopy(arg, i)) of - wOn: include(gNotes, n); - wOff: exclude(gNotes, n); - else liMessage(info, errOnOrOffExpectedButXFound, arg) - end -end; - -function processPath(const path: string): string; -begin - result := UnixToNativePath(format(path, - ['nimrod', getPrefixDir(), 'lib', libpath])) -end; - -procedure processCompile(const filename: string); -var - found, trunc: string; -begin - found := findFile(filename); - if found = '' then found := filename; - trunc := changeFileExt(found, ''); - extccomp.addExternalFileToCompile(trunc); - extccomp.addFileToLink(completeCFilePath(trunc, false)); -end; - -procedure processSwitch(const switch, arg: string; pass: TCmdlinePass; - const info: TLineInfo); -var - theOS: TSystemOS; - cpu: TSystemCPU; - key, val, path: string; -begin - case whichKeyword(switch) of - wPath, wP: begin - expectArg(switch, arg, pass, info); - path := processPath(arg); - {@discard} lists.IncludeStr(options.searchPaths, path) - end; - wOut, wO: begin - expectArg(switch, arg, pass, info); - options.outFile := arg; - end; - wDefine, wD: begin - expectArg(switch, arg, pass, info); - DefineSymbol(arg) - end; - wUndef, wU: begin - expectArg(switch, arg, pass, info); - UndefSymbol(arg) - end; - wCompile: begin - expectArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - processCompile(arg); - end; - wLink: begin - expectArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - addFileToLink(arg); - end; - wDebuginfo: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optCDebug); - end; - wCompileOnly, wC: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optCompileOnly); - end; - wNoLinking: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optNoLinking); - end; - wNoMain: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optNoMain); - end; - wForceBuild, wF: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optForceFullMake); - end; - wGC: begin - expectArg(switch, arg, pass, info); - case whichKeyword(arg) of - wBoehm: begin - include(gGlobalOptions, optBoehmGC); - exclude(gGlobalOptions, optRefcGC); - DefineSymbol('boehmgc'); - end; - wRefc: begin - exclude(gGlobalOptions, optBoehmGC); - include(gGlobalOptions, optRefcGC) - end; - wNone: begin - exclude(gGlobalOptions, optRefcGC); - exclude(gGlobalOptions, optBoehmGC); - defineSymbol('nogc'); - end - else - liMessage(info, errNoneBoehmRefcExpectedButXFound, arg) - end - end; - wWarnings, wW: ProcessOnOffSwitch({@set}[optWarns], arg, pass, info); - wWarning: ProcessSpecificNote(arg, wWarning, pass, info); - wHint: ProcessSpecificNote(arg, wHint, pass, info); - wHints: ProcessOnOffSwitch({@set}[optHints], arg, pass, info); - wCheckpoints: ProcessOnOffSwitch({@set}[optCheckpoints], arg, pass, info); - wStackTrace: ProcessOnOffSwitch({@set}[optStackTrace], arg, pass, info); - wLineTrace: ProcessOnOffSwitch({@set}[optLineTrace], arg, pass, info); - wDebugger: begin - ProcessOnOffSwitch({@set}[optEndb], arg, pass, info); - if optEndb in gOptions then - DefineSymbol('endb') - else - UndefSymbol('endb') - end; - wProfiler: begin - ProcessOnOffSwitch({@set}[optProfiler], arg, pass, info); - if optProfiler in gOptions then DefineSymbol('profiler') - else UndefSymbol('profiler') - end; - wChecks, wX: ProcessOnOffSwitch(checksOptions, arg, pass, info); - wObjChecks: ProcessOnOffSwitch({@set}[optObjCheck], arg, pass, info); - wFieldChecks: ProcessOnOffSwitch({@set}[optFieldCheck], arg, pass, info); - wRangeChecks: ProcessOnOffSwitch({@set}[optRangeCheck], arg, pass, info); - wBoundChecks: ProcessOnOffSwitch({@set}[optBoundsCheck], arg, pass, info); - wOverflowChecks: ProcessOnOffSwitch({@set}[optOverflowCheck], arg, pass, info); - wLineDir: ProcessOnOffSwitch({@set}[optLineDir], arg, pass, info); - wAssertions, wA: ProcessOnOffSwitch({@set}[optAssert], arg, pass, info); - wDeadCodeElim: ProcessOnOffSwitchG({@set}[optDeadCodeElim], arg, pass, info); - wOpt: begin - expectArg(switch, arg, pass, info); - case whichKeyword(arg) of - wSpeed: begin - include(gOptions, optOptimizeSpeed); - exclude(gOptions, optOptimizeSize) - end; - wSize: begin - exclude(gOptions, optOptimizeSpeed); - include(gOptions, optOptimizeSize) - end; - wNone: begin - exclude(gOptions, optOptimizeSpeed); - exclude(gOptions, optOptimizeSize) - end - else - liMessage(info, errNoneSpeedOrSizeExpectedButXFound, arg) - end - end; - wApp: begin - expectArg(switch, arg, pass, info); - case whichKeyword(arg) of - wGui: begin - include(gGlobalOptions, optGenGuiApp); - defineSymbol('guiapp') - end; - wConsole: - exclude(gGlobalOptions, optGenGuiApp); - wLib: begin - include(gGlobalOptions, optGenDynLib); - exclude(gGlobalOptions, optGenGuiApp); - defineSymbol('library') - end; - else - liMessage(info, errGuiConsoleOrLibExpectedButXFound, arg) - end - end; - wListDef: begin - expectNoArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - condsyms.listSymbols(); - end; - wPassC, wT: begin - expectArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - extccomp.addCompileOption(arg) - end; - wPassL, wL: begin - expectArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - extccomp.addLinkOption(arg) - end; - wIndex: begin - expectArg(switch, arg, pass, info); - if pass in {@set}[passCmd2, passPP] then - gIndexFile := arg - end; - wImport: begin - expectArg(switch, arg, pass, info); - options.addImplicitMod(arg); - end; - wListCmd: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optListCmd); - end; - wGenMapping: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optGenMapping); - end; - wOS: begin - expectArg(switch, arg, pass, info); - if (pass = passCmd1) then begin - theOS := platform.NameToOS(arg); - if theOS = osNone then - liMessage(info, errUnknownOS, arg); - if theOS <> platform.hostOS then begin - setTarget(theOS, targetCPU); - include(gGlobalOptions, optCompileOnly); - condsyms.InitDefines() - end - end - end; - wCPU: begin - expectArg(switch, arg, pass, info); - if (pass = passCmd1) then begin - cpu := platform.NameToCPU(arg); - if cpu = cpuNone then - liMessage(info, errUnknownCPU, arg); - if cpu <> platform.hostCPU then begin - setTarget(targetOS, cpu); - include(gGlobalOptions, optCompileOnly); - condsyms.InitDefines() - end - end - end; - wRun, wR: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optRun); - end; - wVerbosity: begin - expectArg(switch, arg, pass, info); - gVerbosity := parseInt(arg); - end; - wParallelBuild: begin - expectArg(switch, arg, pass, info); - gNumberOfProcessors := parseInt(arg); - end; - wVersion, wV: begin - expectNoArg(switch, arg, pass, info); - writeVersionInfo(pass); - end; - wAdvanced: begin - expectNoArg(switch, arg, pass, info); - writeAdvancedUsage(pass); - end; - wHelp, wH: begin - expectNoArg(switch, arg, pass, info); - helpOnError(pass); - end; - wSymbolFiles: ProcessOnOffSwitchG({@set}[optSymbolFiles], arg, pass, info); - wSkipCfg: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optSkipConfigFile); - end; - wSkipProjCfg: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optSkipProjConfigFile); - end; - wGenScript: begin - expectNoArg(switch, arg, pass, info); - include(gGlobalOptions, optGenScript); - end; - wLib: begin - expectArg(switch, arg, pass, info); - libpath := processPath(arg) - end; - wPutEnv: begin - expectArg(switch, arg, pass, info); - splitSwitch(arg, key, val, pass, info); - nos.putEnv(key, val); - end; - wCC: begin - expectArg(switch, arg, pass, info); - setCC(arg) - end; - else if strutils.find(switch, '.') >= strStart then - options.setConfigVar(switch, arg) - else - InvalidCmdLineOption(pass, switch, info) - end -end; - -procedure ProcessCommand(const switch: string; pass: TCmdLinePass); -var - cmd, arg: string; - info: TLineInfo; -begin - info := newLineInfo('command line', 1, 1); - splitSwitch(switch, cmd, arg, pass, info); - ProcessSwitch(cmd, arg, pass, info) -end; - -end. diff --git a/nim/condsyms.pas b/nim/condsyms.pas deleted file mode 100755 index d22bc0e185..0000000000 --- a/nim/condsyms.pas +++ /dev/null @@ -1,152 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit condsyms; - -// This module handles the conditional symbols. - -{$include 'config.inc'} - -interface - -uses - nsystem, ast, astalgo, msgs, nhashes, platform, strutils, idents; - -var - gSymbols: TStrTable; - -procedure InitDefines; -procedure DeinitDefines; - -procedure DefineSymbol(const symbol: string); -procedure UndefSymbol(const symbol: string); -function isDefined(symbol: PIdent): Boolean; -procedure ListSymbols; - -function countDefinedSymbols: int; - -implementation - -procedure DefineSymbol(const symbol: string); -var - sym: PSym; - i: PIdent; -begin - i := getIdent(symbol); - sym := StrTableGet(gSymbols, i); - if sym = nil then begin - new(sym); // circumvent the ID mechanism - {@ignore} - fillChar(sym^, sizeof(sym^), 0); - {@emit} - sym.kind := skConditional; - sym.name := i; - StrTableAdd(gSymbols, sym); - end; - sym.position := 1; -end; - -procedure UndefSymbol(const symbol: string); -var - sym: PSym; -begin - sym := StrTableGet(gSymbols, getIdent(symbol)); - if sym <> nil then sym.position := 0; -end; - -function isDefined(symbol: PIdent): Boolean; -var - sym: PSym; -begin - sym := StrTableGet(gSymbols, symbol); - result := (sym <> nil) and (sym.position = 1) -end; - -procedure ListSymbols; -var - it: TTabIter; - s: PSym; -begin - s := InitTabIter(it, gSymbols); - MessageOut('-- List of currently defined symbols --'); - while s <> nil do begin - if s.position = 1 then MessageOut(s.name.s); - s := nextIter(it, gSymbols); - end; - MessageOut('-- End of list --'); -end; - -function countDefinedSymbols: int; -var - it: TTabIter; - s: PSym; -begin - s := InitTabIter(it, gSymbols); - result := 0; - while s <> nil do begin - if s.position = 1 then inc(result); - s := nextIter(it, gSymbols); - end; -end; - -procedure InitDefines; -begin - initStrTable(gSymbols); - DefineSymbol('nimrod'); // 'nimrod' is always defined -{@ignore} - DefineSymbol('nim'); // Pascal version defines 'nim' in addition -{@emit} - // add platform specific symbols: - case targetCPU of - cpuI386: DefineSymbol('x86'); - cpuIa64: DefineSymbol('itanium'); - cpuAmd64: DefineSymbol('x8664'); - else begin end - end; - case targetOS of - osDOS: DefineSymbol('msdos'); - osWindows: begin - DefineSymbol('mswindows'); - DefineSymbol('win32'); - end; - osLinux, osMorphOS, osSkyOS, osIrix, osPalmOS, osQNX, osAtari, osAix: begin - // these are all 'unix-like' - DefineSymbol('unix'); - DefineSymbol('posix'); - end; - osSolaris: begin - DefineSymbol('sunos'); - DefineSymbol('unix'); - DefineSymbol('posix'); - end; - osNetBSD, osFreeBSD, osOpenBSD: begin - DefineSymbol('unix'); - DefineSymbol('bsd'); - DefineSymbol('posix'); - end; - osMacOS: begin - DefineSymbol('macintosh'); - end; - osMacOSX: begin - DefineSymbol('macintosh'); - DefineSymbol('unix'); - DefineSymbol('posix'); - end; - else begin end - end; - DefineSymbol('cpu' + ToString( cpu[targetCPU].bit )); - DefineSymbol(normalize(endianToStr[cpu[targetCPU].endian])); - DefineSymbol(cpu[targetCPU].name); - DefineSymbol(platform.os[targetOS].name); -end; - -procedure DeinitDefines; -begin -end; - -end. diff --git a/nim/config.inc b/nim/config.inc deleted file mode 100755 index f73444a715..0000000000 --- a/nim/config.inc +++ /dev/null @@ -1,62 +0,0 @@ -{$define debug} -{.$define symtabdebug} -// uncomment this code for debugging the symbol table -// (shouldn't be used anymore; the symbol table is stable!) - -{$ifdef fpc} - {$inline on} - {$mode delphi} - {$define hasInline} // later versions of delphi have this too - {$implicitexceptions off} // produce better code - {$H+} - {$warnings off} // FPC produces way too many warnings ... -{$else} // Delphi does not define these: - {$define delphi} // Delphi does not even define a symbol for its compiler! - {$define x86} - {$define cpu386} - {$define cpu387} - {$define cpu86} - {$define cpu87} - {$define cpui386} -{$endif} - -{.$define GC} // Boehm's GC is broken again! (I don't need it much longer!) -// define if we have a GC: if we have none, the compiler leaks memory, -// but it still should work for bootstraping (the OS will clean up later) - -{$ifdef win32} - {$ifndef mswindows} {$define mswindows} {$endif} - {$ifndef windows} {$define windows} {$endif} -{$endif} - -{$ifdef CPU386} - {$define I386} // Delphi does not define this! -{$endif} - -{$ifdef CPUI386} - {$define I386} -{$endif} - -{$ifdef CPUamd64} - {$define amd64} -{$endif} - -{$ifdef debug} - {$define yamlgen} // when debugging we want the YAML code generator - {$R+} {$Q+} // turn code generation checks on - {$ifndef fpc} - {$O-} // deactivate optimization for Delphi - {$endif} - {$C+} // turn assertions on -{$endif} - -{$define cgen} // activate later if parser is stable -{.$define vmgen} // vmgen is not up to date - -{$ifdef cpu64} - {$define bit64clean} // BUGFIX -{$endif} -{$ifdef fpc} - {$define bit64clean} -{$endif} - diff --git a/nim/crc.pas b/nim/crc.pas deleted file mode 100755 index e147166059..0000000000 --- a/nim/crc.pas +++ /dev/null @@ -1,227 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit crc; - -interface - -{$include 'config.inc'} - -uses - nsystem, strutils; - -type - TCrc32 = int32; - -const - InitCrc32 = TCrc32(-1); - - InitAdler32 = int32(1); - -function updateCrc32(val: Byte; crc: TCrc32): TCrc32; overload; -function updateCrc32(val: Char; crc: TCrc32): TCrc32; overload; - -function crcFromBuf(buf: Pointer; len: int): TCrc32; -function strCrc32(const s: string): TCrc32; - -function crcFromFile(const filename: string): TCrc32; - -function updateAdler32(adler: int32; buf: pointer; len: int): int32; - - -implementation - -{@ignore} -{$ifopt Q+} { we need Q- here! } - {$define Q_on} - {$Q-} -{$endif} - -{$ifopt R+} - {$define R_on} - {$R-} -{$endif} -{@emit} - -{@ignore} -type - TCRC_TabEntry = TCrc32; -{@emit -type - TCRC_TabEntry = int -} - -const - crc32table: array [0..255] of TCRC_TabEntry = ( - 0, 1996959894, -301047508, -1727442502, - 124634137, 1886057615, -379345611, -1637575261, - 249268274, 2044508324, -522852066, -1747789432, - 162941995, 2125561021, -407360249, -1866523247, - 498536548, 1789927666, -205950648, -2067906082, - 450548861, 1843258603, -187386543, -2083289657, - 325883990, 1684777152, -43845254, -1973040660, - 335633487, 1661365465, -99664541, -1928851979, - 997073096, 1281953886, -715111964, -1570279054, - 1006888145, 1258607687, -770865667, -1526024853, - 901097722, 1119000684, -608450090, -1396901568, - 853044451, 1172266101, -589951537, -1412350631, - 651767980, 1373503546, -925412992, -1076862698, - 565507253, 1454621731, -809855591, -1195530993, - 671266974, 1594198024, -972236366, -1324619484, - 795835527, 1483230225, -1050600021, -1234817731, - 1994146192, 31158534, -1731059524, -271249366, - 1907459465, 112637215, -1614814043, -390540237, - 2013776290, 251722036, -1777751922, -519137256, - 2137656763, 141376813, -1855689577, -429695999, - 1802195444, 476864866, -2056965928, -228458418, - 1812370925, 453092731, -2113342271, -183516073, - 1706088902, 314042704, -1950435094, -54949764, - 1658658271, 366619977, -1932296973, -69972891, - 1303535960, 984961486, -1547960204, -725929758, - 1256170817, 1037604311, -1529756563, -740887301, - 1131014506, 879679996, -1385723834, -631195440, - 1141124467, 855842277, -1442165665, -586318647, - 1342533948, 654459306, -1106571248, -921952122, - 1466479909, 544179635, -1184443383, -832445281, - 1591671054, 702138776, -1328506846, -942167884, - 1504918807, 783551873, -1212326853, -1061524307, - -306674912, -1698712650, 62317068, 1957810842, - -355121351, -1647151185, 81470997, 1943803523, - -480048366, -1805370492, 225274430, 2053790376, - -468791541, -1828061283, 167816743, 2097651377, - -267414716, -2029476910, 503444072, 1762050814, - -144550051, -2140837941, 426522225, 1852507879, - -19653770, -1982649376, 282753626, 1742555852, - -105259153, -1900089351, 397917763, 1622183637, - -690576408, -1580100738, 953729732, 1340076626, - -776247311, -1497606297, 1068828381, 1219638859, - -670225446, -1358292148, 906185462, 1090812512, - -547295293, -1469587627, 829329135, 1181335161, - -882789492, -1134132454, 628085408, 1382605366, - -871598187, -1156888829, 570562233, 1426400815, - -977650754, -1296233688, 733239954, 1555261956, - -1026031705, -1244606671, 752459403, 1541320221, - -1687895376, -328994266, 1969922972, 40735498, - -1677130071, -351390145, 1913087877, 83908371, - -1782625662, -491226604, 2075208622, 213261112, - -1831694693, -438977011, 2094854071, 198958881, - -2032938284, -237706686, 1759359992, 534414190, - -2118248755, -155638181, 1873836001, 414664567, - -2012718362, -15766928, 1711684554, 285281116, - -1889165569, -127750551, 1634467795, 376229701, - -1609899400, -686959890, 1308918612, 956543938, - -1486412191, -799009033, 1231636301, 1047427035, - -1362007478, -640263460, 1088359270, 936918000, - -1447252397, -558129467, 1202900863, 817233897, - -1111625188, -893730166, 1404277552, 615818150, - -1160759803, -841546093, 1423857449, 601450431, - -1285129682, -1000256840, 1567103746, 711928724, - -1274298825, -1022587231, 1510334235, 755167117 - ); - -function updateCrc32(val: Byte; crc: TCrc32): TCrc32; overload; -begin - result := TCrc32(crc32Table[(int(crc) xor (int(val) and $ff)) and $ff]) xor - (crc shr TCrc32(8)); -end; - -function updateCrc32(val: Char; crc: TCrc32): TCrc32; overload; -begin - result := updateCrc32(byte(ord(val)), crc); -end; - -function strCrc32(const s: string): TCrc32; -var - i: int; -begin - result := InitCrc32; - for i := strStart to length(s)+StrStart-1 do - result := updateCrc32(s[i], result) -end; - -type - TByteArray = array [0..10000000] of Byte; - PByteArray = ^TByteArray; -function crcFromBuf(buf: Pointer; len: int): TCrc32; -var - p: PByteArray; - i: int; -begin - p := {@cast}PByteArray(buf); - result := InitCrc32; - for i := 0 to len-1 do result := updateCrc32(p[i], result) -end; - -function crcFromFile(const filename: string): TCrc32; -const - bufSize = 8 * 1024; -var - bin: TBinaryFile; - buf: Pointer; - readBytes, i: int; - p: PByteArray; -begin - result := InitCrc32; - if not openFile(bin, filename) then exit; // not equal if file does not exist - buf := alloc(BufSize); - p := {@cast}PByteArray(buf); - while true do begin - readBytes := readBuffer(bin, buf, bufSize); - for i := 0 to readBytes-1 do result := updateCrc32(p[i], result); - if readBytes <> bufSize then break; - end; - dealloc(buf); - CloseFile(bin); -end; - - -const - base = int32(65521); { largest prime smaller than 65536 } - {NMAX = 5552; original code with unsigned 32 bit integer } - { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 } - nmax = 3854; { code with signed 32 bit integer } - { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 } - { The penalty is the time loss in the extra MOD-calls. } - -function updateAdler32(adler: int32; buf: pointer; len: int): int32; -var - s1, s2: int32; - L, k, b: int; -begin - s1 := adler and int32($ffff); - s2 := (adler shr int32(16)) and int32($ffff); - L := len; - b := 0; - while (L > 0) do begin - if L < nmax then k := L - else k := nmax; - dec(L, k); - while (k > 0) do begin - s1 := s1 +{%} int32(({@cast}cstring(buf))[b]); - s2 := s2 +{%} s1; - inc(b); dec(k); - end; - s1 := modu(s1, base); - s2 := modu(s2, base); - end; - result := (s2 shl int32(16)) or s1; -end; - -{@ignore} -{$ifdef Q_on} - {$undef Q_on} - {$Q+} -{$endif} - -{$ifdef R_on} - {$undef R_on} - {$R+} -{$endif} -{@emit} - -end. diff --git a/nim/depends.pas b/nim/depends.pas deleted file mode 100755 index 6711875fe8..0000000000 --- a/nim/depends.pas +++ /dev/null @@ -1,97 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit depends; - -// This module implements a dependency file generator. - -interface - -{$include 'config.inc'} - -uses - nsystem, nos, options, ast, astalgo, msgs, ropes, idents, passes, importer; - -function genDependPass(): TPass; -procedure generateDot(const project: string); - -implementation - -type - TGen = object(TPassContext) - module: PSym; - filename: string; - end; - PGen = ^TGen; - -var - gDotGraph: PRope; // the generated DOT file; we need a global variable - -procedure addDependencyAux(const importing, imported: string); -begin - appf(gDotGraph, '$1 -> $2;$n', [toRope(importing), - toRope(imported)]); - // s1 -> s2_4 [label="[0-9]"]; -end; - -function addDotDependency(c: PPassContext; n: PNode): PNode; -var - i: int; - g: PGen; - imported: string; -begin - result := n; - if n = nil then exit; - g := PGen(c); - case n.kind of - nkImportStmt: begin - for i := 0 to sonsLen(n)-1 do begin - imported := splitFile(getModuleFile(n.sons[i])).name; - addDependencyAux(g.module.name.s, imported); - end - end; - nkFromStmt: begin - imported := splitFile(getModuleFile(n.sons[0])).name; - addDependencyAux(g.module.name.s, imported); - end; - nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: begin - for i := 0 to sonsLen(n)-1 do {@discard} addDotDependency(c, n.sons[i]); - end - else begin end - end -end; - -procedure generateDot(const project: string); -begin - writeRope( - ropef('digraph $1 {$n$2}$n', [ - toRope(changeFileExt(extractFileName(project), '')), gDotGraph]), - changeFileExt(project, 'dot') ); -end; - -function myOpen(module: PSym; const filename: string): PPassContext; -var - g: PGen; -begin - new(g); -{@ignore} - fillChar(g^, sizeof(g^), 0); -{@emit} - g.module := module; - g.filename := filename; - result := g; -end; - -function gendependPass(): TPass; -begin - initPass(result); - result.open := myOpen; - result.process := addDotDependency; -end; - -end. diff --git a/nim/docgen.pas b/nim/docgen.pas deleted file mode 100755 index 468dd1bc95..0000000000 --- a/nim/docgen.pas +++ /dev/null @@ -1,1176 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit docgen; - -// This is the documentation generator. It is currently pretty simple: No -// semantic checking is done for the code. Cross-references are generated -// by knowing how the anchors are going to be named. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, ast, astalgo, strutils, nhashes, options, nversion, msgs, - nos, ropes, idents, wordrecg, nmath, syntaxes, rnimsyn, scanner, rst, ntime, - highlite; - -procedure CommandDoc(const filename: string); -procedure CommandRst2Html(const filename: string); -procedure CommandRst2TeX(const filename: string); - -implementation - -type - TTocEntry = record - n: PRstNode; - refname, header: PRope; - end; - TSections = array [TSymKind] of PRope; - TMetaEnum = (metaNone, metaTitle, metaSubtitle, metaAuthor, metaVersion); - TDocumentor = record // contains a module's documentation - filename: string; // filename of the source file; without extension - basedir: string; // base directory (where to put the documentation) - modDesc: PRope; // module description - dependsOn: PRope; // dependencies - id: int; // for generating IDs - splitAfter: int; // split too long entries in the TOC - tocPart: array of TTocEntry; - hasToc: bool; - toc, section: TSections; - indexFile, theIndex: PRstNode; - indexValFilename: string; - indent, verbatim: int; // for code generation - meta: array [TMetaEnum] of PRope; - end; - PDoc = ^TDocumentor; - -var - splitter: string = ''; - -function findIndexNode(n: PRstNode): PRstNode; -var - i: int; -begin - if n = nil then - result := nil - else if n.kind = rnIndex then begin - result := n.sons[2]; - if result = nil then begin - result := newRstNode(rnDefList); - n.sons[2] := result - end - else if result.kind = rnInner then - result := result.sons[0] - end - else begin - result := nil; - for i := 0 to rsonsLen(n)-1 do begin - result := findIndexNode(n.sons[i]); - if result <> nil then exit - end - end -end; - -procedure initIndexFile(d: PDoc); -var - h: PRstNode; - dummyHasToc: bool; -begin - if gIndexFile = '' then exit; - gIndexFile := addFileExt(gIndexFile, 'txt'); - d.indexValFilename := changeFileExt(extractFilename(d.filename), HtmlExt); - if ExistsFile(gIndexFile) then begin - d.indexFile := rstParse(readFile(gIndexFile), false, gIndexFile, 0, 1, - dummyHasToc); - d.theIndex := findIndexNode(d.indexFile); - if (d.theIndex = nil) or (d.theIndex.kind <> rnDefList) then - rawMessage(errXisNoValidIndexFile, gIndexFile); - clearIndex(d.theIndex, d.indexValFilename); - end - else begin - d.indexFile := newRstNode(rnInner); - h := newRstNode(rnOverline); - h.level := 1; - addSon(h, newRstNode(rnLeaf, 'Index')); - addSon(d.indexFile, h); - h := newRstNode(rnIndex); - addSon(h, nil); // no argument - addSon(h, nil); // no options - d.theIndex := newRstNode(rnDefList); - addSon(h, d.theIndex); - addSon(d.indexFile, h); - end -end; - -function newDocumentor(const filename: string): PDoc; -var - s: string; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit - result.tocPart := @[]; -} - result.filename := filename; - result.id := 100; - result.splitAfter := 20; - s := getConfigVar('split.item.toc'); - if s <> '' then - result.splitAfter := parseInt(s); -end; - -function getVarIdx(const varnames: array of string; const id: string): int; -var - i: int; -begin - for i := 0 to high(varnames) do - if cmpIgnoreStyle(varnames[i], id) = 0 then begin - result := i; exit - end; - result := -1 -end; - -function ropeFormatNamedVars(const frmt: TFormatStr; - const varnames: array of string; - const varvalues: array of PRope): PRope; -var - i, j, L, start, idx, num: int; - id: string; -begin - i := strStart; - L := length(frmt); - result := nil; - num := 0; - while i <= L + StrStart - 1 do begin - if frmt[i] = '$' then begin - inc(i); // skip '$' - case frmt[i] of - '#': begin - app(result, varvalues[num]); - inc(num); - inc(i); - end; - '$': begin - app(result, '$'+''); - inc(i) - end; - '0'..'9': begin - j := 0; - while true do begin - j := (j * 10) + Ord(frmt[i]) - ord('0'); - inc(i); - if (i > L+StrStart-1) or not (frmt[i] in ['0'..'9']) then break - end; - if j > high(varvalues) + 1 then - internalError('ropeFormatNamedVars'); - num := j; - app(result, varvalues[j - 1]) - end; - 'A'..'Z', 'a'..'z', #128..#255: begin - id := ''; - while true do begin - addChar(id, frmt[i]); - inc(i); - if not (frmt[i] in ['A'..'Z', '_', 'a'..'z', #128..#255]) then break - end; - // search for the variable: - idx := getVarIdx(varnames, id); - if idx >= 0 then app(result, varvalues[idx]) - else rawMessage(errUnkownSubstitionVar, id) - end; - '{': begin - id := ''; - inc(i); - while frmt[i] <> '}' do begin - if frmt[i] = #0 then rawMessage(errTokenExpected, '}'+''); - addChar(id, frmt[i]); - inc(i); - end; - inc(i); // skip } - // search for the variable: - idx := getVarIdx(varnames, id); - if idx >= 0 then app(result, varvalues[idx]) - else rawMessage(errUnkownSubstitionVar, id) - end - else - InternalError('ropeFormatNamedVars') - end - end; - start := i; - while (i <= L + StrStart - 1) do begin - if (frmt[i] <> '$') then - inc(i) - else - break - end; - if i - 1 >= start then - app(result, ncopy(frmt, start, i - 1)) - end -end; - -// -------------------- dispatcher ------------------------------------------- - -procedure addXmlChar(var dest: string; c: Char); -begin - case c of - '&': add(dest, '&'); - '<': add(dest, '<'); - '>': add(dest, '>'); - '"': add(dest, '"'); - else addChar(dest, c) - end -end; - -procedure addRtfChar(var dest: string; c: Char); -begin - case c of - '{': add(dest, '\{'); - '}': add(dest, '\}'); - '\': add(dest, '\\'); - else addChar(dest, c) - end -end; - -procedure addTexChar(var dest: string; c: Char); -begin - case c of - '_': add(dest, '\_'); - '{': add(dest, '\symbol{123}'); - '}': add(dest, '\symbol{125}'); - '[': add(dest, '\symbol{91}'); - ']': add(dest, '\symbol{93}'); - '\': add(dest, '\symbol{92}'); - '$': add(dest, '\$'); - '&': add(dest, '\&'); - '#': add(dest, '\#'); - '%': add(dest, '\%'); - '~': add(dest, '\symbol{126}'); - '@': add(dest, '\symbol{64}'); - '^': add(dest, '\symbol{94}'); - '`': add(dest, '\symbol{96}'); - else addChar(dest, c) - end -end; - -procedure escChar(var dest: string; c: Char); -begin - if gCmd <> cmdRst2Tex then addXmlChar(dest, c) - else addTexChar(dest, c); -end; - -function nextSplitPoint(const s: string; start: int): int; -begin - result := start; - while result < length(s)+strStart do begin - case s[result] of - '_': exit; - 'a'..'z': begin - if result+1 < length(s)+strStart then - if s[result+1] in ['A'..'Z'] then exit; - end; - else begin end; - end; - inc(result); - end; - dec(result); // last valid index -end; - -function esc(const s: string; splitAfter: int = -1): string; -var - i, j, k, partLen: int; -begin - result := ''; - if splitAfter >= 0 then begin - partLen := 0; - j := strStart; - while j < length(s)+strStart do begin - k := nextSplitPoint(s, j); - if (splitter <> ' '+'') or (partLen + k - j + 1 > splitAfter) then begin - partLen := 0; - add(result, splitter); - end; - for i := j to k do escChar(result, s[i]); - inc(partLen, k - j + 1); - j := k+1; - end; - end - else begin - for i := strStart to length(s)+strStart-1 do escChar(result, s[i]) - end -end; - -function disp(const xml, tex: string): string; -begin - if gCmd <> cmdRst2Tex then - result := xml - else - result := tex -end; - -function dispF(const xml, tex: string; const args: array of PRope): PRope; -begin - if gCmd <> cmdRst2Tex then - result := ropef(xml, args) - else - result := ropef(tex, args) -end; - -procedure dispA(var dest: PRope; const xml, tex: string; - const args: array of PRope); -begin - if gCmd <> cmdRst2Tex then - appf(dest, xml, args) - else - appf(dest, tex, args) -end; - -// --------------------------------------------------------------------------- - -function renderRstToOut(d: PDoc; n: PRstNode): PRope; forward; - -function renderAux(d: PDoc; n: PRstNode; const outer: string = '$1'): PRope; -var - i: int; -begin - result := nil; - for i := 0 to rsonsLen(n)-1 do - app(result, renderRstToOut(d, n.sons[i])); - result := ropef(outer, [result]); -end; - -procedure setIndexForSourceTerm(d: PDoc; name: PRstNode; id: int); -var - a, h: PRstNode; -begin - if d.theIndex = nil then exit; - h := newRstNode(rnHyperlink); - a := newRstNode(rnLeaf, d.indexValFilename +{&} disp('#'+'', '') - +{&} toString(id)); - addSon(h, a); - addSon(h, a); - a := newRstNode(rnIdx); - addSon(a, name); - setIndexPair(d.theIndex, a, h); -end; - -function renderIndexTerm(d: PDoc; n: PRstNode): PRope; -var - a, h: PRstNode; -begin - inc(d.id); - result := dispF('$2', - '$2\label{$1}', [toRope(d.id), renderAux(d, n)]); - h := newRstNode(rnHyperlink); - a := newRstNode(rnLeaf, d.indexValFilename +{&} disp('#'+'', '') - +{&} toString(d.id)); - addSon(h, a); - addSon(h, a); - setIndexPair(d.theIndex, n, h); -end; - -function genComment(d: PDoc; n: PNode): PRope; -var - dummyHasToc: bool; -begin - if (n.comment <> snil) and startsWith(n.comment, '##') then - result := renderRstToOut(d, rstParse(n.comment, true, toFilename(n.info), - toLineNumber(n.info), - toColumn(n.info), dummyHasToc)) - else - result := nil; -end; - -function genRecComment(d: PDoc; n: PNode): PRope; -var - i: int; -begin - if n = nil then begin result := nil; exit end; - result := genComment(d, n); - if result = nil then begin - if not (n.kind in [nkEmpty..nkNilLit]) then - for i := 0 to sonsLen(n)-1 do begin - result := genRecComment(d, n.sons[i]); - if result <> nil then exit - end - end - else - n.comment := snil -end; - -function isVisible(n: PNode): bool; -var - v: PIdent; -begin - result := false; - if n.kind = nkPostfix then begin - if (sonsLen(n) = 2) and (n.sons[0].kind = nkIdent) then begin - v := n.sons[0].ident; - result := (v.id = ord(wStar)) or (v.id = ord(wMinus)); - end - end - else if n.kind = nkSym then - result := sfInInterface in n.sym.flags - else if n.kind = nkPragmaExpr then - result := isVisible(n.sons[0]); -end; - -function getName(n: PNode; splitAfter: int = -1): string; -begin - case n.kind of - nkPostfix: result := getName(n.sons[1], splitAfter); - nkPragmaExpr: result := getName(n.sons[0], splitAfter); - nkSym: result := esc(n.sym.name.s, splitAfter); - nkIdent: result := esc(n.ident.s, splitAfter); - nkAccQuoted: - result := esc('`'+'') +{&} getName(n.sons[0], splitAfter) +{&} - esc('`'+''); - else begin - internalError(n.info, 'getName()'); - result := '' - end - end -end; - -function getRstName(n: PNode): PRstNode; -begin - case n.kind of - nkPostfix: result := getRstName(n.sons[1]); - nkPragmaExpr: result := getRstName(n.sons[0]); - nkSym: result := newRstNode(rnLeaf, n.sym.name.s); - nkIdent: result := newRstNode(rnLeaf, n.ident.s); - nkAccQuoted: result := getRstName(n.sons[0]); - else begin - internalError(n.info, 'getRstName()'); - result := nil - end - end -end; - -procedure genItem(d: PDoc; n, nameNode: PNode; k: TSymKind); -var - r: TSrcGen; - kind: TTokType; - literal: string; - name, result, comm: PRope; -begin - if not isVisible(nameNode) then exit; - name := toRope(getName(nameNode)); - result := nil; - literal := ''; - kind := tkEof; -{@ignore} - fillChar(r, sizeof(r), 0); -{@emit} - comm := genRecComment(d, n); // call this here for the side-effect! - initTokRender(r, n, {@set}[renderNoPragmas, renderNoBody, renderNoComments, - renderDocComments]); - while true do begin - getNextTok(r, kind, literal); - case kind of - tkEof: break; - tkComment: - dispA(result, '$1', - '\spanComment{$1}', - [toRope(esc(literal))]); - tokKeywordLow..tokKeywordHigh: - dispA(result, '$1', - '\spanKeyword{$1}', - [toRope(literal)]); - tkOpr, tkHat: - dispA(result, '$1', - '\spanOperator{$1}', - [toRope(esc(literal))]); - tkStrLit..tkTripleStrLit: - dispA(result, '$1', - '\spanStringLit{$1}', - [toRope(esc(literal))]); - tkCharLit: - dispA(result, '$1', - '\spanCharLit{$1}', - [toRope(esc(literal))]); - tkIntLit..tkInt64Lit: - dispA(result, '$1', - '\spanDecNumber{$1}', - [toRope(esc(literal))]); - tkFloatLit..tkFloat64Lit: - dispA(result, '$1', - '\spanFloatNumber{$1}', - [toRope(esc(literal))]); - tkSymbol: - dispA(result, '$1', - '\spanIdentifier{$1}', - [toRope(esc(literal))]); - tkInd, tkSad, tkDed, tkSpaces: begin - app(result, literal) - end; - tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, - tkParDotLe, tkParDotRi, tkComma, tkSemiColon, tkColon, - tkEquals, tkDot, tkDotDot, tkAccent: - dispA(result, '$1', - '\spanOther{$1}', - [toRope(esc(literal))]); - else InternalError(n.info, 'docgen.genThing(' + toktypeToStr[kind] + ')'); - end - end; - inc(d.id); - app(d.section[k], ropeFormatNamedVars(getConfigVar('doc.item'), - ['name', 'header', 'desc', 'itemID'], - [name, result, comm, toRope(d.id)])); - app(d.toc[k], ropeFormatNamedVars(getConfigVar('doc.item.toc'), - ['name', 'header', 'desc', 'itemID'], - [toRope(getName(nameNode, d.splitAfter)), result, comm, toRope(d.id)])); - setIndexForSourceTerm(d, getRstName(nameNode), d.id); -end; - -function renderHeadline(d: PDoc; n: PRstNode): PRope; -var - i, len: int; - refname: PRope; -begin - result := nil; - for i := 0 to rsonsLen(n)-1 do - app(result, renderRstToOut(d, n.sons[i])); - refname := toRope(rstnodeToRefname(n)); - if d.hasToc then begin - len := length(d.tocPart); - setLength(d.tocPart, len+1); - d.tocPart[len].refname := refname; - d.tocPart[len].n := n; - d.tocPart[len].header := result; - result := dispF( - '$3', - '\rsth$4{$3}\label{$2}$n', - [toRope(n.level), d.tocPart[len].refname, result, - toRope(chr(n.level-1+ord('A'))+'')]); - end - else - result := dispF('$3', - '\rsth$4{$3}\label{$2}$n', - [toRope(n.level), refname, result, - toRope(chr(n.level-1+ord('A'))+'')]); -end; - -function renderOverline(d: PDoc; n: PRstNode): PRope; -var - i: int; - t: PRope; -begin - t := nil; - for i := 0 to rsonsLen(n)-1 do - app(t, renderRstToOut(d, n.sons[i])); - result := nil; - if d.meta[metaTitle] = nil then d.meta[metaTitle] := t - else if d.meta[metaSubtitle] = nil then d.meta[metaSubtitle] := t - else - result := dispF('
$3
', - '\rstov$4{$3}\label{$2}$n', - [toRope(n.level), toRope(rstnodeToRefname(n)), t, - toRope(chr(n.level-1+ord('A'))+'')]); -end; - -function renderRstToRst(d: PDoc; n: PRstNode): PRope; forward; - -function renderRstSons(d: PDoc; n: PRstNode): PRope; -var - i: int; -begin - result := nil; - for i := 0 to rsonsLen(n)-1 do app(result, renderRstToRst(d, n.sons[i])); -end; - -function renderRstToRst(d: PDoc; n: PRstNode): PRope; -// this is needed for the index generation; it may also be useful for -// debugging, but most code is already debugged... -const - lvlToChar: array [0..8] of char = ('!', '=', '-', '~', '`', - '<', '*', '|', '+'); -var - L: int; - ind: PRope; -begin - result := nil; - if n = nil then exit; - ind := toRope(repeatChar(d.indent)); - case n.kind of - rnInner: result := renderRstSons(d, n); - rnHeadline: begin - result := renderRstSons(d, n); - L := ropeLen(result); - result := ropef('$n$1$2$n$1$3', [ind, result, - toRope(repeatChar(L, lvlToChar[n.level]))]); - end; - rnOverline: begin - result := renderRstSons(d, n); - L := ropeLen(result); - result := ropef('$n$1$3$n$1$2$n$1$3', [ind, result, - toRope(repeatChar(L, lvlToChar[n.level]))]); - end; - rnTransition: - result := ropef('$n$n$1$2$n$n', - [ind, toRope(repeatChar(78-d.indent, '-'))]); - rnParagraph: begin - result := renderRstSons(d, n); - result := ropef('$n$n$1$2', [ind, result]); - end; - rnBulletItem: begin - inc(d.indent, 2); - result := renderRstSons(d, n); - if result <> nil then result := ropef('$n$1* $2', [ind, result]); - dec(d.indent, 2); - end; - rnEnumItem: begin - inc(d.indent, 4); - result := renderRstSons(d, n); - if result <> nil then result := ropef('$n$1(#) $2', [ind, result]); - dec(d.indent, 4); - end; - rnOptionList, rnFieldList, rnDefList, rnDefItem, rnLineBlock, rnFieldName, - rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: - result := renderRstSons(d, n); - rnDefName: begin - result := renderRstSons(d, n); - result := ropef('$n$n$1$2', [ind, result]); - end; - rnDefBody: begin - inc(d.indent, 2); - result := renderRstSons(d, n); - if n.sons[0].kind <> rnBulletList then - result := ropef('$n$1 $2', [ind, result]); - dec(d.indent, 2); - end; - rnField: begin - result := renderRstToRst(d, n.sons[0]); - L := max(ropeLen(result)+3, 30); - inc(d.indent, L); - result := ropef('$n$1:$2:$3$4', [ - ind, result, toRope(repeatChar(L-ropeLen(result)-2)), - renderRstToRst(d, n.sons[1])]); - dec(d.indent, L); - end; - rnLineBlockItem: begin - result := renderRstSons(d, n); - result := ropef('$n$1| $2', [ind, result]); - end; - rnBlockQuote: begin - inc(d.indent, 2); - result := renderRstSons(d, n); - dec(d.indent, 2); - end; - rnRef: begin - result := renderRstSons(d, n); - result := ropef('`$1`_', [result]); - end; - rnHyperlink: begin - result := ropef('`$1 <$2>`_', [renderRstToRst(d, n.sons[0]), - renderRstToRst(d, n.sons[1])]); - end; - rnGeneralRole: begin - result := renderRstToRst(d, n.sons[0]); - result := ropef('`$1`:$2:', [result, renderRstToRst(d, n.sons[1])]); - end; - rnSub: begin - result := renderRstSons(d, n); - result := ropef('`$1`:sub:', [result]); - end; - rnSup: begin - result := renderRstSons(d, n); - result := ropef('`$1`:sup:', [result]); - end; - rnIdx: begin - result := renderRstSons(d, n); - result := ropef('`$1`:idx:', [result]); - end; - rnEmphasis: begin - result := renderRstSons(d, n); - result := ropef('*$1*', [result]); - end; - rnStrongEmphasis: begin - result := renderRstSons(d, n); - result := ropef('**$1**', [result]); - end; - rnInterpretedText: begin - result := renderRstSons(d, n); - result := ropef('`$1`', [result]); - end; - rnInlineLiteral: begin - inc(d.verbatim); - result := renderRstSons(d, n); - result := ropef('``$1``', [result]); - dec(d.verbatim); - end; - rnLeaf: begin - if (d.verbatim = 0) and (n.text = '\'+'') then - result := toRope('\\') // XXX: escape more special characters! - else - result := toRope(n.text); - end; - rnIndex: begin - inc(d.indent, 3); - if n.sons[2] <> nil then - result := renderRstSons(d, n.sons[2]); - dec(d.indent, 3); - result := ropef('$n$n$1.. index::$n$2', [ind, result]); - end; - rnContents: begin - result := ropef('$n$n$1.. contents::', [ind]); - end; - else rawMessage(errCannotRenderX, rstnodeKindToStr[n.kind]); - end; -end; - -function renderTocEntry(d: PDoc; const e: TTocEntry): PRope; -begin - result := dispF( - '
  • $2
    • $n', - '\item\label{$1_toc} $2\ref{$1}$n', - [e.refname, e.header]); -end; - -function renderTocEntries(d: PDoc; var j: int; lvl: int): PRope; -var - a: int; -begin - result := nil; - while (j <= high(d.tocPart)) do begin - a := abs(d.tocPart[j].n.level); - if (a = lvl) then begin - app(result, renderTocEntry(d, d.tocPart[j])); - inc(j); - end - else if (a > lvl) then - app(result, renderTocEntries(d, j, a)) - else - break - end; - if lvl > 1 then - result := dispF('
      $1
    ', - '\begin{enumerate}$1\end{enumerate}', [result]); -end; - -function fieldAux(const s: string): PRope; -begin - result := toRope(strip(s)) -end; - -function renderImage(d: PDoc; n: PRstNode): PRope; -var - s, scale: string; - options: PRope; -begin - options := nil; - s := getFieldValue(n, 'scale'); - if s <> '' then dispA(options, ' scale="$1"', ' scale=$1', [fieldAux(scale)]); - - s := getFieldValue(n, 'height'); - if s <> '' then dispA(options, ' height="$1"', ' height=$1', [fieldAux(s)]); - - s := getFieldValue(n, 'width'); - if s <> '' then dispA(options, ' width="$1"', ' width=$1', [fieldAux(s)]); - - s := getFieldValue(n, 'alt'); - if s <> '' then dispA(options, ' alt="$1"', '', [fieldAux(s)]); - s := getFieldValue(n, 'align'); - if s <> '' then dispA(options, ' align="$1"', '', [fieldAux(s)]); - - if options <> nil then options := dispF('$1', '[$1]', [options]); - result := dispF('', - '\includegraphics$2{$1}', [toRope(getArgument(n)), options]); - if rsonsLen(n) >= 3 then app(result, renderRstToOut(d, n.sons[2])) -end; - -function renderCodeBlock(d: PDoc; n: PRstNode): PRope; -var - m: PRstNode; - g: TGeneralTokenizer; - langstr: string; - lang: TSourceLanguage; -begin - result := nil; - if n.sons[2] = nil then exit; - m := n.sons[2].sons[0]; - if (m.kind <> rnLeaf) then InternalError('renderCodeBlock'); - langstr := strip(getArgument(n)); - if langstr = '' then lang := langNimrod // default language - else lang := getSourceLanguage(langstr); - if lang = langNone then begin - rawMessage(warnLanguageXNotSupported, langstr); - result := toRope(m.text) - end - else begin - initGeneralTokenizer(g, m.text); - while true do begin - getNextToken(g, lang); - case g.kind of - gtEof: break; - gtNone, gtWhitespace: begin - app(result, ncopy(m.text, g.start+strStart, - g.len+g.start-1+strStart)) - end - else - dispA(result, - '$1', - '\span$2{$1}', - [toRope(esc(ncopy(m.text, g.start+strStart, - g.len+g.start-1+strStart))), - toRope(tokenClassToStr[g.kind])]); - end; - end; - deinitGeneralTokenizer(g); - end; - if result <> nil then - result := dispF('
    $1
    ', '\begin{rstpre}$n$1$n\end{rstpre}$n', - [result]) -end; - -function renderContainer(d: PDoc; n: PRstNode): PRope; -var - arg: PRope; -begin - result := renderRstToOut(d, n.sons[2]); - arg := toRope(strip(getArgument(n))); - if arg = nil then result := dispF('
    $1
    ', '$1', [result]) - else result := dispF('
    $2
    ', '$2', [arg, result]) -end; - -function texColumns(n: PRstNode): string; -var - i: int; -begin - result := ''; - for i := 1 to rsonsLen(n) do add(result, '|X'); -end; - -function renderField(d: PDoc; n: PRstNode): PRope; -var - fieldname: string; - fieldval: PRope; - b: bool; -begin - b := false; - if gCmd = cmdRst2Tex then begin - fieldname := addNodes(n.sons[0]); - fieldval := toRope(esc(strip(addNodes(n.sons[1])))); - if cmpIgnoreStyle(fieldname, 'author') = 0 then begin - if d.meta[metaAuthor] = nil then begin - d.meta[metaAuthor] := fieldval; - b := true - end - end - else if cmpIgnoreStyle(fieldName, 'version') = 0 then begin - if d.meta[metaVersion] = nil then begin - d.meta[metaVersion] := fieldval; - b := true - end - end - end; - if b then result := nil - else result := renderAux(d, n, disp('$1$n', '$1')); -end; - -function renderRstToOut(d: PDoc; n: PRstNode): PRope; -var - i: int; -begin - if n = nil then begin result := nil; exit end; - case n.kind of - rnInner: result := renderAux(d, n); - rnHeadline: result := renderHeadline(d, n); - rnOverline: result := renderOverline(d, n); - rnTransition: - result := renderAux(d, n, disp('
    '+nl, '\hrule'+nl)); - rnParagraph: - result := renderAux(d, n, disp('

    $1

    '+nl, '$1$n$n')); - rnBulletList: - result := renderAux(d, n, disp('
      $1
    '+nl, - '\begin{itemize}$1\end{itemize}'+nl)); - rnBulletItem, rnEnumItem: - result := renderAux(d, n, disp('
  • $1
    • '+nl, '\item $1'+nl)); - rnEnumList: - result := renderAux(d, n, disp('
      $1
    '+nl, - '\begin{enumerate}$1\end{enumerate}'+nl)); - rnDefList: - result := renderAux(d, n, disp('
    $1
    '+nl, - '\begin{description}$1\end{description}'+nl)); - rnDefItem: - result := renderAux(d, n); - rnDefName: - result := renderAux(d, n, disp('
    $1
    '+nl, '\item[$1] ')); - rnDefBody: - result := renderAux(d, n, disp('
    $1
    '+nl, '$1'+nl)); - rnFieldList: begin - result := nil; - for i := 0 to rsonsLen(n)-1 do app(result, renderRstToOut(d, n.sons[i])); - if result <> nil then - result := dispf('' + - '' + - '' + - '$1' + - '
    ', - '\begin{description}$1\end{description}'+nl, [result]); - end; - rnField: result := renderField(d, n); - rnFieldName: - result := renderAux(d, n, disp( - '$1:', '\item[$1:]')); - rnFieldBody: - result := renderAux(d, n, disp('$1', ' $1$n')); - rnIndex: - result := renderRstToOut(d, n.sons[2]); - - rnOptionList: - result := renderAux(d, n, disp('$1
    ', - '\begin{description}$n$1\end{description}'+nl)); - rnOptionListItem: - result := renderAux(d, n, disp('$1$n', '$1')); - rnOptionGroup: - result := renderAux(d, n, disp('$1', '\item[$1]')); - rnDescription: - result := renderAux(d, n, disp('$1$n', ' $1$n')); - rnOption, - rnOptionString, - rnOptionArgument: InternalError('renderRstToOut'); - - rnLiteralBlock: - result := renderAux(d, n, disp('
    $1
    $n', - '\begin{rstpre}$n$1$n\end{rstpre}$n')); - rnQuotedLiteralBlock: InternalError('renderRstToOut'); - - rnLineBlock: result := renderAux(d, n, disp('

    $1

    ', '$1$n$n')); - rnLineBlockItem: result := renderAux(d, n, disp('$1
    ', '$1\\$n')); - - rnBlockQuote: - result := renderAux(d, n, disp('

    $1

    $n', - '\begin{quote}$1\end{quote}$n')); - - rnTable, rnGridTable: begin - result := renderAux(d, n, - disp('$1
    ', - '\begin{table}\begin{rsttab}{' +{&} - texColumns(n) +{&} - '|}$n\hline$n$1\end{rsttab}\end{table}')); - end; - rnTableRow: begin - if rsonsLen(n) >= 1 then begin - result := renderRstToOut(d, n.sons[0]); - for i := 1 to rsonsLen(n)-1 do - dispa(result, '$1', ' & $1', [renderRstToOut(d, n.sons[i])]); - result := dispf('$1$n', '$1\\$n\hline$n', [result]); - end - else - result := nil; - end; - rnTableDataCell: result := renderAux(d, n, disp('$1', '$1')); - rnTableHeaderCell: - result := renderAux(d, n, disp('$1', '\textbf{$1}')); - - rnLabel: InternalError('renderRstToOut'); // used for footnotes and other - rnFootnote: InternalError('renderRstToOut'); // a footnote - - rnCitation: InternalError('renderRstToOut'); // similar to footnote - rnRef: - result := dispF('$1', - '$1\ref{$2}', - [renderAux(d, n), toRope(rstnodeToRefname(n))]); - rnStandaloneHyperlink: - result := renderAux(d, n, disp( - '$1', - '\href{$1}{$1}')); - rnHyperlink: - result := dispF('$1', - '\href{$2}{$1}', - [renderRstToOut(d, n.sons[0]), - renderRstToOut(d, n.sons[1])]); - rnDirArg, rnRaw: result := renderAux(d, n); - rnImage, rnFigure: result := renderImage(d, n); - rnCodeBlock: result := renderCodeBlock(d, n); - rnContainer: result := renderContainer(d, n); - rnSubstitutionReferences, rnSubstitutionDef: - result := renderAux(d, n, disp('|$1|', '|$1|')); - rnDirective: result := renderAux(d, n, ''); - - // Inline markup: - rnGeneralRole: - result := dispF('$1', - '\span$2{$1}', - [renderRstToOut(d, n.sons[0]), - renderRstToOut(d, n.sons[1])]); - rnSub: result := renderAux(d, n, disp('$1', '\rstsub{$1}')); - rnSup: result := renderAux(d, n, disp('$1', '\rstsup{$1}')); - rnEmphasis: result := renderAux(d, n, disp('$1', '\emph{$1}')); - rnStrongEmphasis: - result := renderAux(d, n, disp('$1', '\textbf{$1}')); - rnInterpretedText: - result := renderAux(d, n, disp('$1', '\emph{$1}')); - rnIdx: begin - if d.theIndex = nil then - result := renderAux(d, n, disp('$1', '\emph{$1}')) - else - result := renderIndexTerm(d, n); - end; - rnInlineLiteral: - result := renderAux(d, n, disp( - '$1', - '\texttt{$1}')); - rnLeaf: result := toRope(esc(n.text)); - rnContents: d.hasToc := true; - rnTitle: d.meta[metaTitle] := renderRstToOut(d, n.sons[0]); - else InternalError('renderRstToOut'); - end -end; - -procedure generateDoc(d: PDoc; n: PNode); -var - i: int; -begin - if n = nil then exit; - case n.kind of - nkCommentStmt: app(d.modDesc, genComment(d, n)); - nkProcDef: genItem(d, n, n.sons[namePos], skProc); - nkMethodDef: genItem(d, n, n.sons[namePos], skMethod); - nkIteratorDef: genItem(d, n, n.sons[namePos], skIterator); - nkMacroDef: genItem(d, n, n.sons[namePos], skMacro); - nkTemplateDef: genItem(d, n, n.sons[namePos], skTemplate); - nkConverterDef: genItem(d, n, n.sons[namePos], skConverter); - nkVarSection: begin - for i := 0 to sonsLen(n)-1 do - if n.sons[i].kind <> nkCommentStmt then - genItem(d, n.sons[i], n.sons[i].sons[0], skVar); - end; - nkConstSection: begin - for i := 0 to sonsLen(n)-1 do - if n.sons[i].kind <> nkCommentStmt then - genItem(d, n.sons[i], n.sons[i].sons[0], skConst); - end; - nkTypeSection: begin - for i := 0 to sonsLen(n)-1 do - if n.sons[i].kind <> nkCommentStmt then - genItem(d, n.sons[i], n.sons[i].sons[0], skType); - end; - nkStmtList: begin - for i := 0 to sonsLen(n)-1 do generateDoc(d, n.sons[i]); - end; - nkWhenStmt: begin - // generate documentation for the first branch only: - generateDoc(d, lastSon(n.sons[0])); - end - else begin end - end -end; - -procedure genSection(d: PDoc; kind: TSymKind); -var - title: PRope; -begin - if d.section[kind] = nil then exit; - title := toRope(ncopy(symKindToStr[kind], strStart+2) + 's'); - d.section[kind] := ropeFormatNamedVars(getConfigVar('doc.section'), - ['sectionid', 'sectionTitle', 'sectionTitleID', 'content'], - [toRope(ord(kind)), title, toRope(ord(kind)+50), d.section[kind]]); - d.toc[kind] := ropeFormatNamedVars(getConfigVar('doc.section.toc'), - ['sectionid', 'sectionTitle', 'sectionTitleID', 'content'], - [toRope(ord(kind)), title, toRope(ord(kind)+50), d.toc[kind]]); -end; - -function genOutFile(d: PDoc): PRope; -var - code, toc, title, content: PRope; - bodyname: string; - i: TSymKind; - j: int; -begin - j := 0; - toc := renderTocEntries(d, j, 1); - code := nil; - content := nil; - title := nil; - for i := low(TSymKind) to high(TSymKind) do begin - genSection(d, i); - app(toc, d.toc[i]); - end; - if toc <> nil then - toc := ropeFormatNamedVars(getConfigVar('doc.toc'), ['content'], [toc]); - for i := low(TSymKind) to high(TSymKind) do app(code, d.section[i]); - if d.meta[metaTitle] <> nil then - title := d.meta[metaTitle] - else - title := toRope('Module ' + extractFilename(changeFileExt(d.filename, ''))); - if d.hasToc then - bodyname := 'doc.body_toc' - else - bodyname := 'doc.body_no_toc'; - content := ropeFormatNamedVars(getConfigVar(bodyname), - ['title', 'tableofcontents', 'moduledesc', 'date', 'time', 'content'], - [title, toc, d.modDesc, toRope(getDateStr()), toRope(getClockStr()), code]); - if not (optCompileOnly in gGlobalOptions) then - code := ropeFormatNamedVars(getConfigVar('doc.file'), - ['title', 'tableofcontents', 'moduledesc', 'date', 'time', - 'content', 'author', 'version'], - [title, toc, d.modDesc, toRope(getDateStr()), toRope(getClockStr()), - content, d.meta[metaAuthor], d.meta[metaVersion]]) - else - code := content; - result := code; -end; - -procedure generateIndex(d: PDoc); -begin - if d.theIndex <> nil then begin - sortIndex(d.theIndex); - writeRope(renderRstToRst(d, d.indexFile), gIndexFile); - end -end; - -procedure CommandDoc(const filename: string); -var - ast: PNode; - d: PDoc; -begin - ast := parseFile(addFileExt(filename, nimExt)); - if ast = nil then exit; - d := newDocumentor(filename); - initIndexFile(d); - d.hasToc := true; - generateDoc(d, ast); - writeRope(genOutFile(d), getOutFile(filename, HtmlExt)); - generateIndex(d); -end; - -procedure CommandRstAux(const filename, outExt: string); -var - filen: string; - d: PDoc; - rst: PRstNode; - code: PRope; -begin - filen := addFileExt(filename, 'txt'); - d := newDocumentor(filen); - initIndexFile(d); - rst := rstParse(readFile(filen), false, filen, 0, 1, d.hasToc); - d.modDesc := renderRstToOut(d, rst); - code := genOutFile(d); - writeRope(code, getOutFile(filename, outExt)); - generateIndex(d); -end; - -procedure CommandRst2Html(const filename: string); -begin - CommandRstAux(filename, HtmlExt); -end; - -procedure CommandRst2TeX(const filename: string); -begin - splitter := '\-'; - CommandRstAux(filename, TexExt); -end; - -end. diff --git a/nim/ecmasgen.pas b/nim/ecmasgen.pas deleted file mode 100755 index 59cb3c3300..0000000000 --- a/nim/ecmasgen.pas +++ /dev/null @@ -1,1902 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ecmasgen; - -// This is the EMCAScript (also known as JavaScript) code generator. -// **Invariant: each expression only occurs once in the generated -// code!** - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, strutils, nhashes, trees, platform, magicsys, - extccomp, options, nversion, nimsets, msgs, crc, bitsets, idents, - lists, types, nos, ntime, ropes, nmath, passes, ccgutils, wordrecg, rnimsyn, - rodread; - -function ecmasgenPass(): TPass; - -implementation - -type - TEcmasGen = object(TPassContext) - filename: string; - module: PSym; - end; - BModule = ^TEcmasGen; - - TEcmasTypeKind = ( - etyNone, // no type - etyNull, // null type - etyProc, // proc type - etyBool, // bool type - etyInt, // Ecmascript's int - etyFloat, // Ecmascript's float - etyString, // Ecmascript's string - etyObject, // Ecmascript's reference to an object - etyBaseIndex // base + index needed - ); - - TCompRes = record - kind: TEcmasTypeKind; - com: PRope; // computation part - // address if this is a (address, index)-tuple - res: PRope; // result part; index if this is a (address, index)-tuple - end; - - TBlock = record - id: int; // the ID of the label; positive means that it - // has been used (i.e. the label should be emitted) - nestedTryStmts: int; // how many try statements is it nested into - end; - - TGlobals = record - typeInfo, code: PRope; - typeInfoGenerated: TIntSet; - end; - PGlobals = ^TGlobals; - - TProc = record - procDef: PNode; - prc: PSym; - data: PRope; - options: TOptions; - module: BModule; - globals: PGlobals; - BeforeRetNeeded: bool; - nestedTryStmts: int; - unique: int; - blocks: array of TBlock; - end; - -function newGlobals(): PGlobals; -begin - new(result); -{@ignore} fillChar(result^, sizeof(result^), 0); {@emit} - IntSetInit(result.typeInfoGenerated); -end; - -procedure initCompRes(var r: TCompRes); -begin - r.com := nil; r.res := nil; r.kind := etyNone; -end; - -procedure initProc(var p: TProc; globals: PGlobals; module: BModule; - procDef: PNode; options: TOptions); -begin -{@ignore} - fillChar(p, sizeof(p), 0); -{@emit - p.blocks := @[];} - p.options := options; - p.module := module; - p.procDef := procDef; - p.globals := globals; - if procDef <> nil then p.prc := procDef.sons[namePos].sym; -end; - -const - MappedToObject = {@set}[tyObject, tyArray, tyArrayConstr, tyTuple, - tyOpenArray, tySet, tyVar, tyRef, tyPtr]; - -function mapType(typ: PType): TEcmasTypeKind; -var - t: PType; -begin - t := skipTypes(typ, abstractInst); - case t.kind of - tyVar, tyRef, tyPtr: begin - if skipTypes(t.sons[0], abstractInst).kind in mappedToObject then - result := etyObject - else - result := etyBaseIndex - end; - tyPointer: begin - // treat a tyPointer like a typed pointer to an array of bytes - result := etyInt; - end; - tyRange, tyDistinct, tyOrdinal: result := mapType(t.sons[0]); - tyInt..tyInt64, tyEnum, tyChar: - result := etyInt; - tyBool: result := etyBool; - tyFloat..tyFloat128: result := etyFloat; - tySet: begin - result := etyObject // map a set to a table - end; - tyString, tySequence: - result := etyInt; // little hack to get the right semantics - tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray: - result := etyObject; - tyNil: result := etyNull; - tyGenericInst, tyGenericParam, tyGenericBody, tyGenericInvokation, - tyNone, tyForward, tyEmpty, tyExpr, tyStmt, tyTypeDesc: - result := etyNone; - tyProc: result := etyProc; - tyCString: result := etyString; - end -end; - -function mangle(const name: string): string; -var - i: int; -begin - result := ''; - for i := strStart to length(name) + strStart-1 do begin - case name[i] of - 'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a'))); - '_': begin end; - 'a'..'z', '0'..'9': addChar(result, name[i]); - else result := result +{&} 'X' +{&} toHex(ord(name[i]), 2); - end - end -end; - -function mangleName(s: PSym): PRope; -begin - result := s.loc.r; - if result = nil then begin - result := toRope(mangle(s.name.s)); - app(result, '_'+''); - app(result, toRope(s.id)); - s.loc.r := result; - end -end; - -// ----------------------- type information ---------------------------------- - -function genTypeInfo(var p: TProc; typ: PType): PRope; forward; - -function genObjectFields(var p: TProc; typ: PType; n: PNode): PRope; -var - s, u: PRope; - len, i, j: int; - field: PSym; - b: PNode; -begin - result := nil; - case n.kind of - nkRecList: begin - len := sonsLen(n); - if len = 1 then // generates more compact code! - result := genObjectFields(p, typ, n.sons[0]) - else begin - s := nil; - for i := 0 to len-1 do begin - if i > 0 then app(s, ', ' + tnl); - app(s, genObjectFields(p, typ, n.sons[i])); - end; - result := ropef('{kind: 2, len: $1, offset: 0, ' + - 'typ: null, name: null, sons: [$2]}', [toRope(len), s]); - end - end; - nkSym: begin - field := n.sym; - s := genTypeInfo(p, field.typ); - result := ropef('{kind: 1, offset: "$1", len: 0, ' + - 'typ: $2, name: $3, sons: null}', [ - mangleName(field), s, makeCString(field.name.s)]); - end; - nkRecCase: begin - len := sonsLen(n); - if (n.sons[0].kind <> nkSym) then - InternalError(n.info, 'genObjectFields'); - field := n.sons[0].sym; - s := genTypeInfo(p, field.typ); - for i := 1 to len-1 do begin - b := n.sons[i]; // branch - u := nil; - case b.kind of - nkOfBranch: begin - if sonsLen(b) < 2 then - internalError(b.info, 'genObjectFields; nkOfBranch broken'); - for j := 0 to sonsLen(b)-2 do begin - if u <> nil then app(u, ', '); - if b.sons[j].kind = nkRange then begin - appf(u, '[$1, $2]', [toRope(getOrdValue(b.sons[j].sons[0])), - toRope(getOrdValue(b.sons[j].sons[1]))]); - end - else - app(u, toRope(getOrdValue(b.sons[j]))) - end - end; - nkElse: u := toRope(lengthOrd(field.typ)); - else internalError(n.info, 'genObjectFields(nkRecCase)'); - end; - if result <> nil then app(result, ', ' + tnl); - appf(result, '[SetConstr($1), $2]', - [u, genObjectFields(p, typ, lastSon(b))]); - end; - result := ropef('{kind: 3, offset: "$1", len: $3, ' + - 'typ: $2, name: $4, sons: [$5]}', [mangleName(field), s, - toRope(lengthOrd(field.typ)), - makeCString(field.name.s), - result]); - end; - else internalError(n.info, 'genObjectFields'); - end -end; - -procedure genObjectInfo(var p: TProc; typ: PType; name: PRope); -var - s: PRope; -begin - s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' + - 'finalizer: null};$n', [name, toRope(ord(typ.kind))]); - prepend(p.globals.typeInfo, s); - - appf(p.globals.typeInfo, 'var NNI$1 = $2;$n', - [toRope(typ.id), genObjectFields(p, typ, typ.n)]); - appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]); - if (typ.kind = tyObject) and (typ.sons[0] <> nil) then begin - appf(p.globals.typeInfo, '$1.base = $2;$n', - [name, genTypeInfo(p, typ.sons[0])]); - end -end; - -procedure genEnumInfo(var p: TProc; typ: PType; name: PRope); -var - s, n: PRope; - len, i: int; - field: PSym; -begin - len := sonsLen(typ.n); - s := nil; - for i := 0 to len-1 do begin - if (typ.n.sons[i].kind <> nkSym) then - InternalError(typ.n.info, 'genEnumInfo'); - field := typ.n.sons[i].sym; - if i > 0 then app(s, ', '+tnl); - appf(s, '{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}', - [toRope(field.position), name, makeCString(field.name.s)]); - end; - n := ropef('var NNI$1 = {kind: 2, offset: 0, typ: null, ' + - 'name: null, len: $2, sons: [$3]};$n', - [toRope(typ.id), toRope(len), s]); - - s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' + - 'finalizer: null};$n', [name, toRope(ord(typ.kind))]); - prepend(p.globals.typeInfo, s); - - app(p.globals.typeInfo, n); - appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]); - if typ.sons[0] <> nil then begin - appf(p.globals.typeInfo, '$1.base = $2;$n', - [name, genTypeInfo(p, typ.sons[0])]); - end; -end; - -function genTypeInfo(var p: TProc; typ: PType): PRope; -var - t: PType; - s: PRope; -begin - t := typ; - if t.kind = tyGenericInst then t := lastSon(t); - result := ropef('NTI$1', [toRope(t.id)]); - if IntSetContainsOrIncl(p.globals.TypeInfoGenerated, t.id) then exit; - case t.kind of - tyDistinct: result := genTypeInfo(p, typ.sons[0]); - tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, - tyInt..tyFloat128: begin - s := ropef( - 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', - [result, toRope(ord(t.kind))]); - prepend(p.globals.typeInfo, s); - end; - tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: begin - s := ropef( - 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', - [result, toRope(ord(t.kind))]); - prepend(p.globals.typeInfo, s); - appf(p.globals.typeInfo, '$1.base = $2;$n', - [result, genTypeInfo(p, typ.sons[0])]); - end; - tyArrayConstr, tyArray: begin - s := ropef( - 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', - [result, toRope(ord(t.kind))]); - prepend(p.globals.typeInfo, s); - appf(p.globals.typeInfo, '$1.base = $2;$n', - [result, genTypeInfo(p, typ.sons[1])]); - end; - tyEnum: genEnumInfo(p, t, result); - tyObject, tyTuple: genObjectInfo(p, t, result); - else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')'); - end -end; - -// --------------------------------------------------------------------------- - -procedure gen(var p: TProc; n: PNode; var r: TCompRes); forward; -procedure genStmt(var p: TProc; n: PNode; var r: TCompRes); forward; - -procedure useMagic(var p: TProc; const ident: string); -begin - // to implement -end; - -function mergeExpr(a, b: PRope): PRope; overload; -begin - if (a <> nil) then begin - if b <> nil then result := ropef('($1, $2)', [a, b]) - else result := a - end - else result := b -end; - -function mergeExpr(const r: TCompRes): PRope; overload; -begin - result := mergeExpr(r.com, r.res); -end; - -function mergeStmt(const r: TCompRes): PRope; -begin - if r.res = nil then result := r.com - else if r.com = nil then result := r.res - else result := ropef('$1$2', [r.com, r.res]) -end; - -procedure genAnd(var p: TProc; a, b: PNode; var r: TCompRes); -var - x, y: TCompRes; -begin - gen(p, a, x); - gen(p, b, y); - r.res := ropef('($1 && $2)', [mergeExpr(x), mergeExpr(y)]) -end; - -procedure genOr(var p: TProc; a, b: PNode; var r: TCompRes); -var - x, y: TCompRes; -begin - gen(p, a, x); - gen(p, b, y); - r.res := ropef('($1 || $2)', [mergeExpr(x), mergeExpr(y)]) -end; - -type - TMagicFrmt = array [0..3] of string; - -const - // magic checked op; magic unchecked op; checked op; unchecked op - ops: array [mAddi..mStrToStr] of TMagicFrmt = ( - ('addInt', '', 'addInt($1, $2)', '($1 + $2)'), // AddI - ('subInt', '', 'subInt($1, $2)', '($1 - $2)'), // SubI - ('mulInt', '', 'mulInt($1, $2)', '($1 * $2)'), // MulI - ('divInt', '', 'divInt($1, $2)', 'Math.floor($1 / $2)'), // DivI - ('modInt', '', 'modInt($1, $2)', 'Math.floor($1 % $2)'), // ModI - ('addInt64', '', 'addInt64($1, $2)', '($1 + $2)'), // AddI64 - ('subInt64', '', 'subInt64($1, $2)', '($1 - $2)'), // SubI64 - ('mulInt64', '', 'mulInt64($1, $2)', '($1 * $2)'), // MulI64 - ('divInt64', '', 'divInt64($1, $2)', 'Math.floor($1 / $2)'), // DivI64 - ('modInt64', '', 'modInt64($1, $2)', 'Math.floor($1 % $2)'), // ModI64 - ('', '', '($1 >>> $2)', '($1 >>> $2)'), // ShrI - ('', '', '($1 << $2)', '($1 << $2)'), // ShlI - ('', '', '($1 & $2)', '($1 & $2)'), // BitandI - ('', '', '($1 | $2)', '($1 | $2)'), // BitorI - ('', '', '($1 ^ $2)', '($1 ^ $2)'), // BitxorI - ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinI - ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxI - ('', '', '($1 >>> $2)', '($1 >>> $2)'), // ShrI64 - ('', '', '($1 << $2)', '($1 << $2)'), // ShlI64 - ('', '', '($1 & $2)', '($1 & $2)'), // BitandI64 - ('', '', '($1 | $2)', '($1 | $2)'), // BitorI64 - ('', '', '($1 ^ $2)', '($1 ^ $2)'), // BitxorI64 - ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinI64 - ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxI64 - ('', '', '($1 + $2)', '($1 + $2)'), // AddF64 - ('', '', '($1 - $2)', '($1 - $2)'), // SubF64 - ('', '', '($1 * $2)', '($1 * $2)'), // MulF64 - ('', '', '($1 / $2)', '($1 / $2)'), // DivF64 - ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinF64 - ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxF64 - ('AddU', 'AddU', 'AddU($1, $2)', 'AddU($1, $2)'), // AddU - ('SubU', 'SubU', 'SubU($1, $2)', 'SubU($1, $2)'), // SubU - ('MulU', 'MulU', 'MulU($1, $2)', 'MulU($1, $2)'), // MulU - ('DivU', 'DivU', 'DivU($1, $2)', 'DivU($1, $2)'), // DivU - ('ModU', 'ModU', 'ModU($1, $2)', 'ModU($1, $2)'), // ModU - ('AddU64', 'AddU64', 'AddU64($1, $2)', 'AddU64($1, $2)'), // AddU64 - ('SubU64', 'SubU64', 'SubU64($1, $2)', 'SubU64($1, $2)'), // SubU64 - ('MulU64', 'MulU64', 'MulU64($1, $2)', 'MulU64($1, $2)'), // MulU64 - ('DivU64', 'DivU64', 'DivU64($1, $2)', 'DivU64($1, $2)'), // DivU64 - ('ModU64', 'ModU64', 'ModU64($1, $2)', 'ModU64($1, $2)'), // ModU64 - ('', '', '($1 == $2)', '($1 == $2)'), // EqI - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeI - ('', '', '($1 < $2)', '($1 < $2)'), // LtI - ('', '', '($1 == $2)', '($1 == $2)'), // EqI64 - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeI64 - ('', '', '($1 < $2)', '($1 < $2)'), // LtI64 - ('', '', '($1 == $2)', '($1 == $2)'), // EqF64 - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeF64 - ('', '', '($1 < $2)', '($1 < $2)'), // LtF64 - ('LeU', 'LeU', 'LeU($1, $2)', 'LeU($1, $2)'), // LeU - ('LtU', 'LtU', 'LtU($1, $2)', 'LtU($1, $2)'), // LtU - ('LeU64', 'LeU64', 'LeU64($1, $2)', 'LeU64($1, $2)'), // LeU64 - ('LtU64', 'LtU64', 'LtU64($1, $2)', 'LtU64($1, $2)'), // LtU64 - ('', '', '($1 == $2)', '($1 == $2)'), // EqEnum - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeEnum - ('', '', '($1 < $2)', '($1 < $2)'), // LtEnum - ('', '', '($1 == $2)', '($1 == $2)'), // EqCh - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeCh - ('', '', '($1 < $2)', '($1 < $2)'), // LtCh - ('', '', '($1 == $2)', '($1 == $2)'), // EqB - ('', '', '($1 <= $2)', '($1 <= $2)'), // LeB - ('', '', '($1 < $2)', '($1 < $2)'), // LtB - ('', '', '($1 == $2)', '($1 == $2)'), // EqRef - ('', '', '($1 == $2)', '($1 == $2)'), // EqProc - ('', '', '($1 == $2)', '($1 == $2)'), // EqUntracedRef - ('', '', '($1 <= $2)', '($1 <= $2)'), // LePtr - ('', '', '($1 < $2)', '($1 < $2)'), // LtPtr - ('', '', '($1 == $2)', '($1 == $2)'), // EqCString - ('', '', '($1 != $2)', '($1 != $2)'), // Xor - ('NegInt', '', 'NegInt($1)', '-($1)'), // UnaryMinusI - ('NegInt64', '', 'NegInt64($1)', '-($1)'), // UnaryMinusI64 - ('AbsInt', '', 'AbsInt($1)', 'Math.abs($1)'), // AbsI - ('AbsInt64', '', 'AbsInt64($1)', 'Math.abs($1)'), // AbsI64 - ('', '', '!($1)', '!($1)'), // Not - ('', '', '+($1)', '+($1)'), // UnaryPlusI - ('', '', '~($1)', '~($1)'), // BitnotI - ('', '', '+($1)', '+($1)'), // UnaryPlusI64 - ('', '', '~($1)', '~($1)'), // BitnotI64 - ('', '', '+($1)', '+($1)'), // UnaryPlusF64 - ('', '', '-($1)', '-($1)'), // UnaryMinusF64 - ('', '', 'Math.abs($1)', 'Math.abs($1)'), // AbsF64 - - ('Ze8ToI', 'Ze8ToI', 'Ze8ToI($1)', 'Ze8ToI($1)'), // mZe8ToI - ('Ze8ToI64', 'Ze8ToI64', 'Ze8ToI64($1)', 'Ze8ToI64($1)'), // mZe8ToI64 - ('Ze16ToI', 'Ze16ToI', 'Ze16ToI($1)', 'Ze16ToI($1)'), // mZe16ToI - ('Ze16ToI64', 'Ze16ToI64', 'Ze16ToI64($1)', 'Ze16ToI64($1)'), // mZe16ToI64 - ('Ze32ToI64', 'Ze32ToI64', 'Ze32ToI64($1)', 'Ze32ToI64($1)'), // mZe32ToI64 - ('ZeIToI64', 'ZeIToI64', 'ZeIToI64($1)', 'ZeIToI64($1)'), // mZeIToI64 - - ('ToU8', 'ToU8', 'ToU8($1)', 'ToU8($1)'), // ToU8 - ('ToU16', 'ToU16', 'ToU16($1)', 'ToU16($1)'), // ToU16 - ('ToU32', 'ToU32', 'ToU32($1)', 'ToU32($1)'), // ToU32 - ('', '', '$1', '$1'), // ToFloat - ('', '', '$1', '$1'), // ToBiggestFloat - ('', '', 'Math.floor($1)', 'Math.floor($1)'), // ToInt - ('', '', 'Math.floor($1)', 'Math.floor($1)'), // ToBiggestInt - - ('nimCharToStr', 'nimCharToStr', 'nimCharToStr($1)', 'nimCharToStr($1)'), - ('nimBoolToStr', 'nimBoolToStr', 'nimBoolToStr($1)', 'nimBoolToStr($1)'), - ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), - ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), - ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), - ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr($1)', 'cstrToNimStr($1)'), - ('', '', '$1', '$1') - ); - -procedure binaryExpr(var p: TProc; n: PNode; var r: TCompRes; - const magic, frmt: string); -var - x, y: TCompRes; -begin - if magic <> '' then useMagic(p, magic); - gen(p, n.sons[1], x); - gen(p, n.sons[2], y); - r.res := ropef(frmt, [x.res, y.res]); - r.com := mergeExpr(x.com, y.com); -end; - -procedure binaryStmt(var p: TProc; n: PNode; var r: TCompRes; - const magic, frmt: string); -var - x, y: TCompRes; -begin - if magic <> '' then useMagic(p, magic); - gen(p, n.sons[1], x); - gen(p, n.sons[2], y); - if x.com <> nil then appf(r.com, '$1;$n', [x.com]); - if y.com <> nil then appf(r.com, '$1;$n', [y.com]); - appf(r.com, frmt, [x.res, y.res]); -end; - -procedure unaryExpr(var p: TProc; n: PNode; var r: TCompRes; - const magic, frmt: string); -begin - if magic <> '' then useMagic(p, magic); - gen(p, n.sons[1], r); - r.res := ropef(frmt, [r.res]); -end; - -procedure arith(var p: TProc; n: PNode; var r: TCompRes; op: TMagic); -var - x, y: TCompRes; - i: int; -begin - if optOverflowCheck in p.options then i := 0 else i := 1; - useMagic(p, ops[op][i]); - if sonsLen(n) > 2 then begin - gen(p, n.sons[1], x); - gen(p, n.sons[2], y); - r.res := ropef(ops[op][i+2], [x.res, y.res]); - r.com := mergeExpr(x.com, y.com); - end - else begin - gen(p, n.sons[1], r); - r.res := ropef(ops[op][i+2], [r.res]) - end -end; - -procedure genLineDir(var p: TProc; n: PNode; var r: TCompRes); -var - line: int; -begin - line := toLinenumber(n.info); - if optLineDir in p.Options then // pretty useless, but better than nothing - appf(r.com, '// line $2 "$1"$n', - [toRope(toFilename(n.info)), toRope(line)]); - if ([optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb]) and - ((p.prc = nil) or not (sfPure in p.prc.flags)) then begin - useMagic(p, 'endb'); - appf(r.com, 'endb($1);$n', [toRope(line)]) - end - else if ([optLineTrace, optStackTrace] * p.Options = - [optLineTrace, optStackTrace]) and ((p.prc = nil) or - not (sfPure in p.prc.flags)) then - appf(r.com, 'F.line = $1;$n', [toRope(line)]) -end; - -procedure finishTryStmt(var p: TProc; var r: TCompRes; howMany: int); -var - i: int; -begin - for i := 1 to howMany do - app(r.com, 'excHandler = excHandler.prev;' + tnl); -end; - -procedure genWhileStmt(var p: TProc; n: PNode; var r: TCompRes); -var - cond, stmt: TCompRes; - len, labl: int; -begin - genLineDir(p, n, r); - inc(p.unique); - len := length(p.blocks); - setLength(p.blocks, len+1); - p.blocks[len].id := -p.unique; - p.blocks[len].nestedTryStmts := p.nestedTryStmts; - labl := p.unique; - gen(p, n.sons[0], cond); - genStmt(p, n.sons[1], stmt); - if p.blocks[len].id > 0 then - appf(r.com, 'L$3: while ($1) {$n$2}$n', - [mergeExpr(cond), mergeStmt(stmt), toRope(labl)]) - else - appf(r.com, 'while ($1) {$n$2}$n', - [mergeExpr(cond), mergeStmt(stmt)]); - setLength(p.blocks, len); -end; - -procedure genTryStmt(var p: TProc; n: PNode; var r: TCompRes); - // code to generate: -(* - var sp = {prev: excHandler, exc: null}; - excHandler = sp; - try { - stmts; - } catch (e) { - if (e.typ && e.typ == NTI433 || e.typ == NTI2321) { - stmts; - } else if (e.typ && e.typ == NTI32342) { - stmts; - } else { - stmts; - } - } finally { - stmts; - excHandler = excHandler.prev; - } -*) -var - i, j, len, blen: int; - safePoint, orExpr, epart: PRope; - a: TCompRes; -begin - genLineDir(p, n, r); - inc(p.unique); - safePoint := ropef('Tmp$1', [toRope(p.unique)]); - appf(r.com, 'var $1 = {prev: excHandler, exc: null};$n' + - 'excHandler = $1;$n', [safePoint]); - if optStackTrace in p.Options then - app(r.com, 'framePtr = F;' + tnl); - app(r.com, 'try {' + tnl); - len := sonsLen(n); - inc(p.nestedTryStmts); - genStmt(p, n.sons[0], a); - app(r.com, mergeStmt(a)); - i := 1; - epart := nil; - while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin - blen := sonsLen(n.sons[i]); - if blen = 1 then begin - // general except section: - if i > 1 then app(epart, 'else {' + tnl); - genStmt(p, n.sons[i].sons[0], a); - app(epart, mergeStmt(a)); - if i > 1 then app(epart, '}' + tnl); - end - else begin - orExpr := nil; - for j := 0 to blen-2 do begin - if (n.sons[i].sons[j].kind <> nkType) then - InternalError(n.info, 'genTryStmt'); - if orExpr <> nil then app(orExpr, '||'); - appf(orExpr, '($1.exc.m_type == $2)', - [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)]) - end; - if i > 1 then app(epart, 'else '); - appf(epart, 'if ($1.exc && $2) {$n', [safePoint, orExpr]); - genStmt(p, n.sons[i].sons[blen - 1], a); - appf(epart, '$1}$n', [mergeStmt(a)]); - end; - inc(i) - end; - if epart <> nil then - appf(r.com, '} catch (EXC) {$n$1', [epart]); - finishTryStmt(p, r, p.nestedTryStmts); - dec(p.nestedTryStmts); - app(r.com, '} finally {' + tnl + 'excHandler = excHandler.prev;' +{&} tnl); - if (i < len) and (n.sons[i].kind = nkFinally) then begin - genStmt(p, n.sons[i].sons[0], a); - app(r.com, mergeStmt(a)); - end; - app(r.com, '}' + tnl); -end; - -procedure genRaiseStmt(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - typ: PType; -begin - genLineDir(p, n, r); - if n.sons[0] <> nil then begin - gen(p, n.sons[0], a); - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - typ := skipTypes(n.sons[0].typ, abstractPtrs); - useMagic(p, 'raiseException'); - appf(r.com, 'raiseException($1, $2);$n', - [a.res, makeCString(typ.sym.name.s)]); - end - else begin - useMagic(p, 'reraiseException'); - app(r.com, 'reraiseException();' + tnl); - end -end; - -procedure genCaseStmt(var p: TProc; n: PNode; var r: TCompRes); -var - cond, stmt: TCompRes; - i, j: int; - it, e, v: PNode; - stringSwitch: bool; -begin - genLineDir(p, n, r); - gen(p, n.sons[0], cond); - if cond.com <> nil then - appf(r.com, '$1;$n', [cond.com]); - stringSwitch := skipTypes(n.sons[0].typ, abstractVar).kind = tyString; - if stringSwitch then begin - useMagic(p, 'toEcmaStr'); - appf(r.com, 'switch (toEcmaStr($1)) {$n', [cond.res]) - end - else - appf(r.com, 'switch ($1) {$n', [cond.res]); - for i := 1 to sonsLen(n)-1 do begin - it := n.sons[i]; - case it.kind of - nkOfBranch: begin - for j := 0 to sonsLen(it)-2 do begin - e := it.sons[j]; - if e.kind = nkRange then begin - v := copyNode(e.sons[0]); - while (v.intVal <= e.sons[1].intVal) do begin - gen(p, v, cond); - if cond.com <> nil then - internalError(v.info, 'ecmasgen.genCaseStmt'); - appf(r.com, 'case $1: ', [cond.res]); - Inc(v.intVal) - end - end - else begin - gen(p, e, cond); - if cond.com <> nil then - internalError(e.info, 'ecmasgen.genCaseStmt'); - if stringSwitch then begin - case e.kind of - nkStrLit..nkTripleStrLit: - appf(r.com, 'case $1: ', [makeCString(e.strVal)]); - else InternalError(e.info, 'ecmasgen.genCaseStmt: 2'); - end - end - else - appf(r.com, 'case $1: ', [cond.res]); - end - end; - genStmt(p, lastSon(it), stmt); - appf(r.com, '$n$1break;$n', [mergeStmt(stmt)]); - end; - nkElse: begin - genStmt(p, it.sons[0], stmt); - appf(r.com, 'default: $n$1break;$n', [mergeStmt(stmt)]); - end - else internalError(it.info, 'ecmasgen.genCaseStmt') - end - end; - appf(r.com, '}$n', []); -end; - -procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes); forward; - -procedure genBlock(var p: TProc; n: PNode; var r: TCompRes); -var - idx, labl: int; - sym: PSym; -begin - inc(p.unique); - idx := length(p.blocks); - if n.sons[0] <> nil then begin // named block? - if (n.sons[0].kind <> nkSym) then InternalError(n.info, 'genBlock'); - sym := n.sons[0].sym; - sym.loc.k := locOther; - sym.loc.a := idx - end; - setLength(p.blocks, idx+1); - p.blocks[idx].id := -p.unique; // negative because it isn't used yet - p.blocks[idx].nestedTryStmts := p.nestedTryStmts; - labl := p.unique; - if n.kind = nkBlockExpr then genStmtListExpr(p, n.sons[1], r) - else genStmt(p, n.sons[1], r); - if p.blocks[idx].id > 0 then begin // label has been used: - r.com := ropef('L$1: do {$n$2} while(false);$n', - [toRope(labl), r.com]); - end; - setLength(p.blocks, idx) -end; - -procedure genBreakStmt(var p: TProc; n: PNode; var r: TCompRes); -var - idx: int; - sym: PSym; -begin - genLineDir(p, n, r); - idx := length(p.blocks)-1; - if n.sons[0] <> nil then begin // named break? - assert(n.sons[0].kind = nkSym); - sym := n.sons[0].sym; - assert(sym.loc.k = locOther); - idx := sym.loc.a - end; - p.blocks[idx].id := abs(p.blocks[idx].id); // label is used - finishTryStmt(p, r, p.nestedTryStmts - p.blocks[idx].nestedTryStmts); - appf(r.com, 'break L$1;$n', [toRope(p.blocks[idx].id)]) -end; - -procedure genAsmStmt(var p: TProc; n: PNode; var r: TCompRes); -var - i: int; -begin - genLineDir(p, n, r); - assert(n.kind = nkAsmStmt); - for i := 0 to sonsLen(n)-1 do begin - case n.sons[i].Kind of - nkStrLit..nkTripleStrLit: app(r.com, n.sons[i].strVal); - nkSym: app(r.com, mangleName(n.sons[i].sym)); - else InternalError(n.sons[i].info, 'ecmasgen: genAsmStmt()') - end - end -end; - -procedure genIfStmt(var p: TProc; n: PNode; var r: TCompRes); -var - i, toClose: int; - cond, stmt: TCompRes; - it: PNode; -begin - toClose := 0; - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if sonsLen(it) <> 1 then begin - gen(p, it.sons[0], cond); - genStmt(p, it.sons[1], stmt); - if i > 0 then begin appf(r.com, 'else {$n', []); inc(toClose) end; - if cond.com <> nil then appf(r.com, '$1;$n', [cond.com]); - appf(r.com, 'if ($1) {$n$2}', [cond.res, mergeStmt(stmt)]); - end - else begin - // else part: - genStmt(p, it.sons[0], stmt); - appf(r.com, 'else {$n$1}$n', [mergeStmt(stmt)]); - end - end; - app(r.com, repeatChar(toClose, '}')+{&}tnl); -end; - -procedure genIfExpr(var p: TProc; n: PNode; var r: TCompRes); -var - i, toClose: int; - cond, stmt: TCompRes; - it: PNode; -begin - toClose := 0; - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if sonsLen(it) <> 1 then begin - gen(p, it.sons[0], cond); - gen(p, it.sons[1], stmt); - if i > 0 then begin app(r.res, ': ('); inc(toClose); end; - r.com := mergeExpr(r.com, cond.com); - r.com := mergeExpr(r.com, stmt.com); - appf(r.res, '($1) ? ($2)', [cond.res, stmt.res]); - end - else begin - // else part: - gen(p, it.sons[0], stmt); - r.com := mergeExpr(r.com, stmt.com); - appf(r.res, ': ($1)', [stmt.res]); - end - end; - app(r.res, repeatChar(toClose, ')')); -end; - -function generateHeader(var p: TProc; typ: PType): PRope; -var - i: int; - param: PSym; - name: PRope; -begin - result := nil; - for i := 1 to sonsLen(typ.n)-1 do begin - if result <> nil then app(result, ', '); - assert(typ.n.sons[i].kind = nkSym); - param := typ.n.sons[i].sym; - name := mangleName(param); - app(result, name); - if mapType(param.typ) = etyBaseIndex then begin - app(result, ', '); - app(result, name); - app(result, '_Idx'); - end - end -end; - -const - nodeKindsNeedNoCopy = {@set}[nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, - nkCurly, nkPar, - nkStringToCString, nkCStringToString, - nkCall, nkCommand, nkHiddenCallConv, - nkCallStrLit]; - -function needsNoCopy(y: PNode): bool; -begin - result := (y.kind in nodeKindsNeedNoCopy) - or (skipTypes(y.typ, abstractInst).kind in [tyRef, tyPtr, tyVar]) -end; - -procedure genAsgnAux(var p: TProc; x, y: PNode; var r: TCompRes; - noCopyNeeded: bool); -var - a, b: TCompRes; -begin - gen(p, x, a); - gen(p, y, b); - case mapType(x.typ) of - etyObject: begin - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - if b.com <> nil then appf(r.com, '$1;$n', [b.com]); - if needsNoCopy(y) or noCopyNeeded then - appf(r.com, '$1 = $2;$n', [a.res, b.res]) - else begin - useMagic(p, 'NimCopy'); - appf(r.com, '$1 = NimCopy($2, $3);$n', - [a.res, b.res, genTypeInfo(p, y.typ)]); - end - end; - etyBaseIndex: begin - if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then - internalError(x.info, 'genAsgn'); - appf(r.com, '$1 = $2; $3 = $4;$n', [a.com, b.com, a.res, b.res]); - end - else begin - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - if b.com <> nil then appf(r.com, '$1;$n', [b.com]); - appf(r.com, '$1 = $2;$n', [a.res, b.res]); - end - end -end; - -procedure genAsgn(var p: TProc; n: PNode; var r: TCompRes); -begin - genLineDir(p, n, r); - genAsgnAux(p, n.sons[0], n.sons[1], r, false); -end; - -procedure genFastAsgn(var p: TProc; n: PNode; var r: TCompRes); -begin - genLineDir(p, n, r); - genAsgnAux(p, n.sons[0], n.sons[1], r, true); -end; - -procedure genSwap(var p: TProc; n: PNode; var r: TCompRes); -var - a, b: TCompRes; - tmp, tmp2: PRope; -begin - gen(p, n.sons[1], a); - gen(p, n.sons[2], b); - inc(p.unique); - tmp := ropef('Tmp$1', [toRope(p.unique)]); - case mapType(n.sons[1].typ) of - etyBaseIndex: begin - inc(p.unique); - tmp2 := ropef('Tmp$1', [toRope(p.unique)]); - if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then - internalError(n.info, 'genSwap'); - appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1;$n', [tmp, a.com, b.com]); - appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp2, a.res, b.res]); - end - else begin - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - if b.com <> nil then appf(r.com, '$1;$n', [b.com]); - appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp, a.res, b.res]); - end - end -end; - -procedure genFieldAddr(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - f: PSym; -begin - r.kind := etyBaseIndex; - gen(p, n.sons[0], a); - if n.sons[1].kind <> nkSym then - InternalError(n.sons[1].info, 'genFieldAddr'); - f := n.sons[1].sym; - if f.loc.r = nil then f.loc.r := mangleName(f); - r.res := makeCString(ropeToStr(f.loc.r)); - r.com := mergeExpr(a); -end; - -procedure genFieldAccess(var p: TProc; n: PNode; var r: TCompRes); -var - f: PSym; -begin - r.kind := etyNone; - gen(p, n.sons[0], r); - if n.sons[1].kind <> nkSym then - InternalError(n.sons[1].info, 'genFieldAddr'); - f := n.sons[1].sym; - if f.loc.r = nil then f.loc.r := mangleName(f); - r.res := ropef('$1.$2', [r.res, f.loc.r]); -end; - -procedure genCheckedFieldAddr(var p: TProc; n: PNode; var r: TCompRes); -begin - genFieldAddr(p, n.sons[0], r); // XXX -end; - -procedure genCheckedFieldAccess(var p: TProc; n: PNode; var r: TCompRes); -begin - genFieldAccess(p, n.sons[0], r); // XXX -end; - -procedure genArrayAddr(var p: TProc; n: PNode; var r: TCompRes); -var - a, b: TCompRes; - first: biggestInt; - typ: PType; -begin - r.kind := etyBaseIndex; - gen(p, n.sons[0], a); - gen(p, n.sons[1], b); - r.com := mergeExpr(a); - typ := skipTypes(n.sons[0].typ, abstractPtrs); - if typ.kind in [tyArray, tyArrayConstr] then first := FirstOrd(typ.sons[0]) - else first := 0; - if (optBoundsCheck in p.options) and not isConstExpr(n.sons[1]) then begin - useMagic(p, 'chckIndx'); - b.res := ropef('chckIndx($1, $2, $3.length)-$2', - [b.res, toRope(first), a.res]); - // XXX: BUG: a.res evaluated twice! - end - else if first <> 0 then begin - b.res := ropef('($1)-$2', [b.res, toRope(first)]); - end; - r.res := mergeExpr(b); -end; - -procedure genArrayAccess(var p: TProc; n: PNode; var r: TCompRes); -begin - genArrayAddr(p, n, r); - r.kind := etyNone; - r.res := ropef('$1[$2]', [r.com, r.res]); - r.com := nil; -end; - -(* -type - TMyList = record - x: seq[ptr ptr int] - L: int - next: ptr TMyList - -proc myAdd(head: var ptr TMyList, item: ptr TMyList) = - item.next = head - head = item - -proc changeInt(i: var int) = inc(i) - -proc f(p: ptr TMyList, x: ptr ptr int) = - add p.x, x - p.next = nil - changeInt(p.L) - -*) - -procedure genAddr(var p: TProc; n: PNode; var r: TCompRes); -var - s: PSym; -begin - case n.sons[0].kind of - nkSym: begin - s := n.sons[0].sym; - if s.loc.r = nil then InternalError(n.info, 'genAddr: 3'); - case s.kind of - skVar: begin - if mapType(n.typ) = etyObject then begin - // make addr() a no-op: - r.kind := etyNone; - r.res := s.loc.r; - r.com := nil; - end - else if sfGlobal in s.flags then begin - // globals are always indirect accessible - r.kind := etyBaseIndex; - r.com := toRope('Globals'); - r.res := makeCString(ropeToStr(s.loc.r)); - end - else if sfAddrTaken in s.flags then begin - r.kind := etyBaseIndex; - r.com := s.loc.r; - r.res := toRope('0'+''); - end - else InternalError(n.info, 'genAddr: 4'); - end; - else InternalError(n.info, 'genAddr: 2'); - end; - end; - nkCheckedFieldExpr: genCheckedFieldAddr(p, n, r); - nkDotExpr: genFieldAddr(p, n, r); - nkBracketExpr: genArrayAddr(p, n, r); - else InternalError(n.info, 'genAddr'); - end -end; - -procedure genSym(var p: TProc; n: PNode; var r: TCompRes); -var - s: PSym; - k: TEcmasTypeKind; -begin - s := n.sym; - if s.loc.r = nil then - InternalError(n.info, 'symbol has no generated name: ' + s.name.s); - case s.kind of - skVar, skParam, skTemp: begin - k := mapType(s.typ); - if k = etyBaseIndex then begin - r.kind := etyBaseIndex; - if [sfAddrTaken, sfGlobal] * s.flags <> [] then begin - r.com := ropef('$1[0]', [s.loc.r]); - r.res := ropef('$1[1]', [s.loc.r]); - end - else begin - r.com := s.loc.r; - r.res := con(s.loc.r, '_Idx'); - end - end - else if (k <> etyObject) and (sfAddrTaken in s.flags) then - r.res := ropef('$1[0]', [s.loc.r]) - else - r.res := s.loc.r - end - else r.res := s.loc.r; - end -end; - -procedure genDeref(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; -begin - if mapType(n.sons[0].typ) = etyObject then - gen(p, n.sons[0], r) - else begin - gen(p, n.sons[0], a); - if a.kind <> etyBaseIndex then InternalError(n.info, 'genDeref'); - r.res := ropef('$1[$2]', [a.com, a.res]) - end -end; - -procedure genCall(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - i: int; -begin - gen(p, n.sons[0], r); - app(r.res, '('+''); - for i := 1 to sonsLen(n)-1 do begin - if i > 1 then app(r.res, ', '); - gen(p, n.sons[i], a); - if a.kind = etyBaseIndex then begin - app(r.res, a.com); - app(r.res, ', '); - app(r.res, a.res); - end - else - app(r.res, mergeExpr(a)); - end; - app(r.res, ')'+''); -end; - -function putToSeq(const s: string; indirect: bool): PRope; -begin - result := toRope(s); - if indirect then result := ropef('[$1]', [result]) -end; - -function createVar(var p: TProc; typ: PType; - indirect: bool): PRope; forward; - -function createRecordVarAux(var p: TProc; rec: PNode; var c: int): PRope; -var - i: int; -begin - result := nil; - case rec.kind of - nkRecList: begin - for i := 0 to sonsLen(rec)-1 do - app(result, createRecordVarAux(p, rec.sons[i], c)) - end; - nkRecCase: begin - app(result, createRecordVarAux(p, rec.sons[0], c)); - for i := 1 to sonsLen(rec)-1 do - app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)); - end; - nkSym: begin - if c > 0 then app(result, ', '); - app(result, mangleName(rec.sym)); - app(result, ': '); - app(result, createVar(p, rec.sym.typ, false)); - inc(c); - end; - else InternalError(rec.info, 'createRecordVarAux') - end -end; - -function createVar(var p: TProc; typ: PType; indirect: bool): PRope; -var - i, len, c: int; - t, e: PType; -begin - t := skipTypes(typ, abstractInst); - case t.kind of - tyInt..tyInt64, tyEnum, tyChar: begin - result := putToSeq('0'+'', indirect) - end; - tyFloat..tyFloat128: result := putToSeq('0.0', indirect); - tyRange: result := createVar(p, typ.sons[0], indirect); - tySet: result := toRope('{}'); - tyBool: result := putToSeq('false', indirect); - tyArray, tyArrayConstr: begin - len := int(lengthOrd(t)); - e := elemType(t); - if len > 32 then begin - useMagic(p, 'ArrayConstr'); - result := ropef('ArrayConstr($1, $2, $3)', - [toRope(len), createVar(p, e, false), - genTypeInfo(p, e)]) - end - else begin - result := toRope('['+''); - i := 0; - while i < len do begin - if i > 0 then app(result, ', '); - app(result, createVar(p, e, false)); - inc(i); - end; - app(result, ']'+''); - end - end; - tyTuple: begin - result := toRope('{'+''); - c := 0; - app(result, createRecordVarAux(p, t.n, c)); - app(result, '}'+''); - end; - tyObject: begin - result := toRope('{'+''); - c := 0; - if not (tfFinal in t.flags) or (t.sons[0] <> nil) then begin - inc(c); - appf(result, 'm_type: $1', [genTypeInfo(p, t)]); - end; - while t <> nil do begin - app(result, createRecordVarAux(p, t.n, c)); - t := t.sons[0]; - end; - app(result, '}'+''); - end; - tyVar, tyPtr, tyRef: begin - if mapType(t) = etyBaseIndex then - result := putToSeq('[null, 0]', indirect) - else - result := putToSeq('null', indirect); - end; - tySequence, tyString, tyCString, tyPointer: begin - result := putToSeq('null', indirect); - end - else begin - internalError('createVar: ' + typekindtoStr[t.kind]); - result := nil; - end - end -end; - -function isIndirect(v: PSym): bool; -begin - result := (sfAddrTaken in v.flags) and (mapType(v.typ) <> etyObject); -end; - -procedure genVarInit(var p: TProc; v: PSym; n: PNode; var r: TCompRes); -var - a: TCompRes; - s: PRope; -begin - if n = nil then begin - appf(r.com, 'var $1 = $2;$n', - [mangleName(v), createVar(p, v.typ, isIndirect(v))]) - end - else begin - {@discard} mangleName(v); - gen(p, n, a); - case mapType(v.typ) of - etyObject: begin - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - if needsNoCopy(n) then s := a.res - else begin - useMagic(p, 'NimCopy'); - s := ropef('NimCopy($1, $2)', [a.res, genTypeInfo(p, n.typ)]); - end - end; - etyBaseIndex: begin - if (a.kind <> etyBaseIndex) then InternalError(n.info, 'genVarInit'); - if [sfAddrTaken, sfGlobal] * v.flags <> [] then - appf(r.com, 'var $1 = [$2, $3];$n', [v.loc.r, a.com, a.res]) - else - appf(r.com, 'var $1 = $2; var $1_Idx = $3;$n', - [v.loc.r, a.com, a.res]); - exit - end - else begin - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - s := a.res; - end - end; - if isIndirect(v) then - appf(r.com, 'var $1 = [$2];$n', [v.loc.r, s]) - else - appf(r.com, 'var $1 = $2;$n', [v.loc.r, s]) - end; -end; - -procedure genVarStmt(var p: TProc; n: PNode; var r: TCompRes); -var - i: int; - v: PSym; - a: PNode; -begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - assert(a.kind = nkIdentDefs); - assert(a.sons[0].kind = nkSym); - v := a.sons[0].sym; - if lfNoDecl in v.loc.flags then continue; - genLineDir(p, a, r); - genVarInit(p, v, a.sons[2], r); - end -end; - -procedure genConstStmt(var p: TProc; n: PNode; var r: TCompRes); -var - c: PSym; - i: int; -begin - genLineDir(p, n, r); - for i := 0 to sonsLen(n)-1 do begin - if n.sons[i].kind = nkCommentStmt then continue; - assert(n.sons[i].kind = nkConstDef); - c := n.sons[i].sons[0].sym; - if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and - not (lfNoDecl in c.loc.flags) then begin - genLineDir(p, n.sons[i], r); - genVarInit(p, c, c.ast, r); - end - end -end; - -procedure genNew(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - t: Ptype; -begin - gen(p, n.sons[1], a); - t := skipTypes(n.sons[1].typ, abstractVar).sons[0]; - if a.com <> nil then appf(r.com, '$1;$n', [a.com]); - appf(r.com, '$1 = $2;$n', [a.res, createVar(p, t, true)]); -end; - -procedure genOrd(var p: TProc; n: PNode; var r: TCompRes); -begin - case skipTypes(n.sons[1].typ, abstractVar).kind of - tyEnum, tyInt..tyInt64, tyChar: gen(p, n.sons[1], r); - tyBool: unaryExpr(p, n, r, '', '($1 ? 1:0)'); - else InternalError(n.info, 'genOrd'); - end -end; - -procedure genConStrStr(var p: TProc; n: PNode; var r: TCompRes); -var - a, b: TCompRes; -begin - gen(p, n.sons[1], a); - gen(p, n.sons[2], b); - r.com := mergeExpr(a.com, b.com); - if skipTypes(n.sons[1].typ, abstractVarRange).kind = tyChar then - a.res := ropef('[$1, 0]', [a.res]); - if skipTypes(n.sons[2].typ, abstractVarRange).kind = tyChar then - b.res := ropef('[$1, 0]', [b.res]); - r.res := ropef('($1.slice(0,-1)).concat($2)', [a.res, b.res]); -end; - -procedure genMagic(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - line, filen: PRope; - op: TMagic; -begin - op := n.sons[0].sym.magic; - case op of - mOr: genOr(p, n.sons[1], n.sons[2], r); - mAnd: genAnd(p, n.sons[1], n.sons[2], r); - mAddi..mStrToStr: arith(p, n, r, op); - //mRepr: genRepr(p, n, r); - mSwap: genSwap(p, n, r); - mPred: begin // XXX: range checking? - if not (optOverflowCheck in p.Options) then - binaryExpr(p, n, r, '', '$1 - $2') - else - binaryExpr(p, n, r, 'subInt', 'subInt($1, $2)') - end; - mSucc: begin // XXX: range checking? - if not (optOverflowCheck in p.Options) then - binaryExpr(p, n, r, '', '$1 - $2') - else - binaryExpr(p, n, r, 'addInt', 'addInt($1, $2)') - end; - mAppendStrCh: binaryStmt(p, n, r, 'addChar', '$1 = addChar($1, $2)'); - mAppendStrStr: - binaryStmt(p, n, r, '', '$1 = ($1.slice(0,-1)).concat($2)'); - // XXX: make a copy of $2, because of EMCAScript's sucking semantics - mAppendSeqElem: binaryStmt(p, n, r, '', '$1.push($2)'); - mConStrStr: genConStrStr(p, n, r); - mEqStr: binaryExpr(p, n, r, 'eqStrings', 'eqStrings($1, $2)'); - mLeStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) <= 0)'); - mLtStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) < 0)'); - mIsNil: unaryExpr(p, n, r, '', '$1 == null'); - mAssert: begin - if (optAssert in p.Options) then begin - useMagic(p, 'internalAssert'); - gen(p, n.sons[1], a); - line := toRope(toLinenumber(n.info)); - filen := makeCString(ToFilename(n.info)); - appf(r.com, 'if (!($3)) internalAssert($1, $2)', - [filen, line, mergeExpr(a)]) - end - end; - mNew, mNewFinalize: genNew(p, n, r); - mSizeOf: r.res := toRope(getSize(n.sons[1].typ)); - mChr: gen(p, n.sons[1], r); // nothing to do - mOrd: genOrd(p, n, r); - mLengthStr: unaryExpr(p, n, r, '', '($1.length-1)'); - mLengthSeq, mLengthOpenArray, mLengthArray: - unaryExpr(p, n, r, '', '$1.length'); - mHigh: begin - if skipTypes(n.sons[0].typ, abstractVar).kind = tyString then - unaryExpr(p, n, r, '', '($1.length-2)') - else - unaryExpr(p, n, r, '', '($1.length-1)'); - end; - mInc: begin - if not (optOverflowCheck in p.Options) then - binaryStmt(p, n, r, '', '$1 += $2') - else - binaryStmt(p, n, r, 'addInt', '$1 = addInt($1, $2)') - end; - ast.mDec: begin - if not (optOverflowCheck in p.Options) then - binaryStmt(p, n, r, '', '$1 -= $2') - else - binaryStmt(p, n, r, 'subInt', '$1 = subInt($1, $2)') - end; - mSetLengthStr: binaryStmt(p, n, r, '', '$1.length = ($2)-1'); - mSetLengthSeq: binaryStmt(p, n, r, '', '$1.length = $2'); - mCard: unaryExpr(p, n, r, 'SetCard', 'SetCard($1)'); - mLtSet: binaryExpr(p, n, r, 'SetLt', 'SetLt($1, $2)'); - mLeSet: binaryExpr(p, n, r, 'SetLe', 'SetLe($1, $2)'); - mEqSet: binaryExpr(p, n, r, 'SetEq', 'SetEq($1, $2)'); - mMulSet: binaryExpr(p, n, r, 'SetMul', 'SetMul($1, $2)'); - mPlusSet: binaryExpr(p, n, r, 'SetPlus', 'SetPlus($1, $2)'); - mMinusSet: binaryExpr(p, n, r, 'SetMinus', 'SetMinus($1, $2)'); - mIncl: binaryStmt(p, n, r, '', '$1[$2] = true'); - mExcl: binaryStmt(p, n, r, '', 'delete $1[$2]'); - mInSet: binaryExpr(p, n, r, '', '($1[$2] != undefined)'); - mNLen..mNError: - liMessage(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s); - else genCall(p, n, r); - //else internalError(e.info, 'genMagic: ' + magicToStr[op]); - end -end; - -procedure genSetConstr(var p: TProc; n: PNode; var r: TCompRes); -var - a, b: TCompRes; - i: int; - it: PNode; -begin - useMagic(p, 'SetConstr'); - r.res := toRope('SetConstr('); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(r.res, ', '); - it := n.sons[i]; - if it.kind = nkRange then begin - gen(p, it.sons[0], a); - gen(p, it.sons[1], b); - r.com := mergeExpr(r.com, mergeExpr(a.com, b.com)); - appf(r.res, '[$1, $2]', [a.res, b.res]); - end - else begin - gen(p, it, a); - r.com := mergeExpr(r.com, a.com); - app(r.res, a.res); - end - end; - app(r.res, ')'+''); -end; - -procedure genArrayConstr(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - i: int; -begin - r.res := toRope('['+''); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then app(r.res, ', '); - gen(p, n.sons[i], a); - r.com := mergeExpr(r.com, a.com); - app(r.res, a.res); - end; - app(r.res, ']'+''); -end; - -procedure genRecordConstr(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; - i, len: int; -begin - i := 0; - len := sonsLen(n); - r.res := toRope('{'+''); - while i < len do begin - if i > 0 then app(r.res, ', '); - if (n.sons[i].kind <> nkSym) then - internalError(n.sons[i].info, 'genRecordConstr'); - gen(p, n.sons[i+1], a); - r.com := mergeExpr(r.com, a.com); - appf(r.res, '$1: $2', [mangleName(n.sons[i].sym), a.res]); - inc(i, 2) - end -end; - -procedure genConv(var p: TProc; n: PNode; var r: TCompRes); -var - src, dest: PType; -begin - dest := skipTypes(n.typ, abstractVarRange); - src := skipTypes(n.sons[1].typ, abstractVarRange); - gen(p, n.sons[1], r); - if (dest.kind <> src.kind) and (src.kind = tyBool) then - r.res := ropef('(($1)? 1:0)', [r.res]) -end; - -procedure upConv(var p: TProc; n: PNode; var r: TCompRes); -begin - gen(p, n.sons[0], r); // XXX -end; - -procedure genRangeChck(var p: TProc; n: PNode; var r: TCompRes; - const magic: string); -var - a, b: TCompRes; -begin - gen(p, n.sons[0], r); - if optRangeCheck in p.options then begin - gen(p, n.sons[1], a); - gen(p, n.sons[2], b); - r.com := mergeExpr(r.com, mergeExpr(a.com, b.com)); - useMagic(p, 'chckRange'); - r.res := ropef('chckRange($1, $2, $3)', [r.res, a.res, b.res]); - end -end; - -procedure convStrToCStr(var p: TProc; n: PNode; var r: TCompRes); -begin - // we do an optimization here as this is likely to slow down - // much of the code otherwise: - if n.sons[0].kind = nkCStringToString then - gen(p, n.sons[0].sons[0], r) - else begin - gen(p, n.sons[0], r); - if r.res = nil then InternalError(n.info, 'convStrToCStr'); - useMagic(p, 'toEcmaStr'); - r.res := ropef('toEcmaStr($1)', [r.res]); - end; -end; - -procedure convCStrToStr(var p: TProc; n: PNode; var r: TCompRes); -begin - // we do an optimization here as this is likely to slow down - // much of the code otherwise: - if n.sons[0].kind = nkStringToCString then - gen(p, n.sons[0].sons[0], r) - else begin - gen(p, n.sons[0], r); - if r.res = nil then InternalError(n.info, 'convCStrToStr'); - useMagic(p, 'cstrToNimstr'); - r.res := ropef('cstrToNimstr($1)', [r.res]); - end; -end; - -procedure genReturnStmt(var p: TProc; n: PNode; var r: TCompRes); -var - a: TCompRes; -begin - if p.procDef = nil then InternalError(n.info, 'genReturnStmt'); - p.BeforeRetNeeded := true; - if (n.sons[0] <> nil) then begin - genStmt(p, n.sons[0], a); - if a.com <> nil then appf(r.com, '$1;$n', mergeStmt(a)); - end - else genLineDir(p, n, r); - finishTryStmt(p, r, p.nestedTryStmts); - app(r.com, 'break BeforeRet;' + tnl); -end; - -function genProcBody(var p: TProc; prc: PSym; const r: TCompRes): PRope; -begin - if optStackTrace in prc.options then begin - result := ropef( - 'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' + - 'framePtr = F;$n', - [makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s), - makeCString(toFilename(prc.info))]); - end - else - result := nil; - if p.beforeRetNeeded then - appf(result, 'BeforeRet: do {$n$1} while (false); $n', [mergeStmt(r)]) - else - app(result, mergeStmt(r)); - if prc.typ.callConv = ccSysCall then begin - result := ropef('try {$n$1} catch (e) {$n'+ - ' alert("Unhandled exception:\n" + e.message + "\n"$n}', - [result]); - end; - if optStackTrace in prc.options then - app(result, 'framePtr = framePtr.prev;' + tnl); -end; - -procedure genProc(var oldProc: TProc; n: PNode; var r: TCompRes); -var - p: TProc; - prc, resultSym: PSym; - name, returnStmt, resultAsgn, header: PRope; - a: TCompRes; -begin - prc := n.sons[namePos].sym; - initProc(p, oldProc.globals, oldProc.module, n, prc.options); - returnStmt := nil; - resultAsgn := nil; - name := mangleName(prc); - header := generateHeader(p, prc.typ); - if (prc.typ.sons[0] <> nil) and not (sfPure in prc.flags) then begin - resultSym := n.sons[resultPos].sym; - resultAsgn := ropef('var $1 = $2;$n', [mangleName(resultSym), - createVar(p, resultSym.typ, isIndirect(resultSym))]); - gen(p, n.sons[resultPos], a); - if a.com <> nil then appf(returnStmt, '$1;$n', [a.com]); - returnStmt := ropef('return $1;$n', [a.res]); - end; - genStmt(p, n.sons[codePos], r); - r.com := ropef('function $1($2) {$n$3$4$5}$n', - [name, header, resultAsgn, genProcBody(p, prc, r), returnStmt]); - r.res := nil; -end; - -procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes); -var - i: int; - a: TCompRes; -begin - // watch out this trick: ``function () { stmtList; return expr; }()`` - r.res := toRope('function () {'); - for i := 0 to sonsLen(n)-2 do begin - genStmt(p, n.sons[i], a); - app(r.res, mergeStmt(a)); - end; - gen(p, lastSon(n), a); - if a.com <> nil then appf(r.res, '$1;$n', [a.com]); - appf(r.res, 'return $1; }()', [a.res]); -end; - -procedure genStmt(var p: TProc; n: PNode; var r: TCompRes); -var - prc: PSym; - i: int; - a: TCompRes; -begin - r.kind := etyNone; - r.com := nil; - r.res := nil; - case n.kind of - nkNilLit: begin end; - nkStmtList: begin - for i := 0 to sonsLen(n)-1 do begin - genStmt(p, n.sons[i], a); - app(r.com, mergeStmt(a)); - end - end; - nkBlockStmt: genBlock(p, n, r); - nkIfStmt: genIfStmt(p, n, r); - nkWhileStmt: genWhileStmt(p, n, r); - nkVarSection: genVarStmt(p, n, r); - nkConstSection: genConstStmt(p, n, r); - nkForStmt: internalError(n.info, 'for statement not eliminated'); - nkCaseStmt: genCaseStmt(p, n, r); - nkReturnStmt: genReturnStmt(p, n, r); - nkBreakStmt: genBreakStmt(p, n, r); - nkAsgn: genAsgn(p, n, r); - nkFastAsgn: genFastAsgn(p, n, r); - nkDiscardStmt: begin - genLineDir(p, n, r); - gen(p, n.sons[0], r); - app(r.res, ';'+ tnl); - end; - nkAsmStmt: genAsmStmt(p, n, r); - nkTryStmt: genTryStmt(p, n, r); - nkRaiseStmt: genRaiseStmt(p, n, r); - nkTypeSection, nkCommentStmt, nkIteratorDef, - nkIncludeStmt, nkImportStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkPragma: begin end; - nkProcDef, nkMethodDef, nkConverterDef: begin - if (n.sons[genericParamsPos] = nil) then begin - prc := n.sons[namePos].sym; - if (n.sons[codePos] <> nil) and not (lfNoDecl in prc.loc.flags) then - genProc(p, n, r) - else - {@discard} mangleName(prc); - end - end; - else begin - genLineDir(p, n, r); - gen(p, n, r); - app(r.res, ';'+ tnl); - end - end -end; - -procedure gen(var p: TProc; n: PNode; var r: TCompRes); -var - f: BiggestFloat; -begin - r.kind := etyNone; - r.com := nil; - r.res := nil; - case n.kind of - nkSym: genSym(p, n, r); - nkCharLit..nkInt64Lit: begin - r.res := toRope(n.intVal); - end; - nkNilLit: begin - if mapType(n.typ) = etyBaseIndex then begin - r.kind := etyBaseIndex; - r.com := toRope('null'); - r.res := toRope('0'+''); - end - else - r.res := toRope('null'); - end; - nkStrLit..nkTripleStrLit: begin - if skipTypes(n.typ, abstractVarRange).kind = tyString then begin - useMagic(p, 'cstrToNimstr'); - r.res := ropef('cstrToNimstr($1)', [makeCString(n.strVal)]) - end - else - r.res := makeCString(n.strVal) - end; - nkFloatLit..nkFloat64Lit: begin - f := n.floatVal; - if f <> f then - r.res := toRope('NaN') - else if f = 0.0 then - r.res := toRopeF(f) - else if f = 0.5 * f then - if f > 0.0 then r.res := toRope('Infinity') - else r.res := toRope('-Infinity') - else - r.res := toRopeF(f); - end; - nkBlockExpr: genBlock(p, n, r); - nkIfExpr: genIfExpr(p, n, r); - nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit: begin - if (n.sons[0].kind = nkSym) and (n.sons[0].sym.magic <> mNone) then - genMagic(p, n, r) - else - genCall(p, n, r) - end; - nkCurly: genSetConstr(p, n, r); - nkBracket: genArrayConstr(p, n, r); - nkPar: genRecordConstr(p, n, r); - nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r); - nkAddr, nkHiddenAddr: genAddr(p, n, r); - nkDerefExpr, nkHiddenDeref: genDeref(p, n, r); - nkBracketExpr: genArrayAccess(p, n, r); - nkDotExpr: genFieldAccess(p, n, r); - nkCheckedFieldExpr: genCheckedFieldAccess(p, n, r); - nkObjDownConv: gen(p, n.sons[0], r); - nkObjUpConv: upConv(p, n, r); - nkChckRangeF: genRangeChck(p, n, r, 'chckRangeF'); - nkChckRange64: genRangeChck(p, n, r, 'chckRange64'); - nkChckRange: genRangeChck(p, n, r, 'chckRange'); - nkStringToCString: convStrToCStr(p, n, r); - nkCStringToString: convCStrToStr(p, n, r); - nkPassAsOpenArray: gen(p, n.sons[0], r); - nkStmtListExpr: genStmtListExpr(p, n, r); - else - InternalError(n.info, 'gen: unknown node type: ' + nodekindToStr[n.kind]) - end -end; - -// ------------------------------------------------------------------------ - -var - globals: PGlobals; - -function newModule(module: PSym; const filename: string): BModule; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.filename := filename; - result.module := module; - if globals = nil then globals := newGlobals(); -end; - -function genHeader(): PRope; -begin - result := ropef( - '/* Generated by the Nimrod Compiler v$1 */$n' + - '/* (c) 2008 Andreas Rumpf */$n$n' + - '$nvar Globals = this;$n' + - 'var framePtr = null;$n' + - 'var excHandler = null;$n', - [toRope(versionAsString)]) -end; - -procedure genModule(var p: TProc; n: PNode; var r: TCompRes); -begin - genStmt(p, n, r); - if optStackTrace in p.options then begin - r.com := ropef( - 'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' + - 'framePtr = F;$n' + - '$3' + - 'framePtr = framePtr.prev;$n', - [makeCString('module ' + p.module.module.name.s), - makeCString(toFilename(p.module.module.info)), r.com]) - end -end; - -function myProcess(b: PPassContext; n: PNode): PNode; -var - m: BModule; - p: TProc; - r: TCompRes; -begin - result := n; - m := BModule(b); - if m.module = nil then InternalError(n.info, 'myProcess'); - initProc(p, globals, m, nil, m.module.options); - genModule(p, n, r); - app(p.globals.code, p.data); - app(p.globals.code, mergeStmt(r)); -end; - -function myClose(b: PPassContext; n: PNode): PNode; -var - m: BModule; - code: PRope; - outfile: string; -begin - result := myProcess(b, n); - m := BModule(b); - if sfMainModule in m.module.flags then begin - // write the file: - code := con(globals.typeInfo, globals.code); - outfile := changeFileExt(completeCFilePath(m.filename), 'js'); - {@discard} writeRopeIfNotEqual(con(genHeader(), code), outfile); - end -end; - -function myOpenCached(s: PSym; const filename: string; - rd: PRodReader): PPassContext; -begin - InternalError('symbol files are not possible with the Ecmas code generator'); - result := nil; -end; - -function myOpen(s: PSym; const filename: string): PPassContext; -begin - result := newModule(s, filename); -end; - -function ecmasgenPass(): TPass; -begin - InitPass(result); - result.open := myOpen; - result.close := myClose; - result.openCached := myOpenCached; - result.process := myProcess; -end; - -end. diff --git a/nim/evals.pas b/nim/evals.pas deleted file mode 100755 index b7edc43edc..0000000000 --- a/nim/evals.pas +++ /dev/null @@ -1,1414 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit evals; - -// This file implements the evaluator for Nimrod code. -// The evaluator is very slow, but simple. Since this -// is used mainly for evaluating macros and some other -// stuff at compile time, performance is not that -// important. - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, charsets, strutils, magicsys, - lists, options, ast, astalgo, trees, treetab, nimsets, - msgs, nos, condsyms, idents, rnimsyn, types, passes, semfold; - -type - PStackFrame = ^TStackFrame; - TStackFrame = record - mapping: TIdNodeTable; // mapping from symbols to nodes - prc: PSym; // current prc; proc that is evaluated - call: PNode; - next: PStackFrame; // for stacking - params: TNodeSeq; // parameters passed to the proc - end; - - TEvalContext = object(passes.TPassContext) - module: PSym; - tos: PStackFrame; // top of stack - lastException: PNode; - optEval: bool; // evaluation done for optimization purposes - end; - PEvalContext = ^TEvalContext; - -function newStackFrame(): PStackFrame; -procedure pushStackFrame(c: PEvalContext; t: PStackFrame); -procedure popStackFrame(c: PEvalContext); - -function newEvalContext(module: PSym; const filename: string; - optEval: bool): PEvalContext; - -function eval(c: PEvalContext; n: PNode): PNode; -// eval never returns nil! This simplifies the code a lot and -// makes it faster too. - -function evalConstExpr(module: PSym; e: PNode): PNode; - -function evalPass(): TPass; - -implementation - -const - evalMaxIterations = 10000000; // max iterations of all loops - evalMaxRecDepth = 100000; // max recursion depth for evaluation - -var - emptyNode: PNode; - -function newStackFrame(): PStackFrame; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - initIdNodeTable(result.mapping); -{@emit result.params := @[];} -end; - -function newEvalContext(module: PSym; const filename: string; - optEval: bool): PEvalContext; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.module := module; - result.optEval := optEval; -end; - -procedure pushStackFrame(c: PEvalContext; t: PStackFrame); -begin - t.next := c.tos; - c.tos := t; -end; - -procedure popStackFrame(c: PEvalContext); -begin - if (c.tos = nil) then InternalError('popStackFrame'); - c.tos := c.tos.next; -end; - -function evalAux(c: PEvalContext; n: PNode): PNode; forward; - -procedure stackTraceAux(x: PStackFrame); -begin - if x <> nil then begin - stackTraceAux(x.next); - messageOut(format('file: $1, line: $2', [toFilename(x.call.info), - toString(toLineNumber(x.call.info))])); - end -end; - -procedure stackTrace(c: PEvalContext; n: PNode; msg: TMsgKind; - const arg: string = ''); -begin - messageOut('stack trace: (most recent call last)'); - stackTraceAux(c.tos); - liMessage(n.info, msg, arg); -end; - -function isSpecial(n: PNode): bool; -begin - result := (n.kind = nkExceptBranch) or (n.kind = nkEmpty) -end; - -function evalIf(c: PEvalContext; n: PNode): PNode; -var - i, len: int; -begin - i := 0; - len := sonsLen(n); - while (i < len) and (sonsLen(n.sons[i]) >= 2) do begin - result := evalAux(c, n.sons[i].sons[0]); - if isSpecial(result) then exit; - if (result.kind = nkIntLit) and (result.intVal <> 0) then begin - result := evalAux(c, n.sons[i].sons[1]); - exit - end; - inc(i) - end; - if (i < len) and (sonsLen(n.sons[i]) < 2) then // eval else-part - result := evalAux(c, n.sons[i].sons[0]) - else - result := emptyNode -end; - -function evalCase(c: PEvalContext; n: PNode): PNode; -var - i, j: int; - res: PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - res := result; - result := emptyNode; - for i := 1 to sonsLen(n)-1 do begin - if n.sons[i].kind = nkOfBranch then begin - for j := 0 to sonsLen(n.sons[i])-2 do begin - if overlap(res, n.sons[i].sons[j]) then begin - result := evalAux(c, lastSon(n.sons[i])); - exit - end - end - end - else begin - result := evalAux(c, lastSon(n.sons[i])); - end - end; -end; - -var - gWhileCounter: int; // Use a counter to prevent endless loops! - // We make this counter global, because otherwise - // nested loops could make the compiler extremely slow. - gNestedEvals: int; // count the recursive calls to ``evalAux`` to prevent - // endless recursion - -function evalWhile(c: PEvalContext; n: PNode): PNode; -begin - while true do begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - if getOrdValue(result) = 0 then break; - result := evalAux(c, n.sons[1]); - case result.kind of - nkBreakStmt: begin - if result.sons[0] = nil then begin - result := emptyNode; // consume ``break`` token - break - end - end; - nkExceptBranch, nkReturnToken, nkEmpty: break; - else begin end - end; - dec(gWhileCounter); - if gWhileCounter <= 0 then begin - stackTrace(c, n, errTooManyIterations); - break; - end - end -end; - -function evalBlock(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if result.kind = nkBreakStmt then begin - if result.sons[0] <> nil then begin - assert(result.sons[0].kind = nkSym); - if n.sons[0] <> nil then begin - assert(n.sons[0].kind = nkSym); - if result.sons[0].sym.id = n.sons[0].sym.id then - result := emptyNode - end - end - else - result := emptyNode // consume ``break`` token - end -end; - -function evalFinally(c: PEvalContext; n, exc: PNode): PNode; -var - finallyNode: PNode; -begin - finallyNode := lastSon(n); - if finallyNode.kind = nkFinally then begin - result := evalAux(c, finallyNode); - if result.kind <> nkExceptBranch then - result := exc - end - else - result := exc -end; - -function evalTry(c: PEvalContext; n: PNode): PNode; -var - exc: PNode; - i, j, len, blen: int; -begin - result := evalAux(c, n.sons[0]); - case result.kind of - nkBreakStmt, nkReturnToken: begin end; - nkExceptBranch: begin - if sonsLen(result) >= 1 then begin - // creating a nkExceptBranch without sons means that it could not be - // evaluated - exc := result; - i := 1; - len := sonsLen(n); - while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin - blen := sonsLen(n.sons[i]); - if blen = 1 then begin - // general except section: - result := evalAux(c, n.sons[i].sons[0]); - exc := result; - break - end - else begin - for j := 0 to blen-2 do begin - assert(n.sons[i].sons[j].kind = nkType); - if exc.typ.id = n.sons[i].sons[j].typ.id then begin - result := evalAux(c, n.sons[i].sons[blen-1]); - exc := result; - break - end - end - end; - inc(i); - end; - result := evalFinally(c, n, exc); - end - end - else - result := evalFinally(c, n, emptyNode); - end -end; - -function getNullValue(typ: PType; const info: TLineInfo): PNode; -var - i: int; - t: PType; -begin - t := skipTypes(typ, abstractRange); - result := emptyNode; - case t.kind of - tyBool, tyChar, tyInt..tyInt64: result := newNodeIT(nkIntLit, info, t); - tyFloat..tyFloat128: result := newNodeIt(nkFloatLit, info, t); - tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, - tyStmt, tyTypeDesc: - result := newNodeIT(nkNilLit, info, t); - tyObject: begin - result := newNodeIT(nkPar, info, t); - internalError(info, 'init to implement'); - // XXX - end; - tyArray, tyArrayConstr: begin - result := newNodeIT(nkBracket, info, t); - for i := 0 to int(lengthOrd(t))-1 do - addSon(result, getNullValue(elemType(t), info)); - end; - tyTuple: begin - result := newNodeIT(nkPar, info, t); - for i := 0 to sonsLen(t)-1 do - addSon(result, getNullValue(t.sons[i], info)); - end; - else InternalError('getNullValue') - end -end; - -function evalVar(c: PEvalContext; n: PNode): PNode; -var - i: int; - v: PSym; - a: PNode; -begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - assert(a.kind = nkIdentDefs); - assert(a.sons[0].kind = nkSym); - v := a.sons[0].sym; - if a.sons[2] <> nil then begin - result := evalAux(c, a.sons[2]); - if isSpecial(result) then exit; - end - else - result := getNullValue(a.sons[0].typ, a.sons[0].info); - IdNodeTablePut(c.tos.mapping, v, result); - end; - result := emptyNode; -end; - -function evalCall(c: PEvalContext; n: PNode): PNode; -var - d: PStackFrame; - prc: PNode; - i: int; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - prc := result; - // bind the actual params to the local parameter - // of a new binding - d := newStackFrame(); - d.call := n; - if prc.kind = nkSym then begin - d.prc := prc.sym; - if not (prc.sym.kind in [skProc, skConverter]) then - InternalError(n.info, 'evalCall'); - end; - setLength(d.params, sonsLen(n)); - for i := 1 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i]); - if isSpecial(result) then exit; - d.params[i] := result; - end; - if n.typ <> nil then d.params[0] := getNullValue(n.typ, n.info); - pushStackFrame(c, d); - result := evalAux(c, prc); - if isSpecial(result) then exit; - if n.typ <> nil then result := d.params[0]; - popStackFrame(c); -end; - -function evalVariable(c: PStackFrame; sym: PSym): PNode; -// We need to return a node to the actual value, -// which can be modified. -var - x: PStackFrame; -begin - x := c; - while x <> nil do begin - if sfResult in sym.flags then begin - result := x.params[0]; - if result = nil then result := emptyNode; - exit - end; - result := IdNodeTableGet(x.mapping, sym); - if result <> nil then exit; - x := x.next - end; - result := emptyNode; -end; - -function evalArrayAccess(c: PEvalContext; n: PNode): PNode; -var - x: PNode; - idx: biggestInt; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - x := result; - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - idx := getOrdValue(result); - result := emptyNode; - case x.kind of - nkBracket, nkPar, nkMetaNode: begin - if (idx >= 0) and (idx < sonsLen(x)) then - result := x.sons[int(idx)] - else - stackTrace(c, n, errIndexOutOfBounds); - end; - nkStrLit..nkTripleStrLit: begin - result := newNodeIT(nkCharLit, x.info, getSysType(tyChar)); - if (idx >= 0) and (idx < length(x.strVal)) then - result.intVal := ord(x.strVal[int(idx)+strStart]) - else if idx = length(x.strVal) then begin end - else - stackTrace(c, n, errIndexOutOfBounds); - end; - else - stackTrace(c, n, errNilAccess); - end -end; - -function evalFieldAccess(c: PEvalContext; n: PNode): PNode; -// a real field access; proc calls have already been -// transformed -// XXX: field checks! -var - x: PNode; - field: PSym; - i: int; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - x := result; - if x.kind <> nkPar then InternalError(n.info, 'evalFieldAccess'); - field := n.sons[1].sym; - for i := 0 to sonsLen(n)-1 do begin - if x.sons[i].kind <> nkExprColonExpr then - InternalError(n.info, 'evalFieldAccess'); - if x.sons[i].sons[0].sym.name.id = field.id then begin - result := x.sons[i].sons[1]; exit - end - end; - stackTrace(c, n, errFieldXNotFound, field.name.s); - result := emptyNode; -end; - -function evalAsgn(c: PEvalContext; n: PNode): PNode; -var - x: PNode; - i: int; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - x := result; - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - x.kind := result.kind; - x.typ := result.typ; - case x.kind of - nkCharLit..nkInt64Lit: x.intVal := result.intVal; - nkFloatLit..nkFloat64Lit: x.floatVal := result.floatVal; - nkStrLit..nkTripleStrLit: begin - x.strVal := result.strVal; - end - else begin - if not (x.kind in [nkEmpty..nkNilLit]) then begin - discardSons(x); - for i := 0 to sonsLen(result)-1 do addSon(x, result.sons[i]); - end - end - end; - result := emptyNode -end; - -function evalSwap(c: PEvalContext; n: PNode): PNode; -var - x: PNode; - i: int; - tmpi: biggestInt; - tmpf: biggestFloat; - tmps: string; - tmpn: PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - x := result; - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if (x.kind <> result.kind) then - stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]) - else begin - case x.kind of - nkCharLit..nkInt64Lit: begin - tmpi := x.intVal; - x.intVal := result.intVal; - result.intVal := tmpi - end; - nkFloatLit..nkFloat64Lit: begin - tmpf := x.floatVal; - x.floatVal := result.floatVal; - result.floatVal := tmpf; - end; - nkStrLit..nkTripleStrLit: begin - tmps := x.strVal; - x.strVal := result.strVal; - result.strVal := tmps; - end - else begin - tmpn := copyTree(x); - discardSons(x); - for i := 0 to sonsLen(result)-1 do - addSon(x, result.sons[i]); - discardSons(result); - for i := 0 to sonsLen(tmpn)-1 do - addSon(result, tmpn.sons[i]); - end - end - end; - result := emptyNode -end; - -function evalSym(c: PEvalContext; n: PNode): PNode; -begin - case n.sym.kind of - skProc, skConverter, skMacro: result := n.sym.ast.sons[codePos]; - skVar, skForVar, skTemp: result := evalVariable(c.tos, n.sym); - skParam: result := c.tos.params[n.sym.position+1]; - skConst: result := n.sym.ast; - else begin - stackTrace(c, n, errCannotInterpretNodeX, symKindToStr[n.sym.kind]); - result := emptyNode - end - end; - if result = nil then - stackTrace(c, n, errCannotInterpretNodeX, n.sym.name.s); -end; - -function evalIncDec(c: PEvalContext; n: PNode; sign: biggestInt): PNode; -var - a, b: PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - case a.kind of - nkCharLit..nkInt64Lit: a.intval := a.intVal + sign * getOrdValue(b); - else internalError(n.info, 'evalIncDec'); - end; - result := emptyNode -end; - -function getStrValue(n: PNode): string; -begin - case n.kind of - nkStrLit..nkTripleStrLit: result := n.strVal; - else begin InternalError(n.info, 'getStrValue'); result := '' end; - end -end; - -function evalEcho(c: PEvalContext; n: PNode): PNode; -var - i: int; -begin - for i := 1 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i]); - if isSpecial(result) then exit; - Write(output, getStrValue(result)); - end; - writeln(output, ''); - result := emptyNode -end; - -function evalExit(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - liMessage(n.info, hintQuitCalled); - halt(int(getOrdValue(result))); -end; - -function evalOr(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if result.kind <> nkIntLit then InternalError(n.info, 'evalOr'); - if result.intVal = 0 then result := evalAux(c, n.sons[2]) -end; - -function evalAnd(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if result.kind <> nkIntLit then InternalError(n.info, 'evalAnd'); - if result.intVal <> 0 then result := evalAux(c, n.sons[2]) -end; - -function evalNoOpt(c: PEvalContext; n: PNode): PNode; -begin - result := newNodeI(nkExceptBranch, n.info); - // creating a nkExceptBranch without sons means that it could not be - // evaluated -end; - -function evalNew(c: PEvalContext; n: PNode): PNode; -var - t: PType; -begin - if c.optEval then - result := evalNoOpt(c, n) - else begin - t := skipTypes(n.sons[1].typ, abstractVar); - result := newNodeIT(nkRefTy, n.info, t); - addSon(result, getNullValue(t.sons[0], n.info)); - end -end; - -function evalDeref(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - case result.kind of - nkNilLit: stackTrace(c, n, errNilAccess); - nkRefTy: result := result.sons[0]; - else InternalError(n.info, 'evalDeref ' + nodeKindToStr[result.kind]); - end; -end; - -function evalAddr(c: PEvalContext; n: PNode): PNode; -var - a: PNode; - t: PType; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - a := result; - t := newType(tyPtr, c.module); - addSon(t, a.typ); - result := newNodeIT(nkRefTy, n.info, t); - addSon(result, a); -end; - -function evalConv(c: PEvalContext; n: PNode): PNode; -begin - // hm, I cannot think of any conversions that need to be handled here... - result := evalAux(c, n.sons[1]); - result.typ := n.typ; -end; - -function evalCheckedFieldAccess(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[0]); -end; - -function evalUpConv(c: PEvalContext; n: PNode): PNode; -var - dest, src: PType; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - dest := skipTypes(n.typ, abstractPtrs); - src := skipTypes(result.typ, abstractPtrs); - if inheritanceDiff(src, dest) > 0 then - stackTrace(c, n, errInvalidConversionFromTypeX, typeToString(src)); -end; - -function evalRangeChck(c: PEvalContext; n: PNode): PNode; -var - x, a, b: PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - x := result; - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - - if leValueConv(a, x) and leValueConv(x, b) then begin - result := x; // a <= x and x <= b - result.typ := n.typ - end - else - stackTrace(c, n, errGenerated, - format(msgKindToString(errIllegalConvFromXtoY), - [typeToString(n.sons[0].typ), typeToString(n.typ)])); -end; - -function evalConvStrToCStr(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - result.typ := n.typ; -end; - -function evalConvCStrToStr(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - result.typ := n.typ; -end; - -function evalRaise(c: PEvalContext; n: PNode): PNode; -var - a: PNode; -begin - if n.sons[0] <> nil then begin - result := evalAux(c, n.sons[0]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkExceptBranch, n.info, a.typ); - addSon(result, a); - c.lastException := result; - end - else if c.lastException <> nil then - result := c.lastException - else begin - stackTrace(c, n, errExceptionAlreadyHandled); - result := newNodeIT(nkExceptBranch, n.info, nil); - addSon(result, nil); - end -end; - -function evalReturn(c: PEvalContext; n: PNode): PNode; -begin - if n.sons[0] <> nil then begin - result := evalAsgn(c, n.sons[0]); - if isSpecial(result) then exit; - end; - result := newNodeIT(nkReturnToken, n.info, nil); -end; - -function evalProc(c: PEvalContext; n: PNode): PNode; -var - v: PSym; -begin - if n.sons[genericParamsPos] = nil then begin - if (resultPos < sonsLen(n)) and (n.sons[resultPos] <> nil) then begin - v := n.sons[resultPos].sym; - result := getNullValue(v.typ, n.info); - IdNodeTablePut(c.tos.mapping, v, result); - end; - result := evalAux(c, n.sons[codePos]); - if result.kind = nkReturnToken then - result := IdNodeTableGet(c.tos.mapping, v); - end - else - result := emptyNode -end; - -function evalHigh(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - case skipTypes(n.sons[1].typ, abstractVar).kind of - tyOpenArray, tySequence: - result := newIntNodeT(sonsLen(result), n); - tyString: - result := newIntNodeT(length(result.strVal)-1, n); - else InternalError(n.info, 'evalHigh') - end -end; - -function evalIs(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - result := newIntNodeT(ord(inheritanceDiff(result.typ, n.sons[2].typ) >= 0), n) -end; - -function evalSetLengthStr(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; - oldLen, newLen: int; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - case a.kind of - nkStrLit..nkTripleStrLit: begin - {@ignore} - oldLen := length(a.strVal); - {@emit} - newLen := int(getOrdValue(b)); - setLength(a.strVal, newLen); - {@ignore} - FillChar(a.strVal[oldLen+1], newLen-oldLen, 0); - {@emit} - end - else InternalError(n.info, 'evalSetLengthStr') - end; - result := emptyNode -end; - -function evalSetLengthSeq(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; - newLen, oldLen, i: int; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - if a.kind <> nkBracket then InternalError(n.info, 'evalSetLengthSeq'); - newLen := int(getOrdValue(b)); - oldLen := sonsLen(a); - setLength(a.sons, newLen); - for i := oldLen to newLen-1 do - a.sons[i] := getNullValue(skipTypes(n.sons[1].typ, abstractVar), n.info); - result := emptyNode -end; - -function evalNewSeq(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; - t: PType; - i: int; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - - t := skipTypes(n.sons[1].typ, abstractVar); - if a.kind = nkEmpty then InternalError(n.info, 'first parameter is empty'); - a.kind := nkBracket; - a.info := n.info; - a.typ := t; - for i := 0 to int(getOrdValue(b))-1 do - addSon(a, getNullValue(t.sons[0], n.info)); - result := emptyNode -end; - -function evalAssert(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if getOrdValue(result) <> 0 then - result := emptyNode - else - stackTrace(c, n, errAssertionFailed) -end; - -function evalIncl(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - if not inSet(a, b) then addSon(a, copyTree(b)); - result := emptyNode; -end; - -function evalExcl(c: PEvalContext; n: PNode): PNode; -var - a, b, r: PNode; - i: int; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := newNodeIT(nkCurly, n.info, n.sons[1].typ); - addSon(b, result); - r := diffSets(a, b); - discardSons(a); - for i := 0 to sonsLen(r)-1 do addSon(a, r.sons[i]); - result := emptyNode; -end; - -function evalAppendStrCh(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - case a.kind of - nkStrLit..nkTripleStrLit: addChar(a.strVal, chr(int(getOrdValue(b)))); - else InternalError(n.info, 'evalAppendStrCh'); - end; - result := emptyNode; -end; - -function evalConStrStr(c: PEvalContext; n: PNode): PNode; -// we cannot use ``evalOp`` for this as we can here have more than 2 arguments -var - a: PNode; - i: int; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - for i := 2 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i]); - if isSpecial(result) then exit; - a.strVal := getStrValue(a) +{&} getStrValue(result); - end; - result := a; -end; - -function evalAppendStrStr(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - case a.kind of - nkStrLit..nkTripleStrLit: a.strVal := a.strVal +{&} getStrValue(b); - else InternalError(n.info, 'evalAppendStrStr'); - end; - result := emptyNode; -end; - -function evalAppendSeqElem(c: PEvalContext; n: PNode): PNode; -var - a, b: PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - if a.kind = nkBracket then addSon(a, copyTree(b)) - else InternalError(n.info, 'evalAppendSeqElem'); - result := emptyNode; -end; - -function evalRepr(c: PEvalContext; n: PNode): PNode; -begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - result := newStrNodeT(renderTree(result, {@set}[renderNoComments]), n); -end; - -function isEmpty(n: PNode): bool; -begin - result := (n <> nil) and (n.kind = nkEmpty) -end; - -function evalMagicOrCall(c: PEvalContext; n: PNode): PNode; -var - m: TMagic; - a, b, cc: PNode; - k: biggestInt; - i: int; -begin - m := getMagic(n); - case m of - mNone: result := evalCall(c, n); - mIs: result := evalIs(c, n); - mSizeOf: internalError(n.info, 'sizeof() should have been evaluated'); - mHigh: result := evalHigh(c, n); - mAssert: result := evalAssert(c, n); - mExit: result := evalExit(c, n); - mNew, mNewFinalize: result := evalNew(c, n); - mNewSeq: result := evalNewSeq(c, n); - mSwap: result := evalSwap(c, n); - mInc: result := evalIncDec(c, n, 1); - ast.mDec: result := evalIncDec(c, n, -1); - mEcho: result := evalEcho(c, n); - mSetLengthStr: result := evalSetLengthStr(c, n); - mSetLengthSeq: result := evalSetLengthSeq(c, n); - mIncl: result := evalIncl(c, n); - mExcl: result := evalExcl(c, n); - mAnd: result := evalAnd(c, n); - mOr: result := evalOr(c, n); - - mAppendStrCh: result := evalAppendStrCh(c, n); - mAppendStrStr: result := evalAppendStrStr(c, n); - mAppendSeqElem: result := evalAppendSeqElem(c, n); - - mNLen: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkIntLit, n.info, n.typ); - case a.kind of - nkEmpty..nkNilLit: begin end; - else result.intVal := sonsLen(a); - end - end; - mNChild: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - k := getOrdValue(result); - if not (a.kind in [nkEmpty..nkNilLit]) and (k >= 0) - and (k < sonsLen(a)) then begin - result := a.sons[int(k)]; - if result = nil then result := newNode(nkEmpty) - end - else begin - stackTrace(c, n, errIndexOutOfBounds); - result := emptyNode - end; - end; - mNSetChild: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - result := evalAux(c, n.sons[3]); - if isSpecial(result) then exit; - k := getOrdValue(b); - if (k >= 0) and (k < sonsLen(a)) - and not (a.kind in [nkEmpty..nkNilLit]) then begin - if result.kind = nkEmpty then a.sons[int(k)] := nil - else a.sons[int(k)] := result - end - else - stackTrace(c, n, errIndexOutOfBounds); - result := emptyNode; - end; - mNAdd: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - addSon(a, result); - result := emptyNode - end; - mNAddMultiple: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - for i := 0 to sonsLen(result)-1 do addSon(a, result.sons[i]); - result := emptyNode - end; - mNDel: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - result := evalAux(c, n.sons[3]); - if isSpecial(result) then exit; - for i := 0 to int(getOrdValue(result))-1 do - delSon(a, int(getOrdValue(b))); - result := emptyNode; - end; - mNKind: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkIntLit, n.info, n.typ); - result.intVal := ord(a.kind); - end; - mNIntVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkIntLit, n.info, n.typ); - case a.kind of - nkCharLit..nkInt64Lit: result.intVal := a.intVal; - else InternalError(n.info, 'no int value') - end - end; - mNFloatVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkFloatLit, n.info, n.typ); - case a.kind of - nkFloatLit..nkFloat64Lit: result.floatVal := a.floatVal; - else InternalError(n.info, 'no float value') - end - end; - mNSymbol: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if result.kind <> nkSym then InternalError(n.info, 'no symbol') - end; - mNIdent: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if result.kind <> nkIdent then InternalError(n.info, 'no symbol') - end; - mNGetType: result := evalAux(c, n.sons[1]); - mNStrVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkStrLit, n.info, n.typ); - case a.kind of - nkStrLit..nkTripleStrLit: result.strVal := a.strVal; - else InternalError(n.info, 'no string value') - end - end; - mNSetIntVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.intVal := result.intVal; // XXX: exception handling? - result := emptyNode - end; - mNSetFloatVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.floatVal := result.floatVal; // XXX: exception handling? - result := emptyNode - end; - mNSetSymbol: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.sym := result.sym; // XXX: exception handling? - result := emptyNode - end; - mNSetIdent: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.ident := result.ident; // XXX: exception handling? - result := emptyNode - end; - mNSetType: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.typ := result.typ; // XXX: exception handling? - result := emptyNode - end; - mNSetStrVal: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a.strVal := result.strVal; // XXX: exception handling? - result := emptyNode - end; - mNNewNimNode: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - k := getOrdValue(result); - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - a := result; - if (k < 0) or (k > ord(high(TNodeKind))) then - internalError(n.info, 'request to create a NimNode with invalid kind'); - if a.kind = nkNilLit then - result := newNodeI(TNodeKind(int(k)), n.info) - else - result := newNodeI(TNodeKind(int(k)), a.info) - end; - mNCopyNimNode: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - result := copyNode(result); - end; - mNCopyNimTree: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - result := copyTree(result); - end; - mStrToIdent: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if not (result.kind in [nkStrLit..nkTripleStrLit]) then - InternalError(n.info, 'no string node'); - a := result; - result := newNodeIT(nkIdent, n.info, n.typ); - result.ident := getIdent(a.strVal); - end; - mIdentToStr: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - if result.kind <> nkIdent then - InternalError(n.info, 'no ident node'); - a := result; - result := newNodeIT(nkStrLit, n.info, n.typ); - result.strVal := a.ident.s; - end; - mEqIdent: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - result := newNodeIT(nkIntLit, n.info, n.typ); - if (a.kind = nkIdent) and (b.kind = nkIdent) then - if a.ident.id = b.ident.id then result.intVal := 1 - end; - mEqNimrodNode: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - result := newNodeIT(nkIntLit, n.info, n.typ); - if (a = b) - or (b.kind in [nkNilLit, nkEmpty]) - and (a.kind in [nkNilLit, nkEmpty]) then - result.intVal := 1 - end; - mNHint: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - liMessage(n.info, hintUser, getStrValue(result)); - result := emptyNode - end; - mNWarning: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - liMessage(n.info, warnUser, getStrValue(result)); - result := emptyNode - end; - mNError: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - stackTrace(c, n, errUser, getStrValue(result)); - result := emptyNode - end; - mConStrStr: result := evalConStrStr(c, n); - mRepr: result := evalRepr(c, n); - mNewString: begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - result := newNodeIT(nkStrLit, n.info, n.typ); - result.strVal := newString(int(getOrdValue(a))); - end; - else begin - result := evalAux(c, n.sons[1]); - if isSpecial(result) then exit; - a := result; - b := nil; - cc := nil; - if sonsLen(n) > 2 then begin - result := evalAux(c, n.sons[2]); - if isSpecial(result) then exit; - b := result; - if sonsLen(n) > 3 then begin - result := evalAux(c, n.sons[3]); - if isSpecial(result) then exit; - cc := result; - end - end; - if isEmpty(a) or isEmpty(b) or isEmpty(cc) then - result := emptyNode - else - result := evalOp(m, n, a, b, cc); - end - end -end; - -function evalAux(c: PEvalContext; n: PNode): PNode; -var - i: int; - a: PNode; -begin - result := emptyNode; - dec(gNestedEvals); - if gNestedEvals <= 0 then stackTrace(c, n, errTooManyIterations); - case n.kind of // atoms: - nkEmpty: result := n; - nkSym: result := evalSym(c, n); - nkType..pred(nkNilLit): result := copyNode(n); - nkNilLit: result := n; // end of atoms - - nkCall, nkHiddenCallConv, nkMacroStmt, nkCommand, nkCallStrLit: - result := evalMagicOrCall(c, n); - nkCurly, nkBracket, nkRange: begin - a := copyNode(n); - for i := 0 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i]); - if isSpecial(result) then exit; - addSon(a, result); - end; - result := a - end; - nkPar: begin - a := copyTree(n); - for i := 0 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i].sons[1]); - if isSpecial(result) then exit; - a.sons[i].sons[1] := result; - end; - result := a - end; - nkBracketExpr: result := evalArrayAccess(c, n); - nkDotExpr: result := evalFieldAccess(c, n); - nkDerefExpr, nkHiddenDeref: result := evalDeref(c, n); - nkAddr, nkHiddenAddr: result := evalAddr(c, n); - nkHiddenStdConv, nkHiddenSubConv, nkConv: result := evalConv(c, n); - nkAsgn, nkFastAsgn: result := evalAsgn(c, n); - nkWhenStmt, nkIfStmt, nkIfExpr: result := evalIf(c, n); - nkWhileStmt: result := evalWhile(c, n); - nkCaseStmt: result := evalCase(c, n); - nkVarSection: result := evalVar(c, n); - nkTryStmt: result := evalTry(c, n); - nkRaiseStmt: result := evalRaise(c, n); - nkReturnStmt: result := evalReturn(c, n); - nkBreakStmt, nkReturnToken: result := n; - nkBlockExpr, nkBlockStmt: result := evalBlock(c, n); - nkDiscardStmt: result := evalAux(c, n.sons[0]); - nkCheckedFieldExpr: result := evalCheckedFieldAccess(c, n); - nkObjDownConv: result := evalAux(c, n.sons[0]); - nkObjUpConv: result := evalUpConv(c, n); - nkChckRangeF, nkChckRange64, nkChckRange: result := evalRangeChck(c, n); - nkStringToCString: result := evalConvStrToCStr(c, n); - nkCStringToString: result := evalConvCStrToStr(c, n); - nkPassAsOpenArray: result := evalAux(c, n.sons[0]); - - nkStmtListExpr, nkStmtList, nkModule: begin - for i := 0 to sonsLen(n)-1 do begin - result := evalAux(c, n.sons[i]); - case result.kind of - nkExceptBranch, nkReturnToken, nkBreakStmt: break; - else begin end - end - end - end; - nkProcDef, nkMethodDef, nkMacroDef, nkCommentStmt, nkPragma, nkTypeSection, - nkTemplateDef, nkConstSection, nkIteratorDef, nkConverterDef, - nkIncludeStmt, nkImportStmt, nkFromStmt: begin end; - nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, - nkLambda, nkContinueStmt, nkIdent: - stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]); - else InternalError(n.info, 'evalAux: ' + nodekindToStr[n.kind]); - end; - if result = nil then - InternalError(n.info, 'evalAux: returned nil ' + nodekindToStr[n.kind]); - inc(gNestedEvals); -end; - -function eval(c: PEvalContext; n: PNode): PNode; -begin - gWhileCounter := evalMaxIterations; - gNestedEvals := evalMaxRecDepth; - result := evalAux(c, n); - if (result.kind = nkExceptBranch) and (sonsLen(result) >= 1) then - stackTrace(c, n, errUnhandledExceptionX, typeToString(result.typ)); -end; - -function evalConstExpr(module: PSym; e: PNode): PNode; -var - p: PEvalContext; - s: PStackFrame; -begin - p := newEvalContext(module, '', true); - s := newStackFrame(); - s.call := e; - pushStackFrame(p, s); - result := eval(p, e); - if (result <> nil) and (result.kind = nkExceptBranch) then - result := nil; - popStackFrame(p); -end; - -function myOpen(module: PSym; const filename: string): PPassContext; -var - c: PEvalContext; -begin - c := newEvalContext(module, filename, false); - pushStackFrame(c, newStackFrame()); - result := c; -end; - -function myProcess(c: PPassContext; n: PNode): PNode; -begin - result := eval(PEvalContext(c), n); -end; - -function evalPass(): TPass; -begin - initPass(result); - result.open := myOpen; - result.close := myProcess; - result.process := myProcess; -end; - -initialization - emptyNode := newNode(nkEmpty); -end. diff --git a/nim/extccomp.pas b/nim/extccomp.pas deleted file mode 100755 index 7df3e87487..0000000000 --- a/nim/extccomp.pas +++ /dev/null @@ -1,676 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit extccomp; - -// module for calling the different external C compilers - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, lists, ropes, nos, strutils, osproc, platform, condsyms, - options, msgs; - -// some things are read in from the configuration file - -type - TSystemCC = (ccNone, ccGcc, ccLLVM_Gcc, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, - ccTcc, ccPcc, ccUcc, ccIcc, ccGpp); - - TInfoCCProp = ( // properties of the C compiler: - hasSwitchRange, // CC allows ranges in switch statements (GNU C extension) - hasComputedGoto, // CC has computed goto (GNU C extension) - hasCpp, // CC is/contains a C++ compiler - hasAssume // CC has __assume (Visual C extension) - ); - TInfoCCProps = set of TInfoCCProp; - TInfoCC = record{@tuple} - name: string; // the short name of the compiler - objExt: string; // the compiler's object file extenstion - optSpeed: string; // the options for optimization for speed - optSize: string; // the options for optimization for size - compilerExe: string; // the compiler's executable - compileTmpl: string; // the compile command template - buildGui: string; // command to build a GUI application - buildDll: string; // command to build a shared library - linkerExe: string; // the linker's executable - linkTmpl: string; // command to link files to produce an executable - includeCmd: string; // command to add an include directory path - debug: string; // flags for debug build - pic: string; // command for position independent code - // used on some platforms - asmStmtFrmt: string; // format of ASM statement - props: TInfoCCProps; // properties of the C compiler - end; -const - CC: array [succ(low(TSystemCC))..high(TSystemCC)] of TInfoCC = ( - ( - name: 'gcc'; - objExt: 'o'+''; - optSpeed: ' -O3 -ffast-math '; - optSize: ' -Os -ffast-math '; - compilerExe: 'gcc'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: ' -mwindows'; - buildDll: ' -mdll'; - linkerExe: 'gcc'; - linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; - includeCmd: ' -I'; - debug: ''; - pic: '-fPIC'; - asmStmtFrmt: 'asm($1);$n'; - props: {@set}[hasSwitchRange, hasComputedGoto, hasCpp]; - ), - ( - name: 'llvm_gcc'; - objExt: 'o'+''; - optSpeed: ' -O3 -ffast-math '; - optSize: ' -Os -ffast-math '; - compilerExe: 'llvm-gcc'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: ' -mwindows'; - buildDll: ' -mdll'; - linkerExe: 'llvm-gcc'; - linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; - includeCmd: ' -I'; - debug: ''; - pic: '-fPIC'; - asmStmtFrmt: 'asm($1);$n'; - props: {@set}[hasSwitchRange, hasComputedGoto, hasCpp]; - ), - ( - name: 'lcc'; - objExt: 'obj'; - optSpeed: ' -O -p6 '; - optSize: ' -O -p6 '; - compilerExe: 'lcc'; - compileTmpl: '$options $include -Fo$objfile $file'; - buildGui: ' -subsystem windows'; - buildDll: ' -dll'; - linkerExe: 'lcclnk'; - linkTmpl: '$options $buildgui $builddll -O $exefile $objfiles'; - includeCmd: ' -I'; - debug: ' -g5 '; - pic: ''; - asmStmtFrmt: '_asm{$n$1$n}$n'; - props: {@set}[]; - ), - ( - name: 'bcc'; - objExt: 'obj'; - optSpeed: ' -O2 -6 '; - optSize: ' -O1 -6 '; - compilerExe: 'bcc32'; - compileTmpl: '-c $options $include -o$objfile $file'; - buildGui: ' -tW'; - buildDll: ' -tWD'; - linkerExe: 'bcc32'; - linkTmpl: '$options $buildgui $builddll -e$exefile $objfiles'; - includeCmd: ' -I'; - debug: ''; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[hasCpp]; - ), - ( - name: 'dmc'; - objExt: 'obj'; - optSpeed: ' -ff -o -6 '; - optSize: ' -ff -o -6 '; - compilerExe: 'dmc'; - compileTmpl: '-c $options $include -o$objfile $file'; - buildGui: ' -L/exet:nt/su:windows'; - buildDll: ' -WD'; - linkerExe: 'dmc'; - linkTmpl: '$options $buildgui $builddll -o$exefile $objfiles'; - includeCmd: ' -I'; - debug: ' -g '; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[hasCpp]; - ), - ( - name: 'wcc'; - objExt: 'obj'; - optSpeed: ' -ox -on -6 -d0 -fp6 -zW '; - optSize: ''; - compilerExe: 'wcl386'; - compileTmpl: '-c $options $include -fo=$objfile $file'; - buildGui: ' -bw'; - buildDll: ' -bd'; - linkerExe: 'wcl386'; - linkTmpl: '$options $buildgui $builddll -fe=$exefile $objfiles '; - includeCmd: ' -i='; - debug: ' -d2 '; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[hasCpp]; - ), - ( - name: 'vcc'; - objExt: 'obj'; - optSpeed: ' /Ogityb2 /G7 /arch:SSE2 '; - optSize: ' /O1 /G7 '; - compilerExe: 'cl'; - compileTmpl: '/c $options $include /Fo$objfile $file'; - buildGui: ' /link /SUBSYSTEM:WINDOWS '; - buildDll: ' /LD'; - linkerExe: 'cl'; - linkTmpl: '$options $builddll /Fe$exefile $objfiles $buildgui'; - includeCmd: ' /I'; - debug: ' /GZ /Zi '; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[hasCpp, hasAssume]; - ), - ( - name: 'tcc'; - objExt: 'o'+''; - optSpeed: ''; - optSize: ''; - compilerExe: 'tcc'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: 'UNAVAILABLE!'; - buildDll: ' -shared'; - linkerExe: 'tcc'; - linkTmpl: '-o $exefile $options $buildgui $builddll $objfiles'; - includeCmd: ' -I'; - debug: ' -g '; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[hasSwitchRange, hasComputedGoto]; - ), - ( - name: 'pcc'; // Pelles C - objExt: 'obj'; - optSpeed: ' -Ox '; - optSize: ' -Os '; - compilerExe: 'cc'; - compileTmpl: '-c $options $include -Fo$objfile $file'; - buildGui: ' -SUBSYSTEM:WINDOWS'; - buildDll: ' -DLL'; - linkerExe: 'cc'; - linkTmpl: '$options $buildgui $builddll -OUT:$exefile $objfiles'; - includeCmd: ' -I'; - debug: ' -Zi '; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[]; - ), - ( - name: 'ucc'; - objExt: 'o'+''; - optSpeed: ' -O3 '; - optSize: ' -O1 '; - compilerExe: 'cc'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: ''; - buildDll: ' -shared '; - linkerExe: 'cc'; - linkTmpl: '-o $exefile $options $buildgui $builddll $objfiles'; - includeCmd: ' -I'; - debug: ''; - pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; - props: {@set}[]; - ), ( - name: 'icc'; - objExt: 'o'+''; - optSpeed: ' -O3 '; - optSize: ' -Os '; - compilerExe: 'icc'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: ' -mwindows'; - buildDll: ' -mdll'; - linkerExe: 'icc'; - linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; - includeCmd: ' -I'; - debug: ''; - pic: '-fPIC'; - asmStmtFrmt: 'asm($1);$n'; - props: {@set}[hasSwitchRange, hasComputedGoto, hasCpp]; - ), ( - name: 'gpp'; - objExt: 'o'+''; - optSpeed: ' -O3 -ffast-math '; - optSize: ' -Os -ffast-math '; - compilerExe: 'g++'; - compileTmpl: '-c $options $include -o $objfile $file'; - buildGui: ' -mwindows'; - buildDll: ' -mdll'; - linkerExe: 'g++'; - linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; - includeCmd: ' -I'; - debug: ' -g '; - pic: '-fPIC'; - asmStmtFrmt: 'asm($1);$n'; - props: {@set}[hasSwitchRange, hasComputedGoto, hasCpp]; - ) - ); - -var - ccompiler: TSystemCC = ccGcc; // the used compiler - -const - hExt = 'h'+''; - -var - cExt: string = 'c'+''; // extension of generated C/C++ files - // (can be changed to .cpp later) - -function completeCFilePath(const cfile: string; - createSubDir: Boolean = true): string; - -function getCompileCFileCmd(const cfilename: string; - isExternal: bool = false): string; - -procedure addFileToCompile(const filename: string); -procedure addExternalFileToCompile(const filename: string); -procedure addFileToLink(const filename: string); - -procedure addCompileOption(const option: string); -procedure addLinkOption(const option: string); - -function toObjFile(const filenameWithoutExt: string): string; - -procedure CallCCompiler(const projectFile: string); - -procedure execExternalProgram(const cmd: string); - -function NameToCC(const name: string): TSystemCC; - -procedure initVars; - -procedure setCC(const ccname: string); -procedure writeMapping(gSymbolMapping: PRope); - -implementation - -var - toLink, toCompile, externalToCompile: TLinkedList; - linkOptions: string = ''; - compileOptions: string = ''; - - ccompilerpath: string = ''; - -procedure setCC(const ccname: string); -var - i: TSystemCC; -begin - ccompiler := nameToCC(ccname); - if ccompiler = ccNone then rawMessage(errUnknownCcompiler, ccname); - compileOptions := getConfigVar(CC[ccompiler].name + '.options.always'); - linkOptions := getConfigVar(CC[ccompiler].name + '.options.linker'); - ccompilerpath := getConfigVar(CC[ccompiler].name + '.path'); - for i := low(CC) to high(CC) do undefSymbol(CC[i].name); - defineSymbol(CC[ccompiler].name); -end; - -procedure initVars; -var - i: TSystemCC; -begin - // we need to define the symbol here, because ``CC`` may have never been set! - for i := low(CC) to high(CC) do undefSymbol(CC[i].name); - defineSymbol(CC[ccompiler].name); - if gCmd = cmdCompileToCpp then - cExt := '.cpp'; - addCompileOption(getConfigVar(CC[ccompiler].name + '.options.always')); - addLinkOption(getConfigVar(CC[ccompiler].name + '.options.linker')); - if length(ccompilerPath) = 0 then - ccompilerpath := getConfigVar(CC[ccompiler].name + '.path'); -end; - -function completeCFilePath(const cfile: string; - createSubDir: Boolean = true): string; -begin - result := completeGeneratedFilePath(cfile, createSubDir); -end; - -function NameToCC(const name: string): TSystemCC; -var - i: TSystemCC; -begin - for i := succ(ccNone) to high(TSystemCC) do - if cmpIgnoreStyle(name, CC[i].name) = 0 then begin - result := i; exit - end; - result := ccNone -end; - -procedure addOpt(var dest: string; const src: string); -begin - if (length(dest) = 0) or (dest[length(dest)-1+strStart] <> ' ') then - add(dest, ' '+''); - add(dest, src); -end; - -procedure addCompileOption(const option: string); -begin - if strutils.find(compileOptions, option, strStart) < strStart then - addOpt(compileOptions, option) -end; - -procedure addLinkOption(const option: string); -begin - if find(linkOptions, option, strStart) < strStart then - addOpt(linkOptions, option) -end; - -function toObjFile(const filenameWithoutExt: string): string; -begin - result := changeFileExt(filenameWithoutExt, cc[ccompiler].objExt) -end; - -procedure addFileToCompile(const filename: string); -begin - appendStr(toCompile, filename); -end; - -procedure addExternalFileToCompile(const filename: string); -begin - appendStr(externalToCompile, filename); -end; - -procedure addFileToLink(const filename: string); -begin - prependStr(toLink, filename); // BUGFIX - //appendStr(toLink, filename); -end; - -procedure execExternalProgram(const cmd: string); -begin - if (optListCmd in gGlobalOptions) or (gVerbosity > 0) then - MessageOut(cmd); - if execCmd(cmd) <> 0 then - rawMessage(errExecutionOfProgramFailed); -end; - -procedure generateScript(const projectFile: string; script: PRope); -var - path, scriptname, name, ext: string; -begin - splitPath(projectFile, path, scriptname); - SplitFilename(scriptname, name, ext); - name := addFileExt('compile_' + name, platform.os[targetOS].scriptExt); - WriteRope(script, joinPath(path, name)); -end; - -function getOptSpeed(c: TSystemCC): string; -begin - result := getConfigVar(cc[c].name + '.options.speed'); - if result = '' then - result := cc[c].optSpeed // use default settings from this file -end; - -function getDebug(c: TSystemCC): string; -begin - result := getConfigVar(cc[c].name + '.options.debug'); - if result = '' then - result := cc[c].debug // use default settings from this file -end; - -function getOptSize(c: TSystemCC): string; -begin - result := getConfigVar(cc[c].name + '.options.size'); - if result = '' then - result := cc[c].optSize // use default settings from this file -end; - -const - specialFileA = 42; - specialFileB = 42; -var - fileCounter: int; - -function getCompileCFileCmd(const cfilename: string; - isExternal: bool = false): string; -var - cfile, objfile, options, includeCmd, compilePattern, key, trunk, exe: string; - c: TSystemCC; // an alias to ccompiler -begin - c := ccompiler; - options := compileOptions; - trunk := splitFile(cfilename).name; - if optCDebug in gGlobalOptions then begin - key := trunk + '.debug'; - if existsConfigVar(key) then - addOpt(options, getConfigVar(key)) - else - addOpt(options, getDebug(c)) - end; - if (optOptimizeSpeed in gOptions) then begin - //if ((fileCounter >= specialFileA) and (fileCounter <= specialFileB)) then - key := trunk + '.speed'; - if existsConfigVar(key) then - addOpt(options, getConfigVar(key)) - else - addOpt(options, getOptSpeed(c)) - end - else if optOptimizeSize in gOptions then begin - key := trunk + '.size'; - if existsConfigVar(key) then - addOpt(options, getConfigVar(key)) - else - addOpt(options, getOptSize(c)) - end; - key := trunk + '.always'; - if existsConfigVar(key) then - addOpt(options, getConfigVar(key)); - - exe := cc[c].compilerExe; - key := cc[c].name + '.exe'; - if existsConfigVar(key) then - exe := getConfigVar(key); - if targetOS = osWindows then exe := addFileExt(exe, 'exe'); - - if (optGenDynLib in gGlobalOptions) - and (ospNeedsPIC in platform.OS[targetOS].props) then - add(options, ' ' + cc[c].pic); - - if targetOS = platform.hostOS then begin - // compute include paths: - includeCmd := cc[c].includeCmd; // this is more complex than needed, but - // a workaround of a FPC bug... - add(includeCmd, quoteIfContainsWhite(libpath)); - compilePattern := JoinPath(ccompilerpath, exe); - end - else begin - includeCmd := ''; - compilePattern := cc[c].compilerExe - end; - if targetOS = platform.hostOS then - cfile := cfilename - else - cfile := extractFileName(cfilename); - - if not isExternal or (targetOS <> platform.hostOS) then - objfile := toObjFile(cfile) - else - objfile := completeCFilePath(toObjFile(cfile)); - cfile := quoteIfContainsWhite(AddFileExt(cfile, cExt)); - objfile := quoteIfContainsWhite(objfile); - - result := quoteIfContainsWhite(format(compilePattern, - ['file', cfile, - 'objfile', objfile, - 'options', options, - 'include', includeCmd, - 'nimrod', getPrefixDir(), - 'lib', libpath - ])); - add(result, ' '); - add(result, format(cc[c].compileTmpl, - ['file', cfile, - 'objfile', objfile, - 'options', options, - 'include', includeCmd, - 'nimrod', quoteIfContainsWhite(getPrefixDir()), - 'lib', quoteIfContainsWhite(libpath) - ])); -end; - -procedure CompileCFile(const list: TLinkedList; - var script: PRope; - var cmds: TStringSeq; - isExternal: Boolean); -var - it: PStrEntry; - compileCmd: string; -begin - it := PStrEntry(list.head); - while it <> nil do begin - inc(fileCounter); - // call the C compiler for the .c file: - compileCmd := getCompileCFileCmd(it.data, isExternal); - if not (optCompileOnly in gGlobalOptions) then - add(cmds, compileCmd); //execExternalProgram(compileCmd); - if (optGenScript in gGlobalOptions) then begin - app(script, compileCmd); - app(script, tnl); - end; - it := PStrEntry(it.next); - end; -end; - -procedure CallCCompiler(const projectfile: string); -var - it: PStrEntry; - linkCmd, objfiles, exefile, buildgui, builddll, linkerExe: string; - c: TSystemCC; // an alias to ccompiler - script: PRope; - cmds: TStringSeq; - res, i: int; -begin - if (gGlobalOptions * [optCompileOnly, optGenScript] = [optCompileOnly]) then - exit; // speed up that call if only compiling and no script shall be - // generated - if (toCompile.head = nil) and (externalToCompile.head = nil) then exit; - fileCounter := 0; - c := ccompiler; - script := nil; - cmds := {@ignore} nil {@emit @[]}; - CompileCFile(toCompile, script, cmds, false); - CompileCFile(externalToCompile, script, cmds, true); - if not (optCompileOnly in gGlobalOptions) then begin - if gNumberOfProcessors = 0 then - gNumberOfProcessors := countProcessors(); - if gNumberOfProcessors <= 1 then begin - res := 0; - for i := 0 to high(cmds) do res := max(execCmd(cmds[i]), res); - end - else if (optListCmd in gGlobalOptions) or (gVerbosity > 0) then - res := execProcesses(cmds, {@set}[poEchoCmd, poUseShell, poParentStreams], - gNumberOfProcessors) - else - res := execProcesses(cmds, {@set}[poUseShell, poParentStreams], - gNumberOfProcessors); - if res <> 0 then - rawMessage(errExecutionOfProgramFailed); - end; - - if not (optNoLinking in gGlobalOptions) then begin - // call the linker: - linkerExe := getConfigVar(cc[c].name + '.linkerexe'); - if length(linkerExe) = 0 then linkerExe := cc[c].linkerExe; - if targetOS = osWindows then linkerExe := addFileExt(linkerExe, 'exe'); - - if (platform.hostOS <> targetOS) then - linkCmd := quoteIfContainsWhite(linkerExe) - else - linkCmd := quoteIfContainsWhite(JoinPath(ccompilerpath, linkerExe)); - - if optGenGuiApp in gGlobalOptions then - buildGui := cc[c].buildGui - else - buildGui := ''; - - if optGenDynLib in gGlobalOptions then begin - exefile := format(platform.os[targetOS].dllFrmt, - [splitFile(projectFile).name]); - buildDll := cc[c].buildDll; - end - else begin - exefile := splitFile(projectFile).name +{&} platform.os[targetOS].exeExt; - buildDll := ''; - end; - if targetOS = platform.hostOS then - exefile := joinPath(splitFile(projectFile).dir, exefile); - exefile := quoteIfContainsWhite(exefile); - - it := PStrEntry(toLink.head); - objfiles := ''; - while it <> nil do begin - add(objfiles, ' '+''); - if targetOS = platform.hostOS then - add(objfiles, quoteIfContainsWhite(toObjfile(it.data))) - else - add(objfiles, quoteIfContainsWhite( - toObjfile(extractFileName(it.data)))); - it := PStrEntry(it.next); - end; - - linkCmd := quoteIfContainsWhite(format(linkCmd, [ - 'builddll', builddll, - 'buildgui', buildgui, - 'options', linkOptions, - 'objfiles', objfiles, - 'exefile', exefile, - 'nimrod', getPrefixDir(), - 'lib', libpath - ])); - add(linkCmd, ' '); - add(linkCmd, format(cc[c].linkTmpl, [ - 'builddll', builddll, - 'buildgui', buildgui, - 'options', linkOptions, - 'objfiles', objfiles, - 'exefile', exefile, - 'nimrod', quoteIfContainsWhite(getPrefixDir()), - 'lib', quoteIfContainsWhite(libpath) - ])); - - if not (optCompileOnly in gGlobalOptions) then - execExternalProgram(linkCmd); - end // end if not noLinking - else - linkCmd := ''; - if (optGenScript in gGlobalOptions) then begin - app(script, linkCmd); - app(script, tnl); - generateScript(projectFile, script) - end -end; - -function genMappingFiles(const list: TLinkedList): PRope; -var - it: PStrEntry; -begin - result := nil; - it := PStrEntry(list.head); - while it <> nil do begin - appf(result, '--file:r"$1"$n', [toRope(AddFileExt(it.data, cExt))]); - it := PStrEntry(it.next); - end; -end; - -procedure writeMapping(gSymbolMapping: PRope); -var - code: PRope; -begin - if not (optGenMapping in gGlobalOptions) then exit; - code := toRope('[C_Files]'+nl); - app(code, genMappingFiles(toCompile)); - app(code, genMappingFiles(externalToCompile)); - appf(code, '[Symbols]$n$1', [gSymbolMapping]); - WriteRope(code, joinPath(projectPath, 'mapping.txt')); -end; - -end. diff --git a/nim/filters.pas b/nim/filters.pas deleted file mode 100755 index 95f628fe22..0000000000 --- a/nim/filters.pas +++ /dev/null @@ -1,137 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit filters; - -// This module implements Nimrod's simple filters and helpers for filters. - -{$include config.inc} - -interface - -uses - nsystem, llstream, nos, charsets, wordrecg, idents, strutils, - ast, astalgo, msgs, options, rnimsyn; - -function filterReplace(input: PLLStream; const filename: string; - call: PNode): PLLStream; -function filterStrip(input: PLLStream; const filename: string; - call: PNode): PLLStream; - -// helpers to retrieve arguments: -function charArg(n: PNode; const name: string; pos: int; default: Char): Char; -function strArg(n: PNode; const name: string; pos: int; - const default: string): string; -function boolArg(n: PNode; const name: string; pos: int; default: bool): bool; - -implementation - -procedure invalidPragma(n: PNode); -begin - liMessage(n.info, errXNotAllowedHere, renderTree(n, {@set}[renderNoComments])); -end; - -function getArg(n: PNode; const name: string; pos: int): PNode; -var - i: int; -begin - result := nil; - if n.kind in [nkEmpty..nkNilLit] then exit; - for i := 1 to sonsLen(n)-1 do - if n.sons[i].kind = nkExprEqExpr then begin - if n.sons[i].sons[0].kind <> nkIdent then invalidPragma(n); - if IdentEq(n.sons[i].sons[0].ident, name) then begin - result := n.sons[i].sons[1]; - exit - end - end - else if i = pos then begin - result := n.sons[i]; exit - end -end; - -function charArg(n: PNode; const name: string; pos: int; default: Char): Char; -var - x: PNode; -begin - x := getArg(n, name, pos); - if x = nil then result := default - else if x.kind = nkCharLit then result := chr(int(x.intVal)) - else invalidPragma(n); -end; - -function strArg(n: PNode; const name: string; pos: int; - const default: string): string; -var - x: PNode; -begin - x := getArg(n, name, pos); - if x = nil then result := default - else if x.kind in [nkStrLit..nkTripleStrLit] then result := x.strVal - else invalidPragma(n); -end; - -function boolArg(n: PNode; const name: string; pos: int; default: bool): bool; -var - x: PNode; -begin - x := getArg(n, name, pos); - if x = nil then result := default - else if (x.kind = nkIdent) and IdentEq(x.ident, 'true') then result := true - else if (x.kind = nkIdent) and IdentEq(x.ident, 'false') then result := false - else invalidPragma(n); -end; - -// -------------------------- strip filter ----------------------------------- - -function filterStrip(input: PLLStream; const filename: string; - call: PNode): PLLStream; -var - line, pattern, stripped: string; - leading, trailing: bool; -begin - pattern := strArg(call, 'startswith', 1, ''); - leading := boolArg(call, 'leading', 2, true); - trailing := boolArg(call, 'trailing', 3, true); - - result := LLStreamOpen(''); - while not LLStreamAtEnd(input) do begin - line := LLStreamReadLine(input); - {@ignore} - stripped := strip(line); - {@emit - stripped := strip(line, leading, trailing); - } - if (length(pattern) = 0) or startsWith(stripped, pattern) then - LLStreamWriteln(result, stripped) - else - LLStreamWriteln(result, line) - end; - LLStreamClose(input); -end; - -// -------------------------- replace filter --------------------------------- - -function filterReplace(input: PLLStream; const filename: string; - call: PNode): PLLStream; -var - line, sub, by: string; -begin - sub := strArg(call, 'sub', 1, ''); - if length(sub) = 0 then invalidPragma(call); - by := strArg(call, 'by', 2, ''); - - result := LLStreamOpen(''); - while not LLStreamAtEnd(input) do begin - line := LLStreamReadLine(input); - LLStreamWriteln(result, replace(line, sub, by)) - end; - LLStreamClose(input); -end; - -end. diff --git a/nim/hashtest.pas b/nim/hashtest.pas deleted file mode 100755 index 7e93ca5bf7..0000000000 --- a/nim/hashtest.pas +++ /dev/null @@ -1,10 +0,0 @@ -program hashtest; - -{$include 'config.inc'} - -uses - nhashes; - -begin - writeln(output, getNormalizedHash(ParamStr(1))); -end. diff --git a/nim/highlite.pas b/nim/highlite.pas deleted file mode 100755 index fa760d2a28..0000000000 --- a/nim/highlite.pas +++ /dev/null @@ -1,743 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit highlite; - -// Source highlighter for programming or markup languages. -// Currently only few languages are supported, other languages may be added. -// The interface supports one language nested in another. - -interface - -{$include 'config.inc'} - -uses - charsets, nsystem, sysutils, nhashes, options, msgs, strutils, platform, - idents, lexbase, wordrecg, scanner; - -type - TTokenClass = ( - gtEof, - gtNone, - gtWhitespace, - gtDecNumber, - gtBinNumber, - gtHexNumber, - gtOctNumber, - gtFloatNumber, - gtIdentifier, - gtKeyword, - gtStringLit, - gtLongStringLit, - gtCharLit, - gtEscapeSequence, // escape sequence like \xff - gtOperator, - gtPunctation, - gtComment, - gtLongComment, - gtRegularExpression, - gtTagStart, - gtTagEnd, - gtKey, - gtValue, - gtRawData, - gtAssembler, - gtPreprocessor, - gtDirective, - gtCommand, - gtRule, - gtHyperlink, - gtLabel, - gtReference, - gtOther - ); - TGeneralTokenizer = object(NObject) - kind: TTokenClass; - start, len: int; - // private: - buf: PChar; - pos: int; - state: TTokenClass; - end; - TSourceLanguage = ( - langNone, - langNimrod, - langCpp, - langCsharp, - langC, - langJava - ); -const - sourceLanguageToStr: array [TSourceLanguage] of string = ( - 'none', 'Nimrod', 'C++', 'C#', 'C'+'', 'Java' - ); - tokenClassToStr: array [TTokenClass] of string = ( - 'Eof', - 'None', - 'Whitespace', - 'DecNumber', - 'BinNumber', - 'HexNumber', - 'OctNumber', - 'FloatNumber', - 'Identifier', - 'Keyword', - 'StringLit', - 'LongStringLit', - 'CharLit', - 'EscapeSequence', - 'Operator', - 'Punctation', - 'Comment', - 'LongComment', - 'RegularExpression', - 'TagStart', - 'TagEnd', - 'Key', - 'Value', - 'RawData', - 'Assembler', - 'Preprocessor', - 'Directive', - 'Command', - 'Rule', - 'Hyperlink', - 'Label', - 'Reference', - 'Other' - ); - -function getSourceLanguage(const name: string): TSourceLanguage; - -procedure initGeneralTokenizer(var g: TGeneralTokenizer; - const buf: string); -procedure deinitGeneralTokenizer(var g: TGeneralTokenizer); -procedure getNextToken(var g: TGeneralTokenizer; lang: TSourceLanguage); - -implementation - -function getSourceLanguage(const name: string): TSourceLanguage; -var - i: TSourceLanguage; -begin - for i := succ(low(TSourceLanguage)) to high(TSourceLanguage) do - if cmpIgnoreStyle(name, sourceLanguageToStr[i]) = 0 then begin - result := i; exit - end; - result := langNone -end; - -procedure initGeneralTokenizer(var g: TGeneralTokenizer; - const buf: string); -var - pos: int; -begin -{@ignore} fillChar(g, sizeof(g), 0); {@emit} - g.buf := PChar(buf); - g.kind := low(TTokenClass); - g.start := 0; - g.len := 0; - g.state := low(TTokenClass); - pos := 0; - // skip initial whitespace: - while g.buf[pos] in [' ', #9..#13] do inc(pos); - g.pos := pos; -end; - -procedure deinitGeneralTokenizer(var g: TGeneralTokenizer); -begin -end; - -function nimGetKeyword(const id: string): TTokenClass; -var - i: PIdent; -begin - i := getIdent(id); - if (i.id >= ord(tokKeywordLow)-ord(tkSymbol)) and - (i.id <= ord(tokKeywordHigh)-ord(tkSymbol)) then - result := gtKeyword - else - result := gtIdentifier -end; - -function nimNumberPostfix(var g: TGeneralTokenizer; position: int): int; -var - pos: int; -begin - pos := position; - if g.buf[pos] = '''' then begin - inc(pos); - case g.buf[pos] of - 'f', 'F': begin - g.kind := gtFloatNumber; - inc(pos); - if g.buf[pos] in ['0'..'9'] then inc(pos); - if g.buf[pos] in ['0'..'9'] then inc(pos); - end; - 'i', 'I': begin - inc(pos); - if g.buf[pos] in ['0'..'9'] then inc(pos); - if g.buf[pos] in ['0'..'9'] then inc(pos); - end; - else begin end - end - end; - result := pos; -end; - -function nimNumber(var g: TGeneralTokenizer; position: int): int; -const - decChars = ['0'..'9', '_']; -var - pos: int; -begin - pos := position; - g.kind := gtDecNumber; - while g.buf[pos] in decChars do inc(pos); - if g.buf[pos] = '.' then begin - g.kind := gtFloatNumber; - inc(pos); - while g.buf[pos] in decChars do inc(pos); - end; - if g.buf[pos] in ['e', 'E'] then begin - g.kind := gtFloatNumber; - inc(pos); - if g.buf[pos] in ['+', '-'] then inc(pos); - while g.buf[pos] in decChars do inc(pos); - end; - result := nimNumberPostfix(g, pos); -end; - -procedure nimNextToken(var g: TGeneralTokenizer); -const - hexChars = ['0'..'9', 'A'..'F', 'a'..'f', '_']; - octChars = ['0'..'7', '_']; - binChars = ['0'..'1', '_']; -var - pos: int; - id: string; -begin - pos := g.pos; - g.start := g.pos; - if g.state = gtStringLit then begin - g.kind := gtStringLit; - while true do begin - case g.buf[pos] of - '\': begin - g.kind := gtEscapeSequence; - inc(pos); - case g.buf[pos] of - 'x', 'X': begin - inc(pos); - if g.buf[pos] in hexChars then inc(pos); - if g.buf[pos] in hexChars then inc(pos); - end; - '0'..'9': while g.buf[pos] in ['0'..'9'] do inc(pos); - #0: g.state := gtNone; - else inc(pos); - end; - break - end; - #0, #13, #10: begin g.state := gtNone; break end; - '"': begin - inc(pos); - g.state := gtNone; - break - end; - else inc(pos) - end - end - end - else begin - case g.buf[pos] of - ' ', #9..#13: begin - g.kind := gtWhitespace; - while g.buf[pos] in [' ', #9..#13] do inc(pos); - end; - '#': begin - g.kind := gtComment; - while not (g.buf[pos] in [#0, #10, #13]) do inc(pos); - end; - 'a'..'z', 'A'..'Z', '_', #128..#255: begin - id := ''; - while g.buf[pos] in scanner.SymChars+['_'] do begin - addChar(id, g.buf[pos]); - inc(pos) - end; - if (g.buf[pos] = '"') then begin - if (g.buf[pos+1] = '"') and (g.buf[pos+2] = '"') then begin - inc(pos, 3); - g.kind := gtLongStringLit; - while true do begin - case g.buf[pos] of - #0: break; - '"': begin - inc(pos); - if (g.buf[pos] = '"') and (g.buf[pos+1] = '"') then begin - inc(pos, 2); - break - end - end; - else inc(pos); - end - end - end - else begin - g.kind := gtRawData; - inc(pos); - while not (g.buf[pos] in [#0, '"', #10, #13]) do inc(pos); - if g.buf[pos] = '"' then inc(pos); - end - end - else begin - g.kind := nimGetKeyword(id); - end - end; - '0': begin - inc(pos); - case g.buf[pos] of - 'b', 'B': begin - inc(pos); - while g.buf[pos] in binChars do inc(pos); - pos := nimNumberPostfix(g, pos); - end; - 'x', 'X': begin - inc(pos); - while g.buf[pos] in hexChars do inc(pos); - pos := nimNumberPostfix(g, pos); - end; - 'o', 'O': begin - inc(pos); - while g.buf[pos] in octChars do inc(pos); - pos := nimNumberPostfix(g, pos); - end; - else - pos := nimNumber(g, pos); - end - end; - '1'..'9': begin - pos := nimNumber(g, pos); - end; - '''': begin - inc(pos); - g.kind := gtCharLit; - while true do begin - case g.buf[pos] of - #0, #13, #10: break; - '''': begin inc(pos); break end; - '\': begin inc(pos, 2); end; - else inc(pos); - end - end - end; - '"': begin - inc(pos); - if (g.buf[pos] = '"') and (g.buf[pos+1] = '"') then begin - inc(pos, 2); - g.kind := gtLongStringLit; - while true do begin - case g.buf[pos] of - #0: break; - '"': begin - inc(pos); - if (g.buf[pos] = '"') and (g.buf[pos+1] = '"') then begin - inc(pos, 2); - break - end - end; - else inc(pos); - end - end - end - else begin - g.kind := gtStringLit; - while true do begin - case g.buf[pos] of - #0, #13, #10: break; - '"': begin inc(pos); break end; - '\': begin g.state := g.kind; break end; - else inc(pos); - end - end - end - end; - '(', ')', '[', ']', '{', '}', '`', ':', ',', ';': begin - inc(pos); - g.kind := gtPunctation - end; - #0: g.kind := gtEof; - else if g.buf[pos] in scanner.OpChars then begin - g.kind := gtOperator; - while g.buf[pos] in scanner.OpChars do inc(pos); - end - else begin - inc(pos); - g.kind := gtNone - end; - end - end; - g.len := pos - g.pos; - if (g.kind <> gtEof) and (g.len <= 0) then - InternalError('nimNextToken: ' + toString(g.buf)); - g.pos := pos; -end; - -// ------------------------------- helpers ------------------------------------ - -function generalNumber(var g: TGeneralTokenizer; position: int): int; -const - decChars = ['0'..'9']; -var - pos: int; -begin - pos := position; - g.kind := gtDecNumber; - while g.buf[pos] in decChars do inc(pos); - if g.buf[pos] = '.' then begin - g.kind := gtFloatNumber; - inc(pos); - while g.buf[pos] in decChars do inc(pos); - end; - if g.buf[pos] in ['e', 'E'] then begin - g.kind := gtFloatNumber; - inc(pos); - if g.buf[pos] in ['+', '-'] then inc(pos); - while g.buf[pos] in decChars do inc(pos); - end; - result := pos; -end; - -function generalStrLit(var g: TGeneralTokenizer; position: int): int; -const - decChars = ['0'..'9']; - hexChars = ['0'..'9', 'A'..'F', 'a'..'f']; -var - pos: int; - c: Char; -begin - pos := position; - g.kind := gtStringLit; - c := g.buf[pos]; - inc(pos); // skip " or ' - while true do begin - case g.buf[pos] of - #0: break; - '\': begin - inc(pos); - case g.buf[pos] of - #0: break; - '0'..'9': while g.buf[pos] in decChars do inc(pos); - 'x', 'X': begin - inc(pos); - if g.buf[pos] in hexChars then inc(pos); - if g.buf[pos] in hexChars then inc(pos); - end; - else inc(pos, 2) - end - end; - else if g.buf[pos] = c then begin - inc(pos); break; - end - else - inc(pos); - end - end; - result := pos; -end; - -function isKeyword(const x: array of string; const y: string): int; -var - a, b, mid, c: int; -begin - a := 0; - b := length(x)-1; - while a <= b do begin - mid := (a + b) div 2; - c := cmp(x[mid], y); - if c < 0 then - a := mid + 1 - else if c > 0 then - b := mid - 1 - else begin - result := mid; - exit - end - end; - result := -1 -end; - -function isKeywordIgnoreCase(const x: array of string; const y: string): int; -var - a, b, mid, c: int; -begin - a := 0; - b := length(x)-1; - while a <= b do begin - mid := (a + b) div 2; - c := cmpIgnoreCase(x[mid], y); - if c < 0 then - a := mid + 1 - else if c > 0 then - b := mid - 1 - else begin - result := mid; - exit - end - end; - result := -1 -end; - -// --------------------------------------------------------------------------- - -type - TTokenizerFlag = (hasPreprocessor, hasNestedComments); - TTokenizerFlags = set of TTokenizerFlag; - -procedure clikeNextToken(var g: TGeneralTokenizer; - const keywords: array of string; - flags: TTokenizerFlags); -const - hexChars = ['0'..'9', 'A'..'F', 'a'..'f']; - octChars = ['0'..'7']; - binChars = ['0'..'1']; - symChars = ['A'..'Z', 'a'..'z', '0'..'9', '_', #128..#255]; -var - pos, nested: int; - id: string; -begin - pos := g.pos; - g.start := g.pos; - if g.state = gtStringLit then begin - g.kind := gtStringLit; - while true do begin - case g.buf[pos] of - '\': begin - g.kind := gtEscapeSequence; - inc(pos); - case g.buf[pos] of - 'x', 'X': begin - inc(pos); - if g.buf[pos] in hexChars then inc(pos); - if g.buf[pos] in hexChars then inc(pos); - end; - '0'..'9': while g.buf[pos] in ['0'..'9'] do inc(pos); - #0: g.state := gtNone; - else inc(pos); - end; - break - end; - #0, #13, #10: begin g.state := gtNone; break end; - '"': begin - inc(pos); - g.state := gtNone; - break - end; - else inc(pos) - end - end - end - else begin - case g.buf[pos] of - ' ', #9..#13: begin - g.kind := gtWhitespace; - while g.buf[pos] in [' ', #9..#13] do inc(pos); - end; - '/': begin - inc(pos); - if g.buf[pos] = '/' then begin - g.kind := gtComment; - while not (g.buf[pos] in [#0, #10, #13]) do inc(pos); - end - else if g.buf[pos] = '*' then begin - g.kind := gtLongComment; - nested := 0; - inc(pos); - while true do begin - case g.buf[pos] of - '*': begin - inc(pos); - if g.buf[pos] = '/' then begin - inc(pos); - if nested = 0 then break - end; - end; - '/': begin - inc(pos); - if g.buf[pos] = '*' then begin - inc(pos); - if hasNestedComments in flags then inc(nested); - end - end; - #0: break; - else inc(pos); - end - end - end - end; - '#': begin - inc(pos); - if hasPreprocessor in flags then begin - g.kind := gtPreprocessor; - while g.buf[pos] in [' ', Tabulator] do inc(pos); - while g.buf[pos] in symChars do inc(pos); - end - else - g.kind := gtOperator - end; - 'a'..'z', 'A'..'Z', '_', #128..#255: begin - id := ''; - while g.buf[pos] in SymChars do begin - addChar(id, g.buf[pos]); - inc(pos) - end; - if isKeyword(keywords, id) >= 0 then g.kind := gtKeyword - else g.kind := gtIdentifier; - end; - '0': begin - inc(pos); - case g.buf[pos] of - 'b', 'B': begin - inc(pos); - while g.buf[pos] in binChars do inc(pos); - if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); - end; - 'x', 'X': begin - inc(pos); - while g.buf[pos] in hexChars do inc(pos); - if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); - end; - '0'..'7': begin - inc(pos); - while g.buf[pos] in octChars do inc(pos); - if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); - end; - else begin - pos := generalNumber(g, pos); - if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); - end - end - end; - '1'..'9': begin - pos := generalNumber(g, pos); - if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); - end; - '''': begin - pos := generalStrLit(g, pos); - g.kind := gtCharLit; - end; - '"': begin - inc(pos); - g.kind := gtStringLit; - while true do begin - case g.buf[pos] of - #0: break; - '"': begin inc(pos); break end; - '\': begin g.state := g.kind; break end; - else inc(pos); - end - end - end; - '(', ')', '[', ']', '{', '}', ':', ',', ';', '.': begin - inc(pos); - g.kind := gtPunctation - end; - #0: g.kind := gtEof; - else if g.buf[pos] in scanner.OpChars then begin - g.kind := gtOperator; - while g.buf[pos] in scanner.OpChars do inc(pos); - end - else begin - inc(pos); - g.kind := gtNone - end; - end - end; - g.len := pos - g.pos; - if (g.kind <> gtEof) and (g.len <= 0) then InternalError('clikeNextToken'); - g.pos := pos; -end; - -// -------------------------------------------------------------------------- - -procedure cNextToken(var g: TGeneralTokenizer); -const - keywords: array [0..36] of string = ( - '_Bool', '_Complex', '_Imaginary', - 'auto', 'break', 'case', 'char', 'const', 'continue', 'default', 'do', - 'double', 'else', 'enum', 'extern', 'float', 'for', 'goto', 'if', - 'inline', 'int', 'long', 'register', 'restrict', 'return', 'short', - 'signed', 'sizeof', 'static', 'struct', 'switch', 'typedef', 'union', - 'unsigned', 'void', 'volatile', 'while' - ); -begin - clikeNextToken(g, keywords, {@set}[hasPreprocessor]); -end; - -procedure cppNextToken(var g: TGeneralTokenizer); -const - keywords: array [0..47] of string = ( - 'asm', 'auto', 'break', 'case', 'catch', 'char', 'class', 'const', - 'continue', 'default', 'delete', 'do', 'double', 'else', 'enum', 'extern', - 'float', 'for', 'friend', 'goto', 'if', 'inline', 'int', 'long', 'new', - 'operator', 'private', 'protected', 'public', 'register', 'return', - 'short', 'signed', 'sizeof', 'static', 'struct', 'switch', 'template', - 'this', 'throw', 'try', 'typedef', 'union', 'unsigned', 'virtual', 'void', - 'volatile', 'while' - ); -begin - clikeNextToken(g, keywords, {@set}[hasPreprocessor]); -end; - -procedure csharpNextToken(var g: TGeneralTokenizer); -const - keywords: array [0..76] of string = ( - 'abstract', 'as', 'base', 'bool', 'break', 'byte', 'case', 'catch', - 'char', 'checked', 'class', 'const', 'continue', 'decimal', 'default', - 'delegate', 'do', 'double', 'else', 'enum', 'event', 'explicit', 'extern', - 'false', 'finally', 'fixed', 'float', 'for', 'foreach', 'goto', 'if', - 'implicit', 'in', 'int', 'interface', 'internal', 'is', 'lock', 'long', - 'namespace', 'new', 'null', 'object', 'operator', 'out', 'override', - 'params', 'private', 'protected', 'public', 'readonly', 'ref', 'return', - 'sbyte', 'sealed', 'short', 'sizeof', 'stackalloc', 'static', 'string', - 'struct', 'switch', 'this', 'throw', 'true', 'try', 'typeof', 'uint', - 'ulong', 'unchecked', 'unsafe', 'ushort', 'using', 'virtual', 'void', - 'volatile', 'while' - ); -begin - clikeNextToken(g, keywords, {@set}[hasPreprocessor]); -end; - -procedure javaNextToken(var g: TGeneralTokenizer); -const - keywords: array [0..52] of string = ( - 'abstract', 'assert', 'boolean', 'break', 'byte', 'case', 'catch', - 'char', 'class', 'const', 'continue', 'default', 'do', 'double', 'else', - 'enum', 'extends', 'false', 'final', 'finally', 'float', 'for', 'goto', - 'if', 'implements', 'import', 'instanceof', 'int', 'interface', 'long', - 'native', 'new', 'null', 'package', 'private', 'protected', 'public', - 'return', 'short', 'static', 'strictfp', 'super', 'switch', - 'synchronized', 'this', 'throw', 'throws', 'transient', 'true', 'try', - 'void', 'volatile', 'while' - ); -begin - clikeNextToken(g, keywords, {@set}[]); -end; - -procedure getNextToken(var g: TGeneralTokenizer; lang: TSourceLanguage); -begin - case lang of - langNimrod: nimNextToken(g); - langCpp: cppNextToken(g); - langCsharp: csharpNextToken(g); - langC: cNextToken(g); - langJava: javaNextToken(g); - else InternalError('getNextToken'); - end -end; - -end. diff --git a/nim/idents.pas b/nim/idents.pas deleted file mode 100755 index c1c1755e9c..0000000000 --- a/nim/idents.pas +++ /dev/null @@ -1,170 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit idents; - -{$include 'config.inc'} - -// Identifier handling -// An identifier is a shared non-modifiable string that can be compared by its -// id. This module is essential for the compiler's performance. - -interface - -uses - nhashes, nsystem, strutils; - -type - TIdObj = object(NObject) - id: int; // unique id; use this for comparisons and not the pointers - end; - PIdObj = ^TIdObj; - - PIdent = ^TIdent; - TIdent = object(TIdObj) - s: string; - next: PIdent; // for hash-table chaining - h: THash; // hash value of s - end {@acyclic}; - -function getIdent(const identifier: string): PIdent; overload; -function getIdent(const identifier: string; h: THash): PIdent; overload; -function getIdent(identifier: cstring; len: int; h: THash): PIdent; overload; - // special version for the scanner; the scanner's buffering scheme makes - // this horribly efficient. Most of the time no character copying is needed! - -function IdentEq(id: PIdent; const name: string): bool; - -implementation - -function IdentEq(id: PIdent; const name: string): bool; -begin - result := id.id = getIdent(name).id; -end; - -var - buckets: array [0..4096*2-1] of PIdent; - -function cmpIgnoreStyle(a, b: cstring; blen: int): int; -var - aa, bb: char; - i, j: int; -begin - i := 0; - j := 0; - result := 1; - while j < blen do begin - while a[i] = '_' do inc(i); - while b[j] = '_' do inc(j); - // tolower inlined: - aa := a[i]; - bb := b[j]; - if (aa >= 'A') and (aa <= 'Z') then - aa := chr(ord(aa) + (ord('a') - ord('A'))); - if (bb >= 'A') and (bb <= 'Z') then - bb := chr(ord(bb) + (ord('a') - ord('A'))); - result := ord(aa) - ord(bb); - if (result <> 0) or (aa = #0) then break; - inc(i); - inc(j) - end; - if result = 0 then - if a[i] <> #0 then result := 1 -end; - -function cmpExact(a, b: cstring; blen: int): int; -var - aa, bb: char; - i, j: int; -begin - i := 0; - j := 0; - result := 1; - while j < blen do begin - aa := a[i]; - bb := b[j]; - result := ord(aa) - ord(bb); - if (result <> 0) or (aa = #0) then break; - inc(i); - inc(j) - end; - if result = 0 then - if a[i] <> #0 then result := 1 -end; - -function getIdent(const identifier: string): PIdent; -begin - result := getIdent(pchar(identifier), length(identifier), - getNormalizedHash(identifier)) -end; - -function getIdent(const identifier: string; h: THash): PIdent; -begin - result := getIdent(pchar(identifier), length(identifier), h) -end; - -var - wordCounter: int = 1; - -function getIdent(identifier: cstring; len: int; h: THash): PIdent; -var - idx, i, id: int; - last: PIdent; -begin - idx := h and high(buckets); - result := buckets[idx]; - last := nil; - id := 0; - while result <> nil do begin - if cmpExact(pchar(result.s), identifier, len) = 0 then begin - if last <> nil then begin - // make access to last looked up identifier faster: - last.next := result.next; - result.next := buckets[idx]; - buckets[idx] := result - end; - exit - end - else if cmpIgnoreStyle(pchar(result.s), identifier, len) = 0 then begin - (*if (id <> 0) and (id <> result.id) then begin - result := buckets[idx]; - writeln('current id ', id); - for i := 0 to len-1 do write(identifier[i]); - writeln; - while result <> nil do begin - writeln(result.s, ' ', result.id); - result := result.next - end - end;*) - assert((id = 0) or (id = result.id)); - id := result.id - end; - last := result; - result := result.next - end; - // new ident: - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.h := h; - result.s := newString(len); - for i := strStart to len+StrStart-1 do - result.s[i] := identifier[i-StrStart]; - result.next := buckets[idx]; - buckets[idx] := result; - if id = 0 then begin - inc(wordCounter); - result.id := - wordCounter; - end - else - result.id := id -// writeln('new word ', result.s); -end; - -end. diff --git a/nim/importer.pas b/nim/importer.pas deleted file mode 100755 index a1ed579781..0000000000 --- a/nim/importer.pas +++ /dev/null @@ -1,180 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit importer; - -// This module implements the symbol importing mechanism. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, strutils, nos, - ast, astalgo, msgs, options, idents, rodread, lookups, semdata, passes; - -function evalImport(c: PContext; n: PNode): PNode; -function evalFrom(c: PContext; n: PNode): PNode; -procedure importAllSymbols(c: PContext; fromMod: PSym); - -function getModuleFile(n: PNode): string; - -implementation - -function findModule(const info: TLineInfo; const modulename: string): string; -// returns path to module -begin - result := options.FindFile(AddFileExt(modulename, nimExt)); - if result = '' then liMessage(info, errCannotOpenFile, modulename); -end; - -function getModuleFile(n: PNode): string; -begin - case n.kind of - nkStrLit, nkRStrLit, nkTripleStrLit: begin - result := findModule(n.info, UnixToNativePath(n.strVal)); - end; - nkIdent: begin - result := findModule(n.info, n.ident.s); - end; - nkSym: begin - result := findModule(n.info, n.sym.name.s); - end; - else begin - internalError(n.info, 'getModuleFile()'); - result := ''; - end - end -end; - -procedure rawImportSymbol(c: PContext; s: PSym); -var - check, copy, e: PSym; - j: int; - etyp: PType; // enumeration type - it: TIdentIter; -begin - // This does not handle stubs, because otherwise loading on demand would be - // basically pointless. So importing stubs is fine here! - copy := s; // do not copy symbols when importing! - // check if we have already a symbol of the same name: - check := StrTableGet(c.tab.stack[importTablePos], s.name); - if (check <> nil) and (check.id <> copy.id) then begin - if not (s.kind in OverloadableSyms) then begin - // s and check need to be qualified: - IntSetIncl(c.AmbiguousSymbols, copy.id); - IntSetIncl(c.AmbiguousSymbols, check.id); - end - end; - StrTableAdd(c.tab.stack[importTablePos], copy); - if s.kind = skType then begin - etyp := s.typ; - if etyp.kind in [tyBool, tyEnum] then begin - for j := 0 to sonsLen(etyp.n)-1 do begin - e := etyp.n.sons[j].sym; - if (e.Kind <> skEnumField) then - InternalError(s.info, 'rawImportSymbol'); - // BUGFIX: because of aliases for enums the symbol may already - // have been put into the symbol table - // BUGFIX: but only iff they are the same symbols! - check := InitIdentIter(it, c.tab.stack[importTablePos], e.name); - while check <> nil do begin - if check.id = e.id then begin e := nil; break end; - check := NextIdentIter(it, c.tab.stack[importTablePos]); - end; - if e <> nil then rawImportSymbol(c, e); - //check := StrTableGet(c.tab.stack[importTablePos], e.name); - //if (check = nil) or (check.id <> e.id) then - // rawImportSymbol(c, e) - end - end - end - else if s.kind = skConverter then - addConverter(c, s); // rodgen assures that converters are no stubs -end; - -procedure importSymbol(c: PContext; ident: PNode; fromMod: PSym); -var - s, e: PSym; - it: TIdentIter; -begin - if (ident.kind <> nkIdent) then InternalError(ident.info, 'importSymbol'); - s := StrTableGet(fromMod.tab, ident.ident); - if s = nil then - liMessage(ident.info, errUndeclaredIdentifier, ident.ident.s); - if s.kind = skStub then loadStub(s); - if not (s.Kind in ExportableSymKinds) then - InternalError(ident.info, 'importSymbol: 2'); - // for an enumeration we have to add all identifiers - case s.Kind of - skProc, skMethod, skIterator, skMacro, skTemplate, skConverter: begin - // for a overloadable syms add all overloaded routines - e := InitIdentIter(it, fromMod.tab, s.name); - while e <> nil do begin - if (e.name.id <> s.Name.id) then - InternalError(ident.info, 'importSymbol: 3'); - rawImportSymbol(c, e); - e := NextIdentIter(it, fromMod.tab); - end - end; - else rawImportSymbol(c, s) - end -end; - -procedure importAllSymbols(c: PContext; fromMod: PSym); -var - i: TTabIter; - s: PSym; -begin - s := InitTabIter(i, fromMod.tab); - while s <> nil do begin - if s.kind <> skModule then begin - if s.kind <> skEnumField then begin - if not (s.Kind in ExportableSymKinds) then - InternalError(s.info, 'importAllSymbols: ' + symKindToStr[s.kind]); - rawImportSymbol(c, s); // this is correct! - end - end; - s := NextIter(i, fromMod.tab) - end -end; - -function evalImport(c: PContext; n: PNode): PNode; -var - m: PSym; - i: int; - f: string; -begin - result := n; - for i := 0 to sonsLen(n)-1 do begin - f := getModuleFile(n.sons[i]); - m := gImportModule(f); - if sfDeprecated in m.flags then - liMessage(n.sons[i].info, warnDeprecated, m.name.s); - // ``addDecl`` needs to be done before ``importAllSymbols``! - addDecl(c, m); // add symbol to symbol table of module - importAllSymbols(c, m); - end; -end; - -function evalFrom(c: PContext; n: PNode): PNode; -var - m: PSym; - i: int; - f: string; -begin - result := n; - checkMinSonsLen(n, 2); - f := getModuleFile(n.sons[0]); - m := gImportModule(f); - n.sons[0] := newSymNode(m); - addDecl(c, m); // add symbol to symbol table of module - for i := 1 to sonsLen(n)-1 do importSymbol(c, n.sons[i], m); -end; - -end. diff --git a/nim/interact.pas b/nim/interact.pas deleted file mode 100755 index aab3c7fc2f..0000000000 --- a/nim/interact.pas +++ /dev/null @@ -1,22 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit interact; - -// This file implements interactive sessions. - -interface - -{$include 'config.inc'} - -uses - nsystem, llstream, strutils, charsets, ropes, nstrtabs, msgs; - -implementation - -end. diff --git a/nim/lexbase.pas b/nim/lexbase.pas deleted file mode 100755 index 2b056c04f1..0000000000 --- a/nim/lexbase.pas +++ /dev/null @@ -1,232 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit lexbase; - -// Base Object of a lexer with efficient buffer handling. In fact -// I believe that this is the most efficient method of buffer -// handling that exists! Only at line endings checks are necessary -// if the buffer needs refilling. - -interface - -uses - nsystem, llstream, charsets, strutils; - -{@emit -const - Lrz = ' '; - Apo = ''''; - Tabulator = #9; - ESC = #27; - CR = #13; - FF = #12; - LF = #10; - BEL = #7; - BACKSPACE = #8; - VT = #11; -} - -const - EndOfFile = #0; // end of file marker -{ A little picture makes everything clear :-) - buf: - "Example Text\n ha!" bufLen = 17 - ^pos = 0 ^ sentinel = 12 -} - NewLines = {@set}[CR, LF]; - -type - TBaseLexer = object(NObject) - bufpos: int; - buf: PChar; - bufLen: int; // length of buffer in characters - stream: PLLStream; // we read from this stream - LineNumber: int; // the current line number - // private data: - sentinel: int; - lineStart: int; // index of last line start in buffer - end; - -procedure openBaseLexer(out L: TBaseLexer; - inputstream: PLLStream; - bufLen: int = 8192); - // 8K is a reasonable buffer size - -procedure closeBaseLexer(var L: TBaseLexer); - -function getCurrentLine(const L: TBaseLexer; marker: boolean = true): string; -function getColNumber(const L: TBaseLexer; pos: int): int; - -function HandleCR(var L: TBaseLexer; pos: int): int; -// Call this if you scanned over CR in the buffer; it returns the -// position to continue the scanning from. `pos` must be the position -// of the CR. - -function HandleLF(var L: TBaseLexer; pos: int): int; -// Call this if you scanned over LF in the buffer; it returns the the -// position to continue the scanning from. `pos` must be the position -// of the LF. - -implementation - -const - chrSize = sizeof(char); - -procedure closeBaseLexer(var L: TBaseLexer); -begin - dealloc(L.buf); - LLStreamClose(L.stream); -end; - -{@ignore} -{$ifdef false} -procedure printBuffer(const L: TBaseLexer); -var - i: int; -begin - writeln('____________________________________'); - writeln('sentinel: ', L.sentinel); - writeln('bufLen: ', L.bufLen); - writeln('buf: '); - for i := 0 to L.bufLen-1 do write(L.buf[i]); - writeln(NL + '____________________________________'); -end; -{$endif} -{@emit} - -procedure FillBuffer(var L: TBaseLexer); -var - charsRead, toCopy, s: int; // all are in characters, - // not bytes (in case this - // is not the same) - oldBufLen: int; -begin - // we know here that pos == L.sentinel, but not if this proc - // is called the first time by initBaseLexer() - assert(L.sentinel < L.bufLen); - toCopy := L.BufLen - L.sentinel - 1; - assert(toCopy >= 0); - if toCopy > 0 then - MoveMem(L.buf, addr(L.buf[L.sentinel+1]), toCopy * chrSize); - // "moveMem" handles overlapping regions - charsRead := LLStreamRead(L.stream, addr(L.buf[toCopy]), - (L.sentinel+1) * chrSize) div chrSize; - s := toCopy + charsRead; - if charsRead < L.sentinel+1 then begin - L.buf[s] := EndOfFile; // set end marker - L.sentinel := s - end - else begin - // compute sentinel: - dec(s); // BUGFIX (valgrind) - while true do begin - assert(s < L.bufLen); - while (s >= 0) and not (L.buf[s] in NewLines) do Dec(s); - if s >= 0 then begin - // we found an appropriate character for a sentinel: - L.sentinel := s; - break - end - else begin - // rather than to give up here because the line is too long, - // double the buffer's size and try again: - oldBufLen := L.BufLen; - L.bufLen := L.BufLen * 2; - L.buf := {@cast}PChar(realloc(L.buf, L.bufLen*chrSize)); - assert(L.bufLen - oldBuflen = oldBufLen); - charsRead := LLStreamRead(L.stream, addr(L.buf[oldBufLen]), - oldBufLen*chrSize) div chrSize; - if charsRead < oldBufLen then begin - L.buf[oldBufLen+charsRead] := EndOfFile; - L.sentinel := oldBufLen+charsRead; - break - end; - s := L.bufLen - 1 - end - end - end -end; - -function fillBaseLexer(var L: TBaseLexer; pos: int): int; -begin - assert(pos <= L.sentinel); - if pos < L.sentinel then begin - result := pos+1; // nothing to do - end - else begin - fillBuffer(L); - L.bufpos := 0; // XXX: is this really correct? - result := 0; - end; - L.lineStart := result; -end; - -function HandleCR(var L: TBaseLexer; pos: int): int; -begin - assert(L.buf[pos] = CR); - inc(L.linenumber); - result := fillBaseLexer(L, pos); - if L.buf[result] = LF then begin - result := fillBaseLexer(L, result); - end; - //L.lastNL := result-1; // BUGFIX: was: result; -end; - -function HandleLF(var L: TBaseLexer; pos: int): int; -begin - assert(L.buf[pos] = LF); - inc(L.linenumber); - result := fillBaseLexer(L, pos); - //L.lastNL := result-1; // BUGFIX: was: result; -end; - -procedure skip_UTF_8_BOM(var L: TBaseLexer); -begin - if (L.buf[0] = #239) and (L.buf[1] = #187) and (L.buf[2] = #191) then begin - inc(L.bufpos, 3); - inc(L.lineStart, 3) - end -end; - -procedure openBaseLexer(out L: TBaseLexer; inputstream: PLLStream; - bufLen: int = 8192); -begin - assert(bufLen > 0); - L.bufpos := 0; - L.bufLen := bufLen; - L.buf := {@cast}PChar(alloc(bufLen * chrSize)); - L.sentinel := bufLen-1; - L.lineStart := 0; - L.linenumber := 1; // lines start at 1 - L.stream := inputstream; - fillBuffer(L); - skip_UTF_8_BOM(L); -end; - -function getColNumber(const L: TBaseLexer; pos: int): int; -begin - result := abs(pos - L.lineStart); -end; - -function getCurrentLine(const L: TBaseLexer; marker: boolean = true): string; -var - i: int; -begin - result := ''; - i := L.lineStart; - while not (L.buf[i] in [CR, LF, EndOfFile]) do begin - addChar(result, L.buf[i]); - inc(i) - end; - result := result +{&} NL; - if marker then - result := result +{&} RepeatChar(getColNumber(L, L.bufpos)) +{&} '^' +{&} NL -end; - -end. diff --git a/nim/lists.pas b/nim/lists.pas deleted file mode 100755 index e3442eb296..0000000000 --- a/nim/lists.pas +++ /dev/null @@ -1,165 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit lists; - -// This module implements a generic doubled linked list. - -interface - -{@ignore} -uses - nsystem; -{@emit} - -{$include 'config.inc'} - -type - PListEntry = ^TListEntry; - TListEntry = object(nobject) - prev, next: PListEntry; - end; - - TStrEntry = object(TListEntry) - data: string; - end; - PStrEntry = ^TStrEntry; - - TLinkedList = object - head, tail: PListEntry; - Counter: int; - end; - - // for the "find" operation: - TCompareProc = function (entry: PListEntry; closure: Pointer): Boolean; - -procedure InitLinkedList(var list: TLinkedList); -procedure Append(var list: TLinkedList; entry: PListEntry); -procedure Prepend(var list: TLinkedList; entry: PListEntry); -procedure Remove(var list: TLinkedList; entry: PListEntry); -procedure InsertBefore(var list: TLinkedList; pos, entry: PListEntry); - -function Find(const list: TLinkedList; fn: TCompareProc; - closure: Pointer): PListEntry; - -procedure AppendStr(var list: TLinkedList; const data: string); -function IncludeStr(var list: TLinkedList; const data: string): boolean; -procedure PrependStr(var list: TLinkedList; const data: string); - -implementation - -procedure InitLinkedList(var list: TLinkedList); -begin - list.Counter := 0; - list.head := nil; - list.tail := nil; -end; - -procedure Append(var list: TLinkedList; entry: PListEntry); -begin - Inc(list.counter); - entry.next := nil; - entry.prev := list.tail; - if list.tail <> nil then begin - assert(list.tail.next = nil); - list.tail.next := entry - end; - list.tail := entry; - if list.head = nil then - list.head := entry; -end; - -function newStrEntry(const data: string): PStrEntry; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.data := data -end; - -procedure AppendStr(var list: TLinkedList; const data: string); -begin - append(list, newStrEntry(data)); -end; - -procedure PrependStr(var list: TLinkedList; const data: string); -begin - prepend(list, newStrEntry(data)); -end; - -function IncludeStr(var list: TLinkedList; const data: string): boolean; -var - it: PListEntry; -begin - it := list.head; - while it <> nil do begin - if PStrEntry(it).data = data then begin - result := true; exit // already in list - end; - it := it.next; - end; - AppendStr(list, data); // else: add to list - result := false -end; - -procedure InsertBefore(var list: TLinkedList; pos, entry: PListEntry); -begin - assert(pos <> nil); - if pos = list.head then - prepend(list, entry) - else begin - Inc(list.counter); - entry.next := pos; - entry.prev := pos.prev; - if pos.prev <> nil then - pos.prev.next := entry; - pos.prev := entry; - end -end; - -procedure Prepend(var list: TLinkedList; entry: PListEntry); -begin - Inc(list.counter); - entry.prev := nil; - entry.next := list.head; - if list.head <> nil then begin - assert(list.head.prev = nil); - list.head.prev := entry - end; - list.head := entry; - if list.tail = nil then - list.tail := entry -end; - -procedure Remove(var list: TLinkedList; entry: PListEntry); -begin - Dec(list.counter); - if entry = list.tail then begin - list.tail := entry.prev - end; - if entry = list.head then begin - list.head := entry.next; - end; - if entry.next <> nil then - entry.next.prev := entry.prev; - if entry.prev <> nil then - entry.prev.next := entry.next; -end; - -function Find(const list: TLinkedList; fn: TCompareProc; - closure: Pointer): PListEntry; -begin - result := list.head; - while result <> nil do begin - if fn(result, closure) then exit; - result := result.next - end -end; - -end. diff --git a/nim/llstream.pas b/nim/llstream.pas deleted file mode 100755 index 30d9c02872..0000000000 --- a/nim/llstream.pas +++ /dev/null @@ -1,257 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit llstream; - -// Low-level streams for high performance. - -interface - -uses - nsystem, charsets, strutils; - -type - TLLStreamKind = ( - llsNone, // null stream: reading and writing has no effect - llsString, // stream encapsulates a string - llsFile, // stream encapsulates a file - llsStdIn); // stream encapsulates stdin - TLLStream = object(NObject) - kind: TLLStreamKind; // accessible for low-level access (lexbase uses this) - f: TBinaryFile; - s: string; - rd, wr: int; // for string streams - end; - PLLStream = ^TLLStream; - - -function LLStreamOpen(const data: string): PLLStream; overload; -function LLStreamOpen(var f: TBinaryFile): PLLStream; overload; -function LLStreamOpen(const filename: string; mode: TFileMode): PLLStream; overload; -function LLStreamOpen(): PLLStream; overload; -function LLStreamOpenStdIn(): PLLStream; - -procedure LLStreamClose(s: PLLStream); - -function LLStreamRead(s: PLLStream; buf: pointer; bufLen: int): int; -function LLStreamReadLine(s: PLLStream): string; -function LLStreamReadAll(s: PLLStream): string; - -procedure LLStreamWrite(s: PLLStream; const data: string); overload; -procedure LLStreamWrite(s: PLLStream; data: Char); overload; -procedure LLStreamWrite(s: PLLStream; buf: pointer; buflen: int); overload; - -procedure LLStreamWriteln(s: PLLStream; const data: string); - -function LLStreamAtEnd(s: PLLStream): bool; - -implementation - -function LLStreamOpen(const data: string): PLLStream; overload; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - result.s := data; - result.kind := llsString; -end; - -function LLStreamOpen(var f: TBinaryFile): PLLStream; overload; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - result.f := f; - result.kind := llsFile; -end; - -function LLStreamOpen(const filename: string; mode: TFileMode): PLLStream; overload; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - result.kind := llsFile; - if not OpenFile(result.f, filename, mode) then result := nil; -end; - -function LLStreamOpen(): PLLStream; overload; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - result.kind := llsNone; -end; - -function LLStreamOpenStdIn(): PLLStream; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - result.kind := llsStdIn; - result.s := ''; -end; - -procedure LLStreamClose(s: PLLStream); -begin - case s.kind of - llsNone, llsString, llsStdIn: begin end; - llsFile: nimCloseFile(s.f); - end -end; - -function LLreadFromStdin(s: PLLStream; buf: pointer; bufLen: int): int; -var - line: string; - L: int; -begin - s.s := ''; - s.rd := 0; - while true do begin - write(output, 'Nimrod> '); - line := readLine(input); - L := length(line); - add(s.s, line); - add(s.s, nl); - if (L > 0) and (line[L-1+strStart] = '#') then break; - end; - result := min(bufLen, length(s.s)-s.rd); - if result > 0 then begin - copyMem(buf, addr(s.s[strStart+s.rd]), result); - inc(s.rd, result) - end -end; - -function LLStreamRead(s: PLLStream; buf: pointer; bufLen: int): int; -begin - case s.kind of - llsNone: result := 0; - llsString: begin - result := min(bufLen, length(s.s)-s.rd); - if result > 0 then begin - copyMem(buf, addr(s.s[strStart+s.rd]), result); - inc(s.rd, result) - end - end; - llsFile: result := readBuffer(s.f, buf, bufLen); - llsStdIn: result := LLreadFromStdin(s, buf, bufLen); - end -end; - -function LLStreamReadLine(s: PLLStream): string; -begin - case s.kind of - llsNone: result := ''; - llsString: begin - result := ''; - while s.rd < length(s.s) do begin - case s.s[s.rd+strStart] of - #13: begin - inc(s.rd); - if s.s[s.rd+strStart] = #10 then inc(s.rd); - break - end; - #10: begin inc(s.rd); break end; - else begin - addChar(result, s.s[s.rd+strStart]); - inc(s.rd); - end - end - end - end; - llsFile: result := readLine(s.f); - llsStdIn: result := readLine(input); - end -end; - -function LLStreamAtEnd(s: PLLStream): bool; -begin - case s.kind of - llsNone: result := true; - llsString: result := s.rd >= length(s.s); - llsFile: result := endOfFile(s.f); - llsStdIn: result := false; - end -end; - -procedure LLStreamWrite(s: PLLStream; const data: string); overload; -begin - case s.kind of - llsNone, llsStdIn: begin end; - llsString: begin add(s.s, data); inc(s.wr, length(data)) end; - llsFile: nimWrite(s.f, data); - end; -end; - -procedure LLStreamWriteln(s: PLLStream; const data: string); -begin - LLStreamWrite(s, data); - LLStreamWrite(s, nl); -end; - -procedure LLStreamWrite(s: PLLStream; data: Char); overload; -var - c: char; -begin - case s.kind of - llsNone, llsStdIn: begin end; - llsString: begin addChar(s.s, data); inc(s.wr); end; - llsFile: begin - c := data; - {@discard} writeBuffer(s.f, addr(c), sizeof(c)); - end - end -end; - -procedure LLStreamWrite(s: PLLStream; buf: pointer; buflen: int); overload; -begin - case s.kind of - llsNone, llsStdIn: begin end; - llsString: begin - if bufLen > 0 then begin - setLength(s.s, length(s.s) + bufLen); - copyMem(addr(s.s[strStart+s.wr]), buf, bufLen); - inc(s.wr, bufLen); - end - end; - llsFile: {@discard} writeBuffer(s.f, buf, bufLen); - end -end; - -function LLStreamReadAll(s: PLLStream): string; -const - bufSize = 2048; -var - bytes, i: int; -begin - case s.kind of - llsNone, llsStdIn: result := ''; - llsString: begin - if s.rd = 0 then result := s.s - else result := ncopy(s.s, s.rd+strStart); - s.rd := length(s.s); - end; - llsFile: begin - result := newString(bufSize); - bytes := readBuffer(s.f, addr(result[strStart]), bufSize); - i := bytes; - while bytes = bufSize do begin - setLength(result, i+bufSize); - bytes := readBuffer(s.f, addr(result[i+strStart]), bufSize); - inc(i, bytes); - end; - setLength(result, i); - end - end -end; - -end. diff --git a/nim/llvmdata.pas b/nim/llvmdata.pas deleted file mode 100755 index a8ae0f311a..0000000000 --- a/nim/llvmdata.pas +++ /dev/null @@ -1,139 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit llvmdata; - -// this module implements data structures for emitting LLVM. - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, idents, lists, passes; - -type - VTypeKind = ( - VoidTyID, ///< 0: type with no size - FloatTyID, ///< 1: 32 bit floating point type - DoubleTyID, ///< 2: 64 bit floating point type - X86_FP80TyID, ///< 3: 80 bit floating point type (X87) - FP128TyID, ///< 4: 128 bit floating point type (112-bit mantissa) - PPC_FP128TyID, ///< 5: 128 bit floating point type (two 64-bits) - LabelTyID, ///< 6: Labels - MetadataTyID, ///< 7: Metadata - - // Derived types... see DerivedTypes.h file... - // Make sure FirstDerivedTyID stays up to date!!! - IntegerTyID, ///< 8: Arbitrary bit width integers - FunctionTyID, ///< 9: Functions - StructTyID, ///< 10: Structures - ArrayTyID, ///< 11: Arrays - PointerTyID, ///< 12: Pointers - OpaqueTyID, ///< 13: Opaque: type with unknown structure - VectorTyID, ///< 14: SIMD 'packed' format, or other vector type - ); - VType = ^VTypeDesc; - VTypeSeq = array of VType; - VTypeDesc = object(TIdObj) - k: VTypeKind; - s: VTypeSeq; - arrayLen: int; - name: string; - end; - - VInstrKind = ( - iNone, - iAdd, - iSub, - iMul, - iDiv, - iMod, - - ); - VLocalVar = record - - - end; - VInstr = record - k: VInstrKind; - - end; - -/// This represents a single basic block in LLVM. A basic block is simply a -/// container of instructions that execute sequentially. Basic blocks are Values -/// because they are referenced by instructions such as branches and switch -/// tables. The type of a BasicBlock is "Type::LabelTy" because the basic block -/// represents a label to which a branch can jump. -/// - VBlock = ^VBlockDesc; - VBlockDesc = record // LLVM basic block - // list of instructions - end; - - VLinkage = ( - ExternalLinkage, // Externally visible function - LinkOnceLinkage, // Keep one copy of function when linking (inline) - WeakLinkage, // Keep one copy of function when linking (weak) - AppendingLinkage, // Special purpose, only applies to global arrays - InternalLinkage, // Rename collisions when linking (static functions) - DLLImportLinkage, // Function to be imported from DLL - DLLExportLinkage, // Function to be accessible from DLL - ExternalWeakLinkage, // ExternalWeak linkage description - GhostLinkage // Stand-in functions for streaming fns from bitcode - ); - VVisibility = ( - DefaultVisibility, // The GV is visible - HiddenVisibility, // The GV is hidden - ProtectedVisibility // The GV is protected - ); - TLLVMCallConv = ( - CCallConv = 0, - FastCallConv = 8, - ColdCallConv = 9, - X86StdcallCallConv = 64, - X86FastcallCallConv = 65 - ); - - VProc = ^VProcDesc; - VProcDesc = record - b: VBlock; - name: string; - sym: PSym; // proc that is generated - linkage: VLinkage; - vis: VVisibility; - callConv: VCallConv; - next: VProc; - end; - VModule = ^VModuleDesc; - VModuleDesc = object(TPassContext) // represents a C source file - sym: PSym; - filename: string; - typeCache: TIdTable; // cache the generated types - forwTypeCache: TIdTable; // cache for forward declarations of types - declaredThings: TIntSet; // things we have declared in this file - declaredProtos: TIntSet; // prototypes we have declared in this file - headerFiles: TLinkedList; // needed headers to include - typeInfoMarker: TIntSet; // needed for generating type information - initProc: VProc; // code for init procedure - typeStack: TTypeSeq; // used for type generation - dataCache: TNodeTable; - forwardedProcs: TSymSeq; // keep forwarded procs here - typeNodes, nimTypes: int;// used for type info generation - typeNodesName, nimTypesName: PRope; // used for type info generation - labels: natural; // for generating unique module-scope names - next: VModule; // to stack modules - end; - - - -implementation - - -end. - diff --git a/nim/llvmdyn.pas b/nim/llvmdyn.pas deleted file mode 100755 index e039939e5a..0000000000 --- a/nim/llvmdyn.pas +++ /dev/null @@ -1,443 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit llvmdyn; - -// this module implements the interface to LLVM. - -interface - -{$include 'config.inc'} - -uses - nsystem; - -const - llvmdll = 'llvm.dll'; - -{ Opaque types. } -{ - The top-level container for all other LLVM Intermediate Representation (IR) - objects. See the llvm::Module class. -} -type - cuint = int32; - PLLVMBasicBlockRef = ^TLLVMBasicBlockRef; - PLLVMMemoryBufferRef = ^TLLVMMemoryBufferRef; - PLLVMTypeRef = ^TLLVMTypeRef; - PLLVMValueRef = ^TLLVMValueRef; - - TLLVMOpaqueModule = record end; - TLLVMModuleRef = ^TLLVMOpaqueModule; -{ - Each value in the LLVM IR has a type, an instance of [lltype]. See the - llvm: : Type class. -} - TLLVMOpaqueType = record end; - TLLVMTypeRef = ^TLLVMOpaqueType; -{ - When building recursive types using [refine_type], [lltype] values may become - invalid; use [lltypehandle] to resolve this problem. See the - llvm: : AbstractTypeHolder] class. -} - TLLVMOpaqueTypeHandle = record end; - TLLVMTypeHandleRef = ^TLLVMOpaqueTypeHandle; - TLLVMOpaqueValue = record end; - TLLVMValueRef = ^TLLVMOpaqueValue; - TLLVMOpaqueBasicBlock = record end; - TLLVMBasicBlockRef = ^TLLVMOpaqueBasicBlock; - - TLLVMOpaqueBuilder = record end; - TLLVMBuilderRef = ^TLLVMOpaqueBuilder; -{ Used to provide a module to JIT or interpreter. - See the llvm: : ModuleProvider class. -} - TLLVMOpaqueModuleProvider = record end; - TLLVMModuleProviderRef = ^TLLVMOpaqueModuleProvider; -{ Used to provide a module to JIT or interpreter. - See the llvm: : MemoryBuffer class. -} - TLLVMOpaqueMemoryBuffer = record end; - TLLVMMemoryBufferRef = ^TLLVMOpaqueMemoryBuffer; - - TLLVMTypeKind = ( - LLVMVoidTypeKind, // type with no size - LLVMFloatTypeKind, // 32 bit floating point type - LLVMDoubleTypeKind, // 64 bit floating point type - LLVMX86_FP80TypeKind, // 80 bit floating point type (X87) - LLVMFP128TypeKind, // 128 bit floating point type (112-bit mantissa) - LLVMPPC_FP128TypeKind, // 128 bit floating point type (two 64-bits) - LLVMLabelTypeKind, // Labels - LLVMIntegerTypeKind, // Arbitrary bit width integers - LLVMFunctionTypeKind, // Functions - LLVMStructTypeKind, // Structures - LLVMArrayTypeKind, // Arrays - LLVMPointerTypeKind, // Pointers - LLVMOpaqueTypeKind, // Opaque: type with unknown structure - LLVMVectorTypeKind // SIMD 'packed' format, or other vector type - ); - - TLLVMLinkage = ( - LLVMExternalLinkage, // Externally visible function - LLVMLinkOnceLinkage, // Keep one copy of function when linking (inline) - LLVMWeakLinkage, // Keep one copy of function when linking (weak) - LLVMAppendingLinkage, // Special purpose, only applies to global arrays - LLVMInternalLinkage, // Rename collisions when linking (static functions) - LLVMDLLImportLinkage, // Function to be imported from DLL - LLVMDLLExportLinkage, // Function to be accessible from DLL - LLVMExternalWeakLinkage, // ExternalWeak linkage description - LLVMGhostLinkage // Stand-in functions for streaming fns from bitcode - ); - - TLLVMVisibility = ( - LLVMDefaultVisibility, // The GV is visible - LLVMHiddenVisibility, // The GV is hidden - LLVMProtectedVisibility // The GV is protected - ); - - TLLVMCallConv = ( - LLVMCCallConv = 0, - LLVMFastCallConv = 8, - LLVMColdCallConv = 9, - LLVMX86StdcallCallConv = 64, - LLVMX86FastcallCallConv = 65 - ); - - TLLVMIntPredicate = ( - LLVMIntEQ = 32, // equal - LLVMIntNE, // not equal - LLVMIntUGT, // unsigned greater than - LLVMIntUGE, // unsigned greater or equal - LLVMIntULT, // unsigned less than - LLVMIntULE, // unsigned less or equal - LLVMIntSGT, // signed greater than - LLVMIntSGE, // signed greater or equal - LLVMIntSLT, // signed less than - LLVMIntSLE // signed less or equal - ); - - TLLVMRealPredicate = ( - LLVMRealPredicateFalse, // Always false (always folded) - LLVMRealOEQ, // True if ordered and equal - LLVMRealOGT, // True if ordered and greater than - LLVMRealOGE, // True if ordered and greater than or equal - LLVMRealOLT, // True if ordered and less than - LLVMRealOLE, // True if ordered and less than or equal - LLVMRealONE, // True if ordered and operands are unequal - LLVMRealORD, // True if ordered (no nans) - LLVMRealUNO, // True if unordered: isnan(X) | isnan(Y) - LLVMRealUEQ, // True if unordered or equal - LLVMRealUGT, // True if unordered or greater than - LLVMRealUGE, // True if unordered, greater than, or equal - LLVMRealULT, // True if unordered or less than - LLVMRealULE, // True if unordered, less than, or equal - LLVMRealUNE, // True if unordered or not equal - LLVMRealPredicateTrue // Always true (always folded) - ); - -{===-- Error handling ----------------------------------------------------=== } -procedure LLVMDisposeMessage(msg: pchar); cdecl; external llvmdll; -{===-- Modules -----------------------------------------------------------=== } -{ Create and destroy modules. } -function LLVMModuleCreateWithName(ModuleID: pchar): TLLVMModuleRef; cdecl; external llvmdll; -procedure LLVMDisposeModule(M: TLLVMModuleRef);cdecl;external llvmdll; -{ Data layout } -function LLVMGetDataLayout(M: TLLVMModuleRef): pchar;cdecl;external llvmdll; -procedure LLVMSetDataLayout(M: TLLVMModuleRef; Triple: pchar);cdecl;external llvmdll; -{ Target triple } -function LLVMGetTarget(M: TLLVMModuleRef): pchar;cdecl;external llvmdll; -(* Const before type ignored *) -procedure LLVMSetTarget(M: TLLVMModuleRef; Triple: pchar);cdecl;external llvmdll; -{ Same as Module: : addTypeName. } -function LLVMAddTypeName(M: TLLVMModuleRef; Name: pchar; Ty: TLLVMTypeRef): longint;cdecl;external llvmdll; -procedure LLVMDeleteTypeName(M: TLLVMModuleRef; Name: pchar);cdecl;external llvmdll; -{===-- Types -------------------------------------------------------------=== } -{ LLVM types conform to the following hierarchy: - * - * types: - * integer type - * real type - * function type - * sequence types: - * array type - * pointer type - * vector type - * void type - * label type - * opaque type - } -function LLVMGetTypeKind(Ty: TLLVMTypeRef): TLLVMTypeKind; cdecl; external llvmdll; -procedure LLVMRefineAbstractType(AbstractType: TLLVMTypeRef; ConcreteType: TLLVMTypeRef); cdecl; external llvmdll; -{ Operations on integer types } -function LLVMInt1Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMInt8Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMInt16Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMInt32Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMInt64Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMIntType(NumBits: cuint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMGetIntTypeWidth(IntegerTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -{ Operations on real types } -function LLVMFloatType: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMDoubleType: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMX86FP80Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMFP128Type: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMPPCFP128Type: TLLVMTypeRef;cdecl;external llvmdll; -{ Operations on function types } -function LLVMFunctionType(ReturnType: TLLVMTypeRef; ParamTypes: PLLVMTypeRef; ParamCount: cuint; IsVarArg: longint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMIsFunctionVarArg(FunctionTy: TLLVMTypeRef): longint;cdecl;external llvmdll; -function LLVMGetReturnType(FunctionTy: TLLVMTypeRef): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMCountParamTypes(FunctionTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -procedure LLVMGetParamTypes(FunctionTy: TLLVMTypeRef; Dest: PLLVMTypeRef);cdecl;external llvmdll; -{ Operations on struct types } -function LLVMStructType(ElementTypes: PLLVMTypeRef; ElementCount: cuint; isPacked: longint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMCountStructElementTypes(StructTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -procedure LLVMGetStructElementTypes(StructTy: TLLVMTypeRef; Dest: pLLVMTypeRef);cdecl;external llvmdll; -function LLVMIsPackedStruct(StructTy: TLLVMTypeRef): longint;cdecl;external llvmdll; -{ Operations on array, pointer, and vector types (sequence types) } -function LLVMArrayType(ElementType: TLLVMTypeRef; ElementCount: cuint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMPointerType(ElementType: TLLVMTypeRef; AddressSpace: cuint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMVectorType(ElementType: TLLVMTypeRef; ElementCount: cuint): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMGetElementType(Ty: TLLVMTypeRef): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMGetArrayLength(ArrayTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -function LLVMGetPointerAddressSpace(PointerTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -function LLVMGetVectorSize(VectorTy: TLLVMTypeRef): cuint;cdecl;external llvmdll; -{ Operations on other types } -function LLVMVoidType: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMLabelType: TLLVMTypeRef;cdecl;external llvmdll; -function LLVMOpaqueType: TLLVMTypeRef;cdecl;external llvmdll; -{ Operations on type handles } -function LLVMCreateTypeHandle(PotentiallyAbstractTy: TLLVMTypeRef): TLLVMTypeHandleRef;cdecl;external llvmdll; -procedure LLVMRefineType(AbstractTy: TLLVMTypeRef; ConcreteTy: TLLVMTypeRef);cdecl;external llvmdll; -function LLVMResolveTypeHandle(TypeHandle: TLLVMTypeHandleRef): TLLVMTypeRef;cdecl;external llvmdll; -procedure LLVMDisposeTypeHandle(TypeHandle: TLLVMTypeHandleRef);cdecl;external llvmdll; -{===-- Values ------------------------------------------------------------=== } -{ The bulk of LLVM's object model consists of values, which comprise a very - * rich type hierarchy. - * - * values: - * constants: - * scalar constants - * composite contants - * globals: - * global variable - * function - * alias - * basic blocks - } -{ Operations on all values } -function LLVMTypeOf(Val: TLLVMValueRef): TLLVMTypeRef;cdecl;external llvmdll; -function LLVMGetValueName(Val: TLLVMValueRef): pchar;cdecl;external llvmdll; -procedure LLVMSetValueName(Val: TLLVMValueRef; Name: pchar);cdecl;external llvmdll; -procedure LLVMDumpValue(Val: TLLVMValueRef);cdecl;external llvmdll; -{ Operations on constants of any type } -function LLVMConstNull(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -{ all zeroes } -function LLVMConstAllOnes(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -{ only for int/vector } -function LLVMGetUndef(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMIsConstant(Val: TLLVMValueRef): longint;cdecl;external llvmdll; -function LLVMIsNull(Val: TLLVMValueRef): longint;cdecl;external llvmdll; -function LLVMIsUndef(Val: TLLVMValueRef): longint;cdecl;external llvmdll; -{ Operations on scalar constants } -function LLVMConstInt(IntTy: TLLVMTypeRef; N: qword; SignExtend: longint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstReal(RealTy: TLLVMTypeRef; N: double): TLLVMValueRef;cdecl;external llvmdll; -{ Operations on composite constants } -function LLVMConstString(Str: pchar; Length: cuint; DontNullTerminate: longint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstArray(ArrayTy: TLLVMTypeRef; ConstantVals: pLLVMValueRef; Length: cuint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstStruct(ConstantVals: pLLVMValueRef; Count: cuint; ispacked: longint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstVector(ScalarConstantVals: pLLVMValueRef; Size: cuint): TLLVMValueRef;cdecl;external llvmdll; -{ Constant expressions } -function LLVMSizeOf(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstNeg(ConstantVal: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstNot(ConstantVal: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstAdd(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSub(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstMul(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstUDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstURem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSRem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFRem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstAnd(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstOr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstXor(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstICmp(Predicate: TLLVMIntPredicate; LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFCmp(Predicate: TLLVMRealPredicate; LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstShl(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstLShr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstAShr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstGEP(ConstantVal: TLLVMValueRef; ConstantIndices: PLLVMValueRef; NumIndices: cuint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstTrunc(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstZExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFPTrunc(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFPExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstUIToFP(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSIToFP(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFPToUI(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstFPToSI(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstPtrToInt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstIntToPtr(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstBitCast(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstSelect(ConstantCondition: TLLVMValueRef; ConstantIfTrue: TLLVMValueRef; ConstantIfFalse: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstExtractElement(VectorConstant: TLLVMValueRef; IndexConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstInsertElement(VectorConstant: TLLVMValueRef; ElementValueConstant: TLLVMValueRef; IndexConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMConstShuffleVector(VectorAConstant: TLLVMValueRef; VectorBConstant: TLLVMValueRef; MaskConstant: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -{ Operations on global variables, functions, and aliases (globals) } -function LLVMIsDeclaration(Global: TLLVMValueRef): longint;cdecl;external llvmdll; -function LLVMGetLinkage(Global: TLLVMValueRef): TLLVMLinkage;cdecl;external llvmdll; -procedure LLVMSetLinkage(Global: TLLVMValueRef; Linkage: TLLVMLinkage);cdecl;external llvmdll; -function LLVMGetSection(Global: TLLVMValueRef): pchar;cdecl;external llvmdll; -procedure LLVMSetSection(Global: TLLVMValueRef; Section: pchar);cdecl;external llvmdll; -function LLVMGetVisibility(Global: TLLVMValueRef): TLLVMVisibility;cdecl;external llvmdll; -procedure LLVMSetVisibility(Global: TLLVMValueRef; Viz: TLLVMVisibility);cdecl;external llvmdll; -function LLVMGetAlignment(Global: TLLVMValueRef): cuint;cdecl;external llvmdll; -procedure LLVMSetAlignment(Global: TLLVMValueRef; Bytes: cuint);cdecl;external llvmdll; -{ Operations on global variables } -(* Const before type ignored *) -function LLVMAddGlobal(M: TLLVMModuleRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMGetNamedGlobal(M: TLLVMModuleRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -procedure LLVMDeleteGlobal(GlobalVar: TLLVMValueRef);cdecl;external llvmdll; -function LLVMHasInitializer(GlobalVar: TLLVMValueRef): longint;cdecl;external llvmdll; -function LLVMGetInitializer(GlobalVar: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -procedure LLVMSetInitializer(GlobalVar: TLLVMValueRef; ConstantVal: TLLVMValueRef);cdecl;external llvmdll; -function LLVMIsThreadLocal(GlobalVar: TLLVMValueRef): longint;cdecl;external llvmdll; -procedure LLVMSetThreadLocal(GlobalVar: TLLVMValueRef; IsThreadLocal: longint);cdecl;external llvmdll; -function LLVMIsGlobalConstant(GlobalVar: TLLVMValueRef): longint;cdecl;external llvmdll; -procedure LLVMSetGlobalConstant(GlobalVar: TLLVMValueRef; IsConstant: longint);cdecl;external llvmdll; -{ Operations on functions } -(* Const before type ignored *) -function LLVMAddFunction(M: TLLVMModuleRef; Name: pchar; FunctionTy: TLLVMTypeRef): TLLVMValueRef;cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMGetNamedFunction(M: TLLVMModuleRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -procedure LLVMDeleteFunction(Fn: TLLVMValueRef);cdecl;external llvmdll; -function LLVMCountParams(Fn: TLLVMValueRef): cuint;cdecl;external llvmdll; -procedure LLVMGetParams(Fn: TLLVMValueRef; Params: PLLVMValueRef);cdecl;external llvmdll; -function LLVMGetParam(Fn: TLLVMValueRef; Index: cuint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMGetIntrinsicID(Fn: TLLVMValueRef): cuint;cdecl;external llvmdll; -function LLVMGetFunctionCallConv(Fn: TLLVMValueRef): cuint;cdecl;external llvmdll; -procedure LLVMSetFunctionCallConv(Fn: TLLVMValueRef; CC: cuint);cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMGetCollector(Fn: TLLVMValueRef): pchar;cdecl;external llvmdll; -(* Const before type ignored *) -procedure LLVMSetCollector(Fn: TLLVMValueRef; Coll: pchar);cdecl;external llvmdll; -{ Operations on basic blocks } -function LLVMBasicBlockAsValue(Bb: TLLVMBasicBlockRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMValueIsBasicBlock(Val: TLLVMValueRef): longint;cdecl;external llvmdll; -function LLVMValueAsBasicBlock(Val: TLLVMValueRef): TLLVMBasicBlockRef;cdecl;external llvmdll; -function LLVMCountBasicBlocks(Fn: TLLVMValueRef): cuint;cdecl;external llvmdll; -procedure LLVMGetBasicBlocks(Fn: TLLVMValueRef; BasicBlocks: PLLVMBasicBlockRef);cdecl;external llvmdll; -function LLVMGetEntryBasicBlock(Fn: TLLVMValueRef): TLLVMBasicBlockRef;cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMAppendBasicBlock(Fn: TLLVMValueRef; Name: pchar): TLLVMBasicBlockRef;cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMInsertBasicBlock(InsertBeforeBB: TLLVMBasicBlockRef; Name: pchar): TLLVMBasicBlockRef;cdecl;external llvmdll; -procedure LLVMDeleteBasicBlock(BB: TLLVMBasicBlockRef);cdecl;external llvmdll; -{ Operations on call sites } -procedure LLVMSetInstructionCallConv(Instr: TLLVMValueRef; CC: cuint);cdecl;external llvmdll; -function LLVMGetInstructionCallConv(Instr: TLLVMValueRef): cuint;cdecl;external llvmdll; -{ Operations on phi nodes } -procedure LLVMAddIncoming(PhiNode: TLLVMValueRef; IncomingValues: PLLVMValueRef; IncomingBlocks: PLLVMBasicBlockRef; Count: cuint);cdecl;external llvmdll; -function LLVMCountIncoming(PhiNode: TLLVMValueRef): cuint;cdecl;external llvmdll; -function LLVMGetIncomingValue(PhiNode: TLLVMValueRef; Index: cuint): TLLVMValueRef;cdecl;external llvmdll; -function LLVMGetIncomingBlock(PhiNode: TLLVMValueRef; Index: cuint): TLLVMBasicBlockRef;cdecl;external llvmdll; -{===-- Instruction builders ----------------------------------------------=== } -{ An instruction builder represents a point within a basic block, and is the - * exclusive means of building instructions using the C interface. - } -function LLVMCreateBuilder: TLLVMBuilderRef;cdecl;external llvmdll; -procedure LLVMPositionBuilderBefore(Builder: TLLVMBuilderRef; Instr: TLLVMValueRef);cdecl;external llvmdll; -procedure LLVMPositionBuilderAtEnd(Builder: TLLVMBuilderRef; theBlock: TLLVMBasicBlockRef);cdecl;external llvmdll; -procedure LLVMDisposeBuilder(Builder: TLLVMBuilderRef);cdecl;external llvmdll; -{ Terminators } -function LLVMBuildRetVoid(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildRet(para1: TLLVMBuilderRef; V: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildBr(para1: TLLVMBuilderRef; Dest: TLLVMBasicBlockRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildCondBr(para1: TLLVMBuilderRef; IfCond: TLLVMValueRef; ThenBranch: TLLVMBasicBlockRef; ElseBranch: TLLVMBasicBlockRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSwitch(para1: TLLVMBuilderRef; V: TLLVMValueRef; ElseBranch: TLLVMBasicBlockRef; NumCases: cuint): TLLVMValueRef;cdecl;external llvmdll; -(* Const before type ignored *) -function LLVMBuildInvoke(para1: TLLVMBuilderRef; Fn: TLLVMValueRef; Args: PLLVMValueRef; NumArgs: cuint; ThenBranch: TLLVMBasicBlockRef; - Catch: TLLVMBasicBlockRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildUnwind(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildUnreachable(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl;external llvmdll; -{ Add a case to the switch instruction } -procedure LLVMAddCase(Switch: TLLVMValueRef; OnVal: TLLVMValueRef; Dest: TLLVMBasicBlockRef);cdecl;external llvmdll; -{ Arithmetic } -function LLVMBuildAdd(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSub(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildMul(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildUDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildURem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSRem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFRem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildShl(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildLShr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildAShr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildAnd(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildOr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildXor(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildNeg(para1: TLLVMBuilderRef; V: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildNot(para1: TLLVMBuilderRef; V: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -{ Memory } -function LLVMBuildMalloc(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildArrayMalloc(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Val: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildAlloca(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildArrayAlloca(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Val: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFree(para1: TLLVMBuilderRef; PointerVal: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildLoad(para1: TLLVMBuilderRef; PointerVal: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildStore(para1: TLLVMBuilderRef; Val: TLLVMValueRef; thePtr: TLLVMValueRef): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildGEP(B: TLLVMBuilderRef; Pointer: TLLVMValueRef; Indices: PLLVMValueRef; NumIndices: cuint; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -{ Casts } -function LLVMBuildTrunc(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildZExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFPToUI(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFPToSI(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildUIToFP(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSIToFP(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFPTrunc(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFPExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildPtrToInt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildIntToPtr(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildBitCast(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -{ Comparisons } -function LLVMBuildICmp(para1: TLLVMBuilderRef; Op: TLLVMIntPredicate; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildFCmp(para1: TLLVMBuilderRef; Op: TLLVMRealPredicate; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -{ Miscellaneous instructions } -function LLVMBuildPhi(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildCall(para1: TLLVMBuilderRef; Fn: TLLVMValueRef; Args: PLLVMValueRef; NumArgs: cuint; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildSelect(para1: TLLVMBuilderRef; IfCond: TLLVMValueRef; ThenBranch: TLLVMValueRef; ElseBranch: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildVAArg(para1: TLLVMBuilderRef; List: TLLVMValueRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildExtractElement(para1: TLLVMBuilderRef; VecVal: TLLVMValueRef; Index: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildInsertElement(para1: TLLVMBuilderRef; VecVal: TLLVMValueRef; EltVal: TLLVMValueRef; Index: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -function LLVMBuildShuffleVector(para1: TLLVMBuilderRef; V1: TLLVMValueRef; V2: TLLVMValueRef; Mask: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl;external llvmdll; -{===-- Module providers --------------------------------------------------=== } -{ Encapsulates the module M in a module provider, taking ownership of the - module. - See the constructor llvm: : ExistingModuleProvider: : ExistingModuleProvider. -} -function LLVMCreateModuleProviderForExistingModule(M: TLLVMModuleRef): TLLVMModuleProviderRef;cdecl;external llvmdll; -{ Destroys the module provider MP as well as the contained module. - See the destructor llvm: : ModuleProvider: : ~ModuleProvider. -} -procedure LLVMDisposeModuleProvider(MP: TLLVMModuleProviderRef);cdecl;external llvmdll; -{===-- Memory buffers ----------------------------------------------------=== } -function LLVMCreateMemoryBufferWithContentsOfFile(Path: pchar; OutMemBuf: pLLVMMemoryBufferRef; var OutMessage: pchar): longint;cdecl;external llvmdll; -function LLVMCreateMemoryBufferWithSTDIN(OutMemBuf: pLLVMMemoryBufferRef; var OutMessage: pchar): longint;cdecl;external llvmdll; -procedure LLVMDisposeMemoryBuffer(MemBuf: TLLVMMemoryBufferRef);cdecl;external llvmdll; - -function LLVMWriteBitcodeToFile(M: TLLVMModuleRef; path: pchar): int; cdecl; external llvmdll; -// Writes a module to the specified path. Returns 0 on success. - -implementation - -end. diff --git a/nim/llvmstat.pas b/nim/llvmstat.pas deleted file mode 100755 index e7d06a284d..0000000000 --- a/nim/llvmstat.pas +++ /dev/null @@ -1,445 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit llvmstat; - -// this module implements the interface to LLVM. - -interface - -{$include 'config.inc'} - -uses - nsystem, ropes; - -{ Opaque types. } -{ - The top-level container for all other LLVM Intermediate Representation (IR) - objects. See the llvm::Module class. -} -type - cuint = int32; - - TLLVMTypeKind = ( - LLVMVoidTypeKind, // type with no size - LLVMFloatTypeKind, // 32 bit floating point type - LLVMDoubleTypeKind, // 64 bit floating point type - LLVMX86_FP80TypeKind, // 80 bit floating point type (X87) - LLVMFP128TypeKind, // 128 bit floating point type (112-bit mantissa) - LLVMPPC_FP128TypeKind, // 128 bit floating point type (two 64-bits) - LLVMLabelTypeKind, // Labels - LLVMIntegerTypeKind, // Arbitrary bit width integers - LLVMFunctionTypeKind, // Functions - LLVMStructTypeKind, // Structures - LLVMArrayTypeKind, // Arrays - LLVMPointerTypeKind, // Pointers - LLVMOpaqueTypeKind, // Opaque: type with unknown structure - LLVMVectorTypeKind // SIMD 'packed' format, or other vector type - ); - - TLLVMLinkage = ( - LLVMExternalLinkage, // Externally visible function - LLVMLinkOnceLinkage, // Keep one copy of function when linking (inline) - LLVMWeakLinkage, // Keep one copy of function when linking (weak) - LLVMAppendingLinkage, // Special purpose, only applies to global arrays - LLVMInternalLinkage, // Rename collisions when linking (static functions) - LLVMDLLImportLinkage, // Function to be imported from DLL - LLVMDLLExportLinkage, // Function to be accessible from DLL - LLVMExternalWeakLinkage, // ExternalWeak linkage description - LLVMGhostLinkage // Stand-in functions for streaming fns from bitcode - ); - - TLLVMVisibility = ( - LLVMDefaultVisibility, // The GV is visible - LLVMHiddenVisibility, // The GV is hidden - LLVMProtectedVisibility // The GV is protected - ); - - TLLVMCallConv = ( - LLVMCCallConv = 0, - LLVMFastCallConv = 8, - LLVMColdCallConv = 9, - LLVMX86StdcallCallConv = 64, - LLVMX86FastcallCallConv = 65 - ); - - TLLVMIntPredicate = ( - LLVMIntEQ = 32, // equal - LLVMIntNE, // not equal - LLVMIntUGT, // unsigned greater than - LLVMIntUGE, // unsigned greater or equal - LLVMIntULT, // unsigned less than - LLVMIntULE, // unsigned less or equal - LLVMIntSGT, // signed greater than - LLVMIntSGE, // signed greater or equal - LLVMIntSLT, // signed less than - LLVMIntSLE // signed less or equal - ); - - TLLVMRealPredicate = ( - LLVMRealPredicateFalse, // Always false (always folded) - LLVMRealOEQ, // True if ordered and equal - LLVMRealOGT, // True if ordered and greater than - LLVMRealOGE, // True if ordered and greater than or equal - LLVMRealOLT, // True if ordered and less than - LLVMRealOLE, // True if ordered and less than or equal - LLVMRealONE, // True if ordered and operands are unequal - LLVMRealORD, // True if ordered (no nans) - LLVMRealUNO, // True if unordered: isnan(X) | isnan(Y) - LLVMRealUEQ, // True if unordered or equal - LLVMRealUGT, // True if unordered or greater than - LLVMRealUGE, // True if unordered, greater than, or equal - LLVMRealULT, // True if unordered or less than - LLVMRealULE, // True if unordered, less than, or equal - LLVMRealUNE, // True if unordered or not equal - LLVMRealPredicateTrue // Always true (always folded) - ); - - PLLVMBasicBlockRef = ^TLLVMBasicBlockRef; - PLLVMMemoryBufferRef = ^TLLVMMemoryBufferRef; - PLLVMTypeRef = ^TLLVMTypeRef; - PLLVMValueRef = ^TLLVMValueRef; - - TLLVMOpaqueModule = record - code: PRope; - end; - TLLVMModuleRef = ^TLLVMOpaqueModule; -{ - Each value in the LLVM IR has a type, an instance of [lltype]. See the - llvm::Type class. -} - TLLVMOpaqueType = record - kind: TLLVMTypeKind; - - end; - TLLVMTypeRef = ^TLLVMOpaqueType; -{ - When building recursive types using [refine_type], [lltype] values may become - invalid; use [lltypehandle] to resolve this problem. See the - llvm::AbstractTypeHolder] class. -} - TLLVMOpaqueTypeHandle = record end; - TLLVMTypeHandleRef = ^TLLVMOpaqueTypeHandle; - TLLVMOpaqueValue = record end; - TLLVMValueRef = ^TLLVMOpaqueValue; - TLLVMOpaqueBasicBlock = record end; - TLLVMBasicBlockRef = ^TLLVMOpaqueBasicBlock; - - TLLVMOpaqueBuilder = record end; - TLLVMBuilderRef = ^TLLVMOpaqueBuilder; -{ Used to provide a module to JIT or interpreter. - See the llvm::ModuleProvider class. -} - TLLVMOpaqueModuleProvider = record end; - TLLVMModuleProviderRef = ^TLLVMOpaqueModuleProvider; -{ Used to provide a module to JIT or interpreter. - See the llvm: : MemoryBuffer class. -} - TLLVMOpaqueMemoryBuffer = record end; - TLLVMMemoryBufferRef = ^TLLVMOpaqueMemoryBuffer; - -{===-- Error handling ----------------------------------------------------=== } -procedure LLVMDisposeMessage(msg: pchar); cdecl; -{===-- Modules -----------------------------------------------------------=== } -{ Create and destroy modules. } -function LLVMModuleCreateWithName(ModuleID: pchar): TLLVMModuleRef; cdecl; -procedure LLVMDisposeModule(M: TLLVMModuleRef);cdecl; -{ Data layout } -function LLVMGetDataLayout(M: TLLVMModuleRef): pchar;cdecl; -procedure LLVMSetDataLayout(M: TLLVMModuleRef; Triple: pchar);cdecl; -{ Target triple } -function LLVMGetTarget(M: TLLVMModuleRef): pchar;cdecl; -procedure LLVMSetTarget(M: TLLVMModuleRef; Triple: pchar);cdecl; -{ Same as Module: : addTypeName. } -function LLVMAddTypeName(M: TLLVMModuleRef; Name: pchar; Ty: TLLVMTypeRef): longint;cdecl; -procedure LLVMDeleteTypeName(M: TLLVMModuleRef; Name: pchar);cdecl; -{===-- Types -------------------------------------------------------------=== } -{ LLVM types conform to the following hierarchy: - * - * types: - * integer type - * real type - * function type - * sequence types: - * array type - * pointer type - * vector type - * void type - * label type - * opaque type - } -function LLVMGetTypeKind(Ty: TLLVMTypeRef): TLLVMTypeKind; cdecl; -procedure LLVMRefineAbstractType(AbstractType: TLLVMTypeRef; ConcreteType: TLLVMTypeRef); cdecl; -{ Operations on integer types } -function LLVMInt1Type: TLLVMTypeRef;cdecl; -function LLVMInt8Type: TLLVMTypeRef;cdecl; -function LLVMInt16Type: TLLVMTypeRef;cdecl; -function LLVMInt32Type: TLLVMTypeRef;cdecl; -function LLVMInt64Type: TLLVMTypeRef;cdecl; -function LLVMIntType(NumBits: cuint): TLLVMTypeRef;cdecl; -function LLVMGetIntTypeWidth(IntegerTy: TLLVMTypeRef): cuint;cdecl; -{ Operations on real types } -function LLVMFloatType: TLLVMTypeRef;cdecl; -function LLVMDoubleType: TLLVMTypeRef;cdecl; -function LLVMX86FP80Type: TLLVMTypeRef;cdecl; -function LLVMFP128Type: TLLVMTypeRef;cdecl; -function LLVMPPCFP128Type: TLLVMTypeRef;cdecl; -{ Operations on function types } -function LLVMFunctionType(ReturnType: TLLVMTypeRef; ParamTypes: PLLVMTypeRef; ParamCount: cuint; IsVarArg: longint): TLLVMTypeRef;cdecl; -function LLVMIsFunctionVarArg(FunctionTy: TLLVMTypeRef): longint;cdecl; -function LLVMGetReturnType(FunctionTy: TLLVMTypeRef): TLLVMTypeRef;cdecl; -function LLVMCountParamTypes(FunctionTy: TLLVMTypeRef): cuint;cdecl; -procedure LLVMGetParamTypes(FunctionTy: TLLVMTypeRef; Dest: PLLVMTypeRef);cdecl; -{ Operations on struct types } -function LLVMStructType(ElementTypes: PLLVMTypeRef; ElementCount: cuint; isPacked: longint): TLLVMTypeRef;cdecl; -function LLVMCountStructElementTypes(StructTy: TLLVMTypeRef): cuint;cdecl; -procedure LLVMGetStructElementTypes(StructTy: TLLVMTypeRef; Dest: pLLVMTypeRef);cdecl; -function LLVMIsPackedStruct(StructTy: TLLVMTypeRef): longint;cdecl; -{ Operations on array, pointer, and vector types (sequence types) } -function LLVMArrayType(ElementType: TLLVMTypeRef; ElementCount: cuint): TLLVMTypeRef;cdecl; -function LLVMPointerType(ElementType: TLLVMTypeRef; AddressSpace: cuint): TLLVMTypeRef;cdecl; -function LLVMVectorType(ElementType: TLLVMTypeRef; ElementCount: cuint): TLLVMTypeRef;cdecl; -function LLVMGetElementType(Ty: TLLVMTypeRef): TLLVMTypeRef;cdecl; -function LLVMGetArrayLength(ArrayTy: TLLVMTypeRef): cuint;cdecl; -function LLVMGetPointerAddressSpace(PointerTy: TLLVMTypeRef): cuint;cdecl; -function LLVMGetVectorSize(VectorTy: TLLVMTypeRef): cuint;cdecl; -{ Operations on other types } -function LLVMVoidType: TLLVMTypeRef;cdecl; -function LLVMLabelType: TLLVMTypeRef;cdecl; -function LLVMOpaqueType: TLLVMTypeRef;cdecl; -{ Operations on type handles } -function LLVMCreateTypeHandle(PotentiallyAbstractTy: TLLVMTypeRef): TLLVMTypeHandleRef;cdecl; -procedure LLVMRefineType(AbstractTy: TLLVMTypeRef; ConcreteTy: TLLVMTypeRef);cdecl; -function LLVMResolveTypeHandle(TypeHandle: TLLVMTypeHandleRef): TLLVMTypeRef;cdecl; -procedure LLVMDisposeTypeHandle(TypeHandle: TLLVMTypeHandleRef);cdecl; -{===-- Values ------------------------------------------------------------=== } -{ The bulk of LLVM's object model consists of values, which comprise a very - * rich type hierarchy. - * - * values: - * constants: - * scalar constants - * composite contants - * globals: - * global variable - * function - * alias - * basic blocks - } -{ Operations on all values } -function LLVMTypeOf(Val: TLLVMValueRef): TLLVMTypeRef;cdecl; -function LLVMGetValueName(Val: TLLVMValueRef): pchar;cdecl; -procedure LLVMSetValueName(Val: TLLVMValueRef; Name: pchar);cdecl; -procedure LLVMDumpValue(Val: TLLVMValueRef);cdecl; -{ Operations on constants of any type } -function LLVMConstNull(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl; -{ all zeroes } -function LLVMConstAllOnes(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl; -{ only for int/vector } -function LLVMGetUndef(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMIsConstant(Val: TLLVMValueRef): longint;cdecl; -function LLVMIsNull(Val: TLLVMValueRef): longint;cdecl; -function LLVMIsUndef(Val: TLLVMValueRef): longint;cdecl; -{ Operations on scalar constants } -function LLVMConstInt(IntTy: TLLVMTypeRef; N: qword; SignExtend: longint): TLLVMValueRef;cdecl; -function LLVMConstReal(RealTy: TLLVMTypeRef; N: double): TLLVMValueRef;cdecl; -{ Operations on composite constants } -function LLVMConstString(Str: pchar; Length: cuint; DontNullTerminate: longint): TLLVMValueRef;cdecl; -function LLVMConstArray(ArrayTy: TLLVMTypeRef; ConstantVals: pLLVMValueRef; Length: cuint): TLLVMValueRef;cdecl; -function LLVMConstStruct(ConstantVals: pLLVMValueRef; Count: cuint; ispacked: longint): TLLVMValueRef;cdecl; -function LLVMConstVector(ScalarConstantVals: pLLVMValueRef; Size: cuint): TLLVMValueRef;cdecl; -{ Constant expressions } -function LLVMSizeOf(Ty: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstNeg(ConstantVal: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstNot(ConstantVal: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstAdd(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstSub(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstMul(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstUDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstSDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstFDiv(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstURem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstSRem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstFRem(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstAnd(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstOr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstXor(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstICmp(Predicate: TLLVMIntPredicate; LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstFCmp(Predicate: TLLVMRealPredicate; LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstShl(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstLShr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstAShr(LHSConstant: TLLVMValueRef; RHSConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstGEP(ConstantVal: TLLVMValueRef; ConstantIndices: PLLVMValueRef; NumIndices: cuint): TLLVMValueRef;cdecl; -function LLVMConstTrunc(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstSExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstZExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstFPTrunc(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstFPExt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstUIToFP(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstSIToFP(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstFPToUI(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstFPToSI(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstPtrToInt(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstIntToPtr(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstBitCast(ConstantVal: TLLVMValueRef; ToType: TLLVMTypeRef): TLLVMValueRef;cdecl; -function LLVMConstSelect(ConstantCondition: TLLVMValueRef; ConstantIfTrue: TLLVMValueRef; ConstantIfFalse: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstExtractElement(VectorConstant: TLLVMValueRef; IndexConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstInsertElement(VectorConstant: TLLVMValueRef; ElementValueConstant: TLLVMValueRef; IndexConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMConstShuffleVector(VectorAConstant: TLLVMValueRef; VectorBConstant: TLLVMValueRef; MaskConstant: TLLVMValueRef): TLLVMValueRef;cdecl; -{ Operations on global variables, functions, and aliases (globals) } -function LLVMIsDeclaration(Global: TLLVMValueRef): longint;cdecl; -function LLVMGetLinkage(Global: TLLVMValueRef): TLLVMLinkage;cdecl; -procedure LLVMSetLinkage(Global: TLLVMValueRef; Linkage: TLLVMLinkage);cdecl; -function LLVMGetSection(Global: TLLVMValueRef): pchar;cdecl; -procedure LLVMSetSection(Global: TLLVMValueRef; Section: pchar);cdecl; -function LLVMGetVisibility(Global: TLLVMValueRef): TLLVMVisibility;cdecl; -procedure LLVMSetVisibility(Global: TLLVMValueRef; Viz: TLLVMVisibility);cdecl; -function LLVMGetAlignment(Global: TLLVMValueRef): cuint;cdecl; -procedure LLVMSetAlignment(Global: TLLVMValueRef; Bytes: cuint);cdecl; -{ Operations on global variables } -(* Const before type ignored *) -function LLVMAddGlobal(M: TLLVMModuleRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -(* Const before type ignored *) -function LLVMGetNamedGlobal(M: TLLVMModuleRef; Name: pchar): TLLVMValueRef;cdecl; -procedure LLVMDeleteGlobal(GlobalVar: TLLVMValueRef);cdecl; -function LLVMHasInitializer(GlobalVar: TLLVMValueRef): longint;cdecl; -function LLVMGetInitializer(GlobalVar: TLLVMValueRef): TLLVMValueRef;cdecl; -procedure LLVMSetInitializer(GlobalVar: TLLVMValueRef; ConstantVal: TLLVMValueRef);cdecl; -function LLVMIsThreadLocal(GlobalVar: TLLVMValueRef): longint;cdecl; -procedure LLVMSetThreadLocal(GlobalVar: TLLVMValueRef; IsThreadLocal: longint);cdecl; -function LLVMIsGlobalConstant(GlobalVar: TLLVMValueRef): longint;cdecl; -procedure LLVMSetGlobalConstant(GlobalVar: TLLVMValueRef; IsConstant: longint);cdecl; -{ Operations on functions } -(* Const before type ignored *) -function LLVMAddFunction(M: TLLVMModuleRef; Name: pchar; FunctionTy: TLLVMTypeRef): TLLVMValueRef;cdecl; -(* Const before type ignored *) -function LLVMGetNamedFunction(M: TLLVMModuleRef; Name: pchar): TLLVMValueRef;cdecl; -procedure LLVMDeleteFunction(Fn: TLLVMValueRef);cdecl; -function LLVMCountParams(Fn: TLLVMValueRef): cuint;cdecl; -procedure LLVMGetParams(Fn: TLLVMValueRef; Params: PLLVMValueRef);cdecl; -function LLVMGetParam(Fn: TLLVMValueRef; Index: cuint): TLLVMValueRef;cdecl; -function LLVMGetIntrinsicID(Fn: TLLVMValueRef): cuint;cdecl; -function LLVMGetFunctionCallConv(Fn: TLLVMValueRef): cuint;cdecl; -procedure LLVMSetFunctionCallConv(Fn: TLLVMValueRef; CC: cuint);cdecl; -(* Const before type ignored *) -function LLVMGetCollector(Fn: TLLVMValueRef): pchar;cdecl; -(* Const before type ignored *) -procedure LLVMSetCollector(Fn: TLLVMValueRef; Coll: pchar);cdecl; -{ Operations on basic blocks } -function LLVMBasicBlockAsValue(Bb: TLLVMBasicBlockRef): TLLVMValueRef;cdecl; -function LLVMValueIsBasicBlock(Val: TLLVMValueRef): longint;cdecl; -function LLVMValueAsBasicBlock(Val: TLLVMValueRef): TLLVMBasicBlockRef;cdecl; -function LLVMCountBasicBlocks(Fn: TLLVMValueRef): cuint;cdecl; -procedure LLVMGetBasicBlocks(Fn: TLLVMValueRef; BasicBlocks: PLLVMBasicBlockRef);cdecl; -function LLVMGetEntryBasicBlock(Fn: TLLVMValueRef): TLLVMBasicBlockRef;cdecl; -(* Const before type ignored *) -function LLVMAppendBasicBlock(Fn: TLLVMValueRef; Name: pchar): TLLVMBasicBlockRef;cdecl; -(* Const before type ignored *) -function LLVMInsertBasicBlock(InsertBeforeBB: TLLVMBasicBlockRef; Name: pchar): TLLVMBasicBlockRef;cdecl; -procedure LLVMDeleteBasicBlock(BB: TLLVMBasicBlockRef);cdecl; -{ Operations on call sites } -procedure LLVMSetInstructionCallConv(Instr: TLLVMValueRef; CC: cuint);cdecl; -function LLVMGetInstructionCallConv(Instr: TLLVMValueRef): cuint;cdecl; -{ Operations on phi nodes } -procedure LLVMAddIncoming(PhiNode: TLLVMValueRef; IncomingValues: PLLVMValueRef; IncomingBlocks: PLLVMBasicBlockRef; Count: cuint);cdecl; -function LLVMCountIncoming(PhiNode: TLLVMValueRef): cuint;cdecl; -function LLVMGetIncomingValue(PhiNode: TLLVMValueRef; Index: cuint): TLLVMValueRef;cdecl; -function LLVMGetIncomingBlock(PhiNode: TLLVMValueRef; Index: cuint): TLLVMBasicBlockRef;cdecl; -{===-- Instruction builders ----------------------------------------------=== } -{ An instruction builder represents a point within a basic block, and is the - * exclusive means of building instructions using the C interface. - } -function LLVMCreateBuilder: TLLVMBuilderRef;cdecl; -procedure LLVMPositionBuilderBefore(Builder: TLLVMBuilderRef; Instr: TLLVMValueRef);cdecl; -procedure LLVMPositionBuilderAtEnd(Builder: TLLVMBuilderRef; theBlock: TLLVMBasicBlockRef);cdecl; -procedure LLVMDisposeBuilder(Builder: TLLVMBuilderRef);cdecl; -{ Terminators } -function LLVMBuildRetVoid(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl; -function LLVMBuildRet(para1: TLLVMBuilderRef; V: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMBuildBr(para1: TLLVMBuilderRef; Dest: TLLVMBasicBlockRef): TLLVMValueRef;cdecl; -function LLVMBuildCondBr(para1: TLLVMBuilderRef; IfCond: TLLVMValueRef; ThenBranch: TLLVMBasicBlockRef; ElseBranch: TLLVMBasicBlockRef): TLLVMValueRef;cdecl; -function LLVMBuildSwitch(para1: TLLVMBuilderRef; V: TLLVMValueRef; ElseBranch: TLLVMBasicBlockRef; NumCases: cuint): TLLVMValueRef;cdecl; -(* Const before type ignored *) -function LLVMBuildInvoke(para1: TLLVMBuilderRef; Fn: TLLVMValueRef; Args: PLLVMValueRef; NumArgs: cuint; ThenBranch: TLLVMBasicBlockRef; - Catch: TLLVMBasicBlockRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildUnwind(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl; -function LLVMBuildUnreachable(para1: TLLVMBuilderRef): TLLVMValueRef;cdecl; -{ Add a case to the switch instruction } -procedure LLVMAddCase(Switch: TLLVMValueRef; OnVal: TLLVMValueRef; Dest: TLLVMBasicBlockRef);cdecl; -{ Arithmetic } -function LLVMBuildAdd(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSub(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildMul(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildUDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFDiv(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildURem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSRem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFRem(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildShl(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildLShr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildAShr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildAnd(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildOr(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildXor(para1: TLLVMBuilderRef; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildNeg(para1: TLLVMBuilderRef; V: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildNot(para1: TLLVMBuilderRef; V: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -{ Memory } -function LLVMBuildMalloc(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildArrayMalloc(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Val: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildAlloca(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildArrayAlloca(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Val: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFree(para1: TLLVMBuilderRef; PointerVal: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMBuildLoad(para1: TLLVMBuilderRef; PointerVal: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildStore(para1: TLLVMBuilderRef; Val: TLLVMValueRef; thePtr: TLLVMValueRef): TLLVMValueRef;cdecl; -function LLVMBuildGEP(B: TLLVMBuilderRef; Pointer: TLLVMValueRef; Indices: PLLVMValueRef; NumIndices: cuint; Name: pchar): TLLVMValueRef;cdecl; -{ Casts } -function LLVMBuildTrunc(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildZExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFPToUI(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFPToSI(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildUIToFP(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSIToFP(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFPTrunc(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFPExt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildPtrToInt(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildIntToPtr(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildBitCast(para1: TLLVMBuilderRef; Val: TLLVMValueRef; DestTy: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -{ Comparisons } -function LLVMBuildICmp(para1: TLLVMBuilderRef; Op: TLLVMIntPredicate; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildFCmp(para1: TLLVMBuilderRef; Op: TLLVMRealPredicate; LHS: TLLVMValueRef; RHS: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -{ Miscellaneous instructions } -function LLVMBuildPhi(para1: TLLVMBuilderRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildCall(para1: TLLVMBuilderRef; Fn: TLLVMValueRef; Args: PLLVMValueRef; NumArgs: cuint; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildSelect(para1: TLLVMBuilderRef; IfCond: TLLVMValueRef; ThenBranch: TLLVMValueRef; ElseBranch: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildVAArg(para1: TLLVMBuilderRef; List: TLLVMValueRef; Ty: TLLVMTypeRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildExtractElement(para1: TLLVMBuilderRef; VecVal: TLLVMValueRef; Index: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildInsertElement(para1: TLLVMBuilderRef; VecVal: TLLVMValueRef; EltVal: TLLVMValueRef; Index: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -function LLVMBuildShuffleVector(para1: TLLVMBuilderRef; V1: TLLVMValueRef; V2: TLLVMValueRef; Mask: TLLVMValueRef; Name: pchar): TLLVMValueRef;cdecl; -{===-- Module providers --------------------------------------------------=== } -{ Encapsulates the module M in a module provider, taking ownership of the - module. - See the constructor llvm: : ExistingModuleProvider: : ExistingModuleProvider. -} -function LLVMCreateModuleProviderForExistingModule(M: TLLVMModuleRef): TLLVMModuleProviderRef;cdecl; -{ Destroys the module provider MP as well as the contained module. - See the destructor llvm: : ModuleProvider: : ~ModuleProvider. -} -procedure LLVMDisposeModuleProvider(MP: TLLVMModuleProviderRef);cdecl; -{===-- Memory buffers ----------------------------------------------------=== } -function LLVMCreateMemoryBufferWithContentsOfFile(Path: pchar; OutMemBuf: pLLVMMemoryBufferRef; var OutMessage: pchar): longint;cdecl; -function LLVMCreateMemoryBufferWithSTDIN(OutMemBuf: pLLVMMemoryBufferRef; var OutMessage: pchar): longint;cdecl; -procedure LLVMDisposeMemoryBuffer(MemBuf: TLLVMMemoryBufferRef);cdecl; - -function LLVMWriteBitcodeToFile(M: TLLVMModuleRef; path: pchar): int; cdecl; -// Writes a module to the specified path. Returns 0 on success. - -implementation - -end. diff --git a/nim/lookups.pas b/nim/lookups.pas deleted file mode 100755 index e4c07224f5..0000000000 --- a/nim/lookups.pas +++ /dev/null @@ -1,307 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit lookups; - -// This module implements lookup helpers. - -interface - -uses - nsystem, ast, astalgo, idents, semdata, types, msgs, options, rodread, - rnimsyn; - -{$include 'config.inc'} - -type - TOverloadIterMode = (oimDone, oimNoQualifier, oimSelfModule, oimOtherModule, - oimSymChoice); - TOverloadIter = record - stackPtr: int; - it: TIdentIter; - m: PSym; - mode: TOverloadIterMode; - end; - -function getSymRepr(s: PSym): string; - -procedure CloseScope(var tab: TSymTab); - -procedure AddSym(var t: TStrTable; n: PSym); - -procedure addDecl(c: PContext; sym: PSym); -procedure addDeclAt(c: PContext; sym: PSym; at: Natural); -procedure addOverloadableSymAt(c: PContext; fn: PSym; at: Natural); - -procedure addInterfaceDecl(c: PContext; sym: PSym); -procedure addInterfaceOverloadableSymAt(c: PContext; sym: PSym; at: int); - -function lookUp(c: PContext; n: PNode): PSym; -// Looks up a symbol. Generates an error in case of nil. - -function QualifiedLookUp(c: PContext; n: PNode; ambiguousCheck: bool): PSym; - -function InitOverloadIter(out o: TOverloadIter; c: PContext; n: PNode): PSym; -function nextOverloadIter(var o: TOverloadIter; c: PContext; n: PNode): PSym; - -implementation - -function getSymRepr(s: PSym): string; -begin - case s.kind of - skProc, skMethod, skConverter, skIterator: result := getProcHeader(s); - else result := s.name.s - end -end; - -procedure CloseScope(var tab: TSymTab); -var - it: TTabIter; - s: PSym; -begin - // check if all symbols have been used and defined: - if (tab.tos > length(tab.stack)) then InternalError('CloseScope'); - s := InitTabIter(it, tab.stack[tab.tos-1]); - while s <> nil do begin - if sfForward in s.flags then - liMessage(s.info, errImplOfXexpected, getSymRepr(s)) - else if ([sfUsed, sfInInterface] * s.flags = []) and - (optHints in s.options) then // BUGFIX: check options in s! - if not (s.kind in [skForVar, skParam, skMethod, skUnknown]) then - liMessage(s.info, hintXDeclaredButNotUsed, getSymRepr(s)); - s := NextIter(it, tab.stack[tab.tos-1]); - end; - astalgo.rawCloseScope(tab); -end; - -procedure AddSym(var t: TStrTable; n: PSym); -begin - if StrTableIncl(t, n) then liMessage(n.info, errAttemptToRedefine, n.name.s); -end; - -procedure addDecl(c: PContext; sym: PSym); -begin - if SymTabAddUnique(c.tab, sym) = Failure then - liMessage(sym.info, errAttemptToRedefine, sym.Name.s); -end; - -procedure addDeclAt(c: PContext; sym: PSym; at: Natural); -begin - if SymTabAddUniqueAt(c.tab, sym, at) = Failure then - liMessage(sym.info, errAttemptToRedefine, sym.Name.s); -end; - -procedure addOverloadableSymAt(c: PContext; fn: PSym; at: Natural); -var - check: PSym; -begin - if not (fn.kind in OverloadableSyms) then - InternalError(fn.info, 'addOverloadableSymAt'); - check := StrTableGet(c.tab.stack[at], fn.name); - if (check <> nil) and not (check.Kind in OverloadableSyms) then - liMessage(fn.info, errAttemptToRedefine, fn.Name.s); - SymTabAddAt(c.tab, fn, at); -end; - -procedure AddInterfaceDeclAux(c: PContext; sym: PSym); -begin - if (sfInInterface in sym.flags) then begin - // add to interface: - if c.module = nil then InternalError(sym.info, 'AddInterfaceDeclAux'); - StrTableAdd(c.module.tab, sym); - end; - if getCurrOwner().kind = skModule then - include(sym.flags, sfGlobal) -end; - -procedure addInterfaceDecl(c: PContext; sym: PSym); -begin // it adds the symbol to the interface if appropriate - addDecl(c, sym); - AddInterfaceDeclAux(c, sym); -end; - -procedure addInterfaceOverloadableSymAt(c: PContext; sym: PSym; at: int); -begin // it adds the symbol to the interface if appropriate - addOverloadableSymAt(c, sym, at); - AddInterfaceDeclAux(c, sym); -end; - -function lookUp(c: PContext; n: PNode): PSym; -// Looks up a symbol. Generates an error in case of nil. -begin - case n.kind of - nkAccQuoted: result := lookup(c, n.sons[0]); - nkSym: begin (* - result := SymtabGet(c.Tab, n.sym.name); - if result = nil then - liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s); *) - result := n.sym; - end; - nkIdent: begin - result := SymtabGet(c.Tab, n.ident); - if result = nil then - liMessage(n.info, errUndeclaredIdentifier, n.ident.s); - end - else InternalError(n.info, 'lookUp'); - end; - if IntSetContains(c.AmbiguousSymbols, result.id) then - liMessage(n.info, errUseQualifier, result.name.s); - if result.kind = skStub then loadStub(result); -end; - -function QualifiedLookUp(c: PContext; n: PNode; ambiguousCheck: bool): PSym; -var - m: PSym; - ident: PIdent; -begin - case n.kind of - nkIdent: begin - result := SymtabGet(c.Tab, n.ident); - if result = nil then - liMessage(n.info, errUndeclaredIdentifier, n.ident.s) - else if ambiguousCheck - and IntSetContains(c.AmbiguousSymbols, result.id) then - liMessage(n.info, errUseQualifier, n.ident.s) - end; - nkSym: begin (* - result := SymtabGet(c.Tab, n.sym.name); - if result = nil then - liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s) - else *) - result := n.sym; - if ambiguousCheck and IntSetContains(c.AmbiguousSymbols, result.id) then - liMessage(n.info, errUseQualifier, n.sym.name.s) - end; - nkDotExpr: begin - result := nil; - m := qualifiedLookUp(c, n.sons[0], false); - if (m <> nil) and (m.kind = skModule) then begin - ident := nil; - if (n.sons[1].kind = nkIdent) then - ident := n.sons[1].ident - else if (n.sons[1].kind = nkAccQuoted) - and (n.sons[1].sons[0].kind = nkIdent) then - ident := n.sons[1].sons[0].ident; - if ident <> nil then begin - if m = c.module then - // a module may access its private members: - result := StrTableGet(c.tab.stack[ModuleTablePos], ident) - else - result := StrTableGet(m.tab, ident); - if result = nil then - liMessage(n.sons[1].info, errUndeclaredIdentifier, ident.s) - end - else - liMessage(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])); - end - end; - nkAccQuoted: result := QualifiedLookup(c, n.sons[0], ambiguousCheck); - else begin - result := nil; - //liMessage(n.info, errIdentifierExpected, '') - end; - end; - if (result <> nil) and (result.kind = skStub) then loadStub(result); -end; - -function InitOverloadIter(out o: TOverloadIter; c: PContext; n: PNode): PSym; -var - ident: PIdent; -begin - result := nil; - case n.kind of - nkIdent: begin - o.stackPtr := c.tab.tos; - o.mode := oimNoQualifier; - while (result = nil) do begin - dec(o.stackPtr); - if o.stackPtr < 0 then break; - result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.ident); - end; - end; - nkSym: begin - result := n.sym; - o.mode := oimDone; - (* - o.stackPtr := c.tab.tos; - o.mode := oimNoQualifier; - while (result = nil) do begin - dec(o.stackPtr); - if o.stackPtr < 0 then break; - result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.sym.name); - end; *) - end; - nkDotExpr: begin - o.mode := oimOtherModule; - o.m := qualifiedLookUp(c, n.sons[0], false); - if (o.m <> nil) and (o.m.kind = skModule) then begin - ident := nil; - if (n.sons[1].kind = nkIdent) then - ident := n.sons[1].ident - else if (n.sons[1].kind = nkAccQuoted) - and (n.sons[1].sons[0].kind = nkIdent) then - ident := n.sons[1].sons[0].ident; - if ident <> nil then begin - if o.m = c.module then begin - // a module may access its private members: - result := InitIdentIter(o.it, c.tab.stack[ModuleTablePos], ident); - o.mode := oimSelfModule; - end - else - result := InitIdentIter(o.it, o.m.tab, ident); - end - else - liMessage(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])); - end - end; - nkAccQuoted: result := InitOverloadIter(o, c, n.sons[0]); - nkSymChoice: begin - o.mode := oimSymChoice; - result := n.sons[0].sym; - o.stackPtr := 1 - end; - else begin end - end; - if (result <> nil) and (result.kind = skStub) then loadStub(result); -end; - -function nextOverloadIter(var o: TOverloadIter; c: PContext; n: PNode): PSym; -begin - case o.mode of - oimDone: result := nil; - oimNoQualifier: begin - if n.kind = nkAccQuoted then - result := nextOverloadIter(o, c, n.sons[0]) // BUGFIX - else if o.stackPtr >= 0 then begin - result := nextIdentIter(o.it, c.tab.stack[o.stackPtr]); - while (result = nil) do begin - dec(o.stackPtr); - if o.stackPtr < 0 then break; - result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], o.it.name); - // BUGFIX: o.it.name <-> n.ident - end - end - else result := nil; - end; - oimSelfModule: result := nextIdentIter(o.it, c.tab.stack[ModuleTablePos]); - oimOtherModule: result := nextIdentIter(o.it, o.m.tab); - oimSymChoice: begin - if o.stackPtr < sonsLen(n) then begin - result := n.sons[o.stackPtr].sym; - inc(o.stackPtr); - end - else - result := nil - end; - end; - if (result <> nil) and (result.kind = skStub) then loadStub(result); -end; - -end. diff --git a/nim/magicsys.pas b/nim/magicsys.pas deleted file mode 100755 index f4e4beafe1..0000000000 --- a/nim/magicsys.pas +++ /dev/null @@ -1,277 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit magicsys; - -// Built-in types and compilerprocs are registered here. - -interface - -{$include 'config.inc'} - -uses - nsystem, - ast, astalgo, nhashes, msgs, platform, nversion, ntime, idents, rodread; - -var // magic symbols in the system module: - SystemModule: PSym; - -procedure registerSysType(t: PType); -function getSysType(const kind: TTypeKind): PType; - -function getCompilerProc(const name: string): PSym; -procedure registerCompilerProc(s: PSym); - -procedure InitSystem(var tab: TSymTab); -procedure FinishSystem(const tab: TStrTable); - -function getSysSym(const name: string): PSym; - -implementation - -var - gSysTypes: array [TTypeKind] of PType; - compilerprocs: TStrTable; - -procedure registerSysType(t: PType); -begin - if gSysTypes[t.kind] = nil then gSysTypes[t.kind] := t; -end; - -function newSysType(kind: TTypeKind; size: int): PType; -begin - result := newType(kind, systemModule); - result.size := size; - result.align := size; -end; - -function getSysSym(const name: string): PSym; -begin - result := StrTableGet(systemModule.tab, getIdent(name)); - if result = nil then rawMessage(errSystemNeeds, name); - if result.kind = skStub then loadStub(result); -end; - -function sysTypeFromName(const name: string): PType; -begin - result := getSysSym(name).typ; -end; - -function getSysType(const kind: TTypeKind): PType; -begin - result := gSysTypes[kind]; - if result = nil then begin - case kind of - tyInt: result := sysTypeFromName('int'); - tyInt8: result := sysTypeFromName('int8'); - tyInt16: result := sysTypeFromName('int16'); - tyInt32: result := sysTypeFromName('int32'); - tyInt64: result := sysTypeFromName('int64'); - tyFloat: result := sysTypeFromName('float'); - tyFloat32: result := sysTypeFromName('float32'); - tyFloat64: result := sysTypeFromName('float64'); - tyBool: result := sysTypeFromName('bool'); - tyChar: result := sysTypeFromName('char'); - tyString: result := sysTypeFromName('string'); - tyCstring: result := sysTypeFromName('cstring'); - tyPointer: result := sysTypeFromName('pointer'); - tyNil: result := newSysType(tyNil, ptrSize); - else InternalError('request for typekind: ' + typeKindToStr[kind]); - end; - gSysTypes[kind] := result; - end; - if result.kind <> kind then - InternalError('wanted: ' + typeKindToStr[kind] - +{&} ' got: ' +{&} typeKindToStr[result.kind]); - if result = nil then InternalError('type not found: ' + typeKindToStr[kind]); -end; - -function getCompilerProc(const name: string): PSym; -var - ident: PIdent; -begin - ident := getIdent(name, getNormalizedHash(name)); - result := StrTableGet(compilerprocs, ident); - if result = nil then begin - result := StrTableGet(rodCompilerProcs, ident); - if result <> nil then begin - strTableAdd(compilerprocs, result); - if result.kind = skStub then loadStub(result); - end; - // A bit hacky that this code is needed here, but it is the easiest - // solution in order to avoid special cases for sfCompilerProc in the - // rodgen module. Another solution would be to always recompile the system - // module. But I don't want to do that as that would mean less testing of - // the new symbol file cache (and worse performance). - end; -end; - -procedure registerCompilerProc(s: PSym); -begin - strTableAdd(compilerprocs, s); -end; -(* -function FindMagic(const tab: TStrTable; m: TMagic; const s: string): PSym; -var - ti: TIdentIter; -begin - result := InitIdentIter(ti, tab, getIdent(s)); - while result <> nil do begin - if (result.magic = m) then exit; - result := NextIdentIter(ti, tab) - end -end; - -function NewMagic(kind: TSymKind; const name: string; - const info: TLineInfo): PSym; -begin - result := newSym(kind, getIdent(name), SystemModule); - Include(result.loc.Flags, lfNoDecl); - result.info := info; -end; - -function newMagicType(const info: TLineInfo; kind: TTypeKind; - magicSym: PSym): PType; -begin - result := newType(kind, SystemModule); - result.sym := magicSym; -end; - -procedure setSize(t: PType; size: int); -begin - t.align := size; - t.size := size; -end; - -procedure addMagicSym(var tab: TSymTab; sym: PSym; sys: PSym); -begin - SymTabAdd(tab, sym); - StrTableAdd(sys.tab, sym); // add to interface - include(sym.flags, sfInInterface); -end; - -var - fakeInfo: TLineInfo; - -procedure addIntegral(var tab: TSymTab; kind: TTypeKind; const name: string; - size: int); -var - t: PSym; -begin - t := newMagic(skType, name, fakeInfo); - t.typ := newMagicType(fakeInfo, kind, t); - setSize(t.typ, size); - addMagicSym(tab, t, SystemModule); - gSysTypes[kind] := t.typ; -end; - -procedure addMagicTAnyEnum(var tab: TSymTab); -var - s: PSym; -begin - s := newMagic(skType, 'TAnyEnum', fakeInfo); - s.typ := newMagicType(fakeInfo, tyAnyEnum, s); - SymTabAdd(tab, s); -end; -*) -procedure InitSystem(var tab: TSymTab); -begin (* - if SystemModule = nil then InternalError('systemModule == nil'); - fakeInfo := newLineInfo('system.nim', 1, 1); - // symbols with compiler magic are pretended to be in system at line 1 - - // TAnyEnum: - addMagicTAnyEnum(tab); - - // nil: - gSysTypes[tyNil] := newMagicType(fakeInfo, tyNil, nil); - SetSize(gSysTypes[tyNil], ptrSize); - // no need to add it to symbol table since it is a reserved word - - // boolean type: - addIntegral(tab, tyBool, 'bool', 1); - - // false: - c := NewMagic(skConst, 'false', fakeInfo); - c.typ := gSysTypes[tyBool]; - c.ast := newIntNode(nkIntLit, ord(false)); - c.ast.typ := gSysTypes[tyBool]; - addMagicSym(tab, c, systemModule); - - // true: - c := NewMagic(skConst, 'true', fakeInfo); - c.typ := gSysTypes[tyBool]; - c.ast := newIntNode(nkIntLit, ord(true)); - c.ast.typ := gSysTypes[tyBool]; - addMagicSym(tab, c, systemModule); - - addIntegral(tab, tyFloat32, 'float32', 4); - addIntegral(tab, tyFloat64, 'float64', 8); - addIntegral(tab, tyInt8, 'int8', 1); - addIntegral(tab, tyInt16, 'int16', 2); - addIntegral(tab, tyInt32, 'int32', 4); - addIntegral(tab, tyInt64, 'int64', 8); - - if cpu[targetCPU].bit = 64 then begin - addIntegral(tab, tyFloat128, 'float128', 16); - addIntegral(tab, tyInt, 'int', 8); - addIntegral(tab, tyFloat, 'float', 8); - end - else if cpu[targetCPU].bit = 32 then begin - addIntegral(tab, tyInt, 'int', 4); - addIntegral(tab, tyFloat, 'float', 8); - end - else begin // 16 bit cpu: - addIntegral(tab, tyInt, 'int', 2); - addIntegral(tab, tyFloat, 'float', 4); - end; - - // char type: - addIntegral(tab, tyChar, 'char', 1); - - // string type: - addIntegral(tab, tyString, 'string', ptrSize); - typ := gSysTypes[tyString]; - addSon(typ, gSysTypes[tyChar]); - - // pointer type: - addIntegral(tab, tyPointer, 'pointer', ptrSize); - - - addIntegral(tab, tyCString, 'cstring', ptrSize); - typ := gSysTypes[tyCString]; - addSon(typ, gSysTypes[tyChar]); - - gSysTypes[tyEmptySet] := newMagicType(fakeInfo, tyEmptySet, nil); - - intSetBaseType := newMagicType(fakeInfo, tyRange, nil); - addSon(intSetBaseType, gSysTypes[tyInt]); // base type - setSize(intSetBaseType, int(gSysTypes[tyInt].size)); - intSetBaseType.n := newNodeI(nkRange, fakeInfo); - addSon(intSetBaseType.n, newIntNode(nkIntLit, 0)); - addSon(intSetBaseType.n, newIntNode(nkIntLit, nversion.MaxSetElements-1)); - intSetBaseType.n.sons[0].info := fakeInfo; - intSetBaseType.n.sons[1].info := fakeInfo; - intSetBaseType.n.sons[0].typ := gSysTypes[tyInt]; - intSetBaseType.n.sons[1].typ := gSysTypes[tyInt]; *) -end; - -procedure FinishSystem(const tab: TStrTable); -begin (* - notSym := findMagic(tab, mNot, 'not'); - if (notSym = nil) then - rawMessage(errSystemNeeds, 'not'); - - countUpSym := StrTableGet(tab, getIdent('countup')); - if (countUpSym = nil) then - rawMessage(errSystemNeeds, 'countup'); *) -end; - -initialization - initStrTable(compilerprocs); -end. diff --git a/nim/main.pas b/nim/main.pas deleted file mode 100755 index 4b35513c55..0000000000 --- a/nim/main.pas +++ /dev/null @@ -1,423 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit main; - -// implements the command dispatcher and several commands as well as the -// module handling -{$include 'config.inc'} - -interface - -uses - nsystem, llstream, strutils, ast, astalgo, scanner, syntaxes, rnimsyn, - options, msgs, nos, lists, condsyms, paslex, pasparse, rodread, rodwrite, - ropes, trees, wordrecg, sem, semdata, idents, passes, docgen, - extccomp, cgen, ecmasgen, platform, interact, nimconf, importer, - passaux, depends, transf, evals, types; - -procedure MainCommand(const cmd, filename: string); - -implementation - -// ------------------ module handling ----------------------------------------- - -type - TFileModuleRec = record - filename: string; - module: PSym; - end; - TFileModuleMap = array of TFileModuleRec; -var - compMods: TFileModuleMap = {@ignore} nil {@emit @[]}; - // all compiled modules - -procedure registerModule(const filename: string; module: PSym); -var - len: int; -begin - len := length(compMods); - setLength(compMods, len+1); - compMods[len].filename := filename; - compMods[len].module := module; -end; - -function getModule(const filename: string): PSym; -var - i: int; -begin - for i := 0 to high(compMods) do - if sameFile(compMods[i].filename, filename) then begin - result := compMods[i].module; exit end; - result := nil; -end; - -// ---------------------------------------------------------------------------- - -function newModule(const filename: string): PSym; -begin - // We cannot call ``newSym`` here, because we have to circumvent the ID - // mechanism, which we do in order to assign each module a persistent ID. - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.id := -1; // for better error checking - result.kind := skModule; - result.name := getIdent(splitFile(filename).name); - result.owner := result; // a module belongs to itself - result.info := newLineInfo(filename, 1, 1); - include(result.flags, sfUsed); - initStrTable(result.tab); - RegisterModule(filename, result); - - StrTableAdd(result.tab, result); // a module knows itself -end; - -function CompileModule(const filename: string; - isMainFile, isSystemFile: bool): PSym; forward; - -function importModule(const filename: string): PSym; -// this is called by the semantic checking phase -begin - result := getModule(filename); - if result = nil then begin - // compile the module - result := compileModule(filename, false, false); - end - else if sfSystemModule in result.flags then - liMessage(result.info, errAttemptToRedefine, result.Name.s); -end; - -function CompileModule(const filename: string; - isMainFile, isSystemFile: bool): PSym; -var - rd: PRodReader; - f: string; -begin - rd := nil; - f := addFileExt(filename, nimExt); - result := newModule(filename); - if isMainFile then include(result.flags, sfMainModule); - if isSystemFile then include(result.flags, sfSystemModule); - if (gCmd = cmdCompileToC) or (gCmd = cmdCompileToCpp) then begin - rd := handleSymbolFile(result, f); - if result.id < 0 then - InternalError('handleSymbolFile should have set the module''s ID'); - end - else - result.id := getID(); - processModule(result, f, nil, rd); -end; - -procedure CompileProject(const filename: string); -begin - {@discard} CompileModule( - JoinPath(options.libpath, addFileExt('system', nimExt)), false, true); - {@discard} CompileModule(addFileExt(filename, nimExt), true, false); -end; - -procedure semanticPasses; -begin - registerPass(verbosePass()); - registerPass(sem.semPass()); - registerPass(transf.transfPass()); -end; - -procedure CommandGenDepend(const filename: string); -begin - semanticPasses(); - registerPass(genDependPass()); - registerPass(cleanupPass()); - compileProject(filename); - generateDot(filename); - execExternalProgram('dot -Tpng -o' +{&} changeFileExt(filename, 'png') +{&} - ' ' +{&} changeFileExt(filename, 'dot')); -end; - -procedure CommandCheck(const filename: string); -begin - semanticPasses(); - // use an empty backend for semantic checking only - compileProject(filename); -end; - -procedure CommandCompileToC(const filename: string); -begin - semanticPasses(); - registerPass(cgen.cgenPass()); - registerPass(rodwrite.rodwritePass()); - //registerPass(cleanupPass()); - compileProject(filename); - //for i := low(TTypeKind) to high(TTypeKind) do - // MessageOut('kind: ' +{&} typeKindToStr[i] +{&} ' = ' +{&} toString(sameTypeA[i])); - extccomp.CallCCompiler(changeFileExt(filename, '')); -end; - -procedure CommandCompileToEcmaScript(const filename: string); -begin - include(gGlobalOptions, optSafeCode); - setTarget(osEcmaScript, cpuEcmaScript); - initDefines(); - - semanticPasses(); - registerPass(ecmasgenPass()); - compileProject(filename); -end; - -procedure CommandInteractive(); -var - m: PSym; -begin - include(gGlobalOptions, optSafeCode); - setTarget(osNimrodVM, cpuNimrodVM); - initDefines(); - - registerPass(verbosePass()); - registerPass(sem.semPass()); - registerPass(transf.transfPass()); - registerPass(evals.evalPass()); - - // load system module: - {@discard} CompileModule( - JoinPath(options.libpath, addFileExt('system', nimExt)), false, true); - - m := newModule('stdin'); - m.id := getID(); - include(m.flags, sfMainModule); - processModule(m, 'stdin', LLStreamOpenStdIn(), nil); -end; - -// -------------------------------------------------------------------------- - -procedure exSymbols(n: PNode); -var - i: int; -begin - case n.kind of - nkEmpty..nkNilLit: begin end; // atoms - nkProcDef..nkIteratorDef: begin - exSymbol(n.sons[namePos]); - end; - nkWhenStmt, nkStmtList: begin - for i := 0 to sonsLen(n)-1 do exSymbols(n.sons[i]) - end; - nkVarSection, nkConstSection: begin - for i := 0 to sonsLen(n)-1 do - exSymbol(n.sons[i].sons[0]); - end; - nkTypeSection: begin - for i := 0 to sonsLen(n)-1 do begin - exSymbol(n.sons[i].sons[0]); - if (n.sons[i].sons[2] <> nil) and - (n.sons[i].sons[2].kind = nkObjectTy) then - fixRecordDef(n.sons[i].sons[2]) - end - end; - else begin end - end -end; - -procedure CommandExportSymbols(const filename: string); -// now unused! -var - module: PNode; -begin - module := parseFile(addFileExt(filename, NimExt)); - if module <> nil then begin - exSymbols(module); - renderModule(module, getOutFile(filename, 'pretty.'+NimExt)); - end -end; - -procedure CommandPretty(const filename: string); -var - module: PNode; -begin - module := parseFile(addFileExt(filename, NimExt)); - if module <> nil then - renderModule(module, getOutFile(filename, 'pretty.'+NimExt)); -end; - -procedure CommandLexPas(const filename: string); -var - L: TPasLex; - tok: TPasTok; - f: string; - stream: PLLStream; -begin -{@ignore} - fillChar(tok, sizeof(tok), 0); - fillChar(L, sizeof(L), 0); -{@emit} - f := addFileExt(filename, 'pas'); - stream := LLStreamOpen(f, fmRead); - if stream <> nil then begin - OpenLexer(L, f, stream); - getPasTok(L, tok); - while tok.xkind <> pxEof do begin - printPasTok(tok); - getPasTok(L, tok); - end - end - else - rawMessage(errCannotOpenFile, f); - closeLexer(L); -end; - -procedure CommandPas(const filename: string); -var - p: TPasParser; - module: PNode; - f: string; - stream: PLLStream; -begin - f := addFileExt(filename, 'pas'); - stream := LLStreamOpen(f, fmRead); - if stream <> nil then begin - OpenPasParser(p, f, stream); - module := parseUnit(p); - closePasParser(p); - renderModule(module, getOutFile(filename, NimExt)); - end - else - rawMessage(errCannotOpenFile, f); -end; - -procedure CommandScan(const filename: string); -var - L: TLexer; - tok: PToken; - f: string; - stream: PLLStream; -begin - new(tok); -{@ignore} - fillChar(tok^, sizeof(tok^), 0); -{@emit} - f := addFileExt(filename, nimExt); - stream := LLStreamOpen(f, fmRead); - if stream <> nil then begin - openLexer(L, f, stream); - repeat - rawGetTok(L, tok^); - PrintTok(tok); - until tok.tokType = tkEof; - CloseLexer(L); - end - else - rawMessage(errCannotOpenFile, f); -end; - -procedure WantFile(const filename: string); -begin - if filename = '' then - liMessage(newLineInfo('command line', 1, 1), errCommandExpectsFilename); -end; - -procedure MainCommand(const cmd, filename: string); -begin - appendStr(searchPaths, options.libpath); - if filename <> '' then begin - // current path is always looked first for modules - prependStr(searchPaths, splitFile(filename).dir); - end; - setID(100); - passes.gIncludeFile := syntaxes.parseFile; - passes.gImportModule := importModule; - - case whichKeyword(cmd) of - wCompile, wCompileToC, wC, wCC: begin - // compile means compileToC currently - gCmd := cmdCompileToC; - wantFile(filename); - CommandCompileToC(filename); - end; - wCompileToCpp: begin - gCmd := cmdCompileToCpp; - wantFile(filename); - CommandCompileToC(filename); - end; - wCompileToEcmaScript: begin - gCmd := cmdCompileToEcmaScript; - wantFile(filename); - CommandCompileToEcmaScript(filename); - end; - wCompileToLLVM: begin - gCmd := cmdCompileToLLVM; - wantFile(filename); - CommandCompileToC(filename); - end; - wPretty: begin - gCmd := cmdPretty; - wantFile(filename); - //CommandExportSymbols(filename); - CommandPretty(filename); - end; - wDoc: begin - gCmd := cmdDoc; - LoadSpecialConfig(DocConfig); - wantFile(filename); - CommandDoc(filename); - end; - wRst2html: begin - gCmd := cmdRst2html; - LoadSpecialConfig(DocConfig); - wantFile(filename); - CommandRst2Html(filename); - end; - wRst2tex: begin - gCmd := cmdRst2tex; - LoadSpecialConfig(DocTexConfig); - wantFile(filename); - CommandRst2TeX(filename); - end; - wPas: begin - gCmd := cmdPas; - wantFile(filename); - CommandPas(filename); - end; - wBoot: begin - gCmd := cmdBoot; - wantFile(filename); - CommandPas(filename); - end; - wGenDepend: begin - gCmd := cmdGenDepend; - wantFile(filename); - CommandGenDepend(filename); - end; - wListDef: begin - gCmd := cmdListDef; - condsyms.ListSymbols(); - end; - wCheck: begin - gCmd := cmdCheck; - wantFile(filename); - CommandCheck(filename); - end; - wParse: begin - gCmd := cmdParse; - wantFile(filename); - {@discard} parseFile(addFileExt(filename, nimExt)); - end; - wScan: begin - gCmd := cmdScan; - wantFile(filename); - CommandScan(filename); - MessageOut('Beware: Indentation tokens depend on the parser''s state!'); - end; - wI: begin - gCmd := cmdInteractive; - CommandInteractive(); - end; - else rawMessage(errInvalidCommandX, cmd); - end -end; - -end. diff --git a/nim/msgs.pas b/nim/msgs.pas deleted file mode 100755 index 55ccdda5e4..0000000000 --- a/nim/msgs.pas +++ /dev/null @@ -1,893 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit msgs; - -interface - -{$include 'config.inc'} - -uses - nsystem, options, strutils, nos; - -//[[[cog -//from string import replace -//enum = "type\n TMsgKind = (\n" -//msgs = "const\n MsgKindToStr: array [TMsgKind] of string = (\n" -//warns = "const\n WarningsToStr: array [0..%d] of string = (\n" -//hints = "const\n HintsToStr: array [0..%d] of string = (\n" -//w = 0 # counts the warnings -//h = 0 # counts the hints -// -//for elem in eval(open('data/messages.yml').read()): -// for key, val in elem.items(): -// enum = enum + ' %s,\n' % key -// v = replace(val, "'", "''") -// if key[0:4] == 'warn': -// msgs = msgs + " '%s [%s]',\n" % (v, key[4:]) -// warns = warns + " '%s',\n" % key[4:] -// w = w + 1 -// elif key[0:4] == 'hint': -// msgs = msgs + " '%s [%s]',\n" % (v, key[4:]) -// hints = hints + " '%s',\n" % key[4:] -// h = h + 1 -// else: -// msgs = msgs + " '%s',\n" % v -// -//enum = enum[:-2] + ');\n\n' -//msgs = msgs[:-2] + '\n );\n' -//warns = (warns[:-2] + '\n );\n') % (w-1) -//hints = (hints[:-2] + '\n );\n') % (h-1) -// -//cog.out(enum) -//cog.out(msgs) -//cog.out(warns) -//cog.out(hints) -//]]] -type - TMsgKind = ( - errUnknown, - errIllFormedAstX, - errCannotOpenFile, - errInternal, - errGenerated, - errXCompilerDoesNotSupportCpp, - errStringLiteralExpected, - errIntLiteralExpected, - errInvalidCharacterConstant, - errClosingTripleQuoteExpected, - errClosingQuoteExpected, - errTabulatorsAreNotAllowed, - errInvalidToken, - errLineTooLong, - errInvalidNumber, - errNumberOutOfRange, - errNnotAllowedInCharacter, - errClosingBracketExpected, - errMissingFinalQuote, - errIdentifierExpected, - errOperatorExpected, - errTokenExpected, - errStringAfterIncludeExpected, - errRecursiveDependencyX, - errOnOrOffExpected, - errNoneSpeedOrSizeExpected, - errInvalidPragma, - errUnknownPragma, - errInvalidDirectiveX, - errAtPopWithoutPush, - errEmptyAsm, - errInvalidIndentation, - errExceptionExpected, - errExceptionAlreadyHandled, - errYieldNotAllowedHere, - errInvalidNumberOfYieldExpr, - errCannotReturnExpr, - errAttemptToRedefine, - errStmtInvalidAfterReturn, - errStmtExpected, - errInvalidLabel, - errInvalidCmdLineOption, - errCmdLineArgExpected, - errCmdLineNoArgExpected, - errInvalidVarSubstitution, - errUnknownVar, - errUnknownCcompiler, - errOnOrOffExpectedButXFound, - errNoneBoehmRefcExpectedButXFound, - errNoneSpeedOrSizeExpectedButXFound, - errGuiConsoleOrLibExpectedButXFound, - errUnknownOS, - errUnknownCPU, - errGenOutExpectedButXFound, - errArgsNeedRunOption, - errInvalidMultipleAsgn, - errColonOrEqualsExpected, - errExprExpected, - errUndeclaredIdentifier, - errUseQualifier, - errTypeExpected, - errSystemNeeds, - errExecutionOfProgramFailed, - errNotOverloadable, - errInvalidArgForX, - errStmtHasNoEffect, - errXExpectsTypeOrValue, - errXExpectsArrayType, - errIteratorCannotBeInstantiated, - errExprXAmbiguous, - errConstantDivisionByZero, - errOrdinalTypeExpected, - errOrdinalOrFloatTypeExpected, - errOverOrUnderflow, - errCannotEvalXBecauseIncompletelyDefined, - errChrExpectsRange0_255, - errDynlibRequiresExportc, - errUndeclaredFieldX, - errNilAccess, - errIndexOutOfBounds, - errIndexTypesDoNotMatch, - errBracketsInvalidForType, - errValueOutOfSetBounds, - errFieldInitTwice, - errFieldNotInit, - errExprXCannotBeCalled, - errExprHasNoType, - errExprXHasNoType, - errCastNotInSafeMode, - errExprCannotBeCastedToX, - errCommaOrParRiExpected, - errCurlyLeOrParLeExpected, - errSectionExpected, - errRangeExpected, - errAttemptToRedefineX, - errMagicOnlyInSystem, - errPowerOfTwoExpected, - errStringMayNotBeEmpty, - errCallConvExpected, - errProcOnlyOneCallConv, - errSymbolMustBeImported, - errExprMustBeBool, - errConstExprExpected, - errDuplicateCaseLabel, - errRangeIsEmpty, - errSelectorMustBeOfCertainTypes, - errSelectorMustBeOrdinal, - errOrdXMustNotBeNegative, - errLenXinvalid, - errWrongNumberOfVariables, - errExprCannotBeRaised, - errBreakOnlyInLoop, - errTypeXhasUnknownSize, - errConstNeedsConstExpr, - errConstNeedsValue, - errResultCannotBeOpenArray, - errSizeTooBig, - errSetTooBig, - errBaseTypeMustBeOrdinal, - errInheritanceOnlyWithNonFinalObjects, - errInheritanceOnlyWithEnums, - errIllegalRecursionInTypeX, - errCannotInstantiateX, - errExprHasNoAddress, - errVarForOutParamNeeded, - errPureTypeMismatch, - errTypeMismatch, - errButExpected, - errButExpectedX, - errAmbiguousCallXYZ, - errWrongNumberOfArguments, - errXCannotBePassedToProcVar, - errXCannotBeInParamDecl, - errPragmaOnlyInHeaderOfProc, - errImplOfXNotAllowed, - errImplOfXexpected, - errNoSymbolToBorrowFromFound, - errDiscardValue, - errInvalidDiscard, - errIllegalConvFromXtoY, - errCannotBindXTwice, - errInvalidOrderInEnumX, - errEnumXHasWholes, - errExceptExpected, - errInvalidTry, - errOptionExpected, - errXisNoLabel, - errNotAllCasesCovered, - errUnkownSubstitionVar, - errComplexStmtRequiresInd, - errXisNotCallable, - errNoPragmasAllowedForX, - errNoGenericParamsAllowedForX, - errInvalidParamKindX, - errDefaultArgumentInvalid, - errNamedParamHasToBeIdent, - errNoReturnTypeForX, - errConvNeedsOneArg, - errInvalidPragmaX, - errXNotAllowedHere, - errInvalidControlFlowX, - errATypeHasNoValue, - errXisNoType, - errCircumNeedsPointer, - errInvalidExpression, - errInvalidExpressionX, - errEnumHasNoValueX, - errNamedExprExpected, - errNamedExprNotAllowed, - errXExpectsOneTypeParam, - errArrayExpectsTwoTypeParams, - errInvalidVisibilityX, - errInitHereNotAllowed, - errXCannotBeAssignedTo, - errIteratorNotAllowed, - errXNeedsReturnType, - errInvalidCommandX, - errXOnlyAtModuleScope, - errTemplateInstantiationTooNested, - errInstantiationFrom, - errInvalidIndexValueForTuple, - errCommandExpectsFilename, - errXExpected, - errInvalidSectionStart, - errGridTableNotImplemented, - errGeneralParseError, - errNewSectionExpected, - errWhitespaceExpected, - errXisNoValidIndexFile, - errCannotRenderX, - errVarVarTypeNotAllowed, - errIsExpectsTwoArguments, - errIsExpectsObjectTypes, - errXcanNeverBeOfThisSubtype, - errTooManyIterations, - errCannotInterpretNodeX, - errFieldXNotFound, - errInvalidConversionFromTypeX, - errAssertionFailed, - errCannotGenerateCodeForX, - errXRequiresOneArgument, - errUnhandledExceptionX, - errCyclicTree, - errXisNoMacroOrTemplate, - errXhasSideEffects, - errIteratorExpected, - errUser, - warnCannotOpenFile, - warnOctalEscape, - warnXIsNeverRead, - warnXmightNotBeenInit, - warnCannotWriteMO2, - warnCannotReadMO2, - warnDeprecated, - warnSmallLshouldNotBeUsed, - warnUnknownMagic, - warnRedefinitionOfLabel, - warnUnknownSubstitutionX, - warnLanguageXNotSupported, - warnCommentXIgnored, - warnXisPassedToProcVar, - warnUser, - hintSuccess, - hintSuccessX, - hintLineTooLong, - hintXDeclaredButNotUsed, - hintConvToBaseNotNeeded, - hintConvFromXtoItselfNotNeeded, - hintExprAlwaysX, - hintQuitCalled, - hintProcessing, - hintCodeBegin, - hintCodeEnd, - hintConf, - hintUser); - -const - MsgKindToStr: array [TMsgKind] of string = ( - 'unknown error', - 'illformed AST: $1', - 'cannot open ''$1''', - 'internal error: $1', - '$1', - '''$1'' compiler does not support C++', - 'string literal expected', - 'integer literal expected', - 'invalid character constant', - 'closing """ expected, but end of file reached', - 'closing " expected', - 'tabulators are not allowed', - 'invalid token: $1', - 'line too long', - '$1 is not a valid number', - 'number $1 out of valid range', - '\n not allowed in character literal', - 'closing '']'' expected, but end of file reached', - 'missing final ''', - 'identifier expected, but found ''$1''', - 'operator expected, but found ''$1''', - '''$1'' expected', - 'string after ''include'' expected', - 'recursive dependency: ''$1''', - '''on'' or ''off'' expected', - '''none'', ''speed'' or ''size'' expected', - 'invalid pragma', - 'unknown pragma: ''$1''', - 'invalid directive: ''$1''', - '''pop'' without a ''push'' pragma', - 'empty asm statement', - 'invalid indentation', - 'exception expected', - 'exception already handled', - '''yield'' only allowed in a loop of an iterator', - 'invalid number of ''yield'' expresions', - 'current routine cannot return an expression', - 'attempt to redefine ''$1''', - 'statement not allowed after ''return'', ''break'' or ''raise''', - 'statement expected', - '''$1'' is no label', - 'invalid command line option: ''$1''', - 'argument for command line option expected: ''$1''', - 'invalid argument for command line option: ''$1''', - 'invalid variable substitution in ''$1''', - 'unknown variable: ''$1''', - 'unknown C compiler: ''$1''', - '''on'' or ''off'' expected, but ''$1'' found', - '''none'', ''boehm'' or ''refc'' expected, but ''$1'' found', - '''none'', ''speed'' or ''size'' expected, but ''$1'' found', - '''gui'', ''console'' or ''lib'' expected, but ''$1'' found', - 'unknown OS: ''$1''', - 'unknown CPU: ''$1''', - '''c'', ''c++'' or ''yaml'' expected, but ''$1'' found', - 'arguments can only be given if the ''--run'' option is selected', - 'multiple assignment is not allowed', - ''':'' or ''='' expected, but found ''$1''', - 'expression expected, but found ''$1''', - 'undeclared identifier: ''$1''', - 'ambiguous identifier: ''$1'' -- use a qualifier', - 'type expected', - 'system module needs ''$1''', - 'execution of an external program failed', - 'overloaded ''$1'' leads to ambiguous calls', - 'invalid argument for ''$1''', - 'statement has no effect', - '''$1'' expects a type or value', - '''$1'' expects an array type', - '''$1'' cannot be instantiated because its body has not been compiled yet', - 'expression ''$1'' ambiguous in this context', - 'constant division by zero', - 'ordinal type expected', - 'ordinal or float type expected', - 'over- or underflow', - 'cannot evalutate ''$1'' because type is not defined completely', - '''chr'' expects an int in the range 0..255', - '''dynlib'' requires ''exportc''', - 'undeclared field: ''$1''', - 'attempt to access a nil address', - 'index out of bounds', - 'index types do not match', - '''[]'' operator invalid for this type', - 'value out of set bounds', - 'field initialized twice: ''$1''', - 'field ''$1'' not initialized', - 'expression ''$1'' cannot be called', - 'expression has no type', - 'expression ''$1'' has no type (or is ambiguous)', - '''cast'' not allowed in safe mode', - 'expression cannot be casted to $1', - ''','' or '')'' expected', - '''{'' or ''('' expected', - 'section (''type'', ''proc'', etc.) expected', - 'range expected', - 'attempt to redefine ''$1''', - '''magic'' only allowed in system module', - 'power of two expected', - 'string literal may not be empty', - 'calling convention expected', - 'a proc can only have one calling convention', - 'symbol must be imported if ''lib'' pragma is used', - 'expression must be of type ''bool''', - 'constant expression expected', - 'duplicate case label', - 'range is empty', - 'selector must be of an ordinal type, real or string', - 'selector must be of an ordinal type', - 'ord($1) must not be negative', - 'len($1) must be less than 32768', - 'wrong number of variables', - 'only objects can be raised', - '''break'' only allowed in loop construct', - 'type ''$1'' has unknown size', - 'a constant can only be initialized with a constant expression', - 'a constant needs a value', - 'the result type cannot be on open array', - 'computing the type''s size produced an overflow', - 'set is too large', - 'base type of a set must be an ordinal', - 'inheritance only works with non-final objects', - 'inheritance only works with an enum', - 'illegal recursion in type ''$1''', - 'cannot instantiate: ''$1''', - 'expression has no address', - 'for a ''var'' type a variable needs to be passed', - 'type mismatch', - 'type mismatch: got (', - 'but expected one of: ', - 'but expected ''$1''', - 'ambiguous call; both $1 and $2 match for: $3', - 'wrong number of arguments', - '''$1'' cannot be passed to a procvar', - '$1 cannot be declared in parameter declaration', - 'pragmas are only in the header of a proc allowed', - 'implementation of ''$1'' is not allowed', - 'implementation of ''$1'' expected', - 'no symbol to borrow from found', - 'value returned by statement has to be discarded', - 'statement returns no value that can be discarded', - 'conversion from $1 to $2 is invalid', - 'cannot bind parameter ''$1'' twice', - 'invalid order in enum ''$1''', - 'enum ''$1'' has wholes', - '''except'' or ''finally'' expected', - 'after catch all ''except'' or ''finally'' no section may follow', - 'option expected, but found ''$1''', - '''$1'' is not a label', - 'not all cases are covered', - 'unknown substitution variable: ''$1''', - 'complex statement requires indentation', - '''$1'' is not callable', - 'no pragmas allowed for $1', - 'no generic parameters allowed for $1', - 'invalid param kind: ''$1''', - 'default argument invalid', - 'named parameter has to be an identifier', - 'no return type for $1 allowed', - 'a type conversion needs exactly one argument', - 'invalid pragma: $1', - '$1 not allowed here', - 'invalid control flow: $1', - 'a type has no value', - 'invalid type: ''$1''', - '''^'' needs a pointer or reference type', - 'invalid expression', - 'invalid expression: ''$1''', - 'enum has no value ''$1''', - 'named expression expected', - 'named expression not allowed here', - '''$1'' expects one type parameter', - 'array expects two type parameters', - 'invalid visibility: ''$1''', - 'initialization not allowed here', - '''$1'' cannot be assigned to', - 'iterators can only be defined at the module''s top level', - '$1 needs a return type', - 'invalid command: ''$1''', - '''$1'' is only allowed at top level', - 'template/macro instantiation too nested', - 'instantiation from here', - 'invalid index value for tuple subscript', - 'command expects a filename argument', - '''$1'' expected', - 'invalid section start', - 'grid table is not implemented', - 'general parse error', - 'new section expected', - 'whitespace expected, got ''$1''', - '''$1'' is no valid index file', - 'cannot render reStructuredText element ''$1''', - 'type ''var var'' is not allowed', - '''is'' expects two arguments', - '''is'' expects object types', - '''$1'' can never be of this subtype', - 'interpretation requires too many iterations', - 'cannot interpret node kind ''$1''', - 'field ''$1'' cannot be found', - 'invalid conversion from type ''$1''', - 'assertion failed', - 'cannot generate code for ''$1''', - '$1 requires one parameter', - 'unhandled exception: $1', - 'macro returned a cyclic abstract syntax tree', - '''$1'' is no macro or template', - '''$1'' can have side effects', - 'iterator within for loop context expected', - '$1', - 'cannot open ''$1'' [CannotOpenFile]', - 'octal escape sequences do not exist; leading zero is ignored [OctalEscape]', - '''$1'' is never read [XIsNeverRead]', - '''$1'' might not have been initialized [XmightNotBeenInit]', - 'cannot write file ''$1'' [CannotWriteMO2]', - 'cannot read file ''$1'' [CannotReadMO2]', - '''$1'' is deprecated [Deprecated]', - '''l'' should not be used as an identifier; may look like ''1'' (one) [SmallLshouldNotBeUsed]', - 'unknown magic ''$1'' might crash the compiler [UnknownMagic]', - 'redefinition of label ''$1'' [RedefinitionOfLabel]', - 'unknown substitution ''$1'' [UnknownSubstitutionX]', - 'language ''$1'' not supported [LanguageXNotSupported]', - 'comment ''$1'' ignored [CommentXIgnored]', - '''$1'' is passed to a procvar; deprecated [XisPassedToProcVar]', - '$1 [User]', - 'operation successful [Success]', - 'operation successful ($1 lines compiled; $2 sec total) [SuccessX]', - 'line too long [LineTooLong]', - '''$1'' is declared but not used [XDeclaredButNotUsed]', - 'conversion to base object is not needed [ConvToBaseNotNeeded]', - 'conversion from $1 to itself is pointless [ConvFromXtoItselfNotNeeded]', - 'expression evaluates always to ''$1'' [ExprAlwaysX]', - 'quit() called [QuitCalled]', - '$1 [Processing]', - 'generated code listing: [CodeBegin]', - 'end of listing [CodeEnd]', - 'used config file ''$1'' [Conf]', - '$1 [User]' - ); -const - WarningsToStr: array [0..14] of string = ( - 'CannotOpenFile', - 'OctalEscape', - 'XIsNeverRead', - 'XmightNotBeenInit', - 'CannotWriteMO2', - 'CannotReadMO2', - 'Deprecated', - 'SmallLshouldNotBeUsed', - 'UnknownMagic', - 'RedefinitionOfLabel', - 'UnknownSubstitutionX', - 'LanguageXNotSupported', - 'CommentXIgnored', - 'XisPassedToProcVar', - 'User' - ); -const - HintsToStr: array [0..12] of string = ( - 'Success', - 'SuccessX', - 'LineTooLong', - 'XDeclaredButNotUsed', - 'ConvToBaseNotNeeded', - 'ConvFromXtoItselfNotNeeded', - 'ExprAlwaysX', - 'QuitCalled', - 'Processing', - 'CodeBegin', - 'CodeEnd', - 'Conf', - 'User' - ); -//[[[end]]] - -const - fatalMin = errUnknown; - fatalMax = errInternal; - errMin = errUnknown; - errMax = errUser; - warnMin = warnCannotOpenFile; - warnMax = pred(hintSuccess); - hintMin = hintSuccess; - hintMax = high(TMsgKind); - -type - TNoteKind = warnMin..hintMax; - // "notes" are warnings or hints - TNoteKinds = set of TNoteKind; - - TLineInfo = record - // This is designed to be as small as possible, because it is used - // in syntax nodes. We safe space here by using two int16 and an int32 - // on 64 bit and on 32 bit systems this is only 8 bytes. - line, col: int16; - fileIndex: int32; - end; - -function UnknownLineInfo(): TLineInfo; - -var - gNotes: TNoteKinds = [low(TNoteKind)..high(TNoteKind)]; - gErrorCounter: int = 0; // counts the number of errors - gHintCounter: int = 0; - gWarnCounter: int = 0; - gErrorMax: int = 1; // stop after gErrorMax errors - -const // this format is understood by many text editors: it is the same that - // Borland and Freepascal use - PosErrorFormat = '$1($2, $3) Error: $4'; - PosWarningFormat = '$1($2, $3) Warning: $4'; - PosHintFormat = '$1($2, $3) Hint: $4'; - - RawErrorFormat = 'Error: $1'; - RawWarningFormat = 'Warning: $1'; - RawHintFormat = 'Hint: $1'; - -procedure MessageOut(const s: string); - -procedure rawMessage(const msg: TMsgKind; const arg: string = ''); overload; -procedure rawMessage(const msg: TMsgKind; const args: array of string); overload; - -procedure liMessage(const info: TLineInfo; const msg: TMsgKind; - const arg: string = ''); - -procedure InternalError(const info: TLineInfo; const errMsg: string); - overload; -procedure InternalError(const errMsg: string); overload; - -function newLineInfo(const filename: string; line, col: int): TLineInfo; - -function ToFilename(const info: TLineInfo): string; -function toColumn(const info: TLineInfo): int; -function ToLinenumber(const info: TLineInfo): int; - -function MsgKindToString(kind: TMsgKind): string; - -// checkpoints are used for debugging: -function checkpoint(const info: TLineInfo; const filename: string; - line: int): boolean; - -procedure addCheckpoint(const info: TLineInfo); overload; -procedure addCheckpoint(const filename: string; line: int); overload; -function inCheckpoint(const current: TLineInfo): boolean; -// prints the line information if in checkpoint - -procedure pushInfoContext(const info: TLineInfo); -procedure popInfoContext; - -function includeFilename(const f: string): int; - - -implementation - -function UnknownLineInfo(): TLineInfo; -begin - result.line := int16(-1); - result.col := int16(-1); - result.fileIndex := -1; -end; - -{@ignore} -var - filenames: array of string; - msgContext: array of TLineInfo; -{@emit -var - filenames: array of string = @[]; - msgContext: array of TLineInfo = @[]; -} - -procedure pushInfoContext(const info: TLineInfo); -var - len: int; -begin - len := length(msgContext); - setLength(msgContext, len+1); - msgContext[len] := info; -end; - -procedure popInfoContext; -begin - setLength(msgContext, length(msgContext)-1); -end; - -function includeFilename(const f: string): int; -var - i: int; -begin - for i := high(filenames) downto low(filenames) do - if filenames[i] = f then begin - result := i; exit - end; - // not found, so add it: - result := length(filenames); - setLength(filenames, result+1); - filenames[result] := f; -end; - -function checkpoint(const info: TLineInfo; const filename: string; - line: int): boolean; -begin - result := (int(info.line) = line) and ( - ChangeFileExt(extractFilename(filenames[info.fileIndex]), '') = filename); -end; - - -{@ignore} -var - checkPoints: array of TLineInfo; -{@emit -var - checkPoints: array of TLineInfo = @[]; -} - -procedure addCheckpoint(const info: TLineInfo); overload; -var - len: int; -begin - len := length(checkPoints); - setLength(checkPoints, len+1); - checkPoints[len] := info; -end; - -procedure addCheckpoint(const filename: string; line: int); overload; -begin - addCheckpoint(newLineInfo(filename, line, -1)); -end; - -function newLineInfo(const filename: string; line, col: int): TLineInfo; -begin - result.fileIndex := includeFilename(filename); - result.line := int16(line); - result.col := int16(col); -end; - -function ToFilename(const info: TLineInfo): string; -begin - if info.fileIndex = -1 then result := '???' - else result := filenames[info.fileIndex] -end; - -function ToLinenumber(const info: TLineInfo): int; -begin - result := info.line -end; - -function toColumn(const info: TLineInfo): int; -begin - result := info.col -end; - -procedure MessageOut(const s: string); -begin // change only this proc to put it elsewhere - Writeln(output, s); -end; - -function coordToStr(const coord: int): string; -begin - if coord = -1 then result := '???' - else result := toString(coord) -end; - -function MsgKindToString(kind: TMsgKind): string; -begin // later versions may provide translated error messages - result := msgKindToStr[kind]; -end; - -function getMessageStr(msg: TMsgKind; const arg: string): string; -begin - result := format(msgKindToString(msg), [arg]); -end; - -function inCheckpoint(const current: TLineInfo): boolean; -var - i: int; -begin - result := false; - if not (optCheckpoints in gOptions) then exit; // ignore all checkpoints - for i := 0 to high(checkPoints) do begin - if (current.line = checkPoints[i].line) and - (current.fileIndex = (checkPoints[i].fileIndex)) then begin - MessageOut(Format('$1($2, $3) Checkpoint: ', [toFilename(current), - coordToStr(current.line), - coordToStr(current.col)])); - result := true; - exit - end - end -end; - -procedure handleError(const msg: TMsgKind); -begin - if msg = errInternal then assert(false); // we want a stack trace here - if (msg >= fatalMin) and (msg <= fatalMax) then begin - if gVerbosity >= 3 then assert(false); - halt(1) - end; - if (msg >= errMin) and (msg <= errMax) then begin - inc(gErrorCounter); - if gErrorCounter >= gErrorMax then begin - if gVerbosity >= 3 then assert(false); - halt(1) // one error stops the compiler - end - end -end; - -function sameLineInfo(const a, b: TLineInfo): bool; -begin - result := (a.line = b.line) and (a.fileIndex = b.fileIndex); -end; - -procedure writeContext(const lastinfo: TLineInfo); -var - i: int; - info: TLineInfo; -begin - info := lastInfo; - for i := 0 to length(msgContext)-1 do begin - if not sameLineInfo(msgContext[i], lastInfo) - and not sameLineInfo(msgContext[i], info) then - MessageOut(Format(posErrorFormat, [toFilename(msgContext[i]), - coordToStr(msgContext[i].line), - coordToStr(msgContext[i].col), - getMessageStr(errInstantiationFrom, '')])); - info := msgContext[i]; - end; -end; - -procedure rawMessage(const msg: TMsgKind; const args: array of string); -var - frmt: string; -begin - case msg of - errMin..errMax: begin - writeContext(unknownLineInfo()); - frmt := rawErrorFormat; - end; - warnMin..warnMax: begin - if not (optWarns in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := rawWarningFormat; - inc(gWarnCounter); - end; - hintMin..hintMax: begin - if not (optHints in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := rawHintFormat; - inc(gHintCounter); - end; - else assert(false) // cannot happen - end; - MessageOut(Format(frmt, format(msgKindToString(msg), args))); - handleError(msg); -end; - -procedure rawMessage(const msg: TMsgKind; const arg: string = ''); -begin - rawMessage(msg, [arg]); -end; - -procedure liMessage(const info: TLineInfo; const msg: TMsgKind; - const arg: string = ''); -var - frmt: string; -begin - case msg of - errMin..errMax: begin - writeContext(info); - frmt := posErrorFormat; - end; - warnMin..warnMax: begin - if not (optWarns in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := posWarningFormat; - inc(gWarnCounter); - end; - hintMin..hintMax: begin - if not (optHints in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := posHintFormat; - inc(gHintCounter); - end; - else assert(false) // cannot happen - end; - MessageOut(Format(frmt, [toFilename(info), - coordToStr(info.line), - coordToStr(info.col), - getMessageStr(msg, arg)])); - handleError(msg); -end; - -procedure InternalError(const info: TLineInfo; const errMsg: string); -begin - writeContext(info); - liMessage(info, errInternal, errMsg); -end; - -procedure InternalError(const errMsg: string); overload; -begin - writeContext(UnknownLineInfo()); - rawMessage(errInternal, errMsg); -end; - -end. diff --git a/nim/nhashes.pas b/nim/nhashes.pas deleted file mode 100755 index 95bfd62f5a..0000000000 --- a/nim/nhashes.pas +++ /dev/null @@ -1,225 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit nhashes; - -{$include 'config.inc'} - -interface - -uses - charsets, nsystem, strutils; - -const - SmallestSize = (1 shl 3) - 1; - DefaultSize = (1 shl 11) - 1; - BiggestSize = (1 shl 28) - 1; - -type - THash = type int; - PHash = ^THash; - THashFunc = function (str: PChar): THash; - -function GetHash(str: PChar): THash; -function GetHashCI(str: PChar): THash; - -function GetDataHash(Data: Pointer; Size: int): THash; - -function hashPtr(p: Pointer): THash; - -function GetHashStr(const s: string): THash; -function GetHashStrCI(const s: string): THash; - -function getNormalizedHash(const s: string): THash; - -//function nextPowerOfTwo(x: int): int; - -function concHash(h: THash; val: int): THash; -function finishHash(h: THash): THash; - -implementation - -{@ignore} -{$ifopt Q+} { we need Q- here! } - {$define Q_on} - {$Q-} -{$endif} - -{$ifopt R+} - {$define R_on} - {$R-} -{$endif} -{@emit} - -function nextPowerOfTwo(x: int): int; -begin - result := x -{%} 1; - // complicated, to make it a nop if sizeof(int) == 4, - // because shifting more than 31 bits is undefined in C - result := result or (result shr ((sizeof(int)-4)* 8)); - result := result or (result shr 16); - result := result or (result shr 8); - result := result or (result shr 4); - result := result or (result shr 2); - result := result or (result shr 1); - Inc(result) -end; - -function concHash(h: THash; val: int): THash; -begin - result := h +{%} val; - result := result +{%} result shl 10; - result := result xor (result shr 6); -end; - -function finishHash(h: THash): THash; -begin - result := h +{%} h shl 3; - result := result xor (result shr 11); - result := result +{%} result shl 15; -end; - -function GetDataHash(Data: Pointer; Size: int): THash; -var - h: THash; - p: PChar; - i, s: int; -begin - h := 0; - p := {@cast}pchar(Data); - i := 0; - s := size; - while s > 0 do begin - h := h +{%} ord(p[i]); - h := h +{%} h shl 10; - h := h xor (h shr 6); - Inc(i); Dec(s) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -function hashPtr(p: Pointer): THash; -begin - result := ({@cast}THash(p)) shr 3; // skip the alignment -end; - -function GetHash(str: PChar): THash; -var - h: THash; - i: int; -begin - h := 0; - i := 0; - while str[i] <> #0 do begin - h := h +{%} ord(str[i]); - h := h +{%} h shl 10; - h := h xor (h shr 6); - Inc(i) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -function GetHashStr(const s: string): THash; -var - h: THash; - i: int; -begin - h := 0; - for i := 1 to Length(s) do begin - h := h +{%} ord(s[i]); - h := h +{%} h shl 10; - h := h xor (h shr 6); - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -function getNormalizedHash(const s: string): THash; -var - h: THash; - c: Char; - i: int; -begin - h := 0; - for i := strStart to length(s)+strStart-1 do begin - c := s[i]; - if c = '_' then continue; // skip _ - if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() - h := h +{%} ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6); - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -function GetHashStrCI(const s: string): THash; -var - h: THash; - c: Char; - i: int; -begin - h := 0; - for i := strStart to length(s)+strStart-1 do begin - c := s[i]; - if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() - h := h +{%} ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6); - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -function GetHashCI(str: PChar): THash; -var - h: THash; - c: Char; - i: int; -begin - h := 0; - i := 0; - while str[i] <> #0 do begin - c := str[i]; - if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() - h := h +{%} ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6); - Inc(i) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - result := THash(h) -end; - -{@ignore} -{$ifdef Q_on} - {$undef Q_on} - {$Q+} -{$endif} - -{$ifdef R_on} - {$undef R_on} - {$R+} -{$endif} -{@emit} - -end. diff --git a/nim/nimconf.pas b/nim/nimconf.pas deleted file mode 100755 index 69c6f7618d..0000000000 --- a/nim/nimconf.pas +++ /dev/null @@ -1,361 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit nimconf; - -// This module handles the reading of the config file. -{$include 'config.inc'} - -interface - -uses - nsystem, llstream, nversion, commands, nos, strutils, msgs, platform, - condsyms, scanner, options, idents, wordrecg; - -procedure LoadConfig(const project: string); - -procedure LoadSpecialConfig(const configfilename: string); - -implementation - - -// ---------------- configuration file parser ----------------------------- -// we use Nimrod's scanner here to safe space and work - -procedure ppGetTok(var L: TLexer; tok: PToken); -begin - // simple filter - rawGetTok(L, tok^); - while (tok.tokType = tkInd) or (tok.tokType = tkSad) - or (tok.tokType = tkDed) or (tok.tokType = tkComment) do - rawGetTok(L, tok^) -end; - -// simple preprocessor: -function parseExpr(var L: TLexer; tok: PToken): bool; forward; - -function parseAtom(var L: TLexer; tok: PToken): bool; -begin - if tok.tokType = tkParLe then begin - ppGetTok(L, tok); - result := parseExpr(L, tok); - if tok.tokType = tkParRi then ppGetTok(L, tok) - else lexMessage(L, errTokenExpected, ''')''') - end - else if tok.ident.id = ord(wNot) then begin - ppGetTok(L, tok); - result := not parseAtom(L, tok) - end - else begin - result := isDefined(tok.ident); - //condsyms.listSymbols(); - //writeln(tok.ident.s + ' has the value: ', result); - ppGetTok(L, tok) - end; -end; - -function parseAndExpr(var L: TLexer; tok: PToken): bool; -var - b: bool; -begin - result := parseAtom(L, tok); - while tok.ident.id = ord(wAnd) do begin - ppGetTok(L, tok); // skip "and" - b := parseAtom(L, tok); - result := result and b; - end -end; - -function parseExpr(var L: TLexer; tok: PToken): bool; -var - b: bool; -begin - result := parseAndExpr(L, tok); - while tok.ident.id = ord(wOr) do begin - ppGetTok(L, tok); // skip "or" - b := parseAndExpr(L, tok); - result := result or b; - end -end; - -function EvalppIf(var L: TLexer; tok: PToken): bool; -begin - ppGetTok(L, tok); // skip 'if' or 'elif' - result := parseExpr(L, tok); - if tok.tokType = tkColon then ppGetTok(L, tok) - else lexMessage(L, errTokenExpected, ''':''') -end; - -var - condStack: array of bool; - -{@emit - condStack := @[]; -} - -procedure doEnd(var L: TLexer; tok: PToken); -begin - if high(condStack) < 0 then lexMessage(L, errTokenExpected, '@if'); - ppGetTok(L, tok); // skip 'end' - setLength(condStack, high(condStack)) -end; - -type - TJumpDest = (jdEndif, jdElseEndif); - -procedure jumpToDirective(var L: TLexer; tok: PToken; dest: TJumpDest); forward; - -procedure doElse(var L: TLexer; tok: PToken); -begin - if high(condStack) < 0 then - lexMessage(L, errTokenExpected, '@if'); - ppGetTok(L, tok); - if tok.tokType = tkColon then ppGetTok(L, tok); - if condStack[high(condStack)] then - jumpToDirective(L, tok, jdEndif) -end; - -procedure doElif(var L: TLexer; tok: PToken); -var - res: bool; -begin - if high(condStack) < 0 then - lexMessage(L, errTokenExpected, '@if'); - res := EvalppIf(L, tok); - if condStack[high(condStack)] or not res then - jumpToDirective(L, tok, jdElseEndif) - else - condStack[high(condStack)] := true -end; - -procedure jumpToDirective(var L: TLexer; tok: PToken; dest: TJumpDest); -var - nestedIfs: int; -begin - nestedIfs := 0; - while True do begin - if (tok.ident <> nil) and (tok.ident.s = '@'+'') then begin - ppGetTok(L, tok); - case whichKeyword(tok.ident) of - wIf: Inc(nestedIfs); - wElse: begin - if (dest = jdElseEndif) and (nestedIfs = 0) then begin - doElse(L, tok); - break - end - end; - wElif: begin - if (dest = jdElseEndif) and (nestedIfs = 0) then begin - doElif(L, tok); - break - end - end; - wEnd: begin - if nestedIfs = 0 then begin - doEnd(L, tok); - break - end; - if nestedIfs > 0 then Dec(nestedIfs) - end; - else begin end; - end; - ppGetTok(L, tok) - end - else if tok.tokType = tkEof then - lexMessage(L, errTokenExpected, '@end') - else - ppGetTok(L, tok) - end -end; - -procedure parseDirective(var L: TLexer; tok: PToken); -var - res: bool; - key: string; -begin - ppGetTok(L, tok); // skip @ - case whichKeyword(tok.ident) of - wIf: begin - setLength(condStack, length(condStack)+1); - res := EvalppIf(L, tok); - condStack[high(condStack)] := res; - if not res then // jump to "else", "elif" or "endif" - jumpToDirective(L, tok, jdElseEndif) - end; - wElif: doElif(L, tok); - wElse: doElse(L, tok); - wEnd: doEnd(L, tok); - wWrite: begin - ppGetTok(L, tok); - msgs.MessageOut(tokToStr(tok)); - ppGetTok(L, tok) - end; - wPutEnv: begin - ppGetTok(L, tok); - key := tokToStr(tok); - ppGetTok(L, tok); - nos.putEnv(key, tokToStr(tok)); - ppGetTok(L, tok) - end; - wPrependEnv: begin - ppGetTok(L, tok); - key := tokToStr(tok); - ppGetTok(L, tok); - nos.putEnv(key, tokToStr(tok) +{&} nos.getenv(key)); - ppGetTok(L, tok) - end; - wAppendenv: begin - ppGetTok(L, tok); - key := tokToStr(tok); - ppGetTok(L, tok); - nos.putEnv(key, nos.getenv(key) +{&} tokToStr(tok)); - ppGetTok(L, tok) - end - else - lexMessage(L, errInvalidDirectiveX, tokToStr(tok)) - end -end; - -procedure confTok(var L: TLexer; tok: PToken); -begin - ppGetTok(L, tok); - while (tok.ident <> nil) and (tok.ident.s = '@'+'') do - parseDirective(L, tok) - // else: give the token to the parser -end; - -// ----------- end of preprocessor ---------------------------------------- - -procedure checkSymbol(const L: TLexer; tok: PToken); -begin - if not (tok.tokType in [tkSymbol..pred(tkIntLit), - tkStrLit..tkTripleStrLit]) then - lexMessage(L, errIdentifierExpected, tokToStr(tok)) -end; - -procedure parseAssignment(var L: TLexer; tok: PToken); -var - s, val: string; - info: TLineInfo; -begin - if (tok.ident.id = getIdent('-'+'').id) - or (tok.ident.id = getIdent('--').id) then - confTok(L, tok); // skip unnecessary prefix - info := getLineInfo(L); // safe for later in case of an error - checkSymbol(L, tok); - s := tokToStr(tok); - confTok(L, tok); // skip symbol - val := ''; - while tok.tokType = tkDot do begin - addChar(s, '.'); - confTok(L, tok); - checkSymbol(L, tok); - add(s, tokToStr(tok)); - confTok(L, tok) - end; - if tok.tokType = tkBracketLe then begin - // BUGFIX: val, not s! - // BUGFIX: do not copy '['! - confTok(L, tok); - checkSymbol(L, tok); - add(val, tokToStr(tok)); - confTok(L, tok); - if tok.tokType = tkBracketRi then confTok(L, tok) - else lexMessage(L, errTokenExpected, ''']'''); - addChar(val, ']'); - end; - if (tok.tokType = tkColon) or (tok.tokType = tkEquals) then begin - if length(val) > 0 then addChar(val, ':'); // BUGFIX - confTok(L, tok); // skip ':' or '=' - checkSymbol(L, tok); - add(val, tokToStr(tok)); - confTok(L, tok); // skip symbol - while (tok.ident <> nil) and (tok.ident.id = getIdent('&'+'').id) do begin - confTok(L, tok); - checkSymbol(L, tok); - add(val, tokToStr(tok)); - confTok(L, tok) - end - end; - processSwitch(s, val, passPP, info) -end; - -procedure readConfigFile(const filename: string); -var - L: TLexer; - tok: PToken; - stream: PLLStream; -begin - new(tok); -{@ignore} - fillChar(tok^, sizeof(tok^), 0); - fillChar(L, sizeof(L), 0); -{@emit} - stream := LLStreamOpen(filename, fmRead); - if stream <> nil then begin - openLexer(L, filename, stream); - tok.tokType := tkEof; // to avoid a pointless warning - confTok(L, tok); // read in the first token - while tok.tokType <> tkEof do - parseAssignment(L, tok); - if length(condStack) > 0 then - lexMessage(L, errTokenExpected, '@end'); - closeLexer(L); - if gVerbosity >= 1 then rawMessage(hintConf, filename); - end -end; - -// ------------------------------------------------------------------------ - -function getConfigPath(const filename: string): string; -begin - // try local configuration file: - result := joinPath(getConfigDir(), filename); - if not ExistsFile(result) then begin - // try standard configuration file (installation did not distribute files - // the UNIX way) - result := joinPath([getPrefixDir(), 'config', filename]); - if not ExistsFile(result) then begin - result := '/etc/' +{&} filename - end - end -end; - -procedure LoadSpecialConfig(const configfilename: string); -begin - if not (optSkipConfigFile in gGlobalOptions) then - readConfigFile(getConfigPath(configfilename)); -end; - -procedure LoadConfig(const project: string); -var - conffile, prefix: string; -begin - // set default value (can be overwritten): - if libpath = '' then begin - // choose default libpath: - prefix := getPrefixDir(); - if (prefix = '/usr') then - libpath := '/usr/lib/nimrod' - else if (prefix = '/usr/local') then - libpath := '/usr/local/lib/nimrod' - else - libpath := joinPath(prefix, 'lib') - end; - // read default config file: - LoadSpecialConfig('nimrod.cfg'); - // read project config file: - if not (optSkipProjConfigFile in gGlobalOptions) and (project <> '') then begin - conffile := changeFileExt(project, 'cfg'); - if existsFile(conffile) then - readConfigFile(conffile) - end -end; - -end. diff --git a/nim/nimrod.pas b/nim/nimrod.pas deleted file mode 100755 index 8d7db04b2c..0000000000 --- a/nim/nimrod.pas +++ /dev/null @@ -1,126 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -program nimrod; - -{$include 'config.inc'} -{@ignore} -{$ifdef windows} -{$apptype console} -{$endif} -{@emit} - -uses - nsystem, ntime, - charsets, sysutils, commands, scanner, condsyms, options, msgs, nversion, - nimconf, ropes, extccomp, strutils, nos, platform, main, parseopt; - -var - arguments: string = ''; // the arguments to be passed to the program that - // should be run - cmdLineInfo: TLineInfo; - -procedure ProcessCmdLine(pass: TCmdLinePass; var command, filename: string); -var - p: TOptParser; - bracketLe: int; - key, val: string; -begin - p := parseopt.init(); - while true do begin - parseopt.next(p); - case p.kind of - cmdEnd: break; - cmdLongOption, cmdShortOption: begin - // hint[X]:off is parsed as (p.key = "hint[X]", p.val = "off") - // we fix this here - bracketLe := strutils.find(p.key, '['); - if bracketLe >= strStart then begin - key := ncopy(p.key, strStart, bracketLe-1); - val := ncopy(p.key, bracketLe+1) +{&} ':' +{&} p.val; - ProcessSwitch(key, val, pass, cmdLineInfo); - end - else - ProcessSwitch(p.key, p.val, pass, cmdLineInfo); - end; - cmdArgument: begin - if command = '' then command := p.key - else if filename = '' then begin - filename := unixToNativePath(p.key); - // BUGFIX for portable build scripts - break - end - end - end - end; - // collect the arguments: - if pass = passCmd2 then begin - arguments := getRestOfCommandLine(p); - if not (optRun in gGlobalOptions) and (arguments <> '') then - rawMessage(errArgsNeedRunOption); - end -end; - -{@ignore} -type - TTime = int; -{@emit} - -procedure HandleCmdLine; -var - command, filename, prog: string; - start: TTime; -begin - {@emit start := getTime(); } - if paramCount() = 0 then - writeCommandLineUsage() - else begin - // Process command line arguments: - command := ''; - filename := ''; - ProcessCmdLine(passCmd1, command, filename); - if filename <> '' then options.projectPath := splitFile(filename).dir; - nimconf.LoadConfig(filename); // load the right config file - // now process command line arguments again, because some options in the - // command line can overwite the config file's settings - extccomp.initVars(); - - command := ''; - filename := ''; - ProcessCmdLine(passCmd2, command, filename); - MainCommand(command, filename); - {@emit - if gVerbosity >= 2 then echo(GC_getStatistics()); } - if (gCmd <> cmdInterpret) and (msgs.gErrorCounter = 0) then begin - {@ignore} - rawMessage(hintSuccess); - {@emit - rawMessage(hintSuccessX, [toString(gLinesCompiled), - toString(getTime() - start)]); - } - end; - if optRun in gGlobalOptions then begin - {$ifdef unix} - prog := './' + quoteIfContainsWhite(changeFileExt(filename, '')); - {$else} - prog := quoteIfContainsWhite(changeFileExt(filename, '')); - {$endif} - execExternalProgram(prog +{&} ' ' +{&} arguments) - end - end -end; - -begin -//{@emit -// GC_disableMarkAndSweep(); -//} - cmdLineInfo := newLineInfo('command line', -1, -1); - condsyms.InitDefines(); - HandleCmdLine(); - halt(options.gExitcode); -end. diff --git a/nim/nimsets.pas b/nim/nimsets.pas deleted file mode 100755 index 9795817b88..0000000000 --- a/nim/nimsets.pas +++ /dev/null @@ -1,259 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit nimsets; - -// this unit handles Nimrod sets; it implements symbolic sets - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, trees, nversion, msgs, platform, - bitsets, types, rnimsyn; - -procedure toBitSet(s: PNode; out b: TBitSet); - -// this function is used for case statement checking: -function overlap(a, b: PNode): Boolean; - -function inSet(s: PNode; const elem: PNode): Boolean; -function someInSet(s: PNode; const a, b: PNode): Boolean; - -function emptyRange(const a, b: PNode): Boolean; - -function SetHasRange(s: PNode): Boolean; -// returns true if set contains a range (needed by the code generator) - -// these are used for constant folding: -function unionSets(a, b: PNode): PNode; -function diffSets(a, b: PNode): PNode; -function intersectSets(a, b: PNode): PNode; -function symdiffSets(a, b: PNode): PNode; - -function containsSets(a, b: PNode): Boolean; -function equalSets(a, b: PNode): Boolean; - -function cardSet(s: PNode): BiggestInt; - -implementation - -function inSet(s: PNode; const elem: PNode): Boolean; -var - i: int; -begin - if s.kind <> nkCurly then InternalError(s.info, 'inSet'); - for i := 0 to sonsLen(s)-1 do - if s.sons[i].kind = nkRange then begin - if leValue(s.sons[i].sons[0], elem) - and leValue(elem, s.sons[i].sons[1]) then begin - result := true; exit - end - end - else begin - if sameValue(s.sons[i], elem) then begin - result := true; exit - end - end; - result := false -end; - -function overlap(a, b: PNode): Boolean; -begin - if a.kind = nkRange then begin - if b.kind = nkRange then begin - result := leValue(a.sons[0], b.sons[1]) - and leValue(b.sons[1], a.sons[1]) - or leValue(a.sons[0], b.sons[0]) - and leValue(b.sons[0], a.sons[1]) - end - else begin - result := leValue(a.sons[0], b) - and leValue(b, a.sons[1]) - end - end - else begin - if b.kind = nkRange then begin - result := leValue(b.sons[0], a) - and leValue(a, b.sons[1]) - end - else begin - result := sameValue(a, b) - end - end -end; - -function SomeInSet(s: PNode; const a, b: PNode): Boolean; -// checks if some element of a..b is in the set s -var - i: int; -begin - if s.kind <> nkCurly then InternalError(s.info, 'SomeInSet'); - for i := 0 to sonsLen(s)-1 do - if s.sons[i].kind = nkRange then begin - if leValue(s.sons[i].sons[0], b) - and leValue(b, s.sons[i].sons[1]) - or leValue(s.sons[i].sons[0], a) - and leValue(a, s.sons[i].sons[1]) then begin - result := true; exit - end - end - else begin - // a <= elem <= b - if leValue(a, s.sons[i]) and leValue(s.sons[i], b) then begin - result := true; exit - end - end; - result := false -end; - -procedure toBitSet(s: PNode; out b: TBitSet); -var - i: int; - first, j: BiggestInt; -begin - first := firstOrd(s.typ.sons[0]); - bitSetInit(b, int(getSize(s.typ))); - for i := 0 to sonsLen(s)-1 do - if s.sons[i].kind = nkRange then begin - j := getOrdValue(s.sons[i].sons[0]); - while j <= getOrdValue(s.sons[i].sons[1]) do begin - BitSetIncl(b, j - first); - inc(j) - end - end - else - BitSetIncl(b, getOrdValue(s.sons[i]) - first) -end; - -function ToTreeSet(const s: TBitSet; settype: PType; - const info: TLineInfo): PNode; -var - a, b, e, first: BiggestInt; // a, b are interval borders - elemType: PType; - n: PNode; -begin - elemType := settype.sons[0]; - first := firstOrd(elemType); - result := newNodeI(nkCurly, info); - result.typ := settype; - result.info := info; - - e := 0; - while e < high(s)*elemSize do begin - if bitSetIn(s, e) then begin - a := e; b := e; - repeat - Inc(b); - until (b > high(s)*elemSize) or not bitSetIn(s, b); - Dec(b); - if a = b then // a single element: - addSon(result, newIntTypeNode(nkIntLit, a + first, elemType)) - else begin - n := newNodeI(nkRange, info); - n.typ := elemType; - addSon(n, newIntTypeNode(nkIntLit, a + first, elemType)); - addSon(n, newIntTypeNode(nkIntLit, b + first, elemType)); - addSon(result, n); - end; - e := b - end; - Inc(e) - end -end; - -type - TSetOP = (soUnion, soDiff, soSymDiff, soIntersect); - -function nodeSetOp(a, b: PNode; op: TSetOp): PNode; -var - x, y: TBitSet; -begin - toBitSet(a, x); - toBitSet(b, y); - case op of - soUnion: BitSetUnion(x, y); - soDiff: BitSetDiff(x, y); - soSymDiff: BitSetSymDiff(x, y); - soIntersect: BitSetIntersect(x, y); - end; - result := toTreeSet(x, a.typ, a.info); -end; - -function unionSets(a, b: PNode): PNode; -begin - result := nodeSetOp(a, b, soUnion); -end; - -function diffSets(a, b: PNode): PNode; -begin - result := nodeSetOp(a, b, soDiff); -end; - -function intersectSets(a, b: PNode): PNode; -begin - result := nodeSetOp(a, b, soIntersect) -end; - -function symdiffSets(a, b: PNode): PNode; -begin - result := nodeSetOp(a, b, soSymDiff); -end; - -function containsSets(a, b: PNode): Boolean; -var - x, y: TBitSet; -begin - toBitSet(a, x); - toBitSet(b, y); - result := bitSetContains(x, y) -end; - -function equalSets(a, b: PNode): Boolean; -var - x, y: TBitSet; -begin - toBitSet(a, x); - toBitSet(b, y); - result := bitSetEquals(x, y) -end; - -function cardSet(s: PNode): BiggestInt; -var - i: int; -begin - // here we can do better than converting it into a compact set - // we just count the elements directly - result := 0; - for i := 0 to sonsLen(s)-1 do - if s.sons[i].kind = nkRange then - result := result + getOrdValue(s.sons[i].sons[1]) - - getOrdValue(s.sons[i].sons[0]) + 1 - else - Inc(result); -end; - -function SetHasRange(s: PNode): Boolean; -var - i: int; -begin - if s.kind <> nkCurly then InternalError(s.info, 'SetHasRange'); - for i := 0 to sonsLen(s)-1 do - if s.sons[i].kind = nkRange then begin - result := true; exit - end; - result := false -end; - -function emptyRange(const a, b: PNode): Boolean; -begin - result := not leValue(a, b) // a > b iff not (a <= b) -end; - -end. diff --git a/nim/nmath.pas b/nim/nmath.pas deleted file mode 100755 index 8b638eb423..0000000000 --- a/nim/nmath.pas +++ /dev/null @@ -1,68 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit nmath; - -interface - -{$include 'config.inc'} - -{@ignore} -uses - nsystem; -{@emit} - -function countBits(n: cardinal): int; -function IsPowerOfTwo(x: int): Boolean; -function nextPowerOfTwo(x: int): int; - -implementation - -function countBits(n: cardinal): int; -const - lookup: array [0..255] of Byte = ( - 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, - 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, - 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, - 4, 5, 5, 6, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, - 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, - 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, - 4, 5, 5, 6, 5, 6, 6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, - 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, - 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, - 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 2, 3, 3, 4, 3, 4, 4, 5, - 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, - 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, - 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 - ); -var - i: int; -begin - result := 0; - for i := 0 to sizeof(n)-1 do - Inc(result, lookup[ (n shr (i * 8)) and 255 ]) -end; - -function IsPowerOfTwo(x: int): Boolean; -begin - result := x and -x = x -end; - -function nextPowerOfTwo(x: int): int; -begin - result := x - 1; - result := result or (result shr 16); - result := result or (result shr 8); - result := result or (result shr 4); - result := result or (result shr 2); - result := result or (result shr 1); - Inc(result) -end; - -end. diff --git a/nim/nos.pas b/nim/nos.pas deleted file mode 100755 index 7c74ba1bc3..0000000000 --- a/nim/nos.pas +++ /dev/null @@ -1,620 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit nos; - -// This module provides Nimrod's os module in Pascal -// Note: Only implement what is really needed here! - -interface - -{$include 'config.inc'} - -uses - sysutils, -{$ifdef mswindows} - windows, -{$else} - dos, - unix, -{$endif} - strutils, - nsystem; - -type - EOSError = class(exception) - end; - - TSplitFileResult = record - dir, name, ext: string; - end; - TSplitPathResult = record - head, tail: string; - end; - -const - curdir = '.'; -{$ifdef mswindows} - dirsep = '\'; // seperator within paths - altsep = '/'; - exeExt = 'exe'; -{$else} - dirsep = '/'; - altsep = #0; // work around fpc bug - exeExt = ''; -{$endif} - pathSep = ';'; // seperator between paths - sep = dirsep; // alternative name - extsep = '.'; - -function executeShellCommand(const cmd: string): int; -// like exec, but gets a command - -function FileNewer(const a, b: string): Boolean; -// returns true if file a is newer than file b -// i.e. a was modified before b -// if a or b does not exist returns false - -function getEnv(const name: string): string; -procedure putEnv(const name, val: string); - -function JoinPath(const head, tail: string): string; overload; -function JoinPath(const parts: array of string): string; overload; - -procedure SplitPath(const path: string; out head, tail: string); overload; - -function extractDir(const f: string): string; -function extractFilename(const f: string): string; - -function getApplicationDir(): string; -function getApplicationFilename(): string; - -function getCurrentDir: string; -function GetConfigDir(): string; - - -procedure SplitFilename(const filename: string; out name, extension: string); - -function ExistsFile(const filename: string): Boolean; -function AddFileExt(const filename, ext: string): string; -function ChangeFileExt(const filename, ext: string): string; - -procedure createDir(const dir: string); -function expandFilename(filename: string): string; - -function UnixToNativePath(const path: string): string; - -function sameFile(const path1, path2: string): boolean; - - -function extractFileTrunk(const filename: string): string; - -function splitFile(const path: string): TSplitFileResult; -function splitPath(const path: string): TSplitPathResult; overload; - - -implementation - -function splitFile(const path: string): TSplitFileResult; -var - sepPos, dotPos, i: int; -begin - if (path = '') or (path[length(path)] in [dirSep, altSep]) then begin - result.dir := path; - result.name := ''; - result.ext := ''; - end - else begin - sepPos := 0; - dotPos := length(path)+1; - for i := length(path) downto 1 do begin - if path[i] = ExtSep then begin - if (dotPos = length(path)+1) and (i > 1) then dotPos := i - end - else if path[i] in [dirsep, altsep] then begin - sepPos := i; break - end - end; - result.dir := ncopy(path, 1, sepPos-1); - result.name := ncopy(path, sepPos+1, dotPos-1); - result.ext := ncopy(path, dotPos) - end -end; - -function extractFileTrunk(const filename: string): string; -var - f, e, dir: string; -begin - splitPath(filename, dir, f); - splitFilename(f, result, e); -end; - -function GetConfigDir(): string; -begin -{$ifdef windows} - result := getEnv('APPDATA') + '\'; -{$else} - result := getEnv('HOME') + '/.config/'; -{$endif} -end; - -function getCurrentDir: string; -begin - result := sysutils.GetCurrentDir(); -end; - -function UnixToNativePath(const path: string): string; -begin - if dirSep <> '/' then - result := replace(path, '/', dirSep) - else - result := path; -end; - -function expandFilename(filename: string): string; -begin - result := sysutils.expandFilename(filename) -end; - -function sameFile(const path1, path2: string): boolean; -begin - result := cmpIgnoreCase(expandFilename(UnixToNativePath(path1)), - expandFilename(UnixToNativePath(path2))) = 0; -end; - -procedure createDir(const dir: string); -var - i: int; -begin - for i := 2 to length(dir) do begin - if dir[i] in [sep, altsep] then sysutils.createDir(ncopy(dir, 1, i-1)); - end; - sysutils.createDir(dir); -end; - -function searchExtPos(const s: string): int; -var - i: int; -begin - result := -1; - for i := length(s) downto 2 do - if s[i] = extsep then begin - result := i; - break - end - else if s[i] in [dirsep, altsep] then break -end; - -function normExt(const ext: string): string; -begin - if (ext = '') or (ext[1] = extSep) then - result := ext // no copy needed here - else - result := extSep + ext -end; - -function AddFileExt(const filename, ext: string): string; -var - extPos: int; -begin - extPos := searchExtPos(filename); - if extPos < 0 then - result := filename + normExt(ext) - else - result := filename -end; - -function ChangeFileExt(const filename, ext: string): string; -var - extPos: int; -begin - extPos := searchExtPos(filename); - if extPos < 0 then - result := filename + normExt(ext) - else - result := ncopy(filename, strStart, extPos-1) + normExt(ext) -end; - -procedure SplitFilename(const filename: string; out name, extension: string); -var - extPos: int; -begin - extPos := searchExtPos(filename); - if extPos > 0 then begin - name := ncopy(filename, 1, extPos-1); - extension := ncopy(filename, extPos); - end - else begin - name := filename; - extension := '' - end -end; - -procedure SplitPath(const path: string; out head, tail: string); -var - sepPos, i: int; -begin - sepPos := 0; - for i := length(path) downto 1 do - if path[i] in [sep, altsep] then begin - sepPos := i; - break - end; - if sepPos > 0 then begin - head := ncopy(path, 1, sepPos-1); - tail := ncopy(path, sepPos+1) - end - else begin - head := ''; - tail := path - end -end; - -function SplitPath(const path: string): TSplitPathResult; -begin - SplitPath(path, result.head, result.tail); -end; - -function getApplicationFilename(): string; -{$ifdef darwin} -var - tail: string; - p: int; - paths: TStringSeq; -begin - // little heuristic that may works on Mac OS X: - result := ParamStr(0); // POSIX guaranties that this contains the executable - // as it has been executed by the calling process - if (length(result) > 0) and (result[1] <> '/') then begin - // not an absolute path? - // iterate over any path in the $PATH environment variable - paths := split(getEnv('PATH'), [':']); - for p := 0 to high(paths) do begin - tail := joinPath(paths[p], result); - if ExistsFile(tail) then begin result := tail; exit end - end - end -end; -{$else} -begin - result := ParamStr(0); -end; -{$endif} - -function getApplicationDir(): string; -begin - result := extractDir(getApplicationFilename()); -end; - -function extractDir(const f: string): string; -var - tail: string; -begin - SplitPath(f, result, tail) -end; - -function extractFilename(const f: string): string; -var - head: string; -begin - SplitPath(f, head, result); -end; - -function JoinPath(const head, tail: string): string; -begin - if head = '' then - result := tail - else if head[length(head)] in [sep, altsep] then - if (tail <> '') and (tail[1] in [sep, altsep]) then - result := head + ncopy(tail, 2) - else - result := head + tail - else - if (tail <> '') and (tail[1] in [sep, altsep]) then - result := head + tail - else - result := head + sep + tail -end; - -function JoinPath(const parts: array of string): string; -var - i: int; -begin - result := parts[0]; - for i := 1 to high(parts) do - result := JoinPath(result, parts[i]) -end; - -{$ifdef mswindows} -function getEnv(const name: string): string; -var - len: Cardinal; -begin - // get the length: - len := windows.GetEnvironmentVariable(PChar(name), nil, 0); - if len = 0 then - result := '' - else begin - setLength(result, len-1); - windows.GetEnvironmentVariable(PChar(name), @result[1], len); - end -end; - -procedure putEnv(const name, val: string); -begin - windows.SetEnvironmentVariable(PChar(name), PChar(val)); -end; - -function GetDateStr: string; -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - result := IntToStr(st.wYear, 4) + '/' + IntToStr(st.wMonth, 2) + '/' - + IntToStr(st.wDay, 2) -end; - -procedure GetDate(var Day, Month, Year: int); -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - Day := st.wDay; - Month := st.wMonth; - Year := st.wYear -end; - -procedure GetTime(var Hours, Minutes, Seconds, Millisec: int); -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - Hours := st.wHour; - Minutes := st.wMinute; - Seconds := st.wSecond; - Millisec := st.wMilliseconds -end; -{$else} // not windows - -function setenv(var_name, new_value: PChar; - change_flag: Boolean): Integer; cdecl; external 'libc'; - -type - TPair = record - key, val: string; - end; - TPairs = array of TPair; -var - myEnv: TPairs; // this is a horrible fix for Posix systems! - -function getMyEnvIdx(const key: string): int; -var - i: int; -begin - for i := 0 to high(myEnv) do - if myEnv[i].key = key then begin result := i; exit end; - result := -1 -end; - -function getMyEnv(const key: string): string; -var - i: int; -begin - i := getMyEnvIdx(key); - if i >= 0 then result := myEnv[i].val - else result := '' -end; - -procedure setMyEnv(const key, val: string); -var - i: int; -begin - i := getMyEnvIdx(key); - if i < 0 then begin - i := length(myEnv); - setLength(myEnv, i+1); - myEnv[i].key := key - end; - myEnv[i].val := val -end; - -procedure putEnv(const name, val: string); -begin - setEnv(pchar(name), pchar(val), true); - setMyEnv(name, val); -// writeln('putEnv() is not supported under this OS'); -// halt(3); -end; - -function getEnv(const name: string): string; -begin - result := getMyEnv(name); - if result = '' then result := dos.getEnv(name); -end; - -function GetDateStr: string; -var - wMonth, wYear, wDay: Word; -begin - SysUtils.DecodeDate(Date, wYear, wMonth, wDay); - result := IntToStr(wYear, 4) + '/' + IntToStr(wMonth, 2) + '/' - + IntToStr(wDay, 2) -end; - -procedure GetDate(var Day, Month, Year: int); -var - wMonth, wYear, wDay: Word; -begin - SysUtils.DecodeDate(Date, wYear, wMonth, wDay); - Day := wDay; - Month := wMonth; - Year := wYear -end; - -procedure GetTime(var Hours, Minutes, Seconds, Millisec: int); -var - wHour, wMin, wSec, wMSec: Word; -begin - SysUtils.DecodeTime(Time, wHour, wMin, wSec, wMSec); - Hours := wHour; Minutes := wMin; Seconds := wSec; Millisec := wMSec; -end; -{$endif} - -function GetTimeStr: string; -var - Hour, Min, Sec, MSec: int; -begin - GetTime(Hour, min, sec, msec); - result := IntToStr(Hour, 2) + ':' + IntToStr(min, 2) + ':' + IntToStr(Sec, 2) -end; - -function DateAndTime: string; -begin - result := GetDateStr() + ' ' + getTimeStr() -end; - -{$ifdef windows} - -function executeShellCommand(const cmd: string): int; -var - SI: TStartupInfo; - ProcInfo: TProcessInformation; - process: THandle; - L: DWORD; -begin - FillChar(SI, Sizeof(SI), 0); - SI.cb := SizeOf(SI); - SI.hStdError := GetStdHandle(STD_ERROR_HANDLE); - SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE); - SI.hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE); - if not Windows.CreateProcess(nil, PChar(cmd), nil, nil, false, - NORMAL_PRIORITY_CLASS, nil {Windows.GetEnvironmentStrings()}, - nil, SI, ProcInfo) - then - result := getLastError() - else begin - Process := ProcInfo.hProcess; - CloseHandle(ProcInfo.hThread); - if WaitForSingleObject(Process, INFINITE) <> $ffffffff then begin - GetExitCodeProcess(Process, L); - result := int(L) - end - else - result := -1; - CloseHandle(Process); - end; -end; - -{$else} - {$ifdef windows} -function executeShellCommand(const cmd: string): int; -begin - result := dos.Exec(cmd, '') -end; -//C:\Eigenes\compiler\MinGW\bin; - {$else} -// fpc has a portable function for this -function executeShellCommand(const cmd: string): int; -begin - result := shell(cmd); -end; - {$endif} -{$endif} - -{$ifdef windows} -type - TFileAge = packed record - Low, High: Longword; - end; -{$else} -type - TFileAge = dos.DateTime; - {DateTime = packed record - Year: Word; - Month: Word; - Day: Word; - Hour: Word; - Min: Word; - Sec: Word; - end;} -{$endif} - -function GetLastWriteTime(Filename: PChar): TFileAge; -{$ifdef windows} -var - Handle: THandle; - FindRec: Win32_Find_Data; -begin - Handle := FindFirstFile(Filename, FindRec); - FindClose(Handle); - result := TFileAge(FindRec.ftLastWriteTime) -end; -{$else} -var - f: file; - time: longint; -begin - AssignFile(f, AnsiString(Filename)); - Reset(f); - GetFTime(f, time); - unpackTime(time, result); - CloseFile(f); -end; -{$endif} - -function Newer(file1, file2: PChar): Boolean; -var - Time1, Time2: TFileAge; -begin - Time1 := GetLastWriteTime(file1); - Time2 := GetLastWriteTime(file2); -{$ifdef windows} - if Time1.High <> Time2.High then - result := Time1.High > Time2.High - else - result := Time1.Low > Time2.Low -{$else} - if time1.year <> time2.year then - result := time1.year > time2.year - else if time1.month <> time2.month then - result := time1.month > time2.month - else if time1.day <> time2.day then - result := time1.day > time2.day - else if time1.hour <> time2.hour then - result := time1.hour > time2.hour - else if time1.min <> time2.min then - result := time1.min > time2.min - else if time1.sec <> time2.sec then - result := time1.sec > time2.sec -{$endif} -end; - -{$ifopt I+} {$define I_on} {$I-} {$endif} -function ExistsFile(const filename: string): Boolean; -var - txt: TextFile; -begin - AssignFile(txt, filename); - Reset(txt); - if IOResult = 0 then begin - result := true; - CloseFile(txt) - end - else result := false -end; -{$ifdef I_on} {$I+} {$endif} - -function FileNewer(const a, b: string): Boolean; -begin - if not ExistsFile(PChar(a)) or not ExistsFile(PChar(b)) then - result := false - else - result := newer(PChar(a), PChar(b)) -end; - -end. diff --git a/nim/nstrtabs.pas b/nim/nstrtabs.pas deleted file mode 100755 index bcb10f2eda..0000000000 --- a/nim/nstrtabs.pas +++ /dev/null @@ -1,294 +0,0 @@ -// -// -// Nimrod's Runtime Library -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit nstrtabs; - -// String tables. - -interface - -{$include 'config.inc'} - -uses - nsystem, nos, nhashes, strutils; - -type - TStringTableMode = ( - modeCaseSensitive, // the table is case sensitive - modeCaseInsensitive, // the table is case insensitive - modeStyleInsensitive // the table is style insensitive - ); - TKeyValuePair = record{@tuple} - key, val: string; - end; - TKeyValuePairSeq = array of TKeyValuePair; - TStringTable = object(NObject) - counter: int; - data: TKeyValuePairSeq; - mode: TStringTableMode; - end; - PStringTable = ^TStringTable; - -function newStringTable(const keyValuePairs: array of string; - mode: TStringTableMode = modeCaseSensitive): PStringTable; - -procedure put(t: PStringTable; const key, val: string); -function get(t: PStringTable; const key: string): string; -function hasKey(t: PStringTable; const key: string): bool; -function len(t: PStringTable): int; - -type - TFormatFlag = ( - useEnvironment, // use environment variable if the ``$key`` - // is not found in the table - useEmpty, // use the empty string as a default, thus it - // won't throw an exception if ``$key`` is not - // in the table - useKey // do not replace ``$key`` if it is not found - // in the table (or in the environment) - ); - TFormatFlags = set of TFormatFlag; - -function format(const f: string; t: PStringTable; - flags: TFormatFlags = {@set}[]): string; - -implementation - -const - growthFactor = 2; - startSize = 64; - -{@ignore} -function isNil(const s: string): bool; -begin - result := s = '' -end; -{@emit} - -function newStringTable(const keyValuePairs: array of string; - mode: TStringTableMode = modeCaseSensitive): PStringTable; -var - i: int; -begin - new(result); - result.mode := mode; - result.counter := 0; -{@ignore} - setLength(result.data, startSize); - fillChar(result.data[0], length(result.data)*sizeof(result.data[0]), 0); -{@emit - newSeq(result.data, startSize); } - i := 0; - while i < high(keyValuePairs) do begin - put(result, keyValuePairs[i], keyValuePairs[i+1]); - inc(i, 2); - end -end; - -function myhash(t: PStringTable; const key: string): THash; -begin - case t.mode of - modeCaseSensitive: result := nhashes.GetHashStr(key); - modeCaseInsensitive: result := nhashes.GetHashStrCI(key); - modeStyleInsensitive: result := nhashes.getNormalizedHash(key); - end -end; - -function myCmp(t: PStringTable; const a, b: string): bool; -begin - case t.mode of - modeCaseSensitive: result := cmp(a, b) = 0; - modeCaseInsensitive: result := cmpIgnoreCase(a, b) = 0; - modeStyleInsensitive: result := cmpIgnoreStyle(a, b) = 0; - end -end; - -function mustRehash(len, counter: int): bool; -begin - assert(len > counter); - result := (len * 2 < counter * 3) or (len-counter < 4); -end; - -function len(t: PStringTable): int; -begin - result := t.counter -end; - -{@ignore} -const - EmptySeq = nil; -{@emit -const - EmptySeq = []; -} - -function nextTry(h, maxHash: THash): THash; -begin - result := ((5*h) + 1) and maxHash; - // For any initial h in range(maxHash), repeating that maxHash times - // generates each int in range(maxHash) exactly once (see any text on - // random-number generation for proof). -end; - -function RawGet(t: PStringTable; const key: string): int; -var - h: THash; -begin - h := myhash(t, key) and high(t.data); // start with real hash value - while not isNil(t.data[h].key) do begin - if mycmp(t, t.data[h].key, key) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function get(t: PStringTable; const key: string): string; -var - index: int; -begin - index := RawGet(t, key); - if index >= 0 then result := t.data[index].val - else result := '' -end; - -function hasKey(t: PStringTable; const key: string): bool; -begin - result := rawGet(t, key) >= 0 -end; - -procedure RawInsert(t: PStringTable; - var data: TKeyValuePairSeq; - const key, val: string); -var - h: THash; -begin - h := myhash(t, key) and high(data); - while not isNil(data[h].key) do begin - h := nextTry(h, high(data)) - end; - data[h].key := key; - data[h].val := val; -end; - -procedure Enlarge(t: PStringTable); -var - n: TKeyValuePairSeq; - i: int; -begin -{@ignore} - n := emptySeq; - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); -{@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if not isNil(t.data[i].key) then - RawInsert(t, n, t.data[i].key, t.data[i].val); -{@ignore} - t.data := n; -{@emit - swap(t.data, n); -} -end; - -procedure Put(t: PStringTable; const key, val: string); -var - index: int; -begin - index := RawGet(t, key); - if index >= 0 then - t.data[index].val := val - else begin - if mustRehash(length(t.data), t.counter) then Enlarge(t); - RawInsert(t, t.data, key, val); - inc(t.counter) - end; -end; - -{@ignore} -type - EInvalidValue = int; // dummy for the Pascal compiler -{@emit} - -procedure RaiseFormatException(const s: string); -var - e: ^EInvalidValue; -begin -{@ignore} - raise EInvalidFormatStr.create(s); -{@emit - new(e);} -{@emit - e.msg := 'format string: key not found: ' + s;} -{@emit - raise e;} -end; - -function getValue(t: PStringTable; flags: TFormatFlags; - const key: string): string; -begin - if hasKey(t, key) then begin - result := get(t, key); exit - end; - if useEnvironment in flags then - result := nos.getEnv(key) - else - result := ''; - if (result = '') then begin - if useKey in flags then result := '$' + key - else if not (useEmpty in flags) then - raiseFormatException(key) - end -end; - -function format(const f: string; t: PStringTable; - flags: TFormatFlags = {@set}[]): string; -const - PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', '_', #128..#255]; -var - i, j: int; - key: string; -begin - result := ''; - i := strStart; - while i <= length(f)+strStart-1 do - if f[i] = '$' then begin - case f[i+1] of - '$': begin - addChar(result, '$'); - inc(i, 2); - end; - '{': begin - j := i+1; - while (j <= length(f)+strStart-1) and (f[j] <> '}') do inc(j); - key := ncopy(f, i+2+strStart-1, j-1+strStart-1); - add(result, getValue(t, flags, key)); - i := j+1 - end; - 'a'..'z', 'A'..'Z', #128..#255, '_': begin - j := i+1; - while (j <= length(f)+strStart-1) and (f[j] in PatternChars) do inc(j); - key := ncopy(f, i+1+strStart-1, j-1+strStart-1); - add(result, getValue(t, flags, key)); - i := j - end - else begin - addChar(result, f[i]); - inc(i) - end - end - end - else begin - addChar(result, f[i]); - inc(i) - end -end; - -end. diff --git a/nim/nsystem.pas b/nim/nsystem.pas deleted file mode 100755 index 4cdfade937..0000000000 --- a/nim/nsystem.pas +++ /dev/null @@ -1,657 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit nsystem; - -// This module provides things that are in Nimrod's system -// module and not available in Pascal. - -interface - -{$include 'config.inc'} - -uses - sysutils -{$ifdef fpc} - , math -{$endif} - ; - -type - // Generic int like in Nimrod: - // well, no, because of FPC's bugs... -{$ifdef cpu64} - int = int64; - uint = qword; -{$else} - int = longint; - uint = cardinal; -{$endif} - - TResult = Boolean; - EInvalidValue = class(Exception) - end; - -{$ifndef fpc} - EOverflow = class(Exception) - end; -{$endif} - EOutOfRange = class(Exception) - end; - EOS = class(Exception) end; - - float32 = single; - float64 = double; - PFloat32 = ^float32; - PFloat64 = ^float64; -const - Failure = False; - Success = True; - - snil = ''; - -type - TStringSeq = array of string; - TCharSet = set of Char; - - -type - Natural = 0..high(int); - Positive = 1..high(int); - NObject = object // base type for all objects, cannot use - // TObject here, as it would overwrite System.TObject which is - // a class in Object pascal. Anyway, pas2mor has no problems - // to replace NObject by TObject - end; - PObject = ^NObject; - - int16 = smallint; - int8 = shortint; - int32 = longint; - uint16 = word; - uint32 = longword; - uint8 = byte; - - TByteArray = array [0..1024 * 1024] of Byte; - PByteArray = ^TByteArray; - PByte = ^Byte; - cstring = pchar; - bool = boolean; - PInt32 = ^int32; - -{$ifdef bit64clean} // BUGIX: was $ifdef fpc - BiggestUInt = QWord; - BiggestInt = Int64; // biggest integer type available -{$else} - BiggestUInt = Cardinal; // Delphi's Int64 is broken seriously - BiggestInt = Integer; // ditto -{$endif} - BiggestFloat = Double; // biggest floating point type -{$ifdef cpu64} - TAddress = Int64; -{$else} - TAddress = longint; -{$endif} - -var - NaN: float; - inf: float; - NegInf: float; -{$ifdef fpc} -{$else} - {$ifopt Q+} - {$define Q_on} - {$Q-} - {$endif} - {$ifopt R+} - {$define R_on} - {$R-} - {$endif} - const - Inf = 1.0/0.0; - NegInf = (-1.0) / 0.0; - {$ifdef Q_on} - {$Q+} - {$undef Q_on} - {$endif} - {$ifdef R_on} - {$R+} - {$undef R_on} - {$endif} -{$endif} - -function toFloat(i: biggestInt): biggestFloat; -function toInt(r: biggestFloat): biggestInt; - -function min(a, b: int): int; overload; -function max(a, b: int): int; overload; -{$ifndef fpc} // fpc cannot handle these overloads (bug in 64bit version?) -// the Nimrod compiler does not use them anyway, so it does not matter -function max(a, b: real): real; overload; -function min(a, b: real): real; overload; -{$endif} - -procedure zeroMem(p: Pointer; size: int); -procedure copyMem(dest, source: Pointer; size: int); -procedure moveMem(dest, source: Pointer; size: int); -function equalMem(a, b: Pointer; size: int): Boolean; - -function ncopy(s: string; a: int = 1): string; overload; -function ncopy(s: string; a, b: int): string; overload; -// will be replaced by "copy" - -function newString(len: int): string; - -procedure addChar(var s: string; c: Char); - -{@ignore} -function addU(a, b: biggestInt): biggestInt; -function subU(a, b: biggestInt): biggestInt; -function mulU(a, b: biggestInt): biggestInt; -function divU(a, b: biggestInt): biggestInt; -function modU(a, b: biggestInt): biggestInt; -function shlU(a, b: biggestInt): biggestInt; overload; -function shrU(a, b: biggestInt): biggestInt; overload; - -function shlU(a, b: Int32): Int32;overload; -function shrU(a, b: int32): int32;overload; - -function ltU(a, b: biggestInt): bool; -function leU(a, b: biggestInt): bool; - -function toU8(a: biggestInt): byte; -function toU16(a: biggestInt): int16; -function toU32(a: biggestInt): int32; -function ze64(a: byte): biggestInt; -function ze(a: byte): int; -{@emit} - -function alloc(size: int): Pointer; -function realloc(p: Pointer; newsize: int): Pointer; -procedure dealloc(p: Pointer); - -type - TTextFile = record - buf: PChar; - sysFile: system.textFile; - end; - - TBinaryFile = file; - - TFileMode = (fmRead, fmWrite, fmReadWrite, fmReadWriteExisting, fmAppend); - -function OpenFile(out f: tTextFile; const filename: string; - mode: TFileMode = fmRead): Boolean; overload; -function endofFile(var f: tBinaryFile): boolean; overload; -function endofFile(var f: textFile): boolean; overload; - -function readChar(var f: tTextFile): char; -function readLine(var f: tTextFile): string; overload; -function readLine(var f: tBinaryFile): string; overload; -function readLine(var f: textFile): string; overload; - -procedure nimWrite(var f: tTextFile; const str: string); overload; -procedure nimCloseFile(var f: tTextFile); overload; - -// binary file handling: -function OpenFile(var f: tBinaryFile; const filename: string; - mode: TFileMode = fmRead): Boolean; overload; -procedure nimCloseFile(var f: tBinaryFile); overload; - -function ReadBytes(var f: tBinaryFile; out a: array of byte; - start, len: int): int; -function ReadChars(var f: tBinaryFile; out a: array of char; - start, len: int): int; - -function writeBuffer(var f: TBinaryFile; buffer: pointer; len: int): int; -function readBuffer(var f: tBinaryFile; buffer: pointer; len: int): int; -overload; -function readBuffer(var f: tBinaryFile): string; overload; -function getFilePos(var f: tBinaryFile): int; -procedure setFilePos(var f: tBinaryFile; pos: int64); - -function readFile(const filename: string): string; - -procedure nimWrite(var f: tBinaryFile; const str: string); overload; - -procedure add(var x: string; const y: string); overload; -// Pascal version of string appending. Terminating zero is ignored. - -procedure add(var s: TStringSeq; const y: string); overload; - -function isNil(s: string): bool; - -implementation - -function isNil(s: string): bool; -begin - result := s = ''; -end; - -{@ignore} -procedure add(var x: string; const y: string); -// Pascal version of string appending. Terminating zero is ignored. -var - L: int; -begin - L := length(y); - if L > 0 then begin - if y[L] = #0 then x := x + copy(y, 1, L-1) - else x := x + y; - end -end; - -procedure add(var s: TStringSeq; const y: string); overload; -var - L: int; -begin - L := length(s); - setLength(s, L+1); - s[L] := y; -end; -{@emit} - -function alloc(size: int): Pointer; -begin - getMem(result, size); // use standard allocator - FillChar(result^, size, 0); -end; - -function realloc(p: Pointer; newsize: int): Pointer; -begin - reallocMem(p, newsize); // use standard allocator - result := p; -end; - -procedure dealloc(p: pointer); -begin - freeMem(p); -end; - -{@ignore} -function addU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) + biggestUInt(b)); -end; - -function subU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) - biggestUInt(b)); -end; - -function mulU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) * biggestUInt(b)); -end; - -function divU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) div biggestUInt(b)); -end; - -function modU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) mod biggestUInt(b)); -end; - -function shlU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) shl biggestUInt(b)); -end; - -function shrU(a, b: biggestInt): biggestInt; -begin - result := biggestInt(biggestUInt(a) shr biggestUInt(b)); -end; - -function shlU(a, b: Int32): Int32; -begin - result := Int32(UInt32(a) shl UInt32(b)); -end; - -function shrU(a, b: int32): int32; -begin - result := Int32(UInt32(a) shr UInt32(b)); -end; - -function ltU(a, b: biggestInt): bool; -begin - result := biggestUInt(a) < biggestUInt(b); -end; - -function leU(a, b: biggestInt): bool; -begin - result := biggestUInt(a) < biggestUInt(b); -end; - -function toU8(a: biggestInt): byte; -begin - assert(a >= 0); - assert(a <= 255); - result := a; -end; - -function toU32(a: biggestInt): int32; -begin - result := int32(a and $ffffffff); -end; - -function toU16(a: biggestInt): int16; -begin - result := int16(a and $ffff); -end; - -function ze64(a: byte): biggestInt; -begin - result := a -end; - -function ze(a: byte): int; -begin - result := a -end; -{@emit} - -procedure addChar(var s: string; c: Char); -{@ignore} -// delphi produces suboptimal code for "s := s + c" -{$ifndef fpc} -var - len: int; -{$endif} -{@emit} -begin -{@ignore} -{$ifdef fpc} - s := s + c -{$else} - {$ifopt H+} - len := length(s); - setLength(s, len + 1); - PChar(Pointer(s))[len] := c - {$else} - s := s + c - {$endif} -{$endif} -{@emit - s &= c -} -end; - -function newString(len: int): string; -begin - setLength(result, len); - if len > 0 then begin - {@ignore} - fillChar(result[1], length(result), 0); - {@emit} - end -end; - -function toFloat(i: BiggestInt): BiggestFloat; -begin - result := i // conversion automatically in Pascal -end; - -function toInt(r: BiggestFloat): BiggestInt; -begin - result := round(r); -end; - -procedure zeroMem(p: Pointer; size: int); -begin - fillChar(p^, size, 0); -end; - -procedure copyMem(dest, source: Pointer; size: int); -begin - if size > 0 then - move(source^, dest^, size); -end; - -procedure moveMem(dest, source: Pointer; size: int); -begin - if size > 0 then - move(source^, dest^, size); // move handles overlapping regions -end; - -function equalMem(a, b: Pointer; size: int): Boolean; -begin - result := compareMem(a, b, size); -end; - -{$ifndef fpc} -function min(a, b: real): real; overload; -begin - if a < b then result := a else result := b -end; - -function max(a, b: real): real; overload; -begin - if a > b then result := a else result := b -end; -{$endif} - -function min(a, b: int): int; overload; -begin - if a < b then result := a else result := b -end; - -function max(a, b: int): int; overload; -begin - if a > b then result := a else result := b -end; - -function ncopy(s: string; a, b: int): string; -begin - result := copy(s, a, b-a+1); -end; - -function ncopy(s: string; a: int = 1): string; -begin - result := copy(s, a, length(s)) -end; - - -{$ifopt I+} {$define I_on} {$I-} {$endif} -function OpenFile(out f: tTextFile; const filename: string; - mode: TFileMode = fmRead): Boolean; overload; -begin - AssignFile(f.sysFile, filename); - f.buf := alloc(4096); - SetTextBuf(f.sysFile, f.buf^, 4096); - case mode of - fmRead: Reset(f.sysFile); - fmWrite: Rewrite(f.sysFile); - fmReadWrite: Reset(f.sysFile); - fmAppend: Append(f.sysFile); - end; - result := (IOResult = 0); -end; - -function readChar(var f: tTextFile): char; -begin - Read(f.sysFile, result); -end; - -procedure nimWrite(var f: tTextFile; const str: string); -begin - system.write(f.sysFile, str) -end; - -function readLine(var f: tTextFile): string; -begin - Readln(f.sysFile, result); -end; - -function endofFile(var f: tBinaryFile): boolean; -begin - result := eof(f) -end; - -function endofFile(var f: textFile): boolean; -begin - result := eof(f) -end; - -procedure nimCloseFile(var f: tTextFile); -begin - closeFile(f.sysFile); - dealloc(f.buf) -end; - -procedure nimCloseFile(var f: tBinaryFile); -begin - closeFile(f); -end; - -function OpenFile(var f: TBinaryFile; const filename: string; - mode: TFileMode = fmRead): Boolean; -begin - AssignFile(f, filename); - case mode of - fmRead: Reset(f, 1); - fmWrite: Rewrite(f, 1); - fmReadWrite: Reset(f, 1); - fmAppend: assert(false); - end; - result := (IOResult = 0); -end; - -function ReadBytes(var f: tBinaryFile; out a: array of byte; - start, len: int): int; -begin - result := 0; - BlockRead(f, a[0], len, result) -end; - -function ReadChars(var f: tBinaryFile; out a: array of char; - start, len: int): int; -begin - result := 0; - BlockRead(f, a[0], len, result) -end; - -function readBuffer(var f: tBinaryFile; buffer: pointer; len: int): int; -begin - result := 0; - BlockRead(f, buffer^, len, result) -end; - -procedure nimWrite(var f: tBinaryFile; const str: string); overload; -begin - writeBuffer(f, addr(str[1]), length(str)); -end; - -function readLine(var f: tBinaryFile): string; overload; -var - c: char; -begin - result := ''; - while readBuffer(f, addr(c), 1) = 1 do begin - case c of - #13: begin - readBuffer(f, addr(c), 1); // skip #10 - break; - end; - #10: break; - else begin end - end; - addChar(result, c); - end -end; - -function readLine(var f: textFile): string; overload; -begin - result := ''; - readln(f, result); -end; - -function readBuffer(var f: tBinaryFile): string; overload; -const - bufSize = 4096; -var - bytesRead, len, cap: int; -begin - // read the file in 4K chunks - result := newString(bufSize); - cap := bufSize; - len := 0; - while true do begin - bytesRead := readBuffer(f, addr(result[len+1]), bufSize); - inc(len, bytesRead); - if bytesRead <> bufSize then break; - inc(cap, bufSize); - setLength(result, cap); - end; - setLength(result, len); -end; - -function readFile(const filename: string): string; -var - f: tBinaryFile; -begin - if openFile(f, filename) then begin - result := readBuffer(f); - nimCloseFile(f) - end - else - result := ''; -end; - -function writeBuffer(var f: TBinaryFile; buffer: pointer; - len: int): int; -begin - result := 0; - BlockWrite(f, buffer^, len, result); -end; - -function getFilePos(var f: tBinaryFile): int; -begin - result := filePos(f); -end; - -procedure setFilePos(var f: tBinaryFile; pos: int64); -begin - Seek(f, pos); -end; - -{$ifdef I_on} {$undef I_on} {$I+} {$endif} - -{$ifopt R+} {$R-,Q-} {$define R_on} {$endif} -var - zero: float; - Saved8087CW: Word; - savedExcMask: TFPUExceptionMask; -initialization -{$ifdef cpu64} - savedExcMask := SetExceptionMask([exInvalidOp, - exDenormalized, - exPrecision, - exZeroDivide, - exOverflow, - exUnderflow - ]); -{$else} - Saved8087CW := Default8087CW; - Set8087CW($133f); // Disable all fpu exceptions -{$endif} - zero := 0.0; - NaN := 0.0 / zero; - inf := 1.0 / zero; - NegInf := -inf; -finalization -{$ifdef cpu64} - SetExceptionMask(savedExcMask); // set back exception mask -{$else} - Set8087CW(Saved8087CW); -{$endif} -{$ifdef R_on} - {$R+,Q+} -{$endif} -end. diff --git a/nim/ntime.pas b/nim/ntime.pas deleted file mode 100755 index 9135c26c3f..0000000000 --- a/nim/ntime.pas +++ /dev/null @@ -1,107 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ntime; - -interface - -{$include 'config.inc'} - -uses -{$ifdef win32} - windows, -{$else} - sysutils, - {$ifdef fpc} - dos, - {$endif} -{$endif} - nsystem, strutils; - -function DateAndClock: string; -// returns current date and time (format: YYYY-MM-DD Sec:Min:Hour) - -function getDateStr: string; -function getClockStr: string; - -implementation - -{$ifdef mswindows} -function GetDateStr: string; -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - result := IntToStr(st.wYear, 4) + '-' + IntToStr(st.wMonth, 2) + '-' - + IntToStr(st.wDay, 2) -end; - -procedure GetDate(var Day, Month, Year: int); -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - Day := st.wDay; - Month := st.wMonth; - Year := st.wYear -end; - -procedure GetTime(var Hours, Minutes, Seconds, Millisec: int); -var - st: SystemTime; -begin - Windows.GetLocalTime({$ifdef fpc} @ {$endif} st); - Hours := st.wHour; - Minutes := st.wMinute; - Seconds := st.wSecond; - Millisec := st.wMilliseconds -end; -{$else} // not windows -function GetDateStr: string; -var - wMonth, wYear, wDay: Word; -begin - SysUtils.DecodeDate(Date, wYear, wMonth, wDay); - result := IntToStr(wYear, 4) + '-' + IntToStr(wMonth, 2) + '-' - + IntToStr(wDay, 2) -end; - -procedure GetDate(var Day, Month, Year: int); -var - wMonth, wYear, wDay: Word; -begin - SysUtils.DecodeDate(Date, wYear, wMonth, wDay); - Day := wDay; - Month := wMonth; - Year := wYear -end; - -procedure GetTime(var Hours, Minutes, Seconds, Millisec: int); -var - wHour, wMin, wSec, wMSec: Word; -begin - SysUtils.DecodeTime(Time, wHour, wMin, wSec, wMSec); - Hours := wHour; Minutes := wMin; Seconds := wSec; Millisec := wMSec; -end; -{$endif} - -function GetClockStr: string; -var - Hour, Min, Sec, MSec: int; -begin - GetTime(Hour, min, sec, msec); - result := IntToStr(Hour, 2) + ':' + IntToStr(min, 2) + ':' + IntToStr(Sec, 2) -end; - -function DateAndClock: string; -begin - result := GetDateStr() + ' ' + getClockStr() -end; - -end. - diff --git a/nim/nversion.pas b/nim/nversion.pas deleted file mode 100755 index c9bdd24fbc..0000000000 --- a/nim/nversion.pas +++ /dev/null @@ -1,42 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit nversion; - -// this unit implements the version handling - -interface - -{$include 'config.inc'} - -uses - strutils; - -const - MaxSetElements = 1 shl 16; // (2^16) to support unicode character sets? - defaultAsmMarkerSymbol = '!'; - - //[[[cog - //from koch import NIMROD_VERSION - //from string import split - //cog.outl("VersionAsString = '%s';" % NIMROD_VERSION) - //ver = split(NIMROD_VERSION, '.') - //cog.outl('VersionMajor = %s;' % ver[0]) - //cog.outl('VersionMinor = %s;' % ver[1]) - //cog.outl('VersionPatch = %s;' % ver[2]) - //]]] - VersionAsString = '0.8.3'; - VersionMajor = 0; - VersionMinor = 8; - VersionPatch = 3; - //[[[[end]]]] - -implementation - -end. diff --git a/nim/options.pas b/nim/options.pas deleted file mode 100755 index 3a7d4a669c..0000000000 --- a/nim/options.pas +++ /dev/null @@ -1,291 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit options; - -interface - -{$include 'config.inc'} - -uses - nsystem, nos, lists, strutils, nstrtabs; - -type - // please make sure we have under 32 options - // (improves code efficiency a lot!) - TOption = ( // **keep binary compatible** - optNone, - optObjCheck, - optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, optNilCheck, optAssert, optLineDir, - optWarns, optHints, - optOptimizeSpeed, - optOptimizeSize, - optStackTrace, // stack tracing support - optLineTrace, // line tracing support (includes stack tracing) - optEndb, // embedded debugger - optByRef, // use pass by ref for records (for interfacing with C) - optCheckpoints, // check for checkpoints (used for debugging) - optProfiler // profiler turned on - ); - TOptions = set of TOption; - - TGlobalOption = (gloptNone, optForceFullMake, optBoehmGC, - optRefcGC, optDeadCodeElim, optListCmd, optCompileOnly, optNoLinking, - optSafeCode, // only allow safe code - optCDebug, // turn on debugging information - optGenDynLib, // generate a dynamic library - optGenGuiApp, // generate a GUI application - optGenScript, // generate a script file to compile the *.c files - optGenMapping, // generate a mapping file - optRun, // run the compiled project - optSymbolFiles, // use symbol files for speeding up compilation - optSkipConfigFile, // skip the general config file - optSkipProjConfigFile, // skip the project's config file - optNoMain // do not generate a "main" proc - ); - TGlobalOptions = set of TGlobalOption; - - TCommands = ( // Nimrod's commands - cmdNone, - cmdCompileToC, - cmdCompileToCpp, - cmdCompileToEcmaScript, - cmdCompileToLLVM, - cmdInterpret, - cmdPretty, - cmdDoc, - cmdPas, - cmdBoot, - cmdGenDepend, - cmdListDef, - cmdCheck, // semantic checking for whole project - cmdParse, // parse a single file (for debugging) - cmdScan, // scan a single file (for debugging) - cmdDebugTrans, // debug a transformation pass - cmdRst2html, // convert a reStructuredText file to HTML - cmdRst2tex, // convert a reStructuredText file to TeX - cmdInteractive // start interactive session - ); - TStringSeq = array of string; - -const - ChecksOptions = {@set}[optObjCheck, optFieldCheck, optRangeCheck, - optNilCheck, optOverflowCheck, optBoundsCheck, - optAssert]; - optionToStr: array [TOption] of string = ( - 'optNone', 'optObjCheck', 'optFieldCheck', 'optRangeCheck', - 'optBoundsCheck', 'optOverflowCheck', 'optNilCheck', 'optAssert', - 'optLineDir', 'optWarns', 'optHints', 'optOptimizeSpeed', - 'optOptimizeSize', 'optStackTrace', 'optLineTrace', 'optEmdb', - 'optByRef', 'optCheckpoints', 'optProfiler' - ); -var - gOptions: TOptions = {@set}[optObjCheck, optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, - optAssert, optWarns, optHints, - optStackTrace, optLineTrace]; - - gGlobalOptions: TGlobalOptions = {@set}[optRefcGC]; - - gExitcode: Byte; - searchPaths: TLinkedList; - outFile: string = ''; - gIndexFile: string = ''; - - gCmd: TCommands = cmdNone; // the command - - gVerbosity: int; // how verbose the compiler is - gNumberOfProcessors: int; // number of processors - -function FindFile(const f: string): string; - -const - genSubDir = 'nimcache'; - NimExt = 'nim'; - RodExt = 'rod'; - HtmlExt = 'html'; - TexExt = 'tex'; - IniExt = 'ini'; - DocConfig = 'nimdoc.cfg'; - DocTexConfig = 'nimdoc.tex.cfg'; - -function completeGeneratedFilePath(const f: string; - createSubDir: bool = true): string; - -function toGeneratedFile(const path, ext: string): string; -// converts "/home/a/mymodule.nim", "rod" to "/home/a/nimcache/mymodule.rod" - -function getPrefixDir: string; -// gets the application directory - -// additional configuration variables: -var - gConfigVars: PStringTable; - libpath: string = ''; - projectPath: string = ''; - gKeepComments: boolean = true; // whether the parser needs to keep comments - gImplicitMods: TStringSeq = {@ignore} nil {@emit @[]}; - // modules that are to be implicitly imported - -function existsConfigVar(const key: string): bool; -function getConfigVar(const key: string): string; -procedure setConfigVar(const key, val: string); - -procedure addImplicitMod(const filename: string); - -function getOutFile(const filename, ext: string): string; - -function binaryStrSearch(const x: array of string; const y: string): int; - -implementation - -function existsConfigVar(const key: string): bool; -begin - result := hasKey(gConfigVars, key) -end; - -function getConfigVar(const key: string): string; -begin - result := nstrtabs.get(gConfigVars, key); -end; - -procedure setConfigVar(const key, val: string); -begin - nstrtabs.put(gConfigVars, key, val); -end; - -function getOutFile(const filename, ext: string): string; -begin - if options.outFile <> '' then result := options.outFile - else result := changeFileExt(filename, ext) -end; - -procedure addImplicitMod(const filename: string); -var - len: int; -begin - len := length(gImplicitMods); - setLength(gImplicitMods, len+1); - gImplicitMods[len] := filename; -end; - -function getPrefixDir: string; -begin - result := SplitPath(getApplicationDir()).head; -end; - -function shortenDir(const dir: string): string; -var - prefix: string; -begin - // returns the interesting part of a dir - prefix := getPrefixDir() +{&} dirSep; - if startsWith(dir, prefix) then begin - result := ncopy(dir, length(prefix) + strStart); exit - end; - prefix := getCurrentDir() +{&} dirSep; - if startsWith(dir, prefix) then begin - result := ncopy(dir, length(prefix) + strStart); exit - end; - prefix := projectPath +{&} dirSep; - //writeln(output, prefix); - //writeln(output, dir); - if startsWith(dir, prefix) then begin - result := ncopy(dir, length(prefix) + strStart); exit - end; - result := dir; -end; - -function removeTrailingDirSep(const path: string): string; -begin - if (length(path) > 0) and (path[length(path)+strStart-1] = dirSep) then - result := ncopy(path, strStart, length(path)+strStart-2) - else - result := path -end; - -function toGeneratedFile(const path, ext: string): string; -var - head, tail: string; -begin - splitPath(path, head, tail); - if length(head) > 0 then head := shortenDir(head +{&} dirSep); - result := joinPath([projectPath, genSubDir, head, - changeFileExt(tail, ext)]) -end; - -function completeGeneratedFilePath(const f: string; - createSubDir: bool = true): string; -var - head, tail, subdir: string; -begin - splitPath(f, head, tail); - if length(head) > 0 then - head := removeTrailingDirSep(shortenDir(head +{&} dirSep)); - subdir := joinPath([projectPath, genSubDir, head]); - if createSubDir then begin - try - createDir(subdir); - except - on EOS do begin - writeln(output, 'cannot create directory: ' + subdir); - halt(1) - end - end - end; - result := joinPath(subdir, tail) -end; - -function rawFindFile(const f: string): string; -var - it: PStrEntry; -begin - if ExistsFile(f) then result := f - else begin - it := PStrEntry(SearchPaths.head); - while it <> nil do begin - result := JoinPath(it.data, f); - if ExistsFile(result) then exit; - it := PStrEntry(it.Next) - end; - result := '' - end -end; - -function FindFile(const f: string): string; -begin - result := rawFindFile(f); - if length(result) = 0 then - result := rawFindFile(toLower(f)); -end; - -function binaryStrSearch(const x: array of string; const y: string): int; -var - a, b, mid, c: int; -begin - a := 0; - b := length(x)-1; - while a <= b do begin - mid := (a + b) div 2; - c := cmpIgnoreCase(x[mid], y); - if c < 0 then - a := mid + 1 - else if c > 0 then - b := mid - 1 - else begin - result := mid; - exit - end - end; - result := -1 -end; - -initialization - gConfigVars := newStringTable([], modeStyleInsensitive); -end. diff --git a/nim/osproc.pas b/nim/osproc.pas deleted file mode 100755 index 485daaf678..0000000000 --- a/nim/osproc.pas +++ /dev/null @@ -1,58 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit osproc; - -// This module provides Nimrod's osproc module in Pascal -// Note: Only implement what is really needed here! - -interface - -{$include 'config.inc'} - -uses - nsystem, nos; - -type - TProcessOption = (poEchoCmd, poUseShell, poStdErrToStdOut, poParentStreams); - TProcessOptions = set of TProcessOption; - -function execCmd(const cmd: string): int; -function execProcesses(const cmds: array of string; - options: TProcessOptions; - n: int): int; - -function countProcessors(): int; - -implementation - -function execCmd(const cmd: string): int; -begin - writeln(output, cmd); - result := executeShellCommand(cmd); -end; - -function execProcesses(const cmds: array of string; - options: TProcessOptions; - n: int): int; -var - i: int; -begin - result := 0; - for i := 0 to high(cmds) do begin - //if poEchoCmd in options then writeln(output, cmds[i]); - result := max(result, execCmd(cmds[i])) - end -end; - -function countProcessors(): int; -begin - result := 1; -end; - -end. diff --git a/nim/parsecfg.pas b/nim/parsecfg.pas deleted file mode 100755 index ba6a986794..0000000000 --- a/nim/parsecfg.pas +++ /dev/null @@ -1,424 +0,0 @@ -// -// -// Nimrod's Runtime Library -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit parsecfg; - -// A HIGH-PERFORMANCE configuration file parser; -// the Nimrod version of this file is part of the -// standard library. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, llstream, sysutils, nhashes, strutils, lexbase; - -type - TCfgEventKind = ( - cfgEof, // end of file reached - cfgSectionStart, // a ``[section]`` has been parsed - cfgKeyValuePair, // a ``key=value`` pair has been detected - cfgOption, // a ``--key=value`` command line option - cfgError // an error ocurred during parsing; msg contains the - // error message - ); - TCfgEvent = {@ignore} record - kind: TCfgEventKind; - section: string; - key, value: string; - msg: string; - end; - {@emit object(NObject) - case kind: TCfgEventKind of - cfgEof: (); - cfgSectionStart: (section: string); - cfgKeyValuePair, cfgOption: (key, value: string); - cfgError: (msg: string); - end;} - TTokKind = (tkInvalid, tkEof, // order is important here! - tkSymbol, tkEquals, tkColon, - tkBracketLe, tkBracketRi, tkDashDash - ); - TToken = record // a token - kind: TTokKind; // the type of the token - literal: string; // the parsed (string) literal - end; - TParserState = (startState, commaState); - TCfgParser = object(TBaseLexer) - tok: TToken; - state: TParserState; - filename: string; - end; - -procedure Open(var c: TCfgParser; const filename: string; - inputStream: PLLStream); -procedure Close(var c: TCfgParser); - -function next(var c: TCfgParser): TCfgEvent; - -function getColumn(const c: TCfgParser): int; -function getLine(const c: TCfgParser): int; -function getFilename(const c: TCfgParser): string; - -function errorStr(const c: TCfgParser; const msg: string): string; - -implementation - -const - SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', '_', #128..#255]; - -// ---------------------------------------------------------------------------- -procedure rawGetTok(var c: TCfgParser; var tok: TToken); forward; - -procedure open(var c: TCfgParser; const filename: string; - inputStream: PLLStream); -begin -{@ignore} - FillChar(c, sizeof(c), 0); -{@emit} - openBaseLexer(c, inputStream); - c.filename := filename; - c.state := startState; - c.tok.kind := tkInvalid; - c.tok.literal := ''; - rawGetTok(c, c.tok); -end; - -procedure close(var c: TCfgParser); -begin - closeBaseLexer(c); -end; - -function getColumn(const c: TCfgParser): int; -begin - result := getColNumber(c, c.bufPos) -end; - -function getLine(const c: TCfgParser): int; -begin - result := c.linenumber -end; - -function getFilename(const c: TCfgParser): string; -begin - result := c.filename -end; - -// ---------------------------------------------------------------------------- - -procedure handleHexChar(var c: TCfgParser; var xi: int); -begin - case c.buf[c.bufpos] of - '0'..'9': begin - xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')); - inc(c.bufpos); - end; - 'a'..'f': begin - xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10); - inc(c.bufpos); - end; - 'A'..'F': begin - xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10); - inc(c.bufpos); - end; - else begin end // do nothing - end -end; - -procedure handleDecChars(var c: TCfgParser; var xi: int); -begin - while c.buf[c.bufpos] in ['0'..'9'] do begin - xi := (xi * 10) + (ord(c.buf[c.bufpos]) - ord('0')); - inc(c.bufpos); - end; -end; - -procedure getEscapedChar(var c: TCfgParser; var tok: TToken); -var - xi: int; -begin - inc(c.bufpos); // skip '\' - case c.buf[c.bufpos] of - 'n', 'N': begin - tok.literal := tok.literal +{&} nl; - Inc(c.bufpos); - end; - 'r', 'R', 'c', 'C': begin addChar(tok.literal, CR); Inc(c.bufpos); end; - 'l', 'L': begin addChar(tok.literal, LF); Inc(c.bufpos); end; - 'f', 'F': begin addChar(tok.literal, FF); inc(c.bufpos); end; - 'e', 'E': begin addChar(tok.literal, ESC); Inc(c.bufpos); end; - 'a', 'A': begin addChar(tok.literal, BEL); Inc(c.bufpos); end; - 'b', 'B': begin addChar(tok.literal, BACKSPACE); Inc(c.bufpos); end; - 'v', 'V': begin addChar(tok.literal, VT); Inc(c.bufpos); end; - 't', 'T': begin addChar(tok.literal, Tabulator); Inc(c.bufpos); end; - '''', '"': begin addChar(tok.literal, c.buf[c.bufpos]); Inc(c.bufpos); end; - '\': begin addChar(tok.literal, '\'); Inc(c.bufpos) end; - 'x', 'X': begin - inc(c.bufpos); - xi := 0; - handleHexChar(c, xi); - handleHexChar(c, xi); - addChar(tok.literal, Chr(xi)); - end; - '0'..'9': begin - xi := 0; - handleDecChars(c, xi); - if (xi <= 255) then - addChar(tok.literal, Chr(xi)) - else - tok.kind := tkInvalid - end - else tok.kind := tkInvalid - end -end; - -function HandleCRLF(var c: TCfgParser; pos: int): int; -begin - case c.buf[pos] of - CR: result := lexbase.HandleCR(c, pos); - LF: result := lexbase.HandleLF(c, pos); - else result := pos - end -end; - -procedure getString(var c: TCfgParser; var tok: TToken; rawMode: Boolean); -var - pos: int; - ch: Char; - buf: PChar; -begin - pos := c.bufPos + 1; // skip " - buf := c.buf; // put `buf` in a register - tok.kind := tkSymbol; - if (buf[pos] = '"') and (buf[pos+1] = '"') then begin - // long string literal: - inc(pos, 2); // skip "" - // skip leading newline: - pos := HandleCRLF(c, pos); - buf := c.buf; - repeat - case buf[pos] of - '"': begin - if (buf[pos+1] = '"') and (buf[pos+2] = '"') then - break; - addChar(tok.literal, '"'); - Inc(pos) - end; - CR, LF: begin - pos := HandleCRLF(c, pos); - buf := c.buf; - tok.literal := tok.literal +{&} nl; - end; - lexbase.EndOfFile: begin - tok.kind := tkInvalid; - break - end - else begin - addChar(tok.literal, buf[pos]); - Inc(pos) - end - end - until false; - c.bufpos := pos + 3 // skip the three """ - end - else begin // ordinary string literal - repeat - ch := buf[pos]; - if ch = '"' then begin - inc(pos); // skip '"' - break - end; - if ch in [CR, LF, lexbase.EndOfFile] then begin - tok.kind := tkInvalid; - break - end; - if (ch = '\') and not rawMode then begin - c.bufPos := pos; - getEscapedChar(c, tok); - pos := c.bufPos; - end - else begin - addChar(tok.literal, ch); - Inc(pos) - end - until false; - c.bufpos := pos; - end -end; - -procedure getSymbol(var c: TCfgParser; var tok: TToken); -var - pos: int; - buf: pchar; -begin - pos := c.bufpos; - buf := c.buf; - while true do begin - addChar(tok.literal, buf[pos]); - Inc(pos); - if not (buf[pos] in SymChars) then break; - end; - c.bufpos := pos; - tok.kind := tkSymbol -end; - -procedure skip(var c: TCfgParser); -var - buf: PChar; - pos: int; -begin - pos := c.bufpos; - buf := c.buf; - repeat - case buf[pos] of - ' ': Inc(pos); - Tabulator: inc(pos); - '#', ';': while not (buf[pos] in [CR, LF, lexbase.EndOfFile]) do inc(pos); - CR, LF: begin - pos := HandleCRLF(c, pos); - buf := c.buf; - end - else break // EndOfFile also leaves the loop - end - until false; - c.bufpos := pos; -end; - -procedure rawGetTok(var c: TCfgParser; var tok: TToken); -begin - tok.kind := tkInvalid; - setLength(tok.literal, 0); - skip(c); - case c.buf[c.bufpos] of - '=': begin - tok.kind := tkEquals; - inc(c.bufpos); - tok.literal := '='+''; - end; - '-': begin - inc(c.bufPos); - if c.buf[c.bufPos] = '-' then inc(c.bufPos); - tok.kind := tkDashDash; - tok.literal := '--'; - end; - ':': begin - tok.kind := tkColon; - inc(c.bufpos); - tok.literal := ':'+''; - end; - 'r', 'R': begin - if c.buf[c.bufPos+1] = '"' then begin - Inc(c.bufPos); - getString(c, tok, true); - end - else - getSymbol(c, tok); - end; - '[': begin - tok.kind := tkBracketLe; - inc(c.bufpos); - tok.literal := '['+''; - end; - ']': begin - tok.kind := tkBracketRi; - Inc(c.bufpos); - tok.literal := ']'+''; - end; - '"': getString(c, tok, false); - lexbase.EndOfFile: tok.kind := tkEof; - else getSymbol(c, tok); - end -end; - -function errorStr(const c: TCfgParser; const msg: string): string; -begin - result := format('$1($2, $3) Error: $4', [ - c.filename, toString(getLine(c)), toString(getColumn(c)), - msg - ]); -end; - -function getKeyValPair(var c: TCfgParser; kind: TCfgEventKind): TCfgEvent; -begin - if c.tok.kind = tkSymbol then begin - result.kind := kind; - result.key := c.tok.literal; - result.value := ''; - rawGetTok(c, c.tok); - while c.tok.literal = '.'+'' do begin - addChar(result.key, '.'); - rawGetTok(c, c.tok); - if c.tok.kind = tkSymbol then begin - add(result.key, c.tok.literal); - rawGetTok(c, c.tok); - end - else begin - result.kind := cfgError; - result.msg := errorStr(c, 'symbol expected, but found: ' + - c.tok.literal); - break - end - end; - if c.tok.kind in [tkEquals, tkColon] then begin - rawGetTok(c, c.tok); - if c.tok.kind = tkSymbol then begin - result.value := c.tok.literal; - end - else begin - result.kind := cfgError; - result.msg := errorStr(c, 'symbol expected, but found: ' - + c.tok.literal); - end; - rawGetTok(c, c.tok); - end - end - else begin - result.kind := cfgError; - result.msg := errorStr(c, 'symbol expected, but found: ' + c.tok.literal); - rawGetTok(c, c.tok); - end; -end; - -function next(var c: TCfgParser): TCfgEvent; -begin - case c.tok.kind of - tkEof: result.kind := cfgEof; - tkDashDash: begin - rawGetTok(c, c.tok); - result := getKeyValPair(c, cfgOption); - end; - tkSymbol: begin - result := getKeyValPair(c, cfgKeyValuePair); - end; - tkBracketLe: begin - rawGetTok(c, c.tok); - if c.tok.kind = tkSymbol then begin - result.kind := cfgSectionStart; - result.section := c.tok.literal; - end - else begin - result.kind := cfgError; - result.msg := errorStr(c, 'symbol expected, but found: ' + c.tok.literal); - end; - rawGetTok(c, c.tok); - if c.tok.kind = tkBracketRi then rawGetTok(c, c.tok) - else begin - result.kind := cfgError; - result.msg := errorStr(c, ''']'' expected, but found: ' + c.tok.literal); - end - end; - tkInvalid, tkBracketRi, tkEquals, tkColon: begin - result.kind := cfgError; - result.msg := errorStr(c, 'invalid token: ' + c.tok.literal); - rawGetTok(c, c.tok); - end - end -end; - -end. diff --git a/nim/parseopt.pas b/nim/parseopt.pas deleted file mode 100755 index 0ca87bd37a..0000000000 --- a/nim/parseopt.pas +++ /dev/null @@ -1,153 +0,0 @@ -// -// -// Nimrod's Runtime Library -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit parseopt; - -// A command line parser; the Nimrod version of this file -// will become part of the standard library. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, nos, strutils; - -type - TCmdLineKind = ( - cmdEnd, // end of command line reached - cmdArgument, // argument detected - cmdLongoption, // a long option ``--option`` detected - cmdShortOption // a short option ``-c`` detected - ); - TOptParser = object(NObject) - cmd: string; - pos: int; - inShortState: bool; - kind: TCmdLineKind; - key, val: string; - end; - -function init(const cmdline: string = ''): TOptParser; -procedure next(var p: TOptParser); - -function getRestOfCommandLine(const p: TOptParser): string; - -implementation - -function init(const cmdline: string = ''): TOptParser; -var - i: int; -begin - result.pos := strStart; - result.inShortState := false; - if cmdline <> '' then - result.cmd := cmdline - else begin - result.cmd := ''; - for i := 1 to ParamCount() do - result.cmd := result.cmd +{&} quoteIfContainsWhite(paramStr(i)) +{&} ' '; - {@ignore} - result.cmd := result.cmd + #0; - {@emit} - end; - result.kind := cmdEnd; - result.key := ''; - result.val := ''; -end; - -function parseWord(const s: string; const i: int; var w: string; - const delim: TCharSet = {@set}[#9, ' ', #0]): int; -begin - result := i; - if s[result] = '"' then begin - inc(result); - while not (s[result] in [#0, '"']) do begin - addChar(w, s[result]); - inc(result); - end; - if s[result] = '"' then inc(result) - end - else begin - while not (s[result] in delim) do begin - addChar(w, s[result]); - inc(result); - end - end -end; - -procedure handleShortOption(var p: TOptParser); -var - i: int; -begin - i := p.pos; - p.kind := cmdShortOption; - addChar(p.key, p.cmd[i]); - inc(i); - p.inShortState := true; - while p.cmd[i] in [#9, ' '] do begin - inc(i); - p.inShortState := false; - end; - if p.cmd[i] in [':', '='] then begin - inc(i); p.inShortState := false; - while p.cmd[i] in [#9, ' '] do inc(i); - i := parseWord(p.cmd, i, p.val); - end; - if p.cmd[i] = #0 then p.inShortState := false; - p.pos := i; -end; - -procedure next(var p: TOptParser); -var - i: int; -begin - i := p.pos; - while p.cmd[i] in [#9, ' '] do inc(i); - p.pos := i; - setLength(p.key, 0); - setLength(p.val, 0); - if p.inShortState then begin - handleShortOption(p); exit - end; - case p.cmd[i] of - #0: p.kind := cmdEnd; - '-': begin - inc(i); - if p.cmd[i] = '-' then begin - p.kind := cmdLongOption; - inc(i); - i := parseWord(p.cmd, i, p.key, {@set}[#0, ' ', #9, ':', '=']); - while p.cmd[i] in [#9, ' '] do inc(i); - if p.cmd[i] in [':', '='] then begin - inc(i); - while p.cmd[i] in [#9, ' '] do inc(i); - p.pos := parseWord(p.cmd, i, p.val); - end - else - p.pos := i; - end - else begin - p.pos := i; - handleShortOption(p) - end - end; - else begin - p.kind := cmdArgument; - p.pos := parseWord(p.cmd, i, p.key); - end - end -end; - -function getRestOfCommandLine(const p: TOptParser): string; -begin - result := strip(ncopy(p.cmd, p.pos+strStart, length(p.cmd)-1)) - // always -1, because Pascal version uses a trailing zero here -end; - -end. diff --git a/nim/paslex.pas b/nim/paslex.pas deleted file mode 100755 index f3d8daaeba..0000000000 --- a/nim/paslex.pas +++ /dev/null @@ -1,738 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit paslex; - -// This module implements a FreePascal scanner. This is a adaption from -// the scanner module. - -interface - -{$include 'config.inc'} - -uses - charsets, nsystem, sysutils, - nhashes, options, msgs, strutils, platform, idents, - lexbase, wordrecg, scanner; - -const - MaxLineLength = 80; // lines longer than this lead to a warning - - numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; // we support up to base 36 - SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255]; - SymStartChars: TCharSet = ['a'..'z', 'A'..'Z', #128..#255]; - OpChars: TCharSet = ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.', - '|', '=', ':', '%', '&', '$', '@', '~', #128..#255]; - -type - // order is important for TPasTokKind - TPasTokKind = (pxInvalid, pxEof, - // keywords: - //[[[cog - //from string import capitalize - //keywords = eval(open("data/pas_keyw.yml").read()) - //idents = "" - //strings = "" - //i = 1 - //for k in keywords: - // idents = idents + "px" + capitalize(k) + ", " - // strings = strings + "'" + k + "', " - // if i % 4 == 0: - // idents = idents + "\n" - // strings = strings + "\n" - // i = i + 1 - //cog.out(idents) - //]]] - pxAnd, pxArray, pxAs, pxAsm, - pxBegin, pxCase, pxClass, pxConst, - pxConstructor, pxDestructor, pxDiv, pxDo, - pxDownto, pxElse, pxEnd, pxExcept, - pxExports, pxFinalization, pxFinally, pxFor, - pxFunction, pxGoto, pxIf, pxImplementation, - pxIn, pxInherited, pxInitialization, pxInline, - pxInterface, pxIs, pxLabel, pxLibrary, - pxMod, pxNil, pxNot, pxObject, - pxOf, pxOr, pxOut, pxPacked, - pxProcedure, pxProgram, pxProperty, pxRaise, - pxRecord, pxRepeat, pxResourcestring, pxSet, - pxShl, pxShr, pxThen, pxThreadvar, - pxTo, pxTry, pxType, pxUnit, - pxUntil, pxUses, pxVar, pxWhile, - pxWith, pxXor, - //[[[end]]] - pxComment, // ordinary comment - pxCommand, // {@} - pxAmp, // {&} - pxPer, // {%} - pxStrLit, - pxSymbol, // a symbol - - pxIntLit, - pxInt64Lit, // long constant like 0x00000070fffffff or out of int range - pxFloatLit, - - pxParLe, pxParRi, pxBracketLe, pxBracketRi, - pxComma, pxSemiColon, pxColon, - - // operators - pxAsgn, - pxEquals, pxDot, pxDotDot, pxHat, pxPlus, pxMinus, pxStar, pxSlash, - pxLe, pxLt, pxGe, pxGt, pxNeq, pxAt, - - pxStarDirLe, - pxStarDirRi, - pxCurlyDirLe, - pxCurlyDirRi - ); - TPasTokKinds = set of TPasTokKind; -const - PasTokKindToStr: array [TPasTokKind] of string = ( - 'pxInvalid', '[EOF]', - //[[[cog - //cog.out(strings) - //]]] - 'and', 'array', 'as', 'asm', - 'begin', 'case', 'class', 'const', - 'constructor', 'destructor', 'div', 'do', - 'downto', 'else', 'end', 'except', - 'exports', 'finalization', 'finally', 'for', - 'function', 'goto', 'if', 'implementation', - 'in', 'inherited', 'initialization', 'inline', - 'interface', 'is', 'label', 'library', - 'mod', 'nil', 'not', 'object', - 'of', 'or', 'out', 'packed', - 'procedure', 'program', 'property', 'raise', - 'record', 'repeat', 'resourcestring', 'set', - 'shl', 'shr', 'then', 'threadvar', - 'to', 'try', 'type', 'unit', - 'until', 'uses', 'var', 'while', - 'with', 'xor', - //[[[end]]] - 'pxComment', 'pxCommand', - '{&}', '{%}', 'pxStrLit', '[IDENTIFIER]', 'pxIntLit', 'pxInt64Lit', - 'pxFloatLit', - '('+'', ')'+'', '['+'', ']'+'', - ','+'', ';'+'', ':'+'', - ':=', '='+'', '.'+'', '..', '^'+'', '+'+'', '-'+'', '*'+'', '/'+'', - '<=', '<'+'', '>=', '>'+'', '<>', '@'+'', '(*$', '*)', '{$', '}'+'' - ); - -type - TPasTok = object(TToken) // a Pascal token - xkind: TPasTokKind; // the type of the token - end; - - TPasLex = object(TLexer) - end; - -procedure getPasTok(var L: TPasLex; out tok: TPasTok); - -procedure PrintPasTok(const tok: TPasTok); -function pasTokToStr(const tok: TPasTok): string; - -implementation - -function pastokToStr(const tok: TPasTok): string; -begin - case tok.xkind of - pxIntLit, pxInt64Lit: - result := toString(tok.iNumber); - pxFloatLit: - result := toStringF(tok.fNumber); - pxInvalid, pxComment..pxStrLit: - result := tok.literal; - else if (tok.ident.s <> '') then - result := tok.ident.s - else - result := pasTokKindToStr[tok.xkind]; - end -end; - -procedure PrintPasTok(const tok: TPasTok); -begin - write(output, pasTokKindToStr[tok.xkind]); - write(output, ' '); - writeln(output, pastokToStr(tok)) -end; - -// ---------------------------------------------------------------------------- - -procedure setKeyword(var L: TPasLex; var tok: TPasTok); -begin - case tok.ident.id of - //[[[cog - //for k in keywords: - // m = capitalize(k) - // cog.outl("ord(w%s):%s tok.xkind := px%s;" % (m, ' '*(18-len(m)), m)) - //]]] - ord(wAnd): tok.xkind := pxAnd; - ord(wArray): tok.xkind := pxArray; - ord(wAs): tok.xkind := pxAs; - ord(wAsm): tok.xkind := pxAsm; - ord(wBegin): tok.xkind := pxBegin; - ord(wCase): tok.xkind := pxCase; - ord(wClass): tok.xkind := pxClass; - ord(wConst): tok.xkind := pxConst; - ord(wConstructor): tok.xkind := pxConstructor; - ord(wDestructor): tok.xkind := pxDestructor; - ord(wDiv): tok.xkind := pxDiv; - ord(wDo): tok.xkind := pxDo; - ord(wDownto): tok.xkind := pxDownto; - ord(wElse): tok.xkind := pxElse; - ord(wEnd): tok.xkind := pxEnd; - ord(wExcept): tok.xkind := pxExcept; - ord(wExports): tok.xkind := pxExports; - ord(wFinalization): tok.xkind := pxFinalization; - ord(wFinally): tok.xkind := pxFinally; - ord(wFor): tok.xkind := pxFor; - ord(wFunction): tok.xkind := pxFunction; - ord(wGoto): tok.xkind := pxGoto; - ord(wIf): tok.xkind := pxIf; - ord(wImplementation): tok.xkind := pxImplementation; - ord(wIn): tok.xkind := pxIn; - ord(wInherited): tok.xkind := pxInherited; - ord(wInitialization): tok.xkind := pxInitialization; - ord(wInline): tok.xkind := pxInline; - ord(wInterface): tok.xkind := pxInterface; - ord(wIs): tok.xkind := pxIs; - ord(wLabel): tok.xkind := pxLabel; - ord(wLibrary): tok.xkind := pxLibrary; - ord(wMod): tok.xkind := pxMod; - ord(wNil): tok.xkind := pxNil; - ord(wNot): tok.xkind := pxNot; - ord(wObject): tok.xkind := pxObject; - ord(wOf): tok.xkind := pxOf; - ord(wOr): tok.xkind := pxOr; - ord(wOut): tok.xkind := pxOut; - ord(wPacked): tok.xkind := pxPacked; - ord(wProcedure): tok.xkind := pxProcedure; - ord(wProgram): tok.xkind := pxProgram; - ord(wProperty): tok.xkind := pxProperty; - ord(wRaise): tok.xkind := pxRaise; - ord(wRecord): tok.xkind := pxRecord; - ord(wRepeat): tok.xkind := pxRepeat; - ord(wResourcestring): tok.xkind := pxResourcestring; - ord(wSet): tok.xkind := pxSet; - ord(wShl): tok.xkind := pxShl; - ord(wShr): tok.xkind := pxShr; - ord(wThen): tok.xkind := pxThen; - ord(wThreadvar): tok.xkind := pxThreadvar; - ord(wTo): tok.xkind := pxTo; - ord(wTry): tok.xkind := pxTry; - ord(wType): tok.xkind := pxType; - ord(wUnit): tok.xkind := pxUnit; - ord(wUntil): tok.xkind := pxUntil; - ord(wUses): tok.xkind := pxUses; - ord(wVar): tok.xkind := pxVar; - ord(wWhile): tok.xkind := pxWhile; - ord(wWith): tok.xkind := pxWith; - ord(wXor): tok.xkind := pxXor; - //[[[end]]] - else tok.xkind := pxSymbol - end -end; - - -// ---------------------------------------------------------------------------- - -procedure matchUnderscoreChars(var L: TPasLex; var tok: TPasTok; - const chars: TCharSet); -// matches ([chars]_)* -var - pos: int; - buf: PChar; -begin - pos := L.bufpos; // use registers for pos, buf - buf := L.buf; - repeat - if buf[pos] in chars then begin - addChar(tok.literal, buf[pos]); - Inc(pos) - end - else break; - if buf[pos] = '_' then begin - addChar(tok.literal, '_'); - Inc(pos); - end; - until false; - L.bufPos := pos; -end; - -function isFloatLiteral(const s: string): boolean; -var - i: int; -begin - for i := strStart to length(s)+strStart-1 do - if s[i] in ['.','e','E'] then begin - result := true; exit - end; - result := false -end; - -procedure getNumber2(var L: TPasLex; var tok: TPasTok); -var - pos, bits: int; - xi: biggestInt; -begin - pos := L.bufpos+1; // skip % - if not (L.buf[pos] in ['0'..'1']) then begin // BUGFIX for %date% - tok.xkind := pxInvalid; - addChar(tok.literal, '%'); - inc(L.bufpos); - exit; - end; - - tok.base := base2; - xi := 0; - bits := 0; - while true do begin - case L.buf[pos] of - 'A'..'Z', 'a'..'z', '2'..'9', '.': begin - lexMessage(L, errInvalidNumber); - inc(pos) - end; - '_': inc(pos); - '0', '1': begin - xi := shlu(xi, 1) or (ord(L.buf[pos]) - ord('0')); - inc(pos); - inc(bits); - end; - else break; - end - end; - tok.iNumber := xi; - if (bits > 32) then //or (xi < low(int32)) or (xi > high(int32)) then - tok.xkind := pxInt64Lit - else - tok.xkind := pxIntLit; - L.bufpos := pos; -end; - -procedure getNumber16(var L: TPasLex; var tok: TPasTok); -var - pos, bits: int; - xi: biggestInt; -begin - pos := L.bufpos+1; // skip $ - tok.base := base16; - xi := 0; - bits := 0; - while true do begin - case L.buf[pos] of - 'G'..'Z', 'g'..'z', '.': begin - lexMessage(L, errInvalidNumber); - inc(pos); - end; - '_': inc(pos); - '0'..'9': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('0')); - inc(pos); - inc(bits, 4); - end; - 'a'..'f': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10); - inc(pos); - inc(bits, 4); - end; - 'A'..'F': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10); - inc(pos); - inc(bits, 4); - end; - else break; - end - end; - tok.iNumber := xi; - if (bits > 32) then // (xi < low(int32)) or (xi > high(int32)) then - tok.xkind := pxInt64Lit - else - tok.xkind := pxIntLit; - L.bufpos := pos; -end; - -procedure getNumber10(var L: TPasLex; var tok: TPasTok); -begin - tok.base := base10; - matchUnderscoreChars(L, tok, ['0'..'9']); - if (L.buf[L.bufpos] = '.') and (L.buf[L.bufpos+1] in ['0'..'9']) then begin - addChar(tok.literal, '.'); - inc(L.bufpos); - matchUnderscoreChars(L, tok, ['e', 'E', '+', '-', '0'..'9']) - end; - try - if isFloatLiteral(tok.literal) then begin - tok.fnumber := parseFloat(tok.literal); - tok.xkind := pxFloatLit; - end - else begin - tok.iNumber := ParseInt(tok.literal); - if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)) then - tok.xkind := pxInt64Lit - else - tok.xkind := pxIntLit; - end; - except - on EInvalidValue do - lexMessage(L, errInvalidNumber, tok.literal); - on EOverflow do - lexMessage(L, errNumberOutOfRange, tok.literal); - {@ignore} - on sysutils.EIntOverflow do - lexMessage(L, errNumberOutOfRange, tok.literal); - {@emit} - end; -end; - -function HandleCRLF(var L: TLexer; pos: int): int; -begin - case L.buf[pos] of - CR: result := lexbase.HandleCR(L, pos); - LF: result := lexbase.HandleLF(L, pos); - else result := pos - end -end; - -procedure getString(var L: TPasLex; var tok: TPasTok); -var - pos, xi: int; - buf: PChar; -begin - pos := L.bufPos; - buf := L.buf; - while true do begin - if buf[pos] = '''' then begin - inc(pos); - while true do begin - case buf[pos] of - CR, LF, lexbase.EndOfFile: begin - lexMessage(L, errClosingQuoteExpected); - break - end; - '''': begin - inc(pos); - if buf[pos] = '''' then begin - inc(pos); - addChar(tok.literal, ''''); - end - else break; - end; - else begin - addChar(tok.literal, buf[pos]); - inc(pos); - end - end - end - end - else if buf[pos] = '#' then begin - inc(pos); - xi := 0; - case buf[pos] of - '$': begin - inc(pos); - xi := 0; - while true do begin - case buf[pos] of - '0'..'9': xi := (xi shl 4) or (ord(buf[pos]) - ord('0')); - 'a'..'f': xi := (xi shl 4) or (ord(buf[pos]) - ord('a') + 10); - 'A'..'F': xi := (xi shl 4) or (ord(buf[pos]) - ord('A') + 10); - else break; - end; - inc(pos) - end - end; - '0'..'9': begin - xi := 0; - while buf[pos] in ['0'..'9'] do begin - xi := (xi * 10) + (ord(buf[pos]) - ord('0')); - inc(pos); - end; - end - else lexMessage(L, errInvalidCharacterConstant) - end; - if (xi <= 255) then - addChar(tok.literal, Chr(xi)) - else - lexMessage(L, errInvalidCharacterConstant) - end - else break - end; - tok.xkind := pxStrLit; - L.bufpos := pos; -end; - -{@ignore} -{$ifopt Q+} {$define Q_on} {$Q-} {$endif} -{$ifopt R+} {$define R_on} {$R-} {$endif} -{@emit} -procedure getSymbol(var L: TPasLex; var tok: TPasTok); -var - pos: int; - c: Char; - buf: pchar; - h: THash; // hashing algorithm inlined -begin - h := 0; - pos := L.bufpos; - buf := L.buf; - while true do begin - c := buf[pos]; - case c of - 'a'..'z', '0'..'9', #128..#255: begin - h := h +{%} Ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6) - end; - 'A'..'Z': begin - c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() - h := h +{%} Ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6) - end; - '_': begin end; - else break - end; - Inc(pos) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - tok.ident := getIdent(addr(L.buf[L.bufpos]), pos-L.bufpos, h); - L.bufpos := pos; - setKeyword(L, tok); -end; -{@ignore} -{$ifdef Q_on} {$undef Q_on} {$Q+} {$endif} -{$ifdef R_on} {$undef R_on} {$R+} {$endif} -{@emit} - -procedure scanLineComment(var L: TPasLex; var tok: TPasTok); -var - buf: PChar; - pos, col: int; - indent: int; -begin - pos := L.bufpos; - buf := L.buf; - // a comment ends if the next line does not start with the // on the same - // column after only whitespace - tok.xkind := pxComment; - col := getColNumber(L, pos); - while true do begin - inc(pos, 2); // skip // - addChar(tok.literal, '#'); - while not (buf[pos] in [CR, LF, lexbase.EndOfFile]) do begin - addChar(tok.literal, buf[pos]); inc(pos); - end; - pos := handleCRLF(L, pos); - buf := L.buf; - indent := 0; - while buf[pos] = ' ' do begin inc(pos); inc(indent) end; - if (col = indent) and (buf[pos] = '/') and (buf[pos+1] = '/') then - tok.literal := tok.literal +{&} nl - else - break - end; - L.bufpos := pos; -end; - -procedure scanCurlyComment(var L: TPasLex; var tok: TPasTok); -var - buf: PChar; - pos: int; -begin - pos := L.bufpos; - buf := L.buf; - tok.literal := '#'+''; - tok.xkind := pxComment; - repeat - case buf[pos] of - CR, LF: begin - pos := HandleCRLF(L, pos); - buf := L.buf; - tok.literal := tok.literal +{&} nl + '#'; - end; - '}': begin inc(pos); break end; - lexbase.EndOfFile: lexMessage(L, errTokenExpected, '}'+''); - else begin - addChar(tok.literal, buf[pos]); - inc(pos) - end - end - until false; - L.bufpos := pos; -end; - -procedure scanStarComment(var L: TPasLex; var tok: TPasTok); -var - buf: PChar; - pos: int; -begin - pos := L.bufpos; - buf := L.buf; - tok.literal := '#'+''; - tok.xkind := pxComment; - repeat - case buf[pos] of - CR, LF: begin - pos := HandleCRLF(L, pos); - buf := L.buf; - tok.literal := tok.literal +{&} nl + '#'; - end; - '*': begin - inc(pos); - if buf[pos] = ')' then begin inc(pos); break end - else addChar(tok.literal, '*') - end; - lexbase.EndOfFile: lexMessage(L, errTokenExpected, '*)'); - else begin - addChar(tok.literal, buf[pos]); - inc(pos) - end - end - until false; - L.bufpos := pos; -end; - -procedure skip(var L: TPasLex; var tok: TPasTok); -var - buf: PChar; - pos: int; -begin - pos := L.bufpos; - buf := L.buf; - repeat - case buf[pos] of - ' ', Tabulator: Inc(pos); - // newline is special: - CR, LF: begin - pos := HandleCRLF(L, pos); - buf := L.buf; - end - else break // EndOfFile also leaves the loop - end - until false; - L.bufpos := pos; -end; - -procedure getPasTok(var L: TPasLex; out tok: TPasTok); -var - c: Char; -begin - tok.xkind := pxInvalid; - fillToken(tok); - skip(L, tok); - c := L.buf[L.bufpos]; - if c in SymStartChars then // common case first - getSymbol(L, tok) - else if c in ['0'..'9'] then - getNumber10(L, tok) - else begin - case c of - ';': begin tok.xkind := pxSemicolon; Inc(L.bufpos) end; - '/': begin - if L.buf[L.bufpos+1] = '/' then scanLineComment(L, tok) - else begin tok.xkind := pxSlash; inc(L.bufpos) end; - end; - ',': begin tok.xkind := pxComma; Inc(L.bufpos) end; - '(': begin - Inc(L.bufpos); - if (L.buf[L.bufPos] = '*') then begin - if (L.buf[L.bufPos+1] = '$') then begin - Inc(L.bufpos, 2); - skip(L, tok); - getSymbol(L, tok); - tok.xkind := pxStarDirLe; - end - else begin - inc(L.bufpos); - scanStarComment(L, tok) - end - end - else - tok.xkind := pxParLe; - end; - '*': begin - inc(L.bufpos); - if L.buf[L.bufpos] = ')' then begin - inc(L.bufpos); tok.xkind := pxStarDirRi - end - else tok.xkind := pxStar - end; - ')': begin tok.xkind := pxParRi; Inc(L.bufpos) end; - '[': begin Inc(L.bufpos); tok.xkind := pxBracketLe end; - ']': begin Inc(L.bufpos); tok.xkind := pxBracketRi end; - '.': begin - inc(L.bufpos); - if L.buf[L.bufpos] = '.' then begin - tok.xkind := pxDotDot; inc(L.bufpos) - end - else tok.xkind := pxDot - end; - '{': begin - Inc(L.bufpos); - case L.buf[L.bufpos] of - '$': begin - Inc(L.bufpos); - skip(L, tok); - getSymbol(L, tok); - tok.xkind := pxCurlyDirLe - end; - '&': begin Inc(L.bufpos); tok.xkind := pxAmp end; - '%': begin Inc(L.bufpos); tok.xkind := pxPer end; - '@': begin Inc(L.bufpos); tok.xkind := pxCommand end; - else scanCurlyComment(L, tok); - end; - end; - '+': begin tok.xkind := pxPlus; inc(L.bufpos) end; - '-': begin tok.xkind := pxMinus; inc(L.bufpos) end; - ':': begin - inc(L.bufpos); - if L.buf[L.bufpos] = '=' then begin - inc(L.bufpos); tok.xkind := pxAsgn; - end - else tok.xkind := pxColon - end; - '<': begin - inc(L.bufpos); - if L.buf[L.bufpos] = '>' then begin - inc(L.bufpos); - tok.xkind := pxNeq - end - else if L.buf[L.bufpos] = '=' then begin - inc(L.bufpos); - tok.xkind := pxLe - end - else tok.xkind := pxLt - end; - '>': begin - inc(L.bufpos); - if L.buf[L.bufpos] = '=' then begin - inc(L.bufpos); - tok.xkind := pxGe - end - else tok.xkind := pxGt - end; - '=': begin tok.xkind := pxEquals; inc(L.bufpos) end; - '@': begin tok.xkind := pxAt; inc(L.bufpos) end; - '^': begin tok.xkind := pxHat; inc(L.bufpos) end; - '}': begin tok.xkind := pxCurlyDirRi; Inc(L.bufpos) end; - '''', '#': getString(L, tok); - '$': getNumber16(L, tok); - '%': getNumber2(L, tok); - lexbase.EndOfFile: tok.xkind := pxEof; - else begin - tok.literal := c + ''; - tok.xkind := pxInvalid; - lexMessage(L, errInvalidToken, c + ' (\' +{&} toString(ord(c)) + ')'); - Inc(L.bufpos); - end - end - end -end; - -end. diff --git a/nim/pasparse.pas b/nim/pasparse.pas deleted file mode 100755 index dbfbf04375..0000000000 --- a/nim/pasparse.pas +++ /dev/null @@ -1,1998 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit pasparse; - -// This module implements the parser of the Pascal variant Nimrod is written in. -// It transfers a Pascal module into a Nimrod AST. Then the renderer can be -// used to generate the Nimrod version of the compiler. - -{$include config.inc} - -interface - -uses - nsystem, nos, llstream, charsets, scanner, paslex, idents, wordrecg, strutils, - ast, astalgo, msgs, options; - -type - TPasSection = (seImplementation, seInterface); - TPasContext = (conExpr, conStmt, conTypeDesc); - TPasParser = record - section: TPasSection; - inParamList: boolean; - context: TPasContext; // needed for the @emit command - lastVarSection: PNode; - lex: TPasLex; - tok: TPasTok; - repl: TIdTable; // replacements - end; - - TReplaceTuple = array [0..1] of string; - -const - ImportBlackList: array [1..3] of string = ( - 'nsystem', 'sysutils', 'charsets' - ); - stdReplacements: array [1..19] of TReplaceTuple = ( - ('include', 'incl'), - ('exclude', 'excl'), - ('pchar', 'cstring'), - ('assignfile', 'open'), - ('integer', 'int'), - ('longword', 'int32'), - ('cardinal', 'int'), - ('boolean', 'bool'), - ('shortint', 'int8'), - ('smallint', 'int16'), - ('longint', 'int32'), - ('byte', 'int8'), - ('word', 'int16'), - ('single', 'float32'), - ('double', 'float64'), - ('real', 'float'), - ('length', 'len'), - ('len', 'length'), - ('setlength', 'setlen') - ); - nimReplacements: array [1..35] of TReplaceTuple = ( - ('nimread', 'read'), - ('nimwrite', 'write'), - ('nimclosefile', 'close'), - ('closefile', 'close'), - ('openfile', 'open'), - ('nsystem', 'system'), - ('ntime', 'times'), - ('nos', 'os'), - ('nmath', 'math'), - - ('ncopy', 'copy'), - ('addChar', 'add'), - ('halt', 'quit'), - ('nobject', 'TObject'), - ('eof', 'EndOfFile'), - - ('input', 'stdin'), - ('output', 'stdout'), - ('addu', '`+%`'), - ('subu', '`-%`'), - ('mulu', '`*%`'), - ('divu', '`/%`'), - ('modu', '`%%`'), - ('ltu', '`<%`'), - ('leu', '`<=%`'), - ('shlu', '`shl`'), - ('shru', '`shr`'), - ('assigned', 'not isNil'), - - ('eintoverflow', 'EOverflow'), - ('format', '`%`'), - ('snil', 'nil'), - ('tostringf', '$'+''), - ('ttextfile', 'tfile'), - ('tbinaryfile', 'tfile'), - ('strstart', '0'+''), - ('nl', '"\n"'), - ('tostring', '$'+'') - {, - ('NL', '"\n"'), - ('tabulator', '''\t'''), - ('esc', '''\e'''), - ('cr', '''\r'''), - ('lf', '''\l'''), - ('ff', '''\f'''), - ('bel', '''\a'''), - ('backspace', '''\b'''), - ('vt', '''\v''') } - ); - -function ParseUnit(var p: TPasParser): PNode; - -procedure openPasParser(var p: TPasParser; const filename: string; - inputStream: PLLStream); -procedure closePasParser(var p: TPasParser); - -procedure exSymbol(var n: PNode); -procedure fixRecordDef(var n: PNode); -// XXX: move these two to an auxiliary module - -implementation - -procedure OpenPasParser(var p: TPasParser; const filename: string; - inputStream: PLLStream); -var - i: int; -begin -{@ignore} - FillChar(p, sizeof(p), 0); -{@emit} - OpenLexer(p.lex, filename, inputStream); - initIdTable(p.repl); - for i := low(stdReplacements) to high(stdReplacements) do - IdTablePut(p.repl, getIdent(stdReplacements[i][0]), - getIdent(stdReplacements[i][1])); - if gCmd = cmdBoot then - for i := low(nimReplacements) to high(nimReplacements) do - IdTablePut(p.repl, getIdent(nimReplacements[i][0]), - getIdent(nimReplacements[i][1])); -end; - -procedure ClosePasParser(var p: TPasParser); -begin - CloseLexer(p.lex); -end; - -// ---------------- parser helpers -------------------------------------------- - -procedure getTok(var p: TPasParser); -begin - getPasTok(p.lex, p.tok) -end; - -procedure parMessage(const p: TPasParser; const msg: TMsgKind; - const arg: string = ''); -begin - lexMessage(p.lex, msg, arg); -end; - -function parLineInfo(const p: TPasParser): TLineInfo; -begin - result := getLineInfo(p.lex) -end; - -procedure skipCom(var p: TPasParser; n: PNode); -begin - while p.tok.xkind = pxComment do begin - if (n <> nil) then begin - if n.comment = snil then n.comment := p.tok.literal - else n.comment := n.comment +{&} nl +{&} p.tok.literal; - end - else - parMessage(p, warnCommentXIgnored, p.tok.literal); - getTok(p); - end -end; - -procedure ExpectIdent(const p: TPasParser); -begin - if p.tok.xkind <> pxSymbol then - lexMessage(p.lex, errIdentifierExpected, pasTokToStr(p.tok)); -end; - -procedure Eat(var p: TPasParser; xkind: TPasTokKind); -begin - if p.tok.xkind = xkind then getTok(p) - else lexMessage(p.lex, errTokenExpected, PasTokKindToStr[xkind]) -end; - -procedure Opt(var p: TPasParser; xkind: TPasTokKind); -begin - if p.tok.xkind = xkind then getTok(p) -end; -// ---------------------------------------------------------------------------- - -function newNodeP(kind: TNodeKind; const p: TPasParser): PNode; -begin - result := newNodeI(kind, getLineInfo(p.lex)); -end; - -function newIntNodeP(kind: TNodeKind; const intVal: BiggestInt; - const p: TPasParser): PNode; -begin - result := newNodeP(kind, p); - result.intVal := intVal; -end; - -function newFloatNodeP(kind: TNodeKind; const floatVal: BiggestFloat; - const p: TPasParser): PNode; -begin - result := newNodeP(kind, p); - result.floatVal := floatVal; -end; - -function newStrNodeP(kind: TNodeKind; const strVal: string; - const p: TPasParser): PNode; -begin - result := newNodeP(kind, p); - result.strVal := strVal; -end; - -function newIdentNodeP(ident: PIdent; const p: TPasParser): PNode; -begin - result := newNodeP(nkIdent, p); - result.ident := ident; -end; - -function createIdentNodeP(ident: PIdent; const p: TPasParser): PNode; -var - x: PIdent; -begin - result := newNodeP(nkIdent, p); - x := PIdent(IdTableGet(p.repl, ident)); - if x <> nil then result.ident := x - else result.ident := ident; -end; - -// ------------------- Expression parsing ------------------------------------ - -function parseExpr(var p: TPasParser): PNode; forward; -function parseStmt(var p: TPasParser): PNode; forward; -function parseTypeDesc(var p: TPasParser; - definition: PNode=nil): PNode; forward; - -function parseEmit(var p: TPasParser; definition: PNode): PNode; -var - a: PNode; -begin - getTok(p); // skip 'emit' - result := nil; - if p.tok.xkind <> pxCurlyDirRi then - case p.context of - conExpr: result := parseExpr(p); - conStmt: begin - result := parseStmt(p); - if p.tok.xkind <> pxCurlyDirRi then begin - a := result; - result := newNodeP(nkStmtList, p); - addSon(result, a); - while p.tok.xkind <> pxCurlyDirRi do begin - addSon(result, parseStmt(p)); - end - end - end; - conTypeDesc: result := parseTypeDesc(p, definition); - end; - eat(p, pxCurlyDirRi); -end; - -function parseCommand(var p: TPasParser; definition: PNode=nil): PNode; -var - a: PNode; -begin - result := nil; - getTok(p); - if p.tok.ident.id = getIdent('discard').id then begin - result := newNodeP(nkDiscardStmt, p); - getTok(p); eat(p, pxCurlyDirRi); - addSon(result, parseExpr(p)); - end - else if p.tok.ident.id = getIdent('set').id then begin - getTok(p); eat(p, pxCurlyDirRi); - result := parseExpr(p); - result.kind := nkCurly; - assert(sonsNotNil(result)); - end - else if p.tok.ident.id = getIdent('cast').id then begin - getTok(p); eat(p, pxCurlyDirRi); - a := parseExpr(p); - if (a.kind = nkCall) and (sonsLen(a) = 2) then begin - result := newNodeP(nkCast, p); - addSon(result, a.sons[0]); - addSon(result, a.sons[1]); - end - else begin - parMessage(p, errInvalidDirectiveX, pasTokToStr(p.tok)); - result := a - end - end - else if p.tok.ident.id = getIdent('emit').id then begin - result := parseEmit(p, definition); - end - else if p.tok.ident.id = getIdent('ignore').id then begin - getTok(p); eat(p, pxCurlyDirRi); - while true do begin - case p.tok.xkind of - pxEof: parMessage(p, errTokenExpected, '{@emit}'); - pxCommand: begin - getTok(p); - if p.tok.ident.id = getIdent('emit').id then begin - result := parseEmit(p, definition); - break - end - else begin - while (p.tok.xkind <> pxCurlyDirRi) and (p.tok.xkind <> pxEof) do - getTok(p); - eat(p, pxCurlyDirRi); - end; - end; - else getTok(p) // skip token - end - end - end - else if p.tok.ident.id = getIdent('ptr').id then begin - result := newNodeP(nkPtrTy, p); - getTok(p); eat(p, pxCurlyDirRi); - end - else if p.tok.ident.id = getIdent('tuple').id then begin - result := newNodeP(nkTupleTy, p); - getTok(p); eat(p, pxCurlyDirRi); - end - else if p.tok.ident.id = getIdent('acyclic').id then begin - result := newIdentNodeP(p.tok.ident, p); - getTok(p); eat(p, pxCurlyDirRi); - end - else begin - parMessage(p, errInvalidDirectiveX, pasTokToStr(p.tok)); - while true do begin - getTok(p); - if (p.tok.xkind = pxCurlyDirRi) or (p.tok.xkind = pxEof) then break; - end; - eat(p, pxCurlyDirRi); - result := nil - end; -end; - -function getPrecedence(const kind: TPasTokKind): int; -begin - case kind of - pxDiv, pxMod, pxStar, pxSlash, pxShl, pxShr, pxAnd: result := 5; // highest - pxPlus, pxMinus, pxOr, pxXor: result := 4; - pxIn, pxEquals, pxLe, pxLt, pxGe, pxGt, pxNeq, pxIs: result := 3; - else result := -1; - end; -end; - -function rangeExpr(var p: TPasParser): PNode; -var - a: PNode; -begin - a := parseExpr(p); - if p.tok.xkind = pxDotDot then begin - result := newNodeP(nkRange, p); - addSon(result, a); - getTok(p); skipCom(p, result); - addSon(result, parseExpr(p)) - end - else result := a -end; - -function bracketExprList(var p: TPasParser; first: PNode): PNode; -var - a: PNode; -begin - result := newNodeP(nkBracketExpr, p); - addSon(result, first); - getTok(p); - skipCom(p, result); - while true do begin - if p.tok.xkind = pxBracketRi then begin - getTok(p); break - end; - if p.tok.xkind = pxEof then begin - parMessage(p, errTokenExpected, PasTokKindToStr[pxBracketRi]); break - end; - a := rangeExpr(p); - skipCom(p, a); - if p.tok.xkind = pxComma then begin - getTok(p); - skipCom(p, a) - end; - addSon(result, a); - end; -end; - -function exprColonEqExpr(var p: TPasParser; kind: TNodeKind; - tok: TPasTokKind): PNode; -var - a: PNode; -begin - a := parseExpr(p); - if p.tok.xkind = tok then begin - result := newNodeP(kind, p); - getTok(p); - skipCom(p, result); - addSon(result, a); - addSon(result, parseExpr(p)); - end - else - result := a -end; - -procedure exprListAux(var p: TPasParser; elemKind: TNodeKind; - endTok, sepTok: TPasTokKind; result: PNode); -var - a: PNode; -begin - getTok(p); - skipCom(p, result); - while true do begin - if p.tok.xkind = endTok then begin - getTok(p); break - end; - if p.tok.xkind = pxEof then begin - parMessage(p, errTokenExpected, PasTokKindToStr[endtok]); break - end; - a := exprColonEqExpr(p, elemKind, sepTok); - skipCom(p, a); - if (p.tok.xkind = pxComma) or (p.tok.xkind = pxSemicolon) then begin - getTok(p); - skipCom(p, a) - end; - addSon(result, a); - end; -end; - -function qualifiedIdent(var p: TPasParser): PNode; -var - a: PNode; -begin - if p.tok.xkind = pxSymbol then - result := createIdentNodeP(p.tok.ident, p) - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - result := nil; - exit - end; - getTok(p); - skipCom(p, result); - if p.tok.xkind = pxDot then begin - getTok(p); - skipCom(p, result); - if p.tok.xkind = pxSymbol then begin - a := result; - result := newNodeI(nkDotExpr, a.info); - addSon(result, a); - addSon(result, createIdentNodeP(p.tok.ident, p)); - getTok(p); - end - else parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)) - end; -end; - -procedure qualifiedIdentListAux(var p: TPasParser; endTok: TPasTokKind; - result: PNode); -var - a: PNode; -begin - getTok(p); - skipCom(p, result); - while true do begin - if p.tok.xkind = endTok then begin - getTok(p); break - end; - if p.tok.xkind = pxEof then begin - parMessage(p, errTokenExpected, PasTokKindToStr[endtok]); break - end; - a := qualifiedIdent(p); - skipCom(p, a); - if p.tok.xkind = pxComma then begin - getTok(p); skipCom(p, a) - end; - addSon(result, a); - end -end; - -function exprColonEqExprList(var p: TPasParser; kind, elemKind: TNodeKind; - endTok, sepTok: TPasTokKind): PNode; -begin - result := newNodeP(kind, p); - exprListAux(p, elemKind, endTok, sepTok, result); -end; - -procedure setBaseFlags(n: PNode; base: TNumericalBase); -begin - case base of - base10: begin end; - base2: include(n.flags, nfBase2); - base8: include(n.flags, nfBase8); - base16: include(n.flags, nfBase16); - end -end; - -function identOrLiteral(var p: TPasParser): PNode; -var - a: PNode; -begin - case p.tok.xkind of - pxSymbol: begin - result := createIdentNodeP(p.tok.ident, p); - getTok(p) - end; - // literals - pxIntLit: begin - result := newIntNodeP(nkIntLit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - pxInt64Lit: begin - result := newIntNodeP(nkInt64Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - pxFloatLit: begin - result := newFloatNodeP(nkFloatLit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - pxStrLit: begin - if length(p.tok.literal) <> 1 then - result := newStrNodeP(nkStrLit, p.tok.literal, p) - else - result := newIntNodeP(nkCharLit, ord(p.tok.literal[strStart]), p); - getTok(p); - end; - pxNil: begin - result := newNodeP(nkNilLit, p); - getTok(p); - end; - - pxParLe: begin // () constructor - result := exprColonEqExprList(p, nkPar, nkExprColonExpr, pxParRi, - pxColon); - //if hasSonWith(result, nkExprColonExpr) then - // replaceSons(result, nkExprColonExpr, nkExprEqExpr) - if (sonsLen(result) > 1) and not hasSonWith(result, nkExprColonExpr) then - result.kind := nkBracket; // is an array constructor - end; - pxBracketLe: begin // [] constructor - result := newNodeP(nkBracket, p); - getTok(p); - skipCom(p, result); - while (p.tok.xkind <> pxBracketRi) and (p.tok.xkind <> pxEof) do begin - a := rangeExpr(p); - if a.kind = nkRange then - result.kind := nkCurly; // it is definitely a set literal - opt(p, pxComma); - skipCom(p, a); - assert(a <> nil); - addSon(result, a); - end; - eat(p, pxBracketRi); - end; - pxCommand: result := parseCommand(p); - else begin - parMessage(p, errExprExpected, pasTokToStr(p.tok)); - getTok(p); // we must consume a token here to prevend endless loops! - result := nil - end - end; - if result <> nil then - skipCom(p, result); -end; - -function primary(var p: TPasParser): PNode; -var - a: PNode; -begin - // prefix operator? - if (p.tok.xkind = pxNot) or (p.tok.xkind = pxMinus) - or (p.tok.xkind = pxPlus) then begin - result := newNodeP(nkPrefix, p); - a := newIdentNodeP(getIdent(pasTokToStr(p.tok)), p); - addSon(result, a); - getTok(p); - skipCom(p, a); - addSon(result, primary(p)); - exit - end - else if p.tok.xkind = pxAt then begin - result := newNodeP(nkAddr, p); - a := newIdentNodeP(getIdent(pasTokToStr(p.tok)), p); - getTok(p); - if p.tok.xkind = pxBracketLe then begin - result := newNodeP(nkPrefix, p); - addSon(result, a); - addSon(result, identOrLiteral(p)); - end - else - addSon(result, primary(p)); - exit - end; - result := identOrLiteral(p); - while true do begin - case p.tok.xkind of - pxParLe: begin - a := result; - result := newNodeP(nkCall, p); - addSon(result, a); - exprListAux(p, nkExprEqExpr, pxParRi, pxEquals, result); - end; - pxDot: begin - a := result; - result := newNodeP(nkDotExpr, p); - addSon(result, a); - getTok(p); // skip '.' - skipCom(p, result); - if p.tok.xkind = pxSymbol then begin - addSon(result, createIdentNodeP(p.tok.ident, p)); - getTok(p); - end - else - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - end; - pxHat: begin - a := result; - result := newNodeP(nkDerefExpr, p); - addSon(result, a); - getTok(p); - end; - pxBracketLe: result := bracketExprList(p, result); - else break - end - end -end; - -function lowestExprAux(var p: TPasParser; out v: PNode; - limit: int): TPasTokKind; -var - op, nextop: TPasTokKind; - opPred: int; - v2, node, opNode: PNode; -begin - v := primary(p); - // expand while operators have priorities higher than 'limit' - op := p.tok.xkind; - opPred := getPrecedence(op); - while (opPred > limit) do begin - node := newNodeP(nkInfix, p); - opNode := newIdentNodeP(getIdent(pasTokToStr(p.tok)), p); - // skip operator: - getTok(p); - case op of - pxPlus: begin - case p.tok.xkind of - pxPer: begin getTok(p); eat(p, pxCurlyDirRi); - opNode.ident := getIdent('+%') end; - pxAmp: begin getTok(p); eat(p, pxCurlyDirRi); - opNode.ident := getIdent('&'+'') end; - else begin end - end - end; - pxMinus: begin - if p.tok.xkind = pxPer then begin - getTok(p); eat(p, pxCurlyDirRi); - opNode.ident := getIdent('-%') - end; - end; - pxEquals: opNode.ident := getIdent('=='); - pxNeq: opNode.ident := getIdent('!='); - else begin end - end; - - skipCom(p, opNode); - - // read sub-expression with higher priority - nextop := lowestExprAux(p, v2, opPred); - addSon(node, opNode); - addSon(node, v); - addSon(node, v2); - v := node; - op := nextop; - opPred := getPrecedence(nextop); - end; - result := op; // return first untreated operator -end; - -function fixExpr(n: PNode): PNode; -var - i: int; -begin - result := n; - if n = nil then exit; - case n.kind of - nkInfix: begin - if n.sons[1].kind = nkBracket then // binary expression with [] is a set - n.sons[1].kind := nkCurly; - if n.sons[2].kind = nkBracket then // binary expression with [] is a set - n.sons[2].kind := nkCurly; - if (n.sons[0].kind = nkIdent) then begin - if (n.sons[0].ident.id = getIdent('+'+'').id) then begin - if (n.sons[1].kind = nkCharLit) - and (n.sons[2].kind = nkStrLit) and (n.sons[2].strVal = '') then - begin - result := newStrNode(nkStrLit, chr(int(n.sons[1].intVal))+''); - result.info := n.info; - exit; // do not process sons as they don't exist anymore - end - else if (n.sons[1].kind in [nkCharLit, nkStrLit]) - or (n.sons[2].kind in [nkCharLit, nkStrLit]) then begin - n.sons[0].ident := getIdent('&'+''); // fix operator - end - end - end - end - else begin end - end; - if not (n.kind in [nkEmpty..nkNilLit]) then - for i := 0 to sonsLen(n)-1 do - result.sons[i] := fixExpr(n.sons[i]) -end; - -function parseExpr(var p: TPasParser): PNode; -var - oldcontext: TPasContext; -begin - oldcontext := p.context; - p.context := conExpr; - if p.tok.xkind = pxCommand then begin - result := parseCommand(p) - end - else begin - {@discard} lowestExprAux(p, result, -1); - result := fixExpr(result) - end; - //if result = nil then - // internalError(parLineInfo(p), 'parseExpr() returned nil'); - p.context := oldcontext; -end; - -// ---------------------- statement parser ------------------------------------ -function parseExprStmt(var p: TPasParser): PNode; -var - a, b: PNode; - info: TLineInfo; -begin - info := parLineInfo(p); - a := parseExpr(p); - if p.tok.xkind = pxAsgn then begin - getTok(p); - skipCom(p, a); - b := parseExpr(p); - result := newNodeI(nkAsgn, info); - addSon(result, a); - addSon(result, b); - end - else - result := a -end; - -function inImportBlackList(ident: PIdent): bool; -var - i: int; -begin - for i := low(ImportBlackList) to high(ImportBlackList) do - if ident.id = getIdent(ImportBlackList[i]).id then begin - result := true; exit - end; - result := false -end; - -function parseUsesStmt(var p: TPasParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkImportStmt, p); - getTok(p); // skip `import` - skipCom(p, result); - while true do begin - case p.tok.xkind of - pxEof: break; - pxSymbol: a := newIdentNodeP(p.tok.ident, p); - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - break - end; - end; - getTok(p); // skip identifier, string - skipCom(p, a); - if (gCmd <> cmdBoot) or not inImportBlackList(a.ident) then - addSon(result, createIdentNodeP(a.ident, p)); - if p.tok.xkind = pxComma then begin - getTok(p); - skipCom(p, a) - end - else break - end; - if sonsLen(result) = 0 then result := nil; -end; - -function parseIncludeDir(var p: TPasParser): PNode; -var - filename: string; -begin - result := newNodeP(nkIncludeStmt, p); - getTok(p); // skip `include` - filename := ''; - while true do begin - case p.tok.xkind of - pxSymbol, pxDot, pxDotDot, pxSlash: begin - filename := filename +{&} pasTokToStr(p.tok); - getTok(p); - end; - pxStrLit: begin - filename := p.tok.literal; - getTok(p); - break - end; - pxCurlyDirRi: break; - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - break - end; - end; - end; - addSon(result, newStrNodeP(nkStrLit, changeFileExt(filename, 'nim'), p)); - if filename = 'config.inc' then result := nil; -end; - -function definedExprAux(var p: TPasParser): PNode; -begin - result := newNodeP(nkCall, p); - addSon(result, newIdentNodeP(getIdent('defined'), p)); - ExpectIdent(p); - addSon(result, createIdentNodeP(p.tok.ident, p)); - getTok(p); -end; - -function isHandledDirective(const p: TPasParser): bool; -begin - result := false; - if p.tok.xkind in [pxCurlyDirLe, pxStarDirLe] then - case whichKeyword(p.tok.ident) of - wElse, wEndif: result := false - else result := true - end -end; - -function parseStmtList(var p: TPasParser): PNode; -begin - result := newNodeP(nkStmtList, p); - while true do begin - case p.tok.xkind of - pxEof: break; - pxCurlyDirLe, pxStarDirLe: begin - if not isHandledDirective(p) then break; - end - else begin end - end; - addSon(result, parseStmt(p)) - end; - if sonsLen(result) = 1 then result := result.sons[0]; -end; - -procedure parseIfDirAux(var p: TPasParser; result: PNode); -var - s: PNode; - endMarker: TPasTokKind; -begin - addSon(result.sons[0], parseStmtList(p)); - if p.tok.xkind in [pxCurlyDirLe, pxStarDirLe] then begin - endMarker := succ(p.tok.xkind); - if whichKeyword(p.tok.ident) = wElse then begin - s := newNodeP(nkElse, p); - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> endMarker) do getTok(p); - eat(p, endMarker); - addSon(s, parseStmtList(p)); - addSon(result, s); - end; - if p.tok.xkind in [pxCurlyDirLe, pxStarDirLe] then begin - endMarker := succ(p.tok.xkind); - if whichKeyword(p.tok.ident) = wEndif then begin - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> endMarker) do getTok(p); - eat(p, endMarker); - end - else parMessage(p, errXExpected, '{$endif}'); - end - end - else - parMessage(p, errXExpected, '{$endif}'); -end; - -function parseIfdefDir(var p: TPasParser; endMarker: TPasTokKind): PNode; -begin - result := newNodeP(nkWhenStmt, p); - addSon(result, newNodeP(nkElifBranch, p)); - getTok(p); - addSon(result.sons[0], definedExprAux(p)); - eat(p, endMarker); - parseIfDirAux(p, result); -end; - -function parseIfndefDir(var p: TPasParser; endMarker: TPasTokKind): PNode; -var - e: PNode; -begin - result := newNodeP(nkWhenStmt, p); - addSon(result, newNodeP(nkElifBranch, p)); - getTok(p); - e := newNodeP(nkCall, p); - addSon(e, newIdentNodeP(getIdent('not'), p)); - addSon(e, definedExprAux(p)); - eat(p, endMarker); - addSon(result.sons[0], e); - parseIfDirAux(p, result); -end; - -function parseIfDir(var p: TPasParser; endMarker: TPasTokKind): PNode; -begin - result := newNodeP(nkWhenStmt, p); - addSon(result, newNodeP(nkElifBranch, p)); - getTok(p); - addSon(result.sons[0], parseExpr(p)); - eat(p, endMarker); - parseIfDirAux(p, result); -end; - -function parseDirective(var p: TPasParser): PNode; -var - endMarker: TPasTokKind; -begin - result := nil; - if not (p.tok.xkind in [pxCurlyDirLe, pxStarDirLe]) then exit; - endMarker := succ(p.tok.xkind); - if p.tok.ident <> nil then - case whichKeyword(p.tok.ident) of - wInclude: begin - result := parseIncludeDir(p); - eat(p, endMarker); - end; - wIf: result := parseIfDir(p, endMarker); - wIfdef: result := parseIfdefDir(p, endMarker); - wIfndef: result := parseIfndefDir(p, endMarker); - else begin - // skip unknown compiler directive - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> endMarker) do - getTok(p); - eat(p, endMarker); - end - end - else eat(p, endMarker); -end; - -function parseRaise(var p: TPasParser): PNode; -begin - result := newNodeP(nkRaiseStmt, p); - getTok(p); - skipCom(p, result); - if p.tok.xkind <> pxSemicolon then addSon(result, parseExpr(p)) - else addSon(result, nil); -end; - -function parseIf(var p: TPasParser): PNode; -var - branch: PNode; -begin - result := newNodeP(nkIfStmt, p); - while true do begin - getTok(p); // skip ``if`` - branch := newNodeP(nkElifBranch, p); - skipCom(p, branch); - addSon(branch, parseExpr(p)); - eat(p, pxThen); - skipCom(p, branch); - addSon(branch, parseStmt(p)); - skipCom(p, branch); - addSon(result, branch); - if p.tok.xkind = pxElse then begin - getTok(p); - if p.tok.xkind <> pxIf then begin - // ordinary else part: - branch := newNodeP(nkElse, p); - skipCom(p, result); // BUGFIX - addSon(branch, parseStmt(p)); - addSon(result, branch); - break - end - // else: next iteration - end - else break - end -end; - -function parseWhile(var p: TPasParser): PNode; -begin - result := newNodeP(nkWhileStmt, p); - getTok(p); - skipCom(p, result); - addSon(result, parseExpr(p)); - eat(p, pxDo); - skipCom(p, result); - addSon(result, parseStmt(p)); -end; - -function parseRepeat(var p: TPasParser): PNode; -var - a, b, c, s: PNode; -begin - result := newNodeP(nkWhileStmt, p); - getTok(p); - skipCom(p, result); - addSon(result, newIdentNodeP(getIdent('true'), p)); - s := newNodeP(nkStmtList, p); - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> pxUntil) do begin - addSon(s, parseStmt(p)) - end; - eat(p, pxUntil); - a := newNodeP(nkIfStmt, p); - skipCom(p, a); - b := newNodeP(nkElifBranch, p); - c := newNodeP(nkBreakStmt, p); - addSon(c, nil); - addSon(b, parseExpr(p)); - skipCom(p, a); - addSon(b, c); - addSon(a, b); - - if (b.sons[0].kind = nkIdent) and (b.sons[0].ident.id = getIdent('false').id) - then begin end // do not add an ``if false: break`` statement - else addSon(s, a); - addSon(result, s); -end; - -function parseCase(var p: TPasParser): PNode; -var - b: PNode; -begin - result := newNodeP(nkCaseStmt, p); - getTok(p); - addSon(result, parseExpr(p)); - eat(p, pxOf); - skipCom(p, result); - while (p.tok.xkind <> pxEnd) and (p.tok.xkind <> pxEof) do begin - if p.tok.xkind = pxElse then begin - b := newNodeP(nkElse, p); - getTok(p); - end - else begin - b := newNodeP(nkOfBranch, p); - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> pxColon) do begin - addSon(b, rangeExpr(p)); - opt(p, pxComma); - skipcom(p, b); - end; - eat(p, pxColon); - end; - skipCom(p, b); - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkElse then break; - end; - eat(p, pxEnd); -end; - -function parseTry(var p: TPasParser): PNode; -var - b, e: PNode; -begin - result := newNodeP(nkTryStmt, p); - getTok(p); - skipCom(p, result); - b := newNodeP(nkStmtList, p); - while not (p.tok.xkind in [pxFinally, pxExcept, pxEof, pxEnd]) do - addSon(b, parseStmt(p)); - addSon(result, b); - if p.tok.xkind = pxExcept then begin - getTok(p); - while p.tok.ident.id = getIdent('on').id do begin - b := newNodeP(nkExceptBranch, p); - getTok(p); - e := qualifiedIdent(p); - if p.tok.xkind = pxColon then begin - getTok(p); - e := qualifiedIdent(p); - end; - addSon(b, e); - eat(p, pxDo); - addSon(b, parseStmt(p)); - addSon(result, b); - if p.tok.xkind = pxCommand then {@discard} parseCommand(p); - end; - if p.tok.xkind = pxElse then begin - b := newNodeP(nkExceptBranch, p); - getTok(p); - addSon(b, parseStmt(p)); - addSon(result, b); - end - end; - if p.tok.xkind = pxFinally then begin - b := newNodeP(nkFinally, p); - getTok(p); - e := newNodeP(nkStmtList, p); - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> pxEnd) do begin - addSon(e, parseStmt(p)) - end; - if sonsLen(e) = 0 then - addSon(e, newNodeP(nkNilLit, p)); - addSon(result, e); - end; - eat(p, pxEnd); -end; - -function parseFor(var p: TPasParser): PNode; -var - a, b, c: PNode; -begin - result := newNodeP(nkForStmt, p); - getTok(p); - skipCom(p, result); - expectIdent(p); - addSon(result, createIdentNodeP(p.tok.ident, p)); - getTok(p); - eat(p, pxAsgn); - a := parseExpr(p); - b := nil; - c := newNodeP(nkCall, p); - if p.tok.xkind = pxTo then begin - addSon(c, newIdentNodeP(getIdent('countup'), p)); - getTok(p); - b := parseExpr(p); - end - else if p.tok.xkind = pxDownto then begin - addSon(c, newIdentNodeP(getIdent('countdown'), p)); - getTok(p); - b := parseExpr(p); - end - else - parMessage(p, errTokenExpected, PasTokKindToStr[pxTo]); - addSon(c, a); - addSon(c, b); - - eat(p, pxDo); - skipCom(p, result); - addSon(result, c); - addSon(result, parseStmt(p)) -end; - -function parseParam(var p: TPasParser): PNode; -var - a, v: PNode; -begin - result := newNodeP(nkIdentDefs, p); - v := nil; - case p.tok.xkind of - pxConst: getTok(p); - pxVar: begin getTok(p); v := newNodeP(nkVarTy, p); end; - pxOut: begin getTok(p); v := newNodeP(nkVarTy, p); end; - else begin end - end; - while true do begin - case p.tok.xkind of - pxSymbol: a := createIdentNodeP(p.tok.ident, p); - pxColon, pxEof, pxParRi, pxEquals: break; - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - exit; - end; - end; - getTok(p); // skip identifier - skipCom(p, a); - if p.tok.xkind = pxComma then begin - getTok(p); skipCom(p, a) - end; - addSon(result, a); - end; - if p.tok.xkind = pxColon then begin - getTok(p); skipCom(p, result); - if v <> nil then addSon(v, parseTypeDesc(p)) - else v := parseTypeDesc(p); - addSon(result, v); - end - else begin - addSon(result, nil); - if p.tok.xkind <> pxEquals then - parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)) - end; - if p.tok.xkind = pxEquals then begin - getTok(p); skipCom(p, result); - addSon(result, parseExpr(p)); - end - else - addSon(result, nil); -end; - -function parseParamList(var p: TPasParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkFormalParams, p); - addSon(result, nil); // return type - if p.tok.xkind = pxParLe then begin - p.inParamList := true; - getTok(p); - skipCom(p, result); - while true do begin - case p.tok.xkind of - pxSymbol, pxConst, pxVar, pxOut: a := parseParam(p); - pxParRi: begin getTok(p); break end; - else begin parMessage(p, errTokenExpected, ')'+''); break; end; - end; - skipCom(p, a); - if p.tok.xkind = pxSemicolon then begin - getTok(p); skipCom(p, a) - end; - addSon(result, a) - end; - p.inParamList := false - end; - if p.tok.xkind = pxColon then begin - getTok(p); - skipCom(p, result); - result.sons[0] := parseTypeDesc(p) - end -end; - -function parseCallingConvention(var p: TPasParser): PNode; -begin - result := nil; - if p.tok.xkind = pxSymbol then begin - case whichKeyword(p.tok.ident) of - wStdcall, wCDecl, wSafeCall, wSysCall, wInline, wFastCall: begin - result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - getTok(p); - opt(p, pxSemicolon); - end; - wRegister: begin - result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(getIdent('fastcall'), p)); - getTok(p); - opt(p, pxSemicolon); - end - else begin end - end - end -end; - -function parseRoutineSpecifiers(var p: TPasParser; out noBody: boolean): PNode; -var - e: PNode; -begin - result := parseCallingConvention(p); - noBody := false; - while p.tok.xkind = pxSymbol do begin - case whichKeyword(p.tok.ident) of - wAssembler, wOverload, wFar: begin - getTok(p); opt(p, pxSemicolon); - end; - wForward: begin - noBody := true; - getTok(p); opt(p, pxSemicolon); - end; - wImportc: begin - // This is a fake for platform module. There is no ``importc`` - // directive in Pascal. - if result = nil then result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(getIdent('importc'), p)); - noBody := true; - getTok(p); opt(p, pxSemicolon); - end; - wNoConv: begin - // This is a fake for platform module. There is no ``noconv`` - // directive in Pascal. - if result = nil then result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(getIdent('noconv'), p)); - noBody := true; - getTok(p); opt(p, pxSemicolon); - end; - wProcVar: begin - // This is a fake for the Nimrod compiler. There is no ``procvar`` - // directive in Pascal. - if result = nil then result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(getIdent('procvar'), p)); - getTok(p); opt(p, pxSemicolon); - end; - wVarargs: begin - if result = nil then result := newNodeP(nkPragma, p); - addSon(result, newIdentNodeP(getIdent('varargs'), p)); - getTok(p); opt(p, pxSemicolon); - end; - wExternal: begin - if result = nil then result := newNodeP(nkPragma, p); - getTok(p); - noBody := true; - e := newNodeP(nkExprColonExpr, p); - addSon(e, newIdentNodeP(getIdent('dynlib'), p)); - addSon(e, parseExpr(p)); - addSon(result, e); - opt(p, pxSemicolon); - if (p.tok.xkind = pxSymbol) - and (p.tok.ident.id = getIdent('name').id) then begin - e := newNodeP(nkExprColonExpr, p); - getTok(p); - addSon(e, newIdentNodeP(getIdent('importc'), p)); - addSon(e, parseExpr(p)); - addSon(result, e); - end - else - addSon(result, newIdentNodeP(getIdent('importc'), p)); - opt(p, pxSemicolon); - end - else begin - e := parseCallingConvention(p); - if e = nil then break; - if result = nil then result := newNodeP(nkPragma, p); - addSon(result, e.sons[0]); - end; - end - end -end; - -function parseRoutineType(var p: TPasParser): PNode; -begin - result := newNodeP(nkProcTy, p); - getTok(p); skipCom(p, result); - addSon(result, parseParamList(p)); - opt(p, pxSemicolon); - addSon(result, parseCallingConvention(p)); - skipCom(p, result); -end; - -function parseEnum(var p: TPasParser): PNode; -var - a, b: PNode; -begin - result := newNodeP(nkEnumTy, p); - getTok(p); - skipCom(p, result); - addSon(result, nil); // it does not inherit from any enumeration - - while true do begin - case p.tok.xkind of - pxEof, pxParRi: break; - pxSymbol: a := newIdentNodeP(p.tok.ident, p); - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - break - end; - end; - getTok(p); // skip identifier - skipCom(p, a); - if (p.tok.xkind = pxEquals) or (p.tok.xkind = pxAsgn) then begin - getTok(p); - skipCom(p, a); - b := a; - a := newNodeP(nkEnumFieldDef, p); - addSon(a, b); - addSon(a, parseExpr(p)); - end; - if p.tok.xkind = pxComma then begin - getTok(p); skipCom(p, a) - end; - addSon(result, a); - end; - eat(p, pxParRi) -end; - -function identVis(var p: TPasParser): PNode; // identifier with visability -var - a: PNode; -begin - a := createIdentNodeP(p.tok.ident, p); - if p.section = seInterface then begin - result := newNodeP(nkPostfix, p); - addSon(result, newIdentNodeP(getIdent('*'+''), p)); - addSon(result, a); - end - else - result := a; - getTok(p) -end; - -type - TSymbolParser = function (var p: TPasParser): PNode; - -function rawIdent(var p: TPasParser): PNode; -begin - result := createIdentNodeP(p.tok.ident, p); - getTok(p); -end; - -function parseIdentColonEquals(var p: TPasParser; - identParser: TSymbolParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkIdentDefs, p); - while true do begin - case p.tok.xkind of - pxSymbol: a := identParser(p); - pxColon, pxEof, pxParRi, pxEquals: break; - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - exit; - end; - end; - skipCom(p, a); - if p.tok.xkind = pxComma then begin - getTok(p); - skipCom(p, a) - end; - addSon(result, a); - end; - if p.tok.xkind = pxColon then begin - getTok(p); skipCom(p, result); - addSon(result, parseTypeDesc(p)); - end - else begin - addSon(result, nil); - if p.tok.xkind <> pxEquals then - parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)) - end; - if p.tok.xkind = pxEquals then begin - getTok(p); skipCom(p, result); - addSon(result, parseExpr(p)); - end - else - addSon(result, nil); - if p.tok.xkind = pxSemicolon then begin - getTok(p); skipCom(p, result); - end -end; - -function parseRecordCase(var p: TPasParser): PNode; -var - a, b, c: PNode; -begin - result := newNodeP(nkRecCase, p); - getTok(p); - a := newNodeP(nkIdentDefs, p); - addSon(a, rawIdent(p)); - eat(p, pxColon); - addSon(a, parseTypeDesc(p)); - addSon(a, nil); - addSon(result, a); - eat(p, pxOf); - skipCom(p, result); - - while true do begin - case p.tok.xkind of - pxEof, pxEnd: break; - pxElse: begin - b := newNodeP(nkElse, p); - getTok(p); - end; - else begin - b := newNodeP(nkOfBranch, p); - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> pxColon) do begin - addSon(b, rangeExpr(p)); - opt(p, pxComma); - skipcom(p, b); - end; - eat(p, pxColon); - end - end; - skipCom(p, b); - c := newNodeP(nkRecList, p); - eat(p, pxParLe); - while (p.tok.xkind <> pxParRi) and (p.tok.xkind <> pxEof) do begin - addSon(c, parseIdentColonEquals(p, rawIdent)); - opt(p, pxSemicolon); - skipCom(p, lastSon(c)); - end; - eat(p, pxParRi); - opt(p, pxSemicolon); - if sonsLen(c) > 0 then skipCom(p, lastSon(c)) - else addSon(c, newNodeP(nkNilLit, p)); - addSon(b, c); - addSon(result, b); - if b.kind = nkElse then break; - end -end; - -function parseRecordPart(var p: TPasParser): PNode; -begin - result := nil; - while (p.tok.xkind <> pxEof) and (p.tok.xkind <> pxEnd) do begin - if result = nil then result := newNodeP(nkRecList, p); - case p.tok.xkind of - pxSymbol: begin - addSon(result, parseIdentColonEquals(p, rawIdent)); - opt(p, pxSemicolon); - skipCom(p, lastSon(result)); - end; - pxCase: begin - addSon(result, parseRecordCase(p)); - end; - pxComment: skipCom(p, lastSon(result)); - else begin - parMessage(p, errIdentifierExpected, pasTokToStr(p.tok)); - break - end - end - end -end; - -procedure exSymbol(var n: PNode); -var - a: PNode; -begin - case n.kind of - nkPostfix: begin end; // already an export marker - nkPragmaExpr: exSymbol(n.sons[0]); - nkIdent, nkAccQuoted: begin - a := newNodeI(nkPostFix, n.info); - addSon(a, newIdentNode(getIdent('*'+''), n.info)); - addSon(a, n); - n := a - end; - else internalError(n.info, 'exSymbol(): ' + nodekindtostr[n.kind]); - end -end; - -procedure fixRecordDef(var n: PNode); -var - i, len: int; -begin - if n = nil then exit; - case n.kind of - nkRecCase: begin - fixRecordDef(n.sons[0]); - for i := 1 to sonsLen(n)-1 do begin - len := sonsLen(n.sons[i]); - fixRecordDef(n.sons[i].sons[len-1]) - end - end; - nkRecList, nkRecWhen, nkElse, nkOfBranch, nkElifBranch, - nkObjectTy: begin - for i := 0 to sonsLen(n)-1 do fixRecordDef(n.sons[i]) - end; - nkIdentDefs: begin - for i := 0 to sonsLen(n)-3 do exSymbol(n.sons[i]) - end; - nkNilLit: begin end; - //nkIdent: exSymbol(n); - else internalError(n.info, 'fixRecordDef(): ' + nodekindtostr[n.kind]); - end -end; - -procedure addPragmaToIdent(var ident: PNode; pragma: PNode); -var - e, pragmasNode: PNode; -begin - if ident.kind <> nkPragmaExpr then begin - pragmasNode := newNodeI(nkPragma, ident.info); - e := newNodeI(nkPragmaExpr, ident.info); - addSon(e, ident); - addSon(e, pragmasNode); - ident := e; - end - else begin - pragmasNode := ident.sons[1]; - if pragmasNode.kind <> nkPragma then - InternalError(ident.info, 'addPragmaToIdent'); - end; - addSon(pragmasNode, pragma); -end; - -procedure parseRecordBody(var p: TPasParser; result, definition: PNode); -var - a: PNode; -begin - skipCom(p, result); - a := parseRecordPart(p); - if result.kind <> nkTupleTy then fixRecordDef(a); - addSon(result, a); - eat(p, pxEnd); - case p.tok.xkind of - pxSymbol: begin - if (p.tok.ident.id = getIdent('acyclic').id) then begin - if definition <> nil then - addPragmaToIdent(definition.sons[0], newIdentNodeP(p.tok.ident, p)) - else - InternalError(result.info, 'anonymous record is not supported'); - getTok(p); - end - else - InternalError(result.info, 'parseRecordBody'); - end; - pxCommand: begin - if definition <> nil then - addPragmaToIdent(definition.sons[0], parseCommand(p)) - else - InternalError(result.info, 'anonymous record is not supported'); - end; - else begin end - end; - opt(p, pxSemicolon); - skipCom(p, result); -end; - -function parseRecordOrObject(var p: TPasParser; kind: TNodeKind; - definition: PNode): PNode; -var - a: PNode; -begin - result := newNodeP(kind, p); - getTok(p); - addSon(result, nil); - if p.tok.xkind = pxParLe then begin - a := newNodeP(nkOfInherit, p); - getTok(p); - addSon(a, parseTypeDesc(p)); - addSon(result, a); - eat(p, pxParRi); - end - else addSon(result, nil); - parseRecordBody(p, result, definition); -end; - -function parseTypeDesc(var p: TPasParser; definition: PNode=nil): PNode; -var - oldcontext: TPasContext; - a, r: PNode; - i: int; -begin - oldcontext := p.context; - p.context := conTypeDesc; - if p.tok.xkind = pxPacked then getTok(p); - case p.tok.xkind of - pxCommand: result := parseCommand(p, definition); - pxProcedure, pxFunction: result := parseRoutineType(p); - pxRecord: begin - getTok(p); - if p.tok.xkind = pxCommand then begin - result := parseCommand(p); - if result.kind <> nkTupleTy then - InternalError(result.info, 'parseTypeDesc'); - parseRecordBody(p, result, definition); - a := lastSon(result); - // embed nkRecList directly into nkTupleTy - for i := 0 to sonsLen(a)-1 do - if i = 0 then result.sons[sonsLen(result)-1] := a.sons[0] - else addSon(result, a.sons[i]); - end - else begin - result := newNodeP(nkObjectTy, p); - addSon(result, nil); - addSon(result, nil); - parseRecordBody(p, result, definition); - if definition <> nil then - addPragmaToIdent(definition.sons[0], - newIdentNodeP(getIdent('final'), p)) - else - InternalError(result.info, 'anonymous record is not supported'); - end; - end; - pxObject: result := parseRecordOrObject(p, nkObjectTy, definition); - pxParLe: result := parseEnum(p); - pxArray: begin - result := newNodeP(nkBracketExpr, p); - getTok(p); - if p.tok.xkind = pxBracketLe then begin - addSon(result, newIdentNodeP(getIdent('array'), p)); - getTok(p); - addSon(result, rangeExpr(p)); - eat(p, pxBracketRi); - end - else begin - if p.inParamList then - addSon(result, newIdentNodeP(getIdent('openarray'), p)) - else - addSon(result, newIdentNodeP(getIdent('seq'), p)); - end; - eat(p, pxOf); - addSon(result, parseTypeDesc(p)); - end; - pxSet: begin - result := newNodeP(nkBracketExpr, p); - getTok(p); - eat(p, pxOf); - addSon(result, newIdentNodeP(getIdent('set'), p)); - addSon(result, parseTypeDesc(p)); - end; - pxHat: begin - getTok(p); - if p.tok.xkind = pxCommand then - result := parseCommand(p) - else if gCmd = cmdBoot then - result := newNodeP(nkRefTy, p) - else - result := newNodeP(nkPtrTy, p); - addSon(result, parseTypeDesc(p)) - end; - pxType: begin - getTok(p); - result := parseTypeDesc(p); - end; - else begin - a := primary(p); - if p.tok.xkind = pxDotDot then begin - result := newNodeP(nkBracketExpr, p); - r := newNodeP(nkRange, p); - addSon(result, newIdentNodeP(getIdent('range'), p)); - getTok(p); - addSon(r, a); - addSon(r, parseExpr(p)); - addSon(result, r); - end - else - result := a - end - end; - p.context := oldcontext; -end; - -function parseTypeDef(var p: TPasParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkTypeDef, p); - addSon(result, identVis(p)); - addSon(result, nil); // generic params - if p.tok.xkind = pxEquals then begin - getTok(p); skipCom(p, result); - a := parseTypeDesc(p, result); - addSon(result, a); - end - else - addSon(result, nil); - if p.tok.xkind = pxSemicolon then begin - getTok(p); skipCom(p, result); - end; -end; - -function parseTypeSection(var p: TPasParser): PNode; -begin - result := newNodeP(nkTypeSection, p); - getTok(p); - skipCom(p, result); - while p.tok.xkind = pxSymbol do begin - addSon(result, parseTypeDef(p)) - end -end; - -function parseConstant(var p: TPasParser): PNode; -begin - result := newNodeP(nkConstDef, p); - addSon(result, identVis(p)); - if p.tok.xkind = pxColon then begin - getTok(p); skipCom(p, result); - addSon(result, parseTypeDesc(p)); - end - else begin - addSon(result, nil); - if p.tok.xkind <> pxEquals then - parMessage(p, errColonOrEqualsExpected, pasTokToStr(p.tok)); - end; - if p.tok.xkind = pxEquals then begin - getTok(p); skipCom(p, result); - addSon(result, parseExpr(p)); - end - else - addSon(result, nil); - if p.tok.xkind = pxSemicolon then begin - getTok(p); skipCom(p, result); - end; -end; - -function parseConstSection(var p: TPasParser): PNode; -begin - result := newNodeP(nkConstSection, p); - getTok(p); - skipCom(p, result); - while p.tok.xkind = pxSymbol do begin - addSon(result, parseConstant(p)) - end -end; - -function parseVar(var p: TPasParser): PNode; -begin - result := newNodeP(nkVarSection, p); - getTok(p); - skipCom(p, result); - while p.tok.xkind = pxSymbol do begin - addSon(result, parseIdentColonEquals(p, identVis)); - end; - p.lastVarSection := result -end; - -function parseRoutine(var p: TPasParser): PNode; -var - a, stmts: PNode; - noBody: boolean; - i: int; -begin - result := newNodeP(nkProcDef, p); - getTok(p); - skipCom(p, result); - expectIdent(p); - addSon(result, identVis(p)); - addSon(result, nil); // generic parameters - addSon(result, parseParamList(p)); - opt(p, pxSemicolon); - addSon(result, parseRoutineSpecifiers(p, noBody)); - if (p.section = seInterface) or noBody then - addSon(result, nil) - else begin - stmts := newNodeP(nkStmtList, p); - while true do begin - case p.tok.xkind of - pxVar: addSon(stmts, parseVar(p)); - pxConst: addSon(stmts, parseConstSection(p)); - pxType: addSon(stmts, parseTypeSection(p)); - pxComment: skipCom(p, result); - pxBegin: break; - else begin - parMessage(p, errTokenExpected, 'begin'); - break - end - end - end; - a := parseStmt(p); - for i := 0 to sonsLen(a)-1 do addSon(stmts, a.sons[i]); - addSon(result, stmts); - end -end; - -function fixExit(var p: TPasParser; n: PNode): boolean; -var - len: int; - a: PNode; -begin - result := false; - if (p.tok.ident.id = getIdent('exit').id) then begin - len := sonsLen(n); - if (len <= 0) then exit; - a := n.sons[len-1]; - if (a.kind = nkAsgn) - and (a.sons[0].kind = nkIdent) - and (a.sons[0].ident.id = getIdent('result').id) then begin - delSon(a, 0); - a.kind := nkReturnStmt; - result := true; - getTok(p); opt(p, pxSemicolon); - skipCom(p, a); - end - end -end; - -procedure fixVarSection(var p: TPasParser; counter: PNode); -var - i, j: int; - v: PNode; -begin - if p.lastVarSection = nil then exit; - assert(counter.kind = nkIdent); - for i := 0 to sonsLen(p.lastVarSection)-1 do begin - v := p.lastVarSection.sons[i]; - for j := 0 to sonsLen(v)-3 do begin - if v.sons[j].ident.id = counter.ident.id then begin - delSon(v, j); - if sonsLen(v) <= 2 then // : type = int remains --> delete it - delSon(p.lastVarSection, i); - exit - end - end - end -end; - -procedure parseBegin(var p: TPasParser; result: PNode); -begin - getTok(p); - while true do begin - case p.tok.xkind of - pxComment: addSon(result, parseStmt(p)); - pxSymbol: begin - if not fixExit(p, result) then addSon(result, parseStmt(p)) - end; - pxEnd: begin getTok(p); break end; - pxSemicolon: begin getTok(p); end; - pxEof: parMessage(p, errExprExpected); - else addSonIfNotNil(result, parseStmt(p)); - end - end; - if sonsLen(result) = 0 then - addSon(result, newNodeP(nkNilLit, p)); -end; - -function parseStmt(var p: TPasParser): PNode; -var - oldcontext: TPasContext; -begin - oldcontext := p.context; - p.context := conStmt; - result := nil; - case p.tok.xkind of - pxBegin: begin - result := newNodeP(nkStmtList, p); - parseBegin(p, result); - end; - pxCommand: result := parseCommand(p); - pxCurlyDirLe, pxStarDirLe: begin - if isHandledDirective(p) then - result := parseDirective(p); - end; - pxIf: result := parseIf(p); - pxWhile: result := parseWhile(p); - pxRepeat: result := parseRepeat(p); - pxCase: result := parseCase(p); - pxTry: result := parseTry(p); - pxProcedure, pxFunction: result := parseRoutine(p); - pxType: result := parseTypeSection(p); - pxConst: result := parseConstSection(p); - pxVar: result := parseVar(p); - pxFor: begin - result := parseFor(p); - fixVarSection(p, result.sons[0]); - end; - pxRaise: result := parseRaise(p); - pxUses: result := parseUsesStmt(p); - pxProgram, pxUnit, pxLibrary: begin - // skip the pointless header - while not (p.tok.xkind in [pxSemicolon, pxEof]) do getTok(p); - getTok(p); - end; - pxInitialization: begin - getTok(p); // just skip the token - end; - pxImplementation: begin - p.section := seImplementation; - result := newNodeP(nkCommentStmt, p); - result.comment := '# implementation'; - getTok(p); - end; - pxInterface: begin - p.section := seInterface; - getTok(p); - end; - pxComment: begin - result := newNodeP(nkCommentStmt, p); - skipCom(p, result); - end; - pxSemicolon: getTok(p); - pxSymbol: begin - if p.tok.ident.id = getIdent('break').id then begin - result := newNodeP(nkBreakStmt, p); - getTok(p); skipCom(p, result); - addSon(result, nil); - end - else if p.tok.ident.id = getIdent('continue').id then begin - result := newNodeP(nkContinueStmt, p); - getTok(p); skipCom(p, result); - addSon(result, nil); - end - else if p.tok.ident.id = getIdent('exit').id then begin - result := newNodeP(nkReturnStmt, p); - getTok(p); skipCom(p, result); - addSon(result, nil); - end - else result := parseExprStmt(p) - end; - pxDot: getTok(p); // BUGFIX for ``end.`` in main program - else result := parseExprStmt(p) - end; - opt(p, pxSemicolon); - if result <> nil then skipCom(p, result); - p.context := oldcontext; -end; - -function parseUnit(var p: TPasParser): PNode; -begin - result := newNodeP(nkStmtList, p); - getTok(p); // read first token - while true do begin - case p.tok.xkind of - pxEof, pxEnd: break; - pxBegin: parseBegin(p, result); - pxCurlyDirLe, pxStarDirLe: begin - if isHandledDirective(p) then - addSon(result, parseDirective(p)) - else - parMessage(p, errXNotAllowedHere, p.tok.ident.s) - end - else addSon(result, parseStmt(p)) - end; - end; - opt(p, pxEnd); - opt(p, pxDot); - if p.tok.xkind <> pxEof then - addSon(result, parseStmt(p)); // comments after final 'end.' -end; - -end. diff --git a/nim/passaux.pas b/nim/passaux.pas deleted file mode 100755 index 7898d82780..0000000000 --- a/nim/passaux.pas +++ /dev/null @@ -1,77 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit passaux; - -// implements some little helper passes -{$include 'config.inc'} - -interface - -uses - nsystem, strutils, ast, astalgo, passes, msgs, options; - -function verbosePass: TPass; -function cleanupPass: TPass; - -implementation - -function verboseOpen(s: PSym; const filename: string): PPassContext; -begin - //MessageOut('compiling ' + s.name.s); - result := nil; // we don't need a context - if gVerbosity > 0 then - rawMessage(hintProcessing, s.name.s); -end; - -function verboseProcess(context: PPassContext; n: PNode): PNode; -begin - result := n; - if context <> nil then InternalError('logpass: context is not nil'); - if gVerbosity = 3 then - liMessage(n.info, hintProcessing, toString(ast.gid)); -end; - -function verbosePass: TPass; -begin - initPass(result); - result.open := verboseOpen; - result.process := verboseProcess; -end; - -function cleanUp(c: PPassContext; n: PNode): PNode; -var - i: int; - s: PSym; -begin - result := n; - // we cannot clean up if dead code elimination is activated - if (optDeadCodeElim in gGlobalOptions) then exit; - case n.kind of - nkStmtList: begin - for i := 0 to sonsLen(n)-1 do {@discard} cleanup(c, n.sons[i]); - end; - nkProcDef, nkMethodDef: begin - if (n.sons[namePos].kind = nkSym) then begin - s := n.sons[namePos].sym; - if not (sfDeadCodeElim in getModule(s).flags) and - not astNeeded(s) then s.ast.sons[codePos] := nil; // free the memory - end - end - else begin end; - end -end; - -function cleanupPass: TPass; -begin - initPass(result); - result.process := cleanUp; - result.close := cleanUp; -end; - -end. diff --git a/nim/passes.pas b/nim/passes.pas deleted file mode 100755 index c280a75b14..0000000000 --- a/nim/passes.pas +++ /dev/null @@ -1,215 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit passes; - -// This module implements the passes functionality. A pass must implement the -// `TPass` interface. - -interface - -{$include 'config.inc'} - -uses - nsystem, charsets, strutils, - lists, options, ast, astalgo, llstream, - msgs, platform, nos, condsyms, idents, rnimsyn, types, - extccomp, nmath, magicsys, nversion, nimsets, syntaxes, ntime, rodread; - -type - TPassContext = object(NObject) // the pass's context - end; - PPassContext = ^TPassContext; - - TPass = record {@tuple} // a pass is a tuple of procedure vars - open: function (module: PSym; const filename: string): PPassContext; - openCached: function (module: PSym; const filename: string; - rd: PRodReader): PPassContext; - close: function (p: PPassContext; n: PNode): PNode; - process: function (p: PPassContext; topLevelStmt: PNode): PNode; - end; - -// ``TPass.close`` may produce additional nodes. These are passed to the other -// close procedures. This mechanism is needed for the instantiation of -// generics. - -procedure registerPass(const p: TPass); - -procedure initPass(var p: TPass); - -// This implements a memory preserving scheme: Top level statements are -// processed in a pipeline. The compiler never looks at a whole module -// any longer. However, this is simple to change, as new passes may perform -// whole program optimizations. For now, we avoid it to save a lot of memory. - -procedure processModule(module: PSym; const filename: string; - stream: PLLStream; rd: PRodReader); - - -function astNeeded(s: PSym): bool; - // The ``rodwrite`` module uses this to determine if the body of a proc - // needs to be stored. The passes manager frees s.sons[codePos] when - // appropriate to free the procedure body's memory. This is important - // to keep memory usage down. - -// the semantic checker needs these: -var - gImportModule: function (const filename: string): PSym; - gIncludeFile: function (const filename: string): PNode; - -implementation - -function astNeeded(s: PSym): bool; -begin - if (s.kind in [skMethod, skProc]) - and ([sfCompilerProc, sfCompileTime] * s.flags = []) - and (s.typ.callConv <> ccInline) - and (s.ast.sons[genericParamsPos] = nil) then - result := false - else - result := true -end; - -const - maxPasses = 10; - -type - TPassContextArray = array [0..maxPasses-1] of PPassContext; -var - gPasses: array [0..maxPasses-1] of TPass; - gPassesLen: int; - -procedure registerPass(const p: TPass); -begin - gPasses[gPassesLen] := p; - inc(gPassesLen); -end; - -procedure openPasses(var a: TPassContextArray; module: PSym; - const filename: string); -var - i: int; -begin - for i := 0 to gPassesLen-1 do - if assigned(gPasses[i].open) then - a[i] := gPasses[i].open(module, filename) - else - a[i] := nil -end; - -procedure openPassesCached(var a: TPassContextArray; module: PSym; - const filename: string; rd: PRodReader); -var - i: int; -begin - for i := 0 to gPassesLen-1 do - if assigned(gPasses[i].openCached) then - a[i] := gPasses[i].openCached(module, filename, rd) - else - a[i] := nil -end; - -procedure closePasses(var a: TPassContextArray); -var - i: int; - m: PNode; -begin - m := nil; - for i := 0 to gPassesLen-1 do begin - if assigned(gPasses[i].close) then m := gPasses[i].close(a[i], m); - a[i] := nil; // free the memory here - end -end; - -procedure processTopLevelStmt(n: PNode; var a: TPassContextArray); -var - i: int; - m: PNode; -begin - // this implements the code transformation pipeline - m := n; - for i := 0 to gPassesLen-1 do - if assigned(gPasses[i].process) then m := gPasses[i].process(a[i], m); -end; - -procedure processTopLevelStmtCached(n: PNode; var a: TPassContextArray); -var - i: int; - m: PNode; -begin - // this implements the code transformation pipeline - m := n; - for i := 0 to gPassesLen-1 do - if assigned(gPasses[i].openCached) then m := gPasses[i].process(a[i], m); -end; - -procedure closePassesCached(var a: TPassContextArray); -var - i: int; - m: PNode; -begin - m := nil; - for i := 0 to gPassesLen-1 do begin - if assigned(gPasses[i].openCached) and assigned(gPasses[i].close) then - m := gPasses[i].close(a[i], m); - a[i] := nil; // free the memory here - end -end; - -procedure processModule(module: PSym; const filename: string; - stream: PLLStream; rd: PRodReader); -var - p: TParsers; - n: PNode; - a: TPassContextArray; - s: PLLStream; - i: int; -begin - if rd = nil then begin - openPasses(a, module, filename); - if stream = nil then begin - s := LLStreamOpen(filename, fmRead); - if s = nil then begin - rawMessage(errCannotOpenFile, filename); - exit - end; - end - else - s := stream; - while true do begin - openParsers(p, filename, s); - while true do begin - n := parseTopLevelStmt(p); - if n = nil then break; - processTopLevelStmt(n, a) - end; - closeParsers(p); - if s.kind <> llsStdIn then break; - end; - closePasses(a); - // id synchronization point for more consistent code generation: - IDsynchronizationPoint(1000); - end - else begin - openPassesCached(a, module, filename, rd); - n := loadInitSection(rd); - //MessageOut('init section' + renderTree(n)); - for i := 0 to sonsLen(n)-1 do processTopLevelStmtCached(n.sons[i], a); - closePassesCached(a); - end; -end; - -procedure initPass(var p: TPass); -begin - p.open := nil; - p.openCached := nil; - p.close := nil; - p.process := nil; -end; - -end. diff --git a/nim/pbraces.pas b/nim/pbraces.pas deleted file mode 100755 index d1cb84096c..0000000000 --- a/nim/pbraces.pas +++ /dev/null @@ -1,1484 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit pbraces; - -{$include config.inc} - -interface - -uses - nsystem, llstream, scanner, idents, strutils, ast, msgs, pnimsyn; - -function ParseAll(var p: TParser): PNode; - -function parseTopLevelStmt(var p: TParser): PNode; -// implements an iterator. Returns the next top-level statement or nil if end -// of stream. - -implementation - -// ------------------- Expression parsing ------------------------------------ - -function parseExpr(var p: TParser): PNode; forward; -function parseStmt(var p: TParser): PNode; forward; - -function parseTypeDesc(var p: TParser): PNode; forward; -function parseParamList(var p: TParser): PNode; forward; - -function optExpr(var p: TParser): PNode; // [expr] -begin - if (p.tok.tokType <> tkComma) and (p.tok.tokType <> tkBracketRi) - and (p.tok.tokType <> tkDotDot) then - result := parseExpr(p) - else - result := nil; -end; - -function dotdotExpr(var p: TParser; first: PNode = nil): PNode; -begin - result := newNodeP(nkRange, p); - addSon(result, first); - getTok(p); - optInd(p, result); - addSon(result, optExpr(p)); -end; - -function indexExpr(var p: TParser): PNode; -// indexExpr ::= '..' [expr] | expr ['=' expr | '..' expr] -var - a, b: PNode; -begin - if p.tok.tokType = tkDotDot then - result := dotdotExpr(p) - else begin - a := parseExpr(p); - case p.tok.tokType of - tkEquals: begin - result := newNodeP(nkExprEqExpr, p); - addSon(result, a); - getTok(p); - if p.tok.tokType = tkDotDot then - addSon(result, dotdotExpr(p)) - else begin - b := parseExpr(p); - if p.tok.tokType = tkDotDot then b := dotdotExpr(p, b); - addSon(result, b); - end - end; - tkDotDot: result := dotdotExpr(p, a); - else result := a - end - end -end; - -function indexExprList(var p: TParser; first: PNode): PNode; -var - a: PNode; -begin - result := newNodeP(nkBracketExpr, p); - addSon(result, first); - getTok(p); - optInd(p, result); - while (p.tok.tokType <> tkBracketRi) and (p.tok.tokType <> tkEof) - and (p.tok.tokType <> tkSad) do begin - a := indexExpr(p); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function exprColonEqExpr(var p: TParser; kind: TNodeKind; - tok: TTokType): PNode; -var - a: PNode; -begin - a := parseExpr(p); - if p.tok.tokType = tok then begin - result := newNodeP(kind, p); - getTok(p); - //optInd(p, result); - addSon(result, a); - addSon(result, parseExpr(p)); - end - else - result := a -end; - -procedure exprListAux(var p: TParser; elemKind: TNodeKind; - endTok, sepTok: TTokType; result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin - a := exprColonEqExpr(p, elemKind, sepTok); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - eat(p, endTok); -end; - -function qualifiedIdent(var p: TParser): PNode; -var - a: PNode; -begin - result := parseSymbol(p); - if p.tok.tokType = tkDot then begin - getTok(p); - optInd(p, result); - a := result; - result := newNodeI(nkDotExpr, a.info); - addSon(result, a); - addSon(result, parseSymbol(p)); - end; -end; - -procedure qualifiedIdentListAux(var p: TParser; endTok: TTokType; result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin - a := qualifiedIdent(p); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - eat(p, endTok); -end; - -procedure exprColonEqExprListAux(var p: TParser; elemKind: TNodeKind; - endTok, sepTok: TTokType; result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) - and (p.tok.tokType <> tkSad) do begin - a := exprColonEqExpr(p, elemKind, sepTok); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, endTok); -end; - -function exprColonEqExprList(var p: TParser; kind, elemKind: TNodeKind; - endTok, sepTok: TTokType): PNode; -begin - result := newNodeP(kind, p); - exprColonEqExprListAux(p, elemKind, endTok, sepTok, result); -end; - -function parseCast(var p: TParser): PNode; -begin - result := newNodeP(nkCast, p); - getTok(p); - eat(p, tkBracketLe); - optInd(p, result); - addSon(result, parseTypeDesc(p)); - optSad(p); - eat(p, tkBracketRi); - eat(p, tkParLe); - optInd(p, result); - addSon(result, parseExpr(p)); - optSad(p); - eat(p, tkParRi); -end; - -function parseAddr(var p: TParser): PNode; -begin - result := newNodeP(nkAddr, p); - getTok(p); - eat(p, tkParLe); - optInd(p, result); - addSon(result, parseExpr(p)); - optSad(p); - eat(p, tkParRi); -end; - -function identOrLiteral(var p: TParser): PNode; -begin - case p.tok.tokType of - tkSymbol: begin - result := newIdentNodeP(p.tok.ident, p); - getTok(p) - end; - tkAccent: result := accExpr(p); - // literals - tkIntLit: begin - result := newIntNodeP(nkIntLit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt8Lit: begin - result := newIntNodeP(nkInt8Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt16Lit: begin - result := newIntNodeP(nkInt16Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt32Lit: begin - result := newIntNodeP(nkInt32Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt64Lit: begin - result := newIntNodeP(nkInt64Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloatLit: begin - result := newFloatNodeP(nkFloatLit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloat32Lit: begin - result := newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloat64Lit: begin - result := newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkStrLit: begin - result := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkRStrLit: begin - result := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - result := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p); - end; - tkCallRStrLit: begin - result := newNodeP(nkCallStrLit, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)); - getTok(p); - end; - tkCallTripleStrLit: begin - result := newNodeP(nkCallStrLit, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)); - getTok(p); - end; - tkCharLit: begin - result := newIntNodeP(nkCharLit, ord(p.tok.literal[strStart]), p); - getTok(p); - end; - tkNil: begin - result := newNodeP(nkNilLit, p); - getTok(p); - end; - tkParLe: begin // () constructor - result := exprColonEqExprList(p, nkPar, nkExprColonExpr, tkParRi, - tkColon); - end; - tkCurlyLe: begin // {} constructor - result := exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, tkDotDot); - end; - tkBracketLe: begin // [] constructor - result := exprColonEqExprList(p, nkBracket, nkExprColonExpr, tkBracketRi, - tkColon); - end; - tkCast: result := parseCast(p); - tkAddr: result := parseAddr(p); - else begin - parMessage(p, errExprExpected, tokToStr(p.tok)); - getTok(p); // we must consume a token here to prevend endless loops! - result := nil - end - end -end; - -function primary(var p: TParser): PNode; -var - a: PNode; -begin - // prefix operator? - if (p.tok.tokType = tkNot) or (p.tok.tokType = tkOpr) then begin - result := newNodeP(nkPrefix, p); - a := newIdentNodeP(p.tok.ident, p); - addSon(result, a); - getTok(p); - optInd(p, a); - addSon(result, primary(p)); - exit - end - else if p.tok.tokType = tkBind then begin - result := newNodeP(nkBind, p); - getTok(p); - optInd(p, result); - addSon(result, primary(p)); - exit - end; - result := identOrLiteral(p); - while true do begin - case p.tok.tokType of - tkParLe: begin - a := result; - result := newNodeP(nkCall, p); - addSon(result, a); - exprColonEqExprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result); - end; - tkDot: begin - a := result; - result := newNodeP(nkDotExpr, p); - addSon(result, a); - getTok(p); // skip '.' - optInd(p, result); - addSon(result, parseSymbol(p)); - end; - tkHat: begin - a := result; - result := newNodeP(nkDerefExpr, p); - addSon(result, a); - getTok(p); - end; - tkBracketLe: result := indexExprList(p, result); - else break - end - end -end; - -function lowestExprAux(var p: TParser; out v: PNode; limit: int): PToken; -var - op, nextop: PToken; - opPred: int; - v2, node, opNode: PNode; -begin - v := primary(p); - // expand while operators have priorities higher than 'limit' - op := p.tok; - opPred := getPrecedence(p.tok); - while (opPred > limit) do begin - node := newNodeP(nkInfix, p); - opNode := newIdentNodeP(op.ident, p); - // skip operator: - getTok(p); - optInd(p, opNode); - - // read sub-expression with higher priority - nextop := lowestExprAux(p, v2, opPred); - addSon(node, opNode); - addSon(node, v); - addSon(node, v2); - v := node; - op := nextop; - opPred := getPrecedence(nextop); - end; - result := op; // return first untreated operator -end; - -function lowestExpr(var p: TParser): PNode; -begin -{@discard} lowestExprAux(p, result, -1); -end; - -function parseIfExpr(var p: TParser): PNode; -// if (expr) expr else expr -var - branch: PNode; -begin - result := newNodeP(nkIfExpr, p); - while true do begin - getTok(p); // skip `if`, `elif` - branch := newNodeP(nkElifExpr, p); - eat(p, tkParLe); - addSon(branch, parseExpr(p)); - eat(p, tkParRi); - addSon(branch, parseExpr(p)); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - branch := newNodeP(nkElseExpr, p); - eat(p, tkElse); - addSon(branch, parseExpr(p)); - addSon(result, branch); -end; - -function parsePragma(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkPragma, p); - getTok(p); - optInd(p, result); - while (p.tok.tokType <> tkCurlyDotRi) and (p.tok.tokType <> tkCurlyRi) - and (p.tok.tokType <> tkEof) and (p.tok.tokType <> tkSad) do begin - a := exprColonEqExpr(p, nkExprColonExpr, tkColon); - addSon(result, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end - end; - optSad(p); - if (p.tok.tokType = tkCurlyDotRi) or (p.tok.tokType = tkCurlyRi) then - getTok(p) - else - parMessage(p, errTokenExpected, '.}'); -end; - -function identVis(var p: TParser): PNode; // identifier with visability -var - a: PNode; -begin - a := parseSymbol(p); - if p.tok.tokType = tkOpr then begin - result := newNodeP(nkPostfix, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, a); - getTok(p); - end - else - result := a; -end; - -function identWithPragma(var p: TParser): PNode; -var - a: PNode; -begin - a := identVis(p); - if p.tok.tokType = tkCurlyDotLe then begin - result := newNodeP(nkPragmaExpr, p); - addSon(result, a); - addSon(result, parsePragma(p)); - end - else - result := a -end; - -type - TDeclaredIdentFlag = ( - withPragma, // identifier may have pragma - withBothOptional // both ':' and '=' parts are optional - ); - TDeclaredIdentFlags = set of TDeclaredIdentFlag; - -function parseIdentColonEquals(var p: TParser; - flags: TDeclaredIdentFlags): PNode; -var - a: PNode; -begin - result := newNodeP(nkIdentDefs, p); - while true do begin - case p.tok.tokType of - tkSymbol, tkAccent: begin - if withPragma in flags then - a := identWithPragma(p) - else - a := parseSymbol(p); - if a = nil then exit; - end; - else break; - end; - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - if p.tok.tokType = tkColon then begin - getTok(p); optInd(p, result); - addSon(result, parseTypeDesc(p)); - end - else begin - addSon(result, nil); - if (p.tok.tokType <> tkEquals) and not (withBothOptional in flags) then - parMessage(p, errColonOrEqualsExpected, tokToStr(p.tok)) - end; - if p.tok.tokType = tkEquals then begin - getTok(p); optInd(p, result); - addSon(result, parseExpr(p)); - end - else - addSon(result, nil); -end; - -function parseTuple(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkTupleTy, p); - getTok(p); - eat(p, tkBracketLe); - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := parseIdentColonEquals(p, {@set}[]); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function parseParamList(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkFormalParams, p); - addSon(result, nil); // return type - if p.tok.tokType = tkParLe then begin - getTok(p); - optInd(p, result); - while true do begin - case p.tok.tokType of - tkSymbol, tkAccent: a := parseIdentColonEquals(p, {@set}[]); - tkParRi: break; - else begin parMessage(p, errTokenExpected, ')'+''); break; end; - end; - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkParRi); - end; - if p.tok.tokType = tkColon then begin - getTok(p); - optInd(p, result); - result.sons[0] := parseTypeDesc(p) - end -end; - -function parseProcExpr(var p: TParser; isExpr: bool): PNode; -// either a proc type or a anonymous proc -var - pragmas, params: PNode; - info: TLineInfo; -begin - info := parLineInfo(p); - getTok(p); - params := parseParamList(p); - if p.tok.tokType = tkCurlyDotLe then pragmas := parsePragma(p) - else pragmas := nil; - if (p.tok.tokType = tkCurlyLe) and isExpr then begin - result := newNodeI(nkLambda, info); - addSon(result, nil); // no name part - addSon(result, nil); // no generic parameters - addSon(result, params); - addSon(result, pragmas); - //getTok(p); skipComment(p, result); - addSon(result, parseStmt(p)); - end - else begin - result := newNodeI(nkProcTy, info); - addSon(result, params); - addSon(result, pragmas); - end -end; - -function parseTypeDescKAux(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, parseTypeDesc(p)); -end; - -function parseExpr(var p: TParser): PNode; -(* -expr ::= lowestExpr - | 'if' expr ':' expr ('elif' expr ':' expr)* 'else' ':' expr - | 'var' expr - | 'ref' expr - | 'ptr' expr - | 'type' expr - | 'tuple' tupleDesc - | 'proc' paramList [pragma] ['=' stmt] -*) -begin - case p.tok.toktype of - tkVar: result := parseTypeDescKAux(p, nkVarTy); - tkRef: result := parseTypeDescKAux(p, nkRefTy); - tkPtr: result := parseTypeDescKAux(p, nkPtrTy); - tkType: result := parseTypeDescKAux(p, nkTypeOfExpr); - tkTuple: result := parseTuple(p); - tkProc: result := parseProcExpr(p, true); - tkIf: result := parseIfExpr(p); - else result := lowestExpr(p); - end -end; - -function parseTypeDesc(var p: TParser): PNode; -begin - if p.tok.toktype = tkProc then result := parseProcExpr(p, false) - else result := parseExpr(p); -end; - -// ---------------------- statement parser ------------------------------------ -function isExprStart(const p: TParser): bool; -begin - case p.tok.tokType of - tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkBind, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, - tkVar, tkRef, tkPtr, tkTuple, tkType: result := true; - else result := false; - end; -end; - -function parseExprStmt(var p: TParser): PNode; -var - a, b, e: PNode; -begin - a := lowestExpr(p); - if p.tok.tokType = tkEquals then begin - getTok(p); - optInd(p, result); - b := parseExpr(p); - result := newNodeI(nkAsgn, a.info); - addSon(result, a); - addSon(result, b); - end - else begin - result := newNodeP(nkCommand, p); - result.info := a.info; - addSon(result, a); - while true do begin - if not isExprStart(p) then break; - e := parseExpr(p); - addSon(result, e); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a); - end; - if sonsLen(result) <= 1 then result := a - else a := result; - if p.tok.tokType = tkCurlyLe then begin // macro statement - result := newNodeP(nkMacroStmt, p); - result.info := a.info; - addSon(result, a); - getTok(p); - skipComment(p, result); - if (p.tok.tokType = tkInd) - or not (p.tok.TokType in [tkOf, tkElif, tkElse, tkExcept]) then - addSon(result, parseStmt(p)); - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkCurlyLe, tkDotDot, b); - end; - tkElif: begin - b := newNodeP(nkElifBranch, p); - getTok(p); - optInd(p, b); - addSon(b, parseExpr(p)); - eat(p, tkCurlyLe); - end; - tkExcept: begin - b := newNodeP(nkExceptBranch, p); - qualifiedIdentListAux(p, tkCurlyLe, b); - skipComment(p, b); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkCurlyLe); - end; - else break; - end; - addSon(b, parseStmt(p)); - eat(p, tkCurlyRi); - addSon(result, b); - if b.kind = nkElse then break; - end; - eat(p, tkCurlyRi); - end - end -end; - -function parseImportOrIncludeStmt(var p: TParser; kind: TNodeKind): PNode; -var - a: PNode; -begin - result := newNodeP(kind, p); - getTok(p); // skip `import` or `include` - optInd(p, result); - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - tkSymbol, tkAccent: a := parseSymbol(p); - tkRStrLit: begin - a := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p) - end; - tkStrLit: begin - a := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - a := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p) - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end; - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; -end; - -function parseFromStmt(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkFromStmt, p); - getTok(p); // skip `from` - optInd(p, result); - case p.tok.tokType of - tkSymbol, tkAccent: a := parseSymbol(p); - tkRStrLit: begin - a := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p) - end; - tkStrLit: begin - a := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - a := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p) - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); exit - end - end; - addSon(result, a); - //optInd(p, a); - eat(p, tkImport); - optInd(p, result); - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - tkSymbol, tkAccent: a := parseSymbol(p); - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end; - end; - //optInd(p, a); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; -end; - -function parseReturnOrRaise(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed: addSon(result, nil); - else addSon(result, parseExpr(p)); - end; -end; - -function parseYieldOrDiscard(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, parseExpr(p)); -end; - -function parseBreakOrContinue(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed: addSon(result, nil); - else addSon(result, parseSymbol(p)); - end; -end; - -function parseIfOrWhen(var p: TParser; kind: TNodeKind): PNode; -var - branch: PNode; -begin - result := newNodeP(kind, p); - while true do begin - getTok(p); // skip `if`, `when`, `elif` - branch := newNodeP(nkElifBranch, p); - optInd(p, branch); - eat(p, tkParLe); - addSon(branch, parseExpr(p)); - eat(p, tkParRi); - skipComment(p, branch); - addSon(branch, parseStmt(p)); - skipComment(p, branch); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - if p.tok.tokType = tkElse then begin - branch := newNodeP(nkElse, p); - eat(p, tkElse); - skipComment(p, branch); - addSon(branch, parseStmt(p)); - addSon(result, branch); - end -end; - -function parseWhile(var p: TParser): PNode; -begin - result := newNodeP(nkWhileStmt, p); - getTok(p); - optInd(p, result); - eat(p, tkParLe); - addSon(result, parseExpr(p)); - eat(p, tkParRi); - skipComment(p, result); - addSon(result, parseStmt(p)); -end; - -function parseCase(var p: TParser): PNode; -var - b: PNode; - inElif: bool; -begin - result := newNodeP(nkCaseStmt, p); - getTok(p); - eat(p, tkParLe); - addSon(result, parseExpr(p)); - eat(p, tkParRi); - skipComment(p, result); - inElif := false; - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - if inElif then break; - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkColon, tkDotDot, b); - end; - tkElif: begin - inElif := true; - b := newNodeP(nkElifBranch, p); - getTok(p); - optInd(p, b); - addSon(b, parseExpr(p)); - eat(p, tkColon); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkElse then break; - end -end; - -function parseTry(var p: TParser): PNode; -var - b: PNode; -begin - result := newNodeP(nkTryStmt, p); - getTok(p); - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)); - b := nil; - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkExcept: begin - b := newNodeP(nkExceptBranch, p); - qualifiedIdentListAux(p, tkColon, b); - end; - tkFinally: begin - b := newNodeP(nkFinally, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkFinally then break; - end; - if b = nil then parMessage(p, errTokenExpected, 'except'); -end; - -function parseFor(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkForStmt, p); - getTok(p); - optInd(p, result); - a := parseSymbol(p); - addSon(result, a); - while p.tok.tokType = tkComma do begin - getTok(p); - optInd(p, a); - a := parseSymbol(p); - addSon(result, a); - end; - eat(p, tkIn); - addSon(result, exprColonEqExpr(p, nkRange, tkDotDot)); - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)) -end; - -function parseBlock(var p: TParser): PNode; -begin - result := newNodeP(nkBlockStmt, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed, tkColon: addSon(result, nil); - else addSon(result, parseSymbol(p)); - end; - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)); -end; - -function parseAsm(var p: TParser): PNode; -begin - result := newNodeP(nkAsmStmt, p); - getTok(p); - optInd(p, result); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - case p.tok.tokType of - tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)); - tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)); - tkTripleStrLit: - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)); - else begin - parMessage(p, errStringLiteralExpected); - addSon(result, nil); exit - end; - end; - getTok(p); -end; - -function parseGenericParamList(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkGenericParams, p); - getTok(p); - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := parseIdentColonEquals(p, {@set}[withBothOptional]); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function parseRoutine(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, identVis(p)); - if p.tok.tokType = tkBracketLe then addSon(result, parseGenericParamList(p)) - else addSon(result, nil); - addSon(result, parseParamList(p)); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - if p.tok.tokType = tkEquals then begin - getTok(p); skipComment(p, result); - addSon(result, parseStmt(p)); - end - else - addSon(result, nil); - indAndComment(p, result); // XXX: document this in the grammar! -end; - -function newCommentStmt(var p: TParser): PNode; -begin - result := newNodeP(nkCommentStmt, p); - result.info.line := result.info.line - int16(1); -end; - -type - TDefParser = function (var p: TParser): PNode; - -function parseSection(var p: TParser; kind: TNodeKind; - defparser: TDefParser): PNode; -var - a: PNode; -begin - result := newNodeP(kind, p); - getTok(p); - skipComment(p, result); - case p.tok.tokType of - tkInd: begin - pushInd(p.lex^, p.tok.indent); - getTok(p); skipComment(p, result); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkSymbol, tkAccent: begin - a := defparser(p); - skipComment(p, a); - addSon(result, a); - end; - tkDed: begin getTok(p); break end; - tkEof: break; // BUGFIX - tkComment: begin - a := newCommentStmt(p); - skipComment(p, a); - addSon(result, a); - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end - end; - popInd(p.lex^); - end; - tkSymbol, tkAccent, tkParLe: begin - // tkParLe is allowed for ``var (x, y) = ...`` tuple parsing - addSon(result, defparser(p)); - end - else parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - end -end; - -function parseConstant(var p: TParser): PNode; -begin - result := newNodeP(nkConstDef, p); - addSon(result, identWithPragma(p)); - if p.tok.tokType = tkColon then begin - getTok(p); optInd(p, result); - addSon(result, parseTypeDesc(p)); - end - else - addSon(result, nil); - eat(p, tkEquals); - optInd(p, result); - addSon(result, parseExpr(p)); - indAndComment(p, result); // XXX: special extension! -end; - -function parseConstSection(var p: TParser): PNode; -begin - result := newNodeP(nkConstSection, p); - getTok(p); - skipComment(p, result); - if p.tok.tokType = tkCurlyLe then begin - getTok(p); - skipComment(p, result); - while (p.tok.tokType <> tkCurlyRi) and (p.tok.tokType <> tkEof) do begin - addSon(result, parseConstant(p)) - end; - eat(p, tkCurlyRi); - end - else - addSon(result, parseConstant(p)); -end; - - -function parseEnum(var p: TParser): PNode; -var - a, b: PNode; -begin - result := newNodeP(nkEnumTy, p); - a := nil; - getTok(p); - optInd(p, result); - if p.tok.tokType = tkOf then begin - a := newNodeP(nkOfInherit, p); - getTok(p); optInd(p, a); - addSon(a, parseTypeDesc(p)); - addSon(result, a) - end - else addSon(result, nil); - - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - else a := parseSymbol(p); - end; - optInd(p, a); - if p.tok.tokType = tkEquals then begin - getTok(p); - optInd(p, a); - b := a; - a := newNodeP(nkEnumFieldDef, p); - addSon(a, b); - addSon(a, parseExpr(p)); - skipComment(p, a); - end; - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; - addSon(result, a); - end -end; - -function parseObjectPart(var p: TParser): PNode; forward; - -function parseObjectWhen(var p: TParser): PNode; -var - branch: PNode; -begin - result := newNodeP(nkRecWhen, p); - while true do begin - getTok(p); // skip `when`, `elif` - branch := newNodeP(nkElifBranch, p); - optInd(p, branch); - addSon(branch, parseExpr(p)); - eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseObjectPart(p)); - skipComment(p, branch); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - if p.tok.tokType = tkElse then begin - branch := newNodeP(nkElse, p); - eat(p, tkElse); eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseObjectPart(p)); - addSon(result, branch); - end -end; - -function parseObjectCase(var p: TParser): PNode; -var - a, b: PNode; -begin - result := newNodeP(nkRecCase, p); - getTok(p); - a := newNodeP(nkIdentDefs, p); - addSon(a, identWithPragma(p)); - eat(p, tkColon); - addSon(a, parseTypeDesc(p)); - addSon(a, nil); - addSon(result, a); - skipComment(p, result); - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkColon, tkDotDot, b); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseObjectPart(p)); - addSon(result, b); - if b.kind = nkElse then break; - end -end; - -function parseObjectPart(var p: TParser): PNode; -begin - case p.tok.tokType of - tkInd: begin - result := newNodeP(nkRecList, p); - pushInd(p.lex^, p.tok.indent); - getTok(p); skipComment(p, result); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkCase, tkWhen, tkSymbol, tkAccent, tkNil: begin - addSon(result, parseObjectPart(p)); - end; - tkDed: begin getTok(p); break end; - tkEof: break; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end - end; - popInd(p.lex^); - end; - tkWhen: result := parseObjectWhen(p); - tkCase: result := parseObjectCase(p); - tkSymbol, tkAccent: begin - result := parseIdentColonEquals(p, {@set}[withPragma]); - skipComment(p, result); - end; - tkNil: begin - result := newNodeP(nkNilLit, p); - getTok(p); - end; - else result := nil - end -end; - -function parseObject(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkObjectTy, p); - getTok(p); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - if p.tok.tokType = tkOf then begin - a := newNodeP(nkOfInherit, p); - getTok(p); - addSon(a, parseTypeDesc(p)); - addSon(result, a); - end - else addSon(result, nil); - skipComment(p, result); - addSon(result, parseObjectPart(p)); -end; - -function parseDistinct(var p: TParser): PNode; -begin - result := newNodeP(nkDistinctTy, p); - getTok(p); - optInd(p, result); - addSon(result, parseTypeDesc(p)); -end; - -function parseTypeDef(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkTypeDef, p); - addSon(result, identWithPragma(p)); - if p.tok.tokType = tkBracketLe then addSon(result, parseGenericParamList(p)) - else addSon(result, nil); - if p.tok.tokType = tkEquals then begin - getTok(p); optInd(p, result); - case p.tok.tokType of - tkObject: a := parseObject(p); - tkEnum: a := parseEnum(p); - tkDistinct: a := parseDistinct(p); - else a := parseTypeDesc(p); - end; - addSon(result, a); - end - else - addSon(result, nil); - indAndComment(p, result); // special extension! -end; - -function parseVarTuple(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkVarTuple, p); - getTok(p); // skip '(' - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := identWithPragma(p); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - addSon(result, nil); // no type desc - optSad(p); - eat(p, tkParRi); - eat(p, tkEquals); - optInd(p, result); - addSon(result, parseExpr(p)); -end; - -function parseVariable(var p: TParser): PNode; -begin - if p.tok.tokType = tkParLe then - result := parseVarTuple(p) - else - result := parseIdentColonEquals(p, {@set}[withPragma]); - indAndComment(p, result); // special extension! -end; - -function simpleStmt(var p: TParser): PNode; -begin - case p.tok.tokType of - tkReturn: result := parseReturnOrRaise(p, nkReturnStmt); - tkRaise: result := parseReturnOrRaise(p, nkRaiseStmt); - tkYield: result := parseYieldOrDiscard(p, nkYieldStmt); - tkDiscard: result := parseYieldOrDiscard(p, nkDiscardStmt); - tkBreak: result := parseBreakOrContinue(p, nkBreakStmt); - tkContinue: result := parseBreakOrContinue(p, nkContinueStmt); - tkCurlyDotLe: result := parsePragma(p); - tkImport: result := parseImportOrIncludeStmt(p, nkImportStmt); - tkFrom: result := parseFromStmt(p); - tkInclude: result := parseImportOrIncludeStmt(p, nkIncludeStmt); - tkComment: result := newCommentStmt(p); - else begin - if isExprStart(p) then - result := parseExprStmt(p) - else - result := nil; - end - end; - if result <> nil then - skipComment(p, result); -end; - -function parseType(var p: TParser): PNode; -begin - result := newNodeP(nkTypeSection, p); - while true do begin - case p.tok.tokType of - tkComment: skipComment(p, result); - tkType: begin - // type alias: - - end; - tkEnum: begin end; - tkObject: begin end; - tkTuple: begin end; - else break; - end - end -end; - -function complexOrSimpleStmt(var p: TParser): PNode; -begin - case p.tok.tokType of - tkIf: result := parseIfOrWhen(p, nkIfStmt); - tkWhile: result := parseWhile(p); - tkCase: result := parseCase(p); - tkTry: result := parseTry(p); - tkFor: result := parseFor(p); - tkBlock: result := parseBlock(p); - tkAsm: result := parseAsm(p); - tkProc: result := parseRoutine(p, nkProcDef); - tkMethod: result := parseRoutine(p, nkMethodDef); - tkIterator: result := parseRoutine(p, nkIteratorDef); - tkMacro: result := parseRoutine(p, nkMacroDef); - tkTemplate: result := parseRoutine(p, nkTemplateDef); - tkConverter: result := parseRoutine(p, nkConverterDef); - tkType, tkEnum, tkObject, tkTuple: - result := nil; - //result := parseTypeAlias(p, nkTypeSection, parseTypeDef); - tkConst: result := parseConstSection(p); - tkWhen: result := parseIfOrWhen(p, nkWhenStmt); - tkVar: result := parseSection(p, nkVarSection, parseVariable); - else result := simpleStmt(p); - end -end; - -function parseStmt(var p: TParser): PNode; -var - a: PNode; -begin - if p.tok.tokType = tkCurlyLe then begin - result := newNodeP(nkStmtList, p); - getTok(p); - while true do begin - case p.tok.tokType of - tkSad, tkInd, tkDed: getTok(p); - tkEof, tkCurlyRi: break; - else begin - a := complexOrSimpleStmt(p); - if a = nil then break; - addSon(result, a); - end - end - end; - eat(p, tkCurlyRi); - end - else begin - // the case statement is only needed for better error messages: - case p.tok.tokType of - tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, - tkProc, tkIterator, tkMacro, tkType, tkConst, tkWhen, tkVar: begin - parMessage(p, errComplexStmtRequiresInd); - result := nil - end - else begin - result := simpleStmt(p); - if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - if p.tok.tokType in [tkInd, tkDed, tkSad] then getTok(p); - end - end - end -end; - -function parseAll(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkStmtList, p); - while true do begin - case p.tok.tokType of - tkDed, tkInd, tkSad: getTok(p); - tkEof: break; - else begin - a := complexOrSimpleStmt(p); - if a = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - addSon(result, a); - end - end - end -end; - -function parseTopLevelStmt(var p: TParser): PNode; -begin - result := nil; - while true do begin - case p.tok.tokType of - tkDed, tkInd, tkSad: getTok(p); - tkEof: break; - else begin - result := complexOrSimpleStmt(p); - if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - break - end - end - end -end; - -end. diff --git a/nim/pendx.pas b/nim/pendx.pas deleted file mode 100755 index e23229e283..0000000000 --- a/nim/pendx.pas +++ /dev/null @@ -1,36 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit pendx; - -{$include config.inc} - -interface - -uses - nsystem, llstream, scanner, idents, strutils, ast, msgs, pnimsyn; - -function ParseAll(var p: TParser): PNode; - -function parseTopLevelStmt(var p: TParser): PNode; -// implements an iterator. Returns the next top-level statement or nil if end -// of stream. - -implementation - -function ParseAll(var p: TParser): PNode; -begin - result := nil -end; - -function parseTopLevelStmt(var p: TParser): PNode; -begin - result := nil -end; - -end. diff --git a/nim/platform.pas b/nim/platform.pas deleted file mode 100755 index c2fa711b9f..0000000000 --- a/nim/platform.pas +++ /dev/null @@ -1,662 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit platform; - -// This module contains data about the different processors -// and operating systems. -// Note: Unfortunately if an OS or CPU is listed here this does not mean that -// Nimrod has been tested on this platform or that the RTL has been ported. -// Feel free to test for your excentric platform! - -interface - -{$include 'config.inc'} - -uses - nsystem, strutils; - -type - TSystemOS = ( - // Also add OS in initialization section and alias conditionals to - // condsyms (end of module). - osNone, - osDos, - osWindows, - osOs2, - osLinux, - osMorphos, - osSkyos, - osSolaris, - osIrix, - osNetbsd, - osFreebsd, - osOpenbsd, - osAix, - osPalmos, - osQnx, - osAmiga, - osAtari, - osNetware, - osMacos, - osMacosx, - osEcmaScript, - osNimrodVM - ); -type - TInfoOSProp = ( - ospNeedsPIC, // OS needs PIC for libraries - ospCaseInsensitive, // OS filesystem is case insensitive - ospPosix // OS is posix-like - ); - - TInfoOSProps = set of TInfoOSProp; - TInfoOS = record{@tuple} - name: string; - parDir: string; - dllFrmt: string; - altDirSep: string; - objExt: string; - newLine: string; - pathSep: string; - dirSep: string; - scriptExt: string; - curDir: string; - exeExt: string; - extSep: string; - props: TInfoOSProps; - end; -const - OS: array [succ(low(TSystemOS))..high(TSystemOS)] of TInfoOS = ( - ( - name: 'DOS'; - parDir: '..'; - dllFrmt: '$1.dll'; - altDirSep: '/'+''; - objExt: '.obj'; - newLine: #13#10; - pathSep: ';'+''; - dirSep: '\'+''; - scriptExt: '.bat'; - curDir: '.'+''; - exeExt: '.exe'; - extSep: '.'+''; - props: {@set}[ospCaseInsensitive]; - ), - ( - name: 'Windows'; - parDir: '..'; - dllFrmt: '$1.dll'; - altDirSep: '/'+''; - objExt: '.obj'; - newLine: #13#10; - pathSep: ';'+''; - dirSep: '\'+''; - scriptExt: '.bat'; - curDir: '.'+''; - exeExt: '.exe'; - extSep: '.'+''; - props: {@set}[ospCaseInsensitive]; - ), - ( - name: 'OS2'; - parDir: '..'; - dllFrmt: '$1.dll'; - altDirSep: '/'+''; - objExt: '.obj'; - newLine: #13#10; - pathSep: ';'+''; - dirSep: '\'+''; - scriptExt: '.bat'; - curDir: '.'+''; - exeExt: '.exe'; - extSep: '.'+''; - props: {@set}[ospCaseInsensitive]; - ), - ( - name: 'Linux'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'MorphOS'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'SkyOS'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'Solaris'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'Irix'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'NetBSD'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'FreeBSD'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'OpenBSD'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'AIX'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'PalmOS'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC]; - ), - ( - name: 'QNX'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'Amiga'; - parDir: '..'; - dllFrmt: '$1.library'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC]; - ), - ( - name: 'Atari'; - parDir: '..'; - dllFrmt: '$1.dll'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: ''; - curDir: '.'+''; - exeExt: '.tpp'; - extSep: '.'+''; - props: {@set}[ospNeedsPIC]; - ), - ( - name: 'Netware'; - parDir: '..'; - dllFrmt: '$1.nlm'; - altDirSep: '/'+''; - objExt: ''; - newLine: #13#10; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: '.nlm'; - extSep: '.'+''; - props: {@set}[ospCaseInsensitive]; - ), - ( - name: 'MacOS'; - parDir: '::'; - dllFrmt: '$1Lib'; - altDirSep: ':'+''; - objExt: '.o'; - newLine: #13+''; - pathSep: ','+''; - dirSep: ':'+''; - scriptExt: ''; - curDir: ':'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospCaseInsensitive]; - ), - ( - name: 'MacOSX'; - parDir: '..'; - dllFrmt: 'lib$1.dylib'; - altDirSep: ':'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), - ( - name: 'EcmaScript'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[]; - ), - ( - name: 'NimrodVM'; - parDir: '..'; - dllFrmt: 'lib$1.so'; - altDirSep: '/'+''; - objExt: '.o'; - newLine: #10+''; - pathSep: ':'+''; - dirSep: '/'+''; - scriptExt: '.sh'; - curDir: '.'+''; - exeExt: ''; - extSep: '.'+''; - props: {@set}[]; - ) -); -type - TSystemCPU = ( - // Also add CPU for in initialization section and alias conditionals to - // condsyms (end of module). - cpuNone, - cpuI386, - cpuM68k, - cpuAlpha, - cpuPowerpc, - cpuSparc, - cpuVm, - cpuIa64, - cpuAmd64, - cpuMips, - cpuArm, - cpuEcmaScript, - cpuNimrodVM - ); -type - TEndian = (littleEndian, bigEndian); - TInfoCPU = record{@tuple} - name: string; - intSize: int; - endian: TEndian; - floatSize: int; - bit: int; - end; -const - EndianToStr: array [TEndian] of string = ('littleEndian', 'bigEndian'); - CPU: array [succ(low(TSystemCPU))..high(TSystemCPU)] of TInfoCPU = ( - ( - name: 'i386'; - intSize: 32; - endian: littleEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'm68k'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'alpha'; - intSize: 64; - endian: littleEndian; - floatSize: 64; - bit: 64; - ), - ( - name: 'powerpc'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'sparc'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'vm'; - intSize: 32; - endian: littleEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'ia64'; - intSize: 64; - endian: littleEndian; - floatSize: 64; - bit: 64; - ), - ( - name: 'amd64'; - intSize: 64; - endian: littleEndian; - floatSize: 64; - bit: 64; - ), - ( - name: 'mips'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'arm'; - intSize: 32; - endian: littleEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'ecmascript'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ), - ( - name: 'nimrodvm'; - intSize: 32; - endian: bigEndian; - floatSize: 64; - bit: 32; - ) -); - -var - targetCPU, hostCPU: TSystemCPU; - targetOS, hostOS: TSystemOS; - -function NameToOS(const name: string): TSystemOS; -function NameToCPU(const name: string): TSystemCPU; - -var - IntSize: int; - floatSize: int; - PtrSize: int; - tnl: string; // target newline - -procedure setTarget(o: TSystemOS; c: TSystemCPU); - -implementation - -procedure setTarget(o: TSystemOS; c: TSystemCPU); -begin - assert(c <> cpuNone); - assert(o <> osNone); - targetCPU := c; - targetOS := o; - intSize := cpu[c].intSize div 8; - floatSize := cpu[c].floatSize div 8; - ptrSize := cpu[c].bit div 8; - tnl := os[o].newLine; -end; - -function NameToOS(const name: string): TSystemOS; -var - i: TSystemOS; -begin - for i := succ(osNone) to high(TSystemOS) do - if cmpIgnoreStyle(name, OS[i].name) = 0 then begin - result := i; exit - end; - result := osNone -end; - -function NameToCPU(const name: string): TSystemCPU; -var - i: TSystemCPU; -begin - for i := succ(cpuNone) to high(TSystemCPU) do - if cmpIgnoreStyle(name, CPU[i].name) = 0 then begin - result := i; exit - end; - result := cpuNone -end; - -// this is Ok for the Pascal version, but the Nimrod version needs a different -// mechanism -{@emit -procedure nimCPU(): cstring; importc; noconv;} -{@emit -procedure nimOS(): cstring; importc; noconv;} - -{@ignore} -initialization -{$ifdef i386} - hostCPU := cpuI386; -{$endif} -{$ifdef m68k} - hostCPU := cpuM68k; -{$endif} -{$ifdef alpha} - hostCPU := cpuAlpha; -{$endif} -{$ifdef powerpc} - hostCPU := cpuPowerpc; -{$endif} -{$ifdef sparc} - hostCPU := cpuSparc; -{$endif} -{$ifdef vm} - hostCPU := cpuVm; -{$endif} -{$ifdef ia64} - hostCPU := cpuIa64; -{$endif} -{$ifdef amd64} - hostCPU := cpuAmd64; -{$endif} -{$ifdef mips} - hostCPU := cpuMips; -{$endif} -{$ifdef arm} - hostCPU := cpuArm; -{$endif} -{$ifdef DOS} - hostOS := osDOS; -{$endif} -{$ifdef Windows} - hostOS := osWindows; -{$endif} -{$ifdef OS2} - hostOS := osOS2; -{$endif} -{$ifdef Linux} - hostOS := osLinux; -{$endif} -{$ifdef MorphOS} - hostOS := osMorphOS; -{$endif} -{$ifdef SkyOS} - hostOS := osSkyOS; -{$endif} -{$ifdef Solaris} - hostOS := osSolaris; -{$endif} -{$ifdef Irix} - hostOS := osIrix; -{$endif} -{$ifdef NetBSD} - hostOS := osNetBSD; -{$endif} -{$ifdef FreeBSD} - hostOS := osFreeBSD; -{$endif} -{$ifdef OpenBSD} - hostOS := osOpenBSD; -{$endif} -{$ifdef PalmOS} - hostOS := osPalmOS; -{$endif} -{$ifdef QNX} - hostOS := osQNX; -{$endif} -{$ifdef Amiga} - hostOS := osAmiga; -{$endif} -{$ifdef Atari} - hostOS := osAtari; -{$endif} -{$ifdef Netware} - hostOS := osNetware; -{$endif} -{$ifdef MacOS} - hostOS := osMacOS; -{$endif} -{$ifdef MacOSX} - hostOS := osMacOSX; -{$endif} -{$ifdef darwin} // BUGFIX - hostOS := osMacOSX; -{$endif} -{@emit - hostCPU := nameToCPU(toString(nimCPU())); -} -{@emit - hostOS := nameToOS(toString(nimOS())); -} - setTarget(hostOS, hostCPU); // assume no cross-compiling -end. diff --git a/nim/pnimsyn.pas b/nim/pnimsyn.pas deleted file mode 100755 index 260d1e5a5d..0000000000 --- a/nim/pnimsyn.pas +++ /dev/null @@ -1,1802 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit pnimsyn; - -// This module implements the parser of the standard Nimrod representation. -// The parser strictly reflects the grammar ("doc/grammar.txt"); however -// it uses several helper routines to keep the parser small. A special -// efficient algorithm is used for the precedence levels. The parser here can -// be seen as a refinement of the grammar, as it specifies how the AST is build -// from the grammar and how comments belong to the AST. - -{$include config.inc} - -interface - -uses - nsystem, llstream, scanner, idents, strutils, ast, msgs; - -// function ParseFile(const filename: string): PNode; - -type - TParser = record // a TParser object represents a module that - // is being parsed - lex: PLexer; // the lexer that is used for parsing - tok: PToken; // the current token - end; - -function ParseAll(var p: TParser): PNode; - -procedure openParser(var p: TParser; const filename: string; - inputstream: PLLStream); -procedure closeParser(var p: TParser); - -function parseTopLevelStmt(var p: TParser): PNode; -// implements an iterator. Returns the next top-level statement or nil if end -// of stream. - - -// helpers for the other parsers -function getPrecedence(tok: PToken): int; -function isOperator(tok: PToken): bool; - -procedure getTok(var p: TParser); - -procedure parMessage(const p: TParser; const msg: TMsgKind; - const arg: string = ''); -procedure skipComment(var p: TParser; node: PNode); - -function newNodeP(kind: TNodeKind; const p: TParser): PNode; -function newIntNodeP(kind: TNodeKind; const intVal: BiggestInt; - const p: TParser): PNode; -function newFloatNodeP(kind: TNodeKind; const floatVal: BiggestFloat; - const p: TParser): PNode; -function newStrNodeP(kind: TNodeKind; const strVal: string; - const p: TParser): PNode; -function newIdentNodeP(ident: PIdent; const p: TParser): PNode; - -procedure expectIdentOrKeyw(const p: TParser); -procedure ExpectIdent(const p: TParser); -procedure expectIdentOrOpr(const p: TParser); -function parLineInfo(const p: TParser): TLineInfo; -procedure Eat(var p: TParser; TokType: TTokType); - -procedure skipInd(var p: TParser); -procedure optSad(var p: TParser); -procedure optInd(var p: TParser; n: PNode); -procedure indAndComment(var p: TParser; n: PNode); - -procedure setBaseFlags(n: PNode; base: TNumericalBase); - -function parseSymbol(var p: TParser): PNode; -function accExpr(var p: TParser): PNode; - - -implementation - -procedure initParser(var p: TParser); -begin -{@ignore} - FillChar(p, sizeof(p), 0); -{@emit} - new(p.lex); -{@ignore} - fillChar(p.lex^, sizeof(p.lex^), 0); -{@emit} - new(p.tok); -{@ignore} - fillChar(p.tok^, sizeof(p.tok^), 0); -{@emit} -end; - -procedure getTok(var p: TParser); -begin - rawGetTok(p.lex^, p.tok^); -end; - -procedure OpenParser(var p: TParser; const filename: string; - inputStream: PLLStream); -begin - initParser(p); - OpenLexer(p.lex^, filename, inputstream); - getTok(p); // read the first token -end; - -procedure CloseParser(var p: TParser); -begin - CloseLexer(p.lex^); -{@ignore} - dispose(p.lex); -{@emit} -end; - -// ---------------- parser helpers -------------------------------------------- - -procedure parMessage(const p: TParser; const msg: TMsgKind; - const arg: string = ''); -begin - lexMessage(p.lex^, msg, arg); -end; - -procedure skipComment(var p: TParser; node: PNode); -begin - if p.tok.tokType = tkComment then begin - if node <> nil then begin - if node.comment = snil then node.comment := ''; - add(node.comment, p.tok.literal); - end - else - parMessage(p, errInternal, 'skipComment'); - getTok(p); - end -end; - -procedure skipInd(var p: TParser); -begin - if p.tok.tokType = tkInd then getTok(p) -end; - -procedure optSad(var p: TParser); -begin - if p.tok.tokType = tkSad then getTok(p) -end; - -procedure optInd(var p: TParser; n: PNode); -begin - skipComment(p, n); - skipInd(p); -end; - -procedure expectIdentOrKeyw(const p: TParser); -begin - if (p.tok.tokType <> tkSymbol) and not isKeyword(p.tok.tokType) then - lexMessage(p.lex^, errIdentifierExpected, tokToStr(p.tok)); -end; - -procedure ExpectIdent(const p: TParser); -begin - if p.tok.tokType <> tkSymbol then - lexMessage(p.lex^, errIdentifierExpected, tokToStr(p.tok)); -end; - -procedure expectIdentOrOpr(const p: TParser); -begin - if not (p.tok.tokType in tokOperators) then - lexMessage(p.lex^, errOperatorExpected, tokToStr(p.tok)); -end; - -procedure Eat(var p: TParser; TokType: TTokType); -begin - if p.tok.TokType = TokType then getTok(p) - else lexMessage(p.lex^, errTokenExpected, TokTypeToStr[tokType]) -end; - -function parLineInfo(const p: TParser): TLineInfo; -begin - result := getLineInfo(p.lex^) -end; - -procedure indAndComment(var p: TParser; n: PNode); -var - info: TLineInfo; -begin - if p.tok.tokType = tkInd then begin - info := parLineInfo(p); - getTok(p); - if p.tok.tokType = tkComment then skipComment(p, n) - else liMessage(info, errInvalidIndentation); - end - else skipComment(p, n); -end; - -// ---------------------------------------------------------------------------- - -function newNodeP(kind: TNodeKind; const p: TParser): PNode; -begin - result := newNodeI(kind, getLineInfo(p.lex^)); -end; - -function newIntNodeP(kind: TNodeKind; const intVal: BiggestInt; - const p: TParser): PNode; -begin - result := newNodeP(kind, p); - result.intVal := intVal; -end; - -function newFloatNodeP(kind: TNodeKind; const floatVal: BiggestFloat; - const p: TParser): PNode; -begin - result := newNodeP(kind, p); - result.floatVal := floatVal; -end; - -function newStrNodeP(kind: TNodeKind; const strVal: string; - const p: TParser): PNode; -begin - result := newNodeP(kind, p); - result.strVal := strVal; -end; - -function newIdentNodeP(ident: PIdent; const p: TParser): PNode; -begin - result := newNodeP(nkIdent, p); - result.ident := ident; -end; - -// ------------------- Expression parsing ------------------------------------ - -function parseExpr(var p: TParser): PNode; forward; -function parseStmt(var p: TParser): PNode; forward; - -function parseTypeDesc(var p: TParser): PNode; forward; -function parseParamList(var p: TParser): PNode; forward; - -function getPrecedence(tok: PToken): int; -begin - case tok.tokType of - tkOpr: begin - case tok.ident.s[strStart] of - '$': result := 7; - '*', '%', '/', '\': result := 6; - '+', '-', '~', '|': result := 5; - '&': result := 4; - '=', '<', '>', '!': result := 3; - else result := 0 - end - end; - tkDiv, tkMod, tkShl, tkShr: result := 6; - tkIn, tkNotIn, tkIs, tkIsNot: result := 3; - tkAnd: result := 2; - tkOr, tkXor: result := 1; - else result := -1; - end; -end; - -function isOperator(tok: PToken): bool; -begin - result := getPrecedence(tok) >= 0 -end; - -function parseSymbol(var p: TParser): PNode; -var - s: string; - id: PIdent; -begin - case p.tok.tokType of - tkSymbol: begin - result := newIdentNodeP(p.tok.ident, p); - getTok(p); - end; - tkAccent: begin - result := newNodeP(nkAccQuoted, p); - getTok(p); - case p.tok.tokType of - tkBracketLe: begin - s := '['+''; - getTok(p); - if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin - s := s + '$..'; - getTok(p); - eat(p, tkDotDot); - if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin - addChar(s, '$'); - getTok(p); - end; - end - else if p.tok.tokType = tkDotDot then begin - s := s + '..'; - getTok(p); - if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin - addChar(s, '$'); - getTok(p); - end; - end; - eat(p, tkBracketRi); - addChar(s, ']'); - if p.tok.tokType = tkEquals then begin - addChar(s, '='); getTok(p); - end; - addSon(result, newIdentNodeP(getIdent(s), p)); - end; - tkParLe: begin - addSon(result, newIdentNodeP(getIdent('()'), p)); - getTok(p); - eat(p, tkParRi); - end; - tokKeywordLow..tokKeywordHigh, tkSymbol, tkOpr: begin - id := p.tok.ident; - getTok(p); - if p.tok.tokType = tkEquals then begin - addSon(result, newIdentNodeP(getIdent(id.s + '='), p)); - getTok(p); - end - else - addSon(result, newIdentNodeP(id, p)); - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - result := nil - end - end; - eat(p, tkAccent); - end - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - result := nil - end - end -end; - -function accExpr(var p: TParser): PNode; -var - x, y: PNode; -begin - result := newNodeP(nkAccQuoted, p); - getTok(p); // skip ` - x := nil; - y := nil; - case p.tok.tokType of - tkSymbol, tkOpr, tokKeywordLow..tokKeywordHigh: begin - x := newIdentNodeP(p.tok.ident, p); - getTok(p); - end - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - end - end; - if p.tok.tokType = tkDot then begin - getTok(p); - case p.tok.tokType of - tkSymbol, tkOpr, tokKeywordLow..tokKeywordHigh: begin - y := newNodeP(nkDotExpr, p); - addSon(y, x); - addSon(y, newIdentNodeP(p.tok.ident, p)); - getTok(p); - x := y; - end - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - end - end; - end; - addSon(result, x); - eat(p, tkAccent); -end; - -function optExpr(var p: TParser): PNode; // [expr] -begin - if (p.tok.tokType <> tkComma) and (p.tok.tokType <> tkBracketRi) - and (p.tok.tokType <> tkDotDot) then - result := parseExpr(p) - else - result := nil; -end; - -function dotdotExpr(var p: TParser; first: PNode = nil): PNode; -begin - result := newNodeP(nkRange, p); - addSon(result, first); - getTok(p); - optInd(p, result); - addSon(result, optExpr(p)); -end; - -function indexExpr(var p: TParser): PNode; -// indexExpr ::= '..' [expr] | expr ['=' expr | '..' expr] -var - a, b: PNode; -begin - if p.tok.tokType = tkDotDot then - result := dotdotExpr(p) - else begin - a := parseExpr(p); - case p.tok.tokType of - tkEquals: begin - result := newNodeP(nkExprEqExpr, p); - addSon(result, a); - getTok(p); - if p.tok.tokType = tkDotDot then - addSon(result, dotdotExpr(p)) - else begin - b := parseExpr(p); - if p.tok.tokType = tkDotDot then b := dotdotExpr(p, b); - addSon(result, b); - end - end; - tkDotDot: result := dotdotExpr(p, a); - else result := a - end - end -end; - -function indexExprList(var p: TParser; first: PNode): PNode; -var - a: PNode; -begin - result := newNodeP(nkBracketExpr, p); - addSon(result, first); - getTok(p); - optInd(p, result); - while (p.tok.tokType <> tkBracketRi) and (p.tok.tokType <> tkEof) - and (p.tok.tokType <> tkSad) do begin - a := indexExpr(p); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function exprColonEqExpr(var p: TParser; kind: TNodeKind; - tok: TTokType): PNode; -var - a: PNode; -begin - a := parseExpr(p); - if p.tok.tokType = tok then begin - result := newNodeP(kind, p); - getTok(p); - //optInd(p, result); - addSon(result, a); - addSon(result, parseExpr(p)); - end - else - result := a -end; - -procedure exprListAux(var p: TParser; elemKind: TNodeKind; - endTok, sepTok: TTokType; result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin - a := exprColonEqExpr(p, elemKind, sepTok); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - eat(p, endTok); -end; - -function qualifiedIdent(var p: TParser): PNode; -var - a: PNode; -begin - result := parseSymbol(p); - //optInd(p, result); - if p.tok.tokType = tkDot then begin - getTok(p); - optInd(p, result); - a := result; - result := newNodeI(nkDotExpr, a.info); - addSon(result, a); - addSon(result, parseSymbol(p)); - end; -end; - -procedure qualifiedIdentListAux(var p: TParser; endTok: TTokType; - result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin - a := qualifiedIdent(p); - addSon(result, a); - //optInd(p, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - eat(p, endTok); -end; - -procedure exprColonEqExprListAux(var p: TParser; elemKind: TNodeKind; - endTok, sepTok: TTokType; result: PNode); -var - a: PNode; -begin - getTok(p); - optInd(p, result); - while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) - and (p.tok.tokType <> tkSad) do begin - a := exprColonEqExpr(p, elemKind, sepTok); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, endTok); -end; - -function exprColonEqExprList(var p: TParser; kind, elemKind: TNodeKind; - endTok, sepTok: TTokType): PNode; -begin - result := newNodeP(kind, p); - exprColonEqExprListAux(p, elemKind, endTok, sepTok, result); -end; - -function parseCast(var p: TParser): PNode; -begin - result := newNodeP(nkCast, p); - getTok(p); - eat(p, tkBracketLe); - optInd(p, result); - addSon(result, parseTypeDesc(p)); - optSad(p); - eat(p, tkBracketRi); - eat(p, tkParLe); - optInd(p, result); - addSon(result, parseExpr(p)); - optSad(p); - eat(p, tkParRi); -end; - -function parseAddr(var p: TParser): PNode; -begin - result := newNodeP(nkAddr, p); - getTok(p); - eat(p, tkParLe); - optInd(p, result); - addSon(result, parseExpr(p)); - optSad(p); - eat(p, tkParRi); -end; - -procedure setBaseFlags(n: PNode; base: TNumericalBase); -begin - case base of - base10: begin end; - base2: include(n.flags, nfBase2); - base8: include(n.flags, nfBase8); - base16: include(n.flags, nfBase16); - end -end; - -function identOrLiteral(var p: TParser): PNode; -begin - case p.tok.tokType of - tkSymbol: begin - result := newIdentNodeP(p.tok.ident, p); - getTok(p) - end; - tkAccent: result := accExpr(p); - // literals - tkIntLit: begin - result := newIntNodeP(nkIntLit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt8Lit: begin - result := newIntNodeP(nkInt8Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt16Lit: begin - result := newIntNodeP(nkInt16Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt32Lit: begin - result := newIntNodeP(nkInt32Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkInt64Lit: begin - result := newIntNodeP(nkInt64Lit, p.tok.iNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloatLit: begin - result := newFloatNodeP(nkFloatLit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloat32Lit: begin - result := newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkFloat64Lit: begin - result := newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p); - setBaseFlags(result, p.tok.base); - getTok(p); - end; - tkStrLit: begin - result := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkRStrLit: begin - result := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - result := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p); - end; - tkCallRStrLit: begin - result := newNodeP(nkCallStrLit, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)); - getTok(p); - end; - tkCallTripleStrLit: begin - result := newNodeP(nkCallStrLit, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)); - getTok(p); - end; - tkCharLit: begin - result := newIntNodeP(nkCharLit, ord(p.tok.literal[strStart]), p); - getTok(p); - end; - tkNil: begin - result := newNodeP(nkNilLit, p); - getTok(p); - end; - tkParLe: begin // () constructor - result := exprColonEqExprList(p, nkPar, nkExprColonExpr, tkParRi, - tkColon); - end; - tkCurlyLe: begin // {} constructor - result := exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, tkDotDot); - end; - tkBracketLe: begin // [] constructor - result := exprColonEqExprList(p, nkBracket, nkExprColonExpr, tkBracketRi, - tkColon); - end; - tkCast: result := parseCast(p); - tkAddr: result := parseAddr(p); - else begin - parMessage(p, errExprExpected, tokToStr(p.tok)); - getTok(p); // we must consume a token here to prevend endless loops! - result := nil - end - end -end; - -function primary(var p: TParser): PNode; -var - a: PNode; -begin - // prefix operator? - if (p.tok.tokType = tkNot) or (p.tok.tokType = tkOpr) then begin - result := newNodeP(nkPrefix, p); - a := newIdentNodeP(p.tok.ident, p); - addSon(result, a); - getTok(p); - optInd(p, a); - addSon(result, primary(p)); - exit - end - else if p.tok.tokType = tkBind then begin - result := newNodeP(nkBind, p); - getTok(p); - optInd(p, result); - addSon(result, primary(p)); - exit - end; - result := identOrLiteral(p); - while true do begin - case p.tok.tokType of - tkParLe: begin - a := result; - result := newNodeP(nkCall, p); - addSon(result, a); - exprColonEqExprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result); - end; - tkDot: begin - a := result; - result := newNodeP(nkDotExpr, p); - addSon(result, a); - getTok(p); // skip '.' - optInd(p, result); - addSon(result, parseSymbol(p)); - end; - tkHat: begin - a := result; - result := newNodeP(nkDerefExpr, p); - addSon(result, a); - getTok(p); - end; - tkBracketLe: result := indexExprList(p, result); - else break - end - end -end; - -function lowestExprAux(var p: TParser; out v: PNode; limit: int): PToken; -var - op, nextop: PToken; - opPred: int; - v2, node, opNode: PNode; -begin - v := primary(p); - // expand while operators have priorities higher than 'limit' - op := p.tok; - opPred := getPrecedence(p.tok); - while (opPred > limit) do begin - node := newNodeP(nkInfix, p); - opNode := newIdentNodeP(op.ident, p); - // skip operator: - getTok(p); - optInd(p, opNode); - - // read sub-expression with higher priority - nextop := lowestExprAux(p, v2, opPred); - addSon(node, opNode); - addSon(node, v); - addSon(node, v2); - v := node; - op := nextop; - opPred := getPrecedence(nextop); - end; - result := op; // return first untreated operator -end; - -function lowestExpr(var p: TParser): PNode; -begin -{@discard} lowestExprAux(p, result, -1); -end; - -function parseIfExpr(var p: TParser): PNode; -var - branch: PNode; -begin - result := newNodeP(nkIfExpr, p); - while true do begin - getTok(p); // skip `if`, `elif` - branch := newNodeP(nkElifExpr, p); - addSon(branch, parseExpr(p)); - eat(p, tkColon); - addSon(branch, parseExpr(p)); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - branch := newNodeP(nkElseExpr, p); - eat(p, tkElse); eat(p, tkColon); - addSon(branch, parseExpr(p)); - addSon(result, branch); -end; - -function parsePragma(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkPragma, p); - getTok(p); - optInd(p, result); - while (p.tok.tokType <> tkCurlyDotRi) and (p.tok.tokType <> tkCurlyRi) - and (p.tok.tokType <> tkEof) and (p.tok.tokType <> tkSad) do begin - a := exprColonEqExpr(p, nkExprColonExpr, tkColon); - addSon(result, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end - end; - optSad(p); - if (p.tok.tokType = tkCurlyDotRi) or (p.tok.tokType = tkCurlyRi) then - getTok(p) - else - parMessage(p, errTokenExpected, '.}'); -end; - -function identVis(var p: TParser): PNode; // identifier with visability -var - a: PNode; -begin - a := parseSymbol(p); - if p.tok.tokType = tkOpr then begin - result := newNodeP(nkPostfix, p); - addSon(result, newIdentNodeP(p.tok.ident, p)); - addSon(result, a); - getTok(p); - end - else - result := a; -end; - -function identWithPragma(var p: TParser): PNode; -var - a: PNode; -begin - a := identVis(p); - if p.tok.tokType = tkCurlyDotLe then begin - result := newNodeP(nkPragmaExpr, p); - addSon(result, a); - addSon(result, parsePragma(p)); - end - else - result := a -end; - -type - TDeclaredIdentFlag = ( - withPragma, // identifier may have pragma - withBothOptional // both ':' and '=' parts are optional - ); - TDeclaredIdentFlags = set of TDeclaredIdentFlag; - -function parseIdentColonEquals(var p: TParser; - flags: TDeclaredIdentFlags): PNode; -var - a: PNode; -begin - result := newNodeP(nkIdentDefs, p); - while true do begin - case p.tok.tokType of - tkSymbol, tkAccent: begin - if withPragma in flags then - a := identWithPragma(p) - else - a := parseSymbol(p); - if a = nil then exit; - end; - else break; - end; - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - if p.tok.tokType = tkColon then begin - getTok(p); optInd(p, result); - addSon(result, parseTypeDesc(p)); - end - else begin - addSon(result, nil); - if (p.tok.tokType <> tkEquals) and not (withBothOptional in flags) then - parMessage(p, errColonOrEqualsExpected, tokToStr(p.tok)) - end; - if p.tok.tokType = tkEquals then begin - getTok(p); optInd(p, result); - addSon(result, parseExpr(p)); - end - else - addSon(result, nil); -end; - -function parseTuple(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkTupleTy, p); - getTok(p); - eat(p, tkBracketLe); - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := parseIdentColonEquals(p, {@set}[]); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function parseParamList(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkFormalParams, p); - addSon(result, nil); // return type - if p.tok.tokType = tkParLe then begin - getTok(p); - optInd(p, result); - while true do begin - case p.tok.tokType of - tkSymbol, tkAccent: a := parseIdentColonEquals(p, {@set}[]); - tkParRi: break; - else begin parMessage(p, errTokenExpected, ')'+''); break; end; - end; - //optInd(p, a); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkParRi); - end; - if p.tok.tokType = tkColon then begin - getTok(p); - optInd(p, result); - result.sons[0] := parseTypeDesc(p) - end -end; - -function parseProcExpr(var p: TParser; isExpr: bool): PNode; -// either a proc type or a anonymous proc -var - pragmas, params: PNode; - info: TLineInfo; -begin - info := parLineInfo(p); - getTok(p); - params := parseParamList(p); - if p.tok.tokType = tkCurlyDotLe then pragmas := parsePragma(p) - else pragmas := nil; - if (p.tok.tokType = tkEquals) and isExpr then begin - result := newNodeI(nkLambda, info); - addSon(result, nil); // no name part - addSon(result, nil); // no generic parameters - addSon(result, params); - addSon(result, pragmas); - getTok(p); skipComment(p, result); - addSon(result, parseStmt(p)); - end - else begin - result := newNodeI(nkProcTy, info); - addSon(result, params); - addSon(result, pragmas); - end -end; - -function parseTypeDescKAux(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, parseTypeDesc(p)); -end; - -function parseExpr(var p: TParser): PNode; -(* -expr ::= lowestExpr - | 'if' expr ':' expr ('elif' expr ':' expr)* 'else' ':' expr - | 'var' expr - | 'ref' expr - | 'ptr' expr - | 'type' expr - | 'tuple' tupleDesc - | 'proc' paramList [pragma] ['=' stmt] -*) -begin - case p.tok.toktype of - tkVar: result := parseTypeDescKAux(p, nkVarTy); - tkRef: result := parseTypeDescKAux(p, nkRefTy); - tkPtr: result := parseTypeDescKAux(p, nkPtrTy); - tkType: result := parseTypeDescKAux(p, nkTypeOfExpr); - tkTuple: result := parseTuple(p); - tkProc: result := parseProcExpr(p, true); - tkIf: result := parseIfExpr(p); - else result := lowestExpr(p); - end -end; - -function parseTypeDesc(var p: TParser): PNode; -begin - if p.tok.toktype = tkProc then result := parseProcExpr(p, false) - else result := parseExpr(p); -end; - -// ---------------------- statement parser ------------------------------------ -function isExprStart(const p: TParser): bool; -begin - case p.tok.tokType of - tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkBind, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, - tkVar, tkRef, tkPtr, tkTuple, tkType: result := true; - else result := false; - end; -end; - -function parseExprStmt(var p: TParser): PNode; -var - a, b, e: PNode; -begin - a := lowestExpr(p); - if p.tok.tokType = tkEquals then begin - getTok(p); - optInd(p, result); - b := parseExpr(p); - result := newNodeI(nkAsgn, a.info); - addSon(result, a); - addSon(result, b); - end - else begin - result := newNodeP(nkCommand, p); - result.info := a.info; - addSon(result, a); - while true do begin - (*case p.tok.tokType of - tkColon, tkInd, tkSad, tkDed, tkEof, tkComment: break; - else begin end - end;*) - if not isExprStart(p) then break; - e := parseExpr(p); - addSon(result, e); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a); - end; - if sonsLen(result) <= 1 then result := a - else a := result; - if p.tok.tokType = tkColon then begin // macro statement - result := newNodeP(nkMacroStmt, p); - result.info := a.info; - addSon(result, a); - getTok(p); - skipComment(p, result); - if (p.tok.tokType = tkInd) - or not (p.tok.TokType in [tkOf, tkElif, tkElse, tkExcept]) then - addSon(result, parseStmt(p)); - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkColon, tkDotDot, b); - end; - tkElif: begin - b := newNodeP(nkElifBranch, p); - getTok(p); - optInd(p, b); - addSon(b, parseExpr(p)); - eat(p, tkColon); - end; - tkExcept: begin - b := newNodeP(nkExceptBranch, p); - qualifiedIdentListAux(p, tkColon, b); - skipComment(p, b); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkElse then break; - end - end - end -end; - -function parseImportOrIncludeStmt(var p: TParser; kind: TNodeKind): PNode; -var - a: PNode; -begin - result := newNodeP(kind, p); - getTok(p); // skip `import` or `include` - optInd(p, result); - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - tkSymbol, tkAccent: a := parseSymbol(p); - tkRStrLit: begin - a := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p) - end; - tkStrLit: begin - a := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - a := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p) - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end; - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; -end; - -function parseFromStmt(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkFromStmt, p); - getTok(p); // skip `from` - optInd(p, result); - case p.tok.tokType of - tkSymbol, tkAccent: a := parseSymbol(p); - tkRStrLit: begin - a := newStrNodeP(nkRStrLit, p.tok.literal, p); - getTok(p) - end; - tkStrLit: begin - a := newStrNodeP(nkStrLit, p.tok.literal, p); - getTok(p); - end; - tkTripleStrLit: begin - a := newStrNodeP(nkTripleStrLit, p.tok.literal, p); - getTok(p) - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); exit - end - end; - addSon(result, a); - //optInd(p, a); - eat(p, tkImport); - optInd(p, result); - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - tkSymbol, tkAccent: a := parseSymbol(p); - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end; - end; - //optInd(p, a); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; -end; - -function parseReturnOrRaise(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed: addSon(result, nil); - else addSon(result, parseExpr(p)); - end; -end; - -function parseYieldOrDiscard(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, parseExpr(p)); -end; - -function parseBreakOrContinue(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed: addSon(result, nil); - else addSon(result, parseSymbol(p)); - end; -end; - -function parseIfOrWhen(var p: TParser; kind: TNodeKind): PNode; -var - branch: PNode; -begin - result := newNodeP(kind, p); - while true do begin - getTok(p); // skip `if`, `when`, `elif` - branch := newNodeP(nkElifBranch, p); - optInd(p, branch); - addSon(branch, parseExpr(p)); - eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseStmt(p)); - skipComment(p, branch); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - if p.tok.tokType = tkElse then begin - branch := newNodeP(nkElse, p); - eat(p, tkElse); eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseStmt(p)); - addSon(result, branch); - end -end; - -function parseWhile(var p: TParser): PNode; -begin - result := newNodeP(nkWhileStmt, p); - getTok(p); - optInd(p, result); - addSon(result, parseExpr(p)); - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)); -end; - -function parseCase(var p: TParser): PNode; -var - b: PNode; - inElif: bool; -begin - result := newNodeP(nkCaseStmt, p); - getTok(p); - addSon(result, parseExpr(p)); - if p.tok.tokType = tkColon then getTok(p); - skipComment(p, result); - inElif := false; - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - if inElif then break; - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkColon, tkDotDot, b); - end; - tkElif: begin - inElif := true; - b := newNodeP(nkElifBranch, p); - getTok(p); - optInd(p, b); - addSon(b, parseExpr(p)); - eat(p, tkColon); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkElse then break; - end -end; - -function parseTry(var p: TParser): PNode; -var - b: PNode; -begin - result := newNodeP(nkTryStmt, p); - getTok(p); - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)); - b := nil; - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkExcept: begin - b := newNodeP(nkExceptBranch, p); - qualifiedIdentListAux(p, tkColon, b); - end; - tkFinally: begin - b := newNodeP(nkFinally, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseStmt(p)); - addSon(result, b); - if b.kind = nkFinally then break; - end; - if b = nil then parMessage(p, errTokenExpected, 'except'); -end; - -function parseFor(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkForStmt, p); - getTok(p); - optInd(p, result); - a := parseSymbol(p); - addSon(result, a); - while p.tok.tokType = tkComma do begin - getTok(p); - optInd(p, a); - a := parseSymbol(p); - addSon(result, a); - end; - eat(p, tkIn); - addSon(result, exprColonEqExpr(p, nkRange, tkDotDot)); - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)) -end; - -function parseBlock(var p: TParser): PNode; -begin - result := newNodeP(nkBlockStmt, p); - getTok(p); - optInd(p, result); - case p.tok.tokType of - tkEof, tkSad, tkDed, tkColon: addSon(result, nil); - else addSon(result, parseSymbol(p)); - end; - eat(p, tkColon); - skipComment(p, result); - addSon(result, parseStmt(p)); -end; - -function parseAsm(var p: TParser): PNode; -begin - result := newNodeP(nkAsmStmt, p); - getTok(p); - optInd(p, result); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - case p.tok.tokType of - tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)); - tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)); - tkTripleStrLit: - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)); - else begin - parMessage(p, errStringLiteralExpected); - addSon(result, nil); exit - end; - end; - getTok(p); -end; - -function parseGenericParamList(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkGenericParams, p); - getTok(p); - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := parseIdentColonEquals(p, {@set}[withBothOptional]); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - optSad(p); - eat(p, tkBracketRi); -end; - -function parseRoutine(var p: TParser; kind: TNodeKind): PNode; -begin - result := newNodeP(kind, p); - getTok(p); - optInd(p, result); - addSon(result, identVis(p)); - if p.tok.tokType = tkBracketLe then addSon(result, parseGenericParamList(p)) - else addSon(result, nil); - addSon(result, parseParamList(p)); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - if p.tok.tokType = tkEquals then begin - getTok(p); skipComment(p, result); - addSon(result, parseStmt(p)); - end - else - addSon(result, nil); - indAndComment(p, result); // XXX: document this in the grammar! -end; - -function newCommentStmt(var p: TParser): PNode; -begin - result := newNodeP(nkCommentStmt, p); - result.info.line := result.info.line - int16(1); -end; - -type - TDefParser = function (var p: TParser): PNode; - -function parseSection(var p: TParser; kind: TNodeKind; - defparser: TDefParser): PNode; -var - a: PNode; -begin - result := newNodeP(kind, p); - getTok(p); - skipComment(p, result); - case p.tok.tokType of - tkInd: begin - pushInd(p.lex^, p.tok.indent); - getTok(p); skipComment(p, result); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkSymbol, tkAccent: begin - a := defparser(p); - skipComment(p, a); - addSon(result, a); - end; - tkDed: begin getTok(p); break end; - tkEof: break; // BUGFIX - tkComment: begin - a := newCommentStmt(p); - skipComment(p, a); - addSon(result, a); - end; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end - end; - popInd(p.lex^); - end; - tkSymbol, tkAccent, tkParLe: begin - // tkParLe is allowed for ``var (x, y) = ...`` tuple parsing - addSon(result, defparser(p)); - end - else parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - end -end; - -function parseConstant(var p: TParser): PNode; -begin - result := newNodeP(nkConstDef, p); - addSon(result, identWithPragma(p)); - if p.tok.tokType = tkColon then begin - getTok(p); optInd(p, result); - addSon(result, parseTypeDesc(p)); - end - else - addSon(result, nil); - eat(p, tkEquals); - optInd(p, result); - addSon(result, parseExpr(p)); - indAndComment(p, result); // XXX: special extension! -end; - -function parseEnum(var p: TParser): PNode; -var - a, b: PNode; -begin - result := newNodeP(nkEnumTy, p); - a := nil; - getTok(p); - if p.tok.tokType = tkOf then begin - a := newNodeP(nkOfInherit, p); - getTok(p); optInd(p, a); - addSon(a, parseTypeDesc(p)); - addSon(result, a) - end - else addSon(result, nil); - optInd(p, result); - - while true do begin - case p.tok.tokType of - tkEof, tkSad, tkDed: break; - else a := parseSymbol(p); - end; - optInd(p, a); - if p.tok.tokType = tkEquals then begin - getTok(p); - optInd(p, a); - b := a; - a := newNodeP(nkEnumFieldDef, p); - addSon(a, b); - addSon(a, parseExpr(p)); - skipComment(p, a); - end; - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; - addSon(result, a); - end -end; - -function parseObjectPart(var p: TParser): PNode; forward; - -function parseObjectWhen(var p: TParser): PNode; -var - branch: PNode; -begin - result := newNodeP(nkRecWhen, p); - while true do begin - getTok(p); // skip `when`, `elif` - branch := newNodeP(nkElifBranch, p); - optInd(p, branch); - addSon(branch, parseExpr(p)); - eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseObjectPart(p)); - skipComment(p, branch); - addSon(result, branch); - if p.tok.tokType <> tkElif then break - end; - if p.tok.tokType = tkElse then begin - branch := newNodeP(nkElse, p); - eat(p, tkElse); eat(p, tkColon); - skipComment(p, branch); - addSon(branch, parseObjectPart(p)); - addSon(result, branch); - end -end; - -function parseObjectCase(var p: TParser): PNode; -var - a, b: PNode; -begin - result := newNodeP(nkRecCase, p); - getTok(p); - a := newNodeP(nkIdentDefs, p); - addSon(a, identWithPragma(p)); - eat(p, tkColon); - addSon(a, parseTypeDesc(p)); - addSon(a, nil); - addSon(result, a); - skipComment(p, result); - while true do begin - if p.tok.tokType = tkSad then getTok(p); - case p.tok.tokType of - tkOf: begin - b := newNodeP(nkOfBranch, p); - exprListAux(p, nkRange, tkColon, tkDotDot, b); - end; - tkElse: begin - b := newNodeP(nkElse, p); - getTok(p); - eat(p, tkColon); - end; - else break; - end; - skipComment(p, b); - addSon(b, parseObjectPart(p)); - addSon(result, b); - if b.kind = nkElse then break; - end -end; - -function parseObjectPart(var p: TParser): PNode; -begin - case p.tok.tokType of - tkInd: begin - result := newNodeP(nkRecList, p); - pushInd(p.lex^, p.tok.indent); - getTok(p); skipComment(p, result); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkCase, tkWhen, tkSymbol, tkAccent, tkNil: begin - addSon(result, parseObjectPart(p)); - end; - tkDed: begin getTok(p); break end; - tkEof: break; - else begin - parMessage(p, errIdentifierExpected, tokToStr(p.tok)); - break - end - end - end; - popInd(p.lex^); - end; - tkWhen: result := parseObjectWhen(p); - tkCase: result := parseObjectCase(p); - tkSymbol, tkAccent: begin - result := parseIdentColonEquals(p, {@set}[withPragma]); - skipComment(p, result); - end; - tkNil: begin - result := newNodeP(nkNilLit, p); - getTok(p); - end; - else result := nil - end -end; - -function parseObject(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkObjectTy, p); - getTok(p); - if p.tok.tokType = tkCurlyDotLe then addSon(result, parsePragma(p)) - else addSon(result, nil); - if p.tok.tokType = tkOf then begin - a := newNodeP(nkOfInherit, p); - getTok(p); - addSon(a, parseTypeDesc(p)); - addSon(result, a); - end - else addSon(result, nil); - skipComment(p, result); - addSon(result, parseObjectPart(p)); -end; - -function parseDistinct(var p: TParser): PNode; -begin - result := newNodeP(nkDistinctTy, p); - getTok(p); - optInd(p, result); - addSon(result, parseTypeDesc(p)); -end; - -function parseTypeDef(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkTypeDef, p); - addSon(result, identWithPragma(p)); - if p.tok.tokType = tkBracketLe then addSon(result, parseGenericParamList(p)) - else addSon(result, nil); - if p.tok.tokType = tkEquals then begin - getTok(p); optInd(p, result); - case p.tok.tokType of - tkObject: a := parseObject(p); - tkEnum: a := parseEnum(p); - tkDistinct: a := parseDistinct(p); - else a := parseTypeDesc(p); - end; - addSon(result, a); - end - else - addSon(result, nil); - indAndComment(p, result); // special extension! -end; - -function parseVarTuple(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkVarTuple, p); - getTok(p); // skip '(' - optInd(p, result); - while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin - a := identWithPragma(p); - addSon(result, a); - if p.tok.tokType <> tkComma then break; - getTok(p); - optInd(p, a) - end; - addSon(result, nil); // no type desc - optSad(p); - eat(p, tkParRi); - eat(p, tkEquals); - optInd(p, result); - addSon(result, parseExpr(p)); -end; - -function parseVariable(var p: TParser): PNode; -begin - if p.tok.tokType = tkParLe then - result := parseVarTuple(p) - else - result := parseIdentColonEquals(p, {@set}[withPragma]); - indAndComment(p, result); // special extension! -end; - -function simpleStmt(var p: TParser): PNode; -begin - case p.tok.tokType of - tkReturn: result := parseReturnOrRaise(p, nkReturnStmt); - tkRaise: result := parseReturnOrRaise(p, nkRaiseStmt); - tkYield: result := parseYieldOrDiscard(p, nkYieldStmt); - tkDiscard: result := parseYieldOrDiscard(p, nkDiscardStmt); - tkBreak: result := parseBreakOrContinue(p, nkBreakStmt); - tkContinue: result := parseBreakOrContinue(p, nkContinueStmt); - tkCurlyDotLe: result := parsePragma(p); - tkImport: result := parseImportOrIncludeStmt(p, nkImportStmt); - tkFrom: result := parseFromStmt(p); - tkInclude: result := parseImportOrIncludeStmt(p, nkIncludeStmt); - tkComment: result := newCommentStmt(p); - else begin - if isExprStart(p) then - result := parseExprStmt(p) - else - result := nil; - end - end; - if result <> nil then - skipComment(p, result); -end; - -function complexOrSimpleStmt(var p: TParser): PNode; -begin - case p.tok.tokType of - tkIf: result := parseIfOrWhen(p, nkIfStmt); - tkWhile: result := parseWhile(p); - tkCase: result := parseCase(p); - tkTry: result := parseTry(p); - tkFor: result := parseFor(p); - tkBlock: result := parseBlock(p); - tkAsm: result := parseAsm(p); - tkProc: result := parseRoutine(p, nkProcDef); - tkMethod: result := parseRoutine(p, nkMethodDef); - tkIterator: result := parseRoutine(p, nkIteratorDef); - tkMacro: result := parseRoutine(p, nkMacroDef); - tkTemplate: result := parseRoutine(p, nkTemplateDef); - tkConverter: result := parseRoutine(p, nkConverterDef); - tkType: result := parseSection(p, nkTypeSection, parseTypeDef); - tkConst: result := parseSection(p, nkConstSection, parseConstant); - tkWhen: result := parseIfOrWhen(p, nkWhenStmt); - tkVar: result := parseSection(p, nkVarSection, parseVariable); - else result := simpleStmt(p); - end -end; - -function parseStmt(var p: TParser): PNode; -var - a: PNode; -begin - if p.tok.tokType = tkInd then begin - result := newNodeP(nkStmtList, p); - pushInd(p.lex^, p.tok.indent); - getTok(p); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkEof: break; - tkDed: begin getTok(p); break end; - else begin - a := complexOrSimpleStmt(p); - if a = nil then break; - addSon(result, a); - end - end - end; - popInd(p.lex^); - end - else begin - // the case statement is only needed for better error messages: - case p.tok.tokType of - tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, - tkProc, tkIterator, tkMacro, tkType, tkConst, tkWhen, tkVar: begin - parMessage(p, errComplexStmtRequiresInd); - result := nil - end - else begin - result := simpleStmt(p); - if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - if p.tok.tokType = tkSad then getTok(p); - end - end - end -end; - -function parseAll(var p: TParser): PNode; -var - a: PNode; -begin - result := newNodeP(nkStmtList, p); - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkDed, tkInd: parMessage(p, errInvalidIndentation); - tkEof: break; - else begin - a := complexOrSimpleStmt(p); - if a = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - addSon(result, a); - end - end - end -end; - -function parseTopLevelStmt(var p: TParser): PNode; -begin - result := nil; - while true do begin - case p.tok.tokType of - tkSad: getTok(p); - tkDed, tkInd: begin - parMessage(p, errInvalidIndentation); - break; - end; - tkEof: break; - else begin - result := complexOrSimpleStmt(p); - if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); - break - end - end - end -end; - -end. diff --git a/nim/pragmas.pas b/nim/pragmas.pas deleted file mode 100755 index 7a0fd24684..0000000000 --- a/nim/pragmas.pas +++ /dev/null @@ -1,627 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit pragmas; - -// This module implements semantic checking for pragmas - -interface - -{$include 'config.inc'} - -uses - nsystem, nos, platform, condsyms, ast, astalgo, idents, semdata, msgs, - rnimsyn, wordrecg, ropes, options, strutils, lists, extccomp, nmath, - magicsys; - -const - FirstCallConv = wNimcall; - LastCallConv = wNoconv; - -const - procPragmas = {@set}[FirstCallConv..LastCallConv, - wImportc, wExportc, wNodecl, wMagic, wNosideEffect, wSideEffect, - wNoreturn, wDynLib, wHeader, wCompilerProc, wPure, - wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, - wBorrow]; - converterPragmas = procPragmas; - methodPragmas = procPragmas; - macroPragmas = {@set}[FirstCallConv..LastCallConv, - wImportc, wExportc, wNodecl, wMagic, wNosideEffect, - wCompilerProc, wDeprecated, wTypeCheck]; - iteratorPragmas = {@set}[FirstCallConv..LastCallConv, - wNosideEffect, wSideEffect, - wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow]; - stmtPragmas = {@set}[wChecks, wObjChecks, wFieldChecks, wRangechecks, - wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, - wHints, wLinedir, wStacktrace, wLinetrace, wOptimization, - wHint, wWarning, wError, wFatal, wDefine, wUndef, - wCompile, wLink, wLinkSys, wPure, - wPush, wPop, wBreakpoint, wCheckpoint, - wPassL, wPassC, wDeadCodeElim, wDeprecated]; - lambdaPragmas = {@set}[FirstCallConv..LastCallConv, - wImportc, wExportc, wNodecl, wNosideEffect, wSideEffect, - wNoreturn, wDynLib, wHeader, wPure, wDeprecated]; - typePragmas = {@set}[wImportc, wExportc, wDeprecated, wMagic, wAcyclic, - wNodecl, wPure, wHeader, wCompilerProc, wFinal]; - fieldPragmas = {@set}[wImportc, wExportc, wDeprecated]; - varPragmas = {@set}[wImportc, wExportc, wVolatile, wRegister, wThreadVar, - wNodecl, wMagic, wHeader, wDeprecated, wCompilerProc, - wDynLib]; - constPragmas = {@set}[wImportc, wExportc, wHeader, wDeprecated, - wMagic, wNodecl]; - procTypePragmas = [FirstCallConv..LastCallConv, wVarargs, wNosideEffect]; - -procedure pragma(c: PContext; sym: PSym; n: PNode; - const validPragmas: TSpecialWords); - -function pragmaAsm(c: PContext; n: PNode): char; - -implementation - -procedure invalidPragma(n: PNode); -begin - liMessage(n.info, errInvalidPragmaX, renderTree(n, {@set}[renderNoComments])); -end; - -function pragmaAsm(c: PContext; n: PNode): char; -var - i: int; - it: PNode; -begin - result := #0; - if n <> nil then begin - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if (it.kind = nkExprColonExpr) and (it.sons[0].kind = nkIdent) then begin - case whichKeyword(it.sons[0].ident) of - wSubsChar: begin - if it.sons[1].kind = nkCharLit then - result := chr(int(it.sons[1].intVal)) - else invalidPragma(it) - end - else - invalidPragma(it) - end - end - else - invalidPragma(it); - end - end -end; - -const - FirstPragmaWord = wMagic; - LastPragmaWord = wNoconv; - -procedure MakeExternImport(s: PSym; const extname: string); -begin - s.loc.r := toRope(extname); - Include(s.flags, sfImportc); - Exclude(s.flags, sfForward); -end; - -procedure MakeExternExport(s: PSym; const extname: string); -begin - s.loc.r := toRope(extname); - Include(s.flags, sfExportc); -end; - -function expectStrLit(c: PContext; n: PNode): string; -begin - if n.kind <> nkExprColonExpr then begin - liMessage(n.info, errStringLiteralExpected); - result := '' - end - else begin - n.sons[1] := c.semConstExpr(c, n.sons[1]); - case n.sons[1].kind of - nkStrLit, nkRStrLit, nkTripleStrLit: result := n.sons[1].strVal; - else begin - liMessage(n.info, errStringLiteralExpected); - result := '' - end - end - end -end; - -function expectIntLit(c: PContext; n: PNode): int; -begin - if n.kind <> nkExprColonExpr then begin - liMessage(n.info, errIntLiteralExpected); - result := 0 - end - else begin - n.sons[1] := c.semConstExpr(c, n.sons[1]); - case n.sons[1].kind of - nkIntLit..nkInt64Lit: result := int(n.sons[1].intVal); - else begin - liMessage(n.info, errIntLiteralExpected); - result := 0 - end - end - end -end; - -function getOptionalStr(c: PContext; n: PNode; - const defaultStr: string): string; -begin - if n.kind = nkExprColonExpr then - result := expectStrLit(c, n) - else - result := defaultStr -end; - -procedure processMagic(c: PContext; n: PNode; s: PSym); -var - v: string; - m: TMagic; -begin - //if not (sfSystemModule in c.module.flags) then - // liMessage(n.info, errMagicOnlyInSystem); - if n.kind <> nkExprColonExpr then - liMessage(n.info, errStringLiteralExpected); - if n.sons[1].kind = nkIdent then v := n.sons[1].ident.s - else v := expectStrLit(c, n); - Include(s.flags, sfImportc); // magics don't need an implementation, so we - // treat them as imported, instead of modifing a lot of working code - // BUGFIX: magic does not imply ``lfNoDecl`` anymore! - for m := low(TMagic) to high(TMagic) do - if magicToStr[m] = v then begin - s.magic := m; exit - end; - // else: no magic found; make this a warning! - liMessage(n.info, warnUnknownMagic, v); -end; - -function wordToCallConv(sw: TSpecialWord): TCallingConvention; -begin - // this assumes that the order of special words and calling conventions is - // the same - result := TCallingConvention(ord(ccDefault) + ord(sw) - ord(wNimcall)); -end; - -procedure onOff(c: PContext; n: PNode; op: TOptions); -begin - if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin - case whichKeyword(n.sons[1].ident) of - wOn: gOptions := gOptions + op; - wOff: gOptions := gOptions - op; - else liMessage(n.info, errOnOrOffExpected) - end - end - else - liMessage(n.info, errOnOrOffExpected) -end; - -procedure pragmaDeadCodeElim(c: PContext; n: PNode); -begin - if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin - case whichKeyword(n.sons[1].ident) of - wOn: include(c.module.flags, sfDeadCodeElim); - wOff: exclude(c.module.flags, sfDeadCodeElim); - else liMessage(n.info, errOnOrOffExpected) - end - end - else - liMessage(n.info, errOnOrOffExpected) -end; - -procedure processCallConv(c: PContext; n: PNode); -var - sw: TSpecialWord; -begin - if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin - sw := whichKeyword(n.sons[1].ident); - case sw of - firstCallConv..lastCallConv: - POptionEntry(c.optionStack.tail).defaultCC := wordToCallConv(sw); - else - liMessage(n.info, errCallConvExpected) - end - end - else - liMessage(n.info, errCallConvExpected) -end; - -function getLib(c: PContext; kind: TLibKind; const path: string): PLib; -var - it: PLib; -begin - it := PLib(c.libs.head); - while it <> nil do begin - if it.kind = kind then begin - if ospCaseInsensitive in platform.OS[targetOS].props then begin - if cmpIgnoreCase(it.path, path) = 0 then begin result := it; exit end; - end - else begin - if it.path = path then begin result := it; exit end; - end - end; - it := PLib(it.next) - end; - // not found --> we need a new one: - result := newLib(kind); - result.path := path; - Append(c.libs, result) -end; - -procedure processDynLib(c: PContext; n: PNode; sym: PSym); -var - lib: PLib; -begin - if (sym = nil) or (sym.kind = skModule) then - POptionEntry(c.optionStack.tail).dynlib := getLib(c, libDynamic, - expectStrLit(c, n)) - else if n.kind = nkExprColonExpr then begin - lib := getLib(c, libDynamic, expectStrLit(c, n)); - addToLib(lib, sym); - include(sym.loc.flags, lfDynamicLib) - end - else - include(sym.loc.flags, lfExportLib) -end; - -procedure processNote(c: PContext; n: PNode); -var - x: int; - nk: TNoteKind; -begin - if (n.kind = nkExprColonExpr) and (sonsLen(n) = 2) - and (n.sons[0].kind = nkBracketExpr) and (n.sons[0].sons[1].kind = nkIdent) - and (n.sons[0].sons[0].kind = nkIdent) and (n.sons[1].kind = nkIdent) then begin - case whichKeyword(n.sons[0].sons[0].ident) of - wHint: begin - x := findStr(msgs.HintsToStr, n.sons[0].sons[1].ident.s); - if x >= 0 then nk := TNoteKind(x + ord(hintMin)) - else invalidPragma(n) - end; - wWarning: begin - x := findStr(msgs.WarningsToStr, n.sons[0].sons[1].ident.s); - if x >= 0 then nk := TNoteKind(x + ord(warnMin)) - else InvalidPragma(n) - end; - else begin - invalidPragma(n); exit - end - end; - case whichKeyword(n.sons[1].ident) of - wOn: include(gNotes, nk); - wOff: exclude(gNotes, nk); - else liMessage(n.info, errOnOrOffExpected) - end - end - else - invalidPragma(n); -end; - -procedure processOption(c: PContext; n: PNode); -var - sw: TSpecialWord; -begin - if n.kind <> nkExprColonExpr then invalidPragma(n) - else if n.sons[0].kind = nkBracketExpr then - processNote(c, n) - else if n.sons[0].kind <> nkIdent then - invalidPragma(n) - else begin - sw := whichKeyword(n.sons[0].ident); - case sw of - wChecks: OnOff(c, n, checksOptions); - wObjChecks: OnOff(c, n, {@set}[optObjCheck]); - wFieldchecks: OnOff(c, n, {@set}[optFieldCheck]); - wRangechecks: OnOff(c, n, {@set}[optRangeCheck]); - wBoundchecks: OnOff(c, n, {@set}[optBoundsCheck]); - wOverflowchecks: OnOff(c, n, {@set}[optOverflowCheck]); - wNilchecks: OnOff(c, n, {@set}[optNilCheck]); - wAssertions: OnOff(c, n, {@set}[optAssert]); - wWarnings: OnOff(c, n, {@set}[optWarns]); - wHints: OnOff(c, n, {@set}[optHints]); - wCallConv: processCallConv(c, n); - // ------ these are not in the Nimrod spec: ------------- - wLinedir: OnOff(c, n, {@set}[optLineDir]); - wStacktrace: OnOff(c, n, {@set}[optStackTrace]); - wLinetrace: OnOff(c, n, {@set}[optLineTrace]); - wDebugger: OnOff(c, n, {@set}[optEndb]); - wProfiler: OnOff(c, n, {@set}[optProfiler]); - wByRef: OnOff(c, n, {@set}[optByRef]); - wDynLib: processDynLib(c, n, nil); - // ------------------------------------------------------- - wOptimization: begin - if n.sons[1].kind <> nkIdent then - invalidPragma(n) - else begin - case whichKeyword(n.sons[1].ident) of - wSpeed: begin - include(gOptions, optOptimizeSpeed); - exclude(gOptions, optOptimizeSize); - end; - wSize: begin - exclude(gOptions, optOptimizeSpeed); - include(gOptions, optOptimizeSize); - end; - wNone: begin - exclude(gOptions, optOptimizeSpeed); - exclude(gOptions, optOptimizeSize); - end; - else - liMessage(n.info, errNoneSpeedOrSizeExpected); - end - end - end; - else liMessage(n.info, errOptionExpected); - end - end; - // BUGFIX this is a little hack, but at least it works: - //getCurrOwner(c).options := gOptions; -end; - -procedure processPush(c: PContext; n: PNode; start: int); -var - i: int; - x, y: POptionEntry; -begin - x := newOptionEntry(); - y := POptionEntry(c.optionStack.tail); - x.options := gOptions; - x.defaultCC := y.defaultCC; - x.dynlib := y.dynlib; - x.notes := gNotes; - append(c.optionStack, x); - for i := start to sonsLen(n)-1 do - processOption(c, n.sons[i]); - //liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); -end; - -procedure processPop(c: PContext; n: PNode); -begin - if c.optionStack.counter <= 1 then - liMessage(n.info, errAtPopWithoutPush) - else begin - gOptions := POptionEntry(c.optionStack.tail).options; - //liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); - gNotes := POptionEntry(c.optionStack.tail).notes; - remove(c.optionStack, c.optionStack.tail); - end -end; - -procedure processDefine(c: PContext; n: PNode); -begin - if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin - DefineSymbol(n.sons[1].ident.s); - liMessage(n.info, warnDeprecated, 'define'); - end - else - invalidPragma(n) -end; - -procedure processUndef(c: PContext; n: PNode); -begin - if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin - UndefSymbol(n.sons[1].ident.s); - liMessage(n.info, warnDeprecated, 'undef'); - end - else - invalidPragma(n) -end; - -type - TLinkFeature = (linkNormal, linkSys); - -procedure processCompile(c: PContext; n: PNode); -var - s, found, trunc: string; -begin - s := expectStrLit(c, n); - found := findFile(s); - if found = '' then found := s; - trunc := ChangeFileExt(found, ''); - extccomp.addExternalFileToCompile(trunc); - extccomp.addFileToLink(completeCFilePath(trunc, false)); -end; - -procedure processCommonLink(c: PContext; n: PNode; feature: TLinkFeature); -var - f, found: string; -begin - f := expectStrLit(c, n); - if splitFile(f).ext = '' then - f := toObjFile(f); - found := findFile(f); - if found = '' then - found := f; // use the default - case feature of - linkNormal: extccomp.addFileToLink(found); - linkSys: begin - extccomp.addFileToLink(joinPath(libpath, - completeCFilePath(found, false))); - end - else internalError(n.info, 'processCommonLink'); - end -end; - -procedure PragmaBreakpoint(c: PContext; n: PNode); -begin - {@discard} getOptionalStr(c, n, ''); -end; - -procedure PragmaCheckpoint(c: PContext; n: PNode); -// checkpoints can be used to debug the compiler; they are not documented -var - info: TLineInfo; -begin - info := n.info; - inc(info.line); // next line is affected! - msgs.addCheckpoint(info); -end; - -procedure noVal(n: PNode); -begin - if n.kind = nkExprColonExpr then invalidPragma(n) -end; - -procedure pragma(c: PContext; sym: PSym; n: PNode; - const validPragmas: TSpecialWords); -var - i: int; - key, it: PNode; - k: TSpecialWord; - lib: PLib; -begin - if n = nil then exit; - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it.kind = nkExprColonExpr then key := it.sons[0] else key := it; - if key.kind = nkIdent then begin - k := whichKeyword(key.ident); - if k in validPragmas then begin - case k of - wExportc: begin - makeExternExport(sym, getOptionalStr(c, it, sym.name.s)); - include(sym.flags, sfUsed); // avoid wrong hints - end; - wImportc: begin - makeExternImport(sym, getOptionalStr(c, it, sym.name.s)); - end; - wAlign: begin - if sym.typ = nil then invalidPragma(it); - sym.typ.align := expectIntLit(c, it); - if not IsPowerOfTwo(sym.typ.align) and (sym.typ.align <> 0) then - liMessage(it.info, errPowerOfTwoExpected); - end; - wNodecl: begin noVal(it); Include(sym.loc.Flags, lfNoDecl); end; - wPure: begin - noVal(it); - if sym <> nil then include(sym.flags, sfPure); - end; - wVolatile: begin noVal(it); Include(sym.flags, sfVolatile); end; - wRegister: begin noVal(it); include(sym.flags, sfRegister); end; - wThreadVar: begin noVal(it); include(sym.flags, sfThreadVar); end; - wDeadCodeElim: pragmaDeadCodeElim(c, it); - wMagic: processMagic(c, it, sym); - wCompileTime: begin - noVal(it); - include(sym.flags, sfCompileTime); - include(sym.loc.Flags, lfNoDecl); - end; - wMerge: begin - noval(it); - include(sym.flags, sfMerge); - end; - wHeader: begin - lib := getLib(c, libHeader, expectStrLit(c, it)); - addToLib(lib, sym); - include(sym.flags, sfImportc); - include(sym.loc.flags, lfHeader); - include(sym.loc.Flags, lfNoDecl); // implies nodecl, because - // otherwise header would not make sense - if sym.loc.r = nil then sym.loc.r := toRope(sym.name.s) - end; - wNosideeffect: begin - noVal(it); Include(sym.flags, sfNoSideEffect); - if sym.typ <> nil then include(sym.typ.flags, tfNoSideEffect); - end; - wSideEffect: begin noVal(it); Include(sym.flags, sfSideEffect); end; - wNoReturn: begin noVal(it); Include(sym.flags, sfNoReturn); end; - wDynLib: processDynLib(c, it, sym); - wCompilerProc: begin - noVal(it); // compilerproc may not get a string! - makeExternExport(sym, sym.name.s); - include(sym.flags, sfCompilerProc); - include(sym.flags, sfUsed); // suppress all those stupid warnings - registerCompilerProc(sym); - end; - wProcvar: begin - noVal(it); - include(sym.flags, sfProcVar); - end; - wDeprecated: begin - noVal(it); - if sym <> nil then include(sym.flags, sfDeprecated) - else include(c.module.flags, sfDeprecated); - end; - wVarargs: begin - noVal(it); - if sym.typ = nil then invalidPragma(it); - include(sym.typ.flags, tfVarargs); - end; - wBorrow: begin - noVal(it); - include(sym.flags, sfBorrow); - end; - wFinal: begin - noVal(it); - if sym.typ = nil then invalidPragma(it); - include(sym.typ.flags, tfFinal); - end; - wAcyclic: begin - noVal(it); - if sym.typ = nil then invalidPragma(it); - include(sym.typ.flags, tfAcyclic); - end; - wTypeCheck: begin - noVal(it); - include(sym.flags, sfTypeCheck); - end; - - // statement pragmas: - wHint: liMessage(it.info, hintUser, expectStrLit(c, it)); - wWarning: liMessage(it.info, warnUser, expectStrLit(c, it)); - wError: liMessage(it.info, errUser, expectStrLit(c, it)); - wFatal: begin - liMessage(it.info, errUser, expectStrLit(c, it)); - halt(1); - end; - wDefine: processDefine(c, it); - wUndef: processUndef(c, it); - wCompile: processCompile(c, it); - wLink: processCommonLink(c, it, linkNormal); - wLinkSys: processCommonLink(c, it, linkSys); - wPassL: extccomp.addLinkOption(expectStrLit(c, it)); - wPassC: extccomp.addCompileOption(expectStrLit(c, it)); - - wBreakpoint: PragmaBreakpoint(c, it); - wCheckpoint: PragmaCheckpoint(c, it); - - wPush: begin processPush(c, n, i+1); break end; - wPop: processPop(c, it); - wChecks, wObjChecks, wFieldChecks, - wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, - wAssertions, wWarnings, wHints, wLinedir, wStacktrace, - wLinetrace, wOptimization, wByRef, wCallConv, wDebugger, wProfiler: - processOption(c, it); - // calling conventions (boring...): - firstCallConv..lastCallConv: begin - assert(sym <> nil); - if sym.typ = nil then invalidPragma(it); - sym.typ.callConv := wordToCallConv(k) - end - else invalidPragma(it); - end - end - else invalidPragma(it); - end - else begin - processNote(c, it) - end; - end; - if (sym <> nil) and (sym.kind <> skModule) then begin - if (lfExportLib in sym.loc.flags) and not (sfExportc in sym.flags) then - liMessage(n.info, errDynlibRequiresExportc); - lib := POptionEntry(c.optionstack.tail).dynlib; - if ([lfDynamicLib, lfHeader] * sym.loc.flags = []) and - (sfImportc in sym.flags) and - (lib <> nil) then begin - include(sym.loc.flags, lfDynamicLib); - addToLib(lib, sym); - if sym.loc.r = nil then sym.loc.r := toRope(sym.name.s) - end - end -end; - -end. diff --git a/nim/procfind.pas b/nim/procfind.pas deleted file mode 100755 index e93820ab30..0000000000 --- a/nim/procfind.pas +++ /dev/null @@ -1,120 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit procfind; - -// This module implements the searching for procs and iterators. -// This is needed for proper handling of forward declarations. - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, msgs, semdata, types, trees; - -function SearchForProc(c: PContext; fn: PSym; tos: int): PSym; -// Searchs for the fn in the symbol table. If the parameter lists are exactly -// the same the sym in the symbol table is returned, else nil. - -function SearchForBorrowProc(c: PContext; fn: PSym; tos: int): PSym; -// Searchs for the fn in the symbol table. If the parameter lists are suitable -// for borrowing the sym in the symbol table is returned, else nil. - -implementation - -function equalGenericParams(procA, procB: PNode): Boolean; -var - a, b: PSym; - i: int; -begin - result := procA = procB; - if result then exit; - if (procA = nil) or (procB = nil) then exit; - - if sonsLen(procA) <> sonsLen(procB) then exit; - for i := 0 to sonsLen(procA)-1 do begin - if procA.sons[i].kind <> nkSym then - InternalError(procA.info, 'equalGenericParams'); - if procB.sons[i].kind <> nkSym then - InternalError(procB.info, 'equalGenericParams'); - a := procA.sons[i].sym; - b := procB.sons[i].sym; - if (a.name.id <> b.name.id) or not sameTypeOrNil(a.typ, b.typ) then exit; - if (a.ast <> nil) and (b.ast <> nil) then - if not ExprStructuralEquivalent(a.ast, b.ast) then exit; - end; - result := true -end; - -function SearchForProc(c: PContext; fn: PSym; tos: int): PSym; -var - it: TIdentIter; -begin - result := initIdentIter(it, c.tab.stack[tos], fn.Name); - while result <> nil do begin - if (result.Kind = fn.kind) then begin - if equalGenericParams(result.ast.sons[genericParamsPos], - fn.ast.sons[genericParamsPos]) then begin - case equalParams(result.typ.n, fn.typ.n) of - paramsEqual: exit; - paramsIncompatible: begin - liMessage(fn.info, errNotOverloadable, fn.name.s); - exit - end; - paramsNotEqual: begin end; // continue search - end; - end - end; - result := NextIdentIter(it, c.tab.stack[tos]) - end -end; - -function paramsFitBorrow(a, b: PNode): bool; -var - i, len: int; - m, n: PSym; -begin - len := sonsLen(a); - result := false; - if len = sonsLen(b) then begin - for i := 1 to len-1 do begin - m := a.sons[i].sym; - n := b.sons[i].sym; - assert((m.kind = skParam) and (n.kind = skParam)); - if not equalOrDistinctOf(m.typ, n.typ) then exit; - end; - // return type: - if not equalOrDistinctOf(a.sons[0].typ, b.sons[0].typ) then exit; - result := true - end -end; - -function SearchForBorrowProc(c: PContext; fn: PSym; tos: int): PSym; -// Searchs for the fn in the symbol table. If the parameter lists are suitable -// for borrowing the sym in the symbol table is returned, else nil. -var - it: TIdentIter; - scope: int; -begin - for scope := tos downto 0 do begin - result := initIdentIter(it, c.tab.stack[scope], fn.Name); - while result <> nil do begin - // watchout! result must not be the same as fn! - if (result.Kind = fn.kind) and (result.id <> fn.id) then begin - if equalGenericParams(result.ast.sons[genericParamsPos], - fn.ast.sons[genericParamsPos]) then begin - if paramsFitBorrow(fn.typ.n, result.typ.n) then exit; - end - end; - result := NextIdentIter(it, c.tab.stack[scope]) - end - end -end; - -end. diff --git a/nim/ptmplsyn.pas b/nim/ptmplsyn.pas deleted file mode 100755 index 717da6ee05..0000000000 --- a/nim/ptmplsyn.pas +++ /dev/null @@ -1,222 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ptmplsyn; - -// This module implements Nimrod's standard template filter. - -{$include config.inc} - -interface - -uses - nsystem, llstream, nos, charsets, wordrecg, idents, strutils, - ast, astalgo, msgs, options, rnimsyn, filters; - -function filterTmpl(input: PLLStream; const filename: string; - call: PNode): PLLStream; -// #! template(subsChar='$', metaChar='#') | standard(version="0.7.2") - -implementation - -type - TParseState = (psDirective, psTempl); - TTmplParser = record - inp: PLLStream; - state: TParseState; - info: TLineInfo; - indent, par: int; - x: string; // the current input line - outp: PLLStream; // the ouput will be parsed by pnimsyn - subsChar, NimDirective: Char; - emit, conc, toStr: string; - end; - -const - PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255, '.', '_']; - -procedure newLine(var p: TTmplParser); -begin - LLStreamWrite(p.outp, repeatChar(p.par, ')')); - p.par := 0; - if p.info.line > int16(1) then LLStreamWrite(p.outp, nl); -end; - -procedure parseLine(var p: TTmplParser); -var - d, j, curly: int; - keyw: string; -begin - j := strStart; - while p.x[j] = ' ' do inc(j); - if (p.x[strStart] = p.NimDirective) and (p.x[strStart+1] = '!') then - newLine(p) - else if (p.x[j] = p.NimDirective) then begin - newLine(p); - inc(j); - while p.x[j] = ' ' do inc(j); - d := j; - keyw := ''; - while p.x[j] in PatternChars do begin - addChar(keyw, p.x[j]); - inc(j); - end; - case whichKeyword(keyw) of - wEnd: begin - if p.indent >= 2 then - dec(p.indent, 2) - else begin - p.info.col := int16(j); - liMessage(p.info, errXNotAllowedHere, 'end'); - end; - LLStreamWrite(p.outp, repeatChar(p.indent)); - LLStreamWrite(p.outp, '#end'); - end; - wIf, wWhen, wTry, wWhile, wFor, wBlock, wCase, wProc, wIterator, - wConverter, wMacro, wTemplate, wMethod: begin - LLStreamWrite(p.outp, repeatChar(p.indent)); - LLStreamWrite(p.outp, ncopy(p.x, d)); - inc(p.indent, 2); - end; - wElif, wOf, wElse, wExcept, wFinally: begin - LLStreamWrite(p.outp, repeatChar(p.indent-2)); - LLStreamWrite(p.outp, ncopy(p.x, d)); - end - else begin - LLStreamWrite(p.outp, repeatChar(p.indent)); - LLStreamWrite(p.outp, ncopy(p.x, d)); - end - end; - p.state := psDirective - end - else begin - // data line - j := strStart; - case p.state of - psTempl: begin - // next line of string literal: - LLStreamWrite(p.outp, p.conc); - LLStreamWrite(p.outp, nl); - LLStreamWrite(p.outp, repeatChar(p.indent + 2)); - LLStreamWrite(p.outp, '"'+''); - end; - psDirective: begin - newLine(p); - LLStreamWrite(p.outp, repeatChar(p.indent)); - LLStreamWrite(p.outp, p.emit); - LLStreamWrite(p.outp, '("'); - inc(p.par); - end - end; - p.state := psTempl; - while true do begin - case p.x[j] of - #0: break; - #1..#31, #128..#255: begin - LLStreamWrite(p.outp, '\x'); - LLStreamWrite(p.outp, toHex(ord(p.x[j]), 2)); - inc(j); - end; - '\': begin LLStreamWrite(p.outp, '\\'); inc(j); end; - '''': begin LLStreamWrite(p.outp, '\'''); inc(j); end; - '"': begin LLStreamWrite(p.outp, '\"'); inc(j); end; - else if p.x[j] = p.subsChar then begin // parse Nimrod expression: - inc(j); - case p.x[j] of - '{': begin - p.info.col := int16(j); - LLStreamWrite(p.outp, '"'); - LLStreamWrite(p.outp, p.conc); - LLStreamWrite(p.outp, p.toStr); - LLStreamWrite(p.outp, '('); - inc(j); - curly := 0; - while true do begin - case p.x[j] of - #0: liMessage(p.info, errXExpected, '}'+''); - '{': begin - inc(j); - inc(curly); - LLStreamWrite(p.outp, '{'); - end; - '}': begin - inc(j); - if curly = 0 then break; - if curly > 0 then dec(curly); - LLStreamWrite(p.outp, '}'); - end; - else begin - LLStreamWrite(p.outp, p.x[j]); - inc(j) - end - end - end; - LLStreamWrite(p.outp, ')'); - LLStreamWrite(p.outp, p.conc); - LLStreamWrite(p.outp, '"'); - end; - 'a'..'z', 'A'..'Z', #128..#255: begin - LLStreamWrite(p.outp, '"'); - LLStreamWrite(p.outp, p.conc); - LLStreamWrite(p.outp, p.toStr); - LLStreamWrite(p.outp, '('); - while p.x[j] in PatternChars do begin - LLStreamWrite(p.outp, p.x[j]); - inc(j) - end; - LLStreamWrite(p.outp, ')'); - LLStreamWrite(p.outp, p.conc); - LLStreamWrite(p.outp, '"') - end; - else if p.x[j] = p.subsChar then begin - LLStreamWrite(p.outp, p.subsChar); - inc(j); - end - else begin - p.info.col := int16(j); - liMessage(p.info, errInvalidExpression, '$'+''); - end - end - end - else begin - LLStreamWrite(p.outp, p.x[j]); - inc(j); - end - end - end; - LLStreamWrite(p.outp, '\n"'); - end -end; - -function filterTmpl(input: PLLStream; const filename: string; - call: PNode): PLLStream; -var - p: TTmplParser; -begin -{@ignore} - FillChar(p, sizeof(p), 0); -{@emit} - p.info := newLineInfo(filename, 0, 0); - p.outp := LLStreamOpen(''); - p.inp := input; - p.subsChar := charArg(call, 'subschar', 1, '$'); - p.nimDirective := charArg(call, 'metachar', 2, '#'); - p.emit := strArg(call, 'emit', 3, 'result.add'); - p.conc := strArg(call, 'conc', 4, ' & '); - p.toStr := strArg(call, 'tostring', 5, '$'+''); - while not LLStreamAtEnd(p.inp) do begin - p.x := LLStreamReadLine(p.inp) {@ignore} + #0 {@emit}; - p.info.line := p.info.line + int16(1); - parseLine(p); - end; - newLine(p); - result := p.outp; - LLStreamClose(p.inp); -end; - -end. diff --git a/nim/readme.txt b/nim/readme.txt deleted file mode 100755 index 2581925438..0000000000 --- a/nim/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -This is the Pascal version of the sources. The Nimrod version has been -generated automatically from it. DO NOT MODIFY THIS OLD VERSION, BUT THE -UP-TO-DATE VERSION IN NIMROD! - diff --git a/nim/rnimsyn.pas b/nim/rnimsyn.pas deleted file mode 100755 index ec1e9571e3..0000000000 --- a/nim/rnimsyn.pas +++ /dev/null @@ -1,1458 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit rnimsyn; - -// This module implements the renderer of the standard Nimrod representation. - -{$include config.inc} - -interface - -uses - nsystem, charsets, scanner, options, idents, strutils, ast, msgs, - lists; - -type - TRenderFlag = (renderNone, renderNoBody, renderNoComments, - renderDocComments, renderNoPragmas, renderIds); - TRenderFlags = set of TRenderFlag; - - TRenderTok = record - kind: TTokType; - len: int16; - end; - TRenderTokSeq = array of TRenderTok; - - TSrcGen = record - indent: int; - lineLen: int; - pos: int; // current position for iteration over the buffer - idx: int; // current token index for iteration over the buffer - tokens: TRenderTokSeq; - buf: string; - pendingNL: int; // negative if not active; else contains the - // indentation value - comStack: array of PNode; // comment stack - flags: TRenderFlags; - end; - -procedure renderModule(n: PNode; const filename: string; - renderFlags: TRenderFlags = {@set}[]); - -function renderTree(n: PNode; renderFlags: TRenderFlags = {@set}[]): string; - -procedure initTokRender(var r: TSrcGen; n: PNode; - renderFlags: TRenderFlags = {@set}[]); -procedure getNextTok(var r: TSrcGen; var kind: TTokType; var literal: string); - -implementation - -// We render the source code in a two phases: The first -// determines how long the subtree will likely be, the second -// phase appends to a buffer that will be the output. - -const - IndentWidth = 2; - longIndentWid = 4; - MaxLineLen = 80; - LineCommentColumn = 30; - -procedure InitSrcGen(out g: TSrcGen; renderFlags: TRenderFlags); -begin -{@ignore} - fillChar(g, sizeof(g), 0); - g.comStack := nil; - g.tokens := nil; -{@emit - g.comStack := @[];} -{@emit - g.tokens := @[];} - g.indent := 0; - g.lineLen := 0; - g.pos := 0; - g.idx := 0; - g.buf := ''; - g.flags := renderFlags; - g.pendingNL := -1; -end; - -{@ignore} -procedure add(var dest: string; const src: string); -begin - dest := dest +{&} src; -end; -{@emit} - -procedure addTok(var g: TSrcGen; kind: TTokType; const s: string); -var - len: int; -begin - len := length(g.tokens); - setLength(g.tokens, len+1); - g.tokens[len].kind := kind; - g.tokens[len].len := int16(length(s)); - add(g.buf, s); -end; - -procedure addPendingNL(var g: TSrcGen); -begin - if g.pendingNL >= 0 then begin - addTok(g, tkInd, NL+{&}repeatChar(g.pendingNL)); - g.lineLen := g.pendingNL; - g.pendingNL := -1; - end -end; - -procedure putNL(var g: TSrcGen; indent: int); overload; -begin - if g.pendingNL >= 0 then - addPendingNL(g) - else - addTok(g, tkInd, NL); - g.pendingNL := indent; - g.lineLen := indent; -end; - -procedure putNL(var g: TSrcGen); overload; -begin - putNL(g, g.indent); -end; - -procedure optNL(var g: TSrcGen; indent: int); overload; -begin - g.pendingNL := indent; - g.lineLen := indent; // BUGFIX -end; - -procedure optNL(var g: TSrcGen); overload; -begin - optNL(g, g.indent) -end; - -procedure indentNL(var g: TSrcGen); -begin - inc(g.indent, indentWidth); - g.pendingNL := g.indent; - g.lineLen := g.indent; -end; - -procedure Dedent(var g: TSrcGen); -begin - dec(g.indent, indentWidth); - assert(g.indent >= 0); - if g.pendingNL > indentWidth then begin - Dec(g.pendingNL, indentWidth); - Dec(g.lineLen, indentWidth) - end -end; - -procedure put(var g: TSrcGen; const kind: TTokType; const s: string); -begin - addPendingNL(g); - if length(s) > 0 then begin - addTok(g, kind, s); - inc(g.lineLen, length(s)); - end -end; - -procedure putLong(var g: TSrcGen; const kind: TTokType; const s: string; - lineLen: int); -// use this for tokens over multiple lines. -begin - addPendingNL(g); - addTok(g, kind, s); - g.lineLen := lineLen; -end; - -// ----------------------- helpers -------------------------------------------- - -function toNimChar(c: Char): string; -begin - case c of - #0: result := '\0'; - #1..#31, #128..#255: result := '\x' + strutils.toHex(ord(c), 2); - '''', '"', '\': result := '\' + c; - else result := c + '' - end; -end; - -function makeNimString(const s: string): string; -var - i: int; -begin - result := '"' + ''; - for i := strStart to length(s)+strStart-1 do add(result, toNimChar(s[i])); - addChar(result, '"'); -end; - -procedure putComment(var g: TSrcGen; s: string); -var - i, j, ind, comIndent: int; - isCode: bool; - com: string; -begin - {@ignore} s := s + #0; {@emit} - i := strStart; - comIndent := 1; - isCode := (length(s) >= 2) and (s[strStart+1] <> ' '); - ind := g.lineLen; - com := ''; - while true do begin - case s[i] of - #0: break; - #13: begin - put(g, tkComment, com); - com := ''; - inc(i); - if s[i] = #10 then inc(i); - optNL(g, ind); - end; - #10: begin - put(g, tkComment, com); - com := ''; - inc(i); - optNL(g, ind); - end; - '#': begin - addChar(com, s[i]); - inc(i); - comIndent := 0; - while s[i] = ' ' do begin - addChar(com, s[i]); - inc(i); inc(comIndent); - end - end; - ' ', #9: begin - addChar(com, s[i]); - inc(i); - end - else begin - // we may break the comment into a multi-line comment if the line - // gets too long: - - // compute length of the following word: - j := i; - while s[j] > ' ' do inc(j); - if not isCode and (g.lineLen + (j-i) > MaxLineLen) then begin - put(g, tkComment, com); - com := ''; - optNL(g, ind); - com := com +{&} '#' +{&} repeatChar(comIndent); - end; - while s[i] > ' ' do begin - addChar(com, s[i]); - inc(i); - end - end - end - end; - put(g, tkComment, com); - optNL(g); -end; - -function maxLineLength(s: string): int; -var - i, linelen: int; -begin - {@ignore} s := s + #0; {@emit} - result := 0; - i := strStart; - lineLen := 0; - while true do begin - case s[i] of - #0: break; - #13: begin - inc(i); - if s[i] = #10 then inc(i); - result := max(result, lineLen); - lineLen := 0; - end; - #10: begin - inc(i); - result := max(result, lineLen); - lineLen := 0; - end; - else begin - inc(lineLen); inc(i); - end - end - end -end; - -procedure putRawStr(var g: TSrcGen; kind: TTokType; const s: string); -var - i, hi: int; - str: string; -begin - i := strStart; - hi := length(s)+strStart-1; - str := ''; - while i <= hi do begin - case s[i] of - #13: begin - put(g, kind, str); - str := ''; - inc(i); - if (i <= hi) and (s[i] = #10) then inc(i); - optNL(g, 0); - end; - #10: begin - put(g, kind, str); - str := ''; - inc(i); - optNL(g, 0); - end; - else begin - addChar(str, s[i]); - inc(i) - end - end - end; - put(g, kind, str); -end; - -function containsNL(const s: string): bool; -var - i: int; -begin - for i := strStart to length(s)+strStart-1 do - case s[i] of - #13, #10: begin result := true; exit end; - else begin end - end; - result := false -end; - -procedure pushCom(var g: TSrcGen; n: PNode); -var - len: int; -begin - len := length(g.comStack); - setLength(g.comStack, len+1); - g.comStack[len] := n; -end; - -procedure popAllComs(var g: TSrcGen); -begin - setLength(g.comStack, 0); -end; - -procedure popCom(var g: TSrcGen); -begin - setLength(g.comStack, length(g.comStack)-1); -end; - -const - Space = ' '+''; - -function shouldRenderComment(var g: TSrcGen; n: PNode): bool; -begin - result := false; - if n.comment <> snil then - result := not (renderNoComments in g.flags) or - (renderDocComments in g.flags) and startsWith(n.comment, '##'); -end; - -procedure gcom(var g: TSrcGen; n: PNode); -var - ml: int; -begin - assert(n <> nil); - if shouldRenderComment(g, n) then begin - if (g.pendingNL < 0) and (length(g.buf) > 0) - and (g.buf[length(g.buf)] <> ' ') then - put(g, tkSpaces, Space); - // Before long comments we cannot make sure that a newline is generated, - // because this might be wrong. But it is no problem in practice. - if (g.pendingNL < 0) and (length(g.buf) > 0) - and (g.lineLen < LineCommentColumn) then begin - ml := maxLineLength(n.comment); - if ml+LineCommentColumn <= maxLineLen then - put(g, tkSpaces, repeatChar(LineCommentColumn - g.lineLen)); - end; - putComment(g, n.comment); - //assert(g.comStack[high(g.comStack)] = n); - end -end; - -procedure gcoms(var g: TSrcGen); -var - i: int; -begin - for i := 0 to high(g.comStack) do gcom(g, g.comStack[i]); - popAllComs(g); -end; - -// ---------------------------------------------------------------------------- - -function lsub(n: PNode): int; forward; - -function litAux(n: PNode; x: biggestInt; size: int): string; -begin - if nfBase2 in n.flags then result := '0b' + toBin(x, size*8) - else if nfBase8 in n.flags then result := '0o' + toOct(x, size*3) - else if nfBase16 in n.flags then result := '0x' + toHex(x, size*2) - else result := toString(x) -end; - -function atom(n: PNode): string; -var - f: float32; -begin - case n.kind of - nkEmpty: result := ''; - nkIdent: result := n.ident.s; - nkSym: result := n.sym.name.s; - nkStrLit: result := makeNimString(n.strVal); - nkRStrLit: result := 'r"' + n.strVal + '"'; - nkTripleStrLit: result := '"""' + n.strVal + '"""'; - nkCharLit: result := '''' + toNimChar(chr(int(n.intVal))) + ''''; - nkIntLit: result := litAux(n, n.intVal, 4); - nkInt8Lit: result := litAux(n, n.intVal, 1) + '''i8'; - nkInt16Lit: result := litAux(n, n.intVal, 2) + '''i16'; - nkInt32Lit: result := litAux(n, n.intVal, 4) + '''i32'; - nkInt64Lit: result := litAux(n, n.intVal, 8) + '''i64'; - nkFloatLit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) - else - result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8); - end; - nkFloat32Lit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) + '''f32' - else begin - f := n.floatVal; - result := litAux(n, ({@cast}PInt32(addr(f)))^, 4) + '''f32' - end; - end; - nkFloat64Lit: begin - if n.flags * [nfBase2, nfBase8, nfBase16] = [] then - result := toStringF(n.floatVal) + '''f64' - else - result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8) + '''f64'; - end; - nkNilLit: result := 'nil'; - nkType: begin - if (n.typ <> nil) and (n.typ.sym <> nil) then result := n.typ.sym.name.s - else result := '[type node]'; - end; - else InternalError('rnimsyn.atom ' + nodeKindToStr[n.kind]); - end -end; - -// --------------------------------------------------------------------------- - -function lcomma(n: PNode; start: int = 0; theEnd: int = -1): int; -var - i: int; -begin - assert(theEnd < 0); - result := 0; - for i := start to sonsLen(n)+theEnd do begin - inc(result, lsub(n.sons[i])); - inc(result, 2); // for ``, `` - end; - if result > 0 then dec(result, 2); // last does not get a comma! -end; - -function lsons(n: PNode; start: int = 0; theEnd: int = -1): int; -var - i: int; -begin - assert(theEnd < 0); - result := 0; - for i := start to sonsLen(n)+theEnd do inc(result, lsub(n.sons[i])); -end; - -function lsub(n: PNode): int; -// computes the length of a tree -var - L: int; -begin - if n = nil then begin result := 0; exit end; - if n.comment <> snil then begin result := maxLineLen+1; exit end; - case n.kind of - nkTripleStrLit: begin - if containsNL(n.strVal) then result := maxLineLen+1 - else result := length(atom(n)); - end; - nkEmpty..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: - result := length(atom(n)); - nkCall, nkBracketExpr, nkConv: result := lsub(n.sons[0])+lcomma(n, 1)+2; - nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: begin - result := lsub(n.sons[1]); - end; - nkCast: result := lsub(n.sons[0])+lsub(n.sons[1])+length('cast[]()'); - nkAddr: result := lsub(n.sons[0])+length('addr()'); - nkHiddenAddr, nkHiddenDeref: result := lsub(n.sons[0]); - nkCommand: result := lsub(n.sons[0])+lcomma(n, 1)+1; - nkExprEqExpr, nkAsgn, nkFastAsgn: result := lsons(n)+3; - nkPar, nkCurly, nkBracket: result := lcomma(n)+2; - nkSymChoice: result := lsons(n) + length('()') + sonsLen(n)-1; - nkTupleTy: result := lcomma(n)+length('tuple[]'); - nkDotExpr: result := lsons(n)+1; - nkBind: result := lsons(n)+length('bind_'); - nkCheckedFieldExpr: result := lsub(n.sons[0]); - nkLambda: result := lsons(n)+length('lambda__=_'); - nkConstDef, nkIdentDefs: begin - result := lcomma(n, 0, -3); - L := sonsLen(n); - if n.sons[L-2] <> nil then - result := result + lsub(n.sons[L-2]) + 2; - if n.sons[L-1] <> nil then - result := result + lsub(n.sons[L-1]) + 3; - end; - nkVarTuple: result := lcomma(n, 0, -3) + length('() = ') + lsub(lastSon(n)); - nkChckRangeF: result := length('chckRangeF') + 2 + lcomma(n); - nkChckRange64: result := length('chckRange64') + 2 + lcomma(n); - nkChckRange: result := length('chckRange') + 2 + lcomma(n); - - nkObjDownConv, nkObjUpConv, - nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin - result := 2; - if sonsLen(n) >= 1 then - result := result + lsub(n.sons[0]); - result := result + lcomma(n, 1); - end; - nkExprColonExpr: result := lsons(n) + 2; - nkInfix: result := lsons(n) + 2; - nkPrefix: result := lsons(n) + 1; - nkPostfix: result := lsons(n); - nkCallStrLit: result := lsons(n); - nkPragmaExpr: result := lsub(n.sons[0])+lcomma(n, 1); - nkRange: result := lsons(n) + 2; - nkDerefExpr: result := lsub(n.sons[0])+2; - nkAccQuoted: result := lsub(n.sons[0]) + 2; - - nkIfExpr: result := lsub(n.sons[0].sons[0])+lsub(n.sons[0].sons[1]) - + lsons(n, 1) + length('if_:_'); - nkElifExpr: result := lsons(n) + length('_elif_:_'); - nkElseExpr: result := lsub(n.sons[0])+ length('_else:_'); - - // type descriptions - nkTypeOfExpr: result := lsub(n.sons[0])+length('type_'); - nkRefTy: result := lsub(n.sons[0])+length('ref_'); - nkPtrTy: result := lsub(n.sons[0])+length('ptr_'); - nkVarTy: result := lsub(n.sons[0])+length('var_'); - nkDistinctTy: result := lsub(n.sons[0])+length('Distinct_'); - nkTypeDef: result := lsons(n)+3; - nkOfInherit: result := lsub(n.sons[0])+length('of_'); - nkProcTy: result := lsons(n)+length('proc_'); - nkEnumTy: result := lsub(n.sons[0])+lcomma(n,1)+length('enum_'); - nkEnumFieldDef: result := lsons(n)+3; - - nkVarSection: if sonsLen(n) > 1 then result := maxLineLen+1 - else result := lsons(n) + length('var_'); - nkReturnStmt: result := lsub(n.sons[0])+length('return_'); - nkRaiseStmt: result := lsub(n.sons[0])+length('raise_'); - nkYieldStmt: result := lsub(n.sons[0])+length('yield_'); - nkDiscardStmt: result := lsub(n.sons[0])+length('discard_'); - nkBreakStmt: result := lsub(n.sons[0])+length('break_'); - nkContinueStmt: result := lsub(n.sons[0])+length('continue_'); - nkPragma: result := lcomma(n) + 4; - nkCommentStmt: result := length(n.comment); - - nkOfBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) - + length('of_:_'); - nkElifBranch: result := lsons(n)+length('elif_:_'); - nkElse: result := lsub(n.sons[0]) + length('else:_'); - nkFinally: result := lsub(n.sons[0]) + length('finally:_'); - nkGenericParams: result := lcomma(n) + 2; - nkFormalParams: begin - result := lcomma(n, 1) + 2; - if n.sons[0] <> nil then result := result + lsub(n.sons[0]) + 2 - end; - nkExceptBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) - + length('except_:_'); - else result := maxLineLen+1 - end -end; - -function fits(const g: TSrcGen; x: int): bool; -begin - result := x + g.lineLen <= maxLineLen -end; - -// ------------------------- render part -------------------------------------- - -type - TSubFlag = (rfLongMode, rfNoIndent, rfInConstExpr); - TSubFlags = set of TSubFlag; - TContext = record{@tuple} - spacing: int; - flags: TSubFlags; - end; - -const - emptyContext: TContext = (spacing: 0; flags: {@set}[]); - -procedure initContext(out c: TContext); -begin - c.spacing := 0; - c.flags := {@set}[]; -end; - -procedure gsub(var g: TSrcGen; n: PNode; const c: TContext); overload; forward; - -procedure gsub(var g: TSrcGen; n: PNode); overload; -var - c: TContext; -begin - initContext(c); - gsub(g, n, c); -end; - -function hasCom(n: PNode): bool; -var - i: int; -begin - result := false; - if n = nil then exit; - if n.comment <> snil then begin result := true; exit end; - case n.kind of - nkEmpty..nkNilLit: begin end; - else begin - for i := 0 to sonsLen(n)-1 do - if hasCom(n.sons[i]) then begin - result := true; exit - end - end - end -end; - -procedure putWithSpace(var g: TSrcGen; kind: TTokType; const s: string); -begin - put(g, kind, s); - put(g, tkSpaces, Space); -end; - -procedure gcommaAux(var g: TSrcGen; n: PNode; ind: int; - start: int = 0; theEnd: int = -1); -var - i, sublen: int; - c: bool; -begin - for i := start to sonsLen(n)+theEnd do begin - c := i < sonsLen(n)+theEnd; - sublen := lsub(n.sons[i])+ord(c); - if not fits(g, sublen) and (ind+sublen < maxLineLen) then optNL(g, ind); - gsub(g, n.sons[i]); - if c then begin - putWithSpace(g, tkComma, ','+''); - if hasCom(n.sons[i]) then begin - gcoms(g); - optNL(g, ind); - end - end - end -end; - -procedure gcomma(var g: TSrcGen; n: PNode; const c: TContext; - start: int = 0; theEnd: int = -1); overload; -var - ind: int; -begin - if rfInConstExpr in c.flags then - ind := g.indent + indentWidth - else begin - ind := g.lineLen; - if ind > maxLineLen div 2 then ind := g.indent + longIndentWid - end; - gcommaAux(g, n, ind, start, theEnd); -end; - -procedure gcomma(var g: TSrcGen; n: PNode; - start: int = 0; theEnd: int = -1); overload; -var - ind: int; -begin - ind := g.lineLen; - if ind > maxLineLen div 2 then ind := g.indent + longIndentWid; - gcommaAux(g, n, ind, start, theEnd); -end; - -procedure gsons(var g: TSrcGen; n: PNode; const c: TContext; - start: int = 0; theEnd: int = -1); -var - i: int; -begin - for i := start to sonsLen(n)+theEnd do begin - gsub(g, n.sons[i], c); - end -end; - -procedure gsection(var g: TSrcGen; n: PNode; const c: TContext; kind: TTokType; - const k: string); -var - i: int; -begin - if sonsLen(n) = 0 then exit; // empty var sections are possible - putWithSpace(g, kind, k); - gcoms(g); - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i], c); - gcoms(g); - end; - dedent(g); -end; - - -function longMode(n: PNode; start: int = 0; theEnd: int = -1): bool; -var - i: int; -begin - result := n.comment <> snil; - if not result then begin - // check further - for i := start to sonsLen(n)+theEnd do begin - if (lsub(n.sons[i]) > maxLineLen) then begin - result := true; break end; - end - end -end; - -procedure gstmts(var g: TSrcGen; n: PNode; const c: TContext); -var - i: int; -begin - if n = nil then exit; - if (n.kind = nkStmtList) or (n.kind = nkStmtListExpr) then begin - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i]); - gcoms(g); - end; - dedent(g); - end - else begin - if rfLongMode in c.flags then indentNL(g); - gsub(g, n); - gcoms(g); - optNL(g); - if rfLongMode in c.flags then dedent(g); - end -end; - -procedure gif(var g: TSrcGen; n: PNode); -var - c: TContext; - i, len: int; -begin - gsub(g, n.sons[0].sons[0]); - initContext(c); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[0].sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[0].sons[1], c); - len := sonsLen(n); - for i := 1 to len-1 do begin - optNL(g); - gsub(g, n.sons[i], c) - end; -end; - -procedure gwhile(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - putWithSpace(g, tkWhile, 'while'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - initContext(c); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[1], c); -end; - -procedure gtry(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - put(g, tkTry, 'try'); - putWithSpace(g, tkColon, ':'+''); - initContext(c); - if longMode(n) or (lsub(n.sons[0])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); // a good place for comments - gstmts(g, n.sons[0], c); - gsons(g, n, c, 1); -end; - -procedure gfor(var g: TSrcGen; n: PNode); -var - c: TContext; - len: int; -begin - len := sonsLen(n); - putWithSpace(g, tkFor, 'for'); - initContext(c); - if longMode(n) - or (lsub(n.sons[len-1]) - + lsub(n.sons[len-2]) + 6 + g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcomma(g, n, c, 0, -3); - put(g, tkSpaces, Space); - putWithSpace(g, tkIn, 'in'); - gsub(g, n.sons[len-2], c); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[len-1], c); -end; - -procedure gmacro(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - initContext(c); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); - gsons(g, n, c, 1); -end; - -procedure gcase(var g: TSrcGen; n: PNode); -var - c: TContext; - len, last: int; -begin - initContext(c); - len := sonsLen(n); - if n.sons[len-1].kind = nkElse then last := -2 - else last := -1; - if longMode(n, 0, last) then include(c.flags, rfLongMode); - putWithSpace(g, tkCase, 'case'); - gsub(g, n.sons[0]); - gcoms(g); - optNL(g); - gsons(g, n, c, 1, last); - if last = -2 then begin - initContext(c); - if longMode(n.sons[len-1]) then include(c.flags, rfLongMode); - gsub(g, n.sons[len-1], c); - end -end; - -procedure gproc(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - gsub(g, n.sons[2]); - gsub(g, n.sons[3]); - if not (renderNoBody in g.flags) then begin - if n.sons[4] <> nil then begin - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - indentNL(g); - gcoms(g); - dedent(g); - initContext(c); - gstmts(g, n.sons[4], c); - putNL(g); - end - else begin - indentNL(g); - gcoms(g); - dedent(g); - end - end; -end; - -procedure gblock(var g: TSrcGen; n: PNode); -var - c: TContext; -begin - initContext(c); - putWithSpace(g, tkBlock, 'block'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - if longMode(n) or (lsub(n.sons[1])+g.lineLen > maxLineLen) then - include(c.flags, rfLongMode); - gcoms(g); - gstmts(g, n.sons[1], c); -end; - -procedure gasm(var g: TSrcGen; n: PNode); -begin - putWithSpace(g, tkAsm, 'asm'); - gsub(g, n.sons[0]); - gcoms(g); - gsub(g, n.sons[1]); -end; - -procedure gident(var g: TSrcGen; n: PNode); -var - s: string; - t: TTokType; -begin - s := atom(n); - if (s[strStart] in scanner.SymChars) then begin - if (n.kind = nkIdent) then begin - if (n.ident.id < ord(tokKeywordLow)-ord(tkSymbol)) or - (n.ident.id > ord(tokKeywordHigh)-ord(tkSymbol)) then - t := tkSymbol - else - t := TTokType(n.ident.id+ord(tkSymbol)) - end - else - t := tkSymbol; - end - else - t := tkOpr; - put(g, t, s); - if (n.kind = nkSym) and (renderIds in g.flags) then - put(g, tkIntLit, toString(n.sym.id)); -end; - -procedure gsub(var g: TSrcGen; n: PNode; const c: TContext); -var - L, i: int; - a: TContext; -begin - if n = nil then exit; - if n.comment <> snil then pushCom(g, n); - case n.kind of - // atoms: - nkTripleStrLit: putRawStr(g, tkTripleStrLit, n.strVal); - nkEmpty, nkType: put(g, tkInvalid, atom(n)); - nkSym, nkIdent: gident(g, n); - nkIntLit: put(g, tkIntLit, atom(n)); - nkInt8Lit: put(g, tkInt8Lit, atom(n)); - nkInt16Lit: put(g, tkInt16Lit, atom(n)); - nkInt32Lit: put(g, tkInt32Lit, atom(n)); - nkInt64Lit: put(g, tkInt64Lit, atom(n)); - nkFloatLit: put(g, tkFloatLit, atom(n)); - nkFloat32Lit: put(g, tkFloat32Lit, atom(n)); - nkFloat64Lit: put(g, tkFloat64Lit, atom(n)); - nkStrLit: put(g, tkStrLit, atom(n)); - nkRStrLit: put(g, tkRStrLit, atom(n)); - nkCharLit: put(g, tkCharLit, atom(n)); - nkNilLit: put(g, tkNil, atom(n)); - // complex expressions - nkCall, nkConv, nkDotCall: begin - if sonsLen(n) >= 1 then - gsub(g, n.sons[0]); - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - end; - nkCallStrLit: begin - gsub(g, n.sons[0]); - if n.sons[1].kind = nkRStrLit then - put(g, tkRStrLit, '"' + n.sons[1].strVal + '"') - else - gsub(g, n.sons[0]); - end; - nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: begin - gsub(g, n.sons[0]); - end; - nkCast: begin - put(g, tkCast, 'cast'); - put(g, tkBracketLe, '['+''); - gsub(g, n.sons[0]); - put(g, tkBracketRi, ']'+''); - put(g, tkParLe, '('+''); - gsub(g, n.sons[1]); - put(g, tkParRi, ')'+''); - end; - nkAddr: begin - put(g, tkAddr, 'addr'); - put(g, tkParLe, '('+''); - gsub(g, n.sons[0]); - put(g, tkParRi, ')'+''); - end; - nkBracketExpr: begin - gsub(g, n.sons[0]); - put(g, tkBracketLe, '['+''); - gcomma(g, n, 1); - put(g, tkBracketRi, ']'+''); - end; - nkPragmaExpr: begin - gsub(g, n.sons[0]); - gcomma(g, n, 1); - end; - nkCommand: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, space); - gcomma(g, n, 1); - end; - nkExprEqExpr, nkAsgn, nkFastAsgn: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[1]); - end; - nkChckRangeF: begin - put(g, tkSymbol, 'chckRangeF'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkChckRange64: begin - put(g, tkSymbol, 'chckRange64'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkChckRange: begin - put(g, tkSymbol, 'chckRange'); - put(g, tkParLe, '('+''); - gcomma(g, n); - put(g, tkParRi, ')'+''); - end; - nkObjDownConv, nkObjUpConv, - nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin - if sonsLen(n) >= 1 then - gsub(g, n.sons[0]); - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - end; - nkSymChoice: begin - put(g, tkParLe, '('+''); - for i := 0 to sonsLen(n)-1 do begin - if i > 0 then put(g, tkOpr, '|'+''); - gsub(g, n.sons[i], c); - end; - put(g, tkParRi, ')'+''); - end; - nkPar: begin - put(g, tkParLe, '('+''); - gcomma(g, n, c); - put(g, tkParRi, ')'+''); - end; - nkCurly: begin - put(g, tkCurlyLe, '{'+''); - gcomma(g, n, c); - put(g, tkCurlyRi, '}'+''); - end; - nkBracket: begin - put(g, tkBracketLe, '['+''); - gcomma(g, n, c); - put(g, tkBracketRi, ']'+''); - end; - nkDotExpr: begin - gsub(g, n.sons[0]); - put(g, tkDot, '.'+''); - gsub(g, n.sons[1]); - end; - nkBind: begin - putWithSpace(g, tkBind, 'bind'); - gsub(g, n.sons[0]); - end; - nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: gsub(g, n.sons[0]); - nkLambda: begin - assert(n.sons[genericParamsPos] = nil); - putWithSpace(g, tkLambda, 'lambda'); - gsub(g, n.sons[paramsPos]); - gsub(g, n.sons[pragmasPos]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[codePos]); - end; - nkConstDef, nkIdentDefs: begin - gcomma(g, n, 0, -3); - L := sonsLen(n); - if n.sons[L-2] <> nil then begin - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[L-2]) - end; - if n.sons[L-1] <> nil then begin - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[L-1], c) - end; - end; - nkVarTuple: begin - put(g, tkParLe, '('+''); - gcomma(g, n, 0, -3); - put(g, tkParRi, ')'+''); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, lastSon(n), c); - end; - nkExprColonExpr: begin - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[1]); - end; - nkInfix: begin - gsub(g, n.sons[1]); - put(g, tkSpaces, Space); - gsub(g, n.sons[0]); // binary operator - if not fits(g, lsub(n.sons[2])+ lsub(n.sons[0]) + 1) then - optNL(g, g.indent+longIndentWid) - else put(g, tkSpaces, Space); - gsub(g, n.sons[2]); - end; - nkPrefix: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, space); - gsub(g, n.sons[1]); - end; - nkPostfix: begin - gsub(g, n.sons[1]); - gsub(g, n.sons[0]); - end; - nkRange: begin - gsub(g, n.sons[0]); - put(g, tkDotDot, '..'); - gsub(g, n.sons[1]); - end; - nkDerefExpr: begin - gsub(g, n.sons[0]); - putWithSpace(g, tkHat, '^'+''); - // unfortunately this requires a space, because ^. would be - // only one operator - end; - nkAccQuoted: begin - put(g, tkAccent, '`'+''); - gsub(g, n.sons[0]); - put(g, tkAccent, '`'+''); - end; - nkIfExpr: begin - putWithSpace(g, tkIf, 'if'); - gsub(g, n.sons[0].sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0].sons[1]); - gsons(g, n, emptyContext, 1); - end; - nkElifExpr: begin - putWithSpace(g, tkElif, ' elif'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[1]); - end; - nkElseExpr: begin - put(g, tkElse, ' else'); - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0]); - end; - - nkTypeOfExpr: begin - putWithSpace(g, tkType, 'type'); - gsub(g, n.sons[0]); - end; - nkRefTy: begin - putWithSpace(g, tkRef, 'ref'); - gsub(g, n.sons[0]); - end; - nkPtrTy: begin - putWithSpace(g, tkPtr, 'ptr'); - gsub(g, n.sons[0]); - end; - nkVarTy: begin - putWithSpace(g, tkVar, 'var'); - gsub(g, n.sons[0]); - end; - nkDistinctTy: begin - putWithSpace(g, tkDistinct, 'distinct'); - gsub(g, n.sons[0]); - end; - nkTypeDef: begin - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - put(g, tkSpaces, Space); - if n.sons[2] <> nil then begin - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[2]); - end - end; - nkObjectTy: begin - putWithSpace(g, tkObject, 'object'); - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - gcoms(g); - gsub(g, n.sons[2]); - end; - nkRecList: begin - indentNL(g); - for i := 0 to sonsLen(n)-1 do begin - optNL(g); - gsub(g, n.sons[i], c); - gcoms(g); - end; - dedent(g); - putNL(g); - end; - nkOfInherit: begin - putWithSpace(g, tkOf, 'of'); - gsub(g, n.sons[0]); - end; - nkProcTy: begin - putWithSpace(g, tkProc, 'proc'); - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - end; - nkEnumTy: begin - putWithSpace(g, tkEnum, 'enum'); - gsub(g, n.sons[0]); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent, 1); - gcoms(g); // BUGFIX: comment for the last enum field - dedent(g); - end; - nkEnumFieldDef: begin - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[1]); - end; - nkStmtList, nkStmtListExpr: gstmts(g, n, emptyContext); - nkIfStmt: begin - putWithSpace(g, tkIf, 'if'); - gif(g, n); - end; - nkWhenStmt, nkRecWhen: begin - putWithSpace(g, tkWhen, 'when'); - gif(g, n); - end; - nkWhileStmt: gwhile(g, n); - nkCaseStmt, nkRecCase: gcase(g, n); - nkMacroStmt: gmacro(g, n); - nkTryStmt: gtry(g, n); - nkForStmt: gfor(g, n); - nkBlockStmt, nkBlockExpr: gblock(g, n); - nkAsmStmt: gasm(g, n); - nkProcDef: begin - putWithSpace(g, tkProc, 'proc'); - gproc(g, n); - end; - nkMethodDef: begin - putWithSpace(g, tkMethod, 'method'); - gproc(g, n); - end; - nkIteratorDef: begin - putWithSpace(g, tkIterator, 'iterator'); - gproc(g, n); - end; - nkMacroDef: begin - putWithSpace(g, tkMacro, 'macro'); - gproc(g, n); - end; - nkTemplateDef: begin - putWithSpace(g, tkTemplate, 'template'); - gproc(g, n); - end; - nkTypeSection: gsection(g, n, emptyContext, tkType, 'type'); - nkConstSection: begin - initContext(a); - include(a.flags, rfInConstExpr); - gsection(g, n, a, tkConst, 'const') - end; - nkVarSection: begin - L := sonsLen(n); - if L = 0 then exit; - putWithSpace(g, tkVar, 'var'); - if L > 1 then begin - gcoms(g); - indentNL(g); - for i := 0 to L-1 do begin - optNL(g); - gsub(g, n.sons[i]); - gcoms(g); - end; - dedent(g); - end - else - gsub(g, n.sons[0]); - end; - nkReturnStmt: begin - putWithSpace(g, tkReturn, 'return'); - gsub(g, n.sons[0]); - end; - nkRaiseStmt: begin - putWithSpace(g, tkRaise, 'raise'); - gsub(g, n.sons[0]); - end; - nkYieldStmt: begin - putWithSpace(g, tkYield, 'yield'); - gsub(g, n.sons[0]); - end; - nkDiscardStmt: begin - putWithSpace(g, tkDiscard, 'discard'); - gsub(g, n.sons[0]); - end; - nkBreakStmt: begin - putWithSpace(g, tkBreak, 'break'); - gsub(g, n.sons[0]); - end; - nkContinueStmt: begin - putWithSpace(g, tkContinue, 'continue'); - gsub(g, n.sons[0]); - end; - nkPragma: begin - if not (renderNoPragmas in g.flags) then begin - put(g, tkCurlyDotLe, '{.'); - gcomma(g, n, emptyContext); - put(g, tkCurlyDotRi, '.}') - end; - end; - nkImportStmt: begin - putWithSpace(g, tkImport, 'import'); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent); - dedent(g); - putNL(g); - end; - nkFromStmt: begin - putWithSpace(g, tkFrom, 'from'); - gsub(g, n.sons[0]); - put(g, tkSpaces, Space); - putWithSpace(g, tkImport, 'import'); - gcomma(g, n, emptyContext, 1); - putNL(g); - end; - nkIncludeStmt: begin - putWithSpace(g, tkInclude, 'include'); - gcoms(g); - indentNL(g); - gcommaAux(g, n, g.indent); - dedent(g); - putNL(g); - end; - nkCommentStmt: begin - gcoms(g); - optNL(g); - end; - nkOfBranch: begin - optNL(g); - putWithSpace(g, tkOf, 'of'); - gcomma(g, n, c, 0, -2); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, lastSon(n), c); - end; - nkElifBranch: begin - optNL(g); - putWithSpace(g, tkElif, 'elif'); - gsub(g, n.sons[0]); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[1], c) - end; - nkElse: begin - optNL(g); - put(g, tkElse, 'else'); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[0], c) - end; - nkFinally: begin - optNL(g); - put(g, tkFinally, 'finally'); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, n.sons[0], c) - end; - nkExceptBranch: begin - optNL(g); - putWithSpace(g, tkExcept, 'except'); - gcomma(g, n, 0, -2); - putWithSpace(g, tkColon, ':'+''); - gcoms(g); - gstmts(g, lastSon(n), c) - end; - nkGenericParams: begin - put(g, tkBracketLe, '['+''); - gcomma(g, n); - put(g, tkBracketRi, ']'+''); - end; - nkFormalParams: begin - put(g, tkParLe, '('+''); - gcomma(g, n, 1); - put(g, tkParRi, ')'+''); - if n.sons[0] <> nil then begin - putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[0]); - end; - // XXX: gcomma(g, n, 1, -2); - end; - nkTupleTy: begin - put(g, tkTuple, 'tuple'); - put(g, tkBracketLe, '['+''); - gcomma(g, n); - put(g, tkBracketRi, ']'+''); - end; - else begin - //nkNone, nkMetaNode, nkTableConstr, nkExplicitTypeListCall: begin - InternalError(n.info, 'rnimsyn.gsub(' +{&} nodeKindToStr[n.kind] +{&} ')') - end - end -end; - -function renderTree(n: PNode; renderFlags: TRenderFlags = {@set}[]): string; -var - g: TSrcGen; -begin - initSrcGen(g, renderFlags); - gsub(g, n); - result := g.buf -end; - -procedure renderModule(n: PNode; const filename: string; - renderFlags: TRenderFlags = {@set}[]); -var - i: int; - f: tTextFile; - g: TSrcGen; -begin - initSrcGen(g, renderFlags); - for i := 0 to sonsLen(n)-1 do begin - gsub(g, n.sons[i]); - optNL(g); - if n.sons[i] <> nil then - case n.sons[i].kind of - nkTypeSection, nkConstSection, nkVarSection, nkCommentStmt: - putNL(g); - else begin end - end - end; - gcoms(g); - if OpenFile(f, filename, fmWrite) then begin - nimWrite(f, g.buf); - nimCloseFile(f); - end; -end; - -procedure initTokRender(var r: TSrcGen; n: PNode; - renderFlags: TRenderFlags = {@set}[]); -begin - initSrcGen(r, renderFlags); - gsub(r, n); -end; - -procedure getNextTok(var r: TSrcGen; var kind: TTokType; var literal: string); -var - len: int; -begin - if r.idx < length(r.tokens) then begin - kind := r.tokens[r.idx].kind; - len := r.tokens[r.idx].len; - literal := ncopy(r.buf, r.pos+strStart, r.pos+strStart+len-1); - inc(r.pos, len); - inc(r.idx); - end - else - kind := tkEof; -end; - -end. diff --git a/nim/rodread.pas b/nim/rodread.pas deleted file mode 100755 index 457ad6cc23..0000000000 --- a/nim/rodread.pas +++ /dev/null @@ -1,1137 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit rodread; - -// This module is responsible for loading of rod files. -(* - Reading and writing binary files are really hard to debug. Therefore we use - a special text format. ROD-files only describe the interface of a module. - Thus they are smaller than the source files most of the time. Even if they - are bigger, they are more efficient to process because symbols are only - loaded on demand. - It consists of: - - - a header: - NIM:$fileversion\n - - the module's id (even if the module changed, its ID will not!): - ID:Ax3\n - - CRC value of this module: - CRC:CRC-val\n - - a section containing the compiler options and defines this - module has been compiled with: - OPTIONS:options\n - DEFINES:defines\n - - FILES( - myfile.inc - lib/mymodA - ) - - a include file dependency section: - INCLUDES( - \n # fileidx is the LINE in the file section! - ) - - a module dependency section: - DEPS: \n - - an interface section: - INTERF( - identifier1 id\n # id is the symbol's id - identifier2 id\n - ) - - a compiler proc section: - COMPILERPROCS( - identifier1 id\n # id is the symbol's id - ) - - an index consisting of (ID, linenumber)-pairs: - INDEX( - id-diff idx-diff\n - id-diff idx-diff\n - ) - - an import index consisting of (ID, moduleID)-pairs: - IMPORTS( - id-diff moduleID-diff\n - id-diff moduleID-diff\n - ) - - a list of all exported type converters because they are needed for correct - semantic checking: - CONVERTERS:id id\n # position of the symbol in the DATA section - - an AST section that contains the module's AST: - INIT( - idx\n # position of the node in the DATA section - idx\n - ) - - a data section, where each type, symbol or AST is stored. - DATA( - type - (node) - sym - ) - - We now also do index compression, because an index always needs to be read. -*) - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, nos, options, strutils, nversion, ast, astalgo, msgs, - platform, condsyms, ropes, idents, crc; - -type - TReasonForRecompile = ( - rrEmpty, // used by moddeps module - rrNone, // no need to recompile - rrRodDoesNotExist, // rod file does not exist - rrRodInvalid, // rod file is invalid - rrCrcChange, // file has been edited since last recompilation - rrDefines, // defines have changed - rrOptions, // options have changed - rrInclDeps, // an include has changed - rrModDeps // a module this module depends on has been changed - ); -const - reasonToFrmt: array [TReasonForRecompile] of string = ( - '', - 'no need to recompile: $1', - 'symbol file for $1 does not exist', - 'symbol file for $1 has the wrong version', - 'file edited since last compilation: $1', - 'list of conditional symbols changed for: $1', - 'list of options changed for: $1', - 'an include file edited: $1', - 'a module $1 depends on has changed' - ); - -type - TIndex = record // an index with compression - lastIdxKey, lastIdxVal: int; - tab: TIITable; - r: PRope; // writers use this - offset: int; // readers use this - end; - TRodReader = object(NObject) - pos: int; // position; used for parsing - s: string; // the whole file in memory - options: TOptions; - reason: TReasonForRecompile; - modDeps: TStringSeq; - files: TStringSeq; - dataIdx: int; // offset of start of data section - convertersIdx: int; // offset of start of converters section - initIdx, interfIdx, compilerProcsIdx, cgenIdx: int; - filename: string; - index, imports: TIndex; - readerIndex: int; - line: int; // only used for debugging, but is always in the code - moduleID: int; - syms: TIdTable; // already processed symbols - end; - PRodReader = ^TRodReader; - -const - FileVersion = '1012'; // modify this if the rod-format changes! - -var - rodCompilerprocs: TStrTable; // global because this is needed by magicsys - - -function handleSymbolFile(module: PSym; const filename: string): PRodReader; -function GetCRC(const filename: string): TCrc32; - -function loadInitSection(r: PRodReader): PNode; - -procedure loadStub(s: PSym); - -function encodeInt(x: BiggestInt): PRope; -function encode(const s: string): PRope; - -implementation - -var - gTypeTable: TIdTable; - -function rrGetSym(r: PRodReader; id: int; const info: TLineInfo): PSym; forward; - // `info` is only used for debugging purposes - -function rrGetType(r: PRodReader; id: int; const info: TLineInfo): PType; forward; - -function decode(r: PRodReader): string; forward; -function decodeInt(r: PRodReader): int; forward; -function decodeBInt(r: PRodReader): biggestInt; forward; - -function encode(const s: string): PRope; -var - i: int; - res: string; -begin - res := ''; - for i := strStart to length(s)+strStart-1 do begin - case s[i] of - 'a'..'z', 'A'..'Z', '0'..'9', '_': - addChar(res, s[i]); - else - res := res +{&} '\' +{&} toHex(ord(s[i]), 2) - end - end; - result := toRope(res); -end; - -procedure encodeIntAux(var str: string; x: BiggestInt); -const - chars: string = - '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; -var - v, rem: biggestInt; - d: char; - idx: int; -begin - v := x; - rem := v mod 190; - if (rem < 0) then begin - str := str + '-'; - v := -(v div 190); - rem := -rem; - end - else - v := v div 190; - idx := int(rem); - if idx < 62 then d := chars[idx+strStart] - else d := chr(idx - 62 + 128); - if (v <> 0) then encodeIntAux(str, v); - addChar(str, d); -end; - -function encodeInt(x: BiggestInt): PRope; -var - res: string; -begin - res := ''; - encodeIntAux(res, x); - result := toRope(res); -end; - - -procedure decodeLineInfo(r: PRodReader; var info: TLineInfo); -begin - if r.s[r.pos] = '?' then begin - inc(r.pos); - if r.s[r.pos] = ',' then - info.col := int16(-1) - else - info.col := int16(decodeInt(r)); - if r.s[r.pos] = ',' then begin - inc(r.pos); - if r.s[r.pos] = ',' then info.line := int16(-1) - else info.line := int16(decodeInt(r)); - if r.s[r.pos] = ',' then begin - inc(r.pos); - info := newLineInfo(r.files[decodeInt(r)], info.line, info.col); - end - end - end -end; - -function decodeNode(r: PRodReader; const fInfo: TLineInfo): PNode; -var - id: int; - fl: string; -begin - result := nil; - if r.s[r.pos] = '(' then begin - inc(r.pos); - if r.s[r.pos] = ')' then begin - inc(r.pos); exit; // nil node - end; - result := newNodeI(TNodeKind(decodeInt(r)), fInfo); - decodeLineInfo(r, result.info); - if r.s[r.pos] = '$' then begin - inc(r.pos); - result.flags := {@cast}TNodeFlags(int32(decodeInt(r))); - end; - if r.s[r.pos] = '^' then begin - inc(r.pos); - id := decodeInt(r); - result.typ := rrGetType(r, id, result.info); - end; - case result.kind of - nkCharLit..nkInt64Lit: begin - if r.s[r.pos] = '!' then begin - inc(r.pos); - result.intVal := decodeBInt(r); - end - end; - nkFloatLit..nkFloat64Lit: begin - if r.s[r.pos] = '!' then begin - inc(r.pos); - fl := decode(r); - result.floatVal := parseFloat(fl); - end - end; - nkStrLit..nkTripleStrLit: begin - if r.s[r.pos] = '!' then begin - inc(r.pos); - result.strVal := decode(r); - end - else - result.strVal := ''; // BUGFIX - end; - nkIdent: begin - if r.s[r.pos] = '!' then begin - inc(r.pos); - fl := decode(r); - result.ident := getIdent(fl); - end - else - internalError(result.info, 'decodeNode: nkIdent'); - end; - nkSym: begin - if r.s[r.pos] = '!' then begin - inc(r.pos); - id := decodeInt(r); - result.sym := rrGetSym(r, id, result.info); - end - else - internalError(result.info, 'decodeNode: nkSym'); - end; - else begin - while r.s[r.pos] <> ')' do - addSon(result, decodeNode(r, result.info)); - end - end; - if r.s[r.pos] = ')' then inc(r.pos) - else internalError(result.info, 'decodeNode'); - end - else InternalError(result.info, 'decodeNode ' + r.s[r.pos]) -end; - -procedure decodeLoc(r: PRodReader; var loc: TLoc; const info: TLineInfo); -begin - if r.s[r.pos] = '<' then begin - inc(r.pos); - if r.s[r.pos] in ['0'..'9', 'a'..'z', 'A'..'Z'] then - loc.k := TLocKind(decodeInt(r)) - else - loc.k := low(loc.k); - if r.s[r.pos] = '*' then begin - inc(r.pos); - loc.s := TStorageLoc(decodeInt(r)); - end - else - loc.s := low(loc.s); - if r.s[r.pos] = '$' then begin - inc(r.pos); - loc.flags := {@cast}TLocFlags(int32(decodeInt(r))); - end - else - loc.flags := {@set}[]; - if r.s[r.pos] = '^' then begin - inc(r.pos); - loc.t := rrGetType(r, decodeInt(r), info); - end - else - loc.t := nil; - if r.s[r.pos] = '!' then begin - inc(r.pos); - loc.r := toRope(decode(r)); - end - else - loc.r := nil; - if r.s[r.pos] = '?' then begin - inc(r.pos); - loc.a := decodeInt(r); - end - else - loc.a := 0; - if r.s[r.pos] = '>' then inc(r.pos) - else InternalError(info, 'decodeLoc ' + r.s[r.pos]); - end -end; - -function decodeType(r: PRodReader; const info: TLineInfo): PType; -var - d: int; -begin - result := nil; - if r.s[r.pos] = '[' then begin - inc(r.pos); - if r.s[r.pos] = ']' then begin - inc(r.pos); exit; // nil type - end; - end; - new(result); -{@ignore} - FillChar(result^, sizeof(result^), 0); -{@emit} - result.kind := TTypeKind(decodeInt(r)); - if r.s[r.pos] = '+' then begin - inc(r.pos); - result.id := decodeInt(r); - setId(result.id); - if debugIds then registerID(result); - end - else - InternalError(info, 'decodeType: no id'); - IdTablePut(gTypeTable, result, result); // here this also - // avoids endless recursion for recursive type - if r.s[r.pos] = '(' then - result.n := decodeNode(r, UnknownLineInfo()); - if r.s[r.pos] = '$' then begin - inc(r.pos); - result.flags := {@cast}TTypeFlags(int32(decodeInt(r))); - end; - if r.s[r.pos] = '?' then begin - inc(r.pos); - result.callConv := TCallingConvention(decodeInt(r)); - end; - if r.s[r.pos] = '*' then begin - inc(r.pos); - result.owner := rrGetSym(r, decodeInt(r), info); - end; - if r.s[r.pos] = '&' then begin - inc(r.pos); - result.sym := rrGetSym(r, decodeInt(r), info); - end; - if r.s[r.pos] = '/' then begin - inc(r.pos); - result.size := decodeInt(r); - end - else result.size := -1; - if r.s[r.pos] = '=' then begin - inc(r.pos); - result.align := decodeInt(r); - end - else result.align := 2; - if r.s[r.pos] = '@' then begin - inc(r.pos); - result.containerID := decodeInt(r); - end; - decodeLoc(r, result.loc, info); - while r.s[r.pos] = '^' do begin - inc(r.pos); - if r.s[r.pos] = '(' then begin - inc(r.pos); - if r.s[r.pos] = ')' then inc(r.pos) - else InternalError(info, 'decodeType ^(' + r.s[r.pos]); - addSon(result, nil); - end - else begin - d := decodeInt(r); - addSon(result, rrGetType(r, d, info)); - end; - end -end; - -function decodeLib(r: PRodReader): PLib; -begin - result := nil; - if r.s[r.pos] = '|' then begin - new(result); - {@ignore} - fillChar(result^, sizeof(result^), 0); - {@emit} - inc(r.pos); - result.kind := TLibKind(decodeInt(r)); - if r.s[r.pos] <> '|' then InternalError('decodeLib: 1'); - inc(r.pos); - result.name := toRope(decode(r)); - if r.s[r.pos] <> '|' then InternalError('decodeLib: 2'); - inc(r.pos); - result.path := decode(r); - end -end; - -function decodeSym(r: PRodReader; const info: TLineInfo): PSym; -var - k: TSymKind; - id: int; - ident: PIdent; -begin - result := nil; - if r.s[r.pos] = '{' then begin - inc(r.pos); - if r.s[r.pos] = '}' then begin - inc(r.pos); exit; // nil sym - end - end; - k := TSymKind(decodeInt(r)); - if r.s[r.pos] = '+' then begin - inc(r.pos); - id := decodeInt(r); - setId(id); - end - else - InternalError(info, 'decodeSym: no id'); - if r.s[r.pos] = '&' then begin - inc(r.pos); - ident := getIdent(decode(r)); - end - else - InternalError(info, 'decodeSym: no ident'); - result := PSym(IdTableGet(r.syms, id)); - if result = nil then begin - new(result); - {@ignore} - FillChar(result^, sizeof(result^), 0); - {@emit} - result.id := id; - IdTablePut(r.syms, result, result); - if debugIds then registerID(result); - end - else if (result.id <> id) then - InternalError(info, 'decodeSym: wrong id'); - result.kind := k; - result.name := ident; - // read the rest of the symbol description: - if r.s[r.pos] = '^' then begin - inc(r.pos); - result.typ := rrGetType(r, decodeInt(r), info); - end; - decodeLineInfo(r, result.info); - if r.s[r.pos] = '*' then begin - inc(r.pos); - result.owner := rrGetSym(r, decodeInt(r), result.info); - end; - if r.s[r.pos] = '$' then begin - inc(r.pos); - result.flags := {@cast}TSymFlags(int32(decodeInt(r))); - end; - if r.s[r.pos] = '@' then begin - inc(r.pos); - result.magic := TMagic(decodeInt(r)); - end; - if r.s[r.pos] = '(' then - result.ast := decodeNode(r, result.info); - if r.s[r.pos] = '!' then begin - inc(r.pos); - result.options := {@cast}TOptions(int32(decodeInt(r))); - end - else - result.options := r.options; - if r.s[r.pos] = '%' then begin - inc(r.pos); - result.position := decodeInt(r); - end - else - result.position := 0; // BUGFIX: this may have been misused as reader index! - if r.s[r.pos] = '`' then begin - inc(r.pos); - result.offset := decodeInt(r); - end - else - result.offset := -1; - decodeLoc(r, result.loc, result.info); - result.annex := decodeLib(r); -end; - -function decodeInt(r: PRodReader): int; // base 190 numbers -var - i: int; - sign: int; -begin - i := r.pos; - sign := -1; - assert(r.s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-', #128..#255]); - if r.s[i] = '-' then begin - inc(i); - sign := 1 - end; - result := 0; - while true do begin - case r.s[i] of - '0'..'9': result := result * 190 - (ord(r.s[i]) - ord('0')); - 'a'..'z': result := result * 190 - (ord(r.s[i]) - ord('a') + 10); - 'A'..'Z': result := result * 190 - (ord(r.s[i]) - ord('A') + 36); - #128..#255: result := result * 190 - (ord(r.s[i]) - 128 + 62); - else break; - end; - inc(i) - end; - result := result * sign; - r.pos := i -end; - -function decodeBInt(r: PRodReader): biggestInt; -var - i: int; - sign: biggestInt; -begin - i := r.pos; - sign := -1; - assert(r.s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-', #128..#255]); - if r.s[i] = '-' then begin - inc(i); - sign := 1 - end; - result := 0; - while true do begin - case r.s[i] of - '0'..'9': result := result * 190 - (ord(r.s[i]) - ord('0')); - 'a'..'z': result := result * 190 - (ord(r.s[i]) - ord('a') + 10); - 'A'..'Z': result := result * 190 - (ord(r.s[i]) - ord('A') + 36); - #128..#255: result := result * 190 - (ord(r.s[i]) - 128 + 62); - else break; - end; - inc(i) - end; - result := result * sign; - r.pos := i -end; - -procedure hexChar(c: char; var xi: int); -begin - case c of - '0'..'9': xi := (xi shl 4) or (ord(c) - ord('0')); - 'a'..'f': xi := (xi shl 4) or (ord(c) - ord('a') + 10); - 'A'..'F': xi := (xi shl 4) or (ord(c) - ord('A') + 10); - else begin end - end -end; - -function decode(r: PRodReader): string; -var - i, xi: int; -begin - i := r.pos; - result := ''; - while true do begin - case r.s[i] of - '\': begin - inc(i, 3); xi := 0; - hexChar(r.s[i-2], xi); - hexChar(r.s[i-1], xi); - addChar(result, chr(xi)); - end; - 'a'..'z', 'A'..'Z', '0'..'9', '_': begin - addChar(result, r.s[i]); - inc(i); - end - else break - end - end; - r.pos := i; -end; - -procedure skipSection(r: PRodReader); -var - c: int; -begin - if r.s[r.pos] = ':' then begin - while r.s[r.pos] > #10 do inc(r.pos); - end - else if r.s[r.pos] = '(' then begin - c := 0; // count () pairs - inc(r.pos); - while true do begin - case r.s[r.pos] of - #10: inc(r.line); - '(': inc(c); - ')': begin - if c = 0 then begin inc(r.pos); break end - else if c > 0 then dec(c); - end; - #0: break; // end of file - else begin end; - end; - inc(r.pos); - end - end - else - InternalError('skipSection ' + toString(r.line)); -end; - -function rdWord(r: PRodReader): string; -begin - result := ''; - while r.s[r.pos] in ['A'..'Z', '_', 'a'..'z', '0'..'9'] do begin - addChar(result, r.s[r.pos]); - inc(r.pos); - end; -end; - -function newStub(r: PRodReader; const name: string; id: int): PSym; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.kind := skStub; - result.id := id; - result.name := getIdent(name); - result.position := r.readerIndex; - setID(id); - //MessageOut(result.name.s); - if debugIds then registerID(result); -end; - -procedure processInterf(r: PRodReader; module: PSym); -var - s: PSym; - w: string; - key: int; -begin - if r.interfIdx = 0 then InternalError('processInterf'); - r.pos := r.interfIdx; - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - w := decode(r); - inc(r.pos); - key := decodeInt(r); - inc(r.pos); // #10 - s := newStub(r, w, key); - s.owner := module; - StrTableAdd(module.tab, s); - IdTablePut(r.syms, s, s); - end; -end; - -procedure processCompilerProcs(r: PRodReader; module: PSym); -var - s: PSym; - w: string; - key: int; -begin - if r.compilerProcsIdx = 0 then InternalError('processCompilerProcs'); - r.pos := r.compilerProcsIdx; - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - w := decode(r); - inc(r.pos); - key := decodeInt(r); - inc(r.pos); // #10 - s := PSym(IdTableGet(r.syms, key)); - if s = nil then begin - s := newStub(r, w, key); - s.owner := module; - IdTablePut(r.syms, s, s); - end; - StrTableAdd(rodCompilerProcs, s); - end; -end; - -procedure processIndex(r: PRodReader; var idx: TIndex); -var - key, val, tmp: int; -begin - inc(r.pos, 2); // skip "(\10" - inc(r.line); - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - tmp := decodeInt(r); - if r.s[r.pos] = ' ' then begin - inc(r.pos); - key := idx.lastIdxKey + tmp; - val := decodeInt(r) + idx.lastIdxVal; - end - else begin - key := idx.lastIdxKey + 1; - val := tmp + idx.lastIdxVal; - end; - IITablePut(idx.tab, key, val); - idx.lastIdxKey := key; - idx.lastIdxVal := val; - setID(key); // ensure that this id will not be used - if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; - end; - if r.s[r.pos] = ')' then inc(r.pos); -end; - -procedure processRodFile(r: PRodReader; crc: TCrc32); -var - section, w: string; - d, L, inclCrc: int; -begin - while r.s[r.pos] <> #0 do begin - section := rdWord(r); - if r.reason <> rrNone then break; // no need to process this file further - if section = 'CRC' then begin - inc(r.pos); // skip ':' - if int(crc) <> decodeInt(r) then - r.reason := rrCrcChange - end - else if section = 'ID' then begin - inc(r.pos); // skip ':' - r.moduleID := decodeInt(r); - setID(r.moduleID); - end - else if section = 'OPTIONS' then begin - inc(r.pos); // skip ':' - r.options := {@cast}TOptions(int32(decodeInt(r))); - if options.gOptions <> r.options then r.reason := rrOptions - end - else if section = 'DEFINES' then begin - inc(r.pos); // skip ':' - d := 0; - while r.s[r.pos] > #10 do begin - w := decode(r); - inc(d); - if not condsyms.isDefined(getIdent(w)) then begin - r.reason := rrDefines; - //MessageOut('not defined, but should: ' + w); - end; - if r.s[r.pos] = ' ' then inc(r.pos); - end; - if (d <> countDefinedSymbols()) then - r.reason := rrDefines - end - else if section = 'FILES' then begin - inc(r.pos, 2); // skip "(\10" - inc(r.line); - L := 0; - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - setLength(r.files, L+1); - r.files[L] := decode(r); - inc(r.pos); // skip #10 - inc(r.line); - inc(L); - end; - if r.s[r.pos] = ')' then inc(r.pos); - end - else if section = 'INCLUDES' then begin - inc(r.pos, 2); // skip "(\10" - inc(r.line); - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - w := r.files[decodeInt(r)]; - inc(r.pos); // skip ' ' - inclCrc := decodeInt(r); - if r.reason = rrNone then begin - if not ExistsFile(w) or (inclCrc <> int(crcFromFile(w))) then - r.reason := rrInclDeps - end; - if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; - end; - if r.s[r.pos] = ')' then inc(r.pos); - end - else if section = 'DEPS' then begin - inc(r.pos); // skip ':' - L := 0; - while (r.s[r.pos] > #10) do begin - setLength(r.modDeps, L+1); - r.modDeps[L] := r.files[decodeInt(r)]; - inc(L); - if r.s[r.pos] = ' ' then inc(r.pos); - end; - end - else if section = 'INTERF' then begin - r.interfIdx := r.pos+2; - skipSection(r); - end - else if section = 'COMPILERPROCS' then begin - r.compilerProcsIdx := r.pos+2; - skipSection(r); - end - else if section = 'INDEX' then begin - processIndex(r, r.index); - end - else if section = 'IMPORTS' then begin - processIndex(r, r.imports); - end - else if section = 'CONVERTERS' then begin - r.convertersIdx := r.pos+1; - skipSection(r); - end - else if section = 'DATA' then begin - r.dataIdx := r.pos+2; // "(\10" - // We do not read the DATA section here! We read the needed objects on - // demand. - skipSection(r); - end - else if section = 'INIT' then begin - r.initIdx := r.pos+2; // "(\10" - skipSection(r); - end - else if section = 'CGEN' then begin - r.cgenIdx := r.pos+2; - skipSection(r); - end - else begin - MessageOut('skipping section: ' + toString(r.pos)); - skipSection(r); - end; - if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; - end -end; - -function newRodReader(const modfilename: string; crc: TCrc32; - readerIndex: int): PRodReader; -var - version: string; - r: PRodReader; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit result.files := @[];} -{@emit result.modDeps := @[];} - r := result; - r.reason := rrNone; - r.pos := strStart; - r.line := 1; - r.readerIndex := readerIndex; - r.filename := modfilename; - InitIdTable(r.syms); - r.s := readFile(modfilename) {@ignore} + #0 {@emit}; - if startsWith(r.s, 'NIM:') then begin - initIITable(r.index.tab); - initIITable(r.imports.tab); - // looks like a ROD file - inc(r.pos, 4); - version := ''; - while not (r.s[r.pos] in [#0,#10]) do begin - addChar(version, r.s[r.pos]); - inc(r.pos); - end; - if r.s[r.pos] = #10 then inc(r.pos); - if version = FileVersion then begin - // since ROD files are only for caching, no backwarts compability is - // needed - processRodFile(r, crc); - end - else - result := nil - end - else - result := nil; -end; - -function rrGetType(r: PRodReader; id: int; const info: TLineInfo): PType; -var - oldPos, d: int; -begin - result := PType(IdTableGet(gTypeTable, id)); - if result = nil then begin - // load the type: - oldPos := r.pos; - d := IITableGet(r.index.tab, id); - if d = invalidKey then InternalError(info, 'rrGetType'); - r.pos := d + r.dataIdx; - result := decodeType(r, info); - r.pos := oldPos; - end; -end; - -type - TFileModuleRec = record - filename: string; - reason: TReasonForRecompile; - rd: PRodReader; - crc: TCrc32; - end; - TFileModuleMap = array of TFileModuleRec; -var - gMods: TFileModuleMap = {@ignore} nil {@emit @[]}; // all compiled modules - -function decodeSymSafePos(rd: PRodReader; offset: int; - const info: TLineInfo): PSym; -var - oldPos: int; -begin - if rd.dataIdx = 0 then InternalError(info, 'dataIdx == 0'); - oldPos := rd.pos; - rd.pos := offset + rd.dataIdx; - result := decodeSym(rd, info); - rd.pos := oldPos; -end; - -function rrGetSym(r: PRodReader; id: int; const info: TLineInfo): PSym; -var - d, i, moduleID: int; - rd: PRodReader; -begin - result := PSym(IdTableGet(r.syms, id)); - if result = nil then begin - // load the symbol: - d := IITableGet(r.index.tab, id); - if d = invalidKey then begin - moduleID := IiTableGet(r.imports.tab, id); - if moduleID < 0 then - InternalError(info, - 'missing from both indexes: +' + ropeToStr(encodeInt(id))); - // find the reader with the correct moduleID: - for i := 0 to high(gMods) do begin - rd := gMods[i].rd; - if (rd <> nil) then begin - if (rd.moduleID = moduleID) then begin - d := IITableGet(rd.index.tab, id); - if d <> invalidKey then begin - result := decodeSymSafePos(rd, d, info); - break - end - else - InternalError(info, - 'rrGetSym: no reader found: +' + ropeToStr(encodeInt(id))); - end - else begin - //if IiTableGet(rd.index.tab, id) <> invalidKey then - // XXX expensive check! - //InternalError(info, - //'id found in other module: +' + ropeToStr(encodeInt(id))) - end - end - end; - end - else begin - // own symbol: - result := decodeSymSafePos(r, d, info); - end; - end; - if (result <> nil) and (result.kind = skStub) then loadStub(result); -end; - -function loadInitSection(r: PRodReader): PNode; -var - d, oldPos, p: int; -begin - if (r.initIdx = 0) or (r.dataIdx = 0) then InternalError('loadInitSection'); - oldPos := r.pos; - r.pos := r.initIdx; - result := newNode(nkStmtList); - while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin - d := decodeInt(r); - inc(r.pos); // #10 - p := r.pos; - r.pos := d + r.dataIdx; - addSon(result, decodeNode(r, UnknownLineInfo())); - r.pos := p; - end; - r.pos := oldPos; -end; - -procedure loadConverters(r: PRodReader); -var - d: int; -begin - // We have to ensure that no exported converter is a stub anymore. - if (r.convertersIdx = 0) or (r.dataIdx = 0) then - InternalError('importConverters'); - r.pos := r.convertersIdx; - while (r.s[r.pos] > #10) do begin - d := decodeInt(r); - {@discard} rrGetSym(r, d, UnknownLineInfo()); - if r.s[r.pos] = ' ' then inc(r.pos) - end; -end; - -function getModuleIdx(const filename: string): int; -var - i: int; -begin - for i := 0 to high(gMods) do - if sameFile(gMods[i].filename, filename) then begin - result := i; exit - end; - // not found, reserve space: - result := length(gMods); - setLength(gMods, result+1); -end; - -function checkDep(const filename: string): TReasonForRecompile; -var - crc: TCrc32; - r: PRodReader; - rodfile: string; - idx, i: int; - res: TReasonForRecompile; -begin - idx := getModuleIdx(filename); - if gMods[idx].reason <> rrEmpty then begin - // reason has already been computed for this module: - result := gMods[idx].reason; exit - end; - crc := crcFromFile(filename); - gMods[idx].reason := rrNone; // we need to set it here to avoid cycles - gMods[idx].filename := filename; - gMods[idx].crc := crc; - result := rrNone; - r := nil; - rodfile := toGeneratedFile(filename, RodExt); - if ExistsFile(rodfile) then begin - r := newRodReader(rodfile, crc, idx); - if r = nil then - result := rrRodInvalid - else begin - result := r.reason; - if result = rrNone then begin - // check modules it depends on - // NOTE: we need to process the entire module graph so that no ID will - // be used twice! However, compilation speed does not suffer much from - // this, since results are cached. - res := checkDep(JoinPath(options.libpath, addFileExt('system', nimExt))); - if res <> rrNone then result := rrModDeps; - for i := 0 to high(r.modDeps) do begin - res := checkDep(r.modDeps[i]); - if res <> rrNone then begin - result := rrModDeps; - //break // BUGFIX: cannot break here! - end - end - end - end - end - else - result := rrRodDoesNotExist; - if (result <> rrNone) and (gVerbosity > 0) then - MessageOut(format(reasonToFrmt[result], [filename])); - if (result <> rrNone) or (optForceFullMake in gGlobalOptions) then begin - // recompilation is necessary: - r := nil; - end; - gMods[idx].rd := r; - gMods[idx].reason := result; // now we know better -end; - -function handleSymbolFile(module: PSym; const filename: string): PRodReader; -var - idx: int; -begin - if not (optSymbolFiles in gGlobalOptions) then begin - module.id := getID(); - result := nil; - exit - end; - {@discard} checkDep(filename); - idx := getModuleIdx(filename); - if gMods[idx].reason = rrEmpty then InternalError('handleSymbolFile'); - result := gMods[idx].rd; - if result <> nil then begin - module.id := result.moduleID; - IdTablePut(result.syms, module, module); - processInterf(result, module); - processCompilerProcs(result, module); - loadConverters(result); - end - else - module.id := getID(); -end; - -function GetCRC(const filename: string): TCrc32; -var - idx: int; -begin - idx := getModuleIdx(filename); - result := gMods[idx].crc; -end; - -procedure loadStub(s: PSym); -var - rd: PRodReader; - d, theId: int; - rs: PSym; -begin - if s.kind <> skStub then InternalError('loadStub'); - //MessageOut('loading stub: ' + s.name.s); - rd := gMods[s.position].rd; - theId := s.id; // used for later check - d := IITableGet(rd.index.tab, s.id); - if d = invalidKey then InternalError('loadStub: invalid key'); - rs := decodeSymSafePos(rd, d, UnknownLineInfo()); - if rs <> s then InternalError(rs.info, 'loadStub: wrong symbol') - else if rs.id <> theId then InternalError(rs.info, 'loadStub: wrong ID'); - //MessageOut('loaded stub: ' + s.name.s); -end; - -initialization - InitIdTable(gTypeTable); - InitStrTable(rodCompilerProcs); -end. diff --git a/nim/rodwrite.pas b/nim/rodwrite.pas deleted file mode 100755 index c71eda7e3d..0000000000 --- a/nim/rodwrite.pas +++ /dev/null @@ -1,612 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit rodwrite; - -// This module is responsible for writing of rod files. Note that writing of -// rod files is a pass, reading of rod files is not! This is why reading and -// writing of rod files is split into two different modules. - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, nos, options, strutils, nversion, ast, astalgo, msgs, - platform, condsyms, ropes, idents, crc, rodread, passes, importer; - -function rodwritePass(): TPass; - -implementation - -type - TRodWriter = object(TPassContext) - module: PSym; - crc: TCrc32; - options: TOptions; - defines: PRope; - inclDeps: PRope; - modDeps: PRope; - interf: PRope; - compilerProcs: PRope; - index, imports: TIndex; - converters: PRope; - init: PRope; - data: PRope; - filename: string; - sstack: TSymSeq; // a stack of symbols to process - tstack: TTypeSeq; // a stack of types to process - files: TStringSeq; - end; - PRodWriter = ^TRodWriter; - -function newRodWriter(const modfilename: string; crc: TCrc32; - module: PSym): PRodWriter; forward; -procedure addModDep(w: PRodWriter; const dep: string); forward; -procedure addInclDep(w: PRodWriter; const dep: string); forward; -procedure addInterfaceSym(w: PRodWriter; s: PSym); forward; -procedure addStmt(w: PRodWriter; n: PNode); forward; -procedure writeRod(w: PRodWriter); forward; - -function encodeStr(w: PRodWriter; const s: string): PRope; -begin - result := encode(s) -end; - -procedure processStacks(w: PRodWriter); forward; - -function getDefines: PRope; -var - it: TTabIter; - s: PSym; -begin - s := InitTabIter(it, gSymbols); - result := nil; - while s <> nil do begin - if s.position = 1 then begin - if result <> nil then app(result, ' '+''); - app(result, s.name.s); - end; - s := nextIter(it, gSymbols); - end -end; - -function fileIdx(w: PRodWriter; const filename: string): int; -var - i: int; -begin - for i := 0 to high(w.files) do begin - if w.files[i] = filename then begin result := i; exit end; - end; - result := length(w.files); - setLength(w.files, result+1); - w.files[result] := filename; -end; - -function newRodWriter(const modfilename: string; crc: TCrc32; - module: PSym): PRodWriter; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit - result.sstack := @[];} -{@emit - result.tstack := @[];} - InitIITable(result.index.tab); - InitIITable(result.imports.tab); - result.filename := modfilename; - result.crc := crc; - result.module := module; - result.defines := getDefines(); - result.options := options.gOptions; - {@emit result.files := @[];} -end; - -procedure addModDep(w: PRodWriter; const dep: string); -begin - if w.modDeps <> nil then app(w.modDeps, ' '+''); - app(w.modDeps, encodeInt(fileIdx(w, dep))); -end; - -const - rodNL = #10+''; - -procedure addInclDep(w: PRodWriter; const dep: string); -begin - app(w.inclDeps, encodeInt(fileIdx(w, dep))); - app(w.inclDeps, ' '+''); - app(w.inclDeps, encodeInt(crcFromFile(dep))); - app(w.inclDeps, rodNL); -end; - -procedure pushType(w: PRodWriter; t: PType); -var - L: int; -begin - // check so that the stack does not grow too large: - if IiTableGet(w.index.tab, t.id) = invalidKey then begin - L := length(w.tstack); - setLength(w.tstack, L+1); - w.tstack[L] := t; - end -end; - -procedure pushSym(w: PRodWriter; s: PSym); -var - L: int; -begin - // check so that the stack does not grow too large: - if IiTableGet(w.index.tab, s.id) = invalidKey then begin - L := length(w.sstack); - setLength(w.sstack, L+1); - w.sstack[L] := s; - end -end; - -function encodeNode(w: PRodWriter; const fInfo: TLineInfo; n: PNode): PRope; -var - i: int; - f: TNodeFlags; -begin - if n = nil then begin - // nil nodes have to be stored too: - result := toRope('()'); exit - end; - result := toRope('('+''); - app(result, encodeInt(ord(n.kind))); - // we do not write comments for now - // Line information takes easily 20% or more of the filesize! Therefore we - // omit line information if it is the same as the father's line information: - if (finfo.fileIndex <> n.info.fileIndex) then - appf(result, '?$1,$2,$3', [encodeInt(n.info.col), encodeInt(n.info.line), - encodeInt(fileIdx(w, toFilename(n.info)))]) - else if (finfo.line <> n.info.line) then - appf(result, '?$1,$2', [encodeInt(n.info.col), encodeInt(n.info.line)]) - else if (finfo.col <> n.info.col) then - appf(result, '?$1', [encodeInt(n.info.col)]); - // No need to output the file index, as this is the serialization of one - // file. - f := n.flags * PersistentNodeFlags; - if f <> {@set}[] then - appf(result, '$$$1', [encodeInt({@cast}int32(f))]); - if n.typ <> nil then begin - appf(result, '^$1', [encodeInt(n.typ.id)]); - pushType(w, n.typ); - end; - case n.kind of - nkCharLit..nkInt64Lit: begin - if n.intVal <> 0 then - appf(result, '!$1', [encodeInt(n.intVal)]); - end; - nkFloatLit..nkFloat64Lit: begin - if n.floatVal <> 0.0 then - appf(result, '!$1', [encodeStr(w, toStringF(n.floatVal))]); - end; - nkStrLit..nkTripleStrLit: begin - if n.strVal <> '' then - appf(result, '!$1', [encodeStr(w, n.strVal)]); - end; - nkIdent: - appf(result, '!$1', [encodeStr(w, n.ident.s)]); - nkSym: begin - appf(result, '!$1', [encodeInt(n.sym.id)]); - pushSym(w, n.sym); - end; - else begin - for i := 0 to sonsLen(n)-1 do - app(result, encodeNode(w, n.info, n.sons[i])); - end - end; - app(result, ')'+''); -end; - -function encodeLoc(w: PRodWriter; const loc: TLoc): PRope; -begin - result := nil; - if loc.k <> low(loc.k) then - app(result, encodeInt(ord(loc.k))); - if loc.s <> low(loc.s) then - appf(result, '*$1', [encodeInt(ord(loc.s))]); - if loc.flags <> {@set}[] then - appf(result, '$$$1', [encodeInt({@cast}int32(loc.flags))]); - if loc.t <> nil then begin - appf(result, '^$1', [encodeInt(loc.t.id)]); - pushType(w, loc.t); - end; - if loc.r <> nil then - appf(result, '!$1', [encodeStr(w, ropeToStr(loc.r))]); - if loc.a <> 0 then - appf(result, '?$1', [encodeInt(loc.a)]); - if result <> nil then - result := ropef('<$1>', [result]); -end; - -function encodeType(w: PRodWriter; t: PType): PRope; -var - i: int; -begin - if t = nil then begin - // nil nodes have to be stored too: - result := toRope('[]'); exit - end; - result := nil; - if t.kind = tyForward then InternalError('encodeType: tyForward'); - app(result, encodeInt(ord(t.kind))); - appf(result, '+$1', [encodeInt(t.id)]); - if t.n <> nil then - app(result, encodeNode(w, UnknownLineInfo(), t.n)); - if t.flags <> {@set}[] then - appf(result, '$$$1', [encodeInt({@cast}int32(t.flags))]); - if t.callConv <> low(t.callConv) then - appf(result, '?$1', [encodeInt(ord(t.callConv))]); - if t.owner <> nil then begin - appf(result, '*$1', [encodeInt(t.owner.id)]); - pushSym(w, t.owner); - end; - if t.sym <> nil then begin - appf(result, '&$1', [encodeInt(t.sym.id)]); - pushSym(w, t.sym); - end; - if t.size <> -1 then appf(result, '/$1', [encodeInt(t.size)]); - if t.align <> 2 then appf(result, '=$1', [encodeInt(t.align)]); - if t.containerID <> 0 then - appf(result, '@$1', [encodeInt(t.containerID)]); - app(result, encodeLoc(w, t.loc)); - for i := 0 to sonsLen(t)-1 do begin - if t.sons[i] = nil then - app(result, '^()') - else begin - appf(result, '^$1', [encodeInt(t.sons[i].id)]); - pushType(w, t.sons[i]); - end - end; -end; - -function encodeLib(w: PRodWriter; lib: PLib): PRope; -begin - result := nil; - appf(result, '|$1', [encodeInt(ord(lib.kind))]); - appf(result, '|$1', [encodeStr(w, ropeToStr(lib.name))]); - appf(result, '|$1', [encodeStr(w, lib.path)]); -end; - -function encodeSym(w: PRodWriter; s: PSym): PRope; -var - codeAst: PNode; - col, line: PRope; -begin - codeAst := nil; - if s = nil then begin - // nil nodes have to be stored too: - result := toRope('{}'); exit - end; - result := nil; - app(result, encodeInt(ord(s.kind))); - appf(result, '+$1', [encodeInt(s.id)]); - appf(result, '&$1', [encodeStr(w, s.name.s)]); - if s.typ <> nil then begin - appf(result, '^$1', [encodeInt(s.typ.id)]); - pushType(w, s.typ); - end; - if s.info.col = int16(-1) then col := nil - else col := encodeInt(s.info.col); - if s.info.line = int16(-1) then line := nil - else line := encodeInt(s.info.line); - appf(result, '?$1,$2,$3', [col, line, - encodeInt(fileIdx(w, toFilename(s.info)))]); - if s.owner <> nil then begin - appf(result, '*$1', [encodeInt(s.owner.id)]); - pushSym(w, s.owner); - end; - if s.flags <> {@set}[] then - appf(result, '$$$1', [encodeInt({@cast}int32(s.flags))]); - if s.magic <> mNone then - appf(result, '@$1', [encodeInt(ord(s.magic))]); - if (s.ast <> nil) then begin - if not astNeeded(s) then begin - codeAst := s.ast.sons[codePos]; - s.ast.sons[codePos] := nil; - end; - app(result, encodeNode(w, s.info, s.ast)); - if codeAst <> nil then // restore code ast - s.ast.sons[codePos] := codeAst; - end; - if s.options <> w.options then - appf(result, '!$1', [encodeInt({@cast}int32(s.options))]); - if s.position <> 0 then - appf(result, '%$1', [encodeInt(s.position)]); - if s.offset <> -1 then - appf(result, '`$1', [encodeInt(s.offset)]); - app(result, encodeLoc(w, s.loc)); - if s.annex <> nil then - app(result, encodeLib(w, s.annex)); -end; - -procedure addToIndex(var w: TIndex; key, val: int); -begin - if key - w.lastIdxKey = 1 then begin - // we do not store a key-diff of 1 to safe space - app(w.r, encodeInt(val - w.lastIdxVal)); - app(w.r, rodNL); - end - else - appf(w.r, '$1 $2'+rodNL, [encodeInt(key - w.lastIdxKey), - encodeInt(val - w.lastIdxVal)]); - w.lastIdxKey := key; - w.lastIdxVal := val; - IiTablePut(w.tab, key, val); -end; - -var - debugWritten: TIntSet; - -procedure symStack(w: PRodWriter); -var - i, L: int; - s, m: PSym; -begin - i := 0; - while i < length(w.sstack) do begin - s := w.sstack[i]; - if IiTableGet(w.index.tab, s.id) = invalidKey then begin - m := getModule(s); - if m = nil then InternalError('symStack: module nil: ' + s.name.s); - if (m.id = w.module.id) or (sfFromGeneric in s.flags) then begin - // put definition in here - L := ropeLen(w.data); - addToIndex(w.index, s.id, L); - //intSetIncl(debugWritten, s.id); - app(w.data, encodeSym(w, s)); - app(w.data, rodNL); - if sfInInterface in s.flags then - appf(w.interf, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]); - if sfCompilerProc in s.flags then - appf(w.compilerProcs, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]); - if s.kind = skConverter then begin - if w.converters <> nil then app(w.converters, ' '+''); - app(w.converters, encodeInt(s.id)) - end - end - else if IiTableGet(w.imports.tab, s.id) = invalidKey then begin - addToIndex(w.imports, s.id, m.id); - //if not IntSetContains(debugWritten, s.id) then begin - // MessageOut(w.filename); - // debug(s.owner); - // debug(s); - // InternalError('BUG!!!!'); - //end - end - end; - inc(i); - end; - setLength(w.sstack, 0); -end; - -procedure typeStack(w: PRodWriter); -var - i, L: int; -begin - i := 0; - while i < length(w.tstack) do begin - if IiTableGet(w.index.tab, w.tstack[i].id) = invalidKey then begin - L := ropeLen(w.data); - addToIndex(w.index, w.tstack[i].id, L); - app(w.data, encodeType(w, w.tstack[i])); - app(w.data, rodNL); - end; - inc(i); - end; - setLength(w.tstack, 0); -end; - -procedure processStacks(w: PRodWriter); -begin - while (length(w.tstack) > 0) or (length(w.sstack) > 0) do begin - symStack(w); - typeStack(w); - end -end; - -procedure rawAddInterfaceSym(w: PRodWriter; s: PSym); -begin - pushSym(w, s); - processStacks(w); -end; - -procedure addInterfaceSym(w: PRodWriter; s: PSym); -begin - if w = nil then exit; - if [sfInInterface, sfCompilerProc] * s.flags <> [] then begin - rawAddInterfaceSym(w, s); - end -end; - -procedure addStmt(w: PRodWriter; n: PNode); -begin - app(w.init, encodeInt(ropeLen(w.data))); - app(w.init, rodNL); - app(w.data, encodeNode(w, UnknownLineInfo(), n)); - app(w.data, rodNL); - processStacks(w); -end; - -procedure writeRod(w: PRodWriter); -var - content: PRope; - i: int; -begin - processStacks(w); - // write header: - content := toRope('NIM:'); - app(content, toRope(FileVersion)); - app(content, rodNL); - app(content, toRope('ID:')); - app(content, encodeInt(w.module.id)); - app(content, rodNL); - app(content, toRope('CRC:')); - app(content, encodeInt(w.crc)); - app(content, rodNL); - app(content, toRope('OPTIONS:')); - app(content, encodeInt({@cast}int32(w.options))); - app(content, rodNL); - app(content, toRope('DEFINES:')); - app(content, w.defines); - app(content, rodNL); - app(content, toRope('FILES('+rodNL)); - for i := 0 to high(w.files) do begin - app(content, encode(w.files[i])); - app(content, rodNL); - end; - app(content, toRope(')'+rodNL)); - app(content, toRope('INCLUDES('+rodNL)); - app(content, w.inclDeps); - app(content, toRope(')'+rodNL)); - app(content, toRope('DEPS:')); - app(content, w.modDeps); - app(content, rodNL); - app(content, toRope('INTERF('+rodNL)); - app(content, w.interf); - app(content, toRope(')'+rodNL)); - app(content, toRope('COMPILERPROCS('+rodNL)); - app(content, w.compilerProcs); - app(content, toRope(')'+rodNL)); - app(content, toRope('INDEX('+rodNL)); - app(content, w.index.r); - app(content, toRope(')'+rodNL)); - app(content, toRope('IMPORTS('+rodNL)); - app(content, w.imports.r); - app(content, toRope(')'+rodNL)); - app(content, toRope('CONVERTERS:')); - app(content, w.converters); - app(content, toRope(rodNL)); - app(content, toRope('INIT('+rodNL)); - app(content, w.init); - app(content, toRope(')'+rodNL)); - app(content, toRope('DATA('+rodNL)); - app(content, w.data); - app(content, toRope(')'+rodNL)); - - //MessageOut('interf ' + ToString(ropeLen(w.interf))); - //MessageOut('index ' + ToString(ropeLen(w.indexRope))); - //MessageOut('init ' + ToString(ropeLen(w.init))); - //MessageOut('data ' + ToString(ropeLen(w.data))); - - writeRope(content, - completeGeneratedFilePath(changeFileExt(w.filename, 'rod'))); -end; - -function process(c: PPassContext; n: PNode): PNode; -var - i: int; - w: PRodWriter; - a: PNode; - s: PSym; -begin - result := n; - if c = nil then exit; - w := PRodWriter(c); - case n.kind of - nkStmtList: begin - for i := 0 to sonsLen(n)-1 do {@discard} process(c, n.sons[i]); - end; - nkTemplateDef, nkMacroDef: begin - s := n.sons[namePos].sym; - addInterfaceSym(w, s); - end; - nkProcDef, nkMethodDef, nkIteratorDef, nkConverterDef: begin - s := n.sons[namePos].sym; - if s = nil then InternalError(n.info, 'rodwrite.process'); - if (n.sons[codePos] <> nil) or (s.magic <> mNone) - or not (sfForward in s.flags) then begin - addInterfaceSym(w, s); - end - end; - nkVarSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if a.kind <> nkIdentDefs then InternalError(a.info, 'rodwrite.process'); - addInterfaceSym(w, a.sons[0].sym); - end - end; - nkConstSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if a.kind <> nkConstDef then InternalError(a.info, 'rodwrite.process'); - addInterfaceSym(w, a.sons[0].sym); - end - end; - nkTypeSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if a.sons[0].kind <> nkSym then - InternalError(a.info, 'rodwrite.process'); - s := a.sons[0].sym; - addInterfaceSym(w, s); // this takes care of enum fields too - // Note: The check for ``s.typ.kind = tyEnum`` is wrong for enum - // type aliasing! Otherwise the same enum symbol would be included - // several times! - (* - if (a.sons[2] <> nil) and (a.sons[2].kind = nkEnumTy) then begin - a := s.typ.n; - for j := 0 to sonsLen(a)-1 do - addInterfaceSym(w, a.sons[j].sym); - end *) - end - end; - nkImportStmt: begin - for i := 0 to sonsLen(n)-1 do addModDep(w, getModuleFile(n.sons[i])); - addStmt(w, n); - end; - nkFromStmt: begin - addModDep(w, getModuleFile(n.sons[0])); - addStmt(w, n); - end; - nkIncludeStmt: begin - for i := 0 to sonsLen(n)-1 do addInclDep(w, getModuleFile(n.sons[i])); - end; - nkPragma: addStmt(w, n); - else begin end - end; -end; - -function myOpen(module: PSym; const filename: string): PPassContext; -var - w: PRodWriter; -begin - if module.id < 0 then InternalError('rodwrite: module ID not set'); - w := newRodWriter(filename, rodread.GetCRC(filename), module); - rawAddInterfaceSym(w, module); - result := w; -end; - -function myClose(c: PPassContext; n: PNode): PNode; -var - w: PRodWriter; -begin - w := PRodWriter(c); - writeRod(w); - result := n; -end; - -function rodwritePass(): TPass; -begin - initPass(result); - if optSymbolFiles in gGlobalOptions then begin - result.open := myOpen; - result.close := myClose; - result.process := process; - end -end; - -initialization - IntSetInit(debugWritten); -end. diff --git a/nim/ropes.pas b/nim/ropes.pas deleted file mode 100755 index 286f1b9e64..0000000000 --- a/nim/ropes.pas +++ /dev/null @@ -1,635 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit ropes; - -{ Ropes for the C code generator - - Ropes are a data structure that represents a very long string - efficiently; especially concatenation is done in O(1) instead of O(N). - Ropes make use a lazy evaluation: They are essentially concatenation - trees that are only flattened when converting to a native Nimrod - string or when written to disk. The empty string is represented by a - nil pointer. - A little picture makes everything clear: - - "this string" & " is internally " & "represented as" - - con -- inner nodes do not contain raw data - / \ - / \ - / \ - con "represented as" - / \ - / \ - / \ - / \ - / \ -"this string" " is internally " - - Note that this is the same as: - "this string" & (" is internally " & "represented as") - - con - / \ - / \ - / \ - "this string" con - / \ - / \ - / \ - / \ - / \ -" is internally " "represented as" - - The 'con' operator is associative! This does not matter however for - the algorithms we use for ropes. - - Note that the left and right pointers are not needed for leafs. - Leafs have relatively high memory overhead (~30 bytes on a 32 - bit machines) and we produce many of them. This is why we cache and - share leafs accross different rope trees. - To cache them they are inserted in another tree, a splay tree for best - performance. But for the caching tree we use the leafs' left and right - pointers. -} - -interface - -{$include 'config.inc'} - -uses - nsystem, msgs, strutils, platform, nhashes, crc; - -const - CacheLeafs = true; - countCacheMisses = False; // see what our little optimization gives - -type - TFormatStr = string; - // later we may change it to CString for better - // performance of the code generator (assignments copy the format strings - // though it is not necessary) - - PRope = ^TRope; - TRope = object(NObject) - left, right: PRope; - len: int; - data: string; // != nil if a leaf - end {@acyclic}; - // the empty rope is represented by nil to safe space - - TRopeSeq = array of PRope; - -function con(a, b: PRope): PRope; overload; -function con(a: PRope; const b: string): PRope; overload; -function con(const a: string; b: PRope): PRope; overload; -function con(a: array of PRope): PRope; overload; - -procedure app(var a: PRope; b: PRope); overload; -procedure app(var a: PRope; const b: string); overload; - -procedure prepend(var a: PRope; b: PRope); - -function toRope(const s: string): PRope; overload; -function toRopeF(const r: BiggestFloat): PRope; -function toRope(i: BiggestInt): PRope; overload; - -function ropeLen(a: PRope): int; - -procedure WriteRope(head: PRope; const filename: string); -function writeRopeIfNotEqual(r: PRope; const filename: string): boolean; - -function ropeToStr(p: PRope): string; - -function ropef(const frmt: TFormatStr; const args: array of PRope): PRope; - -procedure appf(var c: PRope; const frmt: TFormatStr; - const args: array of PRope); - -function getCacheStats: string; - -function RopeEqualsFile(r: PRope; const f: string): Boolean; -// returns true if the rope r is the same as the contents of file f - -function RopeInvariant(r: PRope): Boolean; -// exported for debugging - -implementation - -function ropeLen(a: PRope): int; -begin - if a = nil then result := 0 - else result := a.len -end; - -function newRope(const data: string = snil): PRope; -begin - new(result); - {@ignore} - fillChar(result^, sizeof(TRope), 0); - {@emit} - if data <> snil then begin - result.len := length(data); - result.data := data; - end -end; - -// -------------- leaf cache: --------------------------------------- -var - cache: PRope; // the root of the cache tree - misses, hits: int; - N: PRope; // dummy rope needed for splay algorithm - -function getCacheStats: string; -begin - if hits+misses <> 0 then - result := 'Misses: ' +{&} ToString(misses) +{&} - ' total: ' +{&} toString(hits+misses) +{&} - ' quot: ' +{&} toStringF(toFloat(misses) / toFloat(hits+misses)) - else - result := '' -end; - -function splay(const s: string; tree: PRope; out cmpres: int): PRope; -var - le, r, y, t: PRope; - c: int; -begin - t := tree; - N.left := nil; N.right := nil; // reset to nil - le := N; - r := N; - repeat - c := cmp(s, t.data); - if c < 0 then begin - if (t.left <> nil) and (s < t.left.data) then begin - y := t.left; t.left := y.right; y.right := t; t := y - end; - if t.left = nil then break; - r.left := t; r := t; t := t.left - end - else if c > 0 then begin - if (t.right <> nil) and (s > t.right.data) then begin - y := t.right; t.right := y.left; y.left := t; t := y - end; - if t.right = nil then break; - le.right := t; le := t; t := t.right - end - else break - until false; - cmpres := c; - le.right := t.left; r.left := t.right; t.left := N.right; t.right := N.left; - result := t -end; - -function insertInCache(const s: string; tree: PRope): PRope; -// Insert i into the tree t, unless it's already there. -// Return a pointer to the resulting tree. -var - t: PRope; - cmp: int; -begin - t := tree; - if t = nil then begin - result := newRope(s); - if countCacheMisses then inc(misses); - exit - end; - t := splay(s, t, cmp); - if cmp = 0 then begin - // We get here if it's already in the Tree - // Don't add it again - result := t; - if countCacheMisses then inc(hits); - end - else begin - if countCacheMisses then inc(misses); - result := newRope(s); - if cmp < 0 then begin - result.left := t.left; result.right := t; t.left := nil - end - else begin // i > t.item: - result.right := t.right; result.left := t; t.right := nil - end - end -end; - -function RopeInvariant(r: PRope): Boolean; -begin - if r = nil then - result := true - else begin - result := true - (* - if r.data <> snil then - result := true - else begin - result := (r.left <> nil) and (r.right <> nil); - if result then result := ropeInvariant(r.left); - if result then result := ropeInvariant(r.right); - end *) - end -end; - -function toRope(const s: string): PRope; -begin - if s = '' then - result := nil - else if cacheLeafs then begin - result := insertInCache(s, cache); - cache := result; - end - else - result := newRope(s); - assert(RopeInvariant(result)); -end; - -// ------------------------------------------------------------------ - -procedure RopeSeqInsert(var rs: TRopeSeq; r: PRope; at: Natural); -var - len, i: int; -begin - len := length(rs); - if at > len then - SetLength(rs, at+1) - else - SetLength(rs, len+1); - - // move old rope elements: - for i := len downto at+1 do - rs[i] := rs[i-1]; // this is correct, I used pen and paper to validate it - rs[at] := r -end; - -function con(a, b: PRope): PRope; overload; -begin - assert(RopeInvariant(a)); - assert(RopeInvariant(b)); - if a = nil then // len is valid for every cord not only for leafs - result := b - else if b = nil then - result := a - else begin - result := newRope(); - result.len := a.len + b.len; - result.left := a; - result.right := b - end; - assert(RopeInvariant(result)); -end; - -function con(a: PRope; const b: string): PRope; overload; -var - r: PRope; -begin - assert(RopeInvariant(a)); - if b = '' then - result := a - else begin - r := toRope(b); - if a = nil then begin - result := r - end - else begin - result := newRope(); - result.len := a.len + r.len; - result.left := a; - result.right := r; - end - end; - assert(RopeInvariant(result)); -end; - -function con(const a: string; b: PRope): PRope; overload; -var - r: PRope; -begin - assert(RopeInvariant(b)); - if a = '' then - result := b - else begin - r := toRope(a); - - if b = nil then - result := r - else begin - result := newRope(); - result.len := b.len + r.len; - result.left := r; - result.right := b; - end - end; - assert(RopeInvariant(result)); -end; - -function con(a: array of PRope): PRope; overload; -var - i: int; -begin - result := nil; - for i := 0 to high(a) do result := con(result, a[i]); - assert(RopeInvariant(result)); -end; - -function toRope(i: BiggestInt): PRope; -begin - result := toRope(ToString(i)) -end; - -function toRopeF(const r: BiggestFloat): PRope; -begin - result := toRope(toStringF(r)) -end; - -procedure app(var a: PRope; b: PRope); overload; -begin - a := con(a, b); - assert(RopeInvariant(a)); -end; - -procedure app(var a: PRope; const b: string); overload; -begin - a := con(a, b); - assert(RopeInvariant(a)); -end; - -procedure prepend(var a: PRope; b: PRope); -begin - a := con(b, a); - assert(RopeInvariant(a)); -end; - -procedure InitStack(var stack: TRopeSeq); -begin - {@ignore} - setLength(stack, 0); - {@emit stack := @[];} -end; - -procedure push(var stack: TRopeSeq; r: PRope); -var - len: int; -begin - len := length(stack); - setLength(stack, len+1); - stack[len] := r; -end; - -function pop(var stack: TRopeSeq): PRope; -var - len: int; -begin - len := length(stack); - result := stack[len-1]; - setLength(stack, len-1); -end; - -procedure WriteRopeRec(var f: TTextFile; c: PRope); -begin - assert(RopeInvariant(c)); - - if c = nil then exit; - if (c.data <> snil) then begin - nimWrite(f, c.data) - end - else begin - writeRopeRec(f, c.left); - writeRopeRec(f, c.right) - end -end; - -procedure newWriteRopeRec(var f: TTextFile; c: PRope); -var - stack: TRopeSeq; - it: PRope; -begin - assert(RopeInvariant(c)); - initStack(stack); - push(stack, c); - while length(stack) > 0 do begin - it := pop(stack); - while it.data = snil do begin - push(stack, it.right); - it := it.left; - assert(it <> nil); - end; - assert(it.data <> snil); - nimWrite(f, it.data); - end -end; - -procedure WriteRope(head: PRope; const filename: string); -var - f: TTextFile; // we use a textfile for automatic buffer handling -begin - if OpenFile(f, filename, fmWrite) then begin - if head <> nil then newWriteRopeRec(f, head); - nimCloseFile(f); - end - else - rawMessage(errCannotOpenFile, filename); -end; - -procedure recRopeToStr(var result: string; var resultLen: int; p: PRope); -begin - if p = nil then exit; // do not add to result - if (p.data = snil) then begin - recRopeToStr(result, resultLen, p.left); - recRopeToStr(result, resultLen, p.right); - end - else begin - CopyMem(@result[resultLen+StrStart], @p.data[strStart], p.len); - Inc(resultLen, p.len); - assert(resultLen <= length(result)); - end -end; - -procedure newRecRopeToStr(var result: string; var resultLen: int; - r: PRope); -var - stack: TRopeSeq; - it: PRope; -begin - initStack(stack); - push(stack, r); - while length(stack) > 0 do begin - it := pop(stack); - while it.data = snil do begin - push(stack, it.right); - it := it.left; - end; - assert(it.data <> snil); - CopyMem(@result[resultLen+StrStart], @it.data[strStart], it.len); - Inc(resultLen, it.len); - assert(resultLen <= length(result)); - end -end; - -function ropeToStr(p: PRope): string; -var - resultLen: int; -begin - assert(RopeInvariant(p)); - if p = nil then - result := '' - else begin - result := newString(p.len); - resultLen := 0; - newRecRopeToStr(result, resultLen, p); - end -end; - -function ropef(const frmt: TFormatStr; const args: array of PRope): PRope; -var - i, j, len, start, num: int; -begin - i := strStart; - len := length(frmt); - result := nil; - num := 0; - while i <= len + StrStart - 1 do begin - if frmt[i] = '$' then begin - inc(i); // skip '$' - case frmt[i] of - '$': begin app(result, '$'+''); inc(i); end; - '#': begin inc(i); app(result, args[num]); inc(num); end; - '0'..'9': begin - j := 0; - repeat - j := (j*10) + Ord(frmt[i]) - ord('0'); - inc(i); - until (i > len + StrStart - 1) or not (frmt[i] in ['0'..'9']); - num := j; - if j > high(args)+1 then - internalError('ropes: invalid format string $' + toString(j)); - app(result, args[j-1]); - end; - 'N', 'n': begin app(result, tnl); inc(i); end; - else InternalError('ropes: invalid format string $' + frmt[i]); - end - end; - start := i; - while (i <= len + StrStart - 1) do - if (frmt[i] <> '$') then inc(i) else break; - if i-1 >= start then begin - app(result, ncopy(frmt, start, i-1)); - end - end; - assert(RopeInvariant(result)); -end; - -procedure appf(var c: PRope; const frmt: TFormatStr; const args: array of PRope); -begin - app(c, ropef(frmt, args)) -end; - -const - bufSize = 1024; // 1 KB is reasonable - -function auxRopeEqualsFile(r: PRope; var bin: TBinaryFile; - buf: Pointer): Boolean; -var - readBytes: int; -begin - if (r.data <> snil) then begin - if r.len > bufSize then - // A token bigger than 1 KB? - This cannot happen in reality. - internalError('ropes: token too long'); - readBytes := readBuffer(bin, buf, r.len); - result := (readBytes = r.len) // BUGFIX - and equalMem(buf, addr(r.data[strStart]), r.len); - end - else begin - result := auxRopeEqualsFile(r.left, bin, buf); - if result then - result := auxRopeEqualsFile(r.right, bin, buf); - end -end; - -function RopeEqualsFile(r: PRope; const f: string): Boolean; -var - bin: TBinaryFile; - buf: Pointer; -begin - result := openFile(bin, f); - if not result then exit; // not equal if file does not exist - buf := alloc(BufSize); - result := auxRopeEqualsFile(r, bin, buf); - if result then - result := readBuffer(bin, buf, bufSize) = 0; // really at the end of file? - dealloc(buf); - CloseFile(bin); -end; - -function crcFromRopeAux(r: PRope; startVal: TCrc32): TCrc32; -var - i: int; -begin - if r.data <> snil then begin - result := startVal; - for i := strStart to length(r.data)+strStart-1 do - result := updateCrc32(r.data[i], result); - end - else begin - result := crcFromRopeAux(r.left, startVal); - result := crcFromRopeAux(r.right, result); - end -end; - -function newCrcFromRopeAux(r: PRope; startVal: TCrc32): TCrc32; -var - stack: TRopeSeq; - it: PRope; - L, i: int; -begin - initStack(stack); - push(stack, r); - result := startVal; - while length(stack) > 0 do begin - it := pop(stack); - while it.data = snil do begin - push(stack, it.right); - it := it.left; - end; - assert(it.data <> snil); - i := strStart; - L := length(it.data)+strStart; - while i < L do begin - result := updateCrc32(it.data[i], result); - inc(i); - end - end -end; - -function crcFromRope(r: PRope): TCrc32; -begin - result := newCrcFromRopeAux(r, initCrc32) -end; - -function writeRopeIfNotEqual(r: PRope; const filename: string): boolean; -// returns true if overwritten -var - c: TCrc32; -begin - c := crcFromFile(filename); - if c <> crcFromRope(r) then begin - writeRope(r, filename); - result := true - end - else - result := false -end; - -initialization - new(N); // init dummy node for splay algorithm -{@ignore} - fillChar(N^, sizeof(N^), 0); -{@emit} -end. diff --git a/nim/rst.pas b/nim/rst.pas deleted file mode 100755 index 89ef2c501a..0000000000 --- a/nim/rst.pas +++ /dev/null @@ -1,2184 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit rst; - -// This module implements a *reStructuredText* parser. A larget -// subset is provided. - -interface - -{$include 'config.inc'} - -uses - nsystem, nos, msgs, strutils, platform, nhashes, ropes, charsets, options; - -type - TRstNodeKind = ( - rnInner, // an inner node or a root - rnHeadline, // a headline - rnOverline, // an over- and underlined headline - rnTransition, // a transition (the -------------
    thingie) - rnParagraph, // a paragraph - - rnBulletList, // a bullet list - rnBulletItem, // a bullet item - rnEnumList, // an enumerated list - rnEnumItem, // an enumerated item - - rnDefList, // a definition list - rnDefItem, // an item of a definition list consisting of ... - rnDefName, // ... a name part ... - rnDefBody, // ... and a body part ... - - rnFieldList, // a field list - rnField, // a field item - rnFieldName, // consisting of a field name ... - rnFieldBody, // ... and a field body - - rnOptionList, - rnOptionListItem, - rnOptionGroup, - rnOption, - rnOptionString, - rnOptionArgument, - rnDescription, - - rnLiteralBlock, - rnQuotedLiteralBlock, - - rnLineBlock, // the | thingie - rnLineBlockItem, // sons of the | thing - - rnBlockQuote, // text just indented - - rnTable, - rnGridTable, - rnTableRow, - rnTableHeaderCell, - rnTableDataCell, - - rnLabel, // used for footnotes and other things - rnFootnote, // a footnote - - rnCitation, // similar to footnote - - rnStandaloneHyperlink, - rnHyperlink, - rnRef, - rnDirective, // a directive - rnDirArg, - rnRaw, - rnTitle, - rnContents, - rnImage, - rnFigure, - rnCodeBlock, - rnContainer, // ``container`` directive - rnIndex, // index directve: - // .. index:: - // key - // * `file#id `_ - // * `file#id '_ - - rnSubstitutionDef, // a definition of a substitution - - rnGeneralRole, - // Inline markup: - rnSub, - rnSup, - rnIdx, - rnEmphasis, // "*" - rnStrongEmphasis, // "**" - rnInterpretedText, // "`" - rnInlineLiteral, // "``" - rnSubstitutionReferences, // "|" - - rnLeaf // a leaf; the node's text field contains the leaf val - ); -const - rstnodekindToStr: array [TRstNodeKind] of string = ( - 'Inner', 'Headline', 'Overline', 'Transition', 'Paragraph', - 'BulletList', 'BulletItem', 'EnumList', 'EnumItem', 'DefList', 'DefItem', - 'DefName', 'DefBody', 'FieldList', 'Field', 'FieldName', 'FieldBody', - 'OptionList', 'OptionListItem', 'OptionGroup', 'Option', 'OptionString', - 'OptionArgument', 'Description', 'LiteralBlock', 'QuotedLiteralBlock', - 'LineBlock', 'LineBlockItem', 'BlockQuote', 'Table', 'GridTable', - 'TableRow', 'TableHeaderCell', 'TableDataCell', 'Label', 'Footnote', - 'Citation', 'StandaloneHyperlink', 'Hyperlink', 'Ref', 'Directive', - 'DirArg', 'Raw', 'Title', 'Contents', 'Image', 'Figure', 'CodeBlock', - 'Container', 'Index', 'SubstitutionDef', 'GeneralRole', - 'Sub', 'Sup', 'Idx', 'Emphasis', 'StrongEmphasis', 'InterpretedText', - 'InlineLiteral', 'SubstitutionReferences', 'Leaf' - ); - -type - // the syntax tree of RST: - PRSTNode = ^TRstNode; - TRstNodeSeq = array of PRstNode; - TRSTNode = record - kind: TRstNodeKind; - text: string; // valid for leafs in the AST; and the title of - // the document or the section - level: int; // valid for some node kinds - sons: TRstNodeSeq; // the node's sons - end {@acyclic}; - - -function rstParse(const text: string; // the text to be parsed - skipPounds: bool; - const filename: string; // for error messages - line, column: int; - var hasToc: bool): PRstNode; -function rsonsLen(n: PRstNode): int; -function newRstNode(kind: TRstNodeKind): PRstNode; overload; -function newRstNode(kind: TRstNodeKind; const s: string): PRstNode; overload; -procedure addSon(father, son: PRstNode); - -function rstnodeToRefname(n: PRstNode): string; - -function addNodes(n: PRstNode): string; - -function getFieldValue(n: PRstNode; const fieldname: string): string; -function getArgument(n: PRstNode): string; - -// index handling: -procedure setIndexPair(index, key, val: PRstNode); -procedure sortIndex(a: PRstNode); -procedure clearIndex(index: PRstNode; const filename: string); - - -implementation - -// ----------------------------- scanner part -------------------------------- - -const - SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255]; - -type - TTokType = (tkEof, tkIndent, tkWhite, tkWord, tkAdornment, tkPunct, tkOther); - TToken = record // a RST token - kind: TTokType; // the type of the token - ival: int; // the indentation or parsed integer value - symbol: string; // the parsed symbol as string - line, col: int; // line and column of the token - end; - TTokenSeq = array of TToken; - TLexer = object(NObject) - buf: PChar; - bufpos: int; - line, col, baseIndent: int; - skipPounds: bool; - end; - -procedure getThing(var L: TLexer; var tok: TToken; const s: TCharSet); -var - pos: int; -begin - tok.kind := tkWord; - tok.line := L.line; - tok.col := L.col; - pos := L.bufpos; - while True do begin - addChar(tok.symbol, L.buf[pos]); - inc(pos); - if not (L.buf[pos] in s) then break - end; - inc(L.col, pos - L.bufpos); - L.bufpos := pos; -end; - -procedure getAdornment(var L: TLexer; var tok: TToken); -var - pos: int; - c: char; -begin - tok.kind := tkAdornment; - tok.line := L.line; - tok.col := L.col; - pos := L.bufpos; - c := L.buf[pos]; - while True do begin - addChar(tok.symbol, L.buf[pos]); - inc(pos); - if L.buf[pos] <> c then break - end; - inc(L.col, pos - L.bufpos); - L.bufpos := pos -end; - -function getIndentAux(var L: TLexer; start: int): int; -var - buf: PChar; - pos: int; -begin - pos := start; - buf := L.buf; - // skip the newline (but include it in the token!) - if buf[pos] = #13 then begin - if buf[pos+1] = #10 then inc(pos, 2) else inc(pos); - end - else if buf[pos] = #10 then inc(pos); - if L.skipPounds then begin - if buf[pos] = '#' then inc(pos); - if buf[pos] = '#' then inc(pos); - end; - result := 0; - while True do begin - case buf[pos] of - ' ', #11, #12: begin - inc(pos); - inc(result); - end; - #9: begin - inc(pos); - result := result - (result mod 8) + 8; - end; - else break; // EndOfFile also leaves the loop - end; - end; - if buf[pos] = #0 then result := 0 - else if (buf[pos] = #10) or (buf[pos] = #13) then begin - // look at the next line for proper indentation: - result := getIndentAux(L, pos); - end; - L.bufpos := pos; // no need to set back buf -end; - -procedure getIndent(var L: TLexer; var tok: TToken); -begin - inc(L.line); - tok.line := L.line; - tok.col := 0; - tok.kind := tkIndent; - // skip the newline (but include it in the token!) - tok.ival := getIndentAux(L, L.bufpos); - L.col := tok.ival; - tok.ival := max(tok.ival - L.baseIndent, 0); - tok.symbol := nl +{&} repeatChar(tok.ival); -end; - -procedure rawGetTok(var L: TLexer; var tok: TToken); -var - c: Char; -begin - tok.symbol := ''; - tok.ival := 0; - c := L.buf[L.bufpos]; - case c of - 'a'..'z', 'A'..'Z', #128..#255, '0'..'9': getThing(L, tok, SymChars); - ' ', #9, #11, #12: begin - getThing(L, tok, {@set}[' ', #9]); - tok.kind := tkWhite; - if L.buf[L.bufpos] in [#13, #10] then - rawGetTok(L, tok); // ignore spaces before \n - end; - #13, #10: getIndent(L, tok); - '!', '"', '#', '$', '%', '&', '''', - '(', ')', '*', '+', ',', '-', '.', '/', - ':', ';', '<', '=', '>', '?', '@', '[', '\', ']', - '^', '_', '`', '{', '|', '}', '~': begin - getAdornment(L, tok); - if length(tok.symbol) <= 3 then tok.kind := tkPunct; - end; - else begin - tok.line := L.line; - tok.col := L.col; - if c = #0 then - tok.kind := tkEof - else begin - tok.kind := tkOther; - addChar(tok.symbol, c); - inc(L.bufpos); - inc(L.col); - end - end - end; - tok.col := max(tok.col - L.baseIndent, 0); -end; - -procedure getTokens(const buffer: string; skipPounds: bool; - var tokens: TTokenSeq); -var - L: TLexer; - len: int; -begin -{@ignore} - fillChar(L, sizeof(L), 0); -{@emit} - len := length(tokens); - L.buf := PChar(buffer); - L.line := 1; - // skip UTF-8 BOM - if (L.buf[0] = #239) and (L.buf[1] = #187) and (L.buf[2] = #191) then - inc(L.bufpos, 3); - L.skipPounds := skipPounds; - if skipPounds then begin - if L.buf[L.bufpos] = '#' then inc(L.bufpos); - if L.buf[L.bufpos] = '#' then inc(L.bufpos); - L.baseIndent := 0; - while L.buf[L.bufpos] = ' ' do begin - inc(L.bufpos); - inc(L.baseIndent); - end - end; - while true do begin - inc(len); - setLength(tokens, len); - rawGetTok(L, tokens[len-1]); - if tokens[len-1].kind = tkEof then break; - end; - if tokens[0].kind = tkWhite then begin // BUGFIX - tokens[0].ival := length(tokens[0].symbol); - tokens[0].kind := tkIndent - end -end; - -// -------------------------------------------------------------------------- - -procedure addSon(father, son: PRstNode); -var - L: int; -begin - L := length(father.sons); - setLength(father.sons, L+1); - father.sons[L] := son; -end; - -procedure addSonIfNotNil(father, son: PRstNode); -begin - if son <> nil then addSon(father, son); -end; - -function rsonsLen(n: PRstNode): int; -begin - result := length(n.sons) -end; - -function newRstNode(kind: TRstNodeKind): PRstNode; overload; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit - result.sons := @[]; -} - result.kind := kind; -end; - -function newRstNode(kind: TRstNodeKind; const s: string): PRstNode; overload; -begin - result := newRstNode(kind); - result.text := s; -end; - -// --------------------------------------------------------------------------- -type - TLevelMap = array [Char] of int; - TSubstitution = record - key: string; - value: PRstNode; - end; - TSharedState = record - uLevel, oLevel: int; // counters for the section levels - subs: array of TSubstitution; // substitutions - refs: array of TSubstitution; // references - underlineToLevel: TLevelMap; - // Saves for each possible title adornment character its level in the - // current document. This is for single underline adornments. - overlineToLevel: TLevelMap; - // Saves for each possible title adornment character its level in the - // current document. This is for over-underline adornments. - end; - PSharedState = ^TSharedState; - TRstParser = object(NObject) - idx: int; - tok: TTokenSeq; - s: PSharedState; - indentStack: array of int; - filename: string; - line, col: int; - hasToc: bool; - end; - -function newSharedState(): PSharedState; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - {@emit - result.subs := @[];} - {@emit - result.refs := @[];} -end; - -function tokInfo(const p: TRstParser; const tok: TToken): TLineInfo; -begin - result := newLineInfo(p.filename, p.line+tok.line, p.col+tok.col); -end; - -procedure rstMessage(const p: TRstParser; msgKind: TMsgKind; - const arg: string); overload; -begin - liMessage(tokInfo(p, p.tok[p.idx]), msgKind, arg); -end; - -procedure rstMessage(const p: TRstParser; msgKind: TMsgKind); overload; -begin - liMessage(tokInfo(p, p.tok[p.idx]), msgKind, p.tok[p.idx].symbol); -end; - -function currInd(const p: TRstParser): int; -begin - result := p.indentStack[high(p.indentStack)]; -end; - -procedure pushInd(var p: TRstParser; ind: int); -var - len: int; -begin - len := length(p.indentStack); - setLength(p.indentStack, len+1); - p.indentStack[len] := ind; -end; - -procedure popInd(var p: TRstParser); -begin - if length(p.indentStack) > 1 then - setLength(p.indentStack, length(p.indentStack)-1); -end; - -procedure initParser(var p: TRstParser; sharedState: PSharedState); -begin - {@ignore} - fillChar(p, sizeof(p), 0); - p.tok := nil; - p.indentStack := nil; - pushInd(p, 0); - {@emit - p.indentStack := @[0];} - {@emit - p.tok := @[];} - p.idx := 0; - p.filename := ''; - p.hasToc := false; - p.col := 0; - p.line := 1; - p.s := sharedState; -end; - -// --------------------------------------------------------------- - -procedure addNodesAux(n: PRstNode; var result: string); -var - i: int; -begin - if n.kind = rnLeaf then - add(result, n.text) - else begin - for i := 0 to rsonsLen(n)-1 do - addNodesAux(n.sons[i], result) - end -end; - -function addNodes(n: PRstNode): string; -begin - result := ''; - addNodesAux(n, result); -end; - -procedure rstnodeToRefnameAux(n: PRstNode; var r: string; var b: bool); -var - i: int; -begin - if n.kind = rnLeaf then begin - for i := strStart to length(n.text)+strStart-1 do begin - case n.text[i] of - '0'..'9': begin - if b then begin addChar(r, '-'); b := false; end; - // BUGFIX: HTML id's cannot start with a digit - if length(r) = 0 then addChar(r, 'Z'); - addChar(r, n.text[i]) - end; - 'a'..'z': begin - if b then begin addChar(r, '-'); b := false; end; - addChar(r, n.text[i]) - end; - 'A'..'Z': begin - if b then begin addChar(r, '-'); b := false; end; - addChar(r, chr(ord(n.text[i]) - ord('A') + ord('a'))); - end; - else if (length(r) > 0) then b := true; - end - end - end - else begin - for i := 0 to rsonsLen(n)-1 do rstnodeToRefnameAux(n.sons[i], r, b) - end -end; - -function rstnodeToRefname(n: PRstNode): string; -var - b: bool; -begin - result := ''; - b := false; - rstnodeToRefnameAux(n, result, b); -end; - -function findSub(var p: TRstParser; n: PRstNode): int; -var - key: string; - i: int; -begin - key := addNodes(n); - // the spec says: if no exact match, try one without case distinction: - for i := 0 to high(p.s.subs) do - if key = p.s.subs[i].key then begin - result := i; exit - end; - for i := 0 to high(p.s.subs) do - if cmpIgnoreStyle(key, p.s.subs[i].key) = 0 then begin - result := i; exit - end; - result := -1 -end; - -procedure setSub(var p: TRstParser; const key: string; value: PRstNode); -var - i, len: int; -begin - len := length(p.s.subs); - for i := 0 to len-1 do - if key = p.s.subs[i].key then begin - p.s.subs[i].value := value; exit - end; - setLength(p.s.subs, len+1); - p.s.subs[len].key := key; - p.s.subs[len].value := value; -end; - -procedure setRef(var p: TRstParser; const key: string; value: PRstNode); -var - i, len: int; -begin - len := length(p.s.refs); - for i := 0 to len-1 do - if key = p.s.refs[i].key then begin - p.s.refs[i].value := value; - rstMessage(p, warnRedefinitionOfLabel, key); - exit - end; - setLength(p.s.refs, len+1); - p.s.refs[len].key := key; - p.s.refs[len].value := value; -end; - -function findRef(var p: TRstParser; const key: string): PRstNode; -var - i: int; -begin - for i := 0 to high(p.s.refs) do - if key = p.s.refs[i].key then begin - result := p.s.refs[i].value; exit - end; - result := nil -end; - -function cmpNodes(a, b: PRstNode): int; -var - x, y: PRstNode; -begin - assert(a.kind = rnDefItem); - assert(b.kind = rnDefItem); - x := a.sons[0]; - y := b.sons[0]; - result := cmpIgnoreStyle(addNodes(x), addNodes(y)) -end; - -procedure sortIndex(a: PRstNode); -// we use shellsort here; fast and simple -var - N, i, j, h: int; - v: PRstNode; -begin - assert(a.kind = rnDefList); - N := rsonsLen(a); - h := 1; repeat h := 3*h+1; until h > N; - repeat - h := h div 3; - for i := h to N-1 do begin - v := a.sons[i]; j := i; - while cmpNodes(a.sons[j-h], v) >= 0 do begin - a.sons[j] := a.sons[j-h]; j := j - h; - if j < h then break - end; - a.sons[j] := v; - end; - until h = 1 -end; - -function eqRstNodes(a, b: PRstNode): bool; -var - i: int; -begin - result := false; - if a.kind <> b.kind then exit; - if a.kind = rnLeaf then - result := a.text = b.text - else begin - if rsonsLen(a) <> rsonsLen(b) then exit; - for i := 0 to rsonsLen(a)-1 do - if not eqRstNodes(a.sons[i], b.sons[i]) then exit; - result := true - end -end; - -function matchesHyperlink(h: PRstNode; const filename: string): bool; -var - s: string; -begin - if h.kind = rnInner then begin - assert(rsonsLen(h) = 1); - result := matchesHyperlink(h.sons[0], filename) - end - else if h.kind = rnHyperlink then begin - s := addNodes(h.sons[1]); - if startsWith(s, filename) and (s[length(filename)+strStart] = '#') then - result := true - else - result := false - end - else // this may happen in broken indexes! - result := false -end; - -procedure clearIndex(index: PRstNode; const filename: string); -var - i, j, k, items, lastItem: int; - val: PRstNode; -begin - assert(index.kind = rnDefList); - for i := 0 to rsonsLen(index)-1 do begin - assert(index.sons[i].sons[1].kind = rnDefBody); - val := index.sons[i].sons[1].sons[0]; - if val.kind = rnInner then val := val.sons[0]; - if val.kind = rnBulletList then begin - items := rsonsLen(val); - lastItem := -1; // save the last valid item index - for j := 0 to rsonsLen(val)-1 do begin - if val.sons[j] = nil then - dec(items) - else if matchesHyperlink(val.sons[j].sons[0], filename) then begin - val.sons[j] := nil; - dec(items) - end - else lastItem := j - end; - if items = 1 then // remove bullet list: - index.sons[i].sons[1].sons[0] := val.sons[lastItem].sons[0] - else if items = 0 then - index.sons[i] := nil - end - else if matchesHyperlink(val, filename) then - index.sons[i] := nil - end; - // remove nil nodes: - k := 0; - for i := 0 to rsonsLen(index)-1 do begin - if index.sons[i] <> nil then begin - if k <> i then index.sons[k] := index.sons[i]; - inc(k) - end - end; - setLength(index.sons, k); -end; - -procedure setIndexPair(index, key, val: PRstNode); -var - i: int; - e, a, b: PRstNode; -begin - // writeln(rstnodekindToStr[key.kind], ': ', rstnodekindToStr[val.kind]); - assert(index.kind = rnDefList); - assert(key.kind <> rnDefName); - a := newRstNode(rnDefName); - addSon(a, key); - - for i := 0 to rsonsLen(index)-1 do begin - if eqRstNodes(index.sons[i].sons[0], a) then begin - assert(index.sons[i].sons[1].kind = rnDefBody); - e := index.sons[i].sons[1].sons[0]; - if e.kind <> rnBulletList then begin - e := newRstNode(rnBulletList); - b := newRstNode(rnBulletItem); - addSon(b, index.sons[i].sons[1].sons[0]); - addSon(e, b); - index.sons[i].sons[1].sons[0] := e; - end; - b := newRstNode(rnBulletItem); - addSon(b, val); - addSon(e, b); - - exit // key already exists - end - end; - e := newRstNode(rnDefItem); - assert(val.kind <> rnDefBody); - b := newRstNode(rnDefBody); - addSon(b, val); - addSon(e, a); - addSon(e, b); - addSon(index, e); -end; - -// --------------------------------------------------------------------------- - -function newLeaf(var p: TRstParser): PRstNode; -begin - result := newRstNode(rnLeaf, p.tok[p.idx].symbol) -end; - -function getReferenceName(var p: TRstParser; const endStr: string): PRstNode; -var - res: PRstNode; -begin - res := newRstNode(rnInner); - while true do begin - case p.tok[p.idx].kind of - tkWord, tkOther, tkWhite: addSon(res, newLeaf(p)); - tkPunct: - if p.tok[p.idx].symbol = endStr then begin inc(p.idx); break end - else addSon(res, newLeaf(p)); - else begin - rstMessage(p, errXexpected, endStr); - break - end - end; - inc(p.idx); - end; - result := res; -end; - -function untilEol(var p: TRstParser): PRstNode; -begin - result := newRstNode(rnInner); - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - addSon(result, newLeaf(p)); inc(p.idx); - end -end; - -procedure expect(var p: TRstParser; const tok: string); -begin - if p.tok[p.idx].symbol = tok then inc(p.idx) - else rstMessage(p, errXexpected, tok) -end; - -(* - From the specification: - - The inline markup start-string and end-string recognition rules are as - follows. If any of the conditions are not met, the start-string or end-string - will not be recognized or processed. - - 1. Inline markup start-strings must start a text block or be immediately - preceded by whitespace or one of: ' " ( [ { < - / : - 2. Inline markup start-strings must be immediately followed by - non-whitespace. - 3. Inline markup end-strings must be immediately preceded by non-whitespace. - 4. Inline markup end-strings must end a text block or be immediately - followed by whitespace or one of: ' " ) ] } > - / : . , ; ! ? \ - 5. If an inline markup start-string is immediately preceded by a single or - double quote, "(", "[", "{", or "<", it must not be immediately followed - by the corresponding single or double quote, ")", "]", "}", or ">". - 6. An inline markup end-string must be separated by at least one character - from the start-string. - 7. An unescaped backslash preceding a start-string or end-string will - disable markup recognition, except for the end-string of inline literals. - See Escaping Mechanism above for details. -*) -function isInlineMarkupEnd(const p: TRstParser; const markup: string): bool; -begin - result := p.tok[p.idx].symbol = markup; - if not result then exit; - // Rule 3: - result := not (p.tok[p.idx-1].kind in [tkIndent, tkWhite]); - if not result then exit; - // Rule 4: - result := (p.tok[p.idx+1].kind in [tkIndent, tkWhite, tkEof]) - or (p.tok[p.idx+1].symbol[strStart] in ['''', '"', ')', ']', '}', '>', - '-', '/', '\', ':', '.', ',', - ';', '!', '?', '_']); - if not result then exit; - // Rule 7: - if p.idx > 0 then begin - if (markup <> '``') and (p.tok[p.idx-1].symbol = '\'+'') then begin - result := false - end - end -end; - -function isInlineMarkupStart(const p: TRstParser; const markup: string): bool; -var - c, d: Char; -begin - result := p.tok[p.idx].symbol = markup; - if not result then exit; - // Rule 1: - result := (p.idx = 0) or (p.tok[p.idx-1].kind in [tkIndent, tkWhite]) - or (p.tok[p.idx-1].symbol[strStart] in ['''', '"', '(', '[', '{', '<', - '-', '/', ':', '_']); - if not result then exit; - // Rule 2: - result := not (p.tok[p.idx+1].kind in [tkIndent, tkWhite, tkEof]); - if not result then exit; - // Rule 5 & 7: - if p.idx > 0 then begin - if p.tok[p.idx-1].symbol = '\'+'' then - result := false - else begin - c := p.tok[p.idx-1].symbol[strStart]; - case c of - '''', '"': d := c; - '(': d := ')'; - '[': d := ']'; - '{': d := '}'; - '<': d := '>'; - else d := #0; - end; - if d <> #0 then - result := p.tok[p.idx+1].symbol[strStart] <> d; - end - end -end; - -procedure parseBackslash(var p: TRstParser; father: PRstNode); -begin - assert(p.tok[p.idx].kind = tkPunct); - if p.tok[p.idx].symbol = '\\' then begin - addSon(father, newRstNode(rnLeaf, '\'+'')); - inc(p.idx); - end - else if p.tok[p.idx].symbol = '\'+'' then begin - // XXX: Unicode? - inc(p.idx); - if p.tok[p.idx].kind <> tkWhite then addSon(father, newLeaf(p)); - inc(p.idx); - end - else begin - addSon(father, newLeaf(p)); - inc(p.idx) - end -end; - -function match(const p: TRstParser; start: int; const expr: string): bool; -// regular expressions are: -// special char exact match -// 'w' tkWord -// ' ' tkWhite -// 'a' tkAdornment -// 'i' tkIndent -// 'p' tkPunct -// 'T' always true -// 'E' whitespace, indent or eof -// 'e' tkWord or '#' (for enumeration lists) -var - i, j, last, len: int; - c: char; -begin - i := strStart; - j := start; - last := length(expr)+strStart-1; - while i <= last do begin - case expr[i] of - 'w': result := p.tok[j].kind = tkWord; - ' ': result := p.tok[j].kind = tkWhite; - 'i': result := p.tok[j].kind = tkIndent; - 'p': result := p.tok[j].kind = tkPunct; - 'a': result := p.tok[j].kind = tkAdornment; - 'o': result := p.tok[j].kind = tkOther; - 'T': result := true; - 'E': result := p.tok[j].kind in [tkEof, tkWhite, tkIndent]; - 'e': begin - result := (p.tok[j].kind = tkWord) or (p.tok[j].symbol = '#'+''); - if result then - case p.tok[j].symbol[strStart] of - 'a'..'z', 'A'..'Z': result := length(p.tok[j].symbol) = 1; - '0'..'9': result := allCharsInSet(p.tok[j].symbol, ['0'..'9']); - else begin end - end - end - else begin - c := expr[i]; - len := 0; - while (i <= last) and (expr[i] = c) do begin inc(i); inc(len) end; - dec(i); - result := (p.tok[j].kind in [tkPunct, tkAdornment]) - and (length(p.tok[j].symbol) = len) - and (p.tok[j].symbol[strStart] = c); - end - end; - if not result then exit; - inc(j); - inc(i) - end; - result := true -end; - -procedure fixupEmbeddedRef(n, a, b: PRstNode); -var - i, sep, incr: int; -begin - sep := -1; - for i := rsonsLen(n)-2 downto 0 do - if n.sons[i].text = '<'+'' then begin sep := i; break end; - if (sep > 0) and (n.sons[sep-1].text[strStart] = ' ') then incr := 2 - else incr := 1; - for i := 0 to sep-incr do addSon(a, n.sons[i]); - for i := sep+1 to rsonsLen(n)-2 do addSon(b, n.sons[i]); -end; - -function parsePostfix(var p: TRstParser; n: PRstNode): PRstNode; -var - a, b: PRstNode; -begin - result := n; - if isInlineMarkupEnd(p, '_'+'') then begin - inc(p.idx); - if (p.tok[p.idx-2].symbol ='`'+'') - and (p.tok[p.idx-3].symbol = '>'+'') then begin - a := newRstNode(rnInner); - b := newRstNode(rnInner); - fixupEmbeddedRef(n, a, b); - if rsonsLen(a) = 0 then begin - result := newRstNode(rnStandaloneHyperlink); - addSon(result, b); - end - else begin - result := newRstNode(rnHyperlink); - addSon(result, a); - addSon(result, b); - setRef(p, rstnodeToRefname(a), b); - end - end - else if n.kind = rnInterpretedText then - n.kind := rnRef - else begin - result := newRstNode(rnRef); - addSon(result, n); - end; - end - else if match(p, p.idx, ':w:') then begin - // a role: - if p.tok[p.idx+1].symbol = 'idx' then - n.kind := rnIdx - else if p.tok[p.idx+1].symbol = 'literal' then - n.kind := rnInlineLiteral - else if p.tok[p.idx+1].symbol = 'strong' then - n.kind := rnStrongEmphasis - else if p.tok[p.idx+1].symbol = 'emphasis' then - n.kind := rnEmphasis - else if (p.tok[p.idx+1].symbol = 'sub') - or (p.tok[p.idx+1].symbol = 'subscript') then - n.kind := rnSub - else if (p.tok[p.idx+1].symbol = 'sup') - or (p.tok[p.idx+1].symbol = 'supscript') then - n.kind := rnSup - else begin - result := newRstNode(rnGeneralRole); - n.kind := rnInner; - addSon(result, n); - addSon(result, newRstNode(rnLeaf, p.tok[p.idx+1].symbol)); - end; - inc(p.idx, 3) - end -end; - -function isURL(const p: TRstParser; i: int): bool; -begin - result := (p.tok[i+1].symbol = ':'+'') and (p.tok[i+2].symbol = '//') - and (p.tok[i+3].kind = tkWord) and (p.tok[i+4].symbol = '.'+'') -end; - -procedure parseURL(var p: TRstParser; father: PRstNode); -var - n: PRstNode; -begin - //if p.tok[p.idx].symbol[strStart] = '<' then begin - if isURL(p, p.idx) then begin - n := newRstNode(rnStandaloneHyperlink); - while true do begin - case p.tok[p.idx].kind of - tkWord, tkAdornment, tkOther: begin end; - tkPunct: begin - if not (p.tok[p.idx+1].kind in [tkWord, tkAdornment, tkOther, tkPunct]) - then break - end - else break - end; - addSon(n, newLeaf(p)); - inc(p.idx); - end; - addSon(father, n); - end - else begin - n := newLeaf(p); - inc(p.idx); - if p.tok[p.idx].symbol = '_'+'' then n := parsePostfix(p, n); - addSon(father, n); - end -end; - -procedure parseUntil(var p: TRstParser; father: PRstNode; - const postfix: string; interpretBackslash: bool); -begin - while true do begin - case p.tok[p.idx].kind of - tkPunct: begin - if isInlineMarkupEnd(p, postfix) then begin - inc(p.idx); - break; - end - else if interpretBackslash then - parseBackslash(p, father) - else begin - addSon(father, newLeaf(p)); - inc(p.idx); - end - end; - tkAdornment, tkWord, tkOther: begin - addSon(father, newLeaf(p)); - inc(p.idx); - end; - tkIndent: begin - addSon(father, newRstNode(rnLeaf, ' '+'')); - inc(p.idx); - if p.tok[p.idx].kind = tkIndent then begin - rstMessage(p, errXExpected, postfix); - break - end - end; - tkWhite: begin - addSon(father, newRstNode(rnLeaf, ' '+'')); - inc(p.idx); - end - else - rstMessage(p, errXExpected, postfix); - end - end -end; - -procedure parseInline(var p: TRstParser; father: PRstNode); -var - n: PRstNode; -begin - case p.tok[p.idx].kind of - tkPunct: begin - if isInlineMarkupStart(p, '**') then begin - inc(p.idx); - n := newRstNode(rnStrongEmphasis); - parseUntil(p, n, '**', true); - addSon(father, n); - end - else if isInlineMarkupStart(p, '*'+'') then begin - inc(p.idx); - n := newRstNode(rnEmphasis); - parseUntil(p, n, '*'+'', true); - addSon(father, n); - end - else if isInlineMarkupStart(p, '``') then begin - inc(p.idx); - n := newRstNode(rnInlineLiteral); - parseUntil(p, n, '``', false); - addSon(father, n); - end - else if isInlineMarkupStart(p, '`'+'') then begin - inc(p.idx); - n := newRstNode(rnInterpretedText); - parseUntil(p, n, '`'+'', true); - n := parsePostfix(p, n); - addSon(father, n); - end - else if isInlineMarkupStart(p, '|'+'') then begin - inc(p.idx); - n := newRstNode(rnSubstitutionReferences); - parseUntil(p, n, '|'+'', false); - addSon(father, n); - end - else begin - parseBackslash(p, father); - end; - end; - tkWord: parseURL(p, father); - tkAdornment, tkOther, tkWhite: begin - addSon(father, newLeaf(p)); - inc(p.idx); - end - else assert(false); - end -end; - -function getDirective(var p: TRstParser): string; -var - j: int; -begin - if (p.tok[p.idx].kind = tkWhite) and (p.tok[p.idx+1].kind = tkWord) then begin - j := p.idx; - inc(p.idx); - result := p.tok[p.idx].symbol; - inc(p.idx); - while p.tok[p.idx].kind in [tkWord, tkPunct, tkAdornment, tkOther] do begin - if p.tok[p.idx].symbol = '::' then break; - add(result, p.tok[p.idx].symbol); - inc(p.idx); - end; - if (p.tok[p.idx].kind = tkWhite) then inc(p.idx); - if p.tok[p.idx].symbol = '::' then begin - inc(p.idx); - if (p.tok[p.idx].kind = tkWhite) then inc(p.idx); - end - else begin - p.idx := j; // set back - result := '' // error - end - end - else - result := ''; -end; - -function parseComment(var p: TRstParser): PRstNode; -var - indent: int; -begin - case p.tok[p.idx].kind of - tkIndent, tkEof: begin - if p.tok[p.idx+1].kind = tkIndent then begin - inc(p.idx); - // empty comment - end - else begin - indent := p.tok[p.idx].ival; - while True do begin - case p.tok[p.idx].kind of - tkEof: break; - tkIndent: begin - if (p.tok[p.idx].ival < indent) then break; - end - else begin end - end; - inc(p.idx) - end - end - end - else - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do inc(p.idx); - end; - result := nil; -end; - -type - TDirKind = ( // must be ordered alphabetically! - dkNone, dkAuthor, dkAuthors, dkCodeBlock, dkContainer, - dkContents, dkFigure, dkImage, dkInclude, dkIndex, dkRaw, dkTitle - ); -const - DirIds: array [0..11] of string = ( - '', 'author', 'authors', 'code-block', 'container', - 'contents', 'figure', 'image', 'include', 'index', 'raw', 'title' - ); - -function getDirKind(const s: string): TDirKind; -var - i: int; -begin - i := binaryStrSearch(DirIds, s); - if i >= 0 then result := TDirKind(i) - else result := dkNone -end; - -procedure parseLine(var p: TRstParser; father: PRstNode); -begin - while True do begin - case p.tok[p.idx].kind of - tkWhite, tkWord, tkOther, tkPunct: parseInline(p, father); - else break; - end - end -end; - -procedure parseSection(var p: TRstParser; result: PRstNode); forward; - -function parseField(var p: TRstParser): PRstNode; -var - col, indent: int; - fieldname, fieldbody: PRstNode; -begin - result := newRstNode(rnField); - col := p.tok[p.idx].col; - inc(p.idx); // skip : - fieldname := newRstNode(rnFieldname); - parseUntil(p, fieldname, ':'+'', false); - fieldbody := newRstNode(rnFieldbody); - - if p.tok[p.idx].kind <> tkIndent then - parseLine(p, fieldbody); - if p.tok[p.idx].kind = tkIndent then begin - indent := p.tok[p.idx].ival; - if indent > col then begin - pushInd(p, indent); - parseSection(p, fieldbody); - popInd(p); - end - end; - addSon(result, fieldname); - addSon(result, fieldbody); -end; - -function parseFields(var p: TRstParser): PRstNode; -var - col: int; -begin - result := nil; - if (p.tok[p.idx].kind = tkIndent) - and (p.tok[p.idx+1].symbol = ':'+'') then begin - col := p.tok[p.idx].ival; // BUGFIX! - result := newRstNode(rnFieldList); - inc(p.idx); - while true do begin - addSon(result, parseField(p)); - if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival = col) - and (p.tok[p.idx+1].symbol = ':'+'') then inc(p.idx) - else break - end - end -end; - -function getFieldValue(n: PRstNode; const fieldname: string): string; -var - i: int; - f: PRstNode; -begin - result := ''; - if n.sons[1] = nil then exit; - if (n.sons[1].kind <> rnFieldList) then - InternalError('getFieldValue (2): ' + rstnodeKindToStr[n.sons[1].kind]); - for i := 0 to rsonsLen(n.sons[1])-1 do begin - f := n.sons[1].sons[i]; - if cmpIgnoreStyle(addNodes(f.sons[0]), fieldname) = 0 then begin - result := addNodes(f.sons[1]); - if result = '' then result := #1#1; // indicates that the field exists - exit - end - end -end; - -function getArgument(n: PRstNode): string; -begin - if n.sons[0] = nil then result := '' - else result := addNodes(n.sons[0]); -end; - -function parseDotDot(var p: TRstParser): PRstNode; forward; - -function parseLiteralBlock(var p: TRstParser): PRstNode; -var - indent: int; - n: PRstNode; -begin - result := newRstNode(rnLiteralBlock); - n := newRstNode(rnLeaf, ''); - if p.tok[p.idx].kind = tkIndent then begin - indent := p.tok[p.idx].ival; - inc(p.idx); - while True do begin - case p.tok[p.idx].kind of - tkEof: break; - tkIndent: begin - if (p.tok[p.idx].ival < indent) then begin - break; - end - else begin - add(n.text, nl); - add(n.text, repeatChar(p.tok[p.idx].ival - indent)); - inc(p.idx) - end - end - else begin - add(n.text, p.tok[p.idx].symbol); - inc(p.idx) - end - end - end - end - else begin - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - add(n.text, p.tok[p.idx].symbol); - inc(p.idx) - end - end; - addSon(result, n); -end; - -function getLevel(var map: TLevelMap; var lvl: int; c: Char): int; -begin - if map[c] = 0 then begin - inc(lvl); - map[c] := lvl; - end; - result := map[c] -end; - -function tokenAfterNewline(const p: TRstParser): int; -begin - result := p.idx; - while true do - case p.tok[result].kind of - tkEof: break; - tkIndent: begin inc(result); break end; - else inc(result) - end -end; - -// --------------------------------------------------------------------------- - -function isLineBlock(const p: TRstParser): bool; -var - j: int; -begin - j := tokenAfterNewline(p); - result := (p.tok[p.idx].col = p.tok[j].col) and (p.tok[j].symbol = '|'+'') - or (p.tok[j].col > p.tok[p.idx].col) -end; - -function predNL(const p: TRstParser): bool; -begin - result := true; - if (p.idx > 0) then - result := (p.tok[p.idx-1].kind = tkIndent) - and (p.tok[p.idx-1].ival = currInd(p)) -end; - -function isDefList(const p: TRstParser): bool; -var - j: int; -begin - j := tokenAfterNewline(p); - result := (p.tok[p.idx].col < p.tok[j].col) - and (p.tok[j].kind in [tkWord, tkOther, tkPunct]) - and (p.tok[j-2].symbol <> '::'); -end; - -function whichSection(const p: TRstParser): TRstNodeKind; -begin - case p.tok[p.idx].kind of - tkAdornment: begin - if match(p, p.idx+1, 'ii') then result := rnTransition - else if match(p, p.idx+1, ' a') then result := rnTable - else if match(p, p.idx+1, 'i'+'') then result := rnOverline - else result := rnLeaf - end; - tkPunct: begin - if match(p, tokenAfterNewLine(p), 'ai') then - result := rnHeadline - else if p.tok[p.idx].symbol = '::' then - result := rnLiteralBlock - else if predNL(p) - and ((p.tok[p.idx].symbol = '+'+'') or - (p.tok[p.idx].symbol = '*'+'') or - (p.tok[p.idx].symbol = '-'+'')) - and (p.tok[p.idx+1].kind = tkWhite) then - result := rnBulletList - else if (p.tok[p.idx].symbol = '|'+'') and isLineBlock(p) then - result := rnLineBlock - else if (p.tok[p.idx].symbol = '..') and predNL(p) then - result := rnDirective - else if (p.tok[p.idx].symbol = ':'+'') and predNL(p) then - result := rnFieldList - else if match(p, p.idx, '(e) ') then - result := rnEnumList - else if match(p, p.idx, '+a+') then begin - result := rnGridTable; - rstMessage(p, errGridTableNotImplemented); - end - else if isDefList(p) then - result := rnDefList - else if match(p, p.idx, '-w') or match(p, p.idx, '--w') - or match(p, p.idx, '/w') then - result := rnOptionList - else - result := rnParagraph - end; - tkWord, tkOther, tkWhite: begin - if match(p, tokenAfterNewLine(p), 'ai') then - result := rnHeadline - else if isDefList(p) then - result := rnDefList - else if match(p, p.idx, 'e) ') or match(p, p.idx, 'e. ') then - result := rnEnumList - else - result := rnParagraph; - end; - else result := rnLeaf; - end -end; - -function parseLineBlock(var p: TRstParser): PRstNode; -var - col: int; - item: PRstNode; -begin - result := nil; - if p.tok[p.idx+1].kind = tkWhite then begin - col := p.tok[p.idx].col; - result := newRstNode(rnLineBlock); - pushInd(p, p.tok[p.idx+2].col); - inc(p.idx, 2); - while true do begin - item := newRstNode(rnLineBlockItem); - parseSection(p, item); - addSon(result, item); - if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival = col) - and (p.tok[p.idx+1].symbol = '|'+'') - and (p.tok[p.idx+2].kind = tkWhite) then inc(p.idx, 3) - else break; - end; - popInd(p); - end; -end; - -procedure parseParagraph(var p: TRstParser; result: PRstNode); -begin - while True do begin - case p.tok[p.idx].kind of - tkIndent: begin - if p.tok[p.idx+1].kind = tkIndent then begin - inc(p.idx); - break - end - else if (p.tok[p.idx].ival = currInd(p)) then begin - inc(p.idx); - case whichSection(p) of - rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: - addSon(result, newRstNode(rnLeaf, ' '+'')); - rnLineBlock: addSonIfNotNil(result, parseLineBlock(p)); - else break; - end; - end - else break - end; - tkPunct: begin - if (p.tok[p.idx].symbol = '::') and (p.tok[p.idx+1].kind = tkIndent) - and (currInd(p) < p.tok[p.idx+1].ival) then begin - addSon(result, newRstNode(rnLeaf, ':'+'')); - inc(p.idx); // skip '::' - addSon(result, parseLiteralBlock(p)); - break - end - else - parseInline(p, result) - end; - tkWhite, tkWord, tkAdornment, tkOther: - parseInline(p, result); - else break; - end - end -end; - -function parseParagraphWrapper(var p: TRstParser): PRstNode; -begin - result := newRstNode(rnParagraph); - parseParagraph(p, result); -end; - -function parseHeadline(var p: TRstParser): PRstNode; -var - c: Char; -begin - result := newRstNode(rnHeadline); - parseLine(p, result); - assert(p.tok[p.idx].kind = tkIndent); - assert(p.tok[p.idx+1].kind = tkAdornment); - c := p.tok[p.idx+1].symbol[strStart]; - inc(p.idx, 2); - result.level := getLevel(p.s.underlineToLevel, p.s.uLevel, c); -end; - -type - TIntSeq = array of int; - -function tokEnd(const p: TRstParser): int; -begin - result := p.tok[p.idx].col + length(p.tok[p.idx].symbol) - 1; -end; - -procedure getColumns(var p: TRstParser; var cols: TIntSeq); -var - L: int; -begin - L := 0; - while true do begin - inc(L); - setLength(cols, L); - cols[L-1] := tokEnd(p); - assert(p.tok[p.idx].kind = tkAdornment); - inc(p.idx); - if p.tok[p.idx].kind <> tkWhite then break; - inc(p.idx); - if p.tok[p.idx].kind <> tkAdornment then break - end; - if p.tok[p.idx].kind = tkIndent then inc(p.idx); - // last column has no limit: - cols[L-1] := 32000; -end; - -function parseDoc(var p: TRstParser): PRstNode; forward; - -function parseSimpleTable(var p: TRstParser): PRstNode; -var - cols: TIntSeq; - row: array of string; - j, i, last, line: int; - c: Char; - q: TRstParser; - a, b: PRstNode; -begin - result := newRstNode(rnTable); -{@ignore} - cols := nil; - row := nil; -{@emit - cols := @[];} -{@emit - row := @[];} - a := nil; - c := p.tok[p.idx].symbol[strStart]; - while true do begin - if p.tok[p.idx].kind = tkAdornment then begin - last := tokenAfterNewline(p); - if p.tok[last].kind in [tkEof, tkIndent] then begin - // skip last adornment line: - p.idx := last; break - end; - getColumns(p, cols); - setLength(row, length(cols)); - if a <> nil then - for j := 0 to rsonsLen(a)-1 do a.sons[j].kind := rnTableHeaderCell; - end; - if p.tok[p.idx].kind = tkEof then break; - for j := 0 to high(row) do row[j] := ''; - // the following while loop iterates over the lines a single cell may span: - line := p.tok[p.idx].line; - while true do begin - i := 0; - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - if (tokEnd(p) <= cols[i]) then begin - add(row[i], p.tok[p.idx].symbol); - inc(p.idx); - end - else begin - if p.tok[p.idx].kind = tkWhite then inc(p.idx); - inc(i) - end - end; - if p.tok[p.idx].kind = tkIndent then inc(p.idx); - if tokEnd(p) <= cols[0] then break; - if p.tok[p.idx].kind in [tkEof, tkAdornment] then break; - for j := 1 to high(row) do addChar(row[j], #10); - end; - // process all the cells: - a := newRstNode(rnTableRow); - for j := 0 to high(row) do begin - initParser(q, p.s); - q.col := cols[j]; - q.line := line-1; - q.filename := p.filename; - getTokens(row[j], false, q.tok); - b := newRstNode(rnTableDataCell); - addSon(b, parseDoc(q)); - addSon(a, b); - end; - addSon(result, a); - end; -end; - -function parseTransition(var p: TRstParser): PRstNode; -begin - result := newRstNode(rnTransition); - inc(p.idx); - if p.tok[p.idx].kind = tkIndent then inc(p.idx); - if p.tok[p.idx].kind = tkIndent then inc(p.idx); -end; - -function parseOverline(var p: TRstParser): PRstNode; -var - c: char; -begin - c := p.tok[p.idx].symbol[strStart]; - inc(p.idx, 2); - result := newRstNode(rnOverline); - while true do begin - parseLine(p, result); - if p.tok[p.idx].kind = tkIndent then begin - inc(p.idx); - if p.tok[p.idx-1].ival > currInd(p) then - addSon(result, newRstNode(rnLeaf, ' '+'')) - else - break - end - else break - end; - result.level := getLevel(p.s.overlineToLevel, p.s.oLevel, c); - if p.tok[p.idx].kind = tkAdornment then begin - inc(p.idx); // XXX: check? - if p.tok[p.idx].kind = tkIndent then inc(p.idx); - end -end; - -function parseBulletList(var p: TRstParser): PRstNode; -var - bullet: string; - col: int; - item: PRstNode; -begin - result := nil; - if p.tok[p.idx+1].kind = tkWhite then begin - bullet := p.tok[p.idx].symbol; - col := p.tok[p.idx].col; - result := newRstNode(rnBulletList); - pushInd(p, p.tok[p.idx+2].col); - inc(p.idx, 2); - while true do begin - item := newRstNode(rnBulletItem); - parseSection(p, item); - addSon(result, item); - if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival = col) - and (p.tok[p.idx+1].symbol = bullet) - and (p.tok[p.idx+2].kind = tkWhite) then inc(p.idx, 3) - else break; - end; - popInd(p); - end; -end; - -function parseOptionList(var p: TRstParser): PRstNode; -var - a, b, c: PRstNode; - j: int; -begin - result := newRstNode(rnOptionList); - while true do begin - if match(p, p.idx, '-w') - or match(p, p.idx, '--w') - or match(p, p.idx, '/w') then begin - a := newRstNode(rnOptionGroup); - b := newRstNode(rnDescription); - c := newRstNode(rnOptionListItem); - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - if (p.tok[p.idx].kind = tkWhite) - and (length(p.tok[p.idx].symbol) > 1) then begin - inc(p.idx); break - end; - addSon(a, newLeaf(p)); - inc(p.idx); - end; - j := tokenAfterNewline(p); - if (j > 0) and (p.tok[j-1].kind = tkIndent) - and (p.tok[j-1].ival > currInd(p)) then begin - pushInd(p, p.tok[j-1].ival); - parseSection(p, b); - popInd(p); - end - else begin - parseLine(p, b); - end; - if (p.tok[p.idx].kind = tkIndent) then inc(p.idx); - addSon(c, a); - addSon(c, b); - addSon(result, c); - end - else break; - end -end; - -function parseDefinitionList(var p: TRstParser): PRstNode; -var - j, col: int; - a, b, c: PRstNode; -begin - result := nil; - j := tokenAfterNewLine(p)-1; - if (j >= 1) and (p.tok[j].kind = tkIndent) - and (p.tok[j].ival > currInd(p)) and (p.tok[j-1].symbol <> '::') then begin - col := p.tok[p.idx].col; - result := newRstNode(rnDefList); - while true do begin - j := p.idx; - a := newRstNode(rnDefName); - parseLine(p, a); - //writeln('after def line: ', p.tok[p.idx].ival :1, ' ', col : 1); - if (p.tok[p.idx].kind = tkIndent) - and (p.tok[p.idx].ival > currInd(p)) - and (p.tok[p.idx+1].symbol <> '::') - and not (p.tok[p.idx+1].kind in [tkIndent, tkEof]) then begin - pushInd(p, p.tok[p.idx].ival); - b := newRstNode(rnDefBody); - parseSection(p, b); - c := newRstNode(rnDefItem); - addSon(c, a); - addSon(c, b); - addSon(result, c); - popInd(p); - end - else begin - p.idx := j; - break - end; - if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival = col) then begin - inc(p.idx); - j := tokenAfterNewLine(p)-1; - if (j >= 1) and (p.tok[j].kind = tkIndent) - and (p.tok[j].ival > col) - and (p.tok[j-1].symbol <> '::') - and (p.tok[j+1].kind <> tkIndent) then begin end - else break - end - end; - if rsonsLen(result) = 0 then result := nil - end -end; - -function parseEnumList(var p: TRstParser): PRstNode; -const - wildcards: array [0..2] of string = ('(e) ', 'e) ', 'e. '); - wildpos: array [0..2] of int = (1, 0, 0); -var - w, col, j: int; - item: PRstNode; -begin - result := nil; - w := 0; - while w <= 2 do begin - if match(p, p.idx, wildcards[w]) then break; - inc(w); - end; - if w <= 2 then begin - col := p.tok[p.idx].col; - result := newRstNode(rnEnumList); - inc(p.idx, wildpos[w]+3); - j := tokenAfterNewLine(p); - if (p.tok[j].col = p.tok[p.idx].col) or match(p, j, wildcards[w]) then begin - pushInd(p, p.tok[p.idx].col); - while true do begin - item := newRstNode(rnEnumItem); - parseSection(p, item); - addSon(result, item); - if (p.tok[p.idx].kind = tkIndent) - and (p.tok[p.idx].ival = col) - and match(p, p.idx+1, wildcards[w]) then - inc(p.idx, wildpos[w]+4) - else - break - end; - popInd(p); - end - else begin - dec(p.idx, wildpos[w]+3); - result := nil - end - end -end; - -function sonKind(father: PRstNode; i: int): TRstNodeKind; -begin - result := rnLeaf; - if i < rsonsLen(father) then result := father.sons[i].kind; -end; - -procedure parseSection(var p: TRstParser; result: PRstNode); -var - a: PRstNode; - k: TRstNodeKind; - leave: bool; -begin - while true do begin - leave := false; - assert(p.idx >= 0); - while p.tok[p.idx].kind = tkIndent do begin - if currInd(p) = p.tok[p.idx].ival then begin - inc(p.idx); - end - else if p.tok[p.idx].ival > currInd(p) then begin - pushInd(p, p.tok[p.idx].ival); - a := newRstNode(rnBlockQuote); - parseSection(p, a); - addSon(result, a); - popInd(p); - end - else begin - leave := true; - break; - end - end; - if leave then break; - if p.tok[p.idx].kind = tkEof then break; - a := nil; - k := whichSection(p); - case k of - rnLiteralBlock: begin - inc(p.idx); // skip '::' - a := parseLiteralBlock(p); - end; - rnBulletList: a := parseBulletList(p); - rnLineblock: a := parseLineBlock(p); - rnDirective: a := parseDotDot(p); - rnEnumList: a := parseEnumList(p); - rnLeaf: begin - rstMessage(p, errNewSectionExpected); - end; - rnParagraph: begin end; - rnDefList: a := parseDefinitionList(p); - rnFieldList: begin - dec(p.idx); - a := parseFields(p); - end; - rnTransition: a := parseTransition(p); - rnHeadline: a := parseHeadline(p); - rnOverline: a := parseOverline(p); - rnTable: a := parseSimpleTable(p); - rnOptionList: a := parseOptionList(p); - else InternalError('rst.parseSection()'); - end; - if (a = nil) and (k <> rnDirective) then begin - a := newRstNode(rnParagraph); - parseParagraph(p, a); - end; - addSonIfNotNil(result, a); - end; - if (sonKind(result, 0) = rnParagraph) - and (sonKind(result, 1) <> rnParagraph) then - result.sons[0].kind := rnInner; -end; - -function parseSectionWrapper(var p: TRstParser): PRstNode; -begin - result := newRstNode(rnInner); - parseSection(p, result); - while (result.kind = rnInner) and (rsonsLen(result) = 1) do - result := result.sons[0] -end; - -function parseDoc(var p: TRstParser): PRstNode; -begin - result := parseSectionWrapper(p); - if p.tok[p.idx].kind <> tkEof then - rstMessage(p, errGeneralParseError); -end; - -type - TDirFlag = (hasArg, hasOptions, argIsFile); - TDirFlags = set of TDirFlag; - TSectionParser = function (var p: TRstParser): PRstNode; - -function parseDirective(var p: TRstParser; flags: TDirFlags; - contentParser: TSectionParser): PRstNode; -var - args, options, content: PRstNode; -begin - result := newRstNode(rnDirective); - args := nil; - options := nil; - if hasArg in flags then begin - args := newRstNode(rnDirArg); - if argIsFile in flags then begin - while True do begin - case p.tok[p.idx].kind of - tkWord, tkOther, tkPunct, tkAdornment: begin - addSon(args, newLeaf(p)); - inc(p.idx); - end; - else break; - end - end - end - else begin - parseLine(p, args); - end - end; - addSon(result, args); - if hasOptions in flags then begin - if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival >= 3) - and (p.tok[p.idx+1].symbol = ':'+'') then - options := parseFields(p); - end; - addSon(result, options); - if (assigned(contentParser)) and (p.tok[p.idx].kind = tkIndent) - and (p.tok[p.idx].ival > currInd(p)) then begin - pushInd(p, p.tok[p.idx].ival); - content := contentParser(p); - popInd(p); - addSon(result, content) - end - else - addSon(result, nil); -end; - -function dirInclude(var p: TRstParser): PRstNode; -(* -The following options are recognized: - -start-after : text to find in the external data file - Only the content after the first occurrence of the specified text will - be included. -end-before : text to find in the external data file - Only the content before the first occurrence of the specified text - (but after any after text) will be included. -literal : flag (empty) - The entire included text is inserted into the document as a single - literal block (useful for program listings). -encoding : name of text encoding - The text encoding of the external data file. Defaults to the document's - encoding (if specified). -*) -var - n: PRstNode; - filename, path: string; - q: TRstParser; -begin - result := nil; - n := parseDirective(p, {@set}[hasArg, argIsFile, hasOptions], nil); - filename := strip(addNodes(n.sons[0])); - path := findFile(filename); - if path = '' then - rstMessage(p, errCannotOpenFile, filename) - else begin - // XXX: error handling; recursive file inclusion! - if getFieldValue(n, 'literal') <> '' then begin - result := newRstNode(rnLiteralBlock); - addSon(result, newRstNode(rnLeaf, readFile(path))); - end - else begin - initParser(q, p.s); - q.filename := filename; - getTokens(readFile(path), false, q.tok); - // workaround a GCC bug: - if find(q.tok[high(q.tok)].symbol, #0#1#2) > 0 then begin - InternalError('Too many binary zeros in include file'); - end; - result := parseDoc(q); - end - end -end; - -function dirCodeBlock(var p: TRstParser): PRstNode; -var - n: PRstNode; - filename, path: string; -begin - result := parseDirective(p, {@set}[hasArg, hasOptions], parseLiteralBlock); - filename := strip(getFieldValue(result, 'file')); - if filename <> '' then begin - path := findFile(filename); - if path = '' then rstMessage(p, errCannotOpenFile, filename); - n := newRstNode(rnLiteralBlock); - addSon(n, newRstNode(rnLeaf, readFile(path))); - result.sons[2] := n; - end; - result.kind := rnCodeBlock; -end; - -function dirContainer(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[hasArg], parseSectionWrapper); - assert(result.kind = rnDirective); - assert(rsonsLen(result) = 3); - result.kind := rnContainer; -end; - -function dirImage(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[hasOptions, hasArg, argIsFile], nil); - result.kind := rnImage -end; - -function dirFigure(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[hasOptions, hasArg, argIsFile], - parseSectionWrapper); - result.kind := rnFigure -end; - -function dirTitle(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[hasArg], nil); - result.kind := rnTitle -end; - -function dirContents(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[hasArg], nil); - result.kind := rnContents -end; - -function dirIndex(var p: TRstParser): PRstNode; -begin - result := parseDirective(p, {@set}[], parseSectionWrapper); - result.kind := rnIndex -end; - -function dirRaw(var p: TRstParser): PRstNode; -(* -The following options are recognized: - -file : string (newlines removed) - The local filesystem path of a raw data file to be included. -url : string (whitespace removed) - An Internet URL reference to a raw data file to be included. -encoding : name of text encoding - The text encoding of the external raw data (file or URL). - Defaults to the document's encoding (if specified). -*) -var - filename, path, f: string; -begin - result := parseDirective(p, {@set}[hasOptions], parseSectionWrapper); - result.kind := rnRaw; - filename := getFieldValue(result, 'file'); - if filename <> '' then begin - path := findFile(filename); - if path = '' then - rstMessage(p, errCannotOpenFile, filename) - else begin - f := readFile(path); - result := newRstNode(rnRaw); - addSon(result, newRstNode(rnLeaf, f)); - end - end -end; - -function parseDotDot(var p: TRstParser): PRstNode; -var - d: string; - col: int; - a, b: PRstNode; -begin - result := nil; - col := p.tok[p.idx].col; - inc(p.idx); - d := getDirective(p); - if d <> '' then begin - pushInd(p, col); - case getDirKind(d) of - dkInclude: result := dirInclude(p); - dkImage: result := dirImage(p); - dkFigure: result := dirFigure(p); - dkTitle: result := dirTitle(p); - dkContainer: result := dirContainer(p); - dkContents: result := dirContents(p); - dkRaw: result := dirRaw(p); - dkCodeblock: result := dirCodeBlock(p); - dkIndex: result := dirIndex(p); - else rstMessage(p, errInvalidDirectiveX, d); - end; - popInd(p); - end - else if match(p, p.idx, ' _') then begin - // hyperlink target: - inc(p.idx, 2); - a := getReferenceName(p, ':'+''); - if p.tok[p.idx].kind = tkWhite then inc(p.idx); - b := untilEol(p); - setRef(p, rstnodeToRefname(a), b); - end - else if match(p, p.idx, ' |') then begin - // substitution definitions: - inc(p.idx, 2); - a := getReferenceName(p, '|'+''); - if p.tok[p.idx].kind = tkWhite then inc(p.idx); - if cmpIgnoreStyle(p.tok[p.idx].symbol, 'replace') = 0 then begin - inc(p.idx); - expect(p, '::'); - b := untilEol(p); - end - else if cmpIgnoreStyle(p.tok[p.idx].symbol, 'image') = 0 then begin - inc(p.idx); - b := dirImage(p); - end - else - rstMessage(p, errInvalidDirectiveX, p.tok[p.idx].symbol); - setSub(p, addNodes(a), b); - end - else if match(p, p.idx, ' [') then begin - // footnotes, citations - inc(p.idx, 2); - a := getReferenceName(p, ']'+''); - if p.tok[p.idx].kind = tkWhite then inc(p.idx); - b := untilEol(p); - setRef(p, rstnodeToRefname(a), b); - end - else - result := parseComment(p); -end; - -function resolveSubs(var p: TRstParser; n: PRstNode): PRstNode; -var - i, x: int; - y: PRstNode; - e, key: string; -begin - result := n; - if n = nil then exit; - case n.kind of - rnSubstitutionReferences: begin - x := findSub(p, n); - if x >= 0 then result := p.s.subs[x].value - else begin - key := addNodes(n); - e := getEnv(key); - if e <> '' then result := newRstNode(rnLeaf, e) - else rstMessage(p, warnUnknownSubstitutionX, key); - end - end; - rnRef: begin - y := findRef(p, rstnodeToRefname(n)); - if y <> nil then begin - result := newRstNode(rnHyperlink); - n.kind := rnInner; - addSon(result, n); - addSon(result, y); - end - end; - rnLeaf: begin end; - rnContents: p.hasToc := true; - else begin - for i := 0 to rsonsLen(n)-1 do - n.sons[i] := resolveSubs(p, n.sons[i]); - end - end -end; - -function rstParse(const text: string; // the text to be parsed - skipPounds: bool; - const filename: string; // for error messages - line, column: int; - var hasToc: bool): PRstNode; -var - p: TRstParser; -begin - if isNil(text) then - rawMessage(errCannotOpenFile, filename); - initParser(p, newSharedState()); - p.filename := filename; - p.line := line; - p.col := column; - getTokens(text, skipPounds, p.tok); - result := resolveSubs(p, parseDoc(p)); - hasToc := p.hasToc; -end; - -end. diff --git a/nim/scanner.pas b/nim/scanner.pas deleted file mode 100755 index c03ae9224e..0000000000 --- a/nim/scanner.pas +++ /dev/null @@ -1,1036 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit scanner; - -// This scanner is handwritten for efficiency. I used an elegant buffering -// scheme which I have not seen anywhere else: -// We guarantee that a whole line is in the buffer. Thus only when scanning -// the \n or \r character we have to check wether we need to read in the next -// chunk. (\n or \r already need special handling for incrementing the line -// counter; choosing both \n and \r allows the scanner to properly read Unix, -// DOS or Macintosh text files, even when it is not the native format. - -interface - -{$include 'config.inc'} - -uses - charsets, nsystem, sysutils, nhashes, options, msgs, strutils, platform, - idents, lexbase, llstream, wordrecg; - -const - MaxLineLength = 80; // lines longer than this lead to a warning - - numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; - SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255]; - SymStartChars: TCharSet = ['a'..'z', 'A'..'Z', #128..#255]; - OpChars: TCharSet = ['+', '-', '*', '/', '\', '<', '>', '!', '?', '^', '.', - '|', '=', '%', '&', '$', '@', '~', #128..#255]; - -type - TTokType = (tkInvalid, tkEof, // order is important here! - tkSymbol, - // keywords: - //[[[cog - //from string import split, capitalize - //keywords = split(open("data/keywords.txt").read()) - //idents = "" - //strings = "" - //i = 1 - //for k in keywords: - // idents = idents + "tk" + capitalize(k) + ", " - // strings = strings + "'" + k + "', " - // if i % 4 == 0: - // idents = idents + "\n" - // strings = strings + "\n" - // i = i + 1 - //cog.out(idents) - //]]] - tkAddr, tkAnd, tkAs, tkAsm, - tkBind, tkBlock, tkBreak, tkCase, - tkCast, tkConst, tkContinue, tkConverter, - tkDiscard, tkDistinct, tkDiv, tkElif, - tkElse, tkEnd, tkEnum, tkExcept, - tkFinally, tkFor, tkFrom, tkGeneric, - tkIf, tkImplies, tkImport, tkIn, - tkInclude, tkIs, tkIsnot, tkIterator, - tkLambda, tkMacro, tkMethod, tkMod, - tkNil, tkNot, tkNotin, tkObject, - tkOf, tkOr, tkOut, tkProc, - tkPtr, tkRaise, tkRef, tkReturn, - tkShl, tkShr, tkTemplate, tkTry, - tkTuple, tkType, tkVar, tkWhen, - tkWhile, tkWith, tkWithout, tkXor, - tkYield, - //[[[end]]] - tkIntLit, tkInt8Lit, tkInt16Lit, tkInt32Lit, tkInt64Lit, - tkFloatLit, tkFloat32Lit, tkFloat64Lit, - tkStrLit, tkRStrLit, tkTripleStrLit, tkCallRStrLit, tkCallTripleStrLit, - tkCharLit, tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, // [. and .] - tkCurlyDotLe, tkCurlyDotRi, // {. and .} - tkParDotLe, tkParDotRi, // (. and .) - tkComma, tkSemiColon, tkColon, - tkEquals, tkDot, tkDotDot, tkHat, tkOpr, - tkComment, tkAccent, tkInd, tkSad, tkDed, - // pseudo token types used by the source renderers: - tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr - ); - TTokTypes = set of TTokType; -const - tokKeywordLow = succ(tkSymbol); - tokKeywordHigh = pred(tkIntLit); - tokOperators: TTokTypes = {@set}[tkOpr, tkSymbol, tkBracketLe, tkBracketRi, - tkIn, tkIs, tkIsNot, tkEquals, tkDot, tkHat, tkNot, tkAnd, tkOr, tkXor, - tkShl, tkShr, tkDiv, tkMod, tkNotIn]; - - TokTypeToStr: array [TTokType] of string = ( - 'tkInvalid', '[EOF]', - 'tkSymbol', - //[[[cog - //cog.out(strings) - //]]] - 'addr', 'and', 'as', 'asm', - 'bind', 'block', 'break', 'case', - 'cast', 'const', 'continue', 'converter', - 'discard', 'distinct', 'div', 'elif', - 'else', 'end', 'enum', 'except', - 'finally', 'for', 'from', 'generic', - 'if', 'implies', 'import', 'in', - 'include', 'is', 'isnot', 'iterator', - 'lambda', 'macro', 'method', 'mod', - 'nil', 'not', 'notin', 'object', - 'of', 'or', 'out', 'proc', - 'ptr', 'raise', 'ref', 'return', - 'shl', 'shr', 'template', 'try', - 'tuple', 'type', 'var', 'when', - 'while', 'with', 'without', 'xor', - 'yield', - //[[[end]]] - 'tkIntLit', 'tkInt8Lit', 'tkInt16Lit', 'tkInt32Lit', 'tkInt64Lit', - 'tkFloatLit', 'tkFloat32Lit', 'tkFloat64Lit', - 'tkStrLit', 'tkRStrLit', 'tkTripleStrLit', - 'tkCallRStrLit', 'tkCallTripleStrLit', - 'tkCharLit', - '('+'', ')'+'', '['+'', ']'+'', '{'+'', '}'+'', - '[.', '.]', '{.', '.}', '(.', '.)', ','+'', ';'+'', ':'+'', - '='+'', '.'+'', '..', '^'+'', 'tkOpr', - 'tkComment', '`'+'', '[new indentation]', '[same indentation]', - '[dedentation]', - 'tkSpaces', 'tkInfixOpr', 'tkPrefixOpr', 'tkPostfixOpr' - ); - -type - TNumericalBase = (base10, // base10 is listed as the first element, - // so that it is the correct default value - base2, - base8, - base16); - PToken = ^TToken; - TToken = object // a Nimrod token - tokType: TTokType; // the type of the token - indent: int; // the indentation; only valid if tokType = tkIndent - ident: PIdent; // the parsed identifier - iNumber: BiggestInt; // the parsed integer literal - fNumber: BiggestFloat; // the parsed floating point literal - base: TNumericalBase; // the numerical base; only valid for int - // or float literals - literal: string; // the parsed (string) literal; and - // documentation comments are here too - next: PToken; // next token; can be used for arbitrary look-ahead - end; - - PLexer = ^TLexer; - TLexer = object(TBaseLexer) - filename: string; - indentStack: array of int; // the indentation stack - dedent: int; // counter for DED token generation - indentAhead: int; // if > 0 an indendation has already been read - // this is needed because scanning comments - // needs so much look-ahead - end; - -var - gLinesCompiled: int; // all lines that have been compiled - -procedure pushInd(var L: TLexer; indent: int); -procedure popInd(var L: TLexer); - -function isKeyword(kind: TTokType): boolean; - -procedure openLexer(out lex: TLexer; const filename: string; - inputstream: PLLStream); - -procedure rawGetTok(var L: TLexer; var tok: TToken); -// reads in the next token into tok and skips it - -function getColumn(const L: TLexer): int; - -function getLineInfo(const L: TLexer): TLineInfo; - -procedure closeLexer(var lex: TLexer); - -procedure PrintTok(tok: PToken); -function tokToStr(tok: PToken): string; - -// auxiliary functions: -procedure lexMessage(const L: TLexer; const msg: TMsgKind; - const arg: string = ''); - -// the Pascal scanner uses this too: -procedure fillToken(var L: TToken); - -implementation - -function isKeyword(kind: TTokType): boolean; -begin - result := (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) -end; - -procedure pushInd(var L: TLexer; indent: int); -var - len: int; -begin - len := length(L.indentStack); - setLength(L.indentStack, len+1); - if (indent > L.indentStack[len-1]) then - L.indentstack[len] := indent - else - InternalError('pushInd'); - //writeln('push indent ', indent); -end; - -procedure popInd(var L: TLexer); -var - len: int; -begin - len := length(L.indentStack); - setLength(L.indentStack, len-1); -end; - -function findIdent(const L: TLexer; indent: int): boolean; -var - i: int; -begin - for i := length(L.indentStack)-1 downto 0 do - if L.indentStack[i] = indent then begin result := true; exit end; - result := false -end; - -function tokToStr(tok: PToken): string; -begin - case tok.tokType of - tkIntLit..tkInt64Lit: - result := toString(tok.iNumber); - tkFloatLit..tkFloat64Lit: - result := toStringF(tok.fNumber); - tkInvalid, tkStrLit..tkCharLit, tkComment: - result := tok.literal; - tkParLe..tkColon, tkEof, tkInd, tkSad, tkDed, tkAccent: - result := tokTypeToStr[tok.tokType]; - else if (tok.ident <> nil) then - result := tok.ident.s - else begin - InternalError('tokToStr'); - result := '' - end - end -end; - -procedure PrintTok(tok: PToken); -begin - write(output, TokTypeToStr[tok.tokType]); - write(output, ' '+''); - writeln(output, tokToStr(tok)) -end; - -// ---------------------------------------------------------------------------- - -var - dummyIdent: PIdent; - -procedure fillToken(var L: TToken); -begin - L.TokType := tkInvalid; - L.iNumber := 0; - L.Indent := 0; - L.literal := ''; - L.fNumber := 0.0; - L.base := base10; - L.ident := dummyIdent; // this prevents many bugs! -end; - -procedure openLexer(out lex: TLexer; const filename: string; - inputstream: PLLStream); -begin -{@ignore} - FillChar(lex, sizeof(lex), 0); -{@emit} - openBaseLexer(lex, inputstream); -{@ignore} - setLength(lex.indentStack, 1); - lex.indentStack[0] := 0; -{@emit lex.indentStack := @[0]; } - lex.filename := filename; - lex.indentAhead := -1; -end; - -procedure closeLexer(var lex: TLexer); -begin - inc(gLinesCompiled, lex.LineNumber); - closeBaseLexer(lex); -end; - -function getColumn(const L: TLexer): int; -begin - result := getColNumber(L, L.bufPos) -end; - -function getLineInfo(const L: TLexer): TLineInfo; -begin - result := newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) -end; - -procedure lexMessage(const L: TLexer; const msg: TMsgKind; - const arg: string = ''); -begin - msgs.liMessage(getLineInfo(L), msg, arg) -end; - -procedure lexMessagePos(var L: TLexer; const msg: TMsgKind; pos: int; - const arg: string = ''); -var - info: TLineInfo; -begin - info := newLineInfo(L.filename, L.linenumber, pos - L.lineStart); - msgs.liMessage(info, msg, arg); -end; - -// ---------------------------------------------------------------------------- - -procedure matchUnderscoreChars(var L: TLexer; var tok: TToken; - const chars: TCharSet); -// matches ([chars]_)* -var - pos: int; - buf: PChar; -begin - pos := L.bufpos; // use registers for pos, buf - buf := L.buf; - repeat - if buf[pos] in chars then begin - addChar(tok.literal, buf[pos]); - Inc(pos) - end - else break; - if buf[pos] = '_' then begin - addChar(tok.literal, '_'); - Inc(pos); - end; - until false; - L.bufPos := pos; -end; - -function matchTwoChars(const L: TLexer; first: Char; - const second: TCharSet): Boolean; -begin - result := (L.buf[L.bufpos] = first) and (L.buf[L.bufpos+1] in Second); -end; - -function isFloatLiteral(const s: string): boolean; -var - i: int; -begin - for i := strStart to length(s)+strStart-1 do - if s[i] in ['.','e','E'] then begin - result := true; exit - end; - result := false -end; - -function GetNumber(var L: TLexer): TToken; -var - pos, endpos: int; - xi: biggestInt; -begin - // get the base: - result.tokType := tkIntLit; // int literal until we know better - result.literal := ''; - result.base := base10; // BUGFIX - pos := L.bufpos; - // make sure the literal is correct for error messages: - matchUnderscoreChars(L, result, ['A'..'Z', 'a'..'z', '0'..'9']); - if (L.buf[L.bufpos] = '.') and (L.buf[L.bufpos+1] in ['0'..'9']) then begin - addChar(result.literal, '.'); - inc(L.bufpos); - //matchUnderscoreChars(L, result, ['A'..'Z', 'a'..'z', '0'..'9']) - matchUnderscoreChars(L, result, ['0'..'9']); - if L.buf[L.bufpos] in ['e', 'E'] then begin - addChar(result.literal, 'e'); - inc(L.bufpos); - if L.buf[L.bufpos] in ['+', '-'] then begin - addChar(result.literal, L.buf[L.bufpos]); - inc(L.bufpos); - end; - matchUnderscoreChars(L, result, ['0'..'9']); - end - end; - endpos := L.bufpos; - if L.buf[endpos] = '''' then begin - //matchUnderscoreChars(L, result, ['''', 'f', 'F', 'i', 'I', '0'..'9']); - inc(endpos); - L.bufpos := pos; // restore position - case L.buf[endpos] of - 'f', 'F': begin - inc(endpos); - if (L.buf[endpos] = '6') and (L.buf[endpos+1] = '4') then begin - result.tokType := tkFloat64Lit; - inc(endpos, 2); - end - else if (L.buf[endpos] = '3') and (L.buf[endpos+1] = '2') then begin - result.tokType := tkFloat32Lit; - inc(endpos, 2); - end - else lexMessage(L, errInvalidNumber, result.literal); - end; - 'i', 'I': begin - inc(endpos); - if (L.buf[endpos] = '6') and (L.buf[endpos+1] = '4') then begin - result.tokType := tkInt64Lit; - inc(endpos, 2); - end - else if (L.buf[endpos] = '3') and (L.buf[endpos+1] = '2') then begin - result.tokType := tkInt32Lit; - inc(endpos, 2); - end - else if (L.buf[endpos] = '1') and (L.buf[endpos+1] = '6') then begin - result.tokType := tkInt16Lit; - inc(endpos, 2); - end - else if (L.buf[endpos] = '8') then begin - result.tokType := tkInt8Lit; - inc(endpos); - end - else lexMessage(L, errInvalidNumber, result.literal); - end; - else lexMessage(L, errInvalidNumber, result.literal); - end - end - else - L.bufpos := pos; // restore position - - try - if (L.buf[pos] = '0') and (L.buf[pos+1] in ['x','X','b','B','o','O','c','C']) - then begin - inc(pos, 2); - xi := 0; - // it may be a base prefix - case L.buf[pos-1] of - 'b', 'B': begin - result.base := base2; - while true do begin - case L.buf[pos] of - 'A'..'Z', 'a'..'z', '2'..'9', '.': begin - lexMessage(L, errInvalidNumber, result.literal); - inc(pos) - end; - '_': inc(pos); - '0', '1': begin - xi := shlu(xi, 1) or (ord(L.buf[pos]) - ord('0')); - inc(pos); - end; - else break; - end - end - end; - 'o', 'c', 'C': begin - result.base := base8; - while true do begin - case L.buf[pos] of - 'A'..'Z', 'a'..'z', '8'..'9', '.': begin - lexMessage(L, errInvalidNumber, result.literal); - inc(pos) - end; - '_': inc(pos); - '0'..'7': begin - xi := shlu(xi, 3) or (ord(L.buf[pos]) - ord('0')); - inc(pos); - end; - else break; - end - end - end; - 'O': lexMessage(L, errInvalidNumber, result.literal); - 'x', 'X': begin - result.base := base16; - while true do begin - case L.buf[pos] of - 'G'..'Z', 'g'..'z', '.': begin - lexMessage(L, errInvalidNumber, result.literal); - inc(pos); - end; - '_': inc(pos); - '0'..'9': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('0')); - inc(pos); - end; - 'a'..'f': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10); - inc(pos); - end; - 'A'..'F': begin - xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10); - inc(pos); - end; - else break; - end - end - end; - else InternalError(getLineInfo(L), 'getNumber'); - end; - // now look at the optional type suffix: - case result.tokType of - tkIntLit, tkInt64Lit: - result.iNumber := xi; - tkInt8Lit: - result.iNumber := biggestInt(int8(toU8(int(xi)))); - tkInt16Lit: - result.iNumber := biggestInt(toU16(int(xi))); - tkInt32Lit: - result.iNumber := biggestInt(toU32(xi)); - tkFloat32Lit: - result.fNumber := ({@cast}PFloat32(addr(xi)))^; - // note: this code is endian neutral! - // XXX: Test this on big endian machine! - tkFloat64Lit: - result.fNumber := ({@cast}PFloat64(addr(xi)))^; - else InternalError(getLineInfo(L), 'getNumber'); - end - end - else if isFloatLiteral(result.literal) - or (result.tokType = tkFloat32Lit) - or (result.tokType = tkFloat64Lit) then begin - result.fnumber := parseFloat(result.literal); - if result.tokType = tkIntLit then result.tokType := tkFloatLit; - end - else begin - result.iNumber := ParseBiggestInt(result.literal); - if (result.iNumber < low(int32)) or (result.iNumber > high(int32)) then - begin - if result.tokType = tkIntLit then result.tokType := tkInt64Lit - else if result.tokType <> tkInt64Lit then - lexMessage(L, errInvalidNumber, result.literal); - end - end; - except - on EInvalidValue do - lexMessage(L, errInvalidNumber, result.literal); - {@ignore} - on sysutils.EIntOverflow do - lexMessage(L, errNumberOutOfRange, result.literal); - {@emit} - on EOverflow do - lexMessage(L, errNumberOutOfRange, result.literal); - on EOutOfRange do - lexMessage(L, errNumberOutOfRange, result.literal); - end; - L.bufpos := endpos; -end; - -procedure handleHexChar(var L: TLexer; var xi: int); -begin - case L.buf[L.bufpos] of - '0'..'9': begin - xi := (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('0')); - inc(L.bufpos); - end; - 'a'..'f': begin - xi := (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('a') + 10); - inc(L.bufpos); - end; - 'A'..'F': begin - xi := (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('A') + 10); - inc(L.bufpos); - end; - else begin end // do nothing - end -end; - -procedure handleDecChars(var L: TLexer; var xi: int); -begin - while L.buf[L.bufpos] in ['0'..'9'] do begin - xi := (xi * 10) + (ord(L.buf[L.bufpos]) - ord('0')); - inc(L.bufpos); - end; -end; - -procedure getEscapedChar(var L: TLexer; var tok: TToken); -var - xi: int; -begin - inc(L.bufpos); // skip '\' - case L.buf[L.bufpos] of - 'n', 'N': begin - if tok.toktype = tkCharLit then - lexMessage(L, errNnotAllowedInCharacter); - tok.literal := tok.literal +{&} tnl; - Inc(L.bufpos); - end; - 'r', 'R', 'c', 'C': begin addChar(tok.literal, CR); Inc(L.bufpos); end; - 'l', 'L': begin addChar(tok.literal, LF); Inc(L.bufpos); end; - 'f', 'F': begin addChar(tok.literal, FF); inc(L.bufpos); end; - 'e', 'E': begin addChar(tok.literal, ESC); Inc(L.bufpos); end; - 'a', 'A': begin addChar(tok.literal, BEL); Inc(L.bufpos); end; - 'b', 'B': begin addChar(tok.literal, BACKSPACE); Inc(L.bufpos); end; - 'v', 'V': begin addChar(tok.literal, VT); Inc(L.bufpos); end; - 't', 'T': begin addChar(tok.literal, Tabulator); Inc(L.bufpos); end; - '''', '"': begin addChar(tok.literal, L.buf[L.bufpos]); Inc(L.bufpos); end; - '\': begin addChar(tok.literal, '\'); Inc(L.bufpos) end; - 'x', 'X': begin - inc(L.bufpos); - xi := 0; - handleHexChar(L, xi); - handleHexChar(L, xi); - addChar(tok.literal, Chr(xi)); - end; - '0'..'9': begin - if matchTwoChars(L, '0', ['0'..'9']) then - // this warning will make it easier for newcomers: - lexMessage(L, warnOctalEscape); - xi := 0; - handleDecChars(L, xi); - if (xi <= 255) then - addChar(tok.literal, Chr(xi)) - else - lexMessage(L, errInvalidCharacterConstant) - end - else lexMessage(L, errInvalidCharacterConstant) - end -end; - -function HandleCRLF(var L: TLexer; pos: int): int; -begin - case L.buf[pos] of - CR: begin - if getColNumber(L, pos) > MaxLineLength then - lexMessagePos(L, hintLineTooLong, pos); - result := lexbase.HandleCR(L, pos) - end; - LF: begin - if getColNumber(L, pos) > MaxLineLength then - lexMessagePos(L, hintLineTooLong, pos); - result := lexbase.HandleLF(L, pos) - end; - else result := pos - end -end; - -procedure getString(var L: TLexer; var tok: TToken; rawMode: Boolean); -var - line, line2, pos: int; - c: Char; - buf: PChar; -begin - pos := L.bufPos + 1; // skip " - buf := L.buf; // put `buf` in a register - line := L.linenumber; // save linenumber for better error message - if (buf[pos] = '"') and (buf[pos+1] = '"') then begin - tok.tokType := tkTripleStrLit; - // long string literal: - inc(pos, 2); // skip "" - // skip leading newline: - pos := HandleCRLF(L, pos); - buf := L.buf; - repeat - case buf[pos] of - '"': begin - if (buf[pos+1] = '"') and (buf[pos+2] = '"') then - break; - addChar(tok.literal, '"'); - Inc(pos) - end; - CR, LF: begin - pos := HandleCRLF(L, pos); - buf := L.buf; - tok.literal := tok.literal +{&} tnl; - end; - lexbase.EndOfFile: begin - line2 := L.linenumber; - L.LineNumber := line; - lexMessagePos(L, errClosingTripleQuoteExpected, L.lineStart); - L.LineNumber := line2; - break - end - else begin - addChar(tok.literal, buf[pos]); - Inc(pos) - end - end - until false; - L.bufpos := pos + 3 // skip the three """ - end - else begin // ordinary string literal - if rawMode then tok.tokType := tkRStrLit - else tok.tokType := tkStrLit; - repeat - c := buf[pos]; - if c = '"' then begin - inc(pos); // skip '"' - break - end; - if c in [CR, LF, lexbase.EndOfFile] then begin - lexMessage(L, errClosingQuoteExpected); - break - end; - if (c = '\') and not rawMode then begin - L.bufPos := pos; - getEscapedChar(L, tok); - pos := L.bufPos; - end - else begin - addChar(tok.literal, c); - Inc(pos) - end - until false; - L.bufpos := pos; - end -end; - -procedure getCharacter(var L: TLexer; var tok: TToken); -var - c: Char; -begin - Inc(L.bufpos); // skip ' - c := L.buf[L.bufpos]; - case c of - #0..Pred(' '), '''': lexMessage(L, errInvalidCharacterConstant); - '\': getEscapedChar(L, tok); - else begin - tok.literal := c + ''; - Inc(L.bufpos); - end - end; - if L.buf[L.bufpos] <> '''' then lexMessage(L, errMissingFinalQuote); - inc(L.bufpos); // skip ' -end; - -{@ignore} -{$ifopt Q+} {$define Q_on} {$Q-} {$endif} -{$ifopt R+} {$define R_on} {$R-} {$endif} -{@emit} -procedure getSymbol(var L: TLexer; var tok: TToken); -var - pos: int; - c: Char; - buf: pchar; - h: THash; // hashing algorithm inlined -begin - h := 0; - pos := L.bufpos; - buf := L.buf; - while true do begin - c := buf[pos]; - case c of - 'a'..'z', '0'..'9', #128..#255: begin - h := h +{%} Ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6) - end; - 'A'..'Z': begin - c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() - h := h +{%} Ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6) - end; - '_': begin end; - else break - end; - Inc(pos) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - tok.ident := getIdent(addr(L.buf[L.bufpos]), pos-L.bufpos, h); - L.bufpos := pos; - if (tok.ident.id < ord(tokKeywordLow)-ord(tkSymbol)) or - (tok.ident.id > ord(tokKeywordHigh)-ord(tkSymbol)) then - tok.tokType := tkSymbol - else - tok.tokType := TTokType(tok.ident.id+ord(tkSymbol)); - if buf[pos] = '"' then begin - getString(L, tok, true); - if tok.tokType = tkRStrLit then tok.tokType := tkCallRStrLit - else tok.tokType := tkCallTripleStrLit - end -end; - -procedure getOperator(var L: TLexer; var tok: TToken); -var - pos: int; - c: Char; - buf: pchar; - h: THash; // hashing algorithm inlined -begin - pos := L.bufpos; - buf := L.buf; - h := 0; - while true do begin - c := buf[pos]; - if c in OpChars then begin - h := h +{%} Ord(c); - h := h +{%} h shl 10; - h := h xor (h shr 6) - end - else break; - Inc(pos) - end; - h := h +{%} h shl 3; - h := h xor (h shr 11); - h := h +{%} h shl 15; - tok.ident := getIdent(addr(L.buf[L.bufpos]), pos-L.bufpos, h); - if (tok.ident.id < oprLow) or (tok.ident.id > oprHigh) then - tok.tokType := tkOpr - else - tok.tokType := TTokType(tok.ident.id - oprLow + ord(tkColon)); - L.bufpos := pos -end; -{@ignore} -{$ifdef Q_on} {$undef Q_on} {$Q+} {$endif} -{$ifdef R_on} {$undef R_on} {$R+} {$endif} -{@emit} - -procedure handleIndentation(var L: TLexer; var tok: TToken; indent: int); -var - i: int; -begin - tok.indent := indent; - i := high(L.indentStack); - if indent > L.indentStack[i] then - tok.tokType := tkInd - else if indent = L.indentStack[i] then - tok.tokType := tkSad - else begin - // check we have the indentation somewhere in the stack: - while (i >= 0) and (indent <> L.indentStack[i]) do begin - dec(i); - inc(L.dedent); - end; - dec(L.dedent); - tok.tokType := tkDed; - if i < 0 then begin - tok.tokType := tkSad; // for the parser it is better as SAD - lexMessage(L, errInvalidIndentation); - end - end -end; - -procedure scanComment(var L: TLexer; var tok: TToken); -var - buf: PChar; - pos, col: int; - indent: int; -begin - pos := L.bufpos; - buf := L.buf; - // a comment ends if the next line does not start with the # on the same - // column after only whitespace - tok.tokType := tkComment; - col := getColNumber(L, pos); - while true do begin - while not (buf[pos] in [CR, LF, lexbase.EndOfFile]) do begin - addChar(tok.literal, buf[pos]); inc(pos); - end; - pos := handleCRLF(L, pos); - buf := L.buf; - indent := 0; - while buf[pos] = ' ' do begin inc(pos); inc(indent) end; - if (buf[pos] = '#') and (col = indent) then begin - tok.literal := tok.literal +{&} nl; - end - else begin - if buf[pos] > ' ' then begin - L.indentAhead := indent; - inc(L.dedent) - end; - break - end - end; - L.bufpos := pos; -end; - -procedure skip(var L: TLexer; var tok: TToken); -var - buf: PChar; - indent, pos: int; -begin - pos := L.bufpos; - buf := L.buf; - repeat - case buf[pos] of - ' ': Inc(pos); - Tabulator: begin - lexMessagePos(L, errTabulatorsAreNotAllowed, pos); - inc(pos); // BUGFIX - end; - // newline is special: - CR, LF: begin - pos := HandleCRLF(L, pos); - buf := L.buf; - indent := 0; - while buf[pos] = ' ' do begin - Inc(pos); Inc(indent) - end; - if (buf[pos] > ' ') then begin - handleIndentation(L, tok, indent); - break; - end - end; - else break // EndOfFile also leaves the loop - end - until false; - L.bufpos := pos; -end; - -procedure rawGetTok(var L: TLexer; var tok: TToken); -var - c: Char; -begin - fillToken(tok); - if L.dedent > 0 then begin - dec(L.dedent); - if L.indentAhead >= 0 then begin - handleIndentation(L, tok, L.indentAhead); - L.indentAhead := -1; - end - else - tok.tokType := tkDed; - exit; - end; - // Skip whitespace, comments: - skip(L, tok); // skip - // got an documentation comment or tkIndent, return that: - if tok.toktype <> tkInvalid then exit; - - c := L.buf[L.bufpos]; - if c in SymStartChars - ['r', 'R', 'l'] then // common case first - getSymbol(L, tok) - else if c in ['0'..'9'] then - tok := getNumber(L) - else begin - case c of - '#': scanComment(L, tok); - ':': begin - tok.tokType := tkColon; - inc(L.bufpos); - end; - ',': begin - tok.toktype := tkComma; - Inc(L.bufpos) - end; - 'l': begin - // if we parsed exactly one character and its a small L (l), this - // is treated as a warning because it may be confused with the number 1 - if not (L.buf[L.bufpos+1] in (SymChars+['_'])) then - lexMessage(L, warnSmallLshouldNotBeUsed); - getSymbol(L, tok); - end; - 'r', 'R': begin - if L.buf[L.bufPos+1] = '"' then begin - Inc(L.bufPos); - getString(L, tok, true); - end - else getSymbol(L, tok); - end; - '(': begin - Inc(L.bufpos); - if (L.buf[L.bufPos] = '.') - and (L.buf[L.bufPos+1] <> '.') then begin - tok.toktype := tkParDotLe; - Inc(L.bufpos); - end - else - tok.toktype := tkParLe; - end; - ')': begin - tok.toktype := tkParRi; - Inc(L.bufpos) - end; - '[': begin - Inc(L.bufpos); - if (L.buf[L.bufPos] = '.') - and (L.buf[L.bufPos+1] <> '.') then begin - tok.toktype := tkBracketDotLe; - Inc(L.bufpos); - end - else - tok.toktype := tkBracketLe; - end; - ']': begin - tok.toktype := tkBracketRi; - Inc(L.bufpos) - end; - '.': begin - if L.buf[L.bufPos+1] = ']' then begin - tok.tokType := tkBracketDotRi; - Inc(L.bufpos, 2); - end - else if L.buf[L.bufPos+1] = '}' then begin - tok.tokType := tkCurlyDotRi; - Inc(L.bufpos, 2); - end - else if L.buf[L.bufPos+1] = ')' then begin - tok.tokType := tkParDotRi; - Inc(L.bufpos, 2); - end - else - getOperator(L, tok) - end; - '{': begin - Inc(L.bufpos); - if (L.buf[L.bufPos] = '.') - and (L.buf[L.bufPos+1] <> '.') then begin - tok.toktype := tkCurlyDotLe; - Inc(L.bufpos); - end - else - tok.toktype := tkCurlyLe; - end; - '}': begin - tok.toktype := tkCurlyRi; - Inc(L.bufpos) - end; - ';': begin - tok.toktype := tkSemiColon; - Inc(L.bufpos) - end; - '`': begin - tok.tokType := tkAccent; - Inc(L.bufpos); - end; - '"': getString(L, tok, false); - '''': begin - getCharacter(L, tok); - tok.tokType := tkCharLit; - end; - lexbase.EndOfFile: tok.toktype := tkEof; - else if c in OpChars then - getOperator(L, tok) - else begin - tok.literal := c + ''; - tok.tokType := tkInvalid; - lexMessage(L, errInvalidToken, c +{&} ' (\' +{&} toString(ord(c)) + ')'); - Inc(L.bufpos); - end - end - end -end; - -initialization - dummyIdent := getIdent(''); -end. diff --git a/nim/sem.pas b/nim/sem.pas deleted file mode 100755 index a5d28d734e..0000000000 --- a/nim/sem.pas +++ /dev/null @@ -1,280 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit sem; - -// This module implements the semantic checking pass. - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, charsets, strutils, nhashes, - lists, options, scanner, ast, astalgo, trees, treetab, wordrecg, - ropes, msgs, nos, condsyms, idents, rnimsyn, types, platform, - nmath, magicsys, pnimsyn, nversion, nimsets, - semdata, evals, semfold, importer, procfind, lookups, rodread, - pragmas, passes; - -//var -// point: array [0..3] of int; - -function semPass(): TPass; - -implementation - -function considerAcc(n: PNode): PIdent; -var - x: PNode; -begin - x := n; - if x.kind = nkAccQuoted then x := x.sons[0]; - case x.kind of - nkIdent: result := x.ident; - nkSym: result := x.sym.name; - else begin - liMessage(n.info, errIdentifierExpected, renderTree(n)); - result := nil - end - end -end; - -function isTopLevel(c: PContext): bool; -begin - result := c.tab.tos <= 2 -end; - -function newSymS(const kind: TSymKind; n: PNode; c: PContext): PSym; -begin - result := newSym(kind, considerAcc(n), getCurrOwner()); - result.info := n.info; -end; - -procedure markUsed(n: PNode; s: PSym); -begin - include(s.flags, sfUsed); - if sfDeprecated in s.flags then liMessage(n.info, warnDeprecated, s.name.s); -end; - -function semIdentVis(c: PContext; kind: TSymKind; n: PNode; - const allowed: TSymFlags): PSym; forward; -// identifier with visability -function semIdentWithPragma(c: PContext; kind: TSymKind; - n: PNode; const allowed: TSymFlags): PSym; forward; - -function semStmtScope(c: PContext; n: PNode): PNode; forward; - -type - TExprFlag = (efAllowType, efLValue, efWantIterator); - TExprFlags = set of TExprFlag; - -function semExpr(c: PContext; n: PNode; - flags: TExprFlags = {@set}[]): PNode; forward; -function semExprWithType(c: PContext; n: PNode; - flags: TExprFlags = {@set}[]): PNode; forward; -function fitNode(c: PContext; formal: PType; arg: PNode): PNode; forward; -function semLambda(c: PContext; n: PNode): PNode; forward; -function semTypeNode(c: PContext; n: PNode; prev: PType): PType; forward; -function semStmt(c: PContext; n: PNode): PNode; forward; -procedure semParamList(c: PContext; n, genericParams: PNode; s: PSym); forward; -procedure addParams(c: PContext; n: PNode); forward; -procedure addResult(c: PContext; t: PType; const info: TLineInfo); forward; -procedure addResultNode(c: PContext; n: PNode); forward; - -function instGenericContainer(c: PContext; n: PNode; header: PType): PType; forward; - -function semConstExpr(c: PContext; n: PNode): PNode; -begin - result := semExprWithType(c, n); - if result = nil then begin - liMessage(n.info, errConstExprExpected); - exit - end; - result := getConstExpr(c.module, result); - if result = nil then - liMessage(n.info, errConstExprExpected); -end; - -function semAndEvalConstExpr(c: PContext; n: PNode): PNode; -var - e: PNode; -begin - e := semExprWithType(c, n); - if e = nil then begin - liMessage(n.info, errConstExprExpected); - result := nil; exit - end; - result := getConstExpr(c.module, e); - if result = nil then begin - //writeln(output, renderTree(n)); - result := evalConstExpr(c.module, e); - if (result = nil) or (result.kind = nkEmpty) then - liMessage(n.info, errConstExprExpected); - end -end; - -function semAfterMacroCall(c: PContext; n: PNode; s: PSym): PNode; -begin - result := n; - case s.typ.sons[0].kind of - tyExpr: result := semExprWithType(c, result); - tyStmt: result := semStmt(c, result); - tyTypeDesc: result.typ := semTypeNode(c, result, nil); - else liMessage(s.info, errInvalidParamKindX, typeToString(s.typ.sons[0])) - end -end; - -{$include 'semtempl.pas'} - -function semMacroExpr(c: PContext; n: PNode; sym: PSym; - semCheck: bool = true): PNode; -var - p: PEvalContext; - s: PStackFrame; -begin - inc(evalTemplateCounter); - if evalTemplateCounter > 100 then - liMessage(n.info, errTemplateInstantiationTooNested); - markUsed(n, sym); - p := newEvalContext(c.module, '', false); - s := newStackFrame(); - s.call := n; - setLength(s.params, 2); - s.params[0] := newNodeIT(nkNilLit, n.info, sym.typ.sons[0]); - s.params[1] := n; - pushStackFrame(p, s); - {@discard} eval(p, sym.ast.sons[codePos]); - result := s.params[0]; - popStackFrame(p); - if cyclicTree(result) then liMessage(n.info, errCyclicTree); - if semCheck then - result := semAfterMacroCall(c, result, sym); - dec(evalTemplateCounter); -end; - -{$include 'seminst.pas'} -{$include 'sigmatch.pas'} - -procedure CheckBool(t: PNode); -begin - if (t.Typ = nil) or (skipTypes(t.Typ, {@set}[tyGenericInst, - tyVar, tyOrdinal]).kind <> tyBool) then - liMessage(t.Info, errExprMustBeBool); -end; - -procedure typeMismatch(n: PNode; formal, actual: PType); -begin - liMessage(n.Info, errGenerated, - msgKindToString(errTypeMismatch) +{&} typeToString(actual) +{&} ') ' - +{&} format(msgKindToString(errButExpectedX), [typeToString(formal)])); -end; - -{$include 'semtypes.pas'} -{$include 'semexprs.pas'} -{$include 'semgnrc.pas'} -{$include 'semstmts.pas'} - -procedure addCodeForGenerics(c: PContext; n: PNode); -var - i: int; - prc: PSym; - it: PNode; -begin - for i := c.lastGenericIdx to sonsLen(c.generics)-1 do begin - it := c.generics.sons[i].sons[1]; - if it.kind <> nkSym then InternalError('addCodeForGenerics'); - prc := it.sym; - if (prc.kind in [skProc, skMethod, skConverter]) - and (prc.magic = mNone) then begin - if (prc.ast = nil) or (prc.ast.sons[codePos] = nil) then - InternalError(prc.info, 'no code for ' + prc.name.s); - addSon(n, prc.ast); - end - end; - c.lastGenericIdx := sonsLen(c.generics); -end; - -function myOpen(module: PSym; const filename: string): PPassContext; -var - c: PContext; -begin - c := newContext(module, filename); - if (c.p <> nil) then InternalError(module.info, 'sem.myOpen'); - c.semConstExpr := semConstExpr; - c.p := newProcCon(module); - pushOwner(c.module); - openScope(c.tab); // scope for imported symbols - SymTabAdd(c.tab, module); // a module knows itself - if sfSystemModule in module.flags then begin - magicsys.SystemModule := module; // set global variable! - InitSystem(c.tab); // currently does nothing - end - else begin - SymTabAdd(c.tab, magicsys.SystemModule); // import the "System" identifier - importAllSymbols(c, magicsys.SystemModule); - end; - openScope(c.tab); // scope for the module's symbols - result := c -end; - -function myOpenCached(module: PSym; const filename: string; - rd: PRodReader): PPassContext; -var - c: PContext; -begin - c := PContext(myOpen(module, filename)); - c.fromCache := true; - result := c -end; - -function myProcess(context: PPassContext; n: PNode): PNode; -var - c: PContext; - a: PNode; -begin - result := nil; - c := PContext(context); - result := semStmt(c, n); - // BUGFIX: process newly generated generics here, not at the end! - if sonsLen(c.generics) > 0 then begin - a := newNodeI(nkStmtList, n.info); - addCodeForGenerics(c, a); - if sonsLen(a) > 0 then begin - // a generic has been added to `a`: - addSonIfNotNil(a, result); - result := a - end - end -end; - -function myClose(context: PPassContext; n: PNode): PNode; -var - c: PContext; -begin - c := PContext(context); - closeScope(c.tab); // close module's scope - rawCloseScope(c.tab); // imported symbols; don't check for unused ones! - if n = nil then result := newNode(nkStmtList) - else InternalError(n.info, 'n is not nil'); - //result := n; - addCodeForGenerics(c, result); - popOwner(); - c.p := nil; -end; - -function semPass(): TPass; -begin - initPass(result); - result.open := myOpen; - result.openCached := myOpenCached; - result.close := myClose; - result.process := myProcess; -end; - -end. diff --git a/nim/semdata.pas b/nim/semdata.pas deleted file mode 100755 index 37934f3d60..0000000000 --- a/nim/semdata.pas +++ /dev/null @@ -1,266 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit semdata; - -// This module contains the data structures for the semantic checking phase. - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, charsets, strutils, - lists, options, scanner, ast, astalgo, trees, treetab, wordrecg, - ropes, msgs, platform, nos, condsyms, idents, rnimsyn, types, - extccomp, nmath, magicsys, nversion, nimsets, pnimsyn, ntime, passes, - rodread; - -type - TOptionEntry = object(lists.TListEntry) - // entries to put on a stack for pragma parsing - options: TOptions; - defaultCC: TCallingConvention; - dynlib: PLib; - Notes: TNoteKinds; - end; - POptionEntry = ^TOptionEntry; - - TProcCon = record // procedure context; also used for top-level - // statements - owner: PSym; // the symbol this context belongs to - resultSym: PSym; // the result symbol (if we are in a proc) - nestedLoopCounter: int; // whether we are in a loop or not - nestedBlockCounter: int; // whether we are in a block or not - end; - PProcCon = ^TProcCon; - - PContext = ^TContext; - TContext = object(TPassContext) // a context represents a module - module: PSym; // the module sym belonging to the context - p: PProcCon; // procedure context - InstCounter: int; // to prevent endless instantiations - generics: PNode; // a list of the things to compile; list of - // nkExprEqExpr nodes which contain the - // generic symbol and the instantiated symbol - lastGenericIdx: int; // used for the generics stack - tab: TSymTab; // each module has its own symbol table - AmbiguousSymbols: TIntSet; // ids of all ambiguous symbols (cannot - // store this info in the syms themselves!) - converters: TSymSeq; // sequence of converters - optionStack: TLinkedList; - libs: TLinkedList; // all libs used by this module - fromCache: bool; // is the module read from a cache? - semConstExpr: function (c: PContext; n: PNode): PNode; - // for the pragmas module - includedFiles: TIntSet; // used to detect recursive include files - filename: string; // the module's filename - end; - -var - gInstTypes: TIdTable; // map PType to PType - -function newContext(module: PSym; const nimfile: string): PContext; -function newProcCon(owner: PSym): PProcCon; - -function lastOptionEntry(c: PContext): POptionEntry; -function newOptionEntry(): POptionEntry; - -procedure addConverter(c: PContext; conv: PSym); - -function newLib(kind: TLibKind): PLib; -procedure addToLib(lib: PLib; sym: PSym); - -function makePtrType(c: PContext; baseType: PType): PType; -function makeVarType(c: PContext; baseType: PType): PType; - -function newTypeS(const kind: TTypeKind; c: PContext): PType; -procedure fillTypeS(dest: PType; const kind: TTypeKind; c: PContext); -function makeRangeType(c: PContext; first, last: biggestInt; - const info: TLineInfo): PType; - -procedure illFormedAst(n: PNode); -function getSon(n: PNode; indx: int): PNode; -procedure checkSonsLen(n: PNode; len: int); -procedure checkMinSonsLen(n: PNode; len: int); - -// owner handling: -function getCurrOwner(): PSym; -procedure PushOwner(owner: PSym); -procedure PopOwner; - -implementation - -var - gOwners: array of PSym; // owner stack (used for initializing the - // owner field of syms) - // the documentation comment always gets - // assigned to the current owner - // BUGFIX: global array is needed! -{@emit gOwners := @[]; } - -function getCurrOwner(): PSym; -begin - result := gOwners[high(gOwners)]; -end; - -procedure PushOwner(owner: PSym); -var - len: int; -begin - len := length(gOwners); - setLength(gOwners, len+1); - gOwners[len] := owner; -end; - -procedure PopOwner; -var - len: int; -begin - len := length(gOwners); - if (len <= 0) then InternalError('popOwner'); - setLength(gOwners, len - 1); -end; - -function lastOptionEntry(c: PContext): POptionEntry; -begin - result := POptionEntry(c.optionStack.tail); -end; - -function newProcCon(owner: PSym): PProcCon; -begin - if owner = nil then InternalError('owner is nil'); - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.owner := owner; -end; - -function newOptionEntry(): POptionEntry; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.options := gOptions; - result.defaultCC := ccDefault; - result.dynlib := nil; - result.notes := gNotes; -end; - -function newContext(module: PSym; const nimfile: string): PContext; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - InitSymTab(result.tab); - IntSetInit(result.AmbiguousSymbols); - initLinkedList(result.optionStack); - initLinkedList(result.libs); - append(result.optionStack, newOptionEntry()); - result.module := module; - result.generics := newNode(nkStmtList); -{@emit result.converters := @[];} - result.filename := nimfile; - IntSetInit(result.includedFiles); -end; - -procedure addConverter(c: PContext; conv: PSym); -var - i, L: int; -begin - L := length(c.converters); - for i := 0 to L-1 do - if c.converters[i].id = conv.id then exit; - setLength(c.converters, L+1); - c.converters[L] := conv; -end; - - -function newLib(kind: TLibKind): PLib; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - result.kind := kind; - //initObjectSet(result.syms) -end; - -procedure addToLib(lib: PLib; sym: PSym); -begin - //ObjectSetIncl(lib.syms, sym); - if sym.annex <> nil then liMessage(sym.info, errInvalidPragma); - sym.annex := lib -end; - -function makePtrType(c: PContext; baseType: PType): PType; -begin - if (baseType = nil) then InternalError('makePtrType'); - result := newTypeS(tyPtr, c); - addSon(result, baseType); -end; - -function makeVarType(c: PContext; baseType: PType): PType; -begin - if (baseType = nil) then InternalError('makeVarType'); - result := newTypeS(tyVar, c); - addSon(result, baseType); -end; - -function newTypeS(const kind: TTypeKind; c: PContext): PType; -begin - result := newType(kind, getCurrOwner()) -end; - -procedure fillTypeS(dest: PType; const kind: TTypeKind; c: PContext); -begin - dest.kind := kind; - dest.owner := getCurrOwner(); - dest.size := -1; -end; - -function makeRangeType(c: PContext; first, last: biggestInt; - const info: TLineInfo): PType; -var - n: PNode; -begin - n := newNodeI(nkRange, info); - addSon(n, newIntNode(nkIntLit, first)); - addSon(n, newIntNode(nkIntLit, last)); - result := newTypeS(tyRange, c); - result.n := n; - addSon(result, getSysType(tyInt)); // basetype of range -end; - -procedure illFormedAst(n: PNode); -begin - liMessage(n.info, errIllFormedAstX, renderTree(n, {@set}[renderNoComments])); -end; - -function getSon(n: PNode; indx: int): PNode; -begin - if (n <> nil) and (indx < sonsLen(n)) then result := n.sons[indx] - else begin illFormedAst(n); result := nil end; -end; - -procedure checkSonsLen(n: PNode; len: int); -begin - if (n = nil) or (sonsLen(n) <> len) then illFormedAst(n); -end; - -procedure checkMinSonsLen(n: PNode; len: int); -begin - if (n = nil) or (sonsLen(n) < len) then illFormedAst(n); -end; - -initialization - initIdTable(gInstTypes); -end. diff --git a/nim/semexprs.pas b/nim/semexprs.pas deleted file mode 100755 index 2d1d0a957d..0000000000 --- a/nim/semexprs.pas +++ /dev/null @@ -1,1426 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - - -// this module does the semantic checking for expressions - -function semTemplateExpr(c: PContext; n: PNode; s: PSym; - semCheck: bool = true): PNode; -begin - markUsed(n, s); - pushInfoContext(n.info); - result := evalTemplate(c, n, s); - if semCheck then - result := semAfterMacroCall(c, result, s); - popInfoContext(); -end; - -function semDotExpr(c: PContext; n: PNode; - flags: TExprFlags = {@set}[]): PNode; forward; - -function semExprWithType(c: PContext; n: PNode; - flags: TExprFlags = {@set}[]): PNode; -var - d: PNode; -begin - result := semExpr(c, n, flags); - if result = nil then InternalError('semExprWithType'); - if (result.typ = nil) then - liMessage(n.info, errExprXHasNoType, - renderTree(result, {@set}[renderNoComments])); - if result.typ.kind = tyVar then begin - d := newNodeIT(nkHiddenDeref, result.info, result.typ.sons[0]); - addSon(d, result); - result := d - end -end; - -procedure checkConversionBetweenObjects(const info: TLineInfo; - castDest, src: PType); -var - diff: int; -begin - diff := inheritanceDiff(castDest, src); - if diff = high(int) then - liMessage(info, errGenerated, - format(MsgKindToString(errIllegalConvFromXtoY), - [typeToString(src), typeToString(castDest)])); -end; - -procedure checkConvertible(const info: TLineInfo; castDest, src: PType); -const - IntegralTypes = [tyBool, tyEnum, tyChar, tyInt..tyFloat128]; -var - d, s: PType; -begin - if sameType(castDest, src) then begin - // don't annoy conversions that may be needed on another processor: - if not (castDest.kind in [tyInt..tyFloat128, tyNil]) then - liMessage(info, hintConvFromXtoItselfNotNeeded, typeToString(castDest)); - exit - end; - - // common case first (converting of objects) - d := skipTypes(castDest, abstractVar); - s := skipTypes(src, abstractVar); - while (d <> nil) and (d.Kind in [tyPtr, tyRef]) - and (d.Kind = s.Kind) do begin - d := base(d); - s := base(s); - end; - if d = nil then - liMessage(info, errGenerated, - format(msgKindToString(errIllegalConvFromXtoY), - [typeToString(src), typeToString(castDest)])); - if (d.Kind = tyObject) and (s.Kind = tyObject) then - checkConversionBetweenObjects(info, d, s) - else if (skipTypes(castDest, abstractVarRange).Kind in IntegralTypes) - and (skipTypes(src, abstractVarRange).Kind in IntegralTypes) then begin - // accept conversion between intregral types - end - else begin - // we use d, s here to speed up that operation a bit: - case cmpTypes(d, s) of - isNone, isGeneric: begin - if not equalOrDistinctOf(castDest, src) and - not equalOrDistinctOf(src, castDest) then - liMessage(info, errGenerated, - format(MsgKindToString(errIllegalConvFromXtoY), - [typeToString(src), typeToString(castDest)])); - end - else begin end - end - end -end; - -function isCastable(dst, src: PType): Boolean; -//const -// castableTypeKinds = {@set}[tyInt, tyPtr, tyRef, tyCstring, tyString, -// tySequence, tyPointer, tyNil, tyOpenArray, -// tyProc, tySet, tyEnum, tyBool, tyChar]; -var - ds, ss: biggestInt; -begin - // this is very unrestrictive; cast is allowed if castDest.size >= src.size - ds := computeSize(dst); - ss := computeSize(src); - if ds < 0 then result := false - else if ss < 0 then result := false - else - result := (ds >= ss) or - (skipTypes(dst, abstractInst).kind in [tyInt..tyFloat128]) or - (skipTypes(src, abstractInst).kind in [tyInt..tyFloat128]) -end; - -function semConv(c: PContext; n: PNode; s: PSym): PNode; -var - op: PNode; - i: int; -begin - if sonsLen(n) <> 2 then liMessage(n.info, errConvNeedsOneArg); - result := newNodeI(nkConv, n.info); - result.typ := semTypeNode(c, n.sons[0], nil); - addSon(result, copyTree(n.sons[0])); - addSon(result, semExprWithType(c, n.sons[1])); - op := result.sons[1]; - if op.kind <> nkSymChoice then - checkConvertible(result.info, result.typ, op.typ) - else begin - for i := 0 to sonsLen(op)-1 do begin - if sameType(result.typ, op.sons[i].typ) then begin - markUsed(n, op.sons[i].sym); - result := op.sons[i]; exit - end - end; - liMessage(n.info, errUseQualifier, op.sons[0].sym.name.s); - end -end; - -function semCast(c: PContext; n: PNode): PNode; -begin - if optSafeCode in gGlobalOptions then liMessage(n.info, errCastNotInSafeMode); - include(c.p.owner.flags, sfSideEffect); - checkSonsLen(n, 2); - result := newNodeI(nkCast, n.info); - result.typ := semTypeNode(c, n.sons[0], nil); - addSon(result, copyTree(n.sons[0])); - addSon(result, semExprWithType(c, n.sons[1])); - if not isCastable(result.typ, result.sons[1].Typ) then - liMessage(result.info, errExprCannotBeCastedToX, typeToString(result.Typ)); -end; - -function semLowHigh(c: PContext; n: PNode; m: TMagic): PNode; -const - opToStr: array [mLow..mHigh] of string = ('low', 'high'); -var - typ: PType; -begin - if sonsLen(n) <> 2 then - liMessage(n.info, errXExpectsTypeOrValue, opToStr[m]) - else begin - n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); - typ := skipTypes(n.sons[1].typ, abstractVarRange); - case typ.Kind of - tySequence, tyString, tyOpenArray: begin - n.typ := getSysType(tyInt); - end; - tyArrayConstr, tyArray: begin - n.typ := n.sons[1].typ.sons[0]; // indextype - end; - tyInt..tyInt64, tyChar, tyBool, tyEnum: begin - n.typ := n.sons[1].typ; - end - else - liMessage(n.info, errInvalidArgForX, opToStr[m]) - end - end; - result := n; -end; - -function semSizeof(c: PContext; n: PNode): PNode; -begin - if sonsLen(n) <> 2 then - liMessage(n.info, errXExpectsTypeOrValue, 'sizeof') - else - n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); - n.typ := getSysType(tyInt); - result := n -end; - -function semIs(c: PContext; n: PNode): PNode; -var - a, b: PType; -begin - if sonsLen(n) = 3 then begin - n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); - n.sons[2] := semExprWithType(c, n.sons[2], {@set}[efAllowType]); - a := n.sons[1].typ; - b := n.sons[2].typ; - if (b.kind <> tyObject) or (a.kind <> tyObject) then - liMessage(n.info, errIsExpectsObjectTypes); - while (b <> nil) and (b.id <> a.id) do b := b.sons[0]; - if b = nil then - liMessage(n.info, errXcanNeverBeOfThisSubtype, typeToString(a)); - n.typ := getSysType(tyBool); - end - else - liMessage(n.info, errIsExpectsTwoArguments); - result := n; -end; - -procedure semOpAux(c: PContext; n: PNode); -var - i: int; - a: PNode; - info: TLineInfo; -begin - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkExprEqExpr then begin - checkSonsLen(a, 2); - info := a.sons[0].info; - a.sons[0] := newIdentNode(considerAcc(a.sons[0]), info); - a.sons[1] := semExprWithType(c, a.sons[1]); - a.typ := a.sons[1].typ; - end - else - n.sons[i] := semExprWithType(c, a); - end -end; - -function overloadedCallOpr(c: PContext; n: PNode): PNode; -var - par: PIdent; - i: int; -begin - // quick check if there is *any* () operator overloaded: - par := getIdent('()'); - if SymtabGet(c.Tab, par) = nil then begin - result := nil - end - else begin - result := newNodeI(nkCall, n.info); - addSon(result, newIdentNode(par, n.info)); - for i := 0 to sonsLen(n)-1 do addSon(result, n.sons[i]); - result := semExpr(c, result) - end -end; - -procedure changeType(n: PNode; newType: PType); -var - i: int; - f: PSym; - a, m: PNode; -begin - case n.kind of - nkCurly, nkBracket: begin - for i := 0 to sonsLen(n)-1 do changeType(n.sons[i], elemType(newType)); - end; - nkPar: begin - if newType.kind <> tyTuple then - InternalError(n.info, 'changeType: no tuple type for constructor'); - if newType.n = nil then - InternalError(n.info, 'changeType: no tuple fields'); - if (sonsLen(n) > 0) and (n.sons[0].kind = nkExprColonExpr) then begin - for i := 0 to sonsLen(n)-1 do begin - m := n.sons[i].sons[0]; - if m.kind <> nkSym then - internalError(m.info, 'changeType(): invalid tuple constr'); - f := getSymFromList(newType.n, m.sym.name); - if f = nil then - internalError(m.info, 'changeType(): invalid identifier'); - changeType(n.sons[i].sons[1], f.typ); - end - end - else begin - for i := 0 to sonsLen(n)-1 do begin - m := n.sons[i]; - a := newNodeIT(nkExprColonExpr, m.info, newType.sons[i]); - addSon(a, newSymNode(newType.n.sons[i].sym)); - addSon(a, m); - changeType(m, newType.sons[i]); - n.sons[i] := a; - end; - end - end; - else begin end - end; - n.typ := newType; -end; - -function semArrayConstr(c: PContext; n: PNode): PNode; -var - typ: PType; - i: int; -begin - result := newNodeI(nkBracket, n.info); - result.typ := newTypeS(tyArrayConstr, c); - addSon(result.typ, nil); // index type - if sonsLen(n) = 0 then - addSon(result.typ, newTypeS(tyEmpty, c)) // needs an empty basetype! - else begin - addSon(result, semExprWithType(c, n.sons[0])); - typ := skipTypes(result.sons[0].typ, - {@set}[tyGenericInst, tyVar, tyOrdinal]); - for i := 1 to sonsLen(n)-1 do begin - n.sons[i] := semExprWithType(c, n.sons[i]); - addSon(result, fitNode(c, typ, n.sons[i])); - end; - addSon(result.typ, typ) - end; - result.typ.sons[0] := makeRangeType(c, 0, sonsLen(result)-1, n.info); -end; - -const - ConstAbstractTypes = {@set}[tyNil, tyChar, tyInt..tyInt64, - tyFloat..tyFloat128, - tyArrayConstr, tyTuple, tySet]; - -procedure fixAbstractType(c: PContext; n: PNode); -var - i: int; - s: PType; - it: PNode; -begin - for i := 1 to sonsLen(n)-1 do begin - it := n.sons[i]; - case it.kind of - nkHiddenStdConv, nkHiddenSubConv: begin - if it.sons[1].kind = nkBracket then - it.sons[1] := semArrayConstr(c, it.sons[1]); - if skipTypes(it.typ, abstractVar).kind = tyOpenArray then begin - s := skipTypes(it.sons[1].typ, abstractVar); - if (s.kind = tyArrayConstr) and (s.sons[1].kind = tyEmpty) then begin - s := copyType(s, getCurrOwner(), false); - skipTypes(s, abstractVar).sons[1] := elemType( - skipTypes(it.typ, abstractVar)); - it.sons[1].typ := s; - end - end - else if skipTypes(it.sons[1].typ, abstractVar).kind in - [tyNil, tyArrayConstr, tyTuple, tySet] then begin - s := skipTypes(it.typ, abstractVar); - changeType(it.sons[1], s); - n.sons[i] := it.sons[1]; - end - end; - nkBracket: begin - // an implicitely constructed array (passed to an open array): - n.sons[i] := semArrayConstr(c, it); - end; - else if (it.typ = nil) then - InternalError(it.info, 'fixAbstractType: ' + renderTree(it)); - end - end -end; - -function skipObjConv(n: PNode): PNode; -begin - case n.kind of - nkHiddenStdConv, nkHiddenSubConv, nkConv: begin - if skipTypes(n.sons[1].typ, abstractPtrs).kind in [tyTuple, tyObject] then - result := n.sons[1] - else - result := n - end; - nkObjUpConv, nkObjDownConv: result := n.sons[0]; - else result := n - end -end; - -type - TAssignableResult = ( - arNone, // no l-value and no discriminant - arLValue, // is an l-value - arDiscriminant // is a discriminant - ); - -function isAssignable(n: PNode): TAssignableResult; -begin - result := arNone; - case n.kind of - nkSym: begin - if (n.sym.kind in [skVar, skTemp]) then - result := arLValue - end; - nkDotExpr: begin - checkMinSonsLen(n, 1); - if skipTypes(n.sons[0].typ, abstractInst).kind in [tyVar, tyPtr, tyRef] then - result := arLValue - else - result := isAssignable(n.sons[0]); - if (result = arLValue) and (sfDiscriminant in n.sons[1].sym.flags) then - result := arDiscriminant - end; - nkBracketExpr: begin - checkMinSonsLen(n, 1); - if skipTypes(n.sons[0].typ, abstractInst).kind in [tyVar, tyPtr, tyRef] then - result := arLValue - else - result := isAssignable(n.sons[0]); - end; - nkHiddenStdConv, nkHiddenSubConv, nkConv: begin - // Object and tuple conversions are still addressable, so we skip them - //if skipPtrsGeneric(n.sons[1].typ).kind in [tyOpenArray, - // tyTuple, tyObject] then - if skipTypes(n.typ, abstractPtrs).kind in [tyOpenArray, tyTuple, tyObject] then - result := isAssignable(n.sons[1]) - end; - nkHiddenDeref, nkDerefExpr: result := arLValue; - nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result := isAssignable(n.sons[0]); - else begin end - end; -end; - -function newHiddenAddrTaken(c: PContext; n: PNode): PNode; -begin - if n.kind = nkHiddenDeref then begin - checkSonsLen(n, 1); - result := n.sons[0] - end - else begin - result := newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)); - addSon(result, n); - if isAssignable(n) <> arLValue then begin - liMessage(n.info, errVarForOutParamNeeded); - end - end -end; - -function analyseIfAddressTaken(c: PContext; n: PNode): PNode; -begin - result := n; - case n.kind of - nkSym: begin - if skipTypes(n.sym.typ, abstractInst).kind <> tyVar then begin - include(n.sym.flags, sfAddrTaken); - result := newHiddenAddrTaken(c, n); - end - end; - nkDotExpr: begin - checkSonsLen(n, 2); - if n.sons[1].kind <> nkSym then - internalError(n.info, 'analyseIfAddressTaken'); - if skipTypes(n.sons[1].sym.typ, abstractInst).kind <> tyVar then begin - include(n.sons[1].sym.flags, sfAddrTaken); - result := newHiddenAddrTaken(c, n); - end - end; - nkBracketExpr: begin - checkMinSonsLen(n, 1); - if skipTypes(n.sons[0].typ, abstractInst).kind <> tyVar then begin - if n.sons[0].kind = nkSym then - include(n.sons[0].sym.flags, sfAddrTaken); - result := newHiddenAddrTaken(c, n); - end - end; - else result := newHiddenAddrTaken(c, n); // BUGFIX! - end -end; - -procedure analyseIfAddressTakenInCall(c: PContext; n: PNode); -const - FakeVarParams = {@set}[mNew, mNewFinalize, mInc, ast.mDec, mIncl, - mExcl, mSetLengthStr, mSetLengthSeq, - mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq]; -var - i: int; - t: PType; -begin - checkMinSonsLen(n, 1); - t := n.sons[0].typ; - if (n.sons[0].kind = nkSym) - and (n.sons[0].sym.magic in FakeVarParams) then exit; - for i := 1 to sonsLen(n)-1 do - if (i < sonsLen(t)) and (skipTypes(t.sons[i], abstractInst).kind = tyVar) then - n.sons[i] := analyseIfAddressTaken(c, n.sons[i]); -end; - -function semDirectCallAnalyseEffects(c: PContext; n: PNode; - flags: TExprFlags): PNode; -var - callee: PSym; -begin - if not (efWantIterator in flags) then - result := semDirectCall(c, n, {@set}[skProc, skMethod, skConverter]) - else - result := semDirectCall(c, n, {@set}[skIterator]); - if result <> nil then begin - if result.sons[0].kind <> nkSym then - InternalError('semDirectCallAnalyseEffects'); - callee := result.sons[0].sym; - if (callee.kind = skIterator) and (callee.id = c.p.owner.id) then - liMessage(n.info, errRecursiveDependencyX, callee.name.s); - if not (sfNoSideEffect in callee.flags) then - if (sfForward in callee.flags) - or ([sfImportc, sfSideEffect] * callee.flags <> []) then - include(c.p.owner.flags, sfSideEffect); - end -end; - -function semIndirectOp(c: PContext; n: PNode; flags: TExprFlags): PNode; -var - m: TCandidate; - msg: string; - i: int; - prc: PNode; - t: PType; -begin - result := nil; - prc := n.sons[0]; - checkMinSonsLen(n, 1); - if n.sons[0].kind = nkDotExpr then begin - checkSonsLen(n.sons[0], 2); - n.sons[0] := semDotExpr(c, n.sons[0]); - if n.sons[0].kind = nkDotCall then begin // it is a static call! - result := n.sons[0]; - result.kind := nkCall; - for i := 1 to sonsLen(n)-1 do addSon(result, n.sons[i]); - result := semExpr(c, result, flags); - exit - end - end - else - n.sons[0] := semExpr(c, n.sons[0]); - semOpAux(c, n); - if (n.sons[0].typ <> nil) then t := skipTypes(n.sons[0].typ, abstractInst) - else t := nil; - if (t <> nil) and (t.kind = tyProc) then begin - initCandidate(m, t); - matches(c, n, m); - if m.state <> csMatch then begin - msg := msgKindToString(errTypeMismatch); - for i := 1 to sonsLen(n)-1 do begin - if i > 1 then add(msg, ', '); - add(msg, typeToString(n.sons[i].typ)); - end; - add(msg, ')' +{&} nl +{&} msgKindToString(errButExpected) +{&} - nl +{&} typeToString(n.sons[0].typ)); - liMessage(n.Info, errGenerated, msg); - result := nil - end - else - result := m.call; - // we assume that a procedure that calls something indirectly - // has side-effects: - if not (tfNoSideEffect in t.flags) then - include(c.p.owner.flags, sfSideEffect); - end - else begin - result := overloadedCallOpr(c, n); - // Now that nkSym does not imply an iteration over the proc/iterator space, - // the old ``prc`` (which is likely an nkIdent) has to be restored: - if result = nil then begin - n.sons[0] := prc; - result := semDirectCallAnalyseEffects(c, n, flags); - end; - if result = nil then - liMessage(n.info, errExprXCannotBeCalled, - renderTree(n, {@set}[renderNoComments])); - end; - fixAbstractType(c, result); - analyseIfAddressTakenInCall(c, result); -end; - -function semDirectOp(c: PContext; n: PNode; flags: TExprFlags): PNode; -begin - // this seems to be a hotspot in the compiler! - semOpAux(c, n); - result := semDirectCallAnalyseEffects(c, n, flags); - if result = nil then begin - result := overloadedCallOpr(c, n); - if result = nil then - liMessage(n.Info, errGenerated, getNotFoundError(c, n)) - end; - fixAbstractType(c, result); - analyseIfAddressTakenInCall(c, result); -end; - -function semEcho(c: PContext; n: PNode): PNode; -var - i: int; - call, arg: PNode; -begin - // this really is a macro - checkMinSonsLen(n, 1); - for i := 1 to sonsLen(n)-1 do begin - arg := semExprWithType(c, n.sons[i]); - call := newNodeI(nkCall, arg.info); - addSon(call, newIdentNode(getIdent('$'+''), n.info)); - addSon(call, arg); - n.sons[i] := semExpr(c, call); - end; - result := n; -end; - -function LookUpForDefined(c: PContext; n: PNode; onlyCurrentScope: bool): PSym; -var - m: PSym; - ident: PIdent; -begin - case n.kind of - nkIdent: begin - if onlyCurrentScope then - result := SymtabLocalGet(c.tab, n.ident) - else - result := SymtabGet(c.Tab, n.ident); // no need for stub loading - end; - nkDotExpr: begin - result := nil; - if onlyCurrentScope then exit; - checkSonsLen(n, 2); - m := LookupForDefined(c, n.sons[0], onlyCurrentScope); - if (m <> nil) and (m.kind = skModule) then begin - if (n.sons[1].kind = nkIdent) then begin - ident := n.sons[1].ident; - if m = c.module then - // a module may access its private members: - result := StrTableGet(c.tab.stack[ModuleTablePos], ident) - else - result := StrTableGet(m.tab, ident); - end - else - liMessage(n.sons[1].info, errIdentifierExpected, ''); - end - end; - nkAccQuoted: begin - checkSonsLen(n, 1); - result := lookupForDefined(c, n.sons[0], onlyCurrentScope); - end - else begin - liMessage(n.info, errIdentifierExpected, renderTree(n)); - result := nil; - end - end -end; - -function semDefined(c: PContext; n: PNode; onlyCurrentScope: bool): PNode; -begin - checkSonsLen(n, 2); - result := newIntNode(nkIntLit, 0); - // we replace this node by a 'true' or 'false' node - if LookUpForDefined(c, n.sons[1], onlyCurrentScope) <> nil then - result.intVal := 1 - else if not onlyCurrentScope and (n.sons[1].kind = nkIdent) - and condsyms.isDefined(n.sons[1].ident) then - result.intVal := 1; - result.info := n.info; - result.typ := getSysType(tyBool); -end; - -function setMs(n: PNode; s: PSym): PNode; -begin - result := n; - n.sons[0] := newSymNode(s); - n.sons[0].info := n.info; -end; - -function semMagic(c: PContext; n: PNode; s: PSym; flags: TExprFlags): PNode; -// this is a hotspot in the compiler! -begin - result := n; - case s.magic of // magics that need special treatment - mDefined: result := semDefined(c, setMs(n, s), false); - mDefinedInScope: result := semDefined(c, setMs(n, s), true); - mLow: result := semLowHigh(c, setMs(n, s), mLow); - mHigh: result := semLowHigh(c, setMs(n, s), mHigh); - mSizeOf: result := semSizeof(c, setMs(n, s)); - mIs: result := semIs(c, setMs(n, s)); - mEcho: result := semEcho(c, setMs(n, s)); - else result := semDirectOp(c, n, flags); - end; -end; - -function isTypeExpr(n: PNode): bool; -begin - case n.kind of - nkType, nkTypeOfExpr: result := true; - nkSym: result := n.sym.kind = skType; - else result := false - end -end; - -function lookupInRecordAndBuildCheck(c: PContext; n, r: PNode; - field: PIdent; var check: PNode): PSym; -// transform in a node that contains the runtime check for the -// field, if it is in a case-part... -var - i, j: int; - s, it, inExpr, notExpr: PNode; -begin - result := nil; - case r.kind of - nkRecList: begin - for i := 0 to sonsLen(r)-1 do begin - result := lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check); - if result <> nil then exit - end - end; - nkRecCase: begin - checkMinSonsLen(r, 2); - if (r.sons[0].kind <> nkSym) then IllFormedAst(r); - result := lookupInRecordAndBuildCheck(c, n, r.sons[0], field, check); - if result <> nil then exit; - s := newNodeI(nkCurly, r.info); - for i := 1 to sonsLen(r)-1 do begin - it := r.sons[i]; - case it.kind of - nkOfBranch: begin - result := lookupInRecordAndBuildCheck(c, n, lastSon(it), - field, check); - if result = nil then begin - for j := 0 to sonsLen(it)-2 do addSon(s, copyTree(it.sons[j])); - end - else begin - if check = nil then begin - check := newNodeI(nkCheckedFieldExpr, n.info); - addSon(check, nil); // make space for access node - end; - s := newNodeI(nkCurly, n.info); - for j := 0 to sonsLen(it)-2 do addSon(s, copyTree(it.sons[j])); - inExpr := newNodeI(nkCall, n.info); - addSon(inExpr, newIdentNode(getIdent('in'), n.info)); - addSon(inExpr, copyTree(r.sons[0])); - addSon(inExpr, s); - //writeln(output, renderTree(inExpr)); - addSon(check, semExpr(c, inExpr)); - exit - end - end; - nkElse: begin - result := lookupInRecordAndBuildCheck(c, n, lastSon(it), - field, check); - if result <> nil then begin - if check = nil then begin - check := newNodeI(nkCheckedFieldExpr, n.info); - addSon(check, nil); // make space for access node - end; - inExpr := newNodeI(nkCall, n.info); - addSon(inExpr, newIdentNode(getIdent('in'), n.info)); - addSon(inExpr, copyTree(r.sons[0])); - addSon(inExpr, s); - notExpr := newNodeI(nkCall, n.info); - addSon(notExpr, newIdentNode(getIdent('not'), n.info)); - addSon(notExpr, inExpr); - addSon(check, semExpr(c, notExpr)); - exit - end - end; - else - illFormedAst(it); - end - end - end; - nkSym: begin - if r.sym.name.id = field.id then result := r.sym; - end; - else illFormedAst(n); - end -end; - -function makeDeref(n: PNode): PNode; -var - t: PType; - a: PNode; -begin - t := skipTypes(n.typ, {@set}[tyGenericInst]); - result := n; - if t.kind = tyVar then begin - result := newNodeIT(nkHiddenDeref, n.info, t.sons[0]); - addSon(result, n); - t := skipTypes(t.sons[0], {@set}[tyGenericInst]); - end; - if t.kind in [tyPtr, tyRef] then begin - a := result; - result := newNodeIT(nkDerefExpr, n.info, t.sons[0]); - addSon(result, a); - end -end; - -function semFieldAccess(c: PContext; n: PNode; flags: TExprFlags): PNode; -var - f: PSym; - ty: PType; - i: PIdent; - check: PNode; -begin - // this is difficult, because the '.' is used in many different contexts - // in Nimrod. We first allow types in the semantic checking. - checkSonsLen(n, 2); - n.sons[0] := semExprWithType(c, n.sons[0], [efAllowType]+flags); - i := considerAcc(n.sons[1]); - ty := n.sons[0].Typ; - f := nil; - result := nil; - if ty.kind = tyEnum then begin - // look up if the identifier belongs to the enum: - while (ty <> nil) do begin - f := getSymFromList(ty.n, i); - if f <> nil then break; - ty := ty.sons[0]; // enum inheritance - end; - if f <> nil then begin - result := newSymNode(f); - result.info := n.info; - result.typ := ty; - markUsed(n, f); - end - else - liMessage(n.sons[1].info, errEnumHasNoValueX, i.s); - exit; - end - else if not (efAllowType in flags) and isTypeExpr(n.sons[0]) then begin - liMessage(n.sons[0].info, errATypeHasNoValue); - exit - end; - - ty := skipTypes(ty, {@set}[tyGenericInst, tyVar, tyPtr, tyRef]); - if ty.kind = tyObject then begin - while true do begin - check := nil; - f := lookupInRecordAndBuildCheck(c, n, ty.n, i, check); - //f := lookupInRecord(ty.n, i); - if f <> nil then break; - if ty.sons[0] = nil then break; - ty := skipTypes(ty.sons[0], {@set}[tyGenericInst]); - end; - if f <> nil then begin - if ([sfStar, sfMinus] * f.flags <> []) - or (getModule(f).id = c.module.id) then begin - // is the access to a public field or in the same module? - n.sons[0] := makeDeref(n.sons[0]); - n.sons[1] := newSymNode(f); // we now have the correct field - n.typ := f.typ; - markUsed(n, f); - if check = nil then result := n - else begin - check.sons[0] := n; - check.typ := n.typ; - result := check - end; - exit - end - end - end - else if ty.kind = tyTuple then begin - f := getSymFromList(ty.n, i); - if f <> nil then begin - n.sons[0] := makeDeref(n.sons[0]); - n.sons[1] := newSymNode(f); - n.typ := f.typ; - result := n; - markUsed(n, f); - exit - end - end; - // allow things like "".replace(...) - // --> replace("", ...) - f := SymTabGet(c.tab, i); - //if (f <> nil) and (f.kind = skStub) then loadStub(f); - // ``loadStub`` is not correct here as we don't care for ``f`` really - if (f <> nil) then begin - // BUGFIX: do not check for (f.kind in [skProc, skMethod, skIterator]) here - result := newNodeI(nkDotCall, n.info); - // This special node kind is to merge with the call handler in `semExpr`. - addSon(result, newIdentNode(i, n.info)); - addSon(result, copyTree(n.sons[0])); - end - else begin - liMessage(n.Info, errUndeclaredFieldX, i.s); - end -end; - -function whichSliceOpr(n: PNode): string; -begin - if (n.sons[0] = nil) then - if (n.sons[1] = nil) then result := '[..]' - else result := '[..$]' - else if (n.sons[1] = nil) then result := '[$..]' - else result := '[$..$]' -end; - -function semArrayAccess(c: PContext; n: PNode; flags: TExprFlags): PNode; -var - arr, indexType: PType; - i: int; - arg: PNode; - idx: biggestInt; -begin - // check if array type: - checkMinSonsLen(n, 2); - n.sons[0] := semExprWithType(c, n.sons[0], flags-[efAllowType]); - arr := skipTypes(n.sons[0].typ, {@set}[tyGenericInst, tyVar, tyPtr, tyRef]); - case arr.kind of - tyArray, tyOpenArray, tyArrayConstr, tySequence, tyString, - tyCString: begin - n.sons[0] := makeDeref(n.sons[0]); - for i := 1 to sonsLen(n)-1 do - n.sons[i] := semExprWithType(c, n.sons[i], flags-[efAllowType]); - if arr.kind = tyArray then indexType := arr.sons[0] - else indexType := getSysType(tyInt); - arg := IndexTypesMatch(c, indexType, n.sons[1].typ, n.sons[1]); - if arg <> nil then - n.sons[1] := arg - else - liMessage(n.info, errIndexTypesDoNotMatch); - result := n; - result.typ := elemType(arr); - end; - tyTuple: begin - n.sons[0] := makeDeref(n.sons[0]); - // [] operator for tuples requires constant expression - n.sons[1] := semConstExpr(c, n.sons[1]); - if skipTypes(n.sons[1].typ, {@set}[tyGenericInst, tyRange, tyOrdinal]).kind in - [tyInt..tyInt64] then begin - idx := getOrdValue(n.sons[1]); - if (idx >= 0) and (idx < sonsLen(arr)) then - n.typ := arr.sons[int(idx)] - else - liMessage(n.info, errInvalidIndexValueForTuple); - end - else - liMessage(n.info, errIndexTypesDoNotMatch); - result := n; - end - else begin // overloaded [] operator: - result := newNodeI(nkCall, n.info); - if n.sons[1].kind = nkRange then begin - checkSonsLen(n.sons[1], 2); - addSon(result, newIdentNode(getIdent(whichSliceOpr(n.sons[1])), n.info)); - addSon(result, n.sons[0]); - addSonIfNotNil(result, n.sons[1].sons[0]); - addSonIfNotNil(result, n.sons[1].sons[1]); - end - else begin - addSon(result, newIdentNode(getIdent('[]'), n.info)); - addSon(result, n.sons[0]); - addSon(result, n.sons[1]); - end; - result := semExpr(c, result); - end - end -end; - -function semIfExpr(c: PContext; n: PNode): PNode; -var - typ: PType; - i: int; - it: PNode; -begin - result := n; - checkSonsLen(n, 2); - typ := nil; - for i := 0 to sonsLen(n) - 1 do begin - it := n.sons[i]; - case it.kind of - nkElifExpr: begin - checkSonsLen(it, 2); - it.sons[0] := semExprWithType(c, it.sons[0]); - checkBool(it.sons[0]); - it.sons[1] := semExprWithType(c, it.sons[1]); - if typ = nil then typ := it.sons[1].typ - else it.sons[1] := fitNode(c, typ, it.sons[1]) - end; - nkElseExpr: begin - checkSonsLen(it, 1); - it.sons[0] := semExprWithType(c, it.sons[0]); - if (typ = nil) then InternalError(it.info, 'semIfExpr'); - it.sons[0] := fitNode(c, typ, it.sons[0]); - end; - else illFormedAst(n); - end - end; - result.typ := typ; -end; - -function semSetConstr(c: PContext; n: PNode): PNode; -var - typ: PType; - i: int; - m: PNode; -begin - result := newNodeI(nkCurly, n.info); - result.typ := newTypeS(tySet, c); - if sonsLen(n) = 0 then - addSon(result.typ, newTypeS(tyEmpty, c)) - else begin - // only semantic checking for all elements, later type checking: - typ := nil; - for i := 0 to sonsLen(n)-1 do begin - if n.sons[i].kind = nkRange then begin - checkSonsLen(n.sons[i], 2); - n.sons[i].sons[0] := semExprWithType(c, n.sons[i].sons[0]); - n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1]); - if typ = nil then - typ := skipTypes(n.sons[i].sons[0].typ, - {@set}[tyGenericInst, tyVar, tyOrdinal]); - n.sons[i].typ := n.sons[i].sons[1].typ; // range node needs type too - end - else begin - n.sons[i] := semExprWithType(c, n.sons[i]); - if typ = nil then - typ := skipTypes(n.sons[i].typ, {@set}[tyGenericInst, tyVar, tyOrdinal]) - end - end; - if not isOrdinalType(typ) then begin - liMessage(n.info, errOrdinalTypeExpected); - exit - end; - if lengthOrd(typ) > MaxSetElements then - typ := makeRangeType(c, 0, MaxSetElements-1, n.info); - addSon(result.typ, typ); - - for i := 0 to sonsLen(n)-1 do begin - if n.sons[i].kind = nkRange then begin - m := newNodeI(nkRange, n.sons[i].info); - addSon(m, fitNode(c, typ, n.sons[i].sons[0])); - addSon(m, fitNode(c, typ, n.sons[i].sons[1])); - end - else begin - m := fitNode(c, typ, n.sons[i]); - end; - addSon(result, m); - end - end -end; - -type - TParKind = (paNone, paSingle, paTupleFields, paTuplePositions); - -function checkPar(n: PNode): TParKind; -var - i, len: int; -begin - len := sonsLen(n); - if len = 0 then result := paTuplePositions // () - else if len = 1 then result := paSingle // (expr) - else begin - if n.sons[0].kind = nkExprColonExpr then result := paTupleFields - else result := paTuplePositions; - for i := 0 to len-1 do begin - if result = paTupleFields then begin - if (n.sons[i].kind <> nkExprColonExpr) - or not (n.sons[i].sons[0].kind in [nkSym, nkIdent]) then begin - liMessage(n.sons[i].info, errNamedExprExpected); - result := paNone; exit - end - end - else begin - if n.sons[i].kind = nkExprColonExpr then begin - liMessage(n.sons[i].info, errNamedExprNotAllowed); - result := paNone; exit - end - end - end - end -end; - -function semTupleFieldsConstr(c: PContext; n: PNode): PNode; -var - i: int; - typ: PType; - ids: TIntSet; - id: PIdent; - f: PSym; -begin - result := newNodeI(nkPar, n.info); - typ := newTypeS(tyTuple, c); - typ.n := newNodeI(nkRecList, n.info); // nkIdentDefs - IntSetInit(ids); - for i := 0 to sonsLen(n)-1 do begin - if (n.sons[i].kind <> nkExprColonExpr) - or not (n.sons[i].sons[0].kind in [nkSym, nkIdent]) then - illFormedAst(n.sons[i]); - if n.sons[i].sons[0].kind = nkIdent then - id := n.sons[i].sons[0].ident - else - id := n.sons[i].sons[0].sym.name; - if IntSetContainsOrIncl(ids, id.id) then - liMessage(n.sons[i].info, errFieldInitTwice, id.s); - n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1]); - f := newSymS(skField, n.sons[i].sons[0], c); - f.typ := n.sons[i].sons[1].typ; - addSon(typ, f.typ); - addSon(typ.n, newSymNode(f)); - n.sons[i].sons[0] := newSymNode(f); - addSon(result, n.sons[i]); - end; - result.typ := typ; -end; - -function semTuplePositionsConstr(c: PContext; n: PNode): PNode; -var - i: int; - typ: PType; -begin - result := n; // we don't modify n, but compute the type: - typ := newTypeS(tyTuple, c); - // leave typ.n nil! - for i := 0 to sonsLen(n)-1 do begin - n.sons[i] := semExprWithType(c, n.sons[i]); - addSon(typ, n.sons[i].typ); - end; - result.typ := typ; -end; - -function semStmtListExpr(c: PContext; n: PNode): PNode; -var - len, i: int; -begin - result := n; - checkMinSonsLen(n, 1); - len := sonsLen(n); - for i := 0 to len-2 do begin - n.sons[i] := semStmt(c, n.sons[i]); - end; - if len > 0 then begin - n.sons[len-1] := semExprWithType(c, n.sons[len-1]); - n.typ := n.sons[len-1].typ - end -end; - -function semBlockExpr(c: PContext; n: PNode): PNode; -begin - result := n; - Inc(c.p.nestedBlockCounter); - checkSonsLen(n, 2); - openScope(c.tab); // BUGFIX: label is in the scope of block! - if n.sons[0] <> nil then begin - addDecl(c, newSymS(skLabel, n.sons[0], c)) - end; - n.sons[1] := semStmtListExpr(c, n.sons[1]); - n.typ := n.sons[1].typ; - closeScope(c.tab); - Dec(c.p.nestedBlockCounter); -end; - -function isCallExpr(n: PNode): bool; -begin - result := n.kind in [nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit]; -end; - -function semMacroStmt(c: PContext; n: PNode; semCheck: bool = true): PNode; -var - s: PSym; - a: PNode; - i: int; -begin - checkMinSonsLen(n, 2); - if isCallExpr(n.sons[0]) then - a := n.sons[0].sons[0] - else - a := n.sons[0]; - s := qualifiedLookup(c, a, false); - if (s <> nil) then begin - case s.kind of - skMacro: result := semMacroExpr(c, n, s, semCheck); - skTemplate: begin - // transform - // nkMacroStmt(nkCall(a...), stmt, b...) - // to - // nkCall(a..., stmt, b...) - result := newNodeI(nkCall, n.info); - addSon(result, a); - if isCallExpr(n.sons[0]) then begin - for i := 1 to sonsLen(n.sons[0])-1 do - addSon(result, n.sons[0].sons[i]); - end; - for i := 1 to sonsLen(n)-1 do addSon(result, n.sons[i]); - result := semTemplateExpr(c, result, s, semCheck); - end; - else - liMessage(n.info, errXisNoMacroOrTemplate, s.name.s); - end - end - else - liMessage(n.info, errInvalidExpressionX, - renderTree(a, {@set}[renderNoComments])); -end; - -function semSym(c: PContext; n: PNode; s: PSym; flags: TExprFlags): PNode; -begin - if (s.kind = skType) and not (efAllowType in flags) then - liMessage(n.info, errATypeHasNoValue); - case s.kind of - skProc, skMethod, skIterator, skConverter: begin - if not (sfProcVar in s.flags) - and (s.typ.callConv = ccDefault) - and (getModule(s).id <> c.module.id) then - liMessage(n.info, warnXisPassedToProcVar, s.name.s); - // XXX change this to errXCannotBePassedToProcVar after version 0.8.2 - // TODO VERSION 0.8.4 - //if (s.magic <> mNone) then - // liMessage(n.info, errInvalidContextForBuiltinX, s.name.s); - result := symChoice(c, n, s); - end; - skConst: begin - (* - Consider:: - const x = [] - proc p(a: openarray[int]) - proc q(a: openarray[char]) - p(x) - q(x) - - It is clear that ``[]`` means two totally different things. Thus, we - copy `x`'s AST into each context, so that the type fixup phase can - deal with two different ``[]``. - *) - markUsed(n, s); - if s.typ.kind in ConstAbstractTypes then begin - result := copyTree(s.ast); - result.info := n.info; - result.typ := s.typ; - end - else begin - result := newSymNode(s); - result.info := n.info; - end - end; - skMacro: result := semMacroExpr(c, n, s); - skTemplate: result := semTemplateExpr(c, n, s); - skVar: begin - markUsed(n, s); - // if a proc accesses a global variable, it is not side effect free - if sfGlobal in s.flags then include(c.p.owner.flags, sfSideEffect); - result := newSymNode(s); - result.info := n.info; - end; - skGenericParam: begin - if s.ast = nil then InternalError(n.info, 'no default for'); - result := semExpr(c, s.ast); - end - else begin - markUsed(n, s); - result := newSymNode(s); - result.info := n.info; - end - end; -end; - -function semDotExpr(c: PContext; n: PNode; flags: TExprFlags): PNode; -var - s: PSym; -begin - s := qualifiedLookup(c, n, true); // check for ambiguity - if s <> nil then - result := semSym(c, n, s, flags) - else - // this is a test comment; please don't touch it - result := semFieldAccess(c, n, flags); -end; - -function semExpr(c: PContext; n: PNode; flags: TExprFlags = {@set}[]): PNode; -var - s: PSym; - t: PType; -begin - result := n; - if n = nil then exit; - if nfSem in n.flags then exit; - case n.kind of - // atoms: - nkIdent: begin - s := lookUp(c, n); - result := semSym(c, n, s, flags); - end; - nkSym: begin - (*s := n.sym; - include(s.flags, sfUsed); - if (s.kind = skType) and not (efAllowType in flags) then - liMessage(n.info, errATypeHasNoValue);*) - // because of the changed symbol binding, this does not mean that we - // don't have to check the symbol for semantics here again! - result := semSym(c, n, n.sym, flags); - end; - nkEmpty, nkNone: begin end; - nkNilLit: result.typ := getSysType(tyNil); - nkType: begin - if not (efAllowType in flags) then liMessage(n.info, errATypeHasNoValue); - n.typ := semTypeNode(c, n, nil); - end; - nkIntLit: if result.typ = nil then result.typ := getSysType(tyInt); - nkInt8Lit: if result.typ = nil then result.typ := getSysType(tyInt8); - nkInt16Lit: if result.typ = nil then result.typ := getSysType(tyInt16); - nkInt32Lit: if result.typ = nil then result.typ := getSysType(tyInt32); - nkInt64Lit: if result.typ = nil then result.typ := getSysType(tyInt64); - nkFloatLit: if result.typ = nil then result.typ := getSysType(tyFloat); - nkFloat32Lit: if result.typ = nil then result.typ := getSysType(tyFloat32); - nkFloat64Lit: if result.typ = nil then result.typ := getSysType(tyFloat64); - nkStrLit..nkTripleStrLit: - if result.typ = nil then result.typ := getSysType(tyString); - nkCharLit: - if result.typ = nil then result.typ := getSysType(tyChar); - nkDotExpr: begin - result := semDotExpr(c, n, flags); - if result.kind = nkDotCall then begin - result.kind := nkCall; - result := semExpr(c, result, flags) - end; - end; - nkBind: result := semExpr(c, n.sons[0], flags); - nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: begin - // check if it is an expression macro: - checkMinSonsLen(n, 1); - s := qualifiedLookup(c, n.sons[0], false); - if (s <> nil) then begin - case s.kind of - skMacro: result := semMacroExpr(c, n, s); - skTemplate: result := semTemplateExpr(c, n, s); - skType: begin - if n.kind <> nkCall then - liMessage(n.info, errXisNotCallable, s.name.s); - // XXX does this check make any sense? - result := semConv(c, n, s); - end; - skProc, skMethod, skConverter, skIterator: begin - if s.magic = mNone then result := semDirectOp(c, n, flags) - else result := semMagic(c, n, s, flags); - end; - else begin - //liMessage(n.info, warnUser, renderTree(n)); - result := semIndirectOp(c, n, flags) - end - end - end - else if n.sons[0].kind = nkSymChoice then - result := semDirectOp(c, n, flags) - else - result := semIndirectOp(c, n, flags); - end; - nkMacroStmt: begin - result := semMacroStmt(c, n); - end; - nkBracketExpr: begin - checkMinSonsLen(n, 1); - s := qualifiedLookup(c, n.sons[0], false); - if (s <> nil) - and (s.kind in [skProc, skMethod, skConverter, skIterator]) then begin - // type parameters: partial generic specialization - // XXX: too implement! - internalError(n.info, 'explicit generic instantation not implemented'); - result := partialSpecialization(c, n, s); - end - else begin - result := semArrayAccess(c, n, flags); - end - end; - nkPragmaExpr: begin - // which pragmas are allowed for expressions? `likely`, `unlikely` - internalError(n.info, 'semExpr() to implement'); - // XXX: to implement - end; - nkPar: begin - case checkPar(n) of - paNone: result := nil; - paTuplePositions: result := semTuplePositionsConstr(c, n); - paTupleFields: result := semTupleFieldsConstr(c, n); - paSingle: result := semExpr(c, n.sons[0]); - end; - end; - nkCurly: result := semSetConstr(c, n); - nkBracket: result := semArrayConstr(c, n); - nkLambda: result := semLambda(c, n); - nkDerefExpr: begin - checkSonsLen(n, 1); - n.sons[0] := semExprWithType(c, n.sons[0]); - result := n; - t := skipTypes(n.sons[0].typ, {@set}[tyGenericInst, tyVar]); - case t.kind of - tyRef, tyPtr: n.typ := t.sons[0]; - else liMessage(n.sons[0].info, errCircumNeedsPointer); - end; - result := n; - end; - nkAddr: begin - result := n; - checkSonsLen(n, 1); - n.sons[0] := semExprWithType(c, n.sons[0]); - if isAssignable(n.sons[0]) <> arLValue then - liMessage(n.info, errExprHasNoAddress); - n.typ := makePtrType(c, n.sons[0].typ); - end; - nkHiddenAddr, nkHiddenDeref: begin - checkSonsLen(n, 1); - n.sons[0] := semExpr(c, n.sons[0], flags); - end; - nkCast: result := semCast(c, n); - nkAccQuoted: begin - checkSonsLen(n, 1); - result := semExpr(c, n.sons[0]); - end; - nkIfExpr: result := semIfExpr(c, n); - nkStmtListExpr: result := semStmtListExpr(c, n); - nkBlockExpr: result := semBlockExpr(c, n); - nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: - checkSonsLen(n, 2); - nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkObjDownConv, - nkObjUpConv: - checkSonsLen(n, 1); - nkChckRangeF, nkChckRange64, nkChckRange: - checkSonsLen(n, 3); - nkCheckedFieldExpr: - checkMinSonsLen(n, 2); - nkSymChoice: begin - liMessage(n.info, errExprXAmbiguous, - renderTree(n, {@set}[renderNoComments])); - result := nil - end - else begin - //InternalError(n.info, nodeKindToStr[n.kind]); - liMessage(n.info, errInvalidExpressionX, - renderTree(n, {@set}[renderNoComments])); - result := nil - end - end; - include(result.flags, nfSem); -end; diff --git a/nim/semfold.pas b/nim/semfold.pas deleted file mode 100755 index 791f391494..0000000000 --- a/nim/semfold.pas +++ /dev/null @@ -1,578 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit semfold; - -// this module folds constants; used by semantic checking phase -// and evaluation phase - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, charsets, strutils, - lists, options, ast, astalgo, trees, treetab, nimsets, ntime, nversion, - platform, nmath, msgs, nos, condsyms, idents, rnimsyn, types; - -function getConstExpr(module: PSym; n: PNode): PNode; - // evaluates the constant expression or returns nil if it is no constant - // expression - -function evalOp(m: TMagic; n, a, b, c: PNode): PNode; -function leValueConv(a, b: PNode): Boolean; - -function newIntNodeT(const intVal: BiggestInt; n: PNode): PNode; -function newFloatNodeT(const floatVal: BiggestFloat; n: PNode): PNode; -function newStrNodeT(const strVal: string; n: PNode): PNode; -function getInt(a: PNode): biggestInt; -function getFloat(a: PNode): biggestFloat; -function getStr(a: PNode): string; -function getStrOrChar(a: PNode): string; - -implementation - -function newIntNodeT(const intVal: BiggestInt; n: PNode): PNode; -begin - if skipTypes(n.typ, abstractVarRange).kind = tyChar then - result := newIntNode(nkCharLit, intVal) - else - result := newIntNode(nkIntLit, intVal); - result.typ := n.typ; - result.info := n.info; -end; - -function newFloatNodeT(const floatVal: BiggestFloat; n: PNode): PNode; -begin - result := newFloatNode(nkFloatLit, floatVal); - result.typ := n.typ; - result.info := n.info; -end; - -function newStrNodeT(const strVal: string; n: PNode): PNode; -begin - result := newStrNode(nkStrLit, strVal); - result.typ := n.typ; - result.info := n.info; -end; - -function getInt(a: PNode): biggestInt; -begin - case a.kind of - nkIntLit..nkInt64Lit: result := a.intVal; - else begin internalError(a.info, 'getInt'); result := 0 end; - end -end; - -function getFloat(a: PNode): biggestFloat; -begin - case a.kind of - nkFloatLit..nkFloat64Lit: result := a.floatVal; - else begin internalError(a.info, 'getFloat'); result := 0.0 end; - end -end; - -function getStr(a: PNode): string; -begin - case a.kind of - nkStrLit..nkTripleStrLit: result := a.strVal; - else begin internalError(a.info, 'getStr'); result := '' end; - end -end; - -function getStrOrChar(a: PNode): string; -begin - case a.kind of - nkStrLit..nkTripleStrLit: result := a.strVal; - nkCharLit: result := chr(int(a.intVal))+''; - else begin internalError(a.info, 'getStrOrChar'); result := '' end; - end -end; - -function enumValToString(a: PNode): string; -var - n: PNode; - field: PSym; - x: biggestInt; - i: int; -begin - x := getInt(a); - n := skipTypes(a.typ, abstractInst).n; - for i := 0 to sonsLen(n)-1 do begin - if n.sons[i].kind <> nkSym then InternalError(a.info, 'enumValToString'); - field := n.sons[i].sym; - if field.position = x then begin - result := field.name.s; exit - end; - end; - InternalError(a.info, 'no symbol for ordinal value: ' + toString(x)); -end; - -function evalOp(m: TMagic; n, a, b, c: PNode): PNode; -// b and c may be nil -begin - result := nil; - case m of - mOrd: result := newIntNodeT(getOrdValue(a), n); - mChr: result := newIntNodeT(getInt(a), n); - mUnaryMinusI, mUnaryMinusI64: result := newIntNodeT(-getInt(a), n); - mUnaryMinusF64: result := newFloatNodeT(-getFloat(a), n); - mNot: result := newIntNodeT(1 - getInt(a), n); - mCard: result := newIntNodeT(nimsets.cardSet(a), n); - mBitnotI, mBitnotI64: result := newIntNodeT(not getInt(a), n); - - mLengthStr: result := newIntNodeT(length(getStr(a)), n); - mLengthArray: result := newIntNodeT(lengthOrd(a.typ), n); - mLengthSeq, mLengthOpenArray: - result := newIntNodeT(sonsLen(a), n); // BUGFIX - - mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: result := a; // throw `+` away - mToFloat, mToBiggestFloat: - result := newFloatNodeT(toFloat(int(getInt(a))), n); - mToInt, mToBiggestInt: result := newIntNodeT(nsystem.toInt(getFloat(a)), n); - mAbsF64: result := newFloatNodeT(abs(getFloat(a)), n); - mAbsI, mAbsI64: begin - if getInt(a) >= 0 then result := a - else result := newIntNodeT(-getInt(a), n); - end; - mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: begin - // byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 - result := newIntNodeT(getInt(a) and (shlu(1, getSize(a.typ)*8) - 1), n); - end; - mToU8: result := newIntNodeT(getInt(a) and $ff, n); - mToU16: result := newIntNodeT(getInt(a) and $ffff, n); - mToU32: result := newIntNodeT(getInt(a) and $00000000ffffffff, n); - - mSucc: result := newIntNodeT(getOrdValue(a)+getInt(b), n); - mPred: result := newIntNodeT(getOrdValue(a)-getInt(b), n); - - mAddI, mAddI64: result := newIntNodeT(getInt(a)+getInt(b), n); - mSubI, mSubI64: result := newIntNodeT(getInt(a)-getInt(b), n); - mMulI, mMulI64: result := newIntNodeT(getInt(a)*getInt(b), n); - mMinI, mMinI64: begin - if getInt(a) > getInt(b) then result := newIntNodeT(getInt(b), n) - else result := newIntNodeT(getInt(a), n); - end; - mMaxI, mMaxI64: begin - if getInt(a) > getInt(b) then result := newIntNodeT(getInt(a), n) - else result := newIntNodeT(getInt(b), n); - end; - mShlI, mShlI64: begin - case skipTypes(n.typ, abstractRange).kind of - tyInt8: result := newIntNodeT(int8(getInt(a)) shl int8(getInt(b)), n); - tyInt16: result := newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n); - tyInt32: result := newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n); - tyInt64, tyInt: - result := newIntNodeT(shlu(getInt(a), getInt(b)), n); - else InternalError(n.info, 'constant folding for shl'); - end - end; - mShrI, mShrI64: begin - case skipTypes(n.typ, abstractRange).kind of - tyInt8: result := newIntNodeT(int8(getInt(a)) shr int8(getInt(b)), n); - tyInt16: result := newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n); - tyInt32: result := newIntNodeT(int32(getInt(a)) shr int32(getInt(b)), n); - tyInt64, tyInt: - result := newIntNodeT(shru(getInt(a), getInt(b)), n); - else InternalError(n.info, 'constant folding for shl'); - end - end; - mDivI, mDivI64: result := newIntNodeT(getInt(a) div getInt(b), n); - mModI, mModI64: result := newIntNodeT(getInt(a) mod getInt(b), n); - - mAddF64: result := newFloatNodeT(getFloat(a)+getFloat(b), n); - mSubF64: result := newFloatNodeT(getFloat(a)-getFloat(b), n); - mMulF64: result := newFloatNodeT(getFloat(a)*getFloat(b), n); - mDivF64: begin - if getFloat(b) = 0.0 then begin - if getFloat(a) = 0.0 then - result := newFloatNodeT(NaN, n) - else - result := newFloatNodeT(Inf, n); - end - else - result := newFloatNodeT(getFloat(a)/getFloat(b), n); - end; - mMaxF64: begin - if getFloat(a) > getFloat(b) then result := newFloatNodeT(getFloat(a), n) - else result := newFloatNodeT(getFloat(b), n); - end; - mMinF64: begin - if getFloat(a) > getFloat(b) then result := newFloatNodeT(getFloat(b), n) - else result := newFloatNodeT(getFloat(a), n); - end; - mIsNil: result := newIntNodeT(ord(a.kind = nkNilLit), n); - mLtI, mLtI64, mLtB, mLtEnum, mLtCh: - result := newIntNodeT(ord(getOrdValue(a) < getOrdValue(b)), n); - mLeI, mLeI64, mLeB, mLeEnum, mLeCh: - result := newIntNodeT(ord(getOrdValue(a) <= getOrdValue(b)), n); - mEqI, mEqI64, mEqB, mEqEnum, mEqCh: - result := newIntNodeT(ord(getOrdValue(a) = getOrdValue(b)), n); - // operators for floats - mLtF64: result := newIntNodeT(ord(getFloat(a) < getFloat(b)), n); - mLeF64: result := newIntNodeT(ord(getFloat(a) <= getFloat(b)), n); - mEqF64: result := newIntNodeT(ord(getFloat(a) = getFloat(b)), n); - // operators for strings - mLtStr: result := newIntNodeT(ord(getStr(a) < getStr(b)), n); - mLeStr: result := newIntNodeT(ord(getStr(a) <= getStr(b)), n); - mEqStr: result := newIntNodeT(ord(getStr(a) = getStr(b)), n); - - mLtU, mLtU64: - result := newIntNodeT(ord(ltU(getOrdValue(a), getOrdValue(b))), n); - mLeU, mLeU64: - result := newIntNodeT(ord(leU(getOrdValue(a), getOrdValue(b))), n); - mBitandI, mBitandI64, mAnd: - result := newIntNodeT(getInt(a) and getInt(b), n); - mBitorI, mBitorI64, mOr: - result := newIntNodeT(getInt(a) or getInt(b), n); - mBitxorI, mBitxorI64, mXor: - result := newIntNodeT(getInt(a) xor getInt(b), n); - - mAddU, mAddU64: result := newIntNodeT(addU(getInt(a), getInt(b)), n); - mSubU, mSubU64: result := newIntNodeT(subU(getInt(a), getInt(b)), n); - mMulU, mMulU64: result := newIntNodeT(mulU(getInt(a), getInt(b)), n); - mModU, mModU64: result := newIntNodeT(modU(getInt(a), getInt(b)), n); - mDivU, mDivU64: result := newIntNodeT(divU(getInt(a), getInt(b)), n); - - mLeSet: result := newIntNodeT(Ord(containsSets(a, b)), n); - mEqSet: result := newIntNodeT(Ord(equalSets(a, b)), n); - mLtSet: result := newIntNodeT(Ord(containsSets(a, b) - and not equalSets(a, b)), n); - mMulSet: begin - result := nimsets.intersectSets(a, b); - result.info := n.info; - end; - mPlusSet: begin - result := nimsets.unionSets(a, b); - result.info := n.info; - end; - mMinusSet: begin - result := nimsets.diffSets(a, b); - result.info := n.info; - end; - mSymDiffSet: begin - result := nimsets.symdiffSets(a, b); - result.info := n.info; - end; - mConStrStr: result := newStrNodeT(getStrOrChar(a)+{&}getStrOrChar(b), n); - mInSet: result := newIntNodeT(Ord(inSet(a, b)), n); - mRepr: begin - // BUGFIX: we cannot eval mRepr here. But this means that it is not - // available for interpretation. I don't know how to fix this. - //result := newStrNodeT(renderTree(a, {@set}[renderNoComments]), n); - end; - mIntToStr, mInt64ToStr: - result := newStrNodeT(toString(getOrdValue(a)), n); - mBoolToStr: begin - if getOrdValue(a) = 0 then - result := newStrNodeT('false', n) - else - result := newStrNodeT('true', n) - end; - mCopyStr: - result := newStrNodeT(ncopy(getStr(a), int(getOrdValue(b))+strStart), n); - mCopyStrLast: - result := newStrNodeT(ncopy(getStr(a), int(getOrdValue(b))+strStart, - int(getOrdValue(c))+strStart), n); - mFloatToStr: result := newStrNodeT(toStringF(getFloat(a)), n); - mCStrToStr, mCharToStr: result := newStrNodeT(getStrOrChar(a), n); - mStrToStr: result := a; - mEnumToStr: result := newStrNodeT(enumValToString(a), n); - mArrToSeq: begin - result := copyTree(a); - result.typ := n.typ; - end; - mNewString, mExit, mInc, ast.mDec, mEcho, mAssert, mSwap, - mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mSetLengthStr, mSetLengthSeq, mNLen..mNError: begin end; - else InternalError(a.info, 'evalOp(' +{&} magicToStr[m] +{&} ')'); - end -end; - -function getConstIfExpr(c: PSym; n: PNode): PNode; -var - i: int; - it, e: PNode; -begin - result := nil; - for i := 0 to sonsLen(n) - 1 do begin - it := n.sons[i]; - case it.kind of - nkElifExpr: begin - e := getConstExpr(c, it.sons[0]); - if e = nil then begin result := nil; exit end; - if getOrdValue(e) <> 0 then - if result = nil then begin - result := getConstExpr(c, it.sons[1]); - if result = nil then exit - end - end; - nkElseExpr: begin - if result = nil then - result := getConstExpr(c, it.sons[0]); - end; - else internalError(it.info, 'getConstIfExpr()'); - end - end -end; - -function partialAndExpr(c: PSym; n: PNode): PNode; -// partial evaluation -var - a, b: PNode; -begin - result := n; - a := getConstExpr(c, n.sons[1]); - b := getConstExpr(c, n.sons[2]); - if a <> nil then begin - if getInt(a) = 0 then result := a - else if b <> nil then result := b - else result := n.sons[2] - end - else if b <> nil then begin - if getInt(b) = 0 then result := b - else result := n.sons[1] - end -end; - -function partialOrExpr(c: PSym; n: PNode): PNode; -// partial evaluation -var - a, b: PNode; -begin - result := n; - a := getConstExpr(c, n.sons[1]); - b := getConstExpr(c, n.sons[2]); - if a <> nil then begin - if getInt(a) <> 0 then result := a - else if b <> nil then result := b - else result := n.sons[2] - end - else if b <> nil then begin - if getInt(b) <> 0 then result := b - else result := n.sons[1] - end -end; - -function leValueConv(a, b: PNode): Boolean; -begin - result := false; - case a.kind of - nkCharLit..nkInt64Lit: - case b.kind of - nkCharLit..nkInt64Lit: result := a.intVal <= b.intVal; - nkFloatLit..nkFloat64Lit: result := a.intVal <= round(b.floatVal); - else InternalError(a.info, 'leValueConv'); - end; - nkFloatLit..nkFloat64Lit: - case b.kind of - nkFloatLit..nkFloat64Lit: result := a.floatVal <= b.floatVal; - nkCharLit..nkInt64Lit: result := a.floatVal <= toFloat(int(b.intVal)); - else InternalError(a.info, 'leValueConv'); - end; - else InternalError(a.info, 'leValueConv'); - end -end; - -function getConstExpr(module: PSym; n: PNode): PNode; -var - s: PSym; - a, b, c: PNode; - i: int; -begin - result := nil; - case n.kind of - nkSym: begin - s := n.sym; - if s.kind = skEnumField then - result := newIntNodeT(s.position, n) - else if (s.kind = skConst) then begin - case s.magic of - mIsMainModule: - result := newIntNodeT(ord(sfMainModule in module.flags), n); - mCompileDate: result := newStrNodeT(ntime.getDateStr(), n); - mCompileTime: result := newStrNodeT(ntime.getClockStr(), n); - mNimrodVersion: result := newStrNodeT(VersionAsString, n); - mNimrodMajor: result := newIntNodeT(VersionMajor, n); - mNimrodMinor: result := newIntNodeT(VersionMinor, n); - mNimrodPatch: result := newIntNodeT(VersionPatch, n); - mCpuEndian: result := newIntNodeT(ord(CPU[targetCPU].endian), n); - mHostOS: - result := newStrNodeT(toLower(platform.OS[targetOS].name), n); - mHostCPU: - result := newStrNodeT(toLower(platform.CPU[targetCPU].name),n); - mNaN: result := newFloatNodeT(NaN, n); - mInf: result := newFloatNodeT(Inf, n); - mNegInf: result := newFloatNodeT(NegInf, n); - else result := copyTree(s.ast); // BUGFIX - end - end - else if s.kind in [skProc, skMethod] then // BUGFIX - result := n - end; - nkCharLit..nkNilLit: result := copyNode(n); - nkIfExpr: result := getConstIfExpr(module, n); - nkCall, nkCommand, nkCallStrLit: begin - if (n.sons[0].kind <> nkSym) then exit; - s := n.sons[0].sym; - if (s.kind <> skProc) then exit; - try - case s.magic of - mNone: begin - exit - // XXX: if it has no sideEffect, it should be evaluated - end; - mSizeOf: begin - a := n.sons[1]; - if computeSize(a.typ) < 0 then - liMessage(a.info, errCannotEvalXBecauseIncompletelyDefined, - 'sizeof'); - if a.typ.kind in [tyArray, tyObject, tyTuple] then - result := nil // XXX: size computation for complex types - // is still wrong - else - result := newIntNodeT(getSize(a.typ), n); - end; - mLow: result := newIntNodeT(firstOrd(n.sons[1].typ), n); - mHigh: begin - if not (skipTypes(n.sons[1].typ, abstractVar).kind in [tyOpenArray, - tySequence, tyString]) then - result := newIntNodeT(lastOrd( - skipTypes(n.sons[1].typ, abstractVar)), n); - end; - else begin - a := getConstExpr(module, n.sons[1]); - if a = nil then exit; - if sonsLen(n) > 2 then begin - b := getConstExpr(module, n.sons[2]); - if b = nil then exit; - if sonsLen(n) > 3 then begin - c := getConstExpr(module, n.sons[3]); - if c = nil then exit; - end - end - else b := nil; - result := evalOp(s.magic, n, a, b, c); - end - end - except - on EIntOverflow do liMessage(n.info, errOverOrUnderflow); - on EDivByZero do liMessage(n.info, errConstantDivisionByZero); - end - end; - nkAddr: begin - a := getConstExpr(module, n.sons[0]); - if a <> nil then begin - result := n; - n.sons[0] := a - end; - end; - nkBracket: begin - result := copyTree(n); - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(module, n.sons[i]); - if a = nil then begin result := nil; exit end; - result.sons[i] := a; - end; - include(result.flags, nfAllConst); - end; - nkRange: begin - a := getConstExpr(module, n.sons[0]); - if a = nil then exit; - b := getConstExpr(module, n.sons[1]); - if b = nil then exit; - result := copyNode(n); - addSon(result, a); - addSon(result, b); - end; - nkCurly: begin - result := copyTree(n); - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(module, n.sons[i]); - if a = nil then begin result := nil; exit end; - result.sons[i] := a; - end; - include(result.flags, nfAllConst); - end; - nkPar: begin // tuple constructor - result := copyTree(n); - if (sonsLen(n) > 0) and (n.sons[0].kind = nkExprColonExpr) then begin - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(module, n.sons[i].sons[1]); - if a = nil then begin result := nil; exit end; - result.sons[i].sons[1] := a; - end - end - else begin - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(module, n.sons[i]); - if a = nil then begin result := nil; exit end; - result.sons[i] := a; - end - end; - include(result.flags, nfAllConst); - end; - nkChckRangeF, nkChckRange64, nkChckRange: begin - a := getConstExpr(module, n.sons[0]); - if a = nil then exit; - if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]) then begin - result := a; // a <= x and x <= b - result.typ := n.typ - end - else - liMessage(n.info, errGenerated, - format(msgKindToString(errIllegalConvFromXtoY), - [typeToString(n.sons[0].typ), typeToString(n.typ)])); - end; - nkStringToCString, nkCStringToString: begin - a := getConstExpr(module, n.sons[0]); - if a = nil then exit; - result := a; - result.typ := n.typ; - end; - nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: begin - a := getConstExpr(module, n.sons[1]); - if a = nil then exit; - case skipTypes(n.typ, abstractRange).kind of - tyInt..tyInt64: begin - case skipTypes(a.typ, abstractRange).kind of - tyFloat..tyFloat64: - result := newIntNodeT(nsystem.toInt(getFloat(a)), n); - tyChar: - result := newIntNodeT(getOrdValue(a), n); - else begin - result := a; - result.typ := n.typ; - end - end - end; - tyFloat..tyFloat64: begin - case skipTypes(a.typ, abstractRange).kind of - tyInt..tyInt64, tyEnum, tyBool, tyChar: - result := newFloatNodeT(toFloat(int(getOrdValue(a))), n); - else begin - result := a; - result.typ := n.typ; - end - end - end; - tyOpenArray, tyProc: begin end; - else begin - //n.sons[1] := a; - //result := n; - result := a; - result.typ := n.typ; - end - end - end - else begin - end - end -end; - -end. diff --git a/nim/semgnrc.pas b/nim/semgnrc.pas deleted file mode 100755 index ee905d4441..0000000000 --- a/nim/semgnrc.pas +++ /dev/null @@ -1,287 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - - -// This implements the first pass over the generic body; it resolves some -// symbols. Thus for generics there is a two-phase symbol lookup just like -// in C++. -// A problem is that it cannot be detected if the symbol is introduced -// as in ``var x = ...`` or used because macros/templates can hide this! -// So we have to eval templates/macros right here so that symbol -// lookup can be accurate. - -type - TSemGenericFlag = (withinBind, withinTypeDesc); - TSemGenericFlags = set of TSemGenericFlag; - -function semGenericStmt(c: PContext; n: PNode; - flags: TSemGenericFlags = {@set}[]): PNode; forward; - -function semGenericStmtScope(c: PContext; n: PNode; - flags: TSemGenericFlags = {@set}[]): PNode; -begin - openScope(c.tab); - result := semGenericStmt(c, n, flags); - closeScope(c.tab); -end; - -function semGenericStmtSymbol(c: PContext; n: PNode; s: PSym): PNode; -begin - case s.kind of - skUnknown: begin - // Introduced in this pass! Leave it as an identifier. - result := n; - end; - skProc, skMethod, skIterator, skConverter: result := symChoice(c, n, s); - skTemplate: result := semTemplateExpr(c, n, s, false); - skMacro: result := semMacroExpr(c, n, s, false); - skGenericParam: result := newSymNode(s); - skParam: result := n; - skType: begin - if (s.typ <> nil) and (s.typ.kind <> tyGenericParam) then - result := newSymNode(s) - else - result := n - end - else result := newSymNode(s) - end -end; - -function getIdentNode(n: PNode): PNode; -begin - case n.kind of - nkPostfix: result := getIdentNode(n.sons[1]); - nkPragmaExpr, nkAccQuoted: result := getIdentNode(n.sons[0]); - nkIdent: result := n; - else begin - illFormedAst(n); - result := nil - end - end -end; - -function semGenericStmt(c: PContext; n: PNode; - flags: TSemGenericFlags = {@set}[]): PNode; -var - i, j, L: int; - a: PNode; - s: PSym; -begin - result := n; - if n = nil then exit; - case n.kind of - nkIdent, nkAccQuoted: begin - s := lookUp(c, n); - if withinBind in flags then - result := symChoice(c, n, s) - else - result := semGenericStmtSymbol(c, n, s); - end; - nkDotExpr: begin - s := QualifiedLookUp(c, n, true); - if s <> nil then - result := semGenericStmtSymbol(c, n, s); - end; - nkSym..nkNilLit: begin end; - nkBind: result := semGenericStmt(c, n.sons[0], {@set}[withinBind]); - - nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkCommand, nkCallStrLit: begin - // check if it is an expression macro: - checkMinSonsLen(n, 1); - s := qualifiedLookup(c, n.sons[0], false); - if (s <> nil) then begin - case s.kind of - skMacro: begin result := semMacroExpr(c, n, s, false); exit end; - skTemplate: begin result := semTemplateExpr(c, n, s, false); exit end; - skUnknown, skParam: begin - // Leave it as an identifier. - end; - skProc, skMethod, skIterator, skConverter: begin - n.sons[0] := symChoice(c, n.sons[0], s); - end; - skGenericParam: n.sons[0] := newSymNode(s); - skType: begin - // bad hack for generics: - if (s.typ <> nil) and (s.typ.kind <> tyGenericParam) then begin - n.sons[0] := newSymNode(s); - end - end; - else n.sons[0] := newSymNode(s) - end - end; - for i := 1 to sonsLen(n)-1 do - n.sons[i] := semGenericStmt(c, n.sons[i], flags); - end; - nkMacroStmt: begin - result := semMacroStmt(c, n, false); - end; - nkIfStmt: begin - for i := 0 to sonsLen(n)-1 do - n.sons[i] := semGenericStmtScope(c, n.sons[i]); - end; - nkWhileStmt: begin - openScope(c.tab); - for i := 0 to sonsLen(n)-1 do - n.sons[i] := semGenericStmt(c, n.sons[i]); - closeScope(c.tab); - end; - nkCaseStmt: begin - openScope(c.tab); - n.sons[0] := semGenericStmt(c, n.sons[0]); - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - checkMinSonsLen(a, 1); - L := sonsLen(a); - for j := 0 to L-2 do - a.sons[j] := semGenericStmt(c, a.sons[j]); - a.sons[L-1] := semGenericStmtScope(c, a.sons[L-1]); - end; - closeScope(c.tab); - end; - nkForStmt: begin - L := sonsLen(n); - openScope(c.tab); - n.sons[L-2] := semGenericStmt(c, n.sons[L-2]); - for i := 0 to L-3 do - addDecl(c, newSymS(skUnknown, n.sons[i], c)); - n.sons[L-1] := semGenericStmt(c, n.sons[L-1]); - closeScope(c.tab); - end; - nkBlockStmt, nkBlockExpr, nkBlockType: begin - checkSonsLen(n, 2); - openScope(c.tab); - if n.sons[0] <> nil then - addDecl(c, newSymS(skUnknown, n.sons[0], c)); - n.sons[1] := semGenericStmt(c, n.sons[1]); - closeScope(c.tab); - end; - nkTryStmt: begin - checkMinSonsLen(n, 2); - n.sons[0] := semGenericStmtScope(c, n.sons[0]); - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - checkMinSonsLen(a, 1); - L := sonsLen(a); - for j := 0 to L-2 do - a.sons[j] := semGenericStmt(c, a.sons[j], {@set}[withinTypeDesc]); - a.sons[L-1] := semGenericStmtScope(c, a.sons[L-1]); - end; - end; - nkVarSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkIdentDefs) and (a.kind <> nkVarTuple) then - IllFormedAst(a); - checkMinSonsLen(a, 3); - L := sonsLen(a); - a.sons[L-2] := semGenericStmt(c, a.sons[L-2], {@set}[withinTypeDesc]); - a.sons[L-1] := semGenericStmt(c, a.sons[L-1]); - for j := 0 to L-3 do - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)); - end - end; - nkGenericParams: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if (a.kind <> nkIdentDefs) then IllFormedAst(a); - checkMinSonsLen(a, 3); - L := sonsLen(a); - a.sons[L-2] := semGenericStmt(c, a.sons[L-2], {@set}[withinTypeDesc]); - // do not perform symbol lookup for default expressions - for j := 0 to L-3 do - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)); - end - end; - nkConstSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkConstDef) then IllFormedAst(a); - checkSonsLen(a, 3); - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)); - a.sons[1] := semGenericStmt(c, a.sons[1], {@set}[withinTypeDesc]); - a.sons[2] := semGenericStmt(c, a.sons[2]); - end - end; - nkTypeSection: begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkTypeDef) then IllFormedAst(a); - checkSonsLen(a, 3); - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)); - end; - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkTypeDef) then IllFormedAst(a); - checkSonsLen(a, 3); - if a.sons[1] <> nil then begin - openScope(c.tab); - a.sons[1] := semGenericStmt(c, a.sons[1]); - a.sons[2] := semGenericStmt(c, a.sons[2], {@set}[withinTypeDesc]); - closeScope(c.tab); - end - else - a.sons[2] := semGenericStmt(c, a.sons[2], {@set}[withinTypeDesc]); - end - end; - nkEnumTy: begin - checkMinSonsLen(n, 1); - if n.sons[0] <> nil then - n.sons[0] := semGenericStmt(c, n.sons[0], {@set}[withinTypeDesc]); - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkEnumFieldDef: a := n.sons[i].sons[0]; - nkIdent: a := n.sons[i]; - else illFormedAst(n); - end; - addDeclAt(c, newSymS(skUnknown, getIdentNode(a.sons[i]), c), - c.tab.tos-1); - end - end; - nkObjectTy, nkTupleTy: begin end; - nkFormalParams: begin - checkMinSonsLen(n, 1); - if n.sons[0] <> nil then - n.sons[0] := semGenericStmt(c, n.sons[0], {@set}[withinTypeDesc]); - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - if (a.kind <> nkIdentDefs) then IllFormedAst(a); - checkMinSonsLen(a, 3); - L := sonsLen(a); - a.sons[L-1] := semGenericStmt(c, a.sons[L-2], {@set}[withinTypeDesc]); - a.sons[L-1] := semGenericStmt(c, a.sons[L-1]); - for j := 0 to L-3 do begin - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)); - end - end - end; - nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef, nkLambda: begin - checkSonsLen(n, codePos+1); - addDecl(c, newSymS(skUnknown, getIdentNode(n.sons[0]), c)); - openScope(c.tab); - n.sons[genericParamsPos] := semGenericStmt(c, n.sons[genericParamsPos]); - if n.sons[paramsPos] <> nil then begin - if n.sons[paramsPos].sons[0] <> nil then - addDecl(c, newSym(skUnknown, getIdent('result'), nil)); - n.sons[paramsPos] := semGenericStmt(c, n.sons[paramsPos]); - end; - n.sons[pragmasPos] := semGenericStmt(c, n.sons[pragmasPos]); - n.sons[codePos] := semGenericStmtScope(c, n.sons[codePos]); - closeScope(c.tab); - end - else begin - for i := 0 to sonsLen(n)-1 do - result.sons[i] := semGenericStmt(c, n.sons[i], flags); - end - end -end; diff --git a/nim/seminst.pas b/nim/seminst.pas deleted file mode 100755 index ea8889007d..0000000000 --- a/nim/seminst.pas +++ /dev/null @@ -1,365 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// This module does the instantiation of generic procs and types. - -function generateInstance(c: PContext; fn: PSym; const pt: TIdTable; - const info: TLineInfo): PSym; forward; -// generates an instantiated proc - - -function searchInstTypes(const tab: TIdTable; key: PType): PType; -var - t: PType; - h: THash; - j: int; - match: bool; -begin // returns nil if we need to declare this type - result := PType(IdTableGet(tab, key)); - if (result = nil) and (tab.counter > 0) then begin - // we have to do a slow linear search because types may need - // to be compared by their structure: - for h := 0 to high(tab.data) do begin - t := PType(tab.data[h].key); - if t <> nil then begin - if key.containerId = t.containerID then begin - match := true; - for j := 0 to sonsLen(t) - 1 do begin - // XXX sameType is not really correct for nested generics? - if not sameType(t.sons[j], key.sons[j]) then begin - match := false; break - end - end; - if match then begin result := PType(tab.data[h].val); exit end; - end - end - end - end -end; - -function containsGenericTypeIter(t: PType; closure: PObject): bool; -begin - result := t.kind in GenericTypes; -end; - -function containsGenericType(t: PType): bool; -begin - result := iterOverType(t, containsGenericTypeIter, nil); -end; - -(* -function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym; -begin - if sym = nil then begin result := nil; exit end; // BUGFIX - result := PSym(idTableGet(c.symMap, sym)); - if (result = nil) then begin - if (sym.owner.id = c.fn.id) then begin // XXX: nested generics? - result := copySym(sym, false); - include(result.flags, sfFromGeneric); - idTablePut(c.symMap, sym, result); // BUGFIX - result.typ := instantiateType(c, sym.typ); - if (result.owner <> nil) and (result.owner.kind = skModule) then - result.owner := c.module // BUGFIX - else - result.owner := instantiateSym(c, result.owner); - if sym.ast <> nil then begin - result.ast := instantiateTree(c, sym.ast); - end - end - else - result := sym // do not copy t! - end -end; -*) - -procedure instantiateGenericParamList(c: PContext; n: PNode; const pt: TIdTable); -var - i: int; - s, q: PSym; - t: PType; - a: PNode; -begin - if (n.kind <> nkGenericParams) then - InternalError(n.info, 'instantiateGenericParamList; no generic params'); - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind <> nkSym then - InternalError(a.info, 'instantiateGenericParamList; no symbol'); - q := a.sym; - if not (q.typ.kind in [tyTypeDesc, tyGenericParam]) then continue; - s := newSym(skType, q.name, getCurrOwner()); - t := PType(IdTableGet(pt, q.typ)); - if t = nil then liMessage(a.info, errCannotInstantiateX, s.name.s); - if (t.kind = tyGenericParam) then begin - InternalError(a.info, 'instantiateGenericParamList: ' + q.name.s); - end; - s.typ := t; - addDecl(c, s) - end -end; - -function GenericCacheGet(c: PContext; genericSym, instSym: PSym): PSym; -var - i: int; - a, b: PSym; -begin - result := nil; - for i := 0 to sonsLen(c.generics)-1 do begin - if c.generics.sons[i].kind <> nkExprEqExpr then - InternalError(genericSym.info, 'GenericCacheGet'); - a := c.generics.sons[i].sons[0].sym; - if genericSym.id = a.id then begin - b := c.generics.sons[i].sons[1].sym; - if equalParams(b.typ.n, instSym.typ.n) = paramsEqual then begin - //if gVerbosity > 0 then - // MessageOut('found in cache: ' + getProcHeader(instSym)); - result := b; exit - end - end - end -end; - -procedure GenericCacheAdd(c: PContext; genericSym, instSym: PSym); -var - n: PNode; -begin - n := newNode(nkExprEqExpr); - addSon(n, newSymNode(genericSym)); - addSon(n, newSymNode(instSym)); - addSon(c.generics, n); -end; - -function generateInstance(c: PContext; fn: PSym; const pt: TIdTable; - const info: TLineInfo): PSym; -// generates an instantiated proc -var - oldPrc, oldMod: PSym; - oldP: PProcCon; - n: PNode; -begin - if c.InstCounter > 1000 then InternalError(fn.ast.info, 'nesting too deep'); - inc(c.InstCounter); - oldP := c.p; // restore later - // NOTE: for access of private fields within generics from a different module - // and other identifiers we fake the current module temporarily! - oldMod := c.module; - c.module := getModule(fn); - result := copySym(fn, false); - include(result.flags, sfFromGeneric); - result.owner := getCurrOwner().owner; - n := copyTree(fn.ast); - result.ast := n; - pushOwner(result); - openScope(c.tab); - if (n.sons[genericParamsPos] = nil) then - InternalError(n.info, 'generateInstance'); - n.sons[namePos] := newSymNode(result); - pushInfoContext(info); - - instantiateGenericParamList(c, n.sons[genericParamsPos], pt); - n.sons[genericParamsPos] := nil; - // semantic checking for the parameters: - if n.sons[paramsPos] <> nil then begin - semParamList(c, n.sons[ParamsPos], nil, result); - addParams(c, result.typ.n); - end - else begin - result.typ := newTypeS(tyProc, c); - addSon(result.typ, nil); - end; - - // now check if we have already such a proc generated - oldPrc := GenericCacheGet(c, fn, result); - if oldPrc = nil then begin - // add it here, so that recursive generic procs are possible: - GenericCacheAdd(c, fn, result); - addDecl(c, result); - if n.sons[codePos] <> nil then begin - c.p := newProcCon(result); - if result.kind in [skProc, skMethod, skConverter] then begin - addResult(c, result.typ.sons[0], n.info); - addResultNode(c, n); - end; - n.sons[codePos] := semStmtScope(c, n.sons[codePos]); - end - end - else - result := oldPrc; - popInfoContext(); - closeScope(c.tab); // close scope for parameters - popOwner(); - c.p := oldP; // restore - c.module := oldMod; - dec(c.InstCounter); -end; - -procedure checkConstructedType(const info: TLineInfo; t: PType); -begin - if (tfAcyclic in t.flags) - and (skipTypes(t, abstractInst).kind <> tyObject) then - liMessage(info, errInvalidPragmaX, 'acyclic'); - if computeSize(t) < 0 then - liMessage(info, errIllegalRecursionInTypeX, typeToString(t)); - if (t.kind = tyVar) and (t.sons[0].kind = tyVar) then - liMessage(info, errVarVarTypeNotAllowed); -end; - -type - TReplTypeVars = record - c: PContext; - typeMap: TIdTable; // map PType to PType - symMap: TIdTable; // map PSym to PSym - info: TLineInfo; - end; - -function ReplaceTypeVarsT(var cl: TReplTypeVars; t: PType): PType; forward; -function ReplaceTypeVarsS(var cl: TReplTypeVars; s: PSym): PSym; forward; - -function ReplaceTypeVarsN(var cl: TReplTypeVars; n: PNode): PNode; -var - i, Len: int; -begin - result := nil; - if n <> nil then begin - result := copyNode(n); - result.typ := ReplaceTypeVarsT(cl, n.typ); - case n.kind of - nkNone..pred(nkSym), succ(nkSym)..nkNilLit: begin end; - nkSym: begin - result.sym := ReplaceTypeVarsS(cl, n.sym); - end; - else begin - len := sonsLen(n); - if len > 0 then begin - newSons(result, len); - for i := 0 to len-1 do - result.sons[i] := ReplaceTypeVarsN(cl, n.sons[i]); - end - end - end - end -end; - -function ReplaceTypeVarsS(var cl: TReplTypeVars; s: PSym): PSym; -begin - if s = nil then begin result := nil; exit end; - result := PSym(idTableGet(cl.symMap, s)); - if (result = nil) then begin - result := copySym(s, false); - include(result.flags, sfFromGeneric); - idTablePut(cl.symMap, s, result); - result.typ := ReplaceTypeVarsT(cl, s.typ); - result.owner := s.owner; - result.ast := ReplaceTypeVarsN(cl, s.ast); - end -end; - -function lookupTypeVar(cl: TReplTypeVars; t: PType): PType; -begin - result := PType(idTableGet(cl.typeMap, t)); - if result = nil then - liMessage(t.sym.info, errCannotInstantiateX, typeToString(t)) - else if result.kind = tyGenericParam then - InternalError(cl.info, 'substitution with generic parameter'); -end; - -function ReplaceTypeVarsT(var cl: TReplTypeVars; t: PType): PType; -var - i: int; - body, newbody, x, header: PType; -begin - result := t; - if t = nil then exit; - case t.kind of - tyGenericParam: begin - result := lookupTypeVar(cl, t); - end; - tyGenericInvokation: begin - body := t.sons[0]; - if body.kind <> tyGenericBody then - InternalError(cl.info, 'no generic body'); - header := nil; - for i := 1 to sonsLen(t)-1 do begin - if t.sons[i].kind = tyGenericParam then begin - x := lookupTypeVar(cl, t.sons[i]); - if header = nil then header := copyType(t, t.owner, false); - header.sons[i] := x; - end - else - x := t.sons[i]; - idTablePut(cl.typeMap, body.sons[i-1], x); - end; - // cycle detection: - if header = nil then header := t; - result := searchInstTypes(gInstTypes, header); - if result <> nil then exit; - - result := newType(tyGenericInst, t.sons[0].owner); - for i := 0 to sonsLen(t)-1 do begin - // if one of the params is not concrete, we cannot do anything - // but we already raised an error! - addSon(result, header.sons[i]); - end; - // add these before recursive calls: - idTablePut(gInstTypes, header, result); - - newbody := ReplaceTypeVarsT(cl, lastSon(body)); - newbody.n := ReplaceTypeVarsN(cl, lastSon(body).n); - addSon(result, newbody); - //writeln(output, ropeToStr(Typetoyaml(newbody))); - checkConstructedType(cl.info, newbody); - end; - tyGenericBody: begin - InternalError(cl.info, 'ReplaceTypeVarsT: tyGenericBody'); - result := ReplaceTypeVarsT(cl, lastSon(t)); - end - else begin - if containsGenericType(t) then begin - result := copyType(t, t.owner, false); - for i := 0 to sonsLen(result)-1 do - result.sons[i] := ReplaceTypeVarsT(cl, result.sons[i]); - result.n := ReplaceTypeVarsN(cl, result.n); - if result.Kind in GenericTypes then - liMessage(cl.info, errCannotInstantiateX, TypeToString(t, preferName)); - //writeln(output, ropeToStr(Typetoyaml(result))); - //checkConstructedType(cl.info, result); - end - end - end -end; - -function instGenericContainer(c: PContext; n: PNode; header: PType): PType; -var - cl: TReplTypeVars; -begin - InitIdTable(cl.symMap); - InitIdTable(cl.typeMap); - cl.info := n.info; - cl.c := c; - result := ReplaceTypeVarsT(cl, header); -end; - -function generateTypeInstance(p: PContext; const pt: TIdTable; - arg: PNode; t: PType): PType; -var - cl: TReplTypeVars; -begin - InitIdTable(cl.symMap); - copyIdTable(cl.typeMap, pt); - cl.info := arg.info; - cl.c := p; - pushInfoContext(arg.info); - result := ReplaceTypeVarsT(cl, t); - popInfoContext(); -end; - -function partialSpecialization(c: PContext; n: PNode; s: PSym): PNode; -begin - result := n; -end; diff --git a/nim/semstmts.pas b/nim/semstmts.pas deleted file mode 100755 index 1ece720238..0000000000 --- a/nim/semstmts.pas +++ /dev/null @@ -1,1116 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// this module does the semantic checking of statements - -function semWhen(c: PContext; n: PNode): PNode; -var - i: int; - it, e: PNode; -begin - result := nil; - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it = nil then illFormedAst(n); - case it.kind of - nkElifBranch: begin - checkSonsLen(it, 2); - e := semConstExpr(c, it.sons[0]); - checkBool(e); - if (e.kind <> nkIntLit) then InternalError(n.info, 'semWhen'); - if (e.intVal <> 0) and (result = nil) then - result := semStmt(c, it.sons[1]); // do not open a new scope! - end; - nkElse: begin - checkSonsLen(it, 1); - if result = nil then result := semStmt(c, it.sons[0]) - // do not open a new scope! - end; - else illFormedAst(n) - end - end; - if result = nil then result := newNodeI(nkNilLit, n.info); - // The ``when`` statement implements the mechanism for platform dependant - // code. Thus we try to ensure here consistent ID allocation after the - // ``when`` statement. - IDsynchronizationPoint(200); -end; - -function semIf(c: PContext; n: PNode): PNode; -var - i: int; - it: PNode; -begin - result := n; - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it = nil then illFormedAst(n); - case it.kind of - nkElifBranch: begin - checkSonsLen(it, 2); - openScope(c.tab); - it.sons[0] := semExprWithType(c, it.sons[0]); - checkBool(it.sons[0]); - it.sons[1] := semStmt(c, it.sons[1]); - closeScope(c.tab); - end; - nkElse: begin - if sonsLen(it) = 1 then it.sons[0] := semStmtScope(c, it.sons[0]) - else illFormedAst(it) - end; - else illFormedAst(n) - end - end -end; - -function semDiscard(c: PContext; n: PNode): PNode; -begin - result := n; - checkSonsLen(n, 1); - n.sons[0] := semExprWithType(c, n.sons[0]); - if n.sons[0].typ = nil then liMessage(n.info, errInvalidDiscard); -end; - -function semBreakOrContinue(c: PContext; n: PNode): PNode; -var - s: PSym; - x: PNode; -begin - result := n; - checkSonsLen(n, 1); - if n.sons[0] <> nil then begin - case n.sons[0].kind of - nkIdent: s := lookUp(c, n.sons[0]); - nkSym: s := n.sons[0].sym; - else illFormedAst(n) - end; - if (s.kind = skLabel) and (s.owner.id = c.p.owner.id) then begin - x := newSymNode(s); - x.info := n.info; - include(s.flags, sfUsed); - n.sons[0] := x - end - else - liMessage(n.info, errInvalidControlFlowX, s.name.s) - end - else if (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0) then - liMessage(n.info, errInvalidControlFlowX, - renderTree(n, {@set}[renderNoComments])) -end; - -function semBlock(c: PContext; n: PNode): PNode; -var - labl: PSym; -begin - result := n; - Inc(c.p.nestedBlockCounter); - checkSonsLen(n, 2); - openScope(c.tab); // BUGFIX: label is in the scope of block! - if n.sons[0] <> nil then begin - labl := newSymS(skLabel, n.sons[0], c); - addDecl(c, labl); - n.sons[0] := newSymNode(labl); // BUGFIX - end; - n.sons[1] := semStmt(c, n.sons[1]); - closeScope(c.tab); - Dec(c.p.nestedBlockCounter); -end; - -function semAsm(con: PContext; n: PNode): PNode; -var - str, sub: string; - a, b, c: int; - e: PSym; - marker: char; -begin - result := n; - checkSonsLen(n, 2); - marker := pragmaAsm(con, n.sons[0]); - if marker = #0 then marker := '`'; // default marker - case n.sons[1].kind of - nkStrLit, nkRStrLit, nkTripleStrLit: begin - result := copyNode(n); - str := n.sons[1].strVal; - if str = '' then liMessage(n.info, errEmptyAsm); - // now parse the string literal and substitute symbols: - a := strStart; - repeat - b := strutils.find(str, marker, a); - if b < strStart then - sub := ncopy(str, a) - else - sub := ncopy(str, a, b-1); - if sub <> '' then - addSon(result, newStrNode(nkStrLit, sub)); - - if b < strStart then break; - c := strutils.find(str, marker, b+1); - if c < strStart then - sub := ncopy(str, b+1) - else - sub := ncopy(str, b+1, c-1); - if sub <> '' then begin - e := SymtabGet(con.tab, getIdent(sub)); - if e <> nil then begin - if e.kind = skStub then loadStub(e); - addSon(result, newSymNode(e)) - end - else - addSon(result, newStrNode(nkStrLit, sub)); - end; - if c < strStart then break; - a := c+1; - until false; - end; - else illFormedAst(n) - end -end; - -function semWhile(c: PContext; n: PNode): PNode; -begin - result := n; - checkSonsLen(n, 2); - openScope(c.tab); - n.sons[0] := semExprWithType(c, n.sons[0]); - CheckBool(n.sons[0]); - inc(c.p.nestedLoopCounter); - n.sons[1] := semStmt(c, n.sons[1]); - dec(c.p.nestedLoopCounter); - closeScope(c.tab); -end; - -function semCase(c: PContext; n: PNode): PNode; -var - i, len: int; - covered: biggestint; - // for some types we count to check if all cases have been covered - chckCovered: boolean; - x: PNode; -begin - // check selector: - result := n; - checkMinSonsLen(n, 2); - openScope(c.tab); - n.sons[0] := semExprWithType(c, n.sons[0]); - chckCovered := false; - covered := 0; - case skipTypes(n.sons[0].Typ, abstractVarRange).Kind of - tyInt..tyInt64, tyChar, tyEnum: chckCovered := true; - tyFloat..tyFloat128, tyString: begin end - else liMessage(n.info, errSelectorMustBeOfCertainTypes); - end; - for i := 1 to sonsLen(n)-1 do begin - x := n.sons[i]; - case x.kind of - nkOfBranch: begin - checkMinSonsLen(x, 2); - semCaseBranch(c, n, x, i, covered); - len := sonsLen(x); - x.sons[len-1] := semStmtScope(c, x.sons[len-1]); - end; - nkElifBranch: begin - chckCovered := false; - checkSonsLen(x, 2); - x.sons[0] := semExprWithType(c, x.sons[0]); - checkBool(x.sons[0]); - x.sons[1] := semStmtScope(c, x.sons[1]) - end; - nkElse: begin - chckCovered := false; - checkSonsLen(x, 1); - x.sons[0] := semStmtScope(c, x.sons[0]) - end; - else illFormedAst(x); - end; - end; - if chckCovered and (covered <> lengthOrd(n.sons[0].typ)) then - liMessage(n.info, errNotAllCasesCovered); - closeScope(c.tab); -end; - -function semAsgn(c: PContext; n: PNode): PNode; -var - le: PType; - a: PNode; - id: PIdent; -begin - checkSonsLen(n, 2); - a := n.sons[0]; - case a.kind of - nkDotExpr: begin - // r.f = x - // --> `f=` (r, x) - checkSonsLen(a, 2); - id := considerAcc(a.sons[1]); - result := newNodeI(nkCall, n.info); - addSon(result, newIdentNode(getIdent(id.s+'='), n.info)); - addSon(result, semExpr(c, a.sons[0])); - addSon(result, semExpr(c, n.sons[1])); - result := semDirectCallAnalyseEffects(c, result, {@set}[]); - if result <> nil then begin - fixAbstractType(c, result); - analyseIfAddressTakenInCall(c, result); - exit; - end - end; - nkBracketExpr: begin - // a[i..j] = x - // --> `[..]=`(a, i, j, x) - result := newNodeI(nkCall, n.info); - checkSonsLen(a, 2); - if a.sons[1].kind = nkRange then begin - checkSonsLen(a.sons[1], 2); - addSon(result, newIdentNode(getIdent(whichSliceOpr(a.sons[1])+'='), - n.info)); - addSon(result, semExpr(c, a.sons[0])); - addSonIfNotNil(result, semExpr(c, a.sons[1].sons[0])); - addSonIfNotNil(result, semExpr(c, a.sons[1].sons[1])); - addSon(result, semExpr(c, n.sons[1])); - result := semDirectCallAnalyseEffects(c, result, {@set}[]); - if result <> nil then begin - fixAbstractType(c, result); - analyseIfAddressTakenInCall(c, result); - exit; - end - end - else begin - addSon(result, newIdentNode(getIdent('[]='), n.info)); - addSon(result, semExpr(c, a.sons[0])); - addSon(result, semExpr(c, a.sons[1])); - addSon(result, semExpr(c, n.sons[1])); - result := semDirectCallAnalyseEffects(c, result, {@set}[]); - if result <> nil then begin - fixAbstractType(c, result); - analyseIfAddressTakenInCall(c, result); - exit; - end - end; - end; - else begin end; - end; - n.sons[0] := semExprWithType(c, n.sons[0], {@set}[efLValue]); - n.sons[1] := semExprWithType(c, n.sons[1]); - le := n.sons[0].typ; - if (skipTypes(le, {@set}[tyGenericInst]).kind <> tyVar) - and (IsAssignable(n.sons[0]) = arNone) then begin - // Direct assignment to a discriminant is allowed! - liMessage(n.sons[0].info, errXCannotBeAssignedTo, - renderTree(n.sons[0], {@set}[renderNoComments])); - end - else begin - n.sons[1] := fitNode(c, le, n.sons[1]); - fixAbstractType(c, n); - end; - result := n; -end; - -function SemReturn(c: PContext; n: PNode): PNode; -var - restype: PType; - a: PNode; // temporary assignment for code generator -begin - result := n; - checkSonsLen(n, 1); - if not (c.p.owner.kind in [skConverter, skMethod, skProc, skMacro]) then - liMessage(n.info, errXNotAllowedHere, '''return'''); - if (n.sons[0] <> nil) then begin - n.sons[0] := SemExprWithType(c, n.sons[0]); - // check for type compatibility: - restype := c.p.owner.typ.sons[0]; - if (restype <> nil) then begin - a := newNodeI(nkAsgn, n.sons[0].info); - - n.sons[0] := fitNode(c, restype, n.sons[0]); - // optimize away ``return result``, because it would be transformed - // to ``result = result; return``: - if (n.sons[0].kind = nkSym) and (sfResult in n.sons[0].sym.flags) then - begin - n.sons[0] := nil; - end - else begin - if (c.p.resultSym = nil) then InternalError(n.info, 'semReturn'); - addSon(a, semExprWithType(c, newSymNode(c.p.resultSym))); - addSon(a, n.sons[0]); - n.sons[0] := a; - end - end - else - liMessage(n.info, errCannotReturnExpr); - end; -end; - -function SemYield(c: PContext; n: PNode): PNode; -var - restype: PType; -begin - result := n; - checkSonsLen(n, 1); - if (c.p.owner = nil) or (c.p.owner.kind <> skIterator) then - liMessage(n.info, errYieldNotAllowedHere); - if (n.sons[0] <> nil) then begin - n.sons[0] := SemExprWithType(c, n.sons[0]); - // check for type compatibility: - restype := c.p.owner.typ.sons[0]; - if (restype <> nil) then begin - n.sons[0] := fitNode(c, restype, n.sons[0]); - if (n.sons[0].typ = nil) then InternalError(n.info, 'semYield'); - end - else - liMessage(n.info, errCannotReturnExpr); - end -end; - -function fitRemoveHiddenConv(c: PContext; typ: Ptype; n: PNode): PNode; -begin - result := fitNode(c, typ, n); - if (result.kind in [nkHiddenStdConv, nkHiddenSubConv]) then begin - changeType(result.sons[1], typ); - result := result.sons[1]; - end - else if not sameType(result.typ, typ) then - changeType(result, typ) -end; - -function semVar(c: PContext; n: PNode): PNode; -var - i, j, len: int; - a, b, def: PNode; - typ, tup: PType; - v: PSym; -begin - result := copyNode(n); - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkIdentDefs) and (a.kind <> nkVarTuple) then IllFormedAst(a); - checkMinSonsLen(a, 3); - len := sonsLen(a); - if a.sons[len-2] <> nil then - typ := semTypeNode(c, a.sons[len-2], nil) - else - typ := nil; - if a.sons[len-1] <> nil then begin - def := semExprWithType(c, a.sons[len-1]); - // BUGFIX: ``fitNode`` is needed here! - // check type compability between def.typ and typ: - if (typ <> nil) then def := fitNode(c, typ, def) - else typ := def.typ; - end - else - def := nil; - if not typeAllowed(typ, skVar) then begin - //debug(typ); - liMessage(a.info, errXisNoType, typeToString(typ)); - end; - tup := skipTypes(typ, {@set}[tyGenericInst]); - if a.kind = nkVarTuple then begin - if tup.kind <> tyTuple then liMessage(a.info, errXExpected, 'tuple'); - if len-2 <> sonsLen(tup) then - liMessage(a.info, errWrongNumberOfVariables); - b := newNodeI(nkVarTuple, a.info); - newSons(b, len); - b.sons[len-2] := nil; // no type desc - b.sons[len-1] := def; - addSon(result, b); - end; - for j := 0 to len-3 do begin - if (c.p.owner.kind = skModule) then begin - v := semIdentWithPragma(c, skVar, a.sons[j], {@set}[sfStar, sfMinus]); - include(v.flags, sfGlobal); - end - else - v := semIdentWithPragma(c, skVar, a.sons[j], {@set}[]); - if v.flags * [sfStar, sfMinus] <> {@set}[] then - include(v.flags, sfInInterface); - addInterfaceDecl(c, v); - if a.kind <> nkVarTuple then begin - v.typ := typ; - b := newNodeI(nkIdentDefs, a.info); - addSon(b, newSymNode(v)); - addSon(b, nil); // no type description - addSon(b, copyTree(def)); - addSon(result, b); - end - else begin - v.typ := tup.sons[j]; - b.sons[j] := newSymNode(v); - end - end - end -end; - -function semConst(c: PContext; n: PNode): PNode; -var - a, def, b: PNode; - i: int; - v: PSym; - typ: PType; -begin - result := copyNode(n); - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkConstDef) then IllFormedAst(a); - checkSonsLen(a, 3); - if (c.p.owner.kind = skModule) then begin - v := semIdentWithPragma(c, skConst, a.sons[0], {@set}[sfStar, sfMinus]); - include(v.flags, sfGlobal); - end - else - v := semIdentWithPragma(c, skConst, a.sons[0], {@set}[]); - - if a.sons[1] <> nil then typ := semTypeNode(c, a.sons[1], nil) - else typ := nil; - def := semAndEvalConstExpr(c, a.sons[2]); - // check type compability between def.typ and typ: - if (typ <> nil) then begin - def := fitRemoveHiddenConv(c, typ, def); - end - else typ := def.typ; - if not typeAllowed(typ, skConst) then - liMessage(a.info, errXisNoType, typeToString(typ)); - - v.typ := typ; - v.ast := def; // no need to copy - if v.flags * [sfStar, sfMinus] <> {@set}[] then - include(v.flags, sfInInterface); - addInterfaceDecl(c, v); - b := newNodeI(nkConstDef, a.info); - addSon(b, newSymNode(v)); - addSon(b, nil); // no type description - addSon(b, copyTree(def)); - addSon(result, b); - end; -end; - -function semFor(c: PContext; n: PNode): PNode; -var - i, len: int; - v, countup: PSym; - iter: PType; - countupNode, call: PNode; -begin - result := n; - checkMinSonsLen(n, 3); - len := sonsLen(n); - openScope(c.tab); - if n.sons[len-2].kind = nkRange then begin - checkSonsLen(n.sons[len-2], 2); - // convert ``in 3..5`` to ``in countup(3, 5)`` - countupNode := newNodeI(nkCall, n.sons[len-2].info); - countUp := StrTableGet(magicsys.systemModule.Tab, getIdent('countup')); - if (countUp = nil) then - liMessage(countupNode.info, errSystemNeeds, 'countup'); - newSons(countupNode, 3); - countupnode.sons[0] := newSymNode(countup); - countupNode.sons[1] := n.sons[len-2].sons[0]; - countupNode.sons[2] := n.sons[len-2].sons[1]; - - n.sons[len-2] := countupNode; - end; - n.sons[len-2] := semExprWithType(c, n.sons[len-2], {@set}[efWantIterator]); - call := n.sons[len-2]; - if (call.kind <> nkCall) or (call.sons[0].kind <> nkSym) - or (call.sons[0].sym.kind <> skIterator) then - liMessage(n.sons[len-2].info, errIteratorExpected); - iter := skipTypes(n.sons[len-2].typ, {@set}[tyGenericInst]); - if iter.kind <> tyTuple then begin - if len <> 3 then liMessage(n.info, errWrongNumberOfVariables); - v := newSymS(skForVar, n.sons[0], c); - v.typ := iter; - n.sons[0] := newSymNode(v); - addDecl(c, v); - end - else begin - if len-2 <> sonsLen(iter) then liMessage(n.info, errWrongNumberOfVariables); - for i := 0 to len-3 do begin - v := newSymS(skForVar, n.sons[i], c); - v.typ := iter.sons[i]; - n.sons[i] := newSymNode(v); - addDecl(c, v); - end - end; - // semantic checking for the sub statements: - Inc(c.p.nestedLoopCounter); - n.sons[len-1] := SemStmt(c, n.sons[len-1]); - closeScope(c.tab); - Dec(c.p.nestedLoopCounter); -end; - -function semRaise(c: PContext; n: PNode): PNode; -var - typ: PType; -begin - result := n; - checkSonsLen(n, 1); - if n.sons[0] <> nil then begin - n.sons[0] := semExprWithType(c, n.sons[0]); - typ := n.sons[0].typ; - if (typ.kind <> tyRef) or (typ.sons[0].kind <> tyObject) then - liMessage(n.info, errExprCannotBeRaised) - end; -end; - -function semTry(c: PContext; n: PNode): PNode; -var - i, j, len: int; - a: PNode; - typ: PType; - check: TIntSet; -begin - result := n; - checkMinSonsLen(n, 2); - n.sons[0] := semStmtScope(c, n.sons[0]); - IntSetInit(check); - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - checkMinSonsLen(a, 1); - len := sonsLen(a); - if a.kind = nkExceptBranch then begin - for j := 0 to len-2 do begin - typ := semTypeNode(c, a.sons[j], nil); - if typ.kind = tyRef then typ := typ.sons[0]; - if (typ.kind <> tyObject) then - liMessage(a.sons[j].info, errExprCannotBeRaised); - a.sons[j] := newNodeI(nkType, a.sons[j].info); - a.sons[j].typ := typ; - if IntSetContainsOrIncl(check, typ.id) then - liMessage(a.sons[j].info, errExceptionAlreadyHandled); - end - end - else if a.kind <> nkFinally then - illFormedAst(n); - // last child of an nkExcept/nkFinally branch is a statement: - a.sons[len-1] := semStmtScope(c, a.sons[len-1]); - end; -end; - -function semGenericParamList(c: PContext; n: PNode; father: PType = nil): PNode; -var - i, j, L: int; - s: PSym; - a, def: PNode; - typ: PType; -begin - result := copyNode(n); - if n.kind <> nkGenericParams then - InternalError(n.info, 'semGenericParamList'); - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind <> nkIdentDefs then illFormedAst(n); - L := sonsLen(a); - def := a.sons[L-1]; - if a.sons[L-2] <> nil then - typ := semTypeNode(c, a.sons[L-2], nil) - else if def <> nil then - typ := newTypeS(tyExpr, c) - else - typ := nil; - for j := 0 to L-3 do begin - if (typ = nil) or (typ.kind = tyTypeDesc) then begin - s := newSymS(skType, a.sons[j], c); - s.typ := newTypeS(tyGenericParam, c) - end - else begin - s := newSymS(skGenericParam, a.sons[j], c); - s.typ := typ - end; - s.ast := def; - s.typ.sym := s; - if father <> nil then addSon(father, s.typ); - s.position := i; - addSon(result, newSymNode(s)); - addDecl(c, s); - end - end -end; - -procedure addGenericParamListToScope(c: PContext; n: PNode); -var - i: int; - a: PNode; -begin - if n.kind <> nkGenericParams then - InternalError(n.info, 'addGenericParamListToScope'); - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind <> nkSym then internalError(a.info, 'addGenericParamListToScope'); - addDecl(c, a.sym) - end -end; - -function SemTypeSection(c: PContext; n: PNode): PNode; -var - i: int; - s: PSym; - t, body: PType; - a: PNode; -begin - result := n; - // process the symbols on the left side for the whole type section, before - // we even look at the type definitions on the right - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkTypeDef) then IllFormedAst(a); - checkSonsLen(a, 3); - if (c.p.owner.kind = skModule) then begin - s := semIdentWithPragma(c, skType, a.sons[0], {@set}[sfStar, sfMinus]); - include(s.flags, sfGlobal); - end - else - s := semIdentWithPragma(c, skType, a.sons[0], {@set}[]); - if s.flags * [sfStar, sfMinus] <> {@set}[] then - include(s.flags, sfInInterface); - s.typ := newTypeS(tyForward, c); - s.typ.sym := s; - // process pragmas: - if a.sons[0].kind = nkPragmaExpr then - pragma(c, s, a.sons[0].sons[1], typePragmas); - // add it here, so that recursive types are possible: - addInterfaceDecl(c, s); - a.sons[0] := newSymNode(s); - end; - - // process the right side of the types: - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.kind <> nkTypeDef) then IllFormedAst(a); - checkSonsLen(a, 3); - if (a.sons[0].kind <> nkSym) then IllFormedAst(a); - s := a.sons[0].sym; - if (s.magic = mNone) and (a.sons[2] = nil) then - liMessage(a.info, errImplOfXexpected, s.name.s); - if s.magic <> mNone then processMagicType(c, s); - if a.sons[1] <> nil then begin - // We have a generic type declaration here. In generic types, - // symbol lookup needs to be done here. - openScope(c.tab); - pushOwner(s); - s.typ.kind := tyGenericBody; - if s.typ.containerID <> 0 then - InternalError(a.info, 'semTypeSection: containerID'); - s.typ.containerID := getID(); - a.sons[1] := semGenericParamList(c, a.sons[1], s.typ); - addSon(s.typ, nil); // to be filled out later - s.ast := a; - body := semTypeNode(c, a.sons[2], nil); - if body <> nil then body.sym := s; - s.typ.sons[sonsLen(s.typ)-1] := body; - //debug(s.typ); - popOwner(); - closeScope(c.tab); - end - else if a.sons[2] <> nil then begin - // process the type's body: - pushOwner(s); - t := semTypeNode(c, a.sons[2], s.typ); - if (t <> s.typ) and (s.typ <> nil) then - internalError(a.info, 'semTypeSection()'); - s.typ := t; - s.ast := a; - popOwner(); - end; - end; - // unfortunately we need another pass over the section for checking of - // illegal recursions and type aliases: - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.sons[0].kind <> nkSym) then IllFormedAst(a); - s := a.sons[0].sym; - // compute the type's size and check for illegal recursions: - if a.sons[1] = nil then begin - if (a.sons[2] <> nil) - and (a.sons[2].kind in [nkSym, nkIdent, nkAccQuoted]) then begin - // type aliases are hard: - //MessageOut('for type ' + typeToString(s.typ)); - t := semTypeNode(c, a.sons[2], nil); - if t.kind in [tyObject, tyEnum] then begin - assignType(s.typ, t); - s.typ.id := t.id; // same id - end - end; - checkConstructedType(s.info, s.typ); - end - end -end; - -procedure semParamList(c: PContext; n, genericParams: PNode; s: PSym); -begin - s.typ := semProcTypeNode(c, n, genericParams, nil); -end; - -procedure addParams(c: PContext; n: PNode); -var - i: int; -begin - for i := 1 to sonsLen(n)-1 do begin - if (n.sons[i].kind <> nkSym) then InternalError(n.info, 'addParams'); - addDecl(c, n.sons[i].sym); - end -end; - -procedure semBorrow(c: PContext; n: PNode; s: PSym); -var - b: PSym; -begin - // search for the correct alias: - b := SearchForBorrowProc(c, s, c.tab.tos-2); - if b = nil then liMessage(n.info, errNoSymbolToBorrowFromFound); - // store the alias: - n.sons[codePos] := newSymNode(b); -end; - -procedure sideEffectsCheck(c: PContext; s: PSym); -begin - if [sfNoSideEffect, sfSideEffect] * s.flags = - [sfNoSideEffect, sfSideEffect] then - liMessage(s.info, errXhasSideEffects, s.name.s); -end; - -procedure addResult(c: PContext; t: PType; const info: TLineInfo); -var - s: PSym; -begin - if t <> nil then begin - s := newSym(skVar, getIdent('result'), getCurrOwner()); - s.info := info; - s.typ := t; - Include(s.flags, sfResult); - Include(s.flags, sfUsed); - addDecl(c, s); - c.p.resultSym := s; - end -end; - -procedure addResultNode(c: PContext; n: PNode); -begin - if c.p.resultSym <> nil then addSon(n, newSymNode(c.p.resultSym)); -end; - -function semLambda(c: PContext; n: PNode): PNode; -var - s: PSym; - oldP: PProcCon; -begin - result := n; - checkSonsLen(n, codePos+1); - s := newSym(skProc, getIdent(':anonymous'), getCurrOwner()); - s.info := n.info; - - oldP := c.p; // restore later - s.ast := n; - n.sons[namePos] := newSymNode(s); - - pushOwner(s); - openScope(c.tab); - if (n.sons[genericParamsPos] <> nil) then illFormedAst(n); - // process parameters: - if n.sons[paramsPos] <> nil then begin - semParamList(c, n.sons[ParamsPos], nil, s); - addParams(c, s.typ.n); - end - else begin - s.typ := newTypeS(tyProc, c); - addSon(s.typ, nil); - end; - - // we are in a nested proc: - s.typ.callConv := ccClosure; - if n.sons[pragmasPos] <> nil then - pragma(c, s, n.sons[pragmasPos], lambdaPragmas); - - s.options := gOptions; - if n.sons[codePos] <> nil then begin - if sfImportc in s.flags then - liMessage(n.sons[codePos].info, errImplOfXNotAllowed, s.name.s); - c.p := newProcCon(s); - addResult(c, s.typ.sons[0], n.info); - n.sons[codePos] := semStmtScope(c, n.sons[codePos]); - addResultNode(c, n); - end - else - liMessage(n.info, errImplOfXexpected, s.name.s); - closeScope(c.tab); // close scope for parameters - popOwner(); - c.p := oldP; // restore - result.typ := s.typ; -end; - -function semProcAux(c: PContext; n: PNode; kind: TSymKind; - const validPragmas: TSpecialWords): PNode; -var - s, proto: PSym; - oldP: PProcCon; - gp: PNode; -begin - result := n; - checkSonsLen(n, codePos+1); - if c.p.owner.kind = skModule then begin - s := semIdentVis(c, kind, n.sons[0], {@set}[sfStar]); - include(s.flags, sfGlobal); - end - else - s := semIdentVis(c, kind, n.sons[0], {@set}[]); - n.sons[namePos] := newSymNode(s); - oldP := c.p; // restore later - if sfStar in s.flags then include(s.flags, sfInInterface); - s.ast := n; - - pushOwner(s); - openScope(c.tab); - if n.sons[genericParamsPos] <> nil then begin - n.sons[genericParamsPos] := semGenericParamList(c, n.sons[genericParamsPos]); - gp := n.sons[genericParamsPos] - end - else - gp := newNodeI(nkGenericParams, n.info); - // process parameters: - if n.sons[paramsPos] <> nil then begin - semParamList(c, n.sons[ParamsPos], gp, s); - if sonsLen(gp) > 0 then n.sons[genericParamsPos] := gp; - addParams(c, s.typ.n); - end - else begin - s.typ := newTypeS(tyProc, c); - addSon(s.typ, nil); - end; - - proto := SearchForProc(c, s, c.tab.tos-2); // -2 because we have a scope open - // for parameters - if proto = nil then begin - if oldP.owner.kind <> skModule then // we are in a nested proc - s.typ.callConv := ccClosure - else - s.typ.callConv := lastOptionEntry(c).defaultCC; - // add it here, so that recursive procs are possible: - // -2 because we have a scope open for parameters - if kind in OverloadableSyms then - addInterfaceOverloadableSymAt(c, s, c.tab.tos-2) - else - addDeclAt(c, s, c.tab.tos-2); - if n.sons[pragmasPos] <> nil then - pragma(c, s, n.sons[pragmasPos], validPragmas) - end - else begin - if n.sons[pragmasPos] <> nil then - liMessage(n.sons[pragmasPos].info, errPragmaOnlyInHeaderOfProc); - if not (sfForward in proto.flags) then - liMessage(n.info, errAttemptToRedefineX, proto.name.s); - exclude(proto.flags, sfForward); - closeScope(c.tab); // close scope with wrong parameter symbols - openScope(c.tab); // open scope for old (correct) parameter symbols - if proto.ast.sons[genericParamsPos] <> nil then - addGenericParamListToScope(c, proto.ast.sons[genericParamsPos]); - addParams(c, proto.typ.n); - proto.info := s.info; // more accurate line information - s.typ := proto.typ; - s := proto; - n.sons[genericParamsPos] := proto.ast.sons[genericParamsPos]; - n.sons[paramsPos] := proto.ast.sons[paramsPos]; - if (n.sons[namePos].kind <> nkSym) then InternalError(n.info, 'semProcAux'); - n.sons[namePos].sym := proto; - proto.ast := n; // needed for code generation - popOwner(); - pushOwner(s); - end; - - s.options := gOptions; - if n.sons[codePos] <> nil then begin - if [sfImportc, sfBorrow] * s.flags <> [] then - liMessage(n.sons[codePos].info, errImplOfXNotAllowed, s.name.s); - if (n.sons[genericParamsPos] = nil) then begin - c.p := newProcCon(s); - if (s.typ.sons[0] <> nil) and (kind <> skIterator) then - addResult(c, s.typ.sons[0], n.info); - n.sons[codePos] := semStmtScope(c, n.sons[codePos]); - if (s.typ.sons[0] <> nil) and (kind <> skIterator) then - addResultNode(c, n); - end - else begin - if (s.typ.sons[0] <> nil) and (kind <> skIterator) then - addDecl(c, newSym(skUnknown, getIdent('result'), nil)); - n.sons[codePos] := semGenericStmtScope(c, n.sons[codePos]); - end - end - else begin - if proto <> nil then - liMessage(n.info, errImplOfXexpected, proto.name.s); - if [sfImportc, sfBorrow] * s.flags = [] then Include(s.flags, sfForward) - else if sfBorrow in s.flags then - semBorrow(c, n, s); - end; - sideEffectsCheck(c, s); - closeScope(c.tab); // close scope for parameters - popOwner(); - c.p := oldP; // restore -end; - -function semIterator(c: PContext; n: PNode): PNode; -var - t: PType; - s: PSym; -begin - result := semProcAux(c, n, skIterator, iteratorPragmas); - s := result.sons[namePos].sym; - t := s.typ; - if t.sons[0] = nil then liMessage(n.info, errXNeedsReturnType, 'iterator'); - if n.sons[codePos] = nil then liMessage(n.info, errImplOfXexpected, s.name.s); -end; - -function semProc(c: PContext; n: PNode): PNode; -begin - result := semProcAux(c, n, skProc, procPragmas); -end; - -function semMethod(c: PContext; n: PNode): PNode; -begin - if not isTopLevel(c) then - liMessage(n.info, errXOnlyAtModuleScope, 'method'); - result := semProcAux(c, n, skMethod, methodPragmas); -end; - -function semConverterDef(c: PContext; n: PNode): PNode; -var - t: PType; - s: PSym; -begin - if not isTopLevel(c) then - liMessage(n.info, errXOnlyAtModuleScope, 'converter'); - checkSonsLen(n, codePos+1); - if n.sons[genericParamsPos] <> nil then - liMessage(n.info, errNoGenericParamsAllowedForX, 'converter'); - result := semProcAux(c, n, skConverter, converterPragmas); - s := result.sons[namePos].sym; - t := s.typ; - if t.sons[0] = nil then liMessage(n.info, errXNeedsReturnType, 'converter'); - if sonsLen(t) <> 2 then liMessage(n.info, errXRequiresOneArgument, 'converter'); - addConverter(c, s); -end; - -function semMacroDef(c: PContext; n: PNode): PNode; -var - t: PType; - s: PSym; -begin - checkSonsLen(n, codePos+1); - if n.sons[genericParamsPos] <> nil then - liMessage(n.info, errNoGenericParamsAllowedForX, 'macro'); - result := semProcAux(c, n, skMacro, macroPragmas); - s := result.sons[namePos].sym; - t := s.typ; - if t.sons[0] = nil then liMessage(n.info, errXNeedsReturnType, 'macro'); - if sonsLen(t) <> 2 then liMessage(n.info, errXRequiresOneArgument, 'macro'); - if n.sons[codePos] = nil then liMessage(n.info, errImplOfXexpected, s.name.s); -end; - -function evalInclude(c: PContext; n: PNode): PNode; -var - i, fileIndex: int; - f: string; -begin - result := newNodeI(nkStmtList, n.info); - addSon(result, n); // the rodwriter needs include information! - for i := 0 to sonsLen(n)-1 do begin - f := getModuleFile(n.sons[i]); - fileIndex := includeFilename(f); - if IntSetContainsOrIncl(c.includedFiles, fileIndex) then - liMessage(n.info, errRecursiveDependencyX, f); - addSon(result, semStmt(c, gIncludeFile(f))); - IntSetExcl(c.includedFiles, fileIndex); - end; -end; - -function semCommand(c: PContext; n: PNode): PNode; -begin - result := semExpr(c, n); - if result.typ <> nil then liMessage(n.info, errDiscardValue); -end; - -function SemStmt(c: PContext; n: PNode): PNode; -const - // must be last statements in a block: - LastBlockStmts = {@set}[nkRaiseStmt, nkReturnStmt, nkBreakStmt, - nkContinueStmt]; -var - len, i, j: int; -begin - result := n; - if n = nil then exit; - if nfSem in n.flags then exit; - case n.kind of - nkAsgn: result := semAsgn(c, n); - nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkMacroStmt, nkCallStrLit: - result := semCommand(c, n); - nkEmpty, nkCommentStmt, nkNilLit: begin end; - nkBlockStmt: result := semBlock(c, n); - nkStmtList: begin - len := sonsLen(n); - for i := 0 to len-1 do begin - n.sons[i] := semStmt(c, n.sons[i]); - if (n.sons[i].kind in LastBlockStmts) then begin - for j := i+1 to len-1 do - case n.sons[j].kind of - nkPragma, nkCommentStmt, nkNilLit, nkEmpty: begin end; - else liMessage(n.sons[j].info, errStmtInvalidAfterReturn); - end - end - end - end; - nkRaiseStmt: result := semRaise(c, n); - nkVarSection: result := semVar(c, n); - nkConstSection: result := semConst(c, n); - nkTypeSection: result := SemTypeSection(c, n); - nkIfStmt: result := SemIf(c, n); - nkWhenStmt: result := semWhen(c, n); - nkDiscardStmt: result := semDiscard(c, n); - nkWhileStmt: result := semWhile(c, n); - nkTryStmt: result := semTry(c, n); - nkBreakStmt, nkContinueStmt: result := semBreakOrContinue(c, n); - nkForStmt: result := semFor(c, n); - nkCaseStmt: result := semCase(c, n); - nkReturnStmt: result := semReturn(c, n); - nkAsmStmt: result := semAsm(c, n); - nkYieldStmt: result := semYield(c, n); - nkPragma: pragma(c, c.p.owner, n, stmtPragmas); - nkIteratorDef: result := semIterator(c, n); - nkProcDef: result := semProc(c, n); - nkMethodDef: result := semMethod(c, n); - nkConverterDef: result := semConverterDef(c, n); - nkMacroDef: result := semMacroDef(c, n); - nkTemplateDef: result := semTemplateDef(c, n); - nkImportStmt: begin - if not isTopLevel(c) then - liMessage(n.info, errXOnlyAtModuleScope, 'import'); - result := evalImport(c, n); - end; - nkFromStmt: begin - if not isTopLevel(c) then - liMessage(n.info, errXOnlyAtModuleScope, 'from'); - result := evalFrom(c, n); - end; - nkIncludeStmt: begin - if not isTopLevel(c) then - liMessage(n.info, errXOnlyAtModuleScope, 'include'); - result := evalInclude(c, n); - end; - else liMessage(n.info, errStmtExpected); - end; - if result = nil then InternalError(n.info, 'SemStmt: result = nil'); - include(result.flags, nfSem); -end; - -function semStmtScope(c: PContext; n: PNode): PNode; -begin - openScope(c.tab); - result := semStmt(c, n); - closeScope(c.tab); -end; diff --git a/nim/semtempl.pas b/nim/semtempl.pas deleted file mode 100755 index fc7e12a73e..0000000000 --- a/nim/semtempl.pas +++ /dev/null @@ -1,270 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -function isExpr(n: PNode): bool; -// returns true if ``n`` looks like an expression -var - i: int; -begin - if n = nil then begin result := false; exit end; - case n.kind of - nkIdent..nkNilLit: result := true; - nkCall..nkPassAsOpenArray: begin - for i := 0 to sonsLen(n)-1 do - if not isExpr(n.sons[i]) then begin - result := false; exit - end; - result := true - end - else result := false - end -end; - -function isTypeDesc(n: PNode): bool; -// returns true if ``n`` looks like a type desc -var - i: int; -begin - if n = nil then begin result := false; exit end; - case n.kind of - nkIdent, nkSym, nkType: result := true; - nkDotExpr, nkBracketExpr: begin - for i := 0 to sonsLen(n)-1 do - if not isTypeDesc(n.sons[i]) then begin - result := false; exit - end; - result := true - end; - nkTypeOfExpr..nkEnumTy: result := true; - else result := false - end -end; - -function evalTemplateAux(c: PContext; templ, actual: PNode; sym: PSym): PNode; -var - i: int; - p: PSym; -begin - if templ = nil then begin result := nil; exit end; - case templ.kind of - nkSym: begin - p := templ.sym; - if (p.kind = skParam) and (p.owner.id = sym.id) then - result := copyTree(actual.sons[p.position]) - else - result := copyNode(templ) - end; - nkNone..nkIdent, nkType..nkNilLit: // atom - result := copyNode(templ); - else begin - result := copyNode(templ); - newSons(result, sonsLen(templ)); - for i := 0 to sonsLen(templ)-1 do - result.sons[i] := evalTemplateAux(c, templ.sons[i], actual, sym); - end - end -end; - -var - evalTemplateCounter: int = 0; // to prevend endless recursion in templates - // instantation - -function evalTemplateArgs(c: PContext; n: PNode; s: PSym): PNode; -var - f, a, i: int; - arg: PNode; -begin - f := sonsLen(s.typ); - // if the template has zero arguments, it can be called without ``()`` - // `n` is then a nkSym or something similar - case n.kind of - nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: - a := sonsLen(n); - else a := 0 - end; - if a > f then liMessage(n.info, errWrongNumberOfArguments); - result := copyNode(n); - for i := 1 to f-1 do begin - if i < a then - arg := n.sons[i] - else - arg := copyTree(s.typ.n.sons[i].sym.ast); - if arg = nil then liMessage(n.info, errWrongNumberOfArguments); - if not (s.typ.sons[i].kind in [tyTypeDesc, tyStmt, tyExpr]) then begin - // concrete type means semantic checking for argument: - arg := fitNode(c, s.typ.sons[i], semExprWithType(c, arg)); - end; - addSon(result, arg); - end -end; - -function evalTemplate(c: PContext; n: PNode; sym: PSym): PNode; -var - args: PNode; -begin - inc(evalTemplateCounter); - if evalTemplateCounter > 100 then - liMessage(n.info, errTemplateInstantiationTooNested); - // replace each param by the corresponding node: - args := evalTemplateArgs(c, n, sym); - result := evalTemplateAux(c, sym.ast.sons[codePos], args, sym); - dec(evalTemplateCounter); -end; - -function symChoice(c: PContext; n: PNode; s: PSym): PNode; -var - a: PSym; - o: TOverloadIter; - i: int; -begin - i := 0; - a := initOverloadIter(o, c, n); - while a <> nil do begin - a := nextOverloadIter(o, c, n); - inc(i); - end; - if i <= 1 then begin - result := newSymNode(s); - result.info := n.info; - markUsed(n, s); - end - else begin - // semantic checking requires a type; ``fitNode`` deals with it - // appropriately - result := newNodeIT(nkSymChoice, n.info, newTypeS(tyNone, c)); - a := initOverloadIter(o, c, n); - while a <> nil do begin - addSon(result, newSymNode(a)); - a := nextOverloadIter(o, c, n); - end; - //liMessage(n.info, warnUser, s.name.s + ' is here symchoice'); - end -end; - -function resolveTemplateParams(c: PContext; n: PNode; withinBind: bool; - var toBind: TIntSet): PNode; -var - i: int; - s: PSym; -begin - if n = nil then begin result := nil; exit end; - case n.kind of - nkIdent: begin - if not withinBind and not IntSetContains(toBind, n.ident.id) then begin - s := SymTabLocalGet(c.Tab, n.ident); - if (s <> nil) then begin - result := newSymNode(s); - result.info := n.info - end - else - result := n - end - else begin - IntSetIncl(toBind, n.ident.id); - result := symChoice(c, n, lookup(c, n)) - end - end; - nkSym..nkNilLit: // atom - result := n; - nkBind: - result := resolveTemplateParams(c, n.sons[0], true, toBind); - else begin - result := n; - for i := 0 to sonsLen(n)-1 do - result.sons[i] := resolveTemplateParams(c, n.sons[i], withinBind, toBind); - end - end -end; - -function transformToExpr(n: PNode): PNode; -var - i, realStmt: int; -begin - result := n; - case n.kind of - nkStmtList: begin - realStmt := -1; - for i := 0 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkCommentStmt, nkEmpty, nkNilLit: begin end; - else begin - if realStmt = -1 then realStmt := i - else realStmt := -2 - end - end - end; - if realStmt >= 0 then - result := transformToExpr(n.sons[realStmt]) - else - n.kind := nkStmtListExpr; - end; - nkBlockStmt: n.kind := nkBlockExpr; - //nkIfStmt: n.kind := nkIfExpr; // this is not correct! - else begin end - end -end; - -function semTemplateDef(c: PContext; n: PNode): PNode; -var - s: PSym; - toBind: TIntSet; -begin - if c.p.owner.kind = skModule then begin - s := semIdentVis(c, skTemplate, n.sons[0], {@set}[sfStar]); - include(s.flags, sfGlobal); - end - else - s := semIdentVis(c, skTemplate, n.sons[0], {@set}[]); - if sfStar in s.flags then include(s.flags, sfInInterface); - // check parameter list: - pushOwner(s); - openScope(c.tab); - n.sons[namePos] := newSymNode(s); - - // check that no pragmas exist: - if n.sons[pragmasPos] <> nil then - liMessage(n.info, errNoPragmasAllowedForX, 'template'); - // check that no generic parameters exist: - if n.sons[genericParamsPos] <> nil then - liMessage(n.info, errNoGenericParamsAllowedForX, 'template'); - if (n.sons[paramsPos] = nil) then begin - // use ``stmt`` as implicit result type - s.typ := newTypeS(tyProc, c); - s.typ.n := newNodeI(nkFormalParams, n.info); - addSon(s.typ, newTypeS(tyStmt, c)); - addSon(s.typ.n, newNodeIT(nkType, n.info, s.typ.sons[0])); - end - else begin - semParamList(c, n.sons[ParamsPos], nil, s); - if n.sons[paramsPos].sons[0] = nil then begin - // use ``stmt`` as implicit result type - s.typ.sons[0] := newTypeS(tyStmt, c); - s.typ.n.sons[0] := newNodeIT(nkType, n.info, s.typ.sons[0]); - end - end; - addParams(c, s.typ.n); - - // resolve parameters: - IntSetInit(toBind); - n.sons[codePos] := resolveTemplateParams(c, n.sons[codePos], false, toBind); - if not (s.typ.sons[0].kind in [tyStmt, tyTypeDesc]) then - n.sons[codePos] := transformToExpr(n.sons[codePos]); - - // only parameters are resolved, no type checking is performed - closeScope(c.tab); - popOwner(); - s.ast := n; - - result := n; - if n.sons[codePos] = nil then - liMessage(n.info, errImplOfXexpected, s.name.s); - // add identifier of template as a last step to not allow - // recursive templates - addInterfaceDecl(c, s); -end; diff --git a/nim/semtypes.pas b/nim/semtypes.pas deleted file mode 100755 index e2a0d2185b..0000000000 --- a/nim/semtypes.pas +++ /dev/null @@ -1,874 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// this module does the semantic checking of type declarations - -function fitNode(c: PContext; formal: PType; arg: PNode): PNode; -begin - result := IndexTypesMatch(c, formal, arg.typ, arg); - if result = nil then typeMismatch(arg, formal, arg.typ); -end; - -function newOrPrevType(kind: TTypeKind; prev: PType; c: PContext): PType; -begin - if prev = nil then - result := newTypeS(kind, c) - else begin - result := prev; - if result.kind = tyForward then result.kind := kind - end -end; - -function semEnum(c: PContext; n: PNode; prev: PType): PType; -var - i: int; - counter, x: BiggestInt; - e: PSym; - base: PType; - v: PNode; -begin - counter := 0; - base := nil; - result := newOrPrevType(tyEnum, prev, c); - result.n := newNodeI(nkEnumTy, n.info); - checkMinSonsLen(n, 1); - if n.sons[0] <> nil then begin - base := semTypeNode(c, n.sons[0].sons[0], nil); - if base.kind <> tyEnum then - liMessage(n.sons[0].info, errInheritanceOnlyWithEnums); - counter := lastOrd(base)+1; - end; - addSon(result, base); - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkEnumFieldDef: begin - e := newSymS(skEnumField, n.sons[i].sons[0], c); - v := semConstExpr(c, n.sons[i].sons[1]); - x := getOrdValue(v); - if i <> 1 then begin - if (x <> counter) then - include(result.flags, tfEnumHasWholes); - if x < counter then - liMessage(n.sons[i].info, errInvalidOrderInEnumX, e.name.s); - end; - counter := x; - end; - nkSym: e := n.sons[i].sym; - nkIdent: begin - e := newSymS(skEnumField, n.sons[i], c); - end; - else - illFormedAst(n); - end; - e.typ := result; - e.position := int(counter); - if (result.sym <> nil) and (sfInInterface in result.sym.flags) then begin - include(e.flags, sfUsed); // BUGFIX - include(e.flags, sfInInterface); // BUGFIX - StrTableAdd(c.module.tab, e); // BUGFIX - end; - addSon(result.n, newSymNode(e)); - addDeclAt(c, e, c.tab.tos-1); - inc(counter); - end; -end; - -function semSet(c: PContext; n: PNode; prev: PType): PType; -var - base: PType; -begin - result := newOrPrevType(tySet, prev, c); - if sonsLen(n) = 2 then begin - base := semTypeNode(c, n.sons[1], nil); - addSon(result, base); - if base.kind = tyGenericInst then base := lastSon(base); - if base.kind <> tyGenericParam then begin - if not isOrdinalType(base) then liMessage(n.info, errOrdinalTypeExpected); - if lengthOrd(base) > MaxSetElements then liMessage(n.info, errSetTooBig); - end - end - else - liMessage(n.info, errXExpectsOneTypeParam, 'set'); -end; - -function semContainer(c: PContext; n: PNode; - kind: TTypeKind; const kindStr: string; - prev: PType): PType; -var - base: PType; -begin - result := newOrPrevType(kind, prev, c); - if sonsLen(n) = 2 then begin - base := semTypeNode(c, n.sons[1], nil); - addSon(result, base); - end - else - liMessage(n.info, errXExpectsOneTypeParam, kindStr); -end; - -function semAnyRef(c: PContext; n: PNode; - kind: TTypeKind; const kindStr: string; prev: PType): PType; -var - base: PType; -begin - result := newOrPrevType(kind, prev, c); - if sonsLen(n) = 1 then begin - base := semTypeNode(c, n.sons[0], nil); - addSon(result, base); - end - else - liMessage(n.info, errXExpectsOneTypeParam, kindStr); -end; - -function semVarType(c: PContext; n: PNode; prev: PType): PType; -var - base: PType; -begin - result := newOrPrevType(tyVar, prev, c); - if sonsLen(n) = 1 then begin - base := semTypeNode(c, n.sons[0], nil); - if base.kind = tyVar then liMessage(n.info, errVarVarTypeNotAllowed); - addSon(result, base); - end - else - liMessage(n.info, errXExpectsOneTypeParam, 'var'); -end; - -function semDistinct(c: PContext; n: PNode; prev: PType): PType; -begin - result := newOrPrevType(tyDistinct, prev, c); - if sonsLen(n) = 1 then - addSon(result, semTypeNode(c, n.sons[0], nil)) - else - liMessage(n.info, errXExpectsOneTypeParam, 'distinct'); -end; - -function semRangeAux(c: PContext; n: PNode; prev: PType): PType; -var - a, b: PNode; -begin - if (n.kind <> nkRange) then InternalError(n.info, 'semRangeAux'); - checkSonsLen(n, 2); - result := newOrPrevType(tyRange, prev, c); - result.n := newNodeI(nkRange, n.info); - if (n.sons[0] = nil) or (n.sons[1] = nil) then - liMessage(n.Info, errRangeIsEmpty); - a := semConstExpr(c, n.sons[0]); - b := semConstExpr(c, n.sons[1]); - if not sameType(a.typ, b.typ) then - liMessage(n.info, errPureTypeMismatch); - if not (a.typ.kind in [tyInt..tyInt64, tyEnum, tyBool, tyChar, - tyFloat..tyFloat128]) then - liMessage(n.info, errOrdinalTypeExpected); - if enumHasWholes(a.typ) then - liMessage(n.info, errEnumXHasWholes, a.typ.sym.name.s); - if not leValue(a, b) then - liMessage(n.Info, errRangeIsEmpty); - addSon(result.n, a); - addSon(result.n, b); - addSon(result, b.typ); -end; - -function semRange(c: PContext; n: PNode; prev: PType): PType; -begin - result := nil; - if sonsLen(n) = 2 then begin - if n.sons[1].kind = nkRange then - result := semRangeAux(c, n.sons[1], prev) - else - liMessage(n.sons[0].info, errRangeExpected); - end - else - liMessage(n.info, errXExpectsOneTypeParam, 'range'); -end; - -function semArray(c: PContext; n: PNode; prev: PType): PType; -var - indx, base: PType; -begin - result := newOrPrevType(tyArray, prev, c); - if sonsLen(n) = 3 then begin // 3 = length(array indx base) - if n.sons[1].kind = nkRange then indx := semRangeAux(c, n.sons[1], nil) - else indx := semTypeNode(c, n.sons[1], nil); - addSon(result, indx); - if indx.kind = tyGenericInst then indx := lastSon(indx); - if indx.kind <> tyGenericParam then begin - if not isOrdinalType(indx) then - liMessage(n.sons[1].info, errOrdinalTypeExpected); - if enumHasWholes(indx) then - liMessage(n.sons[1].info, errEnumXHasWholes, indx.sym.name.s); - end; - base := semTypeNode(c, n.sons[2], nil); - addSon(result, base); - end - else - liMessage(n.info, errArrayExpectsTwoTypeParams); -end; - -function semOrdinal(c: PContext; n: PNode; prev: PType): PType; -var - base: PType; -begin - result := newOrPrevType(tyOrdinal, prev, c); - if sonsLen(n) = 2 then begin - base := semTypeNode(c, n.sons[1], nil); - if base.kind <> tyGenericParam then begin - if not isOrdinalType(base) then - liMessage(n.sons[1].info, errOrdinalTypeExpected); - end; - addSon(result, base); - end - else - liMessage(n.info, errXExpectsOneTypeParam, 'ordinal'); -end; - -function semTypeIdent(c: PContext; n: PNode): PSym; -begin - result := qualifiedLookup(c, n, true); - if (result <> nil) then begin - markUsed(n, result); - if result.kind <> skType then liMessage(n.info, errTypeExpected); - end - else - liMessage(n.info, errIdentifierExpected); -end; - -function semTuple(c: PContext; n: PNode; prev: PType): PType; -var - i, j, len, counter: int; - typ: PType; - check: TIntSet; - a: PNode; - field: PSym; -begin - result := newOrPrevType(tyTuple, prev, c); - result.n := newNodeI(nkRecList, n.info); - IntSetInit(check); - counter := 0; - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if (a.kind <> nkIdentDefs) then IllFormedAst(a); - checkMinSonsLen(a, 3); - len := sonsLen(a); - if a.sons[len-2] <> nil then - typ := semTypeNode(c, a.sons[len-2], nil) - else - liMessage(a.info, errTypeExpected); - if a.sons[len-1] <> nil then - liMessage(a.sons[len-1].info, errInitHereNotAllowed); - for j := 0 to len-3 do begin - field := newSymS(skField, a.sons[j], c); - field.typ := typ; - field.position := counter; - inc(counter); - if IntSetContainsOrIncl(check, field.name.id) then - liMessage(a.sons[j].info, errAttemptToRedefine, field.name.s); - addSon(result.n, newSymNode(field)); - addSon(result, typ); - end - end -end; - -function semGeneric(c: PContext; n: PNode; s: PSym; prev: PType): PType; -var - i: int; - elem: PType; - isConcrete: bool; -begin - if (s.typ = nil) or (s.typ.kind <> tyGenericBody) then - liMessage(n.info, errCannotInstantiateX, s.name.s); - result := newOrPrevType(tyGenericInvokation, prev, c); - if (s.typ.containerID = 0) then InternalError(n.info, 'semtypes.semGeneric'); - if sonsLen(n) <> sonsLen(s.typ) then - liMessage(n.info, errWrongNumberOfArguments); - addSon(result, s.typ); - isConcrete := true; - // iterate over arguments: - for i := 1 to sonsLen(n)-1 do begin - elem := semTypeNode(c, n.sons[i], nil); - if elem.kind = tyGenericParam then isConcrete := false; - addSon(result, elem); - end; - if isConcrete then begin - if s.ast = nil then liMessage(n.info, errCannotInstantiateX, s.name.s); - result := instGenericContainer(c, n, result); - end -end; - -function semIdentVis(c: PContext; kind: TSymKind; n: PNode; - const allowed: TSymFlags): PSym; -// identifier with visibility -var - v: PIdent; -begin - result := nil; - if n.kind = nkPostfix then begin - if (sonsLen(n) = 2) and (n.sons[0].kind = nkIdent) then begin - result := newSymS(kind, n.sons[1], c); - v := n.sons[0].ident; - if (sfStar in allowed) and (v.id = ord(wStar)) then - include(result.flags, sfStar) - else if (sfMinus in allowed) and (v.id = ord(wMinus)) then - include(result.flags, sfMinus) - else - liMessage(n.sons[0].info, errInvalidVisibilityX, v.s); - end - else - illFormedAst(n); - end - else - result := newSymS(kind, n, c); -end; - -function semIdentWithPragma(c: PContext; kind: TSymKind; - n: PNode; const allowed: TSymFlags): PSym; -begin - if n.kind = nkPragmaExpr then begin - checkSonsLen(n, 2); - result := semIdentVis(c, kind, n.sons[0], allowed); - case kind of - skType: begin - // process pragmas later, because result.typ has not been set yet - end; - skField: pragma(c, result, n.sons[1], fieldPragmas); - skVar: pragma(c, result, n.sons[1], varPragmas); - skConst: pragma(c, result, n.sons[1], constPragmas); - else begin end - end - end - else - result := semIdentVis(c, kind, n, allowed); -end; - -procedure checkForOverlap(c: PContext; t, ex: PNode; branchIndex: int); -var - j, i: int; -begin - for i := 1 to branchIndex-1 do - for j := 0 to sonsLen(t.sons[i])-2 do - if overlap(t.sons[i].sons[j], ex) then begin - //MessageOut(renderTree(t)); - liMessage(ex.info, errDuplicateCaseLabel); - end -end; - -procedure semBranchExpr(c: PContext; t: PNode; var ex: PNode); -begin - ex := semConstExpr(c, ex); - checkMinSonsLen(t, 1); - if (cmpTypes(t.sons[0].typ, ex.typ) <= isConvertible) then begin - typeMismatch(ex, t.sons[0].typ, ex.typ); - end; -end; - -procedure SemCaseBranch(c: PContext; t, branch: PNode; - branchIndex: int; var covered: biggestInt); -var - i: int; - b: PNode; -begin - for i := 0 to sonsLen(branch)-2 do begin - b := branch.sons[i]; - if b.kind = nkRange then begin - checkSonsLen(b, 2); - semBranchExpr(c, t, b.sons[0]); - semBranchExpr(c, t, b.sons[1]); - if emptyRange(b.sons[0], b.sons[1]) then begin - //MessageOut(renderTree(t)); - liMessage(b.info, errRangeIsEmpty); - end; - covered := covered + getOrdValue(b.sons[1]) - getOrdValue(b.sons[0]) + 1; - end - else begin - semBranchExpr(c, t, branch.sons[i]); // NOT: `b`, because of var-param! - inc(covered); - end; - checkForOverlap(c, t, branch.sons[i], branchIndex) - end -end; - -procedure semRecordNodeAux(c: PContext; n: PNode; - var check: TIntSet; - var pos: int; father: PNode; - rectype: PSym); forward; - -procedure semRecordCase(c: PContext; n: PNode; - var check: TIntSet; - var pos: int; father: PNode; rectype: PSym); -var - i: int; - covered: biggestint; - chckCovered: boolean; - a, b: PNode; - typ: PType; -begin - a := copyNode(n); - checkMinSonsLen(n, 2); - semRecordNodeAux(c, n.sons[0], check, pos, a, rectype); - if a.sons[0].kind <> nkSym then - internalError('semRecordCase: dicriminant is no symbol'); - include(a.sons[0].sym.flags, sfDiscriminant); - covered := 0; - typ := skipTypes(a.sons[0].Typ, abstractVar); - if not isOrdinalType(typ) then - liMessage(n.info, errSelectorMustBeOrdinal); - if firstOrd(typ) < 0 then - liMessage(n.info, errOrdXMustNotBeNegative, a.sons[0].sym.name.s); - if lengthOrd(typ) > $7fff then - liMessage(n.info, errLenXinvalid, a.sons[0].sym.name.s); - chckCovered := true; - for i := 1 to sonsLen(n)-1 do begin - b := copyTree(n.sons[i]); - case n.sons[i].kind of - nkOfBranch: begin - checkMinSonsLen(b, 2); - semCaseBranch(c, a, b, i, covered); - end; - nkElse: begin - chckCovered := false; - checkSonsLen(b, 1); - end; - else illFormedAst(n); - end; - delSon(b, sonsLen(b)-1); - semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype); - addSon(a, b); - end; - if chckCovered and (covered <> lengthOrd(a.sons[0].typ)) then - liMessage(a.info, errNotAllCasesCovered); - addSon(father, a); -end; - -procedure semRecordNodeAux(c: PContext; n: PNode; var check: TIntSet; - var pos: int; father: PNode; rectype: PSym); -var - i, len: int; - f: PSym; // new field - a, it, e, branch: PNode; - typ: PType; -begin - if n = nil then exit; // BUGFIX: nil is possible - case n.kind of - nkRecWhen: begin - branch := nil; // the branch to take - for i := 0 to sonsLen(n)-1 do begin - it := n.sons[i]; - if it = nil then illFormedAst(n); - case it.kind of - nkElifBranch: begin - checkSonsLen(it, 2); - e := semConstExpr(c, it.sons[0]); - checkBool(e); - if (e.kind <> nkIntLit) then - InternalError(e.info, 'semRecordNodeAux'); - if (e.intVal <> 0) and (branch = nil) then - branch := it.sons[1] - end; - nkElse: begin - checkSonsLen(it, 1); - if branch = nil then branch := it.sons[0]; - end; - else illFormedAst(n) - end - end; - if branch <> nil then - semRecordNodeAux(c, branch, check, pos, father, rectype); - end; - nkRecCase: begin - semRecordCase(c, n, check, pos, father, rectype); - end; - nkNilLit: begin - if father.kind <> nkRecList then - addSon(father, newNodeI(nkRecList, n.info)); - end; - nkRecList: begin - // attempt to keep the nesting at a sane level: - if father.kind = nkRecList then a := father - else a := copyNode(n); - for i := 0 to sonsLen(n)-1 do begin - semRecordNodeAux(c, n.sons[i], check, pos, a, rectype); - end; - if a <> father then addSon(father, a); - end; - nkIdentDefs: begin - checkMinSonsLen(n, 3); - len := sonsLen(n); - if (father.kind <> nkRecList) and (len >= 4) then - a := newNodeI(nkRecList, n.info) - else - a := nil; - if n.sons[len-1] <> nil then - liMessage(n.sons[len-1].info, errInitHereNotAllowed); - if n.sons[len-2] = nil then - liMessage(n.info, errTypeExpected); - typ := semTypeNode(c, n.sons[len-2], nil); - for i := 0 to sonsLen(n)-3 do begin - f := semIdentWithPragma(c, skField, n.sons[i], {@set}[sfStar, sfMinus]); - f.typ := typ; - f.position := pos; - if (rectype <> nil) - and ([sfImportc, sfExportc] * rectype.flags <> []) - and (f.loc.r = nil) then begin - f.loc.r := toRope(f.name.s); - f.flags := f.flags + ([sfImportc, sfExportc] * rectype.flags); - end; - inc(pos); - if IntSetContainsOrIncl(check, f.name.id) then - liMessage(n.sons[i].info, errAttemptToRedefine, f.name.s); - if a = nil then addSon(father, newSymNode(f)) - else addSon(a, newSymNode(f)) - end; - if a <> nil then addSon(father, a); - end; - else illFormedAst(n); - end -end; - -procedure addInheritedFieldsAux(c: PContext; var check: TIntSet; - var pos: int; n: PNode); -var - i: int; -begin - case n.kind of - nkRecCase: begin - if (n.sons[0].kind <> nkSym) then - InternalError(n.info, 'addInheritedFieldsAux'); - addInheritedFieldsAux(c, check, pos, n.sons[0]); - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkOfBranch, nkElse: begin - addInheritedFieldsAux(c, check, pos, lastSon(n.sons[i])); - end; - else internalError(n.info, - 'addInheritedFieldsAux(record case branch)'); - end - end; - end; - nkRecList: begin - for i := 0 to sonsLen(n)-1 do begin - addInheritedFieldsAux(c, check, pos, n.sons[i]); - end; - end; - nkSym: begin - IntSetIncl(check, n.sym.name.id); - inc(pos); - end; - else - InternalError(n.info, 'addInheritedFieldsAux()'); - end; -end; - -procedure addInheritedFields(c: PContext; var check: TIntSet; var pos: int; - obj: PType); -begin - if (sonsLen(obj) > 0) and (obj.sons[0] <> nil) then - addInheritedFields(c, check, pos, obj.sons[0]); - addInheritedFieldsAux(c, check, pos, obj.n); -end; - -function semObjectNode(c: PContext; n: PNode; prev: PType): PType; -var - check: TIntSet; - base: PType; - pos: int; -begin - IntSetInit(check); - pos := 0; - // n.sons[0] contains the pragmas (if any). We process these later... - checkSonsLen(n, 3); - if n.sons[1] <> nil then begin - base := semTypeNode(c, n.sons[1].sons[0], nil); - if base.kind = tyObject then - addInheritedFields(c, check, pos, base) - else - liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects); - end - else - base := nil; - if n.kind <> nkObjectTy then InternalError(n.info, 'semObjectNode'); - result := newOrPrevType(tyObject, prev, c); - addSon(result, base); - result.n := newNodeI(nkRecList, n.info); - semRecordNodeAux(c, n.sons[2], check, pos, result.n, result.sym); - if (base <> nil) and (tfFinal in base.flags) then - liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects); -end; - -function addTypeVarsOfGenericBody(c: PContext; t: PType; genericParams: PNode; - var cl: TIntSet): PType; -var - i, L: int; - s: PSym; -begin - result := t; - if (t = nil) then exit; - if IntSetContainsOrIncl(cl, t.id) then exit; - case t.kind of - tyGenericBody: begin - result := newTypeS(tyGenericInvokation, c); - addSon(result, t); - for i := 0 to sonsLen(t)-2 do begin - if t.sons[i].kind <> tyGenericParam then - InternalError('addTypeVarsOfGenericBody'); - s := copySym(t.sons[i].sym); - s.position := sonsLen(genericParams); - addDecl(c, s); - addSon(genericParams, newSymNode(s)); - addSon(result, t.sons[i]); - end; - end; - tyGenericInst: begin - L := sonsLen(t)-1; - t.sons[L] := addTypeVarsOfGenericBody(c, t.sons[L], genericParams, cl); - end; - tyGenericInvokation: begin - for i := 1 to sonsLen(t)-1 do - t.sons[i] := addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl); - end - else begin - for i := 0 to sonsLen(t)-1 do - t.sons[i] := addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl); - end - end -end; - -function paramType(c: PContext; n, genericParams: PNode; - var cl: TIntSet): PType; -begin - result := semTypeNode(c, n, nil); - if (genericParams <> nil) and (sonsLen(genericParams) = 0) then - result := addTypeVarsOfGenericBody(c, result, genericParams, cl); -end; - -function semProcTypeNode(c: PContext; n, genericParams: PNode; - prev: PType): PType; -var - i, j, len, counter: int; - a, def, res: PNode; - typ: PType; - arg: PSym; - check, cl: TIntSet; -begin - checkMinSonsLen(n, 1); - result := newOrPrevType(tyProc, prev, c); - result.callConv := lastOptionEntry(c).defaultCC; - result.n := newNodeI(nkFormalParams, n.info); - if (genericParams <> nil) and (sonsLen(genericParams) = 0) then - IntSetInit(cl); - if n.sons[0] = nil then begin - addSon(result, nil); // return type - addSon(result.n, newNodeI(nkType, n.info)); // BUGFIX: nkType must exist! - // XXX but it does not, if n.sons[paramsPos] == nil? - end - else begin - addSon(result, nil); - res := newNodeI(nkType, n.info); - addSon(result.n, res); - end; - IntSetInit(check); - counter := 0; - for i := 1 to sonsLen(n)-1 do begin - a := n.sons[i]; - if (a.kind <> nkIdentDefs) then IllFormedAst(a); - checkMinSonsLen(a, 3); - len := sonsLen(a); - if a.sons[len-2] <> nil then - typ := paramType(c, a.sons[len-2], genericParams, cl) - else - typ := nil; - if a.sons[len-1] <> nil then begin - def := semExprWithType(c, a.sons[len-1]); - // check type compability between def.typ and typ: - if (typ <> nil) then begin - if (cmpTypes(typ, def.typ) < isConvertible) then begin - typeMismatch(a.sons[len-1], typ, def.typ); - end; - def := fitNode(c, typ, def); - end - else typ := def.typ; - end - else - def := nil; - for j := 0 to len-3 do begin - arg := newSymS(skParam, a.sons[j], c); - arg.typ := typ; - arg.position := counter; - inc(counter); - arg.ast := copyTree(def); - if IntSetContainsOrIncl(check, arg.name.id) then - liMessage(a.sons[j].info, errAttemptToRedefine, arg.name.s); - addSon(result.n, newSymNode(arg)); - addSon(result, typ); - end - end; - // NOTE: semantic checking of the result type needs to be done here! - if n.sons[0] <> nil then begin - result.sons[0] := paramType(c, n.sons[0], genericParams, cl); - res.typ := result.sons[0]; - end -end; - -function semStmtListType(c: PContext; n: PNode; prev: PType): PType; -var - len, i: int; -begin - checkMinSonsLen(n, 1); - len := sonsLen(n); - for i := 0 to len-2 do begin - n.sons[i] := semStmt(c, n.sons[i]); - end; - if len > 0 then begin - result := semTypeNode(c, n.sons[len-1], prev); - n.typ := result; - n.sons[len-1].typ := result - end - else - result := nil; -end; - -function semBlockType(c: PContext; n: PNode; prev: PType): PType; -begin - Inc(c.p.nestedBlockCounter); - checkSonsLen(n, 2); - openScope(c.tab); - if n.sons[0] <> nil then begin - addDecl(c, newSymS(skLabel, n.sons[0], c)) - end; - result := semStmtListType(c, n.sons[1], prev); - n.sons[1].typ := result; - n.typ := result; - closeScope(c.tab); - Dec(c.p.nestedBlockCounter); -end; - -function semTypeNode(c: PContext; n: PNode; prev: PType): PType; -var - s: PSym; - t: PType; -begin - result := nil; - if n = nil then exit; - case n.kind of - nkTypeOfExpr: begin - result := semExprWithType(c, n, {@set}[efAllowType]).typ; - end; - nkPar: begin - if sonsLen(n) = 1 then result := semTypeNode(c, n.sons[0], prev) - else liMessage(n.info, errTypeExpected); - end; - nkBracketExpr: begin - checkMinSonsLen(n, 2); - s := semTypeIdent(c, n.sons[0]); - case s.magic of - mArray: result := semArray(c, n, prev); - mOpenArray: result := semContainer(c, n, tyOpenArray, 'openarray', prev); - mRange: result := semRange(c, n, prev); - mSet: result := semSet(c, n, prev); - mOrdinal: result := semOrdinal(c, n, prev); - mSeq: result := semContainer(c, n, tySequence, 'seq', prev); - else result := semGeneric(c, n, s, prev); - end - end; - nkIdent, nkDotExpr, nkAccQuoted: begin - s := semTypeIdent(c, n); - if s.typ = nil then - liMessage(n.info, errTypeExpected); - if prev = nil then - result := s.typ - else begin - assignType(prev, s.typ); - prev.id := s.typ.id; - result := prev; - end - end; - nkSym: begin - if (n.sym.kind = skType) and (n.sym.typ <> nil) then begin - t := n.sym.typ; - if prev = nil then - result := t - else begin - assignType(prev, t); - result := prev; - end; - markUsed(n, n.sym); - end - else - liMessage(n.info, errTypeExpected); - end; - nkObjectTy: result := semObjectNode(c, n, prev); - nkTupleTy: result := semTuple(c, n, prev); - nkRefTy: result := semAnyRef(c, n, tyRef, 'ref', prev); - nkPtrTy: result := semAnyRef(c, n, tyPtr, 'ptr', prev); - nkVarTy: result := semVarType(c, n, prev); - nkDistinctTy: result := semDistinct(c, n, prev); - nkProcTy: begin - checkSonsLen(n, 2); - result := semProcTypeNode(c, n.sons[0], nil, prev); - // dummy symbol for `pragma`: - s := newSymS(skProc, newIdentNode(getIdent('dummy'), n.info), c); - s.typ := result; - pragma(c, s, n.sons[1], procTypePragmas); - end; - nkEnumTy: result := semEnum(c, n, prev); - nkType: result := n.typ; - nkStmtListType: result := semStmtListType(c, n, prev); - nkBlockType: result := semBlockType(c, n, prev); - else liMessage(n.info, errTypeExpected); - //internalError(n.info, 'semTypeNode(' +{&} nodeKindToStr[n.kind] +{&} ')'); - end -end; - -procedure setMagicType(m: PSym; kind: TTypeKind; size: int); -begin - m.typ.kind := kind; - m.typ.align := size; - m.typ.size := size; - //m.typ.sym := nil; -end; - -procedure processMagicType(c: PContext; m: PSym); -begin - case m.magic of - mInt: setMagicType(m, tyInt, intSize); - mInt8: setMagicType(m, tyInt8, 1); - mInt16: setMagicType(m, tyInt16, 2); - mInt32: setMagicType(m, tyInt32, 4); - mInt64: setMagicType(m, tyInt64, 8); - mFloat: setMagicType(m, tyFloat, floatSize); - mFloat32: setMagicType(m, tyFloat32, 4); - mFloat64: setMagicType(m, tyFloat64, 8); - mBool: setMagicType(m, tyBool, 1); - mChar: setMagicType(m, tyChar, 1); - mString: begin - setMagicType(m, tyString, ptrSize); - addSon(m.typ, getSysType(tyChar)); - end; - mCstring: begin - setMagicType(m, tyCString, ptrSize); - addSon(m.typ, getSysType(tyChar)); - end; - mPointer: setMagicType(m, tyPointer, ptrSize); - mEmptySet: begin - setMagicType(m, tySet, 1); - addSon(m.typ, newTypeS(tyEmpty, c)); - end; - mIntSetBaseType: begin - setMagicType(m, tyRange, intSize); - //intSetBaseType := m.typ; - exit - end; - mNil: setMagicType(m, tyNil, ptrSize); - mExpr: setMagicType(m, tyExpr, 0); - mStmt: setMagicType(m, tyStmt, 0); - mTypeDesc: setMagicType(m, tyTypeDesc, 0); - mArray, mOpenArray, mRange, mSet, mSeq, mOrdinal: exit; - else liMessage(m.info, errTypeExpected); - end; - //registerSysType(m.typ); -end; diff --git a/nim/sigmatch.pas b/nim/sigmatch.pas deleted file mode 100755 index 45a29fc292..0000000000 --- a/nim/sigmatch.pas +++ /dev/null @@ -1,964 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// This module implements the signature matching for resolving -// the call to overloaded procs, generic procs and operators. - -type - TCandidateState = (csEmpty, csMatch, csNoMatch); - TCandidate = record - exactMatches: int; - subtypeMatches: int; - intConvMatches: int; // conversions to int are not as expensive - convMatches: int; - genericMatches: int; - state: TCandidateState; - callee: PType; // may not be nil! - calleeSym: PSym; // may be nil - call: PNode; // modified call - bindings: TIdTable; // maps sym-ids to types - baseTypeMatch: bool; // needed for conversions from T to openarray[T] - // for example - end; - TTypeRelation = (isNone, isConvertible, isIntConv, isSubtype, - isGeneric, isEqual); - // order is important! - -procedure initCandidate(out c: TCandidate; callee: PType); -begin - c.exactMatches := 0; - c.subtypeMatches := 0; - c.convMatches := 0; - c.intConvMatches := 0; - c.genericMatches := 0; - c.state := csEmpty; - c.callee := callee; - c.calleeSym := nil; - c.call := nil; - c.baseTypeMatch := false; - initIdTable(c.bindings); - //assert(c.callee <> nil); -end; - -procedure copyCandidate(var a: TCandidate; const b: TCandidate); -begin - a.exactMatches := b.exactMatches; - a.subtypeMatches := b.subtypeMatches; - a.convMatches := b.convMatches; - a.intConvMatches := b.intConvMatches; - a.genericMatches := b.genericMatches; - a.state := b.state; - a.callee := b.callee; - a.calleeSym := b.calleeSym; - a.call := copyTree(b.call); - a.baseTypeMatch := b.baseTypeMatch; - copyIdTable(a.bindings, b.bindings); -end; - -function cmpCandidates(const a, b: TCandidate): int; -begin - result := a.exactMatches - b.exactMatches; - if result <> 0 then exit; - result := a.genericMatches - b.genericMatches; - if result <> 0 then exit; - result := a.subtypeMatches - b.subtypeMatches; - if result <> 0 then exit; - result := a.intConvMatches - b.intConvMatches; - if result <> 0 then exit; - result := a.convMatches - b.convMatches; -end; - -procedure writeMatches(const c: TCandidate); -begin - Writeln(output, 'exact matches: ' + toString(c.exactMatches)); - Writeln(output, 'subtype matches: ' + toString(c.subtypeMatches)); - Writeln(output, 'conv matches: ' + toString(c.convMatches)); - Writeln(output, 'intconv matches: ' + toString(c.intConvMatches)); - Writeln(output, 'generic matches: ' + toString(c.genericMatches)); -end; - -function getNotFoundError(c: PContext; n: PNode): string; -// Gives a detailed error message; this is seperated from semDirectCall, -// as semDirectCall is already pretty slow (and we need this information only -// in case of an error). -var - sym: PSym; - o: TOverloadIter; - i: int; - candidates: string; -begin - result := msgKindToString(errTypeMismatch); - for i := 1 to sonsLen(n)-1 do begin - //debug(n.sons[i].typ); - add(result, typeToString(n.sons[i].typ)); - if i <> sonsLen(n)-1 then add(result, ', '); - end; - addChar(result, ')'); - candidates := ''; - sym := initOverloadIter(o, c, n.sons[0]); - while sym <> nil do begin - if sym.kind in [skProc, skMethod, skIterator, skConverter] then begin - add(candidates, getProcHeader(sym)); - add(candidates, nl) - end; - sym := nextOverloadIter(o, c, n.sons[0]); - end; - if candidates <> '' then - add(result, nl +{&} msgKindToString(errButExpected) +{&} nl - +{&} candidates); -end; - -function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; overload; - forward; - -function concreteType(const mapping: TIdTable; t: PType): PType; -begin - case t.kind of - tyArrayConstr: begin // make it an array - result := newType(tyArray, t.owner); - addSon(result, t.sons[0]); // XXX: t.owner is wrong for ID! - addSon(result, t.sons[1]); // XXX: semantic checking for the type? - end; - tyNil: result := nil; // what should it be? - tyGenericParam: begin - result := t; - while true do begin - result := PType(idTableGet(mapping, t)); - if result = nil then InternalError('lookup failed'); - if result.kind <> tyGenericParam then break - end - end; - else result := t // Note: empty is valid here - end -end; - -function handleRange(f, a: PType; min, max: TTypeKind): TTypeRelation; -var - k: TTypeKind; -begin - if a.kind = f.kind then - result := isEqual - else begin - k := skipTypes(a, {@set}[tyRange]).kind; - if k = f.kind then - result := isSubtype - else if (f.kind = tyInt) and (k in [tyInt..tyInt32]) then - result := isIntConv - else if (k >= min) and (k <= max) then - result := isConvertible - else - result := isNone - end -end; - -function handleFloatRange(f, a: PType): TTypeRelation; -var - k: TTypeKind; -begin - if a.kind = f.kind then - result := isEqual - else begin - k := skipTypes(a, {@set}[tyRange]).kind; - if k = f.kind then - result := isSubtype - else if (k >= tyFloat) and (k <= tyFloat128) then - result := isConvertible - else - result := isNone - end -end; - -function isObjectSubtype(a, f: PType): bool; -var - t: PType; -begin - t := a; - while (t <> nil) and (t.id <> f.id) do t := base(t); - result := t <> nil -end; - -function minRel(a, b: TTypeRelation): TTypeRelation; -begin - if a <= b then result := a else result := b -end; - -function tupleRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - i: int; - x, y: PSym; - m: TTypeRelation; -begin - result := isNone; - if sonsLen(a) = sonsLen(f) then begin - result := isEqual; - for i := 0 to sonsLen(f)-1 do begin - m := typeRel(mapping, f.sons[i], a.sons[i]); - if m < isSubtype then begin result := isNone; exit end; - result := minRel(result, m); - end; - if (f.n <> nil) and (a.n <> nil) then begin - for i := 0 to sonsLen(f.n)-1 do begin - // check field names: - if f.n.sons[i].kind <> nkSym then InternalError(f.n.info, 'tupleRel'); - if a.n.sons[i].kind <> nkSym then InternalError(a.n.info, 'tupleRel'); - x := f.n.sons[i].sym; - y := a.n.sons[i].sym; - if x.name.id <> y.name.id then begin - result := isNone; exit - end - end - end - end -end; - -function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - x, concrete: PType; - i: Int; - m: TTypeRelation; -begin // is a subtype of f? - result := isNone; - assert(f <> nil); - assert(a <> nil); - if (a.kind = tyGenericInst) and not - (skipTypes(f, {@set}[tyVar]).kind in [tyGenericBody, tyGenericInvokation]) - then begin - result := typeRel(mapping, f, lastSon(a)); - exit - end; - if (a.kind = tyVar) and (f.kind <> tyVar) then begin - result := typeRel(mapping, f, a.sons[0]); - exit - end; - case f.kind of - tyEnum: begin - if (a.kind = f.kind) and (a.id = f.id) then result := isEqual - else if (skipTypes(a, {@set}[tyRange]).id = f.id) then result := isSubtype - end; - tyBool, tyChar: begin - if (a.kind = f.kind) then result := isEqual - else if skipTypes(a, {@set}[tyRange]).kind = f.kind then - result := isSubtype - end; - tyRange: begin - if (a.kind = f.kind) then begin - result := typeRel(mapping, base(a), base(f)); - if result < isGeneric then result := isNone - end - else if skipTypes(f, {@set}[tyRange]).kind = a.kind then - result := isConvertible // a convertible to f - end; - tyInt: result := handleRange(f, a, tyInt8, tyInt32); - tyInt8: result := handleRange(f, a, tyInt8, tyInt8); - tyInt16: result := handleRange(f, a, tyInt8, tyInt16); - tyInt32: result := handleRange(f, a, tyInt, tyInt32); - tyInt64: result := handleRange(f, a, tyInt, tyInt64); - tyFloat: result := handleFloatRange(f, a); - tyFloat32: result := handleFloatRange(f, a); - tyFloat64: result := handleFloatRange(f, a); - tyFloat128: result := handleFloatRange(f, a); - - tyVar: begin - if (a.kind = f.kind) then - result := typeRel(mapping, base(f), base(a)) - else - result := typeRel(mapping, base(f), a) - end; - tyArray, tyArrayConstr: begin // tyArrayConstr cannot happen really, but - // we wanna be safe here - case a.kind of - tyArray: begin - result := minRel(typeRel(mapping, f.sons[0], a.sons[0]), - typeRel(mapping, f.sons[1], a.sons[1])); - if result < isGeneric then result := isNone; - end; - tyArrayConstr: begin - result := typeRel(mapping, f.sons[1], a.sons[1]); - if result < isGeneric then - result := isNone - else begin - if (result <> isGeneric) and (lengthOrd(f) <> lengthOrd(a)) then - result := isNone - else if f.sons[0].kind in GenericTypes then - result := minRel(result, typeRel(mapping, f.sons[0], a.sons[0])); - end - end; - else begin end - end - end; - tyOpenArray: begin - case a.Kind of - tyOpenArray: begin - result := typeRel(mapping, base(f), base(a)); - if result < isGeneric then result := isNone - end; - tyArrayConstr: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[1].kind = tyEmpty) then - result := isSubtype // [] is allowed here - else if typeRel(mapping, base(f), a.sons[1]) >= isGeneric then - result := isSubtype; - end; - tyArray: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[1].kind = tyEmpty) then - result := isSubtype - else if typeRel(mapping, base(f), a.sons[1]) >= isGeneric then - result := isConvertible - end; - tySequence: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isConvertible - else if typeRel(mapping, base(f), a.sons[0]) >= isGeneric then - result := isConvertible; - end - else begin end - end - end; - tySequence: begin - case a.Kind of - tyNil: result := isSubtype; - tySequence: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isSubtype - else begin - result := typeRel(mapping, f.sons[0], a.sons[0]); - if result < isGeneric then result := isNone - end - end; - else begin end - end - end; - tyOrdinal: begin - if isOrdinalType(a) then begin - if a.kind = tyOrdinal then x := a.sons[0] else x := a; - result := typeRel(mapping, f.sons[0], x); - if result < isGeneric then result := isNone - end - end; - tyForward: InternalError('forward type in typeRel()'); - tyNil: begin - if a.kind = f.kind then result := isEqual - end; - tyTuple: begin - if a.kind = tyTuple then result := tupleRel(mapping, f, a); - end; - tyObject: begin - if a.kind = tyObject then begin - if a.id = f.id then result := isEqual - else if isObjectSubtype(a, f) then result := isSubtype - end - end; - tyDistinct: begin - if (a.kind = tyDistinct) and (a.id = f.id) then result := isEqual; - end; - tySet: begin - if a.kind = tySet then begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isSubtype - else begin - result := typeRel(mapping, f.sons[0], a.sons[0]); - if result <= isConvertible then result := isNone // BUGFIX! - end - end - end; - tyPtr: begin - case a.kind of - tyPtr: begin - result := typeRel(mapping, base(f), base(a)); - if result <= isConvertible then result := isNone - end; - tyNil: result := isSubtype - else begin end - end - end; - tyRef: begin - case a.kind of - tyRef: begin - result := typeRel(mapping, base(f), base(a)); - if result <= isConvertible then result := isNone - end; - tyNil: result := isSubtype - else begin end - end - end; - tyProc: begin - case a.kind of - tyNil: result := isSubtype; - tyProc: begin - if (sonsLen(f) = sonsLen(a)) and (f.callconv = a.callconv) then begin - // Note: We have to do unification for the parameters before the - // return type! - result := isEqual; // start with maximum; also correct for no - // params at all - for i := 1 to sonsLen(f)-1 do begin - m := typeRel(mapping, f.sons[i], a.sons[i]); - if (m = isNone) and (typeRel(mapping, a.sons[i], - f.sons[i]) = isSubtype) then begin - // allow ``f.son`` as subtype of ``a.son``! - result := isConvertible; - end - else if m < isSubtype then begin - result := isNone; exit - end - else result := minRel(m, result) - end; - if f.sons[0] <> nil then begin - if a.sons[0] <> nil then begin - m := typeRel(mapping, f.sons[0], a.sons[0]); - // Subtype is sufficient for return types! - if m < isSubtype then result := isNone - else if m = isSubtype then result := isConvertible - else result := minRel(m, result) - end - else - result := isNone - end - else if a.sons[0] <> nil then - result := isNone; - if (tfNoSideEffect in f.flags) and not (tfNoSideEffect in a.flags) then - result := isNone - end - end - else begin end - end - end; - tyPointer: begin - case a.kind of - tyPointer: result := isEqual; - tyNil: result := isSubtype; - tyRef, tyPtr, tyProc, tyCString: result := isConvertible; - else begin end - end - end; - tyString: begin - case a.kind of - tyString: result := isEqual; - tyNil: result := isSubtype; - else begin end - end - end; - tyCString: begin - // conversion from string to cstring is automatic: - case a.Kind of - tyCString: result := isEqual; - tyNil: result := isSubtype; - tyString: result := isConvertible; - tyPtr: if a.sons[0].kind = tyChar then result := isConvertible; - tyArray: begin - if (firstOrd(a.sons[0]) = 0) - and (skipTypes(a.sons[0], {@set}[tyRange]).kind in [tyInt..tyInt64]) - and (a.sons[1].kind = tyChar) then - result := isConvertible; - end - else begin end - end - end; - - tyEmpty: begin - if a.kind = tyEmpty then result := isEqual; - end; - tyGenericInst: begin - result := typeRel(mapping, lastSon(f), a); - end; (* - tyGenericBody: begin - x := PType(idTableGet(mapping, f)); - if x = nil then begin - assert(f.containerID <> 0); - if (a.kind = tyGenericInst) and (f.containerID = a.containerID) and - (sonsLen(a) = sonsLen(f)) then begin - for i := 0 to sonsLen(f)-2 do begin - if typeRel(mapping, f.sons[i], a.sons[i]) < isGeneric then exit; - end; - result := isGeneric; - idTablePut(mapping, f, a); - end - end - else begin - result := typeRel(mapping, x, a) // check if it fits - end - end; *) - tyGenericBody: begin - result := typeRel(mapping, lastSon(f), a); - end; - tyGenericInvokation: begin - assert(f.sons[0].kind = tyGenericBody); - if a.kind = tyGenericInvokation then begin - InternalError('typeRel: tyGenericInvokation -> tyGenericInvokation'); - end; - if (a.kind = tyGenericInst) then begin - if (f.sons[0].containerID = a.sons[0].containerID) - and (sonsLen(a)-1 = sonsLen(f)) then begin - assert(a.sons[0].kind = tyGenericBody); - for i := 1 to sonsLen(f)-1 do begin - if a.sons[i].kind = tyGenericParam then begin - InternalError('wrong instantiated type!'); - end; - if typeRel(mapping, f.sons[i], a.sons[i]) < isGeneric then exit; - end; - result := isGeneric; - end (* - else begin - MessageOut('came here: ' + toString(sonsLen(f)) + ' ' + - toString(sonsLen(a)) + ' '+ - toString(f.sons[0].containerID) + ' '+ - toString(a.sons[0].containerID)); - end *) - end - else begin - result := typeRel(mapping, f.sons[0], a); - if result <> isNone then begin - // we steal the generic parameters from the tyGenericBody: - for i := 1 to sonsLen(f)-1 do begin - x := PType(idTableGet(mapping, f.sons[0].sons[i-1])); - if (x = nil) or (x.kind = tyGenericParam) then - InternalError('wrong instantiated type!'); - idTablePut(mapping, f.sons[i], x); - end - end - end - end; - tyGenericParam: begin - x := PType(idTableGet(mapping, f)); - if x = nil then begin - if sonsLen(f) = 0 then begin // no constraints - concrete := concreteType(mapping, a); - if concrete <> nil then begin - //MessageOut('putting: ' + f.sym.name.s); - idTablePut(mapping, f, concrete); - result := isGeneric - end; - end - else begin - InternalError(f.sym.info, 'has constraints: ' + f.sym.name.s); - // check constraints: - for i := 0 to sonsLen(f)-1 do begin - if typeRel(mapping, f.sons[i], a) >= isSubtype then begin - concrete := concreteType(mapping, a); - if concrete <> nil then begin - idTablePut(mapping, f, concrete); - result := isGeneric - end; - break - end - end - end - end - else if a.kind = tyEmpty then - result := isGeneric - else if x.kind = tyGenericParam then - result := isGeneric - else - result := typeRel(mapping, x, a) // check if it fits - end; - tyExpr, tyStmt, tyTypeDesc: begin - if a.kind = f.kind then result := isEqual - else - case a.kind of - tyExpr, tyStmt, tyTypeDesc: result := isGeneric; - tyNil: result := isSubtype; - else begin end - end - end; - else internalError('typeRel(' +{&} typeKindToStr[f.kind] +{&} ')'); - end -end; - -function cmpTypes(f, a: PType): TTypeRelation; -var - mapping: TIdTable; -begin - InitIdTable(mapping); - result := typeRel(mapping, f, a); -end; - -function getInstantiatedType(c: PContext; arg: PNode; const m: TCandidate; - f: PType): PType; -begin - result := PType(idTableGet(m.bindings, f)); - if result = nil then begin - result := generateTypeInstance(c, m.bindings, arg, f); - end; - if result = nil then InternalError(arg.info, 'getInstantiatedType'); -end; - -function implicitConv(kind: TNodeKind; f: PType; arg: PNode; - const m: TCandidate; c: PContext): PNode; -begin - result := newNodeI(kind, arg.info); - if containsGenericType(f) then - result.typ := getInstantiatedType(c, arg, m, f) - else - result.typ := f; - if result.typ = nil then InternalError(arg.info, 'implicitConv'); - addSon(result, nil); - addSon(result, arg); -end; - -function userConvMatch(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - i: int; - src, dest: PType; - s: PNode; -begin - result := nil; - for i := 0 to length(c.converters)-1 do begin - src := c.converters[i].typ.sons[1]; - dest := c.converters[i].typ.sons[0]; - if (typeRel(m.bindings, f, dest) = isEqual) and - (typeRel(m.bindings, src, a) = isEqual) then begin - s := newSymNode(c.converters[i]); - s.typ := c.converters[i].typ; - s.info := arg.info; - result := newNodeIT(nkHiddenCallConv, arg.info, s.typ.sons[0]); - addSon(result, s); - addSon(result, copyTree(arg)); - inc(m.convMatches); - exit - end - end -end; - -function ParamTypesMatchAux(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - r: TTypeRelation; -begin - r := typeRel(m.bindings, f, a); - case r of - isConvertible: begin - inc(m.convMatches); - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isIntConv: begin - inc(m.intConvMatches); - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isSubtype: begin - inc(m.subtypeMatches); - result := implicitConv(nkHiddenSubConv, f, copyTree(arg), m, c); - end; - isGeneric: begin - inc(m.genericMatches); - result := copyTree(arg); - result.typ := getInstantiatedType(c, arg, m, f); - // BUG: f may not be the right key! - if (skipTypes(result.typ, abstractVar).kind in [tyTuple, tyOpenArray]) then - // BUGFIX: must pass length implicitely - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - // BUGFIX: use ``result.typ`` and not `f` here - end; - isEqual: begin - inc(m.exactMatches); - result := copyTree(arg); - if (skipTypes(f, abstractVar).kind in [tyTuple, tyOpenArray]) then - // BUGFIX: must pass length implicitely - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isNone: begin - result := userConvMatch(c, m, f, a, arg); - // check for a base type match, which supports openarray[T] without [] - // constructor in a call: - if (result = nil) and (f.kind = tyOpenArray) then begin - r := typeRel(m.bindings, base(f), a); - if r >= isGeneric then begin - inc(m.convMatches); - result := copyTree(arg); - if r = isGeneric then - result.typ := getInstantiatedType(c, arg, m, base(f)); - m.baseTypeMatch := true; - end - else - result := userConvMatch(c, m, base(f), a, arg); - end - end - end -end; - -function ParamTypesMatch(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - i, cmp, best: int; - x, y, z: TCandidate; - r: TTypeRelation; -begin - if (arg = nil) or (arg.kind <> nkSymChoice) then begin - result := ParamTypesMatchAux(c, m, f, a, arg) - end - else begin - // CAUTION: The order depends on the used hashing scheme. Thus it is - // incorrect to simply use the first fitting match. However, to implement - // this correctly is inefficient. We have to copy `m` here to be able to - // roll back the side effects of the unification algorithm. - initCandidate(x, m.callee); - initCandidate(y, m.callee); - initCandidate(z, m.callee); - x.calleeSym := m.calleeSym; - y.calleeSym := m.calleeSym; - z.calleeSym := m.calleeSym; - best := -1; - for i := 0 to sonsLen(arg)-1 do begin - // iterators are not first class yet, so ignore them - if arg.sons[i].sym.kind in {@set}[skProc, skMethod, skConverter] then begin - copyCandidate(z, m); - r := typeRel(z.bindings, f, arg.sons[i].typ); - if r <> isNone then begin - case x.state of - csEmpty, csNoMatch: begin x := z; best := i; x.state := csMatch; end; - csMatch: begin - cmp := cmpCandidates(x, z); - if cmp < 0 then begin best := i; x := z end // z is better than x - else if cmp = 0 then y := z // z is as good as x - else begin end // z is worse than x - end - end - end - end - end; - if x.state = csEmpty then - result := nil - else if (y.state = csMatch) and (cmpCandidates(x, y) = 0) then begin - if x.state <> csMatch then InternalError(arg.info, 'x.state is not csMatch'); - // ambiguous: more than one symbol fits - result := nil - end - else begin - // only one valid interpretation found: - markUsed(arg, arg.sons[best].sym); - result := ParamTypesMatchAux(c, m, f, arg.sons[best].typ, arg.sons[best]); - end - end -end; - -function IndexTypesMatch(c: PContext; f, a: PType; arg: PNode): PNode; -var - m: TCandidate; -begin - initCandidate(m, f); - result := paramTypesMatch(c, m, f, a, arg) -end; - -procedure setSon(father: PNode; at: int; son: PNode); -begin - if sonsLen(father) <= at then - setLength(father.sons, at+1); - father.sons[at] := son; -end; - -procedure matches(c: PContext; n: PNode; var m: TCandidate); -var - f: int; // iterates over formal parameters - a: int; // iterates over the actual given arguments - formalLen: int; - marker: TIntSet; - container, arg: PNode; // constructed container - formal: PSym; -begin - f := 1; - a := 1; - m.state := csMatch; // until proven otherwise - m.call := newNodeI(nkCall, n.info); - m.call.typ := base(m.callee); // may be nil - formalLen := sonsLen(m.callee.n); - addSon(m.call, copyTree(n.sons[0])); - IntSetInit(marker); - container := nil; - formal := nil; - while a < sonsLen(n) do begin - if n.sons[a].kind = nkExprEqExpr then begin - // named param - // check if m.callee has such a param: - if n.sons[a].sons[0].kind <> nkIdent then begin - liMessage(n.sons[a].info, errNamedParamHasToBeIdent); - m.state := csNoMatch; - exit - end; - formal := getSymFromList(m.callee.n, n.sons[a].sons[0].ident, 1); - if formal = nil then begin - // no error message! - m.state := csNoMatch; - exit; - end; - if IntSetContainsOrIncl(marker, formal.position) then begin - // already in namedParams: - liMessage(n.sons[a].info, errCannotBindXTwice, formal.name.s); - m.state := csNoMatch; - exit - end; - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, - n.sons[a].sons[1]); - if (arg = nil) then begin m.state := csNoMatch; exit end; - if m.baseTypeMatch then begin - assert(container = nil); - container := newNodeI(nkBracket, n.sons[a].info); - addSon(container, arg); - setSon(m.call, formal.position+1, container); - if f <> formalLen-1 then container := nil; - end - else begin - setSon(m.call, formal.position+1, arg); - end - end - else begin - // unnamed param - if f >= formalLen then begin // too many arguments? - if tfVarArgs in m.callee.flags then begin - // is ok... but don't increment any counters... - if skipTypes(n.sons[a].typ, abstractVar).kind = tyString then - // conversion to cstring - addSon(m.call, implicitConv(nkHiddenStdConv, - getSysType(tyCString), copyTree(n.sons[a]), m, c)) - else - addSon(m.call, copyTree(n.sons[a])); - end - else if formal <> nil then begin - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]); - if (arg <> nil) and m.baseTypeMatch and (container <> nil) then begin - addSon(container, arg); - end - else begin - m.state := csNoMatch; - exit - end; - end - else begin - m.state := csNoMatch; - exit - end - end - else begin - if m.callee.n.sons[f].kind <> nkSym then - InternalError(n.sons[a].info, 'matches'); - formal := m.callee.n.sons[f].sym; - if IntSetContainsOrIncl(marker, formal.position) then begin - // already in namedParams: - liMessage(n.sons[a].info, errCannotBindXTwice, formal.name.s); - m.state := csNoMatch; - exit - end; - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]); - if (arg = nil) then begin m.state := csNoMatch; exit end; - if m.baseTypeMatch then begin - assert(container = nil); - container := newNodeI(nkBracket, n.sons[a].info); - addSon(container, arg); - setSon(m.call, formal.position+1, - implicitConv(nkHiddenStdConv, formal.typ, container, m, c)); - if f <> formalLen-1 then container := nil; - end - else begin - setSon(m.call, formal.position+1, arg); - end - end - end; - inc(a); - inc(f); - end; - // iterate over all formal params and check all are provided: - f := 1; - while f < sonsLen(m.callee.n) do begin - formal := m.callee.n.sons[f].sym; - if not IntSetContainsOrIncl(marker, formal.position) then begin - if formal.ast = nil then begin // no default value - m.state := csNoMatch; break - end - else begin - // use default value: - setSon(m.call, formal.position+1, copyTree(formal.ast)); - end - end; - inc(f); - end -end; - -function sameMethodDispatcher(a, b: PSym): bool; -var - aa, bb: PNode; -begin - result := false; - if (a.kind = skMethod) and (b.kind = skMethod) then begin - aa := lastSon(a.ast); - bb := lastSon(b.ast); - if (aa.kind = nkSym) and (bb.kind = nkSym) and - (aa.sym = bb.sym) then result := true - end -end; - -function semDirectCall(c: PContext; n: PNode; filter: TSymKinds): PNode; -var - sym: PSym; - o: TOverloadIter; - x, y, z: TCandidate; - cmp: int; -begin - //liMessage(n.info, warnUser, renderTree(n)); - sym := initOverloadIter(o, c, n.sons[0]); - result := nil; - if sym = nil then exit; - initCandidate(x, sym.typ); - x.calleeSym := sym; - initCandidate(y, sym.typ); - y.calleeSym := sym; - while sym <> nil do begin - if sym.kind in filter then begin - initCandidate(z, sym.typ); - z.calleeSym := sym; - matches(c, n, z); - if z.state = csMatch then begin - case x.state of - csEmpty, csNoMatch: x := z; - csMatch: begin - cmp := cmpCandidates(x, z); - if cmp < 0 then x := z // z is better than x - else if cmp = 0 then y := z // z is as good as x - else begin end // z is worse than x - end - end - end - end; - sym := nextOverloadIter(o, c, n.sons[0]) - end; - if x.state = csEmpty then begin - // no overloaded proc found - // do not generate an error yet; the semantic checking will check for - // an overloaded () operator - end - else if (y.state = csMatch) and (cmpCandidates(x, y) = 0) - and not sameMethodDispatcher(x.calleeSym, y.calleeSym) then begin - if x.state <> csMatch then - InternalError(n.info, 'x.state is not csMatch'); - //writeMatches(x); - //writeMatches(y); - liMessage(n.Info, errGenerated, - format(msgKindToString(errAmbiguousCallXYZ), - [getProcHeader(x.calleeSym), - getProcHeader(y.calleeSym), x.calleeSym.Name.s])) - end - else begin - // only one valid interpretation found: - markUsed(n, x.calleeSym); - if x.calleeSym.ast = nil then - internalError(n.info, 'calleeSym.ast is nil'); // XXX: remove this check! - if x.calleeSym.ast.sons[genericParamsPos] <> nil then begin - // a generic proc! - x.calleeSym := generateInstance(c, x.calleeSym, x.bindings, n.info); - x.callee := x.calleeSym.typ; - end; - result := x.call; - result.sons[0] := newSymNode(x.calleeSym); - result.typ := x.callee.sons[0]; - end -end; diff --git a/nim/strutils.pas b/nim/strutils.pas deleted file mode 100755 index 96c07d365b..0000000000 --- a/nim/strutils.pas +++ /dev/null @@ -1,755 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit strutils; - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem; - -type - EInvalidFormatStr = class(Exception) - end; - -const - StrStart = 1; - -function normalize(const s: string): string; -function cmpIgnoreStyle(const x, y: string): int; -function cmp(const x, y: string): int; -function cmpIgnoreCase(const x, y: string): int; - -function format(const f: string; const args: array of string): string; -procedure addf(var result: string; const f: string; args: array of string); - -function toHex(x: BiggestInt; len: int): string; -function toOctal(value: Char): string; -function toOct(x: BiggestInt; len: int): string; -function toBin(x: BiggestInt; len: int): string; - - -procedure addChar(var s: string; c: Char); -function toInt(const s: string): int; -function toBiggestInt(const s: string): BiggestInt; - -function toString(i: BiggestInt): string; overload; - -//function toString(i: int): string; overload; -function ToStringF(const r: Real): string; overload; -function ToString(b: Boolean): string; overload; -function ToString(b: PChar): string; overload; - -function IntToStr(i: BiggestInt; minChars: int): string; - -function find(const s, sub: string; start: int = 1): int; overload; -function replace(const s, search, by: string): string; -procedure deleteStr(var s: string; first, last: int); - -function ToLower(const s: string): string; -function toUpper(c: Char): Char; overload; -function toUpper(s: string): string; overload; - -function parseInt(const s: string): int; -function parseBiggestInt(const s: string): BiggestInt; -function ParseFloat(const s: string; checkEnd: Boolean = True): Real; - -function repeatChar(count: int; c: Char = ' '): string; - -function split(const s: string; const seps: TCharSet): TStringSeq; - -function startsWith(const s, prefix: string): bool; -function endsWith(const s, postfix: string): bool; - -const - WhiteSpace = [' ', #9..#13]; - -function strip(const s: string; const chars: TCharSet = WhiteSpace): string; -function allCharsInSet(const s: string; const theSet: TCharSet): bool; - -function quoteIfContainsWhite(const s: string): string; -procedure addSep(var dest: string; sep: string = ', '); - -implementation - -procedure addSep(var dest: string; sep: string = ', '); -begin - if length(dest) > 0 then add(dest, sep) -end; - -function quoteIfContainsWhite(const s: string): string; -begin - if ((find(s, ' ') >= strStart) - or (find(s, #9) >= strStart)) and (s[strStart] <> '"') then - result := '"' +{&} s +{&} '"' - else - result := s -end; - -function allCharsInSet(const s: string; const theSet: TCharSet): bool; -var - i: int; -begin - for i := strStart to length(s)+strStart-1 do - if not (s[i] in theSet) then begin result := false; exit end; - result := true -end; - -function strip(const s: string; const chars: TCharSet = WhiteSpace): string; -var - a, b, last: int; -begin - a := strStart; - last := length(s) + strStart - 1; - while (a <= last) and (s[a] in chars) do inc(a); - b := last; - while (b >= strStart) and (s[b] in chars) do dec(b); - if a <= b then - result := ncopy(s, a, b) - else - result := ''; -end; - -function startsWith(const s, prefix: string): bool; -var - i, j: int; -begin - result := false; - if length(s) >= length(prefix) then begin - i := 1; - j := 1; - while (i <= length(s)) and (j <= length(prefix)) do begin - if s[i] <> prefix[j] then exit; - inc(i); - inc(j); - end; - result := j > length(prefix); - end -end; - -function endsWith(const s, postfix: string): bool; -var - i, j: int; -begin - result := false; - if length(s) >= length(postfix) then begin - i := length(s); - j := length(postfix); - while (i >= 1) and (j >= 1) do begin - if s[i] <> postfix[j] then exit; - dec(i); - dec(j); - end; - result := j = 0; - end -end; - -function split(const s: string; const seps: TCharSet): TStringSeq; -var - first, last, len: int; -begin - first := 1; - last := 1; - setLength(result, 0); - while last <= length(s) do begin - while (last <= length(s)) and (s[last] in seps) do inc(last); - first := last; - while (last <= length(s)) and not (s[last] in seps) do inc(last); - if first >= last-1 then begin - len := length(result); - setLength(result, len+1); - result[len] := ncopy(s, first, last-1); - end - end -end; - -function repeatChar(count: int; c: Char = ' '): string; -var - i: int; -begin - result := newString(count); - for i := strStart to count+strStart-1 do result[i] := c -end; - -function cmp(const x, y: string): int; -var - aa, bb: char; - a, b: PChar; - i, j: int; -begin - i := 0; - j := 0; - a := PChar(x); // this is correct even for x = '' - b := PChar(y); - repeat - aa := a[i]; - bb := b[j]; - result := ord(aa) - ord(bb); - if (result <> 0) or (aa = #0) then break; - inc(i); - inc(j); - until false -end; - -procedure deleteStr(var s: string; first, last: int); -begin - delete(s, first, last - first + 1); -end; - -function toUpper(c: Char): Char; -begin - if (c >= 'a') and (c <= 'z') then - result := Chr(Ord(c) - Ord('a') + Ord('A')) - else - result := c -end; - -function ToString(b: Boolean): string; -begin - if b then result := 'true' - else result := 'false' -end; - -function toOctal(value: Char): string; -var - i: int; - val: int; -begin - val := ord(value); - result := newString(3); - for i := strStart+2 downto strStart do begin - result[i] := Chr(val mod 8 + ord('0')); - val := val div 8 - end; -end; - -function ToLower(const s: string): string; -var - i: int; -begin - result := ''; - for i := strStart to length(s)+StrStart-1 do - if s[i] in ['A'..'Z'] then - result := result + Chr(Ord(s[i]) + Ord('a') - Ord('A')) - else - result := result + s[i] -end; - -function toUpper(s: string): string; -var - i: int; -begin - result := ''; - for i := strStart to length(s)+StrStart-1 do - if s[i] in ['a'..'z'] then - result := result + Chr(Ord(s[i]) - Ord('a') + Ord('A')) - else - result := result + s[i] -end; - -function find(const s, sub: string; start: int = 1): int; -var - i, j, M, N: int; -begin - M := length(sub); N := length(s); - i := start; j := 1; - if i > N then - result := 0 - else begin - repeat - if s[i] = sub[j] then begin - Inc(i); Inc(j); - end - else begin - i := i - j + 2; - j := 1 - end - until (j > M) or (i > N); - if j > M then result := i - M - else result := 0 - end -end; - -function replace(const s, search, by: string): string; -var - i, j: int; -begin - result := ''; - i := 1; - repeat - j := find(s, search, i); - if j = 0 then begin - // copy the rest: - result := result + copy(s, i, length(s) - i + 1); - break - end; - result := result + copy(s, i, j - i) + by; - i := j + length(search) - until false -end; - -function ToStringF(const r: Real): string; -var - i: int; -begin - result := sysutils.format('%g', [r]); - i := pos(',', result); - if i > 0 then result[i] := '.' // long standing bug! - else if (cmpIgnoreStyle(result, 'nan') = 0) then // BUGFIX - result := 'NAN' - else if (cmpIgnoreStyle(result, 'inf') = 0) or - (cmpIgnoreStyle(result, '+inf') = 0) then - // FPC 2.1.1 seems to write +Inf ..., so here we go - result := 'INF' - else if (cmpIgnoreStyle(result, '-inf') = 0) then - result := '-INF' // another BUGFIX - else if pos('.', result) = 0 then - result := result + '.0' -end; - -function toInt(const s: string): int; -var - code: int; -begin - Val(s, result, code) -end; - -function toHex(x: BiggestInt; len: int): string; -const - HexChars: array [0..$F] of Char = '0123456789ABCDEF'; -var - j: int; - mask, shift: BiggestInt; -begin - assert(len > 0); - SetLength(result, len); - mask := $F; - shift := 0; - for j := len + strStart-1 downto strStart do begin - result[j] := HexChars[(x and mask) shr shift]; - shift := shift + 4; - mask := mask shl 4; - end; -end; - -function toOct(x: BiggestInt; len: int): string; -var - j: int; - mask, shift: BiggestInt; -begin - assert(len > 0); - result := newString(len); - mask := 7; - shift := 0; - for j := len + strStart-1 downto strStart do begin - result[j] := chr(((x and mask) shr shift) + ord('0')); - shift := shift + 3; - mask := mask shl 3; - end; -end; - -function toBin(x: BiggestInt; len: int): string; -var - j: int; - mask, shift: BiggestInt; -begin - assert(len > 0); - result := newString(len); - mask := 1; - shift := 0; - for j := len + strStart-1 downto strStart do begin - result[j] := chr(((x and mask) shr shift) + ord('0')); - shift := shift + 1; - mask := mask shl 1; - end; -end; - -procedure addChar(var s: string; c: Char); -{@ignore} -// delphi produces suboptimal code for "s := s + c" -{$ifndef fpc} -var - len: int; -{$endif} -{@emit} -begin -{@ignore} -{$ifdef fpc} - s := s + c -{$else} - {$ifopt H+} - len := length(s); - setLength(s, len + 1); - PChar(Pointer(s))[len] := c - {$else} - s := s + c - {$endif} -{$endif} -{@emit - s &= c -} -end; - -function IntToStr(i: BiggestInt; minChars: int): string; -var - j: int; -begin - result := sysutils.IntToStr(i); - for j := 1 to minChars - length(result) do - result := '0' + result; -end; - -function toBiggestInt(const s: string): BiggestInt; -begin -{$ifdef dephi} - result := ''; - str(i : 1, result); -{$else} - result := StrToInt64(s); -{$endif} -end; - -function toString(i: BiggestInt): string; overload; -begin - result := sysUtils.intToStr(i); -end; - -function ToString(b: PChar): string; overload; -begin - result := string(b); -end; - -function normalize(const s: string): string; -var - i: int; -begin - result := ''; - for i := strStart to length(s)+StrStart-1 do - if s[i] in ['A'..'Z'] then - result := result + Chr(Ord(s[i]) + Ord('a') - Ord('A')) - else if s[i] <> '_' then - result := result + s[i] -end; - -function cmpIgnoreCase(const x, y: string): int; -var - aa, bb: char; - a, b: PChar; - i, j: int; -begin - i := 0; - j := 0; - a := PChar(x); // this is correct even for x = '' - b := PChar(y); - repeat - aa := a[i]; - bb := b[j]; - if aa in ['A'..'Z'] then aa := Chr(Ord(aa) + Ord('a') - Ord('A')); - if bb in ['A'..'Z'] then bb := Chr(Ord(bb) + Ord('a') - Ord('A')); - result := ord(aa) - ord(bb); - if (result <> 0) or (a[i] = #0) then break; - inc(i); - inc(j); - until false -end; - -function cmpIgnoreStyle(const x, y: string): int; -// this is a hotspot in the compiler! -// it took 14% of total runtime! -// So we optimize the heck out of it! -var - aa, bb: char; - a, b: PChar; - i, j: int; -begin - i := 0; - j := 0; - a := PChar(x); // this is correct even for x = '' - b := PChar(y); - repeat - while a[i] = '_' do inc(i); - while b[j] = '_' do inc(j); - aa := a[i]; - bb := b[j]; - if aa in ['A'..'Z'] then aa := Chr(Ord(aa) + Ord('a') - Ord('A')); - if bb in ['A'..'Z'] then bb := Chr(Ord(bb) + Ord('a') - Ord('A')); - result := ord(aa) - ord(bb); - if (result <> 0) or (a[i] = #0) then break; - inc(i); - inc(j); - until false -end; - -function find(const x: string; const inArray: array of string): int; overload; -var - i: int; - y: string; -begin - y := normalize(x); - i := 0; - while i < high(inArray) do begin - if y = normalize(inArray[i]) then begin - result := i; exit - end; - inc(i, 2); // increment by 2, else a security whole! - end; - result := -1 -end; - -procedure addf(var result: string; const f: string; args: array of string); -const - PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', '_', #128..#255]; -var - i, j, x, num: int; -begin - i := 1; - num := 0; - while i <= length(f) do - if f[i] = '$' then begin - case f[i+1] of - '#': begin - inc(i, 2); - add(result, args[num]); - inc(num); - end; - '$': begin - addChar(result, '$'); - inc(i, 2); - end; - '1'..'9': begin - num := ord(f[i+1]) - ord('0'); - add(result, args[num - 1]); - inc(i, 2); - end; - '{': begin - j := i+1; - while (j <= length(f)) and (f[j] <> '}') do inc(j); - x := find(ncopy(f, i+2, j-1), args); - if (x >= 0) and (x < high(args)) then add(result, args[x+1]) - else raise EInvalidFormatStr.create(''); - i := j+1 - end; - 'a'..'z', 'A'..'Z', #128..#255, '_': begin - j := i+1; - while (j <= length(f)) and (f[j] in PatternChars) do inc(j); - x := find(ncopy(f, i+1, j-1), args); - if (x >= 0) and (x < high(args)) then add(result, args[x+1]) - else raise EInvalidFormatStr.create(ncopy(f, i+1, j-1)); - i := j - end - else raise EInvalidFormatStr.create(''); - end - end - else begin - addChar(result, f[i]); - inc(i) - end -end; - -function format(const f: string; const args: array of string): string; -begin - result := ''; - addf(result, f, args) -end; - -{@ignore} -{$ifopt Q-} {$Q+} -{$else} {$define Q_off} -{$endif} -{@emit} -// this must be compiled with overflow checking turned on: -function rawParseInt(const a: string; var index: int): BiggestInt; -// index contains the start position at proc entry; end position will be -// in index before the proc returns; index = -1 on error (no number at all) -var - i: int; - sign: BiggestInt; - s: string; -begin - s := a + #0; // to avoid the sucking range check errors - i := index; // a local i is more efficient than accessing an in out parameter - sign := 1; - if s[i] = '+' then inc(i) - else if s[i] = '-' then begin - inc(i); - sign := -1 - end; - - if s[i] in ['0'..'9'] then begin - result := 0; - while s[i] in ['0'..'9'] do begin - result := result * 10 + ord(s[i]) - ord('0'); - inc(i); - while s[i] = '_' do inc(i) // underscores are allowed and ignored - end; - result := result * sign; - index := i; // store index back - end - else begin - index := -1; - result := 0 - end -end; -{@ignore} -{$ifdef Q_off} -{$Q-} // turn it off again!!! -{$endif} -{@emit} - -function parseInt(const s: string): int; -var - index: int; - res: BiggestInt; -begin - index := strStart; - res := rawParseInt(s, index); - if index = -1 then - raise EInvalidValue.create('') -{$ifdef cpu32} - //else if (res < low(int)) or (res > high(int)) then - // raise EOverflow.create('') -{$endif} - else - result := int(res) // convert to smaller int type -end; - -function parseBiggestInt(const s: string): BiggestInt; -var - index: int; - res: BiggestInt; -begin - index := strStart; - result := rawParseInt(s, index); - if index = -1 then raise EInvalidValue.create('') -end; - -{@ignore} -{$ifopt Q+} {$Q-} -{$else} {$define Q_on} -{$endif} -{@emit} -// this function must be computed without overflow checking -function parseNimInt(const a: string): biggestInt; -var - i: int; -begin - i := StrStart; - result := rawParseInt(a, i); - if i = -1 then raise EInvalidValue.create(''); -end; - -function ParseFloat(const s: string; checkEnd: Boolean = True): Real; -var - hd, esign, sign: Real; - exponent, i, code: int; - flags: cardinal; -begin - result := 0.0; - code := 1; - exponent := 0; - esign := 1; - flags := 0; - sign := 1; - case s[code] of - '+': inc(code); - '-': begin - sign := -1; - inc(code); - end; - end; - - if (s[code] = 'N') or (s[code] = 'n') then begin - inc(code); - if (s[code] = 'A') or (s[code] = 'a') then begin - inc(code); - if (s[code] = 'N') or (s[code] = 'n') then begin - if code = length(s) then begin result:= NaN; exit end; - end - end; - raise EInvalidValue.create('invalid float: ' + s) - end; - if (s[code] = 'I') or (s[code] = 'i') then begin - inc(code); - if (s[code] = 'N') or (s[code] = 'n') then begin - inc(code); - if (s[code] = 'F') or (s[code] = 'f') then begin - if code = length(s) then begin result:= Inf*sign; exit end; - end - end; - raise EInvalidValue.create('invalid float: ' + s) - end; - - while (code <= Length(s)) and (s[code] in ['0'..'9']) do begin - { Read int part } - flags := flags or 1; - result := result * 10.0 + toFloat(ord(s[code])-ord('0')); - inc(code); - while (code <= length(s)) and (s[code] = '_') do 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; - result := result * 10.0 + toFloat(ord(s[code])-ord('0')); - hd := hd * 10.0; - inc(code); - while (code <= length(s)) and (s[code] = '_') do inc(code); - end; - result := result / hd; - end; - { Again, read int and fractional part } - if flags = 0 then - raise EInvalidValue.create('invalid float: ' + s); - { 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 - raise EInvalidValue.create(''); - while (length(s) >= code) and (s[code] in ['0'..'9']) do begin - exponent := exponent * 10; - exponent := exponent + ord(s[code])-ord('0'); - inc(code); - while (code <= length(s)) and (s[code] = '_') do inc(code); - end; - end; - { Calculate Exponent } - hd := 1.0; - for i := 1 to exponent do hd := hd * 10.0; - if esign > 0 then - result := result * hd - else - result := result / hd; - { Not all characters are read ? } - if checkEnd and (length(s) >= code) then - raise EInvalidValue.create('invalid float: ' + s); - { evaluate sign } - result := result * sign; -end; - -{@ignore} -{$ifdef Q_on} -{$Q+} // turn it on again! -{$endif} -{@emit -@pop # overflowChecks -} - -end. diff --git a/nim/syntaxes.pas b/nim/syntaxes.pas deleted file mode 100755 index 158ab8ea2d..0000000000 --- a/nim/syntaxes.pas +++ /dev/null @@ -1,234 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit syntaxes; - -// Implements the dispatcher for the different parsers. -{$include 'config.inc'} - -interface - -uses - nsystem, strutils, llstream, ast, astalgo, idents, scanner, options, msgs, - pnimsyn, pbraces, ptmplsyn, filters, rnimsyn; - -type - TFilterKind = (filtNone, filtTemplate, filtReplace, filtStrip); - TParserKind = (skinStandard, skinBraces, skinEndX); - -const - parserNames: array [TParserKind] of string = ('standard', 'braces', 'endx'); - filterNames: array [TFilterKind] of string = ('none', 'stdtmpl', 'replace', - 'strip'); - -type - TParsers = record - skin: TParserKind; - parser: TParser; - end; - -{@ignore} -function ParseFile(const filename: string): PNode; -{@emit -function ParseFile(const filename: string): PNode; procvar; -} - -procedure openParsers(var p: TParsers; const filename: string; - inputstream: PLLStream); -procedure closeParsers(var p: TParsers); -function parseAll(var p: TParsers): PNode; - -function parseTopLevelStmt(var p: TParsers): PNode; -// implements an iterator. Returns the next top-level statement or nil if end -// of stream. - - -implementation - -function ParseFile(const filename: string): PNode; -var - p: TParsers; - f: TBinaryFile; -begin - if not OpenFile(f, filename) then begin - rawMessage(errCannotOpenFile, filename); - exit - end; - OpenParsers(p, filename, LLStreamOpen(f)); - result := ParseAll(p); - CloseParsers(p); -end; - -function parseAll(var p: TParsers): PNode; -begin - case p.skin of - skinStandard: result := pnimsyn.parseAll(p.parser); - skinBraces: result := pbraces.parseAll(p.parser); - skinEndX: InternalError('parser to implement'); - // skinEndX: result := pendx.parseAll(p.parser); - end -end; - -function parseTopLevelStmt(var p: TParsers): PNode; -begin - case p.skin of - skinStandard: result := pnimsyn.parseTopLevelStmt(p.parser); - skinBraces: result := pbraces.parseTopLevelStmt(p.parser); - skinEndX: InternalError('parser to implement'); - //skinEndX: result := pendx.parseTopLevelStmt(p.parser); - end -end; - -function UTF8_BOM(const s: string): int; -begin - if (s[strStart] = #239) and (s[strStart+1] = #187) - and (s[strStart+2] = #191) then result := 3 - else result := 0 -end; - -function containsShebang(const s: string; i: int): bool; -var - j: int; -begin - result := false; - if (s[i] = '#') and (s[i+1] = '!') then begin - j := i+2; - while s[j] in WhiteSpace do inc(j); - result := s[j] = '/' - end -end; - -function parsePipe(const filename: string; inputStream: PLLStream): PNode; -var - line: string; - s: PLLStream; - i: int; - q: TParser; -begin - result := nil; - s := LLStreamOpen(filename, fmRead); - if s <> nil then begin - line := LLStreamReadLine(s) {@ignore} + #0 {@emit}; - i := UTF8_Bom(line) + strStart; - if containsShebang(line, i) then begin - line := LLStreamReadLine(s) {@ignore} + #0 {@emit}; - i := strStart; - end; - if (line[i] = '#') and (line[i+1] = '!') then begin - inc(i, 2); - while line[i] in WhiteSpace do inc(i); - OpenParser(q, filename, LLStreamOpen(ncopy(line, i))); - result := pnimsyn.parseAll(q); - CloseParser(q); - end; - LLStreamClose(s); - end -end; - -function getFilter(ident: PIdent): TFilterKind; -var - i: TFilterKind; -begin - for i := low(TFilterKind) to high(TFilterKind) do - if IdentEq(ident, filterNames[i]) then begin - result := i; exit - end; - result := filtNone -end; - -function getParser(ident: PIdent): TParserKind; -var - i: TParserKind; -begin - for i := low(TParserKind) to high(TParserKind) do - if IdentEq(ident, parserNames[i]) then begin - result := i; exit - end; - rawMessage(errInvalidDirectiveX, ident.s); -end; - -function getCallee(n: PNode): PIdent; -begin - if (n.kind = nkCall) and (n.sons[0].kind = nkIdent) then - result := n.sons[0].ident - else if n.kind = nkIdent then result := n.ident - else rawMessage(errXNotAllowedHere, renderTree(n)); -end; - -function applyFilter(var p: TParsers; n: PNode; const filename: string; - input: PLLStream): PLLStream; -var - ident: PIdent; - f: TFilterKind; -begin - ident := getCallee(n); - f := getFilter(ident); - case f of - filtNone: begin - p.skin := getParser(ident); - result := input - end; - filtTemplate: result := filterTmpl(input, filename, n); - filtStrip: result := filterStrip(input, filename, n); - filtReplace: result := filterReplace(input, filename, n); - end; - if f <> filtNone then begin - if gVerbosity >= 2 then begin - rawMessage(hintCodeBegin); - messageOut(result.s); - rawMessage(hintCodeEnd); - end - end -end; - -function evalPipe(var p: TParsers; n: PNode; const filename: string; - start: PLLStream): PLLStream; -var - i: int; -begin - result := start; - if n = nil then exit; - if (n.kind = nkInfix) and (n.sons[0].kind = nkIdent) - and IdentEq(n.sons[0].ident, '|'+'') then begin - for i := 1 to 2 do begin - if n.sons[i].kind = nkInfix then - result := evalPipe(p, n.sons[i], filename, result) - else - result := applyFilter(p, n.sons[i], filename, result) - end - end - else if n.kind = nkStmtList then - result := evalPipe(p, n.sons[0], filename, result) - else - result := applyFilter(p, n, filename, result) -end; - -procedure openParsers(var p: TParsers; const filename: string; - inputstream: PLLStream); -var - pipe: PNode; - s: PLLStream; -begin - p.skin := skinStandard; - pipe := parsePipe(filename, inputStream); - if pipe <> nil then - s := evalPipe(p, pipe, filename, inputStream) - else - s := inputStream; - case p.skin of - skinStandard, skinBraces, skinEndX: - pnimsyn.openParser(p.parser, filename, s); - end -end; - -procedure closeParsers(var p: TParsers); -begin - pnimsyn.closeParser(p.parser); -end; - -end. diff --git a/nim/tigen.pas b/nim/tigen.pas deleted file mode 100755 index 687b709203..0000000000 --- a/nim/tigen.pas +++ /dev/null @@ -1,47 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit tigen; - -// Type information generator. It transforms types into the AST of walker -// procs. This is used by the code generators. - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, strutils, nhashes, trees, treetab, platform, magicsys, - options, msgs, crc, idents, lists, types, rnimsyn; - -function gcWalker(t: PType): PNode; -function initWalker(t: PType): PNode; -function asgnWalker(t: PType): PNode; -function reprWalker(t: PType): PNode; - -implementation - -function gcWalker(t: PType): PNode; -begin -end; - -function initWalker(t: PType): PNode; -begin -end; - -function asgnWalker(t: PType): PNode; -begin -end; - -function reprWalker(t: PType): PNode; -begin -end; - -end. - diff --git a/nim/transf.pas b/nim/transf.pas deleted file mode 100755 index a0f07d51de..0000000000 --- a/nim/transf.pas +++ /dev/null @@ -1,964 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit transf; - -// This module implements the transformator. It transforms the syntax tree -// to ease the work of the code generators. Does some transformations: -// -// * inlines iterators -// * inlines constants -// * performes contant folding -// * introduces nkHiddenDeref, nkHiddenSubConv, etc. -// * introduces method dispatchers - -interface - -{$include 'config.inc'} - -uses - sysutils, nsystem, charsets, strutils, - lists, options, ast, astalgo, trees, treetab, evals, - msgs, nos, idents, rnimsyn, types, passes, semfold, magicsys, cgmeth; - -const - genPrefix = ':tmp'; // prefix for generated names - -function transfPass(): TPass; - -implementation - -type - PTransCon = ^TTransCon; - TTransCon = record // part of TContext; stackable - mapping: TIdNodeTable; // mapping from symbols to nodes - owner: PSym; // current owner - forStmt: PNode; // current for stmt - next: PTransCon; // for stacking - end; - - TTransfContext = object(passes.TPassContext) - module: PSym; - transCon: PTransCon; // top of a TransCon stack - end; - PTransf = ^TTransfContext; - -function newTransCon(): PTransCon; -begin - new(result); -{@ignore} - fillChar(result^, sizeof(result^), 0); -{@emit} - initIdNodeTable(result.mapping); -end; - -procedure pushTransCon(c: PTransf; t: PTransCon); -begin - t.next := c.transCon; - c.transCon := t; -end; - -procedure popTransCon(c: PTransf); -begin - if (c.transCon = nil) then InternalError('popTransCon'); - c.transCon := c.transCon.next; -end; - -// ------------ helpers ----------------------------------------------------- - -function getCurrOwner(c: PTransf): PSym; -begin - if c.transCon <> nil then result := c.transCon.owner - else result := c.module; -end; - -function newTemp(c: PTransf; typ: PType; const info: TLineInfo): PSym; -begin - result := newSym(skTemp, getIdent(genPrefix), getCurrOwner(c)); - result.info := info; - result.typ := skipTypes(typ, {@set}[tyGenericInst]); - include(result.flags, sfFromGeneric); -end; - -// -------------------------------------------------------------------------- - -function transform(c: PTransf; n: PNode): PNode; forward; - -(* - -Transforming iterators into non-inlined versions is pretty hard, but -unavoidable for not bloating the code too much. If we had direct access to -the program counter, things'd be much easier. -:: - - iterator items(a: string): char = - var i = 0 - while i < length(a): - yield a[i] - inc(i) - - for ch in items("hello world"): # `ch` is an iteration variable - echo(ch) - -Should be transformed into:: - - type - TItemsClosure = record - i: int - state: int - proc items(a: string, c: var TItemsClosure): char = - case c.state - of 0: goto L0 # very difficult without goto! - of 1: goto L1 # can be implemented by GCC's computed gotos - - block L0: - c.i = 0 - while c.i < length(a): - c.state = 1 - return a[i] - block L1: inc(c.i) - -More efficient, but not implementable:: - - type - TItemsClosure = record - i: int - pc: pointer - - proc items(a: string, c: var TItemsClosure): char = - goto c.pc - c.i = 0 - while c.i < length(a): - c.pc = label1 - return a[i] - label1: inc(c.i) -*) - -function newAsgnStmt(c: PTransf; le, ri: PNode): PNode; -begin - result := newNodeI(nkFastAsgn, ri.info); - addSon(result, le); - addSon(result, ri); -end; - -function transformSym(c: PTransf; n: PNode): PNode; -var - tc: PTransCon; - b: PNode; -begin - if (n.kind <> nkSym) then internalError(n.info, 'transformSym'); - tc := c.transCon; - if sfBorrow in n.sym.flags then begin - // simply exchange the symbol: - b := n.sym.ast.sons[codePos]; - if b.kind <> nkSym then - internalError(n.info, 'wrong AST for borrowed symbol'); - b := newSymNode(b.sym); - b.info := n.info; - end - else - b := n; - //writeln('transformSym', n.sym.id : 5); - while tc <> nil do begin - result := IdNodeTableGet(tc.mapping, b.sym); - if result <> nil then exit; - //write('not found in: '); - //writeIdNodeTable(tc.mapping); - tc := tc.next - end; - result := b; - case b.sym.kind of - skConst, skEnumField: begin // BUGFIX: skEnumField was missing - if not (skipTypes(b.sym.typ, abstractInst).kind in ConstantDataTypes) then begin - result := getConstExpr(c.module, b); - if result = nil then InternalError(b.info, 'transformSym: const'); - end - end - else begin end - end -end; - -procedure transformContinueAux(c: PTransf; n: PNode; labl: PSym; - var counter: int); -var - i: int; -begin - if n = nil then exit; - case n.kind of - nkEmpty..nkNilLit, nkForStmt, nkWhileStmt: begin end; - nkContinueStmt: begin - n.kind := nkBreakStmt; - addSon(n, newSymNode(labl)); - inc(counter); - end; - else begin - for i := 0 to sonsLen(n)-1 do - transformContinueAux(c, n.sons[i], labl, counter); - end - end -end; - -function transformContinue(c: PTransf; n: PNode): PNode; -// we transform the continue statement into a block statement -var - i, counter: int; - x: PNode; - labl: PSym; -begin - result := n; - for i := 0 to sonsLen(n)-1 do - result.sons[i] := transform(c, n.sons[i]); - counter := 0; - labl := newSym(skLabel, nil, getCurrOwner(c)); - labl.name := getIdent(genPrefix +{&} ToString(labl.id)); - labl.info := result.info; - transformContinueAux(c, result, labl, counter); - if counter > 0 then begin - x := newNodeI(nkBlockStmt, result.info); - addSon(x, newSymNode(labl)); - addSon(x, result); - result := x - end -end; - -function skipConv(n: PNode): PNode; -begin - case n.kind of - nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, - nkChckRangeF, nkChckRange64: - result := n.sons[0]; - nkHiddenStdConv, nkHiddenSubConv, nkConv: result := n.sons[1]; - else result := n - end -end; - -function newTupleAccess(tup: PNode; i: int): PNode; -var - lit: PNode; -begin - result := newNodeIT(nkBracketExpr, tup.info, tup.typ.sons[i]); - addSon(result, copyTree(tup)); - lit := newNodeIT(nkIntLit, tup.info, getSysType(tyInt)); - lit.intVal := i; - addSon(result, lit); -end; - -procedure unpackTuple(c: PTransf; n, father: PNode); -var - i: int; -begin - // XXX: BUG: what if `n` is an expression with side-effects? - for i := 0 to sonsLen(n)-1 do begin - addSon(father, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, newTupleAccess(n, i)))); - end -end; - -function transformYield(c: PTransf; n: PNode): PNode; -var - e: PNode; - i: int; -begin - result := newNodeI(nkStmtList, n.info); - e := n.sons[0]; - if skipTypes(e.typ, {@set}[tyGenericInst]).kind = tyTuple then begin - e := skipConv(e); - if e.kind = nkPar then begin - for i := 0 to sonsLen(e)-1 do begin - addSon(result, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, copyTree(e.sons[i])))); - end - end - else - unpackTuple(c, e, result); - end - else begin - e := transform(c, copyTree(e)); - addSon(result, newAsgnStmt(c, c.transCon.forStmt.sons[0], e)); - end; - // add body of the for loop: - addSon(result, transform(c, lastSon(c.transCon.forStmt))); -end; - -function inlineIter(c: PTransf; n: PNode): PNode; -var - i, j, L: int; - it: PNode; - newVar: PSym; -begin - result := n; - if n = nil then exit; - case n.kind of - nkEmpty..nkNilLit: begin - result := transform(c, copyTree(n)); - end; - nkYieldStmt: result := transformYield(c, n); - nkVarSection: begin - result := copyTree(n); - for i := 0 to sonsLen(result)-1 do begin - it := result.sons[i]; - if it.kind = nkCommentStmt then continue; - if it.kind = nkIdentDefs then begin - if (it.sons[0].kind <> nkSym) then - InternalError(it.info, 'inlineIter'); - newVar := copySym(it.sons[0].sym); - include(newVar.flags, sfFromGeneric); - // fixes a strange bug for rodgen: - //include(it.sons[0].sym.flags, sfFromGeneric); - newVar.owner := getCurrOwner(c); - IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)); - it.sons[0] := newSymNode(newVar); - it.sons[2] := transform(c, it.sons[2]); - end - else begin - if it.kind <> nkVarTuple then - InternalError(it.info, 'inlineIter: not nkVarTuple'); - L := sonsLen(it); - for j := 0 to L-3 do begin - newVar := copySym(it.sons[j].sym); - include(newVar.flags, sfFromGeneric); - newVar.owner := getCurrOwner(c); - IdNodeTablePut(c.transCon.mapping, it.sons[j].sym, - newSymNode(newVar)); - it.sons[j] := newSymNode(newVar); - end; - assert(it.sons[L-2] = nil); - it.sons[L-1] := transform(c, it.sons[L-1]); - end - end - end - else begin - result := copyNode(n); - for i := 0 to sonsLen(n)-1 do addSon(result, inlineIter(c, n.sons[i])); - result := transform(c, result); - end - end -end; - -procedure addVar(father, v: PNode); -var - vpart: PNode; -begin - vpart := newNodeI(nkIdentDefs, v.info); - addSon(vpart, v); - addSon(vpart, nil); - addSon(vpart, nil); - addSon(father, vpart); -end; - -function transformAddrDeref(c: PTransf; n: PNode; a, b: TNodeKind): PNode; -var - m: PNode; -begin - case n.sons[0].kind of - nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, - nkChckRangeF, nkChckRange64: begin - m := n.sons[0].sons[0]; - if (m.kind = a) or (m.kind = b) then begin - // addr ( nkPassAsOpenArray ( deref ( x ) ) ) --> nkPassAsOpenArray(x) - n.sons[0].sons[0] := m.sons[0]; - result := transform(c, n.sons[0]); - exit - end - end; - nkHiddenStdConv, nkHiddenSubConv, nkConv: begin - m := n.sons[0].sons[1]; - if (m.kind = a) or (m.kind = b) then begin - // addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - n.sons[0].sons[1] := m.sons[0]; - result := transform(c, n.sons[0]); - exit - end - end; - else begin - if (n.sons[0].kind = a) or (n.sons[0].kind = b) then begin - // addr ( deref ( x )) --> x - result := transform(c, n.sons[0].sons[0]); - exit - end - end - end; - n.sons[0] := transform(c, n.sons[0]); - result := n; -end; - -function transformConv(c: PTransf; n: PNode): PNode; -var - source, dest: PType; - diff: int; -begin - n.sons[1] := transform(c, n.sons[1]); - result := n; - // numeric types need range checks: - dest := skipTypes(n.typ, abstractVarRange); - source := skipTypes(n.sons[1].typ, abstractVarRange); - case dest.kind of - tyInt..tyInt64, tyEnum, tyChar, tyBool: begin - if (firstOrd(dest) <= firstOrd(source)) and - (lastOrd(source) <= lastOrd(dest)) then begin - // BUGFIX: simply leave n as it is; we need a nkConv node, - // but no range check: - result := n; - end - else begin // generate a range check: - if (dest.kind = tyInt64) or (source.kind = tyInt64) then - result := newNodeIT(nkChckRange64, n.info, n.typ) - else - result := newNodeIT(nkChckRange, n.info, n.typ); - dest := skipTypes(n.typ, abstractVar); - addSon(result, n.sons[1]); - addSon(result, newIntTypeNode(nkIntLit, firstOrd(dest), source)); - addSon(result, newIntTypeNode(nkIntLit, lastOrd(dest), source)); - end - end; - tyFloat..tyFloat128: begin - if skipTypes(n.typ, abstractVar).kind = tyRange then begin - result := newNodeIT(nkChckRangeF, n.info, n.typ); - dest := skipTypes(n.typ, abstractVar); - addSon(result, n.sons[1]); - addSon(result, copyTree(dest.n.sons[0])); - addSon(result, copyTree(dest.n.sons[1])); - end - end; - tyOpenArray: begin - result := newNodeIT(nkPassAsOpenArray, n.info, n.typ); - addSon(result, n.sons[1]); - end; - tyCString: begin - if source.kind = tyString then begin - result := newNodeIT(nkStringToCString, n.info, n.typ); - addSon(result, n.sons[1]); - end; - end; - tyString: begin - if source.kind = tyCString then begin - result := newNodeIT(nkCStringToString, n.info, n.typ); - addSon(result, n.sons[1]); - end; - end; - tyRef, tyPtr: begin - dest := skipTypes(dest, abstractPtrs); - source := skipTypes(source, abstractPtrs); - if source.kind = tyObject then begin - diff := inheritanceDiff(dest, source); - if diff < 0 then begin - result := newNodeIT(nkObjUpConv, n.info, n.typ); - addSon(result, n.sons[1]); - end - else if diff > 0 then begin - result := newNodeIT(nkObjDownConv, n.info, n.typ); - addSon(result, n.sons[1]); - end - else result := n.sons[1]; - end - end; - // conversions between different object types: - tyObject: begin - diff := inheritanceDiff(dest, source); - if diff < 0 then begin - result := newNodeIT(nkObjUpConv, n.info, n.typ); - addSon(result, n.sons[1]); - end - else if diff > 0 then begin - result := newNodeIT(nkObjDownConv, n.info, n.typ); - addSon(result, n.sons[1]); - end - else result := n.sons[1]; - end; (* - tyArray, tySeq: begin - if skipGeneric(dest - end; *) - tyGenericParam, tyOrdinal: result := n.sons[1]; - // happens sometimes for generated assignments, etc. - else begin end - end; -end; - -function skipPassAsOpenArray(n: PNode): PNode; -begin - result := n; - while result.kind = nkPassAsOpenArray do result := result.sons[0] -end; - -type - TPutArgInto = (paDirectMapping, paFastAsgn, paVarAsgn); - -function putArgInto(arg: PNode; formal: PType): TPutArgInto; -// This analyses how to treat the mapping "formal <-> arg" in an -// inline context. -var - i: int; -begin - if skipTypes(formal, abstractInst).kind = tyOpenArray then begin - result := paDirectMapping; // XXX really correct? - // what if ``arg`` has side-effects? - exit - end; - case arg.kind of - nkEmpty..nkNilLit: result := paDirectMapping; - nkPar, nkCurly, nkBracket: begin - result := paFastAsgn; - for i := 0 to sonsLen(arg)-1 do - if putArgInto(arg.sons[i], formal) <> paDirectMapping then - exit; - result := paDirectMapping; - end; - else begin - if skipTypes(formal, abstractInst).kind = tyVar then - result := paVarAsgn - else - result := paFastAsgn - end - end -end; - -function transformFor(c: PTransf; n: PNode): PNode; -// generate access statements for the parameters (unless they are constant) -// put mapping from formal parameters to actual parameters -var - i, len: int; - call, v, body, arg: PNode; - newC: PTransCon; - temp, formal: PSym; -begin - if (n.kind <> nkForStmt) then InternalError(n.info, 'transformFor'); - result := newNodeI(nkStmtList, n.info); - len := sonsLen(n); - n.sons[len-1] := transformContinue(c, n.sons[len-1]); - v := newNodeI(nkVarSection, n.info); - for i := 0 to len-3 do addVar(v, copyTree(n.sons[i])); // declare new vars - addSon(result, v); - newC := newTransCon(); - call := n.sons[len-2]; - if (call.kind <> nkCall) or (call.sons[0].kind <> nkSym) then - InternalError(call.info, 'transformFor'); - newC.owner := call.sons[0].sym; - newC.forStmt := n; - if (newC.owner.kind <> skIterator) then - InternalError(call.info, 'transformFor'); - // generate access statements for the parameters (unless they are constant) - pushTransCon(c, newC); - for i := 1 to sonsLen(call)-1 do begin - arg := skipPassAsOpenArray(transform(c, call.sons[i])); - formal := skipTypes(newC.owner.typ, abstractInst).n.sons[i].sym; - //if IdentEq(newc.Owner.name, 'items') then - // liMessage(arg.info, warnUser, 'items: ' + nodeKindToStr[arg.kind]); - case putArgInto(arg, formal.typ) of - paDirectMapping: IdNodeTablePut(newC.mapping, formal, arg); - paFastAsgn: begin - // generate a temporary and produce an assignment statement: - temp := newTemp(c, formal.typ, formal.info); - addVar(v, newSymNode(temp)); - addSon(result, newAsgnStmt(c, newSymNode(temp), arg)); - IdNodeTablePut(newC.mapping, formal, newSymNode(temp)); - end; - paVarAsgn: begin - assert(skipTypes(formal.typ, abstractInst).kind = tyVar); - InternalError(arg.info, 'not implemented: pass to var parameter'); - end; - end; - end; - body := newC.owner.ast.sons[codePos]; - pushInfoContext(n.info); - addSon(result, inlineIter(c, body)); - popInfoContext(); - popTransCon(c); -end; - -function getMagicOp(call: PNode): TMagic; -begin - if (call.sons[0].kind = nkSym) - and (call.sons[0].sym.kind in [skProc, skMethod, skConverter]) then - result := call.sons[0].sym.magic - else - result := mNone -end; - -procedure gatherVars(c: PTransf; n: PNode; var marked: TIntSet; - owner: PSym; container: PNode); -// gather used vars for closure generation -var - i: int; - s: PSym; - found: bool; -begin - if n = nil then exit; - case n.kind of - nkSym: begin - s := n.sym; - found := false; - case s.kind of - skVar: found := not (sfGlobal in s.flags); - skTemp, skForVar, skParam: found := true; - else begin end; - end; - if found and (owner.id <> s.owner.id) - and not IntSetContainsOrIncl(marked, s.id) then begin - include(s.flags, sfInClosure); - addSon(container, copyNode(n)); // DON'T make a copy of the symbol! - end - end; - nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: begin end; - else begin - for i := 0 to sonsLen(n)-1 do - gatherVars(c, n.sons[i], marked, owner, container); - end - end -end; - -(* - # example: - proc map(f: proc (x: int): int {.closure}, a: seq[int]): seq[int] = - result = @[] - for elem in a: - add result, f(a) - - proc addList(a: seq[int], y: int): seq[int] = - result = map(lambda (x: int): int = return x + y, a) - - should generate --> - - proc map(f: proc(x: int): int, closure: pointer, - a: seq[int]): seq[int] = - result = @[] - for elem in a: - add result, f(a, closure) - - type - PMyClosure = ref object - y: var int - - proc myLambda(x: int, closure: pointer) = - var cl = cast[PMyClosure](closure) - return x + cl.y - - proc addList(a: seq[int], y: int): seq[int] = - var - cl: PMyClosure - new(cl) - cl.y = y - result = map(myLambda, cast[pointer](cl), a) - - - or (but this is not easier and not binary compatible with C!) --> - - type - PClosure = ref object of TObject - f: proc (x: int, c: PClosure): int - - proc map(f: PClosure, a: seq[int]): seq[int] = - result = @[] - for elem in a: - add result, f.f(a, f) - - type - PMyClosure = ref object of PClosure - y: var int - - proc myLambda(x: int, cl: PMyClosure) = - return x + cl.y - - proc addList(a: seq[int], y: int): seq[int] = - var - cl: PMyClosure - new(cl) - cl.y = y - cl.f = myLambda - result = map(cl, a) -*) - -procedure addFormalParam(routine: PSym; param: PSym); -begin - addSon(routine.typ, param.typ); - addSon(routine.ast.sons[paramsPos], newSymNode(param)); -end; - -function indirectAccess(a, b: PSym): PNode; -// returns a^ .b as a node -var - x, y, deref: PNode; -begin - x := newSymNode(a); - y := newSymNode(b); - deref := newNodeI(nkDerefExpr, x.info); - deref.typ := x.typ.sons[0]; - addSon(deref, x); - result := newNodeI(nkDotExpr, x.info); - addSon(result, deref); - addSon(result, y); - result.typ := y.typ; -end; - -function transformLambda(c: PTransf; n: PNode): PNode; -var - marked: TIntSet; - closure: PNode; - s, param: PSym; - cl, p: PType; - i: int; - newC: PTransCon; -begin - result := n; - IntSetInit(marked); - if (n.sons[namePos].kind <> nkSym) then - InternalError(n.info, 'transformLambda'); - s := n.sons[namePos].sym; - closure := newNodeI(nkRecList, n.sons[codePos].info); - gatherVars(c, n.sons[codePos], marked, s, closure); - // add closure type to the param list (even if closure is empty!): - cl := newType(tyObject, s); - cl.n := closure; - addSon(cl, nil); // no super class - p := newType(tyRef, s); - addSon(p, cl); - param := newSym(skParam, getIdent(genPrefix + 'Cl'), s); - param.typ := p; - addFormalParam(s, param); - // all variables that are accessed should be accessed by the new closure - // parameter: - if sonsLen(closure) > 0 then begin - newC := newTransCon(); - for i := 0 to sonsLen(closure)-1 do begin - IdNodeTablePut(newC.mapping, closure.sons[i].sym, - indirectAccess(param, closure.sons[i].sym)) - end; - pushTransCon(c, newC); - n.sons[codePos] := transform(c, n.sons[codePos]); - popTransCon(c); - end; - // Generate code to allocate and fill the closure. This has to be done in - // the outer routine! -end; - -function transformCase(c: PTransf; n: PNode): PNode; -// removes `elif` branches of a case stmt -// adds ``else: nil`` if needed for the code generator -var - len, i, j: int; - ifs, elsen: PNode; -begin - len := sonsLen(n); - i := len-1; - if n.sons[i].kind = nkElse then dec(i); - if n.sons[i].kind = nkElifBranch then begin - while n.sons[i].kind = nkElifBranch do dec(i); - if (n.sons[i].kind <> nkOfBranch) then - InternalError(n.sons[i].info, 'transformCase'); - ifs := newNodeI(nkIfStmt, n.sons[i+1].info); - elsen := newNodeI(nkElse, ifs.info); - for j := i+1 to len-1 do addSon(ifs, n.sons[j]); - setLength(n.sons, i+2); - addSon(elsen, ifs); - n.sons[i+1] := elsen; - end - else if (n.sons[len-1].kind <> nkElse) and - not (skipTypes(n.sons[0].Typ, abstractVarRange).Kind in - [tyInt..tyInt64, tyChar, tyEnum]) then begin - //MessageOut(renderTree(n)); - elsen := newNodeI(nkElse, n.info); - addSon(elsen, newNodeI(nkNilLit, n.info)); - addSon(n, elsen) - end; - result := n; - for j := 0 to sonsLen(n)-1 do result.sons[j] := transform(c, n.sons[j]); -end; - -function transformArrayAccess(c: PTransf; n: PNode): PNode; -var - i: int; -begin - result := copyTree(n); - result.sons[0] := skipConv(result.sons[0]); - result.sons[1] := skipConv(result.sons[1]); - for i := 0 to sonsLen(result)-1 do - result.sons[i] := transform(c, result.sons[i]); -end; - -function getMergeOp(n: PNode): PSym; -begin - result := nil; - case n.kind of - nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, - nkCallStrLit: begin - if (n.sons[0].Kind = nkSym) and (n.sons[0].sym.kind = skProc) - and (sfMerge in n.sons[0].sym.flags) then - result := n.sons[0].sym; - end - else begin end - end -end; - -procedure flattenTreeAux(d, a: PNode; op: PSym); -var - i: int; - op2: PSym; -begin - op2 := getMergeOp(a); - if (op2 <> nil) and ((op2.id = op.id) - or (op.magic <> mNone) and (op2.magic = op.magic)) then - for i := 1 to sonsLen(a)-1 do - flattenTreeAux(d, a.sons[i], op) - else - // a is a "leaf", so add it: - addSon(d, copyTree(a)) -end; - -function flattenTree(root: PNode): PNode; -var - op: PSym; -begin - op := getMergeOp(root); - if op <> nil then begin - result := copyNode(root); - addSon(result, copyTree(root.sons[0])); - flattenTreeAux(result, root, op) - end - else - result := root -end; - -function transformCall(c: PTransf; n: PNode): PNode; -var - i, j: int; - m, a: PNode; - op: PSym; -begin - result := flattenTree(n); - for i := 0 to sonsLen(result)-1 do - result.sons[i] := transform(c, result.sons[i]); - op := getMergeOp(result); - if (op <> nil) and (op.magic <> mNone) and (sonsLen(result) >= 3) then begin - m := result; - result := newNodeIT(nkCall, m.info, m.typ); - addSon(result, copyTree(m.sons[0])); - j := 1; - while j < sonsLen(m) do begin - a := m.sons[j]; - inc(j); - if isConstExpr(a) then - while (j < sonsLen(m)) and isConstExpr(m.sons[j]) do begin - a := evalOp(op.magic, m, a, m.sons[j], nil); - inc(j) - end; - addSon(result, a); - end; - if sonsLen(result) = 2 then - result := result.sons[1]; - end - else if (result.sons[0].kind = nkSym) - and (result.sons[0].sym.kind = skMethod) then begin - // use the dispatcher for the call: - result := methodCall(result); - end - (* - else if result.sons[0].kind = nkSym then begin - // optimization still too aggressive - op := result.sons[0].sym; - if (op.magic = mNone) and (op.kind = skProc) - and ([sfSideEffect, sfForward, sfNoReturn, sfImportc] * op.flags = []) - then begin - for i := 1 to sonsLen(result)-1 do - if not isConstExpr(result.sons[i]) then exit; - // compile-time evaluation: - a := evalConstExpr(c.module, result); - if (a <> nil) and (a.kind <> nkEmpty) then begin - messageout('evaluated at compile time: ' + rendertree(result)); - result := a - end - end - end *) -end; - -function transform(c: PTransf; n: PNode): PNode; -var - i: int; - cnst: PNode; -begin - result := n; - if n = nil then exit; - //if ToLinenumber(n.info) = 32 then - // MessageOut(RenderTree(n)); - case n.kind of - nkSym: begin - result := transformSym(c, n); - exit - end; - nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: begin - // nothing to be done for leaves - end; - nkBracketExpr: result := transformArrayAccess(c, n); - nkLambda: result := transformLambda(c, n); - nkForStmt: result := transformFor(c, n); - nkCaseStmt: result := transformCase(c, n); - nkProcDef, nkMethodDef, nkIteratorDef, nkMacroDef: begin - if n.sons[genericParamsPos] = nil then begin - n.sons[codePos] := transform(c, n.sons[codePos]); - if n.kind = nkMethodDef then - methodDef(n.sons[namePos].sym); - end - end; - nkWhileStmt: begin - if (sonsLen(n) <> 2) then InternalError(n.info, 'transform'); - n.sons[0] := transform(c, n.sons[0]); - n.sons[1] := transformContinue(c, n.sons[1]); - end; - nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, - nkCallStrLit: - result := transformCall(c, result); - nkAddr, nkHiddenAddr: - result := transformAddrDeref(c, n, nkDerefExpr, nkHiddenDeref); - nkDerefExpr, nkHiddenDeref: - result := transformAddrDeref(c, n, nkAddr, nkHiddenAddr); - nkHiddenStdConv, nkHiddenSubConv, nkConv: - result := transformConv(c, n); - nkDiscardStmt: begin - for i := 0 to sonsLen(n)-1 do - result.sons[i] := transform(c, n.sons[i]); - if isConstExpr(result.sons[0]) then - result := newNode(nkCommentStmt) - end; - nkCommentStmt, nkTemplateDef: exit; - nkConstSection: exit; // do not replace ``const c = 3`` with ``const 3 = 3`` - else begin - for i := 0 to sonsLen(n)-1 do - result.sons[i] := transform(c, n.sons[i]); - end - end; - cnst := getConstExpr(c.module, result); - if cnst <> nil then result := cnst; // do not miss an optimization -end; - -function processTransf(context: PPassContext; n: PNode): PNode; -var - c: PTransf; -begin - c := PTransf(context); - result := transform(c, n); -end; - -function openTransf(module: PSym; const filename: string): PPassContext; -var - n: PTransf; -begin - new(n); -{@ignore} - fillChar(n^, sizeof(n^), 0); -{@emit} - n.module := module; - result := n; -end; - -function transfPass(): TPass; -begin - initPass(result); - result.open := openTransf; - result.process := processTransf; - result.close := processTransf; // we need to process generics too! -end; - -end. diff --git a/nim/transtmp.pas b/nim/transtmp.pas deleted file mode 100755 index 15a07f5a20..0000000000 --- a/nim/transtmp.pas +++ /dev/null @@ -1,149 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// This module implements a transformator. It transforms the syntax tree -// to ease the work of the code generators. Does the transformation to -// introduce temporaries to split up complex expressions. -// THIS MODULE IS NOT USED! - -procedure transInto(c: PContext; var dest: PNode; father, src: PNode); forward; -// transforms the expression `src` into the destination `dest`. Uses `father` -// for temorary statements. If dest = nil, the expression is put into a -// temporary. - -function transTmp(c: PContext; father, src: PNode): PNode; -// convienence proc -begin - result := nil; - transInto(c, result, father, src); -end; - -function newLabel(c: PContext): PSym; -begin - inc(gTmpId); - result := newSym(skLabel, getIdent(genPrefix +{&} ToString(gTmpId), - c.transCon.owner)); -end; - -function fewCmps(s: PNode): bool; -// this function estimates whether it is better to emit code -// for constructing the set or generating a bunch of comparisons directly -begin - assert(s.kind in [nkSetConstr, nkConstSetConstr]); - if (s.typ.size <= platform.intSize) and - (s.kind = nkConstSetConstr) then - result := false // it is better to emit the set generation code - else if skipRange(s.typ.sons[0]).Kind in [tyInt..tyInt64] then - result := true // better not emit the set if int is basetype! - else - result := sonsLen(s) <= 8 // 8 seems to be a good value -end; - -function transformIn(c: PContext; father, n: PNode): PNode; -var - a, b, e, setc: PNode; - destLabel, label2: PSym; -begin - if (n.sons[1].kind = nkSetConstr) and fewCmps(n.sons[1]) then begin - // a set constructor but not a constant set: - // do not emit the set, but generate a bunch of comparisons - result := newSymNode(newTemp(c, n.typ, n.info)); - e := transTmp(c, father, n.sons[2]); - setc := n.sons[1]; - destLabel := newLabel(c); - for i := 0 to sonsLen(setc)-1 do begin - if setc.sons[i].kind = nkRange then begin - a := transTmp(c, father, setc.sons[i].sons[0]); - b := transTmp(c, father, setc.sons[i].sons[1]); - label2 := newLabel(c); - addSon(father, newLt(result, e, a)); // e < a? --> goto end - addSon(father, newCondJmp(result, label2)); - addSon(father, newLe(result, e, b)); // e <= b? --> goto set end - addSon(father, newCondJmp(result, destLabel)); - addSon(father, newLabelNode(label2)); - end - else begin - a := transTmp(c, father, setc.sons[i]); - addSon(father, newEq(result, e, a)); - addSon(father, newCondJmp(result, destLabel)); - end - end; - addSon(father, newLabelNode(destLabel)); - end - else begin - result := n; - end -end; - -procedure transformOp2(c: PContext; var dest: PNode; father, n: PNode); -var - a, b: PNode; -begin - if dest = nil then dest := newSymNode(newTemp(c, n.typ, n.info)); - a := transTmp(c, father, n.sons[1]); - b := transTmp(c, father, n.sons[2]); - addSon(father, newAsgnStmt(dest, newOp2(n, a, b))); -end; - -procedure transformOp1(c: PContext; var dest: PNode; father, n: PNode); -var - a: PNode; -begin - if dest = nil then dest := newSymNode(newTemp(c, n.typ, n.info)); - a := transTmp(c, father, n.sons[1]); - addSon(father, newAsgnStmt(dest, newOp1(n, a))); -end; - -procedure genTypeInfo(c: PContext; initSection: PNode); -begin - -end; - -procedure genNew(c: PContext; father, n: PNode); -begin - // how do we handle compilerprocs? - -end; - -function transformCase(c: PContext; father, n: PNode): PNode; -var - ty: PType; - e: PNode; -begin - ty := skipGeneric(n.sons[0].typ); - if ty.kind = tyString then begin - // transform a string case to a bunch of comparisons: - result := newNodeI(nkIfStmt, n); - e := transTmp(c, father, n.sons[0]); - - end - else result := n -end; - - -procedure transInto(c: PContext; var dest: PNode; father, src: PNode); -begin - if src = nil then exit; - if (src.typ <> nil) and (src.typ.kind = tyGenericInst) then - src.typ := skipGeneric(src.typ); - case src.kind of - nkIdent..nkNilLit: begin - if dest = nil then dest := copyTree(src) - else begin - // generate assignment: - addSon(father, newAsgnStmt(dest, src)); - end - end; - nkCall, nkCommand, nkCallStrLit: begin - - end; - - - end; -end; diff --git a/nim/trees.pas b/nim/trees.pas deleted file mode 100755 index 0e0c04a22f..0000000000 --- a/nim/trees.pas +++ /dev/null @@ -1,214 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit trees; - -// tree helper routines - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, scanner, msgs, strutils; - -function getMagic(op: PNode): TMagic; - -// function getConstExpr(const t: TNode; out res: TNode): Boolean; - -function isConstExpr(n: PNode): Boolean; - - -function flattenTree(root: PNode; op: TMagic): PNode; - -function TreeToSym(t: PNode): PSym; - -procedure SwapOperands(op: PNode); -function getOpSym(op: PNode): PSym; - -function getProcSym(call: PNode): PSym; - -function ExprStructuralEquivalent(a, b: PNode): Boolean; - -function sameTree(a, b: PNode): boolean; -function cyclicTree(n: PNode): boolean; - -implementation - -function hasSon(father, son: PNode): boolean; -var - i: int; -begin - for i := 0 to sonsLen(father)-1 do - if father.sons[i] = son then begin result := true; exit end; - result := false -end; - -function cyclicTreeAux(n, s: PNode): boolean; -var - i, m: int; -begin - if n = nil then begin result := false; exit end; - if hasSon(s, n) then begin result := true; exit end; - m := sonsLen(s); - addSon(s, n); - if not (n.kind in [nkEmpty..nkNilLit]) then - for i := 0 to sonsLen(n)-1 do - if cyclicTreeAux(n.sons[i], s) then begin - result := true; exit - end; - result := false; - delSon(s, m); -end; - -function cyclicTree(n: PNode): boolean; -var - s: PNode; -begin - s := newNodeI(nkEmpty, n.info); - result := cyclicTreeAux(n, s); -end; - -function ExprStructuralEquivalent(a, b: PNode): Boolean; -var - i: int; -begin - result := false; - if a = b then begin - result := true - end - else if (a <> nil) and (b <> nil) and (a.kind = b.kind) then - case a.kind of - nkSym: // don't go nuts here: same symbol as string is enough: - result := a.sym.name.id = b.sym.name.id; - nkIdent: - result := a.ident.id = b.ident.id; - nkCharLit..nkInt64Lit: - result := a.intVal = b.intVal; - nkFloatLit..nkFloat64Lit: - result := a.floatVal = b.floatVal; - nkStrLit..nkTripleStrLit: - result := a.strVal = b.strVal; - nkEmpty, nkNilLit, nkType: result := true; - else if sonsLen(a) = sonsLen(b) then begin - for i := 0 to sonsLen(a)-1 do - if not ExprStructuralEquivalent(a.sons[i], b.sons[i]) then exit; - result := true - end - end -end; - -function sameTree(a, b: PNode): Boolean; -var - i: int; -begin - result := false; - if a = b then begin - result := true - end - else if (a <> nil) and (b <> nil) and (a.kind = b.kind) then begin - if a.flags <> b.flags then exit; - if a.info.line <> b.info.line then exit; - if a.info.col <> b.info.col then exit; - //if a.info.fileIndex <> b.info.fileIndex then exit; - case a.kind of - nkSym: // don't go nuts here: same symbol as string is enough: - result := a.sym.name.id = b.sym.name.id; - nkIdent: - result := a.ident.id = b.ident.id; - nkCharLit..nkInt64Lit: - result := a.intVal = b.intVal; - nkFloatLit..nkFloat64Lit: - result := a.floatVal = b.floatVal; - nkStrLit..nkTripleStrLit: - result := a.strVal = b.strVal; - nkEmpty, nkNilLit, nkType: result := true; - else if sonsLen(a) = sonsLen(b) then begin - for i := 0 to sonsLen(a)-1 do - if not sameTree(a.sons[i], b.sons[i]) then exit; - result := true - end - end - end -end; - -function getProcSym(call: PNode): PSym; -begin - result := call.sons[0].sym; -end; - -function getOpSym(op: PNode): PSym; -begin - if not (op.kind in [nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit]) then - result := nil - else begin - if (sonsLen(op) <= 0) then InternalError(op.info, 'getOpSym'); - if op.sons[0].Kind = nkSym then result := op.sons[0].sym - else result := nil - end -end; - -function getMagic(op: PNode): TMagic; -begin - case op.kind of - nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit: begin - case op.sons[0].Kind of - nkSym: begin - result := op.sons[0].sym.magic; - end; - else result := mNone - end - end; - else - result := mNone - end -end; - -function TreeToSym(t: PNode): PSym; -begin - result := t.sym -end; - -function isConstExpr(n: PNode): Boolean; -begin - result := (n.kind in [nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkNilLit]) - or (nfAllConst in n.flags) -end; - -procedure flattenTreeAux(d, a: PNode; op: TMagic); -var - i: int; -begin - if (getMagic(a) = op) then // BUGFIX - for i := 1 to sonsLen(a)-1 do // BUGFIX - flattenTreeAux(d, a.sons[i], op) - else - // a is a "leaf", so add it: - addSon(d, copyTree(a)) -end; - -function flattenTree(root: PNode; op: TMagic): PNode; -begin - result := copyNode(root); - if (getMagic(root) = op) then begin // BUGFIX: forget to copy prc - addSon(result, copyNode(root.sons[0])); - flattenTreeAux(result, root, op) - end -end; - -procedure SwapOperands(op: PNode); -var - tmp: PNode; -begin - tmp := op.sons[1]; - op.sons[1] := op.sons[2]; - op.sons[2] := tmp; -end; - -end. diff --git a/nim/treetab.pas b/nim/treetab.pas deleted file mode 100755 index 31d7aa0cff..0000000000 --- a/nim/treetab.pas +++ /dev/null @@ -1,189 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit treetab; - -// Implements a table from trees to trees. Does structural equavilent checking. - -interface - -{$include 'config.inc'} - -uses - nsystem, nhashes, ast, astalgo, types; - -function NodeTableGet(const t: TNodeTable; key: PNode): int; -procedure NodeTablePut(var t: TNodeTable; key: PNode; val: int); - -function NodeTableTestOrSet(var t: TNodeTable; key: PNode; val: int): int; - -implementation - -function hashTree(n: PNode): THash; -var - i: int; -begin - result := 0; - if n = nil then exit; - result := ord(n.kind); - case n.kind of - nkEmpty, nkNilLit, nkType: begin end; - nkIdent: result := concHash(result, n.ident.h); - nkSym: result := concHash(result, n.sym.name.h); - nkCharLit..nkInt64Lit: begin - if (n.intVal >= low(int)) and (n.intVal <= high(int)) then - result := concHash(result, int(n.intVal)); - end; - nkFloatLit..nkFloat64Lit: begin - if (n.floatVal >= -1000000.0) and (n.floatVal <= 1000000.0) then - result := concHash(result, toInt(n.floatVal)); - end; - nkStrLit..nkTripleStrLit: - result := concHash(result, GetHashStr(n.strVal)); - else begin - for i := 0 to sonsLen(n)-1 do - result := concHash(result, hashTree(n.sons[i])); - end - end -end; - -function TreesEquivalent(a, b: PNode): Boolean; -var - i: int; -begin - result := false; - if a = b then begin - result := true - end - else if (a <> nil) and (b <> nil) and (a.kind = b.kind) then begin - case a.kind of - nkEmpty, nkNilLit, nkType: result := true; - nkSym: - result := a.sym.id = b.sym.id; - nkIdent: - result := a.ident.id = b.ident.id; - nkCharLit..nkInt64Lit: - result := a.intVal = b.intVal; - nkFloatLit..nkFloat64Lit: - result := a.floatVal = b.floatVal; - nkStrLit..nkTripleStrLit: - result := a.strVal = b.strVal; - else if sonsLen(a) = sonsLen(b) then begin - for i := 0 to sonsLen(a)-1 do - if not TreesEquivalent(a.sons[i], b.sons[i]) then exit; - result := true - end - end; - if result then result := sameTypeOrNil(a.typ, b.typ); - end -end; - -function NodeTableRawGet(const t: TNodeTable; k: THash; key: PNode): int; -var - h: THash; -begin - h := k and high(t.data); - while t.data[h].key <> nil do begin - if (t.data[h].h = k) and TreesEquivalent(t.data[h].key, key) then begin - result := h; exit - end; - h := nextTry(h, high(t.data)) - end; - result := -1 -end; - -function NodeTableGet(const t: TNodeTable; key: PNode): int; -var - index: int; -begin - index := NodeTableRawGet(t, hashTree(key), key); - if index >= 0 then result := t.data[index].val - else result := low(int) -end; - -procedure NodeTableRawInsert(var data: TNodePairSeq; k: THash; - key: PNode; val: int); -var - h: THash; -begin - h := k and high(data); - while data[h].key <> nil do h := nextTry(h, high(data)); - assert(data[h].key = nil); - data[h].h := k; - data[h].key := key; - data[h].val := val; -end; - -procedure NodeTablePut(var t: TNodeTable; key: PNode; val: int); -var - index, i: int; - n: TNodePairSeq; - k: THash; -begin - k := hashTree(key); - index := NodeTableRawGet(t, k, key); - if index >= 0 then begin - assert(t.data[index].key <> nil); - t.data[index].val := val - end - else begin - if mustRehash(length(t.data), t.counter) then begin - {@ignore} - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); - {@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i].key <> nil then - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val); - {@ignore} - t.data := n; - {@emit - swap(t.data, n); - } - end; - NodeTableRawInsert(t.data, k, key, val); - inc(t.counter) - end; -end; - -function NodeTableTestOrSet(var t: TNodeTable; key: PNode; val: int): int; -var - index, i: int; - n: TNodePairSeq; - k: THash; -begin - k := hashTree(key); - index := NodeTableRawGet(t, k, key); - if index >= 0 then begin - assert(t.data[index].key <> nil); - result := t.data[index].val - end - else begin - if mustRehash(length(t.data), t.counter) then begin - {@ignore} - setLength(n, length(t.data) * growthFactor); - fillChar(n[0], length(n)*sizeof(n[0]), 0); - {@emit - newSeq(n, length(t.data) * growthFactor); } - for i := 0 to high(t.data) do - if t.data[i].key <> nil then - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val); - {@ignore} - t.data := n; - {@emit - swap(t.data, n); - } - end; - NodeTableRawInsert(t.data, k, key, val); - result := val; - inc(t.counter) - end; -end; - -end. diff --git a/nim/types.pas b/nim/types.pas deleted file mode 100755 index a881b2f11b..0000000000 --- a/nim/types.pas +++ /dev/null @@ -1,1295 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit types; - -// this module contains routines for accessing and iterating over types - -interface - -{$include 'config.inc'} - -uses - nsystem, ast, astalgo, trees, msgs, strutils, platform; - -function firstOrd(t: PType): biggestInt; -function lastOrd(t: PType): biggestInt; -function lengthOrd(t: PType): biggestInt; - -type - TPreferedDesc = (preferName, preferDesc); -function TypeToString(typ: PType; prefer: TPreferedDesc = preferName): string; -function getProcHeader(sym: PSym): string; - -function base(t: PType): PType; - - -// ------------------- type iterator: ---------------------------------------- -type - TTypeIter = function (t: PType; closure: PObject): bool; - // should return true if the iteration should stop - - TTypeMutator = function (t: PType; closure: PObject): PType; - // copy t and mutate it - - TTypePredicate = function (t: PType): bool; - -function IterOverType(t: PType; iter: TTypeIter; closure: PObject): bool; -// Returns result of `iter`. - -function mutateType(t: PType; iter: TTypeMutator; closure: PObject): PType; -// Returns result of `iter`. - - -function SameType(x, y: PType): Boolean; -function SameTypeOrNil(a, b: PType): Boolean; -function equalOrDistinctOf(x, y: PType): bool; - -type - TParamsEquality = (paramsNotEqual, // parameters are not equal - paramsEqual, // parameters are equal - paramsIncompatible); // they are equal, but their - // identifiers or their return - // type differ (i.e. they cannot be - // overloaded) - // this used to provide better error messages -function equalParams(a, b: PNode): TParamsEquality; -// returns whether the parameter lists of the procs a, b are exactly the same - - -function isOrdinalType(t: PType): Boolean; -function enumHasWholes(t: PType): Boolean; - -const - abstractPtrs = {@set}[tyVar, tyPtr, tyRef, tyGenericInst, tyDistinct, tyOrdinal]; - abstractVar = {@set}[tyVar, tyGenericInst, tyDistinct, tyOrdinal]; - abstractRange = {@set}[tyGenericInst, tyRange, tyDistinct, tyOrdinal]; - abstractVarRange = {@set}[tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal]; - abstractInst = {@set}[tyGenericInst, tyDistinct, tyOrdinal]; - -function skipTypes(t: PType; kinds: TTypeKinds): PType; - -function elemType(t: PType): PType; - -function containsObject(t: PType): bool; - -function containsGarbageCollectedRef(typ: PType): Boolean; -function containsHiddenPointer(typ: PType): Boolean; -function canFormAcycle(typ: PType): boolean; - -function isCompatibleToCString(a: PType): bool; - -function getOrdValue(n: PNode): biggestInt; - - -function computeSize(typ: PType): biggestInt; -function getSize(typ: PType): biggestInt; - -function isPureObject(typ: PType): boolean; - -function inheritanceDiff(a, b: PType): int; -// | returns: 0 iff `a` == `b` -// | returns: -x iff `a` is the x'th direct superclass of `b` -// | returns: +x iff `a` is the x'th direct subclass of `b` -// | returns: `maxint` iff `a` and `b` are not compatible at all - - -function InvalidGenericInst(f: PType): bool; -// for debugging - - -type - TTypeFieldResult = ( - frNone, // type has no object type field - frHeader, // type has an object type field only in the header - frEmbedded // type has an object type field somewhere embedded - ); - -function analyseObjectWithTypeField(t: PType): TTypeFieldResult; -// this does a complex analysis whether a call to ``objectInit`` needs to be -// made or intializing of the type field suffices or if there is no type field -// at all in this type. - -function typeAllowed(t: PType; kind: TSymKind): bool; - -implementation - -function InvalidGenericInst(f: PType): bool; -begin - result := (f.kind = tyGenericInst) and (lastSon(f) = nil); -end; - -function inheritanceDiff(a, b: PType): int; -var - x, y: PType; -begin - // conversion to superclass? - x := a; - result := 0; - while (x <> nil) do begin - if x.id = b.id then exit; - x := x.sons[0]; - dec(result); - end; - // conversion to baseclass? - y := b; - result := 0; - while (y <> nil) do begin - if y.id = a.id then exit; - y := y.sons[0]; - inc(result); - end; - result := high(int); -end; - -function isPureObject(typ: PType): boolean; -var - t: PType; -begin - t := typ; - while t.sons[0] <> nil do t := t.sons[0]; - result := (t.sym <> nil) and (sfPure in t.sym.flags); -end; - -function getOrdValue(n: PNode): biggestInt; -begin - case n.kind of - nkCharLit..nkInt64Lit: result := n.intVal; - nkNilLit: result := 0; - else begin - liMessage(n.info, errOrdinalTypeExpected); - result := 0 - end - end -end; - -function isCompatibleToCString(a: PType): bool; -begin - result := false; - if a.kind = tyArray then - if (firstOrd(a.sons[0]) = 0) - and (skipTypes(a.sons[0], {@set}[tyRange]).kind in [tyInt..tyInt64]) - and (a.sons[1].kind = tyChar) then - result := true -end; - -function getProcHeader(sym: PSym): string; -var - i: int; - n, p: PNode; -begin - result := sym.name.s + '('; - n := sym.typ.n; - for i := 1 to sonsLen(n)-1 do begin - p := n.sons[i]; - if (p.kind <> nkSym) then InternalError('getProcHeader'); - add(result, p.sym.name.s); - add(result, ': '); - add(result, typeToString(p.sym.typ)); - if i <> sonsLen(n)-1 then add(result, ', '); - end; - addChar(result, ')'); - if n.sons[0].typ <> nil then - result := result +{&} ': ' +{&} typeToString(n.sons[0].typ); -end; - -function elemType(t: PType): PType; -begin - assert(t <> nil); - case t.kind of - tyGenericInst, tyDistinct: result := elemType(lastSon(t)); - tyArray, tyArrayConstr: result := t.sons[1]; - else result := t.sons[0]; - end; - assert(result <> nil); -end; - -function skipGeneric(t: PType): PType; -begin - result := t; - while result.kind = tyGenericInst do result := lastSon(result) -end; - -function skipRange(t: PType): PType; -begin - result := t; - while result.kind = tyRange do result := base(result) -end; - -function skipAbstract(t: PType): PType; -begin - result := t; - while result.kind in [tyRange, tyGenericInst] do - result := lastSon(result); -end; - -function skipVar(t: PType): PType; -begin - result := t; - while result.kind = tyVar do result := result.sons[0]; -end; - -function skipVarGeneric(t: PType): PType; -begin - result := t; - while result.kind in [tyGenericInst, tyVar] do result := lastSon(result); -end; - -function skipPtrsGeneric(t: PType): PType; -begin - result := t; - while result.kind in [tyGenericInst, tyVar, tyPtr, tyRef] do - result := lastSon(result); -end; - -function skipVarGenericRange(t: PType): PType; -begin - result := t; - while result.kind in [tyGenericInst, tyVar, tyRange] do - result := lastSon(result); -end; - -function skipGenericRange(t: PType): PType; -begin - result := t; - while result.kind in [tyGenericInst, tyVar, tyRange] do - result := lastSon(result); -end; - -function skipTypes(t: PType; kinds: TTypeKinds): PType; -begin - result := t; - while result.kind in kinds do result := lastSon(result); -end; - -function isOrdinalType(t: PType): Boolean; -begin - assert(t <> nil); - result := (t.Kind in [tyChar, tyInt..tyInt64, tyBool, tyEnum]) - or (t.Kind in [tyRange, tyOrdinal]) and isOrdinalType(t.sons[0]); -end; - -function enumHasWholes(t: PType): Boolean; -var - b: PType; -begin - b := t; - while b.kind = tyRange do b := b.sons[0]; - result := (b.Kind = tyEnum) and (tfEnumHasWholes in b.flags) -end; - -function iterOverTypeAux(var marker: TIntSet; t: PType; iter: TTypeIter; - closure: PObject): bool; forward; - -function iterOverNode(var marker: TIntSet; n: PNode; iter: TTypeIter; - closure: PObject): bool; -var - i: int; -begin - result := false; - if n <> nil then begin - case n.kind of - nkNone..nkNilLit: begin // a leaf - result := iterOverTypeAux(marker, n.typ, iter, closure); - end; - else begin - for i := 0 to sonsLen(n)-1 do begin - result := iterOverNode(marker, n.sons[i], iter, closure); - if result then exit; - end - end - end - end -end; - -function iterOverTypeAux(var marker: TIntSet; t: PType; iter: TTypeIter; - closure: PObject): bool; -var - i: int; -begin - result := false; - if t = nil then exit; - result := iter(t, closure); - if result then exit; - if not IntSetContainsOrIncl(marker, t.id) then begin - case t.kind of - tyGenericInst, tyGenericBody: - result := iterOverTypeAux(marker, lastSon(t), iter, closure); - else begin - for i := 0 to sonsLen(t)-1 do begin - result := iterOverTypeAux(marker, t.sons[i], iter, closure); - if result then exit; - end; - if t.n <> nil then result := iterOverNode(marker, t.n, iter, closure) - end - end - end -end; - -function IterOverType(t: PType; iter: TTypeIter; closure: PObject): bool; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := iterOverTypeAux(marker, t, iter, closure); -end; - -function searchTypeForAux(t: PType; predicate: TTypePredicate; - var marker: TIntSet): bool; forward; - -function searchTypeNodeForAux(n: PNode; p: TTypePredicate; - var marker: TIntSet): bool; -var - i: int; -begin - result := false; - case n.kind of - nkRecList: begin - for i := 0 to sonsLen(n)-1 do begin - result := searchTypeNodeForAux(n.sons[i], p, marker); - if result then exit - end - end; - nkRecCase: begin - assert(n.sons[0].kind = nkSym); - result := searchTypeNodeForAux(n.sons[0], p, marker); - if result then exit; - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkOfBranch, nkElse: begin - result := searchTypeNodeForAux(lastSon(n.sons[i]), p, marker); - if result then exit; - end; - else internalError('searchTypeNodeForAux(record case branch)'); - end - end - end; - nkSym: begin - result := searchTypeForAux(n.sym.typ, p, marker); - end; - else internalError(n.info, 'searchTypeNodeForAux()'); - end; -end; - -function searchTypeForAux(t: PType; predicate: TTypePredicate; - var marker: TIntSet): bool; -// iterates over VALUE types! -var - i: int; -begin - result := false; - if t = nil then exit; - if IntSetContainsOrIncl(marker, t.id) then exit; - result := Predicate(t); - if result then exit; - case t.kind of - tyObject: begin - result := searchTypeForAux(t.sons[0], predicate, marker); - if not result then - result := searchTypeNodeForAux(t.n, predicate, marker); - end; - tyGenericInst, tyDistinct: - result := searchTypeForAux(lastSon(t), predicate, marker); - tyArray, tyArrayConstr, tySet, tyTuple: begin - for i := 0 to sonsLen(t)-1 do begin - result := searchTypeForAux(t.sons[i], predicate, marker); - if result then exit - end - end - else begin end - end -end; - -function searchTypeFor(t: PType; predicate: TTypePredicate): bool; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := searchTypeForAux(t, predicate, marker); -end; - -function isObjectPredicate(t: PType): bool; -begin - result := t.kind = tyObject -end; - -function containsObject(t: PType): bool; -begin - result := searchTypeFor(t, isObjectPredicate); -end; - -function isObjectWithTypeFieldPredicate(t: PType): bool; -begin - result := (t.kind = tyObject) and (t.sons[0] = nil) - and not ((t.sym <> nil) and (sfPure in t.sym.flags)) - and not (tfFinal in t.flags); -end; - -function analyseObjectWithTypeFieldAux(t: PType; - var marker: TIntSet): TTypeFieldResult; -var - res: TTypeFieldResult; - i: int; -begin - result := frNone; - if t = nil then exit; - case t.kind of - tyObject: begin - if (t.n <> nil) then - if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker) then begin - result := frEmbedded; exit - end; - for i := 0 to sonsLen(t)-1 do begin - res := analyseObjectWithTypeFieldAux(t.sons[i], marker); - if res = frEmbedded then begin result := frEmbedded; exit end; - if res = frHeader then result := frHeader; - end; - if result = frNone then - if isObjectWithTypeFieldPredicate(t) then result := frHeader - end; - tyGenericInst, tyDistinct: - result := analyseObjectWithTypeFieldAux(lastSon(t), marker); - tyArray, tyArrayConstr, tyTuple: begin - for i := 0 to sonsLen(t)-1 do begin - res := analyseObjectWithTypeFieldAux(t.sons[i], marker); - if res <> frNone then begin result := frEmbedded; exit end; - end - end - else begin end - end -end; - -function analyseObjectWithTypeField(t: PType): TTypeFieldResult; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := analyseObjectWithTypeFieldAux(t, marker); -end; - -function isGBCRef(t: PType): bool; -begin - result := t.kind in [tyRef, tySequence, tyString]; -end; - -function containsGarbageCollectedRef(typ: PType): Boolean; -// returns true if typ contains a reference, sequence or string (all the things -// that are garbage-collected) -begin - result := searchTypeFor(typ, isGBCRef); -end; - -function isHiddenPointer(t: PType): bool; -begin - result := t.kind in [tyString, tySequence]; -end; - -function containsHiddenPointer(typ: PType): Boolean; -// returns true if typ contains a string, table or sequence (all the things -// that need to be copied deeply) -begin - result := searchTypeFor(typ, isHiddenPointer); -end; - -function canFormAcycleAux(var marker: TIntSet; typ: PType; - startId: int): bool; forward; - -function canFormAcycleNode(var marker: TIntSet; n: PNode; startId: int): bool; -var - i: int; -begin - result := false; - if n <> nil then begin - result := canFormAcycleAux(marker, n.typ, startId); - if not result then - case n.kind of - nkNone..nkNilLit: begin end; - else begin - for i := 0 to sonsLen(n)-1 do begin - result := canFormAcycleNode(marker, n.sons[i], startId); - if result then exit - end - end - end - end -end; - -function canFormAcycleAux(var marker: TIntSet; typ: PType; startId: int): bool; -var - i: int; - t: PType; -begin - result := false; - if typ = nil then exit; - if tfAcyclic in typ.flags then exit; - t := skipTypes(typ, abstractInst); - if tfAcyclic in t.flags then exit; - case t.kind of - tyTuple, tyObject, tyRef, tySequence, tyArray, tyArrayConstr, - tyOpenArray: begin - if not IntSetContainsOrIncl(marker, t.id) then begin - for i := 0 to sonsLen(t)-1 do begin - result := canFormAcycleAux(marker, t.sons[i], startId); - if result then exit - end; - if t.n <> nil then result := canFormAcycleNode(marker, t.n, startId) - end - else - result := t.id = startId; - end - else begin end - end -end; - -function canFormAcycle(typ: PType): boolean; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := canFormAcycleAux(marker, typ, typ.id); -end; - -function mutateTypeAux(var marker: TIntSet; t: PType; iter: TTypeMutator; - closure: PObject): PType; forward; - -function mutateNode(var marker: TIntSet; n: PNode; iter: TTypeMutator; - closure: PObject): PNode; -var - i: int; -begin - result := nil; - if n <> nil then begin - result := copyNode(n); - result.typ := mutateTypeAux(marker, n.typ, iter, closure); - case n.kind of - nkNone..nkNilLit: begin // a leaf - end; - else begin - for i := 0 to sonsLen(n)-1 do - addSon(result, mutateNode(marker, n.sons[i], iter, closure)); - end - end - end -end; - -function mutateTypeAux(var marker: TIntSet; t: PType; iter: TTypeMutator; - closure: PObject): PType; -var - i: int; -begin - result := nil; - if t = nil then exit; - result := iter(t, closure); - if not IntSetContainsOrIncl(marker, t.id) then begin - for i := 0 to sonsLen(t)-1 do begin - result.sons[i] := mutateTypeAux(marker, result.sons[i], iter, closure); - if (result.sons[i] = nil) and (result.kind = tyGenericInst) then - assert(false); - end; - if t.n <> nil then - result.n := mutateNode(marker, t.n, iter, closure) - end; - assert(result <> nil); -end; - -function mutateType(t: PType; iter: TTypeMutator; closure: PObject): PType; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := mutateTypeAux(marker, t, iter, closure); -end; - -function rangeToStr(n: PNode): string; -begin - assert(n.kind = nkRange); - result := ValueToString(n.sons[0]) + '..' +{&} ValueToString(n.sons[1]) -end; - -function TypeToString(typ: PType; prefer: TPreferedDesc = preferName): string; -const - typeToStr: array [TTypeKind] of string = ( - 'None', 'bool', 'Char', 'empty', 'Array Constructor [$1]', 'nil', 'expr', - 'stmt', 'typeDesc', - 'GenericInvokation', - 'GenericBody', 'GenericInst', 'GenericParam', 'distinct $1', - 'enum', 'ordinal[$1]', - 'array[$1, $2]', 'object', 'tuple', 'set[$1]', 'range[$1]', - 'ptr ', 'ref ', 'var ', 'seq[$1]', 'proc', 'pointer', - 'OpenArray[$1]', 'string', 'CString', 'Forward', - 'int', 'int8', 'int16', 'int32', 'int64', - 'float', 'float32', 'float64', 'float128' - ); -var - t: PType; - i: int; - prag: string; -begin - t := typ; - result := ''; - if t = nil then exit; - if (prefer = preferName) and (t.sym <> nil) then begin - result := t.sym.Name.s; - exit - end; - case t.Kind of - tyGenericInst: - result := typeToString(lastSon(t), prefer); - tyArray: begin - if t.sons[0].kind = tyRange then - result := 'array[' +{&} rangeToStr(t.sons[0].n) +{&} ', ' - +{&} typeToString(t.sons[1]) +{&} ']' - else - result := 'array[' +{&} typeToString(t.sons[0]) +{&} ', ' - +{&} typeToString(t.sons[1]) +{&} ']' - end; - tyGenericInvokation, tyGenericBody: begin - result := typeToString(t.sons[0]) + '['; - for i := 1 to sonsLen(t)-1 do begin - if i > 1 then add(result, ', '); - add(result, typeToString(t.sons[i])); - end; - addChar(result, ']'); - end; - tyArrayConstr: - result := 'Array constructor[' +{&} rangeToStr(t.sons[0].n) +{&} ', ' - +{&} typeToString(t.sons[1]) +{&} ']'; - tySequence: result := 'seq[' +{&} typeToString(t.sons[0]) +{&} ']'; - tyOrdinal: result := 'ordinal[' +{&} typeToString(t.sons[0]) +{&} ']'; - tySet: result := 'set[' +{&} typeToString(t.sons[0]) +{&} ']'; - tyOpenArray: result := 'openarray[' +{&} typeToString(t.sons[0]) +{&} ']'; - tyDistinct: result := 'distinct ' +{&} typeToString(t.sons[0], preferName); - tyTuple: begin - // we iterate over t.sons here, because t.n may be nil - result := 'tuple['; - if t.n <> nil then begin - assert(sonsLen(t.n) = sonsLen(t)); - for i := 0 to sonsLen(t.n)-1 do begin - assert(t.n.sons[i].kind = nkSym); - add(result, t.n.sons[i].sym.name.s +{&} ': ' - +{&} typeToString(t.sons[i])); - if i < sonsLen(t.n)-1 then add(result, ', '); - end - end - else begin - for i := 0 to sonsLen(t)-1 do begin - add(result, typeToString(t.sons[i])); - if i < sonsLen(t)-1 then add(result, ', '); - end - end; - addChar(result, ']') - end; - tyPtr, tyRef, tyVar: - result := typeToStr[t.kind] +{&} typeToString(t.sons[0]); - tyRange: begin - result := 'range ' +{&} rangeToStr(t.n); - end; - tyProc: begin - result := 'proc ('; - for i := 1 to sonsLen(t)-1 do begin - add(result, typeToString(t.sons[i])); - if i < sonsLen(t)-1 then add(result, ', '); - end; - addChar(result, ')'); - if t.sons[0] <> nil then - add(result, ': ' +{&} TypeToString(t.sons[0])); - if t.callConv <> ccDefault then prag := CallingConvToStr[t.callConv] - else prag := ''; - if tfNoSideEffect in t.flags then begin - addSep(prag); - add(prag, 'noSideEffect') - end; - if length(prag) <> 0 then add(result, '{.' +{&} prag +{&} '.}'); - end; - else begin - result := typeToStr[t.kind] - end - end -end; - -function resultType(t: PType): PType; -begin - assert(t.kind = tyProc); - result := t.sons[0] // nil is allowed -end; - -function base(t: PType): PType; -begin - result := t.sons[0] -end; - -function firstOrd(t: PType): biggestInt; -begin - case t.kind of - tyBool, tyChar, tySequence, tyOpenArray: result := 0; - tySet, tyVar: result := firstOrd(t.sons[0]); - tyArray, tyArrayConstr: begin - result := firstOrd(t.sons[0]); - end; - tyRange: begin - assert(t.n <> nil); - // range directly given: - assert(t.n.kind = nkRange); - result := getOrdValue(t.n.sons[0]) - end; - tyInt: begin - if platform.intSize = 4 then result := -(2147483646) - 2 - else result := $8000000000000000; - end; - tyInt8: result := -128; - tyInt16: result := -32768; - tyInt32: result := -2147483646 - 2; - tyInt64: result := $8000000000000000; - tyEnum: begin - // if basetype <> nil then return firstOrd of basetype - if (sonsLen(t) > 0) and (t.sons[0] <> nil) then - result := firstOrd(t.sons[0]) - else begin - assert(t.n.sons[0].kind = nkSym); - result := t.n.sons[0].sym.position; - end; - end; - tyGenericInst, tyDistinct: result := firstOrd(lastSon(t)); - else begin - InternalError('invalid kind for first(' +{&} - typeKindToStr[t.kind] +{&} ')'); - result := 0; - end - end -end; - -function lastOrd(t: PType): biggestInt; -begin - case t.kind of - tyBool: result := 1; - tyChar: result := 255; - tySet, tyVar: result := lastOrd(t.sons[0]); - tyArray, tyArrayConstr: begin - result := lastOrd(t.sons[0]); - end; - tyRange: begin - assert(t.n <> nil); - // range directly given: - assert(t.n.kind = nkRange); - result := getOrdValue(t.n.sons[1]); - end; - tyInt: begin - if platform.intSize = 4 then result := $7FFFFFFF - else result := $7FFFFFFFFFFFFFFF; - end; - tyInt8: result := $7F; - tyInt16: result := $7FFF; - tyInt32: result := $7FFFFFFF; - tyInt64: result := $7FFFFFFFFFFFFFFF; - tyEnum: begin - assert(t.n.sons[sonsLen(t.n)-1].kind = nkSym); - result := t.n.sons[sonsLen(t.n)-1].sym.position; - end; - tyGenericInst, tyDistinct: result := firstOrd(lastSon(t)); - else begin - InternalError('invalid kind for last(' +{&} - typeKindToStr[t.kind] +{&} ')'); - result := 0; - end - end -end; - -function lengthOrd(t: PType): biggestInt; -begin - case t.kind of - tyInt64, tyInt32, tyInt: result := lastOrd(t); - tyDistinct: result := lengthOrd(t.sons[0]); - else result := lastOrd(t) - firstOrd(t) + 1; - end -end; - -function equalParam(a, b: PSym): TParamsEquality; -begin - if SameTypeOrNil(a.typ, b.typ) then begin - if (a.ast = b.ast) then - result := paramsEqual - else if (a.ast <> nil) and (b.ast <> nil) then begin - if ExprStructuralEquivalent(a.ast, b.ast) then result := paramsEqual - else result := paramsIncompatible - end - else if (a.ast <> nil) then - result := paramsEqual - else if (b.ast <> nil) then - result := paramsIncompatible - end - else - result := paramsNotEqual -end; - -function equalParams(a, b: PNode): TParamsEquality; -var - i, len: int; - m, n: PSym; -begin - result := paramsEqual; - len := sonsLen(a); - if len <> sonsLen(b) then - result := paramsNotEqual - else begin - for i := 1 to len-1 do begin - m := a.sons[i].sym; - n := b.sons[i].sym; - assert((m.kind = skParam) and (n.kind = skParam)); - case equalParam(m, n) of - paramsNotEqual: begin result := paramsNotEqual; exit end; - paramsEqual: begin end; - paramsIncompatible: result := paramsIncompatible; - end; - if (m.name.id <> n.name.id) then begin // BUGFIX - result := paramsNotEqual; exit // paramsIncompatible; - // continue traversal! If not equal, we can return immediately; else - // it stays incompatible - end - end; - // check their return type: - if not SameTypeOrNil(a.sons[0].typ, b.sons[0].typ) then - if (a.sons[0].typ = nil) or (b.sons[0].typ = nil) then - result := paramsNotEqual // one proc has a result, the other not is OK - else - result := paramsIncompatible // overloading by different - // result types does not work - end -end; - -function SameTypeOrNil(a, b: PType): Boolean; -begin - if a = b then - result := true - else begin - if (a = nil) or (b = nil) then result := false - else result := SameType(a, b) - end -end; - -function SameLiteral(x, y: PNode): Boolean; -begin - result := false; - if x.kind = y.kind then - case x.kind of - nkCharLit..nkInt64Lit: - result := x.intVal = y.intVal; - nkFloatLit..nkFloat64Lit: - result := x.floatVal = y.floatVal; - nkNilLit: - result := true - else assert(false); - end -end; - -function SameRanges(a, b: PNode): Boolean; -begin - result := SameLiteral(a.sons[0], b.sons[0]) and - SameLiteral(a.sons[1], b.sons[1]) -end; - -function sameTuple(a, b: PType; DistinctOf: bool): boolean; -// two tuples are equivalent iff the names, types and positions are the same; -// however, both types may not have any field names (t.n may be nil) which -// complicates the matter a bit. -var - i: int; - x, y: PSym; -begin - if sonsLen(a) = sonsLen(b) then begin - result := true; - for i := 0 to sonsLen(a)-1 do begin - if DistinctOf then - result := equalOrDistinctOf(a.sons[i], b.sons[i]) - else - result := SameType(a.sons[i], b.sons[i]); - if not result then exit - end; - if (a.n <> nil) and (b.n <> nil) then begin - for i := 0 to sonsLen(a.n)-1 do begin - // check field names: - if a.n.sons[i].kind <> nkSym then InternalError(a.n.info, 'sameTuple'); - if b.n.sons[i].kind <> nkSym then InternalError(b.n.info, 'sameTuple'); - x := a.n.sons[i].sym; - y := b.n.sons[i].sym; - result := x.name.id = y.name.id; - if not result then break - end - end - end - else - result := false; -end; - -function SameType(x, y: PType): Boolean; -var - i: int; - a, b: PType; -begin - if x = y then begin result := true; exit end; - a := skipTypes(x, {@set}[tyGenericInst]); - b := skipTypes(y, {@set}[tyGenericInst]); - assert(a <> nil); - assert(b <> nil); - if a.kind <> b.kind then begin result := false; exit end; - case a.Kind of - tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyExpr, tyStmt, tyTypeDesc: - result := true; - tyEnum, tyForward, tyObject, tyDistinct: - result := (a.id = b.id); - tyTuple: - result := sameTuple(a, b, false); - tyGenericInst: - result := sameType(lastSon(a), lastSon(b)); - tyGenericParam, tyGenericInvokation, tyGenericBody, tySequence, tyOrdinal, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, - tyArray, tyProc: begin - if sonsLen(a) = sonsLen(b) then begin - result := true; - for i := 0 to sonsLen(a)-1 do begin - result := SameTypeOrNil(a.sons[i], b.sons[i]); // BUGFIX - if not result then exit - end; - if result and (a.kind = tyProc) then - result := a.callConv = b.callConv // BUGFIX - end - else - result := false; - end; - tyRange: begin - result := SameTypeOrNil(a.sons[0], b.sons[0]) - and SameValue(a.n.sons[0], b.n.sons[0]) - and SameValue(a.n.sons[1], b.n.sons[1]) - end; - tyNone: result := false; - end -end; - -function equalOrDistinctOf(x, y: PType): bool; -var - i: int; - a, b: PType; -begin - if x = y then begin result := true; exit end; - if (x = nil) or (y = nil) then begin result := false; exit end; - a := skipTypes(x, {@set}[tyGenericInst]); - b := skipTypes(y, {@set}[tyGenericInst]); - assert(a <> nil); - assert(b <> nil); - if a.kind <> b.kind then begin - if a.kind = tyDistinct then a := a.sons[0]; - if a.kind <> b.kind then begin result := false; exit end - end; - case a.Kind of - tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyExpr, tyStmt, tyTypeDesc: - result := true; - tyEnum, tyForward, tyObject, tyDistinct: - result := (a.id = b.id); - tyTuple: - result := sameTuple(a, b, true); - tyGenericInst: - result := equalOrDistinctOf(lastSon(a), lastSon(b)); - tyGenericParam, tyGenericInvokation, tyGenericBody, tySequence, tyOrdinal, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, - tyArray, tyProc: begin - if sonsLen(a) = sonsLen(b) then begin - result := true; - for i := 0 to sonsLen(a)-1 do begin - result := equalOrDistinctOf(a.sons[i], b.sons[i]); - if not result then exit - end; - if result and (a.kind = tyProc) then - result := a.callConv = b.callConv - end - else - result := false; - end; - tyRange: begin - result := equalOrDistinctOf(a.sons[0], b.sons[0]) - and SameValue(a.n.sons[0], b.n.sons[0]) - and SameValue(a.n.sons[1], b.n.sons[1]) - end; - tyNone: result := false; - end -end; - -function typeAllowedAux(var marker: TIntSet; typ: PType; - kind: TSymKind): bool; forward; - -function typeAllowedNode(var marker: TIntSet; n: PNode; kind: TSymKind): bool; -var - i: int; -begin - result := true; - if n <> nil then begin - result := typeAllowedAux(marker, n.typ, kind); - if not result then debug(n.typ); - if result then - case n.kind of - nkNone..nkNilLit: begin end; - else begin - for i := 0 to sonsLen(n)-1 do begin - result := typeAllowedNode(marker, n.sons[i], kind); - if not result then exit - end - end - end - end -end; - -function typeAllowedAux(var marker: TIntSet; typ: PType; kind: TSymKind): bool; -var - i: int; - t, t2: PType; -begin - assert(kind in [skVar, skConst, skParam]); - result := true; - if typ = nil then exit; - // if we have already checked the type, return true, because we stop the - // evaluation if something is wrong: - if IntSetContainsOrIncl(marker, typ.id) then exit; - t := skipTypes(typ, abstractInst); - case t.kind of - tyVar: begin - t2 := skipTypes(t.sons[0], abstractInst); - case t2.kind of - tyVar: result := false; // ``var var`` is always an invalid type: - tyOpenArray: result := (kind = skParam) and - typeAllowedAux(marker, t2, kind); - else result := (kind <> skConst) and - typeAllowedAux(marker, t2, kind); - end - end; - tyProc: begin - for i := 1 to sonsLen(t)-1 do begin - result := typeAllowedAux(marker, t.sons[i], skParam); - if not result then exit; - end; - if t.sons[0] <> nil then - result := typeAllowedAux(marker, t.sons[0], skVar) - end; - tyExpr, tyStmt, tyTypeDesc: result := true; - tyGenericBody, tyGenericParam, tyForward, tyNone, tyGenericInvokation: begin - result := false; - //InternalError('shit found'); - end; - tyEmpty, tyNil: result := kind = skConst; - tyString, tyBool, tyChar, tyEnum, tyInt..tyFloat128, tyCString, tyPointer: - result := true; - tyOrdinal: result := kind = skParam; - tyGenericInst, tyDistinct: - result := typeAllowedAux(marker, lastSon(t), kind); - tyRange: - result := skipTypes(t.sons[0], abstractInst).kind in - [tyChar, tyEnum, tyInt..tyFloat128]; - tyOpenArray: - result := (kind = skParam) and typeAllowedAux(marker, t.sons[0], skVar); - tySequence: result := (kind <> skConst) - and typeAllowedAux(marker, t.sons[0], skVar) - or (t.sons[0].kind = tyEmpty); - tyArray: result := typeAllowedAux(marker, t.sons[1], skVar); - tyPtr, tyRef: result := typeAllowedAux(marker, t.sons[0], skVar); - tyArrayConstr, tyTuple, tySet: begin - for i := 0 to sonsLen(t)-1 do begin - result := typeAllowedAux(marker, t.sons[i], kind); - if not result then exit - end; - end; - tyObject: begin - for i := 0 to sonsLen(t)-1 do begin - result := typeAllowedAux(marker, t.sons[i], skVar); - if not result then exit - end; - if t.n <> nil then result := typeAllowedNode(marker, t.n, skVar); - end; - end -end; - -function typeAllowed(t: PType; kind: TSymKind): bool; -var - marker: TIntSet; -begin - IntSetInit(marker); - result := typeAllowedAux(marker, t, kind); -end; - -function align(address, alignment: biggestInt): biggestInt; -begin - result := (address + (alignment-1)) and not (alignment-1); -end; - -// we compute the size of types lazily: -function computeSizeAux(typ: PType; var a: biggestInt): biggestInt; forward; - -function computeRecSizeAux(n: PNode; var a, currOffset: biggestInt): biggestInt; -var - maxAlign, maxSize, b, res: biggestInt; - i: int; -begin - case n.kind of - nkRecCase: begin - assert(n.sons[0].kind = nkSym); - result := computeRecSizeAux(n.sons[0], a, currOffset); - maxSize := 0; - maxAlign := 1; - for i := 1 to sonsLen(n)-1 do begin - case n.sons[i].kind of - nkOfBranch, nkElse: begin - res := computeRecSizeAux(lastSon(n.sons[i]), b, currOffset); - if res < 0 then begin result := res; exit end; - maxSize := max(maxSize, res); - maxAlign := max(maxAlign, b); - end; - else internalError('computeRecSizeAux(record case branch)'); - end - end; - currOffset := align(currOffset, maxAlign) + maxSize; - result := align(result, maxAlign) + maxSize; - a := maxAlign; - end; - nkRecList: begin - result := 0; - maxAlign := 1; - for i := 0 to sonsLen(n)-1 do begin - res := computeRecSizeAux(n.sons[i], b, currOffset); - if res < 0 then begin result := res; exit end; - currOffset := align(currOffset, b) + res; - result := align(result, b) + res; - if b > maxAlign then maxAlign := b; - end; - //result := align(result, maxAlign); - // XXX: check GCC alignment for this! - a := maxAlign; - end; - nkSym: begin - result := computeSizeAux(n.sym.typ, a); - n.sym.offset := int(currOffset); - end; - else begin - InternalError('computeRecSizeAux()'); - a := 1; result := -1 - end - end -end; - -function computeSizeAux(typ: PType; var a: biggestInt): biggestInt; -var - i: int; - res, maxAlign, len, currOffset: biggestInt; -begin - if typ.size = -2 then begin - // we are already computing the size of the type - // --> illegal recursion in type - result := -2; - exit - end; - if typ.size >= 0 then begin // size already computed - result := typ.size; - a := typ.align; - exit - end; - typ.size := -2; // mark as being computed - case typ.kind of - tyInt: begin result := IntSize; a := result; end; - tyInt8, tyBool, tyChar: begin result := 1; a := result; end; - tyInt16: begin result := 2; a := result; end; - tyInt32, tyFloat32: begin result := 4; a := result; end; - tyInt64, tyFloat64: begin result := 8; a := result; end; - tyFloat: begin result := floatSize; a := result; end; - tyProc: begin - if typ.callConv = ccClosure then result := 2 * ptrSize - else result := ptrSize; - a := ptrSize; - end; - tyNil, tyCString, tyString, tySequence, tyPtr, tyRef, - tyOpenArray: begin result := ptrSize; a := result; end; - tyArray, tyArrayConstr: begin - result := lengthOrd(typ.sons[0]) * computeSizeAux(typ.sons[1], a); - end; - tyEnum: begin - if firstOrd(typ) < 0 then - result := 4 // use signed int32 - else begin - len := lastOrd(typ); // BUGFIX: use lastOrd! - if len+1 < shlu(1, 8) then result := 1 - else if len+1 < shlu(1, 16) then result := 2 - else if len+1 < shlu(biggestInt(1), 32) then result := 4 - else result := 8; - end; - a := result; - end; - tySet: begin - len := lengthOrd(typ.sons[0]); - if len <= 8 then result := 1 - else if len <= 16 then result := 2 - else if len <= 32 then result := 4 - else if len <= 64 then result := 8 - else if align(len, 8) mod 8 = 0 then result := align(len, 8) div 8 - else result := align(len, 8) div 8 + 1; // BUGFIX! - a := result; - end; - tyRange: result := computeSizeAux(typ.sons[0], a); - tyTuple: begin - result := 0; - maxAlign := 1; - for i := 0 to sonsLen(typ)-1 do begin - res := computeSizeAux(typ.sons[i], a); - if res < 0 then begin result := res; exit end; - maxAlign := max(maxAlign, a); - result := align(result, a) + res; - end; - result := align(result, maxAlign); - a := maxAlign; - end; - tyObject: begin - if typ.sons[0] <> nil then begin - result := computeSizeAux(typ.sons[0], a); - if result < 0 then exit; - maxAlign := a - end - else if isObjectWithTypeFieldPredicate(typ) then begin - result := intSize; maxAlign := result; - end - else begin - result := 0; maxAlign := 1 - end; - currOffset := result; - result := computeRecSizeAux(typ.n, a, currOffset); - if result < 0 then exit; - if a < maxAlign then a := maxAlign; - result := align(result, a); - end; - tyGenericInst, tyDistinct, tyGenericBody: begin - result := computeSizeAux(lastSon(typ), a); - end; - else begin - //internalError('computeSizeAux()'); - result := -1; - end - end; - typ.size := result; - typ.align := int(a); -end; - -function computeSize(typ: PType): biggestInt; -var - a: biggestInt; -begin - a := 1; - result := computeSizeAux(typ, a); -end; - -function getSize(typ: PType): biggestInt; -begin - result := computeSize(typ); - if result < 0 then - InternalError('getSize(' +{&} typekindToStr[typ.kind] +{&} ')'); -end; - -end. diff --git a/nim/wordrecg.pas b/nim/wordrecg.pas deleted file mode 100755 index c189698772..0000000000 --- a/nim/wordrecg.pas +++ /dev/null @@ -1,220 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2009 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit wordrecg; - -// This module contains a word recognizer, i.e. a simple -// procedure which maps special words to an enumeration. -// It is primarily needed because Pascal's case statement -// does not support strings. Without this the code would -// be slow and unreadable. - -interface - -{$include 'config.inc'} - -uses - nsystem, nhashes, strutils, idents; - -type - TSpecialWord = (wInvalid, - // these are mapped to Nimrod keywords: - //[[[cog - //from string import split, capitalize - //keywords = split(open("data/keywords.txt").read()) - //idents = "" - //strings = "" - //i = 1 - //for k in keywords: - // idents = idents + "w" + capitalize(k) + ", " - // strings = strings + "'" + k + "', " - // if i % 4 == 0: - // idents = idents + "\n" - // strings = strings + "\n" - // i = i + 1 - //cog.out(idents) - //]]] - wAddr, wAnd, wAs, wAsm, - wBind, wBlock, wBreak, wCase, - wCast, wConst, wContinue, wConverter, - wDiscard, wDistinct, wDiv, wElif, - wElse, wEnd, wEnum, wExcept, - wFinally, wFor, wFrom, wGeneric, - wIf, wImplies, wImport, wIn, - wInclude, wIs, wIsnot, wIterator, - wLambda, wMacro, wMethod, wMod, - wNil, wNot, wNotin, wObject, - wOf, wOr, wOut, wProc, - wPtr, wRaise, wRef, wReturn, - wShl, wShr, wTemplate, wTry, - wTuple, wType, wVar, wWhen, - wWhile, wWith, wWithout, wXor, - wYield, - //[[[end]]] - // other special tokens: - wColon, wEquals, wDot, wDotDot, wHat, - wStar, wMinus, - // pragmas and command line options: - wMagic, wTypeCheck, wFinal, wProfiler, - wObjChecks, wImportc, wExportc, wAlign, wNodecl, wPure, - wVolatile, wRegister, wSideeffect, wHeader, wNosideeffect, wNoreturn, - wMerge, wLib, wDynlib, wCompilerproc, wProcVar, wFatal, - wError, wWarning, wHint, wLine, wPush, wPop, - wDefine, wUndef, wLinedir, wStacktrace, wLinetrace, wParallelBuild, - wLink, wCompile, wLinksys, wDeprecated, wVarargs, - wByref, wCallconv, wBreakpoint, wDebugger, wNimcall, wStdcall, - wCdecl, wSafecall, wSyscall, wInline, wNoInline, wFastcall, wClosure, - wNoconv, wOn, wOff, wChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wW, wHints, - wOptimization, wSpeed, wSize, wNone, wPath, wP, - wD, wU, wDebuginfo, wCompileonly, wNolinking, wForcebuild, - wF, wDeadCodeElim, wSafecode, wCompileTime, - wGc, wRefc, wBoehm, wA, wOpt, wO, - wApp, wConsole, wGui, wPassc, wT, wPassl, - wL, wListcmd, wGendoc, wGenmapping, - wOs, wCpu, wGenerate, wG, wC, wCpp, - wBorrow, wRun, wR, wVerbosity, wV, wHelp, - wH, wSymbolFiles, wFieldChecks, wX, wVersion, wAdvanced, - wSkipcfg, wSkipProjCfg, wCc, wGenscript, wCheckPoint, wCheckPoints, - wNoMain, - wSubsChar, wAcyclic, wIndex, - // commands: - wCompileToC, wCompileToCpp, wCompileToEcmaScript, wCompileToLLVM, - wPretty, wDoc, wPas, - wGenDepend, wListDef, wCheck, wParse, wScan, wBoot, wLazy, - wRst2html, wRst2tex, wI, - // special for the preprocessor of configuration files: - wWrite, wPutEnv, wPrependEnv, wAppendEnv, - // additional Pascal keywords: - wArray, wBegin, wClass, - wConstructor, wDestructor, wDo, wDownto, - wExports, wFinalization, wFunction, wGoto, - wImplementation, wInherited, wInitialization, wInterface, - wLabel, wLibrary, wPacked, - wProcedure, wProgram, wProperty, wRecord, wRepeat, wResourcestring, - wSet, wThen, wThreadvar, wTo, wUnit, wUntil, - wUses, - // Pascal special tokens: - wExternal, wOverload, wFar, wAssembler, wForward, wIfdef, wIfndef, - wEndif - ); - TSpecialWords = set of TSpecialWord; -const - oprLow = ord(wColon); - oprHigh = ord(wHat); - specialWords: array [low(TSpecialWord)..high(TSpecialWord)] of string = ('', - // keywords: - //[[[cog - //cog.out(strings) - //]]] - 'addr', 'and', 'as', 'asm', - 'bind', 'block', 'break', 'case', - 'cast', 'const', 'continue', 'converter', - 'discard', 'distinct', 'div', 'elif', - 'else', 'end', 'enum', 'except', - 'finally', 'for', 'from', 'generic', - 'if', 'implies', 'import', 'in', - 'include', 'is', 'isnot', 'iterator', - 'lambda', 'macro', 'method', 'mod', - 'nil', 'not', 'notin', 'object', - 'of', 'or', 'out', 'proc', - 'ptr', 'raise', 'ref', 'return', - 'shl', 'shr', 'template', 'try', - 'tuple', 'type', 'var', 'when', - 'while', 'with', 'without', 'xor', - 'yield', - //[[[end]]] - // other special tokens: - ':'+'', '='+'', '.'+'', '..', '^'+'', - '*'+'', '-'+'', - // pragmas and command line options: - 'magic', 'typecheck', 'final', 'profiler', - 'objchecks', 'importc', 'exportc', 'align', 'nodecl', 'pure', - 'volatile', 'register', 'sideeffect', 'header', 'nosideeffect', 'noreturn', - 'merge', 'lib', 'dynlib', 'compilerproc', 'procvar', 'fatal', - 'error', 'warning', 'hint', 'line', 'push', 'pop', - 'define', 'undef', 'linedir', 'stacktrace', 'linetrace', 'parallelbuild', - 'link', 'compile', 'linksys', 'deprecated', 'varargs', - 'byref', 'callconv', 'breakpoint', 'debugger', 'nimcall', 'stdcall', - 'cdecl', 'safecall', 'syscall', 'inline', 'noinline', 'fastcall', 'closure', - 'noconv', 'on', 'off', 'checks', 'rangechecks', 'boundchecks', - 'overflowchecks', 'nilchecks', 'assertions', 'warnings', 'w'+'', 'hints', - 'optimization', 'speed', 'size', 'none', 'path', 'p'+'', - 'd'+'', 'u'+'', 'debuginfo', 'compileonly', 'nolinking', 'forcebuild', - 'f'+'', 'deadcodeelim', 'safecode', 'compiletime', - 'gc', 'refc', 'boehm', 'a'+'', 'opt', 'o'+'', - 'app', 'console', 'gui', 'passc', 't'+'', 'passl', - 'l'+'', 'listcmd', 'gendoc', 'genmapping', - 'os', 'cpu', 'generate', 'g'+'', 'c'+'', 'cpp', - 'borrow', 'run', 'r'+'', 'verbosity', 'v'+'', 'help', - 'h'+'', 'symbolfiles', 'fieldchecks', 'x'+'', 'version', 'advanced', - 'skipcfg', 'skipprojcfg', 'cc', 'genscript', 'checkpoint', 'checkpoints', - 'nomain', - 'subschar', 'acyclic', 'index', - // commands: - 'compiletoc', 'compiletocpp', 'compiletoecmascript', 'compiletollvm', - 'pretty', 'doc', 'pas', 'gendepend', 'listdef', 'check', 'parse', - 'scan', 'boot', 'lazy', 'rst2html', 'rst2tex', 'i'+'', - - // special for the preprocessor of configuration files: - 'write', 'putenv', 'prependenv', 'appendenv', - - 'array', 'begin', 'class', - 'constructor', 'destructor', 'do', 'downto', - 'exports', 'finalization', 'function', 'goto', - 'implementation', 'inherited', 'initialization', 'interface', - 'label', 'library', 'packed', - 'procedure', 'program', 'property', 'record', 'repeat', 'resourcestring', - 'set', 'then', 'threadvar', 'to', 'unit', 'until', - 'uses', - - // Pascal special tokens - 'external', 'overload', 'far', 'assembler', 'forward', 'ifdef', 'ifndef', - 'endif' - ); - -function whichKeyword(id: PIdent): TSpecialWord; overload; -function whichKeyword(const id: String): TSpecialWord; overload; - -function findStr(const a: array of string; const s: string): int; - -implementation - -function findStr(const a: array of string; const s: string): int; -var - i: int; -begin - for i := low(a) to high(a) do - if cmpIgnoreStyle(a[i], s) = 0 then begin result := i; exit end; - result := -1; -end; - -function whichKeyword(const id: String): TSpecialWord; overload; -begin - result := whichKeyword(getIdent(id)) -end; - -function whichKeyword(id: PIdent): TSpecialWord; overload; -begin - if id.id < 0 then result := wInvalid - else result := TSpecialWord(id.id); -end; - -procedure initSpecials(); -var - s: TSpecialWord; -begin - // initialize the keywords: - for s := succ(low(specialWords)) to high(specialWords) do - getIdent(specialWords[s], - getNormalizedHash(specialWords[s])).id := ord(s) -end; - -initialization - initSpecials(); -end. diff --git a/nimlib/copying.txt b/nimlib/copying.txt deleted file mode 100755 index be182d65ca..0000000000 --- a/nimlib/copying.txt +++ /dev/null @@ -1,29 +0,0 @@ -======================================================= - The Nimrod Runtime Library - Copyright (C) 2004-2009 Andreas Rumpf -======================================================= - -This is the file copying.txt, it applies to the Nimrod Run-Time Library -(lib) and base packages (base) distributed by members of the Nimrod -Development Team. - -The source code of the Nimrod Runtime Libraries and packages are -distributed under the Library GNU General Public License -(see the file lgpl.txt) 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 lgpl.txt, contact: - Free Software Foundation - 675 Mass Ave - Cambridge, MA 02139 - USA diff --git a/nimlib/lgpl.txt b/nimlib/lgpl.txt deleted file mode 100755 index f6fa6c9e58..0000000000 --- a/nimlib/lgpl.txt +++ /dev/null @@ -1,502 +0,0 @@ - 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. 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. - - - Copyright (C) - - 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. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! - - diff --git a/nimlib/nimbase.h b/nimlib/nimbase.h deleted file mode 100755 index a0f08f4f3c..0000000000 --- a/nimlib/nimbase.h +++ /dev/null @@ -1,425 +0,0 @@ -/* - - Nimrod's Runtime Library - (c) Copyright 2009 Andreas Rumpf - - See the file "copying.txt", included in this - distribution, for details about the copyright. -*/ - -/* compiler symbols: -__BORLANDC__ -_MSC_VER -__WATCOMC__ -__LCC__ -__GNUC__ -__DMC__ -__POCC__ -__TINYC__ -*/ - - -#ifndef NIMBASE_H -#define NIMBASE_H - -#include - -/* calling convention mess ----------------------------------------------- */ -#if defined(__GNUC__) || defined(__LCC__) || defined(__POCC__) \ - || defined(__TINYC__) - /* these should support C99's inline */ - /* the test for __POCC__ has to come before the test for _MSC_VER, - because PellesC defines _MSC_VER too. This is brain-dead. */ -# define N_INLINE(rettype, name) inline rettype name -#elif defined(__BORLANDC__) || defined(_MSC_VER) -/* Borland's compiler is really STRANGE here; note that the __fastcall - keyword cannot be before the return type, but __inline cannot be after - the return type, so we do not handle this mess in the code generator - but rather here. */ -# define N_INLINE(rettype, name) __inline rettype name -#elif defined(__DMC__) -# define N_INLINE(rettype, name) inline rettype name -#elif defined(__WATCOMC__) -# define N_INLINE(rettype, name) __inline rettype name -#else /* others are less picky: */ -# define N_INLINE(rettype, name) rettype __inline name -#endif - -#if defined(__POCC__) || defined(_MSC_VER) -# define HAVE_LRINT 1 -#endif - -#if defined(__POCC__) -# define NIM_CONST /* PCC is really picky with const modifiers */ -# undef _MSC_VER /* Yeah, right PCC defines _MSC_VER even if it is - not that compatible. Well done. */ -#elif defined(__cplusplus) -# define NIM_CONST /* C++ is picky with const modifiers */ -#else -# define NIM_CONST const -#endif - -#define NIM_THREADVAR __thread - -/* --------------- how int64 constants should be declared: ----------- */ -#if defined(__GNUC__) || defined(__LCC__) || \ - defined(__POCC__) || defined(__DMC__) -# define IL64(x) x##LL -#else /* works only without LL */ -# define IL64(x) x -#endif - -/* ---------------- casting without correct aliasing rules ----------- */ - -#if defined(__GNUCC__) -# define NIM_CAST(type, ptr) (((union{type __x__;}*)(ptr))->__x__) -#else -# define NIM_CAST(type, ptr) ((type)(ptr)) -#endif - -/* ------------------------------------------------------------------- */ - -#if defined(WIN32) || defined(_WIN32) /* only Windows has this mess... */ -# define N_CDECL(rettype, name) rettype __cdecl name -# define N_STDCALL(rettype, name) rettype __stdcall name -# define N_SYSCALL(rettype, name) rettype __syscall name -# define N_FASTCALL(rettype, name) rettype __fastcall name -# define N_SAFECALL(rettype, name) rettype __safecall name -/* function pointers with calling convention: */ -# define N_CDECL_PTR(rettype, name) rettype (__cdecl *name) -# define N_STDCALL_PTR(rettype, name) rettype (__stdcall *name) -# define N_SYSCALL_PTR(rettype, name) rettype (__syscall *name) -# define N_FASTCALL_PTR(rettype, name) rettype (__fastcall *name) -# define N_SAFECALL_PTR(rettype, name) rettype (__safecall *name) - -# define N_LIB_EXPORT extern __declspec(dllexport) -# define N_LIB_IMPORT extern __declspec(dllimport) -#else -# define N_CDECL(rettype, name) rettype name -# define N_STDCALL(rettype, name) rettype name -# define N_SYSCALL(rettype, name) rettype name -# define N_FASTCALL(rettype, name) rettype name -# define N_SAFECALL(rettype, name) rettype name -/* function pointers with calling convention: */ -# define N_CDECL_PTR(rettype, name) rettype (*name) -# define N_STDCALL_PTR(rettype, name) rettype (*name) -# define N_SYSCALL_PTR(rettype, name) rettype (*name) -# define N_FASTCALL_PTR(rettype, name) rettype (*name) -# define N_SAFECALL_PTR(rettype, name) rettype (*name) - -# define N_LIB_EXPORT extern -# define N_LIB_IMPORT extern -#endif - -#define N_NOCONV(rettype, name) rettype name -/* specify no calling convention */ -#define N_NOCONV_PTR(rettype, name) rettype (*name) - -#define N_CLOSURE(rettype, name) rettype name -/* specify no calling convention */ -#define N_CLOSURE_PTR(rettype, name) rettype (*name) - - -#if defined(__GNUC__) || defined(__ICC__) -# define N_NOINLINE(rettype, name) rettype __attribute__((noinline)) name -#elif defined(_MSC_VER) -# define N_NOINLINE(rettype, name) __declspec(noinline) rettype name -#else -# define N_NOINLINE(rettype, name) rettype name -#endif - -#define N_NOINLINE_PTR(rettype, name) rettype (*name) - -#if defined(__BORLANDC__) || defined(__WATCOMC__) || \ - defined(__POCC__) || defined(_MSC_VER) -/* these compilers have a fastcall so use it: */ -# define N_NIMCALL(rettype, name) rettype __fastcall name -# define N_NIMCALL_PTR(rettype, name) rettype (__fastcall *name) -#else -# define N_NIMCALL(rettype, name) rettype name /* no modifier */ -# define N_NIMCALL_PTR(rettype, name) rettype (*name) -#endif - -/* ----------------------------------------------------------------------- */ - -/* from float_cast.h: */ - -/* -** Copyright (C) 2001 Erik de Castro Lopo -** -** Permission to use, copy, modify, distribute, and sell this file for any -** purpose is hereby granted without fee, provided that the above copyright -** and this permission notice appear in all copies. No representations are -** made about the suitability of this software for any purpose. It is -** provided "as is" without express or implied warranty. -*/ - -/* Version 1.1 */ - - -/*============================================================================ -** On Intel Pentium processors (especially PIII and probably P4), converting -** from float to int is very slow. To meet the C specs, the code produced by -** most C compilers targeting Pentium needs to change the FPU rounding mode -** before the float to int conversion is performed. -** -** Changing the FPU rounding mode causes the FPU pipeline to be flushed. It -** is this flushing of the pipeline which is so slow. -** -** Fortunately the ISO C99 specifications define the functions lrint, lrintf, -** llrint and llrintf which fix this problem as a side effect. -** -** On Unix-like systems, the configure process should have detected the -** presence of these functions. If they weren't found we have to replace them -** here with a standard C cast. -*/ - -/* -** The C99 prototypes for lrint and lrintf are as follows: -** -** long int lrintf (float x); -** long int lrint (double x); -*/ - -#if defined(__LCC__) || (defined(__GNUC__) && defined(WIN32)) -/* Linux' GCC does not seem to have these. Why? */ -# define HAVE_LRINT -# define HAVE_LRINTF -#endif - -#if defined(HAVE_LRINT) && defined(HAVE_LRINTF) - -/* These defines enable functionality introduced with the 1999 ISO C -** standard. They must be defined before the inclusion of math.h to -** engage them. If optimisation is enabled, these functions will be -** inlined. With optimisation switched off, you have to link in the -** maths library using -lm. -*/ - -# define _ISOC9X_SOURCE 1 -# define _ISOC99_SOURCE 1 -# define __USE_ISOC9X 1 -# define __USE_ISOC99 1 - -#elif (defined(WIN32) || defined(_WIN32) || defined(__WIN32__)) \ - && !defined(__BORLANDC__) && !defined(__POCC__) - -/* Win32 doesn't seem to have these functions. -** Therefore implement inline versions of these functions here. -*/ -static N_INLINE(long int, lrint)(double flt) { - long int intgr; - _asm { - fld flt - fistp intgr - }; - return intgr; -} - -static N_INLINE(long int, lrintf)(float flt) { - long int intgr; - _asm { - fld flt - fistp intgr - }; - return intgr; -} - -#else - -# ifndef lrint -# define lrint(dbl) ((long int)(dbl)) -# endif -# ifndef lrintf -# define lrintf(flt) ((long int)(flt)) -# endif - -#endif /* defined(HAVE_LRINT) && defined(HAVE_LRINTF) */ - - -#include -#include -#include -#include -#include -#include -#include - -/* -#ifndef INF -static unsigned long nimInf[2]={0xffffffff, 0x7fffffff}; -# define INF (*(double*) nimInf) -#endif */ - -/* C99 compiler? */ -#if (defined(__STD_VERSION__) && (__STD_VERSION__ >= 199901)) -# define HAVE_STDINT_H -#endif - -#if defined(__LCC__) || defined(__DMC__) || defined(__POCC__) -# define HAVE_STDINT_H -#endif - -/* bool types (C++ has it): */ -#ifdef __cplusplus -# ifndef NIM_TRUE -# define NIM_TRUE true -# endif -# ifndef NIM_FALSE -# define NIM_FALSE false -# endif -# define NIM_BOOL bool -#else -# ifdef bool -# define NIM_BOOL bool -# else - typedef unsigned char NIM_BOOL; -# endif -# ifndef NIM_TRUE -# define NIM_TRUE ((NIM_BOOL) 1) -# endif -# ifndef NIM_FALSE -# define NIM_FALSE ((NIM_BOOL) 0) -# endif -#endif - -#define NIM_NIL ((void*)0) /* C's NULL is fucked up in some C compilers, so - the generated code does not rely on it anymore */ - -#if defined(__BORLANDC__) || defined(__DMC__) \ - || defined(__WATCOMC__) || defined(_MSC_VER) -typedef signed char NI8; -typedef signed short int NI16; -typedef signed int NI32; -/* XXX: Float128? */ -typedef unsigned char NU8; -typedef unsigned short int NU16; -typedef unsigned __int64 NU64; -typedef __int64 NI64; -typedef unsigned int NU32; -#elif defined(HAVE_STDINT_H) -# include -typedef int8_t NI8; -typedef int16_t NI16; -typedef int32_t NI32; -typedef int64_t NI64; -typedef uint64_t NU64; -typedef uint8_t NU8; -typedef uint16_t NU16; -typedef uint32_t NU32; -#else -typedef signed char NI8; -typedef signed short int NI16; -typedef signed int NI32; -/* XXX: Float128? */ -typedef unsigned char NU8; -typedef unsigned short int NU16; -typedef unsigned long long int NU64; -typedef long long int NI64; -typedef unsigned int NU32; -#endif - -typedef float NF32; -typedef double NF64; -typedef double NF; - -typedef char NIM_CHAR; -typedef char* NCSTRING; - -#ifdef NIM_BIG_ENDIAN -# define NIM_IMAN 1 -#else -# define NIM_IMAN 0 -#endif - -static N_INLINE(NI32, float64ToInt32)(double val) { - val = val + 68719476736.0*1.5; - /* 2^36 * 1.5, (52-_shiftamt=36) uses limited precisicion to floor */ - return ((NI32*)&val)[NIM_IMAN] >> 16; /* 16.16 fixed point representation */ -} - -static N_INLINE(NI32, float32ToInt32)(float val) { - return float64ToInt32((double)val); -} - -#define float64ToInt64(x) ((NI64) (x)) - -#define zeroMem(a, size) memset(a, 0, size) -#define equalMem(a, b, size) (memcmp(a, b, size) == 0) - -#define STRING_LITERAL(name, str, length) \ - static const struct { \ - TGenericSeq Sup; \ - NIM_CHAR data[length + 1]; \ - } name = {{length, length}, str} - -typedef struct TStringDesc* string; - -/* declared size of a sequence: */ -#if defined(__GNUC__) -# define SEQ_DECL_SIZE /* empty is correct! */ -#else -# define SEQ_DECL_SIZE 1000000 -#endif - -#define ALLOC_0(size) calloc(1, size) -#define DL_ALLOC_0(size) dlcalloc(1, size) - -#define GenericSeqSize sizeof(TGenericSeq) -#define paramCount() cmdCount - -#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__) || defined(__i386__) -# ifndef NAN -static unsigned long nimNaN[2]={0xffffffff, 0x7fffffff}; -# define NAN (*(double*) nimNaN) -# endif -#endif - -#ifndef NAN -# define NAN (0.0 / 0.0) -#endif - -#ifndef INF -# ifdef INFINITY -# define INF INFINITY -# elif defined(HUGE_VAL) -# define INF HUGE_VAL -# else -# define INF (1.0 / 0.0) -# endif -#endif -/* -typedef struct TSafePoint TSafePoint; -struct TSafePoint { - NI exc; - NCSTRING excname; - NCSTRING msg; - TSafePoint* prev; - jmp_buf context; -}; */ - -typedef struct TFrame TFrame; -struct TFrame { - TFrame* prev; - NCSTRING procname; - NI line; - NCSTRING filename; - NI len; -}; - -extern TFrame* framePtr; -/*extern TSafePoint* excHandler; */ - -#if defined(__cplusplus) -struct NimException { - TSafePoint sp; - - NimException(NI aExc, NCSTRING aExcname, NCSTRING aMsg) { - sp.exc = aExc; sp.excname = aExcname; sp.msg = aMsg; - sp.prev = excHandler; - excHandler = &sp; - } -}; -#endif - -#endif diff --git a/nimlib/posix/posix.nim b/nimlib/posix/posix.nim deleted file mode 100755 index ddeaec6642..0000000000 --- a/nimlib/posix/posix.nim +++ /dev/null @@ -1,2444 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Until std_arg!! -# done: ipc, pwd, stat, semaphore, sys/types, sys/utsname, pthread, unistd, -# statvfs, mman, time, wait, signal, nl_types, sched, spawn, select, ucontext, -# net/if, sys/socket, sys/uio, netinet/in, netinet/tcp, netdb - -## This is a raw POSIX interface module. It does not not provide any -## convenience: cstrings are used instead of proper Nimrod strings and -## return codes indicate errors. If you want exceptions -## and a proper Nimrod-like interface, use the OS module or write a wrapper. - -## Coding conventions: -## ALL types are named the same as in the POSIX standard except that they start -## with 'T' or 'P' (if they are pointers) and without the '_t' prefix to be -## consistent with Nimrod conventions. If an identifier is a Nimrod keyword -## the \`identifier\` notation is used. -## -## This library relies on the header files of your C compiler. Thus the -## resulting C code will just include and *not* define the -## symbols declared here. - -from times import TTime - -const - hasSpawnH = defined(linux) - hasAioH = defined(linux) - -when false: - const - C_IRUSR = 0c000400 ## Read by owner. - C_IWUSR = 0c000200 ## Write by owner. - C_IXUSR = 0c000100 ## Execute by owner. - C_IRGRP = 0c000040 ## Read by group. - C_IWGRP = 0c000020 ## Write by group. - C_IXGRP = 0c000010 ## Execute by group. - C_IROTH = 0c000004 ## Read by others. - C_IWOTH = 0c000002 ## Write by others. - C_IXOTH = 0c000001 ## Execute by others. - C_ISUID = 0c004000 ## Set user ID. - C_ISGID = 0c002000 ## Set group ID. - C_ISVTX = 0c001000 ## On directories, restricted deletion flag. - C_ISDIR = 0c040000 ## Directory. - C_ISFIFO = 0c010000 ##FIFO. - C_ISREG = 0c100000 ## Regular file. - C_ISBLK = 0c060000 ## Block special. - C_ISCHR = 0c020000 ## Character special. - C_ISCTG = 0c110000 ## Reserved. - C_ISLNK = 0c120000 ## Symbolic link.

    - C_ISSOCK = 0c140000 ## Socket. - -const - MM_NULLLBL* = nil - MM_NULLSEV* = 0 - MM_NULLMC* = 0 - MM_NULLTXT* = nil - MM_NULLACT* = nil - MM_NULLTAG* = nil - - STDERR_FILENO* = 2 ## File number of stderr; - STDIN_FILENO* = 0 ## File number of stdin; - STDOUT_FILENO* = 1 ## File number of stdout; - -type - TDIR* {.importc: "DIR", header: "", final, pure.} = object - ## A type representing a directory stream. - - Tdirent* {.importc: "struct dirent", - header: "", final, pure.} = object ## dirent_t struct - d_ino*: TIno ## File serial number. - d_name*: array [0..255, char] ## Name of entry. - - Tflock* {.importc: "flock", final, pure, - header: "".} = object ## flock type - l_type*: cshort ## Type of lock; F_RDLCK, F_WRLCK, F_UNLCK. - l_whence*: cshort ## Flag for starting offset. - l_start*: Toff ## Relative offset in bytes. - l_len*: Toff ## Size; if 0 then until EOF. - l_pid*: TPid ## Process ID of the process holding the lock; - ## returned with F_GETLK. - - Tfenv* {.importc: "fenv_t", header: "", final, pure.} = - object ## Represents the entire floating-point environment. The - ## floating-point environment refers collectively to any - ## floating-point status flags and control modes supported - ## by the implementation. - Tfexcept* {.importc: "fexcept_t", header: "", final, pure.} = - object ## Represents the floating-point status flags collectively, - ## including any status the implementation associates with the - ## flags. A floating-point status flag is a system variable - ## whose value is set (but never cleared) when a floating-point - ## exception is raised, which occurs as a side effect of - ## exceptional floating-point arithmetic to provide auxiliary - ## information. A floating-point control mode is a system variable - ## whose value may be set by the user to affect the subsequent - ## behavior of floating-point arithmetic. - - TFTW* {.importc: "struct FTW", header: "", final, pure.} = object - base*: cint - level*: cint - - TGlob* {.importc: "glob_t", header: "", - final, pure.} = object ## glob_t - gl_pathc*: int ## Count of paths matched by pattern. - gl_pathv*: cstringArray ## Pointer to a list of matched pathnames. - gl_offs*: int ## Slots to reserve at the beginning of gl_pathv. - - TGroup* {.importc: "struct group", header: "", - final, pure.} = object ## struct group - gr_name*: cstring ## The name of the group. - gr_gid*: TGid ## Numerical group ID. - gr_mem*: cstringArray ## Pointer to a null-terminated array of character - ## pointers to member names. - - Ticonv* {.importc: "iconv_t", header: "", final, pure.} = - object ## Identifies the conversion from one codeset to another. - - Tlconv* {.importc: "struct lconv", header: "", final, pure.} = object - currency_symbol*: cstring - decimal_point*: cstring - frac_digits*: char - grouping*: cstring - int_curr_symbol*: cstring - int_frac_digits*: char - int_n_cs_precedes*: char - int_n_sep_by_space*: char - int_n_sign_posn*: char - int_p_cs_precedes*: char - int_p_sep_by_space*: char - int_p_sign_posn*: char - mon_decimal_point*: cstring - mon_grouping*: cstring - mon_thousands_sep*: cstring - negative_sign*: cstring - n_cs_precedes*: char - n_sep_by_space*: char - n_sign_posn*: char - positive_sign*: cstring - p_cs_precedes*: char - p_sep_by_space*: char - p_sign_posn*: char - thousands_sep*: cstring - - TMqd* {.importc: "mqd_t", header: "", final, pure.} = object - TMqAttr* {.importc: "struct mq_attr", - header: "", - final, pure.} = object ## message queue attribute - mq_flags*: int ## Message queue flags. - mq_maxmsg*: int ## Maximum number of messages. - mq_msgsize*: int ## Maximum message size. - mq_curmsgs*: int ## Number of messages currently queued. - - TPasswd* {.importc: "struct passwd", header: "", - final, pure.} = object ## struct passwd - pw_name*: cstring ## User's login name. - pw_uid*: TUid ## Numerical user ID. - pw_gid*: TGid ## Numerical group ID. - pw_dir*: cstring ## Initial working directory. - pw_shell*: cstring ## Program to use as shell. - - Tblkcnt* {.importc: "blkcnt_t", header: "".} = int - ## used for file block counts - Tblksize* {.importc: "blksize_t", header: "".} = int - ## used for block sizes - TClock* {.importc: "clock_t", header: "".} = int - TClockId* {.importc: "clockid_t", header: "".} = int - TDev* {.importc: "dev_t", header: "".} = int - Tfsblkcnt* {.importc: "fsblkcnt_t", header: "".} = int - Tfsfilcnt* {.importc: "fsfilcnt_t", header: "".} = int - TGid* {.importc: "gid_t", header: "".} = int - Tid* {.importc: "id_t", header: "".} = int - Tino* {.importc: "ino_t", header: "".} = int - TKey* {.importc: "key_t", header: "".} = int - TMode* {.importc: "mode_t", header: "".} = int - TNlink* {.importc: "nlink_t", header: "".} = int - TOff* {.importc: "off_t", header: "".} = int64 - TPid* {.importc: "pid_t", header: "".} = int - Tpthread_attr* {.importc: "pthread_attr_t", header: "".} = int - Tpthread_barrier* {.importc: "pthread_barrier_t", - header: "".} = int - Tpthread_barrierattr* {.importc: "pthread_barrierattr_t", - header: "".} = int - Tpthread_cond* {.importc: "pthread_cond_t", header: "".} = int - Tpthread_condattr* {.importc: "pthread_condattr_t", - header: "".} = int - Tpthread_key* {.importc: "pthread_key_t", header: "".} = int - Tpthread_mutex* {.importc: "pthread_mutex_t", header: "".} = int - Tpthread_mutexattr* {.importc: "pthread_mutexattr_t", - header: "".} = int - Tpthread_once* {.importc: "pthread_once_t", header: "".} = int - Tpthread_rwlock* {.importc: "pthread_rwlock_t", header: "".} = int - Tpthread_rwlockattr* {.importc: "pthread_rwlockattr_t", - header: "".} = int - Tpthread_spinlock* {.importc: "pthread_spinlock_t", - header: "".} = int - Tpthread* {.importc: "pthread_t", header: "".} = int - Tsuseconds* {.importc: "suseconds_t", header: "".} = int - #Ttime* {.importc: "time_t", header: "".} = int - Ttimer* {.importc: "timer_t", header: "".} = int - Ttrace_attr* {.importc: "trace_attr_t", header: "".} = int - Ttrace_event_id* {.importc: "trace_event_id_t", - header: "".} = int - Ttrace_event_set* {.importc: "trace_event_set_t", - header: "".} = int - Ttrace_id* {.importc: "trace_id_t", header: "".} = int - Tuid* {.importc: "uid_t", header: "".} = int - Tuseconds* {.importc: "useconds_t", header: "".} = int - - Tutsname* {.importc: "struct utsname", - header: "", - final, pure.} = object ## struct utsname - sysname*, ## Name of this implementation of the operating system. - nodename*, ## Name of this node within the communications - ## network to which this node is attached, if any. - release*, ## Current release level of this implementation. - version*, ## Current version level of this release. - machine*: array [0..255, char] ## Name of the hardware type on which the - ## system is running. - - TSem* {.importc: "sem_t", header: "", final, pure.} = object - Tipc_perm* {.importc: "struct ipc_perm", - header: "", final, pure.} = object ## struct ipc_perm - uid*: tuid ## Owner's user ID. - gid*: tgid ## Owner's group ID. - cuid*: Tuid ## Creator's user ID. - cgid*: Tgid ## Creator's group ID. - mode*: TMode ## Read/write permission. - - TStat* {.importc: "struct stat", - header: "", final, pure.} = object ## struct stat - st_dev*: TDev ## Device ID of device containing file. - st_ino*: TIno ## File serial number. - st_mode*: TMode ## Mode of file (see below). - st_nlink*: tnlink ## Number of hard links to the file. - st_uid*: tuid ## User ID of file. - st_gid*: Tgid ## Group ID of file. - st_rdev*: TDev ## Device ID (if file is character or block special). - st_size*: TOff ## For regular files, the file size in bytes. - ## For symbolic links, the length in bytes of the - ## pathname contained in the symbolic link. - ## For a shared memory object, the length in bytes. - ## For a typed memory object, the length in bytes. - ## For other file types, the use of this field is - ## unspecified. - st_atime*: ttime ## Time of last access. - st_mtime*: ttime ## Time of last data modification. - st_ctime*: ttime ## Time of last status change. - st_blksize*: Tblksize ## A file system-specific preferred I/O block size - ## for this object. In some file system types, this - ## may vary from file to file. - st_blocks*: Tblkcnt ## Number of blocks allocated for this object. - - - TStatvfs* {.importc: "struct statvfs", header: "", - final, pure.} = object ## struct statvfs - f_bsize*: int ## File system block size. - f_frsize*: int ## Fundamental file system block size. - f_blocks*: Tfsblkcnt ## Total number of blocks on file system - ## in units of f_frsize. - f_bfree*: Tfsblkcnt ## Total number of free blocks. - f_bavail*: Tfsblkcnt ## Number of free blocks available to - ## non-privileged process. - f_files*: Tfsfilcnt ## Total number of file serial numbers. - f_ffree*: Tfsfilcnt ## Total number of free file serial numbers. - f_favail*: Tfsfilcnt ## Number of file serial numbers available to - ## non-privileged process. - f_fsid*: int ## File system ID. - f_flag*: int ## Bit mask of f_flag values. - f_namemax*: int ## Maximum filename length. - - Tposix_typed_mem_info* {.importc: "struct posix_typed_mem_info", - header: "", final, pure.} = object - posix_tmi_length*: int - - Ttm* {.importc: "struct tm", header: "", - final, pure.} = object ## struct tm - tm_sec*: cint ## Seconds [0,60]. - tm_min*: cint ## Minutes [0,59]. - tm_hour*: cint ## Hour [0,23]. - tm_mday*: cint ## Day of month [1,31]. - tm_mon*: cint ## Month of year [0,11]. - tm_year*: cint ## Years since 1900. - tm_wday*: cint ## Day of week [0,6] (Sunday =0). - tm_yday*: cint ## Day of year [0,365]. - tm_isdst*: cint ## Daylight Savings flag. - Ttimespec* {.importc: "struct timespec", - header: "", final, pure.} = object ## struct timespec - tv_sec*: Ttime ## Seconds. - tv_nsec*: int ## Nanoseconds. - titimerspec* {.importc: "struct itimerspec", header: "", - final, pure.} = object ## struct itimerspec - it_interval*: ttimespec ## Timer period. - it_value*: ttimespec ## Timer expiration. - - Tsig_atomic* {.importc: "sig_atomic_t", header: "".} = cint - ## Possibly volatile-qualified integer type of an object that can be - ## accessed as an atomic entity, even in the presence of asynchronous - ## interrupts. - Tsigset* {.importc: "sigset_t", header: "", final, pure.} = object - - TsigEvent* {.importc: "struct sigevent", - header: "", final, pure.} = object ## struct sigevent - sigev_notify*: cint ## Notification type. - sigev_signo*: cint ## Signal number. - sigev_value*: Tsigval ## Signal value. - sigev_notify_function*: proc (x: TSigval) {.noconv.} ## Notification function. - sigev_notify_attributes*: ptr Tpthreadattr ## Notification attributes. - - TsigVal* {.importc: "union sigval", - header: "", final, pure.} = object ## struct sigval - sival_ptr*: pointer ## pointer signal value; - ## integer signal value not defined! - TSigaction* {.importc: "struct sigaction", - header: "", final, pure.} = object ## struct sigaction - sa_handler*: proc (x: cint) {.noconv.} ## Pointer to a signal-catching - ## function or one of the macros - ## SIG_IGN or SIG_DFL. - sa_mask*: TsigSet ## Set of signals to be blocked during execution of - ## the signal handling function. - sa_flags*: cint ## Special flags. - sa_sigaction*: proc (x: cint, y: var TSigInfo, z: pointer) {.noconv.} - - TStack* {.importc: "stack_t", - header: "", final, pure.} = object ## stack_t - ss_sp*: pointer ## Stack base or pointer. - ss_size*: int ## Stack size. - ss_flags*: cint ## Flags. - - TSigStack* {.importc: "struct sigstack", - header: "", final, pure.} = object ## struct sigstack - ss_onstack*: cint ## Non-zero when signal stack is in use. - ss_sp*: pointer ## Signal stack pointer. - - TsigInfo* {.importc: "siginfo_t", - header: "", final, pure.} = object ## siginfo_t - si_signo*: cint ## Signal number. - si_code*: cint ## Signal code. - si_errno*: cint ## If non-zero, an errno value associated with - ## this signal, as defined in . - si_pid*: tpid ## Sending process ID. - si_uid*: tuid ## Real user ID of sending process. - si_addr*: pointer ## Address of faulting instruction. - si_status*: cint ## Exit value or signal. - si_band*: int ## Band event for SIGPOLL. - si_value*: TSigval ## Signal value. - - Tnl_item* {.importc: "nl_item", header: "".} = cint - Tnl_catd* {.importc: "nl_catd", header: "".} = cint - - Tsched_param* {.importc: "struct sched_param", - header: "", - final, pure.} = object ## struct sched_param - sched_priority*: cint - sched_ss_low_priority*: cint ## Low scheduling priority for - ## sporadic server. - sched_ss_repl_period*: ttimespec ## Replenishment period for - ## sporadic server. - sched_ss_init_budget*: ttimespec ## Initial budget for sporadic server. - sched_ss_max_repl*: cint ## Maximum pending replenishments for - ## sporadic server. - - Ttimeval* {.importc: "struct timeval", header: "", - final, pure.} = object ## struct timeval - tv_sec*: ttime ## Seconds. - tv_usec*: tsuseconds ## Microseconds. - Tfd_set* {.importc: "struct fd_set", header: "", - final, pure.} = object - Tmcontext* {.importc: "mcontext_t", header: "", - final, pure.} = object - Tucontext* {.importc: "ucontext_t", header: "", - final, pure.} = object ## ucontext_t - uc_link*: ptr Tucontext ## Pointer to the context that is resumed - ## when this context returns. - uc_sigmask*: Tsigset ## The set of signals that are blocked when this - ## context is active. - uc_stack*: TStack ## The stack used by this context. - uc_mcontext*: Tmcontext ## A machine-specific representation of the saved - ## context. - -when hasAioH: - type - Taiocb* {.importc: "struct aiocb", header: "", - final, pure.} = object ## struct aiocb - aio_fildes*: cint ## File descriptor. - aio_offset*: TOff ## File offset. - aio_buf*: pointer ## Location of buffer. - aio_nbytes*: int ## Length of transfer. - aio_reqprio*: cint ## Request priority offset. - aio_sigevent*: TSigEvent ## Signal number and value. - aio_lio_opcode: cint ## Operation to be performed. - -when hasSpawnH: - type - Tposix_spawnattr* {.importc: "posix_spawnattr_t", - header: "".} = cint - Tposix_spawn_file_actions* {.importc: "posix_spawn_file_actions_t", - header: "".} = cint - -type - TSocklen* {.importc: "socklen_t", header: "".} = cint - TSa_Family* {.importc: "sa_family_t", header: "".} = cint - - TSockAddr* {.importc: "struct sockaddr", header: "", - pure, final.} = object ## struct sockaddr - sa_family*: Tsa_family ## Address family. - sa_data*: array [0..255, char] ## Socket address (variable-length data). - - Tsockaddr_storage* {.importc: "struct sockaddr_storage", - header: "", - pure, final.} = object ## struct sockaddr_storage - ss_family*: Tsa_family ## Address family. - - Tif_nameindex* {.importc: "struct if_nameindex", final, - pure, header: "".} = object ## struct if_nameindex - if_index*: cint ## Numeric index of the interface. - if_name*: cstring ## Null-terminated name of the interface. - - - TIOVec* {.importc: "struct iovec", pure, final, - header: "".} = object ## struct iovec - iov_base*: pointer ## Base address of a memory region for input or output. - iov_len*: int ## The size of the memory pointed to by iov_base. - - Tmsghdr* {.importc: "struct msghdr", pure, final, - header: "".} = object ## struct msghdr - msg_name*: pointer ## Optional address. - msg_namelen*: TSockLen ## Size of address. - msg_iov*: ptr TIOVec ## Scatter/gather array. - msg_iovlen*: cint ## Members in msg_iov. - msg_control*: pointer ## Ancillary data; see below. - msg_controllen*: TSockLen ## Ancillary data buffer len. - msg_flags*: cint ## Flags on received message. - - - Tcmsghdr* {.importc: "struct cmsghdr", pure, final, - header: "".} = object ## struct cmsghdr - cmsg_len*: TSockLen ## Data byte count, including the cmsghdr. - cmsg_level*: cint ## Originating protocol. - cmsg_type*: cint ## Protocol-specific type. - - TLinger* {.importc: "struct linger", pure, final, - header: "".} = object ## struct linger - l_onoff*: cint ## Indicates whether linger option is enabled. - l_linger*: cint ## Linger time, in seconds. - - TInPort* = int16 ## unsigned! - TInAddrScalar* = int32 ## unsigned! - - TInAddr* {.importc: "struct in_addr", pure, final, - header: "".} = object ## struct in_addr - s_addr*: TInAddrScalar - - Tsockaddr_in* {.importc: "struct sockaddr_in", pure, final, - header: "".} = object ## struct sockaddr_in - sin_family*: TSa_family ## AF_INET. - sin_port*: TInPort ## Port number. - sin_addr*: TInAddr ## IP address. - - TIn6Addr* {.importc: "struct in6_addr", pure, final, - header: "".} = object ## struct in6_addr - s6_addr*: array [0..15, char] - - Tsockaddr_in6* {.importc: "struct sockaddr_in6", pure, final, - header: "".} = object ## struct sockaddr_in6 - sin6_family*: TSa_family ## AF_INET6. - sin6_port*: TInPort ## Port number. - sin6_flowinfo*: int32 ## IPv6 traffic class and flow information. - sin6_addr*: Tin6Addr ## IPv6 address. - sin6_scope_id*: int32 ## Set of interfaces for a scope. - - Tipv6_mreq* {.importc: "struct ipv6_mreq", pure, final, - header: "".} = object ## struct ipv6_mreq - ipv6mr_multiaddr*: TIn6Addr ## IPv6 multicast address. - ipv6mr_interface*: cint ## Interface index. - - Thostent* {.importc: "struct hostent", pure, final, - header: "".} = object ## struct hostent - h_name*: cstring ## Official name of the host. - h_aliases*: cstringArray ## A pointer to an array of pointers to - ## alternative host names, terminated by a - ## null pointer. - h_addrtype*: cint ## Address type. - h_length*: cint ## The length, in bytes, of the address. - h_addr_list*: cstringArray ## A pointer to an array of pointers to network - ## addresses (in network byte order) for the - ## host, terminated by a null pointer. - - Tnetent* {.importc: "struct netent", pure, final, - header: "".} = object ## struct netent - n_name*: cstring ## Official, fully-qualified (including the - ## domain) name of the host. - n_aliases*: cstringArray ## A pointer to an array of pointers to - ## alternative network names, terminated by a - ## null pointer. - n_addrtype*: cint ## The address type of the network. - n_net*: int32 ## The network number, in host byte order. - - TProtoent* {.importc: "struct protoent", pure, final, - header: "".} = object ## struct protoent - p_name*: cstring ## Official name of the protocol. - p_aliases*: cstringArray ## A pointer to an array of pointers to - ## alternative protocol names, terminated by - ## a null pointer. - p_proto*: cint ## The protocol number. - - TServent* {.importc: "struct servent", pure, final, - header: "".} = object ## struct servent - s_name*: cstring ## Official name of the service. - s_aliases*: cstringArray ## A pointer to an array of pointers to - ## alternative service names, terminated by - ## a null pointer. - s_port*: cint ## The port number at which the service - ## resides, in network byte order. - s_proto*: cstring ## The name of the protocol to use when - ## contacting the service. - - Taddrinfo* {.importc: "struct addrinfo", pure, final, - header: "".} = object ## struct addrinfo - ai_flags*: cint ## Input flags. - ai_family*: cint ## Address family of socket. - ai_socktype*: cint ## Socket type. - ai_protocol*: cint ## Protocol of socket. - ai_addrlen*: TSockLen ## Length of socket address. - ai_addr*: ptr TSockAddr ## Socket address of socket. - ai_canonname*: cstring ## Canonical name of service location. - ai_next*: ptr TAddrInfo ## Pointer to next in list. - - TPollfd* {.importc: "struct pollfd", pure, final, - header: "".} = object ## struct pollfd - fd*: cint ## The following descriptor being polled. - events*: cshort ## The input event flags (see below). - revents*: cshort ## The output event flags (see below). - - Tnfds* {.importc: "nfds_t", header: "".} = cint - -var - errno* {.importc, header: "".}: cint ## error variable - daylight* {.importc, header: "".}: cint - timezone* {.importc, header: "".}: int - -# Constants as variables: -when hasAioH: - var - AIO_ALLDONE* {.importc, header: "".}: cint - ## A return value indicating that none of the requested operations - ## could be canceled since they are already complete. - AIO_CANCELED* {.importc, header: "".}: cint - ## A return value indicating that all requested operations have - ## been canceled. - AIO_NOTCANCELED* {.importc, header: "".}: cint - ## A return value indicating that some of the requested operations could - ## not be canceled since they are in progress. - LIO_NOP* {.importc, header: "".}: cint - ## A lio_listio() element operation option indicating that no transfer is - ## requested. - LIO_NOWAIT* {.importc, header: "".}: cint - ## A lio_listio() synchronization operation indicating that the calling - ## thread is to continue execution while the lio_listio() operation is - ## being performed, and no notification is given when the operation is - ## complete. - LIO_READ* {.importc, header: "".}: cint - ## A lio_listio() element operation option requesting a read. - LIO_WAIT* {.importc, header: "".}: cint - ## A lio_listio() synchronization operation indicating that the calling - ## thread is to suspend until the lio_listio() operation is complete. - LIO_WRITE* {.importc, header: "".}: cint - ## A lio_listio() element operation option requesting a write. - -var - RTLD_LAZY* {.importc, header: "".}: cint - ## Relocations are performed at an implementation-defined time. - RTLD_NOW* {.importc, header: "".}: cint - ## Relocations are performed when the object is loaded. - RTLD_GLOBAL* {.importc, header: "".}: cint - ## All symbols are available for relocation processing of other modules. - RTLD_LOCAL* {.importc, header: "".}: cint - ## All symbols are not made available for relocation processing by - ## other modules. - - E2BIG* {.importc, header: "".}: cint - ## Argument list too long. - EACCES* {.importc, header: "".}: cint - ## Permission denied. - EADDRINUSE* {.importc, header: "".}: cint - ## Address in use. - EADDRNOTAVAIL* {.importc, header: "".}: cint - ## Address not available. - EAFNOSUPPORT* {.importc, header: "".}: cint - ## Address family not supported. - EAGAIN* {.importc, header: "".}: cint - ## Resource unavailable, try again (may be the same value as [EWOULDBLOCK]). - EALREADY* {.importc, header: "".}: cint - ## Connection already in progress. - EBADF* {.importc, header: "".}: cint - ## Bad file descriptor. - EBADMSG* {.importc, header: "".}: cint - ## Bad message. - EBUSY* {.importc, header: "".}: cint - ## Device or resource busy. - ECANCELED* {.importc, header: "".}: cint - ## Operation canceled. - ECHILD* {.importc, header: "".}: cint - ## No child processes. - ECONNABORTED* {.importc, header: "".}: cint - ## Connection aborted. - ECONNREFUSED* {.importc, header: "".}: cint - ## Connection refused. - ECONNRESET* {.importc, header: "".}: cint - ## Connection reset. - EDEADLK* {.importc, header: "".}: cint - ## Resource deadlock would occur. - EDESTADDRREQ* {.importc, header: "".}: cint - ## Destination address required. - EDOM* {.importc, header: "".}: cint - ## Mathematics argument out of domain of function. - EDQUOT* {.importc, header: "".}: cint - ## Reserved. - EEXIST* {.importc, header: "".}: cint - ## File exists. - EFAULT* {.importc, header: "".}: cint - ## Bad address. - EFBIG* {.importc, header: "".}: cint - ## File too large. - EHOSTUNREACH* {.importc, header: "".}: cint - ## Host is unreachable. - EIDRM* {.importc, header: "".}: cint - ## Identifier removed. - EILSEQ* {.importc, header: "".}: cint - ## Illegal byte sequence. - EINPROGRESS* {.importc, header: "".}: cint - ## Operation in progress. - EINTR* {.importc, header: "".}: cint - ## Interrupted function. - EINVAL* {.importc, header: "".}: cint - ## Invalid argument. - EIO* {.importc, header: "".}: cint - ## I/O error. - EISCONN* {.importc, header: "".}: cint - ## Socket is connected. - EISDIR* {.importc, header: "".}: cint - ## Is a directory. - ELOOP* {.importc, header: "".}: cint - ## Too many levels of symbolic links. - EMFILE* {.importc, header: "".}: cint - ## Too many open files. - EMLINK* {.importc, header: "".}: cint - ## Too many links. - EMSGSIZE* {.importc, header: "".}: cint - ## Message too large. - EMULTIHOP* {.importc, header: "".}: cint - ## Reserved. - ENAMETOOLONG* {.importc, header: "".}: cint - ## Filename too long. - ENETDOWN* {.importc, header: "".}: cint - ## Network is down. - ENETRESET* {.importc, header: "".}: cint - ## Connection aborted by network. - ENETUNREACH* {.importc, header: "".}: cint - ## Network unreachable. - ENFILE* {.importc, header: "".}: cint - ## Too many files open in system. - ENOBUFS* {.importc, header: "".}: cint - ## No buffer space available. - ENODATA* {.importc, header: "".}: cint - ## No message is available on the STREAM head read queue. - ENODEV* {.importc, header: "".}: cint - ## No such device. - ENOENT* {.importc, header: "".}: cint - ## No such file or directory. - ENOEXEC* {.importc, header: "".}: cint - ## Executable file format error. - ENOLCK* {.importc, header: "".}: cint - ## No locks available. - ENOLINK* {.importc, header: "".}: cint - ## Reserved. - ENOMEM* {.importc, header: "".}: cint - ## Not enough space. - ENOMSG* {.importc, header: "".}: cint - ## No message of the desired type. - ENOPROTOOPT* {.importc, header: "".}: cint - ## Protocol not available. - ENOSPC* {.importc, header: "".}: cint - ## No space left on device. - ENOSR* {.importc, header: "".}: cint - ## No STREAM resources. - ENOSTR* {.importc, header: "".}: cint - ## Not a STREAM. - ENOSYS* {.importc, header: "".}: cint - ## Function not supported. - ENOTCONN* {.importc, header: "".}: cint - ## The socket is not connected. - ENOTDIR* {.importc, header: "".}: cint - ## Not a directory. - ENOTEMPTY* {.importc, header: "".}: cint - ## Directory not empty. - ENOTSOCK* {.importc, header: "".}: cint - ## Not a socket. - ENOTSUP* {.importc, header: "".}: cint - ## Not supported. - ENOTTY* {.importc, header: "".}: cint - ## Inappropriate I/O control operation. - ENXIO* {.importc, header: "".}: cint - ## No such device or address. - EOPNOTSUPP* {.importc, header: "".}: cint - ## Operation not supported on socket. - EOVERFLOW* {.importc, header: "".}: cint - ## Value too large to be stored in data type. - EPERM* {.importc, header: "".}: cint - ## Operation not permitted. - EPIPE* {.importc, header: "".}: cint - ## Broken pipe. - EPROTO* {.importc, header: "".}: cint - ## Protocol error. - EPROTONOSUPPORT* {.importc, header: "".}: cint - ## Protocol not supported. - EPROTOTYPE* {.importc, header: "".}: cint - ## Protocol wrong type for socket. - ERANGE* {.importc, header: "".}: cint - ## Result too large. - EROFS* {.importc, header: "".}: cint - ## Read-only file system. - ESPIPE* {.importc, header: "".}: cint - ## Invalid seek. - ESRCH* {.importc, header: "".}: cint - ## No such process. - ESTALE* {.importc, header: "".}: cint - ## Reserved. - ETIME* {.importc, header: "".}: cint - ## Stream ioctl() timeout. - ETIMEDOUT* {.importc, header: "".}: cint - ## Connection timed out. - ETXTBSY* {.importc, header: "".}: cint - ## Text file busy. - EWOULDBLOCK* {.importc, header: "".}: cint - ## Operation would block (may be the same value as [EAGAIN]). - EXDEV* {.importc, header: "".}: cint - ## Cross-device link. - - F_DUPFD* {.importc, header: "".}: cint - ## Duplicate file descriptor. - F_GETFD* {.importc, header: "".}: cint - ## Get file descriptor flags. - F_SETFD* {.importc, header: "".}: cint - ## Set file descriptor flags. - F_GETFL* {.importc, header: "".}: cint - ## Get file status flags and file access modes. - F_SETFL* {.importc, header: "".}: cint - ## Set file status flags. - F_GETLK* {.importc, header: "".}: cint - ## Get record locking information. - F_SETLK* {.importc, header: "".}: cint - ## Set record locking information. - F_SETLKW* {.importc, header: "".}: cint - ## Set record locking information; wait if blocked. - F_GETOWN* {.importc, header: "".}: cint - ## Get process or process group ID to receive SIGURG signals. - F_SETOWN* {.importc, header: "".}: cint - ## Set process or process group ID to receive SIGURG signals. - FD_CLOEXEC* {.importc, header: "".}: cint - ## Close the file descriptor upon execution of an exec family function. - F_RDLCK* {.importc, header: "".}: cint - ## Shared or read lock. - F_UNLCK* {.importc, header: "".}: cint - ## Unlock. - F_WRLCK* {.importc, header: "".}: cint - ## Exclusive or write lock. - O_CREAT* {.importc, header: "".}: cint - ## Create file if it does not exist. - O_EXCL* {.importc, header: "".}: cint - ## Exclusive use flag. - O_NOCTTY* {.importc, header: "".}: cint - ## Do not assign controlling terminal. - O_TRUNC* {.importc, header: "".}: cint - ## Truncate flag. - O_APPEND* {.importc, header: "".}: cint - ## Set append mode. - O_DSYNC* {.importc, header: "".}: cint - ## Write according to synchronized I/O data integrity completion. - O_NONBLOCK* {.importc, header: "".}: cint - ## Non-blocking mode. - O_RSYNC* {.importc, header: "".}: cint - ## Synchronized read I/O operations. - O_SYNC* {.importc, header: "".}: cint - ## Write according to synchronized I/O file integrity completion. - O_ACCMODE* {.importc, header: "".}: cint - ## Mask for file access modes. - O_RDONLY* {.importc, header: "".}: cint - ## Open for reading only. - O_RDWR* {.importc, header: "".}: cint - ## Open for reading and writing. - O_WRONLY* {.importc, header: "".}: cint - ## Open for writing only. - POSIX_FADV_NORMAL* {.importc, header: "".}: cint - ## The application has no advice to give on its behavior with - ## respect to the specified data. It is the default characteristic - ## if no advice is given for an open file. - POSIX_FADV_SEQUENTIAL* {.importc, header: "".}: cint - ## The application expects to access the specified data - # sequentially from lower offsets to higher offsets. - POSIX_FADV_RANDOM* {.importc, header: "".}: cint - ## The application expects to access the specified data in a random order. - POSIX_FADV_WILLNEED* {.importc, header: "".}: cint - ## The application expects to access the specified data in the near future. - POSIX_FADV_DONTNEED* {.importc, header: "".}: cint - ## The application expects that it will not access the specified data - ## in the near future. - POSIX_FADV_NOREUSE* {.importc, header: "".}: cint - ## The application expects to access the specified data once and - ## then not reuse it thereafter. - - FE_DIVBYZERO* {.importc, header: "".}: cint - FE_INEXACT* {.importc, header: "".}: cint - FE_INVALID* {.importc, header: "".}: cint - FE_OVERFLOW* {.importc, header: "".}: cint - FE_UNDERFLOW* {.importc, header: "".}: cint - FE_ALL_EXCEPT* {.importc, header: "".}: cint - FE_DOWNWARD* {.importc, header: "".}: cint - FE_TONEAREST* {.importc, header: "".}: cint - FE_TOWARDZERO* {.importc, header: "".}: cint - FE_UPWARD* {.importc, header: "".}: cint - FE_DFL_ENV* {.importc, header: "".}: cint - - MM_HARD* {.importc, header: "".}: cint - ## Source of the condition is hardware. - MM_SOFT* {.importc, header: "".}: cint - ## Source of the condition is software. - MM_FIRM* {.importc, header: "".}: cint - ## Source of the condition is firmware. - MM_APPL* {.importc, header: "".}: cint - ## Condition detected by application. - MM_UTIL* {.importc, header: "".}: cint - ## Condition detected by utility. - MM_OPSYS* {.importc, header: "".}: cint - ## Condition detected by operating system. - MM_RECOVER* {.importc, header: "".}: cint - ## Recoverable error. - MM_NRECOV* {.importc, header: "".}: cint - ## Non-recoverable error. - MM_HALT* {.importc, header: "".}: cint - ## Error causing application to halt. - MM_ERROR* {.importc, header: "".}: cint - ## Application has encountered a non-fatal fault. - MM_WARNING* {.importc, header: "".}: cint - ## Application has detected unusual non-error condition. - MM_INFO* {.importc, header: "".}: cint - ## Informative message. - MM_NOSEV* {.importc, header: "".}: cint - ## No severity level provided for the message. - MM_PRINT* {.importc, header: "".}: cint - ## Display message on standard error. - MM_CONSOLE* {.importc, header: "".}: cint - ## Display message on system console. - - MM_OK* {.importc, header: "".}: cint - ## The function succeeded. - MM_NOTOK* {.importc, header: "".}: cint - ## The function failed completely. - MM_NOMSG* {.importc, header: "".}: cint - ## The function was unable to generate a message on standard error, - ## but otherwise succeeded. - MM_NOCON* {.importc, header: "".}: cint - ## The function was unable to generate a console message, but - ## otherwise succeeded. - - FNM_NOMATCH* {.importc, header: "".}: cint - ## The string does not match the specified pattern. - FNM_PATHNAME* {.importc, header: "".}: cint - ## Slash in string only matches slash in pattern. - FNM_PERIOD* {.importc, header: "".}: cint - ## Leading period in string must be exactly matched by period in pattern. - FNM_NOESCAPE* {.importc, header: "".}: cint - ## Disable backslash escaping. - FNM_NOSYS* {.importc, header: "".}: cint - ## Reserved. - - FTW_F* {.importc, header: "".}: cint - ## File. - FTW_D* {.importc, header: "".}: cint - ## Directory. - FTW_DNR* {.importc, header: "".}: cint - ## Directory without read permission. - FTW_DP* {.importc, header: "".}: cint - ## Directory with subdirectories visited. - FTW_NS* {.importc, header: "".}: cint - ## Unknown type; stat() failed. - FTW_SL* {.importc, header: "".}: cint - ## Symbolic link. - FTW_SLN* {.importc, header: "".}: cint - ## Symbolic link that names a nonexistent file. - - FTW_PHYS* {.importc, header: "".}: cint - ## Physical walk, does not follow symbolic links. Otherwise, nftw() - ## follows links but does not walk down any path that crosses itself. - FTW_MOUNT* {.importc, header: "".}: cint - ## The walk does not cross a mount point. - FTW_DEPTH* {.importc, header: "".}: cint - ## All subdirectories are visited before the directory itself. - FTW_CHDIR* {.importc, header: "".}: cint - ## The walk changes to each directory before reading it. - - GLOB_APPEND* {.importc, header: "".}: cint - ## Append generated pathnames to those previously obtained. - GLOB_DOOFFS* {.importc, header: "".}: cint - ## Specify how many null pointers to add to the beginning of gl_pathv. - GLOB_ERR* {.importc, header: "".}: cint - ## Cause glob() to return on error. - GLOB_MARK* {.importc, header: "".}: cint - ## Each pathname that is a directory that matches pattern has a - ## slash appended. - GLOB_NOCHECK* {.importc, header: "".}: cint - ## If pattern does not match any pathname, then return a list - ## consisting of only pattern. - GLOB_NOESCAPE* {.importc, header: "".}: cint - ## Disable backslash escaping. - GLOB_NOSORT* {.importc, header: "".}: cint - ## Do not sort the pathnames returned. - GLOB_ABORTED* {.importc, header: "".}: cint - ## The scan was stopped because GLOB_ERR was set or errfunc() - ## returned non-zero. - GLOB_NOMATCH* {.importc, header: "".}: cint - ## The pattern does not match any existing pathname, and GLOB_NOCHECK - ## was not set in flags. - GLOB_NOSPACE* {.importc, header: "".}: cint - ## An attempt to allocate memory failed. - GLOB_NOSYS* {.importc, header: "".}: cint - ## Reserved - - CODESET* {.importc, header: "".}: cint - ## Codeset name. - D_T_FMT* {.importc, header: "".}: cint - ## String for formatting date and time. - D_FMT * {.importc, header: "".}: cint - ## Date format string. - T_FMT* {.importc, header: "".}: cint - ## Time format string. - T_FMT_AMPM* {.importc, header: "".}: cint - ## a.m. or p.m. time format string. - AM_STR* {.importc, header: "".}: cint - ## Ante-meridiem affix. - PM_STR* {.importc, header: "".}: cint - ## Post-meridiem affix. - DAY_1* {.importc, header: "".}: cint - ## Name of the first day of the week (for example, Sunday). - DAY_2* {.importc, header: "".}: cint - ## Name of the second day of the week (for example, Monday). - DAY_3* {.importc, header: "".}: cint - ## Name of the third day of the week (for example, Tuesday). - DAY_4* {.importc, header: "".}: cint - ## Name of the fourth day of the week (for example, Wednesday). - DAY_5* {.importc, header: "".}: cint - ## Name of the fifth day of the week (for example, Thursday). - DAY_6* {.importc, header: "".}: cint - ## Name of the sixth day of the week (for example, Friday). - DAY_7* {.importc, header: "".}: cint - ## Name of the seventh day of the week (for example, Saturday). - ABDAY_1* {.importc, header: "".}: cint - ## Abbreviated name of the first day of the week. - ABDAY_2* {.importc, header: "".}: cint - ABDAY_3* {.importc, header: "".}: cint - ABDAY_4* {.importc, header: "".}: cint - ABDAY_5* {.importc, header: "".}: cint - ABDAY_6* {.importc, header: "".}: cint - ABDAY_7* {.importc, header: "".}: cint - MON_1* {.importc, header: "".}: cint - ## Name of the first month of the year. - MON_2* {.importc, header: "".}: cint - MON_3* {.importc, header: "".}: cint - MON_4* {.importc, header: "".}: cint - MON_5* {.importc, header: "".}: cint - MON_6* {.importc, header: "".}: cint - MON_7* {.importc, header: "".}: cint - MON_8* {.importc, header: "".}: cint - MON_9* {.importc, header: "".}: cint - MON_10* {.importc, header: "".}: cint - MON_11* {.importc, header: "".}: cint - MON_12* {.importc, header: "".}: cint - ABMON_1* {.importc, header: "".}: cint - ## Abbreviated name of the first month. - ABMON_2* {.importc, header: "".}: cint - ABMON_3* {.importc, header: "".}: cint - ABMON_4* {.importc, header: "".}: cint - ABMON_5* {.importc, header: "".}: cint - ABMON_6* {.importc, header: "".}: cint - ABMON_7* {.importc, header: "".}: cint - ABMON_8* {.importc, header: "".}: cint - ABMON_9* {.importc, header: "".}: cint - ABMON_10* {.importc, header: "".}: cint - ABMON_11* {.importc, header: "".}: cint - ABMON_12* {.importc, header: "".}: cint - ERA* {.importc, header: "".}: cint - ## Era description segments. - ERA_D_FMT* {.importc, header: "".}: cint - ## Era date format string. - ERA_D_T_FMT* {.importc, header: "".}: cint - ## Era date and time format string. - ERA_T_FMT* {.importc, header: "".}: cint - ## Era time format string. - ALT_DIGITS* {.importc, header: "".}: cint - ## Alternative symbols for digits. - RADIXCHAR* {.importc, header: "".}: cint - ## Radix character. - THOUSEP* {.importc, header: "".}: cint - ## Separator for thousands. - YESEXPR* {.importc, header: "".}: cint - ## Affirmative response expression. - NOEXPR* {.importc, header: "".}: cint - ## Negative response expression. - CRNCYSTR* {.importc, header: "".}: cint - ## Local currency symbol, preceded by '-' if the symbol - ## should appear before the value, '+' if the symbol should appear - ## after the value, or '.' if the symbol should replace the radix - ## character. If the local currency symbol is the empty string, - ## implementations may return the empty string ( "" ). - - LC_ALL* {.importc, header: "".}: cint - LC_COLLATE* {.importc, header: "".}: cint - LC_CTYPE* {.importc, header: "".}: cint - LC_MESSAGES* {.importc, header: "".}: cint - LC_MONETARY* {.importc, header: "".}: cint - LC_NUMERIC* {.importc, header: "".}: cint - LC_TIME* {.importc, header: "".}: cint - - PTHREAD_BARRIER_SERIAL_THREAD* {.importc, header: "".}: cint - PTHREAD_CANCEL_ASYNCHRONOUS* {.importc, header: "".}: cint - PTHREAD_CANCEL_ENABLE* {.importc, header: "".}: cint - PTHREAD_CANCEL_DEFERRED* {.importc, header: "".}: cint - PTHREAD_CANCEL_DISABLE* {.importc, header: "".}: cint - PTHREAD_CANCELED* {.importc, header: "".}: cint - PTHREAD_COND_INITIALIZER* {.importc, header: "".}: cint - PTHREAD_CREATE_DETACHED* {.importc, header: "".}: cint - PTHREAD_CREATE_JOINABLE* {.importc, header: "".}: cint - PTHREAD_EXPLICIT_SCHED* {.importc, header: "".}: cint - PTHREAD_INHERIT_SCHED* {.importc, header: "".}: cint - PTHREAD_MUTEX_DEFAULT* {.importc, header: "".}: cint - PTHREAD_MUTEX_ERRORCHECK* {.importc, header: "".}: cint - PTHREAD_MUTEX_INITIALIZER* {.importc, header: "".}: cint - PTHREAD_MUTEX_NORMAL* {.importc, header: "".}: cint - PTHREAD_MUTEX_RECURSIVE* {.importc, header: "".}: cint - PTHREAD_ONCE_INIT* {.importc, header: "".}: cint - PTHREAD_PRIO_INHERIT* {.importc, header: "".}: cint - PTHREAD_PRIO_NONE* {.importc, header: "".}: cint - PTHREAD_PRIO_PROTECT* {.importc, header: "".}: cint - PTHREAD_PROCESS_SHARED* {.importc, header: "".}: cint - PTHREAD_PROCESS_PRIVATE* {.importc, header: "".}: cint - PTHREAD_SCOPE_PROCESS* {.importc, header: "".}: cint - PTHREAD_SCOPE_SYSTEM* {.importc, header: "".}: cint - - POSIX_ASYNC_IO* {.importc: "_POSIX_ASYNC_IO", header: "".}: cint - POSIX_PRIO_IO* {.importc: "_POSIX_PRIO_IO", header: "".}: cint - POSIX_SYNC_IO* {.importc: "_POSIX_SYNC_IO", header: "".}: cint - F_OK* {.importc: "F_OK", header: "".}: cint - R_OK* {.importc: "R_OK", header: "".}: cint - W_OK* {.importc: "W_OK", header: "".}: cint - X_OK* {.importc: "X_OK", header: "".}: cint - - CS_PATH* {.importc: "_CS_PATH", header: "".}: cint - CS_POSIX_V6_ILP32_OFF32_CFLAGS* {.importc: "_CS_POSIX_V6_ILP32_OFF32_CFLAGS", header: "".}: cint - CS_POSIX_V6_ILP32_OFF32_LDFLAGS* {.importc: "_CS_POSIX_V6_ILP32_OFF32_LDFLAGS", header: "".}: cint - CS_POSIX_V6_ILP32_OFF32_LIBS* {.importc: "_CS_POSIX_V6_ILP32_OFF32_LIBS", header: "".}: cint - CS_POSIX_V6_ILP32_OFFBIG_CFLAGS* {.importc: "_CS_POSIX_V6_ILP32_OFFBIG_CFLAGS", header: "".}: cint - CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS* {.importc: "_CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS", header: "".}: cint - CS_POSIX_V6_ILP32_OFFBIG_LIBS* {.importc: "_CS_POSIX_V6_ILP32_OFFBIG_LIBS", header: "".}: cint - CS_POSIX_V6_LP64_OFF64_CFLAGS* {.importc: "_CS_POSIX_V6_LP64_OFF64_CFLAGS", header: "".}: cint - CS_POSIX_V6_LP64_OFF64_LDFLAGS* {.importc: "_CS_POSIX_V6_LP64_OFF64_LDFLAGS", header: "".}: cint - CS_POSIX_V6_LP64_OFF64_LIBS* {.importc: "_CS_POSIX_V6_LP64_OFF64_LIBS", header: "".}: cint - CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS* {.importc: "_CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS", header: "".}: cint - CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS* {.importc: "_CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS", header: "".}: cint - CS_POSIX_V6_LPBIG_OFFBIG_LIBS* {.importc: "_CS_POSIX_V6_LPBIG_OFFBIG_LIBS", header: "".}: cint - CS_POSIX_V6_WIDTH_RESTRICTED_ENVS* {.importc: "_CS_POSIX_V6_WIDTH_RESTRICTED_ENVS", header: "".}: cint - F_LOCK* {.importc: "F_LOCK", header: "".}: cint - F_TEST* {.importc: "F_TEST", header: "".}: cint - F_TLOCK* {.importc: "F_TLOCK", header: "".}: cint - F_ULOCK* {.importc: "F_ULOCK", header: "".}: cint - PC_2_SYMLINKS* {.importc: "_PC_2_SYMLINKS", header: "".}: cint - PC_ALLOC_SIZE_MIN* {.importc: "_PC_ALLOC_SIZE_MIN", header: "".}: cint - PC_ASYNC_IO* {.importc: "_PC_ASYNC_IO", header: "".}: cint - PC_CHOWN_RESTRICTED* {.importc: "_PC_CHOWN_RESTRICTED", header: "".}: cint - PC_FILESIZEBITS* {.importc: "_PC_FILESIZEBITS", header: "".}: cint - PC_LINK_MAX* {.importc: "_PC_LINK_MAX", header: "".}: cint - PC_MAX_CANON* {.importc: "_PC_MAX_CANON", header: "".}: cint - - PC_MAX_INPUT*{.importc: "_PC_MAX_INPUT", header: "".}: cint - PC_NAME_MAX*{.importc: "_PC_NAME_MAX", header: "".}: cint - PC_NO_TRUNC*{.importc: "_PC_NO_TRUNC", header: "".}: cint - PC_PATH_MAX*{.importc: "_PC_PATH_MAX", header: "".}: cint - PC_PIPE_BUF*{.importc: "_PC_PIPE_BUF", header: "".}: cint - PC_PRIO_IO*{.importc: "_PC_PRIO_IO", header: "".}: cint - PC_REC_INCR_XFER_SIZE*{.importc: "_PC_REC_INCR_XFER_SIZE", header: "".}: cint - PC_REC_MIN_XFER_SIZE*{.importc: "_PC_REC_MIN_XFER_SIZE", header: "".}: cint - PC_REC_XFER_ALIGN*{.importc: "_PC_REC_XFER_ALIGN", header: "".}: cint - PC_SYMLINK_MAX*{.importc: "_PC_SYMLINK_MAX", header: "".}: cint - PC_SYNC_IO*{.importc: "_PC_SYNC_IO", header: "".}: cint - PC_VDISABLE*{.importc: "_PC_VDISABLE", header: "".}: cint - SC_2_C_BIND*{.importc: "_SC_2_C_BIND", header: "".}: cint - SC_2_C_DEV*{.importc: "_SC_2_C_DEV", header: "".}: cint - SC_2_CHAR_TERM*{.importc: "_SC_2_CHAR_TERM", header: "".}: cint - SC_2_FORT_DEV*{.importc: "_SC_2_FORT_DEV", header: "".}: cint - SC_2_FORT_RUN*{.importc: "_SC_2_FORT_RUN", header: "".}: cint - SC_2_LOCALEDEF*{.importc: "_SC_2_LOCALEDEF", header: "".}: cint - SC_2_PBS*{.importc: "_SC_2_PBS", header: "".}: cint - SC_2_PBS_ACCOUNTING*{.importc: "_SC_2_PBS_ACCOUNTING", header: "".}: cint - SC_2_PBS_CHECKPOINT*{.importc: "_SC_2_PBS_CHECKPOINT", header: "".}: cint - SC_2_PBS_LOCATE*{.importc: "_SC_2_PBS_LOCATE", header: "".}: cint - SC_2_PBS_MESSAGE*{.importc: "_SC_2_PBS_MESSAGE", header: "".}: cint - SC_2_PBS_TRACK*{.importc: "_SC_2_PBS_TRACK", header: "".}: cint - SC_2_SW_DEV*{.importc: "_SC_2_SW_DEV", header: "".}: cint - SC_2_UPE*{.importc: "_SC_2_UPE", header: "".}: cint - SC_2_VERSION*{.importc: "_SC_2_VERSION", header: "".}: cint - SC_ADVISORY_INFO*{.importc: "_SC_ADVISORY_INFO", header: "".}: cint - SC_AIO_LISTIO_MAX*{.importc: "_SC_AIO_LISTIO_MAX", header: "".}: cint - SC_AIO_MAX*{.importc: "_SC_AIO_MAX", header: "".}: cint - SC_AIO_PRIO_DELTA_MAX*{.importc: "_SC_AIO_PRIO_DELTA_MAX", header: "".}: cint - SC_ARG_MAX*{.importc: "_SC_ARG_MAX", header: "".}: cint - SC_ASYNCHRONOUS_IO*{.importc: "_SC_ASYNCHRONOUS_IO", header: "".}: cint - SC_ATEXIT_MAX*{.importc: "_SC_ATEXIT_MAX", header: "".}: cint - SC_BARRIERS*{.importc: "_SC_BARRIERS", header: "".}: cint - SC_BC_BASE_MAX*{.importc: "_SC_BC_BASE_MAX", header: "".}: cint - SC_BC_DIM_MAX*{.importc: "_SC_BC_DIM_MAX", header: "".}: cint - SC_BC_SCALE_MAX*{.importc: "_SC_BC_SCALE_MAX", header: "".}: cint - SC_BC_STRING_MAX*{.importc: "_SC_BC_STRING_MAX", header: "".}: cint - SC_CHILD_MAX*{.importc: "_SC_CHILD_MAX", header: "".}: cint - SC_CLK_TCK*{.importc: "_SC_CLK_TCK", header: "".}: cint - SC_CLOCK_SELECTION*{.importc: "_SC_CLOCK_SELECTION", header: "".}: cint - SC_COLL_WEIGHTS_MAX*{.importc: "_SC_COLL_WEIGHTS_MAX", header: "".}: cint - SC_CPUTIME*{.importc: "_SC_CPUTIME", header: "".}: cint - SC_DELAYTIMER_MAX*{.importc: "_SC_DELAYTIMER_MAX", header: "".}: cint - SC_EXPR_NEST_MAX*{.importc: "_SC_EXPR_NEST_MAX", header: "".}: cint - SC_FSYNC*{.importc: "_SC_FSYNC", header: "".}: cint - SC_GETGR_R_SIZE_MAX*{.importc: "_SC_GETGR_R_SIZE_MAX", header: "".}: cint - SC_GETPW_R_SIZE_MAX*{.importc: "_SC_GETPW_R_SIZE_MAX", header: "".}: cint - SC_HOST_NAME_MAX*{.importc: "_SC_HOST_NAME_MAX", header: "".}: cint - SC_IOV_MAX*{.importc: "_SC_IOV_MAX", header: "".}: cint - SC_IPV6*{.importc: "_SC_IPV6", header: "".}: cint - SC_JOB_CONTROL*{.importc: "_SC_JOB_CONTROL", header: "".}: cint - SC_LINE_MAX*{.importc: "_SC_LINE_MAX", header: "".}: cint - SC_LOGIN_NAME_MAX*{.importc: "_SC_LOGIN_NAME_MAX", header: "".}: cint - SC_MAPPED_FILES*{.importc: "_SC_MAPPED_FILES", header: "".}: cint - SC_MEMLOCK*{.importc: "_SC_MEMLOCK", header: "".}: cint - SC_MEMLOCK_RANGE*{.importc: "_SC_MEMLOCK_RANGE", header: "".}: cint - SC_MEMORY_PROTECTION*{.importc: "_SC_MEMORY_PROTECTION", header: "".}: cint - SC_MESSAGE_PASSING*{.importc: "_SC_MESSAGE_PASSING", header: "".}: cint - SC_MONOTONIC_CLOCK*{.importc: "_SC_MONOTONIC_CLOCK", header: "".}: cint - SC_MQ_OPEN_MAX*{.importc: "_SC_MQ_OPEN_MAX", header: "".}: cint - SC_MQ_PRIO_MAX*{.importc: "_SC_MQ_PRIO_MAX", header: "".}: cint - SC_NGROUPS_MAX*{.importc: "_SC_NGROUPS_MAX", header: "".}: cint - SC_OPEN_MAX*{.importc: "_SC_OPEN_MAX", header: "".}: cint - SC_PAGE_SIZE*{.importc: "_SC_PAGE_SIZE", header: "".}: cint - SC_PRIORITIZED_IO*{.importc: "_SC_PRIORITIZED_IO", header: "".}: cint - SC_PRIORITY_SCHEDULING*{.importc: "_SC_PRIORITY_SCHEDULING", header: "".}: cint - SC_RAW_SOCKETS*{.importc: "_SC_RAW_SOCKETS", header: "".}: cint - SC_RE_DUP_MAX*{.importc: "_SC_RE_DUP_MAX", header: "".}: cint - SC_READER_WRITER_LOCKS*{.importc: "_SC_READER_WRITER_LOCKS", header: "".}: cint - SC_REALTIME_SIGNALS*{.importc: "_SC_REALTIME_SIGNALS", header: "".}: cint - SC_REGEXP*{.importc: "_SC_REGEXP", header: "".}: cint - SC_RTSIG_MAX*{.importc: "_SC_RTSIG_MAX", header: "".}: cint - SC_SAVED_IDS*{.importc: "_SC_SAVED_IDS", header: "".}: cint - SC_SEM_NSEMS_MAX*{.importc: "_SC_SEM_NSEMS_MAX", header: "".}: cint - SC_SEM_VALUE_MAX*{.importc: "_SC_SEM_VALUE_MAX", header: "".}: cint - SC_SEMAPHORES*{.importc: "_SC_SEMAPHORES", header: "".}: cint - SC_SHARED_MEMORY_OBJECTS*{.importc: "_SC_SHARED_MEMORY_OBJECTS", header: "".}: cint - SC_SHELL*{.importc: "_SC_SHELL", header: "".}: cint - SC_SIGQUEUE_MAX*{.importc: "_SC_SIGQUEUE_MAX", header: "".}: cint - SC_SPAWN*{.importc: "_SC_SPAWN", header: "".}: cint - SC_SPIN_LOCKS*{.importc: "_SC_SPIN_LOCKS", header: "".}: cint - SC_SPORADIC_SERVER*{.importc: "_SC_SPORADIC_SERVER", header: "".}: cint - SC_SS_REPL_MAX*{.importc: "_SC_SS_REPL_MAX", header: "".}: cint - SC_STREAM_MAX*{.importc: "_SC_STREAM_MAX", header: "".}: cint - SC_SYMLOOP_MAX*{.importc: "_SC_SYMLOOP_MAX", header: "".}: cint - SC_SYNCHRONIZED_IO*{.importc: "_SC_SYNCHRONIZED_IO", header: "".}: cint - SC_THREAD_ATTR_STACKADDR*{.importc: "_SC_THREAD_ATTR_STACKADDR", header: "".}: cint - SC_THREAD_ATTR_STACKSIZE*{.importc: "_SC_THREAD_ATTR_STACKSIZE", header: "".}: cint - SC_THREAD_CPUTIME*{.importc: "_SC_THREAD_CPUTIME", header: "".}: cint - SC_THREAD_DESTRUCTOR_ITERATIONS*{.importc: "_SC_THREAD_DESTRUCTOR_ITERATIONS", header: "".}: cint - SC_THREAD_KEYS_MAX*{.importc: "_SC_THREAD_KEYS_MAX", header: "".}: cint - SC_THREAD_PRIO_INHERIT*{.importc: "_SC_THREAD_PRIO_INHERIT", header: "".}: cint - SC_THREAD_PRIO_PROTECT*{.importc: "_SC_THREAD_PRIO_PROTECT", header: "".}: cint - SC_THREAD_PRIORITY_SCHEDULING*{.importc: "_SC_THREAD_PRIORITY_SCHEDULING", header: "".}: cint - SC_THREAD_PROCESS_SHARED*{.importc: "_SC_THREAD_PROCESS_SHARED", header: "".}: cint - SC_THREAD_SAFE_FUNCTIONS*{.importc: "_SC_THREAD_SAFE_FUNCTIONS", header: "".}: cint - SC_THREAD_SPORADIC_SERVER*{.importc: "_SC_THREAD_SPORADIC_SERVER", header: "".}: cint - SC_THREAD_STACK_MIN*{.importc: "_SC_THREAD_STACK_MIN", header: "".}: cint - SC_THREAD_THREADS_MAX*{.importc: "_SC_THREAD_THREADS_MAX", header: "".}: cint - SC_THREADS*{.importc: "_SC_THREADS", header: "".}: cint - SC_TIMEOUTS*{.importc: "_SC_TIMEOUTS", header: "".}: cint - SC_TIMER_MAX*{.importc: "_SC_TIMER_MAX", header: "".}: cint - SC_TIMERS*{.importc: "_SC_TIMERS", header: "".}: cint - SC_TRACE*{.importc: "_SC_TRACE", header: "".}: cint - SC_TRACE_EVENT_FILTER*{.importc: "_SC_TRACE_EVENT_FILTER", header: "".}: cint - SC_TRACE_EVENT_NAME_MAX*{.importc: "_SC_TRACE_EVENT_NAME_MAX", header: "".}: cint - SC_TRACE_INHERIT*{.importc: "_SC_TRACE_INHERIT", header: "".}: cint - SC_TRACE_LOG*{.importc: "_SC_TRACE_LOG", header: "".}: cint - SC_TRACE_NAME_MAX*{.importc: "_SC_TRACE_NAME_MAX", header: "".}: cint - SC_TRACE_SYS_MAX*{.importc: "_SC_TRACE_SYS_MAX", header: "".}: cint - SC_TRACE_USER_EVENT_MAX*{.importc: "_SC_TRACE_USER_EVENT_MAX", header: "".}: cint - SC_TTY_NAME_MAX*{.importc: "_SC_TTY_NAME_MAX", header: "".}: cint - SC_TYPED_MEMORY_OBJECTS*{.importc: "_SC_TYPED_MEMORY_OBJECTS", header: "".}: cint - SC_TZNAME_MAX*{.importc: "_SC_TZNAME_MAX", header: "".}: cint - SC_V6_ILP32_OFF32*{.importc: "_SC_V6_ILP32_OFF32", header: "".}: cint - SC_V6_ILP32_OFFBIG*{.importc: "_SC_V6_ILP32_OFFBIG", header: "".}: cint - SC_V6_LP64_OFF64*{.importc: "_SC_V6_LP64_OFF64", header: "".}: cint - SC_V6_LPBIG_OFFBIG*{.importc: "_SC_V6_LPBIG_OFFBIG", header: "".}: cint - SC_VERSION*{.importc: "_SC_VERSION", header: "".}: cint - SC_XBS5_ILP32_OFF32*{.importc: "_SC_XBS5_ILP32_OFF32", header: "".}: cint - SC_XBS5_ILP32_OFFBIG*{.importc: "_SC_XBS5_ILP32_OFFBIG", header: "".}: cint - SC_XBS5_LP64_OFF64*{.importc: "_SC_XBS5_LP64_OFF64", header: "".}: cint - SC_XBS5_LPBIG_OFFBIG*{.importc: "_SC_XBS5_LPBIG_OFFBIG", - header: "".}: cint - SC_XOPEN_CRYPT*{.importc: "_SC_XOPEN_CRYPT", header: "".}: cint - SC_XOPEN_ENH_I18N*{.importc: "_SC_XOPEN_ENH_I18N", header: "".}: cint - SC_XOPEN_LEGACY*{.importc: "_SC_XOPEN_LEGACY", header: "".}: cint - SC_XOPEN_REALTIME*{.importc: "_SC_XOPEN_REALTIME", header: "".}: cint - SC_XOPEN_REALTIME_THREADS*{.importc: "_SC_XOPEN_REALTIME_THREADS", - header: "".}: cint - SC_XOPEN_SHM*{.importc: "_SC_XOPEN_SHM", header: "".}: cint - SC_XOPEN_STREAMS*{.importc: "_SC_XOPEN_STREAMS", header: "".}: cint - SC_XOPEN_UNIX*{.importc: "_SC_XOPEN_UNIX", header: "".}: cint - SC_XOPEN_VERSION*{.importc: "_SC_XOPEN_VERSION", header: "".}: cint - SC_NPROCESSORS_ONLN*{.importc: "_SC_NPROCESSORS_ONLN", - header: "".}: cint - - SEM_FAILED* {.importc, header: "".}: pointer - IPC_CREAT* {.importc, header: "".}: cint - ## Create entry if key does not exist. - IPC_EXCL* {.importc, header: "".}: cint - ## Fail if key exists. - IPC_NOWAIT* {.importc, header: "".}: cint - ## Error if request must wait. - - IPC_PRIVATE* {.importc, header: "".}: cint - ## Private key. - - IPC_RMID* {.importc, header: "".}: cint - ## Remove identifier. - IPC_SET* {.importc, header: "".}: cint - ## Set options. - IPC_STAT* {.importc, header: "".}: cint - ## Get options. - - S_IFMT* {.importc, header: "".}: cint - ## Type of file. - S_IFBLK* {.importc, header: "".}: cint - ## Block special. - S_IFCHR* {.importc, header: "".}: cint - ## Character special. - S_IFIFO* {.importc, header: "".}: cint - ## FIFO special. - S_IFREG* {.importc, header: "".}: cint - ## Regular. - S_IFDIR* {.importc, header: "".}: cint - ## Directory. - S_IFLNK* {.importc, header: "".}: cint - ## Symbolic link. - S_IFSOCK* {.importc, header: "".}: cint - ## Socket. - S_IRWXU* {.importc, header: "".}: cint - ## Read, write, execute/search by owner. - S_IRUSR* {.importc, header: "".}: cint - ## Read permission, owner. - S_IWUSR* {.importc, header: "".}: cint - ## Write permission, owner. - S_IXUSR* {.importc, header: "".}: cint - ## Execute/search permission, owner. - S_IRWXG* {.importc, header: "".}: cint - ## Read, write, execute/search by group. - S_IRGRP* {.importc, header: "".}: cint - ## Read permission, group. - S_IWGRP* {.importc, header: "".}: cint - ## Write permission, group. - S_IXGRP* {.importc, header: "".}: cint - ## Execute/search permission, group. - S_IRWXO* {.importc, header: "".}: cint - ## Read, write, execute/search by others. - S_IROTH* {.importc, header: "".}: cint - ## Read permission, others. - S_IWOTH* {.importc, header: "".}: cint - ## Write permission, others. - S_IXOTH* {.importc, header: "".}: cint - ## Execute/search permission, others. - S_ISUID* {.importc, header: "".}: cint - ## Set-user-ID on execution. - S_ISGID* {.importc, header: "".}: cint - ## Set-group-ID on execution. - S_ISVTX* {.importc, header: "".}: cint - ## On directories, restricted deletion flag. - - ST_RDONLY* {.importc, header: "".}: cint - ## Read-only file system. - ST_NOSUID* {.importc, header: "".}: cint - ## Does not support the semantics of the ST_ISUID and ST_ISGID file mode bits. - - PROT_READ* {.importc, header: "".}: cint - ## Page can be read. - PROT_WRITE* {.importc, header: "".}: cint - ## Page can be written. - PROT_EXEC* {.importc, header: "".}: cint - ## Page can be executed. - PROT_NONE* {.importc, header: "".}: cint - ## Page cannot be accessed. - MAP_SHARED* {.importc, header: "".}: cint - ## Share changes. - MAP_PRIVATE* {.importc, header: "".}: cint - ## Changes are private. - MAP_FIXED* {.importc, header: "".}: cint - ## Interpret addr exactly. - MS_ASYNC* {.importc, header: "".}: cint - ## Perform asynchronous writes. - MS_SYNC* {.importc, header: "".}: cint - ## Perform synchronous writes. - MS_INVALIDATE* {.importc, header: "".}: cint - ## Invalidate mappings. - MCL_CURRENT* {.importc, header: "".}: cint - ## Lock currently mapped pages. - MCL_FUTURE* {.importc, header: "".}: cint - ## Lock pages that become mapped. - MAP_FAILED* {.importc, header: "".}: cint - POSIX_MADV_NORMAL* {.importc, header: "".}: cint - ## The application has no advice to give on its behavior with - ## respect to the specified range. It is the default characteristic - ## if no advice is given for a range of memory. - POSIX_MADV_SEQUENTIAL* {.importc, header: "".}: cint - ## The application expects to access the specified range sequentially - ## from lower addresses to higher addresses. - POSIX_MADV_RANDOM* {.importc, header: "".}: cint - ## The application expects to access the specified range in a random order. - POSIX_MADV_WILLNEED* {.importc, header: "".}: cint - ## The application expects to access the specified range in the near future. - POSIX_MADV_DONTNEED* {.importc, header: "".}: cint - POSIX_TYPED_MEM_ALLOCATE* {.importc, header: "".}: cint - POSIX_TYPED_MEM_ALLOCATE_CONTIG* {.importc, header: "".}: cint - POSIX_TYPED_MEM_MAP_ALLOCATABLE* {.importc, header: "".}: cint - - - CLOCKS_PER_SEC* {.importc, header: "".}: int - ## A number used to convert the value returned by the clock() function - ## into seconds. - CLOCK_PROCESS_CPUTIME_ID* {.importc, header: "".}: cint - ## The identifier of the CPU-time clock associated with the process - ## making a clock() or timer*() function call. - CLOCK_THREAD_CPUTIME_ID* {.importc, header: "".}: cint - CLOCK_REALTIME* {.importc, header: "".}: cint - ## The identifier of the system-wide realtime clock. - TIMER_ABSTIME* {.importc, header: "".}: cint - ## Flag indicating time is absolute. For functions taking timer - ## objects, this refers to the clock associated with the timer. - CLOCK_MONOTONIC* {.importc, header: "".}: cint - - WNOHANG* {.importc, header: "".}: cint - ## Do not hang if no status is available; return immediately. - WUNTRACED* {.importc, header: "".}: cint - ## Report status of stopped child process. - WEXITSTATUS* {.importc, header: "".}: cint - ## Return exit status. - WIFCONTINUED* {.importc, header: "".}: cint - ## True if child has been continued. - WIFEXITED* {.importc, header: "".}: cint - ## True if child exited normally. - WIFSIGNALED* {.importc, header: "".}: cint - ## True if child exited due to uncaught signal. - WIFSTOPPED* {.importc, header: "".}: cint - ## True if child is currently stopped. - WSTOPSIG* {.importc, header: "".}: cint - ## Return signal number that caused process to stop. - WTERMSIG* {.importc, header: "".}: cint - ## Return signal number that caused process to terminate. - WEXITED* {.importc, header: "".}: cint - ## Wait for processes that have exited. - WSTOPPED* {.importc, header: "".}: cint - ## Status is returned for any child that has stopped upon receipt of a signal. - WCONTINUED* {.importc, header: "".}: cint - ## Status is returned for any child that was stopped and has been continued. - WNOWAIT* {.importc, header: "".}: cint - ## Keep the process whose status is returned in infop in a waitable state. - P_ALL* {.importc, header: "".}: cint - P_PID* {.importc, header: "".}: cint - P_PGID* {.importc, header: "".}: cint - - SIG_DFL* {.importc, header: "".}: proc (x: cint) {.noconv.} - ## Request for default signal handling. - SIG_ERR* {.importc, header: "".}: proc (x: cint) {.noconv.} - ## Return value from signal() in case of error. - cSIG_HOLD* {.importc: "SIG_HOLD", header: "".}: proc (x: cint) {.noconv.} - ## Request that signal be held. - SIG_IGN* {.importc, header: "".}: proc (x: cint) {.noconv.} - ## Request that signal be ignored. - - SIGEV_NONE* {.importc, header: "".}: cint - SIGEV_SIGNAL* {.importc, header: "".}: cint - SIGEV_THREAD* {.importc, header: "".}: cint - SIGABRT* {.importc, header: "".}: cint - SIGALRM* {.importc, header: "".}: cint - SIGBUS* {.importc, header: "".}: cint - SIGCHLD* {.importc, header: "".}: cint - SIGCONT* {.importc, header: "".}: cint - SIGFPE* {.importc, header: "".}: cint - SIGHUP* {.importc, header: "".}: cint - SIGILL* {.importc, header: "".}: cint - SIGINT* {.importc, header: "".}: cint - SIGKILL* {.importc, header: "".}: cint - SIGPIPE* {.importc, header: "".}: cint - SIGQUIT* {.importc, header: "".}: cint - SIGSEGV* {.importc, header: "".}: cint - SIGSTOP* {.importc, header: "".}: cint - SIGTERM* {.importc, header: "".}: cint - SIGTSTP* {.importc, header: "".}: cint - SIGTTIN* {.importc, header: "".}: cint - SIGTTOU* {.importc, header: "".}: cint - SIGUSR1* {.importc, header: "".}: cint - SIGUSR2* {.importc, header: "".}: cint - SIGPOLL* {.importc, header: "".}: cint - SIGPROF* {.importc, header: "".}: cint - SIGSYS* {.importc, header: "".}: cint - SIGTRAP* {.importc, header: "".}: cint - SIGURG* {.importc, header: "".}: cint - SIGVTALRM* {.importc, header: "".}: cint - SIGXCPU* {.importc, header: "".}: cint - SIGXFSZ* {.importc, header: "".}: cint - SA_NOCLDSTOP* {.importc, header: "".}: cint - SIG_BLOCK* {.importc, header: "".}: cint - SIG_UNBLOCK* {.importc, header: "".}: cint - SIG_SETMASK* {.importc, header: "".}: cint - SA_ONSTACK* {.importc, header: "".}: cint - SA_RESETHAND* {.importc, header: "".}: cint - SA_RESTART* {.importc, header: "".}: cint - SA_SIGINFO* {.importc, header: "".}: cint - SA_NOCLDWAIT* {.importc, header: "".}: cint - SA_NODEFER* {.importc, header: "".}: cint - SS_ONSTACK* {.importc, header: "".}: cint - SS_DISABLE* {.importc, header: "".}: cint - MINSIGSTKSZ* {.importc, header: "".}: cint - SIGSTKSZ* {.importc, header: "".}: cint - - NL_SETD* {.importc, header: "".}: cint - NL_CAT_LOCALE* {.importc, header: "".}: cint - - SCHED_FIFO* {.importc, header: "".}: cint - SCHED_RR* {.importc, header: "".}: cint - SCHED_SPORADIC* {.importc, header: "".}: cint - SCHED_OTHER* {.importc, header: "".}: cint - FD_SETSIZE* {.importc, header: "".}: cint - - SEEK_SET* {.importc, header: "".}: cint - SEEK_CUR* {.importc, header: "".}: cint - SEEK_END* {.importc, header: "".}: cint - - SCM_RIGHTS* {.importc, header: "".}: cint - ## Indicates that the data array contains the access rights - ## to be sent or received. - - SOCK_DGRAM* {.importc, header: "".}: cint ## Datagram socket. - SOCK_RAW* {.importc, header: "".}: cint - ## Raw Protocol Interface. - SOCK_SEQPACKET* {.importc, header: "".}: cint - ## Sequenced-packet socket. - SOCK_STREAM* {.importc, header: "".}: cint - ## Byte-stream socket. - - SOL_SOCKET* {.importc, header: "".}: cint - ## Options to be accessed at socket level, not protocol level. - - SO_ACCEPTCONN* {.importc, header: "".}: cint - ## Socket is accepting connections. - SO_BROADCAST* {.importc, header: "".}: cint - ## Transmission of broadcast messages is supported. - SO_DEBUG* {.importc, header: "".}: cint - ## Debugging information is being recorded. - SO_DONTROUTE* {.importc, header: "".}: cint - ## Bypass normal routing. - SO_ERROR* {.importc, header: "".}: cint - ## Socket error status. - SO_KEEPALIVE* {.importc, header: "".}: cint - ## Connections are kept alive with periodic messages. - SO_LINGER* {.importc, header: "".}: cint - ## Socket lingers on close. - SO_OOBINLINE* {.importc, header: "".}: cint - ## Out-of-band data is transmitted in line. - SO_RCVBUF* {.importc, header: "".}: cint - ## Receive buffer size. - SO_RCVLOWAT* {.importc, header: "".}: cint - ## Receive *low water mark*. - SO_RCVTIMEO* {.importc, header: "".}: cint - ## Receive timeout. - SO_REUSEADDR* {.importc, header: "".}: cint - ## Reuse of local addresses is supported. - SO_SNDBUF* {.importc, header: "".}: cint - ## Send buffer size. - SO_SNDLOWAT* {.importc, header: "".}: cint - ## Send *low water mark*. - SO_SNDTIMEO* {.importc, header: "".}: cint - ## Send timeout. - SO_TYPE* {.importc, header: "".}: cint - ## Socket type. - - SOMAXCONN* {.importc, header: "".}: cint - ## The maximum backlog queue length. - - MSG_CTRUNC* {.importc, header: "".}: cint - ## Control data truncated. - MSG_DONTROUTE* {.importc, header: "".}: cint - ## Send without using routing tables. - MSG_EOR* {.importc, header: "".}: cint - ## Terminates a record (if supported by the protocol). - MSG_OOB* {.importc, header: "".}: cint - ## Out-of-band data. - MSG_PEEK* {.importc, header: "".}: cint - ## Leave received data in queue. - MSG_TRUNC* {.importc, header: "".}: cint - ## Normal data truncated. - MSG_WAITALL* {.importc, header: "".}: cint - ## Attempt to fill the read buffer. - - AF_INET* {.importc, header: "".}: cint - ## Internet domain sockets for use with IPv4 addresses. - AF_INET6* {.importc, header: "".}: cint - ## Internet domain sockets for use with IPv6 addresses. - AF_UNIX* {.importc, header: "".}: cint - ## UNIX domain sockets. - AF_UNSPEC* {.importc, header: "".}: cint - ## Unspecified. - - SHUT_RD* {.importc, header: "".}: cint - ## Disables further receive operations. - SHUT_RDWR* {.importc, header: "".}: cint - ## Disables further send and receive operations. - SHUT_WR* {.importc, header: "".}: cint - ## Disables further send operations. - - IF_NAMESIZE* {.importc, header: "".}: cint - - IPPROTO_IP* {.importc, header: "".}: cint - ## Internet protocol. - IPPROTO_IPV6* {.importc, header: "".}: cint - ## Internet Protocol Version 6. - IPPROTO_ICMP* {.importc, header: "".}: cint - ## Control message protocol. - IPPROTO_RAW* {.importc, header: "".}: cint - ## Raw IP Packets Protocol. - IPPROTO_TCP* {.importc, header: "".}: cint - ## Transmission control protocol. - IPPROTO_UDP* {.importc, header: "".}: cint - ## User datagram protocol. - - INADDR_ANY* {.importc, header: "".}: TinAddrScalar - ## IPv4 local host address. - INADDR_BROADCAST* {.importc, header: "".}: TinAddrScalar - ## IPv4 broadcast address. - - INET_ADDRSTRLEN* {.importc, header: "".}: cint - ## 16. Length of the string form for IP. - - IPV6_JOIN_GROUP* {.importc, header: "".}: cint - ## Join a multicast group. - IPV6_LEAVE_GROUP* {.importc, header: "".}: cint - ## Quit a multicast group. - IPV6_MULTICAST_HOPS* {.importc, header: "".}: cint - ## Multicast hop limit. - IPV6_MULTICAST_IF* {.importc, header: "".}: cint - ## Interface to use for outgoing multicast packets. - IPV6_MULTICAST_LOOP* {.importc, header: "".}: cint - ## Multicast packets are delivered back to the local application. - IPV6_UNICAST_HOPS* {.importc, header: "".}: cint - ## Unicast hop limit. - IPV6_V6ONLY* {.importc, header: "".}: cint - ## Restrict AF_INET6 socket to IPv6 communications only. - - TCP_NODELAY* {.importc, header: "".}: cint - ## Avoid coalescing of small segments. - - IPPORT_RESERVED* {.importc, header: "".}: cint - - HOST_NOT_FOUND* {.importc, header: "".}: cint - NO_DATA* {.importc, header: "".}: cint - NO_RECOVERY* {.importc, header: "".}: cint - TRY_AGAIN* {.importc, header: "".}: cint - - AI_PASSIVE* {.importc, header: "".}: cint - ## Socket address is intended for bind(). - AI_CANONNAME* {.importc, header: "".}: cint - ## Request for canonical name. - AI_NUMERICHOST* {.importc, header: "".}: cint - ## Return numeric host address as name. - AI_NUMERICSERV* {.importc, header: "".}: cint - ## Inhibit service name resolution. - AI_V4MAPPED* {.importc, header: "".}: cint - ## If no IPv6 addresses are found, query for IPv4 addresses and - ## return them to the caller as IPv4-mapped IPv6 addresses. - AI_ALL* {.importc, header: "".}: cint - ## Query for both IPv4 and IPv6 addresses. - AI_ADDRCONFIG* {.importc, header: "".}: cint - ## Query for IPv4 addresses only when an IPv4 address is configured; - ## query for IPv6 addresses only when an IPv6 address is configured. - - NI_NOFQDN* {.importc, header: "".}: cint - ## Only the nodename portion of the FQDN is returned for local hosts. - NI_NUMERICHOST* {.importc, header: "".}: cint - ## The numeric form of the node's address is returned instead of its name. - NI_NAMEREQD* {.importc, header: "".}: cint - ## Return an error if the node's name cannot be located in the database. - NI_NUMERICSERV* {.importc, header: "".}: cint - ## The numeric form of the service address is returned instead of its name. - NI_NUMERICSCOPE* {.importc, header: "".}: cint - ## For IPv6 addresses, the numeric form of the scope identifier is - ## returned instead of its name. - NI_DGRAM* {.importc, header: "".}: cint - ## Indicates that the service is a datagram service (SOCK_DGRAM). - - EAI_AGAIN* {.importc, header: "".}: cint - ## The name could not be resolved at this time. Future attempts may succeed. - EAI_BADFLAGS* {.importc, header: "".}: cint - ## The flags had an invalid value. - EAI_FAIL* {.importc, header: "".}: cint - ## A non-recoverable error occurred. - EAI_FAMILY* {.importc, header: "".}: cint - ## The address family was not recognized or the address length - ## was invalid for the specified family. - EAI_MEMORY* {.importc, header: "".}: cint - ## There was a memory allocation failure. - EAI_NONAME* {.importc, header: "".}: cint - ## The name does not resolve for the supplied parameters. - ## NI_NAMEREQD is set and the host's name cannot be located, - ## or both nodename and servname were null. - EAI_SERVICE* {.importc, header: "".}: cint - ## The service passed was not recognized for the specified socket type. - EAI_SOCKTYPE* {.importc, header: "".}: cint - ## The intended socket type was not recognized. - EAI_SYSTEM* {.importc, header: "".}: cint - ## A system error occurred. The error code can be found in errno. - EAI_OVERFLOW* {.importc, header: "".}: cint - ## An argument buffer overflowed. - - POLLIN* {.importc, header: "".}: cshort - ## Data other than high-priority data may be read without blocking. - POLLRDNORM* {.importc, header: "".}: cshort - ## Normal data may be read without blocking. - POLLRDBAND* {.importc, header: "".}: cshort - ## Priority data may be read without blocking. - POLLPRI* {.importc, header: "".}: cshort - ## High priority data may be read without blocking. - POLLOUT* {.importc, header: "".}: cshort - ## Normal data may be written without blocking. - POLLWRNORM* {.importc, header: "".}: cshort - ## Equivalent to POLLOUT. - POLLWRBAND* {.importc, header: "".}: cshort - ## Priority data may be written. - POLLERR* {.importc, header: "".}: cshort - ## An error has occurred (revents only). - POLLHUP* {.importc, header: "".}: cshort - ## Device has been disconnected (revents only). - POLLNVAL* {.importc, header: "".}: cshort - ## Invalid fd member (revents only). - - -when hasSpawnh: - var - POSIX_SPAWN_RESETIDS* {.importc, header: "".}: cint - POSIX_SPAWN_SETPGROUP* {.importc, header: "".}: cint - POSIX_SPAWN_SETSCHEDPARAM* {.importc, header: "".}: cint - POSIX_SPAWN_SETSCHEDULER* {.importc, header: "".}: cint - POSIX_SPAWN_SETSIGDEF* {.importc, header: "".}: cint - POSIX_SPAWN_SETSIGMASK* {.importc, header: "".}: cint - -when hasAioH: - proc aio_cancel*(a1: cint, a2: ptr Taiocb): cint {.importc, header: "".} - proc aio_error*(a1: ptr Taiocb): cint {.importc, header: "".} - proc aio_fsync*(a1: cint, a2: ptr Taiocb): cint {.importc, header: "".} - proc aio_read*(a1: ptr Taiocb): cint {.importc, header: "".} - proc aio_return*(a1: ptr Taiocb): int {.importc, header: "".} - proc aio_suspend*(a1: ptr ptr Taiocb, a2: cint, a3: ptr ttimespec): cint {. - importc, header: "".} - proc aio_write*(a1: ptr Taiocb): cint {.importc, header: "".} - proc lio_listio*(a1: cint, a2: ptr ptr Taiocb, a3: cint, - a4: ptr Tsigevent): cint {.importc, header: "".} - -# arpa/inet.h -proc htonl*(a1: int32): int32 {.importc, header: "".} -proc htons*(a1: int16): int16 {.importc, header: "".} -proc ntohl*(a1: int32): int32 {.importc, header: "".} -proc ntohs*(a1: int16): int16 {.importc, header: "".} - -proc inet_addr*(a1: cstring): int32 {.importc, header: "".} -proc inet_ntoa*(a1: int32): cstring {.importc, header: "".} -proc inet_ntop*(a1: cint, a2: pointer, a3: cstring, a4: int32): cstring {.importc, header: "".} -proc inet_pton*(a1: cint, a2: cstring, a3: pointer): cint {.importc, header: "".} - -var - in6addr_any* {.importc, header: "".}: TIn6Addr - in6addr_loopback* {.importc, header: "".}: TIn6Addr - -proc IN6ADDR_ANY_INIT* (): TIn6Addr {.importc, header: "".} -proc IN6ADDR_LOOPBACK_INIT* (): TIn6Addr {.importc, header: "".} - -# dirent.h -proc closedir*(a1: ptr TDIR): cint {.importc, header: "".} -proc opendir*(a1: cstring): ptr TDir {.importc, header: "".} -proc readdir*(a1: ptr TDIR): ptr TDirent {.importc, header: "".} -proc readdir_r*(a1: ptr TDIR, a2: ptr Tdirent, a3: ptr ptr TDirent): cint {. - importc, header: "".} -proc rewinddir*(a1: ptr TDIR) {.importc, header: "".} -proc seekdir*(a1: ptr TDIR, a2: int) {.importc, header: "".} -proc telldir*(a1: ptr TDIR): int {.importc, header: "".} - -# dlfcn.h -proc dlclose*(a1: pointer): cint {.importc, header: "".} -proc dlerror*(): cstring {.importc, header: "".} -proc dlopen*(a1: cstring, a2: cint): pointer {.importc, header: "".} -proc dlsym*(a1: pointer, a2: cstring): pointer {.importc, header: "".} - -proc creat*(a1: cstring, a2: Tmode): cint {.importc, header: "".} -proc fcntl*(a1: cint, a2: cint): cint {.varargs, importc, header: "".} -proc open*(a1: cstring, a2: cint): cint {.varargs, importc, header: "".} -proc posix_fadvise*(a1: cint, a2, a3: Toff, a4: cint): cint {.importc, header: "".} -proc posix_fallocate*(a1: cint, a2, a3: Toff): cint {.importc, header: "".} - -proc feclearexcept*(a1: cint): cint {.importc, header: "".} -proc fegetexceptflag*(a1: ptr Tfexcept, a2: cint): cint {.importc, header: "".} -proc feraiseexcept*(a1: cint): cint {.importc, header: "".} -proc fesetexceptflag*(a1: ptr Tfexcept, a2: cint): cint {.importc, header: "".} -proc fetestexcept*(a1: cint): cint {.importc, header: "".} -proc fegetround*(): cint {.importc, header: "".} -proc fesetround*(a1: cint): cint {.importc, header: "".} -proc fegetenv*(a1: ptr Tfenv): cint {.importc, header: "".} -proc feholdexcept*(a1: ptr Tfenv): cint {.importc, header: "".} -proc fesetenv*(a1: ptr Tfenv): cint {.importc, header: "".} -proc feupdateenv*(a1: ptr TFenv): cint {.importc, header: "".} - -proc fmtmsg*(a1: int, a2: cstring, a3: cint, - a4, a5, a6: cstring): cint {.importc, header: "".} - -proc fnmatch*(a1, a2: cstring, a3: cint): cint {.importc, header: "".} -proc ftw*(a1: cstring, - a2: proc (x1: cstring, x2: ptr TStat, x3: cint): cint {.noconv.}, - a3: cint): cint {.importc, header: "".} -proc nftw*(a1: cstring, - a2: proc (x1: cstring, x2: ptr TStat, x3: cint, x4: ptr TFTW): cint {.noconv.}, - a3: cint, - a4: cint): cint {.importc, header: "".} - -proc glob*(a1: cstring, a2: cint, - a3: proc (x1: cstring, x2: cint): cint {.noconv.}, - a4: ptr Tglob): cint {.importc, header: "".} -proc globfree*(a1: ptr TGlob) {.importc, header: "".} - -proc getgrgid*(a1: TGid): ptr TGroup {.importc, header: "".} -proc getgrnam*(a1: cstring): ptr TGroup {.importc, header: "".} -proc getgrgid_r*(a1: Tgid, a2: ptr TGroup, a3: cstring, a4: int, - a5: ptr ptr TGroup): cint {.importc, header: "".} -proc getgrnam_r*(a1: cstring, a2: ptr TGroup, a3: cstring, - a4: int, a5: ptr ptr TGroup): cint {.importc, header: "".} -proc getgrent*(): ptr TGroup {.importc, header: "".} -proc endgrent*() {.importc, header: "".} -proc setgrent*() {.importc, header: "".} - - -proc iconv_open*(a1, a2: cstring): TIconv {.importc, header: "".} -proc iconv*(a1: Ticonv, a2: var cstring, a3: var int, a4: var cstring, - a5: var int): int {.importc, header: "".} -proc iconv_close*(a1: Ticonv): cint {.importc, header: "".} - -proc nl_langinfo*(a1: Tnl_item): cstring {.importc, header: "".} - -proc basename*(a1: cstring): cstring {.importc, header: "".} -proc dirname*(a1: cstring): cstring {.importc, header: "".} - -proc localeconv*(): ptr Tlconv {.importc, header: "".} -proc setlocale*(a1: cint, a2: cstring): cstring {. - importc, header: "".} - -proc strfmon*(a1: cstring, a2: int, a3: cstring): int {.varargs, - importc, header: "".} - -proc mq_close*(a1: Tmqd): cint {.importc, header: "".} -proc mq_getattr*(a1: Tmqd, a2: ptr Tmq_attr): cint {.importc, header: "".} -proc mq_notify*(a1: Tmqd, a2: ptr Tsigevent): cint {.importc, header: "".} -proc mq_open*(a1: cstring, a2: cint): TMqd {.varargs, importc, header: "".} -proc mq_receive*(a1: Tmqd, a2: cstring, a3: int, a4: var int): int {.importc, header: "".} -proc mq_send*(a1: Tmqd, a2: cstring, a3: int, a4: int): cint {.importc, header: "".} -proc mq_setattr*(a1: Tmqd, a2, a3: ptr Tmq_attr): cint {.importc, header: "".} - -proc mq_timedreceive*(a1: Tmqd, a2: cstring, a3: int, a4: int, - a5: ptr TTimespec): int {.importc, header: "".} -proc mq_timedsend*(a1: Tmqd, a2: cstring, a3: int, a4: int, - a5: ptr TTimeSpec): cint {.importc, header: "".} -proc mq_unlink*(a1: cstring): cint {.importc, header: "".} - - -proc getpwnam*(a1: cstring): ptr TPasswd {.importc, header: "".} -proc getpwuid*(a1: Tuid): ptr TPasswd {.importc, header: "".} -proc getpwnam_r*(a1: cstring, a2: ptr Tpasswd, a3: cstring, a4: int, - a5: ptr ptr Tpasswd): cint {.importc, header: "".} -proc getpwuid_r*(a1: Tuid, a2: ptr Tpasswd, a3: cstring, - a4: int, a5: ptr ptr Tpasswd): cint {.importc, header: "".} -proc endpwent*() {.importc, header: "".} -proc getpwent*(): ptr TPasswd {.importc, header: "".} -proc setpwent*() {.importc, header: "".} - -proc uname*(a1: var Tutsname): cint {.importc, header: "".} - -proc pthread_atfork*(a1, a2, a3: proc {.noconv.}): cint {.importc, header: "".} -proc pthread_attr_destroy*(a1: ptr Tpthread_attr): cint {.importc, header: "".} -proc pthread_attr_getdetachstate*(a1: ptr Tpthread_attr, a2: cint): cint {.importc, header: "".} -proc pthread_attr_getguardsize*(a1: ptr Tpthread_attr, a2: var cint): cint {.importc, header: "".} -proc pthread_attr_getinheritsched*(a1: ptr Tpthread_attr, - a2: var cint): cint {.importc, header: "".} -proc pthread_attr_getschedparam*(a1: ptr Tpthread_attr, - a2: ptr Tsched_param): cint {.importc, header: "".} -proc pthread_attr_getschedpolicy*(a1: ptr Tpthread_attr, - a2: var cint): cint {.importc, header: "".} -proc pthread_attr_getscope*(a1: ptr Tpthread_attr, - a2: var cint): cint {.importc, header: "".} -proc pthread_attr_getstack*(a1: ptr Tpthread_attr, - a2: var pointer, a3: var int): cint {.importc, header: "".} -proc pthread_attr_getstackaddr*(a1: ptr Tpthread_attr, - a2: var pointer): cint {.importc, header: "".} -proc pthread_attr_getstacksize*(a1: ptr Tpthread_attr, - a2: var int): cint {.importc, header: "".} -proc pthread_attr_init*(a1: ptr Tpthread_attr): cint {.importc, header: "".} -proc pthread_attr_setdetachstate*(a1: ptr Tpthread_attr, a2: cint): cint {.importc, header: "".} -proc pthread_attr_setguardsize*(a1: ptr Tpthread_attr, a2: int): cint {.importc, header: "".} -proc pthread_attr_setinheritsched*(a1: ptr Tpthread_attr, a2: cint): cint {.importc, header: "".} -proc pthread_attr_setschedparam*(a1: ptr Tpthread_attr, - a2: ptr Tsched_param): cint {.importc, header: "".} -proc pthread_attr_setschedpolicy*(a1: ptr Tpthread_attr, a2: cint): cint {.importc, header: "".} -proc pthread_attr_setscope*(a1: ptr Tpthread_attr, a2: cint): cint {.importc, header: "".} -proc pthread_attr_setstack*(a1: ptr Tpthread_attr, a2: pointer, a3: int): cint {.importc, header: "".} -proc pthread_attr_setstackaddr*(a1: ptr TPthread_attr, a2: pointer): cint {.importc, header: "".} -proc pthread_attr_setstacksize*(a1: ptr TPthread_attr, a2: int): cint {.importc, header: "".} -proc pthread_barrier_destroy*(a1: ptr Tpthread_barrier): cint {.importc, header: "".} -proc pthread_barrier_init*(a1: ptr Tpthread_barrier, - a2: ptr Tpthread_barrierattr, a3: cint): cint {.importc, header: "".} -proc pthread_barrier_wait*(a1: ptr Tpthread_barrier): cint {.importc, header: "".} -proc pthread_barrierattr_destroy*(a1: ptr Tpthread_barrierattr): cint {.importc, header: "".} -proc pthread_barrierattr_getpshared*( - a1: ptr Tpthread_barrierattr, a2: var cint): cint {.importc, header: "".} -proc pthread_barrierattr_init*(a1: ptr TPthread_barrierattr): cint {.importc, header: "".} -proc pthread_barrierattr_setpshared*(a1: ptr TPthread_barrierattr, a2: cint): cint {.importc, header: "".} -proc pthread_cancel*(a1: Tpthread): cint {.importc, header: "".} -proc pthread_cleanup_push*(a1: proc (x: pointer) {.noconv.}, a2: pointer) {.importc, header: "".} -proc pthread_cleanup_pop*(a1: cint) {.importc, header: "".} -proc pthread_cond_broadcast*(a1: ptr Tpthread_cond): cint {.importc, header: "".} -proc pthread_cond_destroy*(a1: ptr Tpthread_cond): cint {.importc, header: "".} -proc pthread_cond_init*(a1: ptr Tpthread_cond, - a2: ptr Tpthread_condattr): cint {.importc, header: "".} -proc pthread_cond_signal*(a1: ptr Tpthread_cond): cint {.importc, header: "".} -proc pthread_cond_timedwait*(a1: ptr Tpthread_cond, - a2: ptr Tpthread_mutex, a3: ptr Ttimespec): cint {.importc, header: "".} - -proc pthread_cond_wait*(a1: ptr Tpthread_cond, - a2: ptr Tpthread_mutex): cint {.importc, header: "".} -proc pthread_condattr_destroy*(a1: ptr Tpthread_condattr): cint {.importc, header: "".} -proc pthread_condattr_getclock*(a1: ptr Tpthread_condattr, - a2: var Tclockid): cint {.importc, header: "".} -proc pthread_condattr_getpshared*(a1: ptr Tpthread_condattr, - a2: var cint): cint {.importc, header: "".} - -proc pthread_condattr_init*(a1: ptr TPthread_condattr): cint {.importc, header: "".} -proc pthread_condattr_setclock*(a1: ptr TPthread_condattr,a2: Tclockid): cint {.importc, header: "".} -proc pthread_condattr_setpshared*(a1: ptr TPthread_condattr, a2: cint): cint {.importc, header: "".} - -proc pthread_create*(a1: ptr Tpthread, a2: ptr Tpthread_attr, - a3: proc (x: pointer): pointer {.noconv.}, a4: pointer): cint {.importc, header: "".} -proc pthread_detach*(a1: Tpthread): cint {.importc, header: "".} -proc pthread_equal*(a1, a2: Tpthread): cint {.importc, header: "".} -proc pthread_exit*(a1: pointer) {.importc, header: "".} -proc pthread_getconcurrency*(): cint {.importc, header: "".} -proc pthread_getcpuclockid*(a1: Tpthread, a2: var Tclockid): cint {.importc, header: "".} -proc pthread_getschedparam*(a1: Tpthread, a2: var cint, - a3: ptr Tsched_param): cint {.importc, header: "".} -proc pthread_getspecific*(a1: Tpthread_key): pointer {.importc, header: "".} -proc pthread_join*(a1: Tpthread, a2: ptr pointer): cint {.importc, header: "".} -proc pthread_key_create*(a1: ptr Tpthread_key, a2: proc (x: pointer) {.noconv.}): cint {.importc, header: "".} -proc pthread_key_delete*(a1: Tpthread_key): cint {.importc, header: "".} - -proc pthread_mutex_destroy*(a1: ptr Tpthread_mutex): cint {.importc, header: "".} -proc pthread_mutex_getprioceiling*(a1: ptr Tpthread_mutex, - a2: var cint): cint {.importc, header: "".} -proc pthread_mutex_init*(a1: ptr Tpthread_mutex, - a2: ptr Tpthread_mutexattr): cint {.importc, header: "".} -proc pthread_mutex_lock*(a1: ptr Tpthread_mutex): cint {.importc, header: "".} -proc pthread_mutex_setprioceiling*(a1: ptr Tpthread_mutex,a2: cint, - a3: var cint): cint {.importc, header: "".} -proc pthread_mutex_timedlock*(a1: ptr Tpthread_mutex, - a2: ptr Ttimespec): cint {.importc, header: "".} -proc pthread_mutex_trylock*(a1: ptr Tpthread_mutex): cint {.importc, header: "".} -proc pthread_mutex_unlock*(a1: ptr Tpthread_mutex): cint {.importc, header: "".} -proc pthread_mutexattr_destroy*(a1: ptr Tpthread_mutexattr): cint {.importc, header: "".} - -proc pthread_mutexattr_getprioceiling*( - a1: ptr Tpthread_mutexattr, a2: var cint): cint {.importc, header: "".} -proc pthread_mutexattr_getprotocol*(a1: ptr Tpthread_mutexattr, - a2: var cint): cint {.importc, header: "".} -proc pthread_mutexattr_getpshared*(a1: ptr Tpthread_mutexattr, - a2: var cint): cint {.importc, header: "".} -proc pthread_mutexattr_gettype*(a1: ptr Tpthread_mutexattr, - a2: var cint): cint {.importc, header: "".} - -proc pthread_mutexattr_init*(a1: ptr Tpthread_mutexattr): cint {.importc, header: "".} -proc pthread_mutexattr_setprioceiling*(a1: ptr tpthread_mutexattr, a2: cint): cint {.importc, header: "".} -proc pthread_mutexattr_setprotocol*(a1: ptr Tpthread_mutexattr, a2: cint): cint {.importc, header: "".} -proc pthread_mutexattr_setpshared*(a1: ptr Tpthread_mutexattr, a2: cint): cint {.importc, header: "".} -proc pthread_mutexattr_settype*(a1: ptr Tpthread_mutexattr, a2: cint): cint {.importc, header: "".} - -proc pthread_once*(a1: ptr Tpthread_once, a2: proc {.noconv.}): cint {.importc, header: "".} - -proc pthread_rwlock_destroy*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlock_init*(a1: ptr Tpthread_rwlock, - a2: ptr Tpthread_rwlockattr): cint {.importc, header: "".} -proc pthread_rwlock_rdlock*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlock_timedrdlock*(a1: ptr Tpthread_rwlock, - a2: ptr Ttimespec): cint {.importc, header: "".} -proc pthread_rwlock_timedwrlock*(a1: ptr Tpthread_rwlock, - a2: ptr Ttimespec): cint {.importc, header: "".} - -proc pthread_rwlock_tryrdlock*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlock_trywrlock*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlock_unlock*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlock_wrlock*(a1: ptr Tpthread_rwlock): cint {.importc, header: "".} -proc pthread_rwlockattr_destroy*(a1: ptr Tpthread_rwlockattr): cint {.importc, header: "".} -proc pthread_rwlockattr_getpshared*( - a1: ptr Tpthread_rwlockattr, a2: var cint): cint {.importc, header: "".} -proc pthread_rwlockattr_init*(a1: ptr Tpthread_rwlockattr): cint {.importc, header: "".} -proc pthread_rwlockattr_setpshared*(a1: ptr Tpthread_rwlockattr, a2: cint): cint {.importc, header: "".} - -proc pthread_self*(): Tpthread {.importc, header: "".} -proc pthread_setcancelstate*(a1: cint, a2: var cint): cint {.importc, header: "".} -proc pthread_setcanceltype*(a1: cint, a2: var cint): cint {.importc, header: "".} -proc pthread_setconcurrency*(a1: cint): cint {.importc, header: "".} -proc pthread_setschedparam*(a1: Tpthread, a2: cint, - a3: ptr Tsched_param): cint {.importc, header: "".} - -proc pthread_setschedprio*(a1: Tpthread, a2: cint): cint {. - importc, header: "".} -proc pthread_setspecific*(a1: Tpthread_key, a2: pointer): cint {. - importc, header: "".} -proc pthread_spin_destroy*(a1: ptr Tpthread_spinlock): cint {. - importc, header: "".} -proc pthread_spin_init*(a1: ptr Tpthread_spinlock, a2: cint): cint {. - importc, header: "".} -proc pthread_spin_lock*(a1: ptr Tpthread_spinlock): cint {. - importc, header: "".} -proc pthread_spin_trylock*(a1: ptr Tpthread_spinlock): cint{. - importc, header: "".} -proc pthread_spin_unlock*(a1: ptr Tpthread_spinlock): cint {. - importc, header: "".} -proc pthread_testcancel*() {.importc, header: "".} - - -proc access*(a1: cstring, a2: cint): cint {.importc, header: "".} -proc alarm*(a1: cint): cint {.importc, header: "".} -proc chdir*(a1: cstring): cint {.importc, header: "".} -proc chown*(a1: cstring, a2: Tuid, a3: Tgid): cint {.importc, header: "".} -proc close*(a1: cint): cint {.importc, header: "".} -proc confstr*(a1: cint, a2: cstring, a3: int): int {.importc, header: "".} -proc crypt*(a1, a2: cstring): cstring {.importc, header: "".} -proc ctermid*(a1: cstring): cstring {.importc, header: "".} -proc dup*(a1: cint): cint {.importc, header: "".} -proc dup2*(a1, a2: cint): cint {.importc, header: "".} -proc encrypt*(a1: array[0..63, char], a2: cint) {.importc, header: "".} - -proc execl*(a1, a2: cstring): cint {.varargs, importc, header: "".} -proc execle*(a1, a2: cstring): cint {.varargs, importc, header: "".} -proc execlp*(a1, a2: cstring): cint {.varargs, importc, header: "".} -proc execv*(a1: cstring, a2: cstringArray): cint {.importc, header: "".} -proc execve*(a1: cstring, a2, a3: cstringArray): cint {. - importc, header: "".} -proc execvp*(a1: cstring, a2: cstringArray): cint {.importc, header: "".} -proc fchown*(a1: cint, a2: Tuid, a3: Tgid): cint {.importc, header: "".} -proc fchdir*(a1: cint): cint {.importc, header: "".} -proc fdatasync*(a1: cint): cint {.importc, header: "".} -proc fork*(): Tpid {.importc, header: "".} -proc fpathconf*(a1, a2: cint): int {.importc, header: "".} -proc fsync*(a1: cint): cint {.importc, header: "".} -proc ftruncate*(a1: cint, a2: Toff): cint {.importc, header: "".} -proc getcwd*(a1: cstring, a2: int): cstring {.importc, header: "".} -proc getegid*(): TGid {.importc, header: "".} -proc geteuid*(): TUid {.importc, header: "".} -proc getgid*(): TGid {.importc, header: "".} - -proc getgroups*(a1: cint, a2: ptr array[0..255, Tgid]): cint {. - importc, header: "".} -proc gethostid*(): int {.importc, header: "".} -proc gethostname*(a1: cstring, a2: int): cint {.importc, header: "".} -proc getlogin*(): cstring {.importc, header: "".} -proc getlogin_r*(a1: cstring, a2: int): cint {.importc, header: "".} - -proc getopt*(a1: cint, a2: cstringArray, a3: cstring): cint {. - importc, header: "".} -proc getpgid*(a1: Tpid): Tpid {.importc, header: "".} -proc getpgrp*(): Tpid {.importc, header: "".} -proc getpid*(): Tpid {.importc, header: "".} -proc getppid*(): Tpid {.importc, header: "".} -proc getsid*(a1: Tpid): Tpid {.importc, header: "".} -proc getuid*(): Tuid {.importc, header: "".} -proc getwd*(a1: cstring): cstring {.importc, header: "".} -proc isatty*(a1: cint): cint {.importc, header: "".} -proc lchown*(a1: cstring, a2: Tuid, a3: Tgid): cint {.importc, header: "".} -proc link*(a1, a2: cstring): cint {.importc, header: "".} - -proc lockf*(a1, a2: cint, a3: Toff): cint {.importc, header: "".} -proc lseek*(a1: cint, a2: Toff, a3: cint): Toff {.importc, header: "".} -proc nice*(a1: cint): cint {.importc, header: "".} -proc pathconf*(a1: cstring, a2: cint): int {.importc, header: "".} - -proc pause*(): cint {.importc, header: "".} -proc pipe*(a: array[0..1, cint]): cint {.importc, header: "".} -proc pread*(a1: cint, a2: pointer, a3: int, a4: Toff): int {. - importc, header: "".} -proc pwrite*(a1: cint, a2: pointer, a3: int, a4: Toff): int {. - importc, header: "".} -proc read*(a1: cint, a2: pointer, a3: int): int {.importc, header: "".} -proc readlink*(a1, a2: cstring, a3: int): int {.importc, header: "".} - -proc rmdir*(a1: cstring): cint {.importc, header: "".} -proc setegid*(a1: Tgid): cint {.importc, header: "".} -proc seteuid*(a1: Tuid): cint {.importc, header: "".} -proc setgid*(a1: Tgid): cint {.importc, header: "".} - -proc setpgid*(a1, a2: Tpid): cint {.importc, header: "".} -proc setpgrp*(): Tpid {.importc, header: "".} -proc setregid*(a1, a2: Tgid): cint {.importc, header: "".} -proc setreuid*(a1, a2: Tuid): cint {.importc, header: "".} -proc setsid*(): Tpid {.importc, header: "".} -proc setuid*(a1: Tuid): cint {.importc, header: "".} -proc sleep*(a1: cint): cint {.importc, header: "".} -proc swab*(a1, a2: pointer, a3: int) {.importc, header: "".} -proc symlink*(a1, a2: cstring): cint {.importc, header: "".} -proc sync*() {.importc, header: "".} -proc sysconf*(a1: cint): int {.importc, header: "".} -proc tcgetpgrp*(a1: cint): tpid {.importc, header: "".} -proc tcsetpgrp*(a1: cint, a2: Tpid): cint {.importc, header: "".} -proc truncate*(a1: cstring, a2: Toff): cint {.importc, header: "".} -proc ttyname*(a1: cint): cstring {.importc, header: "".} -proc ttyname_r*(a1: cint, a2: cstring, a3: int): cint {. - importc, header: "".} -proc ualarm*(a1, a2: Tuseconds): Tuseconds {.importc, header: "".} -proc unlink*(a1: cstring): cint {.importc, header: "".} -proc usleep*(a1: Tuseconds): cint {.importc, header: "".} -proc vfork*(): tpid {.importc, header: "".} -proc write*(a1: cint, a2: pointer, a3: int): int {.importc, header: "".} - -proc sem_close*(a1: ptr Tsem): cint {.importc, header: "".} -proc sem_destroy*(a1: ptr Tsem): cint {.importc, header: "".} -proc sem_getvalue*(a1: ptr Tsem, a2: var cint): cint {. - importc, header: "".} -proc sem_init*(a1: ptr Tsem, a2: cint, a3: cint): cint {. - importc, header: "".} -proc sem_open*(a1: cstring, a2: cint): ptr TSem {. - varargs, importc, header: "".} -proc sem_post*(a1: ptr Tsem): cint {.importc, header: "".} -proc sem_timedwait*(a1: ptr Tsem, a2: ptr Ttimespec): cint {. - importc, header: "".} -proc sem_trywait*(a1: ptr Tsem): cint {.importc, header: "".} -proc sem_unlink*(a1: cstring): cint {.importc, header: "".} -proc sem_wait*(a1: ptr Tsem): cint {.importc, header: "".} - -proc ftok*(a1: cstring, a2: cint): Tkey {.importc, header: "".} - -proc statvfs*(a1: cstring, a2: var Tstatvfs): cint {. - importc, header: "".} -proc fstatvfs*(a1: cint, a2: var Tstatvfs): cint {. - importc, header: "".} - -proc chmod*(a1: cstring, a2: TMode): cint {.importc, header: "".} -proc fchmod*(a1: cint, a2: TMode): cint {.importc, header: "".} -proc fstat*(a1: cint, a2: var Tstat): cint {.importc, header: "".} -proc lstat*(a1: cstring, a2: var Tstat): cint {.importc, header: "".} -proc mkdir*(a1: cstring, a2: TMode): cint {.importc, header: "".} -proc mkfifo*(a1: cstring, a2: TMode): cint {.importc, header: "".} -proc mknod*(a1: cstring, a2: TMode, a3: Tdev): cint {. - importc, header: "".} -proc stat*(a1: cstring, a2: var Tstat): cint {.importc, header: "".} -proc umask*(a1: Tmode): TMode {.importc, header: "".} - -proc S_ISBLK*(m: Tmode): bool {.importc, header: "".} - ## Test for a block special file. -proc S_ISCHR*(m: Tmode): bool {.importc, header: "".} - ## Test for a character special file. -proc S_ISDIR*(m: Tmode): bool {.importc, header: "".} - ## Test for a directory. -proc S_ISFIFO*(m: Tmode): bool {.importc, header: "".} - ## Test for a pipe or FIFO special file. -proc S_ISREG*(m: Tmode): bool {.importc, header: "".} - ## Test for a regular file. -proc S_ISLNK*(m: Tmode): bool {.importc, header: "".} - ## Test for a symbolic link. -proc S_ISSOCK*(m: Tmode): bool {.importc, header: "".} - ## Test for a socket. - -proc S_TYPEISMQ*(buf: var TStat): bool {.importc, header: "".} - ## Test for a message queue. -proc S_TYPEISSEM*(buf: var TStat): bool {.importc, header: "".} - ## Test for a semaphore. -proc S_TYPEISSHM*(buf: var TStat): bool {.importc, header: "".} - ## Test for a shared memory object. - -proc S_TYPEISTMO*(buf: var TStat): bool {.importc, header: "".} - ## Test macro for a typed memory object. - -proc mlock*(a1: pointer, a2: int): cint {.importc, header: "".} -proc mlockall*(a1: cint): cint {.importc, header: "".} -proc mmap*(a1: pointer, a2: int, a3, a4, a5: cint, a6: Toff): pointer {. - importc, header: "".} -proc mprotect*(a1: pointer, a2: int, a3: cint): cint {. - importc, header: "".} -proc msync*(a1: pointer, a2: int, a3: cint): cint {.importc, header: "".} -proc munlock*(a1: pointer, a2: int): cint {.importc, header: "".} -proc munlockall*(): cint {.importc, header: "".} -proc munmap*(a1: pointer, a2: int): cint {.importc, header: "".} -proc posix_madvise*(a1: pointer, a2: int, a3: cint): cint {. - importc, header: "".} -proc posix_mem_offset*(a1: pointer, a2: int, a3: var Toff, - a4: var int, a5: var cint): cint {.importc, header: "".} -proc posix_typed_mem_get_info*(a1: cint, - a2: var Tposix_typed_mem_info): cint {.importc, header: "".} -proc posix_typed_mem_open*(a1: cstring, a2, a3: cint): cint {. - importc, header: "".} -proc shm_open*(a1: cstring, a2: cint, a3: Tmode): cint {. - importc, header: "".} -proc shm_unlink*(a1: cstring): cint {.importc, header: "".} - -proc asctime*(a1: var ttm): cstring{.importc, header: "".} - -proc asctime_r*(a1: var ttm, a2: cstring): cstring {.importc, header: "".} -proc clock*(): Tclock {.importc, header: "".} -proc clock_getcpuclockid*(a1: tpid, a2: var Tclockid): cint {. - importc, header: "".} -proc clock_getres*(a1: Tclockid, a2: var Ttimespec): cint {. - importc, header: "".} -proc clock_gettime*(a1: Tclockid, a2: var Ttimespec): cint {. - importc, header: "".} -proc clock_nanosleep*(a1: Tclockid, a2: cint, a3: var Ttimespec, - a4: var Ttimespec): cint {.importc, header: "".} -proc clock_settime*(a1: Tclockid, a2: var Ttimespec): cint {. - importc, header: "".} - -proc ctime*(a1: var Ttime): cstring {.importc, header: "".} -proc ctime_r*(a1: var Ttime, a2: cstring): cstring {.importc, header: "".} -proc difftime*(a1, a2: Ttime): cdouble {.importc, header: "".} -proc getdate*(a1: cstring): ptr ttm {.importc, header: "".} - -proc gmtime*(a1: var ttime): ptr ttm {.importc, header: "".} -proc gmtime_r*(a1: var ttime, a2: var ttm): ptr ttm {.importc, header: "".} -proc localtime*(a1: var ttime): ptr ttm {.importc, header: "".} -proc localtime_r*(a1: var ttime, a2: var ttm): ptr ttm {.importc, header: "".} -proc mktime*(a1: var ttm): ttime {.importc, header: "".} -proc nanosleep*(a1, a2: var Ttimespec): cint {.importc, header: "".} -proc strftime*(a1: cstring, a2: int, a3: cstring, - a4: var ttm): int {.importc, header: "".} -proc strptime*(a1, a2: cstring, a3: var ttm): cstring {.importc, header: "".} -proc time*(a1: var Ttime): ttime {.importc, header: "".} -proc timer_create*(a1: var Tclockid, a2: var Tsigevent, - a3: var Ttimer): cint {.importc, header: "".} -proc timer_delete*(a1: var Ttimer): cint {.importc, header: "".} -proc timer_gettime*(a1: Ttimer, a2: var Titimerspec): cint {. - importc, header: "".} -proc timer_getoverrun*(a1: Ttimer): cint {.importc, header: "".} -proc timer_settime*(a1: Ttimer, a2: cint, a3: var Titimerspec, - a4: var titimerspec): cint {.importc, header: "".} -proc tzset*() {.importc, header: "".} - - -proc wait*(a1: var cint): tpid {.importc, header: "".} -proc waitid*(a1: cint, a2: tid, a3: var Tsiginfo, a4: cint): cint {. - importc, header: "".} -proc waitpid*(a1: tpid, a2: var cint, a3: cint): tpid {. - importc, header: "".} - -proc bsd_signal*(a1: cint, a2: proc (x: pointer) {.noconv.}) {. - importc, header: "".} -proc kill*(a1: Tpid, a2: cint): cint {.importc, header: "".} -proc killpg*(a1: Tpid, a2: cint): cint {.importc, header: "".} -proc pthread_kill*(a1: tpthread, a2: cint): cint {.importc, header: "".} -proc pthread_sigmask*(a1: cint, a2, a3: var Tsigset): cint {. - importc, header: "".} -proc `raise`*(a1: cint): cint {.importc, header: "".} -proc sigaction*(a1: cint, a2, a3: var Tsigaction): cint {. - importc, header: "".} -proc sigaddset*(a1: var Tsigset, a2: cint): cint {.importc, header: "".} -proc sigaltstack*(a1, a2: var Tstack): cint {.importc, header: "".} -proc sigdelset*(a1: var Tsigset, a2: cint): cint {.importc, header: "".} -proc sigemptyset*(a1: var Tsigset): cint {.importc, header: "".} -proc sigfillset*(a1: var Tsigset): cint {.importc, header: "".} -proc sighold*(a1: cint): cint {.importc, header: "".} -proc sigignore*(a1: cint): cint {.importc, header: "".} -proc siginterrupt*(a1, a2: cint): cint {.importc, header: "".} -proc sigismember*(a1: var Tsigset, a2: cint): cint {.importc, header: "".} -proc signal*(a1: cint, a2: proc (x: cint) {.noconv.}) {. - importc, header: "".} -proc sigpause*(a1: cint): cint {.importc, header: "".} -proc sigpending*(a1: var tsigset): cint {.importc, header: "".} -proc sigprocmask*(a1: cint, a2, a3: var tsigset): cint {. - importc, header: "".} -proc sigqueue*(a1: tpid, a2: cint, a3: Tsigval): cint {. - importc, header: "".} -proc sigrelse*(a1: cint): cint {.importc, header: "".} -proc sigset*(a1: int, a2: proc (x: cint) {.noconv.}) {.importc, header: "".} -proc sigsuspend*(a1: var Tsigset): cint {.importc, header: "".} -proc sigtimedwait*(a1: var Tsigset, a2: var tsiginfo, - a3: var ttimespec): cint {.importc, header: "".} -proc sigwait*(a1: var Tsigset, a2: var cint): cint {.importc, header: "".} -proc sigwaitinfo*(a1: var Tsigset, a2: var tsiginfo): cint {. - importc, header: "".} - - -proc catclose*(a1: Tnl_catd): cint {.importc, header: "".} -proc catgets*(a1: Tnl_catd, a2, a3: cint, a4: cstring): cstring {. - importc, header: "".} -proc catopen*(a1: cstring, a2: cint): Tnl_catd {.importc, header: "".} - -proc sched_get_priority_max*(a1: cint): cint {.importc, header: "".} -proc sched_get_priority_min*(a1: cint): cint {.importc, header: "".} -proc sched_getparam*(a1: tpid, a2: var Tsched_param): cint {. - importc, header: "".} -proc sched_getscheduler*(a1: tpid): cint {.importc, header: "".} -proc sched_rr_get_interval*(a1: tpid, a2: var Ttimespec): cint {. - importc, header: "".} -proc sched_setparam*(a1: tpid, a2: var Tsched_param): cint {. - importc, header: "".} -proc sched_setscheduler*(a1: tpid, a2: cint, a3: var tsched_param): cint {. - importc, header: "".} -proc sched_yield*(): cint {.importc, header: "".} - -proc strerror*(errnum: cint): cstring {.importc, header: "".} - -proc FD_CLR*(a1: cint, a2: var Tfd_set) {.importc, header: "".} -proc FD_ISSET*(a1: cint, a2: var Tfd_set): cint {. - importc, header: "".} -proc FD_SET*(a1: cint, a2: var Tfd_set) {.importc, header: "".} -proc FD_ZERO*(a1: var Tfd_set) {.importc, header: "".} - -proc pselect*(a1: cint, a2, a3, a4: var Tfd_set, a5: var ttimespec, - a6: var Tsigset): cint {.importc, header: "".} -proc select*(a1: cint, a2, a3, a4: var Tfd_set, a5: var ttimeval): cint {. - importc, header: "".} - -when hasSpawnH: - proc posix_spawn*(a1: var tpid, a2: cstring, - a3: var Tposix_spawn_file_actions, - a4: var Tposix_spawnattr, - a5, a6: cstringArray): cint {.importc, header: "".} - proc posix_spawn_file_actions_addclose*(a1: var tposix_spawn_file_actions, - a2: cint): cint {.importc, header: "".} - proc posix_spawn_file_actions_adddup2*(a1: var tposix_spawn_file_actions, - a2, a3: cint): cint {.importc, header: "".} - proc posix_spawn_file_actions_addopen*(a1: var tposix_spawn_file_actions, - a2: cint, a3: cstring, a4: cint, a5: tmode): cint {. - importc, header: "".} - proc posix_spawn_file_actions_destroy*( - a1: var tposix_spawn_file_actions): cint {.importc, header: "".} - proc posix_spawn_file_actions_init*( - a1: var tposix_spawn_file_actions): cint {.importc, header: "".} - proc posix_spawnattr_destroy*(a1: var tposix_spawnattr): cint {. - importc, header: "".} - proc posix_spawnattr_getsigdefault*(a1: var tposix_spawnattr, - a2: var Tsigset): cint {.importc, header: "".} - proc posix_spawnattr_getflags*(a1: var tposix_spawnattr, - a2: var cshort): cint {.importc, header: "".} - proc posix_spawnattr_getpgroup*(a1: var tposix_spawnattr, - a2: var tpid): cint {.importc, header: "".} - proc posix_spawnattr_getschedparam*(a1: var tposix_spawnattr, - a2: var tsched_param): cint {.importc, header: "".} - proc posix_spawnattr_getschedpolicy*(a1: var tposix_spawnattr, - a2: var cint): cint {.importc, header: "".} - proc posix_spawnattr_getsigmask*(a1: var tposix_spawnattr, - a2: var tsigset): cint {.importc, header: "".} - - proc posix_spawnattr_init*(a1: var tposix_spawnattr): cint {. - importc, header: "".} - proc posix_spawnattr_setsigdefault*(a1: var tposix_spawnattr, - a2: var tsigset): cint {.importc, header: "".} - proc posix_spawnattr_setflags*(a1: var tposix_spawnattr, a2: cshort): cint {. - importc, header: "".} - proc posix_spawnattr_setpgroup*(a1: var tposix_spawnattr, a2: tpid): cint {. - importc, header: "".} - - proc posix_spawnattr_setschedparam*(a1: var tposix_spawnattr, - a2: var tsched_param): cint {.importc, header: "".} - proc posix_spawnattr_setschedpolicy*(a1: var tposix_spawnattr, - a2: cint): cint {. - importc, header: "".} - proc posix_spawnattr_setsigmask*(a1: var tposix_spawnattr, - a2: var tsigset): cint {.importc, header: "".} - proc posix_spawnp*(a1: var tpid, a2: cstring, - a3: var tposix_spawn_file_actions, - a4: var tposix_spawnattr, - a5, a6: cstringArray): cint {.importc, header: "".} - -proc getcontext*(a1: var Tucontext): cint {.importc, header: "".} -proc makecontext*(a1: var Tucontext, a4: proc (){.noconv.}, a3: cint) {. - varargs, importc, header: "".} -proc setcontext*(a1: var Tucontext): cint {.importc, header: "".} -proc swapcontext*(a1, a2: var Tucontext): cint {.importc, header: "".} - -proc readv*(a1: cint, a2: ptr TIOVec, a3: cint): int {. - importc, header: "".} -proc writev*(a1: cint, a2: ptr TIOVec, a3: cint): int {. - importc, header: "".} - -proc CMSG_DATA*(cmsg: ptr Tcmsghdr): cstring {. - importc, header: "".} - -proc CMSG_NXTHDR*(mhdr: ptr TMsgHdr, cmsg: ptr TCMsgHdr): ptr TCmsgHdr {. - importc, header: "".} - -proc CMSG_FIRSTHDR*(mhdr: ptr TMsgHdr): ptr TCMsgHdr {. - importc, header: "".} - -proc accept*(a1: cint, a2: ptr Tsockaddr, a3: ptr Tsocklen): cint {. - importc, header: "".} - -proc bindSocket*(a1: cint, a2: ptr Tsockaddr, a3: Tsocklen): cint {. - importc: "bind", header: "".} - ## is Posix's ``bind``, because ``bind`` is a reserved word - -proc connect*(a1: cint, a2: ptr Tsockaddr, a3: Tsocklen): cint {. - importc, header: "".} -proc getpeername*(a1: cint, a2: ptr Tsockaddr, a3: ptr Tsocklen): cint {. - importc, header: "".} -proc getsockname*(a1: cint, a2: ptr Tsockaddr, a3: ptr Tsocklen): cint {. - importc, header: "".} - -proc getsockopt*(a1, a2, a3: cint, a4: pointer, a5: ptr Tsocklen): cint {. - importc, header: "".} - -proc listen*(a1, a2: cint): cint {. - importc, header: "".} -proc recv*(a1: cint, a2: pointer, a3: int, a4: cint): int {. - importc, header: "".} -proc recvfrom*(a1: cint, a2: pointer, a3: int, a4: cint, - a5: ptr Tsockaddr, a6: ptr Tsocklen): int {. - importc, header: "".} -proc recvmsg*(a1: cint, a2: ptr Tmsghdr, a3: cint): int {. - importc, header: "".} -proc send*(a1: cint, a2: pointer, a3: int, a4: cint): int {. - importc, header: "".} -proc sendmsg*(a1: cint, a2: ptr Tmsghdr, a3: cint): int {. - importc, header: "".} -proc sendto*(a1: cint, a2: pointer, a3: int, a4: cint, a5: ptr Tsockaddr, - a6: Tsocklen): int {. - importc, header: "".} -proc setsockopt*(a1, a2, a3: cint, a4: pointer, a5: Tsocklen): cint {. - importc, header: "".} -proc shutdown*(a1, a2: cint): cint {. - importc, header: "".} -proc socket*(a1, a2, a3: cint): cint {. - importc, header: "".} -proc sockatmark*(a1: cint): cint {. - importc, header: "".} -proc socketpair*(a1, a2, a3: cint, a4: var array[0..1, cint]): cint {. - importc, header: "".} - -proc if_nametoindex*(a1: cstring): cint {.importc, header: "".} -proc if_indextoname*(a1: cint, a2: cstring): cstring {. - importc, header: "".} -proc if_nameindex*(): ptr Tif_nameindex {.importc, header: "".} -proc if_freenameindex*(a1: ptr Tif_nameindex) {.importc, header: "".} - -proc IN6_IS_ADDR_UNSPECIFIED* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Unspecified address. -proc IN6_IS_ADDR_LOOPBACK* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Loopback address. -proc IN6_IS_ADDR_MULTICAST* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast address. -proc IN6_IS_ADDR_LINKLOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Unicast link-local address. -proc IN6_IS_ADDR_SITELOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Unicast site-local address. -proc IN6_IS_ADDR_V4MAPPED* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## IPv4 mapped address. -proc IN6_IS_ADDR_V4COMPAT* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## IPv4-compatible address. -proc IN6_IS_ADDR_MC_NODELOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast node-local address. -proc IN6_IS_ADDR_MC_LINKLOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast link-local address. -proc IN6_IS_ADDR_MC_SITELOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast site-local address. -proc IN6_IS_ADDR_MC_ORGLOCAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast organization-local address. -proc IN6_IS_ADDR_MC_GLOBAL* (a1: ptr TIn6Addr): cint {. - importc, header: "".} - ## Multicast global address. - -proc endhostent*() {.importc, header: "".} -proc endnetent*() {.importc, header: "".} -proc endprotoent*() {.importc, header: "".} -proc endservent*() {.importc, header: "".} -proc freeaddrinfo*(a1: ptr Taddrinfo) {.importc, header: "".} - -proc gai_strerror*(a1: cint): cstring {.importc, header: "".} - -proc getaddrinfo*(a1, a2: cstring, a3: ptr TAddrInfo, - a4: var ptr TAddrInfo): cint {.importc, header: "".} - -proc gethostbyaddr*(a1: pointer, a2: Tsocklen, a3: cint): ptr THostent {. - importc, header: "".} -proc gethostbyname*(a1: cstring): ptr THostent {.importc, header: "".} -proc gethostent*(): ptr THostent {.importc, header: "".} - -proc getnameinfo*(a1: ptr Tsockaddr, a2: Tsocklen, - a3: cstring, a4: Tsocklen, a5: cstring, - a6: Tsocklen, a7: cint): cint {.importc, header: "".} - -proc getnetbyaddr*(a1: int32, a2: cint): ptr TNetent {.importc, header: "".} -proc getnetbyname*(a1: cstring): ptr TNetent {.importc, header: "".} -proc getnetent*(): ptr TNetent {.importc, header: "".} - -proc getprotobyname*(a1: cstring): ptr TProtoent {.importc, header: "".} -proc getprotobynumber*(a1: cint): ptr TProtoent {.importc, header: "".} -proc getprotoent*(): ptr TProtoent {.importc, header: "".} - -proc getservbyname*(a1, a2: cstring): ptr TServent {.importc, header: "".} -proc getservbyport*(a1: cint, a2: cstring): ptr TServent {. - importc, header: "".} -proc getservent*(): ptr TServent {.importc, header: "".} - -proc sethostent*(a1: cint) {.importc, header: "".} -proc setnetent*(a1: cint) {.importc, header: "".} -proc setprotoent*(a1: cint) {.importc, header: "".} -proc setservent*(a1: cint) {.importc, header: "".} - -proc poll*(a1: ptr Tpollfd, a2: Tnfds, a3: int): cint {. - importc, header: "".} - -proc realpath*(name, resolved: CString): CString {. - importc: "realpath", header: "".} - - diff --git a/nimlib/pure/cgi.nim b/nimlib/pure/cgi.nim deleted file mode 100755 index baae244e7e..0000000000 --- a/nimlib/pure/cgi.nim +++ /dev/null @@ -1,375 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements helper procs for CGI applictions. Example: -## -## .. code-block:: Nimrod -## -## import strtabs, cgi -## -## # Fill the values when debugging: -## when debug: -## setTestData("name", "Klaus", "password", "123456") -## # read the data into `myData` -## var myData = readData() -## # check that the data's variable names are "name" or "passwort" -## validateData(myData, "name", "password") -## # start generating content: -## writeContentType() -## # generate content: -## write(stdout, "\n") -## write(stdout, "Test\n") -## writeln(stdout, "your name: " & myData["name"]) -## writeln(stdout, "your password: " & myData["password"]) -## writeln(stdout, "") - -import strutils, os, strtabs - -proc URLencode*(s: string): string = - ## Encodes a value to be HTTP safe: This means that characters in the set - ## ``{'A'..'Z', 'a'..'z', '0'..'9', '_'}`` are carried over to the result, - ## a space is converted to ``'+'`` and every other character is encoded as - ## ``'%xx'`` where ``xx`` denotes its hexadecimal value. - result = "" - for i in 0..s.len-1: - case s[i] - of 'a'..'z', 'A'..'Z', '0'..'9', '_': add(result, s[i]) - of ' ': add(result, '+') - else: - add(result, '%') - add(result, toHex(ord(s[i]), 2)) - -proc handleHexChar(c: char, x: var int) {.inline.} = - case c - of '0'..'9': x = (x shl 4) or (ord(c) - ord('0')) - of 'a'..'f': x = (x shl 4) or (ord(c) - ord('a') + 10) - of 'A'..'F': x = (x shl 4) or (ord(c) - ord('A') + 10) - else: assert(false) - -proc URLdecode*(s: string): string = - ## Decodes a value from its HTTP representation: This means that a ``'+'`` - ## is converted to a space, ``'%xx'`` (where ``xx`` denotes a hexadecimal - ## value) is converted to the character with ordinal number ``xx``, and - ## and every other character is carried over. - result = "" - var i = 0 - while i < s.len: - case s[i] - of '%': - var x = 0 - handleHexChar(s[i+1], x) - handleHexChar(s[i+2], x) - inc(i, 2) - add(result, chr(x)) - of '+': add(result, ' ') - else: add(result, s[i]) - inc(i) - -proc addXmlChar(dest: var string, c: Char) {.inline.} = - case c - of '&': add(dest, "&") - of '<': add(dest, "<") - of '>': add(dest, ">") - of '\"': add(dest, """) - else: add(dest, c) - -proc XMLencode*(s: string): string = - ## Encodes a value to be XML safe: - ## * ``"`` is replaced by ``"`` - ## * ``<`` is replaced by ``<`` - ## * ``>`` is replaced by ``>`` - ## * ``&`` is replaced by ``&`` - ## * every other character is carried over. - result = "" - for i in 0..len(s)-1: addXmlChar(result, s[i]) - -type - ECgi* = object of EIO ## the exception that is raised, if a CGI error occurs - TRequestMethod* = enum ## the used request method - methodNone, ## no REQUEST_METHOD environment variable - methodPost, ## query uses the POST method - methodGet ## query uses the GET method - -proc cgiError*(msg: string) {.noreturn.} = - ## raises an ECgi exception with message `msg`. - var e: ref ECgi - new(e) - e.msg = msg - raise e - -proc getEncodedData(allowedMethods: set[TRequestMethod]): string = - case getenv("REQUEST_METHOD") - of "POST": - if methodPost notin allowedMethods: - cgiError("'REQUEST_METHOD' 'POST' is not supported") - var L = parseInt(getenv("CONTENT_LENGTH")) - result = newString(L) - if readBuffer(stdin, addr(result[0]), L) != L: - cgiError("cannot read from stdin") - of "GET": - if methodGet notin allowedMethods: - cgiError("'REQUEST_METHOD' 'GET' is not supported") - result = getenv("QUERY_STRING") - else: - if methodNone notin allowedMethods: - cgiError("'REQUEST_METHOD' must be 'POST' or 'GET'") - -iterator decodeData*(allowedMethods: set[TRequestMethod] = - {methodNone, methodPost, methodGet}): tuple[key, value: string] = - ## Reads and decodes CGI data and yields the (name, value) pairs the - ## data consists of. If the client does not use a method listed in the - ## `allowedMethods` set, an `ECgi` exception is raised. - var enc = getEncodedData(allowedMethods) - if not isNil(enc): - # decode everything in one pass: - var i = 0 - var name = "" - var value = "" - while enc[i] != '\0': - setLen(name, 0) # reuse memory - while true: - case enc[i] - of '\0': break - of '%': - var x = 0 - handleHexChar(enc[i+1], x) - handleHexChar(enc[i+2], x) - inc(i, 2) - add(name, chr(x)) - of '+': add(name, ' ') - of '=', '&': break - else: add(name, enc[i]) - inc(i) - if enc[i] != '=': cgiError("'=' expected") - inc(i) # skip '=' - setLen(value, 0) # reuse memory - while true: - case enc[i] - of '%': - var x = 0 - handleHexChar(enc[i+1], x) - handleHexChar(enc[i+2], x) - inc(i, 2) - add(value, chr(x)) - of '+': add(value, ' ') - of '&', '\0': break - else: add(value, enc[i]) - inc(i) - yield (name, value) - if enc[i] == '&': inc(i) - elif enc[i] == '\0': break - else: cgiError("'&' expected") - -proc readData*(allowedMethods: set[TRequestMethod] = - {methodNone, methodPost, methodGet}): PStringTable = - ## Read CGI data. If the client does not use a method listed in the - ## `allowedMethods` set, an `ECgi` exception is raised. - result = newStringTable() - for name, value in decodeData(allowedMethods): - result[name] = value - -proc validateData*(data: PStringTable, validKeys: openarray[string]) = - ## validates data; raises `ECgi` if this fails. This checks that each variable - ## name of the CGI `data` occurs in the `validKeys` array. - for key, val in pairs(data): - if find(validKeys, key) < 0: - cgiError("unknown variable name: " & key) - -proc getContentLength*(): string = - ## returns contents of the ``CONTENT_LENGTH`` environment variable - return getenv("CONTENT_LENGTH") - -proc getContentType*(): string = - ## returns contents of the ``CONTENT_TYPE`` environment variable - return getenv("CONTENT_Type") - -proc getDocumentRoot*(): string = - ## returns contents of the ``DOCUMENT_ROOT`` environment variable - return getenv("DOCUMENT_ROOT") - -proc getGatewayInterface*(): string = - ## returns contents of the ``GATEWAY_INTERFACE`` environment variable - return getenv("GATEWAY_INTERFACE") - -proc getHttpAccept*(): string = - ## returns contents of the ``HTTP_ACCEPT`` environment variable - return getenv("HTTP_ACCEPT") - -proc getHttpAcceptCharset*(): string = - ## returns contents of the ``HTTP_ACCEPT_CHARSET`` environment variable - return getenv("HTTP_ACCEPT_CHARSET") - -proc getHttpAcceptEncoding*(): string = - ## returns contents of the ``HTTP_ACCEPT_ENCODING`` environment variable - return getenv("HTTP_ACCEPT_ENCODING") - -proc getHttpAcceptLanguage*(): string = - ## returns contents of the ``HTTP_ACCEPT_LANGUAGE`` environment variable - return getenv("HTTP_ACCEPT_LANGUAGE") - -proc getHttpConnection*(): string = - ## returns contents of the ``HTTP_CONNECTION`` environment variable - return getenv("HTTP_CONNECTION") - -proc getHttpCookie*(): string = - ## returns contents of the ``HTTP_COOKIE`` environment variable - return getenv("HTTP_COOKIE") - -proc getHttpHost*(): string = - ## returns contents of the ``HTTP_HOST`` environment variable - return getenv("HTTP_HOST") - -proc getHttpReferer*(): string = - ## returns contents of the ``HTTP_REFERER`` environment variable - return getenv("HTTP_REFERER") - -proc getHttpUserAgent*(): string = - ## returns contents of the ``HTTP_USER_AGENT`` environment variable - return getenv("HTTP_USER_AGENT") - -proc getPathInfo*(): string = - ## returns contents of the ``PATH_INFO`` environment variable - return getenv("PATH_INFO") - -proc getPathTranslated*(): string = - ## returns contents of the ``PATH_TRANSLATED`` environment variable - return getenv("PATH_TRANSLATED") - -proc getQueryString*(): string = - ## returns contents of the ``QUERY_STRING`` environment variable - return getenv("QUERY_STRING") - -proc getRemoteAddr*(): string = - ## returns contents of the ``REMOTE_ADDR`` environment variable - return getenv("REMOTE_ADDR") - -proc getRemoteHost*(): string = - ## returns contents of the ``REMOTE_HOST`` environment variable - return getenv("REMOTE_HOST") - -proc getRemoteIdent*(): string = - ## returns contents of the ``REMOTE_IDENT`` environment variable - return getenv("REMOTE_IDENT") - -proc getRemotePort*(): string = - ## returns contents of the ``REMOTE_PORT`` environment variable - return getenv("REMOTE_PORT") - -proc getRemoteUser*(): string = - ## returns contents of the ``REMOTE_USER`` environment variable - return getenv("REMOTE_USER") - -proc getRequestMethod*(): string = - ## returns contents of the ``REQUEST_METHOD`` environment variable - return getenv("REQUEST_METHOD") - -proc getRequestURI*(): string = - ## returns contents of the ``REQUEST_URI`` environment variable - return getenv("REQUEST_URI") - -proc getScriptFilename*(): string = - ## returns contents of the ``SCRIPT_FILENAME`` environment variable - return getenv("SCRIPT_FILENAME") - -proc getScriptName*(): string = - ## returns contents of the ``SCRIPT_NAME`` environment variable - return getenv("SCRIPT_NAME") - -proc getServerAddr*(): string = - ## returns contents of the ``SERVER_ADDR`` environment variable - return getenv("SERVER_ADDR") - -proc getServerAdmin*(): string = - ## returns contents of the ``SERVER_ADMIN`` environment variable - return getenv("SERVER_ADMIN") - -proc getServerName*(): string = - ## returns contents of the ``SERVER_NAME`` environment variable - return getenv("SERVER_NAME") - -proc getServerPort*(): string = - ## returns contents of the ``SERVER_PORT`` environment variable - return getenv("SERVER_PORT") - -proc getServerProtocol*(): string = - ## returns contents of the ``SERVER_PROTOCOL`` environment variable - return getenv("SERVER_PROTOCOL") - -proc getServerSignature*(): string = - ## returns contents of the ``SERVER_SIGNATURE`` environment variable - return getenv("SERVER_SIGNATURE") - -proc getServerSoftware*(): string = - ## returns contents of the ``SERVER_SOFTWARE`` environment variable - return getenv("SERVER_SOFTWARE") - -proc setTestData*(keysvalues: openarray[string]) = - ## fills the appropriate environment variables to test your CGI application. - ## This can only simulate the 'GET' request method. `keysvalues` should - ## provide embedded (name, value)-pairs. Example: - ## - ## .. code-block:: Nimrod - ## setTestData("name", "Hanz", "password", "12345") - putenv("REQUEST_METHOD", "GET") - var i = 0 - var query = "" - while i < keysvalues.len: - add(query, URLencode(keysvalues[i])) - add(query, '=') - add(query, URLencode(keysvalues[i+1])) - add(query, '&') - inc(i, 2) - putenv("QUERY_STRING", query) - -proc writeContentType*() = - ## call this before starting to send your HTML data to `stdout`. This - ## implements this part of the CGI protocol: - ## - ## .. code-block:: Nimrod - ## write(stdout, "Content-type: text/html\n\n") - ## - ## It also modifies the debug stack traces so that they contain - ## ``
    `` and are easily readable in a browser. - write(stdout, "Content-type: text/html\n\n") - system.stackTraceNewLine = "
    \n" - -proc setCookie*(name, value: string) = - ## Sets a cookie. - write(stdout, "Set-Cookie: ", name, "=", value, "\n") - -var - cookies: PStringTable = nil - -proc parseCookies(s: string): PStringTable = - result = newStringTable(modeCaseInsensitive) - var i = 0 - while true: - while s[i] == ' ' or s[i] == '\t': inc(i) - var keystart = i - while s[i] != '=' and s[i] != '\0': inc(i) - var keyend = i-1 - if s[i] == '\0': break - inc(i) # skip '=' - var valstart = i - while s[i] != ';' and s[i] != '\0': inc(i) - result[copy(s, keystart, keyend)] = copy(s, valstart, i-1) - if s[i] == '\0': break - inc(i) # skip ';' - -proc getCookie*(name: string): string = - ## Gets a cookie. If no cookie of `name` exists, "" is returned. - if cookies == nil: cookies = parseCookies(getHttpCookie()) - result = cookies[name] - -proc existsCookie*(name: string): bool = - ## Checks if a cookie of `name` exists. - if cookies == nil: cookies = parseCookies(getHttpCookie()) - result = hasKey(cookies) - - diff --git a/nimlib/pure/complex.nim b/nimlib/pure/complex.nim deleted file mode 100755 index f50ff4bd06..0000000000 --- a/nimlib/pure/complex.nim +++ /dev/null @@ -1,106 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2006 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - - -## This module implements complex numbers. - -{.push checks:off, line_dir:off, stack_trace:off, debugger:off.} -# the user does not want to trace a part -# of the standard library! - -import - math - -type - TComplex* = tuple[re, im: float] - ## a complex number, consisting of a real and an imaginary part - -proc `==` *(x, y: TComplex): bool = - ## Compare two complex numbers `x` and `y` for equality. - result = x.re == y.re and x.im == y.im - -proc `+` *(x, y: TComplex): TComplex = - ## Add two complex numbers. - result.re = x.re + y.re - result.im = x.im + y.im - -proc `-` *(x, y: TComplex): TComplex = - ## Subtract two complex numbers. - result.re = x.re - y.re - result.im = x.im - y.im - -proc `-` *(z: TComplex): TComplex = - ## Unary minus for complex numbers. - result.re = -z.re - result.im = -z.im - -proc `/` *(x, y: TComplex): TComplex = - ## Divide `x` by `y`. - var - r, den: float - if abs(y.re) < abs(y.im): - r = y.re / y.im - den = y.im + r * y.re - result.re = (x.re * r + x.im) / den - result.im = (x.im * r - x.re) / den - else: - r = y.im / y.re - den = y.re + r * y.im - result.re = (x.re + r * x.im) / den - result.im = (x.im - r * x.re) / den - -proc `*` *(x, y: TComplex): TComplex = - ## Multiply `x` with `y`. - result.re = x.re * y.re - x.im * y.im - result.im = x.im * y.re + x.re * y.im - -proc abs*(z: TComplex): float = - ## Return the distance from (0,0) to `z`. - - # optimized by checking special cases (sqrt is expensive) - var x, y, temp: float - - x = abs(z.re) - y = abs(z.im) - if x == 0.0: - result = y - elif y == 0.0: - result = x - elif x > y: - temp = y / x - result = x * sqrt(1.0 + temp * temp) - else: - temp = x / y - result = y * sqrt(1.0 + temp * temp) - -proc sqrt*(z: TComplex): TComplex = - ## Square root for a complex number `z`. - var x, y, w, r: float - - if z.re == 0.0 and z.im == 0.0: - result = z - else: - x = abs(z.re) - y = abs(z.im) - if x >= y: - r = y / x - w = sqrt(x) * sqrt(0.5 * (1.0 + sqrt(1.0 + r * r))) - else: - r = x / y - w = sqrt(y) * sqrt(0.5 * (r + sqrt(1.0 + r * r))) - if z.re >= 0.0: - result.re = w - result.im = z.im / (w * 2) - else: - if z.im >= 0.0: result.im = w - else: result.im = -w - result.re = z.im / (c.im + c.im) - -{.pop.} diff --git a/nimlib/pure/dynlib.nim b/nimlib/pure/dynlib.nim deleted file mode 100755 index 592073e3d5..0000000000 --- a/nimlib/pure/dynlib.nim +++ /dev/null @@ -1,84 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the ability to access symbols from shared -## libraries. On POSIX this uses the ``dlsym`` mechanism, on -## Windows ``LoadLibrary``. - -type - TLibHandle* = pointer ## a handle to a dynamically loaded library - -proc LoadLib*(path: string): TLibHandle - ## loads a library from `path`. Returns nil if the library could not - ## be loaded. - -proc UnloadLib*(lib: TLibHandle) - ## unloads the library `lib` - -proc symAddr*(lib: TLibHandle, name: string): pointer - ## retrieves the address of a procedure/variable from `lib`. Returns nil - ## if the symbol could not be found. - -proc checkedSymAddr*(lib: TLibHandle, name: string): pointer = - ## retrieves the address of a procedure/variable from `lib`. Raises - ## `EInvalidLibrary` if the symbol could not be found. - result = symAddr(lib, name) - if result == nil: - var e: ref EInvalidLibrary - new(e) - e.msg = "could not find symbol: " & name - raise e - -when defined(posix): - # - # ========================================================================= - # This is an implementation based on the dlfcn interface. - # The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, - # NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least - # as an emulation layer on top of native functions. - # ========================================================================= - # - var - RTLD_NOW {.importc: "RTLD_NOW", header: "".}: int - - proc dlclose(lib: TLibHandle) {.importc, header: "".} - proc dlopen(path: CString, mode: int): TLibHandle {. - importc, header: "".} - proc dlsym(lib: TLibHandle, name: cstring): pointer {. - importc, header: "".} - - proc LoadLib(path: string): TLibHandle = return dlopen(path, RTLD_NOW) - proc UnloadLib(lib: TLibHandle) = dlclose(lib) - proc symAddr(lib: TLibHandle, name: string): pointer = - return dlsym(lib, name) - -elif defined(windows) or defined(dos): - # - # ======================================================================= - # Native Windows Implementation - # ======================================================================= - # - type - THINSTANCE {.importc: "HINSTANCE".} = pointer - - proc FreeLibrary(lib: THINSTANCE) {.importc, header: "", stdcall.} - proc winLoadLibrary(path: cstring): THINSTANCE {. - importc: "LoadLibraryA", header: "", stdcall.} - proc GetProcAddress(lib: THINSTANCE, name: cstring): pointer {. - importc: "GetProcAddress", header: "", stdcall.} - - proc LoadLib(path: string): TLibHandle = - result = cast[TLibHandle](winLoadLibrary(path)) - proc UnloadLib(lib: TLibHandle) = FreeLibrary(cast[THINSTANCE](lib)) - - proc symAddr(lib: TLibHandle, name: string): pointer = - result = GetProcAddress(cast[THINSTANCE](lib), name) - -else: - {.error: "no implementation for dynlib".} diff --git a/nimlib/pure/hashes.nim b/nimlib/pure/hashes.nim deleted file mode 100755 index 1593119bd3..0000000000 --- a/nimlib/pure/hashes.nim +++ /dev/null @@ -1,97 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements efficient computations of hash values for diverse -## Nimrod types. - -import - strutils - -type - THash* = int ## a hash value; hash tables using these values should - ## always have a size of a power of two and can use the ``and`` - ## operator instead of ``mod`` for truncation of the hash value. - -proc concHash(h: THash, val: int): THash {.inline.} = - result = h +% val - result = result +% result shl 10 - result = result xor (result shr 6) - -proc finishHash(h: THash): THash {.inline.} = - result = h +% h shl 3 - result = result xor (result shr 11) - result = result +% result shl 15 - -proc hashData*(Data: Pointer, Size: int): THash = - ## hashes an array of bytes of size `size` - var - h: THash - p: cstring - i, s: int - h = 0 - p = cast[cstring](Data) - i = 0 - s = size - while s > 0: - h = concHash(h, ord(p[i])) - Inc(i) - Dec(s) - result = finishHash(h) - -proc hash*(x: Pointer): THash {.inline.} = - ## efficient hashing of pointers - result = (cast[THash](x)) shr 3 # skip the alignment - -proc hash*(x: int): THash {.inline.} = - ## efficient hashing of integers - result = x - -proc hash*(x: int64): THash {.inline.} = - ## efficient hashing of integers - result = toU32(x) - -proc hash*(x: char): THash {.inline.} = - ## efficient hashing of characters - result = ord(x) - -proc hash*(x: string): THash = - ## efficient hashing of strings - var h: THash - h = 0 - for i in 0..x.len-1: - h = concHash(h, ord(x[i])) - result = finishHash(h) - -proc hashIgnoreStyle*(x: string): THash = - ## efficient hashing of strings; style is ignored - var - h: THash - c: Char - h = 0 - for i in 0..x.len-1: - c = x[i] - if c == '_': - continue # skip _ - if c in {'A'..'Z'}: - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = concHash(h, ord(c)) - result = finishHash(h) - -proc hashIgnoreCase*(x: string): THash = - ## efficient hashing of strings; case is ignored - var - h: THash - c: Char - h = 0 - for i in 0..x.len-1: - c = x[i] - if c in {'A'..'Z'}: - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = concHash(h, ord(c)) - result = finishHash(h) diff --git a/nimlib/pure/hashtabs.nim b/nimlib/pure/hashtabs.nim deleted file mode 100755 index 68d19d63b9..0000000000 --- a/nimlib/pure/hashtabs.nim +++ /dev/null @@ -1,163 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## The ``hashtabs`` module implements an efficient generic hash -## table/dictionary data type. - -import - hashes - -const - growthFactor = 2 - startSize = 8 - sham = sizeof(THash)*8-2 # shift amount - mask = 0b11 shl sham - usedSlot = 0b10 shl sham - delSlot = 0b01 shl sham - emptySlot = 0 - -type - TTable*[TKey, TValue] = object - counter: int - data: seq[tuple[key: TKey, val: TValue, h: THash]] - -proc init*(t: var TTable, size = startSize) = - t.counter = 0 - newSeq(t.data, size) - -proc markUsed(h: THash): THash {.inline.} = - return h and not mask or usedSlot - -proc len*(t: TTable): int {.inline.} = - ## returns the number of keys in `t`. - result = t.counter - -proc mustRehash(length, counter: int): bool = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - -proc nextTry(h, maxHash: THash): THash {.inline.} = - result = ((5 * h) + 1) and maxHash - -template eq(a, b: expr): expr = a == b - -proc rawGet(t: TTable, key: TKey, fullhash: THash): int = - var h = fullhash and high(t.data) - while (t.data[h].h and mask) != 0: - # If it is a deleted entry, the comparison with ``markUsed(fullhash)`` - # fails, so there is no need to check for this explicitely. - if t.data[h].h == markUsed(fullhash) and eq(t.data[h].key, key): return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc `[]`*(t: TTable, key: TKey): TValue = - ## retrieves the value at ``t[key]``. If `key` is not in `t`, - ## `EInvalidValue` is raised. - var index = rawGet(t, key, hash(key)) - if index >= 0: result = t.data[index].val - else: - var e: ref EInvalidValue - new(e) - e.msg = "invalid key: " & $key - raise e - -proc hasKey*(t: TTable, key: TKey): bool = - ## returns true iff `key` is in the table `t`. - result = rawGet(t, key) >= 0 - -proc rawInsert[TKey, TValue]( - data: var seq[tuple[key: TKey, val: TValue, h: THash]], - tup: tuple[key: TKey, val: TValue, h: THash]) = - var h = tup.h and high(data) - while (data[h].h and mask) == usedSlot: h = nextTry(h, high(data)) - data[h] = tup - -proc enlarge(t: var TTable) = - var n: seq[tuple[key: TKey, val: TValue, h: THash]] - newSeq(n, len(t.data) * growthFactor) - for i in 0..high(t.data): - if (t.data[i].h and mask) == usedSlot: rawInsert(n, t.data[i]) - swap(t.data, n) - -proc `[]=`*(t: var TTable, key: TKey, val: TValue) = - ## puts a (key, value)-pair into `t`. - var fullhash = hash(key) - var index = rawGet(t, key, fullhash) - if index >= 0: - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): enlarge(t) - rawInsert(t.data, (key, val, markUsed(fullhash))) - inc(t.counter) - -proc add*(t: var TTable, key: TKey, val: TValue) = - ## puts a (key, value)-pair into `t`, but does not check if key already - ## exists. - if mustRehash(len(t.data), t.counter): enlarge(t) - rawInsert(t.data, (key, val, markUsed(hash(key)))) - inc(t.counter) - -proc del*(t: var TTable, key: TKey) = - ## deletes a (key, val)-pair in `t`. - var index = rawGet(t, key) - if index >= 0: - t.data[index].h = delSlot - -proc delAll*(t: var TTable, key: TKey) = - ## deletes all (key, val)-pairs in `t`. - while true: - var index = rawGet(t, key) - if index < 0: break - t.data[index].h = delSlot - -iterator pairs*(t: TTable): tuple[key: TKey, value: TValue] = - ## iterates over any (key, value) pair in the table `t`. - for h in 0..high(t.data): - if (t.data[h].h and mask) == usedSlot: - yield (t.data[h].key, t.data[h].val) - -iterator keys*(t: TTable): TKey = - ## iterate over any key in the table `t`. If key occurs multiple times, it - ## is yielded multiple times. - for h in 0..high(t.data): - if (t.data[h].h and mask) == usedSlot: - yield t.data[h].key - -iterator values*(t: TTable): TValue = - ## iterate over any value in the table `t`. - for h in 0..high(t.data): - if (t.data[h].h and mask) == usedSlot: - yield t.data[h].val - -iterator values*(t: TTable, key: TKey): TValue = - ## iterate over any value associated with `key` in `t`. - var fullhash = hash(key) - var h = fullhash and high(t.data) - while (t.data[h].h and mask) != 0: - # If it is a deleted entry, the comparison with ``markUsed(fullhash)`` - # fails, so there is no need to check for this explicitely. - if t.data[h].h == markUsed(fullhash) and eq(t.data[h].key, key): - yield t.data[h].val - h = nextTry(h, high(t.data)) - -proc `$`*[KeyToStr=`$`, ValueToStr=`$`](t: TTable): string = - ## turns the table into its string representation. `$` must be available - ## for TKey and TValue for this to work. - if t.len == 0: - result = "{:}" - else: - result = "{" - var i = 0 - for k, v in pairs(t): - if i > 0: add(result, ", ") - add(result, KeyToStr(k)) - add(result, ": ") - add(result, ValueToStr(v)) - inc(i) - add(result, "}") diff --git a/nimlib/pure/lexbase.nim b/nimlib/pure/lexbase.nim deleted file mode 100755 index bb207e92a4..0000000000 --- a/nimlib/pure/lexbase.nim +++ /dev/null @@ -1,166 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a base object of a lexer with efficient buffer -## handling. Only at line endings checks are necessary if the buffer -## needs refilling. - -import - strutils, streams - -const - EndOfFile* = '\0' ## end of file marker - NewLines* = {'\c', '\L'} - -# Buffer handling: -# buf: -# "Example Text\n ha!" bufLen = 17 -# ^pos = 0 ^ sentinel = 12 -# - -type - TBaseLexer* = object of TObject ## the base lexer. Inherit your lexer from - ## this object. - bufpos*: int ## the current position within the buffer - buf*: cstring ## the buffer itself - bufLen*: int ## length of buffer in characters - input: PStream ## the input stream - LineNumber*: int ## the current line number - sentinel: int - lineStart: int # index of last line start in buffer - fileOpened: bool - -proc open*(L: var TBaseLexer, input: PStream, bufLen: int = 8192) - ## inits the TBaseLexer with a stream to read from - -proc close*(L: var TBaseLexer) - ## closes the base lexer. This closes `L`'s associated stream too. - -proc getCurrentLine*(L: TBaseLexer, marker: bool = true): string - ## retrieves the current line. - -proc getColNumber*(L: TBaseLexer, pos: int): int - ## retrieves the current column. - -proc HandleCR*(L: var TBaseLexer, pos: int): int - ## Call this if you scanned over '\c' in the buffer; it returns the the - ## position to continue the scanning from. `pos` must be the position - ## of the '\c'. -proc HandleLF*(L: var TBaseLexer, pos: int): int - ## Call this if you scanned over '\L' in the buffer; it returns the the - ## position to continue the scanning from. `pos` must be the position - ## of the '\L'. - -# implementation - -const - chrSize = sizeof(char) - -proc close(L: var TBaseLexer) = - dealloc(L.buf) - L.input.close(L.input) - -proc FillBuffer(L: var TBaseLexer) = - var - charsRead, toCopy, s: int # all are in characters, - # not bytes (in case this - # is not the same) - oldBufLen: int - # we know here that pos == L.sentinel, but not if this proc - # is called the first time by initBaseLexer() - assert(L.sentinel < L.bufLen) - toCopy = L.BufLen - L.sentinel - 1 - assert(toCopy >= 0) - if toCopy > 0: - MoveMem(L.buf, addr(L.buf[L.sentinel + 1]), toCopy * chrSize) # "moveMem" handles overlapping regions - charsRead = L.input.readData(L.input, addr(L.buf[toCopy]), - (L.sentinel + 1) * chrSize) div chrSize - s = toCopy + charsRead - if charsRead < L.sentinel + 1: - L.buf[s] = EndOfFile # set end marker - L.sentinel = s - else: - # compute sentinel: - dec(s) # BUGFIX (valgrind) - while true: - assert(s < L.bufLen) - while (s >= 0) and not (L.buf[s] in NewLines): Dec(s) - if s >= 0: - # we found an appropriate character for a sentinel: - L.sentinel = s - break - else: - # rather than to give up here because the line is too long, - # double the buffer's size and try again: - oldBufLen = L.BufLen - L.bufLen = L.BufLen * 2 - L.buf = cast[cstring](realloc(L.buf, L.bufLen * chrSize)) - assert(L.bufLen - oldBuflen == oldBufLen) - charsRead = L.input.ReadData(L.input, addr(L.buf[oldBufLen]), - oldBufLen * chrSize) div chrSize - if charsRead < oldBufLen: - L.buf[oldBufLen + charsRead] = EndOfFile - L.sentinel = oldBufLen + charsRead - break - s = L.bufLen - 1 - -proc fillBaseLexer(L: var TBaseLexer, pos: int): int = - assert(pos <= L.sentinel) - if pos < L.sentinel: - result = pos + 1 # nothing to do - else: - fillBuffer(L) - L.bufpos = 0 # XXX: is this really correct? - result = 0 - L.lineStart = result - -proc HandleCR(L: var TBaseLexer, pos: int): int = - assert(L.buf[pos] == '\c') - inc(L.linenumber) - result = fillBaseLexer(L, pos) - if L.buf[result] == '\L': - result = fillBaseLexer(L, result) - -proc HandleLF(L: var TBaseLexer, pos: int): int = - assert(L.buf[pos] == '\L') - inc(L.linenumber) - result = fillBaseLexer(L, pos) #L.lastNL := result-1; // BUGFIX: was: result; - -proc skip_UTF_8_BOM(L: var TBaseLexer) = - if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): - inc(L.bufpos, 3) - inc(L.lineStart, 3) - -proc open(L: var TBaseLexer, input: PStream, bufLen: int = 8192) = - assert(bufLen > 0) - assert(input != nil) - L.input = input - L.bufpos = 0 - L.bufLen = bufLen - L.buf = cast[cstring](alloc(bufLen * chrSize)) - L.sentinel = bufLen - 1 - L.lineStart = 0 - L.linenumber = 1 # lines start at 1 - fillBuffer(L) - skip_UTF_8_BOM(L) - -proc getColNumber(L: TBaseLexer, pos: int): int = - result = abs(pos - L.lineStart) - -proc getCurrentLine(L: TBaseLexer, marker: bool = true): string = - var i: int - result = "" - i = L.lineStart - while not (L.buf[i] in {'\c', '\L', EndOfFile}): - add(result, L.buf[i]) - inc(i) - add(result, "\n") - if marker: - add(result, RepeatChar(getColNumber(L, L.bufpos)) & "^\n") - diff --git a/nimlib/pure/logging.nim b/nimlib/pure/logging.nim deleted file mode 100755 index 6df39f50b7..0000000000 --- a/nimlib/pure/logging.nim +++ /dev/null @@ -1,146 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a simple logger. It is based on the following design: -## * Runtime log formating is a bug: Sooner or later ever log file is parsed. -## * Keep it simple: If this library does not fullfill your needs, write your -## own. Trying to support every logging feature just leads to bloat. -## -## Format is:: -## -## DEBUG|INFO|... (2009-11-02 00:00:00)? (Component: )? Message -## -## - -type - TLevel* = enum ## logging level - lvlAll, ## all levels active - lvlDebug, ## debug level (and any above) active - lvlInfo, ## info level (and any above) active - lvlWarn, ## warn level (and any above) active - lvlError, ## error level (and any above) active - lvlFatal ## fatal level (and any above) active - -const - LevelNames*: array [TLevel, string] = [ - "DEBUG", "DEBUG", "INFO", "WARN", "ERROR", "FATAL" - ] - -type - TLogger* = object of TObject ## abstract logger; the base type of all loggers - levelThreshold*: TLevel ## only messages of level >= levelThreshold - ## should be processed - TConsoleLogger* = object of TLogger ## logger that writes the messages to the - ## console - - TFileLogger* = object of TLogger ## logger that writes the messages to a file - f: TFile - - TRollingFileLogger* = object of - TFileLogger ## logger that writes the message to a file - maxlines: int # maximum number of lines - lines: seq[string] - -method log*(L: ref TLogger, level: TLevel, - frmt: string, args: openArray[string]) = - ## override this method in custom loggers. Default implementation does - ## nothing. - nil - -method log*(L: ref TConsoleLogger, level: TLevel, - frmt: string, args: openArray[string]) = - Writeln(stdout, LevelNames[level], " ", frmt % args) - -method log*(L: ref TFileLogger, level: TLevel, - frmt: string, args: openArray[string]) = - Writeln(L.f, LevelNames[level], " ", frmt % args) - -proc defaultFilename*(): string = - ## returns the default filename for a logger - var (path, name, ext) = splitFile(getApplicationFilename()) - result = changeFileExt(path / name & "_" & getDateStr(), "log") - -proc substituteLog*(frmt: string): string = - ## converts $date to the current date - ## converts $time to the current time - ## converts $app to getApplicationFilename() - ## converts - result = "" - var i = 0 - while i < frmt.len: - if frmt[i] != '$': - result.add(frmt[i]) - inc(i) - else: - inc(i) - var v = "" - var app = getApplicationFilename() - while frmt[i] in IdentChars: - v.add(toLower(frmt[i])) - inc(i) - case v - of "date": result.add(getDateStr()) - of "time": result.add(getClockStr()) - of "app": result.add(app) - of "appdir": result.add(app.splitFile.dir) - of "appname": result.add(app.splitFile.name) - - -proc newFileLogger(filename = defaultFilename(), - mode: TFileMode = fmAppend, - levelThreshold = lvlNone): ref TFileLogger = - new(result) - result.levelThreshold = levelThreshold - if not open(result.f, filename, mode): - raiseException(EIO, "cannot open for writing: " & filename) - -proc newRollingFileLogger(filename = defaultFilename(), - mode: TFileMode = fmAppend, - levelThreshold = lvlNone, - maxLines = 1000): ref TFileLogger = - new(result) - result.levelThreshold = levelThreshold - result.maxLines = maxLines - if not open(result.f, filename, mode): - raiseException(EIO, "cannot open for writing: " & filename) - -var - level* = lvlNone - handlers*: seq[ref TLogger] = @[] - -proc logLoop(level: TLevel, msg: string) = - for logger in items(handlers): - if level >= logger.levelThreshold: - log(logger, level, msg) - -template log*(level: TLevel, msg: string) = - ## logs a message of the given level - if level >= logging.Level: - (bind logLoop)(level, frmt, args) - -template debug*(msg: string) = - ## logs a debug message - log(lvlDebug, msg) - -template info*(msg: string) = - ## logs an info message - log(lvlInfo, msg) - -template warn*(msg: string) = - ## logs a warning message - log(lvlWarn, msg) - -template error*(msg: string) = - ## logs an error message - log(lvlError, msg) - -template fatal*(msg: string) = - ## logs a fatal error message and calls ``quit(msg)`` - log(lvlFatal, msg) - diff --git a/nimlib/pure/macros.nim b/nimlib/pure/macros.nim deleted file mode 100755 index 677469ed28..0000000000 --- a/nimlib/pure/macros.nim +++ /dev/null @@ -1,249 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -## This module contains the interface to the compiler's abstract syntax -## tree (`AST`:idx:). Macros operate on this tree. - -## .. include:: ../doc/astspec.txt - -#[[[cog -#def toEnum(name, elems): -# body = "" -# counter = 0 -# for e in elems: -# if counter % 4 == 0: p = "\n " -# else: p = "" -# body = body + p + 'n' + e + ', ' -# counter = counter + 1 -# -# return (" TNimrod%s* = enum%s\n TNim%ss* = set[TNimrod%s]\n" % -# (name, body[:-2], name, name)) -# -#enums = eval(open("data/ast.yml").read()) -#cog.out("type\n") -#for key, val in enums.items(): -# if key[-4:] == "Flag": continue -# cog.out(toEnum(key, val)) -#]]] -type - TNimrodNodeKind* = enum - nnkNone, nnkEmpty, nnkIdent, nnkSym, - nnkType, nnkCharLit, nnkIntLit, nnkInt8Lit, - nnkInt16Lit, nnkInt32Lit, nnkInt64Lit, nnkFloatLit, - nnkFloat32Lit, nnkFloat64Lit, nnkStrLit, nnkRStrLit, - nnkTripleStrLit, nnkMetaNode, nnkNilLit, nnkDotCall, - nnkCommand, nnkCall, nnkCallStrLit, nnkExprEqExpr, - nnkExprColonExpr, nnkIdentDefs, nnkVarTuple, nnkInfix, - nnkPrefix, nnkPostfix, nnkPar, nnkCurly, - nnkBracket, nnkBracketExpr, nnkPragmaExpr, nnkRange, - nnkDotExpr, nnkCheckedFieldExpr, nnkDerefExpr, nnkIfExpr, - nnkElifExpr, nnkElseExpr, nnkLambda, nnkAccQuoted, - nnkTableConstr, nnkBind, nnkSymChoice, nnkHiddenStdConv, - nnkHiddenSubConv, nnkHiddenCallConv, nnkConv, nnkCast, - nnkAddr, nnkHiddenAddr, nnkHiddenDeref, nnkObjDownConv, - nnkObjUpConv, nnkChckRangeF, nnkChckRange64, nnkChckRange, - nnkStringToCString, nnkCStringToString, nnkPassAsOpenArray, nnkAsgn, - nnkFastAsgn, nnkGenericParams, nnkFormalParams, nnkOfInherit, - nnkModule, nnkProcDef, nnkMethodDef, nnkConverterDef, - nnkMacroDef, nnkTemplateDef, nnkIteratorDef, nnkOfBranch, - nnkElifBranch, nnkExceptBranch, nnkElse, nnkMacroStmt, - nnkAsmStmt, nnkPragma, nnkIfStmt, nnkWhenStmt, - nnkForStmt, nnkWhileStmt, nnkCaseStmt, nnkVarSection, - nnkConstSection, nnkConstDef, nnkTypeSection, nnkTypeDef, - nnkYieldStmt, nnkTryStmt, nnkFinally, nnkRaiseStmt, - nnkReturnStmt, nnkBreakStmt, nnkContinueStmt, nnkBlockStmt, - nnkDiscardStmt, nnkStmtList, nnkImportStmt, nnkFromStmt, - nnkIncludeStmt, nnkCommentStmt, nnkStmtListExpr, nnkBlockExpr, - nnkStmtListType, nnkBlockType, nnkTypeOfExpr, nnkObjectTy, - nnkTupleTy, nnkRecList, nnkRecCase, nnkRecWhen, - nnkRefTy, nnkPtrTy, nnkVarTy, nnkDistinctTy, - nnkProcTy, nnkEnumTy, nnkEnumFieldDef, nnkReturnToken - TNimNodeKinds* = set[TNimrodNodeKind] - TNimrodTypeKind* = enum - ntyNone, ntyBool, ntyChar, ntyEmpty, - ntyArrayConstr, ntyNil, ntyExpr, ntyStmt, - ntyTypeDesc, ntyGenericInvokation, ntyGenericBody, ntyGenericInst, - ntyGenericParam, ntyDistinct, ntyEnum, ntyOrdinal, - ntyArray, ntyObject, ntyTuple, ntySet, - ntyRange, ntyPtr, ntyRef, ntyVar, - ntySequence, ntyProc, ntyPointer, ntyOpenArray, - ntyString, ntyCString, ntyForward, ntyInt, - ntyInt8, ntyInt16, ntyInt32, ntyInt64, - ntyFloat, ntyFloat32, ntyFloat64, ntyFloat128 - TNimTypeKinds* = set[TNimrodTypeKind] - TNimrodSymKind* = enum - nskUnknown, nskConditional, nskDynLib, nskParam, - nskGenericParam, nskTemp, nskType, nskConst, - nskVar, nskProc, nskMethod, nskIterator, - nskConverter, nskMacro, nskTemplate, nskField, - nskEnumField, nskForVar, nskModule, nskLabel, - nskStub - TNimSymKinds* = set[TNimrodSymKind] -#[[[end]]] - -type - TNimrodIdent* = object of TObject - ## represents a Nimrod identifier in the AST - - TNimrodSymbol {.final.} = object # hidden - TNimrodType {.final.} = object # hidden - - PNimrodType* {.compilerproc.} = ref TNimrodType - ## represents a Nimrod type in the compiler; currently this is not very - ## useful as there is no API to deal with Nimrod types. - - PNimrodSymbol* {.compilerproc.} = ref TNimrodSymbol - ## represents a Nimrod *symbol* in the compiler; a *symbol* is a looked-up - ## *ident*. - - PNimrodNode* = expr - ## represents a Nimrod AST node. Macros operate on this type. - -# Nodes should be reference counted to make the `copy` operation very fast! -# However, this is difficult to achieve: modify(n[0][1]) should propagate to -# its father. How to do this without back references? - -proc `[]`* (n: PNimrodNode, i: int): PNimrodNode {.magic: "NChild".} - ## get `n`'s `i`'th child. - -proc `[]=`* (n: PNimrodNode, i: int, child: PNimrodNode) {.magic: "NSetChild".} - ## set `n`'s `i`'th child to `child`. - -proc `!` *(s: string): TNimrodIdent {.magic: "StrToIdent".} - ## constructs an identifier from the string `s` - -proc `$`*(i: TNimrodIdent): string {.magic: "IdentToStr".} - ## converts a Nimrod identifier to a string - -proc `==`* (a, b: TNimrodIdent): bool {.magic: "EqIdent", noSideEffect.} - ## compares two Nimrod identifiers - -proc `==`* (a, b: PNimrodNode): bool {.magic: "EqNimrodNode", noSideEffect.} - ## compares two Nimrod nodes - -proc len*(n: PNimrodNode): int {.magic: "NLen".} - ## returns the number of children of `n`. - -proc add*(father, child: PNimrodNode) {.magic: "NAdd".} - ## adds the `child` to the `father` node - -proc add*(father: PNimrodNode, children: openArray[PNimrodNode]) {. - magic: "NAddMultiple".} - ## adds each child of `children` to the `father` node - -proc del*(father: PNimrodNode, idx = 0, n = 1) {.magic: "NDel".} - ## deletes `n` children of `father` starting at index `idx`. - -proc kind*(n: PNimrodNode): TNimrodNodeKind {.magic: "NKind".} - ## returns the `kind` of the node `n`. - -proc intVal*(n: PNimrodNode): biggestInt {.magic: "NIntVal".} -proc floatVal*(n: PNimrodNode): biggestFloat {.magic: "NFloatVal".} -proc symbol*(n: PNimrodNode): PNimrodSymbol {.magic: "NSymbol".} -proc ident*(n: PNimrodNode): TNimrodIdent {.magic: "NIdent".} -proc typ*(n: PNimrodNode): PNimrodType {.magic: "NGetType".} -proc strVal*(n: PNimrodNode): string {.magic: "NStrVal".} - -proc `intVal=`*(n: PNimrodNode, val: biggestInt) {.magic: "NSetIntVal".} -proc `floatVal=`*(n: PNimrodNode, val: biggestFloat) {.magic: "NSetFloatVal".} -proc `symbol=`*(n: PNimrodNode, val: PNimrodSymbol) {.magic: "NSetSymbol".} -proc `ident=`*(n: PNimrodNode, val: TNimrodIdent) {.magic: "NSetIdent".} -proc `typ=`*(n: PNimrodNode, typ: PNimrodType) {.magic: "NSetType".} -proc `strVal=`*(n: PNimrodNode, val: string) {.magic: "NSetStrVal".} - -proc newNimNode*(kind: TNimrodNodeKind, - n: PNimrodNode=nil): PNimrodNode {.magic: "NNewNimNode".} - -proc copyNimNode*(n: PNimrodNode): PNimrodNode {.magic: "NCopyNimNode".} -proc copyNimTree*(n: PNimrodNode): PNimrodNode {.magic: "NCopyNimTree".} - -proc error*(msg: string) {.magic: "NError".} - ## writes an error message at compile time - -proc warning*(msg: string) {.magic: "NWarning".} - ## writes a warning message at compile time - -proc hint*(msg: string) {.magic: "NHint".} - ## writes a hint message at compile time - -proc newStrLitNode*(s: string): PNimrodNode {.compileTime.} = - ## creates a string literal node from `s` - result = newNimNode(nnkStrLit) - result.strVal = s - -proc newIntLitNode*(i: biggestInt): PNimrodNode {.compileTime.} = - ## creates a int literal node from `i` - result = newNimNode(nnkIntLit) - result.intVal = i - -proc newFloatLitNode*(f: biggestFloat): PNimrodNode {.compileTime.} = - ## creates a float literal node from `f` - result = newNimNode(nnkFloatLit) - result.floatVal = f - -proc newIdentNode*(i: TNimrodIdent): PNimrodNode {.compileTime.} = - ## creates an identifier node from `i` - result = newNimNode(nnkIdent) - result.ident = i - -proc newIdentNode*(i: string): PNimrodNode {.compileTime.} = - ## creates an identifier node from `i` - result = newNimNode(nnkIdent) - result.ident = !i - -proc toStrLit*(n: PNimrodNode): PNimrodNode {.compileTime.} = - ## converts the AST `n` to the concrete Nimrod code and wraps that - ## in a string literal node - return newStrLitNode(repr(n)) - -proc expectKind*(n: PNimrodNode, k: TNimrodNodeKind) {.compileTime.} = - ## checks that `n` is of kind `k`. If this is not the case, - ## compilation aborts with an error message. This is useful for writing - ## macros that check the AST that is passed to them. - if n.kind != k: error("macro expects a node of kind: " & repr(k)) - -proc expectMinLen*(n: PNimrodNode, min: int) {.compileTime.} = - ## checks that `n` has at least `min` children. If this is not the case, - ## compilation aborts with an error message. This is useful for writing - ## macros that check its number of arguments. - if n.len < min: error("macro expects a node with " & $min & " children") - -proc expectLen*(n: PNimrodNode, len: int) {.compileTime.} = - ## checks that `n` has exactly `len` children. If this is not the case, - ## compilation aborts with an error message. This is useful for writing - ## macros that check its number of arguments. - if n.len != len: error("macro expects a node with " & $len & " children") - -proc newCall*(theProc: TNimrodIdent, - args: openArray[PNimrodNode]): PNimrodNode {.compileTime.} = - ## produces a new call node. `theProc` is the proc that is called with - ## the arguments ``args[0..]``. - result = newNimNode(nnkCall) - result.add(newIdentNode(theProc)) - result.add(args) - -proc newCall*(theProc: string, - args: openArray[PNimrodNode]): PNimrodNode {.compileTime.} = - ## produces a new call node. `theProc` is the proc that is called with - ## the arguments ``args[0..]``. - result = newNimNode(nnkCall) - result.add(newIdentNode(theProc)) - result.add(args) - -proc nestList*(theProc: TNimrodIdent, - x: PNimrodNode): PNimrodNode {.compileTime.} = - ## nests the list `x` into a tree of call expressions: - ## ``[a, b, c]`` is transformed into ``theProc(a, theProc(c, d))`` - var L = x.len - result = newCall(theProc, x[L-2], x[L-1]) - var a = result - for i in countdown(L-3, 0): - a = newCall(theProc, x[i], copyNimTree(a)) - diff --git a/nimlib/pure/math.nim b/nimlib/pure/math.nim deleted file mode 100755 index bca45894ca..0000000000 --- a/nimlib/pure/math.nim +++ /dev/null @@ -1,249 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Basic math routines for Nimrod. -## This module is available for the ECMAScript target. - -{.push debugger:off .} # the user does not want to trace a part - # of the standard library! - -{.push checks:off, line_dir:off, stack_trace:off.} - -when defined(Posix): - {.passl: "-lm".} - -const - PI* = 3.1415926535897932384626433 ## the circle constant PI (Ludolph's number) - E* = 2.71828182845904523536028747 ## Euler's number - -type - TFloatClass* = enum ## describes the class a floating point value belongs to. - ## This is the type that is returned by `classify`. - fcNormal, ## value is an ordinary nonzero floating point value - fcSubnormal, ## value is a subnormal (a very small) floating point value - fcZero, ## value is zero - fcNegZero, ## value is the negative zero - fcNan, ## value is Not-A-Number (NAN) - fcInf, ## value is positive infinity - fcNegInf ## value is negative infinity - -proc classify*(x: float): TFloatClass = - ## classifies a floating point value. Returns `x`'s class as specified by - ## `TFloatClass`. - - # ECMAScript and most C compilers have no classify: - if x == 0.0: - if 1.0/x == Inf: - return fcZero - else: - return fcNegZero - if x*0.5 == x: - if x > 0.0: return fcInf - else: return fcNegInf - if x != x: return fcNan - return fcNormal - # XXX: fcSubnormal is not detected! - - -proc binom*(n, k: int): int {.noSideEffect.} = - ## computes the binomial coefficient - if k <= 0: return 1 - if 2*k > n: return binom(n, n-k) - result = n - for i in countup(2, k): - result = (result * (n + 1 - i)) div i - -proc fac*(n: int): int {.noSideEffect.} = - ## computes the faculty function - result = 1 - for i in countup(2, n): - result = result * i - -proc isPowerOfTwo*(x: int): bool {.noSideEffect.} = - ## returns true, if x is a power of two, false otherwise. - ## Negative numbers are not a power of two. - return (x and -x) == x - -proc nextPowerOfTwo*(x: int): int = - ## returns the nearest power of two, so that - ## result**2 >= x > (result-1)**2. - result = x - 1 - when defined(cpu64): - result = result or (result shr 32) - result = result or (result shr 16) - result = result or (result shr 8) - result = result or (result shr 4) - result = result or (result shr 2) - result = result or (result shr 1) - Inc(result) - -proc countBits32*(n: int32): int {.noSideEffect.} = - ## counts the set bits in `n`. - var v = n - v = v -% ((v shr 1'i32) and 0x55555555'i32) - v = (v and 0x33333333'i32) +% ((v shr 2'i32) and 0x33333333'i32) - result = ((v +% (v shr 4'i32) and 0xF0F0F0F'i32) *% 0x1010101'i32) shr 24'i32 - -proc sum*[T](x: openarray[T]): T {.noSideEffect.} = - ## computes the sum of the elements in `x`. - ## If `x` is empty, 0 is returned. - for i in items(x): result = result + i - -proc mean*(x: openarray[float]): float {.noSideEffect.} = - ## computes the mean of the elements in `x`. - ## If `x` is empty, NaN is returned. - result = sum(x) / toFloat(len(x)) - -proc variance*(x: openarray[float]): float {.noSideEffect.} = - ## computes the mean of the elements in `x`. - ## If `x` is empty, NaN is returned. - result = 0.0 - var m = mean(x) - for i in 0 .. high(x): - var diff = x[i] - m - result = result + diff*diff - result = result / toFloat(len(x)) - -when not defined(ECMAScript): - proc random*(max: int): int - ## returns a random number in the range 0..max-1. The sequence of - ## random number is always the same, unless `randomize` is called - ## which initializes the random number generator with a "random" - ## number, i.e. a tickcount. - proc randomize*() - ## initializes the random number generator with a "random" - ## number, i.e. a tickcount. Note: Does nothing for the ECMAScript target, - ## as ECMAScript does not support this. - - proc sqrt*(x: float): float {.importc: "sqrt", header: "".} - ## computes the square root of `x`. - - proc ln*(x: float): float {.importc: "log", header: "".} - ## computes ln(x). - proc log10*(x: float): float {.importc: "log10", header: "".} - proc log2*(x: float): float = return ln(x) / ln(2.0) - proc exp*(x: float): float {.importc: "exp", header: "".} - ## computes e**x. - - proc frexp*(x: float, exponent: var int): float {. - importc: "frexp", header: "".} - ## Split a number into mantissa and exponent. - ## `frexp` calculates the mantissa m (a float greater than or equal to 0.5 - ## and less than 1) and the integer value n such that `x` (the original - ## float value) equals m * 2**n. frexp stores n in `exponent` and returns - ## m. - - proc round*(x: float): int {.importc: "lrint", nodecl.} - ## converts a float to an int by rounding. - - proc arccos*(x: float): float {.importc: "acos", header: "".} - proc arcsin*(x: float): float {.importc: "asin", header: "".} - proc arctan*(x: float): float {.importc: "atan", header: "".} - proc arctan2*(y, x: float): float {.importc: "atan2", header: "".} - ## Calculate the arc tangent of `y` / `x`. - ## `atan2` returns the arc tangent of `y` / `x`; it produces correct - ## results even when the resulting angle is near pi/2 or -pi/2 - ## (`x` near 0). - - proc cos*(x: float): float {.importc: "cos", header: "".} - proc cosh*(x: float): float {.importc: "cosh", header: "".} - proc hypot*(x, y: float): float {.importc: "hypot", header: "".} - ## same as ``sqrt(x*x + y*y)``. - - proc sinh*(x: float): float {.importc: "sinh", header: "".} - proc tan*(x: float): float {.importc: "tan", header: "".} - proc tanh*(x: float): float {.importc: "tanh", header: "".} - proc pow*(x, y: float): float {.importc: "pow", header: "".} - ## computes x to power raised of y. - - # C procs: - proc gettime(dummy: ptr cint): cint {.importc: "time", header: "".} - proc srand(seed: cint) {.importc: "srand", nodecl.} - proc rand(): cint {.importc: "rand", nodecl.} - - proc randomize() = srand(gettime(nil)) - proc random(max: int): int = return int(rand()) mod max - -else: - proc mathrandom(): float {.importc: "Math.random", nodecl.} - proc mathfloor(x: float): float {.importc: "Math.floor", nodecl.} - proc random*(max: int): int = return mathfloor(mathrandom() * max) - proc randomize*() = nil - - proc sqrt*(x: float): float {.importc: "Math.sqrt", nodecl.} - proc ln*(x: float): float {.importc: "Math.log", nodecl.} - proc log10*(x: float): float = return ln(x) / ln(10.0) - proc log2*(x: float): float = return ln(x) / ln(2.0) - - proc exp*(x: float): float {.importc: "Math.exp", nodecl.} - proc round*(x: float): int {.importc: "Math.round", nodecl.} - proc pow*(x, y: float): float {.importc: "Math.pow", nodecl.} - - proc frexp*(x: float, exponent: var int): float = - if x == 0.0: - exponent = 0.0 - result = 0.0 - elif x < 0.0: - result = -frexp(-x, exponent) - else: - var ex = mathfloor(log2(x)) - exponent = round(ex) - result = x / pow(2.0, ex) - - proc arccos*(x: float): float {.importc: "Math.acos", nodecl.} - proc arcsin*(x: float): float {.importc: "Math.asin", nodecl.} - proc arctan*(x: float): float {.importc: "Math.atan", nodecl.} - proc arctan2*(y, x: float): float {.importc: "Math.atan2", nodecl.} - - proc cos*(x: float): float {.importc: "Math.cos", nodecl.} - proc cosh*(x: float): float = return (exp(x)+exp(-x))*0.5 - proc hypot*(x, y: float): float = return sqrt(x*x + y*y) - proc sinh*(x: float): float = return (exp(x)-exp(-x))*0.5 - proc tan*(x: float): float {.importc: "Math.tan", nodecl.} - proc tanh*(x: float): float = - var y = exp(2.0*x) - return (y-1.0)/(y+1.0) - - -type - TRunningStat* = object ## an accumulator for statistical data - n*: int ## number of pushed data - sum*, min*, max*, mean*: float ## self-explaining - oldM, oldS, newS: float - -proc push*(s: var TRunningStat, x: float) = - ## pushes a value `x` for processing - inc(s.n) - # See Knuth TAOCP vol 2, 3rd edition, page 232 - if s.n == 1: - s.oldM = x - s.mean = x - s.oldS = 0.0 - else: - s.mean = s.oldM + (x - s.oldM)/toFloat(s.n) - s.newS = s.oldS + (x - s.oldM)*(x - s.mean) - - # set up for next iteration: - s.oldM = s.mean - s.oldS = s.newS - - s.sum = s.sum + x - if s.min > x: s.min = x - if s.max < x: s.max = x - -proc variance*(s: TRunningStat): float = - ## computes the current variance of `s` - if s.n > 1: result = s.newS / (toFloat(s.n - 1)) - -proc standardDeviation*(s: TRunningStat): float = - ## computes the current standard deviation of `s` - result = sqrt(variance(s)) - -{.pop.} -{.pop.} diff --git a/nimlib/pure/md5.nim b/nimlib/pure/md5.nim deleted file mode 100755 index d9bb929490..0000000000 --- a/nimlib/pure/md5.nim +++ /dev/null @@ -1,245 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Module for computing MD5 checksums. - -type - MD5State = array[0..3, int32] - MD5Block = array[0..15, int32] - MD5CBits = array[0..7, int8] - MD5Digest* = array[0..15, int8] - MD5Buffer = array[0..63, int8] - MD5Context* {.final.} = object - State: MD5State - Count: array[0..1, int32] - Buffer: MD5Buffer - -const - padding: cstring = "\x80\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0\0\0\0\0" & - "\0\0\0\0" - -proc F(x, y, z: int32): int32 {.inline.} = - Result = (x and y) or ((not x) and z) - -proc G(x, y, z: int32): int32 {.inline.} = - Result = (x and z) or (y and (not z)) - -proc H(x, y, z: int32): int32 {.inline.} = - Result = x xor y xor z - -proc I(x, y, z: int32): int32 {.inline.} = - Result = y xor (x or (not z)) - -proc rot(x: var int32, n: int8) {.inline.} = - x = toU32(x shl ze(n)) or (x shr toU32(32 -% ze(n))) - -proc FF(a: var int32, b, c, d, x: int32, s: int8, ac: int32) = - a = a +% F(b, c, d) +% x +% ac - rot(a, s) - a = a +% b - -proc GG(a: var int32, b, c, d, x: int32, s: int8, ac: int32) = - a = a +% G(b, c, d) +% x +% ac - rot(a, s) - a = a +% b - -proc HH(a: var int32, b, c, d, x: int32, s: int8, ac: int32) = - a = a +% H(b, c, d) +% x +% ac - rot(a, s) - a = a +% b - -proc II(a: var int32, b, c, d, x: int32, s: int8, ac: int32) = - a = a +% I(b, c, d) +% x +% ac - rot(a, s) - a = a +% b - -proc encode(dest: var MD5Block, src: cstring) = - var j = 0 - for i in 0..high(dest): - dest[i] = toU32(ord(src[j]) or - ord(src[j+1]) shl 8 or - ord(src[j+2]) shl 16 or - ord(src[j+3]) shl 24) - inc(j, 4) - -proc decode(dest: var openarray[int8], src: openarray[int32]) = - var i = 0 - for j in 0..high(src): - dest[i] = toU8(src[j] and 0xff'i32) - dest[i+1] = toU8(src[j] shr 8'i32 and 0xff'i32) - dest[i+2] = toU8(src[j] shr 16'i32 and 0xff'i32) - dest[i+3] = toU8(src[j] shr 24'i32 and 0xff'i32) - inc(i, 4) - -proc transform(Buffer: pointer, State: var MD5State) = - var - myBlock: MD5Block - encode(myBlock, cast[cstring](buffer)) - var a = State[0] - var b = State[1] - var c = State[2] - var d = State[3] - FF(a, b, c, d, myBlock[0], 7'i8, 0xD76AA478'i32) - FF(d, a, b, c, myBlock[1], 12'i8, 0xE8C7B756'i32) - FF(c, d, a, b, myBlock[2], 17'i8, 0x242070DB'i32) - FF(b, c, d, a, myBlock[3], 22'i8, 0xC1BDCEEE'i32) - FF(a, b, c, d, myBlock[4], 7'i8, 0xF57C0FAF'i32) - FF(d, a, b, c, myBlock[5], 12'i8, 0x4787C62A'i32) - FF(c, d, a, b, myBlock[6], 17'i8, 0xA8304613'i32) - FF(b, c, d, a, myBlock[7], 22'i8, 0xFD469501'i32) - FF(a, b, c, d, myBlock[8], 7'i8, 0x698098D8'i32) - FF(d, a, b, c, myBlock[9], 12'i8, 0x8B44F7AF'i32) - FF(c, d, a, b, myBlock[10], 17'i8, 0xFFFF5BB1'i32) - FF(b, c, d, a, myBlock[11], 22'i8, 0x895CD7BE'i32) - FF(a, b, c, d, myBlock[12], 7'i8, 0x6B901122'i32) - FF(d, a, b, c, myBlock[13], 12'i8, 0xFD987193'i32) - FF(c, d, a, b, myBlock[14], 17'i8, 0xA679438E'i32) - FF(b, c, d, a, myBlock[15], 22'i8, 0x49B40821'i32) - GG(a, b, c, d, myBlock[1], 5'i8, 0xF61E2562'i32) - GG(d, a, b, c, myBlock[6], 9'i8, 0xC040B340'i32) - GG(c, d, a, b, myBlock[11], 14'i8, 0x265E5A51'i32) - GG(b, c, d, a, myBlock[0], 20'i8, 0xE9B6C7AA'i32) - GG(a, b, c, d, myBlock[5], 5'i8, 0xD62F105D'i32) - GG(d, a, b, c, myBlock[10], 9'i8, 0x02441453'i32) - GG(c, d, a, b, myBlock[15], 14'i8, 0xD8A1E681'i32) - GG(b, c, d, a, myBlock[4], 20'i8, 0xE7D3FBC8'i32) - GG(a, b, c, d, myBlock[9], 5'i8, 0x21E1CDE6'i32) - GG(d, a, b, c, myBlock[14], 9'i8, 0xC33707D6'i32) - GG(c, d, a, b, myBlock[3], 14'i8, 0xF4D50D87'i32) - GG(b, c, d, a, myBlock[8], 20'i8, 0x455A14ED'i32) - GG(a, b, c, d, myBlock[13], 5'i8, 0xA9E3E905'i32) - GG(d, a, b, c, myBlock[2], 9'i8, 0xFCEFA3F8'i32) - GG(c, d, a, b, myBlock[7], 14'i8, 0x676F02D9'i32) - GG(b, c, d, a, myBlock[12], 20'i8, 0x8D2A4C8A'i32) - HH(a, b, c, d, myBlock[5], 4'i8, 0xFFFA3942'i32) - HH(d, a, b, c, myBlock[8], 11'i8, 0x8771F681'i32) - HH(c, d, a, b, myBlock[11], 16'i8, 0x6D9D6122'i32) - HH(b, c, d, a, myBlock[14], 23'i8, 0xFDE5380C'i32) - HH(a, b, c, d, myBlock[1], 4'i8, 0xA4BEEA44'i32) - HH(d, a, b, c, myBlock[4], 11'i8, 0x4BDECFA9'i32) - HH(c, d, a, b, myBlock[7], 16'i8, 0xF6BB4B60'i32) - HH(b, c, d, a, myBlock[10], 23'i8, 0xBEBFBC70'i32) - HH(a, b, c, d, myBlock[13], 4'i8, 0x289B7EC6'i32) - HH(d, a, b, c, myBlock[0], 11'i8, 0xEAA127FA'i32) - HH(c, d, a, b, myBlock[3], 16'i8, 0xD4EF3085'i32) - HH(b, c, d, a, myBlock[6], 23'i8, 0x04881D05'i32) - HH(a, b, c, d, myBlock[9], 4'i8, 0xD9D4D039'i32) - HH(d, a, b, c, myBlock[12], 11'i8, 0xE6DB99E5'i32) - HH(c, d, a, b, myBlock[15], 16'i8, 0x1FA27CF8'i32) - HH(b, c, d, a, myBlock[2], 23'i8, 0xC4AC5665'i32) - II(a, b, c, d, myBlock[0], 6'i8, 0xF4292244'i32) - II(d, a, b, c, myBlock[7], 10'i8, 0x432AFF97'i32) - II(c, d, a, b, myBlock[14], 15'i8, 0xAB9423A7'i32) - II(b, c, d, a, myBlock[5], 21'i8, 0xFC93A039'i32) - II(a, b, c, d, myBlock[12], 6'i8, 0x655B59C3'i32) - II(d, a, b, c, myBlock[3], 10'i8, 0x8F0CCC92'i32) - II(c, d, a, b, myBlock[10], 15'i8, 0xFFEFF47D'i32) - II(b, c, d, a, myBlock[1], 21'i8, 0x85845DD1'i32) - II(a, b, c, d, myBlock[8], 6'i8, 0x6FA87E4F'i32) - II(d, a, b, c, myBlock[15], 10'i8, 0xFE2CE6E0'i32) - II(c, d, a, b, myBlock[6], 15'i8, 0xA3014314'i32) - II(b, c, d, a, myBlock[13], 21'i8, 0x4E0811A1'i32) - II(a, b, c, d, myBlock[4], 6'i8, 0xF7537E82'i32) - II(d, a, b, c, myBlock[11], 10'i8, 0xBD3AF235'i32) - II(c, d, a, b, myBlock[2], 15'i8, 0x2AD7D2BB'i32) - II(b, c, d, a, myBlock[9], 21'i8, 0xEB86D391'i32) - State[0] = State[0] +% a - State[1] = State[1] +% b - State[2] = State[2] +% c - State[3] = State[3] +% d - -proc MD5Init*(c: var MD5Context) = - ## initializes a MD5Context - c.State[0] = 0x67452301'i32 - c.State[1] = 0xEFCDAB89'i32 - c.State[2] = 0x98BADCFE'i32 - c.State[3] = 0x10325476'i32 - c.Count[0] = 0'i32 - c.Count[1] = 0'i32 - ZeroMem(addr(c.Buffer), SizeOf(MD5Buffer)) - -proc MD5Update*(c: var MD5Context, input: cstring, len: int) = - ## updates the MD5Context with the `input` data of length `len` - var input = input - var Index = (c.Count[0] shr 3) and 0x3F - c.Count[0] = c.count[0] +% toU32(len shl 3) - if c.Count[0] < (len shl 3): c.Count[1] = c.count[1] +% 1'i32 - c.Count[1] = c.count[1] +% toU32(len shr 29) - var PartLen = 64 - Index - if len >= PartLen: - CopyMem(addr(c.Buffer[Index]), Input, PartLen) - transform(addr(c.Buffer), c.State) - var i = PartLen - while i + 63 < len: - Transform(addr(Input[I]), c.State) - inc(i, 64) - CopyMem(addr(c.Buffer[0]), addr(Input[i]), len-i) - else: - CopyMem(addr(c.Buffer[Index]), addr(Input[0]), len) - -proc MD5Final*(c: var MD5Context, digest: var MD5Digest) = - ## finishes the MD5Context and stores the result in `digest` - var - Bits: MD5CBits - PadLen: int - decode(bits, c.Count) - var Index = (c.Count[0] shr 3) and 0x3F - if Index < 56: PadLen = 56 - Index - else: PadLen = 120 - Index - MD5Update(c, padding, PadLen) - MD5Update(c, cast[cstring](addr(Bits)), 8) - decode(digest, c.State) - ZeroMem(addr(c), SizeOf(MD5Context)) - -proc toMD5*(s: string): MD5Digest = - ## computes the MD5Digest value for a string `s` - var c: MD5Context - MD5Init(c) - MD5Update(c, cstring(s), len(s)) - MD5Final(c, result) - -proc `$`*(D: MD5Digest): string = - ## converts a MD5Digest value into its string representation - const digits = "0123456789abcdef" - result = "" - for i in 0..15: - add(result, Digits[(D[I] shr 4) and 0xF]) - add(result, Digits[D[I] and 0xF]) - -proc getMD5*(s: string): string = - ## computes an MD5 value of `s` and returns its string representation - var - c: MD5Context - d: MD5Digest - MD5Init(c) - MD5Update(c, cstring(s), len(s)) - MD5Final(c, d) - result = $d - -proc `==`*(D1, D2: MD5Digest): bool = - ## checks if two MD5Digest values are identical - for i in 0..15: - if D1[i] != D2[i]: return false - return true - -when isMainModule: - assert(getMD5("Franz jagt im komplett verwahrlosten Taxi quer durch Bayern") == - "a3cca2b2aa1e3b5b3b5aad99a8529074") - assert(getMD5("Frank jagt im komplett verwahrlosten Taxi quer durch Bayern") == - "7e716d0e702df0505fc72e2b89467910") - assert($toMD5("") == "d41d8cd98f00b204e9800998ecf8427e") - - diff --git a/nimlib/pure/os.nim b/nimlib/pure/os.nim deleted file mode 100755 index afa145e9f6..0000000000 --- a/nimlib/pure/os.nim +++ /dev/null @@ -1,1147 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module contains basic operating system facilities like -## retrieving environment variables, reading command line arguments, -## working with directories, running shell commands, etc. -{.deadCodeElim: on.} - -{.push debugger: off.} - -import - strutils, times - -when defined(windows): - import winlean -elif defined(posix): - import posix -else: - {.error: "OS module not ported to your operating system!".} - -include "system/ansi_c" - -# copied from excpt.nim, because I don't want to make this template public -template newException(exceptn, message: expr): expr = - block: # open a new scope - var - e: ref exceptn - new(e) - e.msg = message - e - -const - doslike = defined(windows) or defined(OS2) or defined(DOS) - # DOS-like filesystem - -when defined(Nimdoc): # only for proper documentation: - const - CurDir* = '.' - ## The constant string used by the operating system to refer to the - ## current directory. - ## - ## For example: '.' for POSIX or ':' for the classic Macintosh. - - ParDir* = ".." - ## The constant string used by the operating system to refer to the parent - ## directory. - ## - ## For example: ".." for POSIX or "::" for the classic Macintosh. - - DirSep* = '/' - ## The character used by the operating system to separate pathname - ## components, for example, '/' for POSIX or ':' for the classic - ## Macintosh. - - AltSep* = '/' - ## An alternative character used by the operating system to separate - ## pathname components, or the same as `DirSep` if only one separator - ## character exists. This is set to '/' on Windows systems where `DirSep` - ## is a backslash. - - PathSep* = ':' - ## The character conventionally used by the operating system to separate - ## search patch components (as in PATH), such as ':' for POSIX or ';' for - ## Windows. - - FileSystemCaseSensitive* = True - ## True if the file system is case sensitive, false otherwise. Used by - ## `cmpPaths` to compare filenames properly. - - ExeExt* = "" - ## The file extension of native executables. For example: - ## "" for POSIX, "exe" on Windows. - - ScriptExt* = "" - ## The file extension of a script file. For example: "" for POSIX, - ## "bat" on Windows. - -elif defined(macos): - const - curdir* = ':' - pardir* = "::" - dirsep* = ':' - altsep* = dirsep - pathsep* = ',' - FileSystemCaseSensitive* = false - ExeExt* = "" - ScriptExt* = "" - - # 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 if one ensures that all partial paths - # begin with a colon, and all full paths end 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 are 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. -elif doslike: - const - curdir* = '.' - pardir* = ".." - dirsep* = '\\' # seperator within paths - altsep* = '/' - pathSep* = ';' # seperator between paths - FileSystemCaseSensitive* = false - ExeExt* = "exe" - ScriptExt* = "bat" -elif defined(PalmOS) or defined(MorphOS): - const - dirsep* = '/' - altsep* = dirsep - PathSep* = ';' - pardir* = ".." - FileSystemCaseSensitive* = false - ExeExt* = "" - ScriptExt* = "" -elif defined(RISCOS): - const - dirsep* = '.' - altsep* = '.' - pardir* = ".." # is this correct? - pathSep* = ',' - FileSystemCaseSensitive* = true - ExeExt* = "" - ScriptExt* = "" -else: # UNIX-like operating system - const - curdir* = '.' - pardir* = ".." - dirsep* = '/' - altsep* = dirsep - pathSep* = ':' - FileSystemCaseSensitive* = true - ExeExt* = "" - ScriptExt* = "" - -const - ExtSep* = '.' - ## The character which separates the base filename from the extension; - ## for example, the '.' in ``os.nim``. - -# procs dealing with command line arguments: -proc paramCount*(): int - ## Returns the number of command line arguments given to the - ## application. - -proc paramStr*(i: int): string - ## Returns the `i`-th command line arguments given to the - ## application. - ## - ## `i` should be in the range `1..paramCount()`, else - ## the `EOutOfIndex` exception is raised. - -proc OSError*(msg: string = "") {.noinline.} = - ## raises an EOS exception with the given message ``msg``. - ## If ``msg == ""``, the operating system's error flag - ## (``errno``) is converted to a readable error message. On Windows - ## ``GetLastError`` is checked before ``errno``. - ## If no error flag is set, the message ``unknown OS error`` is used. - if len(msg) == 0: - when defined(Windows): - var err = GetLastError() - if err != 0'i32: - # sigh, why is this is so difficult? - var msgbuf: cstring - if FormatMessageA(0x00000100 or 0x00001000 or 0x00000200, - nil, err, 0, addr(msgbuf), 0, nil) != 0'i32: - var m = $msgbuf - if msgbuf != nil: - LocalFree(msgbuf) - raise newException(EOS, m) - if errno != 0'i32: - raise newException(EOS, $os.strerror(errno)) - else: - raise newException(EOS, "unknown OS error") - else: - raise newException(EOS, msg) - -proc UnixToNativePath*(path: string): string {.noSideEffect.} = - ## Converts an UNIX-like path to a native one. - ## - ## On an UNIX system this does nothing. Else it converts - ## '/', '.', '..' to the appropriate things. - when defined(unix): - result = path - else: - var start: int - if path[0] == '/': - # an absolute path - when doslike: - result = r"C:\" - elif defined(macos): - result = "" # must not start with ':' - else: - result = $dirSep - start = 1 - elif path[0] == '.' and path[1] == '/': - # current directory - result = $curdir - start = 2 - else: - result = "" - start = 0 - - var i = start - while i < len(path): # ../../../ --> :::: - if path[i] == '.' and path[i+1] == '.' and path[i+2] == '/': - # parent directory - when defined(macos): - if result[high(result)] == ':': - add result, ':' - else: - add result, pardir - else: - add result, pardir & dirSep - inc(i, 3) - elif path[i] == '/': - add result, dirSep - inc(i) - else: - add result, path[i] - inc(i) - -proc existsFile*(filename: string): bool = - ## Returns true if the file exists, false otherwise. - when defined(windows): - var a = GetFileAttributesA(filename) - if a != -1'i32: - result = (a and FILE_ATTRIBUTE_DIRECTORY) == 0'i32 - else: - var res: TStat - return stat(filename, res) >= 0'i32 and S_ISREG(res.st_mode) - -proc existsDir*(dir: string): bool = - ## Returns true iff the directory `dir` exists. If `dir` is a file, false - ## is returned. - when defined(windows): - var a = GetFileAttributesA(dir) - if a != -1'i32: - result = (a and FILE_ATTRIBUTE_DIRECTORY) != 0'i32 - else: - var res: TStat - return stat(dir, res) >= 0'i32 and S_ISDIR(res.st_mode) - -proc getLastModificationTime*(file: string): TTime = - ## Returns the `file`'s last modification time. - when defined(posix): - var res: TStat - if stat(file, res) < 0'i32: OSError() - return res.st_mtime - else: - var f: TWIN32_Find_Data - var h = findfirstFileA(file, f) - if h == -1'i32: OSError() - result = winTimeToUnixTime(rdFileTime(f.ftLastWriteTime)) - findclose(h) - -proc getLastAccessTime*(file: string): TTime = - ## Returns the `file`'s last read or write access time. - when defined(posix): - var res: TStat - if stat(file, res) < 0'i32: OSError() - return res.st_atime - else: - var f: TWIN32_Find_Data - var h = findfirstFileA(file, f) - if h == -1'i32: OSError() - result = winTimeToUnixTime(rdFileTime(f.ftLastAccessTime)) - findclose(h) - -proc getCreationTime*(file: string): TTime = - ## Returns the `file`'s creation time. - when defined(posix): - var res: TStat - if stat(file, res) < 0'i32: OSError() - return res.st_ctime - else: - var f: TWIN32_Find_Data - var h = findfirstFileA(file, f) - if h == -1'i32: OSError() - result = winTimeToUnixTime(rdFileTime(f.ftCreationTime)) - findclose(h) - -proc fileNewer*(a, b: string): bool = - ## Returns true if the file `a` is newer than file `b`, i.e. if `a`'s - ## modification time is later than `b`'s. - result = getLastModificationTime(a) - getLastModificationTime(b) > 0 - -proc getCurrentDir*(): string = - ## Returns the current working directory. - const bufsize = 512 # should be enough - result = newString(bufsize) - when defined(windows): - var L = GetCurrentDirectoryA(bufsize, result) - if L == 0'i32: OSError() - setLen(result, L) - else: - if getcwd(result, bufsize) != nil: - setlen(result, c_strlen(result)) - else: - OSError() - -proc setCurrentDir*(newDir: string) {.inline.} = - ## Sets the current working directory; `EOS` is raised if - ## `newDir` cannot been set. - when defined(Windows): - if SetCurrentDirectoryA(newDir) == 0'i32: OSError() - else: - if chdir(newDir) != 0'i32: OSError() - -proc JoinPath*(head, tail: string): string {.noSideEffect.} = - ## Joins two directory names to one. - ## - ## For example on Unix: - ## - ## ..code-block:: nimrod - ## JoinPath("usr", "lib") - ## - ## results in: - ## - ## ..code-block:: nimrod - ## "usr/lib" - ## - ## If head is the empty string, tail is returned. - ## If tail is the empty string, head is returned. - if len(head) == 0: - result = tail - elif head[len(head)-1] in {DirSep, AltSep}: - if tail[0] in {DirSep, AltSep}: - result = head & copy(tail, 1) - else: - result = head & tail - else: - if tail[0] in {DirSep, AltSep}: - result = head & tail - else: - result = head & DirSep & tail - -proc JoinPath*(parts: openarray[string]): string {.noSideEffect.} = - ## The same as `JoinPath(head, tail)`, but works with any number - ## of directory parts. - result = parts[0] - for i in 1..high(parts): - result = JoinPath(result, parts[i]) - -proc `/` * (head, tail: string): string {.noSideEffect.} = - ## The same as ``joinPath(head, tail)`` - return joinPath(head, tail) - -proc SplitPath*(path: string, head, tail: var string) {.noSideEffect, - deprecated.} = - ## **Deprecated since version 0.8.2**: use the version that returns a tuple - ## instead - var - sepPos = -1 - for i in countdown(len(path)-1, 0): - if path[i] in {dirsep, altsep}: - sepPos = i - break - if sepPos >= 0: - head = copy(path, 0, sepPos-1) - tail = copy(path, sepPos+1) - else: - head = "" - tail = path # make a string copy here - -proc SplitPath*(path: string): tuple[head, tail: string] {.noSideEffect.} = - ## Splits a directory into (head, tail), so that - ## ``JoinPath(head, tail) == path``. - ## - ## Examples: - ## .. code-block:: nimrod - ## SplitPath("usr/local/bin") -> ("usr/local", "bin") - ## SplitPath("usr/local/bin/") -> ("usr/local/bin", "") - ## SplitPath("bin") -> ("", "bin") - ## SplitPath("/bin") -> ("", "bin") - ## SplitPath("") -> ("", "") - var - sepPos = -1 - for i in countdown(len(path)-1, 0): - if path[i] in {dirsep, altsep}: - sepPos = i - break - if sepPos >= 0: - result.head = copy(path, 0, sepPos-1) - result.tail = copy(path, sepPos+1) - else: - result.head = "" - result.tail = path - -proc parentDir*(path: string): string {.noSideEffect.} = - ## Returns the parent directory of `path`. - ## - ## This is often the same as the ``head`` result of ``splitPath``. - ## If there is no parent, ``path`` is returned. - ## Example: ``parentDir("/usr/local/bin") == "/usr/local"``. - ## Example: ``parentDir("/usr/local/bin/") == "/usr/local"``. - var - sepPos = -1 - q = 1 - if path[len(path)-1] in {dirsep, altsep}: - q = 2 - for i in countdown(len(path)-q, 0): - if path[i] in {dirsep, altsep}: - sepPos = i - break - if sepPos >= 0: - result = copy(path, 0, sepPos-1) - else: - result = path - -proc `/../` * (head, tail: string): string {.noSideEffect.} = - ## The same as ``parentDir(head) / tail`` - return parentDir(head) / tail - -proc normExt(ext: string): string = - if ext == "" or ext[0] == extSep: result = ext # no copy needed here - else: result = extSep & ext - -proc searchExtPos(s: string): int = - # BUGFIX: do not search until 0! .DS_Store is no file extension! - result = -1 - for i in countdown(len(s)-1, 1): - if s[i] == extsep: - result = i - break - elif s[i] in {dirsep, altsep}: - break # do not skip over path - -proc splitFile*(path: string): tuple[dir, name, ext: string] {.noSideEffect.} = - ## Splits a filename into (dir, filename, extension). - ## `dir` does not end in `DirSep`. - ## `extension` includes the leading dot. - ## - ## Example: - ## - ## .. code-block:: nimrod - ## var (dir, name, ext) = splitFile("usr/local/nimrodc.html") - ## assert dir == "usr/local" - ## assert name == "nimrodc" - ## assert ext == ".html" - ## - ## If `path` has no extension, `ext` is the empty string. - ## If `path` has no directory component, `dir` is the empty string. - ## If `path` has no filename component, `name` and `ext` are empty strings. - if path.len == 0 or path[path.len-1] in {dirSep, altSep}: - result = (path, "", "") - else: - var sepPos = -1 - var dotPos = path.len - for i in countdown(len(path)-1, 0): - if path[i] == ExtSep: - if dotPos == path.len and i > 0: dotPos = i - elif path[i] in {dirsep, altsep}: - sepPos = i - break - result.dir = copy(path, 0, sepPos-1) - result.name = copy(path, sepPos+1, dotPos-1) - result.ext = copy(path, dotPos) - -proc extractDir*(path: string): string {.noSideEffect, deprecated.} = - ## Extracts the directory of a given path. This is almost the - ## same as the `head` result of `splitPath`, except that - ## ``extractDir("/usr/lib/") == "/usr/lib/"``. - ## **Deprecated since version 0.8.2**: Use ``splitFile(path).dir`` instead. - result = splitFile(path).dir - -proc extractFilename*(path: string): string {.noSideEffect.} = - ## Extracts the filename of a given `path`. This is the same as - ## ``name & ext`` from ``splitFile(path)``. - if path.len == 0 or path[path.len-1] in {dirSep, altSep}: - result = "" - else: - result = splitPath(path).tail - -proc expandFilename*(filename: string): string = - ## Returns the full path of `filename`, raises EOS in case of an error. - when defined(windows): - var unused: cstring - result = newString(3072) - var L = GetFullPathNameA(filename, 3072'i32, result, unused) - if L <= 0'i32 or L >= 3072'i32: OSError() - setLen(result, L) - else: - var res = realpath(filename, nil) - if res == nil: OSError() - result = $res - c_free(res) - -proc SplitFilename*(filename: string, name, extension: var string) {. - noSideEffect, deprecated.} = - ## Splits a filename into (name, extension), so that - ## ``name & extension == filename``. - ## - ## Example: After ``SplitFilename("usr/local/nimrodc.html", name, ext)``, - ## `name` is "usr/local/nimrodc" and `ext` is ".html". - ## If the file has no extension, extension is the empty string. - ## **Deprecated since version 0.8.2**: Use ``splitFile(filename)`` instead. - var extPos = searchExtPos(filename) - if extPos >= 0: - name = copy(filename, 0, extPos-1) - extension = copy(filename, extPos) - else: - name = filename # make a string copy here - extension = "" - -proc extractFileExt*(filename: string): string {.noSideEffect, deprecated.} = - ## Extracts the file extension of a given `filename`. This is the - ## same as the `extension` result of `splitFilename`. - ## **Deprecated since version 0.8.2**: Use ``splitFile(filename).ext`` - ## instead. - result = splitFile(filename).ext - -proc extractFileTrunk*(filename: string): string {.noSideEffect, deprecated.} = - ## Extracts the file name of a given `filename`. This removes any - ## directory information and the file extension. - ## **Deprecated since version 0.8.2**: Use ``splitFile(path).name`` instead. - result = splitFile(filename).name - -proc ChangeFileExt*(filename, ext: string): string {.noSideEffect.} = - ## Changes the file extension to `ext`. - ## - ## If the `filename` has no extension, `ext` will be added. - ## If `ext` == "" then any extension is removed. - ## `Ext` should be given without the leading '.', because some - ## filesystems may use a different character. (Although I know - ## of none such beast.) - var extPos = searchExtPos(filename) - if extPos < 0: result = filename & normExt(ext) - else: result = copy(filename, 0, extPos-1) & normExt(ext) - -proc addFileExt*(filename, ext: string): string {.noSideEffect.} = - ## Adds the file extension `ext` to `filename`, unless - ## `filename` already has an extension. - ## - ## `Ext` should be given without the leading '.', because some - ## filesystems may use a different character. - ## (Although I know of none such beast.) - var extPos = searchExtPos(filename) - if extPos < 0: result = filename & normExt(ext) - else: result = filename - -proc AppendFileExt*(filename, ext: string): string {. - noSideEffect, deprecated.} = - ## **Deprecated since version 0.8.2**: Use `addFileExt` instead. - result = addFileExt(filename, ext) - -proc cmpPaths*(pathA, pathB: string): int {.noSideEffect.} = - ## Compares two paths. - ## - ## On a case-sensitive filesystem this is done - ## case-sensitively otherwise case-insensitively. Returns: - ## - ## | 0 iff pathA == pathB - ## | < 0 iff pathA < pathB - ## | > 0 iff pathA > pathB - if FileSystemCaseSensitive: - result = cmp(pathA, pathB) - else: - result = cmpIgnoreCase(pathA, pathB) - -proc sameFile*(path1, path2: string): bool = - ## Returns True if both pathname arguments refer to the same file or - ## directory (as indicated by device number and i-node number). - ## Raises an exception if an os.stat() call on either pathname fails. - when defined(Windows): - var - a, b: TWin32FindData - var resA = findfirstFileA(path1, a) - var resB = findfirstFileA(path2, b) - if resA != -1 and resB != -1: - result = $a.cFileName == $b.cFileName - else: - # work around some ``findfirstFileA`` bugs - result = cmpPaths(path1, path2) == 0 - if resA != -1: findclose(resA) - if resB != -1: findclose(resB) - else: - var - a, b: TStat - if stat(path1, a) < 0'i32 or stat(path2, b) < 0'i32: - result = cmpPaths(path1, path2) == 0 # be consistent with Windows - else: - result = a.st_dev == b.st_dev and a.st_ino == b.st_ino - -proc sameFileContent*(path1, path2: string): bool = - ## Returns True if both pathname arguments refer to files with identical - ## binary content. - const - bufSize = 8192 # 8K buffer - var - a, b: TFile - if not open(a, path1): return false - if not open(b, path2): - close(a) - return false - var bufA = alloc(bufsize) - var bufB = alloc(bufsize) - while True: - var readA = readBuffer(a, bufA, bufsize) - var readB = readBuffer(b, bufB, bufsize) - if readA != readB: - result = false - break - if readA == 0: - result = true - break - result = equalMem(bufA, bufB, readA) - if not result: break - if readA != bufSize: break # end of file - dealloc(bufA) - dealloc(bufB) - close(a) - close(b) - -proc copyFile*(dest, source: string) = - ## Copies a file from `source` to `dest`. If this fails, - ## `EOS` is raised. - when defined(Windows): - if CopyFileA(source, dest, 0'i32) == 0'i32: OSError() - else: - # generic version of copyFile which works for any platform: - const - bufSize = 8192 # 8K buffer - var - d, s: TFile - if not open(s, source): OSError() - if not open(d, dest, fmWrite): - close(s) - OSError() - var - buf: Pointer = alloc(bufsize) - bytesread, byteswritten: int - while True: - bytesread = readBuffer(s, buf, bufsize) - byteswritten = writeBuffer(d, buf, bytesread) - if bytesread != bufSize: break - if bytesread != bytesWritten: OSError() - dealloc(buf) - close(s) - close(d) - -proc moveFile*(dest, source: string) = - ## Moves a file from `source` to `dest`. If this fails, `EOS` is raised. - if crename(source, dest) != 0'i32: OSError() - -proc removeFile*(file: string) = - ## Removes the `file`. If this fails, `EOS` is raised. - if cremove(file) != 0'i32: OSError() - -proc executeShellCommand*(command: string): int {.deprecated.} = - ## **Deprecated since version 0.8.2**: Use `execShellCmd` instead. - result = csystem(command) - -proc execShellCmd*(command: string): int = - ## Executes a shell command. - ## - ## Command has the form 'program args' where args are the command - ## line arguments given to program. The proc returns the error code - ## of the shell when it has finished. The proc does not return until - ## the process has finished. To execute a program without having a - ## shell involved, use the `execProcess` proc of the `osproc` - ## module. - result = csystem(command) - -var - envComputed: bool = false - environment: seq[string] = @[] - -when defined(windows): - # because we support Windows GUI applications, things get really - # messy here... - proc strEnd(cstr: CString, c = 0'i32): CString {. - importc: "strchr", header: "".} - - proc getEnvVarsC() = - if not envComputed: - var - env = getEnvironmentStringsA() - e = env - if e == nil: return # an error occured - while True: - var eend = strEnd(e) - add(environment, $e) - e = cast[CString](cast[TAddress](eend)+1) - if eend[1] == '\0': break - envComputed = true - discard FreeEnvironmentStringsA(env) - -else: - var - gEnv {.importc: "gEnv".}: ptr array [0..10_000, CString] - - proc getEnvVarsC() = - # retrieves the variables of char** env of C's main proc - if not envComputed: - var i = 0 - while True: - if gEnv[i] == nil: break - add environment, $gEnv[i] - inc(i) - envComputed = true - -proc findEnvVar(key: string): int = - getEnvVarsC() - var temp = key & '=' - for i in 0..high(environment): - if startsWith(environment[i], temp): return i - return -1 - -proc getEnv*(key: string): string = - ## Returns the value of the environment variable named `key`. - ## - ## If the variable does not exist, "" is returned. To distinguish - ## whether a variable exists or it's value is just "", call - ## `existsEnv(key)`. - var i = findEnvVar(key) - if i >= 0: - return copy(environment[i], find(environment[i], '=')+1) - else: - var env = cgetenv(key) - if env == nil: return "" - result = $env - -proc existsEnv*(key: string): bool = - ## Checks whether the environment variable named `key` exists. - ## Returns true if it exists, false otherwise. - if cgetenv(key) != nil: return true - else: return findEnvVar(key) >= 0 - -proc putEnv*(key, val: string) = - ## Sets the value of the environment variable named `key` to `val`. - ## If an error occurs, `EInvalidEnvVar` is raised. - - # Note: by storing the string in the environment sequence, - # we gurantee that we don't free the memory before the program - # ends (this is needed for POSIX compliance). It is also needed so that - # the process itself may access its modified environment variables! - var indx = findEnvVar(key) - if indx >= 0: - environment[indx] = key & '=' & val - else: - add environment, (key & '=' & val) - indx = high(environment) - when defined(unix): - if cputenv(environment[indx]) != 0'i32: - OSError() - else: - if SetEnvironmentVariableA(key, val) == 0'i32: - OSError() - -iterator iterOverEnvironment*(): tuple[key, value: string] {.deprecated.} = - ## Iterate over all environments variables. In the first component of the - ## tuple is the name of the current variable stored, in the second its value. - ## **Deprecated since version 0.8.2**: Use `envPairs` instead. - getEnvVarsC() - for i in 0..high(environment): - var p = find(environment[i], '=') - yield (copy(environment[i], 0, p-1), copy(environment[i], p+1)) - -iterator envPairs*(): tuple[key, value: string] = - ## Iterate over all environments variables. In the first component of the - ## tuple is the name of the current variable stored, in the second its value. - getEnvVarsC() - for i in 0..high(environment): - var p = find(environment[i], '=') - yield (copy(environment[i], 0, p-1), copy(environment[i], p+1)) - -iterator walkFiles*(pattern: string): string = - ## Iterate over all the files that match the `pattern`. - ## - ## `pattern` is OS dependant, but at least the "\*.ext" - ## notation is supported. - when defined(windows): - var - f: TWin32FindData - res: int - res = findfirstFileA(pattern, f) - if res != -1: - while true: - if f.cFileName[0] != '.': - yield splitFile(pattern).dir / extractFilename($f.cFileName) - if findnextFileA(res, f) == 0'i32: break - findclose(res) - else: # here we use glob - var - f: TGlob - res: int - f.gl_offs = 0 - f.gl_pathc = 0 - f.gl_pathv = nil - res = glob(pattern, 0, nil, addr(f)) - if res == 0: - for i in 0.. f.gl_pathc - 1: - assert(f.gl_pathv[i] != nil) - yield $f.gl_pathv[i] - globfree(addr(f)) - -type - TPathComponent* = enum ## Enumeration specifying a path component. - pcFile, ## path refers to a file - pcLinkToFile, ## path refers to a symbolic link to a file - pcDir, ## path refers to a directory - pcLinkToDir ## path refers to a symbolic link to a directory - -const - pcDirectory* {.deprecated.} = pcDir ## deprecated alias - pcLinkToDirectory* {.deprecated.} = pcLinkToDir ## deprecated alias - -iterator walkDir*(dir: string): tuple[kind: TPathComponent, path: string] = - ## walks over the directory `dir` and yields for each directory or file in - ## `dir`. The component type and full path for each item is returned. - ## Walking is not recursive. - ## Example: This directory structure:: - ## dirA / dirB / fileB1.txt - ## / dirC - ## / fileA1.txt - ## / fileA2.txt - ## - ## and this code: - ## - ## .. code-block:: Nimrod - ## for kind, path in walkDir("dirA"): - ## echo(path) - ## - ## produces this output (though not necessarily in this order!):: - ## dirA/dirB - ## dirA/dirC - ## dirA/fileA1.txt - ## dirA/fileA2.txt - when defined(windows): - var f: TWIN32_Find_Data - var h = findfirstFileA(dir / "*", f) - if h != -1: - while true: - var k = pcFile - if f.cFilename[0] != '.': - if (f.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) != 0'i32: - k = pcDir - yield (k, dir / extractFilename($f.cFilename)) - if findnextFileA(h, f) == 0'i32: break - findclose(h) - else: - var d = openDir(dir) - if d != nil: - while true: - var x = readDir(d) - if x == nil: break - var y = $x.d_name - if y != "." and y != "..": - var s: TStat - y = dir / y - if stat(y, s) < 0'i32: break - var k = pcFile - if S_ISDIR(s.st_mode): k = pcDir - if S_ISLNK(s.st_mode): k = succ(k) - yield (k, y) - discard closeDir(d) - -iterator walkDirRec*(dir: string, filter={pcFile, pcDir}): string = - ## walks over the directory `dir` and yields for each file in `dir`. The - ## full path for each file is returned. - ## Walking is recursive. `filter` controls the behaviour of the iterator: - ## - ## --------------------- --------------------------------------------- - ## filter meaning - ## --------------------- --------------------------------------------- - ## ``pcFile`` yield real files - ## ``pcLinkToFile`` yield symbolic links to files - ## ``pcDir`` follow real directories - ## ``pcLinkToDir`` follow symbolic links to directories - ## --------------------- --------------------------------------------- - ## - var stack = @[dir] - while stack.len > 0: - for k,p in walkDir(stack.pop()): - if k in filter: - case k - of pcFile, pcLinkToFile: yield p - of pcDir, pcLinkToDir: stack.add(p) - -proc rawRemoveDir(dir: string) = - when defined(windows): - if RemoveDirectoryA(dir) == 0'i32: OSError() - else: - if rmdir(dir) != 0'i32: OSError() - -proc removeDir*(dir: string) = - ## Removes the directory `dir` including all subdirectories and files - ## in `dir` (recursively). If this fails, `EOS` is raised. - for kind, path in walkDir(dir): - case kind - of pcFile, pcLinkToFile, pcLinkToDir: removeFile(path) - of pcDir: removeDir(path) - rawRemoveDir(dir) - -proc rawCreateDir(dir: string) = - when defined(unix): - if mkdir(dir, 0o711) != 0'i32 and errno != EEXIST: - OSError() - else: - if CreateDirectoryA(dir, nil) == 0'i32 and GetLastError() != 183'i32: - OSError() - -proc createDir*(dir: string) = - ## Creates the directory `dir`. - ## - ## The directory may contain several subdirectories that do not exist yet. - ## The full path is created. If this fails, `EOS` is raised. It does **not** - ## fail if the path already exists because for most usages this does not - ## indicate an error. - for i in 1.. dir.len-1: - if dir[i] in {dirsep, altsep}: rawCreateDir(copy(dir, 0, i-1)) - rawCreateDir(dir) - -proc parseCmdLine*(c: string): seq[string] = - ## Splits a command line into several components; components are separated by - ## whitespace unless the whitespace occurs within ``"`` or ``'`` quotes. - ## This proc is only occassionally useful, better use the `parseopt` module. - result = @[] - var i = 0 - var a = "" - while true: - setLen(a, 0) - while c[i] >= '\1' and c[i] <= ' ': inc(i) # skip whitespace - case c[i] - of '\'', '\"': - var delim = c[i] - inc(i) # skip ' or " - while c[i] != '\0' and c[i] != delim: - add a, c[i] - inc(i) - if c[i] != '\0': inc(i) - of '\0': break - else: - while c[i] > ' ': - add(a, c[i]) - inc(i) - add(result, a) - -type - TFilePermission* = enum ## file access permission; modelled after UNIX - fpUserExec, ## execute access for the file owner - fpUserWrite, ## write access for the file owner - fpUserRead, ## read access for the file owner - fpGroupExec, ## execute access for the group - fpGroupWrite, ## write access for the group - fpGroupRead, ## read access for the group - fpOthersExec, ## execute access for others - fpOthersWrite, ## write access for others - fpOthersRead ## read access for others - -proc getFilePermissions*(filename: string): set[TFilePermission] = - ## retrieves file permissions for `filename`. `OSError` is raised in case of - ## an error. On Windows, only the ``readonly`` flag is checked, every other - ## permission is available in any case. - when defined(posix): - var a: TStat - if stat(filename, a) < 0'i32: OSError() - result = {} - if (a.st_mode and S_IRUSR) != 0'i32: result.incl(fpUserRead) - if (a.st_mode and S_IWUSR) != 0'i32: result.incl(fpUserWrite) - if (a.st_mode and S_IXUSR) != 0'i32: result.incl(fpUserExec) - - if (a.st_mode and S_IRGRP) != 0'i32: result.incl(fpGroupRead) - if (a.st_mode and S_IWGRP) != 0'i32: result.incl(fpGroupWrite) - if (a.st_mode and S_IXGRP) != 0'i32: result.incl(fpGroupExec) - - if (a.st_mode and S_IROTH) != 0'i32: result.incl(fpOthersRead) - if (a.st_mode and S_IWOTH) != 0'i32: result.incl(fpOthersWrite) - if (a.st_mode and S_IXOTH) != 0'i32: result.incl(fpOthersExec) - else: - var res = GetFileAttributesA(filename) - if res == -1'i32: OSError() - if (res and FILE_ATTRIBUTE_READONLY) != 0'i32: - result = {fpUserExec, fpUserRead, fpGroupExec, fpGroupRead, - fpOthersExec, fpOthersRead} - else: - result = {fpUserExec..fpOthersRead} - -proc setFilePermissions*(filename: string, permissions: set[TFilePermission]) = - ## sets the file permissions for `filename`. `OSError` is raised in case of - ## an error. On Windows, only the ``readonly`` flag is changed, depending on - ## ``fpUserWrite``. - when defined(posix): - var p = 0'i32 - if fpUserRead in permissions: p = p or S_IRUSR - if fpUserWrite in permissions: p = p or S_IWUSR - if fpUserExec in permissions: p = p or S_IXUSR - - if fpGroupRead in permissions: p = p or S_IRGRP - if fpGroupWrite in permissions: p = p or S_IWGRP - if fpGroupExec in permissions: p = p or S_IXGRP - - if fpOthersRead in permissions: p = p or S_IROTH - if fpOthersWrite in permissions: p = p or S_IWOTH - if fpOthersExec in permissions: p = p or S_IXOTH - - if chmod(filename, p) != 0: OSError() - else: - var res = GetFileAttributesA(filename) - if res == -1'i32: OSError() - if fpUserWrite in permissions: - res = res and not FILE_ATTRIBUTE_READONLY - else: - res = res or FILE_ATTRIBUTE_READONLY - if SetFileAttributesA(filename, res) != 0'i32: - OSError() - -proc inclFilePermissions*(filename: string, - permissions: set[TFilePermission]) = - ## a convenience procedure for: - ## - ## .. code-block:: nimrod - ## setFilePermissions(filename, getFilePermissions(filename)+permissions) - setFilePermissions(filename, getFilePermissions(filename)+permissions) - -proc exclFilePermissions*(filename: string, - permissions: set[TFilePermission]) = - ## a convenience procedure for: - ## - ## .. code-block:: nimrod - ## setFilePermissions(filename, getFilePermissions(filename)-permissions) - setFilePermissions(filename, getFilePermissions(filename)-permissions) - -proc getHomeDir*(): string = - ## Returns the home directory of the current user. - when defined(windows): return getEnv("USERPROFILE") & "\\" - else: return getEnv("HOME") & "/" - -proc getConfigDir*(): string = - ## Returns the config directory of the current user for applications. - when defined(windows): return getEnv("APPDATA") & "\\" - else: return getEnv("HOME") & "/.config/" - -when defined(windows): - # Since we support GUI applications with Nimrod, we sometimes generate - # a WinMain entry proc. But a WinMain proc has no access to the parsed - # command line arguments. The way to get them differs. Thus we parse them - # ourselves. This has the additional benefit that the program's behaviour - # is always the same -- independent of the used C compiler. - var - ownArgv: seq[string] - - proc paramStr(i: int): string = - if isNil(ownArgv): ownArgv = parseCmdLine($getCommandLineA()) - return ownArgv[i] - - proc paramCount(): int = - if isNil(ownArgv): ownArgv = parseCmdLine($getCommandLineA()) - result = ownArgv.len-1 - -else: - var - cmdCount {.importc: "cmdCount".}: cint - cmdLine {.importc: "cmdLine".}: cstringArray - - proc paramStr(i: int): string = - if i < cmdCount and i >= 0: return $cmdLine[i] - raise newException(EInvalidIndex, "invalid index") - - proc paramCount(): int = return cmdCount-1 - -when defined(linux) or defined(solaris) or defined(bsd) or defined(aix): - proc getApplAux(procPath: string): string = - result = newString(256) - var len = readlink(procPath, result, 256) - if len > 256: - result = newString(len+1) - len = readlink(procPath, result, len) - setlen(result, len) - -when defined(macosx): - # a really hacky solution: since we like to include 2 headers we have to - # define two procs which in reality are the same - proc getExecPath1(c: cstring, size: var int32) {. - importc: "_NSGetExecutablePath", header: "".} - proc getExecPath2(c: cstring, size: var int32): bool {. - importc: "_NSGetExecutablePath", header: "".} - -proc getApplicationFilename*(): string = - ## Returns the filename of the application's executable. - - # Linux: /proc//exe - # Solaris: - # /proc//object/a.out (filename only) - # /proc//path/a.out (complete pathname) - # *BSD (and maybe Darwin too): - # /proc//file - when defined(windows): - result = newString(256) - var len = getModuleFileNameA(0, result, 256) - setlen(result, int(len)) - elif defined(linux) or defined(aix): - result = getApplAux("/proc/self/exe") - elif defined(solaris): - result = getApplAux("/proc/" & $getpid() & "/path/a.out") - elif defined(bsd): - result = getApplAux("/proc/" & $getpid() & "/file") - elif defined(macosx): - var size: int32 - getExecPath1(nil, size) - result = newString(int(size)) - if getExecPath2(result, size): - result = "" # error! - else: - # little heuristic that may work on other POSIX-like systems: - result = getEnv("_") - if len(result) == 0: - result = ParamStr(0) # POSIX guaranties that this contains the executable - # as it has been executed by the calling process - if len(result) > 0 and result[0] != DirSep: # not an absolute path? - # iterate over any path in the $PATH environment variable - for p in split(getEnv("PATH"), {PathSep}): - var x = joinPath(p, result) - if ExistsFile(x): return x - -proc getApplicationDir*(): string = - ## Returns the directory of the application's executable. - result = splitFile(getApplicationFilename()).dir - -proc sleep*(milsecs: int) = - ## sleeps `milsecs` milliseconds. - when defined(windows): - winlean.sleep(int32(milsecs)) - else: - var a, b: Ttimespec - a.tv_sec = TTime(milsecs div 1000) - a.tv_nsec = (milsecs mod 1000) * 1000 - discard posix.nanosleep(a, b) - -{.pop.} diff --git a/nimlib/pure/osproc.nim b/nimlib/pure/osproc.nim deleted file mode 100755 index d76825531a..0000000000 --- a/nimlib/pure/osproc.nim +++ /dev/null @@ -1,543 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements an advanced facility for executing OS processes -## and process communication. - -import - strutils, os, strtabs, streams - -when defined(windows): - import winlean -else: - import posix - -type - TProcess = object of TObject - when defined(windows): - FProcessHandle: Thandle - inputHandle, outputHandle, errorHandle: TFileHandle - else: - inputHandle, outputHandle, errorHandle: TFileHandle - id: cint - exitCode: cint - - PProcess* = ref TProcess ## represents an operating system process - - TProcessOption* = enum ## options that can be passed `startProcess` - poEchoCmd, ## echo the command before execution - poUseShell, ## use the shell to execute the command; NOTE: This - ## often creates a security whole! - poStdErrToStdOut, ## merge stdout and stderr to the stdout stream - poParentStreams ## use the parent's streams - -proc execProcess*(command: string, - options: set[TProcessOption] = {poStdErrToStdOut, - poUseShell}): string - ## A convience procedure that executes ``command`` with ``startProcess`` - ## and returns its output as a string. - -proc executeProcess*(command: string, - options: set[TProcessOption] = {poStdErrToStdOut, - poUseShell}): string {. - deprecated.} = - ## **Deprecated since version 0.8.2**: Use `execProcess` instead. - result = execProcess(command, options) - -proc execCmd*(command: string): int - ## Executes ``command`` and returns its error code. Standard input, output, - ## error streams are inherited from the calling process. - -proc executeCommand*(command: string): int {.deprecated.} = - ## **Deprecated since version 0.8.2**: Use `execCmd` instead. - result = execCmd(command) - - -proc startProcess*(command: string, - workingDir: string = "", - args: openarray[string] = [], - env: PStringTable = nil, - options: set[TProcessOption] = {poStdErrToStdOut}): PProcess - ## Starts a process. `Command` is the executable file, `workingDir` is the - ## process's working directory. If ``workingDir == ""`` the current directory - ## is used. `args` are the command line arguments that are passed to the - ## process. On many operating systems, the first command line argument is the - ## name of the executable. `args` should not contain this argument! - ## `env` is the environment that will be passed to the process. - ## If ``env == nil`` the environment is inherited of - ## the parent process. `options` are additional flags that may be passed - ## to `startProcess`. See the documentation of ``TProcessOption`` for the - ## meaning of these flags. - ## - ## Return value: The newly created process object. Nil is never returned, - ## but ``EOS`` is raised in case of an error. - -proc suspend*(p: PProcess) - ## Suspends the process `p`. - -proc resume*(p: PProcess) - ## Resumes the process `p`. - -proc terminate*(p: PProcess) - ## Terminates the process `p`. - -proc running*(p: PProcess): bool - ## Returns true iff the process `p` is still running. Returns immediately. - -proc processID*(p: PProcess): int = - ## returns `p`'s process ID. - return p.id - -proc waitForExit*(p: PProcess): int - ## waits for the process to finish and returns `p`'s error code. - -proc inputStream*(p: PProcess): PStream - ## returns ``p``'s input stream for writing to - -proc outputStream*(p: PProcess): PStream - ## returns ``p``'s output stream for reading from - -proc errorStream*(p: PProcess): PStream - ## returns ``p``'s output stream for reading from - -when defined(macosx) or defined(bsd): - const - CTL_HW = 6 - HW_AVAILCPU = 25 - HW_NCPU = 3 - proc sysctl(x: ptr array[0..3, cint], y: cint, z: pointer, - a: var int, b: pointer, c: int): cint {. - importc: "sysctl", header: "".} - -proc countProcessors*(): int = - ## returns the numer of the processors/cores the machine has. - ## Returns 0 if it cannot be determined. - when defined(windows): - var x = getenv("NUMBER_OF_PROCESSORS") - if x.len > 0: result = parseInt(x) - elif defined(macosx) or defined(bsd): - var - mib: array[0..3, cint] - len, numCPU: int - mib[0] = CTL_HW - mib[1] = HW_AVAILCPU - len = sizeof(numCPU) - discard sysctl(addr(mib), 2, addr(numCPU), len, nil, 0) - if numCPU < 1: - mib[1] = HW_NCPU - discard sysctl(addr(mib), 2, addr(numCPU), len, nil, 0) - result = numCPU - elif defined(hpux): - result = mpctl(MPC_GETNUMSPUS, nil, nil) - elif defined(irix): - var SC_NPROC_ONLN {.importc: "_SC_NPROC_ONLN", header: "".}: cint - result = sysconf(SC_NPROC_ONLN) - else: - result = sysconf(SC_NPROCESSORS_ONLN) - if result <= 0: result = 1 - -proc startProcessAux(cmd: string, options: set[TProcessOption]): PProcess = - var c = parseCmdLine(cmd) - var a: seq[string] = @[] # slicing is not yet implemented :-( - for i in 1 .. c.len-1: add(a, c[i]) - result = startProcess(command=c[0], args=a, options=options) - -proc execProcesses*(cmds: openArray[string], - options = {poStdErrToStdOut, poParentStreams}, - n = countProcessors()): int = - ## executes the commands `cmds` in parallel. Creates `n` processes - ## that execute in parallel. The highest return value of all processes - ## is returned. - assert n > 0 - if n > 1: - var q: seq[PProcess] - newSeq(q, n) - var m = min(n, cmds.len) - for i in 0..m-1: - q[i] = startProcessAux(cmds[i], options=options) - when defined(noBusyWaiting): - var r = 0 - for i in m..high(cmds): - when defined(debugExecProcesses): - var err = "" - var outp = outputStream(q[r]) - while running(q[r]) or not outp.atEnd(outp): - err.add(outp.readLine()) - err.add("\n") - echo(err) - result = max(waitForExit(q[r]), result) - q[r] = startProcessAux(cmds[i], options=options) - r = (r + 1) mod n - else: - var i = m - while i <= high(cmds): - sleep(50) - for r in 0..n-1: - if not running(q[r]): - #echo(outputStream(q[r]).readLine()) - result = max(waitForExit(q[r]), result) - q[r] = startProcessAux(cmds[i], options=options) - inc(i) - if i > high(cmds): break - for i in 0..m-1: - result = max(waitForExit(q[i]), result) - else: - for i in 0..high(cmds): - var p = startProcessAux(cmds[i], options=options) - result = max(waitForExit(p), result) - -when true: - nil -else: - proc startGUIProcess*(command: string, - workingDir: string = "", - args: openarray[string] = [], - env: PStringTable = nil, - x = -1, - y = -1, - width = -1, - height = -1): PProcess - -proc execProcess(command: string, - options: set[TProcessOption] = {poStdErrToStdOut, - poUseShell}): string = - var p = startProcessAux(command, options=options) - var outp = outputStream(p) - result = "" - while running(p) or not outp.atEnd(outp): - result.add(outp.readLine()) - result.add("\n") - -when false: - proc deallocCStringArray(a: cstringArray) = - var i = 0 - while a[i] != nil: - dealloc(a[i]) - inc(i) - dealloc(a) - -when defined(Windows): - # We need to implement a handle stream for Windows: - type - PFileHandleStream = ref TFileHandleStream - TFileHandleStream = object of TStream - handle: THandle - atTheEnd: bool - - proc hsClose(s: PFileHandleStream) = nil # nothing to do here - proc hsAtEnd(s: PFileHandleStream): bool = return s.atTheEnd - - proc hsReadData(s: PFileHandleStream, buffer: pointer, bufLen: int): int = - if s.atTheEnd: return 0 - var br: int32 - var a = winlean.ReadFile(s.handle, buffer, bufLen, br, nil) - # TRUE and zero bytes returned (EOF). - # TRUE and n (>0) bytes returned (good data). - # FALSE and bytes returned undefined (system error). - if a == 0 and br != 0: OSError() - s.atTheEnd = br < bufLen - result = br - - proc hsWriteData(s: PFileHandleStream, buffer: pointer, bufLen: int) = - var bytesWritten: int32 - var a = winlean.writeFile(s.handle, buffer, bufLen, bytesWritten, nil) - if a == 0: OSError() - - proc newFileHandleStream(handle: THandle): PFileHandleStream = - new(result) - result.handle = handle - result.close = hsClose - result.atEnd = hsAtEnd - result.readData = hsReadData - result.writeData = hsWriteData - - proc buildCommandLine(a: string, args: openarray[string]): cstring = - var res = quoteIfContainsWhite(a) - for i in 0..high(args): - res.add(' ') - res.add(quoteIfContainsWhite(args[i])) - result = cast[cstring](alloc0(res.len+1)) - copyMem(result, cstring(res), res.len) - - proc buildEnv(env: PStringTable): cstring = - var L = 0 - for key, val in pairs(env): inc(L, key.len + val.len + 2) - result = cast[cstring](alloc0(L+2)) - L = 0 - for key, val in pairs(env): - var x = key & "=" & val - copyMem(addr(result[L]), cstring(x), x.len+1) # copy \0 - inc(L, x.len+1) - - #proc open_osfhandle(osh: THandle, mode: int): int {. - # importc: "_open_osfhandle", header: "".} - - #var - # O_WRONLY {.importc: "_O_WRONLY", header: "".}: int - # O_RDONLY {.importc: "_O_RDONLY", header: "".}: int - - proc CreatePipeHandles(Rdhandle, WrHandle: var THandle) = - var piInheritablePipe: TSecurityAttributes - piInheritablePipe.nlength = SizeOF(TSecurityAttributes) - piInheritablePipe.lpSecurityDescriptor = nil - piInheritablePipe.Binherithandle = 1 - if CreatePipe(Rdhandle, Wrhandle, piInheritablePipe, 1024) == 0'i32: - OSError() - - proc fileClose(h: THandle) {.inline.} = - if h > 4: discard CloseHandle(h) - - proc startProcess(command: string, - workingDir: string = "", - args: openarray[string] = [], - env: PStringTable = nil, - options: set[TProcessOption] = {poStdErrToStdOut}): PProcess = - var - SI: TStartupInfo - ProcInfo: TProcessInformation - success: int - hi, ho, he: THandle - new(result) - SI.cb = SizeOf(SI) - if poParentStreams notin options: - SI.dwFlags = STARTF_USESTDHANDLES # STARTF_USESHOWWINDOW or - CreatePipeHandles(SI.hStdInput, HI) - CreatePipeHandles(HO, Si.hStdOutput) - if poStdErrToStdOut in options: - SI.hStdError = SI.hStdOutput - HE = HO - else: - CreatePipeHandles(HE, Si.hStdError) - result.inputHandle = hi - result.outputHandle = ho - result.errorHandle = he - else: - SI.hStdError = GetStdHandle(STD_ERROR_HANDLE) - SI.hStdInput = GetStdHandle(STD_INPUT_HANDLE) - SI.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE) - result.inputHandle = si.hStdInput - result.outputHandle = si.hStdOutput - result.errorHandle = si.hStdError - - var cmdl: cstring - if false: # poUseShell in options: - cmdl = buildCommandLine(getEnv("COMSPEC"), @["/c", command] & args) - else: - cmdl = buildCommandLine(command, args) - var wd: cstring = nil - var e: cstring = nil - if len(workingDir) > 0: wd = workingDir - if env != nil: e = buildEnv(env) - if poEchoCmd in options: echo($cmdl) - success = winlean.CreateProcess(nil, - cmdl, nil, nil, 1, NORMAL_PRIORITY_CLASS, e, wd, SI, ProcInfo) - - if poParentStreams notin options: - FileClose(si.hStdInput) - FileClose(si.hStdOutput) - if poStdErrToStdOut notin options: - FileClose(si.hStdError) - - if e != nil: dealloc(e) - dealloc(cmdl) - if success == 0: OSError() - # Close the handle now so anyone waiting is woken: - discard closeHandle(procInfo.hThread) - result.FProcessHandle = procInfo.hProcess - result.id = procInfo.dwProcessID - - proc suspend(p: PProcess) = - discard SuspendThread(p.FProcessHandle) - - proc resume(p: PProcess) = - discard ResumeThread(p.FProcessHandle) - - proc running(p: PProcess): bool = - var x = waitForSingleObject(p.FProcessHandle, 50) - return x == WAIT_TIMEOUT - - proc terminate(p: PProcess) = - if running(p): - discard TerminateProcess(p.FProcessHandle, 0) - - proc waitForExit(p: PProcess): int = - discard WaitForSingleObject(p.FProcessHandle, Infinite) - var res: int32 - discard GetExitCodeProcess(p.FProcessHandle, res) - result = res - discard CloseHandle(p.FProcessHandle) - - proc inputStream(p: PProcess): PStream = - result = newFileHandleStream(p.inputHandle) - - proc outputStream(p: PProcess): PStream = - result = newFileHandleStream(p.outputHandle) - - proc errorStream(p: PProcess): PStream = - result = newFileHandleStream(p.errorHandle) - - proc execCmd(command: string): int = - var - SI: TStartupInfo - ProcInfo: TProcessInformation - process: THandle - L: int32 - SI.cb = SizeOf(SI) - SI.hStdError = GetStdHandle(STD_ERROR_HANDLE) - SI.hStdInput = GetStdHandle(STD_INPUT_HANDLE) - SI.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE) - if winlean.CreateProcess(nil, command, nil, nil, 0, - NORMAL_PRIORITY_CLASS, nil, nil, SI, ProcInfo) == 0: - OSError() - else: - Process = ProcInfo.hProcess - discard CloseHandle(ProcInfo.hThread) - if WaitForSingleObject(Process, INFINITE) != -1: - discard GetExitCodeProcess(Process, L) - result = int(L) - else: - result = -1 - discard CloseHandle(Process) - -else: - const - readIdx = 0 - writeIdx = 1 - - proc addCmdArgs(command: string, args: openarray[string]): string = - result = quoteIfContainsWhite(command) - for i in 0 .. high(args): - add(result, " ") - add(result, quoteIfContainsWhite(args[i])) - - proc toCStringArray(b, a: openarray[string]): cstringArray = - result = cast[cstringArray](alloc0((a.len + b.len + 1) * sizeof(cstring))) - for i in 0..high(b): - result[i] = cast[cstring](alloc(b[i].len+1)) - copyMem(result[i], cstring(b[i]), b[i].len+1) - for i in 0..high(a): - result[i+b.len] = cast[cstring](alloc(a[i].len+1)) - copyMem(result[i+b.len], cstring(a[i]), a[i].len+1) - - proc ToCStringArray(t: PStringTable): cstringArray = - result = cast[cstringArray](alloc0((t.len + 1) * sizeof(cstring))) - var i = 0 - for key, val in pairs(t): - var x = key & "=" & val - result[i] = cast[cstring](alloc(x.len+1)) - copyMem(result[i], addr(x[0]), x.len+1) - inc(i) - - proc startProcess(command: string, - workingDir: string = "", - args: openarray[string] = [], - env: PStringTable = nil, - options: set[TProcessOption] = {poStdErrToStdOut}): PProcess = - var - p_stdin, p_stdout, p_stderr: array [0..1, cint] - new(result) - result.exitCode = 3 # for ``waitForExit`` - if pipe(p_stdin) != 0'i32 or pipe(p_stdout) != 0'i32: - OSError("failed to create a pipe") - var Pid = fork() - if Pid < 0: - OSError("failed to fork process") - - if pid == 0: - ## child process: - discard close(p_stdin[writeIdx]) - if dup2(p_stdin[readIdx], readIdx) < 0: OSError() - discard close(p_stdout[readIdx]) - if dup2(p_stdout[writeIdx], writeIdx) < 0: OSError() - if poStdErrToStdOut in options: - if dup2(p_stdout[writeIdx], 2) < 0: OSError() - else: - if pipe(p_stderr) != 0'i32: OSError("failed to create a pipe") - discard close(p_stderr[readIdx]) - if dup2(p_stderr[writeIdx], 2) < 0: OSError() - - if workingDir.len > 0: - os.setCurrentDir(workingDir) - if poUseShell notin options: - var a = toCStringArray([extractFilename(command)], args) - if env == nil: - discard execv(command, a) - else: - discard execve(command, a, ToCStringArray(env)) - else: - var x = addCmdArgs(command, args) - var a = toCStringArray(["sh", "-c"], [x]) - if env == nil: - discard execv("/bin/sh", a) - else: - discard execve("/bin/sh", a, ToCStringArray(env)) - # too risky to raise an exception here: - quit("execve call failed: " & $strerror(errno)) - # Parent process. Copy process information. - if poEchoCmd in options: - echo(command & " " & join(args, " ")) - result.id = pid - - result.inputHandle = p_stdin[writeIdx] - result.outputHandle = p_stdout[readIdx] - if poStdErrToStdOut in options: - result.errorHandle = result.outputHandle - else: - result.errorHandle = p_stderr[readIdx] - discard close(p_stderr[writeIdx]) - discard close(p_stdin[readIdx]) - discard close(p_stdout[writeIdx]) - - proc suspend(p: PProcess) = - discard kill(p.id, SIGSTOP) - - proc resume(p: PProcess) = - discard kill(p.id, SIGCONT) - - proc running(p: PProcess): bool = - result = waitPid(p.id, p.exitCode, WNOHANG) == int(p.id) - - proc terminate(p: PProcess) = - if kill(p.id, SIGTERM) == 0'i32: - if running(p): discard kill(p.id, SIGKILL) - - proc waitForExit(p: PProcess): int = - #if waitPid(p.id, p.exitCode, 0) == int(p.id): - # ``waitPid`` fails if the process is not running anymore. But then - # ``running`` probably set ``p.exitCode`` for us. Since ``p.exitCode`` is - # initialized with 3, wrong success exit codes are prevented. - var oldExitCode = p.exitCode - if waitPid(p.id, p.exitCode, 0) < 0: - # failed, so restore old exitCode - p.exitCode = oldExitCode - result = int(p.exitCode) - - proc inputStream(p: PProcess): PStream = - var f: TFile - if not open(f, p.inputHandle, fmWrite): OSError() - result = newFileStream(f) - - proc outputStream(p: PProcess): PStream = - var f: TFile - if not open(f, p.outputHandle, fmRead): OSError() - result = newFileStream(f) - - proc errorStream(p: PProcess): PStream = - var f: TFile - if not open(f, p.errorHandle, fmRead): OSError() - result = newFileStream(f) - - proc csystem(cmd: cstring): cint {.nodecl, importc: "system".} - - proc execCmd(command: string): int = - result = csystem(command) - -when isMainModule: - var x = execProcess("gcc -v") - echo "ECHO ", x diff --git a/nimlib/pure/parsecfg.nim b/nimlib/pure/parsecfg.nim deleted file mode 100755 index c26dab0993..0000000000 --- a/nimlib/pure/parsecfg.nim +++ /dev/null @@ -1,352 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## The ``parsecfg`` module implements a high performance configuration file -## parser. The configuration file's syntax is similar to the Windows ``.ini`` -## format, but much more powerful, as it is not a line based parser. String -## literals, raw string literals and triple quoted string literals are supported -## as in the Nimrod programming language. - -## This is an example of how a configuration file may look like: -## -## .. include:: doc/mytest.cfg -## :literal: -## The file ``tests/tparscfg.nim`` demonstrates how to use the -## configuration file parser: -## -## .. code-block:: nimrod -## :file: tests/tparscfg.nim - - -import - hashes, strutils, lexbase, streams - -type - TCfgEventKind* = enum ## enumation of all events that may occur when parsing - cfgEof, ## end of file reached - cfgSectionStart, ## a ``[section]`` has been parsed - cfgKeyValuePair, ## a ``key=value`` pair has been detected - cfgOption, ## a ``--key=value`` command line option - cfgError ## an error ocurred during parsing - - TCfgEvent* = object of TObject ## describes a parsing event - case kind*: TCfgEventKind ## the kind of the event - of cfgEof: nil - of cfgSectionStart: - section*: string ## `section` contains the name of the - ## parsed section start (syntax: ``[section]``) - of cfgKeyValuePair, cfgOption: - key*, value*: string ## contains the (key, value) pair if an option - ## of the form ``--key: value`` or an ordinary - ## ``key= value`` pair has been parsed. - ## ``value==""`` if it was not specified in the - ## configuration file. - of cfgError: ## the parser encountered an error: `msg` - msg*: string ## contains the error message. No exceptions - ## are thrown if a parse error occurs. - - TTokKind = enum - tkInvalid, tkEof, - tkSymbol, tkEquals, tkColon, tkBracketLe, tkBracketRi, tkDashDash - TToken {.final.} = object # a token - kind: TTokKind # the type of the token - literal: string # the parsed (string) literal - - TParserState = enum - startState # , commaState # not yet used - TCfgParser* = object of TBaseLexer ## the parser object. - tok: TToken - state: TParserState - filename: string - -proc open*(c: var TCfgParser, input: PStream, filename: string) - ## initializes the parser with an input stream. `Filename` is only used - ## for nice error messages. - -proc close*(c: var TCfgParser) - ## closes the parser `c` and its associated input stream. - -proc next*(c: var TCfgParser): TCfgEvent - ## retrieves the first/next event. This controls the parser. - -proc getColumn*(c: TCfgParser): int - ## get the current column the parser has arrived at. - -proc getLine*(c: TCfgParser): int - ## get the current line the parser has arrived at. - -proc getFilename*(c: TCfgParser): string - ## get the filename of the file that the parser processes. - -proc errorStr*(c: TCfgParser, msg: string): string - ## returns a properly formated error message containing current line and - ## column information. - - -# implementation - -const - SymChars: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} - -proc rawGetTok(c: var TCfgParser, tok: var TToken) -proc open(c: var TCfgParser, input: PStream, filename: string) = - lexbase.open(c, input) - c.filename = filename - c.state = startState - c.tok.kind = tkInvalid - c.tok.literal = "" - rawGetTok(c, c.tok) - -proc close(c: var TCfgParser) = - lexbase.close(c) - -proc getColumn(c: TCfgParser): int = - result = getColNumber(c, c.bufPos) - -proc getLine(c: TCfgParser): int = - result = c.linenumber - -proc getFilename(c: TCfgParser): string = - result = c.filename - -proc handleHexChar(c: var TCfgParser, xi: var int) = - case c.buf[c.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10) - inc(c.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10) - inc(c.bufpos) - else: - nil - -proc handleDecChars(c: var TCfgParser, xi: var int) = - while c.buf[c.bufpos] in {'0'..'9'}: - xi = (xi * 10) + (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - -proc getEscapedChar(c: var TCfgParser, tok: var TToken) = - inc(c.bufpos) # skip '\' - case c.buf[c.bufpos] - of 'n', 'N': - add(tok.literal, "\n") - Inc(c.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, '\c') - Inc(c.bufpos) - of 'l', 'L': - add(tok.literal, '\L') - Inc(c.bufpos) - of 'f', 'F': - add(tok.literal, '\f') - inc(c.bufpos) - of 'e', 'E': - add(tok.literal, '\e') - Inc(c.bufpos) - of 'a', 'A': - add(tok.literal, '\a') - Inc(c.bufpos) - of 'b', 'B': - add(tok.literal, '\b') - Inc(c.bufpos) - of 'v', 'V': - add(tok.literal, '\v') - Inc(c.bufpos) - of 't', 'T': - add(tok.literal, '\t') - Inc(c.bufpos) - of '\'', '\"': - add(tok.literal, c.buf[c.bufpos]) - Inc(c.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(c.bufpos) - of 'x', 'X': - inc(c.bufpos) - var xi = 0 - handleHexChar(c, xi) - handleHexChar(c, xi) - add(tok.literal, Chr(xi)) - of '0'..'9': - var xi = 0 - handleDecChars(c, xi) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: tok.kind = tkInvalid - else: tok.kind = tkInvalid - -proc HandleCRLF(c: var TCfgParser, pos: int): int = - case c.buf[pos] - of '\c': result = lexbase.HandleCR(c, pos) - of '\L': result = lexbase.HandleLF(c, pos) - else: result = pos - -proc getString(c: var TCfgParser, tok: var TToken, rawMode: bool) = - var pos = c.bufPos + 1 # skip " - var buf = c.buf # put `buf` in a register - tok.kind = tkSymbol - if (buf[pos] == '\"') and (buf[pos + 1] == '\"'): - # long string literal: - inc(pos, 2) # skip "" - # skip leading newline: - pos = HandleCRLF(c, pos) - buf = c.buf - while true: - case buf[pos] - of '\"': - if (buf[pos + 1] == '\"') and (buf[pos + 2] == '\"'): break - add(tok.literal, '\"') - Inc(pos) - of '\c', '\L': - pos = HandleCRLF(c, pos) - buf = c.buf - add(tok.literal, "\n") - of lexbase.EndOfFile: - tok.kind = tkInvalid - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - c.bufpos = pos + 3 # skip the three """ - else: - # ordinary string literal - while true: - var ch = buf[pos] - if ch == '\"': - inc(pos) # skip '"' - break - if ch in {'\c', '\L', lexbase.EndOfFile}: - tok.kind = tkInvalid - break - if (ch == '\\') and not rawMode: - c.bufPos = pos - getEscapedChar(c, tok) - pos = c.bufPos - else: - add(tok.literal, ch) - Inc(pos) - c.bufpos = pos - -proc getSymbol(c: var TCfgParser, tok: var TToken) = - var pos = c.bufpos - var buf = c.buf - while true: - add(tok.literal, buf[pos]) - Inc(pos) - if not (buf[pos] in SymChars): break - c.bufpos = pos - tok.kind = tkSymbol - -proc skip(c: var TCfgParser) = - var pos = c.bufpos - var buf = c.buf - while true: - case buf[pos] - of ' ', '\t': - Inc(pos) - of '#', ';': - while not (buf[pos] in {'\c', '\L', lexbase.EndOfFile}): inc(pos) - of '\c', '\L': - pos = HandleCRLF(c, pos) - buf = c.buf - else: - break # EndOfFile also leaves the loop - c.bufpos = pos - -proc rawGetTok(c: var TCfgParser, tok: var TToken) = - tok.kind = tkInvalid - setlen(tok.literal, 0) - skip(c) - case c.buf[c.bufpos] - of '=': - tok.kind = tkEquals - inc(c.bufpos) - tok.literal = "=" - of '-': - inc(c.bufPos) - if c.buf[c.bufPos] == '-': inc(c.bufPos) - tok.kind = tkDashDash - tok.literal = "--" - of ':': - tok.kind = tkColon - inc(c.bufpos) - tok.literal = ":" - of 'r', 'R': - if c.buf[c.bufPos + 1] == '\"': - Inc(c.bufPos) - getString(c, tok, true) - else: - getSymbol(c, tok) - of '[': - tok.kind = tkBracketLe - inc(c.bufpos) - tok.literal = "]" - of ']': - tok.kind = tkBracketRi - Inc(c.bufpos) - tok.literal = "]" - of '\"': - getString(c, tok, false) - of lexbase.EndOfFile: - tok.kind = tkEof - tok.literal = "[EOF]" - else: getSymbol(c, tok) - -proc errorStr(c: TCfgParser, msg: string): string = - result = `%`("$1($2, $3) Error: $4", - [c.filename, $getLine(c), $getColumn(c), msg]) - -proc getKeyValPair(c: var TCfgParser, kind: TCfgEventKind): TCfgEvent = - if c.tok.kind == tkSymbol: - result.kind = kind - result.key = c.tok.literal - result.value = "" - rawGetTok(c, c.tok) - if c.tok.kind in {tkEquals, tkColon}: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.value = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - -proc next(c: var TCfgParser): TCfgEvent = - case c.tok.kind - of tkEof: - result.kind = cfgEof - of tkDashDash: - rawGetTok(c, c.tok) - result = getKeyValPair(c, cfgOption) - of tkSymbol: - result = getKeyValPair(c, cfgKeyValuePair) - of tkBracketLe: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.kind = cfgSectionStart - result.section = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - if c.tok.kind == tkBracketRi: - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "\']\' expected, but found: " & c.tok.literal) - of tkInvalid, tkEquals, tkColon, tkBracketRi: - result.kind = cfgError - result.msg = errorStr(c, "invalid token: " & c.tok.literal) - rawGetTok(c, c.tok) diff --git a/nimlib/pure/parsecsv.nim b/nimlib/pure/parsecsv.nim deleted file mode 100755 index 5970f2090d..0000000000 --- a/nimlib/pure/parsecsv.nim +++ /dev/null @@ -1,178 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a simple high performance `CSV`:idx: -## (`comma separated value`:idx:) parser. -## -## Example: How to use the parser -## ============================== -## -## .. code-block:: nimrod -## import os, parsecsv, streams -## var s = newFileStream(ParamStr(1), fmRead) -## if s == nil: quit("cannot open the file" & ParamStr(1)) -## var x: TCsvParser -## open(x, s, ParamStr(1)) -## while readRow(x): -## Echo "new row: " -## for val in items(x.row): -## Echo "##", val, "##" -## close(x) -## - -import - lexbase, streams - -type - TCsvRow* = seq[string] ## a row in a CSV file - TCsvParser* = object of TBaseLexer ## the parser object. - row*: TCsvRow ## the current row - filename: string - sep, quote, esc: char - skipWhite: bool - currRow: int - - EInvalidCsv* = object of EIO ## exception that is raised if - ## a parsing error occurs - -proc raiseEInvalidCsv(filename: string, line, col: int, - msg: string) {.noreturn.} = - var e: ref EInvalidCsv - new(e) - e.msg = filename & "(" & $line & ", " & $col & ") Error: " & msg - raise e - -proc error(my: TCsvParser, pos: int, msg: string) = - raiseEInvalidCsv(my.filename, my.LineNumber, getColNumber(my, pos), msg) - -proc open*(my: var TCsvParser, input: PStream, filename: string, - separator = ',', quote = '"', escape = '\0', - skipInitialSpace = false) = - ## initializes the parser with an input stream. `Filename` is only used - ## for nice error messages. The parser's behaviour can be controlled by - ## the diverse optional parameters: - ## - `separator`: character used to separate fields - ## - `quote`: Used to quote fields containing special characters like - ## `separator`, `quote` or new-line characters. '\0' disables the parsing - ## of quotes. - ## - `escape`: removes any special meaning from the following character; - ## '\0' disables escaping; if escaping is disabled and `quote` is not '\0', - ## two `quote` characters are parsed one literal `quote` character. - ## - `skipInitialSpace`: If true, whitespace immediately following the - ## `separator` is ignored. - lexbase.open(my, input) - my.filename = filename - my.sep = separator - my.quote = quote - my.esc = escape - my.skipWhite = skipInitialSpace - my.row = @[] - my.currRow = 0 - -proc parseField(my: var TCsvParser, a: var string) = - var pos = my.bufpos - var buf = my.buf - if my.skipWhite: - while buf[pos] in {' ', '\t'}: inc(pos) - setLen(a, 0) # reuse memory - if buf[pos] == my.quote and my.quote != '\0': - inc(pos) - while true: - var c = buf[pos] - if c == '\0': - my.bufpos = pos # can continue after exception? - error(my, pos, my.quote & " expected") - break - elif c == my.quote: - if my.esc == '\0' and buf[pos+1] == my.quote: - add(a, my.quote) - inc(pos, 2) - else: - inc(pos) - break - elif c == my.esc: - add(a, buf[pos+1]) - inc(pos, 2) - else: - case c - of '\c': - pos = handleCR(my, pos) - buf = my.buf - add(a, "\n") - of '\l': - pos = handleLF(my, pos) - buf = my.buf - add(a, "\n") - else: - add(a, c) - inc(pos) - else: - while true: - var c = buf[pos] - if c == my.sep: break - if c in {'\c', '\l', '\0'}: break - add(a, c) - inc(pos) - my.bufpos = pos - -proc processedRows*(my: var TCsvParser): int = - ## returns number of the processed rows - return my.currRow - -proc readRow*(my: var TCsvParser, columns = 0): bool = - ## reads the next row; if `columns` > 0, it expects the row to have - ## exactly this many columns. Returns false if the end of the file - ## has been encountered else true. - var col = 0 # current column - var oldpos = my.bufpos - while my.buf[my.bufpos] != '\0': - var oldlen = my.row.len - if oldlen < col+1: - setLen(my.row, col+1) - my.row[col] = "" - parseField(my, my.row[col]) - inc(col) - if my.buf[my.bufpos] == my.sep: - inc(my.bufpos) - else: - case my.buf[my.bufpos] - of '\c', '\l': - # skip empty lines: - while true: - case my.buf[my.bufpos] - of '\c': my.bufpos = handleCR(my, my.bufpos) - of '\l': my.bufpos = handleLF(my, my.bufpos) - else: break - of '\0': nil - else: error(my, my.bufpos, my.sep & " expected") - break - - setlen(my.row, col) - result = col > 0 - if result and col != columns and columns > 0: - error(my, oldpos+1, $columns & " columns expected, but found " & - $col & " columns") - inc(my.currRow) - -proc close*(my: var TCsvParser) {.inline.} = - ## closes the parser `my` and its associated input stream. - lexbase.close(my) - -when isMainModule: - import os - var s = newFileStream(ParamStr(1), fmRead) - if s == nil: quit("cannot open the file" & ParamStr(1)) - var x: TCsvParser - open(x, s, ParamStr(1)) - while readRow(x): - Echo "new row: " - for val in items(x.row): - Echo "##", val, "##" - close(x) - diff --git a/nimlib/pure/parseopt.nim b/nimlib/pure/parseopt.nim deleted file mode 100755 index 8f4be98f47..0000000000 --- a/nimlib/pure/parseopt.nim +++ /dev/null @@ -1,152 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module provides the standard Nimrod command line parser. -## It supports one convenience iterator over all command line options and some -## lower-level features. - -{.push debugger: off.} - -import - os, strutils - -type - TCmdLineKind* = enum ## the detected command line token - cmdEnd, ## end of command line reached - cmdArgument, ## argument detected - cmdLongoption, ## a long option ``--option`` detected - cmdShortOption ## a short option ``-c`` detected - TOptParser* = - object of TObject ## this object implements the command line parser - cmd: string - pos: int - inShortState: bool - kind*: TCmdLineKind ## the dected command line token - key*, val*: string ## key and value pair; ``key`` is the option - ## or the argument, ``value`` is not "" if - ## the option was given a value - -proc initOptParser*(cmdline = ""): TOptParser = - ## inits the option parser. If ``cmdline == ""``, the real command line - ## (as provided by the ``OS`` module) is taken. - result.pos = 0 - result.inShortState = false - if cmdline != "": - result.cmd = cmdline - else: - result.cmd = "" - for i in countup(1, ParamCount()): - result.cmd = result.cmd & quoteIfContainsWhite(paramStr(i)) & ' ' - result.kind = cmdEnd - result.key = "" - result.val = "" - -proc init*(cmdline: string = ""): TOptParser {.deprecated.} = - ## **Deprecated since version 0.8.2**: Use `initOptParser` instead. - result = initOptParser(cmdline) - -proc parseWord(s: string, i: int, w: var string, - delim: TCharSet = {'\x09', ' ', '\0'}): int = - result = i - if s[result] == '\"': - inc(result) - while not (s[result] in {'\0', '\"'}): - add(w, s[result]) - inc(result) - if s[result] == '\"': inc(result) - else: - while not (s[result] in delim): - add(w, s[result]) - inc(result) - -proc handleShortOption(p: var TOptParser) = - var i = p.pos - p.kind = cmdShortOption - add(p.key, p.cmd[i]) - inc(i) - p.inShortState = true - while p.cmd[i] in {'\x09', ' '}: - inc(i) - p.inShortState = false - if p.cmd[i] in {':', '='}: - inc(i) - p.inShortState = false - while p.cmd[i] in {'\x09', ' '}: inc(i) - i = parseWord(p.cmd, i, p.val) - if p.cmd[i] == '\0': p.inShortState = false - p.pos = i - -proc next*(p: var TOptParser) = - ## parses the first or next option; ``p.kind`` describes what token has been - ## parsed. ``p.key`` and ``p.val`` are set accordingly. - var i = p.pos - while p.cmd[i] in {'\x09', ' '}: inc(i) - p.pos = i - setlen(p.key, 0) - setlen(p.val, 0) - if p.inShortState: - handleShortOption(p) - return - case p.cmd[i] - of '\0': - p.kind = cmdEnd - of '-': - inc(i) - if p.cmd[i] == '-': - p.kind = cmdLongOption - inc(i) - i = parseWord(p.cmd, i, p.key, {'\0', ' ', '\x09', ':', '='}) - while p.cmd[i] in {'\x09', ' '}: inc(i) - if p.cmd[i] in {':', '='}: - inc(i) - while p.cmd[i] in {'\x09', ' '}: inc(i) - p.pos = parseWord(p.cmd, i, p.val) - else: - p.pos = i - else: - p.pos = i - handleShortOption(p) - else: - p.kind = cmdArgument - p.pos = parseWord(p.cmd, i, p.key) - -proc cmdLineRest*(p: TOptParser): string = - ## retrieves the rest of the command line that has not been parsed yet. - result = strip(copy(p.cmd, p.pos, len(p.cmd) - 1)) - -proc getRestOfCommandLine*(p: TOptParser): string {.deprecated.} = - ## **Deprecated since version 0.8.2**: Use `cmdLineRest` instead. - result = cmdLineRest(p) - -iterator getopt*(): tuple[kind: TCmdLineKind, key, val: string] = - ## This is an convenience iterator for iterating over the command line. - ## This uses the TOptParser object. Example: - ## - ## .. code-block:: nimrod - ## var - ## filename = "" - ## for kind, key, val in getopt(): - ## case kind - ## of cmdArgument: - ## filename = key - ## of cmdLongOption, cmdShortOption: - ## case key - ## of "help", "h": writeHelp() - ## of "version", "v": writeVersion() - ## of cmdEnd: assert(false) # cannot happen - ## if filename == "": - ## # no filename has been given, so we show the help: - ## writeHelp() - var p = initOptParser() - while true: - next(p) - if p.kind == cmdEnd: break - yield (p.kind, p.key, p.val) - -{.pop.} diff --git a/nimlib/pure/parsesql.nim b/nimlib/pure/parsesql.nim deleted file mode 100755 index 2109c273ad..0000000000 --- a/nimlib/pure/parsesql.nim +++ /dev/null @@ -1,1345 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## The ``parsesql`` module implements a high performance SQL file -## parser. It parses PostgreSQL syntax and the SQL ANSI standard. - -import - hashes, strutils, lexbase, streams - -# ------------------- scanner ------------------------------------------------- - -type - TTokKind = enum ## enumeration of all SQL tokens - tkInvalid, ## invalid token - tkEof, ## end of file reached - tkIdentifier, ## abc - tkQuotedIdentifier, ## "abc" - tkStringConstant, ## 'abc' - tkEscapeConstant, ## e'abc' - tkDollarQuotedConstant, ## $tag$abc$tag$ - tkBitStringConstant, ## B'00011' - tkHexStringConstant, ## x'00011' - tkInteger, - tkNumeric, - tkOperator, ## + - * / < > = ~ ! @ # % ^ & | ` ? - tkSemicolon, ## ';' - tkColon, ## ':' - tkComma, ## ',' - tkParLe, ## '(' - tkParRi, ## ')' - tkBracketLe, ## '[' - tkBracketRi, ## ']' - tkDot ## '.' - - TToken {.final.} = object # a token - kind: TTokKind # the type of the token - literal: string # the parsed (string) literal - - TSqlLexer* = object of TBaseLexer ## the parser object. - filename: string - -const - tokKindToStr: array[TTokKind, string] = [ - "invalid", "[EOF]", "identifier", "quoted identifier", "string constant", - "escape string constant", "dollar quoted constant", "bit string constant", - "hex string constant", "integer constant", "numeric constant", "operator", - ";", ":", ",", "(", ")", "[", "]", "." - ] - -proc open(L: var TSqlLexer, input: PStream, filename: string) = - lexbase.open(L, input) - L.filename = filename - -proc close(L: var TSqlLexer) = - lexbase.close(L) - -proc getColumn(L: TSqlLexer): int = - ## get the current column the parser has arrived at. - result = getColNumber(L, L.bufPos) - -proc getLine(L: TSqlLexer): int = - result = L.linenumber - -proc handleHexChar(c: var TSqlLexer, xi: var int) = - case c.buf[c.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10) - inc(c.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10) - inc(c.bufpos) - else: - nil - -proc handleOctChar(c: var TSqlLexer, xi: var int) = - if c.buf[c.bufpos] in {'0'..'7'}: - xi = (xi shl 3) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - -proc getEscapedChar(c: var TSqlLexer, tok: var TToken) = - inc(c.bufpos) - case c.buf[c.bufpos] - of 'n', 'N': - add(tok.literal, '\L') - Inc(c.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, '\c') - Inc(c.bufpos) - of 'l', 'L': - add(tok.literal, '\L') - Inc(c.bufpos) - of 'f', 'F': - add(tok.literal, '\f') - inc(c.bufpos) - of 'e', 'E': - add(tok.literal, '\e') - Inc(c.bufpos) - of 'a', 'A': - add(tok.literal, '\a') - Inc(c.bufpos) - of 'b', 'B': - add(tok.literal, '\b') - Inc(c.bufpos) - of 'v', 'V': - add(tok.literal, '\v') - Inc(c.bufpos) - of 't', 'T': - add(tok.literal, '\t') - Inc(c.bufpos) - of '\'', '\"': - add(tok.literal, c.buf[c.bufpos]) - Inc(c.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(c.bufpos) - of 'x', 'X': - inc(c.bufpos) - var xi = 0 - handleHexChar(c, xi) - handleHexChar(c, xi) - add(tok.literal, Chr(xi)) - of '0'..'7': - var xi = 0 - handleOctChar(c, xi) - handleOctChar(c, xi) - handleOctChar(c, xi) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: tok.kind = tkInvalid - else: tok.kind = tkInvalid - -proc HandleCRLF(c: var TSqlLexer, pos: int): int = - case c.buf[pos] - of '\c': result = lexbase.HandleCR(c, pos) - of '\L': result = lexbase.HandleLF(c, pos) - else: result = pos - -proc skip(c: var TSqlLexer) = - var pos = c.bufpos - var buf = c.buf - var nested = 0 - while true: - case buf[pos] - of ' ', '\t': - Inc(pos) - of '-': - if buf[pos+1] == '-': - while not (buf[pos] in {'\c', '\L', lexbase.EndOfFile}): inc(pos) - else: - break - of '/': - if buf[pos+1] == '*': - inc(pos,2) - while true: - case buf[pos] - of '\0': break - of '\c', '\L': - pos = HandleCRLF(c, pos) - buf = c.buf - of '*': - if buf[pos+1] == '/': - inc(pos, 2) - if nested <= 0: break - dec(nested) - else: - inc(pos) - of '/': - if buf[pos+1] == '*': - inc(pos, 2) - inc(nested) - else: - inc(pos) - else: inc(pos) - else: break - of '\c', '\L': - pos = HandleCRLF(c, pos) - buf = c.buf - else: - break # EndOfFile also leaves the loop - c.bufpos = pos - -proc getString(c: var TSqlLexer, tok: var TToken, kind: TTokKind) = - var pos = c.bufPos + 1 - var buf = c.buf - tok.kind = kind - block parseLoop: - while true: - while true: - var ch = buf[pos] - if ch == '\'': - if buf[pos+1] == '\'': - inc(pos, 2) - add(tok.literal, '\'') - else: - inc(pos) - break - elif ch in {'\c', '\L', lexbase.EndOfFile}: - tok.kind = tkInvalid - break parseLoop - elif (ch == '\\') and kind == tkEscapeConstant: - c.bufPos = pos - getEscapedChar(c, tok) - pos = c.bufPos - else: - add(tok.literal, ch) - Inc(pos) - c.bufpos = pos - var line = c.linenumber - skip(c) - if c.linenumber > line: - # a new line whitespace has been parsed, so we check if the string - # continues after the whitespace: - buf = c.buf # may have been reallocated - pos = c.bufpos - if buf[pos] == '\'': inc(pos) - else: break parseLoop - else: break parseLoop - c.bufpos = pos - -proc getDollarString(c: var TSqlLexer, tok: var TToken) = - var pos = c.bufPos + 1 - var buf = c.buf - tok.kind = tkDollarQuotedConstant - var tag = "$" - while buf[pos] in IdentChars: - add(tag, buf[pos]) - inc(pos) - if buf[pos] == '$': inc(pos) - else: - tok.kind = tkInvalid - return - while true: - case buf[pos] - of '\c', '\L': - pos = HandleCRLF(c, pos) - buf = c.buf - add(tok.literal, "\L") - of '\0': - tok.kind = tkInvalid - break - of '$': - inc(pos) - var tag2 = "$" - while buf[pos] in IdentChars: - add(tag2, buf[pos]) - inc(pos) - if buf[pos] == '$': inc(pos) - if tag2 == tag: break - add(tok.literal, tag2) - add(tok.literal, '$') - else: - add(tok.literal, buf[pos]) - inc(pos) - c.bufpos = pos - -proc getSymbol(c: var TSqlLexer, tok: var TToken) = - var pos = c.bufpos - var buf = c.buf - while true: - add(tok.literal, buf[pos]) - Inc(pos) - if not (buf[pos] in {'a'..'z','A'..'Z','0'..'9','_','$', '\128'..'\255'}): - break - c.bufpos = pos - tok.kind = tkIdentifier - -proc getQuotedIdentifier(c: var TSqlLexer, tok: var TToken) = - var pos = c.bufPos + 1 - var buf = c.buf - tok.kind = tkQuotedIdentifier - while true: - var ch = buf[pos] - if ch == '\"': - if buf[pos+1] == '\"': - inc(pos, 2) - add(tok.literal, '\"') - else: - inc(pos) - break - elif ch in {'\c', '\L', lexbase.EndOfFile}: - tok.kind = tkInvalid - break - else: - add(tok.literal, ch) - Inc(pos) - c.bufpos = pos - -proc getBitHexString(c: var TSqlLexer, tok: var TToken, validChars: TCharSet) = - var pos = c.bufPos + 1 - var buf = c.buf - block parseLoop: - while true: - while true: - var ch = buf[pos] - if ch in validChars: - add(tok.literal, ch) - Inc(pos) - elif ch == '\'': - inc(pos) - break - else: - tok.kind = tkInvalid - break parseLoop - c.bufpos = pos - var line = c.linenumber - skip(c) - if c.linenumber > line: - # a new line whitespace has been parsed, so we check if the string - # continues after the whitespace: - buf = c.buf # may have been reallocated - pos = c.bufpos - if buf[pos] == '\'': inc(pos) - else: break parseLoop - else: break parseLoop - c.bufpos = pos - -proc getNumeric(c: var TSqlLexer, tok: var TToken) = - tok.kind = tkInteger - var pos = c.bufPos - var buf = c.buf - while buf[pos] in Digits: - add(tok.literal, buf[pos]) - inc(pos) - if buf[pos] == '.': - tok.kind = tkNumeric - add(tok.literal, buf[pos]) - inc(pos) - while buf[pos] in Digits: - add(tok.literal, buf[pos]) - inc(pos) - if buf[pos] in {'E', 'e'}: - tok.kind = tkNumeric - add(tok.literal, buf[pos]) - inc(pos) - if buf[pos] == '+': - inc(pos) - elif buf[pos] == '-': - add(tok.literal, buf[pos]) - inc(pos) - if buf[pos] in Digits: - while buf[pos] in Digits: - add(tok.literal, buf[pos]) - inc(pos) - else: - tok.kind = tkInvalid - c.bufpos = pos - -proc getOperator(c: var TSqlLexer, tok: var TToken) = - const operators = {'+', '-', '*', '/', '<', '>', '=', '~', '!', '@', '#', '%', - '^', '&', '|', '`', '?'} - tok.kind = tkOperator - var pos = c.bufPos - var buf = c.buf - var trailingPlusMinus = false - while true: - case buf[pos] - of '-': - if buf[pos] == '-': break - if not trailingPlusMinus and buf[pos+1] notin operators and - tok.literal.len > 0: break - of '/': - if buf[pos] == '*': break - of '~', '!', '@', '#', '%', '^', '&', '|', '`', '?': - trailingPlusMinus = true - of '+': - if not trailingPlusMinus and buf[pos+1] notin operators and - tok.literal.len > 0: break - of '*', '<', '>', '=': nil - else: break - add(tok.literal, buf[pos]) - inc(pos) - c.bufpos = pos - -proc getTok(c: var TSqlLexer, tok: var TToken) = - tok.kind = tkInvalid - setlen(tok.literal, 0) - skip(c) - case c.buf[c.bufpos] - of ';': - tok.kind = tkSemiColon - inc(c.bufPos) - add(tok.literal, ';') - of ',': - tok.kind = tkComma - inc(c.bufpos) - add(tok.literal, ',') - of ':': - tok.kind = tkColon - inc(c.bufpos) - add(tok.literal, ':') - of 'e', 'E': - if c.buf[c.bufPos + 1] == '\'': - Inc(c.bufPos) - getString(c, tok, tkEscapeConstant) - else: - getSymbol(c, tok) - of 'b', 'B': - if c.buf[c.bufPos + 1] == '\'': - tok.kind = tkBitStringConstant - getBitHexString(c, tok, {'0'..'1'}) - else: - getSymbol(c, tok) - of 'x', 'X': - if c.buf[c.bufPos + 1] == '\'': - tok.kind = tkHexStringConstant - getBitHexString(c, tok, {'a'..'f','A'..'F','0'..'9'}) - else: - getSymbol(c, tok) - of '$': getDollarString(c, tok) - of '[': - tok.kind = tkBracketLe - inc(c.bufpos) - add(tok.literal, '[') - of ']': - tok.kind = tkBracketRi - Inc(c.bufpos) - add(tok.literal, ']') - of '(': - tok.kind = tkParLe - Inc(c.bufpos) - add(tok.literal, '(') - of ')': - tok.kind = tkParRi - Inc(c.bufpos) - add(tok.literal, ')') - of '.': - if c.buf[c.bufPos + 1] in Digits: - getNumeric(c, tok) - else: - tok.kind = tkDot - inc(c.bufpos) - add(tok.literal, '.') - of '0'..'9': getNumeric(c, tok) - of '\'': getString(c, tok, tkStringConstant) - of '"': getQuotedIdentifier(c, tok) - of lexbase.EndOfFile: - tok.kind = tkEof - tok.literal = "[EOF]" - of 'a', 'c', 'd', 'f'..'w', 'y', 'z', 'A', 'C', 'D', 'F'..'W', 'Y', 'Z', '_', - '\128'..'\255': - getSymbol(c, tok) - of '+', '-', '*', '/', '<', '>', '=', '~', '!', '@', '#', '%', - '^', '&', '|', '`', '?': - getOperator(c, tok) - else: - add(tok.literal, c.buf[c.bufpos]) - inc(c.bufpos) - -proc errorStr(L: TSqlLexer, msg: string): string = - result = "$1($2, $3) Error: $4" % [L.filename, $getLine(L), $getColumn(L), msg] - - -# ----------------------------- parser ---------------------------------------- - -# Operator/Element Associativity Description -# . left table/column name separator -# :: left PostgreSQL-style typecast -# [ ] left array element selection -# - right unary minus -# ^ left exponentiation -# * / % left multiplication, division, modulo -# + - left addition, subtraction -# IS IS TRUE, IS FALSE, IS UNKNOWN, IS NULL -# ISNULL test for null -# NOTNULL test for not null -# (any other) left all other native and user-defined oprs -# IN set membership -# BETWEEN range containment -# OVERLAPS time interval overlap -# LIKE ILIKE SIMILAR string pattern matching -# < > less than, greater than -# = right equality, assignment -# NOT right logical negation -# AND left logical conjunction -# OR left logical disjunction - -type - TSqlNodeKind* = enum ## kind of SQL abstract syntax tree - nkNone, - nkIdent, - nkStringLit, - nkBitStringLit, - nkHexStringLit, - nkIntegerLit, - nkNumericLit, - nkPrimaryKey, - nkForeignKey, - nkNotNull, - - nkStmtList, - nkDot, - nkDotDot, - nkPrefix, - nkInfix, - nkCall, - nkColumnReference, - nkReferences, - nkDefault, - nkCheck, - nkConstraint, - nkUnique, - nkIdentity, - nkColumnDef, ## name, datatype, constraints - nkInsert, - nkUpdate, - nkDelete, - nkSelect, - nkSelectDistinct, - nkSelectColumns, - nkAsgn, - nkFrom, - nkGroup, - nkHaving, - nkOrder, - nkDesc, - nkUnion, - nkIntersect, - nkExcept, - nkColumnList, - nkValueList, - nkWhere, - nkCreateTable, - nkCreateTableIfNotExists, - nkCreateType, - nkCreateTypeIfNotExists, - nkCreateIndex, - nkCreateIndexIfNotExists, - nkEnumDef - -type - EInvalidSql* = object of EBase ## Invalid SQL encountered - PSqlNode* = ref TSqlNode ## an SQL abstract syntax tree node - TSqlNode* = object ## an SQL abstract syntax tree node - case kind*: TSqlNodeKind ## kind of syntax tree - of nkIdent, nkStringLit, nkBitStringLit, nkHexStringLit, - nkIntegerLit, nkNumericLit: - strVal*: string ## AST leaf: the identifier, numeric literal - ## string literal, etc. - else: - sons*: seq[PSqlNode] ## the node's children - - TSqlParser* = object of TSqlLexer ## SQL parser object - tok: TToken - -proc newNode(k: TSqlNodeKind): PSqlNode = - new(result) - result.kind = k - -proc newNode(k: TSqlNodeKind, s: string): PSqlNode = - new(result) - result.kind = k - result.strVal = s - -proc len*(n: PSqlNode): int = - if isNil(n.sons): result = 0 - else: result = n.sons.len - -proc add*(father, n: PSqlNode) = - if isNil(father.sons): father.sons = @[] - add(father.sons, n) - -proc getTok(p: var TSqlParser) = - getTok(p, p.tok) - -proc sqlError(p: TSqlParser, msg: string) = - var e: ref EInvalidSql - new(e) - e.msg = errorStr(p, msg) - raise e - -proc isKeyw(p: TSqlParser, keyw: string): bool = - result = p.tok.kind == tkIdentifier and - cmpIgnoreCase(p.tok.literal, keyw) == 0 - -proc isOpr(p: TSqlParser, opr: string): bool = - result = p.tok.kind == tkOperator and - cmpIgnoreCase(p.tok.literal, opr) == 0 - -proc optKeyw(p: var TSqlParser, keyw: string) = - if p.tok.kind == tkIdentifier and cmpIgnoreCase(p.tok.literal, keyw) == 0: - getTok(p) - -proc expectIdent(p: TSqlParser) = - if p.tok.kind != tkIdentifier and p.tok.kind != tkQuotedIdentifier: - sqlError(p, "identifier expected") - -proc expect(p: TSqlParser, kind: TTokKind) = - if p.tok.kind != kind: - sqlError(p, tokKindToStr[kind] & " expected") - -proc eat(p: var TSqlParser, kind: TTokKind) = - if p.tok.kind == kind: - getTok(p) - else: - sqlError(p, tokKindToStr[kind] & " expected") - -proc eat(p: var TSqlParser, keyw: string) = - if isKeyw(p, keyw): - getTok(p) - else: - sqlError(p, keyw.toUpper() & " expected") - -proc parseDataType(p: var TSqlParser): PSqlNode = - if isKeyw(p, "enum"): - result = newNode(nkEnumDef) - getTok(p) - if p.tok.kind == tkParLe: - getTok(p) - result.add(newNode(nkStringLit, p.tok.literal)) - getTok(p) - while p.tok.kind == tkComma: - getTok(p) - result.add(newNode(nkStringLit, p.tok.literal)) - getTok(p) - eat(p, tkParRi) - else: - expectIdent(p) - result = newNode(nkIdent, p.tok.literal) - getTok(p) - # ignore (12, 13) part: - if p.tok.kind == tkParLe: - getTok(p) - expect(p, tkInteger) - getTok(p) - while p.tok.kind == tkComma: - getTok(p) - expect(p, tkInteger) - getTok(p) - eat(p, tkParRi) - -proc getPrecedence(p: TSqlParser): int = - if isOpr(p, "*") or isOpr(p, "/") or isOpr(p, "%"): - result = 6 - elif isOpr(p, "+") or isOpr(p, "-"): - result = 5 - elif isOpr(p, "=") or isOpr(p, "<") or isOpr(p, ">") or isOpr(p, ">=") or - isOpr(p, "<=") or isOpr(p, "<>") or isOpr(p, "!=") or isKeyw(p, "is") or - isKeyw(p, "like"): - result = 3 - elif isKeyw(p, "and"): - result = 2 - elif isKeyw(p, "or"): - result = 1 - elif p.tok.kind == tkOperator: - # user-defined operator: - result = 0 - else: - result = - 1 - -proc parseExpr(p: var TSqlParser): PSqlNode - -proc identOrLiteral(p: var TSqlParser): PSqlNode = - case p.tok.kind - of tkIdentifier, tkQuotedIdentifier: - result = newNode(nkIdent, p.tok.literal) - getTok(p) - of tkStringConstant, tkEscapeConstant, tkDollarQuotedConstant: - result = newNode(nkStringLit, p.tok.literal) - getTok(p) - of tkBitStringConstant: - result = newNode(nkBitStringLit, p.tok.literal) - getTok(p) - of tkHexStringConstant: - result = newNode(nkHexStringLit, p.tok.literal) - getTok(p) - of tkInteger: - result = newNode(nkIntegerLit, p.tok.literal) - getTok(p) - of tkNumeric: - result = newNode(nkNumericLit, p.tok.literal) - getTok(p) - of tkParLe: - getTok(p) - result = parseExpr(p) - eat(p, tkParRi) - else: - sqlError(p, "expression expected") - getTok(p) # we must consume a token here to prevend endless loops! - -proc primary(p: var TSqlParser): PSqlNode = - if p.tok.kind == tkOperator or isKeyw(p, "not"): - result = newNode(nkPrefix) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - result.add(primary(p)) - return - result = identOrLiteral(p) - while true: - case p.tok.kind - of tkParLe: - var a = result - result = newNode(nkCall) - result.add(a) - getTok(p) - while true: - result.add(parseExpr(p)) - if p.tok.kind == tkComma: getTok(p) - else: break - eat(p, tkParRi) - of tkDot: - getTok(p) - var a = result - if p.tok.kind == tkDot: - getTok(p) - result = newNode(nkDotDot) - else: - result = newNode(nkDot) - result.add(a) - if isOpr(p, "*"): - result.add(newNode(nkIdent, "*")) - elif p.tok.kind in {tkIdentifier, tkQuotedIdentifier}: - result.add(newNode(nkIdent, p.tok.literal)) - else: - sqlError(p, "identifier expected") - getTok(p) - else: break - -proc lowestExprAux(p: var TSqlParser, v: var PSqlNode, limit: int): int = - var - v2, node, opNode: PSqlNode - v = primary(p) # expand while operators have priorities higher than 'limit' - var opPred = getPrecedence(p) - result = opPred - while opPred > limit: - node = newNode(nkInfix) - opNode = newNode(nkIdent, p.tok.literal) - getTok(p) - result = lowestExprAux(p, v2, opPred) - node.add(opNode) - node.add(v) - node.add(v2) - v = node - opPred = getPrecedence(p) - -proc parseExpr(p: var TSqlParser): PSqlNode = - discard lowestExprAux(p, result, - 1) - -proc parseTableName(p: var TSqlParser): PSqlNode = - expectIdent(p) - result = primary(p) - -proc parseColumnReference(p: var TSqlParser): PSqlNode = - result = parseTableName(p) - if p.tok.kind == tkParLe: - getTok(p) - var a = result - result = newNode(nkColumnReference) - result.add(a) - result.add(parseTableName(p)) - while p.tok.kind == tkComma: - getTok(p) - result.add(parseTableName(p)) - eat(p, tkParRi) - -proc parseCheck(p: var TSqlParser): PSqlNode = - getTok(p) - result = newNode(nkCheck) - result.add(parseExpr(p)) - -proc parseConstraint(p: var TSqlParser): PSqlNode = - getTok(p) - result = newNode(nkConstraint) - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - eat(p, "check") - result.add(parseExpr(p)) - -proc parseColumnConstraints(p: var TSqlParser, result: PSqlNode) = - while true: - if isKeyw(p, "default"): - getTok(p) - var n = newNode(nkDefault) - n.add(parseExpr(p)) - result.add(n) - elif isKeyw(p, "references"): - getTok(p) - var n = newNode(nkReferences) - n.add(parseColumnReference(p)) - result.add(n) - elif isKeyw(p, "not"): - getTok(p) - eat(p, "null") - result.add(newNode(nkNotNull)) - elif isKeyw(p, "identity"): - getTok(p) - result.add(newNode(nkIdentity)) - elif isKeyw(p, "primary"): - getTok(p) - eat(p, "key") - result.add(newNode(nkPrimaryKey)) - elif isKeyw(p, "check"): - result.add(parseCheck(p)) - elif isKeyw(p, "constraint"): - result.add(parseConstraint(p)) - elif isKeyw(p, "unique"): - result.add(newNode(nkUnique)) - else: - break - -proc parseColumnDef(p: var TSqlParser): PSqlNode = - expectIdent(p) - result = newNode(nkColumnDef) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - result.add(parseDataType(p)) - parseColumnConstraints(p, result) - -proc parseIfNotExists(p: var TSqlParser, k: TSqlNodeKind): PSqlNode = - getTok(p) - if isKeyw(p, "if"): - getTok(p) - eat(p, "not") - eat(p, "exists") - result = newNode(succ(k)) - else: - result = newNode(k) - -proc parseParIdentList(p: var TSqlParser, father: PSqlNode) = - eat(p, tkParLe) - while true: - expectIdent(p) - father.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - if p.tok.kind != tkComma: break - getTok(p) - eat(p, tkParRi) - -proc parseTableConstraint(p: var TSqlParser): PSqlNode = - if isKeyw(p, "primary"): - getTok(p) - eat(p, "key") - result = newNode(nkPrimaryKey) - parseParIdentList(p, result) - elif isKeyw(p, "foreign"): - getTok(p) - eat(p, "key") - result = newNode(nkForeignKey) - parseParIdentList(p, result) - eat(p, "references") - var m = newNode(nkReferences) - m.add(parseColumnReference(p)) - result.add(m) - elif isKeyw(p, "unique"): - getTok(p) - eat(p, "key") - result = newNode(nkUnique) - parseParIdentList(p, result) - elif isKeyw(p, "check"): - result = parseCheck(p) - elif isKeyw(p, "constraint"): - result = parseConstraint(p) - else: - sqlError(p, "column definition expected") - -proc parseTableDef(p: var TSqlParser): PSqlNode = - result = parseIfNotExists(p, nkCreateTable) - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - if p.tok.kind == tkParLe: - while true: - getTok(p) - if p.tok.kind == tkIdentifier or p.tok.kind == tkQuotedIdentifier: - result.add(parseColumnDef(p)) - else: - result.add(parseTableConstraint(p)) - if p.tok.kind != tkComma: break - eat(p, tkParRi) - -proc parseTypeDef(p: var TSqlParser): PSqlNode = - result = parseIfNotExists(p, nkCreateType) - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - eat(p, "as") - result.add(parseDataType(p)) - -proc parseWhere(p: var TSqlParser): PSqlNode = - getTok(p) - result = newNode(nkWhere) - result.add(parseExpr(p)) - -proc parseIndexDef(p: var TSqlParser): PSqlNode = - result = parseIfNotExists(p, nkCreateIndex) - if isKeyw(p, "primary"): - getTok(p) - eat(p, "key") - result.add(newNode(nkPrimaryKey)) - else: - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - eat(p, "on") - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - eat(p, tkParLe) - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - while p.tok.kind == tkComma: - getTok(p) - expectIdent(p) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - eat(p, tkParRi) - -proc parseInsert(p: var TSqlParser): PSqlNode = - getTok(p) - eat(p, "into") - expectIdent(p) - result = newNode(nkInsert) - result.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - if p.tok.kind == tkParLe: - var n = newNode(nkColumnList) - parseParIdentList(p, n) - else: - result.add(nil) - if isKeyw(p, "default"): - getTok(p) - eat(p, "values") - result.add(newNode(nkDefault)) - else: - eat(p, "values") - eat(p, tkParLe) - var n = newNode(nkValueList) - while true: - n.add(parseExpr(p)) - if p.tok.kind != tkComma: break - getTok(p) - result.add(n) - eat(p, tkParRi) - -proc parseUpdate(p: var TSqlParser): PSqlNode = - getTok(p) - result = newNode(nkUpdate) - result.add(primary(p)) - eat(p, "set") - while true: - var a = newNode(nkAsgn) - expectIdent(p) - a.add(newNode(nkIdent, p.tok.literal)) - getTok(p) - if isOpr(p, "="): getTok(p) - else: sqlError(p, "= expected") - a.add(parseExpr(p)) - result.add(a) - if p.tok.kind != tkComma: break - getTok(p) - if isKeyw(p, "where"): - result.add(parseWhere(p)) - else: - result.add(nil) - -proc parseDelete(p: var TSqlParser): PSqlNode = - getTok(p) - result = newNode(nkDelete) - eat(p, "from") - result.add(primary(p)) - if isKeyw(p, "where"): - result.add(parseWhere(p)) - else: - result.add(nil) - -proc parseSelect(p: var TSqlParser): PSqlNode = - getTok(p) - if isKeyw(p, "distinct"): - getTok(p) - result = newNode(nkSelectDistinct) - elif isKeyw(p, "all"): - getTok(p) - result = newNode(nkSelect) - var a = newNode(nkSelectColumns) - while true: - if isOpr(p, "*"): - a.add(newNode(nkIdent, "*")) - getTok(p) - else: - a.add(parseExpr(p)) - if p.tok.kind != tkComma: break - getTok(p) - result.add(a) - if isKeyw(p, "from"): - var f = newNode(nkFrom) - while true: - getTok(p) - f.add(parseExpr(p)) - if p.tok.kind != tkComma: break - result.add(f) - if isKeyw(p, "where"): - result.add(parseWhere(p)) - if isKeyw(p, "group"): - getTok(p) - eat(p, "by") - var g = newNode(nkGroup) - while true: - g.add(parseExpr(p)) - if p.tok.kind != tkComma: break - getTok(p) - result.add(g) - if isKeyw(p, "having"): - var h = newNode(nkHaving) - while true: - getTok(p) - h.add(parseExpr(p)) - if p.tok.kind != tkComma: break - result.add(h) - if isKeyw(p, "union"): - result.add(newNode(nkUnion)) - getTok(p) - elif isKeyw(p, "intersect"): - result.add(newNode(nkIntersect)) - getTok(p) - elif isKeyw(p, "except"): - result.add(newNode(nkExcept)) - getTok(p) - if isKeyw(p, "order"): - getTok(p) - eat(p, "by") - var n = newNode(nkOrder) - while true: - var e = parseExpr(p) - if isKeyw(p, "asc"): getTok(p) # is default - elif isKeyw(p, "desc"): - getTok(p) - var x = newNode(nkDesc) - x.add(e) - e = x - n.add(e) - if p.tok.kind != tkComma: break - getTok(p) - result.add(n) - -proc parseStmt(p: var TSqlParser): PSqlNode = - if isKeyw(p, "create"): - getTok(p) - optKeyw(p, "cached") - optKeyw(p, "memory") - optKeyw(p, "temp") - optKeyw(p, "global") - optKeyw(p, "local") - optKeyw(p, "temporary") - optKeyw(p, "unique") - optKeyw(p, "hash") - if isKeyw(p, "table"): - result = parseTableDef(p) - elif isKeyw(p, "type"): - result = parseTypeDef(p) - elif isKeyw(p, "index"): - result = parseIndexDef(p) - else: - sqlError(p, "TABLE expected") - elif isKeyw(p, "insert"): - result = parseInsert(p) - elif isKeyw(p, "update"): - result = parseUpdate(p) - elif isKeyw(p, "delete"): - result = parseDelete(p) - elif isKeyw(p, "select"): - result = parseSelect(p) - else: - sqlError(p, "CREATE expected") - -proc open(p: var TSqlParser, input: PStream, filename: string) = - ## opens the parser `p` and assigns the input stream `input` to it. - ## `filename` is only used for error messages. - open(TSqlLexer(p), input, filename) - p.tok.kind = tkInvalid - p.tok.literal = "" - getTok(p) - -proc parse(p: var TSqlParser): PSqlNode = - ## parses the content of `p`'s input stream and returns the SQL AST. - ## Syntax errors raise an `EInvalidSql` exception. - result = newNode(nkStmtList) - while p.tok.kind != tkEof: - var s = parseStmt(p) - eat(p, tkSemiColon) - result.add(s) - if result.len == 1: - result = result.sons[0] - -proc close(p: var TSqlParser) = - ## closes the parser `p`. The associated input stream is closed too. - close(TSqlLexer(p)) - -proc parseSQL*(input: PStream, filename: string): PSqlNode = - ## parses the SQL from `input` into an AST and returns the AST. - ## `filename` is only used for error messages. - ## Syntax errors raise an `EInvalidSql` exception. - var p: TSqlParser - open(p, input, filename) - try: - result = parse(p) - finally: - close(p) - -proc ra(n: PSqlNode, s: var string, indent: int) - -proc rs(n: PSqlNode, s: var string, indent: int, - prefix = "(", suffix = ")", - sep = ", ") = - if n.len > 0: - s.add(prefix) - for i in 0 .. n.len-1: - if i > 0: s.add(sep) - ra(n.sons[i], s, indent) - s.add(suffix) - -proc ra(n: PSqlNode, s: var string, indent: int) = - if n == nil: return - case n.kind - of nkNone: nil - of nkIdent: - if allCharsInSet(n.strVal, {'\33'..'\127'}): - s.add(n.strVal) - else: - s.add("\"" & replace(n.strVal, "\"", "\"\"") & "\"") - of nkStringLit: - s.add(escape(n.strVal, "e'", "'")) - of nkBitStringLit: - s.add("b'" & n.strVal & "'") - of nkHexStringLit: - s.add("x'" & n.strVal & "'") - of nkIntegerLit, nkNumericLit: - s.add(n.strVal) - of nkPrimaryKey: - s.add(" primary key") - rs(n, s, indent) - of nkForeignKey: - s.add(" foreign key") - rs(n, s, indent) - of nkNotNull: - s.add(" not null") - of nkDot: - ra(n.sons[0], s, indent) - s.add(".") - ra(n.sons[1], s, indent) - of nkDotDot: - ra(n.sons[0], s, indent) - s.add(". .") - ra(n.sons[1], s, indent) - of nkPrefix: - s.add('(') - ra(n.sons[0], s, indent) - s.add(' ') - ra(n.sons[1], s, indent) - s.add(')') - of nkInfix: - s.add('(') - ra(n.sons[1], s, indent) - s.add(' ') - ra(n.sons[0], s, indent) - s.add(' ') - ra(n.sons[2], s, indent) - s.add(')') - of nkCall, nkColumnReference: - ra(n.sons[0], s, indent) - s.add('(') - for i in 1..n.len-1: - if i > 1: s.add(", ") - ra(n.sons[i], s, indent) - s.add(')') - of nkReferences: - s.add(" references ") - ra(n.sons[0], s, indent) - of nkDefault: - s.add(" default ") - ra(n.sons[0], s, indent) - of nkCheck: - s.add(" check ") - ra(n.sons[0], s, indent) - of nkConstraint: - s.add(" constraint ") - ra(n.sons[0], s, indent) - s.add(" check ") - ra(n.sons[1], s, indent) - of nkUnique: - s.add(" unique") - rs(n, s, indent) - of nkIdentity: - s.add(" identity") - of nkColumnDef: - s.add("\n ") - rs(n, s, indent, "", "", " ") - of nkStmtList: - for i in 0..n.len-1: - ra(n.sons[i], s, indent) - s.add("\n") - of nkInsert: - assert n.len == 3 - s.add("insert into ") - ra(n.sons[0], s, indent) - ra(n.sons[1], s, indent) - if n.sons[2].kind == nkDefault: - s.add("default values") - else: - s.add("\nvalues ") - ra(n.sons[2], s, indent) - s.add(';') - of nkUpdate: - s.add("update ") - ra(n.sons[0], s, indent) - s.add(" set ") - var L = n.len - for i in 1 .. L-2: - if i > 1: s.add(", ") - var it = n.sons[i] - assert it.kind == nkAsgn - ra(it, s, indent) - ra(n.sons[L-1], s, indent) - s.add(';') - of nkDelete: - s.add("delete from ") - ra(n.sons[0], s, indent) - ra(n.sons[1], s, indent) - s.add(';') - of nkSelect, nkSelectDistinct: - s.add("select ") - if n.kind == nkSelectDistinct: - s.add("distinct ") - rs(n.sons[0], s, indent, "", "", ", ") - for i in 1 .. n.len-1: ra(n.sons[i], s, indent) - s.add(';') - of nkSelectColumns: - assert(false) - of nkAsgn: - ra(n.sons[0], s, indent) - s.add(" = ") - ra(n.sons[1], s, indent) - of nkFrom: - s.add("\nfrom ") - rs(n, s, indent, "", "", ", ") - of nkGroup: - s.add("\ngroup by") - rs(n, s, indent, "", "", ", ") - of nkHaving: - s.add("\nhaving") - rs(n, s, indent, "", "", ", ") - of nkOrder: - s.add("\norder by ") - rs(n, s, indent, "", "", ", ") - of nkDesc: - ra(n.sons[0], s, indent) - s.add(" desc") - of nkUnion: - s.add(" union") - of nkIntersect: - s.add(" intersect") - of nkExcept: - s.add(" except") - of nkColumnList: - rs(n, s, indent) - of nkValueList: - s.add("values ") - rs(n, s, indent) - of nkWhere: - s.add("\nwhere ") - ra(n.sons[0], s, indent) - of nkCreateTable, nkCreateTableIfNotExists: - s.add("create table ") - if n.kind == nkCreateTableIfNotExists: - s.add("if not exists ") - ra(n.sons[0], s, indent) - s.add('(') - for i in 1..n.len-1: - if i > 1: s.add(", ") - ra(n.sons[i], s, indent) - s.add(");") - of nkCreateType, nkCreateTypeIfNotExists: - s.add("create type ") - if n.kind == nkCreateTypeIfNotExists: - s.add("if not exists ") - ra(n.sons[0], s, indent) - s.add(" as ") - ra(n.sons[1], s, indent) - s.add(';') - of nkCreateIndex, nkCreateIndexIfNotExists: - s.add("create index ") - if n.kind == nkCreateIndexIfNotExists: - s.add("if not exists ") - ra(n.sons[0], s, indent) - s.add(" on ") - ra(n.sons[1], s, indent) - s.add('(') - for i in 2..n.len-1: - if i > 2: s.add(", ") - ra(n.sons[i], s, indent) - s.add(");") - of nkEnumDef: - s.add("enum ") - rs(n, s, indent) - -# What I want: -# -#select(columns = [T1.all, T2.name], -# fromm = [T1, T2], -# where = T1.name ==. T2.name, -# orderby = [name]): -# -#for row in dbQuery(db, """select x, y, z -# from a, b -# where a.name = b.name"""): -# - -#select x, y, z: -# fromm: Table1, Table2 -# where: x.name == y.name -#db.select(fromm = [t1, t2], where = t1.name == t2.name): -#for x, y, z in db.select(fromm = a, b where = a.name == b.name): -# writeln x, y, z - -proc renderSQL*(n: PSqlNode): string = - ## Converts an SQL abstract syntax tree to its string representation. - result = "" - ra(n, result, 0) - -when isMainModule: - echo(renderSQL(parseSQL(newStringStream(""" - CREATE TYPE happiness AS ENUM ('happy', 'very happy', 'ecstatic'); - CREATE TABLE holidays ( - num_weeks int, - happiness happiness - ); - CREATE INDEX table1_attr1 ON table1(attr1); - - SELECT * FROM myTab WHERE col1 = 'happy'; - """), "stdin"))) - -# CREATE TYPE happiness AS ENUM ('happy', 'very happy', 'ecstatic'); -# CREATE TABLE holidays ( -# num_weeks int, -# happiness happiness -# ); -# CREATE INDEX table1_attr1 ON table1(attr1) diff --git a/nimlib/pure/parsexml.nim b/nimlib/pure/parsexml.nim deleted file mode 100755 index 54f62a9a4a..0000000000 --- a/nimlib/pure/parsexml.nim +++ /dev/null @@ -1,635 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a simple high performance `XML`:idx: / `HTML`:idx: -## parser. -## The only encoding that is supported is UTF-8. The parser has been designed -## to be somewhat error correcting, so that even most "wild HTML" found on the -## web can be parsed with it. **Note:** This parser does not check that each -## ```` has a corresponding ````! These checks have do be -## implemented by the client code for various reasons: -## -## * Old HTML contains tags that have no end tag: ``
    `` for example. -## * HTML tags are case insensitive, XML tags are case sensitive. Since this -## library can parse both, only the client knows which comparison is to be -## used. -## * Thus the checks would have been very difficult to implement properly with -## little benefit, especially since they are simple to implement in the -## client. The client should use the `errorMsgExpected` proc to generate -## a nice error message that fits the other error messages this library -## creates. -## -## -## Example 1: Retrieve HTML title -## ============================== -## -## The file ``examples/htmltitle.nim`` demonstrates how to use the -## XML parser to accomplish a simple task: To determine the title of an HTML -## document. -## -## .. code-block:: nimrod -## :file: examples/htmltitle.nim -## -## -## Example 2: Retrieve all HTML links -## ================================== -## -## The file ``examples/htmlrefs.nim`` demonstrates how to use the -## XML parser to accomplish another simple task: To determine all the links -## an HTML document contains. -## -## .. code-block:: nimrod -## :file: examples/htmlrefs.nim -## - -import - hashes, strutils, lexbase, streams, unicode - -# the parser treats ``
    `` as ``

    `` - -type - TXmlEventKind* = enum ## enumation of all events that may occur when parsing - xmlError, ## an error ocurred during parsing - xmlEof, ## end of file reached - xmlCharData, ## character data - xmlWhitespace, ## whitespace has been parsed - xmlComment, ## a comment has been parsed - xmlPI, ## processing instruction (````) - xmlElementStart, ## ```` - xmlElementEnd, ## ```` - xmlElementOpen, ## ```` - xmlCData, ## ```` - xmlEntity, ## &entity; - xmlSpecial ## ```` - - TXmlError* = enum ## enumeration that lists all errors that can occur - errNone, ## no error - errEndOfCDataExpected, ## ``]]>`` expected - errNameExpected, ## name expected - errSemicolonExpected, ## ``;`` expected - errQmGtExpected, ## ``?>`` expected - errGtExpected, ## ``>`` expected - errEqExpected, ## ``=`` expected - errQuoteExpected, ## ``"`` or ``'`` expected - errEndOfCommentExpected ## ``-->`` expected - - TParserState = enum - stateStart, stateNormal, stateAttr, stateEmptyElementTag, stateError - - TXmlParseOption* = enum ## options for the XML parser - reportWhitespace, ## report whitespace - reportComments ## report comments - - TXmlParser* = object of TBaseLexer ## the parser object. - a, b: string - kind: TXmlEventKind - err: TXmlError - state: TParserState - filename: string - options: set[TXmlParseOption] - -const - errorMessages: array [TXmlError, string] = [ - "no error", - "']]>' expected", - "name expected", - "';' expected", - "'?>' expected", - "'>' expected", - "'=' expected", - "'\"' or \"'\" expected", - "'-->' expected" - ] - -proc open*(my: var TXmlParser, input: PStream, filename: string, - options: set[TXmlParseOption] = {}) = - ## initializes the parser with an input stream. `Filename` is only used - ## for nice error messages. The parser's behaviour can be controlled by - ## the `options` parameter: If `options` contains ``reportWhitespace`` - ## a whitespace token is reported as an ``xmlWhitespace`` event. - ## If `options` contains ``reportComments`` a comment token is reported as an - ## ``xmlComment`` event. - lexbase.open(my, input) - my.filename = filename - my.state = stateStart - my.kind = xmlError - my.a = "" - my.b = "" - my.options = options - -proc close*(my: var TXmlParser) {.inline.} = - ## closes the parser `my` and its associated input stream. - lexbase.close(my) - -proc charData*(my: TXmlParser): string {.inline.} = - ## returns the character data for the events: ``xmlCharData``, - ## ``xmlWhitespace``, ``xmlComment``, ``xmlCData``, ``xmlSpecial`` - assert(my.kind in {xmlCharData, xmlWhitespace, xmlComment, xmlCData, - xmlSpecial}) - return my.a - -proc kind*(my: TXmlParser): TXmlEventKind {.inline.} = - ## returns the current event type for the XML parser - return my.kind - -proc elementName*(my: TXmlParser): string {.inline.} = - ## returns the element name for the events: ``xmlElementStart``, - ## ``xmlElementEnd``, ``xmlElementOpen`` - assert(my.kind in {xmlElementStart, xmlElementEnd, xmlElementOpen}) - return my.a - -proc entityName*(my: TXmlParser): string {.inline.} = - ## returns the entity name for the event: ``xmlEntity`` - assert(my.kind == xmlEntity) - return my.a - -proc attrKey*(my: TXmlParser): string {.inline.} = - ## returns the attribute key for the event ``xmlAttribute`` - assert(my.kind == xmlAttribute) - return my.a - -proc attrValue*(my: TXmlParser): string {.inline.} = - ## returns the attribute value for the event ``xmlAttribute`` - assert(my.kind == xmlAttribute) - return my.b - -proc PIName*(my: TXmlParser): string {.inline.} = - ## returns the processing instruction name for the event ``xmlPI`` - assert(my.kind == xmlPI) - return my.a - -proc PIRest*(my: TXmlParser): string {.inline.} = - ## returns the rest of the processing instruction for the event ``xmlPI`` - assert(my.kind == xmlPI) - return my.b - -proc getColumn*(my: TXmlParser): int {.inline.} = - ## get the current column the parser has arrived at. - result = getColNumber(my, my.bufPos) - -proc getLine*(my: TXmlParser): int {.inline.} = - ## get the current line the parser has arrived at. - result = my.linenumber - -proc getFilename*(my: TXmlParser): string {.inline.} = - ## get the filename of the file that the parser processes. - result = my.filename - -proc errorMsg*(my: TXmlParser): string = - ## returns a helpful error message for the event ``xmlError`` - assert(my.kind == xmlError) - result = "$1($2, $3) Error: $4" % [ - my.filename, $getLine(my), $getColumn(my), errorMessages[my.err]] - -proc errorMsgExpected*(my: TXmlParser, tag: string): string = - ## returns an error message " expected" in the same format as the - ## other error messages - result = "$1($2, $3) Error: $4" % [ - my.filename, $getLine(my), $getColumn(my), "<$1> expected" % tag] - -proc markError(my: var TXmlParser, kind: TXmlError) {.inline.} = - my.err = kind - my.state = stateError - -proc parseCDATA(my: var TXMLParser) = - var pos = my.bufpos + len("': - inc(pos, 3) - break - add(my.a, ']') - inc(pos) - of '\0': - markError(my, errEndOfCDataExpected) - break - of '\c': - pos = lexbase.HandleCR(my, pos) - buf = my.buf - add(my.a, '\L') - of '\L': - pos = lexbase.HandleLF(my, pos) - buf = my.buf - add(my.a, '\L') - else: - add(my.a, buf[pos]) - inc(pos) - my.bufpos = pos # store back - my.kind = xmlCDATA - -proc parseComment(my: var TXMLParser) = - var pos = my.bufpos + len("" % x.charData) - of xmlPI: echo("" % [x.PIName, x.PIRest]) - of xmlElementStart: echo("<$1>" % x.elementName) - of xmlElementEnd: echo("" % x.elementName) - - of xmlElementOpen: echo("<$1" % x.elementName) - of xmlAttribute: - echo("Key: " & x.attrKey) - echo("Value: " & x.attrValue) - - of xmlElementClose: echo(">") - of xmlCData: - echo("" % x.charData) - of xmlEntity: - echo("&$1;" % x.entityName) - of xmlSpecial: - echo("SPECIAL: " & x.charData) - close(x) - diff --git a/nimlib/pure/pegs.nim b/nimlib/pure/pegs.nim deleted file mode 100755 index 488e42c7d6..0000000000 --- a/nimlib/pure/pegs.nim +++ /dev/null @@ -1,1365 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Simple PEG (Parsing expression grammar) matching. Uses no memorization, but -## uses superoperators and symbol inlining to improve performance. Note: -## Matching performance is hopefully competitive with optimized regular -## expression engines. -## -## .. include:: ../doc/pegdocs.txt -## - -const - useUnicode = true ## change this to deactivate proper UTF-8 support - -import - strutils - -when useUnicode: - import unicode - -const - InlineThreshold = 5 ## number of leaves; -1 to disable inlining - -type - TPegKind = enum - pkEmpty, - pkAny, ## any character (.) - pkAnyRune, ## any Unicode character (_) - pkNewLine, ## CR-LF, LF, CR - pkTerminal, - pkTerminalIgnoreCase, - pkTerminalIgnoreStyle, - pkChar, ## single character to match - pkCharChoice, - pkNonTerminal, - pkSequence, ## a b c ... --> Internal DSL: peg(a, b, c) - pkOrderedChoice, ## a / b / ... --> Internal DSL: a / b or /[a, b, c] - pkGreedyRep, ## a* --> Internal DSL: *a - ## a+ --> (a a*) - pkGreedyRepChar, ## x* where x is a single character (superop) - pkGreedyRepSet, ## [set]* (superop) - pkGreedyAny, ## .* or _* (superop) - pkOption, ## a? --> Internal DSL: ?a - pkAndPredicate, ## &a --> Internal DSL: &a - pkNotPredicate, ## !a --> Internal DSL: !a - pkCapture, ## {a} --> Internal DSL: capture(a) - pkSearch, ## @a --> Internal DSL: @a - pkRule, ## a <- b - pkList ## a, b - TNonTerminalFlag = enum - ntDeclared, ntUsed - TNonTerminal {.final.} = object ## represents a non terminal symbol - name: string ## the name of the symbol - line: int ## the line the symbol has been declared/used in - col: int ## the column the symbol has been declared/used in - flags: set[TNonTerminalFlag] ## the nonterminal's flags - rule: TNode ## the rule that the symbol refers to - TNode {.final.} = object - case kind: TPegKind - of pkEmpty, pkAny, pkAnyRune, pkGreedyAny, pkNewLine: nil - of pkTerminal, pkTerminalIgnoreCase, pkTerminalIgnoreStyle: term: string - of pkChar, pkGreedyRepChar: ch: char - of pkCharChoice, pkGreedyRepSet: charChoice: ref set[char] - of pkNonTerminal: nt: PNonTerminal - else: sons: seq[TNode] - PNonTerminal* = ref TNonTerminal - - TPeg* = TNode ## type that represents a PEG - -proc term*(t: string): TPeg = - ## constructs a PEG from a terminal string - if t.len != 1: - result.kind = pkTerminal - result.term = t - else: - result.kind = pkChar - result.ch = t[0] - -proc termIgnoreCase*(t: string): TPeg = - ## constructs a PEG from a terminal string; ignore case for matching - result.kind = pkTerminalIgnoreCase - result.term = t - -proc termIgnoreStyle*(t: string): TPeg = - ## constructs a PEG from a terminal string; ignore style for matching - result.kind = pkTerminalIgnoreStyle - result.term = t - -proc term*(t: char): TPeg = - ## constructs a PEG from a terminal char - assert t != '\0' - result.kind = pkChar - result.ch = t - -proc charSet*(s: set[char]): TPeg = - ## constructs a PEG from a character set `s` - assert '\0' notin s - result.kind = pkCharChoice - new(result.charChoice) - result.charChoice^ = s - -proc len(a: TPeg): int {.inline.} = return a.sons.len -proc add(d: var TPeg, s: TPeg) {.inline.} = add(d.sons, s) - -proc addChoice(dest: var TPeg, elem: TPeg) = - var L = dest.len-1 - if L >= 0 and dest.sons[L].kind == pkCharChoice: - case elem.kind - of pkCharChoice: - dest.sons[L].charChoice^ = dest.sons[L].charChoice^ + elem.charChoice^ - of pkChar: incl(dest.sons[L].charChoice^, elem.ch) - else: add(dest, elem) - else: add(dest, elem) - -template multipleOp(k: TPegKind, localOpt: expr) = - result.kind = k - result.sons = @[] - for x in items(a): - if x.kind == k: - for y in items(x.sons): - localOpt(result, y) - else: - localOpt(result, x) - if result.len == 1: - result = result.sons[0] - -proc `/`*(a: openArray[TPeg]): TPeg = - ## constructs an ordered choice with the PEGs in `a` - multipleOp(pkOrderedChoice, addChoice) - -proc addSequence(dest: var TPeg, elem: TPeg) = - var L = dest.len-1 - if L >= 0 and dest.sons[L].kind == pkTerminal: - case elem.kind - of pkTerminal: add(dest.sons[L].term, elem.term) - of pkChar: add(dest.sons[L].term, elem.ch) - else: add(dest, elem) - else: add(dest, elem) - -proc sequence*(a: openArray[TPeg]): TPeg = - ## constructs a sequence with all the PEGs from `a` - multipleOp(pkSequence, addSequence) - -proc `?`*(a: TPeg): TPeg = - ## constructs an optional for the PEG `a` - if a.kind in {pkOption, pkGreedyRep, pkGreedyAny, pkGreedyRepChar, - pkGreedyRepSet}: - # a* ? --> a* - # a? ? --> a? - result = a - else: - result.kind = pkOption - result.sons = @[a] - -proc `*`*(a: TPeg): TPeg = - ## constructs a "greedy repetition" for the PEG `a` - case a.kind - of pkGreedyRep, pkGreedyRepChar, pkGreedyRepSet, pkGreedyAny, pkOption: - assert false - # produces endless loop! - of pkChar: - result.kind = pkGreedyRepChar - result.ch = a.ch - of pkCharChoice: - result.kind = pkGreedyRepSet - result.charChoice = a.charChoice # copying a reference suffices! - of pkAny, pkAnyRune: - result.kind = pkGreedyAny - else: - result.kind = pkGreedyRep - result.sons = @[a] - -proc `@`*(a: TPeg): TPeg = - ## constructs a "search" for the PEG `a` - result.kind = pkSearch - result.sons = @[a] - -when false: - proc contains(a: TPeg, k: TPegKind): bool = - if a.kind == k: return true - case a.kind - of pkEmpty, pkAny, pkAnyRune, pkGreedyAny, pkNewLine, pkTerminal, - pkTerminalIgnoreCase, pkTerminalIgnoreStyle, pkChar, pkGreedyRepChar, - pkCharChoice, pkGreedyRepSet: nil - of pkNonTerminal: return true - else: - for i in 0..a.sons.len-1: - if contains(a.sons[i], k): return true - -proc `+`*(a: TPeg): TPeg = - ## constructs a "greedy positive repetition" with the PEG `a` - return sequence(a, *a) - -proc `&`*(a: TPeg): TPeg = - ## constructs an "and predicate" with the PEG `a` - result.kind = pkAndPredicate - result.sons = @[a] - -proc `!`*(a: TPeg): TPeg = - ## constructs a "not predicate" with the PEG `a` - result.kind = pkNotPredicate - result.sons = @[a] - -proc any*: TPeg {.inline.} = - ## constructs the PEG `any character`:idx: (``.``) - result.kind = pkAny - -proc anyRune*: TPeg {.inline.} = - ## constructs the PEG `any rune`:idx: (``_``) - result.kind = pkAnyRune - -proc newLine*: TPeg {.inline.} = - ## constructs the PEG `newline`:idx: (``\n``) - result.kind = pkNewline - -proc capture*(a: TPeg): TPeg = - ## constructs a capture with the PEG `a` - result.kind = pkCapture - result.sons = @[a] - -proc spaceCost(n: TPeg): int = - case n.kind - of pkEmpty: nil - of pkTerminal, pkTerminalIgnoreCase, pkTerminalIgnoreStyle, pkChar, - pkGreedyRepChar, pkCharChoice, pkGreedyRepSet, pkAny, pkAnyRune, - pkNewLine, pkGreedyAny: - result = 1 - of pkNonTerminal: - # we cannot inline a rule with a non-terminal - result = InlineThreshold+1 - else: - for i in 0..n.len-1: - inc(result, spaceCost(n.sons[i])) - if result >= InlineThreshold: break - -proc nonterminal*(n: PNonTerminal): TPeg = - ## constructs a PEG that consists of the nonterminal symbol - assert n != nil - if ntDeclared in n.flags and spaceCost(n.rule) < InlineThreshold: - when false: echo "inlining symbol: ", n.name - result = n.rule # inlining of rule enables better optimizations - else: - result.kind = pkNonTerminal - result.nt = n - -proc newNonTerminal*(name: string, line, column: int): PNonTerminal = - ## constructs a nonterminal symbol - new(result) - result.name = name - result.line = line - result.col = column - -template letters*: expr = - ## expands to ``charset({'A'..'Z', 'a'..'z'})`` - charset({'A'..'Z', 'a'..'z'}) - -template digits*: expr = - ## expands to ``charset({'0'..'9'})`` - charset({'0'..'9'}) - -template whitespace*: expr = - ## expands to ``charset({' ', '\9'..'\13'})`` - charset({' ', '\9'..'\13'}) - -template identChars*: expr = - ## expands to ``charset({'a'..'z', 'A'..'Z', '0'..'9', '_'})`` - charset({'a'..'z', 'A'..'Z', '0'..'9', '_'}) - -template identStartChars*: expr = - ## expands to ``charset({'A'..'Z', 'a'..'z', '_'})`` - charset({'a'..'z', 'A'..'Z', '_'}) - -template ident*: expr = - ## same as ``[a-zA-Z_][a-zA-z_0-9]*``; standard identifier - sequence(charset({'a'..'z', 'A'..'Z', '_'}), - *charset({'a'..'z', 'A'..'Z', '0'..'9', '_'})) - -template natural*: expr = - ## same as ``\d+`` - +digits - -const - MaxSubpatterns* = 10 ## defines the maximum number of subpatterns that - ## can be captured. More subpatterns cannot be captured! - -# ------------------------- debugging ----------------------------------------- - -proc esc(c: char, reserved = {'\0'..'\255'}): string = - case c - of '\b': result = "\\b" - of '\t': result = "\\t" - of '\c': result = "\\c" - of '\L': result = "\\l" - of '\v': result = "\\v" - of '\f': result = "\\f" - of '\e': result = "\\e" - of '\a': result = "\\a" - of '\\': result = "\\\\" - of 'a'..'z', 'A'..'Z', '0'..'9', '_': result = $c - elif c < ' ' or c >= '\128': result = '\\' & $ord(c) - elif c in reserved: result = '\\' & c - else: result = $c - -proc singleQuoteEsc(c: Char): string = return "'" & esc(c, {'\''}) & "'" - -proc singleQuoteEsc(str: string): string = - result = "'" - for c in items(str): add result, esc(c, {'\''}) - add result, '\'' - -proc charSetEscAux(cc: set[char]): string = - const reserved = {'^', '-', ']'} - result = "" - var c1 = 0 - while c1 <= 0xff: - if chr(c1) in cc: - var c2 = c1 - while c2 < 0xff and chr(succ(c2)) in cc: inc(c2) - if c1 == c2: - add result, esc(chr(c1), reserved) - elif c2 == succ(c1): - add result, esc(chr(c1), reserved) & esc(chr(c2), reserved) - else: - add result, esc(chr(c1), reserved) & '-' & esc(chr(c2), reserved) - c1 = c2 - inc(c1) - -proc CharSetEsc(cc: set[char]): string = - if card(cc) >= 128+64: - result = "[^" & CharSetEscAux({'\1'..'\xFF'} - cc) & ']' - else: - result = '[' & CharSetEscAux(cc) & ']' - -proc toStrAux(r: TPeg, res: var string) = - case r.kind - of pkEmpty: add(res, "()") - of pkAny: add(res, '.') - of pkAnyRune: add(res, '_') - of pkNewline: add(res, "\\n") - of pkTerminal: add(res, singleQuoteEsc(r.term)) - of pkTerminalIgnoreCase: - add(res, 'i') - add(res, singleQuoteEsc(r.term)) - of pkTerminalIgnoreStyle: - add(res, 'y') - add(res, singleQuoteEsc(r.term)) - of pkChar: add(res, singleQuoteEsc(r.ch)) - of pkCharChoice: add(res, charSetEsc(r.charChoice^)) - of pkNonTerminal: add(res, r.nt.name) - of pkSequence: - add(res, '(') - toStrAux(r.sons[0], res) - for i in 1 .. high(r.sons): - add(res, ' ') - toStrAux(r.sons[i], res) - add(res, ')') - of pkOrderedChoice: - add(res, '(') - toStrAux(r.sons[0], res) - for i in 1 .. high(r.sons): - add(res, " / ") - toStrAux(r.sons[i], res) - add(res, ')') - of pkGreedyRep: - toStrAux(r.sons[0], res) - add(res, '*') - of pkGreedyRepChar: - add(res, singleQuoteEsc(r.ch)) - add(res, '*') - of pkGreedyRepSet: - add(res, charSetEsc(r.charChoice^)) - add(res, '*') - of pkGreedyAny: - add(res, ".*") - of pkOption: - toStrAux(r.sons[0], res) - add(res, '?') - of pkAndPredicate: - add(res, '&') - toStrAux(r.sons[0], res) - of pkNotPredicate: - add(res, '!') - toStrAux(r.sons[0], res) - of pkSearch: - add(res, '@') - toStrAux(r.sons[0], res) - of pkCapture: - add(res, '{') - toStrAux(r.sons[0], res) - add(res, '}') - of pkRule: - toStrAux(r.sons[0], res) - add(res, " <- ") - toStrAux(r.sons[1], res) - of pkList: - for i in 0 .. high(r.sons): - toStrAux(r.sons[i], res) - add(res, "\n") - -proc `$` *(r: TPeg): string = - ## converts a PEG to its string representation - result = "" - toStrAux(r, result) - -# --------------------- core engine ------------------------------------------- - -type - TMatchClosure {.final.} = object - matches: array[0..maxSubpatterns-1, tuple[first, last: int]] - ml: int - -when not useUnicode: - type - TRune = char - template fastRuneAt(s, i, ch: expr) = - ch = s[i] - inc(i) - template runeLenAt(s, i: expr): expr = 1 - -proc m(s: string, p: TPeg, start: int, c: var TMatchClosure): int = - ## this implements a simple PEG interpreter. Thanks to superoperators it - ## has competitive performance nevertheless. - ## Returns -1 if it does not match, else the length of the match - case p.kind - of pkEmpty: result = 0 # match of length 0 - of pkAny: - if s[start] != '\0': result = 1 - else: result = -1 - of pkAnyRune: - if s[start] != '\0': - result = runeLenAt(s, start) - else: - result = -1 - of pkGreedyAny: - result = len(s) - start - of pkNewLine: - if s[start] == '\L': result = 1 - elif s[start] == '\C': - if s[start+1] == '\L': result = 2 - else: result = 1 - else: result = -1 - of pkTerminal: - result = len(p.term) - for i in 0..result-1: - if p.term[i] != s[start+i]: - result = -1 - break - of pkTerminalIgnoreCase: - var - i = 0 - a, b: TRune - result = start - while i < len(p.term): - fastRuneAt(p.term, i, a) - fastRuneAt(s, result, b) - if toLower(a) != toLower(b): - result = -1 - break - dec(result, start) - of pkTerminalIgnoreStyle: - var - i = 0 - a, b: TRune - result = start - while i < len(p.term): - while true: - fastRuneAt(p.term, i, a) - if a != TRune('_'): break - while true: - fastRuneAt(s, result, b) - if b != TRune('_'): break - if toLower(a) != toLower(b): - result = -1 - break - dec(result, start) - of pkChar: - if p.ch == s[start]: result = 1 - else: result = -1 - of pkCharChoice: - if contains(p.charChoice^, s[start]): result = 1 - else: result = -1 - of pkNonTerminal: - var oldMl = c.ml - when false: echo "enter: ", p.nt.name - result = m(s, p.nt.rule, start, c) - when false: echo "leave: ", p.nt.name - if result < 0: c.ml = oldMl - of pkSequence: - var oldMl = c.ml - result = 0 - for i in 0..high(p.sons): - var x = m(s, p.sons[i], start+result, c) - if x < 0: - c.ml = oldMl - result = -1 - break - else: inc(result, x) - of pkOrderedChoice: - var oldMl = c.ml - for i in 0..high(p.sons): - result = m(s, p.sons[i], start, c) - if result >= 0: break - c.ml = oldMl - of pkSearch: - var oldMl = c.ml - result = 0 - while start+result < s.len: - var x = m(s, p.sons[0], start+result, c) - if x >= 0: - inc(result, x) - return - inc(result) - result = -1 - c.ml = oldMl - of pkGreedyRep: - result = 0 - while true: - var x = m(s, p.sons[0], start+result, c) - # if x == 0, we have an endless loop; so the correct behaviour would be - # not to break. But endless loops can be easily introduced: - # ``(comment / \w*)*`` is such an example. Breaking for x == 0 does the - # expected thing in this case. - if x <= 0: break - inc(result, x) - of pkGreedyRepChar: - result = 0 - var ch = p.ch - while ch == s[start+result]: inc(result) - of pkGreedyRepSet: - result = 0 - while contains(p.charChoice^, s[start+result]): inc(result) - of pkOption: - result = max(0, m(s, p.sons[0], start, c)) - of pkAndPredicate: - var oldMl = c.ml - result = m(s, p.sons[0], start, c) - if result >= 0: result = 0 # do not consume anything - else: c.ml = oldMl - of pkNotPredicate: - var oldMl = c.ml - result = m(s, p.sons[0], start, c) - if result < 0: result = 0 - else: - c.ml = oldMl - result = -1 - of pkCapture: - var idx = c.ml # reserve a slot for the subpattern - inc(c.ml) - result = m(s, p.sons[0], start, c) - if result >= 0: - if idx < maxSubpatterns: - c.matches[idx] = (start, start+result-1) - #else: silently ignore the capture - else: - c.ml = idx - of pkRule, pkList: assert false - -proc match*(s: string, pattern: TPeg, matches: var openarray[string], - start = 0): bool = - ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and - ## the captured substrings in the array ``matches``. If it does not - ## match, nothing is written into ``matches`` and ``false`` is - ## returned. - var c: TMatchClosure - result = m(s, pattern, start, c) == len(s) - if result: - for i in 0..c.ml-1: - matches[i] = copy(s, c.matches[i][0], c.matches[i][1]) - -proc match*(s: string, pattern: TPeg, start = 0): bool = - ## returns ``true`` if ``s`` matches the ``pattern`` beginning from ``start``. - var c: TMatchClosure - result = m(s, pattern, start, c) == len(s) - -proc matchLen*(s: string, pattern: TPeg, matches: var openarray[string], - start = 0): int = - ## the same as ``match``, but it returns the length of the match, - ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. It's possible that a suffix of `s` remains - ## that does not belong to the match. - var c: TMatchClosure - result = m(s, pattern, start, c) - if result >= 0: - for i in 0..c.ml-1: - matches[i] = copy(s, c.matches[i][0], c.matches[i][1]) - -proc matchLen*(s: string, pattern: TPeg, start = 0): int = - ## the same as ``match``, but it returns the length of the match, - ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. It's possible that a suffix of `s` remains - ## that does not belong to the match. - var c: TMatchClosure - result = m(s, pattern, start, c) - -proc find*(s: string, pattern: TPeg, matches: var openarray[string], - start = 0): int = - ## returns the starting position of ``pattern`` in ``s`` and the captured - ## substrings in the array ``matches``. If it does not match, nothing - ## is written into ``matches`` and -1 is returned. - for i in 0 .. s.len-1: - if matchLen(s, pattern, matches, i) >= 0: return i - return -1 - # could also use the pattern here: (!P .)* P - -proc find*(s: string, pattern: TPeg, start = 0): int = - ## returns the starting position of ``pattern`` in ``s``. If it does not - ## match, -1 is returned. - for i in 0 .. s.len-1: - if matchLen(s, pattern, i) >= 0: return i - return -1 - -template `=~`*(s: string, pattern: TPeg): expr = - ## This calls ``match`` with an implicit declared ``matches`` array that - ## can be used in the scope of the ``=~`` call: - ## - ## .. code-block:: nimrod - ## - ## if line =~ peg"\s* {\w+} \s* '=' \s* {\w+}": - ## # matches a key=value pair: - ## echo("Key: ", matches[0]) - ## echo("Value: ", matches[1]) - ## elif line =~ peg"\s*{'#'.*}": - ## # matches a comment - ## # note that the implicit ``matches`` array is different from the - ## # ``matches`` array of the first branch - ## echo("comment: ", matches[0]) - ## else: - ## echo("syntax error") - ## - when not definedInScope(matches): - var matches: array[0..maxSubpatterns-1, string] - match(s, pattern, matches) - -# ------------------------- more string handling ------------------------------ - -proc contains*(s: string, pattern: TPeg, start = 0): bool = - ## same as ``find(s, pattern, start) >= 0`` - return find(s, pattern, start) >= 0 - -proc contains*(s: string, pattern: TPeg, matches: var openArray[string], - start = 0): bool = - ## same as ``find(s, pattern, matches, start) >= 0`` - return find(s, pattern, matches, start) >= 0 - -proc startsWith*(s: string, prefix: TPeg): bool = - ## returns true if `s` starts with the pattern `prefix` - result = matchLen(s, prefix) >= 0 - -proc endsWith*(s: string, suffix: TPeg): bool = - ## returns true if `s` ends with the pattern `prefix` - for i in 0 .. s.len-1: - if matchLen(s, suffix, i) == s.len - i: return true - -proc replace*(s: string, sub: TPeg, by: string): string = - ## Replaces `sub` in `s` by the string `by`. Captures can be accessed in `by` - ## with the notation ``$i`` and ``$#`` (see strutils.`%`). Examples: - ## - ## .. code-block:: nimrod - ## "var1=key; var2=key2".replace(peg"{\ident}'='{\ident}", "$1<-$2$2") - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## - ## "var1<-keykey; val2<-key2key2" - result = "" - var i = 0 - var caps: array[0..maxSubpatterns-1, string] - while i < s.len: - var x = matchLen(s, sub, caps, i) - if x <= 0: - add(result, s[i]) - inc(i) - else: - addf(result, by, caps) - inc(i, x) - # copy the rest: - add(result, copy(s, i)) - -proc parallelReplace*(s: string, subs: openArray[ - tuple[pattern: TPeg, repl: string]]): string = - ## Returns a modified copy of `s` with the substitutions in `subs` - ## applied in parallel. - result = "" - var i = 0 - var caps: array[0..maxSubpatterns-1, string] - while i < s.len: - block searchSubs: - for j in 0..high(subs): - var x = matchLen(s, subs[j][0], caps, i) - if x > 0: - addf(result, subs[j][1], caps) - inc(i, x) - break searchSubs - add(result, s[i]) - inc(i) - # copy the rest: - add(result, copy(s, i)) - -proc transformFile*(infile, outfile: string, - subs: openArray[tuple[pattern: TPeg, repl: string]]) = - ## reads in the file `infile`, performs a parallel replacement (calls - ## `parallelReplace`) and writes back to `outfile`. Calls ``quit`` if an - ## error occurs. This is supposed to be used for quick scripting. - var x = readFile(infile) - if not isNil(x): - var f: TFile - if open(f, outfile, fmWrite): - write(f, x.parallelReplace(subs)) - close(f) - else: - quit("cannot open for writing: " & outfile) - else: - quit("cannot open for reading: " & infile) - -iterator split*(s: string, sep: TPeg): string = - ## Splits the string `s` into substrings. - ## - ## Substrings are separated by the PEG `sep`. - ## Examples: - ## - ## .. code-block:: nimrod - ## for word in split("00232this02939is39an22example111", peg"\d+"): - ## writeln(stdout, word) - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "this" - ## "is" - ## "an" - ## "example" - ## - var - first = 0 - last = 0 - while last < len(s): - var x = matchLen(s, sep, last) - if x > 0: inc(last, x) - first = last - while last < len(s): - inc(last) - x = matchLen(s, sep, last) - if x > 0: break - if first < last: - yield copy(s, first, last-1) - -proc split*(s: string, sep: TPeg): seq[string] {.noSideEffect.} = - ## Splits the string `s` into substrings. - accumulateResult(split(s, sep)) - -# ------------------- scanner ------------------------------------------------- - -type - TModifier = enum - modNone, - modVerbatim, - modIgnoreCase, - modIgnoreStyle - TTokKind = enum ## enumeration of all tokens - tkInvalid, ## invalid token - tkEof, ## end of file reached - tkAny, ## . - tkAnyRune, ## _ - tkIdentifier, ## abc - tkStringLit, ## "abc" or 'abc' - tkCharSet, ## [^A-Z] - tkParLe, ## '(' - tkParRi, ## ')' - tkCurlyLe, ## '{' - tkCurlyRi, ## '}' - tkArrow, ## '<-' - tkBar, ## '/' - tkStar, ## '*' - tkPlus, ## '+' - tkAmp, ## '&' - tkNot, ## '!' - tkOption, ## '?' - tkAt, ## '@' - tkBuiltin, ## \identifier - tkEscaped ## \\ - - TToken {.final.} = object ## a token - kind: TTokKind ## the type of the token - modifier: TModifier - literal: string ## the parsed (string) literal - charset: set[char] ## if kind == tkCharSet - - TPegLexer = object ## the lexer object. - bufpos: int ## the current position within the buffer - buf: cstring ## the buffer itself - LineNumber: int ## the current line number - lineStart: int ## index of last line start in buffer - colOffset: int ## column to add - filename: string - -const - tokKindToStr: array[TTokKind, string] = [ - "invalid", "[EOF]", ".", "_", "identifier", "string literal", - "character set", "(", ")", "{", "}", "<-", "/", "*", "+", "&", "!", "?", - "@", "built-in", "escaped" - ] - -proc HandleCR(L: var TPegLexer, pos: int): int = - assert(L.buf[pos] == '\c') - inc(L.linenumber) - result = pos+1 - if L.buf[result] == '\L': inc(result) - L.lineStart = result - -proc HandleLF(L: var TPegLexer, pos: int): int = - assert(L.buf[pos] == '\L') - inc(L.linenumber) - result = pos+1 - L.lineStart = result - -proc init(L: var TPegLexer, input, filename: string, line = 1, col = 0) = - L.buf = input - L.bufpos = 0 - L.lineNumber = line - L.colOffset = col - L.lineStart = 0 - L.filename = filename - -proc getColumn(L: TPegLexer): int {.inline.} = - result = abs(L.bufpos - L.lineStart) + L.colOffset - -proc getLine(L: TPegLexer): int {.inline.} = - result = L.linenumber - -proc errorStr(L: TPegLexer, msg: string, line = -1, col = -1): string = - var line = if line < 0: getLine(L) else: line - var col = if col < 0: getColumn(L) else: col - result = "$1($2, $3) Error: $4" % [L.filename, $line, $col, msg] - -proc handleHexChar(c: var TPegLexer, xi: var int) = - case c.buf[c.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10) - inc(c.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10) - inc(c.bufpos) - else: nil - -proc getEscapedChar(c: var TPegLexer, tok: var TToken) = - inc(c.bufpos) - case c.buf[c.bufpos] - of 'r', 'R', 'c', 'C': - add(tok.literal, '\c') - Inc(c.bufpos) - of 'l', 'L': - add(tok.literal, '\L') - Inc(c.bufpos) - of 'f', 'F': - add(tok.literal, '\f') - inc(c.bufpos) - of 'e', 'E': - add(tok.literal, '\e') - Inc(c.bufpos) - of 'a', 'A': - add(tok.literal, '\a') - Inc(c.bufpos) - of 'b', 'B': - add(tok.literal, '\b') - Inc(c.bufpos) - of 'v', 'V': - add(tok.literal, '\v') - Inc(c.bufpos) - of 't', 'T': - add(tok.literal, '\t') - Inc(c.bufpos) - of 'x', 'X': - inc(c.bufpos) - var xi = 0 - handleHexChar(c, xi) - handleHexChar(c, xi) - if xi == 0: tok.kind = tkInvalid - else: add(tok.literal, Chr(xi)) - of '0'..'9': - var val = ord(c.buf[c.bufpos]) - ord('0') - Inc(c.bufpos) - var i = 1 - while (i <= 3) and (c.buf[c.bufpos] in {'0'..'9'}): - val = val * 10 + ord(c.buf[c.bufpos]) - ord('0') - inc(c.bufpos) - inc(i) - if val > 0 and val <= 255: add(tok.literal, chr(val)) - else: tok.kind = tkInvalid - of '\0'..'\31': - tok.kind = tkInvalid - elif c.buf[c.bufpos] in strutils.letters: - tok.kind = tkInvalid - else: - add(tok.literal, c.buf[c.bufpos]) - Inc(c.bufpos) - -proc skip(c: var TPegLexer) = - var pos = c.bufpos - var buf = c.buf - while true: - case buf[pos] - of ' ', '\t': - Inc(pos) - of '#': - while not (buf[pos] in {'\c', '\L', '\0'}): inc(pos) - of '\c': - pos = HandleCR(c, pos) - buf = c.buf - of '\L': - pos = HandleLF(c, pos) - buf = c.buf - else: - break # EndOfFile also leaves the loop - c.bufpos = pos - -proc getString(c: var TPegLexer, tok: var TToken) = - tok.kind = tkStringLit - var pos = c.bufPos + 1 - var buf = c.buf - var quote = buf[pos-1] - while true: - case buf[pos] - of '\\': - c.bufpos = pos - getEscapedChar(c, tok) - pos = c.bufpos - of '\c', '\L', '\0': - tok.kind = tkInvalid - break - elif buf[pos] == quote: - inc(pos) - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - c.bufpos = pos - -proc getCharSet(c: var TPegLexer, tok: var TToken) = - tok.kind = tkCharSet - tok.charset = {} - var pos = c.bufPos + 1 - var buf = c.buf - var caret = false - if buf[pos] == '^': - inc(pos) - caret = true - while true: - var ch: char - case buf[pos] - of ']': - inc(pos) - break - of '\\': - c.bufpos = pos - getEscapedChar(c, tok) - pos = c.bufpos - ch = tok.literal[tok.literal.len-1] - of '\C', '\L', '\0': - tok.kind = tkInvalid - break - else: - ch = buf[pos] - Inc(pos) - incl(tok.charset, ch) - if buf[pos] == '-': - if buf[pos+1] == ']': - incl(tok.charset, '-') - inc(pos) - else: - inc(pos) - var ch2: char - case buf[pos] - of '\\': - c.bufpos = pos - getEscapedChar(c, tok) - pos = c.bufpos - ch2 = tok.literal[tok.literal.len-1] - of '\C', '\L', '\0': - tok.kind = tkInvalid - break - else: - ch2 = buf[pos] - Inc(pos) - for i in ord(ch)+1 .. ord(ch2): - incl(tok.charset, chr(i)) - c.bufpos = pos - if caret: tok.charset = {'\1'..'\xFF'} - tok.charset - -proc getSymbol(c: var TPegLexer, tok: var TToken) = - var pos = c.bufpos - var buf = c.buf - while true: - add(tok.literal, buf[pos]) - Inc(pos) - if buf[pos] notin strutils.IdentChars: break - c.bufpos = pos - tok.kind = tkIdentifier - -proc getBuiltin(c: var TPegLexer, tok: var TToken) = - if c.buf[c.bufpos+1] in strutils.Letters: - inc(c.bufpos) - getSymbol(c, tok) - tok.kind = tkBuiltin - else: - tok.kind = tkEscaped - getEscapedChar(c, tok) # may set tok.kind to tkInvalid - -proc getTok(c: var TPegLexer, tok: var TToken) = - tok.kind = tkInvalid - tok.modifier = modNone - setlen(tok.literal, 0) - skip(c) - case c.buf[c.bufpos] - of '{': - tok.kind = tkCurlyLe - inc(c.bufpos) - add(tok.literal, '{') - of '}': - tok.kind = tkCurlyRi - inc(c.bufpos) - add(tok.literal, '}') - of '[': - getCharset(c, tok) - of '(': - tok.kind = tkParLe - Inc(c.bufpos) - add(tok.literal, '(') - of ')': - tok.kind = tkParRi - Inc(c.bufpos) - add(tok.literal, ')') - of '.': - tok.kind = tkAny - inc(c.bufpos) - add(tok.literal, '.') - of '_': - tok.kind = tkAnyRune - inc(c.bufpos) - add(tok.literal, '_') - of '\\': - getBuiltin(c, tok) - of '\'', '"': getString(c, tok) - of '\0': - tok.kind = tkEof - tok.literal = "[EOF]" - of 'a'..'z', 'A'..'Z', '\128'..'\255': - getSymbol(c, tok) - if c.buf[c.bufpos] in {'\'', '"'}: - case tok.literal - of "i": tok.modifier = modIgnoreCase - of "y": tok.modifier = modIgnoreStyle - of "v": tok.modifier = modVerbatim - else: nil - setLen(tok.literal, 0) - getString(c, tok) - if tok.modifier == modNone: tok.kind = tkInvalid - of '+': - tok.kind = tkPlus - inc(c.bufpos) - add(tok.literal, '+') - of '*': - tok.kind = tkStar - inc(c.bufpos) - add(tok.literal, '+') - of '<': - if c.buf[c.bufpos+1] == '-': - inc(c.bufpos, 2) - tok.kind = tkArrow - add(tok.literal, "<-") - else: - add(tok.literal, '<') - of '/': - tok.kind = tkBar - inc(c.bufpos) - add(tok.literal, '/') - of '?': - tok.kind = tkOption - inc(c.bufpos) - add(tok.literal, '?') - of '!': - tok.kind = tkNot - inc(c.bufpos) - add(tok.literal, '!') - of '&': - tok.kind = tkAmp - inc(c.bufpos) - add(tok.literal, '!') - of '@': - tok.kind = tkAt - inc(c.bufpos) - add(tok.literal, '@') - else: - add(tok.literal, c.buf[c.bufpos]) - inc(c.bufpos) - -proc arrowIsNextTok(c: TPegLexer): bool = - # the only look ahead we need - var pos = c.bufpos - while c.buf[pos] in {'\t', ' '}: inc(pos) - result = c.buf[pos] == '<' and c.buf[pos+1] == '-' - -# ----------------------------- parser ---------------------------------------- - -type - EInvalidPeg* = object of EBase ## raised if an invalid PEG has been detected - TPegParser = object of TPegLexer ## the PEG parser object - tok: TToken - nonterms: seq[PNonTerminal] - modifier: TModifier - -proc getTok(p: var TPegParser) = getTok(p, p.tok) - -proc pegError(p: TPegParser, msg: string, line = -1, col = -1) = - var e: ref EInvalidPeg - new(e) - e.msg = errorStr(p, msg, line, col) - raise e - -proc eat(p: var TPegParser, kind: TTokKind) = - if p.tok.kind == kind: getTok(p) - else: pegError(p, tokKindToStr[kind] & " expected") - -proc parseExpr(p: var TPegParser): TPeg - -proc getNonTerminal(p: TPegParser, name: string): PNonTerminal = - for i in 0..high(p.nonterms): - result = p.nonterms[i] - if cmpIgnoreStyle(result.name, name) == 0: return - # forward reference: - result = newNonTerminal(name, getLine(p), getColumn(p)) - add(p.nonterms, result) - -proc modifiedTerm(s: string, m: TModifier): TPeg = - case m - of modNone, modVerbatim: result = term(s) - of modIgnoreCase: result = termIgnoreCase(s) - of modIgnoreStyle: result = termIgnoreStyle(s) - -proc primary(p: var TPegParser): TPeg = - case p.tok.kind - of tkAmp: - getTok(p) - return &primary(p) - of tkNot: - getTok(p) - return !primary(p) - of tkAt: - getTok(p) - return @primary(p) - else: nil - case p.tok.kind - of tkIdentifier: - if not arrowIsNextTok(p): - var nt = getNonTerminal(p, p.tok.literal) - incl(nt.flags, ntUsed) - result = nonTerminal(nt) - getTok(p) - else: - pegError(p, "expression expected, but found: " & p.tok.literal) - of tkStringLit: - var m = p.tok.modifier - if m == modNone: m = p.modifier - result = modifiedTerm(p.tok.literal, m) - getTok(p) - of tkCharSet: - if '\0' in p.tok.charset: - pegError(p, "binary zero ('\\0') not allowed in character class") - result = charset(p.tok.charset) - getTok(p) - of tkParLe: - getTok(p) - result = parseExpr(p) - eat(p, tkParRi) - of tkCurlyLe: - getTok(p) - result = capture(parseExpr(p)) - eat(p, tkCurlyRi) - of tkAny: - result = any() - getTok(p) - of tkAnyRune: - result = anyRune() - getTok(p) - of tkBuiltin: - case p.tok.literal - of "n": result = newLine() - of "d": result = charset({'0'..'9'}) - of "D": result = charset({'\1'..'\xff'} - {'0'..'9'}) - of "s": result = charset({' ', '\9'..'\13'}) - of "S": result = charset({'\1'..'\xff'} - {' ', '\9'..'\13'}) - of "w": result = charset({'a'..'z', 'A'..'Z', '_'}) - of "W": result = charset({'\1'..'\xff'} - {'a'..'z', 'A'..'Z', '_'}) - of "ident": result = pegs.ident - else: pegError(p, "unknown built-in: " & p.tok.literal) - getTok(p) - of tkEscaped: - result = term(p.tok.literal[0]) - getTok(p) - else: - pegError(p, "expression expected, but found: " & p.tok.literal) - getTok(p) # we must consume a token here to prevent endless loops! - while true: - case p.tok.kind - of tkOption: - result = ?result - getTok(p) - of tkStar: - result = *result - getTok(p) - of tkPlus: - result = +result - getTok(p) - else: break - -proc seqExpr(p: var TPegParser): TPeg = - result = primary(p) - while true: - case p.tok.kind - of tkAmp, tkNot, tkAt, tkStringLit, tkCharset, tkParLe, tkCurlyLe, - tkAny, tkAnyRune, tkBuiltin, tkEscaped: - result = sequence(result, primary(p)) - of tkIdentifier: - if not arrowIsNextTok(p): - result = sequence(result, primary(p)) - else: break - else: break - -proc parseExpr(p: var TPegParser): TPeg = - result = seqExpr(p) - while p.tok.kind == tkBar: - getTok(p) - result = result / seqExpr(p) - -proc parseRule(p: var TPegParser): PNonTerminal = - if p.tok.kind == tkIdentifier and arrowIsNextTok(p): - result = getNonTerminal(p, p.tok.literal) - if ntDeclared in result.flags: - pegError(p, "attempt to redefine: " & result.name) - result.line = getLine(p) - result.col = getColumn(p) - getTok(p) - eat(p, tkArrow) - result.rule = parseExpr(p) - incl(result.flags, ntDeclared) # NOW inlining may be attempted - else: - pegError(p, "rule expected, but found: " & p.tok.literal) - -proc rawParse(p: var TPegParser): TPeg = - ## parses a rule or a PEG expression - if p.tok.kind == tkBuiltin: - case p.tok.literal - of "i": - p.modifier = modIgnoreCase - getTok(p) - of "y": - p.modifier = modIgnoreStyle - getTok(p) - else: nil - if p.tok.kind == tkIdentifier and arrowIsNextTok(p): - result = parseRule(p).rule - while p.tok.kind != tkEof: - discard parseRule(p) - else: - result = parseExpr(p) - if p.tok.kind != tkEof: - pegError(p, "EOF expected, but found: " & p.tok.literal) - for i in 0..high(p.nonterms): - var nt = p.nonterms[i] - if ntDeclared notin nt.flags: - pegError(p, "undeclared identifier: " & nt.name, nt.line, nt.col) - elif ntUsed notin nt.flags and i > 0: - pegError(p, "unused rule: " & nt.name, nt.line, nt.col) - -proc parsePeg*(input: string, filename = "pattern", line = 1, col = 0): TPeg = - var p: TPegParser - init(TPegLexer(p), input, filename, line, col) - p.tok.kind = tkInvalid - p.tok.modifier = modNone - p.tok.literal = "" - p.tok.charset = {} - p.nonterms = @[] - getTok(p) - result = rawParse(p) - -proc peg*(pattern: string): TPeg = - ## constructs a TPeg object from the `pattern`. The short name has been - ## chosen to encourage its use as a raw string modifier:: - ## - ## peg"{\ident} \s* '=' \s* {.*}" - result = parsePeg(pattern, "pattern") - -when isMainModule: - assert match("(a b c)", peg"'(' @ ')'") - assert match("W_HI_Le", peg"\y 'while'") - assert(not match("W_HI_L", peg"\y 'while'")) - assert(not match("W_HI_Le", peg"\y v'while'")) - assert match("W_HI_Le", peg"y'while'") - - assert($ +digits == $peg"\d+") - assert "0158787".match(peg"\d+") - assert "ABC 0232".match(peg"\w+\s+\d+") - assert "ABC".match(peg"\d+ / \w+") - - for word in split("00232this02939is39an22example111", peg"\d+"): - writeln(stdout, word) - - assert matchLen("key", ident) == 3 - - var pattern = sequence(ident, *whitespace, term('='), *whitespace, ident) - assert matchLen("key1= cal9", pattern) == 11 - - var ws = newNonTerminal("ws", 1, 1) - ws.rule = *whitespace - - var expr = newNonTerminal("expr", 1, 1) - expr.rule = sequence(capture(ident), *sequence( - nonterminal(ws), term('+'), nonterminal(ws), nonterminal(expr))) - - var c: TMatchClosure - var s = "a+b + c +d+e+f" - assert m(s, expr.rule, 0, c) == len(s) - var a = "" - for i in 0..c.ml-1: - a.add(copy(s, c.matches[i][0], c.matches[i][1])) - assert a == "abcdef" - #echo expr.rule - - #const filename = "lib/devel/peg/grammar.txt" - #var grammar = parsePeg(newFileStream(filename, fmRead), filename) - #echo "a <- [abc]*?".match(grammar) - assert find("_____abc_______", term("abc")) == 5 - assert match("_______ana", peg"A <- 'ana' / . A") - assert match("abcs%%%", peg"A <- ..A / .A / '%'") - - if "abc" =~ peg"{'a'}'bc' 'xyz' / {\ident}": - assert matches[0] == "abc" - else: - assert false - - var g2 = peg"""S <- A B / C D - A <- 'a'+ - B <- 'b'+ - C <- 'c'+ - D <- 'd'+ - """ - assert($g2 == "((A B) / (C D))") - assert match("cccccdddddd", g2) - assert("var1=key; var2=key2".replace(peg"{\ident}'='{\ident}", "$1<-$2$2") == - "var1<-keykey; var2<-key2key2") - assert "var1=key; var2=key2".endsWith(peg"{\ident}'='{\ident}") - - if "aaaaaa" =~ peg"'aa' !. / ({'a'})+": - assert matches[0] == "a" - else: - assert false diff --git a/nimlib/pure/re.nim b/nimlib/pure/re.nim deleted file mode 100755 index 1328f5f1fa..0000000000 --- a/nimlib/pure/re.nim +++ /dev/null @@ -1,354 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Regular expression support for Nimrod. Consider using the pegs module -## instead. - -{.compile: "tre/tre_all.c".} - -from strutils import addf - -type - TRegExDesc {.pure, final.} = object - re_nsub: int # Number of parenthesized subexpressions. - value: pointer # For internal use only. - - TRegEx* = ref TRegExDesc ## a compiled regular expression - EInvalidRegEx* = object of EInvalidValue - ## is raised if the pattern is no valid regular expression. - - TRegMatch {.pure.} = object - so, eo: cint - -const - MaxSubpatterns* = 10 - ## defines the maximum number of subpatterns that can be captured. - ## More subpatterns cannot be captured! - -proc regnexec(preg: ptr TRegExDesc, s: cstring, len, nmatch: int, - pmatch: ptr array [0..maxSubpatterns-1, TRegMatch], - eflags: cint): cint {.importc.} -proc regncomp(preg: ptr TRegExDesc, regex: cstring, n: int, - cflags: cint): cint {.importc.} -proc regfree(preg: ptr TRegExDesc) {.importc.} - -const - # POSIX regcomp() flags - REG_EXTENDED = 1 - REG_ICASE = (REG_EXTENDED shl 1) - REG_NEWLINE = (REG_ICASE shl 1) - REG_NOSUB = (REG_NEWLINE shl 1) - # Extra regcomp() flags - REG_BASIC = 0 - REG_LITERAL = (REG_NOSUB shl 1) - REG_RIGHT_ASSOC = (REG_LITERAL shl 1) - REG_UNGREEDY = (REG_RIGHT_ASSOC shl 1) - - # POSIX regexec() flags - REG_NOTBOL = 1 - REG_NOTEOL = (REG_NOTBOL shl 1) - - # Extra regexec() flags - REG_APPROX_MATCHER = (REG_NOTEOL shl 1) - REG_BACKTRACKING_MATCHER = (REG_APPROX_MATCHER shl 1) - - ErrorMessages = [ - "No error", - "No match", - "Invalid regexp", - "Unknown collating element", - "Unknown character class name", - "Trailing backslash", - "Invalid back reference", - "Missing ']'", - "Missing ')'", - "Missing '}'", - "Invalid contents of {}", - "Invalid character range", - "Out of memory", - "Invalid use of repetition operators" - ] - -proc finalizeRegEx(x: TRegEx) = regfree(addr(x^)) - -proc re*(s: string): TRegEx = - ## Constructor of regular expressions. Note that Nimrod's - ## extended raw string literals supports this syntax ``re"[abc]"`` as - ## a short form for ``re(r"[abc]")``. - new(result, finalizeRegEx) - var err = int(regncomp(addr(result^), s, s.len, - cint(REG_EXTENDED or REG_NEWLINE))) - if err != 0: - var e: ref EInvalidRegEx - new(e) - e.msg = ErrorMessages[err] - raise e - -proc xre*(pattern: string): TRegEx = - ## deletes whitespace from a pattern that is not escaped or in a character - ## class. Then it constructs a regular expresion object via `re`. - ## This is modelled after Perl's ``/x`` modifier. - var p = "" - var i = 0 - while i < pattern.len: - case pattern[i] - of ' ', '\t': - inc i - of '\\': - add p, '\\' - add p, pattern[i+1] - inc i, 2 - of '[': - while pattern[i] != ']' and pattern[i] != '\0': - add p, pattern[i] - inc i - else: - add p, pattern[i] - inc i - result = re(p) - -proc rawmatch(s: string, pattern: TRegEx, matches: var openarray[string], - start: int): tuple[first, last: int] = - var - rawMatches: array [0..maxSubpatterns-1, TRegMatch] - cs = cstring(s) - res = int(regnexec(addr(pattern^), cast[cstring](addr(cs[start])), - s.len-start, maxSubpatterns, addr(rawMatches), cint(0))) - if res == 0: - for i in 0..min(matches.len, int(pattern.re_nsub))-1: - var a = int(rawMatches[i].so) - var b = int(rawMatches[i].eo) - echo "a: ", a, " b: ", b - if a >= 0 and b >= 0: - matches[i] = copy(s, a+start, b - 1 + start) - else: - matches[i] = "" - return (int(rawMatches[0].so), int(rawMatches[0].eo)-1) - return (-1, -1) - -proc match*(s: string, pattern: TRegEx, matches: var openarray[string], - start = 0): bool = - ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and - ## the captured substrings in the array ``matches``. If it does not - ## match, nothing is written into ``matches`` and ``false`` is - ## returned. - result = rawmatch(s, pattern, matches, start).first == 0 - -proc match*(s: string, pattern: TRegEx, start: int = 0): bool = - ## returns ``true`` if ``s`` matches the ``pattern`` beginning - ## from ``start``. - var matches: array [0..0, string] - result = rawmatch(s, pattern, matches, start).first == 0 - -proc matchLen*(s: string, pattern: TRegEx, matches: var openarray[string], - start = 0): int = - ## the same as ``match``, but it returns the length of the match, - ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. - var (a, b) = rawmatch(s, pattern, matches, start) - result = a - b + 1 - -proc matchLen*(s: string, pattern: TRegEx, start = 0): int = - ## the same as ``match``, but it returns the length of the match, - ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. - var matches: array [0..0, string] - var (a, b) = rawmatch(s, pattern, matches, start) - result = a - b + 1 - -proc find*(s: string, pattern: TRegEx, matches: var openarray[string], - start = 0): int = - ## returns ``true`` if ``pattern`` occurs in ``s`` and the captured - ## substrings in the array ``matches``. If it does not match, nothing - ## is written into ``matches``. - result = rawmatch(s, pattern, matches, start).first - if result >= 0: inc(result, start) - -proc find*(s: string, pattern: TRegEx, start = 0): int = - ## returns ``true`` if ``pattern`` occurs in ``s``. - var matches: array [0..0, string] - result = rawmatch(s, pattern, matches, start).first - if result >= 0: inc(result, start) - -template `=~`*(s: string, pattern: TRegEx): expr = - ## This calls ``match`` with an implicit declared ``matches`` array that - ## can be used in the scope of the ``=~`` call: - ## - ## .. code-block:: nimrod - ## - ## if line =~ r"\s*(\w+)\s*\=\s*(\w+)": - ## # matches a key=value pair: - ## echo("Key: ", matches[1]) - ## echo("Value: ", matches[2]) - ## elif line =~ r"\s*(\#.*)": - ## # matches a comment - ## # note that the implicit ``matches`` array is different from the - ## # ``matches`` array of the first branch - ## echo("comment: ", matches[1]) - ## else: - ## echo("syntax error") - ## - when not definedInScope(matches): - var matches: array[0..maxSubPatterns-1, string] - match(s, pattern, matches) - -# ------------------------- more string handling ------------------------------ - -proc contains*(s: string, pattern: TRegEx, start = 0): bool = - ## same as ``find(s, pattern, start) >= 0`` - return find(s, pattern, start) >= 0 - -proc contains*(s: string, pattern: TRegEx, matches: var openArray[string], - start = 0): bool = - ## same as ``find(s, pattern, matches, start) >= 0`` - return find(s, pattern, matches, start) >= 0 - -proc startsWith*(s: string, prefix: TRegEx): bool = - ## returns true if `s` starts with the pattern `prefix` - result = matchLen(s, prefix) >= 0 - -proc endsWith*(s: string, suffix: TRegEx): bool = - ## returns true if `s` ends with the pattern `prefix` - for i in 0 .. s.len-1: - if matchLen(s, suffix, i) == s.len - i: return true - -proc replace*(s: string, sub: TRegEx, by: string): string = - ## Replaces `sub` in `s` by the string `by`. Captures can be accessed in `by` - ## with the notation ``$i`` and ``$#`` (see strutils.`%`). Examples: - ## - ## .. code-block:: nimrod - ## "var1=key; var2=key2".replace(re"(\w+)'='(\w+)", "$1<-$2$2") - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## - ## "var1<-keykey; val2<-key2key2" - result = "" - var i = 0 - var caps: array[0..maxSubpatterns-1, string] - while i < s.len: - var x = matchLen(s, sub, caps, i) - if x <= 0: - add(result, s[i]) - inc(i) - else: - addf(result, by, caps) - inc(i, x) - # copy the rest: - add(result, copy(s, i)) - -proc parallelReplace*(s: string, subs: openArray[ - tuple[pattern: TRegEx, repl: string]]): string = - ## Returns a modified copy of `s` with the substitutions in `subs` - ## applied in parallel. - result = "" - var i = 0 - var caps: array[0..maxSubpatterns-1, string] - while i < s.len: - block searchSubs: - for j in 0..high(subs): - var x = matchLen(s, subs[j][0], caps, i) - if x > 0: - addf(result, subs[j][1], caps) - inc(i, x) - break searchSubs - add(result, s[i]) - inc(i) - # copy the rest: - add(result, copy(s, i)) - -proc transformFile*(infile, outfile: string, - subs: openArray[tuple[pattern: TRegEx, repl: string]]) = - ## reads in the file `infile`, performs a parallel replacement (calls - ## `parallelReplace`) and writes back to `outfile`. Calls ``quit`` if an - ## error occurs. This is supposed to be used for quick scripting. - var x = readFile(infile) - if not isNil(x): - var f: TFile - if open(f, outfile, fmWrite): - write(f, x.parallelReplace(subs)) - close(f) - else: - quit("cannot open for writing: " & outfile) - else: - quit("cannot open for reading: " & infile) - -iterator split*(s: string, sep: TRegEx): string = - ## Splits the string `s` into substrings. - ## - ## Substrings are separated by the regular expression `sep`. - ## Examples: - ## - ## .. code-block:: nimrod - ## for word in split("00232this02939is39an22example111", re"\d+"): - ## writeln(stdout, word) - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "this" - ## "is" - ## "an" - ## "example" - ## - var - first = 0 - last = 0 - while last < len(s): - var x = matchLen(s, sep, last) - if x > 0: inc(last, x) - first = last - while last < len(s): - inc(last) - x = matchLen(s, sep, last) - if x > 0: break - if first < last: - yield copy(s, first, last-1) - -proc split*(s: string, sep: TRegEx): seq[string] = - ## Splits the string `s` into substrings. - accumulateResult(split(s, sep)) - -const ## common regular expressions - reIdentifier* = r"\b[a-zA-Z_]+[a-zA-Z_0-9]*\b" ## describes an identifier - reNatural* = r"\b\d+\b" ## describes a natural number - reInteger* = r"\b[-+]?\d+\b" ## describes an integer - reHex* = r"\b0[xX][0-9a-fA-F]+\b" ## describes a hexadecimal number - reBinary* = r"\b0[bB][01]+\b" ## describes a binary number (example: 0b11101) - reOctal* = r"\b0[oO][0-7]+\b" ## describes an octal number (example: 0o777) - reFloat* = r"\b[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?\b" - ## describes a floating point number - reEmail* = r"\b[a-zA-Z0-9!#$%&'*+/=?^_`{|}~\-]+(?:\. &" & - r"[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)" & - r"*@(?:[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?\.)+" & - r"(?:[a-zA-Z]{2}|com|org|" & - r"net|gov|mil|biz|info|mobi|name|aero|jobs|museum)\b" - ## describes a common email address - reURL* = r"\b(http(s)?|ftp|gopher|telnet|file|notes|ms\-help):" & - r"((//)|(\\\\))+[\w\d:#@%/;$()~_?\+\-\=\\\.\&]*\b" - ## describes an URL - -when isMainModule: - echo matchLen("key", re"[a-zA-Z_][a-zA-Z_0-9]*") - - var pattern = re"[a-zA-Z_][a-zA-Z_0-9]*\s*=\s*[a-zA-Z_][a-zA-Z_0-9]*" - echo matchLen("key1= cal9", pattern, 2) - - echo find("_____abc_______", re("abc"), 3) - #echo "var1=key; var2=key2".replace(peg"{\ident}'='{\ident}", "$1<-$2$2") - #echo "var1=key; var2=key2".endsWith(peg"{\ident}'='{\ident}") - - if "abc" =~ re"(a)bc xyz|([a-z]+)": - echo matches[0] - else: - echo "BUG" - -# for word in split("00232this02939is39an22example111", peg"\d+"): -# writeln(stdout, word) diff --git a/nimlib/pure/regexprs.nim b/nimlib/pure/regexprs.nim deleted file mode 100755 index cff3152cf7..0000000000 --- a/nimlib/pure/regexprs.nim +++ /dev/null @@ -1,177 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Regular expression support for Nimrod. -## Currently this module is implemented by providing a wrapper around the -## `PRCE (Perl-Compatible Regular Expressions) `_ -## C library. This means that your application will depend on the PRCE -## library's licence when using this module, which should not be a problem -## though. -## PRCE's licence follows: -## -## .. include:: ../doc/regexprs.txt -## - -# This is not just a convenient wrapper for the pcre library; the -# API will stay the same if the implementation should change. - -import - pcre, strutils - -type - EInvalidRegEx* = object of EInvalidValue - ## is raised if the pattern is no valid regular expression. - -const - MaxSubpatterns* = 10 - ## defines the maximum number of subpatterns that can be captured. - ## More subpatterns cannot be captured! - -proc match*(s, pattern: string, matches: var openarray[string], - start: int = 0): bool - ## returns ``true`` if ``s[start..]`` matches the ``pattern`` and - ## the captured substrings in the array ``matches``. If it does not - ## match, nothing is written into ``matches`` and ``false`` is - ## returned. - -proc match*(s, pattern: string, start: int = 0): bool - ## returns ``true`` if ``s`` matches the ``pattern`` beginning from ``start``. - -proc matchLen*(s, pattern: string, matches: var openarray[string], - start: int = 0): int - ## the same as ``match``, but it returns the length of the match, - ## if there is no match, -1 is returned. Note that a match length - ## of zero can happen. - -proc find*(s, pattern: string, matches: var openarray[string], - start: int = 0): bool - ## returns ``true`` if ``pattern`` occurs in ``s`` and the captured - ## substrings in the array ``matches``. If it does not match, nothing - ## is written into ``matches``. - -proc find*(s, pattern: string, start: int = 0): bool - ## returns ``true`` if ``pattern`` occurs in ``s``. - -proc rawCompile(pattern: string, flags: cint): PPcre = - var - msg: CString - offset: int - com = pcreCompile(pattern, flags, addr(msg), addr(offset), nil) - if com == nil: - var e: ref EInvalidRegEx - new(e) - e.msg = $msg & "\n" & pattern & "\n" & repeatChar(offset) & "^\n" - raise e - return com - -proc matchOrFind(s: string, pattern: PPcre, matches: var openarray[string], - start: cint): cint = - var - rawMatches: array [0..maxSubpatterns * 3 - 1, cint] - res = int(pcreExec(pattern, nil, s, len(s), start, 0, - cast[ptr cint](addr(rawMatches)), maxSubpatterns * 3)) - dealloc(pattern) - if res < 0: return res - for i in 0..res-1: - var - a = rawMatches[i * 2] - b = rawMatches[i * 2 + 1] - if a >= 0'i32: matches[i] = copy(s, a, int(b)-1) - else: matches[i] = "" - return res - -proc matchOrFind(s: string, pattern: PPcre, start: cint): cint = - var - rawMatches: array [0..maxSubpatterns * 3 - 1, cint] - res = pcreExec(pattern, nil, s, len(s), start, 0, - cast[ptr cint](addr(rawMatches)), maxSubpatterns * 3) - dealloc(pattern) - return res - -proc match(s, pattern: string, matches: var openarray[string], - start: int = 0): bool = - return matchOrFind(s, rawCompile(pattern, PCRE_ANCHORED), - matches, start) >= 0'i32 - -proc matchLen(s, pattern: string, matches: var openarray[string], - start: int = 0): int = - return matchOrFind(s, rawCompile(pattern, PCRE_ANCHORED), matches, start) - -proc find(s, pattern: string, matches: var openarray[string], - start: int = 0): bool = - return matchOrFind(s, rawCompile(pattern, PCRE_MULTILINE), - matches, start) >= 0'i32 - -proc match(s, pattern: string, start: int = 0): bool = - return matchOrFind(s, rawCompile(pattern, PCRE_ANCHORED), start) >= 0'i32 - -proc find(s, pattern: string, start: int = 0): bool = - return matchOrFind(s, rawCompile(pattern, PCRE_MULTILINE), start) >= 0'i32 - -template `=~` *(s, pattern: expr): expr = - ## This calls ``match`` with an implicit declared ``matches`` array that - ## can be used in the scope of the ``=~`` call: - ## - ## .. code-block:: nimrod - ## - ## if line =~ r"\s*(\w+)\s*\=\s*(\w+)": - ## # matches a key=value pair: - ## echo("Key: ", matches[1]) - ## echo("Value: ", matches[2]) - ## elif line =~ r"\s*(\#.*)": - ## # matches a comment - ## # note that the implicit ``matches`` array is different from the - ## # ``matches`` array of the first branch - ## echo("comment: ", matches[1]) - ## else: - ## echo("syntax error") - ## - when not definedInScope(matches): - var matches: array[0..maxSubPatterns-1, string] - match(s, pattern, matches) - - -const ## common regular expressions - reIdentifier* = r"\b[a-zA-Z_][a-zA-Z_0-9]*\b" ## describes an identifier - reNatural* = r"\b\d+\b" ## describes a natural number - reInteger* = r"\b[-+]?\d+\b" ## describes an integer - reHex* = r"\b0[xX][0-9a-fA-F]+\b" ## describes a hexadecimal number - reBinary* = r"\b0[bB][01]+\b" ## describes a binary number (example: 0b11101) - reOctal* = r"\b0[oO][0-7]+\b" ## describes an octal number (example: 0o777) - reFloat* = r"\b[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?\b" - ## describes a floating point number - reEmail* = r"\b[a-zA-Z0-9!#$%&'*+/=?^_`{|}~\-]+(?:\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)" & - r"*@(?:[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?\.)+(?:[a-zA-Z]{2}|com|org|" & - r"net|gov|mil|biz|info|mobi|name|aero|jobs|museum)\b" - ## describes a common email address - reURL* = r"\b(http(s)?|ftp|gopher|telnet|file|notes|ms\-help):" & - r"((//)|(\\\\))+[\w\d:#@%/;$()~_?\+\-\=\\\.\&]*\b" - ## describes an URL - -proc verbose*(pattern: string): string {.noSideEffect.} = - ## deletes whitespace from a pattern that is not escaped or in a character - ## class. This is modelled after Perl's ``/x`` modifier. - result = "" - var i = 0 - while i < pattern.len: - case pattern[i] - of ' ', '\t': - inc i - of '\\': - add result, '\\' - add result, pattern[i+1] - inc i, 2 - of '[': - while pattern[i] != ']' and pattern[i] != '\0': - add result, pattern[i] - inc i - else: - add result, pattern[i] - inc i - diff --git a/nimlib/pure/streams.nim b/nimlib/pure/streams.nim deleted file mode 100755 index f4d2911fc4..0000000000 --- a/nimlib/pure/streams.nim +++ /dev/null @@ -1,245 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module provides a stream interface and two implementations thereof: -## the `PFileStream` and the `PStringStream` which implement the stream -## interface for Nimrod file objects (`TFile`) and strings. Other modules -## may provide other implementations for this standard stream interface. - -proc newEIO(msg: string): ref EIO = - new(result) - result.msg = msg - -type - PStream* = ref TStream - TStream* = object of TObject ## Stream interface that supports - ## writing or reading. - close*: proc (s: PStream) - atEnd*: proc (s: PStream): bool - setPosition*: proc (s: PStream, pos: int) - getPosition*: proc (s: PStream): int - readData*: proc (s: PStream, buffer: pointer, bufLen: int): int - writeData*: proc (s: PStream, buffer: pointer, bufLen: int) - -proc write*[T](s: PStream, x: T) = - ## generic write procedure. Writes `x` to the stream `s`. Implementation: - ## - ## .. code-block:: Nimrod - ## - ## s.writeData(s, addr(x), sizeof(x)) - var x = x - s.writeData(s, addr(x), sizeof(x)) - -proc write*(s: PStream, x: string) = - ## writes the string `x` to the the stream `s`. No length field or - ## terminating zero is written. - s.writeData(s, cstring(x), x.len) - -proc read[T](s: PStream, result: var T) = - ## generic read procedure. Reads `result` from the stream `s`. - if s.readData(s, addr(result), sizeof(T)) != sizeof(T): - raise newEIO("cannot read from stream") - -proc readChar*(s: PStream): char = - ## reads a char from the stream `s`. Raises `EIO` if an error occured. - ## Returns '\0' as an EOF marker. - discard s.readData(s, addr(result), sizeof(result)) - -proc readBool*(s: PStream): bool = - ## reads a bool from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readInt8*(s: PStream): int8 = - ## reads an int8 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readInt16*(s: PStream): int16 = - ## reads an int16 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readInt32*(s: PStream): int32 = - ## reads an int32 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readInt64*(s: PStream): int64 = - ## reads an int64 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readFloat32*(s: PStream): float32 = - ## reads a float32 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readFloat64*(s: PStream): float64 = - ## reads a float64 from the stream `s`. Raises `EIO` if an error occured. - read(s, result) - -proc readStr*(s: PStream, length: int): string = - ## reads a string of length `length` from the stream `s`. Raises `EIO` if - ## an error occured. - result = newString(length) - var L = s.readData(s, addr(result[0]), length) - if L != length: setLen(result, L) - -proc readLine*(s: PStream): string = - ## Reads a line from a stream `s`. Note: This is not very efficient. Raises - ## `EIO` if an error occured. - result = "" - while not s.atEnd(s): - var c = readChar(s) - if c == '\c': - c = readChar(s) - break - elif c == '\L' or c == '\0': break - result.add(c) - -type - PStringStream* = ref TStringStream ## a stream that encapsulates a string - TStringStream* = object of TStream - data*: string - pos: int - -proc ssAtEnd(s: PStringStream): bool = - return s.pos >= s.data.len - -proc ssSetPosition(s: PStringStream, pos: int) = - s.pos = min(pos, s.data.len-1) - -proc ssGetPosition(s: PStringStream): int = - return s.pos - -proc ssReadData(s: PStringStream, buffer: pointer, bufLen: int): int = - result = min(bufLen, s.data.len - s.pos) - if result > 0: - copyMem(buffer, addr(s.data[s.pos]), result) - inc(s.pos, result) - -proc ssWriteData(s: PStringStream, buffer: pointer, bufLen: int) = - if bufLen > 0: - setLen(s.data, s.data.len + bufLen) - copyMem(addr(s.data[s.pos]), buffer, bufLen) - inc(s.pos, bufLen) - -proc ssClose(s: PStringStream) = - s.data = nil - -proc newStringStream*(s: string = ""): PStringStream = - ## creates a new stream from the string `s`. - new(result) - result.data = s - result.pos = 0 - result.close = ssClose - result.atEnd = ssAtEnd - result.setPosition = ssSetPosition - result.getPosition = ssGetPosition - result.readData = ssReadData - result.writeData = ssWriteData - -type - PFileStream* = ref TFileStream ## a stream that encapsulates a `TFile` - TFileStream* = object of TStream - f: TFile - -proc fsClose(s: PFileStream) = close(s.f) -proc fsAtEnd(s: PFileStream): bool = return EndOfFile(s.f) -proc fsSetPosition(s: PFileStream, pos: int) = setFilePos(s.f, pos) -proc fsGetPosition(s: PFileStream): int = return int(getFilePos(s.f)) - -proc fsReadData(s: PFileStream, buffer: pointer, bufLen: int): int = - result = readBuffer(s.f, buffer, bufLen) - -proc fsWriteData(s: PFileStream, buffer: pointer, bufLen: int) = - if writeBuffer(s.f, buffer, bufLen) != bufLen: - raise newEIO("cannot write to stream") - -proc newFileStream*(f: TFile): PFileStream = - ## creates a new stream from the file `f`. - new(result) - result.f = f - result.close = fsClose - result.atEnd = fsAtEnd - result.setPosition = fsSetPosition - result.getPosition = fsGetPosition - result.readData = fsReadData - result.writeData = fsWriteData - -proc newFileStream*(filename: string, mode: TFileMode): PFileStream = - ## creates a new stream from the file named `filename` with the mode `mode`. - ## If the file cannot be opened, nil is returned. - var f: TFile - if Open(f, filename, mode): result = newFileStream(f) - - -when true: - nil -else: - type - TFileHandle* = cint ## Operating system file handle - PFileHandleStream* = ref TFileHandleStream - TFileHandleStream* = object of TStream - handle*: TFileHandle - pos: int - - proc newEOS(msg: string): ref EOS = - new(result) - result.msg = msg - - proc hsGetPosition(s: PFileHandleStream): int = - return s.pos - - when defined(windows): - # do not import windows as this increases compile times: - nil - else: - import posix - - proc hsSetPosition(s: PFileHandleStream, pos: int) = - discard lseek(s.handle, pos, SEEK_SET) - - proc hsClose(s: PFileHandleStream) = discard close(s.handle) - proc hsAtEnd(s: PFileHandleStream): bool = - var pos = hsGetPosition(s) - var theEnd = lseek(s.handle, 0, SEEK_END) - result = pos >= theEnd - hsSetPosition(s, pos) # set position back - - proc hsReadData(s: PFileHandleStream, buffer: pointer, bufLen: int): int = - result = posix.read(s.handle, buffer, bufLen) - inc(s.pos, result) - - proc hsWriteData(s: PFileHandleStream, buffer: pointer, bufLen: int) = - if posix.write(s.handle, buffer, bufLen) != bufLen: - raise newEIO("cannot write to stream") - inc(s.pos, bufLen) - - proc newFileHandleStream*(handle: TFileHandle): PFileHandleStream = - new(result) - result.handle = handle - result.pos = 0 - result.close = hsClose - result.atEnd = hsAtEnd - result.setPosition = hsSetPosition - result.getPosition = hsGetPosition - result.readData = hsReadData - result.writeData = hsWriteData - - proc newFileHandleStream*(filename: string, - mode: TFileMode): PFileHandleStream = - when defined(windows): - nil - else: - var flags: cint - case mode - of fmRead: flags = posix.O_RDONLY - of fmWrite: flags = O_WRONLY or int(O_CREAT) - of fmReadWrite: flags = O_RDWR or int(O_CREAT) - of fmReadWriteExisting: flags = O_RDWR - of fmAppend: flags = O_WRONLY or int(O_CREAT) or O_APPEND - var handle = open(filename, flags) - if handle < 0: raise newEOS("posix.open() call failed") - result = newFileHandleStream(handle) diff --git a/nimlib/pure/strtabs.nim b/nimlib/pure/strtabs.nim deleted file mode 100755 index 10cd0b9331..0000000000 --- a/nimlib/pure/strtabs.nim +++ /dev/null @@ -1,198 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## The ``strtabs`` module implements an efficient hash table that is a mapping -## from strings to strings. Supports a case-sensitive, case-insensitive and -## style-insensitive mode. An efficient string substitution operator ``%`` -## for the string table is also provided. - -import - os, hashes, strutils - -type - TStringTableMode* = enum ## describes the tables operation mode - modeCaseSensitive, ## the table is case sensitive - modeCaseInsensitive, ## the table is case insensitive - modeStyleInsensitive ## the table is style insensitive - TKeyValuePair = tuple[key, val: string] - TKeyValuePairSeq = seq[TKeyValuePair] - TStringTable* = object of TObject - counter: int - data: TKeyValuePairSeq - mode: TStringTableMode - - PStringTable* = ref TStringTable ## use this type to declare string tables - -proc newStringTable*(keyValuePairs: openarray[string], - mode: TStringTableMode = modeCaseSensitive): PStringTable - ## creates a new string table with given key value pairs. - ## Example:: - ## var mytab = newStringTable("key1", "val1", "key2", "val2", - ## modeCaseInsensitive) - -proc newStringTable*(mode: TStringTableMode = modeCaseSensitive): PStringTable - ## creates a new string table that is empty. - -proc `[]=`*(t: PStringTable, key, val: string) - ## puts a (key, value)-pair into `t`. - -proc `[]`*(t: PStringTable, key: string): string - ## retrieves the value at ``t[key]``. If `key` is not in `t`, "" is returned - ## and no exception is raised. One can check with ``hasKey`` whether the key - ## exists. - -proc hasKey*(t: PStringTable, key: string): bool - ## returns true iff `key` is in the table `t`. - -proc len*(t: PStringTable): int = - ## returns the number of keys in `t`. - result = t.counter - -iterator pairs*(t: PStringTable): tuple[key, value: string] = - ## iterates over any (key, value) pair in the table `t`. - for h in 0..high(t.data): - if not isNil(t.data[h].key): - yield (t.data[h].key, t.data[h].val) - -type - TFormatFlag* = enum ## flags for the `%` operator - useEnvironment, ## use environment variable if the ``$key`` - ## is not found in the table - useEmpty, ## use the empty string as a default, thus it - ## won't throw an exception if ``$key`` is not - ## in the table - useKey ## do not replace ``$key`` if it is not found - ## in the table (or in the environment) - -proc `%`*(f: string, t: PStringTable, flags: set[TFormatFlag] = {}): string - ## The `%` operator for string tables. - -# implementation - -const - growthFactor = 2 - startSize = 64 - -proc newStringTable(mode: TStringTableMode = modeCaseSensitive): PStringTable = - new(result) - result.mode = mode - result.counter = 0 - newSeq(result.data, startSize) - -proc newStringTable(keyValuePairs: openarray[string], - mode: TStringTableMode = modeCaseSensitive): PStringTable = - result = newStringTable(mode) - var i = 0 - while i < high(keyValuePairs): - result[keyValuePairs[i]] = keyValuePairs[i + 1] - inc(i, 2) - -proc myhash(t: PStringTable, key: string): THash = - case t.mode - of modeCaseSensitive: result = hashes.hash(key) - of modeCaseInsensitive: result = hashes.hashIgnoreCase(key) - of modeStyleInsensitive: result = hashes.hashIgnoreStyle(key) - -proc myCmp(t: PStringTable, a, b: string): bool = - case t.mode - of modeCaseSensitive: result = cmp(a, b) == 0 - of modeCaseInsensitive: result = cmpIgnoreCase(a, b) == 0 - of modeStyleInsensitive: result = cmpIgnoreStyle(a, b) == 0 - -proc mustRehash(length, counter: int): bool = - assert(length > counter) - result = (length * 2 < counter * 3) or (length - counter < 4) - -proc nextTry(h, maxHash: THash): THash = - result = ((5 * h) + 1) and maxHash - -proc RawGet(t: PStringTable, key: string): int = - var h: THash - h = myhash(t, key) and high(t.data) # start with real hash value - while not isNil(t.data[h].key): - if mycmp(t, t.data[h].key, key): - return h - h = nextTry(h, high(t.data)) - result = - 1 - -proc `[]`(t: PStringTable, key: string): string = - var index: int - index = RawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = "" - -proc hasKey(t: PStringTable, key: string): bool = - result = rawGet(t, key) >= 0 - -proc RawInsert(t: PStringTable, data: var TKeyValuePairSeq, key, val: string) = - var h: THash - h = myhash(t, key) and high(data) - while not isNil(data[h].key): - h = nextTry(h, high(data)) - data[h].key = key - data[h].val = val - -proc Enlarge(t: PStringTable) = - var n: TKeyValuePairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if not isNil(t.data[i].key): RawInsert(t, n, t.data[i].key, t.data[i].val) - swap(t.data, n) - -proc `[]=`(t: PStringTable, key, val: string) = - var index = RawGet(t, key) - if index >= 0: - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): Enlarge(t) - RawInsert(t, t.data, key, val) - inc(t.counter) - -proc RaiseFormatException(s: string) = - var e: ref EInvalidValue - new(e) - e.msg = "format string: key not found: " & s - raise e - -proc getValue(t: PStringTable, flags: set[TFormatFlag], key: string): string = - if hasKey(t, key): return t[key] - if useEnvironment in flags: result = os.getEnv(key) - else: result = "" - if result.len == 0: - if useKey in flags: result = '$' & key - elif not (useEmpty in flags): raiseFormatException(key) - -proc `%`(f: string, t: PStringTable, flags: set[TFormatFlag] = {}): string = - const - PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} - result = "" - var i = 0 - while i < len(f): - if f[i] == '$': - case f[i+1] - of '$': - add(result, '$') - inc(i, 2) - of '{': - var j = i + 1 - while j < f.len and f[j] != '}': inc(j) - add(result, getValue(t, flags, copy(f, i+2, j-1))) - i = j + 1 - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF', '_': - var j = i + 1 - while j < f.len and f[j] in PatternChars: inc(j) - add(result, getValue(t, flags, copy(f, i+1, j-1))) - i = j - else: - add(result, f[i]) - inc(i) - else: - add(result, f[i]) - inc(i) - diff --git a/nimlib/pure/strutils.nim b/nimlib/pure/strutils.nim deleted file mode 100755 index d7fd69f614..0000000000 --- a/nimlib/pure/strutils.nim +++ /dev/null @@ -1,973 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module contains various string utility routines. -## See the module `regexprs` for regular expression support. - -{.deadCodeElim: on.} - -{.push debugger:off .} # the user does not want to trace a part - # of the standard library! - -# copied from excpt.nim, because I don't want to make this template public -template newException(exceptn, message: expr): expr = - block: # open a new scope - var - e: ref exceptn - new(e) - e.msg = message - e - - -type - TCharSet* = set[char] # for compatibility with Nim - -const - Whitespace* = {' ', '\t', '\v', '\r', '\l', '\f'} - ## All the characters that count as whitespace. - - Letters* = {'A'..'Z', 'a'..'z'} - ## the set of letters - - Digits* = {'0'..'9'} - ## the set of digits - - IdentChars* = {'a'..'z', 'A'..'Z', '0'..'9', '_'} - ## the set of characters an identifier can consist of - - IdentStartChars* = {'a'..'z', 'A'..'Z', '_'} - ## the set of characters an identifier can start with - -proc `%` *(formatstr: string, a: openarray[string]): string {.noSideEffect.} - ## The `substitution`:idx: operator performs string substitutions in - ## `formatstr` and returns a modified `formatstr`. This is often called - ## `string interpolation`:idx:. - ## - ## This is best explained by an example: - ## - ## .. code-block:: nimrod - ## "$1 eats $2." % ["The cat", "fish"] - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "The cat eats fish." - ## - ## The substitution variables (the thing after the ``$``) are enumerated - ## from 1 to ``a.len``. - ## The notation ``$#`` can be used to refer to the next substitution variable: - ## - ## .. code-block:: nimrod - ## "$# eats $#." % ["The cat", "fish"] - ## - ## Substitution variables can also be words (that is - ## ``[A-Za-z_]+[A-Za-z0-9_]*``) in which case the arguments in `a` with even - ## indices are keys and with odd indices are the corresponding values. - ## An example: - ## - ## .. code-block:: nimrod - ## "$animal eats $food." % ["animal", "The cat", "food", "fish"] - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "The cat eats fish." - ## - ## The variables are compared with `cmpIgnoreStyle`. `EInvalidValue` is - ## raised if an ill-formed format string has been passed to the `%` operator. - -proc `%` *(formatstr, a: string): string {.noSideEffect.} - ## This is the same as ``formatstr % [a]``. - -proc addf*(s: var string, formatstr: string, a: openarray[string]) - ## The same as ``add(s, formatstr % a)``, but more efficient. - -proc strip*(s: string, leading = true, trailing = true): string {.noSideEffect.} - ## Strips whitespace from `s` and returns the resulting string. - ## If `leading` is true, leading whitespace is stripped. - ## If `trailing` is true, trailing whitespace is stripped. - -proc toLower*(s: string): string {.noSideEffect, procvar.} - ## Converts `s` into lower case. This works only for the letters A-Z. - ## See `unicode.toLower` for a version that works for any Unicode character. - -proc toLower*(c: Char): Char {.noSideEffect, procvar.} - ## Converts `c` into lower case. This works only for the letters A-Z. - ## See `unicode.toLower` for a version that works for any Unicode character. - -proc toUpper*(s: string): string {.noSideEffect, procvar.} - ## Converts `s` into upper case. This works only for the letters a-z. - ## See `unicode.toUpper` for a version that works for any Unicode character. - -proc toUpper*(c: Char): Char {.noSideEffect, procvar.} - ## Converts `c` into upper case. This works only for the letters a-z. - ## See `unicode.toUpper` for a version that works for any Unicode character. - -proc capitalize*(s: string): string {.noSideEffect, procvar.} - ## Converts the first character of `s` into upper case. - ## This works only for the letters a-z. - -proc normalize*(s: string): string {.noSideEffect, procvar.} - ## Normalizes the string `s`. That means to convert it to lower case and - ## remove any '_'. This is needed for Nimrod identifiers for example. - -proc find*(s, sub: string, start: int = 0): int {.noSideEffect.} - ## Searches for `sub` in `s` starting at position `start`. Searching is - ## case-sensitive. If `sub` is not in `s`, -1 is returned. - -proc find*(s: string, sub: char, start: int = 0): int {.noSideEffect.} - ## Searches for `sub` in `s` starting at position `start`. Searching is - ## case-sensitive. If `sub` is not in `s`, -1 is returned. - -proc find*(s: string, chars: set[char], start: int = 0): int {.noSideEffect.} - ## Searches for `chars` in `s` starting at position `start`. If `s` contains - ## none of the characters in `chars`, -1 is returned. - -proc replaceStr*(s, sub, by: string): string {.noSideEffect, deprecated.} - ## Replaces `sub` in `s` by the string `by`. - ## **Deprecated since version 0.8.0**: Use `replace` instead. - -proc replaceStr*(s: string, sub, by: char): string {.noSideEffect, deprecated.} - ## optimized version for characters. - ## **Deprecated since version 0.8.0**: Use `replace` instead. - -proc deleteStr*(s: var string, first, last: int) {.deprecated.} - ## Deletes in `s` the characters at position `first`..`last`. This modifies - ## `s` itself, it does not return a copy. - ## **Deprecated since version 0.8.0**: Use `delete` instead. - -proc toOctal*(c: char): string - ## Converts a character `c` to its octal representation. The resulting - ## string may not have a leading zero. Its length is always exactly 3. - -iterator split*(s: string, seps: set[char] = Whitespace): string = - ## Splits the string `s` into substrings. - ## - ## Substrings are separated by a substring containing only `seps`. - ## Examples: - ## - ## .. code-block:: nimrod - ## for word in split(" this is an example "): - ## writeln(stdout, word) - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "this" - ## "is" - ## "an" - ## "example" - ## - ## for word in split(";;this;is;an;;example;;;", {';'}): - ## writeln(stdout, word) - ## - ## produces the same output. - var last = 0 - assert(not ('\0' in seps)) - while last < len(s): - while s[last] in seps: inc(last) - var first = last - while last < len(s) and s[last] not_in seps: inc(last) # BUGFIX! - if first <= last-1: - yield copy(s, first, last-1) - -iterator split*(s: string, sep: char): string = - ## Splits the string `s` into substrings. - ## - ## Substrings are separated by the character `sep`. - ## Example: - ## - ## .. code-block:: nimrod - ## for word in split(";;this;is;an;;example;;;", ';'): - ## writeln(stdout, word) - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "" - ## "" - ## "this" - ## "is" - ## "an" - ## "" - ## "example" - ## "" - ## "" - ## "" - ## - var last = 0 - assert('\0' != sep) - if len(s) > 0: - # `<=` is correct here for the edge cases! - while last <= len(s): - var first = last - while last < len(s) and s[last] != sep: inc(last) - yield copy(s, first, last-1) - inc(last) - -iterator splitLines*(s: string): string = - ## Splits the string `s` into its containing lines. Every newline - ## combination (CR, LF, CR-LF) is supported. The result strings contain - ## no trailing ``\n``. - ## - ## Example: - ## - ## .. code-block:: nimrod - ## for line in lines("\nthis\nis\nan\n\nexample\n"): - ## writeln(stdout, line) - ## - ## Results in: - ## - ## .. code-block:: nimrod - ## "" - ## "this" - ## "is" - ## "an" - ## "" - ## "example" - ## "" - var first = 0 - var last = 0 - while true: - while s[last] notin {'\0', '\c', '\l'}: inc(last) - yield copy(s, first, last-1) - # skip newlines: - if s[last] == '\l': inc(last) - elif s[last] == '\c': - inc(last) - if s[last] == '\l': inc(last) - else: break # was '\0' - first = last - -proc splitLinesSeq*(s: string): seq[string] {.noSideEffect, deprecated.} = - ## The same as `splitLines`, but is a proc that returns a sequence - ## of substrings. - ## **Deprecated since version 0.8.0**: Use `splitLines` instead. - accumulateResult(splitLines(s)) - -proc splitSeq*(s: string, seps: set[char] = Whitespace): seq[string] {. - noSideEffect, deprecated.} = - ## The same as `split`, but is a proc that returns a sequence of substrings. - ## **Deprecated since version 0.8.0**: Use `split` instead. - accumulateResult(split(s, seps)) - -proc splitSeq*(s: string, sep: char): seq[string] {.noSideEffect, - deprecated.} = - ## The same as `split`, but is a proc that returns a sequence of substrings. - ## **Deprecated since version 0.8.0**: Use `split` instead. - accumulateResult(split(s, sep)) - -proc splitLines*(s: string): seq[string] {.noSideEffect.} = - ## The same as the `splitLines` iterator, but is a proc that returns a - ## sequence of substrings. - accumulateResult(splitLines(s)) - -proc split*(s: string, seps: set[char] = Whitespace): seq[string] {. - noSideEffect.} = - ## The same as the `split` iterator, but is a proc that returns a - ## sequence of substrings. - accumulateResult(split(s, seps)) - -proc split*(s: string, sep: char): seq[string] {.noSideEffect.} = - ## The same as the `split` iterator, but is a proc that returns a sequence - ## of substrings. - accumulateResult(split(s, sep)) - -proc cmpIgnoreCase*(a, b: string): int {.noSideEffect.} - ## Compares two strings in a case insensitive manner. Returns: - ## - ## | 0 iff a == b - ## | < 0 iff a < b - ## | > 0 iff a > b - -proc cmpIgnoreStyle*(a, b: string): int {.noSideEffect.} - ## Compares two strings normalized (i.e. case and - ## underscores do not matter). Returns: - ## - ## | 0 iff a == b - ## | < 0 iff a < b - ## | > 0 iff a > b - -proc contains*(s: string, c: char): bool {.noSideEffect.} - ## Same as ``find(s, c) >= 0``. - -proc contains*(s, sub: string): bool {.noSideEffect.} - ## Same as ``find(s, sub) >= 0``. - -proc contains*(s: string, chars: set[char]): bool {.noSideEffect.} - ## Same as ``find(s, chars) >= 0``. - -proc toHex*(x: BiggestInt, len: int): string {.noSideEffect.} - ## Converts `x` to its hexadecimal representation. The resulting string - ## will be exactly `len` characters long. No prefix like ``0x`` - ## is generated. `x` is treated as an unsigned value. - -proc intToStr*(x: int, minchars: int = 1): string - ## Converts `x` to its decimal representation. The resulting string - ## will be minimally `minchars` characters long. This is achieved by - ## adding leading zeros. - -proc ParseInt*(s: string): int {.noSideEffect, procvar.} - ## Parses a decimal integer value contained in `s`. If `s` is not - ## a valid integer, `EInvalidValue` is raised. - -proc ParseBiggestInt*(s: string): biggestInt {.noSideEffect, procvar.} - ## Parses a decimal integer value contained in `s`. If `s` is not - ## a valid integer, `EInvalidValue` is raised. - -proc ParseFloat*(s: string): float {.noSideEffect, procvar.} - ## Parses a decimal floating point value contained in `s`. If `s` is not - ## a valid floating point number, `EInvalidValue` is raised. ``NAN``, - ## ``INF``, ``-INF`` are also supported (case insensitive comparison). - -# the stringify and format operators: -proc toString*[Ty](x: Ty): string {.deprecated.} - ## This generic proc is the same as the stringify operator `$`. - ## - ## **Deprecated since version 0.8.2:** Use `$` instead. - -proc repeatChar*(count: int, c: Char = ' '): string - ## Returns a string of length `count` consisting only of - ## the character `c`. - -proc startsWith*(s, prefix: string): bool {.noSideEffect.} - ## Returns true iff ``s`` starts with ``prefix``. - ## If ``prefix == ""`` true is returned. - -proc endsWith*(s, suffix: string): bool {.noSideEffect.} - ## Returns true iff ``s`` ends with ``suffix``. - ## If ``suffix == ""`` true is returned. - -proc addSep*(dest: var string, sep = ", ", startLen = 0) {.noSideEffect, - inline.} = - ## A shorthand for: - ## - ## .. code-block:: nimrod - ## if dest.len > startLen: add(dest, sep) - ## - ## This is often useful for generating some code where the items need to - ## be *separated* by `sep`. `sep` is only added if `dest` is longer than - ## `startLen`. The following example creates a string describing - ## an array of integers: - ## - ## .. code-block:: nimrod - ## var arr = "[" - ## for x in items([2, 3, 5, 7, 11]): - ## addSep(arr, startLen=len("[")) - ## add(arr, $x) - ## add(arr, "]") - if dest.len > startLen: add(dest, sep) - -proc allCharsInSet*(s: string, theSet: TCharSet): bool = - ## returns true iff each character of `s` is in the set `theSet`. - for c in items(s): - if c notin theSet: return false - return true - -proc quoteIfContainsWhite*(s: string): string = - ## returns ``'"' & s & '"'`` if `s` contains a space and does not - ## start with a quote, else returns `s` - if find(s, {' ', '\t'}) >= 0 and s[0] != '"': - result = '"' & s & '"' - else: - result = s - -proc startsWith(s, prefix: string): bool = - var i = 0 - while true: - if prefix[i] == '\0': return true - if s[i] != prefix[i]: return false - inc(i) - -proc endsWith(s, suffix: string): bool = - var - i = 0 - j = len(s) - len(suffix) - while true: - if suffix[i] == '\0': return true - if s[i+j] != suffix[i]: return false - inc(i) - -when false: - proc abbrev(s: string, possibilities: openarray[string]): int = - ## returns the index of the first item in `possibilities` if not - ## ambiguous; -1 if no item has been found; -2 if multiple items - ## match. - result = -1 # none found - for i in 0..possibilities.len-1: - if possibilities[i].startsWith(s): - if result >= 0: return -2 # ambiguous - result = i - -proc repeatChar(count: int, c: Char = ' '): string = - result = newString(count) - for i in 0..count-1: - result[i] = c - -proc intToStr(x: int, minchars: int = 1): string = - result = $abs(x) - for i in 1 .. minchars - len(result): - result = '0' & result - if x < 0: - result = '-' & result - -proc toString[Ty](x: Ty): string = return $x - -proc toOctal(c: char): string = - result = newString(3) - var val = ord(c) - for i in countdown(2, 0): - result[i] = Chr(val mod 8 + ord('0')) - val = val div 8 - -proc `%`(formatstr: string, a: string): string = - return formatstr % [a] - -proc findNormalized(x: string, inArray: openarray[string]): int = - var i = 0 - while i < high(inArray): - if cmpIgnoreStyle(x, inArray[i]) == 0: return i - inc(i, 2) # incrementing by 1 would probably result in a - # security whole ... - return -1 - -proc addf(s: var string, formatstr: string, a: openarray[string]) = - const PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '\128'..'\255', '_'} - var i = 0 - var num = 0 - while i < len(formatstr): - if formatstr[i] == '$': - case formatstr[i+1] # again we use the fact that strings - # are zero-terminated here - of '#': - add s, a[num] - inc i, 2 - inc num - of '$': - add s, '$' - inc(i, 2) - of '1'..'9': - var j = 0 - inc(i) # skip $ - while formatstr[i] in {'0'..'9'}: - j = j * 10 + ord(formatstr[i]) - ord('0') - inc(i) - num = j - add s, a[j - 1] - of '{': - var j = i+1 - while formatstr[j] notin {'\0', '}'}: inc(j) - var x = findNormalized(copy(formatstr, i+2, j-1), a) - if x >= 0 and x < high(a): add s, a[x+1] - else: raise newException(EInvalidValue, "invalid format string") - i = j+1 - of 'a'..'z', 'A'..'Z', '\128'..'\255', '_': - var j = i+1 - while formatstr[j] in PatternChars: inc(j) - var x = findNormalized(copy(formatstr, i+1, j-1), a) - if x >= 0 and x < high(a): add s, a[x+1] - else: raise newException(EInvalidValue, "invalid format string") - i = j - else: raise newException(EInvalidValue, "invalid format string") - else: - add s, formatstr[i] - inc(i) - -proc `%`(formatstr: string, a: openarray[string]): string = - result = "" - addf(result, formatstr, a) - -proc cmpIgnoreCase(a, b: string): int = - # makes usage of the fact that strings are zero-terminated - for i in 0..len(a)-1: - var aa = toLower(a[i]) - var bb = toLower(b[i]) - result = ord(aa) - ord(bb) - if result != 0: break - -{.push checks: off, line_trace: off .} # this is a hot-spot in the compiler! - # thus we compile without checks here - -proc cmpIgnoreStyle(a, b: string): int = - var i = 0 - var j = 0 - while True: - while a[i] == '_': inc(i) - while b[j] == '_': inc(j) # BUGFIX: typo - var aa = toLower(a[i]) - var bb = toLower(b[j]) - result = ord(aa) - ord(bb) - if result != 0 or aa == '\0': break - inc(i) - inc(j) - -{.pop.} - -# --------------------------------------------------------------------------- - -proc join*(a: openArray[string], sep: string): string = - ## concatenates all strings in `a` separating them with `sep`. - if len(a) > 0: - var L = sep.len * (a.len-1) - for i in 0..high(a): inc(L, a[i].len) - result = newString(L) - setLen(result, 0) - add(result, a[0]) - for i in 1..high(a): - add(result, sep) - add(result, a[i]) - else: - result = "" - -proc join*(a: openArray[string]): string = - ## concatenates all strings in `a`. - if len(a) > 0: - var L = 0 - for i in 0..high(a): inc(L, a[i].len) - result = newString(L) - setLen(result, 0) - for i in 0..high(a): add(result, a[i]) - else: - result = "" - -proc strip(s: string, leading = true, trailing = true): string = - const - chars: set[Char] = Whitespace - var - first = 0 - last = len(s)-1 - if leading: - while s[first] in chars: inc(first) - if trailing: - while last >= 0 and s[last] in chars: dec(last) - result = copy(s, first, last) - -proc toLower(c: Char): Char = - if c in {'A'..'Z'}: - result = chr(ord(c) + (ord('a') - ord('A'))) - else: - result = c - -proc toLower(s: string): string = - result = newString(len(s)) - for i in 0..len(s) - 1: - result[i] = toLower(s[i]) - -proc toUpper(c: Char): Char = - if c in {'a'..'z'}: - result = Chr(Ord(c) - (Ord('a') - Ord('A'))) - else: - result = c - -proc toUpper(s: string): string = - result = newString(len(s)) - for i in 0..len(s) - 1: - result[i] = toUpper(s[i]) - -proc capitalize(s: string): string = - result = toUpper(s[0]) & copy(s, 1) - -proc normalize(s: string): string = - result = "" - for i in 0..len(s) - 1: - if s[i] in {'A'..'Z'}: - add result, Chr(Ord(s[i]) + (Ord('a') - Ord('A'))) - elif s[i] != '_': - add result, s[i] - -type - TSkipTable = array[Char, int] - -proc preprocessSub(sub: string, a: var TSkipTable) = - var m = len(sub) - for i in 0..0xff: a[chr(i)] = m+1 - for i in 0..m-1: a[sub[i]] = m-i - -proc findAux(s, sub: string, start: int, a: TSkipTable): int = - # fast "quick search" algorithm: - var - m = len(sub) - n = len(s) - # search: - var j = start - while j <= n - m: - block match: - for k in 0..m-1: - if sub[k] != s[k+j]: break match - return j - inc(j, a[s[j+m]]) - return -1 - -proc find(s, sub: string, start: int = 0): int = - var a: TSkipTable - preprocessSub(sub, a) - result = findAux(s, sub, start, a) - -proc find(s: string, sub: char, start: int = 0): int = - for i in start..len(s)-1: - if sub == s[i]: return i - return -1 - -proc find(s: string, chars: set[char], start: int = 0): int = - for i in start..s.len-1: - if s[i] in chars: return i - return -1 - -proc contains(s: string, chars: set[char]): bool = - return find(s, chars) >= 0 - -proc contains(s: string, c: char): bool = - return find(s, c) >= 0 - -proc contains(s, sub: string): bool = - return find(s, sub) >= 0 - -proc replace*(s, sub, by: string): string = - ## Replaces `sub` in `s` by the string `by`. - var a: TSkipTable - result = "" - preprocessSub(sub, a) - var i = 0 - while true: - var j = findAux(s, sub, i, a) - if j < 0: break - add result, copy(s, i, j - 1) - add result, by - i = j + len(sub) - # copy the rest: - add result, copy(s, i) - -proc replace*(s: string, sub, by: char): string = - ## optimized version for characters. - result = newString(s.len) - var i = 0 - while i < s.len: - if s[i] == sub: result[i] = by - else: result[i] = s[i] - inc(i) - -proc delete*(s: var string, first, last: int) = - ## Deletes in `s` the characters at position `first`..`last`. This modifies - ## `s` itself, it does not return a copy. - var - i = first - # example: "abc___uvwxyz\0" (___ is to be deleted) - # --> first == 3, last == 5 - # s[first..] = s[last+1..] - while last+i+1 < len(s): - s[i] = s[last+i+1] - inc(i) - setlen(s, len(s)-(last-first+1)) - -proc replaceStr(s, sub, by: string): string = return replace(s, sub, by) -proc replaceStr(s: string, sub, by: char): string = return replace(s, sub, by) -proc deleteStr*(s: var string, first, last: int) = delete(s, first, last) - -# parsing numbers: - -proc toHex(x: BiggestInt, len: int): string = - const - HexChars = "0123456789ABCDEF" - var - shift: BiggestInt - result = newString(len) - for j in countdown(len-1, 0): - result[j] = HexChars[toU32(x shr shift) and 0xF'i32] - shift = shift + 4 - -{.push overflowChecks: on.} -# this must be compiled with overflow checking turned on: -proc rawParseInt(s: string, index: var int): BiggestInt = - # index contains the start position at proc entry; end position will be - # an index before the proc returns; index = -1 on error (no number at all) - # the problem here is that integers have an asymmetrical range: there is - # one more valid negative than prositive integer. Thus we perform the - # computation as a negative number and then change the sign at the end. - var - i = index # a local i is more efficient than accessing a var parameter - sign: BiggestInt = -1 - if s[i] == '+': - inc(i) - elif s[i] == '-': - inc(i) - sign = 1 - if s[i] in {'0'..'9'}: - result = 0 - while s[i] in {'0'..'9'}: - result = result * 10 - (ord(s[i]) - ord('0')) - inc(i) - while s[i] == '_': - inc(i) # underscores are allowed and ignored - result = result * sign - if s[i] == '\0': - index = i # store index back - else: - index = -1 # BUGFIX: error! - else: - index = -1 - -{.pop.} # overflowChecks - -proc parseInt(s: string): int = - var - index = 0 - res = rawParseInt(s, index) - if index == -1: - raise newException(EInvalidValue, "invalid integer: " & s) - elif (sizeof(int) <= 4) and - ((res < low(int)) or (res > high(int))): - raise newException(EOverflow, "overflow") - else: - result = int(res) # convert to smaller integer type - -proc ParseBiggestInt(s: string): biggestInt = - var index = 0 - result = rawParseInt(s, index) - if index == -1: - raise newException(EInvalidValue, "invalid integer: " & s) - -proc ParseFloat(s: string): float = - var - esign = 1.0 - sign = 1.0 - i = 0 - exponent: int - flags: int - result = 0.0 - if s[i] == '+': inc(i) - elif s[i] == '-': - sign = -1.0 - inc(i) - if s[i] == 'N' or s[i] == 'n': - if s[i+1] == 'A' or s[i+1] == 'a': - if s[i+2] == 'N' or s[i+2] == 'n': - if s[i+3] == '\0': return NaN - raise newException(EInvalidValue, "invalid float: " & s) - if s[i] == 'I' or s[i] == 'i': - if s[i+1] == 'N' or s[i+1] == 'n': - if s[i+2] == 'F' or s[i+2] == 'f': - if s[i+3] == '\0': return Inf*sign - raise newException(EInvalidValue, "invalid float: " & s) - while s[i] in {'0'..'9'}: - # Read integer part - flags = flags or 1 - result = result * 10.0 + toFloat(ord(s[i]) - ord('0')) - inc(i) - while s[i] == '_': inc(i) - # Decimal? - if s[i] == '.': - var hd = 1.0 - inc(i) - while s[i] in {'0'..'9'}: - # Read fractional part - flags = flags or 2 - result = result * 10.0 + toFloat(ord(s[i]) - ord('0')) - hd = hd * 10.0 - inc(i) - while s[i] == '_': inc(i) - result = result / hd # this complicated way preserves precision - # Again, read integer and fractional part - if flags == 0: - raise newException(EInvalidValue, "invalid float: " & s) - # Exponent? - if s[i] in {'e', 'E'}: - inc(i) - if s[i] == '+': - inc(i) - elif s[i] == '-': - esign = -1.0 - inc(i) - if s[i] notin {'0'..'9'}: - raise newException(EInvalidValue, "invalid float: " & s) - while s[i] in {'0'..'9'}: - exponent = exponent * 10 + ord(s[i]) - ord('0') - inc(i) - while s[i] == '_': inc(i) - # Calculate Exponent - var hd = 1.0 - for j in 1..exponent: - hd = hd * 10.0 - if esign > 0.0: result = result * hd - else: result = result / hd - # Not all characters are read? - if s[i] != '\0': raise newException(EInvalidValue, "invalid float: " & s) - # evaluate sign - result = result * sign - -proc toOct*(x: BiggestInt, len: int): string = - ## converts `x` into its octal representation. The resulting string is - ## always `len` characters long. No leading ``0o`` prefix is generated. - var - mask: BiggestInt = 7 - shift: BiggestInt = 0 - assert(len > 0) - result = newString(len) - for j in countdown(len-1, 0): - result[j] = chr(int((x and mask) shr shift) + ord('0')) - shift = shift + 3 - mask = mask shl 3 - -proc toBin*(x: BiggestInt, len: int): string = - ## converts `x` into its binary representation. The resulting string is - ## always `len` characters long. No leading ``0b`` prefix is generated. - var - mask: BiggestInt = 1 - shift: BiggestInt = 0 - assert(len > 0) - result = newString(len) - for j in countdown(len-1, 0): - result[j] = chr(int((x and mask) shr shift) + ord('0')) - shift = shift + 1 - mask = mask shl 1 - -proc escape*(s: string, prefix = "\"", suffix = "\""): string = - ## Escapes a string `s`. This does these operations (at the same time): - ## * replaces any ``\`` by ``\\`` - ## * replaces any ``'`` by ``\'`` - ## * replaces any ``"`` by ``\"`` - ## * replaces any other character in the set ``{'\0'..'\31', '\128'..'\255'}`` - ## by ``\xHH`` where ``HH`` is its hexadecimal value. - ## The procedure has been designed so that its output is usable for many - ## different common syntaxes. The resulting string is prefixed with - ## ``prefix`` and suffixed with ``suffix``. Both may be empty strings. - result = prefix - for c in items(s): - case c - of '\0'..'\31', '\128'..'\255': - add(result, '\\') - add(result, toHex(ord(c), 2)) - of '\\': add(result, "\\\\") - of '\'': add(result, "\\'") - of '\"': add(result, "\\\"") - else: add(result, c) - add(result, suffix) - -proc validEmailAddress*(s: string): bool = - ## returns true if `s` seems to be a valid e-mail address. - ## The checking also uses a domain list. - const - chars = Letters + Digits + {'!','#','$','%','&', - '\'','*','+','/','=','?','^','_','`','{','}','|','~','-','.'} - var i = 0 - if s[i] notin chars or s[i] == '.': return false - while s[i] in chars: - if s[i] == '.' and s[i+1] == '.': return false - inc(i) - if s[i] != '@': return false - var j = len(s)-1 - if s[j] notin letters: return false - while j >= i and s[j] in letters: dec(j) - inc(i) # skip '@' - while s[i] in {'0'..'9', 'a'..'z', '-', '.'}: inc(i) - if s[i] != '\0': return false - - var x = copy(s, j+1) - if len(x) == 2 and x[0] in Letters and x[1] in Letters: return true - case toLower(x) - of "com", "org", "net", "gov", "mil", "biz", "info", "mobi", "name", - "aero", "jobs", "museum": return true - return false - -proc validIdentifier*(s: string): bool = - ## returns true if `s` is a valid identifier. A valid identifier starts - ## with a character of the set `IdentStartChars` and is followed by any - ## number of characters of the set `IdentChars`. - if s[0] in IdentStartChars: - for i in 1..s.len-1: - if s[i] notin IdentChars: return false - return true - -proc editDistance*(a, b: string): int = - ## returns the edit distance between `a` and `b`. This uses the Levenshtein - ## distance algorithm with only a linear memory overhead. This implementation - ## is highly optimized! - var len1 = a.len - var len2 = b.len - if len1 > len2: - # make `b` the longer string - return editDistance(b, a) - - # strip common prefix: - var s = 0 - while a[s] == b[s] and a[s] != '\0': - inc(s) - dec(len1) - dec(len2) - # strip common suffix: - while len1 > 0 and len2 > 0 and a[s+len1-1] == b[s+len2-1]: - dec(len1) - dec(len2) - # trivial cases: - if len1 == 0: return len2 - if len2 == 0: return len1 - - # another special case: - if len1 == 1: - for j in s..len2-1: - if a[s] == b[j]: return len2 - 1 - return len2 - - inc(len1) - inc(len2) - var half = len1 shr 1 - # initalize first row: - #var row = cast[ptr array[0..high(int) div 8, int]](alloc(len2 * sizeof(int))) - var row: seq[int] - newSeq(row, len2) - var e = s + len2 - 1 # end marker - for i in 1..len2 - half - 1: row[i] = i - row[0] = len1 - half - 1 - for i in 1 .. len1 - 1: - var char1 = a[i + s - 1] - var char2p: int - var D, x: int - var p: int - if i >= len1 - half: - # skip the upper triangle: - var offset = i - len1 + half - char2p = offset - p = offset - var c3 = row[p] + ord(char1 != b[s + char2p]) - inc(p) - inc(char2p) - x = row[p] + 1 - D = x - if x > c3: x = c3 - row[p] = x - inc(p) - else: - p = 1 - char2p = 0 - D = i - x = i - if i <= half + 1: - # skip the lower triangle: - e = len2 + i - half - 2 - # main: - while p <= e: - dec(D) - var c3 = D + ord(char1 != b[char2p + s]) - inc(char2p) - inc(x) - if x > c3: x = c3 - D = row[p] + 1 - if x > D: x = D - row[p] = x - inc(p) - # lower triangle sentinel: - if i <= half: - dec(D) - var c3 = D + ord(char1 != b[char2p + s]) - inc(x) - if x > c3: x = c3 - row[p] = x - result = row[e] - #dealloc(row) - -{.pop.} diff --git a/nimlib/pure/terminal.nim b/nimlib/pure/terminal.nim deleted file mode 100755 index 42bd80cb42..0000000000 --- a/nimlib/pure/terminal.nim +++ /dev/null @@ -1,310 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module contains a few procedures to control the *terminal* -## (also called *console*). On UNIX, the implementation simply uses ANSI escape -## sequences and does not depend on any other module, on Windows it uses the -## Windows API. -## Changing the style is permanent even after program termination! Use the -## code ``system.addQuitProc(resetAttributes)`` to restore the defaults. - -when defined(windows): - import windows, os - - var - conHandle: THandle - # = createFile("CONOUT$", GENERIC_WRITE, 0, nil, OPEN_ALWAYS, 0, 0) - - block: - var hTemp = GetStdHandle(STD_OUTPUT_HANDLE()) - if DuplicateHandle(GetCurrentProcess(), hTemp, GetCurrentProcess(), - addr(conHandle), 0, 1, DUPLICATE_SAME_ACCESS) == 0: - OSError() - - proc getCursorPos(): tuple [x,y: int] = - var c: TCONSOLE_SCREEN_BUFFER_INFO - if GetConsoleScreenBufferInfo(conHandle, addr(c)) == 0: OSError() - return (int(c.dwCursorPosition.x), int(c.dwCursorPosition.y)) - - proc getAttributes(): int16 = - var c: TCONSOLE_SCREEN_BUFFER_INFO - # workaround Windows bugs: try several times - if GetConsoleScreenBufferInfo(conHandle, addr(c)) != 0: - return c.wAttributes - else: - OSError() - return 0x70'i16 # ERROR: return white background, black text - - var - oldAttr = getAttributes() - -proc setCursorPos*(x, y: int) = - ## sets the terminal's cursor to the (x,y) position. (0,0) is the - ## upper left of the screen. - when defined(windows): - var c: TCoord - c.x = int16(x) - c.y = int16(y) - if SetConsoleCursorPosition(conHandle, c) == 0: OSError() - else: - stdout.write("\e[" & $y & ';' & $x & 'f') - -proc setCursorXPos*(x: int) = - ## sets the terminal's cursor to the x position. The y position is - ## not changed. - when defined(windows): - var scrbuf: TCONSOLE_SCREEN_BUFFER_INFO - var hStdout = conHandle - if GetConsoleScreenBufferInfo(hStdout, addr(scrbuf)) == 0: OSError() - var origin = scrbuf.dwCursorPosition - origin.x = int16(x) - if SetConsoleCursorPosition(conHandle, origin) == 0: OSError() - else: - stdout.write("\e[" & $x & 'G') - -when defined(windows): - proc setCursorYPos*(y: int) = - ## sets the terminal's cursor to the y position. The x position is - ## not changed. **Warning**: This is not supported on UNIX! - when defined(windows): - var scrbuf: TCONSOLE_SCREEN_BUFFER_INFO - var hStdout = conHandle - if GetConsoleScreenBufferInfo(hStdout, addr(scrbuf)) == 0: OSError() - var origin = scrbuf.dwCursorPosition - origin.y = int16(y) - if SetConsoleCursorPosition(conHandle, origin) == 0: OSError() - else: - nil - -proc CursorUp*(count=1) = - ## Moves the cursor up by `count` rows. - when defined(windows): - var p = getCursorPos() - dec(p.y, count) - setCursorPos(p.x, p.y) - else: - stdout.write("\e[" & $count & 'A') - -proc CursorDown*(count=1) = - ## Moves the cursor down by `count` rows. - when defined(windows): - var p = getCursorPos() - inc(p.y, count) - setCursorPos(p.x, p.y) - else: - stdout.write("\e[" & $count & 'B') - -proc CursorForward*(count=1) = - ## Moves the cursor forward by `count` columns. - when defined(windows): - var p = getCursorPos() - inc(p.x, count) - setCursorPos(p.x, p.y) - else: - stdout.write("\e[" & $count & 'C') - -proc CursorBackward*(count=1) = - ## Moves the cursor backward by `count` columns. - when defined(windows): - var p = getCursorPos() - dec(p.x, count) - setCursorPos(p.x, p.y) - else: - stdout.write("\e[" & $count & 'D') - -when true: - nil -else: - proc EraseLineEnd* = - ## Erases from the current cursor position to the end of the current line. - when defined(windows): - nil - else: - stdout.write("\e[K") - - proc EraseLineStart* = - ## Erases from the current cursor position to the start of the current line. - when defined(windows): - nil - else: - stdout.write("\e[1K") - - proc EraseDown* = - ## Erases the screen from the current line down to the bottom of the screen. - when defined(windows): - nil - else: - stdout.write("\e[J") - - proc EraseUp* = - ## Erases the screen from the current line up to the top of the screen. - when defined(windows): - nil - else: - stdout.write("\e[1J") - -proc EraseLine* = - ## Erases the entire current line. - when defined(windows): - var scrbuf: TCONSOLE_SCREEN_BUFFER_INFO - var numwrote: DWORD - var hStdout = conHandle - if GetConsoleScreenBufferInfo(hStdout, addr(scrbuf)) == 0: OSError() - var origin = scrbuf.dwCursorPosition - origin.x = 0'i16 - if SetConsoleCursorPosition(conHandle, origin) == 0: OSError() - var ht = scrbuf.dwSize.Y - origin.Y - var wt = scrbuf.dwSize.X - origin.X - if FillConsoleOutputCharacter(hStdout,' ', ht*wt, - origin, addr(numwrote)) == 0: - OSError() - if FillConsoleOutputAttribute(hStdout, scrbuf.wAttributes, ht * wt, - scrbuf.dwCursorPosition, addr(numwrote)) == 0: - OSError() - else: - stdout.write("\e[2K") - setCursorXPos(0) - -proc EraseScreen* = - ## Erases the screen with the background colour and moves the cursor to home. - when defined(windows): - var scrbuf: TCONSOLE_SCREEN_BUFFER_INFO - var numwrote: DWORD - var origin: TCoord # is inititalized to 0, 0 - var hStdout = conHandle - if GetConsoleScreenBufferInfo(hStdout, addr(scrbuf)) == 0: OSError() - if FillConsoleOutputCharacter(hStdout, ' ', scrbuf.dwSize.X*scrbuf.dwSize.Y, - origin, addr(numwrote)) == 0: - OSError() - if FillConsoleOutputAttribute(hStdout, scrbuf.wAttributes, - scrbuf.dwSize.X * scrbuf.dwSize.Y, - origin, addr(numwrote)) == 0: - OSError() - setCursorXPos(0) - else: - stdout.write("\e[2J") - -proc ResetAttributes* {.noconv.} = - ## resets all attributes; it is advisable to register this as a quit proc - ## with ``system.addQuitProc(resetAttributes)``. - when defined(windows): - discard SetConsoleTextAttribute(conHandle, oldAttr) - else: - stdout.write("\e[0m") - -type - TStyle* = enum ## different styles for text output - styleBright = 1, ## bright text - styleDim, ## dim text - styleUnknown, ## unknown - styleUnderscore = 4, ## underscored text - styleBlink, ## blinking/bold text - styleReverse, ## unknown - styleHidden ## hidden text - -when not defined(windows): - var - gFG = 0 - gBG = 0 - -proc WriteStyled*(txt: string, style: set[TStyle] = {styleBright}) = - ## writes the text `txt` in a given `style`. - when defined(windows): - var a = 0'i16 - if styleBright in style: a = a or int16(FOREGROUND_INTENSITY) - if styleBlink in style: a = a or int16(BACKGROUND_INTENSITY) - if styleReverse in style: a = a or 0x4000'i16 # COMMON_LVB_REVERSE_VIDEO - if styleUnderscore in style: a = a or 0x8000'i16 # COMMON_LVB_UNDERSCORE - var old = getAttributes() - discard SetConsoleTextAttribute(conHandle, old or a) - stdout.write(txt) - discard SetConsoleTextAttribute(conHandle, old) - else: - for s in items(style): - stdout.write("\e[" & $ord(s) & 'm') - stdout.write(txt) - resetAttributes() - if gFG != 0: - stdout.write("\e[" & $ord(gFG) & 'm') - if gBG != 0: - stdout.write("\e[" & $ord(gBG) & 'm') - -type - TForegroundColor* = enum ## terminal's foreground colors - fgBlack = 30, ## black - fgRed, ## red - fgGreen, ## green - fgYellow, ## yellow - fgBlue, ## blue - fgMagenta, ## magenta - fgCyan, ## cyan - fgWhite ## white - - TBackgroundColor* = enum ## terminal's background colors - bgBlack = 40, ## black - bgRed, ## red - bgGreen, ## green - bgYellow, ## yellow - bgBlue, ## blue - bgMagenta, ## magenta - bgCyan, ## cyan - bgWhite ## white - -proc setForegroundColor*(fg: TForegroundColor, bright=false) = - ## sets the terminal's foreground color - when defined(windows): - var old = getAttributes() and not 0x0007 - if bright: - old = old or FOREGROUND_INTENSITY - const lookup: array [TForegroundColor, int] = [ - 0, - (FOREGROUND_RED), - (FOREGROUND_GREEN), - (FOREGROUND_RED or FOREGROUND_GREEN), - (FOREGROUND_BLUE), - (FOREGROUND_RED or FOREGROUND_BLUE), - (FOREGROUND_BLUE or FOREGROUND_GREEN), - (FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED)] - discard SetConsoleTextAttribute(conHandle, toU16(old or lookup[fg])) - else: - gFG = ord(fg) - if bright: inc(gFG, 60) - stdout.write("\e[" & $gFG & 'm') - -proc setBackgroundColor*(bg: TBackgroundColor, bright=false) = - ## sets the terminal's background color - when defined(windows): - var old = getAttributes() and not 0x0070 - if bright: - old = old or BACKGROUND_INTENSITY - const lookup: array [TBackgroundColor, int] = [ - 0, - (BACKGROUND_RED), - (BACKGROUND_GREEN), - (BACKGROUND_RED or BACKGROUND_GREEN), - (BACKGROUND_BLUE), - (BACKGROUND_RED or BACKGROUND_BLUE), - (BACKGROUND_BLUE or BACKGROUND_GREEN), - (BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED)] - discard SetConsoleTextAttribute(conHandle, toU16(old or lookup[bg])) - else: - gBG = ord(bg) - if bright: inc(gBG, 60) - stdout.write("\e[" & $gBG & 'm') - -when isMainModule: - system.addQuitProc(resetAttributes) - write(stdout, "never mind") - eraseLine() - #setCursorPos(2, 2) - writeStyled("styled text ", {styleBright, styleBlink, styleUnderscore}) - setBackGroundColor(bgCyan, true) - setForeGroundColor(fgBlue) - writeln(stdout, "ordinary text") - diff --git a/nimlib/pure/times.nim b/nimlib/pure/times.nim deleted file mode 100755 index 8c21b60270..0000000000 --- a/nimlib/pure/times.nim +++ /dev/null @@ -1,307 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -## This module contains routines and types for dealing with time. -## This module is available for the ECMAScript target. - -{.push debugger:off .} # the user does not want to trace a part - # of the standard library! - -import - strutils - -type - TMonth* = enum ## represents a month - mJan, mFeb, mMar, mApr, mMay, mJun, mJul, mAug, mSep, mOct, mNov, mDec - TWeekDay* = enum ## represents a weekday - dMon, dTue, dWed, dThu, dFri, dSat, dSun - -when defined(posix): - type - TTime* = distinct int ## distinct type that represents a time -elif defined(windows): - when defined(vcc): - # newest version of Visual C++ defines time_t to be of 64 bits - type TTime* = distinct int64 - else: - type TTime* = distinct int32 -elif defined(ECMAScript): - type - TTime* {.final.} = object - getDay: proc (): int - getFullYear: proc (): int - getHours: proc (): int - getMilliseconds: proc (): int - getMinutes: proc (): int - getMonth: proc (): int - getSeconds: proc (): int - getTime: proc (): int - getTimezoneOffset: proc (): int - getUTCDate: proc (): int - getUTCFullYear: proc (): int - getUTCHours: proc (): int - getUTCMilliseconds: proc (): int - getUTCMinutes: proc (): int - getUTCMonth: proc (): int - getUTCSeconds: proc (): int - getYear: proc (): int - parse: proc (s: cstring): TTime - setDate: proc (x: int) - setFullYear: proc (x: int) - setHours: proc (x: int) - setMilliseconds: proc (x: int) - setMinutes: proc (x: int) - setMonth: proc (x: int) - setSeconds: proc (x: int) - setTime: proc (x: int) - setUTCDate: proc (x: int) - setUTCFullYear: proc (x: int) - setUTCHours: proc (x: int) - setUTCMilliseconds: proc (x: int) - setUTCMinutes: proc (x: int) - setUTCMonth: proc (x: int) - setUTCSeconds: proc (x: int) - setYear: proc (x: int) - toGMTString: proc (): cstring - toLocaleString: proc (): cstring - UTC: proc (): int - -type - TTimeInfo* = object of TObject ## represents a time in different parts - second*: range[0..61] ## The number of seconds after the minute, - ## normally in the range 0 to 59, but can - ## be up to 61 to allow for leap seconds. - minute*: range[0..59] ## The number of minutes after the hour, - ## in the range 0 to 59. - hour*: range[0..23] ## The number of hours past midnight, - ## in the range 0 to 23. - monthday*: range[1..31] ## The day of the month, in the range 1 to 31. - month*: TMonth ## The current month. - year*: int ## The current year. - weekday*: TWeekDay ## The current day of the week. - yearday*: range[0..365] ## The number of days since January 1, - ## in the range 0 to 365. - ## Always 0 if the target is ECMAScript. - -proc getTime*(): TTime ## gets the current calendar time -proc getLocalTime*(t: TTime): TTimeInfo - ## converts the calendar time `t` to broken-time representation, - ## expressed relative to the user's specified time zone. -proc getGMTime*(t: TTime): TTimeInfo - ## converts the calendar time `t` to broken-down time representation, - ## expressed in Coordinated Universal Time (UTC). - -proc TimeInfoToTime*(timeInfo: TTimeInfo): TTime - ## converts a broken-down time structure, expressed as local time, to - ## calendar time representation. The function ignores the specified - ## contents of the structure members `weekday` and `yearday` and recomputes - ## them from the other information in the broken-down time structure. - -proc `$` *(timeInfo: TTimeInfo): string - ## converts a `TTimeInfo` object to a string representation. -proc `$` *(time: TTime): string - ## converts a calendar time to a string representation. - -proc getDateStr*(): string - ## gets the current date as a string of the format - ## ``YYYY-MM-DD``. -proc getClockStr*(): string - ## gets the current clock time as a string of the format ``HH:MM:SS``. - -proc `-` *(a, b: TTime): int64 - ## computes the difference of two calendar times. Result is in seconds. - -proc `<` * (a, b: TTime): bool = - ## returns true iff ``a < b``, that is iff a happened before b. - result = a - b < 0 - -proc `<=` * (a, b: TTime): bool = - ## returns true iff ``a <= b``. - result = a - b <= 0 - -proc getStartMilsecs*(): int - ## get the miliseconds from the start of the program - - -when not defined(ECMAScript): - # C wrapper: - type - structTM {.importc: "struct tm", final.} = object - second {.importc: "tm_sec".}, - minute {.importc: "tm_min".}, - hour {.importc: "tm_hour".}, - monthday {.importc: "tm_mday".}, - month {.importc: "tm_mon".}, - year {.importc: "tm_year".}, - weekday {.importc: "tm_wday".}, - yearday {.importc: "tm_yday".}, - isdst {.importc: "tm_isdst".}: cint - - PTimeInfo = ptr structTM - PTime = ptr TTime - - TClock {.importc: "clock_t".} = range[low(int)..high(int)] - - proc localtime(timer: PTime): PTimeInfo {. - importc: "localtime", header: "".} - proc gmtime(timer: PTime): PTimeInfo {.importc: "gmtime", header: "".} - proc timec(timer: PTime): TTime {.importc: "time", header: "".} - proc mktime(t: structTM): TTime {.importc: "mktime", header: "".} - proc asctime(tblock: structTM): CString {. - importc: "asctime", header: "".} - proc ctime(time: PTime): CString {.importc: "ctime", header: "".} - # strftime(s: CString, maxsize: int, fmt: CString, t: tm): int {. - # importc: "strftime", header: "".} - proc clock(): TClock {.importc: "clock", header: "".} - proc difftime(a, b: TTime): float {.importc: "difftime", header: "".} - - var - clocksPerSec {.importc: "CLOCKS_PER_SEC", nodecl.}: int - - - # our own procs on top of that: - proc tmToTimeInfo(tm: structTM): TTimeInfo = - const - weekDays: array [0..6, TWeekDay] = [ - dSun, dMon, dTue, dWed, dThu, dFri, dSat] - result.second = int(tm.second) - result.minute = int(tm.minute) - result.hour = int(tm.hour) - result.monthday = int(tm.monthday) - result.month = TMonth(tm.month) - result.year = tm.year + 1900'i32 - result.weekday = weekDays[int(tm.weekDay)] - result.yearday = int(tm.yearday) - - proc timeInfoToTM(t: TTimeInfo): structTM = - const - weekDays: array [TWeekDay, int] = [1, 2, 3, 4, 5, 6, 0] - result.second = t.second - result.minute = t.minute - result.hour = t.hour - result.monthday = t.monthday - result.month = ord(t.month) - result.year = t.year - 1900 - result.weekday = weekDays[t.weekDay] - result.yearday = t.yearday - result.isdst = -1 - - proc `-` (a, b: TTime): int64 = - return toBiggestInt(difftime(a, b)) - - proc getStartMilsecs(): int = return clock() div (clocksPerSec div 1000) - proc getTime(): TTime = return timec(nil) - proc getLocalTime(t: TTime): TTimeInfo = - var a = t - result = tmToTimeInfo(localtime(addr(a))^) - # copying is needed anyway to provide reentrancity; thus - # the convertion is not expensive - - proc getGMTime(t: TTime): TTimeInfo = - var a = t - result = tmToTimeInfo(gmtime(addr(a))^) - # copying is needed anyway to provide reentrancity; thus - # the convertion is not expensive - - proc TimeInfoToTime(timeInfo: TTimeInfo): TTime = - var cTimeInfo = timeInfo # for C++ we have to make a copy, - # because the header of mktime is broken in my version of libc - return mktime(timeInfoToTM(cTimeInfo)) - - proc toStringTillNL(p: cstring): string = - result = "" - var i = 0 - while p[i] != '\0' and p[i] != '\10' and p[i] != '\13': - add(result, p[i]) - inc(i) - return result - - proc `$`(timeInfo: TTimeInfo): string = - # BUGFIX: asctime returns a newline at the end! - var p = asctime(timeInfoToTM(timeInfo)) - result = toStringTillNL(p) - - proc `$`(time: TTime): string = - # BUGFIX: ctime returns a newline at the end! - var a = time - return toStringTillNL(ctime(addr(a))) - - const - epochDiff = 116444736000000000'i64 - rateDiff = 10000000'i64 # 100 nsecs - - proc unixTimeToWinTime*(t: TTime): int64 = - ## converts a UNIX `TTime` (``time_t``) to a Windows file time - result = int64(t) * rateDiff + epochDiff - - proc winTimeToUnixTime*(t: int64): TTime = - ## converts a Windows time to a UNIX `TTime` (``time_t``) - result = TTime((t - epochDiff) div rateDiff) - -else: - proc getTime(): TTime {.importc: "new Date", nodecl.} - - const - weekDays: array [0..6, TWeekDay] = [ - dSun, dMon, dTue, dWed, dThu, dFri, dSat] - - proc getLocalTime(t: TTime): TTimeInfo = - result.second = t.getSeconds() - result.minute = t.getMinutes() - result.hour = t.getHours() - result.monthday = t.getDate() - result.month = TMonth(t.getMonth()) - result.year = t.getFullYear() - result.weekday = weekDays[t.getDay()] - result.yearday = 0 - - proc getGMTime(t: TTime): TTimeInfo = - result.second = t.getUTCSeconds() - result.minute = t.getUTCMinutes() - result.hour = t.getUTCHours() - result.monthday = t.getUTCDate() - result.month = TMonth(t.getUTCMonth()) - result.year = t.getUTCFullYear() - result.weekday = weekDays[t.getDay()] - result.yearday = 0 - - proc TimeInfoToTime*(timeInfo: TTimeInfo): TTime = - result = getTime() - result.setSeconds(timeInfo.second) - result.setMinutes(timeInfo.minute) - result.setHours(timeInfo.hour) - result.setMonth(ord(timeInfo.month)) - result.setFullYear(timeInfo.year) - result.setDate(timeInfo.monthday) - - proc `$`(timeInfo: TTimeInfo): string = return $(TimeInfoToTIme(timeInfo)) - proc `$`(time: TTime): string = $time.toLocaleString() - - proc `-` (a, b: TTime): int64 = - return a.getTime() - b.getTime() - - var - startMilsecs = getTime() - - proc getStartMilsecs(): int = - ## get the miliseconds from the start of the program - return int(getTime() - startMilsecs) - -proc getDateStr(): string = - var ti = getLocalTime(getTime()) - result = $ti.year & '-' & intToStr(ord(ti.month)+1, 2) & - '-' & intToStr(ti.monthDay, 2) - -proc getClockStr(): string = - var ti = getLocalTime(getTime()) - result = intToStr(ti.hour, 2) & ':' & intToStr(ti.minute, 2) & - ':' & intToStr(ti.second, 2) - -{.pop.} diff --git a/nimlib/pure/unicode.nim b/nimlib/pure/unicode.nim deleted file mode 100755 index 2a53d76601..0000000000 --- a/nimlib/pure/unicode.nim +++ /dev/null @@ -1,1178 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module provides support to handle the Unicode UTF-8 encoding. - -{.deadCodeElim: on.} - -type - irune = int # underlying type of TRune - TRune* = distinct irune ## type that can hold any Unicode character - TRune16* = distinct int16 ## 16 bit Unicode character - -proc `<=%`*(a, b: TRune): bool {.borrow.} -proc `<%`*(a, b: TRune): bool {.borrow.} -proc `==`*(a, b: TRune): bool {.borrow.} - -template ones(n: expr): expr = ((1 shl n)-1) - -proc runeLen*(s: string): int = - ## returns the number of Unicode characters of the string `s`. - var i = 0 - while i < len(s): - if ord(s[i]) <=% 127: inc(i) - elif ord(s[i]) shr 5 == 0b110: inc(i, 2) - elif ord(s[i]) shr 4 == 0b1110: inc(i, 3) - elif ord(s[i]) shr 3 == 0b11110: inc(i, 4) - else: assert(false) - inc(result) - -proc runeLenAt*(s: string, i: int): int = - ## returns the number of bytes the rune starting at ``s[i]`` takes. - if ord(s[i]) <=% 127: result = 1 - elif ord(s[i]) shr 5 == 0b110: result = 2 - elif ord(s[i]) shr 4 == 0b1110: result = 3 - elif ord(s[i]) shr 3 == 0b11110: result = 4 - else: assert(false) - -template fastRuneAt*(s: string, i: int, result: expr, doInc = true) = - ## Returns the unicode character ``s[i]`` in `result`. If ``doInc == true`` - ## `i` is incremented by the number of bytes that have been processed. - if ord(s[i]) <=% 127: - result = TRune(ord(s[i])) - when doInc: inc(i) - elif ord(s[i]) shr 5 == 0b110: - assert(ord(s[i+1]) shr 6 == 0b10) - result = TRune((ord(s[i]) and (bind ones(5))) shl 6 or - (ord(s[i+1]) and ones(6))) - when doInc: inc(i, 2) - elif ord(s[i]) shr 4 == 0b1110: - assert(ord(s[i+1]) shr 6 == 0b10) - assert(ord(s[i+2]) shr 6 == 0b10) - result = TRune((ord(s[i]) and ones(4)) shl 12 or - (ord(s[i+1]) and ones(6)) shl 6 or - (ord(s[i+2]) and ones(6))) - when doInc: inc(i, 3) - elif ord(s[i]) shr 3 == 0b11110: - assert(ord(s[i+1]) shr 6 == 0b10) - assert(ord(s[i+2]) shr 6 == 0b10) - assert(ord(s[i+3]) shr 6 == 0b10) - result = TRune((ord(s[i]) and ones(3)) shl 18 or - (ord(s[i+1]) and ones(6)) shl 12 or - (ord(s[i+2]) and ones(6)) shl 6 or - (ord(s[i+3]) and ones(6))) - when doInc: inc(i, 4) - else: - assert(false) - -proc runeAt*(s: string, i: int): TRune = - ## returns the unicode character in `s` at byte index `i` - fastRuneAt(s, i, result, false) - -proc toUTF8*(c: TRune): string = - ## converts a rune into its UTF8 representation - var i = irune(c) - if i <=% 127: - result = newString(1) - result[0] = chr(i) - elif i <=% 0x07FF: - result = newString(2) - result[0] = chr(i shr 6 or 0b110_0000) - result[1] = chr(i and ones(6) or 0b10_000000) - elif i <=% 0xFFFF: - result = newString(3) - result[0] = chr(i shr 12 or 0b1110_0000) - result[1] = chr(i shr 6 and ones(6) or 0b10_0000_00) - result[2] = chr(i and ones(6) or 0b10_0000_00) - elif i <=% 0x0010FFFF: - result = newString(4) - result[0] = chr(i shr 18 or 0b1111_0000) - result[1] = chr(i shr 12 and ones(6) or 0b10_0000_00) - result[2] = chr(i shr 6 and ones(6) or 0b10_0000_00) - result[3] = chr(i and ones(6) or 0b10_0000_00) - else: - assert false - -const - alphaRanges = [ - 0x00d8, 0x00f6, # Ø - ö - 0x00f8, 0x01f5, # ø - ǵ - 0x0250, 0x02a8, # ɐ - ʨ - 0x038e, 0x03a1, # Ύ - Ρ - 0x03a3, 0x03ce, # Σ - ώ - 0x03d0, 0x03d6, # ϐ - ϖ - 0x03e2, 0x03f3, # Ϣ - ϳ - 0x0490, 0x04c4, # Ґ - ӄ - 0x0561, 0x0587, # ա - և - 0x05d0, 0x05ea, # א - ת - 0x05f0, 0x05f2, # װ - ײ - 0x0621, 0x063a, # ء - غ - 0x0640, 0x064a, # ـ - ي - 0x0671, 0x06b7, # ٱ - ڷ - 0x06ba, 0x06be, # ں - ھ - 0x06c0, 0x06ce, # ۀ - ێ - 0x06d0, 0x06d3, # ې - ۓ - 0x0905, 0x0939, # अ - ह - 0x0958, 0x0961, # क़ - ॡ - 0x0985, 0x098c, # অ - ঌ - 0x098f, 0x0990, # এ - ঐ - 0x0993, 0x09a8, # ও - ন - 0x09aa, 0x09b0, # প - র - 0x09b6, 0x09b9, # শ - হ - 0x09dc, 0x09dd, # ড় - ঢ় - 0x09df, 0x09e1, # য় - ৡ - 0x09f0, 0x09f1, # ৰ - ৱ - 0x0a05, 0x0a0a, # ਅ - ਊ - 0x0a0f, 0x0a10, # ਏ - ਐ - 0x0a13, 0x0a28, # ਓ - ਨ - 0x0a2a, 0x0a30, # ਪ - ਰ - 0x0a32, 0x0a33, # ਲ - ਲ਼ - 0x0a35, 0x0a36, # ਵ - ਸ਼ - 0x0a38, 0x0a39, # ਸ - ਹ - 0x0a59, 0x0a5c, # ਖ਼ - ੜ - 0x0a85, 0x0a8b, # અ - ઋ - 0x0a8f, 0x0a91, # એ - ઑ - 0x0a93, 0x0aa8, # ઓ - ન - 0x0aaa, 0x0ab0, # પ - ર - 0x0ab2, 0x0ab3, # લ - ળ - 0x0ab5, 0x0ab9, # વ - હ - 0x0b05, 0x0b0c, # ଅ - ଌ - 0x0b0f, 0x0b10, # ଏ - ଐ - 0x0b13, 0x0b28, # ଓ - ନ - 0x0b2a, 0x0b30, # ପ - ର - 0x0b32, 0x0b33, # ଲ - ଳ - 0x0b36, 0x0b39, # ଶ - ହ - 0x0b5c, 0x0b5d, # ଡ଼ - ଢ଼ - 0x0b5f, 0x0b61, # ୟ - ୡ - 0x0b85, 0x0b8a, # அ - ஊ - 0x0b8e, 0x0b90, # எ - ஐ - 0x0b92, 0x0b95, # ஒ - க - 0x0b99, 0x0b9a, # ங - ச - 0x0b9e, 0x0b9f, # ஞ - ட - 0x0ba3, 0x0ba4, # ண - த - 0x0ba8, 0x0baa, # ந - ப - 0x0bae, 0x0bb5, # ம - வ - 0x0bb7, 0x0bb9, # ஷ - ஹ - 0x0c05, 0x0c0c, # అ - ఌ - 0x0c0e, 0x0c10, # ఎ - ఐ - 0x0c12, 0x0c28, # ఒ - న - 0x0c2a, 0x0c33, # ప - ళ - 0x0c35, 0x0c39, # వ - హ - 0x0c60, 0x0c61, # ౠ - ౡ - 0x0c85, 0x0c8c, # ಅ - ಌ - 0x0c8e, 0x0c90, # ಎ - ಐ - 0x0c92, 0x0ca8, # ಒ - ನ - 0x0caa, 0x0cb3, # ಪ - ಳ - 0x0cb5, 0x0cb9, # ವ - ಹ - 0x0ce0, 0x0ce1, # ೠ - ೡ - 0x0d05, 0x0d0c, # അ - ഌ - 0x0d0e, 0x0d10, # എ - ഐ - 0x0d12, 0x0d28, # ഒ - ന - 0x0d2a, 0x0d39, # പ - ഹ - 0x0d60, 0x0d61, # ൠ - ൡ - 0x0e01, 0x0e30, # ก - ะ - 0x0e32, 0x0e33, # า - ำ - 0x0e40, 0x0e46, # เ - ๆ - 0x0e5a, 0x0e5b, # ๚ - ๛ - 0x0e81, 0x0e82, # ກ - ຂ - 0x0e87, 0x0e88, # ງ - ຈ - 0x0e94, 0x0e97, # ດ - ທ - 0x0e99, 0x0e9f, # ນ - ຟ - 0x0ea1, 0x0ea3, # ມ - ຣ - 0x0eaa, 0x0eab, # ສ - ຫ - 0x0ead, 0x0eae, # ອ - ຮ - 0x0eb2, 0x0eb3, # າ - ຳ - 0x0ec0, 0x0ec4, # ເ - ໄ - 0x0edc, 0x0edd, # ໜ - ໝ - 0x0f18, 0x0f19, # ༘ - ༙ - 0x0f40, 0x0f47, # ཀ - ཇ - 0x0f49, 0x0f69, # ཉ - ཀྵ - 0x10d0, 0x10f6, # ა - ჶ - 0x1100, 0x1159, # ᄀ - ᅙ - 0x115f, 0x11a2, # ᅟ - ᆢ - 0x11a8, 0x11f9, # ᆨ - ᇹ - 0x1e00, 0x1e9b, # Ḁ - ẛ - 0x1f50, 0x1f57, # ὐ - ὗ - 0x1f80, 0x1fb4, # ᾀ - ᾴ - 0x1fb6, 0x1fbc, # ᾶ - ᾼ - 0x1fc2, 0x1fc4, # ῂ - ῄ - 0x1fc6, 0x1fcc, # ῆ - ῌ - 0x1fd0, 0x1fd3, # ῐ - ΐ - 0x1fd6, 0x1fdb, # ῖ - Ί - 0x1fe0, 0x1fec, # ῠ - Ῥ - 0x1ff2, 0x1ff4, # ῲ - ῴ - 0x1ff6, 0x1ffc, # ῶ - ῼ - 0x210a, 0x2113, # ℊ - ℓ - 0x2115, 0x211d, # ℕ - ℝ - 0x2120, 0x2122, # ℠ - ™ - 0x212a, 0x2131, # K - ℱ - 0x2133, 0x2138, # ℳ - ℸ - 0x3041, 0x3094, # ぁ - ゔ - 0x30a1, 0x30fa, # ァ - ヺ - 0x3105, 0x312c, # ㄅ - ㄬ - 0x3131, 0x318e, # ㄱ - ㆎ - 0x3192, 0x319f, # ㆒ - ㆟ - 0x3260, 0x327b, # ㉠ - ㉻ - 0x328a, 0x32b0, # ㊊ - ㊰ - 0x32d0, 0x32fe, # ㋐ - ㋾ - 0x3300, 0x3357, # ㌀ - ㍗ - 0x3371, 0x3376, # ㍱ - ㍶ - 0x337b, 0x3394, # ㍻ - ㎔ - 0x3399, 0x339e, # ㎙ - ㎞ - 0x33a9, 0x33ad, # ㎩ - ㎭ - 0x33b0, 0x33c1, # ㎰ - ㏁ - 0x33c3, 0x33c5, # ㏃ - ㏅ - 0x33c7, 0x33d7, # ㏇ - ㏗ - 0x33d9, 0x33dd, # ㏙ - ㏝ - 0x4e00, 0x9fff, # 一 - 鿿 - 0xac00, 0xd7a3, # 가 - 힣 - 0xf900, 0xfb06, # 豈 - st - 0xfb13, 0xfb17, # ﬓ - ﬗ - 0xfb1f, 0xfb28, # ײַ - ﬨ - 0xfb2a, 0xfb36, # שׁ - זּ - 0xfb38, 0xfb3c, # טּ - לּ - 0xfb40, 0xfb41, # נּ - סּ - 0xfb43, 0xfb44, # ףּ - פּ - 0xfb46, 0xfbb1, # צּ - ﮱ - 0xfbd3, 0xfd3d, # ﯓ - ﴽ - 0xfd50, 0xfd8f, # ﵐ - ﶏ - 0xfd92, 0xfdc7, # ﶒ - ﷇ - 0xfdf0, 0xfdf9, # ﷰ - ﷹ - 0xfe70, 0xfe72, # ﹰ - ﹲ - 0xfe76, 0xfefc, # ﹶ - ﻼ - 0xff66, 0xff6f, # ｦ - ｯ - 0xff71, 0xff9d, # ｱ - ﾝ - 0xffa0, 0xffbe, # ﾠ - ﾾ - 0xffc2, 0xffc7, # ￂ - ￇ - 0xffca, 0xffcf, # ￊ - ￏ - 0xffd2, 0xffd7, # ￒ - ￗ - 0xffda, 0xffdc] # ￚ - ￜ - - alphaSinglets = [ - 0x00aa, # ª - 0x00b5, # µ - 0x00ba, # º - 0x03da, # Ϛ - 0x03dc, # Ϝ - 0x03de, # Ϟ - 0x03e0, # Ϡ - 0x06d5, # ە - 0x09b2, # ল - 0x0a5e, # ਫ਼ - 0x0a8d, # ઍ - 0x0ae0, # ૠ - 0x0b9c, # ஜ - 0x0cde, # ೞ - 0x0e4f, # ๏ - 0x0e84, # ຄ - 0x0e8a, # ຊ - 0x0e8d, # ຍ - 0x0ea5, # ລ - 0x0ea7, # ວ - 0x0eb0, # ະ - 0x0ebd, # ຽ - 0x1fbe, # ι - 0x207f, # ⁿ - 0x20a8, # ₨ - 0x2102, # ℂ - 0x2107, # ℇ - 0x2124, # ℤ - 0x2126, # Ω - 0x2128, # ℨ - 0xfb3e, # מּ - 0xfe74] # ﹴ - - spaceRanges = [ - 0x0009, 0x000a, # tab and newline - 0x0020, 0x0020, # space - 0x00a0, 0x00a0, #   - 0x2000, 0x200b, #   - ​ - 0x2028, 0x2029, # - 
 0x3000, 0x3000, # 　 - 0xfeff, 0xfeff] #  - - toupperRanges = [ - 0x0061, 0x007a, 468, # a-z A-Z - 0x00e0, 0x00f6, 468, # à-ö À-Ö - 0x00f8, 0x00fe, 468, # ø-þ Ø-Þ - 0x0256, 0x0257, 295, # ɖ-ɗ Ɖ-Ɗ - 0x0258, 0x0259, 298, # ɘ-ə Ǝ-Ə - 0x028a, 0x028b, 283, # ʊ-ʋ Ʊ-Ʋ - 0x03ad, 0x03af, 463, # έ-ί Έ-Ί - 0x03b1, 0x03c1, 468, # α-ρ Α-Ρ - 0x03c3, 0x03cb, 468, # σ-ϋ Σ-Ϋ - 0x03cd, 0x03ce, 437, # ύ-ώ Ύ-Ώ - 0x0430, 0x044f, 468, # а-я А-Я - 0x0451, 0x045c, 420, # ё-ќ Ё-Ќ - 0x045e, 0x045f, 420, # ў-џ Ў-Џ - 0x0561, 0x0586, 452, # ա-ֆ Ա-Ֆ - 0x1f00, 0x1f07, 508, # ἀ-ἇ Ἀ-Ἇ - 0x1f10, 0x1f15, 508, # ἐ-ἕ Ἐ-Ἕ - 0x1f20, 0x1f27, 508, # ἠ-ἧ Ἠ-Ἧ - 0x1f30, 0x1f37, 508, # ἰ-ἷ Ἰ-Ἷ - 0x1f40, 0x1f45, 508, # ὀ-ὅ Ὀ-Ὅ - 0x1f60, 0x1f67, 508, # ὠ-ὧ Ὠ-Ὧ - 0x1f70, 0x1f71, 574, # ὰ-ά Ὰ-Ά - 0x1f72, 0x1f75, 586, # ὲ-ή Ὲ-Ή - 0x1f76, 0x1f77, 600, # ὶ-ί Ὶ-Ί - 0x1f78, 0x1f79, 628, # ὸ-ό Ὸ-Ό - 0x1f7a, 0x1f7b, 612, # ὺ-ύ Ὺ-Ύ - 0x1f7c, 0x1f7d, 626, # ὼ-ώ Ὼ-Ώ - 0x1f80, 0x1f87, 508, # ᾀ-ᾇ ᾈ-ᾏ - 0x1f90, 0x1f97, 508, # ᾐ-ᾗ ᾘ-ᾟ - 0x1fa0, 0x1fa7, 508, # ᾠ-ᾧ ᾨ-ᾯ - 0x1fb0, 0x1fb1, 508, # ᾰ-ᾱ Ᾰ-Ᾱ - 0x1fd0, 0x1fd1, 508, # ῐ-ῑ Ῐ-Ῑ - 0x1fe0, 0x1fe1, 508, # ῠ-ῡ Ῠ-Ῡ - 0x2170, 0x217f, 484, # ⅰ-ⅿ Ⅰ-Ⅿ - 0x24d0, 0x24e9, 474, # ⓐ-ⓩ Ⓐ-Ⓩ - 0xff41, 0xff5a, 468] # ａ-ｚ Ａ-Ｚ - - toupperSinglets = [ - 0x00ff, 621, # ÿ Ÿ - 0x0101, 499, # ā Ā - 0x0103, 499, # ă Ă - 0x0105, 499, # ą Ą - 0x0107, 499, # ć Ć - 0x0109, 499, # ĉ Ĉ - 0x010b, 499, # ċ Ċ - 0x010d, 499, # č Č - 0x010f, 499, # ď Ď - 0x0111, 499, # đ Đ - 0x0113, 499, # ē Ē - 0x0115, 499, # ĕ Ĕ - 0x0117, 499, # ė Ė - 0x0119, 499, # ę Ę - 0x011b, 499, # ě Ě - 0x011d, 499, # ĝ Ĝ - 0x011f, 499, # ğ Ğ - 0x0121, 499, # ġ Ġ - 0x0123, 499, # ģ Ģ - 0x0125, 499, # ĥ Ĥ - 0x0127, 499, # ħ Ħ - 0x0129, 499, # ĩ Ĩ - 0x012b, 499, # ī Ī - 0x012d, 499, # ĭ Ĭ - 0x012f, 499, # į Į - 0x0131, 268, # ı I - 0x0133, 499, # ij IJ - 0x0135, 499, # ĵ Ĵ - 0x0137, 499, # ķ Ķ - 0x013a, 499, # ĺ Ĺ - 0x013c, 499, # ļ Ļ - 0x013e, 499, # ľ Ľ - 0x0140, 499, # ŀ Ŀ - 0x0142, 499, # ł Ł - 0x0144, 499, # ń Ń - 0x0146, 499, # ņ Ņ - 0x0148, 499, # ň Ň - 0x014b, 499, # ŋ Ŋ - 0x014d, 499, # ō Ō - 0x014f, 499, # ŏ Ŏ - 0x0151, 499, # ő Ő - 0x0153, 499, # œ Œ - 0x0155, 499, # ŕ Ŕ - 0x0157, 499, # ŗ Ŗ - 0x0159, 499, # ř Ř - 0x015b, 499, # ś Ś - 0x015d, 499, # ŝ Ŝ - 0x015f, 499, # ş Ş - 0x0161, 499, # š Š - 0x0163, 499, # ţ Ţ - 0x0165, 499, # ť Ť - 0x0167, 499, # ŧ Ŧ - 0x0169, 499, # ũ Ũ - 0x016b, 499, # ū Ū - 0x016d, 499, # ŭ Ŭ - 0x016f, 499, # ů Ů - 0x0171, 499, # ű Ű - 0x0173, 499, # ų Ų - 0x0175, 499, # ŵ Ŵ - 0x0177, 499, # ŷ Ŷ - 0x017a, 499, # ź Ź - 0x017c, 499, # ż Ż - 0x017e, 499, # ž Ž - 0x017f, 200, # ſ S - 0x0183, 499, # ƃ Ƃ - 0x0185, 499, # ƅ Ƅ - 0x0188, 499, # ƈ Ƈ - 0x018c, 499, # ƌ Ƌ - 0x0192, 499, # ƒ Ƒ - 0x0199, 499, # ƙ Ƙ - 0x01a1, 499, # ơ Ơ - 0x01a3, 499, # ƣ Ƣ - 0x01a5, 499, # ƥ Ƥ - 0x01a8, 499, # ƨ Ƨ - 0x01ad, 499, # ƭ Ƭ - 0x01b0, 499, # ư Ư - 0x01b4, 499, # ƴ Ƴ - 0x01b6, 499, # ƶ Ƶ - 0x01b9, 499, # ƹ Ƹ - 0x01bd, 499, # ƽ Ƽ - 0x01c5, 499, # Dž DŽ - 0x01c6, 498, # dž DŽ - 0x01c8, 499, # Lj LJ - 0x01c9, 498, # lj LJ - 0x01cb, 499, # Nj NJ - 0x01cc, 498, # nj NJ - 0x01ce, 499, # ǎ Ǎ - 0x01d0, 499, # ǐ Ǐ - 0x01d2, 499, # ǒ Ǒ - 0x01d4, 499, # ǔ Ǔ - 0x01d6, 499, # ǖ Ǖ - 0x01d8, 499, # ǘ Ǘ - 0x01da, 499, # ǚ Ǚ - 0x01dc, 499, # ǜ Ǜ - 0x01df, 499, # ǟ Ǟ - 0x01e1, 499, # ǡ Ǡ - 0x01e3, 499, # ǣ Ǣ - 0x01e5, 499, # ǥ Ǥ - 0x01e7, 499, # ǧ Ǧ - 0x01e9, 499, # ǩ Ǩ - 0x01eb, 499, # ǫ Ǫ - 0x01ed, 499, # ǭ Ǭ - 0x01ef, 499, # ǯ Ǯ - 0x01f2, 499, # Dz DZ - 0x01f3, 498, # dz DZ - 0x01f5, 499, # ǵ Ǵ - 0x01fb, 499, # ǻ Ǻ - 0x01fd, 499, # ǽ Ǽ - 0x01ff, 499, # ǿ Ǿ - 0x0201, 499, # ȁ Ȁ - 0x0203, 499, # ȃ Ȃ - 0x0205, 499, # ȅ Ȅ - 0x0207, 499, # ȇ Ȇ - 0x0209, 499, # ȉ Ȉ - 0x020b, 499, # ȋ Ȋ - 0x020d, 499, # ȍ Ȍ - 0x020f, 499, # ȏ Ȏ - 0x0211, 499, # ȑ Ȑ - 0x0213, 499, # ȓ Ȓ - 0x0215, 499, # ȕ Ȕ - 0x0217, 499, # ȗ Ȗ - 0x0253, 290, # ɓ Ɓ - 0x0254, 294, # ɔ Ɔ - 0x025b, 297, # ɛ Ɛ - 0x0260, 295, # ɠ Ɠ - 0x0263, 293, # ɣ Ɣ - 0x0268, 291, # ɨ Ɨ - 0x0269, 289, # ɩ Ɩ - 0x026f, 289, # ɯ Ɯ - 0x0272, 287, # ɲ Ɲ - 0x0283, 282, # ʃ Ʃ - 0x0288, 282, # ʈ Ʈ - 0x0292, 281, # ʒ Ʒ - 0x03ac, 462, # ά Ά - 0x03cc, 436, # ό Ό - 0x03d0, 438, # ϐ Β - 0x03d1, 443, # ϑ Θ - 0x03d5, 453, # ϕ Φ - 0x03d6, 446, # ϖ Π - 0x03e3, 499, # ϣ Ϣ - 0x03e5, 499, # ϥ Ϥ - 0x03e7, 499, # ϧ Ϧ - 0x03e9, 499, # ϩ Ϩ - 0x03eb, 499, # ϫ Ϫ - 0x03ed, 499, # ϭ Ϭ - 0x03ef, 499, # ϯ Ϯ - 0x03f0, 414, # ϰ Κ - 0x03f1, 420, # ϱ Ρ - 0x0461, 499, # ѡ Ѡ - 0x0463, 499, # ѣ Ѣ - 0x0465, 499, # ѥ Ѥ - 0x0467, 499, # ѧ Ѧ - 0x0469, 499, # ѩ Ѩ - 0x046b, 499, # ѫ Ѫ - 0x046d, 499, # ѭ Ѭ - 0x046f, 499, # ѯ Ѯ - 0x0471, 499, # ѱ Ѱ - 0x0473, 499, # ѳ Ѳ - 0x0475, 499, # ѵ Ѵ - 0x0477, 499, # ѷ Ѷ - 0x0479, 499, # ѹ Ѹ - 0x047b, 499, # ѻ Ѻ - 0x047d, 499, # ѽ Ѽ - 0x047f, 499, # ѿ Ѿ - 0x0481, 499, # ҁ Ҁ - 0x0491, 499, # ґ Ґ - 0x0493, 499, # ғ Ғ - 0x0495, 499, # ҕ Ҕ - 0x0497, 499, # җ Җ - 0x0499, 499, # ҙ Ҙ - 0x049b, 499, # қ Қ - 0x049d, 499, # ҝ Ҝ - 0x049f, 499, # ҟ Ҟ - 0x04a1, 499, # ҡ Ҡ - 0x04a3, 499, # ң Ң - 0x04a5, 499, # ҥ Ҥ - 0x04a7, 499, # ҧ Ҧ - 0x04a9, 499, # ҩ Ҩ - 0x04ab, 499, # ҫ Ҫ - 0x04ad, 499, # ҭ Ҭ - 0x04af, 499, # ү Ү - 0x04b1, 499, # ұ Ұ - 0x04b3, 499, # ҳ Ҳ - 0x04b5, 499, # ҵ Ҵ - 0x04b7, 499, # ҷ Ҷ - 0x04b9, 499, # ҹ Ҹ - 0x04bb, 499, # һ Һ - 0x04bd, 499, # ҽ Ҽ - 0x04bf, 499, # ҿ Ҿ - 0x04c2, 499, # ӂ Ӂ - 0x04c4, 499, # ӄ Ӄ - 0x04c8, 499, # ӈ Ӈ - 0x04cc, 499, # ӌ Ӌ - 0x04d1, 499, # ӑ Ӑ - 0x04d3, 499, # ӓ Ӓ - 0x04d5, 499, # ӕ Ӕ - 0x04d7, 499, # ӗ Ӗ - 0x04d9, 499, # ә Ә - 0x04db, 499, # ӛ Ӛ - 0x04dd, 499, # ӝ Ӝ - 0x04df, 499, # ӟ Ӟ - 0x04e1, 499, # ӡ Ӡ - 0x04e3, 499, # ӣ Ӣ - 0x04e5, 499, # ӥ Ӥ - 0x04e7, 499, # ӧ Ӧ - 0x04e9, 499, # ө Ө - 0x04eb, 499, # ӫ Ӫ - 0x04ef, 499, # ӯ Ӯ - 0x04f1, 499, # ӱ Ӱ - 0x04f3, 499, # ӳ Ӳ - 0x04f5, 499, # ӵ Ӵ - 0x04f9, 499, # ӹ Ӹ - 0x1e01, 499, # ḁ Ḁ - 0x1e03, 499, # ḃ Ḃ - 0x1e05, 499, # ḅ Ḅ - 0x1e07, 499, # ḇ Ḇ - 0x1e09, 499, # ḉ Ḉ - 0x1e0b, 499, # ḋ Ḋ - 0x1e0d, 499, # ḍ Ḍ - 0x1e0f, 499, # ḏ Ḏ - 0x1e11, 499, # ḑ Ḑ - 0x1e13, 499, # ḓ Ḓ - 0x1e15, 499, # ḕ Ḕ - 0x1e17, 499, # ḗ Ḗ - 0x1e19, 499, # ḙ Ḙ - 0x1e1b, 499, # ḛ Ḛ - 0x1e1d, 499, # ḝ Ḝ - 0x1e1f, 499, # ḟ Ḟ - 0x1e21, 499, # ḡ Ḡ - 0x1e23, 499, # ḣ Ḣ - 0x1e25, 499, # ḥ Ḥ - 0x1e27, 499, # ḧ Ḧ - 0x1e29, 499, # ḩ Ḩ - 0x1e2b, 499, # ḫ Ḫ - 0x1e2d, 499, # ḭ Ḭ - 0x1e2f, 499, # ḯ Ḯ - 0x1e31, 499, # ḱ Ḱ - 0x1e33, 499, # ḳ Ḳ - 0x1e35, 499, # ḵ Ḵ - 0x1e37, 499, # ḷ Ḷ - 0x1e39, 499, # ḹ Ḹ - 0x1e3b, 499, # ḻ Ḻ - 0x1e3d, 499, # ḽ Ḽ - 0x1e3f, 499, # ḿ Ḿ - 0x1e41, 499, # ṁ Ṁ - 0x1e43, 499, # ṃ Ṃ - 0x1e45, 499, # ṅ Ṅ - 0x1e47, 499, # ṇ Ṇ - 0x1e49, 499, # ṉ Ṉ - 0x1e4b, 499, # ṋ Ṋ - 0x1e4d, 499, # ṍ Ṍ - 0x1e4f, 499, # ṏ Ṏ - 0x1e51, 499, # ṑ Ṑ - 0x1e53, 499, # ṓ Ṓ - 0x1e55, 499, # ṕ Ṕ - 0x1e57, 499, # ṗ Ṗ - 0x1e59, 499, # ṙ Ṙ - 0x1e5b, 499, # ṛ Ṛ - 0x1e5d, 499, # ṝ Ṝ - 0x1e5f, 499, # ṟ Ṟ - 0x1e61, 499, # ṡ Ṡ - 0x1e63, 499, # ṣ Ṣ - 0x1e65, 499, # ṥ Ṥ - 0x1e67, 499, # ṧ Ṧ - 0x1e69, 499, # ṩ Ṩ - 0x1e6b, 499, # ṫ Ṫ - 0x1e6d, 499, # ṭ Ṭ - 0x1e6f, 499, # ṯ Ṯ - 0x1e71, 499, # ṱ Ṱ - 0x1e73, 499, # ṳ Ṳ - 0x1e75, 499, # ṵ Ṵ - 0x1e77, 499, # ṷ Ṷ - 0x1e79, 499, # ṹ Ṹ - 0x1e7b, 499, # ṻ Ṻ - 0x1e7d, 499, # ṽ Ṽ - 0x1e7f, 499, # ṿ Ṿ - 0x1e81, 499, # ẁ Ẁ - 0x1e83, 499, # ẃ Ẃ - 0x1e85, 499, # ẅ Ẅ - 0x1e87, 499, # ẇ Ẇ - 0x1e89, 499, # ẉ Ẉ - 0x1e8b, 499, # ẋ Ẋ - 0x1e8d, 499, # ẍ Ẍ - 0x1e8f, 499, # ẏ Ẏ - 0x1e91, 499, # ẑ Ẑ - 0x1e93, 499, # ẓ Ẓ - 0x1e95, 499, # ẕ Ẕ - 0x1ea1, 499, # ạ Ạ - 0x1ea3, 499, # ả Ả - 0x1ea5, 499, # ấ Ấ - 0x1ea7, 499, # ầ Ầ - 0x1ea9, 499, # ẩ Ẩ - 0x1eab, 499, # ẫ Ẫ - 0x1ead, 499, # ậ Ậ - 0x1eaf, 499, # ắ Ắ - 0x1eb1, 499, # ằ Ằ - 0x1eb3, 499, # ẳ Ẳ - 0x1eb5, 499, # ẵ Ẵ - 0x1eb7, 499, # ặ Ặ - 0x1eb9, 499, # ẹ Ẹ - 0x1ebb, 499, # ẻ Ẻ - 0x1ebd, 499, # ẽ Ẽ - 0x1ebf, 499, # ế Ế - 0x1ec1, 499, # ề Ề - 0x1ec3, 499, # ể Ể - 0x1ec5, 499, # ễ Ễ - 0x1ec7, 499, # ệ Ệ - 0x1ec9, 499, # ỉ Ỉ - 0x1ecb, 499, # ị Ị - 0x1ecd, 499, # ọ Ọ - 0x1ecf, 499, # ỏ Ỏ - 0x1ed1, 499, # ố Ố - 0x1ed3, 499, # ồ Ồ - 0x1ed5, 499, # ổ Ổ - 0x1ed7, 499, # ỗ Ỗ - 0x1ed9, 499, # ộ Ộ - 0x1edb, 499, # ớ Ớ - 0x1edd, 499, # ờ Ờ - 0x1edf, 499, # ở Ở - 0x1ee1, 499, # ỡ Ỡ - 0x1ee3, 499, # ợ Ợ - 0x1ee5, 499, # ụ Ụ - 0x1ee7, 499, # ủ Ủ - 0x1ee9, 499, # ứ Ứ - 0x1eeb, 499, # ừ Ừ - 0x1eed, 499, # ử Ử - 0x1eef, 499, # ữ Ữ - 0x1ef1, 499, # ự Ự - 0x1ef3, 499, # ỳ Ỳ - 0x1ef5, 499, # ỵ Ỵ - 0x1ef7, 499, # ỷ Ỷ - 0x1ef9, 499, # ỹ Ỹ - 0x1f51, 508, # ὑ Ὑ - 0x1f53, 508, # ὓ Ὓ - 0x1f55, 508, # ὕ Ὕ - 0x1f57, 508, # ὗ Ὗ - 0x1fb3, 509, # ᾳ ᾼ - 0x1fc3, 509, # ῃ ῌ - 0x1fe5, 507, # ῥ Ῥ - 0x1ff3, 509] # ῳ ῼ - - tolowerRanges = [ - 0x0041, 0x005a, 532, # A-Z a-z - 0x00c0, 0x00d6, 532, # À-Ö à-ö - 0x00d8, 0x00de, 532, # Ø-Þ ø-þ - 0x0189, 0x018a, 705, # Ɖ-Ɗ ɖ-ɗ - 0x018e, 0x018f, 702, # Ǝ-Ə ɘ-ə - 0x01b1, 0x01b2, 717, # Ʊ-Ʋ ʊ-ʋ - 0x0388, 0x038a, 537, # Έ-Ί έ-ί - 0x038e, 0x038f, 563, # Ύ-Ώ ύ-ώ - 0x0391, 0x03a1, 532, # Α-Ρ α-ρ - 0x03a3, 0x03ab, 532, # Σ-Ϋ σ-ϋ - 0x0401, 0x040c, 580, # Ё-Ќ ё-ќ - 0x040e, 0x040f, 580, # Ў-Џ ў-џ - 0x0410, 0x042f, 532, # А-Я а-я - 0x0531, 0x0556, 548, # Ա-Ֆ ա-ֆ - 0x10a0, 0x10c5, 548, # Ⴀ-Ⴥ ა-ჵ - 0x1f08, 0x1f0f, 492, # Ἀ-Ἇ ἀ-ἇ - 0x1f18, 0x1f1d, 492, # Ἐ-Ἕ ἐ-ἕ - 0x1f28, 0x1f2f, 492, # Ἠ-Ἧ ἠ-ἧ - 0x1f38, 0x1f3f, 492, # Ἰ-Ἷ ἰ-ἷ - 0x1f48, 0x1f4d, 492, # Ὀ-Ὅ ὀ-ὅ - 0x1f68, 0x1f6f, 492, # Ὠ-Ὧ ὠ-ὧ - 0x1f88, 0x1f8f, 492, # ᾈ-ᾏ ᾀ-ᾇ - 0x1f98, 0x1f9f, 492, # ᾘ-ᾟ ᾐ-ᾗ - 0x1fa8, 0x1faf, 492, # ᾨ-ᾯ ᾠ-ᾧ - 0x1fb8, 0x1fb9, 492, # Ᾰ-Ᾱ ᾰ-ᾱ - 0x1fba, 0x1fbb, 426, # Ὰ-Ά ὰ-ά - 0x1fc8, 0x1fcb, 414, # Ὲ-Ή ὲ-ή - 0x1fd8, 0x1fd9, 492, # Ῐ-Ῑ ῐ-ῑ - 0x1fda, 0x1fdb, 400, # Ὶ-Ί ὶ-ί - 0x1fe8, 0x1fe9, 492, # Ῠ-Ῡ ῠ-ῡ - 0x1fea, 0x1feb, 388, # Ὺ-Ύ ὺ-ύ - 0x1ff8, 0x1ff9, 372, # Ὸ-Ό ὸ-ό - 0x1ffa, 0x1ffb, 374, # Ὼ-Ώ ὼ-ώ - 0x2160, 0x216f, 516, # Ⅰ-Ⅿ ⅰ-ⅿ - 0x24b6, 0x24cf, 526, # Ⓐ-Ⓩ ⓐ-ⓩ - 0xff21, 0xff3a, 532] # Ａ-Ｚ ａ-ｚ - - tolowerSinglets = [ - 0x0100, 501, # Ā ā - 0x0102, 501, # Ă ă - 0x0104, 501, # Ą ą - 0x0106, 501, # Ć ć - 0x0108, 501, # Ĉ ĉ - 0x010a, 501, # Ċ ċ - 0x010c, 501, # Č č - 0x010e, 501, # Ď ď - 0x0110, 501, # Đ đ - 0x0112, 501, # Ē ē - 0x0114, 501, # Ĕ ĕ - 0x0116, 501, # Ė ė - 0x0118, 501, # Ę ę - 0x011a, 501, # Ě ě - 0x011c, 501, # Ĝ ĝ - 0x011e, 501, # Ğ ğ - 0x0120, 501, # Ġ ġ - 0x0122, 501, # Ģ ģ - 0x0124, 501, # Ĥ ĥ - 0x0126, 501, # Ħ ħ - 0x0128, 501, # Ĩ ĩ - 0x012a, 501, # Ī ī - 0x012c, 501, # Ĭ ĭ - 0x012e, 501, # Į į - 0x0130, 301, # İ i - 0x0132, 501, # IJ ij - 0x0134, 501, # Ĵ ĵ - 0x0136, 501, # Ķ ķ - 0x0139, 501, # Ĺ ĺ - 0x013b, 501, # Ļ ļ - 0x013d, 501, # Ľ ľ - 0x013f, 501, # Ŀ ŀ - 0x0141, 501, # Ł ł - 0x0143, 501, # Ń ń - 0x0145, 501, # Ņ ņ - 0x0147, 501, # Ň ň - 0x014a, 501, # Ŋ ŋ - 0x014c, 501, # Ō ō - 0x014e, 501, # Ŏ ŏ - 0x0150, 501, # Ő ő - 0x0152, 501, # Œ œ - 0x0154, 501, # Ŕ ŕ - 0x0156, 501, # Ŗ ŗ - 0x0158, 501, # Ř ř - 0x015a, 501, # Ś ś - 0x015c, 501, # Ŝ ŝ - 0x015e, 501, # Ş ş - 0x0160, 501, # Š š - 0x0162, 501, # Ţ ţ - 0x0164, 501, # Ť ť - 0x0166, 501, # Ŧ ŧ - 0x0168, 501, # Ũ ũ - 0x016a, 501, # Ū ū - 0x016c, 501, # Ŭ ŭ - 0x016e, 501, # Ů ů - 0x0170, 501, # Ű ű - 0x0172, 501, # Ų ų - 0x0174, 501, # Ŵ ŵ - 0x0176, 501, # Ŷ ŷ - 0x0178, 379, # Ÿ ÿ - 0x0179, 501, # Ź ź - 0x017b, 501, # Ż ż - 0x017d, 501, # Ž ž - 0x0181, 710, # Ɓ ɓ - 0x0182, 501, # Ƃ ƃ - 0x0184, 501, # Ƅ ƅ - 0x0186, 706, # Ɔ ɔ - 0x0187, 501, # Ƈ ƈ - 0x018b, 501, # Ƌ ƌ - 0x0190, 703, # Ɛ ɛ - 0x0191, 501, # Ƒ ƒ - 0x0193, 705, # Ɠ ɠ - 0x0194, 707, # Ɣ ɣ - 0x0196, 711, # Ɩ ɩ - 0x0197, 709, # Ɨ ɨ - 0x0198, 501, # Ƙ ƙ - 0x019c, 711, # Ɯ ɯ - 0x019d, 713, # Ɲ ɲ - 0x01a0, 501, # Ơ ơ - 0x01a2, 501, # Ƣ ƣ - 0x01a4, 501, # Ƥ ƥ - 0x01a7, 501, # Ƨ ƨ - 0x01a9, 718, # Ʃ ʃ - 0x01ac, 501, # Ƭ ƭ - 0x01ae, 718, # Ʈ ʈ - 0x01af, 501, # Ư ư - 0x01b3, 501, # Ƴ ƴ - 0x01b5, 501, # Ƶ ƶ - 0x01b7, 719, # Ʒ ʒ - 0x01b8, 501, # Ƹ ƹ - 0x01bc, 501, # Ƽ ƽ - 0x01c4, 502, # DŽ dž - 0x01c5, 501, # Dž dž - 0x01c7, 502, # LJ lj - 0x01c8, 501, # Lj lj - 0x01ca, 502, # NJ nj - 0x01cb, 501, # Nj nj - 0x01cd, 501, # Ǎ ǎ - 0x01cf, 501, # Ǐ ǐ - 0x01d1, 501, # Ǒ ǒ - 0x01d3, 501, # Ǔ ǔ - 0x01d5, 501, # Ǖ ǖ - 0x01d7, 501, # Ǘ ǘ - 0x01d9, 501, # Ǚ ǚ - 0x01db, 501, # Ǜ ǜ - 0x01de, 501, # Ǟ ǟ - 0x01e0, 501, # Ǡ ǡ - 0x01e2, 501, # Ǣ ǣ - 0x01e4, 501, # Ǥ ǥ - 0x01e6, 501, # Ǧ ǧ - 0x01e8, 501, # Ǩ ǩ - 0x01ea, 501, # Ǫ ǫ - 0x01ec, 501, # Ǭ ǭ - 0x01ee, 501, # Ǯ ǯ - 0x01f1, 502, # DZ dz - 0x01f2, 501, # Dz dz - 0x01f4, 501, # Ǵ ǵ - 0x01fa, 501, # Ǻ ǻ - 0x01fc, 501, # Ǽ ǽ - 0x01fe, 501, # Ǿ ǿ - 0x0200, 501, # Ȁ ȁ - 0x0202, 501, # Ȃ ȃ - 0x0204, 501, # Ȅ ȅ - 0x0206, 501, # Ȇ ȇ - 0x0208, 501, # Ȉ ȉ - 0x020a, 501, # Ȋ ȋ - 0x020c, 501, # Ȍ ȍ - 0x020e, 501, # Ȏ ȏ - 0x0210, 501, # Ȑ ȑ - 0x0212, 501, # Ȓ ȓ - 0x0214, 501, # Ȕ ȕ - 0x0216, 501, # Ȗ ȗ - 0x0386, 538, # Ά ά - 0x038c, 564, # Ό ό - 0x03e2, 501, # Ϣ ϣ - 0x03e4, 501, # Ϥ ϥ - 0x03e6, 501, # Ϧ ϧ - 0x03e8, 501, # Ϩ ϩ - 0x03ea, 501, # Ϫ ϫ - 0x03ec, 501, # Ϭ ϭ - 0x03ee, 501, # Ϯ ϯ - 0x0460, 501, # Ѡ ѡ - 0x0462, 501, # Ѣ ѣ - 0x0464, 501, # Ѥ ѥ - 0x0466, 501, # Ѧ ѧ - 0x0468, 501, # Ѩ ѩ - 0x046a, 501, # Ѫ ѫ - 0x046c, 501, # Ѭ ѭ - 0x046e, 501, # Ѯ ѯ - 0x0470, 501, # Ѱ ѱ - 0x0472, 501, # Ѳ ѳ - 0x0474, 501, # Ѵ ѵ - 0x0476, 501, # Ѷ ѷ - 0x0478, 501, # Ѹ ѹ - 0x047a, 501, # Ѻ ѻ - 0x047c, 501, # Ѽ ѽ - 0x047e, 501, # Ѿ ѿ - 0x0480, 501, # Ҁ ҁ - 0x0490, 501, # Ґ ґ - 0x0492, 501, # Ғ ғ - 0x0494, 501, # Ҕ ҕ - 0x0496, 501, # Җ җ - 0x0498, 501, # Ҙ ҙ - 0x049a, 501, # Қ қ - 0x049c, 501, # Ҝ ҝ - 0x049e, 501, # Ҟ ҟ - 0x04a0, 501, # Ҡ ҡ - 0x04a2, 501, # Ң ң - 0x04a4, 501, # Ҥ ҥ - 0x04a6, 501, # Ҧ ҧ - 0x04a8, 501, # Ҩ ҩ - 0x04aa, 501, # Ҫ ҫ - 0x04ac, 501, # Ҭ ҭ - 0x04ae, 501, # Ү ү - 0x04b0, 501, # Ұ ұ - 0x04b2, 501, # Ҳ ҳ - 0x04b4, 501, # Ҵ ҵ - 0x04b6, 501, # Ҷ ҷ - 0x04b8, 501, # Ҹ ҹ - 0x04ba, 501, # Һ һ - 0x04bc, 501, # Ҽ ҽ - 0x04be, 501, # Ҿ ҿ - 0x04c1, 501, # Ӂ ӂ - 0x04c3, 501, # Ӄ ӄ - 0x04c7, 501, # Ӈ ӈ - 0x04cb, 501, # Ӌ ӌ - 0x04d0, 501, # Ӑ ӑ - 0x04d2, 501, # Ӓ ӓ - 0x04d4, 501, # Ӕ ӕ - 0x04d6, 501, # Ӗ ӗ - 0x04d8, 501, # Ә ә - 0x04da, 501, # Ӛ ӛ - 0x04dc, 501, # Ӝ ӝ - 0x04de, 501, # Ӟ ӟ - 0x04e0, 501, # Ӡ ӡ - 0x04e2, 501, # Ӣ ӣ - 0x04e4, 501, # Ӥ ӥ - 0x04e6, 501, # Ӧ ӧ - 0x04e8, 501, # Ө ө - 0x04ea, 501, # Ӫ ӫ - 0x04ee, 501, # Ӯ ӯ - 0x04f0, 501, # Ӱ ӱ - 0x04f2, 501, # Ӳ ӳ - 0x04f4, 501, # Ӵ ӵ - 0x04f8, 501, # Ӹ ӹ - 0x1e00, 501, # Ḁ ḁ - 0x1e02, 501, # Ḃ ḃ - 0x1e04, 501, # Ḅ ḅ - 0x1e06, 501, # Ḇ ḇ - 0x1e08, 501, # Ḉ ḉ - 0x1e0a, 501, # Ḋ ḋ - 0x1e0c, 501, # Ḍ ḍ - 0x1e0e, 501, # Ḏ ḏ - 0x1e10, 501, # Ḑ ḑ - 0x1e12, 501, # Ḓ ḓ - 0x1e14, 501, # Ḕ ḕ - 0x1e16, 501, # Ḗ ḗ - 0x1e18, 501, # Ḙ ḙ - 0x1e1a, 501, # Ḛ ḛ - 0x1e1c, 501, # Ḝ ḝ - 0x1e1e, 501, # Ḟ ḟ - 0x1e20, 501, # Ḡ ḡ - 0x1e22, 501, # Ḣ ḣ - 0x1e24, 501, # Ḥ ḥ - 0x1e26, 501, # Ḧ ḧ - 0x1e28, 501, # Ḩ ḩ - 0x1e2a, 501, # Ḫ ḫ - 0x1e2c, 501, # Ḭ ḭ - 0x1e2e, 501, # Ḯ ḯ - 0x1e30, 501, # Ḱ ḱ - 0x1e32, 501, # Ḳ ḳ - 0x1e34, 501, # Ḵ ḵ - 0x1e36, 501, # Ḷ ḷ - 0x1e38, 501, # Ḹ ḹ - 0x1e3a, 501, # Ḻ ḻ - 0x1e3c, 501, # Ḽ ḽ - 0x1e3e, 501, # Ḿ ḿ - 0x1e40, 501, # Ṁ ṁ - 0x1e42, 501, # Ṃ ṃ - 0x1e44, 501, # Ṅ ṅ - 0x1e46, 501, # Ṇ ṇ - 0x1e48, 501, # Ṉ ṉ - 0x1e4a, 501, # Ṋ ṋ - 0x1e4c, 501, # Ṍ ṍ - 0x1e4e, 501, # Ṏ ṏ - 0x1e50, 501, # Ṑ ṑ - 0x1e52, 501, # Ṓ ṓ - 0x1e54, 501, # Ṕ ṕ - 0x1e56, 501, # Ṗ ṗ - 0x1e58, 501, # Ṙ ṙ - 0x1e5a, 501, # Ṛ ṛ - 0x1e5c, 501, # Ṝ ṝ - 0x1e5e, 501, # Ṟ ṟ - 0x1e60, 501, # Ṡ ṡ - 0x1e62, 501, # Ṣ ṣ - 0x1e64, 501, # Ṥ ṥ - 0x1e66, 501, # Ṧ ṧ - 0x1e68, 501, # Ṩ ṩ - 0x1e6a, 501, # Ṫ ṫ - 0x1e6c, 501, # Ṭ ṭ - 0x1e6e, 501, # Ṯ ṯ - 0x1e70, 501, # Ṱ ṱ - 0x1e72, 501, # Ṳ ṳ - 0x1e74, 501, # Ṵ ṵ - 0x1e76, 501, # Ṷ ṷ - 0x1e78, 501, # Ṹ ṹ - 0x1e7a, 501, # Ṻ ṻ - 0x1e7c, 501, # Ṽ ṽ - 0x1e7e, 501, # Ṿ ṿ - 0x1e80, 501, # Ẁ ẁ - 0x1e82, 501, # Ẃ ẃ - 0x1e84, 501, # Ẅ ẅ - 0x1e86, 501, # Ẇ ẇ - 0x1e88, 501, # Ẉ ẉ - 0x1e8a, 501, # Ẋ ẋ - 0x1e8c, 501, # Ẍ ẍ - 0x1e8e, 501, # Ẏ ẏ - 0x1e90, 501, # Ẑ ẑ - 0x1e92, 501, # Ẓ ẓ - 0x1e94, 501, # Ẕ ẕ - 0x1ea0, 501, # Ạ ạ - 0x1ea2, 501, # Ả ả - 0x1ea4, 501, # Ấ ấ - 0x1ea6, 501, # Ầ ầ - 0x1ea8, 501, # Ẩ ẩ - 0x1eaa, 501, # Ẫ ẫ - 0x1eac, 501, # Ậ ậ - 0x1eae, 501, # Ắ ắ - 0x1eb0, 501, # Ằ ằ - 0x1eb2, 501, # Ẳ ẳ - 0x1eb4, 501, # Ẵ ẵ - 0x1eb6, 501, # Ặ ặ - 0x1eb8, 501, # Ẹ ẹ - 0x1eba, 501, # Ẻ ẻ - 0x1ebc, 501, # Ẽ ẽ - 0x1ebe, 501, # Ế ế - 0x1ec0, 501, # Ề ề - 0x1ec2, 501, # Ể ể - 0x1ec4, 501, # Ễ ễ - 0x1ec6, 501, # Ệ ệ - 0x1ec8, 501, # Ỉ ỉ - 0x1eca, 501, # Ị ị - 0x1ecc, 501, # Ọ ọ - 0x1ece, 501, # Ỏ ỏ - 0x1ed0, 501, # Ố ố - 0x1ed2, 501, # Ồ ồ - 0x1ed4, 501, # Ổ ổ - 0x1ed6, 501, # Ỗ ỗ - 0x1ed8, 501, # Ộ ộ - 0x1eda, 501, # Ớ ớ - 0x1edc, 501, # Ờ ờ - 0x1ede, 501, # Ở ở - 0x1ee0, 501, # Ỡ ỡ - 0x1ee2, 501, # Ợ ợ - 0x1ee4, 501, # Ụ ụ - 0x1ee6, 501, # Ủ ủ - 0x1ee8, 501, # Ứ ứ - 0x1eea, 501, # Ừ ừ - 0x1eec, 501, # Ử ử - 0x1eee, 501, # Ữ ữ - 0x1ef0, 501, # Ự ự - 0x1ef2, 501, # Ỳ ỳ - 0x1ef4, 501, # Ỵ ỵ - 0x1ef6, 501, # Ỷ ỷ - 0x1ef8, 501, # Ỹ ỹ - 0x1f59, 492, # Ὑ ὑ - 0x1f5b, 492, # Ὓ ὓ - 0x1f5d, 492, # Ὕ ὕ - 0x1f5f, 492, # Ὗ ὗ - 0x1fbc, 491, # ᾼ ᾳ - 0x1fcc, 491, # ῌ ῃ - 0x1fec, 493, # Ῥ ῥ - 0x1ffc, 491] # ῼ ῳ - - toTitleSinglets = [ - 0x01c4, 501, # DŽ Dž - 0x01c6, 499, # dž Dž - 0x01c7, 501, # LJ Lj - 0x01c9, 499, # lj Lj - 0x01ca, 501, # NJ Nj - 0x01cc, 499, # nj Nj - 0x01f1, 501, # DZ Dz - 0x01f3, 499] # dz Dz - -proc binarySearch(c: irune, tab: openArray[iRune], len, stride: int): int = - var n = len - var t = 0 - while n > 1: - var m = n div 2 - var p = t + m*stride - if c >= tab[p]: - t = p - n = n-m - else: - n = m - if n != 0 and c >= tab[t]: - return t - return -1 - -proc toLower*(c: TRune): TRune = - ## Converts `c` into lower case. This works for any Unicode character. - ## If possible, prefer `toLower` over `toUpper`. - var c = irune(c) - var p = binarySearch(c, tolowerRanges, len(toLowerRanges) div 3, 3) - if p >= 0 and c >= tolowerRanges[p] and c <= tolowerRanges[p+1]: - return TRune(c + tolowerRanges[p+2] - 500) - p = binarySearch(c, toLowerSinglets, len(toLowerSinglets) div 2, 2) - if p >= 0 and c == toLowerSinglets[p]: - return TRune(c + toLowerSinglets[p+1] - 500) - return TRune(c) - -proc toUpper*(c: TRune): TRune = - ## Converts `c` into upper case. This works for any Unicode character. - ## If possible, prefer `toLower` over `toUpper`. - var c = irune(c) - var p = binarySearch(c, toUpperRanges, len(toUpperRanges) div 3, 3) - if p >= 0 and c >= toUpperRanges[p] and c <= toUpperRanges[p+1]: - return TRune(c + toUpperRanges[p+2] - 500) - p = binarySearch(c, toUpperSinglets, len(toUpperSinglets) div 2, 2) - if p >= 0 and c == toUpperSinglets[p]: - return TRune(c + toUpperSinglets[p+1] - 500) - return TRune(c) - -proc toTitle*(c: TRune): TRune = - var c = irune(c) - var p = binarySearch(c, toTitleSinglets, len(toTitleSinglets) div 2, 2) - if p >= 0 and c == toTitleSinglets[p]: - return TRune(c + toTitleSinglets[p+1] - 500) - return TRune(c) - -proc isLower*(c: TRune): bool = - ## returns true iff `c` is a lower case Unicode character - ## If possible, prefer `isLower` over `isUpper`. - var c = irune(c) - # Note: toUpperRanges is correct here! - var p = binarySearch(c, toUpperRanges, len(toUpperRanges) div 3, 3) - if p >= 0 and c >= toUpperRanges[p] and c <= toUpperRanges[p+1]: - return true - p = binarySearch(c, toUpperSinglets, len(toUpperSinglets) div 2, 2) - if p >= 0 and c == toUpperSinglets[p]: - return true - -proc isUpper*(c: TRune): bool = - ## returns true iff `c` is a upper case Unicode character - ## If possible, prefer `isLower` over `isUpper`. - var c = irune(c) - # Note: toLowerRanges is correct here! - var p = binarySearch(c, toLowerRanges, len(toLowerRanges) div 3, 3) - if p >= 0 and c >= toLowerRanges[p] and c <= toLowerRanges[p+1]: - return true - p = binarySearch(c, toLowerSinglets, len(toLowerSinglets) div 2, 2) - if p >= 0 and c == toLowerSinglets[p]: - return true - -proc isAlpha*(c: TRune): bool = - ## returns true iff `c` is an *alpha* Unicode character (i.e. a letter) - if isUpper(c) or isLower(c): - return true - var c = irune(c) - var p = binarySearch(c, alphaRanges, len(alphaRanges) div 2, 2) - if p >= 0 and c >= alphaRanges[p] and c <= alphaRanges[p+1]: - return true - p = binarySearch(c, alphaSinglets, len(alphaSinglets), 1) - if p >= 0 and c == alphaSinglets[p]: - return true - -proc isTitle*(c: TRune): bool = - return isUpper(c) and isLower(c) - -proc isWhiteSpace*(c: TRune): bool = - ## returns true iff `c` is a Unicode whitespace character - var c = irune(c) - var p = binarySearch(c, spaceRanges, len(spaceRanges) div 2, 2) - if p >= 0 and c >= spaceRanges[p] and c <= spaceRanges[p+1]: - return true - -iterator runes*(s: string): TRune = - ## iterates over any unicode character of the string `s`. - var - i = 0 - result: TRune - while i < len(s): - fastRuneAt(s, i, result, true) - yield result - -proc cmpRunesIgnoreCase*(a, b: string): int = - ## compares two UTF8 strings and ignores the case. Returns: - ## - ## | 0 iff a == b - ## | < 0 iff a < b - ## | > 0 iff a > b - var i = 0 - var j = 0 - var ar, br: TRune - while i < a.len and j < b.len: - # slow path: - fastRuneAt(a, i, ar) - fastRuneAt(b, j, br) - result = irune(toLower(ar)) - irune(toLower(br)) - if result != 0: return - result = a.len - b.len - diff --git a/nimlib/pure/variants.nim b/nimlib/pure/variants.nim deleted file mode 100755 index 40679c779e..0000000000 --- a/nimlib/pure/variants.nim +++ /dev/null @@ -1,181 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements Nimrod's support for the ``variant`` datatype. -## `TVariant` shows how the flexibility of dynamic typing is achieved -## within a static type system. - -type - TVarType* = enum - vtNone, - vtBool, - vtChar, - vtEnum, - vtInt, - vtFloat, - vtString, - vtSet, - vtSeq, - vtDict - TVariant* {.final.} = object of TObject - case vtype: TVarType - of vtNone: nil - of vtBool, vtChar, vtEnum, vtInt: vint: int64 - of vtFloat: vfloat: float64 - of vtString: vstring: string - of vtSet, vtSeq: q: seq[TVariant] - of vtDict: d: seq[tuple[key, val: TVariant]] - -iterator objectFields*[T](x: T, skipInherited: bool): tuple[ - key: string, val: TVariant] {.magic: "ObjectFields"} - -proc `<>`*(x: ordinal): TVariant = - result.kind = vtEnum - result.vint = x - -proc `<>`*(x: biggestInt): TVariant = - result.kind = vtInt - result.vint = x - -proc `<>`*(x: char): TVariant = - result.kind = vtChar - result.vint = ord(x) - -proc `<>`*(x: bool): TVariant = - result.kind = vtBool - result.vint = ord(x) - -proc `<>`*(x: biggestFloat): TVariant = - result.kind = vtFloat - result.vfloat = x - -proc `<>`*(x: string): TVariant = - result.kind = vtString - result.vstring = x - -proc `<>`*[T](x: openArray[T]): TVariant = - result.kind = vtSeq - newSeq(result.q, x.len) - for i in 0..x.len-1: result.q[i] = <>x[i] - -proc `<>`*[T](x: set[T]): TVariant = - result.kind = vtSet - result.q = @[] - for a in items(x): result.q.add(<>a) - -proc `<>`* [T: object](x: T): TVariant {.magic: "ToVariant".} - ## this converts a value to a variant ("boxing") - -proc `><`*[T](v: TVariant, typ: T): T {.magic: "FromVariant".} - -[<>5, <>67, <>"hello"] -myVar>b] -proc `[]`* (a: TVariant, b: string): TVariant {.inline} = return a[<>b] -proc `[]=`* (a: TVariant, b: int, c: TVariant) {.inline} = a[<>b] = c -proc `[]=`* (a: TVariant, b: string, c: TVariant) {.inline} = a[<>b] = c - -proc `+`* (x, y: TVariant): TVariant = - case x.vtype - of vtBool, vtChar, vtEnum, vtInt: - if y.vtype == x.vtype: - result.vtype = x.vtype - result.vint = x.vint + y.vint - else: - case y.vtype - of vtBool, vtChar, vtEnum, vtInt: - - - - vint: int64 - of vtFloat: vfloat: float64 - of vtString: vstring: string - of vtSet, vtSeq: q: seq[TVariant] - of vtDict: d: seq[tuple[key, val: TVariant]] - -proc `-`* (x, y: TVariant): TVariant -proc `*`* (x, y: TVariant): TVariant -proc `/`* (x, y: TVariant): TVariant -proc `div`* (x, y: TVariant): TVariant -proc `mod`* (x, y: TVariant): TVariant -proc `&`* (x, y: TVariant): TVariant -proc `$`* (x: TVariant): string = - # uses JS notation - -proc parseVariant*(s: string): TVariant -proc `<`* (x, y: TVariant): bool -proc `<=`* (x, y: TVariant): bool - -proc hash*(x: TVariant): int = - - diff --git a/nimlib/pure/xmlgen.nim b/nimlib/pure/xmlgen.nim deleted file mode 100755 index 79a7822529..0000000000 --- a/nimlib/pure/xmlgen.nim +++ /dev/null @@ -1,406 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a simple `XML`:idx: and `HTML`:idx: code -## generator. Each commonly used HTML tag has a corresponding macro -## that generates a string with its HTML representation. -## -## Example: -## -## .. code-block:: nimrod -## var nim = "Nimrod" -## echo h1(a(href="http://force7.de/nimrod", nim)) -## -## Writes the string:: -## -##

    Nimrod

    -## - -import - macros, strutils - -const - coreAttr* = " id class title style " - eventAttr* = " onclick ondblclick onmousedown onmouseup " & - "onmouseover onmousemove onmouseout onkeypress onkeydown onkeyup " - commonAttr* = coreAttr & eventAttr - -proc getIdent(e: PNimrodNode): string {.compileTime.} = - case e.kind - of nnkIdent: result = normalize($e.ident) - of nnkAccQuoted: result = getIdent(e[0]) - else: error("cannot extract identifier from node: " & toStrLit(e).strVal) - -proc delete[T](s: var seq[T], attr: T): bool = - var idx = find(s, attr) - if idx >= 0: - var L = s.len - s[idx] = s[L-1] - setLen(s, L-1) - result = true - -proc xmlCheckedTag*(e: PNimrodNode, tag: string, - optAttr = "", reqAttr = "", - isLeaf = false): PNimrodNode {.compileTime.} = - ## use this procedure to define a new XML tag - - # copy the attributes; when iterating over them these lists - # will be modified, so that each attribute is only given one value - var req = splitSeq(reqAttr) - var opt = splitSeq(optAttr) - result = newNimNode(nnkBracket, e) - result.add(newStrLitNode("<")) - result.add(newStrLitNode(tag)) - # first pass over attributes: - for i in 1..e.len-1: - if e[i].kind == nnkExprEqExpr: - var name = getIdent(e[i][0]) - if delete(req, name) or delete(opt, name): - result.add(newStrLitNode(" ")) - result.add(newStrLitNode(name)) - result.add(newStrLitNode("=\"")) - result.add(e[i][1]) - result.add(newStrLitNode("\"")) - else: - error("invalid attribute for '" & tag & "' element: " & name) - # check each required attribute exists: - if req.len > 0: - error(req[0] & " attribute for '" & tag & "' element expected") - if isLeaf: - for i in 1..e.len-1: - if e[i].kind != nnkExprEqExpr: - error("element " & tag & " cannot be nested") - result.add(newStrLitNode(" />")) - else: - result.add(newStrLitNode(">")) - # second pass over elements: - for i in 1..e.len-1: - if e[i].kind != nnkExprEqExpr: result.add(e[i]) - result.add(newStrLitNode("")) - result = NestList(!"&", result) - - -macro a*(e: expr): expr = - ## generates the HTML ``a`` element. - result = xmlCheckedTag(e, "a", "href charset type hreflang rel rev " & - "accesskey tabindex" & commonAttr) - -macro acronym*(e: expr): expr = - ## generates the HTML ``acronym`` element. - result = xmlCheckedTag(e, "acronym", commonAttr) - -macro address*(e: expr): expr = - ## generates the HTML ``address`` element. - result = xmlCheckedTag(e, "address", commonAttr) - -macro area*(e: expr): expr = - ## generates the HTML ``area`` element. - result = xmlCheckedTag(e, "area", "shape coords href nohref" & - " accesskey tabindex" & commonAttr, "alt", true) - -macro b*(e: expr): expr = - ## generates the HTML ``b`` element. - result = xmlCheckedTag(e, "b", commonAttr) - -macro base*(e: expr): expr = - ## generates the HTML ``base`` element. - result = xmlCheckedTag(e, "base", "", "href", true) - -macro big*(e: expr): expr = - ## generates the HTML ``big`` element. - result = xmlCheckedTag(e, "big", commonAttr) - -macro blockquote*(e: expr): expr = - ## generates the HTML ``blockquote`` element. - result = xmlCheckedTag(e, "blockquote", " cite" & commonAttr) - -macro body*(e: expr): expr = - ## generates the HTML ``body`` element. - result = xmlCheckedTag(e, "body", commonAttr) - -macro br*(e: expr): expr = - ## generates the HTML ``br`` element. - result = xmlCheckedTag(e, "br", "", "", true) - -macro button*(e: expr): expr = - ## generates the HTML ``button`` element. - result = xmlCheckedTag(e, "button", "accesskey tabindex " & - "disabled name type value" & commonAttr) - -macro caption*(e: expr): expr = - ## generates the HTML ``caption`` element. - result = xmlCheckedTag(e, "caption", commonAttr) - -macro cite*(e: expr): expr = - ## generates the HTML ``cite`` element. - result = xmlCheckedTag(e, "cite", commonAttr) - -macro code*(e: expr): expr = - ## generates the HTML ``code`` element. - result = xmlCheckedTag(e, "code", commonAttr) - -macro col*(e: expr): expr = - ## generates the HTML ``col`` element. - result = xmlCheckedTag(e, "col", "span align valign" & commonAttr, "", true) - -macro colgroup*(e: expr): expr = - ## generates the HTML ``colgroup`` element. - result = xmlCheckedTag(e, "colgroup", "span align valign" & commonAttr) - -macro dd*(e: expr): expr = - ## generates the HTML ``dd`` element. - result = xmlCheckedTag(e, "dd", commonAttr) - -macro del*(e: expr): expr = - ## generates the HTML ``del`` element. - result = xmlCheckedTag(e, "del", "cite datetime" & commonAttr) - -macro dfn*(e: expr): expr = - ## generates the HTML ``dfn`` element. - result = xmlCheckedTag(e, "dfn", commonAttr) - -macro `div`*(e: expr): expr = - ## generates the HTML ``div`` element. - result = xmlCheckedTag(e, "div", commonAttr) - -macro dl*(e: expr): expr = - ## generates the HTML ``dl`` element. - result = xmlCheckedTag(e, "dl", commonAttr) - -macro dt*(e: expr): expr = - ## generates the HTML ``dt`` element. - result = xmlCheckedTag(e, "dt", commonAttr) - -macro em*(e: expr): expr = - ## generates the HTML ``em`` element. - result = xmlCheckedTag(e, "em", commonAttr) - -macro fieldset*(e: expr): expr = - ## generates the HTML ``fieldset`` element. - result = xmlCheckedTag(e, "fieldset", commonAttr) - -macro form*(e: expr): expr = - ## generates the HTML ``form`` element. - result = xmlCheckedTag(e, "form", "method encype accept accept-charset" & - commonAttr, "action") - -macro h1*(e: expr): expr = - ## generates the HTML ``h1`` element. - result = xmlCheckedTag(e, "h1", commonAttr) - -macro h2*(e: expr): expr = - ## generates the HTML ``h2`` element. - result = xmlCheckedTag(e, "h2", commonAttr) - -macro h3*(e: expr): expr = - ## generates the HTML ``h3`` element. - result = xmlCheckedTag(e, "h3", commonAttr) - -macro h4*(e: expr): expr = - ## generates the HTML ``h4`` element. - result = xmlCheckedTag(e, "h4", commonAttr) - -macro h5*(e: expr): expr = - ## generates the HTML ``h5`` element. - result = xmlCheckedTag(e, "h5", commonAttr) - -macro h6*(e: expr): expr = - ## generates the HTML ``h6`` element. - result = xmlCheckedTag(e, "h6", commonAttr) - -macro head*(e: expr): expr = - ## generates the HTML ``head`` element. - result = xmlCheckedTag(e, "head", "profile") - -macro html*(e: expr): expr = - ## generates the HTML ``html`` element. - result = xmlCheckedTag(e, "html", "", "xmlns") - -macro hr*(e: expr): expr = - ## generates the HTML ``hr`` element. - result = xmlCheckedTag(e, "hr", commonAttr, "", true) - -macro i*(e: expr): expr = - ## generates the HTML ``i`` element. - result = xmlCheckedTag(e, "i", commonAttr) - -macro img*(e: expr): expr = - ## generates the HTML ``img`` element. - result = xmlCheckedTag(e, "img", "longdesc height width", "src alt", true) - -macro input*(e: expr): expr = - ## generates the HTML ``input`` element. - result = xmlCheckedTag(e, "input", "name type value checked maxlength src" & - " alt accept disabled readonly accesskey tabindex" & commonAttr, "", true) - -macro ins*(e: expr): expr = - ## generates the HTML ``ins`` element. - result = xmlCheckedTag(e, "ins", "cite datetime" & commonAttr) - -macro kbd*(e: expr): expr = - ## generates the HTML ``kbd`` element. - result = xmlCheckedTag(e, "kbd", commonAttr) - -macro label*(e: expr): expr = - ## generates the HTML ``label`` element. - result = xmlCheckedTag(e, "label", "for accesskey" & commonAttr) - -macro legend*(e: expr): expr = - ## generates the HTML ``legend`` element. - result = xmlCheckedTag(e, "legend", "accesskey" & commonAttr) - -macro li*(e: expr): expr = - ## generates the HTML ``li`` element. - result = xmlCheckedTag(e, "li", commonAttr) - -macro link*(e: expr): expr = - ## generates the HTML ``link`` element. - result = xmlCheckedTag(e, "link", "href charset hreflang type rel rev media" & - commonAttr, "", true) - -macro map*(e: expr): expr = - ## generates the HTML ``map`` element. - result = xmlCheckedTag(e, "map", "class title" & eventAttr, "id", false) - -macro meta*(e: expr): expr = - ## generates the HTML ``meta`` element. - result = xmlCheckedTag(e, "meta", "name http-equiv scheme", "content", true) - -macro noscript*(e: expr): expr = - ## generates the HTML ``noscript`` element. - result = xmlCheckedTag(e, "noscript", commonAttr) - -macro `object`*(e: expr): expr = - ## generates the HTML ``object`` element. - result = xmlCheckedTag(e, "object", "classid data codebase declare type " & - "codetype archive standby width height name tabindex" & commonAttr) - -macro ol*(e: expr): expr = - ## generates the HTML ``ol`` element. - result = xmlCheckedTag(e, "ol", commonAttr) - -macro optgroup*(e: expr): expr = - ## generates the HTML ``optgroup`` element. - result = xmlCheckedTag(e, "optgroup", "disabled" & commonAttr, "label", false) - -macro option*(e: expr): expr = - ## generates the HTML ``option`` element. - result = xmlCheckedTag(e, "option", "selected value" & commonAttr) - -macro p*(e: expr): expr = - ## generates the HTML ``p`` element. - result = xmlCheckedTag(e, "p", commonAttr) - -macro param*(e: expr): expr = - ## generates the HTML ``param`` element. - result = xmlCheckedTag(e, "param", "value id type valuetype", "name", true) - -macro pre*(e: expr): expr = - ## generates the HTML ``pre`` element. - result = xmlCheckedTag(e, "pre", commonAttr) - -macro q*(e: expr): expr = - ## generates the HTML ``q`` element. - result = xmlCheckedTag(e, "q", "cite" & commonAttr) - -macro samp*(e: expr): expr = - ## generates the HTML ``samp`` element. - result = xmlCheckedTag(e, "samp", commonAttr) - -macro script*(e: expr): expr = - ## generates the HTML ``script`` element. - result = xmlCheckedTag(e, "script", "src charset defer", "type", false) - -macro select*(e: expr): expr = - ## generates the HTML ``select`` element. - result = xmlCheckedTag(e, "select", "name size multiple disabled tabindex" & - commonAttr) - -macro small*(e: expr): expr = - ## generates the HTML ``small`` element. - result = xmlCheckedTag(e, "small", commonAttr) - -macro span*(e: expr): expr = - ## generates the HTML ``span`` element. - result = xmlCheckedTag(e, "span", commonAttr) - -macro strong*(e: expr): expr = - ## generates the HTML ``strong`` element. - result = xmlCheckedTag(e, "strong", commonAttr) - -macro style*(e: expr): expr = - ## generates the HTML ``style`` element. - result = xmlCheckedTag(e, "style", "media title", "type") - -macro sub*(e: expr): expr = - ## generates the HTML ``sub`` element. - result = xmlCheckedTag(e, "sub", commonAttr) - -macro sup*(e: expr): expr = - ## generates the HTML ``sup`` element. - result = xmlCheckedTag(e, "sup", commonAttr) - -macro table*(e: expr): expr = - ## generates the HTML ``table`` element. - result = xmlCheckedTag(e, "table", "summary border cellpadding cellspacing" & - " frame rules width" & commonAttr) - -macro tbody*(e: expr): expr = - ## generates the HTML ``tbody`` element. - result = xmlCheckedTag(e, "tbody", "align valign" & commonAttr) - -macro td*(e: expr): expr = - ## generates the HTML ``td`` element. - result = xmlCheckedTag(e, "td", "colspan rowspan abbr axis headers scope" & - " align valign" & commonAttr) - -macro textarea*(e: expr): expr = - ## generates the HTML ``textarea`` element. - result = xmlCheckedTag(e, "textarea", " name disabled readonly accesskey" & - " tabindex" & commonAttr, "rows cols", false) - -macro tfoot*(e: expr): expr = - ## generates the HTML ``tfoot`` element. - result = xmlCheckedTag(e, "tfoot", "align valign" & commonAttr) - -macro th*(e: expr): expr = - ## generates the HTML ``th`` element. - result = xmlCheckedTag(e, "th", "colspan rowspan abbr axis headers scope" & - " align valign" & commonAttr) - -macro thead*(e: expr): expr = - ## generates the HTML ``thead`` element. - result = xmlCheckedTag(e, "thead", "align valign" & commonAttr) - -macro title*(e: expr): expr = - ## generates the HTML ``title`` element. - result = xmlCheckedTag(e, "title") - -macro tr*(e: expr): expr = - ## generates the HTML ``tr`` element. - result = xmlCheckedTag(e, "tr", "align valign" & commonAttr) - -macro tt*(e: expr): expr = - ## generates the HTML ``tt`` element. - result = xmlCheckedTag(e, "tt", commonAttr) - -macro ul*(e: expr): expr = - ## generates the HTML ``ul`` element. - result = xmlCheckedTag(e, "ul", commonAttr) - -macro `var`*(e: expr): expr = - ## generates the HTML ``var`` element. - result = xmlCheckedTag(e, "var", commonAttr) - -when isMainModule: - var nim = "Nimrod" - echo h1(a(href="http://force7.de/nimrod", nim)) - diff --git a/nimlib/readme.txt b/nimlib/readme.txt deleted file mode 100755 index 2b2c4a03c8..0000000000 --- a/nimlib/readme.txt +++ /dev/null @@ -1,2 +0,0 @@ -This directory contains a fixed system library and some other libraries for -bootstrapping Nimrod with Nim, the old Pascal version of the compiler. diff --git a/nimlib/system.nim b/nimlib/system.nim deleted file mode 100755 index 174d739cd7..0000000000 --- a/nimlib/system.nim +++ /dev/null @@ -1,1531 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## The compiler depends on the System module to work properly and the System -## module depends on the compiler. Most of the routines listed here use -## special compiler magic. -## Each module implicitly imports the System module; it may not be listed -## explicitly. Because of this there cannot be a user-defined module named -## ``system``. - -{.push hints: off.} - -type - int* {.magic: Int.} ## default integer type; bitwidth depends on - ## architecture, but is always the same as a pointer - int8* {.magic: Int8.} ## signed 8 bit integer type - int16* {.magic: Int16.} ## signed 16 bit integer type - int32* {.magic: Int32.} ## signed 32 bit integer type - int64* {.magic: Int64.} ## signed 64 bit integer type - float* {.magic: Float.} ## default floating point type - float32* {.magic: Float32.} ## 32 bit floating point type - float64* {.magic: Float64.} ## 64 bit floating point type -type # we need to start a new type section here, so that ``0`` can have a type - bool* {.magic: Bool.} = enum ## built-in boolean type - false = 0, true = 1 - -type - char* {.magic: Char.} ## built-in 8 bit character type (unsigned) - string* {.magic: String.} ## built-in string type - cstring* {.magic: Cstring.} ## built-in cstring (*compatible string*) type - pointer* {.magic: Pointer.} ## built-in pointer type - Ordinal* {.magic: Ordinal.}[T] - -type - `nil` {.magic: "Nil".} - expr* {.magic: Expr.} ## meta type to denote an expression (for templates) - stmt* {.magic: Stmt.} ## meta type to denote a statement (for templates) - typeDesc* {.magic: TypeDesc.} ## meta type to denote - ## a type description (for templates) - -proc defined*[T](x: T): bool {.magic: "Defined", noSideEffect.} - ## Special comile-time procedure that checks whether `x` is - ## defined. `x` has to be an identifier or a qualified identifier. - ## This can be used to check whether a library provides a certain - ## feature or not: - ## - ## .. code-block:: Nimrod - ## when not defined(strutils.toUpper): - ## # provide our own toUpper proc here, because strutils is - ## # missing it. - -proc definedInScope*[T](x: T): bool {. - magic: "DefinedInScope", noSideEffect.} - ## Special comile-time procedure that checks whether `x` is - ## defined in the current scope. `x` has to be an identifier. - -# these require compiler magic: -proc `not` *(x: bool): bool {.magic: "Not", noSideEffect.} - ## Boolean not; returns true iff ``x == false``. - -proc `and`*(x, y: bool): bool {.magic: "And", noSideEffect.} - ## Boolean ``and``; returns true iff ``x == y == true``. - ## Evaluation is short-circuited: This means that if ``x`` is false, - ## ``y`` will not even be evaluated. -proc `or`*(x, y: bool): bool {.magic: "Or", noSideEffect.} - ## Boolean ``or``; returns true iff ``not (not x and not y)``. - ## Evaluation is short-circuited: This means that if ``x`` is true, - ## ``y`` will not even be evaluated. -proc `xor`*(x, y: bool): bool {.magic: "Xor", noSideEffect.} - ## Boolean `exclusive or`; returns true iff ``x != y``. - -proc new*[T](a: var ref T) {.magic: "New", noSideEffect.} - ## creates a new object of type ``T`` and returns a safe (traced) - ## reference to it in ``a``. - -proc new*[T](a: var ref T, finalizer: proc (x: ref T)) {. - magic: "NewFinalize", noSideEffect.} - ## creates a new object of type ``T`` and returns a safe (traced) - ## reference to it in ``a``. When the garbage collector frees the object, - ## `finalizer` is called. The `finalizer` may not keep a reference to the - ## object pointed to by `x`. The `finalizer` cannot prevent the GC from - ## freeing the object. Note: The `finalizer` refers to the type `T`, not to - ## the object! This means that for each object of type `T` the finalizer - ## will be called! - -# for low and high the return type T may not be correct, but -# we handle that with compiler magic in SemLowHigh() -proc high*[T](x: T): T {.magic: "High", noSideEffect.} - ## returns the highest possible index of an array, a sequence, a string or - ## the highest possible value of an ordinal value `x`. As a special - ## semantic rule, `x` may also be a type identifier. - -proc low*[T](x: T): T {.magic: "Low", noSideEffect.} - ## returns the lowest possible index of an array, a sequence, a string or - ## the lowest possible value of an ordinal value `x`. As a special - ## semantic rule, `x` may also be a type identifier. - -type - range*{.magic: "Range".} [T] ## Generic type to construct range types. - array*{.magic: "Array".}[I, T] ## Generic type to construct - ## fixed-length arrays. - openarray*{.magic: "OpenArray".}[T] ## Generic type to construct open arrays. - ## Open arrays are implemented as a - ## pointer to the array data and a - ## length field. - seq*{.magic: "Seq".}[T] ## Generic type to construct sequences. - set*{.magic: "Set".}[T] ## Generic type to construct bit sets. - -when not defined(EcmaScript) and not defined(NimrodVM): - type - TGenericSeq {.compilerproc, pure.} = object - len, space: int - PGenericSeq {.exportc.} = ptr TGenericSeq - # len and space without counting the terminating zero: - NimStringDesc {.compilerproc, final.} = object of TGenericSeq - data: array[0..100_000_000, char] - NimString = ptr NimStringDesc - - include "system/hti" - -type - Byte* = Int8 ## this is an alias for ``int8``, that is a signed - ## int 8 bits wide. - - Natural* = range[0..high(int)] - ## is an int type ranging from zero to the maximum value - ## of an int. This type is often useful for documentation and debugging. - - Positive* = range[1..high(int)] - ## is an int type ranging from one to the maximum value - ## of an int. This type is often useful for documentation and debugging. - - TObject* {.exportc: "TNimObject".} = - object ## the root of Nimrod's object hierarchy. Objects should - ## inherit from TObject or one of its descendants. However, - ## objects that have no ancestor are allowed. - PObject* = ref TObject ## reference to TObject - - E_Base* {.compilerproc.} = object of TObject ## base exception class; - ## each exception has to - ## inherit from `E_Base`. - name*: cstring ## The exception's name is its Nimrod identifier. - ## This field is filled automatically in the - ## ``raise`` statement. - msg* {.exportc: "message".}: cstring ## the exception's message. Not - ## providing an - ## exception message is bad style. - - EAsynch* = object of E_Base ## Abstract exception class for - ## *asynchronous exceptions* (interrupts). - ## This is rarely needed: Most - ## exception types inherit from `ESynch` - ESynch* = object of E_Base ## Abstract exception class for - ## *synchronous exceptions*. Most exceptions - ## should be inherited (directly or indirectly) - ## from ESynch. - ESystem* = object of ESynch ## Abstract class for exceptions that the runtime - ## system raises. - EIO* = object of ESystem ## raised if an IO error occured. - EOS* = object of ESystem ## raised if an operating system service failed. - EInvalidLibrary* = object of EOS ## raised if a dynamic library - ## could not be loaded. - ERessourceExhausted* = object of ESystem ## raised if a ressource request - ## could not be fullfilled. - EArithmetic* = object of ESynch ## raised if any kind of arithmetic - ## error occured. - EDivByZero* {.compilerproc.} = - object of EArithmetic ## is the exception class for integer divide-by-zero - ## errors. - EOverflow* {.compilerproc.} = - object of EArithmetic ## is the exception class for integer calculations - ## whose results are too large to fit in the - ## provided bits. - - EAccessViolation* {.compilerproc.} = - object of ESynch ## the exception class for invalid memory access errors - - EAssertionFailed* {.compilerproc.} = - object of ESynch ## is the exception class for Assert - ## procedures that is raised if the - ## assertion proves wrong - - EControlC* = object of EAsynch ## is the exception class for Ctrl+C - ## key presses in console applications. - - EInvalidValue* = object of ESynch ## is the exception class for string - ## and object conversion errors. - - EOutOfMemory* = object of ESystem ## is the exception class for - ## unsuccessful attempts to allocate - ## memory. - - EInvalidIndex* = object of ESynch ## is raised if an array index is out - ## of bounds. - EInvalidField* = object of ESynch ## is raised if a record field is not - ## accessible because its dicriminant's - ## value does not fit. - - EOutOfRange* = object of ESynch ## is raised if a range check error - ## occured. - - EStackOverflow* = object of ESystem ## is raised if the hardware stack - ## used for subroutine calls overflowed. - - ENoExceptionToReraise* = object of ESynch ## is raised if there is no - ## exception to reraise. - - EInvalidObjectAssignment* = - object of ESynch ## is raised if an object gets assigned to its - ## farther's object. - - EInvalidObjectConversion* = - object of ESynch ## is raised if an object is converted to an incompatible - ## object type. - - TResult* = enum Failure, Success - -proc sizeof*[T](x: T): natural {.magic: "SizeOf", noSideEffect.} - ## returns the size of ``x`` in bytes. Since this is a low-level proc, - ## its usage is discouraged - using ``new`` for the most cases suffices - ## that one never needs to know ``x``'s size. As a special semantic rule, - ## ``x`` may also be a type identifier (``sizeof(int)`` is valid). - -proc succ*[T](x: ordinal[T], y = 1): T {.magic: "Succ", noSideEffect.} - ## returns the ``y``-th successor of the value ``x``. ``T`` has to be - ## an ordinal type. If such a value does not exist, ``EOutOfRange`` is raised - ## or a compile time error occurs. - -proc pred*[T](x: ordinal[T], y = 1): T {.magic: "Pred", noSideEffect.} - ## returns the ``y``-th predecessor of the value ``x``. ``T`` has to be - ## an ordinal type. If such a value does not exist, ``EOutOfRange`` is raised - ## or a compile time error occurs. - -proc inc*[T](x: var ordinal[T], y = 1) {.magic: "Inc", noSideEffect.} - ## increments the ordinal ``x`` by ``y``. If such a value does not - ## exist, ``EOutOfRange`` is raised or a compile time error occurs. This is a - ## short notation for: ``x = succ(x, y)``. - -proc dec*[T](x: var ordinal[T], y = 1) {.magic: "Dec", noSideEffect.} - ## decrements the ordinal ``x`` by ``y``. If such a value does not - ## exist, ``EOutOfRange`` is raised or a compile time error occurs. This is a - ## short notation for: ``x = pred(x, y)``. - -proc newSeq*[T](s: var seq[T], len: int) {.magic: "NewSeq", noSideEffect.} - ## creates a new sequence of type ``seq[T]`` with length ``len``. - ## This is equivalent to ``s = @[]; setlen(s, len)``, but more - ## efficient since no reallocation is needed. - -proc len*[T](x: openarray[T]): int {.magic: "LengthOpenArray", noSideEffect.} -proc len*(x: string): int {.magic: "LengthStr", noSideEffect.} -proc len*(x: cstring): int {.magic: "LengthStr", noSideEffect.} -proc len*[I, T](x: array[I, T]): int {.magic: "LengthArray", noSideEffect.} -proc len*[T](x: seq[T]): int {.magic: "LengthSeq", noSideEffect.} - ## returns the length of an array, a sequence or a string. - ## This is rougly the same as ``high(T)-low(T)+1``, but its resulting type is - ## always an int. - -# set routines: -proc incl*[T](x: var set[T], y: T) {.magic: "Incl", noSideEffect.} - ## includes element ``y`` to the set ``x``. This is the same as - ## ``x = x + {y}``, but it might be more efficient. - -proc excl*[T](x: var set[T], y: T) {.magic: "Excl", noSideEffect.} - ## excludes element ``y`` to the set ``x``. This is the same as - ## ``x = x - {y}``, but it might be more efficient. - -proc card*[T](x: set[T]): int {.magic: "Card", noSideEffect.} - ## returns the cardinality of the set ``x``, i.e. the number of elements - ## in the set. - -proc ord*[T](x: T): int {.magic: "Ord", noSideEffect.} - ## returns the internal int value of an ordinal value ``x``. - -proc chr*(u: range[0..255]): char {.magic: "Chr", noSideEffect.} - ## converts an int in the range 0..255 to a character. - -# -------------------------------------------------------------------------- -# built-in operators - -proc ze*(x: int8): int {.magic: "Ze8ToI", noSideEffect.} - ## zero extends a smaller integer type to ``int``. This treats `x` as - ## unsigned. -proc ze*(x: int16): int {.magic: "Ze16ToI", noSideEffect.} - ## zero extends a smaller integer type to ``int``. This treats `x` as - ## unsigned. - -proc ze64*(x: int8): int64 {.magic: "Ze8ToI64", noSideEffect.} - ## zero extends a smaller integer type to ``int64``. This treats `x` as - ## unsigned. -proc ze64*(x: int16): int64 {.magic: "Ze16ToI64", noSideEffect.} - ## zero extends a smaller integer type to ``int64``. This treats `x` as - ## unsigned. - -proc ze64*(x: int32): int64 {.magic: "Ze32ToI64", noSideEffect.} - ## zero extends a smaller integer type to ``int64``. This treats `x` as - ## unsigned. -proc ze64*(x: int): int64 {.magic: "ZeIToI64", noDecl, noSideEffect.} - ## zero extends a smaller integer type to ``int64``. This treats `x` as - ## unsigned. Does nothing if the size of an ``int`` is the same as ``int64``. - ## (This is the case on 64 bit processors.) - -proc toU8*(x: int): int8 {.magic: "ToU8", noSideEffect.} - ## treats `x` as unsigned and converts it to a byte by taking the last 8 bits - ## from `x`. -proc toU16*(x: int): int16 {.magic: "ToU16", noSideEffect.} - ## treats `x` as unsigned and converts it to an ``int16`` by taking the last - ## 16 bits from `x`. -proc toU32*(x: int64): int32 {.magic: "ToU32", noSideEffect.} - ## treats `x` as unsigned and converts it to an ``int32`` by taking the - ## last 32 bits from `x`. - - -# integer calculations: -proc `+` *(x: int): int {.magic: "UnaryPlusI", noSideEffect.} -proc `+` *(x: int8): int8 {.magic: "UnaryPlusI", noSideEffect.} -proc `+` *(x: int16): int16 {.magic: "UnaryPlusI", noSideEffect.} -proc `+` *(x: int32): int32 {.magic: "UnaryPlusI", noSideEffect.} -proc `+` *(x: int64): int64 {.magic: "UnaryPlusI64", noSideEffect.} - ## Unary `+` operator for an integer. Has no effect. - -proc `-` *(x: int): int {.magic: "UnaryMinusI", noSideEffect.} -proc `-` *(x: int8): int8 {.magic: "UnaryMinusI", noSideEffect.} -proc `-` *(x: int16): int16 {.magic: "UnaryMinusI", noSideEffect.} -proc `-` *(x: int32): int32 {.magic: "UnaryMinusI", noSideEffect.} -proc `-` *(x: int64): int64 {.magic: "UnaryMinusI64", noSideEffect.} - ## Unary `-` operator for an integer. Negates `x`. - -proc `not` *(x: int): int {.magic: "BitnotI", noSideEffect.} -proc `not` *(x: int8): int8 {.magic: "BitnotI", noSideEffect.} -proc `not` *(x: int16): int16 {.magic: "BitnotI", noSideEffect.} -proc `not` *(x: int32): int32 {.magic: "BitnotI", noSideEffect.} -proc `not` *(x: int64): int64 {.magic: "BitnotI64", noSideEffect.} - ## computes the `bitwise complement` of the integer `x`. - -proc `+` *(x, y: int): int {.magic: "AddI", noSideEffect.} -proc `+` *(x, y: int8): int8 {.magic: "AddI", noSideEffect.} -proc `+` *(x, y: int16): int16 {.magic: "AddI", noSideEffect.} -proc `+` *(x, y: int32): int32 {.magic: "AddI", noSideEffect.} -proc `+` *(x, y: int64): int64 {.magic: "AddI64", noSideEffect.} - ## Binary `+` operator for an integer. - -proc `-` *(x, y: int): int {.magic: "SubI", noSideEffect.} -proc `-` *(x, y: int8): int8 {.magic: "SubI", noSideEffect.} -proc `-` *(x, y: int16): int16 {.magic: "SubI", noSideEffect.} -proc `-` *(x, y: int32): int32 {.magic: "SubI", noSideEffect.} -proc `-` *(x, y: int64): int64 {.magic: "SubI64", noSideEffect.} - ## Binary `-` operator for an integer. - -proc `*` *(x, y: int): int {.magic: "MulI", noSideEffect.} -proc `*` *(x, y: int8): int8 {.magic: "MulI", noSideEffect.} -proc `*` *(x, y: int16): int16 {.magic: "MulI", noSideEffect.} -proc `*` *(x, y: int32): int32 {.magic: "MulI", noSideEffect.} -proc `*` *(x, y: int64): int64 {.magic: "MulI64", noSideEffect.} - ## Binary `*` operator for an integer. - -proc `div` *(x, y: int): int {.magic: "DivI", noSideEffect.} -proc `div` *(x, y: int8): int8 {.magic: "DivI", noSideEffect.} -proc `div` *(x, y: int16): int16 {.magic: "DivI", noSideEffect.} -proc `div` *(x, y: int32): int32 {.magic: "DivI", noSideEffect.} -proc `div` *(x, y: int64): int64 {.magic: "DivI64", noSideEffect.} - ## computes the integer division. This is roughly the same as - ## ``floor(x/y)``. - -proc `mod` *(x, y: int): int {.magic: "ModI", noSideEffect.} -proc `mod` *(x, y: int8): int8 {.magic: "ModI", noSideEffect.} -proc `mod` *(x, y: int16): int16 {.magic: "ModI", noSideEffect.} -proc `mod` *(x, y: int32): int32 {.magic: "ModI", noSideEffect.} -proc `mod` *(x, y: int64): int64 {.magic: "ModI64", noSideEffect.} - ## computes the integer modulo operation. This is the same as - ## ``x - (x div y) * y``. - -proc `shr` *(x, y: int): int {.magic: "ShrI", noSideEffect.} -proc `shr` *(x, y: int8): int8 {.magic: "ShrI", noSideEffect.} -proc `shr` *(x, y: int16): int16 {.magic: "ShrI", noSideEffect.} -proc `shr` *(x, y: int32): int32 {.magic: "ShrI", noSideEffect.} -proc `shr` *(x, y: int64): int64 {.magic: "ShrI64", noSideEffect.} - ## computes the `shift right` operation of `x` and `y`. - -proc `shl` *(x, y: int): int {.magic: "ShlI", noSideEffect.} -proc `shl` *(x, y: int8): int8 {.magic: "ShlI", noSideEffect.} -proc `shl` *(x, y: int16): int16 {.magic: "ShlI", noSideEffect.} -proc `shl` *(x, y: int32): int32 {.magic: "ShlI", noSideEffect.} -proc `shl` *(x, y: int64): int64 {.magic: "ShlI64", noSideEffect.} - ## computes the `shift left` operation of `x` and `y`. - -proc `and` *(x, y: int): int {.magic: "BitandI", noSideEffect.} -proc `and` *(x, y: int8): int8 {.magic: "BitandI", noSideEffect.} -proc `and` *(x, y: int16): int16 {.magic: "BitandI", noSideEffect.} -proc `and` *(x, y: int32): int32 {.magic: "BitandI", noSideEffect.} -proc `and` *(x, y: int64): int64 {.magic: "BitandI64", noSideEffect.} - ## computes the `bitwise and` of numbers `x` and `y`. - -proc `or` *(x, y: int): int {.magic: "BitorI", noSideEffect.} -proc `or` *(x, y: int8): int8 {.magic: "BitorI", noSideEffect.} -proc `or` *(x, y: int16): int16 {.magic: "BitorI", noSideEffect.} -proc `or` *(x, y: int32): int32 {.magic: "BitorI", noSideEffect.} -proc `or` *(x, y: int64): int64 {.magic: "BitorI64", noSideEffect.} - ## computes the `bitwise or` of numbers `x` and `y`. - -proc `xor` *(x, y: int): int {.magic: "BitxorI", noSideEffect.} -proc `xor` *(x, y: int8): int8 {.magic: "BitxorI", noSideEffect.} -proc `xor` *(x, y: int16): int16 {.magic: "BitxorI", noSideEffect.} -proc `xor` *(x, y: int32): int32 {.magic: "BitxorI", noSideEffect.} -proc `xor` *(x, y: int64): int64 {.magic: "BitxorI64", noSideEffect.} - ## computes the `bitwise xor` of numbers `x` and `y`. - -proc `==` *(x, y: int): bool {.magic: "EqI", noSideEffect.} -proc `==` *(x, y: int8): bool {.magic: "EqI", noSideEffect.} -proc `==` *(x, y: int16): bool {.magic: "EqI", noSideEffect.} -proc `==` *(x, y: int32): bool {.magic: "EqI", noSideEffect.} -proc `==` *(x, y: int64): bool {.magic: "EqI64", noSideEffect.} - ## Compares two integers for equality. - -proc `<=` *(x, y: int): bool {.magic: "LeI", noSideEffect.} -proc `<=` *(x, y: int8): bool {.magic: "LeI", noSideEffect.} -proc `<=` *(x, y: int16): bool {.magic: "LeI", noSideEffect.} -proc `<=` *(x, y: int32): bool {.magic: "LeI", noSideEffect.} -proc `<=` *(x, y: int64): bool {.magic: "LeI64", noSideEffect.} - ## Returns true iff `x` is less than or equal to `y`. - -proc `<` *(x, y: int): bool {.magic: "LtI", noSideEffect.} -proc `<` *(x, y: int8): bool {.magic: "LtI", noSideEffect.} -proc `<` *(x, y: int16): bool {.magic: "LtI", noSideEffect.} -proc `<` *(x, y: int32): bool {.magic: "LtI", noSideEffect.} -proc `<` *(x, y: int64): bool {.magic: "LtI64", noSideEffect.} - ## Returns true iff `x` is less than `y`. - -proc abs*(x: int): int {.magic: "AbsI", noSideEffect.} -proc abs*(x: int8): int8 {.magic: "AbsI", noSideEffect.} -proc abs*(x: int16): int16 {.magic: "AbsI", noSideEffect.} -proc abs*(x: int32): int32 {.magic: "AbsI", noSideEffect.} -proc abs*(x: int64): int64 {.magic: "AbsI64", noSideEffect.} - ## returns the absolute value of `x`. If `x` is ``low(x)`` (that - ## is -MININT for its type), an overflow exception is thrown (if overflow - ## checking is turned on). - -proc `+%` *(x, y: int): int {.magic: "AddU", noSideEffect.} -proc `+%` *(x, y: int8): int8 {.magic: "AddU", noSideEffect.} -proc `+%` *(x, y: int16): int16 {.magic: "AddU", noSideEffect.} -proc `+%` *(x, y: int32): int32 {.magic: "AddU", noSideEffect.} -proc `+%` *(x, y: int64): int64 {.magic: "AddU64", noSideEffect.} - ## treats `x` and `y` as unsigned and adds them. The result is truncated to - ## fit into the result. This implements modulo arithmetic. No overflow - ## errors are possible. - -proc `-%` *(x, y: int): int {.magic: "SubU", noSideEffect.} -proc `-%` *(x, y: int8): int8 {.magic: "SubU", noSideEffect.} -proc `-%` *(x, y: int16): int16 {.magic: "SubU", noSideEffect.} -proc `-%` *(x, y: int32): int32 {.magic: "SubU", noSideEffect.} -proc `-%` *(x, y: int64): int64 {.magic: "SubU64", noSideEffect.} - ## treats `x` and `y` as unsigned and subtracts them. The result is - ## truncated to fit into the result. This implements modulo arithmetic. - ## No overflow errors are possible. - -proc `*%` *(x, y: int): int {.magic: "MulU", noSideEffect.} -proc `*%` *(x, y: int8): int8 {.magic: "MulU", noSideEffect.} -proc `*%` *(x, y: int16): int16 {.magic: "MulU", noSideEffect.} -proc `*%` *(x, y: int32): int32 {.magic: "MulU", noSideEffect.} -proc `*%` *(x, y: int64): int64 {.magic: "MulU64", noSideEffect.} - ## treats `x` and `y` as unsigned and multiplies them. The result is - ## truncated to fit into the result. This implements modulo arithmetic. - ## No overflow errors are possible. - -proc `/%` *(x, y: int): int {.magic: "DivU", noSideEffect.} -proc `/%` *(x, y: int8): int8 {.magic: "DivU", noSideEffect.} -proc `/%` *(x, y: int16): int16 {.magic: "DivU", noSideEffect.} -proc `/%` *(x, y: int32): int32 {.magic: "DivU", noSideEffect.} -proc `/%` *(x, y: int64): int64 {.magic: "DivU64", noSideEffect.} - ## treats `x` and `y` as unsigned and divides them. The result is - ## truncated to fit into the result. This implements modulo arithmetic. - ## No overflow errors are possible. - -proc `%%` *(x, y: int): int {.magic: "ModU", noSideEffect.} -proc `%%` *(x, y: int8): int8 {.magic: "ModU", noSideEffect.} -proc `%%` *(x, y: int16): int16 {.magic: "ModU", noSideEffect.} -proc `%%` *(x, y: int32): int32 {.magic: "ModU", noSideEffect.} -proc `%%` *(x, y: int64): int64 {.magic: "ModU64", noSideEffect.} - ## treats `x` and `y` as unsigned and compute the modulo of `x` and `y`. - ## The result is truncated to fit into the result. - ## This implements modulo arithmetic. - ## No overflow errors are possible. - -proc `<=%` *(x, y: int): bool {.magic: "LeU", noSideEffect.} -proc `<=%` *(x, y: int8): bool {.magic: "LeU", noSideEffect.} -proc `<=%` *(x, y: int16): bool {.magic: "LeU", noSideEffect.} -proc `<=%` *(x, y: int32): bool {.magic: "LeU", noSideEffect.} -proc `<=%` *(x, y: int64): bool {.magic: "LeU64", noSideEffect.} - ## treats `x` and `y` as unsigned and compares them. - ## Returns true iff ``unsigned(x) <= unsigned(y)``. - -proc `<%` *(x, y: int): bool {.magic: "LtU", noSideEffect.} -proc `<%` *(x, y: int8): bool {.magic: "LtU", noSideEffect.} -proc `<%` *(x, y: int16): bool {.magic: "LtU", noSideEffect.} -proc `<%` *(x, y: int32): bool {.magic: "LtU", noSideEffect.} -proc `<%` *(x, y: int64): bool {.magic: "LtU64", noSideEffect.} - ## treats `x` and `y` as unsigned and compares them. - ## Returns true iff ``unsigned(x) < unsigned(y)``. - - -# floating point operations: -proc `+` *(x: float): float {.magic: "UnaryPlusF64", noSideEffect.} -proc `-` *(x: float): float {.magic: "UnaryMinusF64", noSideEffect.} -proc `+` *(x, y: float): float {.magic: "AddF64", noSideEffect.} -proc `-` *(x, y: float): float {.magic: "SubF64", noSideEffect.} -proc `*` *(x, y: float): float {.magic: "MulF64", noSideEffect.} -proc `/` *(x, y: float): float {.magic: "DivF64", noSideEffect.} - ## computes the floating point division - -proc `==` *(x, y: float): bool {.magic: "EqF64", noSideEffect.} -proc `<=` *(x, y: float): bool {.magic: "LeF64", noSideEffect.} -proc `<` *(x, y: float): bool {.magic: "LtF64", noSideEffect.} -proc abs*(x: float): float {.magic: "AbsF64", noSideEffect.} -proc min*(x, y: float): float {.magic: "MinF64", noSideEffect.} -proc max*(x, y: float): float {.magic: "MaxF64", noSideEffect.} - -# set operators -proc `*` *[T](x, y: set[T]): set[T] {.magic: "MulSet", noSideEffect.} - ## This operator computes the intersection of two sets. -proc `+` *[T](x, y: set[T]): set[T] {.magic: "PlusSet", noSideEffect.} - ## This operator computes the union of two sets. -proc `-` *[T](x, y: set[T]): set[T] {.magic: "MinusSet", noSideEffect.} - ## This operator computes the difference of two sets. -proc `-+-` *[T](x, y: set[T]): set[T] {.magic: "SymDiffSet", noSideEffect.} - ## computes the symmetric set difference. This is the same as - ## ``(A - B) + (B - A)``, but more efficient. - -# comparison operators: -proc `==` *[T](x, y: ordinal[T]): bool {.magic: "EqEnum", noSideEffect.} -proc `==` *(x, y: pointer): bool {.magic: "EqRef", noSideEffect.} -proc `==` *(x, y: string): bool {.magic: "EqStr", noSideEffect.} -proc `==` *(x, y: cstring): bool {.magic: "EqCString", noSideEffect.} -proc `==` *(x, y: char): bool {.magic: "EqCh", noSideEffect.} -proc `==` *(x, y: bool): bool {.magic: "EqB", noSideEffect.} -proc `==` *[T](x, y: set[T]): bool {.magic: "EqSet", noSideEffect.} -proc `==` *[T](x, y: ref T): bool {.magic: "EqRef", noSideEffect.} -proc `==` *[T](x, y: ptr T): bool {.magic: "EqRef", noSideEffect.} - -proc `<=` *[T](x, y: ordinal[T]): bool {.magic: "LeEnum", noSideEffect.} -proc `<=` *(x, y: string): bool {.magic: "LeStr", noSideEffect.} -proc `<=` *(x, y: char): bool {.magic: "LeCh", noSideEffect.} -proc `<=` *[T](x, y: set[T]): bool {.magic: "LeSet", noSideEffect.} -proc `<=` *(x, y: bool): bool {.magic: "LeB", noSideEffect.} -proc `<=` *[T](x, y: ref T): bool {.magic: "LePtr", noSideEffect.} -proc `<=` *(x, y: pointer): bool {.magic: "LePtr", noSideEffect.} - -proc `<` *[T](x, y: ordinal[T]): bool {.magic: "LtEnum", noSideEffect.} -proc `<` *(x, y: string): bool {.magic: "LtStr", noSideEffect.} -proc `<` *(x, y: char): bool {.magic: "LtCh", noSideEffect.} -proc `<` *[T](x, y: set[T]): bool {.magic: "LtSet", noSideEffect.} -proc `<` *(x, y: bool): bool {.magic: "LtB", noSideEffect.} -proc `<` *[T](x, y: ref T): bool {.magic: "LtPtr", noSideEffect.} -proc `<` *[T](x, y: ptr T): bool {.magic: "LtPtr", noSideEffect.} -proc `<` *(x, y: pointer): bool {.magic: "LtPtr", noSideEffect.} - -template `!=` * (x, y: expr): expr = - ## unequals operator. This is a shorthand for ``not (x == y)``. - not (x == y) - -template `>=` * (x, y: expr): expr = - ## "is greater or equals" operator. This is the same as ``y <= x``. - y <= x - -template `>` * (x, y: expr): expr = - ## "is greater" operator. This is the same as ``y < x``. - y < x - -proc contains*[T](x: set[T], y: T): bool {.magic: "InSet", noSideEffect.} - ## One should overload this proc if one wants to overload the ``in`` operator. - ## The parameters are in reverse order! ``a in b`` is a template for - ## ``contains(b, a)``. - ## This is because the unification algorithm that Nimrod uses for overload - ## resolution works from left to right. - ## But for the ``in`` operator that would be the wrong direction for this - ## piece of code: - ## - ## .. code-block:: Nimrod - ## var s: set[range['a'..'z']] = {'a'..'c'} - ## writeln(stdout, 'b' in s) - ## - ## If ``in`` had been declared as ``[T](elem: T, s: set[T])`` then ``T`` would - ## have been bound to ``char``. But ``s`` is not compatible to type - ## ``set[char]``! The solution is to bind ``T`` to ``range['a'..'z']``. This - ## is achieved by reversing the parameters for ``contains``; ``in`` then - ## passes its arguments in reverse order. - -template `in` * (x, y: expr): expr = contains(y, x) -template `not_in` * (x, y: expr): expr = not contains(y, x) - -proc `is` *[T, S](x: T, y: S): bool {.magic: "Is", noSideEffect.} -template `is_not` *(x, y: expr): expr = not (x is y) - -proc cmp*[T, S: typeDesc](x: T, y: S): int = - ## Generic compare proc. Returns a value < 0 iff x < y, a value > 0 iff x > y - ## and 0 iff x == y. This is useful for writing generic algorithms without - ## performance loss. This generic implementation uses the `==` and `<` - ## operators. - if x == y: return 0 - if x < y: return -1 - return 1 - -proc cmp*(x, y: string): int {.noSideEffect.} - ## Compare proc for strings. More efficient than the generic version. - -proc `@` * [IDX, T](a: array[IDX, T]): seq[T] {. - magic: "ArrToSeq", nosideeffect.} - ## turns an array into a sequence. This most often useful for constructing - ## sequences with the array constructor: ``@[1, 2, 3]`` has the type - ## ``seq[int]``, while ``[1, 2, 3]`` has the type ``array[0..2, int]``. - -proc setLen*[T](s: var seq[T], newlen: int) {. - magic: "SetLengthSeq", noSideEffect.} - ## sets the length of `s` to `newlen`. - ## ``T`` may be any sequence type. - ## If the current length is greater than the new length, - ## ``s`` will be truncated. - -proc setLen*(s: var string, newlen: int) {. - magic: "SetLengthStr", noSideEffect.} - ## sets the length of `s` to `newlen`. - ## If the current length is greater than the new length, - ## ``s`` will be truncated. - -proc newString*(len: int): string {. - magic: "NewString", importc: "mnewString", noSideEffect.} - ## returns a new string of length ``len`` but with uninitialized - ## content. One needs to fill the string character after character - ## with the index operator ``s[i]``. This procedure exists only for - ## optimization purposes; the same effect can be achieved with the - ## ``&`` operator. - -# concat operator: -proc `&` * (x: string, y: char): string {. - magic: "ConStrStr", noSideEffect, merge.} -proc `&` * (x: char, y: char): string {. - magic: "ConStrStr", noSideEffect, merge.} -proc `&` * (x, y: string): string {. - magic: "ConStrStr", noSideEffect, merge.} -proc `&` * (x: char, y: string): string {. - magic: "ConStrStr", noSideEffect, merge.} - ## is the `concatenation operator`. It concatenates `x` and `y`. - -proc add*(x: var string, y: char) {.magic: "AppendStrCh", noSideEffect.} -proc add*(x: var string, y: string) {.magic: "AppendStrStr", noSideEffect.} - -when not defined(ECMAScript): - {.push overflow_checks:off} - proc add* (x: var string, y: cstring) = - var i = 0 - while y[i] != '\0': - add(x, y[i]) - inc(i) - {.pop.} -else: - proc add* (x: var string, y: cstring) {.pure.} = - asm """ - var len = `x`[0].length-1; - for (var i = 0; i < `y`.length; ++i) { - `x`[0][len] = `y`.charCodeAt(i); - ++len; - } - `x`[0][len] = 0 - """ - -proc add *[T](x: var seq[T], y: T) {.magic: "AppendSeqElem", noSideEffect.} -proc add *[T](x: var seq[T], y: openArray[T]) {.noSideEffect.} = - ## Generic proc for adding a data item `y` to a container `x`. - ## For containers that have an order, `add` means *append*. New generic - ## containers should also call their adding proc `add` for consistency. - ## Generic code becomes much easier to write if the Nimrod naming scheme is - ## respected. - var xl = x.len - setLen(x, xl + y.len) - for i in 0..high(y): x[xl+i] = y[i] - -proc repr*[T](x: T): string {.magic: "Repr", noSideEffect.} - ## takes any Nimrod variable and returns its string representation. It - ## works even for complex data graphs with cycles. This is a great - ## debugging tool. - -type - TAddress* = int - ## is the signed integer type that should be used for converting - ## pointers to integer addresses for readability. - -type - BiggestInt* = int64 - ## is an alias for the biggest signed integer type the Nimrod compiler - ## supports. Currently this is ``int64``, but it is platform-dependant - ## in general. - - BiggestFloat* = float64 - ## is an alias for the biggest floating point type the Nimrod - ## compiler supports. Currently this is ``float64``, but it is - ## platform-dependant in general. - -type # these work for most platforms: - cchar* {.importc: "char", nodecl.} = char - ## This is the same as the type ``char`` in *C*. - cschar* {.importc: "signed char", nodecl.} = byte - ## This is the same as the type ``signed char`` in *C*. - cshort* {.importc: "short", nodecl.} = int16 - ## This is the same as the type ``short`` in *C*. - cint* {.importc: "int", nodecl.} = int32 - ## This is the same as the type ``int`` in *C*. - clong* {.importc: "long", nodecl.} = int - ## This is the same as the type ``long`` in *C*. - clonglong* {.importc: "long long", nodecl.} = int64 - ## This is the same as the type ``long long`` in *C*. - cfloat* {.importc: "float", nodecl.} = float32 - ## This is the same as the type ``float`` in *C*. - cdouble* {.importc: "double", nodecl.} = float64 - ## This is the same as the type ``double`` in *C*. - clongdouble* {.importc: "long double", nodecl.} = BiggestFloat - ## This is the same as the type ``long double`` in *C*. - ## This C type is not supported by Nimrod's code generator - - cstringArray* {.importc: "char**", nodecl.} = ptr array [0..50_000, cstring] - ## This is binary compatible to the type ``char**`` in *C*. The array's - ## high value is large enough to disable bounds checking in practice. - - TEndian* = enum ## is a type describing the endianness of a processor. - littleEndian, bigEndian - - PFloat32* = ptr Float32 ## an alias for ``ptr float32`` - PFloat64* = ptr Float64 ## an alias for ``ptr float64`` - PInt64* = ptr Int64 ## an alias for ``ptr int64`` - PInt32* = ptr Int32 ## an alias for ``ptr int32`` - -const - isMainModule* {.magic: "IsMainModule".}: bool = false - ## is true only when accessed in the main module. This works thanks to - ## compiler magic. It is useful to embed testing code in a module. - - CompileDate* {.magic: "CompileDate"}: string = "0000-00-00" - ## is the date of compilation as a string of the form - ## ``YYYY-MM-DD``. This works thanks to compiler magic. - - CompileTime* {.magic: "CompileTime"}: string = "00:00:00" - ## is the time of compilation as a string of the form - ## ``HH:MM:SS``. This works thanks to compiler magic. - - NimrodVersion* {.magic: "NimrodVersion"}: string = "0.0.0" - ## is the version of Nimrod as a string. - ## This works thanks to compiler magic. - - NimrodMajor* {.magic: "NimrodMajor"}: int = 0 - ## is the major number of Nimrod's version. - ## This works thanks to compiler magic. - - NimrodMinor* {.magic: "NimrodMinor"}: int = 0 - ## is the minor number of Nimrod's version. - ## This works thanks to compiler magic. - - NimrodPatch* {.magic: "NimrodPatch"}: int = 0 - ## is the patch number of Nimrod's version. - ## This works thanks to compiler magic. - - cpuEndian* {.magic: "CpuEndian"}: TEndian = littleEndian - ## is the endianness of the target CPU. This is a valuable piece of - ## information for low-level code only. This works thanks to compiler magic. - - hostOS* {.magic: "HostOS"}: string = "" - ## a string that describes the host operating system. Possible values: - ## "windows", "macosx", "linux", "netbsd", "freebsd", "openbsd", "solaris", - ## "aix" - - hostCPU* {.magic: "HostCPU"}: string = "" - ## a string that describes the host CPU. Possible values: - ## "i386", "alpha", "powerpc", "sparc", "amd64", "mips", "arm" - -proc toFloat*(i: int): float {. - magic: "ToFloat", noSideEffect, importc: "toFloat".} - ## converts an integer `i` into a ``float``. If the conversion - ## fails, `EInvalidValue` is raised. However, on most platforms the - ## conversion cannot fail. - -proc toBiggestFloat*(i: biggestint): biggestfloat {. - magic: "ToBiggestFloat", noSideEffect, importc: "toBiggestFloat".} - ## converts an biggestint `i` into a ``biggestfloat``. If the conversion - ## fails, `EInvalidValue` is raised. However, on most platforms the - ## conversion cannot fail. - -proc toInt*(f: float): int {. - magic: "ToInt", noSideEffect, importc: "toInt".} - ## converts a floating point number `f` into an ``int``. Conversion - ## rounds `f` if it does not contain an integer value. If the conversion - ## fails (because `f` is infinite for example), `EInvalidValue` is raised. - -proc toBiggestInt*(f: biggestfloat): biggestint {. - magic: "ToBiggestInt", noSideEffect, importc: "toBiggestInt".} - ## converts a biggestfloat `f` into a ``biggestint``. Conversion - ## rounds `f` if it does not contain an integer value. If the conversion - ## fails (because `f` is infinite for example), `EInvalidValue` is raised. - -proc addQuitProc*(QuitProc: proc {.noconv.}) {.importc: "atexit", nodecl.} - ## adds/registers a quit procedure. Each call to ``addQuitProc`` - ## registers another quit procedure. Up to 30 procedures can be - ## registered. They are executed on a last-in, first-out basis - ## (that is, the last function registered is the first to be executed). - ## ``addQuitProc`` raises an EOutOfIndex if ``quitProc`` cannot be - ## registered. - -# Support for addQuitProc() is done by Ansi C's facilities here. -# In case of an unhandled exeption the exit handlers should -# not be called explicitly! The user may decide to do this manually though. - -proc copy*(s: string, first = 0): string {. - magic: "CopyStr", importc: "copyStr", noSideEffect.} -proc copy*(s: string, first, last: int): string {. - magic: "CopyStrLast", importc: "copyStrLast", noSideEffect.} - ## copies a slice of `s` into a new string and returns this new - ## string. The bounds `first` and `last` denote the indices of - ## the first and last characters that shall be copied. If ``last`` - ## is omitted, it is treated as ``high(s)``. - -proc zeroMem*(p: Pointer, size: int) {.importc, noDecl.} - ## overwrites the contents of the memory at ``p`` with the value 0. - ## Exactly ``size`` bytes will be overwritten. Like any procedure - ## dealing with raw memory this is *unsafe*. - -proc copyMem*(dest, source: Pointer, size: int) {.importc: "memcpy", noDecl.} - ## copies the contents from the memory at ``source`` to the memory - ## at ``dest``. Exactly ``size`` bytes will be copied. The memory - ## regions may not overlap. Like any procedure dealing with raw - ## memory this is *unsafe*. - -proc moveMem*(dest, source: Pointer, size: int) {.importc: "memmove", noDecl.} - ## copies the contents from the memory at ``source`` to the memory - ## at ``dest``. Exactly ``size`` bytes will be copied. The memory - ## regions may overlap, ``moveMem`` handles this case appropriately - ## and is thus somewhat more safe than ``copyMem``. Like any procedure - ## dealing with raw memory this is still *unsafe*, though. - -proc equalMem*(a, b: Pointer, size: int): bool {. - importc: "equalMem", noDecl, noSideEffect.} - ## compares the memory blocks ``a`` and ``b``. ``size`` bytes will - ## be compared. If the blocks are equal, true is returned, false - ## otherwise. Like any procedure dealing with raw memory this is - ## *unsafe*. - -proc alloc*(size: int): pointer {.noconv.} - ## allocates a new memory block with at least ``size`` bytes. The - ## block has to be freed with ``realloc(block, 0)`` or - ## ``dealloc(block)``. The block is not initialized, so reading - ## from it before writing to it is undefined behaviour! -proc alloc0*(size: int): pointer {.noconv.} - ## allocates a new memory block with at least ``size`` bytes. The - ## block has to be freed with ``realloc(block, 0)`` or - ## ``dealloc(block)``. The block is initialized with all bytes - ## containing zero, so it is somewhat safer than ``alloc``. -proc realloc*(p: Pointer, newsize: int): pointer {.noconv.} - ## grows or shrinks a given memory block. If p is **nil** then a new - ## memory block is returned. In either way the block has at least - ## ``newsize`` bytes. If ``newsize == 0`` and p is not **nil** - ## ``realloc`` calls ``dealloc(p)``. In other cases the block has to - ## be freed with ``dealloc``. -proc dealloc*(p: Pointer) {.noconv.} - ## frees the memory allocated with ``alloc``, ``alloc0`` or - ## ``realloc``. This procedure is dangerous! If one forgets to - ## free the memory a leak occurs; if one tries to access freed - ## memory (or just freeing it twice!) a core dump may happen - ## or other memory may be corrupted. - -proc assert*(cond: bool) {.magic: "Assert", noSideEffect.} - ## provides a means to implement `programming by contracts`:idx: in Nimrod. - ## ``assert`` evaluates expression ``cond`` and if ``cond`` is false, it - ## raises an ``EAssertionFailure`` exception. However, the compiler may - ## not generate any code at all for ``assert`` if it is advised to do so. - ## Use ``assert`` for debugging purposes only. - -proc swap*[T](a, b: var T) {.magic: "Swap", noSideEffect.} - ## swaps the values `a` and `b`. This is often more efficient than - ## ``tmp = a; a = b; b = tmp``. Particularly useful for sorting algorithms. - -template `>=%` *(x, y: expr): expr = y <=% x - ## treats `x` and `y` as unsigned and compares them. - ## Returns true iff ``unsigned(x) >= unsigned(y)``. - -template `>%` *(x, y: expr): expr = y <% x - ## treats `x` and `y` as unsigned and compares them. - ## Returns true iff ``unsigned(x) > unsigned(y)``. - -proc `$` *(x: int): string {.magic: "IntToStr", noSideEffect.} - ## The stingify operator for an integer argument. Returns `x` - ## converted to a decimal string. - -proc `$` *(x: int64): string {.magic: "Int64ToStr", noSideEffect.} - ## The stingify operator for an integer argument. Returns `x` - ## converted to a decimal string. - -proc `$` *(x: float): string {.magic: "FloatToStr", noSideEffect.} - ## The stingify operator for a float argument. Returns `x` - ## converted to a decimal string. - -proc `$` *(x: bool): string {.magic: "BoolToStr", noSideEffect.} - ## The stingify operator for a boolean argument. Returns `x` - ## converted to the string "false" or "true". - -proc `$` *(x: char): string {.magic: "CharToStr", noSideEffect.} - ## The stingify operator for a character argument. Returns `x` - ## converted to a string. - -proc `$` *(x: Cstring): string {.magic: "CStrToStr", noSideEffect.} - ## The stingify operator for a CString argument. Returns `x` - ## converted to a string. - -proc `$` *(x: string): string {.magic: "StrToStr", noSideEffect.} - ## The stingify operator for a string argument. Returns `x` - ## as it is. This operator is useful for generic code, so - ## that ``$expr`` also works if ``expr`` is already a string. - -proc `$` *[T](x: ordinal[T]): string {.magic: "EnumToStr", noSideEffect.} - ## The stingify operator for an enumeration argument. This works for - ## any enumeration type thanks to compiler magic. If a - ## a ``$`` operator for a concrete enumeration is provided, this is - ## used instead. (In other words: *Overwriting* is possible.) - -# undocumented: -proc getRefcount*[T](x: ref T): int {.importc: "getRefcount", noSideEffect.} - ## retrieves the reference count of an heap-allocated object. The - ## value is implementation-dependant. - -#proc writeStackTrace() {.export: "writeStackTrace".} - -when not defined(NimrodVM): - proc getCurrentExceptionMsg*(): string {.exportc.} - ## retrieves the error message that was attached to the current - ## exception; if there is none, "" is returned. - -# new constants: -const - inf* {.magic: "Inf".} = 1.0 / 0.0 - ## contains the IEEE floating point value of positive infinity. - neginf* {.magic: "NegInf".} = -inf - ## contains the IEEE floating point value of negative infinity. - nan* {.magic: "NaN".} = 0.0 / 0.0 - ## contains an IEEE floating point value of *Not A Number*. Note - ## that you cannot compare a floating point value to this value - ## and expect a reasonable result - use the `classify` procedure - ## in the module ``math`` for checking for NaN. - -var - dbgLineHook*: proc = nil - ## set this variable to provide a procedure that should be called before - ## each executed instruction. This should only be used by debuggers! - ## Only code compiled with the ``debugger:on`` switch calls this hook. - -# GC interface: - -proc getOccupiedMem*(): int - ## returns the number of bytes that are owned by the process and hold data. - -proc getFreeMem*(): int - ## returns the number of bytes that are owned by the process, but do not - ## hold any meaningful data. - -proc getTotalMem*(): int - ## returns the number of bytes that are owned by the process. - - -iterator countdown*[T](a, b: T, step = 1): T {.inline.} = - ## Counts from ordinal value `a` down to `b` with the given - ## step count. `T` may be any ordinal type, `step` may only - ## be positive. - var res = a - while res >= b: - yield res - dec(res, step) - -iterator countup*[T](a, b: T, step = 1): T {.inline.} = - ## Counts from ordinal value `a` up to `b` with the given - ## step count. `T` may be any ordinal type, `step` may only - ## be positive. - var res = a - while res <= b: - yield res - inc(res, step) - # we cannot use ``for x in a..b: `` here, because that is not - # known in the System module - - -proc min*(x, y: int): int {.magic: "MinI", noSideEffect.} -proc min*(x, y: int8): int8 {.magic: "MinI", noSideEffect.} -proc min*(x, y: int16): int16 {.magic: "MinI", noSideEffect.} -proc min*(x, y: int32): int32 {.magic: "MinI", noSideEffect.} -proc min*(x, y: int64): int64 {.magic: "MinI64", noSideEffect.} - ## The minimum value of two integers. - -proc min*[T](x: openarray[T]): T = - ## The minimum value of an openarray. - result = x[0] - for i in 1..high(x): result = min(result, x[i]) - -proc max*(x, y: int): int {.magic: "MaxI", noSideEffect.} -proc max*(x, y: int8): int8 {.magic: "MaxI", noSideEffect.} -proc max*(x, y: int16): int16 {.magic: "MaxI", noSideEffect.} -proc max*(x, y: int32): int32 {.magic: "MaxI", noSideEffect.} -proc max*(x, y: int64): int64 {.magic: "MaxI64", noSideEffect.} - ## The maximum value of two integers. - -proc max*[T](x: openarray[T]): T = - ## The maximum value of an openarray. - result = x[0] - for i in 1..high(x): result = max(result, x[i]) - - -iterator items*[T](a: openarray[T]): T {.inline.} = - ## iterates over each item of `a`. - var i = 0 - while i < len(a): - yield a[i] - inc(i) - -iterator items*[IX, T](a: array[IX, T]): T {.inline.} = - ## iterates over each item of `a`. - var i = low(IX) - if i <= high(IX): - while true: - yield a[i] - if i >= high(IX): break - inc(i) - -iterator items*[T](a: seq[T]): T {.inline.} = - ## iterates over each item of `a`. - var i = 0 - while i < len(a): - yield a[i] - inc(i) - -iterator items*(a: string): char {.inline.} = - ## iterates over each item of `a`. - var i = 0 - while i < len(a): - yield a[i] - inc(i) - -iterator items*[T](a: set[T]): T {.inline.} = - ## iterates over each element of `a`. `items` iterates only over the - ## elements that are really in the set (and not over the ones the set is - ## able to hold). - var i = low(T) - if i <= high(T): - while true: - if i in a: yield i - if i >= high(T): break - inc(i) - -iterator items*(a: cstring): char {.inline.} = - ## iterates over each item of `a`. - var i = 0 - while a[i] != '\0': - yield a[i] - inc(i) - -proc isNil*[T](x: seq[T]): bool {.noSideEffect, magic: "IsNil".} -proc isNil*[T](x: ref T): bool {.noSideEffect, magic: "IsNil".} -proc isNil*(x: string): bool {.noSideEffect, magic: "IsNil".} -proc isNil*[T](x: ptr T): bool {.noSideEffect, magic: "IsNil".} -proc isNil*(x: pointer): bool {.noSideEffect, magic: "IsNil".} -proc isNil*(x: cstring): bool {.noSideEffect, magic: "IsNil".} - ## Fast check whether `x` is nil. This is sometimes more efficient than - ## ``== nil``. - - -# Fixup some magic symbols here: -#{.fixup_system.} -# This is an undocumented pragma that can only be used -# once in the system module. - -proc `&` *[T](x, y: openArray[T]): seq[T] {.noSideEffect.} = - newSeq(result, x.len + y.len) - for i in 0..x.len-1: - result[i] = x[i] - for i in 0..y.len-1: - result[i+x.len] = y[i] - -proc `&` *[T](x: openArray[T], y: T): seq[T] {.noSideEffect.} = - newSeq(result, x.len + 1) - for i in 0..x.len-1: - result[i] = x[i] - result[x.len] = y - -proc `&` *[T](x: T, y: openArray[T]): seq[T] {.noSideEffect.} = - newSeq(result, y.len + 1) - for i in 0..y.len-1: - result[i] = y[i] - result[y.len] = x - -when not defined(NimrodVM): - when not defined(ECMAScript): - proc seqToPtr[T](x: seq[T]): pointer {.inline, nosideeffect.} = - result = cast[pointer](x) - else: - proc seqToPtr[T](x: seq[T]): pointer {.pure, nosideeffect.} = - asm """return `x`""" - - proc `==` *[T: typeDesc](x, y: seq[T]): bool {.noSideEffect.} = - ## Generic equals operator for sequences: relies on a equals operator for - ## the element type `T`. - if seqToPtr(x) == seqToPtr(y): - result = true - elif seqToPtr(x) == nil or seqToPtr(y) == nil: - result = false - elif x.len == y.len: - for i in 0..x.len-1: - if x[i] != y[i]: return false - result = true - -proc find*[T, S: typeDesc](a: T, item: S): int {.inline.}= - ## Returns the first index of `item` in `a` or -1 if not found. This requires - ## appropriate `items` and `==` procs to work. - for i in items(a): - if i == item: return - inc(result) - result = -1 - -proc contains*[T](a: openArray[T], item: T): bool {.inline.}= - ## Returns true if `item` is in `a` or false if not found. This is a shortcut - ## for ``find(a, item) >= 0``. - return find(a, item) >= 0 - -proc pop*[T](s: var seq[T]): T {.inline, noSideEffect.} = - ## returns the last item of `s` and decreases ``s.len`` by one. This treats - ## `s` as a stack and implements the common *pop* operation. - var L = s.len-1 - result = s[L] - setLen(s, L) - -proc each*[T, S](data: openArray[T], op: proc (x: T): S): seq[S] {. - noSideEffect.} = - ## The well-known ``map`` operation from functional programming. Applies - ## `op` to every item in `data` and returns the result as a sequence. - newSeq(result, data.len) - for i in 0..data.len-1: result[i] = op(data[i]) - - -# ----------------- FPU ------------------------------------------------------ - -#proc disableFPUExceptions*() -# disables all floating point unit exceptions - -#proc enableFPUExceptions*() -# enables all floating point unit exceptions - -# ----------------- GC interface --------------------------------------------- - -proc GC_disable*() - ## disables the GC. If called n-times, n calls to `GC_enable` are needed to - ## reactivate the GC. Note that in most circumstances one should only disable - ## the mark and sweep phase with `GC_disableMarkAndSweep`. - -proc GC_enable*() - ## enables the GC again. - -proc GC_fullCollect*() - ## forces a full garbage collection pass. - ## Ordinary code does not need to call this (and should not). - -type - TGC_Strategy* = enum ## the strategy the GC should use for the application - gcThroughput, ## optimize for throughput - gcResponsiveness, ## optimize for responsiveness (default) - gcOptimizeTime, ## optimize for speed - gcOptimizeSpace ## optimize for memory footprint - -proc GC_setStrategy*(strategy: TGC_Strategy) - ## tells the GC the desired strategy for the application. - -proc GC_enableMarkAndSweep*() -proc GC_disableMarkAndSweep*() - ## the current implementation uses a reference counting garbage collector - ## with a seldomly run mark and sweep phase to free cycles. The mark and - ## sweep phase may take a long time and is not needed if the application - ## does not create cycles. Thus the mark and sweep phase can be deactivated - ## and activated separately from the rest of the GC. - -proc GC_getStatistics*(): string - ## returns an informative string about the GC's activity. This may be useful - ## for tweaking. - -proc GC_ref*[T](x: ref T) {.magic: "GCref".} -proc GC_ref*[T](x: seq[T]) {.magic: "GCref".} -proc GC_ref*(x: string) {.magic: "GCref".} - ## marks the object `x` as referenced, so that it will not be freed until - ## it is unmarked via `GC_unref`. If called n-times for the same object `x`, - ## n calls to `GC_unref` are needed to unmark `x`. - -proc GC_unref*[T](x: ref T) {.magic: "GCunref".} -proc GC_unref*[T](x: seq[T]) {.magic: "GCunref".} -proc GC_unref*(x: string) {.magic: "GCunref".} - ## see the documentation of `GC_ref`. - -template accumulateResult*(iter: expr) = - ## helps to convert an iterator to a proc. - result = @[] - for x in iter: add(result, x) - -{.push checks: off, line_dir: off, debugger: off.} -# obviously we cannot generate checking operations here :-) -# because it would yield into an endless recursion -# however, stack-traces are available for most parts -# of the code - -proc echo*[Ty](x: openarray[Ty]) {.magic: "Echo".} - ## equivalent to ``writeln(stdout, x); flush(stdout)``. BUT: This is - ## available for the ECMAScript target too! - -template newException(exceptn, message: expr): expr = - block: # open a new scope - var - e: ref exceptn - new(e) - e.msg = message - e - -const - QuitSuccess* = 0 - ## is the value that should be passed to ``quit`` to indicate - ## success. - - QuitFailure* = 1 - ## is the value that should be passed to ``quit`` to indicate - ## failure. - -proc quit*(errorcode: int = QuitSuccess) {. - magic: "Exit", importc: "exit", noDecl, noReturn.} - ## stops the program immediately; before stopping the program the - ## "quit procedures" are called in the opposite order they were added - ## with ``addQuitProc``. ``quit`` never returns and ignores any - ## exception that may have been raised by the quit procedures. - ## It does *not* call the garbage collector to free all the memory, - ## unless a quit procedure calls ``GC_collect``. - -when not defined(EcmaScript) and not defined(NimrodVM): - proc quit*(errormsg: string) {.noReturn.} - ## a shorthand for ``echo(errormsg); quit(quitFailure)``. - -when not defined(EcmaScript) and not defined(NimrodVM): - - proc initGC() - - var - strDesc: TNimType - - strDesc.size = sizeof(string) - strDesc.kind = tyString - strDesc.flags = {ntfAcyclic} - initGC() # BUGFIX: need to be called here! - - {.push stack_trace: off.} - - include "system/ansi_c" - - proc cmp(x, y: string): int = - return int(c_strcmp(x, y)) - - const pccHack = if defined(pcc): "_" else: "" # Hack for PCC - when defined(windows): - # work-around C's sucking abstraction: - # BUGFIX: stdin and stdout should be binary files! - proc setmode(handle, mode: int) {.importc: pccHack & "setmode", - header: "".} - proc fileno(f: C_TextFileStar): int {.importc: pccHack & "fileno", - header: "".} - var - O_BINARY {.importc: pccHack & "O_BINARY", nodecl.}: int - - # we use binary mode in Windows: - setmode(fileno(c_stdin), O_BINARY) - setmode(fileno(c_stdout), O_BINARY) - - when defined(endb): - proc endbStep() - - # ----------------- IO Part -------------------------------------------------- - - type - CFile {.importc: "FILE", nodecl, final.} = object # empty record for - # data hiding - TFile* = ptr CFile ## The type representing a file handle. - - TFileMode* = enum ## The file mode when opening a file. - fmRead, ## Open the file for read access only. - fmWrite, ## Open the file for write access only. - fmReadWrite, ## Open the file for read and write access. - ## If the file does not exist, it will be - ## created. - fmReadWriteExisting, ## Open the file for read and write access. - ## If the file does not exist, it will not be - ## created. - fmAppend ## Open the file for writing only; append data - ## at the end. - - TFileHandle* = cint ## type that represents an OS file handle; this is - ## useful for low-level file access - - # text file handling: - var - stdin* {.importc: "stdin", noDecl.}: TFile ## The standard input stream. - stdout* {.importc: "stdout", noDecl.}: TFile ## The standard output stream. - stderr* {.importc: "stderr", noDecl.}: TFile - ## The standard error stream. - ## - ## Note: In my opinion, this should not be used -- the concept of a - ## separate error stream is a design flaw of UNIX. A seperate *message - ## stream* is a good idea, but since it is named ``stderr`` there are few - ## programs out there that distinguish properly between ``stdout`` and - ## ``stderr``. So, that's what you get if you don't name your variables - ## appropriately. It also annoys people if redirection via ``>output.txt`` - ## does not work because the program writes to ``stderr``. - - proc OpenFile*(f: var TFile, filename: string, - mode: TFileMode = fmRead, - bufSize: int = -1): Bool {.deprecated.} - ## **Deprecated since version 0.8.0**: Use `open` instead. - - proc OpenFile*(f: var TFile, filehandle: TFileHandle, - mode: TFileMode = fmRead): Bool {.deprecated.} - ## **Deprecated since version 0.8.0**: Use `open` instead. - - proc Open*(f: var TFile, filename: string, - mode: TFileMode = fmRead, bufSize: int = -1): Bool - ## Opens a file named `filename` with given `mode`. - ## - ## Default mode is readonly. Returns true iff the file could be opened. - ## This throws no exception if the file could not be opened. The reason is - ## that the programmer needs to provide an appropriate error message anyway - ## (yes, even in scripts). - - proc Open*(f: var TFile, filehandle: TFileHandle, - mode: TFileMode = fmRead): Bool - ## Creates a ``TFile`` from a `filehandle` with given `mode`. - ## - ## Default mode is readonly. Returns true iff the file could be opened. - - proc CloseFile*(f: TFile) {.importc: "fclose", nodecl, deprecated.} - ## Closes the file. - ## **Deprecated since version 0.8.0**: Use `close` instead. - - proc Close*(f: TFile) {.importc: "fclose", nodecl.} - ## Closes the file. - - proc EndOfFile*(f: TFile): Bool - ## Returns true iff `f` is at the end. - proc readChar*(f: TFile): char {.importc: "fgetc", nodecl.} - ## Reads a single character from the stream `f`. If the stream - ## has no more characters, `EEndOfFile` is raised. - proc FlushFile*(f: TFile) {.importc: "fflush", noDecl.} - ## Flushes `f`'s buffer. - - proc readFile*(filename: string): string - ## Opens a file name `filename` for reading. Then reads the - ## file's content completely into a string and - ## closes the file afterwards. Returns the string. Returns nil if there was - ## an error. Does not throw an IO exception. - - proc write*(f: TFile, r: float) - proc write*(f: TFile, i: int) - proc write*(f: TFile, s: string) - proc write*(f: TFile, b: Bool) - proc write*(f: TFile, c: char) - proc write*(f: TFile, c: cstring) - proc write*(f: TFile, a: openArray[string]) - ## Writes a value to the file `f`. May throw an IO exception. - - proc readLine*(f: TFile): string - ## reads a line of text from the file `f`. May throw an IO exception. - ## Reading from an empty file buffer, does not throw an exception, but - ## returns nil. A line of text may be delimited by ``CR``, ``LF`` or - ## ``CRLF``. The newline character(s) are not part of the returned string. - - proc writeln*[Ty](f: TFile, x: Ty) {.inline.} - ## writes a value `x` to `f` and then writes "\n". - ## May throw an IO exception. - - proc writeln*[Ty](f: TFile, x: openArray[Ty]) {.inline.} - ## writes a value `x` to `f` and then writes "\n". - ## May throw an IO exception. - - proc getFileSize*(f: TFile): int64 - ## retrieves the file size (in bytes) of `f`. - - proc ReadBytes*(f: TFile, a: var openarray[byte], start, len: int): int - ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns - ## the actual number of bytes that have been read which may be less than - ## `len` (if not as many bytes are remaining), but not greater. - - proc ReadChars*(f: TFile, a: var openarray[char], start, len: int): int - ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns - ## the actual number of bytes that have been read which may be less than - ## `len` (if not as many bytes are remaining), but not greater. - - proc readBuffer*(f: TFile, buffer: pointer, len: int): int - ## reads `len` bytes into the buffer pointed to by `buffer`. Returns - ## the actual number of bytes that have been read which may be less than - ## `len` (if not as many bytes are remaining), but not greater. - - proc writeBytes*(f: TFile, a: openarray[byte], start, len: int): int - ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns - ## the number of actual written bytes, which may be less than `len` in case - ## of an error. - - proc writeChars*(f: tFile, a: openarray[char], start, len: int): int - ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns - ## the number of actual written bytes, which may be less than `len` in case - ## of an error. - - proc writeBuffer*(f: TFile, buffer: pointer, len: int): int - ## writes the bytes of buffer pointed to by the parameter `buffer` to the - ## file `f`. Returns the number of actual written bytes, which may be less - ## than `len` in case of an error. - - proc setFilePos*(f: TFile, pos: int64) - ## sets the position of the file pointer that is used for read/write - ## operations. The file's first byte has the index zero. - - proc getFilePos*(f: TFile): int64 - ## retrieves the current position of the file pointer that is used to - ## read from the file `f`. The file's first byte has the index zero. - - include "system/sysio" - - iterator lines*(filename: string): string = - ## Iterate over any line in the file named `filename`. - ## If the file does not exist `EIO` is raised. - var - f: TFile - if not open(f, filename): - raise newException(EIO, "cannot open: " & filename) - var res = "" - while not endOfFile(f): - rawReadLine(f, res) - yield res - Close(f) - - proc fileHandle*(f: TFile): TFileHandle {.importc: "fileno", - header: ""} - ## returns the OS file handle of the file ``f``. This is only useful for - ## platform specific programming. - - proc quit(errormsg: string) = - echo(errormsg) - quit(quitFailure) - - # ---------------------------------------------------------------------------- - - include "system/excpt" - # we cannot compile this with stack tracing on - # as it would recurse endlessly! - include "system/arithm" - {.pop.} # stack trace - include "system/dyncalls" - include "system/sets" - - const - GenericSeqSize = (2 * sizeof(int)) - - proc reprAny(p: pointer, typ: PNimType): string {.compilerproc.} - - proc getDiscriminant(aa: Pointer, n: ptr TNimNode): int = - assert(n.kind == nkCase) - var d: int - var a = cast[TAddress](aa) - case n.typ.size - of 1: d = ze(cast[ptr int8](a +% n.offset)^) - of 2: d = ze(cast[ptr int16](a +% n.offset)^) - of 4: d = int(cast[ptr int32](a +% n.offset)^) - else: assert(false) - return d - - proc selectBranch(aa: Pointer, n: ptr TNimNode): ptr TNimNode = - var discr = getDiscriminant(aa, n) - if discr <% n.len: - result = n.sons[discr] - if result == nil: result = n.sons[n.len] - # n.sons[n.len] contains the ``else`` part (but may be nil) - else: - result = n.sons[n.len] - - include "system/mm" - include "system/sysstr" - include "system/assign" - include "system/repr" - - # we have to implement it here after gentostr for the cstrToNimStrDummy proc - proc getCurrentExceptionMsg(): string = - if excHandler == nil: return "" - return $excHandler.exc.msg - - {.push stack_trace: off.} - when defined(endb): - include "system/debugger" - - when defined(profiler): - include "system/profiler" - {.pop.} # stacktrace - -elif defined(ecmaScript): - include "system/ecmasys" -elif defined(NimrodVM): - # Stubs for the GC interface: - proc GC_disable() = nil - proc GC_enable() = nil - proc GC_fullCollect() = nil - proc GC_setStrategy(strategy: TGC_Strategy) = nil - proc GC_enableMarkAndSweep() = nil - proc GC_disableMarkAndSweep() = nil - proc GC_getStatistics(): string = return "" - - proc getOccupiedMem(): int = return -1 - proc getFreeMem(): int = return -1 - proc getTotalMem(): int = return -1 - - proc cmp(x, y: string): int = - if x == y: return 0 - if x < y: return -1 - return 1 - - proc dealloc(p: pointer) = nil - proc alloc(size: int): pointer = nil - proc alloc0(size: int): pointer = nil - proc realloc(p: Pointer, newsize: int): pointer = nil - -{.pop.} # checks -{.pop.} # hints diff --git a/nimlib/system/alloc.nim b/nimlib/system/alloc.nim deleted file mode 100755 index 95feff854b..0000000000 --- a/nimlib/system/alloc.nim +++ /dev/null @@ -1,596 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Low level allocator for Nimrod. Has been designed to support the GC. -# TODO: -# - eliminate "used" field -# - make searching for block O(1) - -# ------------ platform specific chunk allocation code ----------------------- - -when defined(posix): - const - PROT_READ = 1 # page can be read - PROT_WRITE = 2 # page can be written - MAP_PRIVATE = 2 # Changes are private - - when defined(linux) or defined(aix): - const MAP_ANONYMOUS = 0x20 # don't use a file - elif defined(macosx) or defined(bsd): - const MAP_ANONYMOUS = 0x1000 - elif defined(solaris): - const MAP_ANONYMOUS = 0x100 - else: - {.error: "Port memory manager to your platform".} - - proc mmap(adr: pointer, len: int, prot, flags, fildes: cint, - off: int): pointer {.header: "".} - - proc munmap(adr: pointer, len: int) {.header: "".} - - proc osAllocPages(size: int): pointer {.inline.} = - result = mmap(nil, size, PROT_READ or PROT_WRITE, - MAP_PRIVATE or MAP_ANONYMOUS, -1, 0) - if result == nil or result == cast[pointer](-1): - raiseOutOfMem() - - proc osDeallocPages(p: pointer, size: int) {.inline} = - when reallyOsDealloc: munmap(p, size) - -elif defined(windows): - const - MEM_RESERVE = 0x2000 - MEM_COMMIT = 0x1000 - MEM_TOP_DOWN = 0x100000 - PAGE_READWRITE = 0x04 - - MEM_DECOMMIT = 0x4000 - MEM_RELEASE = 0x8000 - - proc VirtualAlloc(lpAddress: pointer, dwSize: int, flAllocationType, - flProtect: int32): pointer {. - header: "", stdcall.} - - proc VirtualFree(lpAddress: pointer, dwSize: int, - dwFreeType: int32) {.header: "", stdcall.} - - proc osAllocPages(size: int): pointer {.inline.} = - result = VirtualAlloc(nil, size, MEM_RESERVE or MEM_COMMIT, - PAGE_READWRITE) - if result == nil: raiseOutOfMem() - - proc osDeallocPages(p: pointer, size: int) {.inline.} = - # according to Microsoft, 0 is the only correct value here: - when reallyOsDealloc: VirtualFree(p, 0, MEM_RELEASE) - -else: - {.error: "Port memory manager to your platform".} - -# --------------------- end of non-portable code ----------------------------- - -# We manage *chunks* of memory. Each chunk is a multiple of the page size. -# Each chunk starts at an address that is divisible by the page size. Chunks -# that are bigger than ``ChunkOsReturn`` are returned back to the operating -# system immediately. - -const - ChunkOsReturn = 256 * PageSize - InitialMemoryRequest = ChunkOsReturn div 2 # < ChunkOsReturn! - SmallChunkSize = PageSize - -type - PTrunk = ptr TTrunk - TTrunk {.final.} = object - next: PTrunk # all nodes are connected with this pointer - key: int # start address at bit 0 - bits: array[0..IntsPerTrunk-1, int] # a bit vector - - TTrunkBuckets = array[0..1023, PTrunk] - TIntSet {.final.} = object - data: TTrunkBuckets - -type - TAlignType = biggestFloat - TFreeCell {.final, pure.} = object - next: ptr TFreeCell # next free cell in chunk (overlaid with refcount) - zeroField: int # 0 means cell is not used (overlaid with typ field) - # 1 means cell is manually managed pointer - - PChunk = ptr TBaseChunk - PBigChunk = ptr TBigChunk - PSmallChunk = ptr TSmallChunk - TBaseChunk {.pure.} = object - prevSize: int # size of previous chunk; for coalescing - size: int # if < PageSize it is a small chunk - used: bool # later will be optimized into prevSize... - - TSmallChunk = object of TBaseChunk - next, prev: PSmallChunk # chunks of the same size - freeList: ptr TFreeCell - free: int # how many bytes remain - acc: int # accumulator for small object allocation - data: TAlignType # start of usable memory - - TBigChunk = object of TBaseChunk # not necessarily > PageSize! - next: PBigChunk # chunks of the same (or bigger) size - prev: PBigChunk - align: int - data: TAlignType # start of usable memory - -template smallChunkOverhead(): expr = sizeof(TSmallChunk)-sizeof(TAlignType) -template bigChunkOverhead(): expr = sizeof(TBigChunk)-sizeof(TAlignType) - -proc roundup(x, v: int): int {.inline.} = - result = (x + (v-1)) and not (v-1) - assert(result >= x) - #return ((-x) and (v-1)) +% x - -assert(roundup(14, PageSize) == PageSize) -assert(roundup(15, 8) == 16) -assert(roundup(65, 8) == 72) - -# ------------- chunk table --------------------------------------------------- -# We use a PtrSet of chunk starts and a table[Page, chunksize] for chunk -# endings of big chunks. This is needed by the merging operation. The only -# remaining operation is best-fit for big chunks. Since there is a size-limit -# for big chunks (because greater than the limit means they are returned back -# to the OS), a fixed size array can be used. - -type - PLLChunk = ptr TLLChunk - TLLChunk {.pure.} = object ## *low-level* chunk - size: int # remaining size - acc: int # accumulator - - TAllocator {.final, pure.} = object - llmem: PLLChunk - currMem, maxMem, freeMem: int # memory sizes (allocated from OS) - freeSmallChunks: array[0..SmallChunkSize div MemAlign-1, PSmallChunk] - freeChunksList: PBigChunk # XXX make this a datastructure with O(1) access - chunkStarts: TIntSet - -proc incCurrMem(a: var TAllocator, bytes: int) {.inline.} = - inc(a.currMem, bytes) - -proc decCurrMem(a: var TAllocator, bytes: int) {.inline.} = - a.maxMem = max(a.maxMem, a.currMem) - dec(a.currMem, bytes) - -proc getMaxMem(a: var TAllocator): int = - # Since we update maxPagesCount only when freeing pages, - # maxPagesCount may not be up to date. Thus we use the - # maximum of these both values here: - return max(a.currMem, a.maxMem) - -var - allocator: TAllocator - -proc llAlloc(a: var TAllocator, size: int): pointer = - # *low-level* alloc for the memory managers data structures. Deallocation - # is never done. - if a.llmem == nil or size > a.llmem.size: - var request = roundup(size+sizeof(TLLChunk), PageSize) - a.llmem = cast[PLLChunk](osAllocPages(request)) - incCurrMem(a, request) - a.llmem.size = request - sizeof(TLLChunk) - a.llmem.acc = sizeof(TLLChunk) - result = cast[pointer](cast[TAddress](a.llmem) + a.llmem.acc) - dec(a.llmem.size, size) - inc(a.llmem.acc, size) - zeroMem(result, size) - -proc IntSetGet(t: TIntSet, key: int): PTrunk = - var it = t.data[key and high(t.data)] - while it != nil: - if it.key == key: return it - it = it.next - result = nil - -proc IntSetPut(t: var TIntSet, key: int): PTrunk = - result = IntSetGet(t, key) - if result == nil: - result = cast[PTrunk](llAlloc(allocator, sizeof(result^))) - result.next = t.data[key and high(t.data)] - t.data[key and high(t.data)] = result - result.key = key - -proc Contains(s: TIntSet, key: int): bool = - var t = IntSetGet(s, key shr TrunkShift) - if t != nil: - var u = key and TrunkMask - result = (t.bits[u shr IntShift] and (1 shl (u and IntMask))) != 0 - else: - result = false - -proc Incl(s: var TIntSet, key: int) = - var t = IntSetPut(s, key shr TrunkShift) - var u = key and TrunkMask - t.bits[u shr IntShift] = t.bits[u shr IntShift] or (1 shl (u and IntMask)) - -proc Excl(s: var TIntSet, key: int) = - var t = IntSetGet(s, key shr TrunkShift) - if t != nil: - var u = key and TrunkMask - t.bits[u shr IntShift] = t.bits[u shr IntShift] and not - (1 shl (u and IntMask)) - -proc ContainsOrIncl(s: var TIntSet, key: int): bool = - var t = IntSetGet(s, key shr TrunkShift) - if t != nil: - var u = key and TrunkMask - result = (t.bits[u shr IntShift] and (1 shl (u and IntMask))) != 0 - if not result: - t.bits[u shr IntShift] = t.bits[u shr IntShift] or - (1 shl (u and IntMask)) - else: - Incl(s, key) - result = false - -# ------------- chunk management ---------------------------------------------- -proc pageIndex(c: PChunk): int {.inline.} = - result = cast[TAddress](c) shr PageShift - -proc pageIndex(p: pointer): int {.inline.} = - result = cast[TAddress](p) shr PageShift - -proc pageAddr(p: pointer): PChunk {.inline.} = - result = cast[PChunk](cast[TAddress](p) and not PageMask) - assert(Contains(allocator.chunkStarts, pageIndex(result))) - -var lastSize = PageSize - -proc requestOsChunks(a: var TAllocator, size: int): PBigChunk = - incCurrMem(a, size) - inc(a.freeMem, size) - result = cast[PBigChunk](osAllocPages(size)) - assert((cast[TAddress](result) and PageMask) == 0) - #zeroMem(result, size) - result.next = nil - result.prev = nil - result.used = false - result.size = size - # update next.prevSize: - var nxt = cast[TAddress](result) +% size - assert((nxt and PageMask) == 0) - var next = cast[PChunk](nxt) - if pageIndex(next) in a.chunkStarts: - #echo("Next already allocated!") - next.prevSize = size - # set result.prevSize: - var prv = cast[TAddress](result) -% lastSize - assert((nxt and PageMask) == 0) - var prev = cast[PChunk](prv) - if pageIndex(prev) in a.chunkStarts and prev.size == lastSize: - #echo("Prev already allocated!") - result.prevSize = lastSize - else: - result.prevSize = 0 # unknown - lastSize = size # for next request - -proc freeOsChunks(a: var TAllocator, p: pointer, size: int) = - # update next.prevSize: - var c = cast[PChunk](p) - var nxt = cast[TAddress](p) +% c.size - assert((nxt and PageMask) == 0) - var next = cast[PChunk](nxt) - if pageIndex(next) in a.chunkStarts: - next.prevSize = 0 # XXX used - excl(a.chunkStarts, pageIndex(p)) - osDeallocPages(p, size) - decCurrMem(a, size) - dec(a.freeMem, size) - #c_fprintf(c_stdout, "[Alloc] back to OS: %ld\n", size) - -proc isAccessible(p: pointer): bool {.inline.} = - result = Contains(allocator.chunkStarts, pageIndex(p)) - -proc contains[T](list, x: T): bool = - var it = list - while it != nil: - if it == x: return true - it = it.next - -proc writeFreeList(a: TAllocator) = - var it = a.freeChunksList - c_fprintf(c_stdout, "freeChunksList: %p\n", it) - while it != nil: - c_fprintf(c_stdout, "it: %p, next: %p, prev: %p\n", - it, it.next, it.prev) - it = it.next - -proc ListAdd[T](head: var T, c: T) {.inline.} = - assert(c notin head) - assert c.prev == nil - assert c.next == nil - c.next = head - if head != nil: - assert head.prev == nil - head.prev = c - head = c - -proc ListRemove[T](head: var T, c: T) {.inline.} = - assert(c in head) - if c == head: - head = c.next - assert c.prev == nil - if head != nil: head.prev = nil - else: - assert c.prev != nil - c.prev.next = c.next - if c.next != nil: c.next.prev = c.prev - c.next = nil - c.prev = nil - -proc isSmallChunk(c: PChunk): bool {.inline.} = - return c.size <= SmallChunkSize-smallChunkOverhead() - #return c.size < SmallChunkSize - -proc chunkUnused(c: PChunk): bool {.inline.} = - result = not c.used - -proc updatePrevSize(a: var TAllocator, c: PBigChunk, - prevSize: int) {.inline.} = - var ri = cast[PChunk](cast[TAddress](c) +% c.size) - assert((cast[TAddress](ri) and PageMask) == 0) - if isAccessible(ri): - ri.prevSize = prevSize - -proc freeBigChunk(a: var TAllocator, c: PBigChunk) = - var c = c - assert(c.size >= PageSize) - inc(a.freeMem, c.size) - when coalescRight: - var ri = cast[PChunk](cast[TAddress](c) +% c.size) - assert((cast[TAddress](ri) and PageMask) == 0) - if isAccessible(ri) and chunkUnused(ri): - assert(not isSmallChunk(ri)) - if not isSmallChunk(ri): - ListRemove(a.freeChunksList, cast[PBigChunk](ri)) - inc(c.size, ri.size) - excl(a.chunkStarts, pageIndex(ri)) - when coalescLeft: - if c.prevSize != 0: - var le = cast[PChunk](cast[TAddress](c) -% c.prevSize) - assert((cast[TAddress](le) and PageMask) == 0) - if isAccessible(le) and chunkUnused(le): - assert(not isSmallChunk(le)) - if not isSmallChunk(le): - ListRemove(a.freeChunksList, cast[PBigChunk](le)) - inc(le.size, c.size) - excl(a.chunkStarts, pageIndex(c)) - c = cast[PBigChunk](le) - - if c.size < ChunkOsReturn: - incl(a.chunkStarts, pageIndex(c)) - updatePrevSize(a, c, c.size) - ListAdd(a.freeChunksList, c) - c.used = false - else: - freeOsChunks(a, c, c.size) - -proc splitChunk(a: var TAllocator, c: PBigChunk, size: int) = - var rest = cast[PBigChunk](cast[TAddress](c) +% size) - if rest in a.freeChunksList: - c_fprintf(c_stdout, "to add: %p\n", rest) - writeFreeList(allocator) - assert false - rest.size = c.size - size - rest.used = false - rest.next = nil - rest.prev = nil - rest.prevSize = size - updatePrevSize(a, c, rest.size) - c.size = size - incl(a.chunkStarts, pageIndex(rest)) - ListAdd(a.freeChunksList, rest) - -proc getBigChunk(a: var TAllocator, size: int): PBigChunk = - # use first fit for now: - assert((size and PageMask) == 0) - assert(size > 0) - result = a.freeChunksList - block search: - while result != nil: - #if not chunkUnused(result): - # c_fprintf(c_stdout, "%lld\n", int(result.used)) - assert chunkUnused(result) - if result.size == size: - ListRemove(a.freeChunksList, result) - break search - elif result.size > size: - #c_fprintf(c_stdout, "res size: %lld; size: %lld\n", result.size, size) - ListRemove(a.freeChunksList, result) - splitChunk(a, result, size) - break search - result = result.next - assert result != a.freeChunksList - if size < InitialMemoryRequest: - result = requestOsChunks(a, InitialMemoryRequest) - splitChunk(a, result, size) - else: - result = requestOsChunks(a, size) - result.prevSize = 0 # XXX why is this needed? - result.used = true - incl(a.chunkStarts, pageIndex(result)) - dec(a.freeMem, size) - -proc getSmallChunk(a: var TAllocator): PSmallChunk = - var res = getBigChunk(a, PageSize) - assert res.prev == nil - assert res.next == nil - result = cast[PSmallChunk](res) - -# ----------------------------------------------------------------------------- - -proc getCellSize(p: pointer): int {.inline.} = - var c = pageAddr(p) - result = c.size - -proc rawAlloc(a: var TAllocator, requestedSize: int): pointer = - assert(roundup(65, 8) == 72) - assert requestedSize >= sizeof(TFreeCell) - var size = roundup(requestedSize, MemAlign) - #c_fprintf(c_stdout, "alloc; size: %ld; %ld\n", requestedSize, size) - if size <= SmallChunkSize-smallChunkOverhead(): - # allocate a small block: for small chunks, we use only its next pointer - var s = size div MemAlign - var c = a.freeSmallChunks[s] - if c == nil: - c = getSmallChunk(a) - c.freeList = nil - assert c.size == PageSize - c.size = size - c.acc = size - c.free = SmallChunkSize - smallChunkOverhead() - size - c.next = nil - c.prev = nil - ListAdd(a.freeSmallChunks[s], c) - result = addr(c.data) - assert((cast[TAddress](result) and (MemAlign-1)) == 0) - else: - assert c.next != c - #if c.size != size: - # c_fprintf(c_stdout, "csize: %lld; size %lld\n", c.size, size) - assert c.size == size - if c.freeList == nil: - assert(c.acc + smallChunkOverhead() + size <= SmallChunkSize) - result = cast[pointer](cast[TAddress](addr(c.data)) +% c.acc) - inc(c.acc, size) - else: - result = c.freeList - assert(c.freeList.zeroField == 0) - c.freeList = c.freeList.next - dec(c.free, size) - assert((cast[TAddress](result) and (MemAlign-1)) == 0) - if c.free < size: - ListRemove(a.freeSmallChunks[s], c) - else: - size = roundup(requestedSize+bigChunkOverhead(), PageSize) - # allocate a large block - var c = getBigChunk(a, size) - assert c.prev == nil - assert c.next == nil - assert c.size == size - result = addr(c.data) - assert((cast[TAddress](result) and (MemAlign-1)) == 0) - assert(isAccessible(result)) - -proc rawDealloc(a: var TAllocator, p: pointer) = - var c = pageAddr(p) - if isSmallChunk(c): - # `p` is within a small chunk: - var c = cast[PSmallChunk](c) - var s = c.size - var f = cast[ptr TFreeCell](p) - #echo("setting to nil: ", $cast[TAddress](addr(f.zeroField))) - assert(f.zeroField != 0) - f.zeroField = 0 - f.next = c.freeList - c.freeList = f - when overwriteFree: - # set to 0xff to check for usage after free bugs: - c_memset(cast[pointer](cast[int](p) +% sizeof(TFreeCell)), -1'i32, - s -% sizeof(TFreeCell)) - # check if it is not in the freeSmallChunks[s] list: - if c.free < s: - assert c notin a.freeSmallChunks[s div memAlign] - # add it to the freeSmallChunks[s] array: - ListAdd(a.freeSmallChunks[s div memAlign], c) - inc(c.free, s) - else: - inc(c.free, s) - if c.free == SmallChunkSize-smallChunkOverhead(): - ListRemove(a.freeSmallChunks[s div memAlign], c) - c.size = SmallChunkSize - freeBigChunk(a, cast[PBigChunk](c)) - else: - # set to 0xff to check for usage after free bugs: - when overwriteFree: c_memset(p, -1'i32, c.size -% bigChunkOverhead()) - # free big chunk - freeBigChunk(a, cast[PBigChunk](c)) - -proc isAllocatedPtr(a: TAllocator, p: pointer): bool = - if isAccessible(p): - var c = pageAddr(p) - if not chunkUnused(c): - if isSmallChunk(c): - var c = cast[PSmallChunk](c) - var offset = (cast[TAddress](p) and (PageSize-1)) -% - smallChunkOverhead() - result = (c.acc >% offset) and (offset %% c.size == 0) and - (cast[ptr TFreeCell](p).zeroField >% 1) - else: - var c = cast[PBigChunk](c) - result = p == addr(c.data) and cast[ptr TFreeCell](p).zeroField >% 1 - -# ---------------------- interface to programs ------------------------------- - -proc alloc(size: int): pointer = - result = rawAlloc(allocator, size+sizeof(TFreeCell)) - cast[ptr TFreeCell](result).zeroField = 1 # mark it as used - assert(not isAllocatedPtr(allocator, result)) - result = cast[pointer](cast[TAddress](result) +% sizeof(TFreeCell)) - -proc alloc0(size: int): pointer = - result = alloc(size) - zeroMem(result, size) - -proc dealloc(p: pointer) = - var x = cast[pointer](cast[TAddress](p) -% sizeof(TFreeCell)) - assert(cast[ptr TFreeCell](x).zeroField == 1) - rawDealloc(allocator, x) - assert(not isAllocatedPtr(allocator, x)) - -proc ptrSize(p: pointer): int = - var x = cast[pointer](cast[TAddress](p) -% sizeof(TFreeCell)) - result = pageAddr(x).size - sizeof(TFreeCell) - -proc realloc(p: pointer, newsize: int): pointer = - if newsize > 0: - result = alloc(newsize) - if p != nil: - copyMem(result, p, ptrSize(p)) - dealloc(p) - elif p != nil: - dealloc(p) - -proc countFreeMem(): int = - # only used for assertions - var it = allocator.freeChunksList - while it != nil: - inc(result, it.size) - it = it.next - -proc getFreeMem(): int = - result = allocator.freeMem - #assert(result == countFreeMem()) - -proc getTotalMem(): int = return allocator.currMem -proc getOccupiedMem(): int = return getTotalMem() - getFreeMem() - -when isMainModule: - const iterations = 4000_000 - incl(allocator.chunkStarts, 11) - assert 11 in allocator.chunkStarts - excl(allocator.chunkStarts, 11) - assert 11 notin allocator.chunkStarts - var p: array [1..iterations, pointer] - for i in 7..7: - var x = i * 8 - for j in 1.. iterations: - p[j] = alloc(allocator, x) - for j in 1..iterations: - assert isAllocatedPtr(allocator, p[j]) - echo($i, " used memory: ", $(allocator.currMem)) - for j in countdown(iterations, 1): - #echo("j: ", $j) - dealloc(allocator, p[j]) - assert(not isAllocatedPtr(allocator, p[j])) - echo($i, " after freeing: ", $(allocator.currMem)) - diff --git a/nimlib/system/ansi_c.nim b/nimlib/system/ansi_c.nim deleted file mode 100755 index e9300949b7..0000000000 --- a/nimlib/system/ansi_c.nim +++ /dev/null @@ -1,105 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This include file contains headers of Ansi C procs -# and definitions of Ansi C types in Nimrod syntax -# All symbols are prefixed with 'c_' to avoid ambiguities - -{.push hints:off} - -proc c_strcmp(a, b: CString): cint {.nodecl, noSideEffect, importc: "strcmp".} -proc c_memcmp(a, b: CString, size: cint): cint {. - nodecl, noSideEffect, importc: "memcmp".} -proc c_memcpy(a, b: CString, size: cint) {.nodecl, importc: "memcpy".} -proc c_strlen(a: CString): int {.nodecl, noSideEffect, importc: "strlen".} -proc c_memset(p: pointer, value: cint, size: int) {.nodecl, importc: "memset".} - -type - C_TextFile {.importc: "FILE", nodecl, final.} = object # empty record for - # data hiding - C_BinaryFile {.importc: "FILE", nodecl, final.} = object - C_TextFileStar = ptr CTextFile - C_BinaryFileStar = ptr CBinaryFile - - C_JmpBuf {.importc: "jmp_buf".} = array[0..31, int] - -var - c_stdin {.importc: "stdin", noDecl.}: C_TextFileStar - c_stdout {.importc: "stdout", noDecl.}: C_TextFileStar - c_stderr {.importc: "stderr", noDecl.}: C_TextFileStar - -var # constants faked as variables: - SIGINT {.importc: "SIGINT", nodecl.}: cint - SIGSEGV {.importc: "SIGSEGV", nodecl.}: cint - SIGABRT {.importc: "SIGABRT", nodecl.}: cint - SIGFPE {.importc: "SIGFPE", nodecl.}: cint - SIGILL {.importc: "SIGILL", nodecl.}: cint - -when defined(macosx): - var - SIGBUS {.importc: "SIGBUS", nodecl.}: cint - # hopefully this does not lead to new bugs -else: - var - SIGBUS {.importc: "SIGSEGV", nodecl.}: cint - # only Mac OS X has this shit - -proc c_longjmp(jmpb: C_JmpBuf, retval: cint) {.nodecl, importc: "longjmp".} -proc c_setjmp(jmpb: var C_JmpBuf): cint {.nodecl, importc: "setjmp".} - -proc c_signal(sig: cint, handler: proc (a: cint) {.noconv.}) {. - importc: "signal", header: "".} -proc c_raise(sig: cint) {.importc: "raise", header: "".} - -proc c_fputs(c: cstring, f: C_TextFileStar) {.importc: "fputs", noDecl.} -proc c_fgets(c: cstring, n: int, f: C_TextFileStar): cstring {. - importc: "fgets", noDecl.} -proc c_fgetc(stream: C_TextFileStar): int {.importc: "fgetc", nodecl.} -proc c_ungetc(c: int, f: C_TextFileStar) {.importc: "ungetc", nodecl.} -proc c_putc(c: Char, stream: C_TextFileStar) {.importc: "putc", nodecl.} -proc c_fprintf(f: C_TextFileStar, frmt: CString) {. - importc: "fprintf", nodecl, varargs.} - -proc c_fopen(filename, mode: cstring): C_TextFileStar {. - importc: "fopen", nodecl.} -proc c_fclose(f: C_TextFileStar) {.importc: "fclose", nodecl.} - -proc c_sprintf(buf, frmt: CString) {.nodecl, importc: "sprintf", varargs.} - # we use it only in a way that cannot lead to security issues - -proc c_fread(buf: Pointer, size, n: int, f: C_BinaryFileStar): int {. - importc: "fread", noDecl.} -proc c_fseek(f: C_BinaryFileStar, offset: clong, whence: int): int {. - importc: "fseek", noDecl.} - -proc c_fwrite(buf: Pointer, size, n: int, f: C_BinaryFileStar): int {. - importc: "fwrite", noDecl.} - -proc c_exit(errorcode: cint) {.importc: "exit", nodecl.} -proc c_ferror(stream: C_TextFileStar): bool {.importc: "ferror", nodecl.} -proc c_fflush(stream: C_TextFileStar) {.importc: "fflush", nodecl.} -proc c_abort() {.importc: "abort", nodecl.} -proc c_feof(stream: C_TextFileStar): bool {.importc: "feof", nodecl.} - -proc c_malloc(size: int): pointer {.importc: "malloc", nodecl.} -proc c_free(p: pointer) {.importc: "free", nodecl.} -proc c_realloc(p: pointer, newsize: int): pointer {.importc: "realloc", nodecl.} - -var errno {.importc, header: "".}: cint ## error variable -proc strerror(errnum: cint): cstring {.importc, header: "".} - -proc c_remove(filename: CString): cint {.importc: "remove", noDecl.} -proc c_rename(oldname, newname: CString): cint {.importc: "rename", noDecl.} - -proc c_system(cmd: CString): cint {.importc: "system", header: "".} -proc c_getenv(env: CString): CString {.importc: "getenv", noDecl.} -proc c_putenv(env: CString): cint {.importc: "putenv", noDecl.} - -{.pop} - diff --git a/nimlib/system/arithm.nim b/nimlib/system/arithm.nim deleted file mode 100755 index f097ee7942..0000000000 --- a/nimlib/system/arithm.nim +++ /dev/null @@ -1,316 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -# simple integer arithmetic with overflow checking - -proc raiseOverflow {.compilerproc, noinline, noreturn.} = - # a single proc to reduce code size to a minimum - raise newException(EOverflow, "over- or underflow") - -proc raiseDivByZero {.compilerproc, noinline, noreturn.} = - raise newException(EDivByZero, "divison by zero") - -proc addInt64(a, b: int64): int64 {.compilerProc, inline.} = - result = a +% b - if (result xor a) >= int64(0) or (result xor b) >= int64(0): - return result - raiseOverflow() - -proc subInt64(a, b: int64): int64 {.compilerProc, inline.} = - result = a -% b - if (result xor a) >= int64(0) or (result xor not b) >= int64(0): - return result - raiseOverflow() - -proc negInt64(a: int64): int64 {.compilerProc, inline.} = - if a != low(int64): return -a - raiseOverflow() - -proc absInt64(a: int64): int64 {.compilerProc, inline.} = - if a != low(int64): - if a >= 0: return a - else: return -a - raiseOverflow() - -proc divInt64(a, b: int64): int64 {.compilerProc, inline.} = - if b == int64(0): - raiseDivByZero() - if a == low(int64) and b == int64(-1): - raiseOverflow() - return a div b - -proc modInt64(a, b: int64): int64 {.compilerProc, inline.} = - if b == int64(0): - raiseDivByZero() - return a mod b - -# -# This code has been inspired by Python's source code. -# The native int product x*y is either exactly right or *way* off, being -# just the last n bits of the true product, where n is the number of bits -# in an int (the delivered product is the true product plus i*2**n for -# some integer i). -# -# The native float64 product x*y is subject to three -# rounding errors: on a sizeof(int)==8 box, each cast to double can lose -# info, and even on a sizeof(int)==4 box, the multiplication can lose info. -# But, unlike the native int product, it's not in *range* trouble: even -# if sizeof(int)==32 (256-bit ints), the product easily fits in the -# dynamic range of a float64. So the leading 50 (or so) bits of the float64 -# product are correct. -# -# We check these two ways against each other, and declare victory if they're -# approximately the same. Else, because the native int product is the only -# one that can lose catastrophic amounts of information, it's the native int -# product that must have overflowed. -# -proc mulInt64(a, b: int64): int64 {.compilerproc.} = - var - resAsFloat, floatProd: float64 - result = a *% b - floatProd = toBiggestFloat(a) # conversion - floatProd = floatProd * toBiggestFloat(b) - resAsFloat = toBiggestFloat(result) - - # Fast path for normal case: small multiplicands, and no info - # is lost in either method. - if resAsFloat == floatProd: return result - - # Somebody somewhere lost info. Close enough, or way off? Note - # that a != 0 and b != 0 (else resAsFloat == floatProd == 0). - # The difference either is or isn't significant compared to the - # true value (of which floatProd is a good approximation). - - # abs(diff)/abs(prod) <= 1/32 iff - # 32 * abs(diff) <= abs(prod) -- 5 good bits is "close enough" - if 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd): - return result - raiseOverflow() - - -proc absInt(a: int): int {.compilerProc, inline.} = - if a != low(int): - if a >= 0: return a - else: return -a - raiseOverflow() - -const - asmVersion = defined(I386) and (defined(vcc) or defined(wcc) or - defined(dmc) or defined(gcc) or defined(llvm_gcc)) - # my Version of Borland C++Builder does not have - # tasm32, which is needed for assembler blocks - # this is why Borland is not included in the 'when' - -when asmVersion and not defined(gcc) and not defined(llvm_gcc): - # assembler optimized versions for compilers that - # have an intel syntax assembler: - proc addInt(a, b: int): int {.compilerProc, pure.} = - # a in eax, and b in edx - asm """ - mov eax, `a` - add eax, `b` - jno theEnd - call `raiseOverflow` - theEnd: - """ - - proc subInt(a, b: int): int {.compilerProc, pure.} = - asm """ - mov eax, `a` - sub eax, `b` - jno theEnd - call `raiseOverflow` - theEnd: - """ - - proc negInt(a: int): int {.compilerProc, pure.} = - asm """ - mov eax, `a` - neg eax - jno theEnd - call `raiseOverflow` - theEnd: - """ - - proc divInt(a, b: int): int {.compilerProc, pure.} = - asm """ - mov eax, `a` - mov ecx, `b` - xor edx, edx - idiv ecx - jno theEnd - call `raiseOverflow` - theEnd: - """ - - proc modInt(a, b: int): int {.compilerProc, pure.} = - asm """ - mov eax, `a` - mov ecx, `b` - xor edx, edx - idiv ecx - jno theEnd - call `raiseOverflow` - theEnd: - mov eax, edx - """ - - proc mulInt(a, b: int): int {.compilerProc, pure.} = - asm """ - mov eax, `a` - mov ecx, `b` - xor edx, edx - imul ecx - jno theEnd - call `raiseOverflow` - theEnd: - """ - -elif false: # asmVersion and (defined(gcc) or defined(llvm_gcc)): - proc addInt(a, b: int): int {.compilerProc, inline.} = - # don't use a pure proc here! - asm """ - "addl %%ecx, %%eax\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - :"=a"(`result`) - :"a"(`a`), "c"(`b`) - """ - - proc subInt(a, b: int): int {.compilerProc, inline.} = - asm """ "subl %%ecx,%%eax\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - :"=a"(`result`) - :"a"(`a`), "c"(`b`) - """ - - proc mulInt(a, b: int): int {.compilerProc, inline.} = - asm """ "xorl %%edx, %%edx\n" - "imull %%ecx\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - :"=a"(`result`) - :"a"(`a`), "c"(`b`) - :"%edx" - """ - - proc negInt(a: int): int {.compilerProc, inline.} = - asm """ "negl %%eax\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - :"=a"(`result`) - :"a"(`a`) - """ - - proc divInt(a, b: int): int {.compilerProc, inline.} = - asm """ "xorl %%edx, %%edx\n" - "idivl %%ecx\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - :"=a"(`result`) - :"a"(`a`), "c"(`b`) - :"%edx" - """ - - proc modInt(a, b: int): int {.compilerProc, inline.} = - asm """ "xorl %%edx, %%edx\n" - "idivl %%ecx\n" - "jno 1\n" - "call _raiseOverflow\n" - "1: \n" - "movl %%edx, %%eax" - :"=a"(`result`) - :"a"(`a`), "c"(`b`) - :"%edx" - """ - -# Platform independant versions of the above (slower!) -when not defined(addInt): - proc addInt(a, b: int): int {.compilerProc, inline.} = - result = a +% b - if (result xor a) >= 0 or (result xor b) >= 0: - return result - raiseOverflow() - -when not defined(subInt): - proc subInt(a, b: int): int {.compilerProc, inline.} = - result = a -% b - if (result xor a) >= 0 or (result xor not b) >= 0: - return result - raiseOverflow() - -when not defined(negInt): - proc negInt(a: int): int {.compilerProc, inline.} = - if a != low(int): return -a - raiseOverflow() - -when not defined(divInt): - proc divInt(a, b: int): int {.compilerProc, inline.} = - if b == 0: - raiseDivByZero() - if a == low(int) and b == -1: - raiseOverflow() - return a div b - -when not defined(modInt): - proc modInt(a, b: int): int {.compilerProc, inline.} = - if b == 0: - raiseDivByZero() - return a mod b - -when not defined(mulInt): - # - # This code has been inspired by Python's source code. - # The native int product x*y is either exactly right or *way* off, being - # just the last n bits of the true product, where n is the number of bits - # in an int (the delivered product is the true product plus i*2**n for - # some integer i). - # - # The native float64 product x*y is subject to three - # rounding errors: on a sizeof(int)==8 box, each cast to double can lose - # info, and even on a sizeof(int)==4 box, the multiplication can lose info. - # But, unlike the native int product, it's not in *range* trouble: even - # if sizeof(int)==32 (256-bit ints), the product easily fits in the - # dynamic range of a float64. So the leading 50 (or so) bits of the float64 - # product are correct. - # - # We check these two ways against each other, and declare victory if - # they're approximately the same. Else, because the native int product is - # the only one that can lose catastrophic amounts of information, it's the - # native int product that must have overflowed. - # - proc mulInt(a, b: int): int {.compilerProc.} = - var - resAsFloat, floatProd: float - - result = a *% b - floatProd = toFloat(a) * toFloat(b) - resAsFloat = toFloat(result) - - # Fast path for normal case: small multiplicands, and no info - # is lost in either method. - if resAsFloat == floatProd: return result - - # Somebody somewhere lost info. Close enough, or way off? Note - # that a != 0 and b != 0 (else resAsFloat == floatProd == 0). - # The difference either is or isn't significant compared to the - # true value (of which floatProd is a good approximation). - - # abs(diff)/abs(prod) <= 1/32 iff - # 32 * abs(diff) <= abs(prod) -- 5 good bits is "close enough" - if 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd): - return result - raiseOverflow() diff --git a/nimlib/system/assign.nim b/nimlib/system/assign.nim deleted file mode 100755 index 44d2e5c64e..0000000000 --- a/nimlib/system/assign.nim +++ /dev/null @@ -1,120 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -#when defined(debugGC): -# {.define: logAssign.} -proc genericAssign(dest, src: Pointer, mt: PNimType) {.compilerProc.} -proc genericAssignAux(dest, src: Pointer, n: ptr TNimNode) = - var - d = cast[TAddress](dest) - s = cast[TAddress](src) - case n.kind - of nkNone: assert(false) - of nkSlot: - genericAssign(cast[pointer](d +% n.offset), cast[pointer](s +% n.offset), - n.typ) - of nkList: - for i in 0..n.len-1: - genericAssignAux(dest, src, n.sons[i]) - of nkCase: - copyMem(cast[pointer](d +% n.offset), cast[pointer](s +% n.offset), - n.typ.size) - var m = selectBranch(src, n) - if m != nil: genericAssignAux(dest, src, m) - -proc genericAssign(dest, src: Pointer, mt: PNimType) = - var - d = cast[TAddress](dest) - s = cast[TAddress](src) - - assert(mt != nil) - case mt.Kind - of tySequence: - var s2 = cast[ppointer](src)^ - var seq = cast[PGenericSeq](s2) - if s2 == nil: # this can happen! nil sequences are allowed - var x = cast[ppointer](dest) - x^ = nil - return - assert(dest != nil) - unsureAsgnRef(cast[ppointer](dest), - newObj(mt, seq.len * mt.base.size + GenericSeqSize)) - var dst = cast[taddress](cast[ppointer](dest)^) - for i in 0..seq.len-1: - genericAssign( - cast[pointer](dst +% i*% mt.base.size +% GenericSeqSize), - cast[pointer](cast[taddress](s2) +% i *% mt.base.size +% - GenericSeqSize), - mt.Base) - var dstseq = cast[PGenericSeq](dst) - dstseq.len = seq.len - dstseq.space = seq.len - of tyObject, tyTuple, tyPureObject: - # we don't need to copy m_type field for tyObject, as they are equal anyway - genericAssignAux(dest, src, mt.node) - of tyArray, tyArrayConstr: - for i in 0..(mt.size div mt.base.size)-1: - genericAssign(cast[pointer](d +% i*% mt.base.size), - cast[pointer](s +% i*% mt.base.size), mt.base) - of tyString: # a leaf - var s2 = cast[ppointer](s)^ - if s2 != nil: # nil strings are possible! - unsureAsgnRef(cast[ppointer](dest), copyString(cast[NimString](s2))) - else: - var x = cast[ppointer](dest) - x^ = nil - return - of tyRef: # BUGFIX: a long time this has been forgotten! - unsureAsgnRef(cast[ppointer](dest), cast[ppointer](s)^) - else: - copyMem(dest, src, mt.size) # copy raw bits - -proc genericSeqAssign(dest, src: Pointer, mt: PNimType) {.compilerProc.} = - var src = src # ugly, but I like to stress the parser sometimes :-) - genericAssign(dest, addr(src), mt) - -proc genericAssignOpenArray(dest, src: pointer, len: int, - mt: PNimType) {.compilerproc.} = - var - d = cast[TAddress](dest) - s = cast[TAddress](src) - for i in 0..len-1: - genericAssign(cast[pointer](d +% i*% mt.base.size), - cast[pointer](s +% i*% mt.base.size), mt.base) - -proc objectInit(dest: Pointer, typ: PNimType) {.compilerProc.} -proc objectInitAux(dest: Pointer, n: ptr TNimNode) = - var d = cast[TAddress](dest) - case n.kind - of nkNone: assert(false) - of nkSLot: objectInit(cast[pointer](d +% n.offset), n.typ) - of nkList: - for i in 0..n.len-1: - objectInitAux(dest, n.sons[i]) - of nkCase: - var m = selectBranch(dest, n) - if m != nil: objectInitAux(dest, m) - -proc objectInit(dest: Pointer, typ: PNimType) = - # the generic init proc that takes care of initialization of complex - # objects on the stack or heap - var d = cast[TAddress](dest) - case typ.kind - of tyObject: - # iterate over any structural type - # here we have to init the type field: - var pint = cast[ptr PNimType](dest) - pint^ = typ - objectInitAux(dest, typ.node) - of tyTuple, tyPureObject: - objectInitAux(dest, typ.node) - of tyArray, tyArrayConstr: - for i in 0..(typ.size div typ.base.size)-1: - objectInit(cast[pointer](d +% i * typ.base.size), typ.base) - else: nil # nothing to do diff --git a/nimlib/system/cellsets.nim b/nimlib/system/cellsets.nim deleted file mode 100755 index 0ce83864cb..0000000000 --- a/nimlib/system/cellsets.nim +++ /dev/null @@ -1,196 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Efficient set of pointers for the GC (and repr) - -type - TCell {.pure.} = object - refcount: int # the refcount and some flags - typ: PNimType - when debugGC: - filename: cstring - line: int - - PCell = ptr TCell - - PPageDesc = ptr TPageDesc - TBitIndex = range[0..UnitsPerPage-1] - TPageDesc {.final, pure.} = object - next: PPageDesc # all nodes are connected with this pointer - key: TAddress # start address at bit 0 - bits: array[TBitIndex, int] # a bit vector - - PPageDescArray = ptr array[0..1000_000, PPageDesc] - TCellSet {.final, pure.} = object - counter, max: int - head: PPageDesc - data: PPageDescArray - - PCellArray = ptr array[0..100_000_000, PCell] - TCellSeq {.final, pure.} = object - len, cap: int - d: PCellArray - -# ------------------- cell set handling --------------------------------------- - -proc contains(s: TCellSeq, c: PCell): bool {.inline.} = - for i in 0 .. s.len-1: - if s.d[i] == c: return True - return False - -proc add(s: var TCellSeq, c: PCell) {.inline.} = - if s.len >= s.cap: - s.cap = s.cap * 3 div 2 - var d = cast[PCellArray](alloc(s.cap * sizeof(PCell))) - copyMem(d, s.d, s.len * sizeof(PCell)) - dealloc(s.d) - s.d = d - # XXX: realloc? - s.d[s.len] = c - inc(s.len) - -proc init(s: var TCellSeq, cap: int = 1024) = - s.len = 0 - s.cap = cap - s.d = cast[PCellArray](alloc0(cap * sizeof(PCell))) - -proc deinit(s: var TCellSeq) = - dealloc(s.d) - s.d = nil - s.len = 0 - s.cap = 0 - -const - InitCellSetSize = 1024 # must be a power of two! - -proc Init(s: var TCellSet) = - s.data = cast[PPageDescArray](alloc0(InitCellSetSize * sizeof(PPageDesc))) - s.max = InitCellSetSize-1 - s.counter = 0 - s.head = nil - -proc Deinit(s: var TCellSet) = - var it = s.head - while it != nil: - var n = it.next - dealloc(it) - it = n - s.head = nil # play it safe here - dealloc(s.data) - s.data = nil - s.counter = 0 - -proc nextTry(h, maxHash: int): int {.inline.} = - result = ((5*h) + 1) and maxHash - # For any initial h in range(maxHash), repeating that maxHash times - # generates each int in range(maxHash) exactly once (see any text on - # random-number generation for proof). - -proc CellSetGet(t: TCellSet, key: TAddress): PPageDesc = - var h = cast[int](key) and t.max - while t.data[h] != nil: - if t.data[h].key == key: return t.data[h] - h = nextTry(h, t.max) - return nil - -proc CellSetRawInsert(t: TCellSet, data: PPageDescArray, desc: PPageDesc) = - var h = cast[int](desc.key) and t.max - while data[h] != nil: - assert(data[h] != desc) - h = nextTry(h, t.max) - assert(data[h] == nil) - data[h] = desc - -proc CellSetEnlarge(t: var TCellSet) = - var oldMax = t.max - t.max = ((t.max+1)*2)-1 - var n = cast[PPageDescArray](alloc0((t.max + 1) * sizeof(PPageDesc))) - for i in 0 .. oldmax: - if t.data[i] != nil: - CellSetRawInsert(t, n, t.data[i]) - dealloc(t.data) - t.data = n - -proc CellSetPut(t: var TCellSet, key: TAddress): PPageDesc = - var h = cast[int](key) and t.max - while true: - var x = t.data[h] - if x == nil: break - if x.key == key: return x - h = nextTry(h, t.max) - - if ((t.max+1)*2 < t.counter*3) or ((t.max+1)-t.counter < 4): - CellSetEnlarge(t) - inc(t.counter) - h = cast[int](key) and t.max - while t.data[h] != nil: h = nextTry(h, t.max) - assert(t.data[h] == nil) - # the new page descriptor goes into result - result = cast[PPageDesc](alloc0(sizeof(TPageDesc))) - result.next = t.head - result.key = key - t.head = result - t.data[h] = result - -# ---------- slightly higher level procs -------------------------------------- - -proc contains(s: TCellSet, cell: PCell): bool = - var u = cast[TAddress](cell) - var t = CellSetGet(s, u shr PageShift) - if t != nil: - u = (u %% PageSize) /% MemAlign - result = (t.bits[u shr IntShift] and (1 shl (u and IntMask))) != 0 - else: - result = false - -proc incl(s: var TCellSet, cell: PCell) {.noinline.} = - var u = cast[TAddress](cell) - var t = CellSetPut(s, u shr PageShift) - u = (u %% PageSize) /% MemAlign - t.bits[u shr IntShift] = t.bits[u shr IntShift] or (1 shl (u and IntMask)) - -proc excl(s: var TCellSet, cell: PCell) = - var u = cast[TAddress](cell) - var t = CellSetGet(s, u shr PageShift) - if t != nil: - u = (u %% PageSize) /% MemAlign - t.bits[u shr IntShift] = (t.bits[u shr IntShift] and - not (1 shl (u and IntMask))) - -proc containsOrIncl(s: var TCellSet, cell: PCell): bool = - var u = cast[TAddress](cell) - var t = CellSetGet(s, u shr PageShift) - if t != nil: - u = (u %% PageSize) /% MemAlign - result = (t.bits[u shr IntShift] and (1 shl (u and IntMask))) != 0 - if not result: - t.bits[u shr IntShift] = t.bits[u shr IntShift] or - (1 shl (u and IntMask)) - else: - Incl(s, cell) - result = false - -iterator elements(t: TCellSet): PCell {.inline.} = - # while traversing it is forbidden to add pointers to the tree! - var r = t.head - while r != nil: - var i = 0 - while i <= high(r.bits): - var w = r.bits[i] # taking a copy of r.bits[i] here is correct, because - # modifying operations are not allowed during traversation - var j = 0 - while w != 0: # test all remaining bits for zero - if (w and 1) != 0: # the bit is set! - yield cast[PCell]((r.key shl PageShift) or - (i shl IntShift +% j) *% MemAlign) - inc(j) - w = w shr 1 - inc(i) - r = r.next - diff --git a/nimlib/system/cntbits.nim b/nimlib/system/cntbits.nim deleted file mode 100755 index 281b96dd05..0000000000 --- a/nimlib/system/cntbits.nim +++ /dev/null @@ -1,12 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2006 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - - - diff --git a/nimlib/system/debugger.nim b/nimlib/system/debugger.nim deleted file mode 100755 index 01d8bd8a2b..0000000000 --- a/nimlib/system/debugger.nim +++ /dev/null @@ -1,500 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This file implements the embedded debugger that can be linked -# with the application. We should not use dynamic memory here as that -# would interfere with the GC and trigger ON/OFF errors if the -# user program corrupts memory. Unfortunately, for dispaying -# variables we use the ``system.repr()`` proc which uses Nimrod -# strings and thus allocates memory from the heap. Pity, but -# I do not want to implement ``repr()`` twice. We also cannot deactivate -# the GC here as that might run out of memory too quickly... - -type - TDbgState = enum - dbOff, # debugger is turned off - dbStepInto, # debugger is in tracing mode - dbStepOver, - dbSkipCurrent, - dbQuiting, # debugger wants to quit - dbBreakpoints # debugger is only interested in breakpoints - - TDbgBreakpoint {.final.} = object - low, high: int # range from low to high; if disabled - # both low and high are set to their negative values - # this makes the check faster and safes memory - filename: string - name: string # name of breakpoint - - TVarSlot {.compilerproc, final.} = object # variable slots used for debugger: - address: pointer - typ: PNimType - name: cstring # for globals this is "module.name" - - PExtendedFrame = ptr TExtendedFrame - TExtendedFrame {.final.} = object # If the debugger is enabled the compiler - # provides an extended frame. Of course - # only slots that are - # needed are allocated and not 10_000, - # except for the global data description. - f: TFrame - slots: array[0..10_000, TVarSlot] - -var - dbgInSignal: bool # wether the debugger is in the signal handler - dbgIn: TFile # debugger input stream - dbgUser: string = "s" # buffer for user input; first command is ``step_into`` - # needs to be global cause we store the last command - # in it - dbgState: TDbgState = dbStepInto # state of debugger - dbgBP: array[0..127, TDbgBreakpoint] # breakpoints - dbgBPlen: int = 0 - - dbgSkipToFrame: PFrame # frame to be skipped to - - dbgGlobalData: TExtendedFrame # this reserves much space, but - # for now it is the most practical way - - maxDisplayRecDepth: int = 5 # do not display too much data! - -proc findBreakpoint(name: string): int = - # returns -1 if not found - for i in countdown(dbgBPlen-1, 0): - if name == dbgBP[i].name: return i - return -1 - -proc ListBreakPoints() = - write(stdout, "*** endb| Breakpoints:\n") - for i in 0 .. dbgBPlen-1: - write(stdout, dbgBP[i].name & ": " & $abs(dbgBP[i].low) & ".." & - $abs(dbgBP[i].high) & dbgBP[i].filename) - if dbgBP[i].low < 0: - write(stdout, " [disabled]\n") - else: - write(stdout, "\n") - write(stdout, "***\n") - -proc openAppend(filename: string): TFile = - if open(result, filename, fmAppend): - write(result, "----------------------------------------\n") - -proc dbgRepr(p: pointer, typ: PNimType): string = - var - cl: TReprClosure - initReprClosure(cl) - cl.recDepth = maxDisplayRecDepth - # locks for the GC turned out to be a bad idea... - # inc(recGcLock) - result = "" - reprAux(result, p, typ, cl) - # dec(recGcLock) - deinitReprClosure(cl) - -proc writeVariable(stream: TFile, slot: TVarSlot) = - write(stream, slot.name) - write(stream, " = ") - writeln(stream, dbgRepr(slot.address, slot.typ)) - -proc ListFrame(stream: TFile, f: PExtendedFrame) = - write(stream, "*** endb| Frame (" & $f.f.len & " slots):\n") - for i in 0 .. f.f.len-1: - writeVariable(stream, f.slots[i]) - write(stream, "***\n") - -proc ListVariables(stream: TFile, f: PExtendedFrame) = - write(stream, "*** endb| Frame (" & $f.f.len & " slots):\n") - for i in 0 .. f.f.len-1: - writeln(stream, f.slots[i].name) - write(stream, "***\n") - -proc debugOut(msg: cstring) = - # the *** *** markers are for easy recognition of debugger - # output for external frontends. - write(stdout, "*** endb| ") - write(stdout, msg) - write(stdout, "***\n") - -proc dbgFatal(msg: cstring) = - debugOut(msg) - dbgAborting = True # the debugger wants to abort - quit(1) - -proc findVariable(frame: PExtendedFrame, varname: cstring): int = - for i in 0 .. frame.f.len - 1: - if c_strcmp(frame.slots[i].name, varname) == 0: return i - return -1 - -proc dbgShowCurrentProc(dbgFramePointer: PFrame) = - if dbgFramePointer != nil: - write(stdout, "*** endb| now in proc: ") - write(stdout, dbgFramePointer.procname) - write(stdout, " ***\n") - else: - write(stdout, "*** endb| (procedure name not available) ***\n") - -proc dbgShowExecutionPoint() = - write(stdout, "*** endb| " & $framePtr.filename & "(" & $framePtr.line & - ") " & $framePtr.procname & " ***\n") - -when defined(windows) or defined(dos) or defined(os2): - {.define: FileSystemCaseInsensitive.} - -proc fileMatches(c, bp: cstring): bool = - # bp = breakpoint filename - # c = current filename - # we consider it a match if bp is a suffix of c - # and the character for the suffix does not exist or - # is one of: \ / : - # depending on the OS case does not matter! - var blen: int = c_strlen(bp) - var clen: int = c_strlen(c) - if blen > clen: return false - # check for \ / : - if clen-blen-1 >= 0 and c[clen-blen-1] notin {'\\', '/', ':'}: - return false - var i = 0 - while i < blen: - var x, y: char - x = bp[i] - y = c[i+clen-blen] - when defined(FileSystemCaseInsensitive): - if x >= 'A' and x <= 'Z': x = chr(ord(x) - ord('A') + ord('a')) - if y >= 'A' and y <= 'Z': y = chr(ord(y) - ord('A') + ord('a')) - if x != y: return false - inc(i) - return true - -proc dbgBreakpointReached(line: int): int = - for i in 0..dbgBPlen-1: - if line >= dbgBP[i].low and line <= dbgBP[i].high and - fileMatches(framePtr.filename, dbgBP[i].filename): return i - return -1 - -proc scanAndAppendWord(src: string, a: var string, start: int): int = - result = start - # skip whitespace: - while src[result] in {'\t', ' '}: inc(result) - while True: - case src[result] - of 'a'..'z', '0'..'9': add(a, src[result]) - of '_': nil # just skip it - of 'A'..'Z': add(a, chr(ord(src[result]) - ord('A') + ord('a'))) - else: break - inc(result) - -proc scanWord(src: string, a: var string, start: int): int = - a = "" - result = scanAndAppendWord(src, a, start) - -proc scanFilename(src: string, a: var string, start: int): int = - result = start - a = "" - # skip whitespace: - while src[result] in {'\t', ' '}: inc(result) - while src[result] notin {'\t', ' ', '\0'}: - add(a, src[result]) - inc(result) - -proc scanNumber(src: string, a: var int, start: int): int = - result = start - a = 0 - while src[result] in {'\t', ' '}: inc(result) - while true: - case src[result] - of '0'..'9': a = a * 10 + ord(src[result]) - ord('0') - of '_': nil # skip underscores (nice for long line numbers) - else: break - inc(result) - -proc dbgHelp() = - debugOut(""" -list of commands (see the manual for further help): - GENERAL -h, help display this help message -q, quit quit the debugger and the program - repeat the previous debugger command - EXECUTING -s, step single step, stepping into routine calls -n, next single step, without stepping into routine calls -f, skipcurrent continue execution until the current routine finishes -c, continue continue execution until the next breakpoint -i, ignore continue execution, ignore all breakpoints - BREAKPOINTS -b, break [fromline [toline]] [file] - set a new breakpoint named 'name' for line and file - if line or file are omitted the current one is used -breakpoints display the entire breakpoint list -disable disable a breakpoint -enable enable a breakpoint - DATA DISPLAY -e, eval evaluate the expression -o, out evaluate and write it to -w, where display the current execution point -stackframe [file] display current stack frame [and write it to file] -u, up go up in the call stack -d, down go down in the call stack -bt, backtrace display the entire call stack -l, locals display available local variables -g, globals display available global variables -maxdisplay set the display's recursion maximum -""") - -proc InvalidCommand() = - debugOut("[Warning] invalid command ignored (type 'h' for help) ") - -proc hasExt(s: string): bool = - # returns true if s has a filename extension - for i in countdown(len(s)-1, 0): - if s[i] == '.': return true - return false - -proc setBreakPoint(s: string, start: int) = - var dbgTemp: string - var i = scanWord(s, dbgTemp, start) - if i <= start: - InvalidCommand() - return - if dbgBPlen >= high(dbgBP): - debugOut("[Warning] no breakpoint could be set; out of breakpoint space ") - return - var x = dbgBPlen - inc(dbgBPlen) - dbgBP[x].name = dbgTemp - i = scanNumber(s, dbgBP[x].low, i) - if dbgBP[x].low == 0: - # set to current line: - dbgBP[x].low = framePtr.line - i = scanNumber(s, dbgBP[x].high, i) - if dbgBP[x].high == 0: # set to low: - dbgBP[x].high = dbgBP[x].low - i = scanFilename(s, dbgTemp, i) - if not (dbgTemp.len == 0): - if not hasExt(dbgTemp): add(dbgTemp, ".nim") - dbgBP[x].filename = dbgTemp - else: # use current filename - dbgBP[x].filename = $framePtr.filename - # skip whitespace: - while s[i] in {' ', '\t'}: inc(i) - if s[i] != '\0': - dec(dbgBPLen) # remove buggy breakpoint - InvalidCommand() - -proc BreakpointSetEnabled(s: string, start, enabled: int) = - var dbgTemp: string - var i = scanWord(s, dbgTemp, start) - if i <= start: - InvalidCommand() - return - var x = findBreakpoint(dbgTemp) - if x < 0: debugOut("[Warning] breakpoint does not exist ") - elif enabled * dbgBP[x].low < 0: # signs are different? - dbgBP[x].low = -dbgBP[x].low - dbgBP[x].high = -dbgBP[x].high - -proc dbgEvaluate(stream: TFile, s: string, start: int, - currFrame: PExtendedFrame) = - var dbgTemp: string - var i = scanWord(s, dbgTemp, start) - while s[i] in {' ', '\t'}: inc(i) - var f = currFrame - if s[i] == '.': - inc(i) # skip '.' - add(dbgTemp, '.') - i = scanAndAppendWord(s, dbgTemp, i) - # search for global var: - f = addr(dbgGlobalData) - if s[i] != '\0': - debugOut("[Warning] could not parse expr ") - return - var j = findVariable(f, dbgTemp) - if j < 0: - debugOut("[Warning] could not find variable ") - return - writeVariable(stream, f.slots[j]) - -proc dbgOut(s: string, start: int, currFrame: PExtendedFrame) = - var dbgTemp: string - var i = scanFilename(s, dbgTemp, start) - if dbgTemp.len == 0: - InvalidCommand() - return - var stream = openAppend(dbgTemp) - if stream == nil: - debugOut("[Warning] could not open or create file ") - return - dbgEvaluate(stream, s, i, currFrame) - close(stream) - -proc dbgStackFrame(s: string, start: int, currFrame: PExtendedFrame) = - var dbgTemp: string - var i = scanFilename(s, dbgTemp, start) - if dbgTemp.len == 0: - # just write it to stdout: - ListFrame(stdout, currFrame) - else: - var stream = openAppend(dbgTemp) - if stream == nil: - debugOut("[Warning] could not open or create file ") - return - ListFrame(stream, currFrame) - close(stream) - -proc CommandPrompt() = - # if we return from this routine, user code executes again - var - again = True - dbgFramePtr = framePtr # for going down and up the stack - dbgDown = 0 # how often we did go down - - while again: - write(stdout, "*** endb| >>") - var tmp = readLine(stdin) - if tmp.len > 0: dbgUser = tmp - # now look what we have to do: - var dbgTemp: string - var i = scanWord(dbgUser, dbgTemp, 0) - case dbgTemp - of "": InvalidCommand() - of "s", "step": - dbgState = dbStepInto - again = false - of "n", "next": - dbgState = dbStepOver - dbgSkipToFrame = framePtr - again = false - of "f", "skipcurrent": - dbgState = dbSkipCurrent - dbgSkipToFrame = framePtr.prev - again = false - of "c", "continue": - dbgState = dbBreakpoints - again = false - of "i", "ignore": - dbgState = dbOff - again = false - of "h", "help": - dbgHelp() - of "q", "quit": - dbgState = dbQuiting - dbgAborting = True - again = false - quit(1) # BUGFIX: quit with error code > 0 - of "e", "eval": - dbgEvaluate(stdout, dbgUser, i, cast[PExtendedFrame](dbgFramePtr)) - of "o", "out": - dbgOut(dbgUser, i, cast[PExtendedFrame](dbgFramePtr)) - of "stackframe": - dbgStackFrame(dbgUser, i, cast[PExtendedFrame](dbgFramePtr)) - of "w", "where": - dbgShowExecutionPoint() - of "l", "locals": - ListVariables(stdout, cast[PExtendedFrame](dbgFramePtr)) - of "g", "globals": - ListVariables(stdout, addr(dbgGlobalData)) - of "u", "up": - if dbgDown <= 0: - debugOut("[Warning] cannot go up any further ") - else: - dbgFramePtr = framePtr - for j in 0 .. dbgDown-2: # BUGFIX - dbgFramePtr = dbgFramePtr.prev - dec(dbgDown) - dbgShowCurrentProc(dbgFramePtr) - of "d", "down": - if dbgFramePtr != nil: - inc(dbgDown) - dbgFramePtr = dbgFramePtr.prev - dbgShowCurrentProc(dbgFramePtr) - else: - debugOut("[Warning] cannot go down any further ") - of "bt", "backtrace": - WriteStackTrace() - of "b", "break": - setBreakPoint(dbgUser, i) - of "breakpoints": - ListBreakPoints() - of "disable": - BreakpointSetEnabled(dbgUser, i, -1) - of "enable": - BreakpointSetEnabled(dbgUser, i, +1) - of "maxdisplay": - var parsed: int - i = scanNumber(dbgUser, parsed, i) - if dbgUser[i-1] in {'0'..'9'}: - if parsed == 0: maxDisplayRecDepth = -1 - else: maxDisplayRecDepth = parsed - else: - InvalidCommand() - else: - InvalidCommand() - -proc endbStep() = - # we get into here if an unhandled exception has been raised - # XXX: do not allow the user to run the program any further? - # XXX: BUG: the frame is lost here! - dbgShowExecutionPoint() - CommandPrompt() - -proc checkForBreakpoint() = - var i = dbgBreakpointReached(framePtr.line) - if i >= 0: - write(stdout, "*** endb| reached ") - write(stdout, dbgBP[i].name) - write(stdout, " in ") - write(stdout, framePtr.filename) - write(stdout, "(") - write(stdout, framePtr.line) - write(stdout, ") ") - write(stdout, framePtr.procname) - write(stdout, " ***\n") - CommandPrompt() - -# interface to the user program: - -proc dbgRegisterBreakpoint(line: int, - filename, name: cstring) {.compilerproc.} = - var x = dbgBPlen - inc(dbgBPlen) - dbgBP[x].name = $name - dbgBP[x].filename = $filename - dbgBP[x].low = line - dbgBP[x].high = line - -proc dbgRegisterGlobal(name: cstring, address: pointer, - typ: PNimType) {.compilerproc.} = - var i = dbgGlobalData.f.len - if i >= high(dbgGlobalData.slots): - debugOut("[Warning] cannot register global ") - return - dbgGlobalData.slots[i].name = name - dbgGlobalData.slots[i].typ = typ - dbgGlobalData.slots[i].address = address - inc(dbgGlobalData.f.len) - -proc endb(line: int) {.compilerproc.} = - # This proc is called before every Nimrod code line! - # Thus, it must have as few parameters as possible to keep the - # code size small! - # Check if we are at an enabled breakpoint or "in the mood" - framePtr.line = line # this is done here for smaller code size! - if dbgLineHook != nil: dbgLineHook() - case dbgState - of dbStepInto: - # we really want the command prompt here: - dbgShowExecutionPoint() - CommandPrompt() - of dbSkipCurrent, dbStepOver: # skip current routine - if framePtr == dbgSkipToFrame: - dbgShowExecutionPoint() - CommandPrompt() - else: # breakpoints are wanted though (I guess) - checkForBreakpoint() - of dbBreakpoints: # debugger is only interested in breakpoints - checkForBreakpoint() - else: nil diff --git a/nimlib/system/dyncalls.nim b/nimlib/system/dyncalls.nim deleted file mode 100755 index 0946ee3554..0000000000 --- a/nimlib/system/dyncalls.nim +++ /dev/null @@ -1,127 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This file implements the ability to call native procs from libraries. -# It is not possible to do this in a platform independant way, unfortunately. -# However, the interface has been designed to take platform differences into -# account and been ported to all major platforms. - -type - TLibHandle = pointer # private type - TProcAddr = pointer # libary loading and loading of procs: - -const - NilLibHandle: TLibHandle = nil - -proc nimLoadLibrary(path: string): TLibHandle {.compilerproc.} -proc nimUnloadLibrary(lib: TLibHandle) {.compilerproc.} -proc nimGetProcAddr(lib: TLibHandle, name: cstring): TProcAddr {.compilerproc.} - -proc nimLoadLibraryError(path: string) {.compilerproc, noinline.} = - raise newException(EInvalidLibrary, "could not load: " & path) - -# this code was inspired from Lua's source code: -# Lua - An Extensible Extension Language -# Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil -# http://www.lua.org -# mailto:info@lua.org - -when defined(posix): - # - # ========================================================================= - # This is an implementation based on the dlfcn interface. - # The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, - # NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least - # as an emulation layer on top of native functions. - # ========================================================================= - # - - # c stuff: - var - RTLD_NOW {.importc: "RTLD_NOW", header: "".}: int - - proc dlclose(lib: TLibHandle) {.importc, header: "".} - proc dlopen(path: CString, mode: int): TLibHandle {. - importc, header: "".} - proc dlsym(lib: TLibHandle, name: cstring): TProcAddr {. - importc, header: "".} - - proc nimUnloadLibrary(lib: TLibHandle) = - dlclose(lib) - - proc nimLoadLibrary(path: string): TLibHandle = - result = dlopen(path, RTLD_NOW) - - proc nimGetProcAddr(lib: TLibHandle, name: cstring): TProcAddr = - result = dlsym(lib, name) - if result == nil: nimLoadLibraryError($name) - -elif defined(windows) or defined(dos): - # - # ======================================================================= - # Native Windows Implementation - # ======================================================================= - # - type - THINSTANCE {.importc: "HINSTANCE".} = pointer - - proc FreeLibrary(lib: THINSTANCE) {.importc, header: "", stdcall.} - proc winLoadLibrary(path: cstring): THINSTANCE {. - importc: "LoadLibraryA", header: "", stdcall.} - proc GetProcAddress(lib: THINSTANCE, name: cstring): TProcAddr {. - importc: "GetProcAddress", header: "", stdcall.} - - proc nimUnloadLibrary(lib: TLibHandle) = - FreeLibrary(cast[THINSTANCE](lib)) - - proc nimLoadLibrary(path: string): TLibHandle = - result = cast[TLibHandle](winLoadLibrary(path)) - - proc nimGetProcAddr(lib: TLibHandle, name: cstring): TProcAddr = - result = GetProcAddress(cast[THINSTANCE](lib), name) - if result == nil: nimLoadLibraryError($name) - -elif defined(mac): - # - # ======================================================================= - # Native Mac OS X / Darwin Implementation - # ======================================================================= - # - {.error: "no implementation for dyncalls yet".} - - proc nimUnloadLibrary(lib: TLibHandle) = - NSUnLinkModule(NSModule(lib), NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES) - - var - dyld_present {.importc: "_dyld_present", header: "".}: int - - proc nimLoadLibrary(path: string): TLibHandle = - var - img: NSObjectFileImage - ret: NSObjectFileImageReturnCode - modul: NSModule - # this would be a rare case, but prevents crashing if it happens - result = nil - if dyld_present != 0: - ret = NSCreateObjectFileImageFromFile(path, addr(img)) - if ret == NSObjectFileImageSuccess: - modul = NSLinkModule(img, path, NSLINKMODULE_OPTION_PRIVATE or - NSLINKMODULE_OPTION_RETURN_ON_ERROR) - NSDestroyObjectFileImage(img) - result = TLibHandle(modul) - - proc nimGetProcAddr(lib: TLibHandle, name: cstring): TProcAddr = - var - nss: NSSymbol - nss = NSLookupSymbolInModule(NSModule(lib), name) - result = TProcAddr(NSAddressOfSymbol(nss)) - if result == nil: nimLoadLibraryError($name) - -else: - {.error: "no implementation for dyncalls".} diff --git a/nimlib/system/ecmasys.nim b/nimlib/system/ecmasys.nim deleted file mode 100755 index c0d0a5fd67..0000000000 --- a/nimlib/system/ecmasys.nim +++ /dev/null @@ -1,531 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Stubs for the GC interface: - -proc GC_disable() = nil -proc GC_enable() = nil -proc GC_fullCollect() = nil -proc GC_setStrategy(strategy: TGC_Strategy) = nil -proc GC_enableMarkAndSweep() = nil -proc GC_disableMarkAndSweep() = nil -proc GC_getStatistics(): string = return "" - -proc getOccupiedMem(): int = return -1 -proc getFreeMem(): int = return -1 -proc getTotalMem(): int = return -1 - -proc alert(s: cstring) {.importc, nodecl.} - -type - PSafePoint = ptr TSafePoint - TSafePoint {.compilerproc, final.} = object - prev: PSafePoint # points to next safe point - exc: ref E_Base - - PCallFrame = ptr TCallFrame - TCallFrame {.importc, nodecl, final.} = object - prev: PCallFrame - procname: CString - line: int # current line number - filename: CString - -var - framePtr {.importc, nodecl, volatile.}: PCallFrame - excHandler {.importc, nodecl, volatile.}: PSafePoint = nil - # list of exception handlers - # a global variable for the root of all try blocks - -{.push stacktrace: off.} -proc nimBoolToStr(x: bool): string {.compilerproc.} = - if x: result = "true" - else: result = "false" - -proc nimCharToStr(x: char): string {.compilerproc.} = - result = newString(1) - result[0] = x - -proc getCurrentExceptionMsg(): string = - if excHandler != nil: return $excHandler.exc.msg - return "" - -proc auxWriteStackTrace(f: PCallFrame): string = - type - TTempFrame = tuple[procname: CString, line: int] - var - it = f - i = 0 - total = 0 - tempFrames: array [0..63, TTempFrame] - while it != nil and i <= high(tempFrames): - tempFrames[i].procname = it.procname - tempFrames[i].line = it.line - inc(i) - inc(total) - it = it.prev - while it != nil: - inc(total) - it = it.prev - result = "" - # if the buffer overflowed print '...': - if total != i: - add(result, "(") - add(result, $(total-i)) - add(result, " calls omitted) ...\n") - for j in countdown(i-1, 0): - add(result, tempFrames[j].procname) - if tempFrames[j].line > 0: - add(result, ", line: ") - add(result, $tempFrames[j].line) - add(result, "\n") - -proc rawWriteStackTrace(): string = - if framePtr == nil: - result = "No stack traceback available\n" - else: - result = "Traceback (most recent call last)\n"& auxWriteStackTrace(framePtr) - framePtr = nil - -proc raiseException(e: ref E_Base, ename: cstring) {.compilerproc, pure.} = - e.name = ename - if excHandler != nil: - excHandler.exc = e - else: - var buf = rawWriteStackTrace() - if e.msg != nil and e.msg[0] != '\0': - add(buf, "Error: unhandled exception: ") - add(buf, e.msg) - else: - add(buf, "Error: unhandled exception") - add(buf, " [") - add(buf, ename) - add(buf, "]\n") - alert(buf) - asm """throw `e`;""" - -proc reraiseException() = - if excHandler == nil: - raise newException(ENoExceptionToReraise, "no exception to reraise") - else: - asm """throw excHandler.exc;""" - -proc raiseOverflow {.exportc: "raiseOverflow", noreturn.} = - raise newException(EOverflow, "over- or underflow") - -proc raiseDivByZero {.exportc: "raiseDivByZero", noreturn.} = - raise newException(EDivByZero, "divison by zero") - -proc raiseRangeError() {.compilerproc, noreturn.} = - raise newException(EOutOfRange, "value out of range") - -proc raiseIndexError() {.compilerproc, noreturn.} = - raise newException(EInvalidIndex, "index out of bounds") - -proc raiseFieldError(f: string) {.compilerproc, noreturn.} = - raise newException(EInvalidField, f & " is not accessible") - - - -proc SetConstr() {.varargs, pure, compilerproc.} = - asm """ - var result = {}; - for (var i = 0; i < arguments.length; ++i) { - var x = arguments[i]; - if (typeof(x) == "object") { - for (var j = x[0]; j <= x[1]; ++j) { - result[j] = true; - } - } else { - result[x] = true; - } - } - return result; - """ - -proc cstrToNimstr(c: cstring): string {.pure, compilerproc.} = - asm """ - var result = []; - for (var i = 0; i < `c`.length; ++i) { - result[i] = `c`.charCodeAt(i); - } - result[result.length] = 0; // terminating zero - return result; - """ - -proc toEcmaStr(s: string): cstring {.pure, compilerproc.} = - asm """ - var len = `s`.length-1; - var result = new Array(len); - var fcc = String.fromCharCode; - for (var i = 0; i < len; ++i) { - result[i] = fcc(`s`[i]); - } - return result.join(""); - """ - -proc mnewString(len: int): string {.pure, compilerproc.} = - asm """ - var result = new Array(`len`+1); - result[0] = 0; - result[`len`] = 0; - return result; - """ - -proc SetCard(a: int): int {.compilerproc, pure.} = - # argument type is a fake - asm """ - var result = 0; - for (var elem in `a`) { ++result; } - return result; - """ - -proc SetEq(a, b: int): bool {.compilerproc, pure.} = - asm """ - for (var elem in `a`) { if (!`b`[elem]) return false; } - for (var elem in `b`) { if (!`a`[elem]) return false; } - return true; - """ - -proc SetLe(a, b: int): bool {.compilerproc, pure.} = - asm """ - for (var elem in `a`) { if (!`b`[elem]) return false; } - return true; - """ - -proc SetLt(a, b: int): bool {.compilerproc.} = - result = SetLe(a, b) and not SetEq(a, b) - -proc SetMul(a, b: int): int {.compilerproc, pure.} = - asm """ - var result = {}; - for (var elem in `a`) { - if (`b`[elem]) { result[elem] = true; } - } - return result; - """ - -proc SetPlus(a, b: int): int {.compilerproc, pure.} = - asm """ - var result = {}; - for (var elem in `a`) { result[elem] = true; } - for (var elem in `b`) { result[elem] = true; } - return result; - """ - -proc SetMinus(a, b: int): int {.compilerproc, pure.} = - asm """ - var result = {}; - for (var elem in `a`) { - if (!`b`[elem]) { result[elem] = true; } - } - return result; - """ - -proc cmpStrings(a, b: string): int {.pure, compilerProc.} = - asm """ - if (`a` == `b`) return 0; - if (!`a`) return -1; - if (!`b`) return 1; - for (var i = 0; i < `a`.length-1; ++i) { - var result = `a`[i] - `b`[i]; - if (result != 0) return result; - } - return 0; - """ - -proc cmp(x, y: string): int = return cmpStrings(x, y) - -proc eqStrings(a, b: string): bool {.pure, compilerProc.} = - asm """ - if (`a == `b`) return true; - if ((!`a`) || (!`b`)) return false; - var alen = `a`.length; - if (alen != `b`.length) return false; - for (var i = 0; i < alen; ++i) - if (`a`[i] != `b`[i]) return false; - return true; - """ - -type - TDocument {.importc.} = object of TObject - write: proc (text: cstring) - writeln: proc (text: cstring) - createAttribute: proc (identifier: cstring): ref TNode - createElement: proc (identifier: cstring): ref TNode - createTextNode: proc (identifier: cstring): ref TNode - getElementById: proc (id: cstring): ref TNode - getElementsByName: proc (name: cstring): seq[ref TNode] - getElementsByTagName: proc (name: cstring): seq[ref TNode] - - TNodeType* = enum - ElementNode = 1, - AttributeNode, - TextNode, - CDATANode, - EntityRefNode, - EntityNode, - ProcessingInstructionNode, - CommentNode, - DocumentNode, - DocumentTypeNode, - DocumentFragmentNode, - NotationNode - TNode* {.importc.} = object of TObject - attributes*: seq[ref TNode] - childNodes*: seq[ref TNode] - data*: cstring - firstChild*: ref TNode - lastChild*: ref TNode - nextSibling*: ref TNode - nodeName*: cstring - nodeType*: TNodeType - nodeValue*: cstring - parentNode*: ref TNode - previousSibling*: ref TNode - appendChild*: proc (child: ref TNode) - appendData*: proc (data: cstring) - cloneNode*: proc (copyContent: bool) - deleteData*: proc (start, len: int) - getAttribute*: proc (attr: cstring): cstring - getAttributeNode*: proc (attr: cstring): ref TNode - getElementsByTagName*: proc (): seq[ref TNode] - hasChildNodes*: proc (): bool - insertBefore*: proc (newNode, before: ref TNode) - insertData*: proc (position: int, data: cstring) - removeAttribute*: proc (attr: cstring) - removeAttributeNode*: proc (attr: ref TNode) - removeChild*: proc (child: ref TNode) - replaceChild*: proc (newNode, oldNode: ref TNode) - replaceData*: proc (start, len: int, text: cstring) - setAttribute*: proc (name, value: cstring) - setAttributeNode*: proc (attr: ref TNode) - -var - document {.importc, nodecl.}: ref TDocument - -proc ewriteln(x: cstring) = - var node = document.getElementsByTagName("body")[0] - if node != nil: - node.appendChild(document.createTextNode(x)) - node.appendChild(document.createElement("br")) - else: - raise newException(EInvalidValue, " element does not exist yet!") - -proc echo*(x: int) = ewriteln($x) -proc echo*(x: float) = ewriteln($x) -proc echo*(x: bool) = ewriteln(if x: cstring("true") else: cstring("false")) -proc echo*(x: string) = ewriteln(x) -proc echo*(x: cstring) = ewriteln(x) - -proc echo[Ty](x: Ty) = - echo(x) - -proc echo[Ty](x: openArray[Ty]) = - for a in items(x): echo(a) - -# Arithmetic: -proc addInt(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` + `b`; - if (result > 2147483647 || result < -2147483648) raiseOverflow(); - return result; - """ - -proc subInt(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` - `b`; - if (result > 2147483647 || result < -2147483648) raiseOverflow(); - return result; - """ - -proc mulInt(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` * `b`; - if (result > 2147483647 || result < -2147483648) raiseOverflow(); - return result; - """ - -proc divInt(a, b: int): int {.pure, compilerproc.} = - asm """ - if (`b` == 0) raiseDivByZero(); - if (`b` == -1 && `a` == 2147483647) raiseOverflow(); - return Math.floor(`a` / `b`); - """ - -proc modInt(a, b: int): int {.pure, compilerproc.} = - asm """ - if (`b` == 0) raiseDivByZero(); - if (`b` == -1 && `a` == 2147483647) raiseOverflow(); - return Math.floor(`a` % `b`); - """ - - - -proc addInt64(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` + `b`; - if (result > 9223372036854775807 - || result < -9223372036854775808) raiseOverflow(); - return result; - """ - -proc subInt64(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` - `b`; - if (result > 9223372036854775807 - || result < -9223372036854775808) raiseOverflow(); - return result; - """ - -proc mulInt64(a, b: int): int {.pure, compilerproc.} = - asm """ - var result = `a` * `b`; - if (result > 9223372036854775807 - || result < -9223372036854775808) raiseOverflow(); - return result; - """ - -proc divInt64(a, b: int): int {.pure, compilerproc.} = - asm """ - if (`b` == 0) raiseDivByZero(); - if (`b` == -1 && `a` == 9223372036854775807) raiseOverflow(); - return Math.floor(`a` / `b`); - """ - -proc modInt64(a, b: int): int {.pure, compilerproc.} = - asm """ - if (`b` == 0) raiseDivByZero(); - if (`b` == -1 && `a` == 9223372036854775807) raiseOverflow(); - return Math.floor(`a` % `b`); - """ - -proc nimMin(a, b: int): int {.compilerproc.} = return if a <= b: a else: b -proc nimMax(a, b: int): int {.compilerproc.} = return if a >= b: a else: b - -proc internalAssert(file: cstring, line: int) {.pure, compilerproc.} = - var - e: ref EAssertionFailed - new(e) - asm """`e`.message = "[Assertion failure] file: "+`file`+", line: "+`line`""" - raise e - -include hti - -proc isFatPointer(ti: PNimType): bool = - # This has to be consistent with the code generator! - return ti.base.kind notin {tyRecord, tyRecordConstr, tyObject, - tyArray, tyArrayConstr, tyPureObject, tyTuple, - tyEmptySet, tyOpenArray, tySet, tyVar, tyRef, tyPtr} - -proc NimCopy(x: pointer, ti: PNimType): pointer {.compilerproc.} - -proc NimCopyAux(dest, src: Pointer, n: ptr TNimNode) {.exportc.} = - case n.kind - of nkNone: assert(false) - of nkSlot: - asm "`dest`[`n`.offset] = NimCopy(`src`[`n`.offset], `n`.typ);" - of nkList: - for i in 0..n.len-1: - NimCopyAux(dest, src, n.sons[i]) - of nkCase: - asm """ - `dest`[`n`.offset] = NimCopy(`src`[`n`.offset], `n`.typ); - for (var i = 0; i < `n`.sons.length; ++i) { - NimCopyAux(`dest`, `src`, `n`.sons[i][1]); - } - """ - -proc NimCopy(x: pointer, ti: PNimType): pointer = - case ti.kind - of tyPtr, tyRef, tyVar, tyNil: - if not isFatPointer(ti): - result = x - else: - asm """ - `result` = [null, 0]; - `result`[0] = `x`[0]; - `result`[1] = `x`[1]; - """ - of tyEmptySet, tySet: - asm """ - `result` = {}; - for (var key in `x`) { `result`[key] = `x`[key]; } - """ - of tyPureObject, tyTuple, tyObject: - if ti.base != nil: result = NimCopy(x, ti.base) - elif ti.kind == tyObject: - asm "`result` = {m_type: `ti`};" - else: - asm "`result` = {};" - NimCopyAux(result, x, ti.node) - of tySequence, tyArrayConstr, tyOpenArray, tyArray: - asm """ - `result` = new Array(`x`.length); - for (var i = 0; i < `x`.length; ++i) { - `result`[i] = NimCopy(`x`[i], `ti`.base); - } - """ - of tyString: - asm "`result` = `x`.slice(0);" - else: - result = x - - -proc ArrayConstr(len: int, value: pointer, typ: PNimType): pointer {. - pure, compilerproc.} = - # types are fake - asm """ - var result = new Array(`len`); - for (var i = 0; i < `len`; ++i) result[i] = NimCopy(`value`, `typ`); - return result; - """ - -proc chckIndx(i, a, b: int): int {.compilerproc.} = - if i >= a and i <= b: return i - else: raiseIndexError() - -proc chckRange(i, a, b: int): int {.compilerproc.} = - if i >= a and i <= b: return i - else: raiseRangeError() - -proc chckObj(obj, subclass: PNimType) {.compilerproc.} = - # checks if obj is of type subclass: - var x = obj - if x == subclass: return # optimized fast path - while x != subclass: - if x == nil: - raise newException(EInvalidObjectConversion, "invalid object conversion") - x = x.base - -{.pop.} - -#proc AddU($1, $2) -#SubU($1, $2) -#MulU($1, $2) -#DivU($1, $2) -#ModU($1, $2) -#AddU64($1, $2) -#SubU64($1, $2) -#MulU64($1, $2) -#DivU64($1, $2) -#ModU64($1, $2) -#LeU($1, $2) -#LtU($1, $2) -#LeU64($1, $2) -#LtU64($1, $2) -#Ze($1) -#Ze64($1) -#ToU8($1) -#ToU16($1) -#ToU32($1) - -#NegInt($1) -#NegInt64($1) -#AbsInt($1) -#AbsInt64($1) diff --git a/nimlib/system/excpt.nim b/nimlib/system/excpt.nim deleted file mode 100755 index 293491fe9a..0000000000 --- a/nimlib/system/excpt.nim +++ /dev/null @@ -1,285 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -# Exception handling code. This is difficult because it has -# to work if there is no more memory. Thus we have to use -# a static string. Do not use ``sprintf``, etc. as they are -# unsafe! - -when not defined(windows) or not defined(guiapp): - proc writeToStdErr(msg: CString) = write(stdout, msg) - -else: - proc MessageBoxA(hWnd: cint, lpText, lpCaption: cstring, uType: int): int32 {. - header: "", nodecl.} - - proc writeToStdErr(msg: CString) = - discard MessageBoxA(0, msg, nil, 0) - -proc raiseException(e: ref E_Base, ename: CString) {.compilerproc.} -proc reraiseException() {.compilerproc.} - -proc registerSignalHandler() {.compilerproc.} - -proc chckIndx(i, a, b: int): int {.inline, compilerproc.} -proc chckRange(i, a, b: int): int {.inline, compilerproc.} -proc chckRangeF(x, a, b: float): float {.inline, compilerproc.} -proc chckNil(p: pointer) {.inline, compilerproc.} - -type - PSafePoint = ptr TSafePoint - TSafePoint {.compilerproc, final.} = object - prev: PSafePoint # points to next safe point ON THE STACK - exc: ref E_Base - status: int - context: C_JmpBuf - -var - excHandler {.compilerproc.}: PSafePoint = nil - # list of exception handlers - # a global variable for the root of all try blocks - -proc reraiseException() = - if excHandler == nil: - raise newException(ENoExceptionToReraise, "no exception to reraise") - else: - c_longjmp(excHandler.context, 1) - -type - PFrame = ptr TFrame - TFrame {.importc, nodecl, final.} = object - prev: PFrame - procname: CString - line: int # current line number - filename: CString - len: int # length of slots (when not debugging always zero) - -var - buf: string # cannot be allocated on the stack! - assertBuf: string # we need a different buffer for - # assert, as it raises an exception and - # exception handler needs the buffer too - - framePtr {.exportc.}: PFrame - - tempFrames: array [0..127, PFrame] # cannot be allocated on the stack! - - stackTraceNewLine* = "\n" ## undocumented feature - -proc auxWriteStackTrace(f: PFrame, s: var string) = - const - firstCalls = 32 - var - it = f - i = 0 - total = 0 - while it != nil and i <= high(tempFrames)-(firstCalls-1): - # the (-1) is for a nil entry that marks where the '...' should occur - tempFrames[i] = it - inc(i) - inc(total) - it = it.prev - var b = it - while it != nil: - inc(total) - it = it.prev - for j in 1..total-i-(firstCalls-1): - if b != nil: b = b.prev - if total != i: - tempFrames[i] = nil - inc(i) - while b != nil and i <= high(tempFrames): - tempFrames[i] = b - inc(i) - b = b.prev - for j in countdown(i-1, 0): - if tempFrames[j] == nil: - add(s, "(") - add(s, $(total-i-1)) - add(s, " calls omitted) ...") - else: - add(s, $tempFrames[j].procname) - if tempFrames[j].line > 0: - add(s, ", line: ") - add(s, $tempFrames[j].line) - add(s, stackTraceNewLine) - -proc rawWriteStackTrace(s: var string) = - if framePtr == nil: - add(s, "No stack traceback available") - add(s, stackTraceNewLine) - else: - add(s, "Traceback (most recent call last)") - add(s, stackTraceNewLine) - auxWriteStackTrace(framePtr, s) - -proc quitOrDebug() {.inline.} = - when not defined(endb): - quit(1) - else: - endbStep() # call the debugger - -proc raiseException(e: ref E_Base, ename: CString) = - GC_disable() # a bad thing is an error in the GC while raising an exception - e.name = ename - if excHandler != nil: - excHandler.exc = e - c_longjmp(excHandler.context, 1) - else: - if not isNil(buf): - setLen(buf, 0) - rawWriteStackTrace(buf) - if e.msg != nil and e.msg[0] != '\0': - add(buf, "Error: unhandled exception: ") - add(buf, $e.msg) - else: - add(buf, "Error: unhandled exception") - add(buf, " [") - add(buf, $ename) - add(buf, "]\n") - writeToStdErr(buf) - else: - writeToStdErr(ename) - quitOrDebug() - GC_enable() - -var - gAssertionFailed: ref EAssertionFailed - -proc internalAssert(file: cstring, line: int, cond: bool) {.compilerproc.} = - if not cond: - #c_fprintf(c_stdout, "Assertion failure: file %s line %ld\n", file, line) - #quit(1) - GC_disable() # BUGFIX: `$` allocates a new string object! - if not isNil(assertBuf): - # BUGFIX: when debugging the GC, assertBuf may be nil - setLen(assertBuf, 0) - add(assertBuf, "[Assertion failure] file: ") - add(assertBuf, file) - add(assertBuf, " line: ") - add(assertBuf, $line) - add(assertBuf, "\n") - gAssertionFailed.msg = assertBuf - GC_enable() - if gAssertionFailed != nil: - raise gAssertionFailed - else: - c_fprintf(c_stdout, "Assertion failure: file %s line %ld\n", file, line) - quit(1) - -proc WriteStackTrace() = - var s = "" - rawWriteStackTrace(s) - writeToStdErr(s) - -#proc stackTraceWrapper {.noconv.} = -# writeStackTrace() - -#addQuitProc(stackTraceWrapper) - -var - dbgAborting: bool # whether the debugger wants to abort - -proc signalHandler(sig: cint) {.exportc: "signalHandler", noconv.} = - # print stack trace and quit - var s = sig - GC_disable() - setLen(buf, 0) - rawWriteStackTrace(buf) - - if s == SIGINT: add(buf, "SIGINT: Interrupted by Ctrl-C.\n") - elif s == SIGSEGV: add(buf, "SIGSEGV: Illegal storage access.\n") - elif s == SIGABRT: - if dbgAborting: return # the debugger wants to abort - add(buf, "SIGABRT: Abnormal termination.\n") - elif s == SIGFPE: add(buf, "SIGFPE: Arithmetic error.\n") - elif s == SIGILL: add(buf, "SIGILL: Illegal operation.\n") - elif s == SIGBUS: add(buf, "SIGBUS: Illegal storage access.\n") - else: add(buf, "unknown signal\n") - writeToStdErr(buf) - dbgAborting = True # play safe here... - GC_enable() - quit(1) # always quit when SIGABRT - -proc registerSignalHandler() = - c_signal(SIGINT, signalHandler) - c_signal(SIGSEGV, signalHandler) - c_signal(SIGABRT, signalHandler) - c_signal(SIGFPE, signalHandler) - c_signal(SIGILL, signalHandler) - c_signal(SIGBUS, signalHandler) - -when not defined(noSignalHandler): - registerSignalHandler() # call it in initialization section -# for easier debugging of the GC, this memory is only allocated after the -# signal handlers have been registered -new(gAssertionFailed) -buf = newString(2048) -assertBuf = newString(2048) -setLen(buf, 0) -setLen(assertBuf, 0) - -proc raiseRangeError(val: biggestInt) {.compilerproc, noreturn, noinline.} = - raise newException(EOutOfRange, "value " & $val & " out of range") - -proc raiseIndexError() {.compilerproc, noreturn, noinline.} = - raise newException(EInvalidIndex, "index out of bounds") - -proc raiseFieldError(f: string) {.compilerproc, noreturn, noinline.} = - raise newException(EInvalidField, f & " is not accessible") - -proc chckIndx(i, a, b: int): int = - if i >= a and i <= b: - return i - else: - raiseIndexError() - -proc chckRange(i, a, b: int): int = - if i >= a and i <= b: - return i - else: - raiseRangeError(i) - -proc chckRange64(i, a, b: int64): int64 {.compilerproc.} = - if i >= a and i <= b: - return i - else: - raiseRangeError(i) - -proc chckRangeF(x, a, b: float): float = - if x >= a and x <= b: - return x - else: - raise newException(EOutOfRange, "value " & $x & " out of range") - -proc chckNil(p: pointer) = - if p == nil: c_raise(SIGSEGV) - -proc chckObj(obj, subclass: PNimType) {.compilerproc.} = - # checks if obj is of type subclass: - var x = obj - if x == subclass: return # optimized fast path - while x != subclass: - if x == nil: - raise newException(EInvalidObjectConversion, "invalid object conversion") - x = x.base - -proc chckObjAsgn(a, b: PNimType) {.compilerproc, inline.} = - if a != b: - raise newException(EInvalidObjectAssignment, "invalid object assignment") - -proc isObj(obj, subclass: PNimType): bool {.compilerproc.} = - # checks if obj is of type subclass: - var x = obj - if x == subclass: return true # optimized fast path - while x != subclass: - if x == nil: return false - x = x.base - return true diff --git a/nimlib/system/gc.nim b/nimlib/system/gc.nim deleted file mode 100755 index da8f757684..0000000000 --- a/nimlib/system/gc.nim +++ /dev/null @@ -1,647 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -# Garbage Collector -# -# The basic algorithm is *Deferrent Reference Counting* with cycle detection. -# Special care has been taken to avoid recursion as far as possible to avoid -# stack overflows when traversing deep datastructures. This is comparable to -# an incremental and generational GC. It should be well-suited for soft real -# time applications (like games). -# -# Future Improvements: -# * Support for multi-threading. However, locks for the reference counting -# might turn out to be too slow. - -const - CycleIncrease = 2 # is a multiplicative increase - InitialCycleThreshold = 4*1024*1024 # X MB because cycle checking is slow - ZctThreshold = 256 # we collect garbage if the ZCT's size - # reaches this threshold - # this seems to be a good value - -const - rcIncrement = 0b1000 # so that lowest 3 bits are not touched - # NOTE: Most colors are currently unused - rcBlack = 0b000 # cell is colored black; in use or free - rcGray = 0b001 # possible member of a cycle - rcWhite = 0b010 # member of a garbage cycle - rcPurple = 0b011 # possible root of a cycle - rcZct = 0b100 # in ZCT - rcRed = 0b101 # Candidate cycle undergoing sigma-computation - rcOrange = 0b110 # Candidate cycle awaiting epoch boundary - rcShift = 3 # shift by rcShift to get the reference counter - colorMask = 0b111 -type - TWalkOp = enum - waZctDecRef, waPush, waCycleDecRef - - TFinalizer {.compilerproc.} = proc (self: pointer) - # A ref type can have a finalizer that is called before the object's - # storage is freed. - - TGcStat {.final, pure.} = object - stackScans: int # number of performed stack scans (for statistics) - cycleCollections: int # number of performed full collections - maxThreshold: int # max threshold that has been set - maxStackSize: int # max stack size - maxStackCells: int # max stack cells in ``decStack`` - cycleTableSize: int # max entries in cycle table - - TGcHeap {.final, pure.} = object # this contains the zero count and - # non-zero count table - zct: TCellSeq # the zero count table - decStack: TCellSeq # cells in the stack that are to decref again - cycleRoots: TCellSet - tempStack: TCellSeq # temporary stack for recursion elimination - stat: TGcStat - -var - stackBottom: pointer - gch: TGcHeap - cycleThreshold: int = InitialCycleThreshold - recGcLock: int = 0 - # we use a lock to prevend the garbage collector to be triggered in a - # finalizer; the collector should not call itself this way! Thus every - # object allocated by a finalizer will not trigger a garbage collection. - # This is wasteful but safe. This is a lock against recursive garbage - # collection, not a lock for threads! - -proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc.} - # unsureAsgnRef updates the reference counters only if dest is not on the - # stack. It is used by the code generator if it cannot decide wether a - # reference is in the stack or not (this can happen for var parameters). -#proc growObj(old: pointer, newsize: int): pointer {.compilerproc.} -proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} -proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} - -proc addZCT(s: var TCellSeq, c: PCell) {.noinline.} = - if (c.refcount and rcZct) == 0: - c.refcount = c.refcount and not colorMask or rcZct - add(s, c) - -proc cellToUsr(cell: PCell): pointer {.inline.} = - # convert object (=pointer to refcount) to pointer to userdata - result = cast[pointer](cast[TAddress](cell)+%TAddress(sizeof(TCell))) - -proc usrToCell(usr: pointer): PCell {.inline.} = - # convert pointer to userdata to object (=pointer to refcount) - result = cast[PCell](cast[TAddress](usr)-%TAddress(sizeof(TCell))) - -proc canbeCycleRoot(c: PCell): bool {.inline.} = - result = ntfAcyclic notin c.typ.flags - -proc extGetCellType(c: pointer): PNimType {.compilerproc.} = - # used for code generation concerning debugging - result = usrToCell(c).typ - -proc internRefcount(p: pointer): int {.exportc: "getRefcount".} = - result = int(usrToCell(p).refcount) shr rcShift - -proc GC_disable() = inc(recGcLock) -proc GC_enable() = - if recGcLock > 0: dec(recGcLock) - -proc GC_setStrategy(strategy: TGC_Strategy) = - case strategy - of gcThroughput: nil - of gcResponsiveness: nil - of gcOptimizeSpace: nil - of gcOptimizeTime: nil - -proc GC_enableMarkAndSweep() = - cycleThreshold = InitialCycleThreshold - -proc GC_disableMarkAndSweep() = - cycleThreshold = high(cycleThreshold)-1 - # set to the max value to suppress the cycle detector - -# this that has to equals zero, otherwise we have to round up UnitsPerPage: -when BitsPerPage mod (sizeof(int)*8) != 0: - {.error: "(BitsPerPage mod BitsPerUnit) should be zero!".} - -when debugGC: - proc writeCell(msg: CString, c: PCell) = - var kind = -1 - if c.typ != nil: kind = ord(c.typ.kind) - when debugGC: - c_fprintf(c_stdout, "[GC] %s: %p %d rc=%ld from %s(%ld)\n", - msg, c, kind, c.refcount shr rcShift, c.filename, c.line) - else: - c_fprintf(c_stdout, "[GC] %s: %p %d rc=%ld\n", - msg, c, kind, c.refcount shr rcShift) - -when traceGC: - # traceGC is a special switch to enable extensive debugging - type - TCellState = enum - csAllocated, csZctFreed, csCycFreed - var - states: array[TCellState, TCellSet] - - proc traceCell(c: PCell, state: TCellState) = - case state - of csAllocated: - if c in states[csAllocated]: - writeCell("attempt to alloc an already allocated cell", c) - assert(false) - excl(states[csCycFreed], c) - excl(states[csZctFreed], c) - of csZctFreed: - if c in states[csZctFreed]: - writeCell("attempt to free zct cell twice", c) - assert(false) - if c in states[csCycFreed]: - writeCell("attempt to free with zct, but already freed with cyc", c) - assert(false) - if c notin states[csAllocated]: - writeCell("attempt to free not an allocated cell", c) - assert(false) - excl(states[csAllocated], c) - of csCycFreed: - if c notin states[csAllocated]: - writeCell("attempt to free a not allocated cell", c) - assert(false) - if c in states[csCycFreed]: - writeCell("attempt to free cyc cell twice", c) - assert(false) - if c in states[csZctFreed]: - writeCell("attempt to free with cyc, but already freed with zct", c) - assert(false) - excl(states[csAllocated], c) - incl(states[state], c) - - proc writeLeakage() = - var z = 0 - var y = 0 - var e = 0 - for c in elements(states[csAllocated]): - inc(e) - if c in states[csZctFreed]: inc(z) - elif c in states[csCycFreed]: inc(z) - else: writeCell("leak", c) - cfprintf(cstdout, "Allocations: %ld; ZCT freed: %ld; CYC freed: %ld\n", - e, z, y) - -template gcTrace(cell, state: expr): stmt = - when traceGC: traceCell(cell, state) - -# ----------------------------------------------------------------------------- - -# forward declarations: -proc collectCT(gch: var TGcHeap) -proc IsOnStack(p: pointer): bool {.noinline.} -proc forAllChildren(cell: PCell, op: TWalkOp) -proc doOperation(p: pointer, op: TWalkOp) -proc forAllChildrenAux(dest: Pointer, mt: PNimType, op: TWalkOp) -# we need the prototype here for debugging purposes - -proc prepareDealloc(cell: PCell) = - if cell.typ.finalizer != nil: - # the finalizer could invoke something that - # allocates memory; this could trigger a garbage - # collection. Since we are already collecting we - # prevend recursive entering here by a lock. - # XXX: we should set the cell's children to nil! - inc(recGcLock) - (cast[TFinalizer](cell.typ.finalizer))(cellToUsr(cell)) - dec(recGcLock) - -proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = - stackBottom = theStackBottom - -proc PossibleRoot(gch: var TGcHeap, c: PCell) {.inline.} = - if canbeCycleRoot(c): incl(gch.cycleRoots, c) - -proc decRef(c: PCell) {.inline.} = - when stressGC: - if c.refcount <% rcIncrement: - writeCell("broken cell", c) - assert(c.refcount >=% rcIncrement) - c.refcount = c.refcount -% rcIncrement - if c.refcount <% rcIncrement: - addZCT(gch.zct, c) - elif canBeCycleRoot(c): - incl(gch.cycleRoots, c) - -proc incRef(c: PCell) {.inline.} = - c.refcount = c.refcount +% rcIncrement - if canBeCycleRoot(c): - incl(gch.cycleRoots, c) - -proc nimGCref(p: pointer) {.compilerproc, inline.} = incRef(usrToCell(p)) -proc nimGCunref(p: pointer) {.compilerproc, inline.} = decRef(usrToCell(p)) - -proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} = - # the code generator calls this proc! - assert(not isOnStack(dest)) - # BUGFIX: first incRef then decRef! - if src != nil: incRef(usrToCell(src)) - if dest^ != nil: decRef(usrToCell(dest^)) - dest^ = src - -proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} = - # the code generator calls this proc if it is known at compile time that no - # cycle is possible. - if src != nil: - var c = usrToCell(src) - c.refcount = c.refcount +% rcIncrement - if dest^ != nil: - var c = usrToCell(dest^) - c.refcount = c.refcount -% rcIncrement - if c.refcount <% rcIncrement: - addZCT(gch.zct, c) - dest^ = src - -proc unsureAsgnRef(dest: ppointer, src: pointer) = - if not IsOnStack(dest): - if src != nil: incRef(usrToCell(src)) - if dest^ != nil: decRef(usrToCell(dest^)) - dest^ = src - -proc initGC() = - when traceGC: - for i in low(TCellState)..high(TCellState): Init(states[i]) - gch.stat.stackScans = 0 - gch.stat.cycleCollections = 0 - gch.stat.maxThreshold = 0 - gch.stat.maxStackSize = 0 - gch.stat.maxStackCells = 0 - gch.stat.cycleTableSize = 0 - # init the rt - init(gch.zct) - init(gch.tempStack) - Init(gch.cycleRoots) - Init(gch.decStack) - new(gOutOfMem) # reserve space for the EOutOfMemory exception here! - -proc forAllSlotsAux(dest: pointer, n: ptr TNimNode, op: TWalkOp) = - var d = cast[TAddress](dest) - case n.kind - of nkNone: assert(false) - of nkSlot: forAllChildrenAux(cast[pointer](d +% n.offset), n.typ, op) - of nkList: - for i in 0..n.len-1: forAllSlotsAux(dest, n.sons[i], op) - of nkCase: - var m = selectBranch(dest, n) - if m != nil: forAllSlotsAux(dest, m, op) - -proc forAllChildrenAux(dest: Pointer, mt: PNimType, op: TWalkOp) = - var d = cast[TAddress](dest) - if dest == nil: return # nothing to do - if ntfNoRefs notin mt.flags: - case mt.Kind - of tyArray, tyArrayConstr, tyOpenArray: - for i in 0..(mt.size div mt.base.size)-1: - forAllChildrenAux(cast[pointer](d +% i *% mt.base.size), mt.base, op) - of tyRef, tyString, tySequence: # leaf: - doOperation(cast[ppointer](d)^, op) - of tyObject, tyTuple, tyPureObject: - forAllSlotsAux(dest, mt.node, op) - else: nil - -proc forAllChildren(cell: PCell, op: TWalkOp) = - assert(cell != nil) - assert(cell.typ != nil) - case cell.typ.Kind - of tyRef: # common case - forAllChildrenAux(cellToUsr(cell), cell.typ.base, op) - of tySequence: - var d = cast[TAddress](cellToUsr(cell)) - var s = cast[PGenericSeq](d) - if s != nil: - for i in 0..s.len-1: - forAllChildrenAux(cast[pointer](d +% i *% cell.typ.base.size +% - GenericSeqSize), cell.typ.base, op) - of tyString: nil - else: assert(false) - -proc checkCollection {.inline.} = - # checks if a collection should be done - if recGcLock == 0: - collectCT(gch) - -proc newObj(typ: PNimType, size: int): pointer = - # generates a new object and sets its reference counter to 0 - assert(typ.kind in {tyRef, tyString, tySequence}) - checkCollection() - var res = cast[PCell](rawAlloc(allocator, size + sizeof(TCell))) - zeroMem(res, size+sizeof(TCell)) - assert((cast[TAddress](res) and (MemAlign-1)) == 0) - # now it is buffered in the ZCT - res.typ = typ - when debugGC: - if framePtr != nil and framePtr.prev != nil: - res.filename = framePtr.prev.filename - res.line = framePtr.prev.line - res.refcount = rcZct # refcount is zero, but mark it to be in the ZCT - assert(isAllocatedPtr(allocator, res)) - # its refcount is zero, so add it to the ZCT: - block addToZCT: - # we check the last 8 entries (cache line) for a slot - # that could be reused - var L = gch.zct.len - var d = gch.zct.d - for i in countdown(L-1, max(0, L-8)): - var c = d[i] - if c.refcount >=% rcIncrement: - c.refcount = c.refcount and not colorMask - d[i] = res - break addToZCT - add(gch.zct, res) - when logGC: writeCell("new cell", res) - gcTrace(res, csAllocated) - result = cellToUsr(res) - -proc newSeq(typ: PNimType, len: int): pointer = - result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize)) - cast[PGenericSeq](result).len = len - cast[PGenericSeq](result).space = len - -proc growObj(old: pointer, newsize: int): pointer = - checkCollection() - var ol = usrToCell(old) - assert(ol.typ != nil) - assert(ol.typ.kind in {tyString, tySequence}) - var res = cast[PCell](rawAlloc(allocator, newsize + sizeof(TCell))) - var elemSize = 1 - if ol.typ.kind != tyString: - elemSize = ol.typ.base.size - - var oldsize = cast[PGenericSeq](old).len*elemSize + GenericSeqSize - copyMem(res, ol, oldsize + sizeof(TCell)) - zeroMem(cast[pointer](cast[TAddress](res)+% oldsize +% sizeof(TCell)), - newsize-oldsize) - assert((cast[TAddress](res) and (MemAlign-1)) == 0) - assert(res.refcount shr rcShift <=% 1) - #if res.refcount <% rcIncrement: - # add(gch.zct, res) - #else: # XXX: what to do here? - # decRef(ol) - if (ol.refcount and colorMask) == rcZct: - var j = gch.zct.len-1 - var d = gch.zct.d - while j >= 0: - if d[j] == ol: - d[j] = res - break - dec(j) - if canBeCycleRoot(ol): excl(gch.cycleRoots, ol) - when logGC: - writeCell("growObj old cell", ol) - writeCell("growObj new cell", res) - gcTrace(ol, csZctFreed) - gcTrace(res, csAllocated) - when reallyDealloc: rawDealloc(allocator, ol) - else: - assert(ol.typ != nil) - zeroMem(ol, sizeof(TCell)) - result = cellToUsr(res) - -# ---------------- cycle collector ------------------------------------------- - -proc doOperation(p: pointer, op: TWalkOp) = - if p == nil: return - var c: PCell = usrToCell(p) - assert(c != nil) - case op # faster than function pointers because of easy prediction - of waZctDecRef: - assert(c.refcount >=% rcIncrement) - c.refcount = c.refcount -% rcIncrement - when logGC: writeCell("decref (from doOperation)", c) - if c.refcount <% rcIncrement: addZCT(gch.zct, c) - of waPush: - add(gch.tempStack, c) - of waCycleDecRef: - assert(c.refcount >=% rcIncrement) - c.refcount = c.refcount -% rcIncrement - -# we now use a much simpler and non-recursive algorithm for cycle removal -proc collectCycles(gch: var TGcHeap) = - var tabSize = 0 - for c in elements(gch.cycleRoots): - inc(tabSize) - forallChildren(c, waCycleDecRef) - gch.stat.cycleTableSize = max(gch.stat.cycleTableSize, tabSize) - - # restore reference counts (a depth-first traversal is needed): - var marker: TCellSet - Init(marker) - for c in elements(gch.cycleRoots): - if c.refcount >=% rcIncrement: - if not containsOrIncl(marker, c): - gch.tempStack.len = 0 - forAllChildren(c, waPush) - while gch.tempStack.len > 0: - dec(gch.tempStack.len) - var d = gch.tempStack.d[gch.tempStack.len] - d.refcount = d.refcount +% rcIncrement - if d in gch.cycleRoots and not containsOrIncl(marker, d): - forAllChildren(d, waPush) - # remove cycles: - for c in elements(gch.cycleRoots): - if c.refcount <% rcIncrement: - gch.tempStack.len = 0 - forAllChildren(c, waPush) - while gch.tempStack.len > 0: - dec(gch.tempStack.len) - var d = gch.tempStack.d[gch.tempStack.len] - if d.refcount <% rcIncrement: - if d notin gch.cycleRoots: # d is leaf of c and not part of cycle - addZCT(gch.zct, d) - when logGC: writeCell("add to ZCT (from cycle collector)", d) - prepareDealloc(c) - gcTrace(c, csCycFreed) - when logGC: writeCell("cycle collector dealloc cell", c) - when reallyDealloc: rawDealloc(allocator, c) - else: - assert(c.typ != nil) - zeroMem(c, sizeof(TCell)) - Deinit(gch.cycleRoots) - Init(gch.cycleRoots) - -proc gcMark(p: pointer) {.inline.} = - # the addresses are not as cells on the stack, so turn them to cells: - var cell = usrToCell(p) - var c = cast[TAddress](cell) - if c >% PageSize and (c and (MemAlign-1)) == 0: - # fast check: does it look like a cell? - if isAllocatedPtr(allocator, cell): - # mark the cell: - cell.refcount = cell.refcount +% rcIncrement - add(gch.decStack, cell) - -# ----------------- stack management -------------------------------------- -# inspired from Smart Eiffel - -proc stackSize(): int {.noinline.} = - var stackTop: array[0..1, pointer] - result = abs(cast[int](addr(stackTop[0])) - cast[int](stackBottom)) - -when defined(sparc): # For SPARC architecture. - proc isOnStack(p: pointer): bool = - var stackTop: array [0..1, pointer] - var b = cast[TAddress](stackBottom) - var a = cast[TAddress](addr(stackTop[0])) - var x = cast[TAddress](p) - result = x >=% a and x <=% b - - proc markStackAndRegisters(gch: var TGcHeap) {.noinline, cdecl.} = - when defined(sparcv9): - asm """"flushw \n" """ - else: - asm """"ta 0x3 ! ST_FLUSH_WINDOWS\n" """ - - var - max = stackBottom - sp: PPointer - stackTop: array[0..1, pointer] - sp = addr(stackTop[0]) - # Addresses decrease as the stack grows. - while sp <= max: - gcMark(sp^) - sp = cast[ppointer](cast[TAddress](sp) +% sizeof(pointer)) - -elif defined(ELATE): - {.error: "stack marking code is to be written for this architecture".} - -elif defined(hppa) or defined(hp9000) or defined(hp9000s300) or - defined(hp9000s700) or defined(hp9000s800) or defined(hp9000s820): - # --------------------------------------------------------------------------- - # Generic code for architectures where addresses increase as the stack grows. - # --------------------------------------------------------------------------- - proc isOnStack(p: pointer): bool = - var stackTop: array [0..1, pointer] - var a = cast[TAddress](stackBottom) - var b = cast[TAddress](addr(stackTop[0])) - var x = cast[TAddress](p) - result = x >=% a and x <=% b - - var - jmpbufSize {.importc: "sizeof(jmp_buf)", nodecl.}: int - # a little hack to get the size of a TJmpBuf in the generated C code - # in a platform independant way - - proc markStackAndRegisters(gch: var TGcHeap) {.noinline, cdecl.} = - var registers: C_JmpBuf - if c_setjmp(registers) == 0'i32: # To fill the C stack with registers. - var max = cast[TAddress](stackBottom) - var sp = cast[TAddress](addr(registers)) +% jmpbufSize -% sizeof(pointer) - # sp will traverse the JMP_BUF as well (jmp_buf size is added, - # otherwise sp would be below the registers structure). - while sp >=% max: - gcMark(cast[ppointer](sp)^) - sp = sp -% sizeof(pointer) - -else: - # --------------------------------------------------------------------------- - # Generic code for architectures where addresses decrease as the stack grows. - # --------------------------------------------------------------------------- - proc isOnStack(p: pointer): bool = - var stackTop: array [0..1, pointer] - var b = cast[TAddress](stackBottom) - var a = cast[TAddress](addr(stackTop[0])) - var x = cast[TAddress](p) - result = x >=% a and x <=% b - - proc markStackAndRegisters(gch: var TGcHeap) {.noinline, cdecl.} = - # We use a jmp_buf buffer that is in the C stack. - # Used to traverse the stack and registers assuming - # that 'setjmp' will save registers in the C stack. - var registers: C_JmpBuf - if c_setjmp(registers) == 0'i32: # To fill the C stack with registers. - var max = cast[TAddress](stackBottom) - var sp = cast[TAddress](addr(registers)) - while sp <=% max: - gcMark(cast[ppointer](sp)^) - sp = sp +% sizeof(pointer) - -# ---------------------------------------------------------------------------- -# end of non-portable code -# ---------------------------------------------------------------------------- - -proc CollectZCT(gch: var TGcHeap) = - # Note: Freeing may add child objects to the ZCT! So essentially we do - # deep freeing, which is bad for incremental operation. In order to - # avoid a deep stack, we move objects to keep the ZCT small. - # This is performance critical! - var L = addr(gch.zct.len) - while L^ > 0: - var c = gch.zct.d[0] - # remove from ZCT: - assert((c.refcount and colorMask) == rcZct) - c.refcount = c.refcount and not colorMask - gch.zct.d[0] = gch.zct.d[L^ - 1] - dec(L^) - if c.refcount <% rcIncrement: - # It may have a RC > 0, if it is in the hardware stack or - # it has not been removed yet from the ZCT. This is because - # ``incref`` does not bother to remove the cell from the ZCT - # as this might be too slow. - # In any case, it should be removed from the ZCT. But not - # freed. **KEEP THIS IN MIND WHEN MAKING THIS INCREMENTAL!** - if canBeCycleRoot(c): excl(gch.cycleRoots, c) - when logGC: writeCell("zct dealloc cell", c) - gcTrace(c, csZctFreed) - # We are about to free the object, call the finalizer BEFORE its - # children are deleted as well, because otherwise the finalizer may - # access invalid memory. This is done by prepareDealloc(): - prepareDealloc(c) - forAllChildren(c, waZctDecRef) - when reallyDealloc: rawDealloc(allocator, c) - else: - assert(c.typ != nil) - zeroMem(c, sizeof(TCell)) - -proc unmarkStackAndRegisters(gch: var TGcHeap) = - var d = gch.decStack.d - for i in 0..gch.decStack.len-1: - assert isAllocatedPtr(allocator, d[i]) - decRef(d[i]) # OPT: cannot create a cycle! - gch.decStack.len = 0 - -proc collectCT(gch: var TGcHeap) = - if gch.zct.len >= ZctThreshold or (cycleGC and - getOccupiedMem() >= cycleThreshold) or stressGC: - gch.stat.maxStackSize = max(gch.stat.maxStackSize, stackSize()) - assert(gch.decStack.len == 0) - markStackAndRegisters(gch) - gch.stat.maxStackCells = max(gch.stat.maxStackCells, gch.decStack.len) - inc(gch.stat.stackScans) - collectZCT(gch) - when cycleGC: - if getOccupiedMem() >= cycleThreshold or stressGC: - collectCycles(gch) - collectZCT(gch) - inc(gch.stat.cycleCollections) - cycleThreshold = max(InitialCycleThreshold, getOccupiedMem() * - cycleIncrease) - gch.stat.maxThreshold = max(gch.stat.maxThreshold, cycleThreshold) - unmarkStackAndRegisters(gch) - -proc GC_fullCollect() = - var oldThreshold = cycleThreshold - cycleThreshold = 0 # forces cycle collection - collectCT(gch) - cycleThreshold = oldThreshold - -proc GC_getStatistics(): string = - GC_disable() - result = "[GC] total memory: " & $(getTotalMem()) & "\n" & - "[GC] occupied memory: " & $(getOccupiedMem()) & "\n" & - "[GC] stack scans: " & $gch.stat.stackScans & "\n" & - "[GC] stack cells: " & $gch.stat.maxStackCells & "\n" & - "[GC] cycle collections: " & $gch.stat.cycleCollections & "\n" & - "[GC] max threshold: " & $gch.stat.maxThreshold & "\n" & - "[GC] zct capacity: " & $gch.zct.cap & "\n" & - "[GC] max cycle table size: " & $gch.stat.cycleTableSize & "\n" & - "[GC] max stack size: " & $gch.stat.maxStackSize - when traceGC: writeLeakage() - GC_enable() diff --git a/nimlib/system/hti.nim b/nimlib/system/hti.nim deleted file mode 100755 index 3343000ae4..0000000000 --- a/nimlib/system/hti.nim +++ /dev/null @@ -1,58 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -type # This should be he same as ast.TTypeKind - # many enum fields are not used at runtime - TNimKind = enum - tyNone, tyBool, tyChar, - tyEmpty, tyArrayConstr, tyNil, tyExpr, tyStmt, tyTypeDesc, - tyGenericInvokation, # ``T[a, b]`` for types to invoke - tyGenericBody, # ``T[a, b, body]`` last parameter is the body - tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type - tyGenericParam, # ``a`` in the example - tyDistinct, # distinct type - tyEnum, - tyOrdinal, - tyArray, - tyObject, - tyTuple, - tySet, - tyRange, - tyPtr, tyRef, - tyVar, - tySequence, - tyProc, - tyPointer, tyOpenArray, - tyString, tyCString, tyForward, - tyInt, tyInt8, tyInt16, tyInt32, tyInt64, - tyFloat, tyFloat32, tyFloat64, tyFloat128, - tyPureObject # signals that object has no `n_type` field - - TNimNodeKind = enum nkNone, nkSlot, nkList, nkCase - TNimNode {.compilerproc, final.} = object - kind: TNimNodeKind - offset: int - typ: ptr TNimType - name: Cstring - len: int - sons: ptr array [0..0x7fff, ptr TNimNode] - - TNimTypeFlag = enum - ntfNoRefs = 0, # type contains no tyRef, tySequence, tyString - ntfAcyclic = 1 # type cannot form a cycle - TNimType {.compilerproc, final.} = object - size: int - kind: TNimKind - flags: set[TNimTypeFlag] - base: ptr TNimType - node: ptr TNimNode # valid for tyRecord, tyObject, tyTuple, tyEnum - finalizer: pointer # the finalizer for the type - PNimType = ptr TNimType - -# node.len may be the ``first`` element of a set diff --git a/nimlib/system/mm.nim b/nimlib/system/mm.nim deleted file mode 100755 index 76b5d83bd5..0000000000 --- a/nimlib/system/mm.nim +++ /dev/null @@ -1,189 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Nimrod high-level memory manager: It supports Boehm's GC, no GC and the -# native Nimrod GC. The native Nimrod GC is the default. - -#{.push checks:on, assertions:on.} -{.push checks:off.} - -const - debugGC = false # we wish to debug the GC... - logGC = false - traceGC = false # extensive debugging - reallyDealloc = true # for debugging purposes this can be set to false - cycleGC = true # (de)activate the cycle GC - stressGC = false - reallyOsDealloc = true - coalescRight = true - coalescLeft = true - overwriteFree = false - -type - PPointer = ptr pointer - TByteArray = array[0..1000_0000, byte] - PByte = ptr TByteArray - PString = ptr string - -# Page size of the system; in most cases 4096 bytes. For exotic OS or -# CPU this needs to be changed: -const - PageShift = 12 - PageSize = 1 shl PageShift - PageMask = PageSize-1 - - MemAlign = 8 # also minimal allocatable memory block - - BitsPerPage = PageSize div MemAlign - UnitsPerPage = BitsPerPage div (sizeof(int)*8) - # how many ints do we need to describe a page: - # on 32 bit systems this is only 16 (!) - - TrunkShift = 9 - BitsPerTrunk = 1 shl TrunkShift # needs to be power of 2 and divisible by 64 - TrunkMask = BitsPerTrunk - 1 - IntsPerTrunk = BitsPerTrunk div (sizeof(int)*8) - IntShift = 5 + ord(sizeof(int) == 8) # 5 or 6, depending on int width - IntMask = 1 shl IntShift - 1 - -var - gOutOfMem: ref EOutOfMemory - -proc raiseOutOfMem() {.noreturn.} = - if gOutOfMem == nil: quit("out of memory; cannot even throw an exception") - gOutOfMem.msg = "out of memory" - raise gOutOfMem - -when defined(boehmgc): - when defined(windows): - const boehmLib = "boehmgc.dll" - else: - const boehmLib = "/usr/lib/libgc.so.1" - - proc boehmGC_disable {.importc: "GC_disable", dynlib: boehmLib.} - proc boehmGC_enable {.importc: "GC_enable", dynlib: boehmLib.} - proc boehmGCincremental {. - importc: "GC_enable_incremental", dynlib: boehmLib.} - proc boehmGCfullCollect {.importc: "GC_gcollect", dynlib: boehmLib.} - proc boehmAlloc(size: int): pointer {. - importc: "GC_malloc", dynlib: boehmLib.} - proc boehmAllocAtomic(size: int): pointer {. - importc: "GC_malloc_atomic", dynlib: boehmLib.} - proc boehmRealloc(p: pointer, size: int): pointer {. - importc: "GC_realloc", dynlib: boehmLib.} - proc boehmDealloc(p: pointer) {.importc: "GC_free", dynlib: boehmLib.} - - proc alloc(size: int): pointer = - result = boehmAlloc(size) - if result == nil: raiseOutOfMem() - proc alloc0(size: int): pointer = - result = alloc(size) - zeroMem(result, size) - proc realloc(p: Pointer, newsize: int): pointer = - result = boehmRealloc(p, newsize) - if result == nil: raiseOutOfMem() - proc dealloc(p: Pointer) = - boehmDealloc(p) - - proc initGC() = nil - - #boehmGCincremental() - - proc GC_disable() = boehmGC_disable() - proc GC_enable() = boehmGC_enable() - proc GC_fullCollect() = boehmGCfullCollect() - proc GC_setStrategy(strategy: TGC_Strategy) = nil - proc GC_enableMarkAndSweep() = nil - proc GC_disableMarkAndSweep() = nil - proc GC_getStatistics(): string = return "" - - proc getOccupiedMem(): int = return -1 - proc getFreeMem(): int = return -1 - proc getTotalMem(): int = return -1 - - proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} = - result = alloc(size) - proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} = - result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize)) - cast[PGenericSeq](result).len = len - cast[PGenericSeq](result).space = len - - proc growObj(old: pointer, newsize: int): pointer = - result = realloc(old, newsize) - - proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = nil - proc nimGCref(p: pointer) {.compilerproc, inline.} = nil - proc nimGCunref(p: pointer) {.compilerproc, inline.} = nil - - proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - - include "system/cellsets" -elif defined(nogc): - include "system/alloc" - - when false: - proc alloc(size: int): pointer = - result = c_malloc(size) - if result == nil: raiseOutOfMem() - proc alloc0(size: int): pointer = - result = alloc(size) - zeroMem(result, size) - proc realloc(p: Pointer, newsize: int): pointer = - result = c_realloc(p, newsize) - if result == nil: raiseOutOfMem() - proc dealloc(p: Pointer) = c_free(p) - proc getOccupiedMem(): int = return -1 - proc getFreeMem(): int = return -1 - proc getTotalMem(): int = return -1 - - proc initGC() = nil - proc GC_disable() = nil - proc GC_enable() = nil - proc GC_fullCollect() = nil - proc GC_setStrategy(strategy: TGC_Strategy) = nil - proc GC_enableMarkAndSweep() = nil - proc GC_disableMarkAndSweep() = nil - proc GC_getStatistics(): string = return "" - - - proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} = - result = alloc0(size) - proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} = - result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize)) - cast[PGenericSeq](result).len = len - cast[PGenericSeq](result).space = len - proc growObj(old: pointer, newsize: int): pointer = - result = realloc(old, newsize) - - proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = nil - proc nimGCref(p: pointer) {.compilerproc, inline.} = nil - proc nimGCunref(p: pointer) {.compilerproc, inline.} = nil - - proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} = - dest^ = src - - include "system/cellsets" -else: - include "system/alloc" - include "system/cellsets" - assert(sizeof(TCell) == sizeof(TFreeCell)) - include "system/gc" - -{.pop.} - - diff --git a/nimlib/system/profiler.nim b/nimlib/system/profiler.nim deleted file mode 100755 index b87b30d4a7..0000000000 --- a/nimlib/system/profiler.nim +++ /dev/null @@ -1,61 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This file implements the Nimrod profiler. The profiler needs support by the -# code generator. - -type - TProfileData {.compilerproc, final.} = object - procname: cstring - total: float - -var - profileData {.compilerproc.}: array [0..64*1024-1, TProfileData] - -proc sortProfile(a: var array[0..64*1024-1, TProfileData], N: int) = - # we use shellsort here; fast enough and simple - var h = 1 - while true: - h = 3 * h + 1 - if h > N: break - while true: - h = h div 3 - for i in countup(h, N - 1): - var v = a[i] - var j = i - while a[j-h].total <= v.total: - a[j] = a[j-h] - j = j-h - if j < h: break - a[j] = v - if h == 1: break - -proc writeProfile() {.noconv.} = - const filename = "profile_results" - var i = 0 - var f: TFile - var j = 1 - while open(f, filename & $j & ".txt"): - close(f) - inc(j) - if open(f, filename & $j & ".txt", fmWrite): - var N = 0 - # we have to compute the actual length of the array: - while profileData[N].procname != nil: inc(N) - sortProfile(profileData, N) - writeln(f, "total running time of each proc" & - " (interpret these numbers relatively)") - while profileData[i].procname != nil: - write(f, profileData[i].procname) - write(f, ": ") - writeln(f, profileData[i].total) - inc(i) - close(f) - -addQuitProc(writeProfile) diff --git a/nimlib/system/repr.nim b/nimlib/system/repr.nim deleted file mode 100755 index e340f1d7c0..0000000000 --- a/nimlib/system/repr.nim +++ /dev/null @@ -1,249 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# The generic ``repr`` procedure. It is an invaluable debugging tool. - -#proc cstrToNimStrDummy(s: cstring): string {.inline.} = -# result = cast[string](cstrToNimStr(s)) - -proc reprInt(x: int64): string {.compilerproc.} = return $x -proc reprFloat(x: float): string {.compilerproc.} = return $x - -proc reprPointer(x: pointer): string {.compilerproc.} = - var buf: array [0..59, char] - c_sprintf(buf, "%p", x) - return $buf - -proc reprStrAux(result: var string, s: string) = - if cast[pointer](s) == nil: - add result, "nil" - return - add result, reprPointer(cast[pointer](s)) & "\"" - for c in items(s): - case c - of '"': add result, "\\\"" - of '\\': add result, "\\\\" # BUGFIX: forgotten - of '\10': add result, "\\10\"\n\"" # " \n " # better readability - of '\128' .. '\255', '\0'..'\9', '\11'..'\31': - add result, "\\" & reprInt(ord(c)) - else: result.add(c) - add result, "\"" - -proc reprStr(s: string): string {.compilerproc.} = - result = "" - reprStrAux(result, s) - -proc reprBool(x: bool): string {.compilerproc.} = - if x: result = "true" - else: result = "false" - -proc reprChar(x: char): string {.compilerproc.} = - result = "\'" - case x - of '"': add result, "\\\"" - of '\\': add result, "\\\\" - of '\128' .. '\255', '\0'..'\31': add result, "\\" & reprInt(ord(x)) - else: add result, x - add result, "\'" - -proc reprEnum(e: int, typ: PNimType): string {.compilerproc.} = - if e <% typ.node.len: # BUGFIX - result = $typ.node.sons[e].name - else: - result = $e & " (invalid data!)" - -type - pbyteArray = ptr array[0.. 0xffff, byte] - -proc addSetElem(result: var string, elem: int, typ: PNimType) = - case typ.kind - of tyEnum: add result, reprEnum(elem, typ) - of tyBool: add result, reprBool(bool(elem)) - of tyChar: add result, reprChar(chr(elem)) - of tyRange: addSetElem(result, elem, typ.base) - of tyInt..tyInt64: add result, reprInt(elem) - else: # data corrupt --> inform the user - add result, " (invalid data!)" - -proc reprSetAux(result: var string, p: pointer, typ: PNimType) = - # "typ.slots.len" field is for sets the "first" field - var elemCounter = 0 # we need this flag for adding the comma at - # the right places - add result, "{" - var u: int64 - case typ.size - of 1: u = ze64(cast[ptr int8](p)^) - of 2: u = ze64(cast[ptr int16](p)^) - of 4: u = ze64(cast[ptr int32](p)^) - of 8: u = cast[ptr int64](p)^ - else: - var a = cast[pbyteArray](p) - for i in 0 .. typ.size*8-1: - if (ze(a[i div 8]) and (1 shl (i mod 8))) != 0: - if elemCounter > 0: add result, ", " - addSetElem(result, i+typ.node.len, typ.base) - inc(elemCounter) - if typ.size <= 8: - for i in 0..sizeof(int64)*8-1: - if (u and (1 shl i)) != 0: - if elemCounter > 0: add result, ", " - addSetElem(result, i+typ.node.len, typ.base) - inc(elemCounter) - add result, "}" - -proc reprSet(p: pointer, typ: PNimType): string {.compilerproc.} = - result = "" - reprSetAux(result, p, typ) - -type - TReprClosure {.final.} = object # we cannot use a global variable here - # as this wouldn't be thread-safe - marked: TCellSet - recdepth: int # do not recurse endless - indent: int # indentation - -proc initReprClosure(cl: var TReprClosure) = - Init(cl.marked) - cl.recdepth = -1 # default is to display everything! - cl.indent = 0 - -proc deinitReprClosure(cl: var TReprClosure) = - Deinit(cl.marked) - -proc reprBreak(result: var string, cl: TReprClosure) = - add result, "\n" - for i in 0..cl.indent-1: add result, ' ' - -proc reprAux(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) - -proc reprArray(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) = - add result, "[" - var bs = typ.base.size - for i in 0..typ.size div bs - 1: - if i > 0: add result, ", " - reprAux(result, cast[pointer](cast[TAddress](p) + i*bs), typ.base, cl) - add result, "]" - -proc reprSequence(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) = - if p == nil: - add result, "nil" - return - result.add(reprPointer(p) & "[") - var bs = typ.base.size - for i in 0..cast[PGenericSeq](p).len-1: - if i > 0: add result, ", " - reprAux(result, cast[pointer](cast[TAddress](p) + GenericSeqSize + i*bs), - typ.Base, cl) - add result, "]" - -proc reprRecordAux(result: var string, p: pointer, n: ptr TNimNode, - cl: var TReprClosure) = - case n.kind - of nkNone: assert(false) - of nkSlot: - add result, $n.name - add result, " = " - reprAux(result, cast[pointer](cast[TAddress](p) + n.offset), n.typ, cl) - of nkList: - for i in 0..n.len-1: - if i > 0: add result, ",\n" - reprRecordAux(result, p, n.sons[i], cl) - of nkCase: - var m = selectBranch(p, n) - reprAux(result, cast[pointer](cast[TAddress](p) + n.offset), n.typ, cl) - if m != nil: reprRecordAux(result, p, m, cl) - -proc reprRecord(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) = - add result, "[" - reprRecordAux(result, p, typ.node, cl) - add result, "]" - -proc reprRef(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) = - # we know that p is not nil here: - when defined(boehmGC) or defined(nogc): - var cell = cast[PCell](p) - else: - var cell = usrToCell(p) - add result, "ref " & reprPointer(p) - if cell notin cl.marked: - # only the address is shown: - incl(cl.marked, cell) - add result, " --> " - reprAux(result, p, typ.base, cl) - -proc reprAux(result: var string, p: pointer, typ: PNimType, - cl: var TReprClosure) = - if cl.recdepth == 0: - add result, "..." - return - dec(cl.recdepth) - case typ.kind - of tySet: reprSetAux(result, p, typ) - of tyArray: reprArray(result, p, typ, cl) - of tyTuple, tyPureObject: reprRecord(result, p, typ, cl) - of tyObject: - var t = cast[ptr PNimType](p)^ - reprRecord(result, p, t, cl) - of tyRef, tyPtr: - assert(p != nil) - if cast[ppointer](p)^ == nil: add result, "nil" - else: reprRef(result, cast[ppointer](p)^, typ, cl) - of tySequence: - reprSequence(result, cast[ppointer](p)^, typ, cl) - of tyInt: add result, $(cast[ptr int](p)^) - of tyInt8: add result, $int(cast[ptr Int8](p)^) - of tyInt16: add result, $int(cast[ptr Int16](p)^) - of tyInt32: add result, $int(cast[ptr Int32](p)^) - of tyInt64: add result, $(cast[ptr Int64](p)^) - of tyFloat: add result, $(cast[ptr float](p)^) - of tyFloat32: add result, $(cast[ptr float32](p)^) - of tyFloat64: add result, $(cast[ptr float64](p)^) - of tyEnum: add result, reprEnum(cast[ptr int](p)^, typ) - of tyBool: add result, reprBool(cast[ptr bool](p)^) - of tyChar: add result, reprChar(cast[ptr char](p)^) - of tyString: reprStrAux(result, cast[ptr string](p)^) - of tyCString: reprStrAux(result, $(cast[ptr cstring](p)^)) - of tyRange: reprAux(result, p, typ.base, cl) - of tyProc, tyPointer: - if cast[ppointer](p)^ == nil: add result, "nil" - else: add result, reprPointer(cast[ppointer](p)^) - else: - add result, "(invalid data!)" - inc(cl.recdepth) - -proc reprOpenArray(p: pointer, length: int, elemtyp: PNimType): string {. - compilerproc.} = - var - cl: TReprClosure - initReprClosure(cl) - result = "[" - var bs = elemtyp.size - for i in 0..length - 1: - if i > 0: add result, ", " - reprAux(result, cast[pointer](cast[TAddress](p) + i*bs), elemtyp, cl) - add result, "]" - deinitReprClosure(cl) - -proc reprAny(p: pointer, typ: PNimType): string = - var - cl: TReprClosure - initReprClosure(cl) - result = "" - if typ.kind in {tyObject, tyPureObject, tyTuple, tyArray, tySet}: - reprAux(result, p, typ, cl) - else: - var p = p - reprAux(result, addr(p), typ, cl) - add result, "\n" - deinitReprClosure(cl) diff --git a/nimlib/system/sets.nim b/nimlib/system/sets.nim deleted file mode 100755 index f9f3eb32b6..0000000000 --- a/nimlib/system/sets.nim +++ /dev/null @@ -1,28 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# set handling - -type - TNimSet = array [0..4*2048-1, int8] - -proc countBits32(n: int32): int {.compilerproc.} = - var v = n - v = v -% ((v shr 1'i32) and 0x55555555'i32) - v = (v and 0x33333333'i32) +% ((v shr 2'i32) and 0x33333333'i32) - result = ((v +% (v shr 4'i32) and 0xF0F0F0F'i32) *% 0x1010101'i32) shr 24'i32 - -proc countBits64(n: int64): int {.compilerproc.} = - result = countBits32(toU32(n and 0xffff'i64)) + - countBits32(toU32(n shr 16'i64)) - -proc cardSet(s: TNimSet, len: int): int {.compilerproc.} = - result = 0 - for i in countup(0, len-1): - inc(result, countBits32(int32(ze(s[i])))) diff --git a/nimlib/system/sysio.nim b/nimlib/system/sysio.nim deleted file mode 100755 index 8b6d0e2856..0000000000 --- a/nimlib/system/sysio.nim +++ /dev/null @@ -1,184 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - - -## Nimrod's standard IO library. It contains high-performance -## routines for reading and writing data to (buffered) files or -## TTYs. - -{.push debugger:off .} # the user does not want to trace a part - # of the standard library! - - -proc fputs(c: cstring, f: TFile) {.importc: "fputs", noDecl.} -proc fgets(c: cstring, n: int, f: TFile): cstring {.importc: "fgets", noDecl.} -proc fgetc(stream: TFile): cint {.importc: "fgetc", nodecl.} -proc ungetc(c: cint, f: TFile) {.importc: "ungetc", nodecl.} -proc putc(c: Char, stream: TFile) {.importc: "putc", nodecl.} -proc fprintf(f: TFile, frmt: CString) {.importc: "fprintf", nodecl, varargs.} -proc strlen(c: cstring): int {.importc: "strlen", nodecl.} - -proc setvbuf(stream: TFile, buf: pointer, typ, size: cint): cint {. - importc, nodecl.} - -proc write(f: TFile, c: cstring) = fputs(c, f) - -var - IOFBF {.importc: "_IOFBF", nodecl.}: cint - IONBF {.importc: "_IONBF", nodecl.}: cint - -proc rawReadLine(f: TFile, result: var string) = - # of course this could be optimized a bit; but IO is slow anyway... - # and it was difficult to get this CORRECT with Ansi C's methods - setLen(result, 0) # reuse the buffer! - while True: - var c = fgetc(f) - if c < 0'i32: break # EOF - if c == 10'i32: break # LF - if c == 13'i32: # CR - c = fgetc(f) # is the next char LF? - if c != 10'i32: ungetc(c, f) # no, put the character back - break - add result, chr(int(c)) - -proc readLine(f: TFile): string = - result = "" - rawReadLine(f, result) - -proc write(f: TFile, s: string) = fputs(s, f) -proc write(f: TFile, i: int) = - when sizeof(int) == 8: - fprintf(f, "%lld", i) - else: - fprintf(f, "%ld", i) - -proc write(f: TFile, b: bool) = - if b: write(f, "true") - else: write(f, "false") -proc write(f: TFile, r: float) = fprintf(f, "%g", r) -proc write(f: TFile, c: Char) = putc(c, f) -proc write(f: TFile, a: openArray[string]) = - for x in items(a): write(f, x) - -#{.error: "for debugging.".} - -proc readFile(filename: string): string = - var f: TFile - try: - if open(f, filename): - var len = getFileSize(f) - if len < high(int): - result = newString(int(len)) - if readBuffer(f, addr(result[0]), int(len)) != len: - result = nil - close(f) - else: - result = nil - except EIO: - result = nil - -proc EndOfFile(f: TFile): bool = - # do not blame me; blame the ANSI C standard this is so brain-damaged - var c = fgetc(f) - ungetc(c, f) - return c == -1'i32 - -proc writeln[Ty](f: TFile, x: Ty) = - write(f, x) - write(f, "\n") - -proc writeln[Ty](f: TFile, x: openArray[Ty]) = - for i in items(x): write(f, i) - write(f, "\n") - -proc rawEcho(x: string) {.inline, compilerproc.} = write(stdout, x) -proc rawEchoNL() {.inline, compilerproc.} = write(stdout, "\n") - -# interface to the C procs: -proc fopen(filename, mode: CString): pointer {.importc: "fopen", noDecl.} - -const - FormatOpen: array [TFileMode, string] = ["rb", "wb", "w+b", "r+b", "ab"] - #"rt", "wt", "w+t", "r+t", "at" - # we always use binary here as for Nimrod the OS line ending - # should not be translated. - - -proc Open(f: var TFile, filename: string, - mode: TFileMode = fmRead, - bufSize: int = -1): Bool = - var - p: pointer - p = fopen(filename, FormatOpen[mode]) - result = (p != nil) - f = cast[TFile](p) - if bufSize > 0: - if setvbuf(f, nil, IOFBF, bufSize) != 0'i32: - raise newException(EOutOfMemory, "out of memory") - elif bufSize == 0: - discard setvbuf(f, nil, IONBF, 0) - -proc fdopen(filehandle: TFileHandle, mode: cstring): TFile {. - importc: pccHack & "fdopen", header: "".} - -proc open(f: var TFile, filehandle: TFileHandle, mode: TFileMode): bool = - f = fdopen(filehandle, FormatOpen[mode]) - result = f != nil - -proc OpenFile(f: var TFile, filename: string, - mode: TFileMode = fmRead, - bufSize: int = -1): Bool = - result = open(f, filename, mode, bufSize) - -proc openFile(f: var TFile, filehandle: TFileHandle, mode: TFileMode): bool = - result = open(f, filehandle, mode) - -# C routine that is used here: -proc fread(buf: Pointer, size, n: int, f: TFile): int {. - importc: "fread", noDecl.} -proc fseek(f: TFile, offset: clong, whence: int): int {. - importc: "fseek", noDecl.} -proc ftell(f: TFile): int {.importc: "ftell", noDecl.} - -proc fwrite(buf: Pointer, size, n: int, f: TFile): int {. - importc: "fwrite", noDecl.} - -proc readBuffer(f: TFile, buffer: pointer, len: int): int = - result = fread(buffer, 1, len, f) - -proc ReadBytes(f: TFile, a: var openarray[byte], start, len: int): int = - result = readBuffer(f, addr(a[start]), len) - -proc ReadChars(f: TFile, a: var openarray[char], start, len: int): int = - result = readBuffer(f, addr(a[start]), len) - -proc writeBytes(f: TFile, a: openarray[byte], start, len: int): int = - var x = cast[ptr array[0..1000_000_000, byte]](a) - result = writeBuffer(f, addr(x[start]), len) -proc writeChars(f: TFile, a: openarray[char], start, len: int): int = - var x = cast[ptr array[0..1000_000_000, byte]](a) - result = writeBuffer(f, addr(x[start]), len) -proc writeBuffer(f: TFile, buffer: pointer, len: int): int = - result = fwrite(buffer, 1, len, f) - -proc setFilePos(f: TFile, pos: int64) = - if fseek(f, clong(pos), 0) != 0: - raise newException(EIO, "cannot set file position") - -proc getFilePos(f: TFile): int64 = - result = ftell(f) - if result < 0: raise newException(EIO, "cannot retrieve file position") - -proc getFileSize(f: TFile): int64 = - var oldPos = getFilePos(f) - discard fseek(f, 0, 2) # seek the end of the file - result = getFilePos(f) - setFilePos(f, oldPos) - -{.pop.} diff --git a/nimlib/system/sysstr.nim b/nimlib/system/sysstr.nim deleted file mode 100755 index 20a49093b4..0000000000 --- a/nimlib/system/sysstr.nim +++ /dev/null @@ -1,289 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# string & sequence handling procedures needed by the code generator - -# strings are dynamically resized, have a length field -# and are zero-terminated, so they can be casted to C -# strings easily -# we don't use refcounts because that's a behaviour -# the programmer may not want - -# implementation: - -proc resize(old: int): int {.inline.} = - if old <= 0: return 4 - elif old < 65536: return old * 2 - else: return old * 3 div 2 # for large arrays * 3/2 is better - -proc cmpStrings(a, b: NimString): int {.inline, compilerProc.} = - if a == b: return 0 - if a == nil: return -1 - if b == nil: return 1 - return c_strcmp(a.data, b.data) - -proc eqStrings(a, b: NimString): bool {.inline, compilerProc.} = - if a == b: return true - if a == nil or b == nil: return false - return a.len == b.len and - c_memcmp(a.data, b.data, a.len * sizeof(char)) == 0'i32 - -proc rawNewString(space: int): NimString {.compilerProc.} = - var s = space - if s < 8: s = 7 - result = cast[NimString](newObj(addr(strDesc), sizeof(TGenericSeq) + - (s+1) * sizeof(char))) - result.space = s - -proc mnewString(len: int): NimString {.exportc.} = - #c_fprintf(c_stdout, "[NEWSTRING] len: %ld\n", len) - result = rawNewString(len) - result.len = len - -proc toNimStr(str: CString, len: int): NimString {.compilerProc.} = - result = rawNewString(len) - result.len = len - c_memcpy(result.data, str, (len+1) * sizeof(Char)) - result.data[len] = '\0' # readline relies on this! - -proc cstrToNimstr(str: CString): NimString {.compilerProc.} = - return toNimstr(str, c_strlen(str)) - -proc copyString(src: NimString): NimString {.compilerProc.} = - if src == nil: return nil - result = rawNewString(src.space) - result.len = src.len - c_memcpy(result.data, src.data, (src.len + 1) * sizeof(Char)) - -proc hashString(s: string): int {.compilerproc.} = - # the compiler needs exactly the same hash function! - # this used to be used for efficient generation of string case statements - var h = 0 - for i in 0..Len(s)-1: - h = h +% Ord(s[i]) - h = h +% h shl 10 - h = h xor (h shr 6) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - result = h - -proc copyStrLast(s: NimString, start, last: int): NimString {.exportc.} = - var start = max(start, 0) - var len = min(last, s.len-1) - start + 1 - if len > 0: - result = rawNewString(len) - result.len = len - c_memcpy(result.data, addr(s.data[start]), len * sizeof(Char)) - result.data[len] = '\0' - else: - result = mnewString(0) - -proc copyStr(s: NimString, start: int): NimString {.exportc.} = - return copyStrLast(s, start, s.len-1) - -proc addChar(s: NimString, c: char): NimString {.compilerProc.} = - result = s - if result.len >= result.space: - result.space = resize(result.space) - result = cast[NimString](growObj(result, - sizeof(TGenericSeq) + (result.space+1) * sizeof(char))) - #var space = resize(result.space) - #result = rawNewString(space) - #copyMem(result, s, s.len * sizeof(char) + sizeof(TGenericSeq)) - #result.space = space - result.data[result.len] = c - result.data[result.len+1] = '\0' - inc(result.len) - -# These routines should be used like following: -# -# s &= "Hello " & name & ", how do you feel?" -# -# -# { -# s = resizeString(s, 6 + name->len + 17); -# appendString(s, strLit1); -# appendString(s, strLit2); -# appendString(s, strLit3); -# } -# -# -# s = "Hello " & name & ", how do you feel?" -# -# -# { -# string tmp0; -# tmp0 = rawNewString(6 + name->len + 17); -# appendString(s, strLit1); -# appendString(s, strLit2); -# appendString(s, strLit3); -# s = tmp0; -# } -# -# -# s = "" -# -# -# s = rawNewString(0); - -proc resizeString(dest: NimString, addlen: int): NimString {.compilerproc.} = - if dest.len + addLen + 1 <= dest.space: # BUGFIX: this is horrible! - result = dest - else: # slow path: - var sp = max(resize(dest.space), dest.len + addLen + 1) - result = cast[NimString](growObj(dest, sizeof(TGenericSeq) + - (sp+1) * sizeof(Char))) - result.space = sp - #result = rawNewString(sp) - #copyMem(result, dest, dest.len * sizeof(char) + sizeof(TGenericSeq)) - # DO NOT UPDATE LEN YET: dest.len = newLen - -proc appendString(dest, src: NimString) {.compilerproc, inline.} = - c_memcpy(addr(dest.data[dest.len]), src.data, (src.len + 1) * sizeof(Char)) - inc(dest.len, src.len) - -proc appendChar(dest: NimString, c: char) {.compilerproc, inline.} = - dest.data[dest.len] = c - dest.data[dest.len+1] = '\0' - inc(dest.len) - -proc setLengthStr(s: NimString, newLen: int): NimString {.compilerProc.} = - var n = max(newLen, 0) - if n <= s.space: - result = s - else: - result = resizeString(s, n) - result.len = n - result.data[n] = '\0' - -# ----------------- sequences ---------------------------------------------- - -proc incrSeq(seq: PGenericSeq, elemSize: int): PGenericSeq {.compilerProc.} = - # increments the length by one: - # this is needed for supporting ``add``; - # - # add(seq, x) generates: - # seq = incrSeq(seq, sizeof(x)); - # seq[seq->len-1] = x; - when false: - # broken version: - result = seq - if result.len >= result.space: - var s = resize(result.space) - result = cast[PGenericSeq](newSeq(extGetCellType(seq), s)) - genericSeqAssign(result, seq, XXX) - #copyMem(result, seq, seq.len * elemSize + GenericSeqSize) - inc(result.len) - else: - result = seq - if result.len >= result.space: - result.space = resize(result.space) - result = cast[PGenericSeq](growObj(result, elemSize * result.space + - GenericSeqSize)) - # set new elements to zero: - #var s = cast[TAddress](result) - #zeroMem(cast[pointer](s + GenericSeqSize + (result.len * elemSize)), - # (result.space - result.len) * elemSize) - # for i in len .. space-1: - # seq->data[i] = 0 - inc(result.len) - -proc setLengthSeq(seq: PGenericSeq, elemSize, newLen: int): PGenericSeq {. - compilerProc.} = - when false: - # broken version: - result = seq - if result.space < newLen: - var s = max(resize(result.space), newLen) - result = cast[PGenericSeq](newSeq(extGetCellType(seq), s)) - result.len = newLen - else: - result = seq - if result.space < newLen: - result.space = max(resize(result.space), newLen) - result = cast[PGenericSeq](growObj(result, elemSize * result.space + - GenericSeqSize)) - elif newLen < result.len: - # we need to decref here, otherwise the GC leaks! - when not defined(boehmGC) and not defined(nogc): - for i in newLen..result.len-1: - forAllChildrenAux(cast[pointer](cast[TAddress](result) +% - GenericSeqSize +% (i*%elemSize)), - extGetCellType(result).base, waZctDecRef) - # and set the memory to nil: - zeroMem(cast[pointer](cast[TAddress](result) +% GenericSeqSize +% - (newLen*%elemSize)), (result.len-%newLen) *% elemSize) - result.len = newLen - -# --------------- other string routines ---------------------------------- -proc nimIntToStr(x: int): string {.compilerproc.} = - result = newString(sizeof(x)*4) - var i = 0 - var y = x - while True: - var d = y div 10 - result[i] = chr(abs(int(y - d*10)) + ord('0')) - inc(i) - y = d - if y == 0: break - if x < 0: - result[i] = '-' - inc(i) - setLen(result, i) - # mirror the string: - for j in 0..i div 2 - 1: - swap(result[j], result[i-j-1]) - -proc nimFloatToStr(x: float): string {.compilerproc.} = - var buf: array [0..59, char] - c_sprintf(buf, "%#g", x) - return $buf - -proc nimInt64ToStr(x: int64): string {.compilerproc.} = - # we don't rely on C's runtime here as some C compiler's - # int64 support is weak - result = newString(sizeof(x)*4) - var i = 0 - var y = x - while True: - var d = y div 10 - result[i] = chr(abs(int(y - d*10)) + ord('0')) - inc(i) - y = d - if y == 0: break - if x < 0: - result[i] = '-' - inc(i) - setLen(result, i) - # mirror the string: - for j in 0..i div 2 - 1: - swap(result[j], result[i-j-1]) - -proc nimBoolToStr(x: bool): string {.compilerproc.} = - return if x: "true" else: "false" - -proc nimCharToStr(x: char): string {.compilerproc.} = - result = newString(1) - result[0] = x - -proc binaryStrSearch(x: openarray[string], y: string): int {.compilerproc.} = - var - a = 0 - b = len(x) - while a < b: - var mid = (a + b) div 2 - if x[mid] < y: - a = mid + 1 - else: - b = mid - if (a < len(x)) and (x[a] == y): - return a - else: - return -1 diff --git a/nimlib/windows/winlean.nim b/nimlib/windows/winlean.nim deleted file mode 100755 index 40e6e7b119..0000000000 --- a/nimlib/windows/winlean.nim +++ /dev/null @@ -1,192 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2009 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements a small wrapper for some needed Win API procedures, -## so that the Nimrod compiler does not depend on the huge Windows module. - -type - THandle* = int - WINBOOL* = int32 - - TSECURITY_ATTRIBUTES* {.final, pure.} = object - nLength*: int32 - lpSecurityDescriptor*: pointer - bInheritHandle*: WINBOOL - - TSTARTUPINFO* {.final, pure.} = object - cb*: int32 - lpReserved*: cstring - lpDesktop*: cstring - lpTitle*: cstring - dwX*: int32 - dwY*: int32 - dwXSize*: int32 - dwYSize*: int32 - dwXCountChars*: int32 - dwYCountChars*: int32 - dwFillAttribute*: int32 - dwFlags*: int32 - wShowWindow*: int16 - cbReserved2*: int16 - lpReserved2*: pointer - hStdInput*: THANDLE - hStdOutput*: THANDLE - hStdError*: THANDLE - - TPROCESS_INFORMATION* {.final, pure.} = object - hProcess*: THANDLE - hThread*: THANDLE - dwProcessId*: int32 - dwThreadId*: int32 - -const - STARTF_USESHOWWINDOW* = 1'i32 - STARTF_USESTDHANDLES* = 256'i32 - HIGH_PRIORITY_CLASS* = 128'i32 - IDLE_PRIORITY_CLASS* = 64'i32 - NORMAL_PRIORITY_CLASS* = 32'i32 - REALTIME_PRIORITY_CLASS* = 256'i32 - WAIT_TIMEOUT* = 0x00000102'i32 - INFINITE* = -1'i32 - - STD_INPUT_HANDLE* = -10'i32 - STD_OUTPUT_HANDLE* = -11'i32 - STD_ERROR_HANDLE* = -12'i32 - - DETACHED_PROCESS* = 8'i32 - -proc CloseHandle*(hObject: THANDLE): WINBOOL {.stdcall, dynlib: "kernel32", - importc: "CloseHandle".} - -proc ReadFile*(hFile: THandle, Buffer: pointer, nNumberOfBytesToRead: int32, - lpNumberOfBytesRead: var int32, lpOverlapped: pointer): WINBOOL{. - stdcall, dynlib: "kernel32", importc: "ReadFile".} - -proc WriteFile*(hFile: THandle, Buffer: pointer, nNumberOfBytesToWrite: int32, - lpNumberOfBytesWritten: var int32, - lpOverlapped: pointer): WINBOOL{. - stdcall, dynlib: "kernel32", importc: "WriteFile".} - -proc CreatePipe*(hReadPipe, hWritePipe: var THandle, - lpPipeAttributes: var TSECURITY_ATTRIBUTES, - nSize: int32): WINBOOL{. - stdcall, dynlib: "kernel32", importc: "CreatePipe".} - -proc CreateProcess*(lpApplicationName, lpCommandLine: cstring, - lpProcessAttributes: ptr TSECURITY_ATTRIBUTES, - lpThreadAttributes: ptr TSECURITY_ATTRIBUTES, - bInheritHandles: WINBOOL, dwCreationFlags: int32, - lpEnvironment: pointer, lpCurrentDirectory: cstring, - lpStartupInfo: var TSTARTUPINFO, - lpProcessInformation: var TPROCESS_INFORMATION): WINBOOL{. - stdcall, dynlib: "kernel32", importc: "CreateProcessA".} - -proc SuspendThread*(hThread: THANDLE): int32 {.stdcall, dynlib: "kernel32", - importc: "SuspendThread".} -proc ResumeThread*(hThread: THANDLE): int32 {.stdcall, dynlib: "kernel32", - importc: "ResumeThread".} - -proc WaitForSingleObject*(hHandle: THANDLE, dwMilliseconds: int32): int32 {. - stdcall, dynlib: "kernel32", importc: "WaitForSingleObject".} - -proc TerminateProcess*(hProcess: THANDLE, uExitCode: int): WINBOOL {.stdcall, - dynlib: "kernel32", importc: "TerminateProcess".} - -proc GetExitCodeProcess*(hProcess: THANDLE, lpExitCode: var int32): WINBOOL {. - stdcall, dynlib: "kernel32", importc: "GetExitCodeProcess".} - -proc GetStdHandle*(nStdHandle: int32): THANDLE {.stdcall, dynlib: "kernel32", - importc: "GetStdHandle".} -proc SetStdHandle*(nStdHandle: int32, hHandle: THANDLE): WINBOOL {.stdcall, - dynlib: "kernel32", importc: "SetStdHandle".} -proc FlushFileBuffers*(hFile: THANDLE): WINBOOL {.stdcall, dynlib: "kernel32", - importc: "FlushFileBuffers".} - -proc GetLastError*(): int32 {.importc, stdcall, dynlib: "kernel32".} -proc FormatMessageA*(dwFlags: int32, lpSource: pointer, - dwMessageId, dwLanguageId: int32, - lpBuffer: pointer, nSize: int32, - Arguments: pointer): int32 {. - importc, stdcall, dynlib: "kernel32".} -proc LocalFree*(p: pointer) {.importc, stdcall, dynlib: "kernel32".} - -proc GetCurrentDirectoryA*(nBufferLength: int32, lpBuffer: cstring): int32 {. - importc, dynlib: "kernel32", stdcall.} -proc SetCurrentDirectoryA*(lpPathName: cstring): int32 {. - importc, dynlib: "kernel32", stdcall.} -proc CreateDirectoryA*(pathName: cstring, security: Pointer): int32 {. - importc: "CreateDirectoryA", dynlib: "kernel32", stdcall.} -proc RemoveDirectoryA*(lpPathName: cstring): int32 {. - importc, dynlib: "kernel32", stdcall.} -proc SetEnvironmentVariableA*(lpName, lpValue: cstring): int32 {. - stdcall, dynlib: "kernel32", importc.} - -proc GetModuleFileNameA*(handle: THandle, buf: CString, size: int32): int32 {. - importc, dynlib: "kernel32", stdcall.} - -const - FILE_ATTRIBUTE_ARCHIVE* = 32'i32 - FILE_ATTRIBUTE_COMPRESSED* = 2048'i32 - FILE_ATTRIBUTE_NORMAL* = 128'i32 - FILE_ATTRIBUTE_DIRECTORY* = 16'i32 - FILE_ATTRIBUTE_HIDDEN* = 2'i32 - FILE_ATTRIBUTE_READONLY* = 1'i32 - FILE_ATTRIBUTE_SYSTEM* = 4'i32 - - MAX_PATH* = 260 -type - FILETIME* {.final, pure.} = object ## CANNOT BE int64 BECAUSE OF ALIGNMENT - dwLowDateTime*: int32 - dwHighDateTime*: int32 - TWIN32_FIND_DATA* {.pure.} = object - dwFileAttributes*: int32 - ftCreationTime*: FILETIME - ftLastAccessTime*: FILETIME - ftLastWriteTime*: FILETIME - nFileSizeHigh*: int32 - nFileSizeLow*: int32 - dwReserved0: int32 - dwReserved1: int32 - cFileName*: array[0..(MAX_PATH) - 1, char] - cAlternateFileName*: array[0..13, char] -proc FindFirstFileA*(lpFileName: cstring, - lpFindFileData: var TWIN32_FIND_DATA): THANDLE {. - stdcall, dynlib: "kernel32", importc: "FindFirstFileA".} -proc FindNextFileA*(hFindFile: THANDLE, - lpFindFileData: var TWIN32_FIND_DATA): int32 {. - stdcall, dynlib: "kernel32", importc: "FindNextFileA".} -proc FindClose*(hFindFile: THANDLE) {.stdcall, dynlib: "kernel32", - importc: "FindClose".} - -proc GetFullPathNameA*(lpFileName: cstring, nBufferLength: int32, - lpBuffer: cstring, lpFilePart: var cstring): int32 {. - stdcall, dynlib: "kernel32", importc.} -proc GetFileAttributesA*(lpFileName: cstring): int32 {. - stdcall, dynlib: "kernel32", importc.} -proc SetFileAttributesA*(lpFileName: cstring, dwFileAttributes: int32): WINBOOL {. - stdcall, dynlib: "kernel32", importc: "SetFileAttributesA".} - -proc CopyFileA*(lpExistingFileName, lpNewFileName: CString, - bFailIfExists: cint): cint {. - importc, stdcall, dynlib: "kernel32".} - -proc GetEnvironmentStringsA*(): cstring {. - stdcall, dynlib: "kernel32", importc.} -proc FreeEnvironmentStringsA*(para1: cstring): int32 {. - stdcall, dynlib: "kernel32", importc.} - -proc GetCommandLineA*(): CString {.importc, stdcall, dynlib: "kernel32".} - -proc rdFileTime*(f: FILETIME): int64 = - result = ze64(f.dwLowDateTime) or (ze64(f.dwHighDateTime) shl 32) - -proc Sleep*(dwMilliseconds: int32){.stdcall, dynlib: "kernel32", - importc: "Sleep".} - - diff --git a/obj/empty.txt b/obj/empty.txt deleted file mode 100755 index 20f9a91e35..0000000000 --- a/obj/empty.txt +++ /dev/null @@ -1 +0,0 @@ -This file keeps several tools from deleting this subdirectory. diff --git a/rod/expandimportc.nim b/rod/expandimportc.nim deleted file mode 100755 index d4b2fee188..0000000000 --- a/rod/expandimportc.nim +++ /dev/null @@ -1,73 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2010 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Simple tool to expand ``importc`` pragmas. Used for the clean up process of -## the diverse wrappers. - -import - os, ropes, idents, ast, pnimsyn, rnimsyn, msgs, wordrecg, syntaxes, pegs - -proc modifyPragmas(n: PNode, name: string) = - if n == nil: return - for i in 0..len(n)-1: - var it = n[i] - if it.kind == nkIdent and whichKeyword(it.ident) == wImportc: - var x = newNode(nkExprColonExpr) - add(x, it) - add(x, newStrNode(nkStrLit, name)) - n.sons[i] = x - -proc getName(n: PNode): string = - case n.kind - of nkPostfix: result = getName(n[1]) - of nkPragmaExpr: result = getName(n[0]) - of nkSym: result = n.sym.name.s - of nkIdent: result = n.ident.s - of nkAccQuoted: result = getName(n[0]) - else: internalError(n.info, "getName()") - -proc processRoutine(n: PNode) = - var name = getName(n[namePos]) - modifyPragmas(n[pragmasPos], name) - -proc processIdent(ident, prefix: string, n: PNode): string = - var pattern = sequence(capture(?(termIgnoreCase"T" / termIgnoreCase"P")), - termIgnoreCase(prefix), ?term('_'), capture(*any())) - if ident =~ pattern: - result = matches[0] & matches[1] - else: - result = ident - -proc processTree(n: PNode, prefix: string) = - if n == nil: return - case n.kind - of nkEmpty..pred(nkIdent), succ(nkIdent)..nkNilLit: nil - of nkIdent: - if prefix.len > 0: n.ident = getIdent(processIdent(n.ident.s, prefix, n)) - of nkProcDef, nkConverterDef: - processRoutine(n) - for i in 0..sonsLen(n)-1: processTree(n[i], prefix) - else: - for i in 0..sonsLen(n)-1: processTree(n[i], prefix) - -proc main*(infile, outfile, prefix: string) = - var module = ParseFile(infile) - processTree(module, prefix) - renderModule(module, outfile) - -when isMainModule: - if paramcount() >= 1: - var infile = addFileExt(paramStr(1), "nim") - var outfile = changeFileExt(infile, "new.nim") - if paramCount() >= 2: - outfile = addFileExt(paramStr(2), "new.nim") - var prefix = if paramCount() >= 3: paramStr(3) else: "" - main(infile, outfile, prefix) - else: - echo "usage: expand_importc filename[.nim] outfilename[.nim] [prefix]" diff --git a/rod/hashtest.nim b/rod/hashtest.nim deleted file mode 100755 index c1b3ea0f42..0000000000 --- a/rod/hashtest.nim +++ /dev/null @@ -1,5 +0,0 @@ - -import - nhashes - -writeln(stdout, getNormalizedHash(ParamStr(1))) \ No newline at end of file diff --git a/rod/noprefix2.nim b/rod/noprefix2.nim deleted file mode 100755 index 6fbdaaddcf..0000000000 --- a/rod/noprefix2.nim +++ /dev/null @@ -1,15 +0,0 @@ -# strip those silly GTK/ATK prefixes... - -import - expandimportc, os - -const - filelist = [ - ("gtk/pango", "pango"), - ("gtk/pangoutils", "pango") - ] - -for filename, prefix in items(filelist): - var f = addFileExt(filename, "nim") - main("lib/newwrap" / f, "lib/newwrap" / filename & ".new.nim", prefix) - diff --git a/rod/tigen.nim b/rod/tigen.nim deleted file mode 100755 index ef13fe42b9..0000000000 --- a/rod/tigen.nim +++ /dev/null @@ -1,33 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Type information generator. It transforms types into the AST of walker -# procs. This is used by the code generators. - -import - ast, astalgo, strutils, nhashes, trees, treetab, platform, magicsys, options, - msgs, crc, idents, lists, types, rnimsyn - -proc gcWalker*(t: PType): PNode -proc initWalker*(t: PType): PNode -proc asgnWalker*(t: PType): PNode -proc reprWalker*(t: PType): PNode -# implementation - -proc gcWalker(t: PType): PNode = - nil - -proc initWalker(t: PType): PNode = - nil - -proc asgnWalker(t: PType): PNode = - nil - -proc reprWalker(t: PType): PNode = - nil diff --git a/rod/transtmp.nim b/rod/transtmp.nim deleted file mode 100755 index 44a462feaa..0000000000 --- a/rod/transtmp.nim +++ /dev/null @@ -1,111 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2008 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# -# This module implements a transformator. It transforms the syntax tree -# to ease the work of the code generators. Does the transformation to -# introduce temporaries to split up complex expressions. -# THIS MODULE IS NOT USED! - -proc transInto(c: PContext, dest: var PNode, father, src: PNode) - # transforms the expression `src` into the destination `dest`. Uses `father` - # for temorary statements. If dest = nil, the expression is put into a - # temporary. -proc transTmp(c: PContext, father, src: PNode): PNode = - # convienence proc - result = nil - transInto(c, result, father, src) - -proc newLabel(c: PContext): PSym = - inc(gTmpId) - result = newSym(skLabel, getIdent(genPrefix & $(gTmpId), c.transCon.owner)) - -proc fewCmps(s: PNode): bool = - # this function estimates whether it is better to emit code - # for constructing the set or generating a bunch of comparisons directly - assert(s.kind in {nkSetConstr, nkConstSetConstr}) - if (s.typ.size <= platform.intSize) and (s.kind == nkConstSetConstr): - result = false # it is better to emit the set generation code - elif skipRange(s.typ.sons[0]).Kind in {tyInt..tyInt64}: - result = true # better not emit the set if int is basetype! - else: - result = sonsLen(s) <= - 8 # 8 seems to be a good value - -proc transformIn(c: PContext, father, n: PNode): PNode = - var - a, b, e, setc: PNode - destLabel, label2: PSym - if (n.sons[1].kind == nkSetConstr) and fewCmps(n.sons[1]): - # a set constructor but not a constant set: - # do not emit the set, but generate a bunch of comparisons - result = newSymNode(newTemp(c, n.typ, n.info)) - e = transTmp(c, father, n.sons[2]) - setc = n.sons[1] - destLabel = newLabel(c) - for i in countup(0, sonsLen(setc) - 1): - if setc.sons[i].kind == nkRange: - a = transTmp(c, father, setc.sons[i].sons[0]) - b = transTmp(c, father, setc.sons[i].sons[1]) - label2 = newLabel(c) - addSon(father, newLt(result, e, a)) # e < a? --> goto end - addSon(father, newCondJmp(result, label2)) - addSon(father, newLe(result, e, b)) # e <= b? --> goto set end - addSon(father, newCondJmp(result, destLabel)) - addSon(father, newLabelNode(label2)) - else: - a = transTmp(c, father, setc.sons[i]) - addSon(father, newEq(result, e, a)) - addSon(father, newCondJmp(result, destLabel)) - addSon(father, newLabelNode(destLabel)) - else: - result = n - -proc transformOp2(c: PContext, dest: var PNode, father, n: PNode) = - var a, b: PNode - if dest == nil: dest = newSymNode(newTemp(c, n.typ, n.info)) - a = transTmp(c, father, n.sons[1]) - b = transTmp(c, father, n.sons[2]) - addSon(father, newAsgnStmt(dest, newOp2(n, a, b))) - -proc transformOp1(c: PContext, dest: var PNode, father, n: PNode) = - var a: PNode - if dest == nil: dest = newSymNode(newTemp(c, n.typ, n.info)) - a = transTmp(c, father, n.sons[1]) - addSon(father, newAsgnStmt(dest, newOp1(n, a))) - -proc genTypeInfo(c: PContext, initSection: PNode) = - nil - -proc genNew(c: PContext, father, n: PNode) = - # how do we handle compilerprocs? - -proc transformCase(c: PContext, father, n: PNode): PNode = - var - ty: PType - e: PNode - ty = skipGeneric(n.sons[0].typ) - if ty.kind == tyString: - # transform a string case to a bunch of comparisons: - result = newNodeI(nkIfStmt, n) - e = transTmp(c, father, n.sons[0]) - else: - result = n - -proc transInto(c: PContext, dest: var PNode, father, src: PNode) = - if src == nil: return - if (src.typ != nil) and (src.typ.kind == tyGenericInst): - src.typ = skipGeneric(src.typ) - case src.kind - of nkIdent..nkNilLit: - if dest == nil: - dest = copyTree(src) - else: - # generate assignment: - addSon(father, newAsgnStmt(dest, src)) - of nkCall, nkCommand, nkCallStrLit: - nil