Asm8080: PROCEDURE OPTIONS(MAIN); /* 8080 Assembler - Feb 28, 1987 - by Bruce Tomlin 3/10/87: Added options for Kern's object format. Added listing on/off control. Added command line options. 3/17/87: Fixed expression evaluator and made it have operator precedence. Changed xfer address output to hold xfer address until CodeEnd is called. Made a full command line parser. The following DCL command is needed to set up the assembler: $ ASM :== $your_disk:[your_directory]ASM8080.EXE 3/31/87: Fixed bug that would prevent lines after an END statement from going into the listing file. NOTE: [this bug NOT fixed] The command line parser will probably choke and gag on a source file spec with a '.' typed in as part of a directory name. The -l= and -o= may not like directory name periods either. */ %REPLACE TRUE BY '1'B; %REPLACE FALSE BY '0'B; %REPLACE MaxSymLen BY 16; %REPLACE MaxOpcdLen BY 4; %REPLACE AlphaNumeric BY '1234567890$ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; %REPLACE Numeric BY '1234567890'; %REPLACE White BY ' '; /* A tab plus a space */ %REPLACE O_Illegal BY 0; /* Opcode not found in FindOpcode */ %REPLACE O_None BY 1; /* No operands */ %REPLACE O_One BY 2; /* One byte immediate operand */ %REPLACE O_Two BY 3; /* Two byte immediate operand */ %REPLACE O_InrDcr BY 4; /* INR or DCR instruction */ %REPLACE O_Arith BY 5; /* Register to accumulator arithmetic */ %REPLACE O_MOV BY 6; /* MOV instruction */ %REPLACE O_MVI BY 7; /* MVI instruction */ %REPLACE O_LXI BY 8; /* LXI instruction */ %REPLACE O_InxDcx BY 9; /* INX, DCX, and DAD instructions */ %REPLACE O_PushPop BY 10; /* PUSH and POP instructions */ %REPLACE O_StaxLdax BY 11; /* STAX and LDAX instructions */ %REPLACE O_RST BY 12; /* RST instruction */ %REPLACE O_DB BY 13; /* DB pseudo-op */ %REPLACE O_DW BY 14; /* DW pseudo-op */ %REPLACE O_DS BY 15; /* DS pseudo-op */ %REPLACE O_EQU BY -16; /* EQU and SET pseudo-ops */ %REPLACE O_ORG BY -17; /* ORG pseudo-op */ %REPLACE O_END BY 18; /* END pseudo-op */ %REPLACE O_LIST BY -19; /* LIST pseudo-op */ %REPLACE O_OPT BY -20; /* OPT pseudo-op */ %REPLACE O_INT BY -21; /* INT pseudo-op */ %REPLACE Regs BY ' B C D E H L M A '; %REPLACE RegVals BY ' 0 1 2 3 4 5 6 7 '; %REPLACE RegPairs BY ' B D H SP BC DE HL '; %REPLACE RegPairVals BY ' 0 1 2 3 0 1 2 '; %REPLACE PushRegs BY ' B D H PSW BC DE HL AF '; %REPLACE PushRegVals BY ' 0 1 2 3 0 1 2 3 '; %REPLACE StaxRegs BY ' B D BC DE '; %REPLACE StaxRegVals BY ' 0 1 0 1 '; DECLARE 1 Sym BASED, 2 Name CHAR(MaxSymLen), /* Symbol name */ 2 Value FIXED BINARY(15), /* Symbol value */ 2 Next POINTER, /* Pointer to next symtab entry */ 2 Defined BIT, /* TRUE if defined */ 2 Multidef BIT, /* TRUE if multiply defined */ 2 Set BIT, /* TRUE if defined with SET pseudo */ 2 Equ BIT, /* TRUE if defined with EQU pseudo */ SymTab POINTER, /* Pointer to first entry in symtab */ 1 Opcd BASED, 2 Name CHAR(MaxOpcdLen), /* Opcode name */ 2 Type FIXED BINARY(15), /* Opcode type */ 2 Parm FIXED BINARY(15), /* Opcode parameter */ 2 Next POINTER, /* Pointer to next opcode entry */ OpcdTab POINTER, /* Opcode table */ 1 Int BASED, 2 Time FIXED BINARY(31), 2 RST_No FIXED BINARY(15), 2 Next POINTER, IntList POINTER, LocPtr FIXED BINARY(15), /* Current program address */ Pass FIXED BINARY(15), /* Current assembler pass */ ErrFlag BIT, /* TRUE if error occured this line */ ErrCount FIXED BINARY(15), /* Total number of errors */ Line CHAR(80) VARYING, /* Current line from input file */ ListLine CHAR(132), /* Current listing line */ ListFlag BIT, /* FALSE to supress listing source */ ListThisLine BIT, /* TRUE to force listing this line */ SourceEnd BIT, /* TRUE when END pseudo encountered */ Instr(1:3) FIXED BINARY(15), /* Current instruction word */ InstrLen FIXED BINARY(15), /* Current instruction length */ BytStr CHAR(80) VARYING, /* Buffer for long DB statements */ ShowAddr BIT, /* TRUE to show LocPtr on listing */ KernFmt BIT, /* TRUE to use Kern's object format */ XferAddr FIXED BINARY(15), /* Transfer address from END pseudo */ XferFound BIT, /* TRUE if xfer addr defined w/ END */ CL_SrcName CHAR(80) VARYING, /* Source file name */ CL_ListName CHAR(80) VARYING, /* Listing file name */ CL_ObjName CHAR(80) VARYING, /* Object file name */ CL_Kern BIT, /* TRUE to use Kern's object format */ CL_Err BIT, /* TRUE for errors to screen */ LIB$Get_Foreign EXTERNAL ENTRY( CHAR(*), CHAR(*), FIXED BINARY(15), FIXED BINARY(31)) RETURNS(FIXED BINARY(31)) OPTIONS(VARIABLE), SS$_Normal FIXED BINARY(31) GLOBALREF VALUE, Null BUILTIN, Source EXTERNAL FILE STREAM INPUT, Object EXTERNAL FILE STREAM OUTPUT, Listing EXTERNAL FILE STREAM OUTPUT, SysIn EXTERNAL FILE STREAM INPUT, SysPrint EXTERNAL FILE STREAM OUTPUT PRINT; IF Get_Options(CL_SrcName,CL_ListName,CL_ObjName,CL_Kern,CL_Err) THEN DO; CALL Show_Options; RETURN; END; OPEN FILE(Listing) TITLE(CL_ListName); OPEN FILE(Object) TITLE(CL_ObjName); KernFmt = CL_Kern; SymTab = NULL; IntList = NULL; XferAddr = 0; XferFound = FALSE; CALL InitOpcodes; Pass = 1; CALL DoPass; CALL DumpInts; Pass = 2; CALL DoPass; PUT FILE(Listing) EDIT('') (COL(1),SKIP,A); PUT FILE(Listing) EDIT(ErrCount,' Total Error(s)') (COL(1),P'99999',A); PUT FILE(Listing) EDIT('') (COL(1),SKIP,A); IF CL_Err THEN DO; PUT EDIT('') (COL(1),SKIP,A); PUT EDIT(ErrCount,' Total Error(s)') (COL(1),P'99999',A); PUT EDIT('') (COL(1),A); END; CALL DumpSymTab; CLOSE FILE(Listing); CLOSE FILE(Object); DoPass: PROCEDURE; DECLARE Label CHAR(MaxSymLen), Opcode CHAR(MaxOpcdLen), Type FIXED BINARY(15), Parm FIXED BINARY(15), I FIXED BINARY(15), Eof BIT INIT(FALSE), Word CHAR(80) VARYING; OPEN FILE(Source) TITLE(CL_SrcName); ON ENDFILE(Source) Eof = TRUE; SourceEnd = FALSE; PUT EDIT('Pass ',Pass) (COL(1),A,F(1)); CALL CodeOrg(0); ErrCount = 0; ListFlag = TRUE; GET FILE(Source) EDIT(Line) (COL(1),A(80)); DO WHILE(^(Eof | SourceEnd)); ErrFlag = FALSE; InstrLen = 0; ShowAddr = FALSE; ListThisLine = ListFlag; ListLine = ''; IF Pass=2 THEN SubStr(ListLine,17) = Line; Label = ''; IF Length(Line)>0 THEN IF Index(White,SubStr(Line,1,1))=0 THEN DO; Label = GetWord(); ShowAddr = (Label ^= ''); IF Length(Line)>0 THEN IF SubStr(Line,1,1)=':' THEN Line=Substr(Line,2); END; Opcode = GetWord(); IF Opcode='' THEN DO; Type=0; CALL DefSym(Label,LocPtr,FALSE,FALSE); END; ELSE DO; CALL FindOpcode(Opcode,Type,Parm); SELECT; WHEN(Type = O_Illegal) CALL Error('Illegal opcode "' || Deblank(Opcode) || '"'); WHEN(Type < 0) DO; ShowAddr = FALSE; CALL DoLabelOp(Type,Parm,Label); END; OTHERWISE DO; ShowAddr = TRUE; CALL DefSym(Label,LocPtr,FALSE,FALSE); CALL DoOpcode(Type,Parm); END; END; IF Type^=O_Illegal THEN IF Length(GetWord())>0 THEN CALL Error('Too many operands'); END; IF Pass=2 THEN DO; IF ShowAddr THEN SubStr(ListLine,1,5) = Hex4(LocPtr) || ':'; IF InstrLen>0 THEN DO I=1 TO InstrLen; SubStr(ListLine,I*3+4,2) = Hex2(Instr(I)); CALL CodeOut(Instr(I)); END; ELSE DO I=1 TO -InstrLen; IF I<=3 THEN SubStr(ListLine,I*3+4,2) = Hex2(Rank(SubStr(BytStr,I,1))); CALL CodeOut(Rank(SubStr(BytStr,I,1))); END; IF ListThisLine THEN CALL ListOut; END; DO I=1 TO ABS(InstrLen); LocPtr = AddOne(LocPtr); END; GET FILE(Source) EDIT(Line) (COL(1),A(80)); END; IF Pass=2 THEN CALL CodeEnd; /* Put the lines after the END statement into the listing file */ /* while still checking for listing control statements. Ignore */ /* any lines which have invalid syntax, etc., because whatever */ /* is found after an END statement should esentially be ignored. */ IF Pass=2 THEN DO WHILE(^Eof); ListThisLine = ListFlag; ListLine = ''; SubStr(ListLine,17) = Line; IF Length(Line)>0 THEN IF Index(White,SubStr(Line,1,1))^=0 THEN DO; Word = GetWord(); IF Word^='' THEN SELECT(Word); WHEN('LIST') DO; ListThisLine = TRUE; Word = GetWord(); SELECT(Word); WHEN('ON') ListFlag = TRUE; WHEN('OFF') ListFlag = FALSE; OTHERWISE ListThisLine = ListFlag; END; END; WHEN('OPT') DO; ListThisLine = TRUE; Word = GetWord(); SELECT(Word); WHEN('LIST') ListFlag = TRUE; WHEN('NOLIST') ListFlag = FALSE; OTHERWISE ListThisLine = ListFlag; END; END; OTHERWISE; /* ignore anything else */ END; END; IF ListThisLine THEN CALL ListOut; GET FILE(Source) EDIT(Line) (COL(1),A(80)); END; CLOSE FILE(Source); END DoPass; ListOut: PROCEDURE; SELECT; WHEN(Trim(ListLine,White,White) = Byte(12)) PUT FILE(Listing) EDIT(Byte(12)) (COL(1),A); WHEN(Trim(ListLine,White,White) = '') PUT FILE(Listing) EDIT('') (COL(1),SKIP,A); OTHERWISE DO; PUT FILE(Listing) EDIT(Trim(ListLine,'',White)) (COL(1),A); IF ErrFlag & CL_Err THEN PUT EDIT(Trim(ListLine,'',White)) (COL(1),A); END; END; END ListOut; DoOpcode: PROCEDURE(Type,Parm); DECLARE Type FIXED BINARY(15) VALUE, Parm FIXED BINARY(15) VALUE; DECLARE Val FIXED BINARY(31), Reg1 FIXED BINARY(15), Reg2 FIXED BINARY(15), Word CHAR(80) VARYING, OldLine CHAR(80) VARYING; SELECT(Type); WHEN(O_None) DO; Instr(1) = Parm; InstrLen = 1; END; WHEN(O_One) DO; Instr(1) = Parm; Instr(2) = EvalByte(); InstrLen = 2; END; WHEN(O_Two) DO; Val = UnFix16(Eval()); Instr(1) = Parm; Instr(2) = MOD(Val,256); Instr(3) = Val / 256; InstrLen = 3; END; WHEN(O_InrDcr) DO; Reg1 = FindReg(GetWord(),Regs,RegVals); Instr(1) = Parm + Reg1*8; InstrLen = 1; END; WHEN(O_Arith) DO; Reg1 = FindReg(GetWord(),Regs,RegVals); Instr(1) = Parm + Reg1; InstrLen = 1; END; WHEN(O_MOV) DO; Reg1 = FindReg(GetWord(),Regs,RegVals); CALL Comma; Reg2 = FindReg(GetWord(),Regs,RegVals); Instr(1) = Parm + Reg1*8 + Reg2; InstrLen = 1; END; WHEN(O_MVI) DO; Reg1 = FindReg(GetWord(),Regs,RegVals); CALL Comma; Instr(1) = Parm + Reg1*8; Instr(2) = EvalByte(); InstrLen = 2; END; WHEN(O_LXI) DO; Reg1 = FindReg(GetWord(),RegPairs,RegPairVals); CALL Comma; Val = UnFix16(Eval()); Instr(1) = Parm + Reg1*16; Instr(2) = MOD(Val,256); Instr(3) = Val / 256; InstrLen = 3; END; WHEN(O_InxDcx) DO; Reg1 = FindReg(GetWord(),RegPairs,RegPairVals); Instr(1) = Parm + Reg1*16; InstrLen = 1; END; WHEN(O_PushPop) DO; Reg1 = FindReg(GetWord(),PushRegs,PushRegVals); Instr(1) = Parm + Reg1*16; InstrLen = 1; END; WHEN(O_StaxLdax) DO; Reg1 = FindReg(GetWord(),StaxRegs,StaxRegVals); Instr(1) = Parm + Reg1*16; InstrLen = 1; END; WHEN(O_RST) DO; Val = Eval(); SELECT(Val); WHEN(0,1,2,3,4,5,6,7) Val = Val*8; WHEN(8,16,24,32,40,48,56); OTHERWISE DO; CALL Error('Illegal restart number'); Val = 0; END; END; Instr(1) = Parm+Val; InstrLen = 1; END; WHEN(O_DB) DO; OldLine = Line; Word = GetWord(); IF Word='''' THEN DO; Val = Index(Line,''''); IF Val=0 THEN DO; BytStr = Line; Line = ''; END; ELSE DO; BytStr = SubStr(Line,1,Val-1); Line = SubStr(Line,Val+1); END; InstrLen = -Length(BytStr); END; ELSE DO; Line = OldLine; Instr(1) = EvalByte(); InstrLen = 1; END; END; WHEN(O_DW) DO; Val = UnFix16(Eval()); Instr(1) = MOD(Val,256); Instr(2) = Val / 256; InstrLen = 2; END; WHEN(O_DS) DO; Val = Fixed15(Eval()); IF Pass=2 THEN DO; ShowAddr = FALSE; SubStr(ListLine,1,5) = Hex4(LocPtr) || ':'; SubStr(ListLine,8,6) = '(' || Hex4(Val) || ')'; END; Val = Fixed15(Val + LocPtr); CALL CodeOrg(Val); END; WHEN(O_END) DO; OldLine = Line; IF GetWord()^='' THEN DO; Line = OldLine; Val = Eval(); CALL CodeXfer(Val); SubStr(ListLine,8,6) = '(' || Hex4(Val) || ')'; END; SourceEnd = TRUE; END; OTHERWISE CALL Error('Unknown opcode'); END; /* of SELECT(Type) */ END DoOpcode; DoLabelOp: PROCEDURE(Type,Parm,Label); DECLARE Type FIXED BINARY(15) VALUE, Parm FIXED BINARY(15) VALUE, Label CHAR(MaxSymLen); DECLARE Val FIXED BINARY(31), Word CHAR(80) VARYING; SELECT(Type); WHEN(O_EQU) DO; IF Label='' THEN CALL Error('Missing label'); ELSE DO; Val = Eval(); SubStr(ListLine,7,6) = '= ' || Hex4(Val); CALL DefSym(Label,Val,Parm=1,Parm=0); END; END; WHEN(O_ORG) DO; CALL CodeOrg(Eval()); CALL DefSym(Label,LocPtr,FALSE,FALSE); ShowAddr = TRUE; END; WHEN(O_LIST) DO; ListThisLine = TRUE; IF Label^='' THEN CALL Error('Label not allowed'); Word = GetWord(); SELECT(Word); WHEN('ON') ListFlag = TRUE; WHEN('OFF') ListFlag = FALSE; OTHERWISE CALL Error('Illegal operand'); END; END; WHEN(O_OPT) DO; ListThisLine = TRUE; IF Label^='' THEN CALL Error('Label not allowed'); Word = GetWord(); SELECT(Word); WHEN('KERN') KernFmt = TRUE; WHEN('LIST') ListFlag = TRUE; WHEN('NOLIST') ListFlag = FALSE; OTHERWISE CALL Error('Illegal option'); END; END; WHEN(O_INT) DO; IF Label^='' THEN CALL Error('Label not allowed'); IF ^KernFmt THEN CALL Error('Kern format required'); CALL DoIntOp; END; OTHERWISE CALL Error('Unknown opcode'); END; /* of SELECT(Type) */ END DoLabelOp; EvalByte: PROCEDURE RETURNS(FIXED BINARY(7)); DECLARE Val FIXED BINARY(15); Val=Eval(); IF Val<-128 | Val>255 THEN CALL Error('Byte out of range'); RETURN(Fixed7(Val)); END EvalByte; Eval: PROCEDURE RETURNS(FIXED BINARY(15)); DECLARE Word CHAR(80) VARYING, Val FIXED BINARY(31), OldLine CHAR(80) VARYING; Val = Term(); OldLine = Line; Word = GetWord(); DO WHILE(Word='+' | Word='-' | Word='*' | Word='/'); SELECT(Word); WHEN('+') Val = Val + Term(); WHEN('-') Val = Val - Term(); END; Val = Fixed15(Val); OldLine = Line; Word = GetWord(); END; Line = OldLine; RETURN(Val); END Eval; Term: PROCEDURE RETURNS(FIXED BINARY(15)); DECLARE Word CHAR(80) VARYING, Val FIXED BINARY(31), OldLine CHAR(80) VARYING; Val = Factor(); OldLine = Line; Word = GetWord(); DO WHILE(Word='*' | Word='/' | Word='%'); SELECT(Word); WHEN('*') Val = Val * Factor(); WHEN('/') Val = Val / Factor(); WHEN('%') Val = MOD(Val,Factor()); END; Val = Fixed15(Val); OldLine = Line; Word = GetWord(); END; Line = OldLine; RETURN(Val); END Term; Factor: PROCEDURE RETURNS(FIXED BINARY(15)); DECLARE Word CHAR(80) VARYING, Val FIXED BINARY(31); Word = GetWord(); Val = 0; SELECT; WHEN(Word='') CALL Error('Missing operand'); WHEN(Word='.' | Word='*') Val = LocPtr; WHEN(Word='-') Val = -Factor(); WHEN(Word='+') Val = Factor(); WHEN(Word='~') Val = -Factor()-1; WHEN(Word='(') DO; Val = Eval(); CALL Expect(')'); END; WHEN(Word='''') DO; IF Length(Line)=0 THEN CALL Error('Missing operand'); ELSE DO; Val = Rank(SubStr(Line,1,1)); Line = SubStr(Line,2); CALL Expect(''''); END; END; WHEN(Index(Numeric,SubStr(Word,1,1))>0) SELECT(SubStr(Word,Length(Word),1)); WHEN('O') Val = EvalOct(SubStr(Word,1,Length(Word)-1)); WHEN('D') Val = EvalDec(SubStr(Word,1,Length(Word)-1)); WHEN('H') Val = EvalHex(SubStr(Word,1,Length(Word)-1)); OTHERWISE Val = EvalDec(CHARACTER(Word)); END; OTHERWISE Val = RefSym(CHARACTER(Word)); END; RETURN(Fixed15(Val)); END Factor; EvalOct: PROCEDURE(OctStr) RETURNS(FIXED BINARY(31)); DECLARE OctStr CHAR(*); DECLARE OctVal FIXED BINARY(31), NewOctStr CHAR(6), EvalErr BIT INIT(FALSE); IF Length(OctStr)<6 THEN NewOctStr = Copy('0',6-Length(OctStr)) || OctStr; ELSE NewOctStr = Substr(OctStr,Length(OctStr)-5,6); ON ERROR EvalErr = TRUE; GET STRING(NewOctStr) EDIT(OctVal) (B3(6)); IF EvalErr THEN DO; OctVal = 0; CALL Error('Invalid octal number'); END; RETURN(OctVal); END EvalOct; EvalDec: PROCEDURE(DecStr) RETURNS(FIXED BINARY(31)); DECLARE DecStr CHAR(*); DECLARE DecVal FIXED BINARY(31), EvalErr BIT INIT(FALSE); ON ERROR EvalErr = TRUE; DecVal = Decimal(DecStr); IF EvalErr THEN DO; DecVal = 0; CALL Error('Invalid decimal number'); END; RETURN(DecVal); END EvalDec; EvalHex: PROCEDURE(HexStr) RETURNS(FIXED BINARY(31)); DECLARE HexStr CHAR(*); DECLARE HexVal FIXED BINARY(31), NewHexStr CHAR(4), EvalErr BIT INIT(FALSE); IF Length(HexStr)<4 THEN NewHexStr = Copy('0',4-Length(HexStr)) || HexStr; ELSE NewHexStr = Substr(HexStr,Length(HexStr)-3,4); ON ERROR EvalErr = TRUE; GET STRING(NewHexStr) EDIT(HexVal) (B4(4)); IF EvalErr THEN DO; HexVal = 0; CALL Error('Invalid hexadecimal number'); END; RETURN(HexVal); END EvalHex; FindReg: PROCEDURE(RegName,RegList,ValList) RETURNS(FIXED BINARY(15)); DECLARE RegName CHAR(*), RegList CHAR(*), ValList CHAR(*); DECLARE Pos FIXED BINARY(15), Reg FIXED BINARY(15); Pos = Index(RegList,' ' || Deblank(RegName) || ' '); IF Pos=0 THEN DO; Reg = 0; CALL Error('Illegal register "' || Deblank(RegName) || '"'); END; ELSE DO; Reg = Decimal(Substr(ValList,Pos,2)); END; RETURN(Reg); END FindReg; GetWord: PROCEDURE RETURNS(CHAR(*)); DECLARE Word CHAR(80) VARYING; DECLARE Done BIT; Line = Trim(line,white,''); IF Length(Line)=0 THEN RETURN(''); Word=''; IF Rank(SubStr(Line,1,1))=12 | SubStr(Line,1,1)=';' THEN DO; Line = ''; RETURN(''); END; IF Index(AlphaNumeric,Upcase(SubStr(Line,1,1)))=0 THEN DO; Word = SubStr(Line,1,1); Line = SubStr(Line,2); END; ELSE DO; Done = FALSE; DO UNTIL(Length(Line)=0 | Done); Word = Word || Upcase(SubStr(Line,1,1)); Line = SubStr(Line,2); IF Length(Line)>0 THEN Done = Index(AlphaNumeric,Upcase(SubStr(Line,1,1)))=0; END; END; RETURN(Word); END GetWord; Error: PROCEDURE(Message); DECLARE Message CHAR(*); DECLARE I FIXED BINARY(15); ErrFlag = TRUE; ErrCount = ErrCount+1; IF Pass=1 THEN RETURN; ListThisLine = TRUE; PUT FILE(Listing) EDIT('*** Error: ',Message,' ***') (COL(1),A,A,A); IF CL_Err THEN PUT EDIT('*** Error: ',Message,' ***') (COL(1),A,A,A); END Error; Expect: PROCEDURE(Expected); DECLARE Expected CHAR(*); IF GetWord()^=Expected THEN CALL Error('"' || Expected || '" expected'); END Expect; Comma: PROCEDURE; CALL Expect(','); END Comma; CodeOut: PROCEDURE(Byte); DECLARE Byte FIXED BINARY(15) VALUE; IF Pass=2 THEN PUT FILE(Object) EDIT(Hex2(Byte)) (COL(1),A); END CodeOut; CodeOrg: PROCEDURE(Addr); DECLARE Addr FIXED BINARY(15) VALUE; LocPtr = Addr; IF Pass=2 THEN IF KernFmt THEN PUT FILE(Object) EDIT('LADR',Hex4(Addr)) (COL(1),A); ELSE PUT FILE(Object) EDIT( ':' , Hex4(Addr)) (COL(1),A,A); END CodeOrg; CodeFlush: PROCEDURE; /* Neither object format uses buffering; no flush needed */ END CodeFlush; CodeEnd: PROCEDURE; CALL CodeFlush; IF Pass=2 & KernFmt & XferFound THEN PUT FILE(Object) EDIT('XADR',Hex4(XferAddr)) (COL(1),A); END CodeEnd; CodeXfer: PROCEDURE(Addr); DECLARE Addr FIXED BINARY(15) VALUE; XferAddr = Addr; XferFound = TRUE; END CodeXfer; RefSym: PROCEDURE(SymName) RETURNS(FIXED BINARY(15)); DECLARE SymName CHAR(MaxSymLen); DECLARE P POINTER; P = FindSym(SymName); IF P=NULL THEN P = AddSym(SymName); IF ^P->Sym.Defined THEN CALL Error('Symbol "' || Deblank(SymName) || '" undefined'); RETURN(P->Sym.Value); END RefSym; DefSym: PROCEDURE(SymName,Val,SetSym,EquSym); DECLARE SymName CHAR(MaxSymLen), Val FIXED BINARY(15) VALUE, SetSym BIT VALUE, EquSym BIT VALUE; DECLARE P POINTER; IF SymName='' THEN RETURN; P = FindSym(SymName); IF P=NULL THEN P = AddSym(SymName); IF ^P->Sym.Defined | (P->Sym.Set & SetSym) THEN DO; P->Sym.Value = Val; P->Sym.Defined = TRUE; P->Sym.Set = SetSym; P->Sym.Equ = EquSym; END; ELSE IF P->Sym.Value ^= Val THEN DO; P->Sym.Multidef = TRUE; CALL Error('Symbol "' || Deblank(SymName) || '" multiply defined'); END; END DefSym; AddSym: PROCEDURE(SymName) RETURNS(POINTER); DECLARE SymName CHAR(MaxSymLen); DECLARE P POINTER; ALLOCATE Sym SET(P); P->Sym.Name = SymName; P->Sym.Value = 0; P->Sym.Next = SymTab; P->Sym.Defined = FALSE; P->Sym.Multidef = FALSE; P->Sym.Set = FALSE; P->Sym.Equ = FALSE; SymTab = P; RETURN(P); END AddSym; FindSym: PROCEDURE(SymName) RETURNS(POINTER); DECLARE SymName CHAR(MaxSymLen); DECLARE P POINTER, Found BIT; Found = FALSE; P = SymTab; DO WHILE(P^=NULL & ^Found); Found = (P->Sym.Name = SymName); IF ^Found THEN P = P->Sym.Next; END; RETURN(P); END FindSym; DumpSymTab: PROCEDURE; DECLARE P POINTER; CALL SortSymTab; P = SymTab; DO WHILE(P^=NULL); CALL DumpSym(P); P = P->Sym.Next; END; END DumpSymTab; DumpSym: PROCEDURE(P); DECLARE P POINTER; PUT FILE(Listing) EDIT(P->Sym.Name,Hex4(P->Sym.Value)) (COL(1),A(MaxSymLen),X,A); IF ^P->Sym.Defined THEN PUT FILE(Listing) EDIT('U') (X,A); IF P->Sym.Multidef THEN PUT FILE(Listing) EDIT('M') (X,A); IF P->Sym.Set THEN PUT FILE(Listing) EDIT('S') (X,A); IF P->Sym.Equ THEN PUT FILE(Listing) EDIT('=') (X,A); END DumpSym; SortSymTab: PROCEDURE; DECLARE I POINTER, J POINTER, T POINTER, Sorted BIT, 1 Temp LIKE Sym; IF SymTab=NULL THEN RETURN; I = SymTab; J = I->Sym.Next; DO WHILE(J ^= NULL); Sorted = TRUE; DO WHILE(J ^= NULL); IF J->Sym.Name < I->Sym.Name THEN DO; Temp = I->Sym; I->Sym = J->Sym; J->Sym = Temp; T = I->Sym.Next; I->Sym.Next = J->Sym.Next; J->Sym.Next = T; Sorted = FALSE; END; J = J->Sym.Next; END; I = I->Sym.Next; J = I->Sym.Next; END; END SortSymTab; InitOpcodes: PROCEDURE; OpcdTab = NULL; CALL AddOpcode('NOP ',O_None,0); CALL AddOpcode('RLC ',O_None,7); CALL AddOpcode('RRC ',O_None,15); CALL AddOpcode('RAL ',O_None,23); CALL AddOpcode('RAR ',O_None,31); CALL AddOpcode('DAA ',O_None,39); CALL AddOpcode('CMA ',O_None,47); CALL AddOpcode('RIM ',O_None,48); CALL AddOpcode('STC ',O_None,55); CALL AddOpcode('SIM ',O_None,56); CALL AddOpcode('CMC ',O_None,63); CALL AddOpcode('HLT ',O_None,118); CALL AddOpcode('RNZ ',O_None,192); CALL AddOpcode('RZ ',O_None,200); CALL AddOpcode('RET ',O_None,201); CALL AddOpcode('RNC ',O_None,208); CALL AddOpcode('RC ',O_None,216); CALL AddOpcode('RPO ',O_None,224); CALL AddOpcode('XTHL',O_None,227); CALL AddOpcode('RPE ',O_None,232); CALL AddOpcode('PCHL',O_None,233); CALL AddOpcode('XCHG',O_None,235); CALL AddOpcode('RP ',O_None,240); CALL AddOpcode('DI ',O_None,243); CALL AddOpcode('RM ',O_None,248); CALL AddOpcode('SPHL',O_None,249); CALL AddOpcode('EI ',O_None,251); CALL AddOpcode('ADI ',O_One,198); CALL AddOpcode('ACI ',O_One,206); CALL AddOpcode('OUT ',O_One,211); CALL AddOpcode('SUI ',O_One,214); CALL AddOpcode('IN ',O_One,219); CALL AddOpcode('SBI ',O_One,222); CALL AddOpcode('ANI ',O_One,230); CALL AddOpcode('XRI ',O_One,238); CALL AddOpcode('ORI ',O_One,246); CALL AddOpcode('CPI ',O_One,254); CALL AddOpcode('SHLD',O_Two,34); CALL AddOpcode('LHLD',O_Two,42); CALL AddOpcode('STA ',O_Two,50); CALL AddOpcode('LDA ',O_Two,58); CALL AddOpcode('JNZ ',O_Two,194); CALL AddOpcode('JMP ',O_Two,195); CALL AddOpcode('CNZ ',O_Two,196); CALL AddOpcode('JZ ',O_Two,202); CALL AddOpcode('CZ ',O_Two,204); CALL AddOpcode('CALL',O_Two,205); CALL AddOpcode('JNC ',O_Two,210); CALL AddOpcode('CNC ',O_Two,212); CALL AddOpcode('JC ',O_Two,218); CALL AddOpcode('CC ',O_Two,220); CALL AddOpcode('JPO ',O_Two,226); CALL AddOpcode('CPO ',O_Two,228); CALL AddOpcode('JPE ',O_Two,234); CALL AddOpcode('CPE ',O_Two,236); CALL AddOpcode('JP ',O_Two,242); CALL AddOpcode('CP ',O_Two,244); CALL AddOpcode('JM ',O_Two,250); CALL AddOpcode('CM ',O_Two,252); CALL AddOpcode('INR ',O_InrDcr,4); CALL AddOpcode('DCR ',O_InrDcr,5); CALL AddOpcode('ADD ',O_Arith,128); CALL AddOpcode('ADC ',O_Arith,136); CALL AddOpcode('SUB ',O_Arith,144); CALL AddOpcode('SBB ',O_Arith,152); CALL AddOpcode('ANA ',O_Arith,160); CALL AddOpcode('XRA ',O_Arith,168); CALL AddOpcode('ORA ',O_Arith,176); CALL AddOpcode('CMP ',O_Arith,184); CALL AddOpcode('MOV ',O_MOV,64); CALL AddOpcode('MVI ',O_MVI,6); CALL AddOpcode('LXI ',O_LXI,1); CALL AddOpcode('INX ',O_InxDcx,3); CALL AddOpcode('DAD ',O_InxDcx,9); CALL AddOpcode('DCX ',O_InxDcx,11); CALL AddOpcode('POP ',O_PushPop,193); CALL AddOpcode('PUSH',O_PushPop,197); CALL AddOpcode('STAX',O_StaxLdax,2); CALL AddOpcode('LDAX',O_StaxLdax,10); CALL AddOpcode('RST ',O_RST,199); CALL AddOpcode('DB ',O_DB,0); CALL AddOpcode('DW ',O_DW,0); CALL AddOpcode('DS ',O_DS,0); CALL AddOpcode('= ',O_EQU,0); CALL AddOpcode('EQU ',O_EQU,0); CALL AddOpcode('SET ',O_EQU,1); CALL AddOpcode('ORG ',O_ORG,0); CALL AddOpcode('END ',O_END,0); CALL AddOpcode('LIST',O_LIST,0); CALL AddOpcode('OPT ',O_OPT,0); CALL AddOpcode('INT ',O_INT,0); END InitOpcodes; AddOpcode: PROCEDURE(Name,Type,Parm); DECLARE Name CHAR(MaxOpcdLen), Type FIXED BINARY(15), Parm FIXED BINARY(15); DECLARE P POINTER; ALLOCATE Opcd SET(P); P->Opcd.Name = Name; P->Opcd.Type = Type; P->Opcd.Parm = Parm; P->Opcd.Next = OpcdTab; OpcdTab = P; END AddOpcode; FindOpcode: PROCEDURE(Name,Type,Parm); DECLARE Name CHAR(MaxOpcdLen), Type FIXED BINARY(15), Parm FIXED BINARY(15); DECLARE P POINTER, Found BIT; Found = FALSE; P = OpcdTab; DO WHILE(P^=NULL & ^Found); Found = (P->Opcd.Name = Name); IF ^Found THEN P = P->Opcd.Next; END; IF ^Found THEN DO; Type = O_Illegal; Parm = 0; END; ELSE DO; Type = P->Opcd.Type; Parm = P->Opcd.Parm; END; END FindOpcode; DoIntOp: PROCEDURE; DECLARE Word CHAR(80) VARYING, Time FIXED BINARY(31), Err BIT; Err = FALSE; ON ERROR Err = TRUE; Word = GetWord(); IF Word='-' | Word='+' THEN Word = Word || GetWord(); Time = Decimal(Word); IF Err | Time<0 | Time>999999999 THEN DO; CALL Error('Illegal operand'); Word = GetWord(); /* Eat up second operand if it exists */ Word = GetWord(); /* to avoid 'Too many operands' error */ END; ELSE DO; CALL Comma; Word = GetWord(); IF Length(Word)^=1 THEN CALL Error('Illegal restart number'); ELSE DO; IF Word<'0' | Word>'7' THEN CALL Error('Illegal restart number'); ELSE CALL AddInt(Time,Decimal(Word)); END; END; END DoIntOp; AddInt: PROCEDURE(Time,RST_No); DECLARE Time FIXED BINARY(31) VALUE, RST_No FIXED BINARY(15) VALUE; DECLARE New POINTER, P POINTER, Q POINTER, Done BIT; IF Pass=2 THEN RETURN; ALLOCATE Int SET(New); New->Int.Time = Time; New->Int.RST_No = RST_No; Q = NULL; P = IntList; Done = FALSE; DO WHILE(P^=NULL & ^Done); Done = Time < P->Int.Time; IF ^Done THEN DO; Q = P; P = Q->Int.Next; END; END; IF Q=NULL THEN IntList = New; ELSE Q->Int.Next = New; New->Int.Next = P; END AddInt; DumpInts: PROCEDURE; DECLARE P POINTER; P = IntList; IF P=NULL | ^KernFmt THEN RETURN; PUT FILE(Object) EDIT('TINT') (COL(1),A); DO WHILE(P^=NULL); PUT FILE(Object) EDIT(P->Int.Time,P->Int.Rst_No) (COL(1),P'999999999',X,F(1)); P = P->Int.Next; END; END DumpInts; Deblank: PROCEDURE(String) RETURNS(CHAR(*)); DECLARE String CHAR(*); RETURN(Trim(String,' ',' ')); END Deblank; UpCase: PROCEDURE(String) RETURNS(CHAR(*)); DECLARE String CHAR(*); RETURN(Translate(String,'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 'abcdefghijklmnopqrstuvwxyz')); END UpCase; Fixed7: PROCEDURE(Val) RETURNS(FIXED BINARY(7)); DECLARE Val FIXED BINARY(31) VALUE; IF (Val>=-128) & (Val<=127) THEN RETURN(Val); IF (Val>= 128) & (Val<=255) THEN RETURN(Val-256); RETURN(Fixed7(MOD(Val,256))); END Fixed7; Fixed15: PROCEDURE(Val) RETURNS(FIXED BINARY(15)); DECLARE Val FIXED BINARY(31) VALUE; IF (Val>=-32768) & (Val<=32767) THEN RETURN(Val); IF (Val>= 32768) & (Val<=65535) THEN RETURN(Val-65536); RETURN(Fixed15(MOD(Val,65536))); END Fixed15; UnFix8: PROCEDURE(Val) RETURNS(FIXED BINARY(8)); DECLARE Val FIXED BINARY(7) VALUE; IF Val<0 THEN RETURN(Val+256); ELSE RETURN(Val); END UnFix8; UnFix16: PROCEDURE(Val) RETURNS(FIXED BINARY(16)); DECLARE Val FIXED BINARY(15) VALUE; IF Val<0 THEN RETURN(Val+65536); ELSE RETURN(Val); END UnFix16; AddOne: PROCEDURE(Val) RETURNS(FIXED BINARY(15)); DECLARE Val FIXED BINARY(31) VALUE; RETURN(Fixed15(Val+1)); END AddOne; SubOne: PROCEDURE(Val) RETURNS(FIXED BINARY(15)); DECLARE Val FIXED BINARY(31) VALUE; RETURN(Fixed15(Val-1)); END SubOne; Hex2: PROCEDURE(Val) RETURNS(CHAR(2)); DECLARE Val FIXED BINARY(31) VALUE; DECLARE RetStr CHAR(2); PUT STRING(RetStr) EDIT(UnFix8(Fixed7(Val))) (B4(2)); RETURN(RetStr); END Hex2; Hex4: PROCEDURE(Val) RETURNS(CHAR(4)); DECLARE Val FIXED BINARY(31) VALUE; DECLARE RetStr CHAR(4); PUT STRING(RetStr) EDIT(UnFix16(Fixed15(Val))) (B4(4)); RETURN(RetStr); END Hex4; Get_Options: PROCEDURE(CL_SrcName,CL_ListName,CL_ObjName,CL_Kern,CL_Err) RETURNS(BIT); DECLARE CL_SrcName CHAR(*) VARYING, CL_ListName CHAR(*) VARYING, CL_ObjName CHAR(*) VARYING, CL_Kern BIT, CL_Err BIT; DECLARE Str CHAR(80), Len FIXED BINARY(15), OptStr CHAR(80) VARYING, Option CHAR(80) VARYING, OptParm CHAR(80) VARYING, Prefix CHAR(80) VARYING, /* name of src file without '.asm' */ Pos FIXED BINARY(15), Err FIXED BINARY(31), OptErr BIT; CL_SrcName = ''; CL_ListName = 'NL:'; CL_ObjName = 'NL:'; CL_Kern = FALSE; CL_Err = FALSE; Err = LIB$Get_Foreign(Str,,Len,); IF Err=SS$_Normal THEN DO; OptErr = FALSE; OptStr = SubStr(Str,1,Len); Option = Get_Option(OptStr); DO WHILE(Option ^= ''); OptParm=''; Pos = Index(Option,'='); IF Pos>0 THEN DO; OptParm = SubStr(Option,Pos+1); Option = SubStr(Option,1,Pos-1); END; SELECT(Option); WHEN('-L') CL_ListName = OptParm; WHEN('-O') CL_ObjName = OptParm; WHEN('-K') CL_Kern = TRUE; WHEN('-E') CL_Err = TRUE; WHEN('?') OptErr = TRUE; OTHERWISE DO; IF SubStr(Option,1,1)='-' | CL_SrcName^='' | OptParm^='' THEN DO; OptErr = TRUE; PUT EDIT('Illegal command line option: ',Option) (COL(1),A,A); END; ELSE DO; CL_SrcName = Option; IF Index(CL_SrcName,'.')=0 THEN DO; Pos = Index(CL_SrcName,';'); IF Pos=0 THEN CL_SrcName = CL_SrcName || '.ASM'; ELSE CL_SrcName = SubStr(CL_SrcName,1,Pos-1) || '.ASM' || SubStr(CL_SrcName,Pos); END; Pos = Index(Option,'.'); IF Pos=0 THEN Pos = Index(Option,';'); IF Pos=0 THEN Prefix = Option; ELSE Prefix = SubStr(Option,1,Pos-1); END; END; END; /* of SELECT(Option) */ Option = Get_Option(OptStr); END; IF CL_SrcName = '' THEN DO; OptErr = TRUE; PUT EDIT('Source file not specified') (COL(1),A); END; IF CL_ListName = '' THEN CL_ListName = Prefix || '.LIS'; IF CL_ObjName = '' THEN CL_ObjName = Prefix || '.DAT'; IF SubStr(CL_ListName,1,1)='.' THEN CL_ListName = Prefix || CL_ListName; IF SubStr(CL_ObjName ,1,1)='.' THEN CL_ObjName = Prefix || CL_ObjName; END; RETURN(OptErr); END Get_Options; Show_Options: PROCEDURE; PUT EDIT('') (COL(1),SKIP,A); PUT EDIT(' Command line syntax:') (COL(1),A); PUT EDIT('') (COL(1),SKIP,A); PUT EDIT(' $ ASM [options] src [options]') (COL(1),A); PUT EDIT('') (COL(1),SKIP,A); PUT EDIT(' Valid options:') (COL(1),A); PUT EDIT('') (COL(1),SKIP,A); PUT EDIT(' -E Show errors to terminal') (COL(1),A); PUT EDIT(' -K Use Kern''s object code format') (COL(1),A); PUT EDIT(' -L Make a listing file to src.LIS') (COL(1),A); PUT EDIT(' -L=name') (COL(1),A); PUT EDIT(' -O Make an object file to src.DAT') (COL(1),A); PUT EDIT(' -O=name') (COL(1),A); PUT EDIT('') (COL(1),A); END Show_Options; Get_Option: PROCEDURE(OptStr) RETURNS(CHAR(*) VARYING); DECLARE OptStr CHAR(*) VARYING; DECLARE Option CHAR(80) VARYING, Pos FIXED BINARY(15); OptStr = Deblank(CHARACTER(OptStr)); Pos = Index(OptStr,' '); IF Pos=0 THEN DO; Option = OptStr; OptStr = ''; END; ELSE DO; Option = SubStr(OptStr,1,Pos-1); OptStr = SubStr(OptStr,Pos+1); END; OptStr = Deblank(CHARACTER(OptStr)); RETURN(Option); END Get_Option; END Asm8080;