File:  [gforth] / gforth / arch / misc / prim.fs
Revision 1.23: download - view: text, annotated - select for diffs
Sat Nov 1 22:19:30 2008 UTC (14 years, 1 month ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright years

    1: \ MISC primitives
    2: 
    3: \ Copyright (C) 1998,2000,2003,2004,2006,2007,2008 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation, either version 3
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: 0 [IF]
   21: Ideas/Todo
   22: 
   23: 
   24: [THEN]
   25: 
   26: UNLOCK
   27: >ENVIRON
   28: \ true SetValue PrimTrace
   29: 
   30: LOCK
   31: 
   32: UNLOCK
   33: also assembler definitions
   34: 
   35: X has? PrimTrace [IF]
   36: : dout PC+6 X , accu X ,
   37:        *accu X , txd X ,
   38:        PC+4 X , jmp X ,
   39:        X , 0 X , ;
   40: [ELSE]
   41: : dout drop ;
   42: [THEN]
   43: 
   44: LOCK
   45: 
   46: \ pie primitives
   47: 
   48: $20 allot
   49: 
   50: Label start	ahere 2 + , jmp ,
   51: Label "IntoForth" 4711 ,
   52: 
   53: Label RP'       0 ,
   54: Label SP'       0 ,
   55: Label UP'       0 ,
   56: Label IP'       0 ,
   57: 
   58: Label #0	0 ,
   59: Label #1	1 ,
   60: Label #2	2 ,
   61: Label #4	4 ,
   62: Label #FF	$FF ,
   63: Label #$8000	$8000 ,
   64: Label #-1	-1 ,
   65: Label "Next"	1802 ,
   66: Label "Next1"	1802 ,
   67: Label ""Next""  "Next" ,
   68: End-Label
   69: 
   70: \ The virtual machine registers an data (stacks) go
   71: \ to a seperate memory region (hopefully ram)
   72: 
   73: \ UNLOCK
   74: \ current-region vm-memory activate ( saved-region )
   75: \ LOCK
   76: 
   77: Label RP	0 ,
   78: Label SP	0 ,
   79: Label UP	0 ,
   80: Label IP	0 ,
   81: Label W		0 ,
   82: Label t0	0 ,
   83: Label t1	0 ,
   84: Label t2	0 ,
   85: Label t3	0 ,
   86: Label srcx	0 ,
   87: Label dstx	0 ,
   88:                 "Next" , jmp ,
   89: Label data-stack     50 cells allot
   90: Label data-stack-top 2 cells allot
   91: Label return-stack     50 cells allot
   92: Label return-stack-top 2 cells allot
   93: 
   94: End-Label
   95: 
   96: \ UNLOCK
   97: \ ( saved-region ) activate
   98: \ LOCK
   99: 
  100: \ Up to here it's self modified
  101: Label IntoForth 
  102:                 \ Transfer VM registers initial values
  103:                 RP' , RP ,
  104:                 SP' , SP ,
  105:                 IP' , IP ,
  106:                 UP' , UP , \ useless since UP is initialized by gforth boot
  107:                 ""Next"" , dstx 1 + ,
  108:                 #0 , dstx 2 + ,
  109: 
  110: Label Next	#0 , add ,  \ clear carry
  111: 		IP , shr ,
  112: 		sym Next
  113: 		*accu , W ,
  114: 		#1 , add ,
  115: 		accu , add ,
  116: 		accu , IP ,
  117: Label Next1	W , shr ,
  118: 		*accu , shr ,
  119: 		accu , jmp ,
  120: 
  121: Label "xmov"	srcx ,
  122: End-Label
  123: 
  124: IntoForth "IntoForth" 2* !
  125: Next "Next" 2* !
  126: Next1 "Next1" 2* !
  127: 
  128: has? PrimTrace [IF]
  129: Label "0"	'< ,
  130: Label "1"	'1 ,
  131: Label "2"	'2 ,
  132: Label "3"	'3 ,
  133: Label "4"	'4 ,
  134: Label "5"	'5 ,
  135: Label "6"	'6 ,
  136: Label "A"	'A ,
  137: Label "B"	'B ,
  138: Label "C"	'C ,
  139: Label "D"	'D ,
  140: Label "E"	'E ,
  141: Label "F"	'> ,
  142: Label "?"	'? ,
  143: Label "+"	'+ ,
  144: Label "/"	'/ ,
  145: Label "H"	'H ,
  146: Label "I"	'I ,
  147: Label "J"	'J ,
  148: Label "K"	'K ,
  149: Label "L"	'L ,
  150: Label "M"	'M ,
  151: Label "N"	'N ,
  152: Label "O"	'O ,
  153: Label "P"	'P ,
  154: Label "Q"	'Q ,
  155: Label "R"	'R ,
  156: Label "S"	'S ,
  157: Label "T"	'T ,
  158: Label "#"	'# ,
  159: End-Label
  160: [THEN]
  161: 
  162: 
  163: Code: :docol	
  164:                 ': dout
  165: 		RP , accu ,
  166: 		#1 , sub ,
  167: 		accu , RP ,
  168: 		IP , *accu ,
  169: 		W , accu ,
  170: 		#4 , add ,
  171: 		accu , IP ,
  172: 		"Next" , jmp ,
  173: end-code
  174: 
  175: Code: :docon	
  176:                 '1 dout
  177: 		#0 , add ,
  178: 		W , shr ,
  179: 		#2 , add ,
  180: 		*accu , t0 ,
  181: 		SP , accu ,
  182: 		#1 , sub ,
  183: 		accu , SP ,
  184: 		t0 , *accu ,
  185: 		"Next" , jmp ,
  186: end-code
  187: 
  188: Code: :dovar
  189:                 '2 dout
  190: 		W , accu ,
  191: 		#4 , add ,
  192: 		accu , t0 ,
  193: 		SP , accu ,
  194: 		#1 , sub ,
  195: 		accu , SP ,
  196: 		t0 , *accu ,
  197: 		"Next" , jmp ,
  198: end-code
  199: 
  200: Code: :douser	
  201:                 '3 dout
  202: 		#0 , add ,
  203: 		W , shr ,
  204: 		#2 , add ,
  205: 		*accu , accu ,
  206: 		UP , add ,
  207: 		accu , t0 ,
  208: 		SP , accu ,
  209: 		#1 , sub ,
  210: 		accu , SP ,
  211: 		t0 , *accu ,
  212: 		"Next" , jmp ,
  213: end-code
  214: 
  215: Code: :dodefer	
  216:                 '4 dout
  217: 		#0 , add ,
  218: 		W , shr ,
  219: 		#2 , add ,
  220: 		*accu , W ,
  221: 		"Next1" , jmp ,
  222: end-code
  223: 
  224: Code: :dofield
  225:                 '5 dout
  226: 		#0 , add ,
  227: 		W , shr ,
  228: 		#2 , add ,
  229: 		*accu , accu ,
  230: 		accu , t0 ,
  231: 		SP , accu ,
  232: 		*accu , accu ,
  233: 		t0 , add ,
  234: 		accu , t0 ,
  235: 		SP , accu ,
  236: 		t0 , *accu ,
  237: 		"Next" , jmp ,
  238: end-code
  239: 
  240: Code: :dodoes
  241:                 '6 dout
  242: 		RP , accu ,
  243: 		#1 , sub ,
  244: 		accu , RP ,
  245: 		IP , *accu ,
  246: 		W , accu ,
  247: 		#4 , add ,
  248: 		accu , t0 ,
  249: 		SP , accu ,
  250: 		#1 , sub ,
  251: 		accu , SP ,
  252: 		t0 , *accu ,
  253: 		t0 , accu ,
  254: 		#2 , sub ,
  255: 		#0 , add ,
  256: 		accu , shr ,
  257: 		*accu , IP ,
  258: 		"Next" , jmp ,
  259: end-code
  260: 
  261: Code: :doesjump
  262: end-code
  263: 
  264: Code execute
  265:                 'E dout
  266: 		SP , accu ,
  267: 		*accu , W ,
  268: 		#1 , add ,
  269: 		accu , SP ,
  270: 		"Next1" , jmp ,
  271: end-code
  272: 
  273: Code ;s
  274:                 '; dout
  275: 		RP , accu ,
  276: 		#1 , add ,
  277: 		accu , RP ,
  278: 		#1 , sub ,
  279: 		*accu , IP ,
  280: 		"Next" , jmp ,
  281: end-code
  282: 
  283: Code !
  284:                 '! dout
  285: 		SP , accu ,
  286: 		*accu , t0 ,
  287: 		#1 , add ,
  288: 		*accu , t1 ,
  289: 		#1 , add ,
  290: 		accu , SP ,
  291: 		t0 , shr ,
  292: 		t1 , *accu ,
  293: 		"Next" , jmp ,
  294: end-code
  295: 
  296: Code @
  297:                 '@ dout
  298: 		#0 , add ,
  299: 		SP , accu ,
  300: 		*accu , shr ,
  301: 		*accu , t0 ,
  302: 		SP , accu ,
  303: 		t0 , *accu ,
  304: 		"Next" , jmp ,
  305: end-code
  306: 
  307: Code ?branch
  308:                 '? dout
  309: 		#0 , add ,
  310: 		IP , shr ,
  311: 		accu , t0 ,
  312: 		#1 , add ,
  313: 		accu , add ,
  314: 		accu , IP ,
  315:                 SP , accu ,
  316:                 *accu , t1 ,
  317: 		#1 , add ,
  318: 		accu , SP ,
  319:                 t1 , accu ,
  320: 		pc+4 , jz ,
  321: 		"Next" , jmp ,
  322:                 '~ dout
  323: 		t0 , accu ,
  324: 		*accu , IP ,
  325: 		"Next" , jmp ,
  326: end-code
  327: 
  328: Code branch
  329:                 'b dout
  330: 		#0 , add ,
  331: 		IP , shr ,
  332: 		*accu , IP ,
  333: 		"Next" , jmp ,
  334: end-code
  335: 
  336: Code (loop)	
  337:                 'l dout
  338: 		#0 , add ,
  339: 		IP , shr ,
  340: 		accu , t0 ,
  341: 		#1 , add ,
  342: 		accu , add ,
  343:                 accu , IP ,
  344:     
  345: 		RP , accu ,
  346: 		*accu , t2 ,
  347: 		#1 , add ,
  348: 		*accu , t3 ,
  349: 		t2 , accu ,
  350: 		#1 , add ,
  351: 		accu , t1 ,
  352: 		RP , accu ,
  353: 		t1 , *accu ,
  354: 		t1 , accu ,
  355: 		t3 , sub ,
  356: 		"Next" , jz ,
  357: 		t0 , accu ,
  358: 		*accu , IP ,
  359: 		"Next" , jmp ,
  360: end-code
  361: 		
  362: Code xor
  363:                 'x dout
  364: 		SP , accu ,
  365: 		*accu , t0 ,
  366: 		#1 , add ,
  367: 		accu , SP ,
  368: 		*accu , accu ,
  369: 		t0 , xor ,
  370: 		accu , t0 ,
  371: 		SP , accu ,
  372: 		t0 , *accu ,
  373: 		"Next" , jmp ,
  374: end-code
  375: 
  376: Code or	
  377:                 'o dout	
  378: 		SP , accu ,
  379: 		*accu , t0 ,
  380: 		#1 , add ,
  381: 		accu , SP ,
  382: 		*accu , accu ,
  383: 		t0 , or ,
  384: 		accu , t0 ,
  385: 		SP , accu ,
  386: 		t0 , *accu ,
  387: 		"Next" , jmp ,
  388: end-code
  389: 
  390: Code and
  391:                 'a dout
  392: 		SP , accu ,
  393: 		*accu , t0 ,
  394: 		#1 , add ,
  395: 		accu , SP ,
  396: 		*accu , accu ,
  397: 		t0 , and ,
  398: 		accu , t0 ,
  399: 		SP , accu ,
  400: 		t0 , *accu ,
  401: 		"Next" , jmp ,
  402: end-code
  403: 
  404: Code +		
  405:                 '+ dout
  406: 		SP , accu ,
  407: 		*accu , t0 ,
  408: 		#1 , add ,
  409: 		accu , SP ,
  410: 		*accu , accu ,
  411: 		t0 , add ,
  412: 		accu , t0 ,
  413: 		SP , accu ,
  414: 		t0 , *accu ,
  415: 		"Next" , jmp ,
  416: end-code
  417: 
  418: Code -		
  419:                 '- dout
  420: 		SP , accu ,
  421: 		*accu , t0 ,
  422: 		#1 , add ,
  423: 		accu , SP ,
  424: 		*accu , accu ,
  425: 		t0 , sub ,
  426: 		accu , t0 ,
  427: 		SP , accu ,
  428: 		t0 , *accu ,
  429: 		"Next" , jmp ,
  430: end-code
  431: 
  432: Code 2/		
  433:                 '/ dout
  434: 		#0 , add ,
  435: 		SP , accu ,
  436: 		*accu , accu ,
  437: 		PC+6 , js ,
  438: 		accu , shr ,
  439: 		PC+6 , jmp ,
  440: 		accu , shr ,
  441: 		#$8000 , or ,
  442: 		accu , t0 ,
  443: 		SP , accu ,
  444: 		t0 , *accu ,
  445: 		"Next" , jmp ,
  446: end-code
  447: 
  448: Code 0=		
  449:                 '0 dout
  450: 		SP , accu ,
  451: 		*accu , accu ,
  452: 		ZF , accu ,
  453: 		#1 , xor ,
  454: 		#1 , sub ,
  455: 		accu , t0 ,
  456: 		SP , accu ,
  457: 		t0 , *accu ,
  458: 		"Next" , jmp ,
  459: end-code
  460: 
  461: Code 0<>	
  462:                 '% dout
  463: 		SP , accu ,
  464: 		*accu , accu ,
  465: 		ZF , accu ,
  466: 		#1 , sub ,
  467: 		accu , t0 ,
  468: 		SP , accu ,
  469: 		t0 , *accu ,
  470: 		"Next" , jmp ,
  471: end-code
  472: 
  473: Code =		
  474:                 '= dout
  475: 		SP , accu ,
  476: 		*accu , t0 ,
  477: 		#1 , add ,
  478: 		accu , SP ,
  479: 		*accu , accu ,
  480: 		t0 , sub ,
  481: 		ZF , accu ,
  482: 		#1 , xor ,
  483: 		#1 , sub ,
  484: 		accu , t0 ,
  485: 		SP , accu ,
  486: 		t0 , *accu ,
  487: 		"Next" , jmp ,
  488: end-code
  489: 
  490: Code u<		
  491:                 '< dout
  492: 		SP , accu ,
  493: 		*accu , t0 ,
  494: 		#1 , add ,
  495: 		accu , SP ,
  496: 		*accu , accu ,
  497: 		t0 , sub ,
  498: 		CF , accu ,
  499: 		#1 , xor ,
  500: 		#1 , sub ,
  501: 		accu , t0 ,
  502: 		SP , accu ,
  503: 		t0 , *accu ,
  504: 		"Next" , jmp ,
  505: end-code
  506: 
  507: Code 1+		
  508:                 'p dout
  509: 		SP , accu ,
  510: 		*accu , accu ,
  511: 		#1 , add ,
  512: 		accu , t0 ,
  513: 		SP , accu ,
  514: 		t0 , *accu ,
  515: 		"Next" , jmp ,
  516: end-code
  517: 
  518: Code cell+	
  519:                 'P dout
  520: 		SP , accu ,
  521: 		*accu , accu ,
  522: 		#2 , add ,
  523: 		accu , t0 ,
  524: 		SP , accu ,
  525: 		t0 , *accu ,
  526: 		"Next" , jmp ,
  527: end-code
  528: 
  529: Code 8<<	
  530:                 '{ dout
  531: 		#0 , add ,
  532: 		SP , accu ,
  533: 		*accu , accu ,
  534: 		accu , add ,
  535: 		accu , add ,
  536: 		accu , add ,
  537: 		accu , add ,
  538: 		accu , add ,
  539: 		accu , add ,
  540: 		accu , add ,
  541: 		accu , add ,
  542: 		accu , t0 ,
  543: 		SP , accu ,
  544: 		t0 , *accu ,
  545: 		"Next" , jmp ,
  546: end-code
  547: 
  548: Code 8>>	
  549:                 '{ dout
  550: 		#0 , add ,
  551: 		SP , accu ,
  552: Label c-even@	*accu , shr ,
  553: 		accu , shr ,
  554: 		accu , shr ,
  555: 		accu , shr ,
  556: 		accu , shr ,
  557: 		accu , shr ,
  558: 		accu , shr ,
  559: 		accu , shr ,
  560: 		#FF , and ,
  561: 		accu , t0 ,
  562: 		SP , accu ,
  563: 		t0 , *accu ,
  564: 		"Next" , jmp ,
  565: Label "c-even@"	c-even@ ,
  566: end-code
  567: 
  568: Code c@		
  569:                 'c dout
  570: 		#0 , add ,
  571: 		SP , accu ,
  572: 		*accu , shr ,
  573: 		PC+4 , jc ,
  574: 		"c-even@" , jmp ,
  575: 		*accu , accu ,
  576: 		#FF , and ,
  577: 		accu , t0 ,
  578: 		SP , accu ,
  579: 		t0 , *accu ,
  580: 		"Next" , jmp ,
  581: end-code
  582: 
  583: Code 2*		
  584:                 '* dout
  585: 		SP , accu ,
  586: 		*accu , accu ,
  587: 		accu , add ,
  588: 		accu , t0 ,
  589: 		SP , accu ,
  590: 		t0 , *accu ,
  591: 		"Next" , jmp ,
  592: end-code
  593: 
  594: Code >r		
  595:                 'R dout
  596: 		SP , accu ,
  597: 		*accu , t0 ,
  598: 		#1 , add ,
  599: 		accu , SP ,
  600: 		RP , accu ,
  601: 		#1 , sub ,
  602: 		accu , RP ,
  603: 		t0 , *accu ,
  604: 		"Next" , jmp ,
  605: end-code
  606: 
  607: Code r>		
  608:                 'r dout
  609: 		RP , accu ,
  610: 		*accu , t0 ,
  611: 		#1 , add ,
  612: 		accu , RP ,
  613: 		SP , accu ,
  614: 		#1 , sub ,
  615: 		accu , SP ,
  616: 		t0 , *accu ,
  617: 		"Next" , jmp ,
  618: end-code
  619: 
  620: Code sp@	
  621:                 's dout
  622: 		SP , accu ,
  623: 		accu , add ,
  624: 		accu , t0 ,
  625: 		SP , accu ,
  626: 		#1 , sub ,
  627: 		accu , SP ,
  628: 		t0 , *accu ,
  629: 		"Next" , jmp ,
  630: end-code
  631: 
  632: Code sp!	
  633:                 'S dout
  634: 		#0 , add ,
  635: 		SP , accu ,
  636: 		*accu , shr ,
  637: 		accu , SP ,
  638: 		"Next" , jmp ,
  639: end-code
  640: 
  641: Code rp@	
  642: 		RP , accu ,
  643: 		accu , add ,
  644: 		accu , t0 ,
  645: 		SP , accu ,
  646: 		#1 , sub ,
  647: 		accu , SP ,
  648: 		t0 , *accu ,
  649: 		"Next" , jmp ,
  650: end-code
  651: 
  652: Code rp!	sym rp!
  653: 		SP , accu ,
  654: 		*accu , t0 ,
  655: 		#1 , add ,
  656: 		accu , SP ,
  657: 		#0 , add ,
  658: 		t0 , shr ,
  659: 		accu , RP ,
  660: 		"Next" , jmp ,
  661: end-code
  662: 
  663: Code drop
  664:                 'd dout	
  665: 		SP , accu ,
  666: 		#1 , add ,
  667: 		accu , SP ,
  668: 		"Next" , jmp ,
  669: end-code
  670: 
  671: Code lit	
  672:                 '# dout
  673: 		IP , shr ,
  674: 		*accu , t0 ,
  675: 		#1 , add ,
  676: 		accu , add ,
  677: 		accu , IP ,
  678: 		SP , accu ,
  679: 		#1 , sub ,
  680: 		accu , SP ,
  681: 		t0 , *accu ,
  682: 		"Next" , jmp ,
  683: end-code
  684: 
  685: Code dup	
  686:                 'u dout
  687: 		SP , accu ,
  688: 		*accu , t0 ,
  689: 		#1 , sub ,
  690: 		accu , SP ,
  691: 		t0 , *accu ,
  692: 		"Next" , jmp ,
  693: end-code
  694: 
  695: Code r@		
  696:                 'I dout
  697: 		RP , accu ,
  698: 		*accu , t0 ,
  699: 		SP , accu ,
  700: 		#1 , sub ,
  701: 		accu , SP ,
  702: 		t0 , *accu ,
  703: 		"Next" , jmp ,
  704: end-code
  705: 
  706: Code over	
  707:                 'v dout
  708: 		SP , accu ,
  709: 		#1 , add ,
  710: 		*accu , t0 ,
  711: 		#2 , sub ,
  712: 		accu , SP ,
  713: 		t0 , *accu ,
  714: 		"Next" , jmp ,
  715: end-code
  716: 
  717: Code swap	
  718:                 'w dout
  719: 		SP , accu ,
  720: 		*accu , t0 ,
  721: 		#1 , add ,
  722: 		*accu , t1 ,
  723: 		t0 , *accu ,
  724: 		#1 , sub ,
  725: 		t1 , *accu ,
  726: 		"Next" , jmp ,
  727: end-code
  728: 
  729: Code d+		
  730: 		SP , accu ,
  731: 		*accu , t0 ,
  732: 		#1 , add ,
  733: 		*accu , t1 ,
  734: 		#1 , add ,
  735: 		*accu , t2 ,
  736: 		accu , SP ,
  737: 		#1 , add ,
  738: 		*accu , accu ,
  739: 		t1 , add ,
  740: 		accu , t1 ,
  741: 		CF , accu ,
  742: 		t2 , add ,
  743: 		t0 , add ,
  744: 		accu , t0 ,
  745: 		SP , accu ,
  746: 		t0 , *accu ,
  747: 		#1 , add ,
  748: 		t1 , *accu ,
  749: 		"Next" , jmp ,
  750: end-code
  751: 
  752: Label cf1	0 ,
  753: End-Label
  754: Code d2*+	sym d2*+
  755: 		SP , accu ,
  756: Label >d2*+	*accu , t0 ,
  757: 		#1 , add ,
  758: 		*accu , t1 ,
  759: 		#1 , add ,
  760: 		*accu , t2 ,
  761: 		accu , t3 ,
  762: 		t0 , accu ,
  763: 		t2 , add ,
  764: 		t2 , add ,
  765: 		accu , t2 ,
  766: 		CF , accu ,
  767: 		t1 , add ,
  768: 		t1 , add ,
  769: 		accu , t0 ,
  770: 		t1 , accu ,
  771: 		#$8000 , and ,
  772: 		accu , t1 ,
  773: 		t3 , accu ,
  774: 		t2 , *accu ,
  775: 		#1 , sub ,
  776: 		t0 , *accu ,
  777: 		#1 , sub ,
  778: 		t1 , *accu ,
  779: 		"Next" , jmp ,
  780: end-code
  781: 
  782: Label "d2*+"	>d2*+ ,
  783: End-Label
  784: Code /modstep ( ud c R: u -- ud-?u 0/1 )
  785: 		sym /modstep
  786: 		SP , accu ,
  787: 		*accu , t0 ,
  788: 		#1 , add ,
  789: 		*accu , t1 ,
  790: 		#1 , add ,
  791: 		*accu , t2 ,
  792: 		t2 , accu ,
  793: 		t0 , sub ,
  794: 		accu , t0 ,
  795: 		CF , accu ,
  796: 		t1 , or ,
  797: 		PC+6 , JZ ,
  798: 		#0 , accu ,
  799: 		PC+6 , jmp ,
  800: 		t0 , t2 ,
  801: 		#1 , accu ,
  802: 		accu , t0 ,
  803: 		SP , accu ,
  804: 		#1 , add ,
  805: 		t0 , *accu ,
  806: 		#1 , add ,
  807: 		t2 , *accu ,
  808: 		#1 , sub ,
  809: 		"d2*+" , jmp ,
  810: end-code
  811: 
  812: Code (key)      
  813: 		SP , accu ,
  814: 		#1 , sub ,
  815: 		accu , SP ,
  816:                 rxd , *accu ,
  817: 		"Next" , jmp ,
  818: end-code
  819: 
  820: Code (key?)      
  821:                 rx? , accu ,
  822: 		ZF , accu ,
  823: 		#1 , sub ,
  824: 		accu , t0 ,
  825: 		SP , accu ,
  826: 		#1 , sub ,
  827: 		accu , SP ,
  828: 		t0 , *accu ,
  829: 		"Next" , jmp ,
  830: end-code
  831: 
  832: Code (emit)      
  833: 		SP , accu ,
  834:                 *accu , txd ,
  835: 		#1 , add ,
  836: 		accu , SP ,
  837: 		"Next" , jmp ,
  838: end-code
  839: 		
  840: UP 2* Constant UP
  841: 
  842: : up@ up @ ;
  843: : up! up ! ;
  844: 
  845: \ include ./key.fs
  846: include ./optcmove.fs
  847: 
  848: : finish-code ;
  849: : compile-prim1 ;
  850: : (bye) ;
  851: : bye ;
  852: : float+ 8 + ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>