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