-
+ 37B242324EBF0BAB3BC67812F23111C84D70420348F47F1CB617856E9F18A5E11A30D2CD0CEBB802BC435588BFC49AF3A50D8EB24674A795B83102809C52D3AEbitcoin/src/shiva/hack.txt(0 . 0)(1 . 244)
519
520 How to hack TinyScheme
521 ----------------------
522
523 TinyScheme is easy to learn and modify. It is structured like a
524 meta-interpreter, only it is written in C. All data are Scheme
525 objects, which facilitates both understanding/modifying the
526 code and reifying the interpreter workings.
527
528 In place of a dry description, we will pace through the addition
529 of a useful new datatype: garbage-collected memory blocks.
530 The interface will be:
531
532 (make-block <n> [<fill>]) makes a new block of the specified size
533 optionally filling it with a specified byte
534 (block? <obj>)
535 (block-length <block>)
536 (block-ref <block> <index>) retrieves byte at location
537 (block-set! <block> <index> <byte>) modifies byte at location
538
539 In the sequel, lines that begin with '>' denote lines to add to the
540 code. Lines that begin with '|' are just citations of existing code.
541 Lines that begin with X denote lines to be removed from the code.
542
543 First of all, we need to assign a typeid to our new type. Typeids
544 in TinyScheme are small integers declared in the scheme_types enum
545 located near the top of the scheme.c file; it begins with T_STRING.
546 Add a new entry at the end, say T_MEMBLOCK. Remember to adjust the
547 value of T_LAST_SYTEM_TYPE when adding new entries. There can be at
548 most 31 types, but you don't have to worry about that limit yet.
549
550 | T_ENVIRONMENT=14,
551 X T_LAST_SYSTEM_TYPE=14
552 > T_MEMBLOCK=15,
553 > T_LAST_SYSTEM_TYPE=15
554 | };
555
556
557 Then, some helper macros would be useful. Go to where is_string()
558 and the rest are defined and add:
559
560 > INTERFACE INLINE int is_memblock(pointer p) { return (type(p)==T_MEMBLOCK); }
561
562 This actually is a function, because it is meant to be exported by
563 scheme.h. If no foreign function will ever manipulate a memory block,
564 you can instead define it as a macro:
565
566 > #define is_memblock(p) (type(p)==T_MEMBLOCK)
567
568 Then we make space for the new type in the main data structure:
569 struct cell. As it happens, the _string part of the union _object
570 (that is used to hold character strings) has two fields that suit us:
571
572 | struct {
573 | char *_svalue;
574 | int _keynum;
575 | } _string;
576
577 We can use _svalue to hold the actual pointer and _keynum to hold its
578 length. If we couln't reuse existing fields, we could always add other
579 alternatives in union _object.
580
581 We then proceed to write the function that actually makes a new block.
582 For conformance reasons, we name it mk_memblock
583
584 > static pointer mk_memblock(scheme *sc, int len, char fill) {
585 > pointer x;
586 > char *p=(char*)sc->malloc(len);
587 >
588 > if(p==0) {
589 > return sc->NIL;
590 > }
591 > x = get_cell(sc, sc->NIL, sc->NIL);
592 >
593 > typeflag(x) = T_MEMBLOCK|T_ATOM;
594 > strvalue(x)=p;
595 > keynum(x)=len;
596 > memset(p,fill,len);
597 > return (x);
598 > }
599
600 The memory used by the MEMBLOCK will have to be freed when the cell
601 is reclaimed during garbage collection. There is a placeholder for
602 that staff, function finalize_cell(), currently handling strings only.
603
604 | static void finalize_cell(scheme *sc, pointer a) {
605 | if(is_string(a)) {
606 | sc->free(strvalue(a));
607 > } else if(is_memblock(a)) {
608 > sc->free(strvalue(a));
609 | } else if(is_port(a)) {
610
611 There are no MEMBLOCK literals, so we don't concern ourselves with
612 the READER part (yet!). We must cater to the PRINTER, though. We
613 add one case more in atom2str().
614
615 | } else if (iscontinuation(l)) {
616 | p = "#<CONTINUATION>";
617 > } else if (is_memblock(l)) {
618 > p = "#<MEMORY BLOCK>";
619 | } else {
620
621 Whenever a MEMBLOCK is displayed, it will look like that.
622 Now, we must add the interface functions: constructor, predicate,
623 accessor, modifier. We must in fact create new op-codes for the virtual
624 machine underlying TinyScheme. Since version 1.30, TinyScheme uses
625 macros and a single source text to keep the enums and the dispatch table
626 in sync. The op-codes are defined in the opdefines.h file with one line
627 for each op-code. The lines in the file have six columns between the
628 starting _OPDEF( and ending ): A, B, C, D, E, and OP.
629 Note that this file uses unusually long lines to accomodate all the
630 information; adjust your editor to handle this.
631
632 The purpose of the columns is:
633 - Column A is the name of the subroutine that handles the op-code.
634 - Column B is the name of the op-code function.
635 - Columns C and D are the minimum and maximum number of arguments
636 that are accepted by the op-code.
637 - Column E is a set of flags that tells the interpreter the type of
638 each of the arguments expected by the op-code.
639 - Column OP is used in the scheme_opcodes enum located in the
640 scheme-private.h file.
641
642 Op-codes are really just tags for a huge C switch, only this switch
643 is broken up in to a number of different opexe_X functions. The
644 correspondence is made in table "dispatch_table". There, we assign
645 the new op-codes to opexe_2, where the equivalent ones for vectors
646 are situated. We also assign a name for them, and specify the minimum
647 and maximum arity (number of expected arguments). INF_ARG as a maximum
648 arity means "unlimited".
649
650 For reasons of consistency, we add the new op-codes right after those
651 for vectors:
652
653 | _OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
654 > _OP_DEF(opexe_2, "make-block", 1, 2, TST_NATURAL TST_CHAR, OP_MKBLOCK )
655 > _OP_DEF(opexe_2, "block-length", 1, 1, T_MEMBLOCK, OP_BLOCKLEN )
656 > _OP_DEF(opexe_2, "block-ref", 2, 2, T_MEMBLOCK TST_NATURAL, OP_BLOCKREF )
657 > _OP_DEF(opexe_2, "block-set!", 1, 1, T_MEMBLOCK TST_NATURAL TST_CHAR, OP_BLOCKSET )
658 | _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT )
659
660 We add the predicate along with the other predicates in opexe_3:
661
662 | _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY, OP_VECTORP )
663 > _OP_DEF(opexe_3, "block?", 1, 1, TST_ANY, OP_BLOCKP )
664 | _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ )
665
666 All that remains is to write the actual code to do the processing and
667 add it to the switch statement in opexe_2, after the OP_VECSET case.
668
669 > case OP_MKBLOCK: { /* make-block */
670 > int fill=0;
671 > int len;
672 >
673 > if(!isnumber(car(sc->args))) {
674 > Error_1(sc,"make-block: not a number:",car(sc->args));
675 > }
676 > len=ivalue(car(sc->args));
677 > if(len<=0) {
678 > Error_1(sc,"make-block: not positive:",car(sc->args));
679 > }
680 >
681 > if(cdr(sc->args)!=sc->NIL) {
682 > if(!isnumber(cadr(sc->args)) || ivalue(cadr(sc->args))<0) {
683 > Error_1(sc,"make-block: not a positive number:",cadr(sc->args));
684 > }
685 > fill=charvalue(cadr(sc->args))%255;
686 > }
687 > s_return(sc,mk_memblock(sc,len,(char)fill));
688 > }
689 >
690 > case OP_BLOCKLEN: /* block-length */
691 > if(!ismemblock(car(sc->args))) {
692 > Error_1(sc,"block-length: not a memory block:",car(sc->args));
693 > }
694 > s_return(sc,mk_integer(sc,keynum(car(sc->args))));
695 >
696 > case OP_BLOCKREF: { /* block-ref */
697 > char *str;
698 > int index;
699 >
700 > if(!ismemblock(car(sc->args))) {
701 > Error_1(sc,"block-ref: not a memory block:",car(sc->args));
702 > }
703 > str=strvalue(car(sc->args));
704 >
705 > if(cdr(sc->args)==sc->NIL) {
706 > Error_0(sc,"block-ref: needs two arguments");
707 > }
708 > if(!isnumber(cadr(sc->args))) {
709 > Error_1(sc,"block-ref: not a number:",cadr(sc->args));
710 > }
711 > index=ivalue(cadr(sc->args));
712 >
713 > if(index<0 || index>=keynum(car(sc->args))) {
714 > Error_1(sc,"block-ref: out of bounds:",cadr(sc->args));
715 > }
716 >
717 > s_return(sc,mk_integer(sc,str[index]));
718 > }
719 >
720 > case OP_BLOCKSET: { /* block-set! */
721 > char *str;
722 > int index;
723 > int c;
724 >
725 > if(!ismemblock(car(sc->args))) {
726 > Error_1(sc,"block-set!: not a memory block:",car(sc->args));
727 > }
728 > if(isimmutable(car(sc->args))) {
729 > Error_1(sc,"block-set!: unable to alter immutable memory block:",car(sc->args));
730 > }
731 > str=strvalue(car(sc->args));
732 >
733 > if(cdr(sc->args)==sc->NIL) {
734 > Error_0(sc,"block-set!: needs three arguments");
735 > }
736 > if(!isnumber(cadr(sc->args))) {
737 > Error_1(sc,"block-set!: not a number:",cadr(sc->args));
738 > }
739 > index=ivalue(cadr(sc->args));
740 > if(index<0 || index>=keynum(car(sc->args))) {
741 > Error_1(sc,"block-set!: out of bounds:",cadr(sc->args));
742 > }
743 >
744 > if(cddr(sc->args)==sc->NIL) {
745 > Error_0(sc,"block-set!: needs three arguments");
746 > }
747 > if(!isinteger(caddr(sc->args))) {
748 > Error_1(sc,"block-set!: not an integer:",caddr(sc->args));
749 > }
750 > c=ivalue(caddr(sc->args))%255;
751 >
752 > str[index]=(char)c;
753 > s_return(sc,car(sc->args));
754 > }
755
756 Finally, do the same for the predicate in opexe_3.
757
758 | case OP_VECTORP: /* vector? */
759 | s_retbool(is_vector(car(sc->args)));
760 > case OP_BLOCKP: /* block? */
761 > s_retbool(is_memblock(car(sc->args)));
762 | case OP_EQ: /* eq? */