PageRenderTime 73ms CodeModel.GetById 2ms app.highlight 63ms RepoModel.GetById 1ms app.codeStats 0ms

/src/tools/make-boot.r

https://github.com/WoodyLin/r3
R | 1195 lines | 972 code | 199 blank | 24 comment | 45 complexity | fc5aea562172d6d49d3baefc6238d689 MD5 | raw file
   1REBOL [
   2	System: "REBOL [R3] Language Interpreter and Run-time Environment"
   3	Title: "Make primary boot files"
   4	Rights: {
   5		Copyright 2012 REBOL Technologies
   6		REBOL is a trademark of REBOL Technologies
   7	}
   8	License: {
   9		Licensed under the Apache License, Version 2.0
  10		See: http://www.apache.org/licenses/LICENSE-2.0
  11	}
  12	Author: "Carl Sassenrath"
  13	Version: 2.100.0
  14	Needs: 2.100.100
  15	Purpose: {
  16		A lot of the REBOL system is built by REBOL, and this program
  17		does most of the serious work. It generates most of the C include
  18		files required to compile REBOL.
  19	}
  20]
  21
  22print "--- Make Boot : System Embedded Script ---"
  23
  24do %form-header.r
  25
  26; Set platform TARGET
  27do %systems.r
  28target: config-system/define ; default
  29
  30; Include graphics for these systems:
  31graphics-targets: [
  32	TO_WIN32
  33]
  34has-graphics: false ;not not find graphics-targets target
  35
  36opts: system/options/args
  37
  38if all [block? opts opts/1 = ">"] [opts: none] ; cw editor
  39
  40if block? opts [
  41	if find opts "no-gfx" [
  42		has-graphics: false
  43		opts: next opts
  44	]
  45	if not tail? opts [
  46		opts: load first opts
  47		unless tuple? opts [print "Invalid version arg." wait 2 quit]
  48		target: config-system/platform opts
  49	]
  50]
  51
  52write-if: func [file data] [
  53	if data <> attempt [read file][
  54		print ["UPDATE:" file]
  55		write file data
  56	]
  57]
  58
  59;-- SETUP --------------------------------------------------------------
  60
  61change-dir %../boot/
  62;dir: %../core/temp/  ; temporary definition
  63inc: %../include/
  64src: %../core/
  65
  66version: load %version.r
  67either tuple? opts [
  68	version/4: opts/2
  69	version/5: opts/3
  70][
  71	version/4: system/version/4
  72	version/5: system/version/5
  73]
  74
  75;-- Title string put into boot.h file checksum:
  76Title:
  77{REBOL
  78Copyright 2012 REBOL Technologies
  79REBOL is a trademark of REBOL Technologies
  80Licensed under the Apache License, Version 2.0
  81}
  82
  83sections: [
  84	boot-types
  85	boot-words
  86	boot-root
  87	boot-task
  88	boot-strings
  89	boot-booters
  90	boot-actions
  91	boot-natives
  92	boot-ops
  93	boot-typespecs
  94	boot-errors
  95	boot-sysobj
  96	boot-base
  97	boot-sys
  98	boot-mezz
  99	boot-protocols
 100;	boot-script
 101]
 102
 103include-protocols: false      ; include protocols in build
 104
 105system/options/args: [">"]
 106
 107;-- Error handler:
 108error: func [msg arg] [print ["*** Make-boot error:" msg arg] halt]
 109
 110;-- Args passed: platform, product
 111if none? args: system/options/args [error "No platform specified." ""]
 112if args/1 = ">" [args: ["Win32" "VIEW-PRO"]] ; for debugging only
 113platform: to-word args/1
 114product:  to-word args/2
 115
 116platform-data: context [type: 'windows]
 117build: context [features: [help-strings]]
 118
 119;-- Fetch platform specifications:
 120;init-build-objects/platform platform
 121;platform-data: platforms/:platform
 122;build: platform-data/builds/:product
 123
 124;-- UTILITIES ----------------------------------------------------------
 125
 126up-word: func [w] [
 127	w: uppercase form w
 128	foreach [f t] [
 129		#"-" #"_"
 130	][replace/all w f t]
 131	w
 132]
 133
 134;-- Emit Function
 135out: make string! 100000
 136emit: func [data] [repend out data]
 137
 138to-c-name: func [word] [
 139	word: form word
 140	foreach [f t] [
 141		#"-" #"_"
 142		#"." #"_"
 143		#"?" #"q"
 144		#"!" #"x"
 145		#"~" ""
 146		#"*" "_p"
 147		#"+" "_add"
 148		#"|" "or_bar"
 149	][replace/all word f t]
 150	word
 151]
 152
 153emit-enum: func [word] [emit [tab to-c-name word "," newline]]
 154
 155emit-line: func [prefix word cmt /var /define /code /decl /up1 /local str][
 156
 157	str: to-c-name word
 158
 159	if word = 0 [prefix: ""]
 160	
 161	if not any [code decl] [
 162		either var [uppercase/part str 1] [uppercase str]
 163	]
 164
 165	if up1 [uppercase/part str 1]
 166
 167	str: any [
 168		if define [rejoin [prefix str]]
 169		if code   [rejoin ["    " prefix str cmt]]
 170		if decl   [rejoin [prefix str cmt]]
 171		rejoin ["    " prefix str ","]
 172	]
 173	if any [code decl] [cmt: none]
 174	if cmt [
 175		len: 31 - length? str
 176		loop to-integer len / 4 [append str tab]
 177		any [
 178			if define [repend str cmt]
 179			if cmt [repend str ["// " cmt]]
 180		]
 181	]
 182	append str newline
 183	append out str
 184]
 185
 186emit-head: func [title [string!] file [file!]] [
 187	clear out
 188	emit form-header/gen title file %make-boot.r
 189]
 190
 191emit-end: func [/easy] [
 192	if not easy [remove find/last out #","]
 193	append out {^};^/}
 194]
 195
 196binary-to-c: either system/version/4 = 3 [
 197	; Windows format:
 198	func [comp-data /local out] [
 199		out: make string! 4 * (length? comp-data)
 200		forall comp-data [
 201			out: insert out reduce [to-integer first comp-data ", "]
 202			if zero? ((index? comp-data) // 10) [out: insert out "^/^-"]
 203		]
 204;		remove/part out either (pick out -1) = #" " [-2][-4]
 205		head out
 206	]
 207][
 208	; Other formats (Linux, OpenBSD, etc.):
 209	func [comp-data /local out] [
 210		out: make string! 4 * (length? comp-data)
 211		forall comp-data [
 212			data: copy/part comp-data 16
 213			comp-data: skip comp-data 15
 214			data: enbase/base data 16
 215			forall data [
 216				insert data "\x"
 217				data: skip data 3
 218			]
 219			data: tail data
 220			insert data {"^/}
 221			append out {"}
 222			append out head data
 223		]
 224		head out
 225	]
 226]
 227
 228remove-tests: func [d] [
 229	while [d: find d #test][remove/part d 2]
 230]
 231
 232;----------------------------------------------------------------------------
 233;
 234; Evaltypes.h - Evaluation Dispatch Maps
 235;
 236;----------------------------------------------------------------------------
 237
 238boot-types: load %types.r
 239type-record: [type evalclass typeclass moldtype formtype haspath maker typesets]
 240
 241emit-head "Evaluation Maps" %evaltypes.h
 242emit {
 243/***********************************************************************
 244**
 245*/	const REBINT Eval_Type_Map[REB_MAX] =
 246/*
 247**		Specifies the evaluation method used for each datatype.
 248**
 249***********************************************************************/
 250^{
 251}
 252
 253foreach :type-record boot-types [
 254	emit-line "ET_" evalclass type
 255]
 256emit-end
 257
 258emit {
 259/***********************************************************************
 260**
 261*/	const REBDOF Func_Dispatch[] =
 262/*
 263**		The function evaluation dispatchers.
 264**
 265***********************************************************************/
 266^{
 267}
 268
 269foreach :type-record boot-types [
 270	if find [function operator] evalclass [
 271		emit-line/var "Do_" type none
 272	]
 273]
 274emit-end
 275
 276emit {
 277/***********************************************************************
 278**
 279*/	const REBACT Value_Dispatch[REB_MAX] =
 280/*
 281**		The ACTION dispatch function for each datatype.
 282**
 283***********************************************************************/
 284^{
 285}
 286
 287foreach :type-record boot-types [
 288	emit-line/var "T_" typeclass type
 289]
 290emit-end
 291
 292emit {
 293/***********************************************************************
 294**
 295*/	const REBPEF Path_Dispatch[REB_MAX] =
 296/*
 297**		The path evaluator function for each datatype.
 298**
 299***********************************************************************/
 300^{
 301}
 302
 303foreach :type-record boot-types [
 304	emit-line/var "PD_" switch/default haspath [
 305		* [typeclass]
 306		- [0]
 307	][haspath] type
 308]
 309emit-end
 310
 311write inc/tmp-evaltypes.h out
 312
 313
 314;----------------------------------------------------------------------------
 315;
 316; Maketypes.h - Dispatchers for Make (used by construct)
 317;
 318;----------------------------------------------------------------------------
 319
 320emit-head "Datatype Makers" %maketypes.h
 321emit newline
 322
 323types-used: []
 324
 325foreach :type-record boot-types [
 326	if all [
 327		maker = '*
 328		word? typeclass
 329		not find types-used typeclass
 330	][
 331		emit-line/up1/decl "extern REBFLG MT_" typeclass "(REBVAL *, REBVAL *, REBCNT);"
 332		append types-used typeclass
 333	]
 334]
 335
 336emit {
 337
 338/***********************************************************************
 339**
 340*/	const MAKE_FUNC Make_Dispatch[REB_MAX] =
 341/*
 342**		Specifies the make method used for each datatype.
 343**
 344***********************************************************************/
 345^{
 346}
 347
 348foreach :type-record boot-types [
 349 	either maker = '* [
 350		emit-line/var "MT_" typeclass type
 351	][
 352		emit-line "" "0"  type
 353	]
 354]
 355
 356emit-end
 357
 358write inc/tmp-maketypes.h out
 359
 360;----------------------------------------------------------------------------
 361;
 362; Comptypes.h - compare functions
 363;
 364;----------------------------------------------------------------------------
 365
 366emit-head "Datatype Comparison Functions" %comptypes.h
 367emit newline
 368
 369types-used: []
 370
 371foreach :type-record boot-types [
 372	if all [
 373		word? typeclass
 374		not find types-used typeclass
 375	][
 376		emit-line/up1/decl "extern REBINT CT_" typeclass "(REBVAL *, REBVAL *, REBINT);"
 377		append types-used typeclass
 378	]
 379]
 380
 381emit {
 382/***********************************************************************
 383**
 384*/	const REBCTF Compare_Types[REB_MAX] =
 385/*
 386**		Type comparision functions.
 387**
 388***********************************************************************/
 389^{
 390}
 391
 392foreach :type-record boot-types [
 393	emit-line/var "CT_" typeclass type
 394]
 395emit-end
 396
 397write inc/tmp-comptypes.h out
 398
 399
 400;----------------------------------------------------------------------------
 401;
 402; Moldtypes.h - Dispatchers for Mold and Form
 403;
 404;----------------------------------------------------------------------------
 405
 406;emit-head "Mold Dispatchers"
 407;
 408;emit {
 409;/***********************************************************************
 410;**
 411;*/	const MOLD_FUNC Mold_Dispatch[REB_MAX] =
 412;/*
 413;**		The MOLD dispatch function for each datatype.
 414;**
 415;***********************************************************************/
 416;^{
 417;}
 418;
 419;foreach :type-record boot-types [
 420;	f: "Mold_"
 421;	switch/default moldtype [
 422;		* [t: typeclass]
 423;		+ [t: type]
 424;		- [t: 0]
 425;	][t: uppercase/part form moldtype 1]
 426;	emit [tab "case " uppercase join "REB_" type ":" tab "\\" t]
 427;	emit newline
 428;	;emit-line/var f t type
 429;]
 430;emit-end
 431;
 432;emit {
 433;/***********************************************************************
 434;**
 435;*/	const MOLD_FUNC Form_Dispatch[REB_MAX] =
 436;/*
 437;**		The FORM dispatch function for each datatype.
 438;**
 439;***********************************************************************/
 440;^{
 441;}
 442;foreach :type-record boot-types [
 443;	f: "Mold_"
 444;	switch/default formtype [
 445;		*  [t: typeclass]
 446;		f* [t: typeclass f: "Form_"]
 447;		+  [t: type]
 448;		f+ [t: type f: "Form_"]
 449;		-  [t: 0]
 450;	][t: uppercase/part form moldtype 1]
 451;	emit [tab "case " uppercase join "REB_" type ":" tab "\\" t]
 452;	emit newline
 453;	;emit-line/var f t type
 454;]
 455;emit-end
 456;
 457;write inc/tmp-moldtypes.h out
 458
 459;----------------------------------------------------------------------------
 460;
 461; Bootdefs.h - Boot include file
 462;
 463;----------------------------------------------------------------------------
 464
 465emit-head "Datatype Definitions" %reb-types.h
 466
 467emit [
 468{
 469/***********************************************************************
 470**
 471*/	enum REBOL_Types
 472/*
 473**		Internal datatype numbers. These change. Do not export.
 474**
 475***********************************************************************/
 476^{
 477}
 478]
 479
 480datatypes: []
 481n: 0
 482foreach :type-record boot-types [
 483	append datatypes type
 484	emit-line "REB_" type n
 485	n: n + 1
 486]
 487emit {    REB_MAX
 488^};
 489}
 490
 491emit {
 492/***********************************************************************
 493**
 494**	REBOL Type Check Macros
 495**
 496***********************************************************************/
 497}
 498
 499new-types: []
 500foreach :type-record boot-types [
 501	append new-types to-word join type "!"
 502	str: uppercase form type
 503	replace/all str #"-" #"_"
 504	def: join {#define IS_} [str "(v)"]
 505	len: 31 - length? def
 506	loop to-integer len / 4 [append def tab]
 507	emit [def "(VAL_TYPE(v)==REB_" str ")" newline]
 508]
 509
 510emit {
 511/***********************************************************************
 512**
 513**	REBOL Typeset Defines
 514**
 515***********************************************************************/
 516}
 517
 518typeset-sets: []
 519
 520foreach :type-record boot-types [
 521	typesets: compose [(typesets)]
 522	foreach ts typesets [
 523		spot: any [
 524			select typeset-sets ts
 525			first back insert tail typeset-sets reduce [ts copy []]
 526		]
 527		append spot type
 528	]
 529]
 530remove/part typeset-sets 2 ; the - markers
 531
 532foreach [ts types] typeset-sets [
 533	emit ["#define TS_" up-word ts " ("]
 534	foreach t types [
 535		emit ["((REBU64)1<<REB_" up-word t ")|"]
 536	]
 537	append remove back tail out ")^/"
 538]
 539
 540write-if inc/reb-types.h out
 541
 542;----------------------------------------------------------------------------
 543;
 544; Extension Related Tables
 545;
 546;----------------------------------------------------------------------------
 547
 548ext-types: load %types-ext.r
 549rxt-record: [type offset size]
 550
 551; Generate type table with necessary gaps
 552rxt-types: []
 553n: 0
 554foreach :rxt-record ext-types [
 555	if integer? offset [
 556		insert/dup tail rxt-types 0 offset - n
 557		n: offset
 558	]
 559	append rxt-types type
 560	n: n + 1
 561]
 562
 563
 564emit-head "Extension Types (Isolators)" %ext-types.h
 565
 566emit [
 567{
 568enum REBOL_Ext_Types
 569^{
 570}
 571]
 572n: 0
 573foreach :rxt-record ext-types [
 574	either integer? offset [
 575		emit-line "RXT_" rejoin [type " = " offset] n
 576	][
 577		emit-line "RXT_" type n
 578	]
 579	n: n + 1
 580]
 581emit {    RXT_MAX
 582^};
 583}
 584
 585write inc/ext-types.h out ; part of Host-Kit distro
 586
 587emit-head "Extension Type Equates" %tmp-exttypes.h
 588emit {
 589/***********************************************************************
 590**
 591*/	const REBYTE Reb_To_RXT[REB_MAX] =
 592/*
 593***********************************************************************/
 594^{
 595}
 596
 597foreach :type-record boot-types [
 598	either find ext-types type [
 599		emit-line "RXT_" type type
 600	][
 601		emit-line "" 0 type
 602	]
 603]
 604emit-end
 605
 606emit {
 607/***********************************************************************
 608**
 609*/	const REBYTE RXT_To_Reb[RXT_MAX] =
 610/*
 611***********************************************************************/
 612^{
 613}
 614
 615n: 0
 616foreach type rxt-types [
 617	either word? type [emit-line "REB_" type n][
 618		emit-line "" 0 n
 619	]
 620	n: n + 1
 621]
 622emit-end
 623
 624emit {
 625/***********************************************************************
 626**
 627*/	const REBCNT RXT_Eval_Class[RXT_MAX] =
 628/*
 629***********************************************************************/
 630^{
 631}
 632
 633n: 0
 634foreach type rxt-types [
 635	either all [
 636		word? type
 637		rec: find ext-types type
 638	][
 639		emit-line "RXE_" rec/3 rec/1
 640	][
 641		emit-line "" 0 n
 642	]
 643	n: n + 1
 644]
 645emit-end
 646
 647emit {
 648#define RXT_ALLOWED_TYPES (}
 649foreach type next rxt-types [
 650	if word? type [
 651		emit replace join "((u64)" uppercase rejoin ["1<<REB_" type ") \^/"] #"-" #"_"
 652		emit "|"
 653	]
 654]
 655remove back tail out
 656emit ")^/"
 657
 658write inc/tmp-exttypes.h out
 659
 660
 661;----------------------------------------------------------------------------
 662;
 663; Bootdefs.h - Boot include file
 664;
 665;----------------------------------------------------------------------------
 666
 667emit-head "Boot Definitions" %bootdefs.h
 668
 669emit [
 670{
 671#define REBOL_VER } version/1 {
 672#define REBOL_REV } version/2 {
 673#define REBOL_UPD } version/3 {
 674#define REBOL_SYS } version/4 {
 675#define REBOL_VAR } version/5 {
 676}
 677]
 678
 679;-- Generate Lower-Level String Table ----------------------------------------
 680
 681emit {
 682/***********************************************************************
 683**
 684**	REBOL Boot Strings
 685**
 686**		These are special strings required during boot and other
 687**		operations. Putting them here hides them from exe hackers.
 688**		These are all string offsets within a single string.
 689**
 690***********************************************************************/
 691}
 692
 693boot-strings: load %strings.r
 694
 695code: ""
 696n: 0
 697foreach str boot-strings [
 698	either set-word? :str [
 699		emit-line/define "#define RS_" to word! str n ;R3
 700	][
 701		n: n + 1
 702		append code str
 703		append code null
 704	]
 705]
 706
 707emit ["#define RS_MAX" tab n lf]
 708emit ["#define RS_SIZE" tab length? out lf]
 709boot-strings: to-binary code
 710
 711;-- Generate Canonical Words (must follow datatypes above!) ------------------
 712
 713emit {
 714/***********************************************************************
 715**
 716*/	enum REBOL_Symbols
 717/*
 718**		REBOL static canonical words (symbols) used with the code.
 719**
 720***********************************************************************/
 721^{
 722	SYM_NOT_USED = 0,
 723}
 724
 725n: 1
 726foreach :type-record boot-types [
 727	emit-line "SYM_" join type "_type" n
 728	n: n + 1
 729]
 730
 731boot-words: load %words.r
 732
 733replace boot-words '*port-modes* load %modes.r
 734
 735foreach word boot-words [
 736	emit-line "SYM_" word reform [n "-" word]
 737	n: n + 1
 738]
 739emit-end
 740
 741;-- Generate Action Constants ------------------------------------------------
 742
 743emit {
 744/***********************************************************************
 745**
 746*/	enum REBOL_Actions
 747/*
 748**		REBOL datatype action numbers.
 749**
 750***********************************************************************/
 751^{
 752}
 753
 754boot-actions: load %actions.r
 755n: 1
 756emit-line "A_" "type = 0" "Handled by interpreter"
 757foreach word boot-actions [
 758	if set-word? :word [
 759		emit-line "A_" to word! :word n ;R3
 760		n: n + 1
 761	]
 762]
 763emit [tab "A_MAX_ACTION" lf "};"]
 764emit {
 765
 766#define IS_BINARY_ACT(a) ((a) <= A_XOR)
 767}
 768print [n "actions"]
 769
 770write inc/tmp-bootdefs.h out
 771
 772;----------------------------------------------------------------------------
 773;
 774; Sysobj.h - System Object Selectors
 775;
 776;----------------------------------------------------------------------------
 777
 778emit-head "System Object" %sysobj.h
 779emit newline
 780
 781at-value: func ['field] [next find boot-sysobj to-set-word field]
 782
 783boot-sysobj: load %sysobj.r
 784change at-value version version
 785when: now
 786when: when - when/zone
 787when/zone: 0:00
 788change at-value build when
 789
 790plats: load %platforms.r
 791change/only at-value platform reduce [pick plats version/4 * 2 - 1 pick pick plats version/4 * 2 version/5]
 792
 793ob: context boot-sysobj
 794
 795make-obj-defs: func [obj prefix depth /local f] [
 796	uppercase prefix
 797	emit ["enum " prefix "object {" newline]
 798	emit-line prefix "SELF = 0" none
 799	foreach field words-of obj [ ;R3
 800		emit-line prefix field none
 801	]
 802	emit [tab uppercase join prefix "MAX^/"]
 803	emit "};^/^/"
 804
 805	if depth > 1 [
 806		foreach field words-of obj [ ;R3
 807			f: join prefix [field #"_"]
 808			replace/all f "-" "_"
 809			all [
 810				field <> 'standard
 811				object? get in obj field
 812				make-obj-defs obj/:field f depth - 1
 813			]
 814		]
 815	]
 816]
 817
 818make-obj-defs ob "SYS_" 1
 819make-obj-defs ob/catalog "CAT_" 4
 820make-obj-defs ob/contexts "CTX_" 4
 821make-obj-defs ob/standard "STD_" 4
 822make-obj-defs ob/state "STATE_" 4
 823;make-obj-defs ob/network "NET_" 4
 824make-obj-defs ob/ports "PORTS_" 4
 825make-obj-defs ob/options "OPTIONS_" 4
 826;make-obj-defs ob/intrinsic "INTRINSIC_" 4
 827make-obj-defs ob/locale "LOCALE_" 4
 828make-obj-defs ob/view "VIEW_" 4
 829
 830write inc/tmp-sysobj.h out
 831
 832;----------------------------------------------------------------------------
 833
 834emit-head "Dialects" %reb-dialect.h
 835emit {
 836enum REBOL_dialect_error {
 837	REB_DIALECT_END = 0,	// End of dialect block
 838	REB_DIALECT_MISSING,	// Requested dialect is missing or not valid
 839	REB_DIALECT_NO_CMD,		// Command needed before the arguments
 840	REB_DIALECT_BAD_SPEC,	// Dialect spec is not valid
 841	REB_DIALECT_BAD_ARG,	// The argument type does not match the dialect
 842	REB_DIALECT_EXTRA_ARG	// There are more args than the command needs
 843};
 844
 845}
 846make-obj-defs ob/dialects "DIALECTS_" 4
 847
 848emit {#define DIALECT_LIT_CMD 0x1000
 849}
 850
 851write inc/reb-dialect.h out
 852
 853
 854;----------------------------------------------------------------------------
 855;
 856; Event Types
 857;
 858;----------------------------------------------------------------------------
 859
 860emit-head "Event Types" %reb-evtypes.h
 861emit newline
 862
 863emit ["enum event_types {" newline]
 864foreach field ob/view/event-types [
 865	emit-line "EVT_" field none
 866]
 867emit [tab "EVT_MAX^/"]
 868emit "};^/^/"
 869
 870emit ["enum event_keys {" newline]
 871emit-line "EVK_" "NONE" none
 872foreach field ob/view/event-keys [
 873	emit-line "EVK_" field none
 874]
 875emit [tab "EVK_MAX^/"]
 876emit "};^/^/"
 877
 878write inc/reb-evtypes.h out
 879
 880
 881;----------------------------------------------------------------------------
 882;
 883; Error Constants
 884;
 885;----------------------------------------------------------------------------
 886
 887;-- Error Structure ----------------------------------------------------------
 888
 889emit-head "Error Structure and Constants" %errnums.h
 890
 891emit {
 892#ifdef VAL_TYPE
 893/***********************************************************************
 894**
 895*/	typedef struct REBOL_Error_Obj
 896/*
 897***********************************************************************/
 898^{
 899}
 900; Generate ERROR object and append it to bootdefs.h:
 901emit-line/code "REBVAL " 'self ";" ;R3
 902foreach word words-of ob/standard/error [ ;R3
 903	if word = 'near [word: 'nearest] ; prevents C problem
 904	emit-line/code "REBVAL " word ";"
 905]
 906emit {^} ERROR_OBJ;
 907#endif
 908}
 909
 910emit {
 911/***********************************************************************
 912**
 913*/	enum REBOL_Errors
 914/*
 915***********************************************************************/
 916^{
 917}
 918
 919boot-errors: load %errors.r
 920err-list: make block! 200
 921errs: false
 922
 923foreach [cat msgs] boot-errors [
 924	code: second msgs
 925	new1: true
 926	foreach [word val] skip msgs 4 [
 927		err: uppercase form to word! word ;R3
 928		replace/all err "-" "_"
 929		if find err-list err [print ["DUPLICATE Error Constant:" err] errs: true]
 930		append err-list err
 931		either new1 [
 932			emit-line "RE_" reform [err "=" code] reform [code mold val]
 933			new1: false
 934		][
 935			emit-line "RE_" err reform [code mold val]
 936		]
 937		code: code + 1
 938	]
 939	emit-line "RE_" join to word! cat "_max" none ;R3
 940	emit newline
 941]
 942if errs [wait 3 quit]
 943emit-end
 944
 945emit {
 946#define RE_NOTE RE_NO_LOAD
 947#define RE_USER RE_MESSAGE
 948}
 949
 950write inc/tmp-errnums.h out
 951
 952;-------------------------------------------------------------------------
 953
 954emit-head "Port Modes" %port-modes.h
 955
 956data: load %modes.r
 957
 958emit {
 959enum port_modes ^{
 960}
 961
 962foreach word data [
 963	emit-enum word
 964]
 965emit-end
 966
 967write inc/tmp-portmodes.h out
 968
 969;----------------------------------------------------------------------------
 970;
 971; Load Boot Mezzanine Functions - Base, Sys, and Plus
 972;
 973;----------------------------------------------------------------------------
 974
 975;-- Add other MEZZ functions:
 976mezz-files: load %../mezz/boot-files.r ; base lib, sys, mezz
 977
 978;append boot-mezz+ none ?? why was this needed?
 979
 980foreach section [boot-base boot-sys boot-mezz] [
 981	set section make block! 200
 982	foreach file first mezz-files [
 983		append get section load join %../mezz/ file
 984	]
 985	remove-tests get section
 986	mezz-files: next mezz-files
 987]
 988
 989boot-protocols: make block! 20
 990foreach file first mezz-files [
 991	m: load/all join %../mezz/ file ; not REBOL word
 992	append/only append/only boot-protocols m/2 skip m 2
 993]
 994
 995emit-head "Sys Context" %sysctx.h
 996sctx: construct boot-sys
 997make-obj-defs sctx "SYS_CTX_" 1
 998write inc/tmp-sysctx.h out
 999
1000
1001;----------------------------------------------------------------------------
1002;
1003; b-boot.c - Boot data file
1004;
1005;----------------------------------------------------------------------------
1006
1007;-- Build b-boot.c output file -------------------------------------------------
1008
1009
1010emit-head "Natives and Bootstrap" %b-boot.c
1011emit {
1012#include "sys-core.h"
1013
1014}
1015
1016externs: make string! 2000
1017boot-booters: load %booters.r
1018boot-natives: load %natives.r
1019
1020if has-graphics [append boot-natives load %graphics.r]
1021
1022nats: append copy boot-booters boot-natives
1023
1024n: boot-sys
1025;while [n: find n 'native] [
1026;	if set-word? first back n [
1027;		print index? n
1028;		append nats copy/part back n 3
1029;	]
1030;	n: next next n
1031;]
1032
1033nat-count: 0
1034
1035foreach val nats [
1036	if set-word? val [
1037		emit-line/decl "REBNATIVE(" to word! val ");" ;R3
1038		nat-count: nat-count + 1
1039	]
1040]
1041
1042print [nat-count "natives"]
1043
1044emit [newline {const REBFUN Native_Funcs[} nat-count {] = ^{
1045}]
1046foreach val nats [
1047	if set-word? val [
1048		emit-line/code "N_" to word! val "," ;R3
1049	]
1050	;nat-count: nat-count + 1
1051]
1052emit-end
1053emit newline
1054
1055;-- Embedded REBOL Tests:
1056;where: find boot/script 'tests
1057;if where [
1058;	remove where
1059;	foreach file sort load %../tests/ [
1060;		test: load join %../tests/ file
1061;		if test/1 <> 'skip-test [
1062;			where: insert where test
1063;		]
1064;	]
1065;]
1066
1067;-- Build typespecs block (in same order as datatypes table):
1068boot-typespecs: make block! 100
1069specs: load %typespec.r
1070foreach type datatypes [
1071	append/only boot-typespecs select specs type
1072]
1073
1074;-- Create main code section (compressed):
1075boot-types: new-types
1076boot-root: load %root.r
1077boot-task: load %task.r
1078boot-ops: load %ops.r
1079;boot-script: load %script.r
1080
1081write %boot-code.r mold reduce sections
1082data: mold/flat reduce sections
1083insert data reduce ["; Copyright (C) REBOL Technologies " now newline]
1084insert tail data make char! 0 ; scanner requires zero termination
1085
1086comp-data: compress data: to-binary data ;R3
1087;append comp-data "ABCD"
1088
1089encloak/with comp-data thekey: checksum/secure to binary! "REBOL Version 3.0" ;R3
1090
1091;cc: decompress decloak/with comp-data thekey print ["decompressed?" cc = data] halt
1092
1093emit ["const REBYTE Native_Specs[" length? comp-data "] = {^/^-"]
1094
1095;-- Convert to C-encoded string:
1096emit binary-to-c comp-data
1097emit-end/easy
1098
1099write src/b-boot.c out
1100
1101;-- Output stats:
1102print [
1103	"Compressed" length? data "to" length? comp-data "bytes:"
1104	to-integer ((length? comp-data) / (length? data) * 100)
1105	"percent of original"
1106]
1107
1108;-- Create platform string:
1109;platform: to-string platform
1110;lowercase platform
1111;if platform-data/type = 'windows [ ; Why?? Not sure.
1112;	product: to-string product
1113;	lowercase product
1114;	replace/all product "-" ""
1115;]
1116;;dir: to-file rejoin [%../to- platform "/" product "/temp/"]
1117
1118;----------------------------------------------------------------------------
1119;
1120; Boot.h - Boot header file
1121;
1122;----------------------------------------------------------------------------
1123
1124emit-head "Bootstrap Structure and Root Module" %boot.h
1125
1126emit [
1127{
1128#define MAX_NATS      } nat-count {
1129#define NAT_SPEC_SIZE } length? comp-data {
1130#define CHECK_TITLE   } checksum to binary! title {
1131
1132extern const REBYTE Native_Specs[];
1133extern const REBFUN Native_Funcs[];
1134
1135typedef struct REBOL_Boot_Block ^{
1136}
1137]
1138
1139foreach word sections [
1140	word: form word
1141	remove/part word 5 ; boot_
1142	emit-line/code "REBVAL " word ";"
1143]
1144emit "} BOOT_BLK;"
1145
1146;-------------------
1147
1148emit [
1149{
1150
1151//**** ROOT Context (Root Module):
1152
1153typedef struct REBOL_Root_Context ^{
1154}
1155]
1156
1157foreach word boot-root [
1158	emit-line/code "REBVAL " word ";"
1159]
1160emit ["} ROOT_CTX;" lf lf]
1161
1162n: 0
1163foreach word boot-root [
1164	emit-line/define "#define ROOT_" word join "(&Root_Context->" [lowercase replace/all form word #"-" #"_" ")"]
1165	n: n + 1
1166]
1167emit ["#define ROOT_MAX " n lf]
1168
1169;-------------------
1170
1171emit [
1172{
1173
1174//**** Task Context
1175
1176typedef struct REBOL_Task_Context ^{
1177}
1178]
1179
1180foreach word boot-task [
1181	emit-line/code "REBVAL " word ";"
1182]
1183emit ["} TASK_CTX;" lf lf]
1184
1185n: 0
1186foreach word boot-task [
1187	emit-line/define "#define TASK_" word join "(&Task_Context->" [lowercase replace/all form word #"-" #"_" ")"]
1188	n: n + 1
1189]
1190emit ["#define TASK_MAX " n lf]
1191
1192write inc/tmp-boot.h out
1193;print ask "-DONE-"
1194;wait .3
1195print "   "