![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tokunx.spt CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / spitbol|
Return to tokunx.spt CVS log | Up to [Research Unix] / researchv10no / cmd / spitbol |
1.1 root 1: -IN80
2: -TITLE TOKUNX: TRANSLATE FROM TOKENS TO UNIX ASSEMBLER
3: -STITL REVISION HISTORY
4: *
5: * 12-AUG-82 (REG):
6: * Read tokenized input and remove EQUATES processing
7: * 09-MAR-82 (SGD):
8: * CHK is back - better than ever...
9: * Copy .INI file to start of .MAR file
10: * 10-SEP-81 (SGD):
11: * Read in problem label table from filename.PLB
12: * 01-AUG-81 (SGD):
13: * Better encoding of CTB,CTW,BTW and WTB
14: * 13-MAY-81 (SGD):
15: * Added logic in XOP to put a longword type displacement on displacement
16: * operands as VMS assembler assumes a word displacement. (Phhhhaaa - ed)
17: * 15-MAR-81 (SGD):
18: * Made CHK a comment, as now handled as exception.
19: * 10-SEP-80 (SGD):
20: * Made revisions to make XFER reflect VAX SBL capabilities. Note that
21: * this version of XFER is no longer capable of running on PDP-11, since
22: * it will be too big. [Major change was to substitute tables for LOOKUP
23: * strings, and corresponding addition of TINIT].
24: * 02-AUG-80 (SGD):
25: * Altered translation of conditional branches to emit conditional
26: * branch directly. Those which cause problems are listed in a
27: * table that inhibits the direct translation.
28: * 18-MAY-80 (SGD):
29: * Fixed translation of vertical tab (CH$VT) from ASCII 011 to ASCII 012
30: * to conform to SOS Editor standard.
31: *
32: -STITL INTRODUCTION
33: *
34: * ________________________________
35: *
36: * Coded by:
37: * Steven G. Duff
38: * 1345-M16 Cabrillo Park Dr.
39: * Santa Ana, California 96701
40: * (714) 541-9619
41: *
42: * This is a Macro Spitbol program for translation of the Macro
43: * Spitbol Minimal Source to Vax 11/780 Macro Source. The program
44: * is fairly simple in order that it be able to run in the limited
45: * address space of a PDP-11. As a consequence, certain of the
46: * Minimal Opcodes are left untranslated, to be expanded as macros
47: * at assembly time. These macros are:
48: *
49: * AOV, BSW, CMC, CVD, CVM, ESW,
50: * IFF, LSX, MCB, MFI, MVC, MVW, MWB, RMI, SEC, TRC.
51: *
52: * There are two principal parts of Minimal that make translation
53: * tricky vis-a-vis VAX MACRO-32:
54: *
55: *
56: * Tricky #1: BSW,IFF and ESW normally require buffering, sorting
57: * etc. These can (and are) handled by macros though. BSW
58: * emits a CASEL and a word table containing the default
59: * value. IFF re-biases the location counter during assembly
60: * and overwrites the default word. ESW resets the location
61: * counter back. XFER is not capable of handling the needed
62: * computation without more working store.
63: *
64: * VVVVVVVVV NOW HANDLED BY TOKENIZER
65: * Tricky #2: Minimal operands of the form DLBL(X) must be translated
66: * to 4*DLBL(X) as called for by the language spec. This
67: * requires that XFER be able to distinguish DLBLs from other
68: * stuff. This in turn means that a record of all EQU labels
69: * must be kept. This eats up a lot of working store, but
70: * can't be helped.
71: *
72: * The other macro-ops are simple enough, and are omitted purely to
73: * avoid using up dynamic unnecessarily.
74: -EJECT
75: * This program works with four files, with the same name, and
76: * different extensions. Name.MIN is used as the source input
77: * file. Name.MAR is created and becomes the source output file.
78: * Name.ERR is created, and is where the ERR and ERB messages and
79: * numbers are written. Name.INI is a prefix (MACRO32) file
80: * that is read as input and copied to Name.MAR before translation
81: * begins.
82: *
83: * The VAX assembler does not permit an equate to a register symbol
84: * for the purpose of creating symbolic register names.
85: * Thus this translator maps registers from Minimal to Vax thusly:
86: *
87: * RA <=> R2
88: * CP <=> R3
89: * IA <=> R5
90: * WA <=> R6
91: * WB <=> R7
92: * WC <=> R8
93: * XR <=> R9
94: * XL <=> R10 (XT ALSO)
95: * XS <=> SP (R14)
96: *
97: * Additionally, there are two other 'phantom' registers assumed
98: * by the translator - a scratch register (SR) which is used by
99: * a few instructions and by some of the character macros for
100: * holding temps, and EXI for returns. For remaindering,
101: * a register (IA2) is presumed to be available immediately below IA.
102: * The mappings of these registers are:
103: *
104: * IA2 <=> R4
105: * SR <=> R11
106: *
107: * Changes to this mapping are ill-advised and difficult.
108: *
109: *
110: * XFER aint got much smarts (it cant afford them). Except for cursory
111: * syntax and opcode checks, almost anything will get through, so it
112: * should be said that it expects valid Minimal Source. Simple errors
113: * are flagged on the listing (with a traceback) and a count given at
114: * the end, so they should not be too hard to find.
115: -STITL INITIALIZATION
116: * WARNING - POST NO LABELS!!!!!
117: * -----------------------------
118: * No labels should appear in this initializing code that would prevent
119: * the code from being garbage-collected by SPITBOL.
120: -SPACE 3
121: * Keyword initialization
122: *
123: &ANCHOR = 1; &TRIM = 1; &STLIMIT = -1
124: *
125: * Useful constants
126: *
127: MINLETS = 'ABCDEFGHIJKLMNOPQRSTUVWXY$'
128: ucase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
129: lcase = 'abcdefghijklmnopqrstuvwxyz'
130: NOS = '0123456789'
131: TAB = SUBSTR( &ALPHABET,10,1 )
132: REGNAME = ('X' ANY('LSTR')) | ('W' ANY('ABC')) | 'IA' | 'RA' | 'CP'
133: *
134: * Zero the counts
135: *
136: LABCNT = NOUTLINES = NLINES = NSTMTS = NTARGET = NERRORS = 0
137: *
138: * Get file name
139: *
140: FILENAMI = INPUT
141: TERMINAL = 'TOKEN file: ' FILENAMI
142: TERMINAL =
143: FILENAMP = INPUT
144: TERMINAL = 'Problem label file: ' FILENAMP
145: TERMINAL =
146: FILENAMO = INPUT
147: TERMINAL = 'ASSEMBLER file: ' FILENAMO
148: TERMINAL =
149:
150: FLCFLAG = REPLACE( INPUT,'y','Y' )
151: TERMINAL = 'Full line comments passed? ' FLCFLAG
152: *
153: * No page ejects without full line comments
154: *
155: TERMINAL = DIFFER(FLCFLAG,'N')
156: EJCFLAG = REPLACE( (DIFFER(FLCFLAG,'N') INPUT, 'N'),'y','Y' )
157: TERMINAL = 'EJCs passed? ' EJCFLAG
158: -STITL XFER FUNCTIONS
159: * TINIT is used during initialization to take a string of the
160: * form "index1[value1]index2[value2]...indexn[valuen]" and
161: * stuff the index/value pairs into a table which it returns.
162: *
163: DEFINE('TINIT(STR)POS,CNT,INDEX,VAL,LASTVAL')
164: * CRACK parses STMT into a STMT data plex and returns it.
165: * It fails if there is a syntax error.
166: *
167: DEFINE('CRACK(LINE)LABEL,OPCODE,OPERANDS,COMMENT,OPERAND,CHAR')
168: *
169: * STMT is the common data plex used to hold the components of
170: * a statement (either Minimal or VAX) during processing.
171: *
172: DATA('STMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)')
173: *
174: * MINLABEL is a pattern matching a valid Minimal Source Label.
175: *
176: MINLABEL = ANY(MINLETS) ANY(MINLETS) ANY(MINLETS NOS)
177: + ANY(MINLETS NOS) ANY(MINLETS NOS)
178: *
179: * MINCOND is a pattern that matches Minimal Conditional assembly ops
180: *
181: MINCOND = 'IF' | 'THEN' | 'ELSE' | 'FI' | 'DEF' | 'UNDEF'
182: *
183: -EJECT
184: * DOSTMT is the driver routine that causes processing of the
185: * statement plex in THISSTMT.
186: *
187: DEFINE('DOSTMT()LABEL,OPCODE,OP1,OP2,OP3,COMMENT,T')
188: *
189: * HANDLER is a table providing the name of the processing appendage
190: * for every Minimal Op-Code. The name in this table is prefixed with
191: * "H_" to get the string name of the appendage. Every op must be
192: * in this string, including conditional ops.
193: *
194: HANDLER = TINIT(
195: + 'ADD[H]ADI[ADD2]ADR[ADD2]ANB[ANB]'
196: + 'AOV[AOV]BCT[H]BEQ[BCMP]BGE[BCMP]'
197: + 'BGT[BCMP]BHI[BCMP]BLE[BCMP]BLO[BCMP]'
198: + 'BLT[BCMP]BNE[BCMP]BRN[H]BRI[BRI]'
199: + 'BNZ[BTST]'
200: + 'BSW[BSW]BTW[BTW]BZE[BTST]CEQ[BCMP]'
201: + 'CHK[SBCALL]CMB[CMB]CMC[CMC]CNE[BCMP]'
202: + 'CSC[NOOP]CTB[CTX]CTW[CTX]CVD[CVD]'
203: + 'CVM[CVM]DAC[H]DBC[H]DCA[NEW1]'
204: + 'DCV[H]DEF[ZZZ]DIC[DXC]DRC[DXC]'
205: + 'DTC[DTC]DVI[ADD2]DVR[ADD2]EJC[EJC]'
206: + 'ELSE[ZZZ]END[END]ENP[NOOP]ENT[ENT]'
207: + 'EQU[EQU]ERB[ERX]ERR[ERX]ESW[NOOP]'
208: + 'EXI[EXI]EXP[GBLS]FI[ZZZ]FLC[FLC]ICA[NEW1]'
209: + 'ICP[ICP]ICV[H]IEQ[ATST]IF[ZZZ]'
210: + 'IFF[IFF]IGE[ATST]IGT[ATST]ILE[ATST]'
211: + 'ILT[ATST]INE[ATST]INO[OVF]INP[GBLS]'
212: + 'INR[GBLS]IOV[OVF]ITR[ITR]JSR[H]'
213: + 'LCH[SWP12]LCT[LCT]LCP[ADD2]LCW[NEW1]'
214: + 'LDI[ADD2]LDR[ADD2]LEI[LEI]LSH[XSH]'
215: + 'LSX[H]MCB[SBCALL]MFI[MFI]MLI[ADD2]MLR[ADD2]'
216: + 'MNZ[NEW1]MOV[H]MTI[ADD2]MVC[SBCALL]'
217: + 'MVW[SBCALL]MWB[SBCALL]NGI[NGX]NGR[NGX]'
218: + 'NZB[BTST]ORB[H]PLC[PXC]PPM[PPM]'
219: + 'PRC[PRC]PSC[PXC]REQ[ATST]RGE[ATST]'
220: + 'RGT[ATST]RLE[ATST]RLT[ATST]RMI[RMI]'
221: + 'RNE[ATST]RNO[OVF]ROV[OVF]RSH[XSH]'
222: + 'RSX[H]RTI[RTI]RTN[NOOP]SBI[ADD2]'
223: + 'SBR[ADD2]SCH[H]SCP[NEW1]SEC[SEC]'
224: + 'SSL[NOOP]SSS[NOOP]STI[STX]STR[STX]'
225: + 'SUB[H]THEN[ZZZ]TRC[SBCALL]TTL[TTL]'
226: + 'ZZZ[UNDEF]WTB[WTB]XOB[H]'
227: + 'ZER[H]ZGB[NOOP]ZRB[BTST]')
228: *
229: * H_ADD2.OPS is used by the H_ADD2 appendage to find
230: * the operand it is to insert.
231: *
232: H_ADD2.OPS = TINIT(
233: + 'ADI[R5]ADR[R2]DVI[R5]DVR[R2]LCP[R3]LDI[R5]'
234: + 'LDR[R2]MLI[R5]MLR[R2]MTI[R5]SBI[R5]SBR[R2]')
235: -EJECT
236: * H_BNCH.OPCS provides opcode translations for branch-type
237: * instructions. Branches are emitted directly, unless they are
238: * in the H_BNCH.PLAB problem label table, in which case an inverted
239: * branch/jump combination is emitted.
240: *
241: H_BNCH.OPCS = TINIT('BEQ[BEQLU]BGE[BGEQU]BGT[BGTRU]BHI[BGEQU]'
242: + 'BLE[BLEQU]BLO[BLEQU]BLT[BLSSU]BNE[BNEQU]'
243: + 'BNZ[BNEQU]BZE[BEQLU]CEQ[BEQLU]'
244: + 'CNE[BNEQU]IEQ[BEQL]IGE[BGEQ]IGT[BGTR]'
245: + 'ILE[BLEQ]ILT[BLSS]INE[BNEQ]INO[BVC]'
246: + 'IOV[BVS]NZB[BNEQU]'
247: + 'REQ[BEQL]RGE[BGEQ]RGT[BGTR]RLE[BLEQ]'
248: + 'RLT[BLSS]RNE[BNEQ]RNO[BVC]ROV[BVS]'
249: + 'ZRB[BEQLU]')
250: *
251: * H_BNCH.PLAB is a list of problem labels which for which 'short'
252: * conditional jumps cannot be issued, because one or more instructions
253: * in the code cause range trouble. Inverted branches are emitted
254: * instead.
255: *
256: H_BNCH.PLAB = TABLE(101)
257: *
258: * H_BNCH.IOCS is a translate list for the inverted branches needed
259: * for problem labels.
260: *
261: H_BNCH.IOCS = TINIT('BEQ[BNEQU]BGE[BLSSU]BGT[BLEQU]BHI[BLSSU]'
262: + 'BLE[BGTRU]BLO[BGTRU]BLT[BGEQU]BNE[BEQLU]'
263: + 'BNZ[BEQLU]BZE[BNEQU]CEQ[BNEQU]'
264: + 'CNE[BEQLU]IEQ[BNEQ]IGE[BLSS]IGT[BLEQ]'
265: + 'ILE[BGTR]ILT[BGEQ]INE[BEQL]INO[BVS]'
266: + 'IOV[BVC]NZB[BEQLU]'
267: + 'REQ[BNEQ]RGE[BLSS]RGT[BLEQ]RLE[BGTR]'
268: + 'RLT[BGEQ]RNE[BEQL]RNO[BVS]ROV[BVC]'
269: + 'ZRB[BNEQU]')
270: *
271: * H_EQU.DEFS is used by H_EQU to insert the fluid EQU
272: * definitions (...EQU *).
273: *
274: H_EQU.DEFS = TINIT(
275: + 'CFP$A[256]CFP$B[4]CFP$C[4]CFP$F[8]'
276: + 'CFP$I[1]CFP$M[0X7FFFFFFF]CFP$N[32]'
277: + 'NSTMX[10]CFP$R[1]CFP$S[6]CFP$X[2]'
278: + 'CFP$U[128]'
279: + 'E$SRS[50]E$STS[512]E$CBS[512]E$HNB[253]'
280: + 'E$HNW[3]E$FSP[20]'
281: + 'CH$LA[065]CH$LB[066]CH$LC[067]CH$LD[068]'
282: + 'CH$LE[069]CH$LF[070]CH$LG[071]CH$LH[072]'
283: + 'CH$LI[073]CH$LJ[074]CH$LK[075]CH$LL[076]'
284: + 'CH$LM[077]CH$LN[078]CH$LO[079]CH$LP[080]'
285: + 'CH$LQ[081]CH$LR[082]CH$LS[083]CH$LT[084]'
286: + 'CH$LU[085]CH$LV[086]CH$LW[087]CH$LX[088]'
287: + 'CH$LY[089]CH$L$[090]'
288: + 'CH$D0[048]CH$D1[049]CH$D2[050]CH$D3[051]'
289: + 'CH$D4[052]CH$D5[053]CH$D6[054]CH$D7[055]'
290: + 'CH$D8[056]CH$D9[057]'
291: + 'CH$$A[097]CH$$B[098]CH$$C[099]CH$$D[100]'
292: + 'CH$$E[101]CH$$F[102]CH$$G[103]CH$$H[104]'
293: + 'CH$$I[105]CH$$J[106]CH$$K[107]CH$$L[108]'
294: + 'CH$$M[109]CH$$N[110]CH$$O[111]CH$$P[112]'
295: + 'CH$$Q[113]CH$$R[114]CH$$S[115]CH$$T[116]'
296: + 'CH$$U[117]CH$$V[118]CH$$W[119]CH$$X[120]'
297: + 'CH$$Y[121]CH$$$[122]'
298: + 'CH$AM[038]CH$AS[042]CH$AT[064]CH$BB[060]'
299: + 'CH$BL[032]CH$BR[124]CH$CL[058]CH$CM[044]'
300: + 'CH$DL[036]CH$DT[046]CH$DQ[034]CH$EQ[061]'
301: + 'CH$EX[033]CH$MN[045]CH$NM[035]CH$NT[126]'
302: + 'CH$PC[037]CH$PL[043]CH$PP[040]CH$RB[062]'
303: + 'CH$RP[041]CH$QU[063]CH$SL[047]CH$SM[059]'
304: + 'CH$SQ[039]CH$UN[095]CH$OB[091]CH$CB[093]'
305: + 'CH$HT[009]CH$VT[012]IODEL[000]')
306: -EJECT
307: * H_H.XOPS is a table that encodes opcode translation
308: * for H_H.
309: *
310: H_H.XOPS = TINIT(
311: + 'ADD[ADDL2]ADI[ADDL2]ADR[ADDF2]ANB[BICL2]'
312: + 'BCT[SOBGTR]'
313: + 'BRN[JMP]'
314: + 'CMB[MCOML]'
315: + 'CTB[BICL2]CTW[ASHL]'
316: + 'DAC[.LONG]DBC[.LONG]'
317: + 'DCA[SUBL2]DCV[DECL]DIC[.LONG]DRC[.FLOAT]'
318: + 'DVI[DIVL2]DVR[DIVF2]EJC[#PAGE]'
319: + 'ERB[JMP]'
320: + 'ERR[.LONG]'
321: + 'ICA[ADDL2]ICP[TSTL]ICV[INCL]'
322: + 'ITR[CVTLF]JSR[JSB]'
323: + 'LCH[MOVZBL]LCT[MOVL]LCP[MOVL]LCW[MOVL]'
324: + 'LDI[MOVL]LDR[MOVF]LEI[MOVZWL]LSH[ASHL]'
325: + 'MLI[MULL2]MLR[MULF2]'
326: + 'MNZ[MOVL]MOV[MOVL]MTI[MOVL]'
327: + 'NGI[MNEGL]NGR[MNEGF]'
328: + 'ORB[BISL2]PPM[.LONG]'
329: + 'RSH[ASHL]'
330: + 'SBI[SUBL2]'
331: + 'SBR[SUBF2]SCH[MOVB]SCP[MOVL]'
332: + 'SEC[#SEC]'
333: + 'STI[MOVL]STR[MOVF]'
334: + 'SUB[SUBL2]'
335: + 'TTL[#TITLE]'
336: + 'XOB[XORL2]ZER[CLRL]')
337: *
338: * H_NEW1.OPS is a table used by the H_NEW1 appendage to find
339: * the operand to insert. It is indexed by opcode.
340: *
341: H_NEW1.OPS = TINIT(
342: + 'ICA[$4]DCA[$4]'
343: + 'LCW[(R3)+]MNZ[SP]SCP[R3]')
344: *
345: * Associate file for ERB,ERR messages in H_ERX
346: *
347: OUTPUT(.ERRFILE,4,(IDENT(FILENAMO) '', 'min.err'))
348: -EJECT
349: * Error is used to report an error for THISSTMT
350: *
351: DEFINE('ERROR(TEXT)')
352: -SPACE 3
353: * OUTSTMT is used to send a target statement to the target code
354: * output file (OUTFILE <=> LU2)
355: *
356: DEFINE('OUTSTMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)T,STMTOUT')
357: *
358: * Associate output file
359: *
360: OUTPUT(.OUTFILE,2,(IDENT(FILENAMO) '', FILENAMO))
361: *
362: * OS.LLS is used by OUTSTMT to recognise local labels
363: *
364: OS.LLS = SPAN(NOS) '$' RPOS(0)
365: *
366: * READLINE is called to return the next non-comment line from
367: * the Minimal input file (INFILE <=> LU1). Note that it will
368: * not fail on EOF, but it will return a Minimal END statement
369: *
370: DEFINE('READLINE()')
371: *
372: * Associate input file to LU1
373: *
374: INPUT(.INFILE,1,(IDENT(FILENAMI) '', FILENAMI))
375: -EJECT
376: *
377: * XOP.REGS is a pattern to match out register names for translation.
378: *
379: XOP.REGS = (*REGNAME . VAL RPOS(0) . PREFIX) |
380: + (BREAK('(') LEN(1)) . PREFIX LEN(2) . VAL
381: *
382: * XOP.XREGS is a table with register translations
383: *
384: XOP.XREGS = TINIT('IA[R5]RA[R2]CP[R3]WA[R6]WB[R7]WC[R8]XR[R9]'
385: + 'XL[R10]XT[R10]XS[SP]')
386: *
387: * XPINTX is a pattern that will match the INT(X) type operand
388: *
389: XPINTX = SPAN(NOS) . VAL '('
390: *
391: * XPDLBLX is a pattern that will match the DLBL(X) type operand
392: *
393: XPDLBLX = MINLABEL . VAL '('
394: -STITL MAIN PROGRAM
395: * Here follows the driver code for the "main" program.
396: -SPACE 3
397: * Read the problem label table
398: *
399: INPUT(.PLTAB,.PLTAB,DIFFER(FILENAMP) FILENAMP) :F(MN02)
400: MN01 H_BNCH.PLAB[PLTAB] = 1 :S(MN01)
401: ENDFILE(.PLTAB)
402: MN02
403: *
404: * Loop until program exits via H_END
405: *
406: MN04 DOSTMT() :(MN04)
407: -STITL CRACK(LINE)
408: * CRACK is called to create a STMT plex containing the various
409: * entrails of the Minimal Source statement in LINE. For
410: * conditional assembly ops, the opcode is the op, and OP1
411: * is the symbol. Note that DTC is handled as a special case to
412: * assure that the decomposition is correct.
413: *
414: * CRACK will print an error and fail if a syntax error occurs.
415: *
416: CRACK NSTMTS = NSTMTS + 1
417: LINE '{' BREAK( '{' ) . LABEL
418: + '{' BREAK( '{' ) . OPCODE
419: + '{' BREAK( '{' ) . OP1
420: + '{' BREAK( '{' ) . OP2
421: + '{' BREAK( '{' ) . OP3
422: + '{' REM . COMMENT :F(CS03)
423: IDENT(OPCODE,'DTC') :S(CS00)
424: OP1 ANY('@') = '*'
425: OP1 ANY('#') = '$'
426: OP2 ANY('@') = '*'
427: OP2 ANY('#') = '$'
428: CS00 CRACK = STMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)
429: *
430: * Operands all parsed out. That's all folks.
431: *
432: CS01 :(RETURN)
433: *
434: * Here on syntax error
435: *
436: CS03 ERROR('SOURCE LINE SYNTAX ERROR') :(FRETURN)
437: -STITL DOSTMT()
438: * DOSTMT is invoked to initiate processing of the next line from
439: * READLINE. For efficient access
440: * DOSTMT puts name values corresponding to the components in
441: * variables with the same names (LABEL, OPCODE, OP1,OP2,OP3 and
442: * COMMENT) which allows the various handlers to $var to store/fetch
443: * the values of the statment.
444: *
445: * After doing this, DOSTMT branches to the handler routine indicated
446: * for this opcode in the HANDLER table (there must be an entry or
447: * an error results). The handlers all have entry points beginning
448: * with "H_", and can be considered a logical extension of the
449: * DOSTMT routine. The handlers have the choice of branching back
450: * to DSGEN to cause the THISSTMT plex to be sent to OUTSTMT, or
451: * of RETURNing themselves, in which case the handler must output
452: * all needed code itself.
453: *
454: * The handlers are listed in a separate section below.
455: *
456: DOSTMT THISLINE = READLINE()
457: THISSTMT = CRACK(THISLINE) :F(DOSTMT)
458: LABEL = .LABEL(THISSTMT)
459: OPCODE = .OPCODE(THISSTMT)
460: MINOP = $OPCODE
461: OP1 = .OP1(THISSTMT)
462: OP2 = .OP2(THISSTMT)
463: OP3 = .OP3(THISSTMT)
464: COMMENT = .COMMENT(THISSTMT)
465: *
466: * Get handler entry point (less "H_" prefix)
467: *
468: DIFFER(T = HANDLER[$OPCODE]) :F(DS01)
469: *
470: * Jump to handler
471: *
472: :($('H_' T))
473: *
474: * Here if bad OpCode
475: *
476: DS01 ERROR('BAD OP-CODE') :(RETURN)
477: *
478: * Handlers can come back here to cause code generation of THISSTMT
479: *
480: DSGEN OUTSTMT($LABEL,$OPCODE,$OP1,$OP2,$OP3,$COMMENT) :(RETURN)
481: -STITL ERROR(TEXT)
482: * This module handles reporting of errors with the offending
483: * statement text in THISLINE. Comments explaining
484: * the error are written to the listing (including error chain), and
485: * the appropriate counts are updated.
486: *
487: ERROR OUTFILE = '# *???* ' THISLINE
488: OUTFILE = '# ' TEXT
489: + (IDENT(LASTERROR),'. LAST ERROR WAS LINE ' LASTERROR)
490: LASTERROR = NOUTLINES
491: NOUTLINES = NOUTLINES + 2
492: NERRORS = NERRORS + 1
493: + :(RETURN)
494: -STITL OUTSTMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)
495: * This module writes the components of the VAX MACRO statement
496: * passed in the argument list to the formatted .MAR file
497: *
498: OUTSTMT STMTOUT = (IDENT(LABEL) TAB,
499: + LABEL ':' TAB)
500: + OPCODE (GT(SIZE(OPCODE),7) ' ', TAB)
501: + (IDENT(OP1), OP1
502: + (IDENT(OP2), ',' OP2
503: + (IDENT(OP3), ',' OP3)))
504: + (IDENT(COMMENT),
505: + (GT(T = SIZE(OP1 OP2 OP3), 16) ' ',
506: + DUPL(TAB, (22 - T) / 8))
507: + '# ' COMMENT)
508: *
509: * Translate everything but string constants to lower case.
510: *
511: stmtout = differ( opcode,'.ASCII' )
512: + replace( stmtout,ucase,lcase )
513: stmtout ident( opcode,'.ASCII' )
514: + ( break(*tab) *tab break(*tab) ) $ t =
515: + replace( t,ucase,lcase )
516: *
517: * Send text to OUTFILE
518: *
519: OUTFILE = STMTOUT
520: NTARGET = NTARGET + 1
521: NOUTLINES = NOUTLINES + 1
522: + :(RETURN)
523: -STITL READLINE()
524: * This routine returns the next statement line in the input file
525: * to the caller. It never fails. If there is no more input,
526: * then a Minimal END statement is returned.
527: * Comments are passed through to the output file directly.
528: *
529: *
530: READLINE READLINE = INFILE :F(RL02)
531: NLINES = NLINES + 1
532: READLINE ANY('*') = '#' :F(RL01)
533: *
534: * Only print comment if requested.
535: *
536: OUTFILE = IDENT(FLCFLAG,'Y') READLINE :F(READLINE)
537: NOUTLINES = NOUTLINES + 1 :(READLINE)
538: *
539: * Here if not a comment line
540: *
541: RL01 :(RETURN)
542: *
543: * Here on EOF
544: *
545: RL02 READLINE = ' END'
546: :(RL01)
547: -STITL TINIT(STR)
548: * This routine is called to initialize a table from a string of
549: * index/value pairs.
550: *
551: TINIT POS = 0
552: *
553: * Count the number of "[" symbols to get an assessment of the table
554: * size we need.
555: *
556: TIN01 STR (TAB(*POS) '[' BREAK(']') *?(CNT = CNT + 1) @POS)
557: + :S(TIN01)
558: *
559: * Allocate the table, and then fill it. Note that a small memory
560: * optimisation is attempted here by trying to re-use the previous
561: * value string if it is the same as the present one.
562: *
563: TINIT = TABLE(CNT)
564: TIN02 STR (BREAK('[') $ INDEX LEN(1) BREAK(']') $ VAL LEN(1)) =
565: + :F(RETURN)
566: VAL = CONVERT(VAL,'INTEGER')
567: VAL = IDENT(VAL,LASTVAL) LASTVAL
568: LASTVAL = VAL
569: TINIT[INDEX] = VAL :(TIN02)
570: -STITL OPCODE HANDLER APPENDAGES
571: * Ops that need a second operand (get from table).
572: *
573: H_ADD2 $OP2 = H_ADD2.OPS[$OPCODE] :(H_H)
574: -SPACE 3
575: * Do ANB opcode
576: *
577: H_ANB OUTSTMT($LABEL,'MCOML',$OP1,'R11',,$COMMENT)
578: $OP1 = 'R11'
579: $LABEL = $COMMENT = :(H_H)
580: -SPACE 3
581: * DO AOV
582: *
583: H_AOV OUTSTMT($LABEL,'ADDL2',$OP1,$OP2,,$COMMENT)
584: OUTSTMT(,'BVC','0F')
585: OUTSTMT(,'JMP',$OP3)
586: OUTSTMT('0') :(RETURN)
587: -SPACE 3
588: * Real and Integer Branch tests
589: * CHANGE CALL OF XOP TO XOP.XREGS LOOKUP
590: *
591: H_ATST OUTSTMT($LABEL,'TST' (IDENT(SUBSTR($OPCODE,1,1),'R') 'F', 'L'),
592: + XOP.XREGS[SUBSTR($OPCODE,1,1) 'A'],,,$COMMENT)
593: $OP2 = $OP1 :(H_BNCH)
594: -SPACE 3
595: * Comparison branches - emit a CMPL
596: *
597: H_BCMP OUTSTMT($LABEL,'CMPL',$OP1,$OP2,,$COMMENT)
598: $OP2 = $OP3 :(H_BNCH)
599: -SPACE 3
600: * Entered via various handlers to generate conditional branch code
601: *
602: H_BNCH DIFFER(H_BNCH.PLAB[$OP2]) :S(H_BNCH01)
603: OUTSTMT(,H_BNCH.OPCS[$OPCODE],$OP2) :(RETURN)
604: H_BNCH01 OUTSTMT(,H_BNCH.IOCS[$OPCODE],'0F')
605: OUTSTMT(,'JMP',$OP2)
606: OUTSTMT('0') :(RETURN)
607: -SPACE 3
608: * Handle BRI instruction with indirection
609: *
610: H_BRI OUTSTMT($LABEL,'MOVL',$OP1,'R11',,$COMMENT)
611: OUTSTMT(,'JMP','(R11)') :(RETURN)
612: -EJECT
613: *
614: * BSW generates a CASEL and a label for .WORD references.
615: *
616: h_bsw outstmt( $label,'CASEL',$OP1,'$0','$' $OP2,$COMMENT )
617: outstmt( '5' ) :(return)
618: -SPACE 3
619: * Zero branch comparisons
620: *
621: H_BTST OUTSTMT($LABEL,'TSTL',$OP1,,,$COMMENT)
622: + :(H_BNCH)
623: -EJECT
624: * BTW opcode
625: *
626: H_BTW OUTSTMT($LABEL,'ASHL','$-2',$OP1,$OP1,$COMMENT) :(RETURN)
627: -SPACE 3
628: * Do CMB instruction by duping operand for MCOML
629: *
630: H_CMB $OP2 = $OP1 :(H_H)
631: -SPACE 3
632: * DO CMC INSTRUCTION BY SUBROUTINE CALL
633: *
634: H_CMC OUTSTMT($LABEL,'JSB','SBCMC',,,$COMMENT)
635: OUTSTMT(,'.LONG',$OP1)
636: OUTSTMT(,'.LONG',$OP2) :(RETURN)
637: -SPACE 3
638: * Do CTB and CTW
639: *
640: H_CTX OUTSTMT($LABEL,'MOVAB','3+(4*' $OP2 ')(' $OP1 ')',$OP1,,$COMMENT)
641: $LABEL = $COMMENT =
642: $OP2 = $OP1
643: $OP1 = (IDENT($OPCODE,'CTB') '$3','$-2')
644: $OP3 = IDENT($OPCODE,'CTW') $OP2 :(H_H)
645: -SPACE 3
646: * DO CVD
647: *
648: H_CVD OUTSTMT($LABEL,'ASHQ','$-32','R4','R4',$COMMENT)
649: OUTSTMT(,'EDIV','$10','R4,R5,R6')
650: OUTSTMT(,'MNEGL','R6','R6')
651: OUTSTMT(,'BISB2','$0X30','R6') :(RETURN)
652: -SPACE 3
653: * DO CVM
654: *
655: H_CVM OUTSTMT($LABEL,'MULL2','$10','R5',,$COMMENT)
656: OUTSTMT(,'BVC','0F')
657: OUTSTMT(,'JMP',$OP1)
658: OUTSTMT('0','BICL2','$0XFFFFFFF0','R7')
659: OUTSTMT(,'SUBL2','R7','R5')
660: OUTSTMT(,'BVC','1F')
661: OUTSTMT(,'JMP',$OP1)
662: OUTSTMT('1') :(RETURN)
663: -SPACE 3
664: * Handle DIC and DRC by stripping leading plus (UNIX as does not
665: * support unary plus) and placing "0f" in front of single
666: * precision floating point constants.
667: *
668: h_dxc $op1 '+' =
669: $op1 = ident( $opcode,'DRC' ) '0f' $op1 :(h_h)
670: -SPACE 3
671: * Handle DTC by emitting .ASCII and then alignment order
672: *
673: H_DTC $OP1 = '"' SUBSTR($OP1,2,SIZE($OP1) - 2) '"'
674: OUTSTMT($LABEL,'.ASCII',$OP1,,,$COMMENT)
675: OUTSTMT(,'.ALIGN','2',) :(RETURN)
676: -SPACE 3
677: * EJC checks to see if page feeds are to be passed.
678: *
679: H_EJC IDENT(EJCFLAG,'Y') :S(H_H)F(RETURN)
680: -SPACE 3
681: * END prints statistics on terminal then exits program
682: *
683: H_END OUTSTMT(,'#END',,,,$COMMENT)
684: TERMINAL = '*** TRANSLATION COMPLETE ***'
685: TERMINAL = NLINES ' LINES READ.'
686: TERMINAL = NSTMTS ' STATEMENTS PROCESSED.'
687: TERMINAL = NTARGET ' TARGET CODE LINES PRODUCED.'
688: TERMINAL = NERRORS ' ERRORS OCCURRED.'
689: TERMINAL = DIFFER(LASTERROR) 'THE LAST ERROR WAS IN LINE ' LASTERROR
690: &CODE = NE(NERRORS) 2001
691: :(END)
692: -EJECT
693: * ENT emits the word ID (if needed) and the entry label
694: *
695: H_ENT IDENT($OP1) :S(H_ENT01)
696: OUTSTMT(,'.ALIGN','2')
697: OUTSTMT(,'.WORD',$OP1)
698: *
699: * Merge here to emit label entry point
700: *
701: H_ENT01 OUTSTMT($LABEL,,,,,$COMMENT) :(RETURN)
702: * Handle EQU by substituting '*' operands from definitions table
703: * if necessary
704: *
705: H_EQU $OP2 = $OP1
706: $OPCODE = '.SET'
707: $OP1 = $LABEL
708: $OP2 = IDENT($OP2,'*') H_EQU.DEFS[$LABEL]
709: $LABEL = :(DSGEN)
710: -SPACE 3
711: * Handle ERB and ERR in essentially the same way. First, send
712: * the message to the auxilliary .ERR file. Then make sure to
713: * note if this is the highest error # seen so far, so branch
714: * table can be properly emitted (see SEC). Then set OP1 to
715: * be "ERROR_" concatenated with the error number. This label
716: * refers to a label in the jump table that will load this error
717: * code in WA and jump to ERROR$.
718: *
719: H_ERX ERRFILE = LPAD($OP1,3,0) ($COMMENT = (IDENT($OP2), $OP2 ' ')
720: + $COMMENT)
721: MAXERR = GT($OP1,MAXERR) $OP1
722: $OP1 = 'ER_' LPAD($OP1,3,0)
723: $OP2 = :(H_H)
724: -EJECT
725: * There are 8 cases to EXI, partitioned along 3 binary dimensions.
726: * These are: 1. OP1 given/not given, 2. PTYPE is R/E or N,
727: * 3. OP1=1 (or #Ppms=0 if OP1 not given). Each possibility generates
728: * slightly different code.
729: *
730: H_EXI IDENT($OP1) :S(H_EXI00)
731: T = (IDENT(PTYPE,'N') PNAME '_S','(SP)+')
732: (EQ($OP1,1) OUTSTMT($LABEL,'MOVL',T,'R11',,$COMMENT),
733: + OUTSTMT($LABEL,'ADDL3','$4*' $OP1 - 1,T,'R11',$COMMENT))
734: OUTSTMT(,'JMP','*(R11)+') :(H_EXI04)
735: *
736: * Here if EXI has no OP1 given (normal exit)
737: *
738: H_EXI00 EQ(PPMS,0) :S(H_EXI02)
739: IDENT(PTYPE,'N') :S(H_EXI01)
740: *
741: * No OP1, #PPMs>0 and R/E-type
742: *
743: OUTSTMT($LABEL,'ADDL2','$4*' PPMS,'(SP)',,$COMMENT)
744: OUTSTMT(,'RSB') :(H_EXI04)
745: *
746: * Here if N-type PRC with no OP1 given & #PPMs > 0
747: *
748: H_EXI01 OUTSTMT($LABEL,'ADDL3','$4*' PPMS,PNAME '_S','R11',$COMMENT)
749: OUTSTMT(,'JMP','(R11)') :(H_EXI04)
750: *
751: * Here if no OP1, & #PPMs = 0
752: *
753: H_EXI02 IDENT(PTYPE,'N') :S(H_EXI03)
754: *
755: * No OP1, #PPMs=0 and R/E-type
756: *
757: OUTSTMT($LABEL,'RSB',,,,$COMMENT) :(H_EXI04)
758: *
759: * No OP1, #PPMs=0 and N-type
760: *
761: H_EXI03 OUTSTMT($LABEL,'JMP','*' PNAME '_S',,,$COMMENT)
762: *
763: * Merge to exit
764: *
765: H_EXI04 :(RETURN)
766: -EJECT
767: * FLC folds a lower case character to upper case.
768: *
769: H_FLC OUTSTMT( $LABEL,'BICL2','$CH$BL',$OP1,,$COMMENT ) :(RETURN)
770: *
771: * GBLS is entered to produce global directives for important
772: * routines internal and external to the compiler.
773: *
774: h_gbls outstmt( ,'.GLOBL',$LABEL,,,$COMMENT ) :(return)
775: -SPACE 3
776: * H is entered directly by some opcodes, and eventually by
777: * most others. It performs an opcode translation if an entry exists
778: * for it (non-null) in the H_H.XOPS table and then goes to DSGEN to
779: * dump the statement.
780: *
781: H_H $OPCODE = DIFFER(TEMP = H_H.XOPS[$OPCODE]) TEMP :(DSGEN)
782: -SPACE 3
783: * Handle ICP opcode with a TSTL on (CP)+
784: *
785: H_ICP $OP1 = '(R3)+' :(H_H)
786: -SPACE 3
787: * Handle IFF by generating a word with the proper offset.
788: *
789: h_iff outstmt( ,'.WORD',$OP2 '-5B',,,$COMMENT ) :(return)
790: -SPACE 3
791: * Handle ITR with a MOVLF on IA to RA
792: *
793: H_ITR $OP1 = 'R5'
794: $OP2 = 'R2' :(H_H)
795: -SPACE 3
796: * LCT does not emit if both operands are the same
797: *
798: H_LCT DIFFER($OP1,$OP2) :S(H_SWP12)
799: OUTSTMT($LABEL,,,,,$COMMENT) :(RETURN)
800: -SPACE 3
801: * LEI uses MOVZWL on the word just prior to the entry point
802: *
803: H_LEI $OP2 = $OP1
804: $OP1 = '-2(' $OP1 ')' :(H_H)
805: -EJECT
806: * DO MFI
807: *
808: H_MFI OUTSTMT($LABEL,'MOVL','R5',$OP1,,$COMMENT)
809: IDENT($OP2) :S(RETURN)
810: OUTSTMT(,'BGEQ','0F')
811: OUTSTMT(,'JMP',$OP2)
812: OUTSTMT('0') :(RETURN)
813: * Make operand 1 operand 2, and put in a new operand 1 according
814: * to the table.
815: *
816: H_NEW1 $OP2 = $OP1
817: $OP1 = H_NEW1.OPS[$OPCODE] :(H_H)
818: -SPACE 3
819: * No-op instructions. Comment out the opcode
820: *
821: H_NOOP (IDENT($OPCODE,'INP'), IDENT($OPCODE,'INR'), IDENT($OPCODE,'EXP'))
822: + :S(RETURN)
823: $OPCODE = '#' $OPCODE :(DSGEN)
824: -SPACE 3
825: * Do arithmetic negate ops
826: * CHANGE CALL OF XOP TO LOOKUP IN XOP.XREGS
827: *
828: H_NGX $OP1 = $OP2 = XOP.XREGS[SUBSTR($OPCODE,3,1) 'A']
829: + :(H_H)
830: -SPACE 3
831: * Handle arithmetic overflow tests [IOV,INO,ROV,RNO]
832: *
833: H_OVF $OP2 = $OP1
834: $OP1 = :(H_BNCH)
835: -SPACE 3
836: * Insert dummy PPM branch point if none given
837: *
838: H_PPM $OP1 = IDENT($OP1) 'INVALID$' :(H_H)
839: -SPACE 3
840: * PRC notes the operands for later EXIs in global variables, and
841: * emits save area code if N-type.
842: *
843: H_PRC PTYPE = $OP1
844: PPMS = $OP2
845: PNAME = $LABEL
846: *
847: * If N-type, then we need a save area word
848: *
849: DIFFER(PTYPE,'N') :S(H_PRC01)
850: OUTSTMT(,'.DATA','1')
851: OUTSTMT(PNAME '_S','.LONG','0')
852: OUTSTMT(,'.TEXT','0')
853: OUTSTMT($LABEL,'MOVL','(SP)+',PNAME '_S',,$COMMENT)
854: :(H_PRC02)
855: *
856: * Here if R/E type
857: *
858: H_PRC01 OUTSTMT($LABEL,'#PRC',,,,$COMMENT)
859: *
860: * Merge to exit
861: *
862: H_PRC02 :(RETURN)
863: -EJECT
864: * Do PLC, PSC ops
865: *
866: H_PXC (IDENT($OP2) OUTSTMT($LABEL,'MOVAB','CFP$F(' $OP1 ')',$OP1,,$COMMENT))
867: + :S(RETURN)
868: $OP2 ((('R' ANY(NOS) (ANY(NOS) | '')) | 'SP') RPOS(0)) :S(H_PXC1)
869: OUTSTMT($LABEL,'MOVL',$OP2,'R11',,'[GET IN SCRATCH REGISTER]')
870: $LABEL =
871: $OP2 = 'R11'
872: H_PXC1 OUTSTMT($LABEL,'MOVAB','CFP$F(' $OP1 ')[' $OP2 ']',$OP1,,$COMMENT)
873: + :(RETURN)
874: -SPACE 3
875: * DO RMI
876: *
877: H_RMI OUTSTMT($LABEL,'ASHQ','$-32','R4','R4',$COMMENT)
878: OUTSTMT(,'EDIV',$OP1,'R4,R11,R5') :(RETURN)
879: -SPACE 3
880: * Handle RTI with CVTFL and then BVS if PLBL present
881: *
882: H_RTI OUTSTMT($LABEL,'CVTFL','R2','R5',,$COMMENT)
883: (DIFFER($OP1) OUTSTMT(,'BVS',$OP1)) :(RETURN)
884: -SPACE 3
885: * SBCALL GENERATES A JSB TO THE LABEL 'SB' CONCATENTATED WITH
886: * THE MINIMAL INSTRUCTION NAME.
887: *
888: H_SBCALL
889: $OP1 = 'SB' $OPCODE
890: $OPCODE = 'JSB' :(DSGEN)
891: *
892: * SEC does various things depending on the current section
893: *
894: H_SEC H_SEC.CNT = H_SEC.CNT + 1
895: *
896: * Generate appropriate .text and .data directives:
897: *
898: * all instructions .text 0
899: * all constants .data 0
900: * all working storage .data 1
901: *
902: * procedures sec -------
903: * definitions sec -------
904: * constants sec .data 0
905: * working storage sec .data 1
906: * program sec .text 0
907: * stack overflow sec -------
908: * error section -------
909: *
910: ( eq( h_sec.cnt,3 ) outstmt( ,'.DATA','0' ),
911: + eq( h_sec.cnt,4 ) outstmt( ,'.DATA','1' ),
912: + eq( h_sec.cnt,5 ) outstmt( ,'.TEXT','0' ),
913: + )
914: *
915: * Get rid of the extrinsic defs. if past defs. section (saves space)
916: *
917: H_EQU.DEFS = EQ(H_SEC.CNT,3)
918: *
919: * Be sure to generate label for program sec.
920: *
921: eq( h_sec.cnt,5 ) :f(h_sec00)
922: outstmt( ,'.GLOBL','SEC04' )
923: outstmt( 'SEC04' ) :(h_sec02)
924: *
925: * If we have reached the Stack Ovfl. sect. then dump the ERR list
926: *
927: H_SEC00 NE(H_SEC.CNT,6) :S(H_SEC02)
928: T = 0
929: *
930: * Loop here to emit code for saved up ERR objects.
931: *
932: H_SEC01 T = LT(T,MAXERR) T + 1 :F(H_SEC01X)
933: OUTSTMT('ER_' LPAD(T,3,'0'), 'MOVZWL', '$' T, 'R6')
934: OUTSTMT(,'JMP','ERROR') :(H_SEC01)
935: *
936: H_SEC01X
937: outstmt( ,'.GLOBL','SEC05' )
938: outstmt( 'SEC05' )
939: *
940: * Merged when finished with ERRs list.
941: *
942: H_SEC02 :(H_H)
943: -EJECT
944: * Arithmetic store ops (STI,STR)
945: * CHANGE CALL OF XOP TO LOOKUP OF XOP.XREGS
946: *
947: H_STX $OP2 = $OP1
948: $OP1 = XOP.XREGS[SUBSTR($OPCODE,3,1) 'A'] :(H_H)
949: -SPACE 3
950: * Ops that need to have op1 and op2 switched.
951: *
952: H_SWP12 T = $OP1
953: $OP1 = $OP2
954: $OP2 = T :(H_H)
955: -SPACE 3
956: *
957: * TTL restores the title text from OP1 and COMMENT
958: *
959: H_TTL $OP1 = (IDENT($OP1), $OP1 ' ') $COMMENT
960: $COMMENT = :(H_H)
961: -SPACE 3
962: * Immediate mode shifts
963: *
964: H_XSH $OP3 = $OP1
965: $OP1 = '$' (IDENT($OPCODE,'LSH'),'-') $OP2
966: $OP2 = $OP3 :(H_H)
967: -SPACE 3
968: * WTB opcode
969: H_WTB OUTSTMT($LABEL,'MOVAL','0[' $OP1 ']',$OP1,,$COMMENT) :(RETURN)
970: -SPACE 3
971: * come here if an opcode is found that should have been procesed
972: * by a previous preprocessor.
973: *
974: h_zzz terminal = 'Invalid opcode detected in line '
975: + lpad( nlines,5 ) ': ' $opcode :(error)
976: -EJECT
977: END
978: spitv35.tok
979: spitv35.plb
980: spitv35.src
981: y
982: y
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.