|
|
1.1 root 1: /*
2: # ISCOPE(3.icon)
3: #
4: # Inspect Icon internals
5: #
6: # Ralph E. Griswold and William H. Mitchell
7: #
8: # Last modified 8/19/84
9: #
10: */
11:
12: #include "../h/rt.h"
13: #ifdef VAX
14:
15: /*
16: * Word2(x,y) - return second word of descriptor as integer
17: */
18:
19: XWord2(nargs, arg2, arg1, arg0)
20: int nargs;
21: struct descrip arg2, arg1, arg0;
22: {
23: long i;
24:
25: defint(&arg2, &i, 0);
26: if (i == 0)
27: DeRef(arg1)
28: mkint(arg1.value.integr, &arg0);
29: }
30:
31: Procblock(Word2,2)
32:
33: /*
34: * Word1(x,y) - return first word of descriptor as integer.
35: */
36:
37: XWord1(nargs, arg2, arg1, arg0)
38: int nargs;
39: struct descrip arg2, arg1, arg0;
40: {
41: long i;
42:
43: defint(&arg2, &i, 0);
44: if (i == 0)
45: DeRef(arg1)
46: mkint(arg1.type, &arg0);
47: }
48:
49: Procblock(Word1,2)
50:
51: /*
52: * Descr(x,y) - consstruct descriptor from integers i1 and i2.
53: */
54:
55: XDescr(nargs, arg2, arg1, arg0)
56: int nargs;
57: struct descrip arg2, arg1, arg0;
58: {
59: int t1, t2;
60: long i1, i2;
61: DeRef(arg1)
62: DeRef(arg2)
63: defint(&arg1, &i1, 0);
64: defint(&arg2, &i2, 0);
65: arg0.type = i1;
66: arg0.value.integr = i2;
67:
68: }
69:
70: Procblock(Descr,2)
71:
72: /*
73: * Indir(x) - return integer to where x points.
74: */
75:
76: XIndir(nargs, arg1, arg0)
77: int nargs;
78: struct descrip arg1, arg0;
79: {
80: int *i;
81: int j;
82:
83: DeRef(arg1)
84: i = (int *) arg1.value.integr;
85: j = *i;
86: mkint(j, &arg0);
87: }
88:
89: Procblock(Indir,1)
90:
91: XPfp(nargs, arg0)
92: int nargs;
93: struct descrip arg0;
94: {
95: register int r11, r10;
96:
97: asm(" movl 12(fp),r11");
98: mkint(r11, &arg0);
99: }
100: Procblock(Pfp,0)
101:
102: XEfp(nargs, arg0)
103: int nargs;
104: struct descrip arg0;
105: {
106: register int r11, r10;
107:
108: asm(" movl -4(ap),r11");
109: mkint(r11, &arg0);
110: }
111: Procblock(Efp,0)
112:
113: XGfp(nargs, arg0)
114: int nargs;
115: struct descrip arg0;
116: {
117: register int r11, r10;
118:
119: asm(" movl -8(ap),r11");
120: mkint(r11, &arg0);
121: }
122: Procblock(Gfp,0)
123:
124: /*
125: * Symbol(x) - get address of Icon symbol.
126: */
127:
128: XSymbol(nargs, arg1, arg0)
129: int nargs;
130: struct descrip arg1, arg0;
131: {
132: extern globals, eglobals, gnames;
133: char sbuf[MAXSTRING];
134: DeRef(arg1)
135: if (cvstr(&arg1, sbuf) == NULL)
136: runerr(103, &arg1);
137: qtos(&arg1, sbuf);
138: ((arg0).type) = D_INTEGER;
139: if (strcmp(sbuf, "globals") == 0)
140: INTVAL(arg0) = (int) &globals;
141: else if (strcmp(sbuf, "eglobals") == 0)
142: INTVAL(arg0) = (int) &eglobals;
143: else if (strcmp(sbuf, "gnames") == 0)
144: INTVAL(arg0) = (int) &gnames;
145: else if (strcmp(sbuf, "strings") == 0)
146: INTVAL(arg0) = (int) strings;
147: else if (strcmp(sbuf, "sfree") == 0)
148: INTVAL(arg0) = (int) sfree;
149: else if (strcmp(sbuf, "hpbase") == 0)
150: INTVAL(arg0) = (int) hpbase;
151: else if (strcmp(sbuf, "hpfree") == 0)
152: INTVAL(arg0) = (int) hpfree;
153: else if (strcmp(sbuf, "stacks") == 0)
154: INTVAL(arg0) = (int) stacks;
155: else if (strcmp(sbuf, "esfree") == 0)
156: INTVAL(arg0) = (int) esfree;
157: else fail();
158: }
159:
160: Procblock(Symbol,1)
161: #endif VAX
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.