\stdio.g bool DEBUG = false; char VERSION1 = '1', VERSION2 = '1'; word DASMAGIC = 0x4689, /* magic number at start of .REL files */ PBSIZE = 2000, /* size of program buffer */ STABSIZ = 400, /* size of symbol table */ CBSIZE = 2000, /* size of symbol character buffer */ SECTORSIZE = 128, /* size of CP/M file record */ BUFFSIZ = SECTORSIZE * 10, /* size of I/O buffers */ OPCOUNT = 78; /* number of entries in OPCODE table */ type /* symbol table entry types */ SYMTYPE = enum { SUNDEF, /* an undefined symbol (e.g. forward ref) */ SFLABEL, /* file variable */ SLLABEL, /* local variable */ SPLABEL, /* program label */ SXSYM, /* an external symbol (e.g. other routine) */ SCONS, /* a constant, set by := */ SEXTERN, /* the token 'extern' */ SPROC, /* the token 'proc' */ SCODE, /* the token 'code' */ SCORP, /* the token 'corp' */ SDS, /* the token 'ds' */ SDB, /* the token 'db' */ SDW /* the token 'dw' */ }, /* op-code table instruction types */ OPTYPE = enum { OPGEN, /* general form, no operands, e.g. cma */ OPSOURC, /* one source operand, e.g. add */ OPDEST, /* one destination operand, e.g. inr */ OPMOV, /* the mov instruction */ OP16, /* 16 bit (reg pair) instructions, eg inx */ OPIMM, /* immediate mode, e.g. adi */ OPIMM2, /* the mvi instruction */ OPIMM16, /* the lxi instruction */ OPJMP, /* jumps, calls, abs. addresses, e.g. lda */ OPAX /* the instructions ldax and stax */ }, /* the structure of a symbol table entry */ SYMBOL = struct { *char s_name; /* pointer to chars of name (in NameBuff) */ word s_value; /* value of constant or label */ word s_chain; /* useage chain for labels, externs, undefs*/ SYMTYPE s_type; /* type of identifier (as in above table) */ }, /* the structure of an op-code table entry */ OPCODE = struct { [4] char op_name; /* the mnemonic (all are <= 4 chars) */ byte op_code; /* the op-code */ OPTYPE op_type; /* the type (as in above table) */ }; /* special token values */ char TNUM = '\(1)', /* a number was encountered */ TID = '\(2)', /* an identifier, not in label position */ TLABEL = '\(3)', /* an identifer, starting in the first col */ TEOF = '\(4)', /* end-of-file encountered */ TEOL = '\(5)', /* end-of-line encountered */ TSHR = '\(6)', /* >> */ TSHL = '\(7)', /* << */ TASS = '\(8)', /* := */ TXOR = '\(9)'; /* >< */ /* the global variables */ *SYMBOL SymbolNext, /* next slot in symbol table */ LastSym, /* last symbol entered into table */ SymSave; /* last slot used outside of proc */ *char ProgramNext, /* next position in program buffer */ NameNext; /* next position in symbol name buf*/ word ErrorCount, /* global error counter */ SourcePos, /* position in source line */ SourceMax, /* length of current source buffer */ CodePos, /* position in code buffer */ Line, /* number of the current line */ OLine, /* line on previous char */ OOLine, /* line on 2nd previous char */ Column, /* column in current line */ OColumn, /* column on previous char */ OOColumn, /* column on 2nd previous char */ FileSize, /* current size of file variables */ LocalSize; /* current size of local variables */ *[OPCOUNT] OPCODE Ops; /* points to op-code table */ int IntValue; /* value returned for int constants*/ [PBSIZE] char ProgramBuff; /* the program buffer */ [STABSIZ] SYMBOL SymbolTable; /* the symbol table */ [CBSIZE] char NameBuff; /* symbol name buffer */ [BUFFSIZ] char SourceBuff, /* buffer for input data */ CodeBuff; /* buffer for code output data */ FILE SourceFile, /* FCB for source input file */ CodeFile; /* FCB for code output file */ byte Eof; /* 0, 1, 2 EOF flag */ char Char, /* the current input character */ NextChar, /* next input character */ Token; /* the current token */ bool InProc, /* true if inside a proc */ InCode, /* true if in code ... corp */ FirstProc; /* true if doing first proc */ extern DeleteFile(FILE f)void, MakeFile(FILE f)byte; /* * codeWrite - add a buffer to the code file, using buffering */ proc nonrec codeWrite(*char buffer; int length)void: while length > 0 do if CodePos = BUFFSIZ then CodePos := F_Write(CodeFile, &CodeBuff[0], BUFFSIZ); CodePos := 0; fi; CodeBuff[CodePos] := buffer*; CodePos := CodePos + 1; buffer := buffer + 1; length := length - 1; od; corp; /* * flush - flush out the code buffer */ proc nonrec flush()void: if CodePos ~= 0 then CodePos := F_Write(CodeFile, &CodeBuff[0], CodePos); fi; corp; /* * err - write out a note for an error at the current position */ proc nonrec err(*char message)void: PChars("***"); PFName(SourceFile); PChars(": ("); PInt(OOLine); PChar(','); PInt(OOColumn); PChars("): "); PChars(message); PChars(".\r\n"); ErrorCount := ErrorCount + 1; corp; /* * next1 - directly get the next character from the input file */ proc nonrec next1()void: if SourcePos = SourceMax then /* need to read in another buffer */ SourcePos := 0; SourceMax := F_Read(SourceFile, &SourceBuff[0], BUFFSIZ); if SourceMax = 0 then /* end of file? */ SourceBuff[0] := CPM_EOF; fi; fi; if SourceBuff[SourcePos] = CPM_EOF then Eof := 1; NextChar := ' '; else NextChar := SourceBuff[SourcePos]; SourcePos := SourcePos + 1; fi; corp; /* * next - get the next input char into Char, next one into NextChar */ proc nonrec next()void: Char := NextChar; OOLine := OLine; OOColumn := OColumn; OLine := Line; OColumn := Column; if Eof = 2 then err("unexpected end-of-file"); exit(1); elif Eof = 1 then Eof := 2; NextChar := ' '; else next1(); if Char = '\r' then /* started a new line on input */ Line := Line + 1; Column := 1; if NextChar = '\n' then next1(); fi; elif Char = '\n' then Line := Line + 1; Column := 1; if NextChar = '\r' then next1(); fi; Char := '\r'; elif Char = '\t' then Column := ((Column + 7) & ~7) + 1; else Column := Column + 1; fi; fi; corp; /* * scan - get the next input token, leave it in Token */ proc nonrec scan()void: *SYMBOL s1; *char cptr1, cptr2; word w1, w2; bool overFlow; byte b, base; if Token = TEOF then /* allow next to give error */ next(); fi; while Eof = 0 and (Char = ' ' or Char = '\t') do /* skip white-space*/ next(); od; if Char = ';' then /* skip a comment */ while Eof = 0 and Char ~= '\r' do next(); od; fi; if DEBUG then PChars("getting a token: "); fi; if Eof = 2 then Token := TEOF; if DEBUG then PChars("EOF\r\n"); fi; elif Char = '\r' then Token := TEOL; next(); if DEBUG then PChars("EOL\r\n"); fi; elif Char >= '0' and Char <= '9' then /* got a number */ IntValue := 0; base := 10; if Char = '0' then next(); if Char = 'x' or Char = 'X' then next(); base := 16; w2 := 0xfff; elif Char = 'o' or Char = 'O' then next(); base := 8; w2 := 0o17777; elif Char = 'b' or Char = 'B' then next(); base := 2; w2 := 0b111111111111111; fi; fi; overFlow := false; while Char >= '0' and Char <= '9' or base = 16 and (Char >= 'a' and Char <= 'f' or Char >= 'A' and Char <= 'F') do b := Char - if Char >= 'a' and Char <= 'f' then 'a' - 10 elif Char >= 'A' and Char <= 'F' then 'A' - 10 else '0' fi; if b >= base then err("invalid character for this base"); fi; w1 := IntValue; if not overFlow and if base = 10 then IntValue > 6553 or IntValue = 6553 and b > 5 else w1 > w2 fi then err("overflow on numeric input"); overFlow := true; fi; IntValue := IntValue * base + b; next(); od; Token := TNUM; if DEBUG then PChars("number="); PInt(IntValue); PNL(); fi; elif Char >= 'a' and Char <= 'z' or Char = '.' or /* got an identifer*/ Char >= 'A' and Char <= 'Z' or Char = '_' or Char = '^' then Token := if OColumn = 1 then TLABEL else TID fi; if DEBUG then PChars(if Token = TLABEL then "label :" else "identifier :" fi); fi; if SymbolNext = &SymbolTable[STABSIZ] then err("symbol table overflow"); exit(1); fi; /* insert an undefined symbol at the next free slot */ LastSym := SymbolNext; LastSym*.s_name := NameNext; LastSym*.s_chain := 0; LastSym*.s_type := SUNDEF; while Char >= 'a' and Char <= 'z' or Char = '.' or Char >= 'A' and Char <= 'Z' or Char = '_' or Char = '^' or Char >= '0' and Char <= '9' do NameNext* := if Char = '^' then '_' else Char fi; NameNext := NameNext + 1; next(); od; NameNext* := '\e'; NameNext := NameNext + 1; if DEBUG then PChars(LastSym*.s_name); fi; if NameNext >= &NameBuff[CBSIZE] then err("name table overflow"); exit(1); fi; /* check to see if the new symbol is already in the symbol table */ s1 := &SymbolTable[0]; while cptr1 := s1*.s_name; cptr2 := LastSym*.s_name; while cptr2* ~= '\e' and cptr2* = cptr1* do cptr1 := cptr1 + 1; cptr2 := cptr2 + 1; od; cptr1* ~= cptr2* do s1 := s1 + sizeof(SYMBOL); od; if s1 ~= LastSym then /* symbol was already defined */ if DEBUG then PChars(": type="); PInt(pretend(s1*.s_type, byte)); PNL(); fi; NameNext := LastSym*.s_name; LastSym := s1; else /* this is a new symbol */ if DEBUG then PChars(": undefined\r\n"); fi; SymbolNext := SymbolNext + sizeof(SYMBOL); /*move up in table */ fi; else /* multi-character operator tokens */ if Char = '>' and NextChar = '>' then next(); next(); Token := TSHR; elif Char = '<' and NextChar = '<' then next(); next(); Token := TSHL; elif Char = ':' and NextChar = '=' then next(); next(); Token := TASS; elif Char = '>' and NextChar = '<' then next(); next(); Token := TXOR; elif Char < ' ' or Char = '!' or Char = '\#' or Char = '$' or Char = '\'' or Char = '?' or Char = '@' or Char = '[' or Char = ']' or Char = '`' or Char = '{' or Char = '}' or Char >= '\(0x7f)' then next(); err("illegal character"); else Token := Char; next(); fi; if DEBUG then if Token <= ' ' then PInt(pretend(Token, byte)); else PChar(Token); fi; PNL(); fi; fi; corp; /* * skipToEOL - syntax error; ignore rest of input line */ proc nonrec skipToEOL()void: while Token ~= TEOL and Token ~= TEOF do scan(); od; corp; /* * notExpr - parse and evaluate an expression involving the ~ operator * this level of the recursive descent also handles the primitive * identifiers and constants */ proc notExpr()word: extern plusMinusExpr()int; word val; bool gotNot; gotNot := false; while Token = '~' do gotNot := not gotNot; scan(); od; if Token = TNUM then val := IntValue; scan(); elif Token = TID then if LastSym*.s_type ~= SCONS then /* only constants allowed */ err(if LastSym*.s_type = SUNDEF then "undefined symbol" else "invalid symbol in expression" fi); val := 0; else val := LastSym*.s_value; fi; scan(); elif Token = '(' then /* a bracketed sub-expression */ scan(); val := plusMinusExpr(); if Token = ')' then scan(); else err("missing ')'"); fi; else /* basically, we have a syntax error in the expr */ err("expecting term in expression"); skipToEOL(); val := 0; fi; if gotNot then ~val else val fi corp; /* * shiftAndXorExpr - parse and evaluate expressions using >>, <<, & and >< */ proc shiftAndXorExpr()word: word val, valRight; char tokenSave; val := notExpr(); while Token = TSHR or Token = TSHL or Token = TXOR or Token = '&' do tokenSave := Token; scan(); valRight := notExpr(); val := if tokenSave = TSHR then val >> valRight elif tokenSave = TSHL then val << valRight elif tokenSave = TXOR then val >< valRight else val & valRight fi; od; val corp; /* * orExpr - parse and evaluate expressions involving | */ proc orExpr()int: word val; val := shiftAndXorExpr(); while Token = '|' do scan(); val := val | shiftAndXorExpr(); od; val corp; /* * negAbsExpr - parse and evaluate expressions involving ~ and | (unary) */ proc negAbsExpr()int: int val; bool hadNeg, hadAbs; hadNeg := false; hadAbs := false; while Token = '-' or Token = '|' do if Token = '-' then if not hadAbs then /* an earlier | cancels any -'s */ hadNeg := not hadNeg; fi; else hadAbs := true; fi; scan(); od; val := orExpr(); if hadAbs then if hadNeg then -|val else |val fi elif hadNeg then -val else val fi corp; /* * mulDivExpr - parse and evaluate expressions involving *, / and % */ proc mulDivExpr()int: int val, valRight; char tokenSave; val := negAbsExpr(); while Token = '*' or Token = '/' or Token = '%' do tokenSave := Token; scan(); valRight := negAbsExpr(); val := if tokenSave = '*' then val * valRight elif tokenSave = '/' then val / valRight else val % valRight fi; od; val corp; /* * plusMinusExpr - parse and evaluate expressions involving + and - */ proc plusMinusExpr()int: int val, valRight; char tokenSave; val := mulDivExpr(); while Token = '+' or Token = '-' do tokenSave := Token; scan(); valRight := mulDivExpr(); val := if tokenSave = '+' then val + valRight else val - valRight fi; od; if DEBUG then PChars("expression value is "); PInt(val); PNL(); fi; val corp; /* * genByte - add the given byte to the code generated */ proc nonrec genByte(byte val)void: if InCode then /* can only generate code in the code ... proc part*/ if ProgramNext = &ProgramBuff[PBSIZE] then err("program buffer overflow"); exit(1); else ProgramNext* := pretend(val, char); ProgramNext := ProgramNext + 1; fi; else err("code appears outside of 'code' ... 'corp'"); InProc := true; InCode := true; fi; corp; /* * genWord - add a word to the output code buffer */ proc nonrec genWord(word w)void: genByte(w); genByte(w >> 8); corp; /* * getSource - get a valid source operand (e.g. for add, sub) */ proc nonrec getSource()byte: int val; val := plusMinusExpr(); if val >= 0 and val <= 7 then val else err("source field (register number) out of range"); 0 fi corp; /* * getDest - get a valid destination operand (e.g. for mov, inr) */ proc nonrec getDest()byte: int val; val := plusMinusExpr(); if val >= 0 and val <= 7 then val else err("destination field (register number) out of range"); 0 fi corp; /* * getPair - get a valid register pair operand (e.g. for lxi, inx) */ proc nonrec getPair()byte: word val; val := plusMinusExpr(); if val >= 0 and val <= 7 and val & 1 = 0 then val >> 1 else err("register pair name inappropriate"); 0 fi corp; /* * getImmediate - get a valid one-byte value for immediate mode instructions */ proc nonrec getImmediate()byte: int val; val := plusMinusExpr(); if val >= 0 and val <= 255 then val else err("immediate value must be 0 - 255"); 0 fi corp; /* * comma - scan past the comma separating operands */ proc nonrec comma()void: if Token = ',' then scan(); else err("expecting ',' as separator"); fi; corp; /* * genAddr - generate a reference to a possible address (or constant word) */ proc nonrec genAddr()void: int address; /* here is the key to this one-pass assembler. Any label-type symbol, as well as undefined symbols, are handled by putting the offset in the code buffer of where the address is needed onto a useage chain associated with the label. These values are written out to the code file and will be filled in by the link editor. Expressions are not allowed here, since that would require keeping track of the type of the expression (absolute or relocatable) and the resulting offset from some symbol, which may be undefined as yet */ if Token = TID and LastSym*.s_type <= SXSYM then genWord(LastSym*.s_chain); LastSym*.s_chain := ProgramNext - &ProgramBuff[0] - 2; scan(); else address := plusMinusExpr(); genWord(address); fi; corp; /* * genOp - parse the operands and construct an instruction */ proc nonrec genOp(*OPCODE opPtr)void: word address; OPTYPE typ; byte dest, opCode; typ := opPtr*.op_type; opCode := opPtr*.op_code; if DEBUG then PChars("genOp, typ="); PInt(pretend(typ, byte)); PChars(", opCode="); PInt(opCode); PNL(); fi; case typ incase OPGEN: /* no operands, e.g. cma, daa */ genByte(opCode); incase OPSOURC: /* a source register only, e.g. add, sbb */ genByte(opCode | getSource()); incase OPDEST: /* a destination reg only, e.g. inr, rst */ genByte(opCode | getDest() << 3); incase OPMOV: /* the mov instruction */ dest := getDest(); comma(); genByte(opCode | dest << 3 | getSource()); incase OP16: /* reg pair instructions, e.g. inx, push */ genByte(opCode | getPair() << 4); incase OPIMM: /* immediate data, e.g. adi, xri */ genByte(opCode); genByte(getImmediate()); incase OPIMM2: /* the mvi instruction */ genByte(opCode | getDest() << 3); comma(); genByte(getImmediate()); incase OPIMM16: /* the lxi instruction */ genByte(opCode | getPair() << 4); comma(); genAddr(); incase OPJMP: /* jmp, call, lda, sta, lhld, etc. */ genByte(opCode); genAddr(); incase OPAX: /* ldax and stax */ address := plusMinusExpr(); if address ~= 0 and address ~= 2 then err("address register field must be b(0) or d(2)"); address := 0; fi; genByte(opCode | address << 3); esac; corp; /* * define - define the given symbol to be a label at the current position */ proc nonrec define(*SYMBOL symPtr)void: if symPtr < &SymbolTable[STABSIZ] then if DEBUG then PChars("defining :"); PChars(symPtr*.s_name); PChars(":\r\n"); fi; if InCode then /* if after 'code', is a program label */ symPtr*.s_type := SPLABEL; symPtr*.s_value := ProgramNext - &ProgramBuff[0]; elif InProc then /* before 'code', after 'proc' - local var */ symPtr*.s_type := SLLABEL; symPtr*.s_value := LocalSize; else /* outside of 'proc' - file static var */ if not FirstProc then err("cannot have file variable after first 'proc'"); fi; symPtr*.s_type := SFLABEL; symPtr*.s_value := FileSize; fi; fi; corp; /* * findOp - look up the symbol in the op code table, return nil if not found */ proc nonrec findOp(*SYMBOL symPtr)*OPCODE: *OPCODE op; *char pName; [4] char name; pName := symPtr*.s_name; if DEBUG then PChars("checking for op-code :"); PChars(pName); fi; /* quick check - all op-codes are 2, 3, or 4 characters long */ if (pName + 1)* = '\e' or (pName + 2)* ~= '\e' and (pName + 3)* ~= '\e' and (pName + 4)* ~= '\e' then if DEBUG then PChars(": not found (wrong length)\r\n"); fi; nil else /* pad the name with blanks if necessary, and put into 'name' */ name[0] := pName*; name[1] := (pName + 1)*; name[2] := if (pName + 2)* = '\e' then ' ' else (pName + 2)* fi; name[3] := if (pName + 2)* = '\e' or (pName + 3)* = '\e' then ' ' else (pName + 3)* fi; op := &Ops*[0]; /* look up the 'name' in the table of op-codes */ while op ~= &Ops*[OPCOUNT] and (op*.op_name[0] ~= name[0] or op*.op_name[1] ~= name[1] or op*.op_name[2] ~= name[2] or op*.op_name[3] ~= name[3]) do op := op + sizeof(OPCODE); od; if op = &Ops*[OPCOUNT] then /* didn't find it */ if DEBUG then PChars(": not found\r\n"); fi; nil else /* found it, return pointer to the table entry */ if DEBUG then PChars(": found, opCode is "); PInt(pretend(op*.op_code, byte)); PNL(); fi; SymbolNext := LastSym; /* wasn't really undefined */ op fi fi corp; /* * endProc - end the current proc, ready for the next */ proc nonrec endProc()void: *SYMBOL symPtr; word count; *char p; if DEBUG then PChars("endProc\r\n"); fi; if not InCode or not InProc then err("no initial 'proc'"); FirstProc := false; fi; /* write out the length of code and the code itself */ count := ProgramNext - &ProgramBuff[0]; codeWrite(pretend(&count, *char), 2); codeWrite(&ProgramBuff[0], count); ProgramNext := &ProgramBuff[0]; codeWrite("\(0)\(0)", 2); /* no globals reloc data */ /* count the number of file static relocation pairs to write out */ symPtr := &SymbolTable[0]; count := 0; while symPtr ~= SymbolNext do if symPtr*.s_type = SFLABEL and symPtr*.s_chain ~= 0 then count := count + 1; fi; symPtr := symPtr + sizeof(SYMBOL); od; codeWrite(pretend(&count, *char), 2);/* count of file statics relocs */ /* write out the file statics reloc pairs, count the local statics, and check for undefined symbols used in this proc */ symPtr := &SymbolTable[0]; count := 0; while symPtr ~= SymbolNext do if symPtr*.s_type = SFLABEL and symPtr*.s_chain ~= 0 then codeWrite(pretend(&symPtr*.s_value, *char), 4); symPtr*.s_chain := 0; /* ready for next proc */ elif symPtr*.s_type = SLLABEL and symPtr*.s_chain ~= 0 then count := count + 1; elif symPtr*.s_type = SUNDEF and symPtr*.s_chain ~= 0 then PChars("Symbol \""); PChars(symPtr*.s_name); PChars("\" used in proc \""); PChars(SymSave*.s_name); PChars("\" is undefined.\r\n"); ErrorCount := ErrorCount + 1; fi; symPtr := symPtr + sizeof(SYMBOL); od; codeWrite(pretend(&count, *char), 2);/* count of local statics relocs */ /* write out the local statics reloc pairs, count the program relocs */ symPtr := &SymbolTable[0]; count := 0; while symPtr ~= SymbolNext do if symPtr*.s_type = SLLABEL and symPtr*.s_chain ~= 0 then codeWrite(pretend(&symPtr*.s_value, *char), 4); elif symPtr*.s_type = SPLABEL and symPtr*.s_chain ~= 0 then count := count + 1; fi; symPtr := symPtr + sizeof(SYMBOL); od; codeWrite(pretend(&count, *char), 2);/* count of program label relocs */ /* write out the program label relocation pairs */ symPtr := &SymbolTable[0]; while symPtr ~= SymbolNext do if symPtr*.s_type = SPLABEL and symPtr*.s_chain ~= 0 then codeWrite(pretend(&symPtr*.s_value, *char), 4); fi; symPtr := symPtr + sizeof(SYMBOL); od; /* write out linkage info for external symbols used in this proc */ while SymbolNext ~= &SymbolTable[0] do if SymbolNext*.s_type = SXSYM and SymbolNext*.s_chain ~= 0 then p := SymbolNext*.s_name; while p* ~= '\e' do p := p + 1; od; codeWrite(SymbolNext*.s_name, p - SymbolNext*.s_name + 1); codeWrite(pretend(&SymbolNext*.s_chain, *char), 2); SymbolNext*.s_chain := 0; /* ready for next */ fi; SymbolNext := SymbolNext - sizeof(SYMBOL); od; SymbolNext := SymSave; codeWrite("\(0)", 1); /* flag end of externals */ NameNext := SymbolNext*.s_name; InProc := false; InCode := false; corp; /* * newProc - initialize code generation for a new procedure */ proc nonrec newProc(*SYMBOL symPtr)void: *char p; if DEBUG then PChars("newProc :"); PChars(symPtr*.s_name); PChars(":\r\n"); fi; if InProc then err("previous 'proc' has no ending 'corp'"); endProc(); fi; if FirstProc then /* i.e. do on first proc only */ pretend(p, word) := DASMAGIC; codeWrite(pretend(&p, *char), 2); codeWrite("\(0)\(0)", 2); /* no globals */ codeWrite(pretend(&FileSize, *char), 2); FirstProc := false; fi; if symPtr = nil then err("no name for the proc"); if SymbolNext = &SymbolTable[STABSIZ] then err("symbol table overflow"); exit(1); fi; symPtr := SymbolNext; symPtr*.s_name := "????"; SymbolNext := SymbolNext + sizeof(SYMBOL); fi; p := symPtr*.s_name; while p* ~= '\e' do p := p + 1; od; codeWrite(symPtr*.s_name, p - symPtr*.s_name + 1); SymSave := SymbolNext - sizeof(SYMBOL); SymSave*.s_type := SPLABEL; SymSave*.s_chain := 0; SymSave*.s_value := 0; InProc := true; InCode := false; LocalSize := 0; corp; /* * startCode - set up for actual code */ proc nonrec startCode()void: if DEBUG then PChars("startCode\r\n"); fi; if not InProc then err("no initial 'proc'"); InProc := true; fi; InCode := true; codeWrite(pretend(&LocalSize, *char), 2);/* size of local statics */ corp; /* * parse - parse a set of input lines from the current input file */ proc nonrec parse()void: int val; *SYMBOL symPtr; *OPCODE opPtr; SYMTYPE typ; char c; InProc := false; InCode := false; FirstProc := true; FileSize := 0; LocalSize := 0; Token := ' '; scan(); while Token ~= TEOF do if DEBUG then PChars("parsing the next line\r\n"); fi; if Token = TLABEL then if DEBUG then PChars("got a label\r\n"); fi; symPtr := LastSym; if symPtr*.s_type ~= SUNDEF then err("symbol already defined"); symPtr := &SymbolTable[0]; /* use the dummy first symbol */ fi; scan(); if Token = ':' then /* the colon is optional */ scan(); fi; else symPtr := &SymbolTable[STABSIZ]; fi; if Token = TASS then /* defining a constant */ if DEBUG then PChars("defining a constant:\r\n"); fi; if symPtr = &SymbolTable[STABSIZ] then err("no symbol to define"); symPtr := SymbolNext; fi; scan(); symPtr*.s_value := plusMinusExpr(); symPtr*.s_type := SCONS; elif Token = TID then /* usual case, mnemonic or keyword */ typ := LastSym*.s_type; opPtr := findOp(LastSym); if opPtr ~= nil then /* this symbol is an op-code */ scan(); define(symPtr); genOp(opPtr); elif typ = SEXTERN then /* defining a symbol as external */ if DEBUG then PChars("an extern symbol\r\n"); fi; scan(); symPtr*.s_type := SXSYM; elif typ = SDS then /* defining a variable */ if DEBUG then PChars("ds, length:\r\n"); fi; if InCode then err("'ds' cannot appear inside 'code'...'corp'"); InCode := false; fi; scan(); define(symPtr); val := plusMinusExpr(); if val < 0 then err("ds length is <= 0"); val := 0; fi; if InProc then /* a local variable */ LocalSize := LocalSize + val; else /* a file static variable */ FileSize := FileSize + val; fi; elif typ = SPROC then /* starting a new proc */ scan(); newProc(symPtr); elif typ = SCODE then /* starting code part of a proc */ scan(); startCode(); elif typ = SCORP then /* ending the current proc */ scan(); endProc(); elif typ = SDB then /* generating one byte of code */ if DEBUG then PChars("db:\r\n"); fi; scan(); define(symPtr); genByte(getImmediate()); elif typ = SDW then /* generating one word of code */ if DEBUG then PChars("dw:\r\n"); fi; scan(); define(symPtr); genAddr(); else /* nothing else is legal statement */ define(symPtr); err("invalid identifier"); skipToEOL(); fi; elif Token = '"' then /* a string constant */ if DEBUG then PChars("string constant\r\n"); fi; define(symPtr); while Char ~= '"' do if Char = '\\' or Char = '\#' then next(); if Char = 'n' then c := '\n'; next(); elif Char = 'r' then c := '\r'; next(); elif Char = 'b' then c := '\b'; next(); elif Char = 't' then c := '\t'; next(); elif Char = 'e' then c := '\e'; next(); elif Char = '(' then next(); scan(); c := pretend(plusMinusExpr(), char); if Token ~= ')' then err("missing ')'"); fi; else c := Char; next(); fi; genByte(pretend(c, byte)); else genByte(pretend(Char, byte)); next(); fi; od; next(); scan(); elif Token = TEOL or Token = TEOF then if DEBUG then PChars("Label by itself\r\n"); fi; define(symPtr); /* handle label by itself on line */ else define(symPtr); err("invalid statement"); skipToEOL(); fi; if Token = TEOL then scan(); elif Token ~= TEOF then err("unexpected characters after complete statement"); skipToEOL(); if Token ~= TEOF then scan(); fi; fi; od; if InProc then err("last proc not closed"); endProc(); fi; if FirstProc then /* in case no proc's given */ val := DASMAGIC; codeWrite(pretend(&val, *char), 2); codeWrite("\(0)\(0)", 2); codeWrite(pretend(&FileSize, *char), 2); fi; codeWrite("\(0)", 1); /* no more procs in this file */ flush(); /* flush the buffer */ corp; /* * sym - define the given symbol to have the given type (used for predefs) */ proc nonrec sym(*char name; word val; SYMTYPE typ)void: if DEBUG then PChars("predefined symbol, SymbolNext="); PHex(pretend(SymbolNext, word)); PChars(", :"); PChars(name); PChars(": typ="); PInt(pretend(typ, byte)); PChars(", val="); PInt(val); PNL(); fi; SymbolNext*.s_name := name; SymbolNext*.s_type := typ; SymbolNext*.s_value := val; SymbolNext := SymbolNext + sizeof(SYMBOL); corp; /* * setOps - set up the 'Ops' array of opcode descriptions */ proc nonrec setOps()void: /* the actual op-code table as a string constant */ *char OPS = "mov \(0o100)\(pretend(OPMOV, byte))" "hlt \(0o166)\(pretend(OPGEN, byte))" "mvi \(0o006)\(pretend(OPIMM2, byte))" "inr \(0o004)\(pretend(OPDEST, byte))" "dcr \(0o005)\(pretend(OPDEST, byte))" "add \(0o200)\(pretend(OPSOURC, byte))" "adc \(0o210)\(pretend(OPSOURC, byte))" "sub \(0o220)\(pretend(OPSOURC, byte))" "sbb \(0o230)\(pretend(OPSOURC, byte))" "ana \(0o240)\(pretend(OPSOURC, byte))" "xra \(0o250)\(pretend(OPSOURC, byte))" "ora \(0o260)\(pretend(OPSOURC, byte))" "cmp \(0o270)\(pretend(OPSOURC, byte))" "adi \(0o306)\(pretend(OPIMM, byte))" "aci \(0o316)\(pretend(OPIMM, byte))" "sui \(0o326)\(pretend(OPIMM, byte))" "sbi \(0o336)\(pretend(OPIMM, byte))" "ani \(0o346)\(pretend(OPIMM, byte))" "xri \(0o356)\(pretend(OPIMM, byte))" "ori \(0o366)\(pretend(OPIMM, byte))" "cpi \(0o376)\(pretend(OPIMM, byte))" "rlc \(0o007)\(pretend(OPGEN, byte))" "rrc \(0o017)\(pretend(OPGEN, byte))" "ral \(0o027)\(pretend(OPGEN, byte))" "rar \(0o037)\(pretend(OPGEN, byte))" "jmp \(0o303)\(pretend(OPJMP, byte))" "jc \(0o332)\(pretend(OPJMP, byte))" "jnc \(0o322)\(pretend(OPJMP, byte))" "jz \(0o312)\(pretend(OPJMP, byte))" "jnz \(0o302)\(pretend(OPJMP, byte))" "jp \(0o362)\(pretend(OPJMP, byte))" "jm \(0o372)\(pretend(OPJMP, byte))" "jpe \(0o352)\(pretend(OPJMP, byte))" "jpo \(0o342)\(pretend(OPJMP, byte))" "call\(0o315)\(pretend(OPJMP, byte))" "cc \(0o334)\(pretend(OPJMP, byte))" "cnc \(0o324)\(pretend(OPJMP, byte))" "cz \(0o314)\(pretend(OPJMP, byte))" "cnz \(0o304)\(pretend(OPJMP, byte))" "cp \(0o364)\(pretend(OPJMP, byte))" "cm \(0o374)\(pretend(OPJMP, byte))" "cpe \(0o354)\(pretend(OPJMP, byte))" "cpo \(0o344)\(pretend(OPJMP, byte))" "ret \(0o311)\(pretend(OPGEN, byte))" "rc \(0o330)\(pretend(OPGEN, byte))" "rnc \(0o320)\(pretend(OPGEN, byte))" "rz \(0o310)\(pretend(OPGEN, byte))" "rnz \(0o300)\(pretend(OPGEN, byte))" "rp \(0o360)\(pretend(OPGEN, byte))" "rm \(0o370)\(pretend(OPGEN, byte))" "rpe \(0o350)\(pretend(OPGEN, byte))" "rpo \(0o340)\(pretend(OPGEN, byte))" "rst \(0o307)\(pretend(OPDEST, byte))" "in \(0o333)\(pretend(OPIMM, byte))" "out \(0o323)\(pretend(OPIMM, byte))" "lxi \(0o001)\(pretend(OPIMM16, byte))" "push\(0o305)\(pretend(OP16, byte))" "pop \(0o301)\(pretend(OP16, byte))" "sta \(0o062)\(pretend(OPJMP, byte))" "lda \(0o072)\(pretend(OPJMP, byte))" "xchg\(0o353)\(pretend(OPGEN, byte))" "xthl\(0o343)\(pretend(OPGEN, byte))" "sphl\(0o371)\(pretend(OPGEN, byte))" "pchl\(0o351)\(pretend(OPGEN, byte))" "dad \(0o011)\(pretend(OP16, byte))" "stax\(0o002)\(pretend(OPAX, byte))" "ldax\(0o012)\(pretend(OPAX, byte))" "inx \(0o003)\(pretend(OP16, byte))" "dcx \(0o013)\(pretend(OP16, byte))" "cma \(0o057)\(pretend(OPGEN, byte))" "stc \(0o067)\(pretend(OPGEN, byte))" "cmc \(0o077)\(pretend(OPGEN, byte))" "daa \(0o047)\(pretend(OPGEN, byte))" "shld\(0o042)\(pretend(OPJMP, byte))" "lhld\(0o052)\(pretend(OPJMP, byte))" "ei \(0o373)\(pretend(OPGEN, byte))" "di \(0o363)\(pretend(OPGEN, byte))" "nop \(0o000)\(pretend(OPGEN, byte))"; Ops := pretend(OPS, *[OPCOUNT] OPCODE); corp; /* * initialize - set up everything, define the predefined symbols */ proc nonrec initialize()void: if DEBUG then PChars("initializing\r\n"); fi; SymbolNext := &SymbolTable[0]; ProgramNext := &ProgramBuff[0]; NameNext := &NameBuff[0]; setOps(); sym(" ", 0, SCONS); /* create a dummy first symbol */ sym("extern", 0, SEXTERN); sym("proc", 0, SPROC); sym("code", 0, SCODE); sym("corp", 0, SCORP); sym("ds", 0, SDS); sym("db", 0, SDB); sym("dw", 0, SDW); sym("a", 7, SCONS); sym("b", 0, SCONS); sym("c", 1, SCONS); sym("d", 2, SCONS); sym("e", 3, SCONS); sym("h", 4, SCONS); sym("l", 5, SCONS); sym("m", 6, SCONS); sym("psw", 6, SCONS); sym("sp", 6, SCONS); corp; /* * main - the main program; scan the file arguments and process each one */ proc nonrec main()void: *char parPtr; int totalErrors; [3] char typ; PChars("Draco assembler version \(VERSION1).\(VERSION2), " "Copyright 1983 by Chris Gray.\r\n"); parPtr := GetPar(); if parPtr = nil then PChars("Use is: das f1[.das] ... fn[.das]\r\n"); exit(1); fi; totalErrors := 0; while parPtr ~= nil do initialize(); SetFileName(SourceFile, parPtr); GetFileType(SourceFile, typ); if typ[0] = ' ' then typ[0] := 'D'; typ[1] := 'A'; typ[2] := 'S'; SetFileType(SourceFile, typ); fi; if F_Open2(SourceFile, F_READ | F_CHAR) ~= F_OK then PFName(SourceFile); PChars(": cannot open\r\n"); exit(1); fi; SetFileName(CodeFile, parPtr); typ[0] := 'R'; typ[1] := 'E'; typ[2] := 'L'; SetFileType(CodeFile, typ); DeleteFile(CodeFile); if MakeFile(CodeFile) = 0xff then PFName(SourceFile); PChars(": cannot create\r\n"); exit(1); fi; if F_Open2(CodeFile, F_WRITE | F_BINARY) ~= F_OK then PFName(CodeFile); PChars(": cannot open\r\n"); exit(1); fi; PFName(SourceFile); PChars(":\r\n"); SourceMax := 0; SourcePos := 0; CodePos := 0; Line := 1; Column := 0; Eof := 0; NextChar := ' '; next(); next(); ErrorCount := 0; parse(); F_Close(CodeFile); F_Close(SourceFile); if ErrorCount ~= 0 then DeleteFile(CodeFile); totalErrors := totalErrors + ErrorCount; PFName(SourceFile); PChars(": "); PInt(ErrorCount); PChars(" error(s)\r\n"); fi; parPtr := GetPar(); od; corp;