\ Binary arithmetic demonstration \ --------------------------------------------------- \ (c) Copyright 2001 Julian V. Noble. \ \ Permission is granted by the author to \ \ use this software for any application pro- \ \ vided this copyright notice is preserved. \ \ --------------------------------------------------- \ This is an ANS Forth program requiring the CORE and \ CORE EXT wordsets MARKER -exhibit \ binary display utility BL PARSE (D.) DUP PAD C! PAD CHAR+ SWAP CHARS MOVE PAD FIND NIP 0= [IF] : (D.) TUCK DABS <# #S ROT SIGN #> ; [THEN] \ conditional definition of common non-STANDARD word \ .NAME ( xt -- "wordname" to display) CR .( Are you using GForth? ) KEY DUP CHAR Y = SWAP CHAR y = OR [IF] : .NAME LOOK DROP .NAME ; [THEN] \ thanks to Alberto Santini \ added June 8th, 2000 - 15:15 CR .( Are you using SwiftForth? ) KEY DUP CHAR Y = SWAP CHAR y = OR [IF] : .NAME >name count type space ; [THEN] 32 VALUE #bits \ width of output field : zeros ( w --) DUP 0< IF DROP EXIT THEN 0 ?DO [CHAR] 0 EMIT LOOP ; : 0.r ( n w --) \ display a number right-justified in \ a field of width w, with leading 0's >R 0 (D.) R> \ in the current base OVER - zeros TYPE ; : 0.b ( n w --) \ display in binary BINARY CR 0.r DECIMAL ; : dash_line ( w --) 0 DO [CHAR] - EMIT LOOP ; : exhibit ( xt a b -- ) LOCALS| b a xt | \ stack items -> locals CR \ new line (carriage return) a #bits 0.b \ print 1st operand b #bits 0.b \ print 2nd operand 3 SPACES xt .NAME \ print operator a b xt EXECUTE ( -- answer = a op b) CR #bits dash_line \ print dashed line #bits 0.b \ print result ; \ Example: \ 8 to #bits ok \ ' xor 3 5 exhibit \ 00000011 \ 00000101 XOR \ -------- \ 00000110 ok \ 3 invert 8 0.b \ 11111111111111111111111111111100 ok