![[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] / researchv10no / cmd / spitbol|
Return to tokvms.spt CVS log | Up to [Research Unix] / researchv10no / 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.