Annotation of gforth/see.fs, revision 1.42
1.1 anton 1: \ SEE.FS highend SEE for ANSforth 16may93jaw
2:
1.30 anton 3: \ Copyright (C) 1995,2000 Free Software Foundation, Inc.
1.9 anton 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 2
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, write to the Free Software
1.31 anton 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.9 anton 20:
21:
1.1 anton 22: \ May be cross-compiled
23:
24: \ I'm sorry. This is really not "forthy" enough.
25:
26: \ Ideas: Level should be a stack
27:
1.18 jwilke 28: require look.fs
1.10 anton 29: require termsize.fs
1.18 jwilke 30: require wordinfo.fs
1.32 anton 31: [IFUNDEF] .name
32: : id. ( nt -- ) \ gforth
33: \G Print the name of the word represented by @var{nt}.
34: \ this name comes from fig-Forth
35: name>string type space ;
36:
37: ' id. alias .id ( nt -- )
38: \G F83 name for @code{id.}.
39:
40: ' id. alias .name ( nt -- )
41: \G Gforth <=0.5.0 name for @code{id.}.
42:
43: [THEN]
1.10 anton 44:
1.1 anton 45: decimal
46:
47: \ Screen format words 16may93jaw
48:
49: VARIABLE C-Output 1 C-Output !
50: VARIABLE C-Formated 1 C-Formated !
51: VARIABLE C-Highlight 0 C-Highlight !
52: VARIABLE C-Clearline 0 C-Clearline !
53:
54: VARIABLE XPos
55: VARIABLE YPos
56: VARIABLE Level
57:
58: : Format C-Formated @ C-Output @ and
59: IF dup spaces XPos +! ELSE drop THEN ;
60:
61: : level+ 7 Level +!
62: Level @ XPos @ -
63: dup 0> IF Format ELSE drop THEN ;
64:
65: : level- -7 Level +! ;
66:
67: VARIABLE nlflag
1.15 pazsan 68: VARIABLE uppercase \ structure words are in uppercase
1.1 anton 69:
70: DEFER nlcount ' noop IS nlcount
71:
72: : nl nlflag on ;
73: : (nl) nlcount
1.18 jwilke 74: XPos @ Level @ = IF EXIT THEN \ ?Exit
1.1 anton 75: C-Formated @ IF
76: C-Output @
1.10 anton 77: IF C-Clearline @ IF cols XPos @ - spaces
1.1 anton 78: ELSE cr THEN
79: 1 YPos +! 0 XPos !
80: Level @ spaces
81: THEN Level @ XPos ! THEN ;
82:
83: : warp? ( len -- len )
84: nlflag @ IF (nl) nlflag off THEN
1.10 anton 85: XPos @ over + cols u>= IF (nl) THEN ;
1.1 anton 86:
1.22 crook 87: : c-to-upper ( c1 -- c2 ) \ gforth
88: \ nac05feb1999 there is a primitive, toupper, with this function
89: dup [char] a >= over [char] z <= and if bl - then ;
1.15 pazsan 90:
1.1 anton 91: : ctype ( adr len -- )
1.15 pazsan 92: warp? dup XPos +! C-Output @
93: IF uppercase @ IF bounds ?DO i c@ c-to-upper emit LOOP
94: uppercase off ELSE type THEN
95: ELSE 2drop THEN ;
1.1 anton 96:
97: : cemit 1 warp?
98: over bl = Level @ XPos @ = and
99: IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN
100: THEN ;
101:
1.34 anton 102: DEFER .string ( c-addr u n -- )
1.1 anton 103:
104: [IFDEF] Green
105: VARIABLE Colors Colors on
106:
107: : (.string) ( c-addr u n -- )
108: over warp? drop
109: Colors @
110: IF C-Highlight @ ?dup
111: IF CT@ swap CT@ or
112: ELSE CT@
113: THEN
114: attr! ELSE drop THEN
115: ctype ct @ attr! ;
116: [ELSE]
117: : (.string) ( c-addr u n -- )
118: drop ctype ;
119: [THEN]
120:
121: ' (.string) IS .string
122:
123:
1.15 pazsan 124: : .struc
125: uppercase on Str# .string ;
1.1 anton 126:
1.17 jwilke 127: \ CODES (Branchtypes) 15may93jaw
1.1 anton 128:
129: 21 CONSTANT RepeatCode
130: 22 CONSTANT AgainCode
131: 23 CONSTANT UntilCode
132: \ 09 CONSTANT WhileCode
133: 10 CONSTANT ElseCode
134: 11 CONSTANT AheadCode
135: 13 CONSTANT WhileCode2
136: 14 CONSTANT Disable
1.17 jwilke 137: 15 CONSTANT LeaveCode
138:
1.1 anton 139:
140: \ FORMAT WORDS 13jun93jaw
141:
142: VARIABLE C-Stop
143: VARIABLE Branches
144:
1.17 jwilke 145: VARIABLE BranchPointer \ point to the end of branch table
1.1 anton 146: VARIABLE SearchPointer
1.17 jwilke 147:
148: \ The branchtable consists of three entrys:
149: \ address of branch , branch destination , branch type
150:
1.25 pazsan 151: CREATE BranchTable 128 cells allot
1.1 anton 152: here 3 cells -
153: ACONSTANT MaxTable
154:
155: : FirstBranch BranchTable cell+ SearchPointer ! ;
156:
1.17 jwilke 157: : (BranchAddr?) ( a-addr1 -- a-addr2 true | false )
158: \ searches a branch with destination a-addr1
159: \ a-addr1: branch destination
160: \ a-addr2: pointer in branch table
1.1 anton 161: SearchPointer @
162: BEGIN dup BranchPointer @ u<
163: WHILE
164: dup @ 2 pick <>
165: WHILE 3 cells +
166: REPEAT
167: nip dup 3 cells + SearchPointer ! true
168: ELSE
169: 2drop false
170: THEN ;
171:
172: : BranchAddr?
173: FirstBranch (BranchAddr?) ;
174:
175: ' (BranchAddr?) ALIAS MoreBranchAddr?
176:
177: : CheckEnd ( a-addr -- true | false )
178: BranchTable cell+
179: BEGIN dup BranchPointer @ u<
180: WHILE
181: dup @ 2 pick u<=
182: WHILE 3 cells +
183: REPEAT
184: 2drop false
185: ELSE
186: 2drop true
187: THEN ;
188:
1.17 jwilke 189: : MyBranch ( a-addr -- a-addr a-addr2 )
190: \ finds branch table entry for branch at a-addr
191: dup @ over +
192: BranchAddr?
193: BEGIN
194: WHILE 1 cells - @
195: over <>
196: WHILE dup @ over +
197: MoreBranchAddr?
198: REPEAT
199: SearchPointer @ 3 cells -
200: ELSE true ABORT" SEE: Table failure"
201: THEN ;
202:
1.1 anton 203: \
204: \ addrw addrt
205: \ BEGIN ... WHILE ... AGAIN ... THEN
206: \ ^ ! ! ^
207: \ ----------+--------+ !
208: \ ! !
209: \ +-------------------+
210: \
211: \
212:
213: : CheckWhile ( a-addrw a-addrt -- true | false )
214: BranchTable
215: BEGIN dup BranchPointer @ u<
216: WHILE dup @ 3 pick u>
217: over @ 3 pick u< and
218: IF dup cell+ @ 3 pick u<
219: IF 2drop drop true EXIT THEN
220: THEN
221: 3 cells +
222: REPEAT
223: 2drop drop false ;
224:
225: : ,Branch ( a-addr -- )
226: BranchPointer @ dup MaxTable u> ABORT" SEE: Table overflow"
227: !
228: 1 cells BranchPointer +! ;
229:
230: : Type! ( u -- )
231: BranchPointer @ 1 cells - ! ;
232:
233: : Branch! ( a-addr rel -- a-addr )
234: over + over ,Branch ,Branch 0 ,Branch ;
235:
236: \ DEFER CheckUntil
237: VARIABLE NoOutput
238: VARIABLE C-Pass
239:
240: 0 CONSTANT ScanMode
241: 1 CONSTANT DisplayMode
242: 2 CONSTANT DebugMode
243:
244: : Scan? ( -- flag ) C-Pass @ 0= ;
245: : Display? ( -- flag ) C-Pass @ 1 = ;
246: : Debug? ( -- flag ) C-Pass @ 2 = ;
247:
248: : back? ( n -- flag ) 0< ;
249: : ahead? ( n -- flag ) 0> ;
250:
251: : c-lit
1.8 pazsan 252: Display? IF
253: dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
254: THEN
255: cell+ ;
256:
1.36 anton 257: : .word ( addr xt -- addr )
1.35 pazsan 258: look 0= IF
1.36 anton 259: drop dup 1 cells - @ dup body> look
260: IF
261: nip dup ." <" name>string rot wordinfo .string ." >"
262: ELSE
263: drop ." <" 0 .r ." >"
264: THEN
1.35 pazsan 265: ELSE
266: dup cell+ @ immediate-mask and
267: IF
268: bl cemit ." POSTPONE "
269: THEN
270: dup name>string rot wordinfo .string
271: THEN ;
272:
273: : c-call
1.38 pazsan 274: Display? IF ." call " dup @ body> .word bl cemit THEN cell+ ;
1.35 pazsan 275:
1.18 jwilke 276: : .name-without ( addr -- addr )
277: \ prints a name without () e.g. (+LOOP) or (s")
278: dup 1 cells - @ look
279: IF name>string over c@ '( = IF 1 /string THEN
280: 2dup + 1- c@ ') = IF 1- THEN .struc ELSE drop
281: THEN ;
1.1 anton 282:
283: : c-c"
1.18 jwilke 284: Display? IF nl .name-without THEN
1.1 anton 285: count 2dup + aligned -rot
286: Display?
1.18 jwilke 287: IF bl cemit 0 .string
1.1 anton 288: [char] " cemit bl cemit
289: ELSE 2drop
290: THEN ;
291:
292:
1.17 jwilke 293: : Forward? ( a-addr true | false -- a-addr true | false )
294: \ a-addr1 is pointer into branch table
295: \ returns true when jump is a forward jump
1.1 anton 296: IF dup dup @ swap 1 cells - @ -
297: Ahead? IF true ELSE drop false THEN
298: \ only if forward jump
299: ELSE false THEN ;
300:
1.17 jwilke 301: : RepeatCheck ( a-addr1 a-addr2 true | false -- false )
1.1 anton 302: IF BEGIN 2dup
303: 1 cells - @ swap dup @ +
304: u<=
305: WHILE drop dup cell+
306: MoreBranchAddr? 0=
307: UNTIL false
308: ELSE true
309: THEN
310: ELSE false
311: THEN ;
312:
313: : c-branch
314: Scan?
315: IF dup @ Branch!
316: dup @ back?
317: IF \ might be: AGAIN, REPEAT
318: dup cell+ BranchAddr? Forward?
319: RepeatCheck
320: IF RepeatCode Type!
321: cell+ Disable swap !
322: ELSE AgainCode Type!
323: THEN
324: ELSE dup cell+ BranchAddr? Forward?
325: IF ElseCode Type! drop
326: ELSE AheadCode Type!
327: THEN
328: THEN
329: THEN
330: Display?
331: IF
332: dup @ back?
333: IF \ might be: AGAIN, REPEAT
334: level- nl
335: dup cell+ BranchAddr? Forward?
336: RepeatCheck
337: IF drop S" REPEAT " .struc nl
338: ELSE S" AGAIN " .struc nl
339: THEN
1.17 jwilke 340: ELSE MyBranch cell+ @ LeaveCode =
341: IF S" LEAVE " .struc
342: ELSE
343: dup cell+ BranchAddr? Forward?
344: IF dup cell+ @ WhileCode2 =
345: IF nl S" ELSE" .struc level+
346: ELSE level- nl S" ELSE" .struc level+ THEN
347: cell+ Disable swap !
348: ELSE S" AHEAD" .struc level+
349: THEN
350: THEN
1.1 anton 351: THEN
352: THEN
353: Debug?
354: IF dup @ +
355: ELSE cell+
356: THEN ;
357:
358: : DebugBranch
359: Debug?
360: IF dup @ over + swap THEN ; \ return 2 different addresses
361:
362: : c-?branch
363: Scan?
364: IF dup @ Branch!
365: dup @ Back?
366: IF UntilCode Type! THEN
367: THEN
368: Display?
369: IF dup @ Back?
370: IF level- nl S" UNTIL " .struc nl
371: ELSE dup dup @ over +
372: CheckWhile
373: IF MyBranch
374: cell+ dup @ 0=
375: IF WhileCode2 swap !
376: ELSE drop THEN
377: level- nl
1.8 pazsan 378: S" WHILE " .struc
1.1 anton 379: level+
1.17 jwilke 380: ELSE MyBranch cell+ @ LeaveCode =
381: IF s" 0= ?LEAVE " .struc
382: ELSE nl S" IF " .struc level+
383: THEN
1.1 anton 384: THEN
385: THEN
386: THEN
387: DebugBranch
388: cell+ ;
389:
390: : c-for
391: Display? IF nl S" FOR" .struc level+ THEN ;
392:
393: : c-loop
1.15 pazsan 394: Display? IF level- nl .name-without bl cemit nl THEN
1.17 jwilke 395: DebugBranch cell+
396: Scan?
397: IF dup BranchAddr?
398: BEGIN WHILE cell+ LeaveCode swap !
399: dup MoreBranchAddr?
400: REPEAT
401: THEN
402: cell+ ;
1.1 anton 403:
1.15 pazsan 404: : c-do
405: Display? IF nl .name-without level+ THEN ;
1.1 anton 406:
1.15 pazsan 407: : c-?do
408: Display? IF nl S" ?DO" .struc level+ THEN
409: DebugBranch cell+ ;
1.8 pazsan 410:
1.1 anton 411: : c-exit dup 1 cells -
412: CheckEnd
413: IF Display? IF nlflag off S" ;" Com# .string THEN
414: C-Stop on
415: ELSE Display? IF S" EXIT " .struc THEN
416: THEN
417: Debug? IF drop THEN ;
418:
419: : c-abort"
420: count 2dup + aligned -rot
421: Display?
422: IF S" ABORT" .struc
423: [char] " cemit bl cemit 0 .string
424: [char] " cemit bl cemit
425: ELSE 2drop
426: THEN ;
427:
1.23 jwilke 428: [IFDEF] (does>)
429: : c-does> \ end of create part
430: Display? IF S" DOES> " Com# .string THEN
431: maxaligned /does-handler + ;
432: [THEN]
433:
434: [IFDEF] (compile)
435: : c-(compile)
436: Display?
437: IF
438: s" POSTPONE " Com# .string
439: dup @ look 0= ABORT" SEE: No valid XT"
440: name>string 0 .string bl cemit
441: THEN
442: cell+ ;
443: [THEN]
1.1 anton 444:
445: CREATE C-Table
1.18 jwilke 446: ' lit A, ' c-lit A,
1.37 pazsan 447: [IFDEF] call ' call A, ' c-call A, [THEN]
1.42 ! anton 448: [IFDEF] (s") ' (s") A, ' c-c" A, [THEN]
! 449: [IFDEF] (.") ' (.") A, ' c-c" A, [THEN]
! 450: [IFDEF] "lit ' "lit A, ' c-c" A, [THEN]
1.18 jwilke 451: [IFDEF] (c") ' (c") A, ' c-c" A, [THEN]
452: ' (do) A, ' c-do A,
453: [IFDEF] (+do) ' (+do) A, ' c-do A, [THEN]
454: [IFDEF] (u+do) ' (u+do) A, ' c-do A, [THEN]
455: [IFDEF] (-do) ' (-do) A, ' c-do A, [THEN]
456: [IFDEF] (u-do) ' (u-do) A, ' c-do A, [THEN]
457: ' (?do) A, ' c-?do A,
458: ' (for) A, ' c-for A,
459: ' ?branch A, ' c-?branch A,
460: ' branch A, ' c-branch A,
461: ' (loop) A, ' c-loop A,
462: ' (+loop) A, ' c-loop A,
463: [IFDEF] (s+loop) ' (s+loop) A, ' c-loop A, [THEN]
464: [IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN]
465: ' (next) A, ' c-loop A,
466: ' ;s A, ' c-exit A,
1.42 ! anton 467: [IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN]
1.23 jwilke 468: \ only defined if compiler is loaded
469: [IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN]
470: [IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN]
1.18 jwilke 471: 0 , here 0 ,
1.15 pazsan 472:
473: avariable c-extender
474: c-extender !
1.1 anton 475:
476: \ DOTABLE 15may93jaw
477:
478: : DoTable ( cfa -- flag )
479: C-Table
1.15 pazsan 480: BEGIN dup @ dup 0=
481: IF drop cell+ @ dup
482: IF ( next table!) dup @ ELSE
483: ( end!) 2drop false EXIT THEN
484: THEN
485: \ jump over to extender, if any 26jan97jaw
1.41 anton 486: xt>threaded 2 pick <>
1.1 anton 487: WHILE 2 cells +
488: REPEAT
1.11 anton 489: nip cell+ perform
1.1 anton 490: true
1.15 pazsan 491: ;
1.1 anton 492:
493: : BranchTo? ( a-addr -- a-addr )
1.17 jwilke 494: Display? IF dup BranchAddr?
1.15 pazsan 495: IF
496: BEGIN cell+ @ dup 20 u>
1.1 anton 497: IF drop nl S" BEGIN " .struc level+
498: ELSE
1.17 jwilke 499: dup Disable <> over LeaveCode <> and
1.1 anton 500: IF WhileCode2 =
501: IF nl S" THEN " .struc nl ELSE
502: level- nl S" THEN " .struc nl THEN
503: ELSE drop THEN
504: THEN
505: dup MoreBranchAddr? 0=
506: UNTIL
507: THEN
508: THEN ;
509:
510: : analyse ( a-addr1 -- a-addr2 )
1.34 anton 511: Branches @ IF BranchTo? THEN
512: dup cell+ swap @
513: dup >r DoTable r> swap IF drop EXIT THEN
514: Display?
515: IF
1.35 pazsan 516: .word bl cemit
1.34 anton 517: ELSE
518: drop
519: THEN ;
1.1 anton 520:
521: : c-init
522: 0 YPos ! 0 XPos !
523: 0 Level ! nlflag off
524: BranchTable BranchPointer !
525: c-stop off
526: Branches on ;
527:
528: : makepass ( a-addr -- )
1.14 anton 529: c-stop off
530: BEGIN
531: analyse
532: c-stop @
533: UNTIL drop ;
534:
535: Defer xt-see-xt ( xt -- )
536: \ this one is just a forward declaration for indirect recursion
537:
538: : .defname ( xt c-addr u -- )
539: rot look
540: if ( c-addr u nfa )
541: -rot type space .name
542: else
543: drop ." noname " type
544: then
545: space ;
546:
1.28 anton 547: Defer discode ( addr u -- ) \ gforth
548: \G hook for the disassembler: disassemble code at addr of length u
1.27 anton 549: ' dump IS discode
550:
551: : next-head ( addr1 -- addr2 ) \ gforth
552: \G find the next header starting after addr1, up to here (unreliable).
553: here swap u+do
554: i head?
555: if
556: i unloop exit
557: then
558: cell +loop
559: here ;
560:
561: : umin ( u1 u2 -- u )
562: 2dup u>
563: if
564: swap
565: then
566: drop ;
567:
1.28 anton 568: : next-prim ( addr1 -- addr2 ) \ gforth
569: \G find the next primitive after addr1 (unreliable)
1.27 anton 570: 1+ >r -1 primstart
571: begin ( umin head R: boundary )
572: @ dup
573: while
1.28 anton 574: tuck name>int >code-address ( head1 umin ca R: boundary )
1.27 anton 575: r@ - umin
576: swap
577: repeat
1.28 anton 578: drop dup r@ negate u>=
579: \ "umin+boundary within [0,boundary)" = "umin within [-boundary,0)"
580: if ( umin R: boundary ) \ no primitive found behind -> use a default length
581: drop 31
582: then
583: r> + ;
1.14 anton 584:
585: : seecode ( xt -- )
586: dup s" Code" .defname
1.39 anton 587: >code-address
1.27 anton 588: dup in-dictionary? \ user-defined code word?
589: if
590: dup next-head
591: else
592: dup next-prim
593: then
594: over - discode
595: ." end-code" cr ;
1.14 anton 596: : seevar ( xt -- )
597: s" Variable" .defname cr ;
598: : seeuser ( xt -- )
599: s" User" .defname cr ;
600: : seecon ( xt -- )
601: dup >body ?
602: s" Constant" .defname cr ;
603: : seevalue ( xt -- )
604: dup >body ?
605: s" Value" .defname cr ;
606: : seedefer ( xt -- )
607: dup >body @ xt-see-xt cr
608: dup s" Defer" .defname cr
1.26 anton 609: >name ?dup-if
610: ." IS " .name cr
1.14 anton 611: else
1.26 anton 612: ." lastxt >body !"
1.14 anton 613: then ;
614: : see-threaded ( addr -- )
615: C-Pass @ DebugMode = IF
616: ScanMode c-pass !
617: EXIT
1.10 anton 618: THEN
619: ScanMode c-pass ! dup makepass
620: DisplayMode c-pass ! makepass ;
1.14 anton 621: : seedoes ( xt -- )
622: dup s" create" .defname cr
623: S" DOES> " Com# .string XPos @ Level !
624: >does-code see-threaded ;
625: : seecol ( xt -- )
1.15 pazsan 626: dup s" :" .defname nl
1.14 anton 627: 2 Level !
628: >body see-threaded ;
629: : seefield ( xt -- )
630: dup >body ." 0 " ? ." 0 0 "
631: s" Field" .defname cr ;
632:
1.29 anton 633: : xt-see ( xt -- ) \ gforth
634: \G Decompile the definition represented by @i{xt}.
1.14 anton 635: cr c-init
636: dup >does-code
637: if
638: seedoes EXIT
639: then
1.18 jwilke 640: dup xtprim?
1.14 anton 641: if
642: seecode EXIT
643: then
644: dup >code-address
645: CASE
646: docon: of seecon endof
647: docol: of seecol endof
648: dovar: of seevar endof
1.18 jwilke 649: [ [IFDEF] douser: ]
1.14 anton 650: douser: of seeuser endof
1.18 jwilke 651: [ [THEN] ]
652: [ [IFDEF] dodefer: ]
1.14 anton 653: dodefer: of seedefer endof
1.18 jwilke 654: [ [THEN] ]
655: [ [IFDEF] dofield: ]
1.14 anton 656: dofield: of seefield endof
1.18 jwilke 657: [ [THEN] ]
1.27 anton 658: over of seecode endof \ direct threaded code words
659: over >body of seecode endof \ indirect threaded code words
1.14 anton 660: 2drop abort" unknown word type"
661: ENDCASE ;
662:
663: : (xt-see-xt) ( xt -- )
664: xt-see cr ." lastxt" ;
665: ' (xt-see-xt) is xt-see-xt
666:
667: : (.immediate) ( xt -- )
668: ['] execute = if
669: ." immediate"
670: then ;
671:
672: : name-see ( nfa -- )
673: dup name>int >r
674: dup name>comp
675: over r@ =
676: if \ normal or immediate word
677: swap xt-see (.immediate)
678: else
1.40 anton 679: r@ ['] ticking-compile-only-error =
1.14 anton 680: if \ compile-only word
681: swap xt-see (.immediate) ." compile-only"
682: else \ interpret/compile word
683: r@ xt-see-xt cr
684: swap xt-see-xt cr
685: ." interpret/compile " over .name (.immediate)
686: then
687: then
688: rdrop drop ;
1.3 pazsan 689:
1.21 crook 690: : see ( "<spaces>name" -- ) \ tools
691: \G Locate @var{name} using the current search order. Display the
692: \G definition of @var{name}. Since this is achieved by decompiling
693: \G the definition, the formatting is mechanised and some source
694: \G information (comments, interpreted sequences within definitions
695: \G etc.) is lost.
1.13 anton 696: name find-name dup 0=
697: IF
1.24 anton 698: drop -&13 throw
1.13 anton 699: THEN
1.14 anton 700: name-see ;
1.1 anton 701:
702:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>