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