-
Notifications
You must be signed in to change notification settings - Fork 2
/
linacrawl.cul
100 lines (77 loc) · 3.12 KB
/
linacrawl.cul
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
( $Id: linacrawl.cul,v 1.14 2019/10/18 16:33:41 albert Exp $ )
( Copyright{2000}: Albert van der Horst, HCC FIG Holland by GNU Public License)
( Uses Richard Stallmans convention. Uppercased word are parameters. )
HEX INIT-ALL
INCLUDE elf.cul
0804,A0DC CONSTANT semis \ Not EQU, to prevent duplicate labels.
0804,B7AC CONSTANT semiscode \ Not EQU, to prevent duplicate labels.
0804,A664 EQU docol
0804,BE3C LABEL donumber
0804,A6EC LABEL doconstant
0804,A72C LABEL dovar
0804,A75C LABEL douse
0804,B814 LABEL dodoes
0804,C828 LABEL DOVOC \ High level code.
0804,9968 LABEL init_user
0804,F82C EQU last_dea \ TASK
0804,95C4 EQU last_dea_envir
\ Align an address in the host space.
: hALIGN 1- 3 OR 1+ ;
CREATE NAME-BUFFER 0 , 256 ALLOT
\ Prepend to NAME a PREFIX, return prefixed NAME in a static buffer.
: PRE-PEND NAME-BUFFER $! NAME-BUFFER $+! NAME-BUFFER $@ ;
\ Transform NAME into: NAMELABEL (prepended "N_").
: >N_ "N_" PRE-PEND ;
\ ADDRESS points to a valid name. Add a label to address the name.
: ADD-NAME-LABEL DUP th $@ >N_ INSERT-EQU ;
\ Generate a equ label at (target) ADDRESS with NAME,
\ unless address is already labeled.
: ?LABELED? 2>R DUP >LABEL 0= IF 2R> INSERT-EQU ELSE 2R> 2DROP DROP THEN ;
\ ADDRESS points to a valid dea. Add a label to address the dea(xt)
\ and the datafield.
\ Assume that just before the dea's name has been analysed.
: ADD-DEA-LABEL &X NAME-BUFFER CELL+ C! DUP NAME-BUFFER $@ ?LABELED?
&H NAME-BUFFER CELL+ C! 4 + L@ NAME-BUFFER $@ ?LABELED? ;
\ ADDRESS points to a valid name.
\ Add an anonymous section to disassemble the name.
: ADD-NAME-SECTION DUP L@ hALIGN OVER + 4 + -d$- ;
\ ADDRESS points to a dea.
\ Add an anonymous section to disassemble the dea.
: ADD-DEA-SECTION DUP 18 + -dl- ;
\ Add the information that ADDRESS is a nfa.
: IS-A-NAME L@ DUP IF DUP ADD-NAME-LABEL ADD-NAME-SECTION _ THEN DROP ;
\ The CONTENT of address indicates : "This IS not yet the end of
\ high level code".
: STILL-CODE? >R R@ semis <> R@ semiscode <> AND RDROP ;
\ Add the information that ADDRESS points to high level code.
: IS-HIGH-LEVEL DUP BEGIN DUP L@ STILL-CODE? WHILE 4 + REPEAT 4 + -dl- ;
\ For CFA : "it POINTS to the high level interpreter"
: IS-DOCOL? L@ docol = ;
\ Accumulate the information that ADDRESS contains a code field address.
: IS-A-CFA DUP L@ CRAWL DUP IS-DOCOL? IF 4 + L@ IS-HIGH-LEVEL _ THEN DROP ;
\ Accumulate the information that DEA is a dea.
: IS-A-DEA DUP 8 + L@ 1 AND IF DROP EXIT THEN \ Dummy field
DUP 10 + IS-A-NAME DUP ADD-DEA-LABEL
DUP IS-A-CFA DUP ADD-DEA-SECTION
DROP ;
\ Accumulate the information from DEA as a wid, follow the link field.
: CRAWL-WID BEGIN DUP IS-A-DEA 0C + L@ DUP 0= UNTIL DROP ;
SORT-ALL
last_dea_envir CRAWL-WID
last_dea CRAWL-WID
SORT-ALL
\ User area contains longs
init_user DUP 100 + -dl-
\ Yet another buffer
0804,DA0C DUP 200 + -dl-
\ The data fields of vocabularies consist of pointers.
H_DENOTATION DUP 10 + -dl-
H_ENVIRONMENT DUP 10 + -dl-
H_FORTH DUP 10 + -dl-
MAKE-CUL
\ EXIT
CLEANUP-SECTIONS
MAKE-CUL
PLUG-HOLES
MAKE-CUL
DISASSEMBLE-ALL