Sim8080: PROCEDURE OPTIONS(MAIN); %REPLACE TRUE BY '1'B; %REPLACE FALSE BY '0'B; %REPLACE KernCmds BY ' TINT LADR XADR '; DECLARE SYS$GETMSG EXTERNAL ENTRY (FIXED BINARY(31) VALUE, /* msgid = msg id # to be retrieved */ FIXED BINARY(15), /* msglen = word to receive len of string */ CHAR(*), /* bufadr = buffer to receive error message */ BIT(31) ALIGNED VALUE, /* flags = flag bits for msg content */ (1:4) FIXED BINARY(7)) /* outadr = 4-byte array for arg info */ RETURNS(FIXED BINARY(31)) OPTIONS(VARIABLE); DECLARE SYS$ASSIGN EXTERNAL ENTRY (CHAR(*), /* devnam = device or logical name string */ FIXED BINARY(15), /* chan = word to receive chan # assigned */ FIXED BINARY(31) VALUE, /* acmode = access mode associated w/ chan */ CHAR(*)) /* mbxnam = mailbox logical name string */ RETURNS(FIXED BINARY(31)) OPTIONS(VARIABLE); DECLARE SYS$QIOW EXTERNAL ENTRY (FIXED BINARY(31) VALUE, /* efn = event flag to set on completion */ FIXED BINARY(15) VALUE, /* chan = I/O device channel number */ FIXED BINARY(31) VALUE, /* func = IO$_SetMode!IO$M_CtrlCAst */ ANY, /* iosb = I/O status block address */ ENTRY VALUE, /* astadr = completion AST address */ ANY VALUE, /* astprm = completion AST parameter */ ANY VALUE, /* p1 - ctrl/c AST address */ ANY, /* p2 - ctrl/c AST parameter */ ANY VALUE, /* p3 - ctrl/c AST access mode */ ANY VALUE, ANY VALUE, ANY VALUE) /* p4-p6 not used for IO$M_CtrlCAst */ RETURNS (FIXED BINARY(31)) OPTIONS(VARIABLE); /* Values for ExecEnd */ %REPLACE E_Go BY 0; /* Execution not stopped */ %REPLACE E_Breakpoint BY 1; /* Execution stopped due to a breakpoint */ %REPLACE E_User_Stopped BY 2; /* User stopped execution */ %REPLACE E_Halted BY 3; /* HLT instruction encountered */ %REPLACE E_Illegal BY 4; /* Illegal instruction encountered */ %REPLACE E_Unimpl BY 5; /* Unimplemented instruction encountered */ %REPLACE E_Stepped BY 6; /* Execution stopped for single stepping */ %REPLACE E_Traced BY 7; /* Single step with trace */ %REPLACE E_GoBreak BY 8; /* Execution stopped at 'GT' cmd breakpoint */ /* Bit positions for processor flags */ %REPLACE F_Sign BY 7; %REPLACE F_Zero BY 6; %REPLACE F_AuxCarry BY 4; %REPLACE F_Parity BY 2; %REPLACE F_Carry BY 0; DECLARE Inkey EXTERNAL ENTRY RETURNS(FIXED BINARY(31)), TypeAhdCnt EXTERNAL ENTRY RETURNS(FIXED BINARY(31)), SenseChar EXTERNAL ENTRY RETURNS(FIXED BINARY(31)), SmgKey EXTERNAL ENTRY RETURNS(FIXED BINARY(31)), Page(0:255) FIXED BINARY(7) BASED, MemPage(0:255) POINTER, /* Pointers to 256 byte pages */ Access(0:255) BIT, /* TRUE if page was read/written */ 1 Regs, /* The simulated 8080's registers */ 2 PSW_Regs UNION, /* Processor status word */ 3 PSW FIXED BINARY(15), 3 Singly, 4 Flgs UNION, /* Processor flags */ 5 F FIXED BINARY(7), 5 Flags(0:7) BIT, 4 A FIXED BINARY(7), /* Accumulator */ 2 BC_Regs UNION, /* BC register pair */ 3 BC FIXED BINARY(15), 3 Singly, 4 C FIXED BINARY(7), 4 B FIXED BINARY(7), 2 DE_Regs UNION, /* DE register pair */ 3 DE FIXED BINARY(15), 3 Singly, 4 E FIXED BINARY(7), 4 D FIXED BINARY(7), 2 HL_Regs UNION, /* HL register pair */ 3 HL FIXED BINARY(15), 3 Singly, 4 L FIXED BINARY(7), 4 H FIXED BINARY(7), 2 PC FIXED BINARY(15), /* Program counter */ 2 SP FIXED BINARY(15), /* Stack pointer */ 2 IntFlag BIT, /* Interrupt enable flag */ 2 TempIntDis BIT, /* TRUE after EI and DI instrs */ 2 TState FIXED BINARY(31), /* Current T-state num */ 1 Int BASED, 2 Time FIXED BINARY(31), 2 RST_No FIXED BINARY(15), 2 Next POINTER, IntList POINTER, 1 Brk, 2 Chan FIXED BINARY(15), /* Channel number for ctrl/c AST */ 2 Break BIT, /* Flag set by ctrl/c AST */ InpLine CHAR(80) VARYING, /* Monitor cmd input line */ DefRadix FIXED BINARY(15), /* Default EvalNum radix */ EvalErr BIT, /* TRUE if error in EvalNum */ Quit BIT, /* TRUE to exit simulator */ ExecEnd FIXED BINARY(15), /* Shows why exec stopped */ Trace BIT, /* TRUE to trace execution */ TraceStep BIT, /* TRUE to single-step with trace */ StepCnt FIXED BINARY(31), /* >0 to single-step */ ErrVal FIXED BINARY(31), /* Error code for 'ErrMsg' */ NextAddr FIXED BINARY(15), /* Default address for null input */ NextCmd CHAR(16) VARYING, /* Default command for null input */ GoBreakAddr FIXED BINARY(15), /* 'GT' command breakpoint address */ GoBreak BIT, /* TRUE if GoBreak enabled */ Kern_IO BIT, /* TRUE to use Kern mode I/O */ SS$_Normal FIXED BINARY(31) GLOBALREF VALUE, IO$_SetMode FIXED BINARY(31) GLOBALREF VALUE, IO$M_CtrlCAst FIXED BINARY(31) GLOBALREF VALUE, BIT BUILTIN, Byte BUILTIN, /* Numeric to ASCII */ CHARACTER BUILTIN, Copy BUILTIN, Decimal BUILTIN, /* Character to numeric */ FIXED BUILTIN, Index BUILTIN, Length BUILTIN, NULL BUILTIN, OnCode BUILTIN, Rank BUILTIN, /* ASCII to numeric */ Substr BUILTIN, DataIn EXTERNAL FILE STREAM INPUT, DataOut EXTERNAL FILE STREAM OUTPUT, SysIn EXTERNAL FILE STREAM INPUT, SysPrint EXTERNAL FILE STREAM OUTPUT PRINT; PUT EDIT(' ') (COL(1),A); PUT EDIT('SIM8080 - 8080 simulator') (COL(1),A); PUT EDIT('Enter "?" for help.') (COL(1),A); PUT EDIT(' ','') (COL(1),A,COL(1),A); NextAddr = 0; NextCmd = ''; DefRadix = 16; ExecEnd = E_Go; GoBreak = FALSE; IntList = NULL; Kern_IO = FALSE; Quit = FALSE; CALL InitMemory; CALL ResetProcessor; CALL StartCtrlC; DO UNTIL(Quit); CALL Monitor; ExecEnd = E_Go; Break = FALSE; DO WHILE(^Quit & ExecEnd=E_Go); CALL Execute; END; END; Monitor: PROCEDURE; DECLARE Command CHAR(80) VARYING, LeaveMonitor BIT INIT(FALSE), P FIXED BINARY(15), Addr FIXED BINARY(15), DisLine CHAR(80) VARYING; SELECT(ExecEnd); WHEN(E_Go); /* Can only get here during simulator startup */ WHEN(E_Breakpoint) PUT EDIT('Breakpoint encountered, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_User_Stopped) PUT EDIT('User stopped execution, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_Halted) PUT EDIT('HLT instruction, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_Illegal) PUT EDIT('Illegal instruction, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_Unimpl) PUT EDIT('Unimplemented instruction, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_Stepped) PUT EDIT('Stepped, PC = ',UnFix16(PC)) (COL(1),A,B4(4)); WHEN(E_Traced); WHEN(E_GoBreak); END; GoBreak = FALSE; StepCnt = 0; TraceStep = FALSE; IF ExecEnd^=E_Go THEN DO; Addr = PC; CALL DisOne(Addr,DisLine,TRUE,TRUE); PUT EDIT(DisLine) (COL(1),A); NextAddr = PC; END; DO UNTIL(LeaveMonitor | Quit); CALL Input(InpLine,'X','>'); CALL GetWord(InpLine,Command); IF Command='' THEN Command = NextCmd; NextCmd = ''; Command = UpCase(Command); Break = FALSE; SELECT(Command); WHEN('X','Q') Quit = YesNo('N','Do you really want to quit? '); WHEN('RESET') IF YesNo('N','Do you really want to reset the processor? ') THEN DO; CALL ResetProcessor; PUT EDIT('Processor reset.') (COL(1),A); END; WHEN('CLEAR') IF YesNo('N','Do you really want to reset the processor and ' || 'clear out memory? ') THEN DO; CALL ClearMemory; CALL ResetProcessor; PUT EDIT('Processor reset and memory cleared.') (COL(1),A); END; WHEN('R') IF InpLine = '' THEN CALL DumpRegs; ELSE CALL SetRegs; WHEN('RR') CALL TraceRegs; WHEN('D','DM') CALL DumpMem; WHEN('M','SM') CALL SetMem; WHEN('ML') CALL LoadMem; WHEN('MS') CALL SaveMem; WHEN('L','IL') CALL Disassemble; WHEN('G','GO') IF InpLine='' THEN LeaveMonitor = TRUE; ELSE LeaveMonitor = GoAddr(); WHEN('GT') LeaveMonitor = GoTill(); WHEN('S') IF InpLine='' THEN DO; StepCnt = 1; LeaveMonitor = TRUE; NextCmd = 'S'; END; ELSE LeaveMonitor = SetStepCount(); WHEN('T') IF InpLine='' THEN DO; TraceStep = TRUE; LeaveMonitor = TRUE; NextCmd = 'T'; END; ELSE CALL OnOff(Trace); WHEN('PC') DO; InpLine = 'PC ' || InpLine; CALL SetRegs; END; WHEN('INT') CALL IntCmd; WHEN('KIO') CALL OnOff(Kern_IO); WHEN('TI') PUT EDIT('Temp interrupt disable flag = ',TempIntDis) (COL(1),A,B1(1)); WHEN('P') CALL ShowPages; WHEN('?','HELP') DO; PUT EDIT('D addr [cnt] = Display memory') (COL(10),A); PUT EDIT('M addr val... = Store bytes in memory') (COL(10),A); PUT EDIT('L addr [cnt] = Disassemble') (COL(10),A); PUT EDIT('R = Register dump') (COL(10),A); PUT EDIT('R reg value = Set register') (COL(10),A); PUT EDIT('G [addr] = Begin execution') (COL(10),A); PUT EDIT('GT addr = Execute until PC = addr') (COL(10),A); PUT EDIT('S = Single step one instr') (COL(10),A); PUT EDIT('S cnt = Step cnt instrtuctions') (COL(10),A); PUT EDIT('T = Trace one instruction') (COL(10),A); PUT EDIT('T ON | OFF = Trace on or off') (COL(10),A); PUT EDIT('ML fname = Load memory from file') (COL(10),A); PUT EDIT('MS fname s e = Save memory to file') (COL(10),A); PUT EDIT('INT = Show all interrupts') (COL(10),A); PUT EDIT('INT time rst = Add an interrupt') (COL(10),A); PUT EDIT('INT -time rst = Remove an interrupt') (COL(10),A); PUT EDIT('INT CLEAR = Clear all interrupts') (COL(10),A); PUT EDIT('KIO ON | OFF = Kern''s I/O on or off') (COL(10),A); PUT EDIT('CLEAR = Reset and clear memory') (COL(10),A); PUT EDIT('RESET = Reset processor') (COL(10),A); PUT EDIT('Q or X = Exit simulator') (COL(10),A); PUT EDIT('? or HELP = Help') (COL(10),A); /* Future commands: PUT EDIT('BR addr = Set breakpoint') (COL(10),A); PUT EDIT('CL [addr] = Clear breakpoint') (COL(10),A); PUT EDIT('MSK fname s e = Save memory in Kern fmt') (COL(10),A); */ END; WHEN(''); /* Ignore null command */ OTHERWISE PUT EDIT('???') (COL(1),A); END; /* of SELECT(Command) */ END; END Monitor; Execute: PROCEDURE; DECLARE OldPC FIXED BINARY(15); OldPC = PC; IF ^DoInterrupt() THEN CALL ExecuteInstr; IF Trace | TraceStep THEN CALL TraceRegs; IF ExecEnd=E_Go THEN DO; SELECT; WHEN(StepCnt>0) DO; StepCnt = StepCnt - 1; IF StepCnt=0 THEN ExecEnd = E_Stepped; END; WHEN(PC=GoBreakAddr & GoBreak) ExecEnd = E_GoBreak; /* WHEN(PC=breakpoint) ExecEnd = E_BreakPoint */ WHEN(TraceStep) ExecEnd = E_Traced; WHEN(Break) ExecEnd = E_User_Stopped; OTHERWISE; END; END; ELSE DO; /* Can only get here if illegal, unimplemented, or halt */ PC = OldPC; END; END Execute; DoInterrupt: PROCEDURE RETURNS(BIT); DECLARE Time FIXED BINARY(31), RST_No FIXED BINARY(15); IF IntList=NULL | ^IntFlag | TempIntDis THEN RETURN(FALSE); Time = IntList->Int.Time; RST_No = IntList->Int.RST_No; IF TState < Time THEN RETURN(FALSE); IF Trace | TraceStep THEN PUT EDIT('Interrupt encountered, TState =',TState,', int time =',Time, ', RST num =',RST_No) (COL(1),A,F(10),A,F(10),A,F(2)); CALL DelInt(Time,RST_No); CALL Do_RST(RST_No); IntFlag = FALSE; RETURN(TRUE); END DoInterrupt; ExecuteInstr: PROCEDURE; DECLARE IR FIXED BINARY(15), P1 FIXED BINARY(7), P2 FIXED BINARY(7), P3 FIXED BINARY(7), P4 FIXED BINARY(7), P5 BIT; TempIntDis = FALSE; IR = UnFix8(Fetch()); P1 = IR/64; P2 = MOD(FIXED(IR/8,7),8); P3 = MOD(IR,8); P4 = MOD(FIXED(IR/16,7),4); P5 = MOD(P2,2)=1; SELECT(P1); WHEN(0) SELECT(P3); WHEN(0) IF P2=0 THEN TState = TState + 4; /* NOP instr */ ELSE ExecEnd = E_Illegal; WHEN(1) IF P5 THEN CALL Do_DAD(P4); ELSE CALL Do_LXI(P4); WHEN(2) SELECT(P2); WHEN(0,2) CALL Do_STAX(P4); WHEN(1,3) CALL Do_LDAX(P4); WHEN(4) CALL Do_SHLD; WHEN(5) CALL Do_LHLD; WHEN(6) CALL Do_STA; WHEN(7) CALL Do_LDA; END; /* of SELECT(P2) */ WHEN(3) IF P5 THEN CALL Do_DCX(P4); ELSE CALL Do_INX(P4); WHEN(4) CALL Do_INR(P2); WHEN(5) CALL Do_DCR(P2); WHEN(6) CALL Do_MVI(P2); WHEN(7) SELECT(P2); WHEN(0) CALL Do_RLC; WHEN(1) CALL Do_RRC; WHEN(2) CALL Do_RAL; WHEN(3) CALL Do_RAR; WHEN(4) CALL Do_DAA; WHEN(5) CALL Do_CMA; WHEN(6) CALL Do_STC; WHEN(7) CALL Do_CMC; END; /* of SELECT(P2) */ END; /* of SELECT(P3) */ WHEN(1) DO; IF P2=6 & P3=6 THEN DO; ExecEnd = E_Halted; TState = TState + 7; END; ELSE CALL Do_MOV(P2,P3); END; WHEN(2) SELECT(P2); WHEN(0) CALL Do_ADD(P3); WHEN(1) CALL Do_ADC(P3); WHEN(2) CALL Do_SUB(P3); WHEN(3) CALL Do_SBB(P3); WHEN(4) CALL Do_ANA(P3); WHEN(5) CALL Do_XRA(P3); WHEN(6) CALL Do_ORA(P3); WHEN(7) CALL Do_CMP(P3); END; WHEN(3) SELECT(P3); WHEN(0) CALL Do_Cond_Return(P2); WHEN(1) SELECT(P2); WHEN(0,2,4,6) CALL Do_POP(P4); WHEN(1) CALL Do_RET; WHEN(3) ExecEnd = E_Illegal; /* D9 is illegal */ WHEN(5) CALL Do_PCHL; WHEN(7) CALL Do_SPHL; END; /* of SELECT(P2) */ WHEN(2) CALL Do_Cond_Jump(P2); WHEN(3) SELECT(P2); WHEN(0) CALL Do_JMP; WHEN(1) ExecEnd = E_Illegal; /* CB is illegal */ WHEN(2) CALL Do_OUT; WHEN(3) CALL Do_IN; WHEN(4) CALL Do_XTHL; WHEN(5) CALL Do_XCHG; WHEN(6) CALL Do_DI; WHEN(7) CALL Do_EI; END; /* of SELECT(P2) */ WHEN(4) CALL Do_Cond_Call(P2); WHEN(5) SELECT(P2); WHEN(0,2,4,6) CALL Do_PUSH(P4); WHEN(1) CALL Do_CALL; WHEN(3,5,7) ExecEnd = E_Illegal; /* DD ED FD */ END; /* of SELECT(P2) */ WHEN(6) SELECT(P2); WHEN(0) CALL Do_ADI; WHEN(1) CALL Do_ACI; WHEN(2) CALL Do_SUI; WHEN(3) CALL Do_SBI; WHEN(4) CALL Do_ANI; WHEN(5) CALL Do_XRI; WHEN(6) CALL Do_ORI; WHEN(7) CALL Do_CPI; END; WHEN(7) CALL Do_RST(P2); END; /* of SELECT(P3) */ END; /* of SELECT(P1) */ END ExecuteInstr; Do_MOV: PROCEDURE(Dest,Src); DECLARE Dest FIXED BINARY(7) VALUE, Src FIXED BINARY(7) VALUE; DECLARE Val FIXED BINARY(7); SELECT(Src); WHEN(0) Val=B; WHEN(1) Val=C; WHEN(2) Val=D; WHEN(3) Val=E; WHEN(4) Val=H; WHEN(5) Val=L; WHEN(6) Val=GetMem(HL); WHEN(7) Val=A; END; SELECT(Dest); WHEN(0) B=Val; WHEN(1) C=Val; WHEN(2) D=Val; WHEN(3) E=Val; WHEN(4) H=Val; WHEN(5) L=Val; WHEN(6) CALL PutMem(HL,Val); WHEN(7) A=Val; END; TState = TState + 5; IF Src=6 | Dest=6 THEN TState=TState+2; END Do_MOV; Do_RST: PROCEDURE(Which_RST); DECLARE Which_RST FIXED BINARY(15) VALUE; CALL Push(PC); PC = Which_RST * 8; TState = TState + 11; END Do_RST; Do_PCHL: PROCEDURE; PC = HL; TState = TState + 5; END Do_PCHL; Do_SPHL: PROCEDURE; SP = HL; TState = TState + 5; END Do_SPHL; Do_XTHL: PROCEDURE; DECLARE Temp FIXED BINARY(15); Temp = Pop(); CALL Push(HL); HL = Temp; TState = TState + 18; END Do_XTHL; Do_XCHG: PROCEDURE; DECLARE Temp FIXED BINARY(15); Temp = DE; DE = HL; HL = Temp; TState = TState + 4; END Do_XCHG; Do_EI: PROCEDURE; IntFlag = TRUE; TempIntDis = TRUE; TState = TState + 4; END Do_EI; Do_DI: PROCEDURE; IntFlag = FALSE; TempIntDis = TRUE; TState = TState + 4; END Do_DI; Do_LXI: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) BC = Fetch2(); WHEN(1) DE = Fetch2(); WHEN(2) HL = Fetch2(); WHEN(3) SP = Fetch2(); END; /* of SELECT(RegPair) */ TState = TState + 10; END Do_LXI; Do_DAD: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; DECLARE Val FIXED BINARY(31); Val = Unfix16(HL); SELECT(RegPair); WHEN(0) Val = Val + Unfix16(BC); WHEN(1) Val = Val + Unfix16(DE); WHEN(2) Val = Val + Unfix16(HL); WHEN(3) Val = Val + Unfix16(SP); END; /* of SELECT(RegPair) */ Flags(F_Carry) = Val>65535; HL = Fixed15(Val); TState = TState + 10; END Do_DAD; Do_STAX: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) CALL PutMem(BC,A); WHEN(1) CALL PutMem(DE,A); END; /* of SELECT(RegPair) */ TState = TState + 7; END Do_STAX; Do_LDAX: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) A = GetMem(BC); WHEN(1) A = GetMem(DE); END; /* of SELECT(RegPair) */ TState = TState + 7; END Do_LDAX; Do_SHLD: PROCEDURE; DECLARE Addr FIXED BINARY(15); Addr = Fetch2(); CALL PutMem(Addr,L); CALL PutMem(AddOne(Addr),H); TState = TState + 16; END Do_SHLD; Do_LHLD: PROCEDURE; DECLARE Addr FIXED BINARY(15); Addr = Fetch2(); L = GetMem(Addr); H = GetMem(AddOne(Addr)); TState = TState + 16; END Do_LHLD; Do_STA: PROCEDURE; CALL PutMem(Fetch2(),A); TState = TState + 13; END Do_STA; Do_LDA: PROCEDURE; A = GetMem(Fetch2()); TState = TState + 13; END Do_LDA; Do_INX: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) BC = AddOne(BC); WHEN(1) DE = AddOne(DE); WHEN(2) HL = AddOne(HL); WHEN(3) SP = AddOne(SP); END; /* of SELECT(RegPair) */ TState = TState + 5; END Do_INX; Do_DCX: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) BC = SubOne(BC); WHEN(1) DE = SubOne(DE); WHEN(2) HL = SubOne(HL); WHEN(3) SP = SubOne(SP); END; /* of SELECT(RegPair) */ TState = TState + 5; END Do_DCX; Increment: PROCEDURE(Val) RETURNS(FIXED BINARY(7)); DECLARE Val FIXED BINARY(7) VALUE; DECLARE Result FIXED BINARY(15); Result = UnFix8(Val); Result = Result + 1; Flags(F_AuxCarry) = MOD(Result,16)=0; CALL SetFlags(Fixed7(Result)); RETURN(Fixed7(Result)); END Increment; Do_INR: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7) VALUE; SELECT(Reg); WHEN(0) B = Increment(B); WHEN(1) C = Increment(C); WHEN(2) D = Increment(D); WHEN(3) E = Increment(E); WHEN(4) H = Increment(H); WHEN(5) L = Increment(L); WHEN(6) CALL PutMem(HL,Increment(GetMem(HL))); WHEN(7) A = Increment(A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 10; ELSE TState = TState + 5; END Do_INR; Decrement: PROCEDURE(Val) RETURNS(FIXED BINARY(7)); DECLARE Val FIXED BINARY(7) VALUE; DECLARE Result FIXED BINARY(15); Result = UnFix8(Val); Flags(F_AuxCarry) = MOD(Result,16)=0; Result = Result - 1; CALL SetFlags(Fixed7(Result)); RETURN(Fixed7(Result)); END Decrement; Do_DCR: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7) VALUE; SELECT(Reg); WHEN(0) B = Decrement(B); WHEN(1) C = Decrement(C); WHEN(2) D = Decrement(D); WHEN(3) E = Decrement(E); WHEN(4) H = Decrement(H); WHEN(5) L = Decrement(L); WHEN(6) CALL PutMem(HL,Decrement(GetMem(HL))); WHEN(7) A = Decrement(A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 10; ELSE TState = TState + 5; END Do_DCR; Do_MVI: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7) VALUE; SELECT(Reg); WHEN(0) B = Fetch(); WHEN(1) C = Fetch(); WHEN(2) D = Fetch(); WHEN(3) E = Fetch(); WHEN(4) H = Fetch(); WHEN(5) L = Fetch(); WHEN(6) CALL PutMem(HL,Fetch()); WHEN(7) A = Fetch(); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 10; ELSE TState = TState + 7; END Do_MVI; Do_RLC: PROCEDURE; DECLARE Val FIXED BINARY(15); Val = UnFix8(A); Val = Val*2; Flags(F_Carry) = Val>255; IF Flags(F_Carry) THEN Val=Val+1; A = Fixed7(Val); TState = TState + 4; END Do_RLC; Do_RRC: PROCEDURE; DECLARE Val FIXED BINARY(15); Val = UnFix8(A); Flags(F_Carry) = (MOD(Val,2)=1); Val = Val/2; IF Flags(F_Carry) THEN Val=Val+128; A = Fixed7(Val); TState = TState + 4; END Do_RRC; Do_RAL: PROCEDURE; DECLARE Val FIXED BINARY(15); Val = UnFix8(A); Val = Val*2; IF Flags(F_Carry) THEN Val=Val+1; Flags(F_Carry) = (Val>255); A = Fixed7(Val); TState = TState + 4; END Do_RAL; Do_RAR: PROCEDURE; DECLARE Val FIXED BINARY(15); Val = UnFix8(A); Val = Val/2; IF Flags(F_Carry) THEN Val=Val+128; Flags(F_Carry) = (MOD(A,2)=1); A = Fixed7(Val); TState = TState + 4; END Do_RAR; Do_DAA: PROCEDURE; DECLARE Val FIXED BINARY(15), Hi FIXED BINARY(15), Lo FIXED BINARY(15); Val = UnFix8(A); Hi = Val/16; Lo = MOD(Val,16); IF Flags(F_AuxCarry) | Lo>9 THEN DO; Lo = Lo + 6; IF Lo>15 THEN DO; Lo = Lo - 16; Hi = Hi + 1; Flags(F_AuxCarry) = TRUE; END; END; IF Flags(F_Carry) | Hi>9 THEN DO; Hi = Hi + 6; IF Hi>15 THEN Flags(F_Carry) = TRUE; END; A = Fixed7(Hi*16 + Lo); CALL SetFlags(A); TState = TState + 4; END Do_DAA; Do_CMA: PROCEDURE; A = Fixed7(SubOne(-FIXED(A,15))); TState = TState + 4; END Do_CMA; Do_STC: PROCEDURE; Flags(F_Carry) = TRUE; TState = TState + 4; END Do_STC; Do_CMC: PROCEDURE; Flags(F_Carry) = ^Flags(F_Carry); TState = TState + 4; END Do_CMC; Do_ADD: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Add_Operation(A,B,FALSE); WHEN(1) A = Add_Operation(A,C,FALSE); WHEN(2) A = Add_Operation(A,D,FALSE); WHEN(3) A = Add_Operation(A,E,FALSE); WHEN(4) A = Add_Operation(A,H,FALSE); WHEN(5) A = Add_Operation(A,L,FALSE); WHEN(6) A = Add_Operation(A,GetMem(HL),FALSE); WHEN(7) A = Add_Operation(A,A,FALSE); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_ADD; Do_ADI: PROCEDURE; A = Add_Operation(A,Fetch(),FALSE); TState = TState + 7; END Do_ADI; Do_ADC: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Add_Operation(A,B,TRUE); WHEN(1) A = Add_Operation(A,C,TRUE); WHEN(2) A = Add_Operation(A,D,TRUE); WHEN(3) A = Add_Operation(A,E,TRUE); WHEN(4) A = Add_Operation(A,H,TRUE); WHEN(5) A = Add_Operation(A,L,TRUE); WHEN(6) A = Add_Operation(A,GetMem(HL),TRUE); WHEN(7) A = Add_Operation(A,A,TRUE); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_ADC; Do_ACI: PROCEDURE; A = Add_Operation(A,Fetch(),TRUE); TState = TState + 7; END Do_ACI; Do_SUB: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Sub_Operation(A,B,FALSE); WHEN(1) A = Sub_Operation(A,C,FALSE); WHEN(2) A = Sub_Operation(A,D,FALSE); WHEN(3) A = Sub_Operation(A,E,FALSE); WHEN(4) A = Sub_Operation(A,H,FALSE); WHEN(5) A = Sub_Operation(A,L,FALSE); WHEN(6) A = Sub_Operation(A,GetMem(HL),FALSE); WHEN(7) A = Sub_Operation(A,A,FALSE); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_SUB; Do_SUI: PROCEDURE; A = Sub_Operation(A,Fetch(),FALSE); TState = TState + 7; END Do_SUI; Do_SBB: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Sub_Operation(A,B,TRUE); WHEN(1) A = Sub_Operation(A,C,TRUE); WHEN(2) A = Sub_Operation(A,D,TRUE); WHEN(3) A = Sub_Operation(A,E,TRUE); WHEN(4) A = Sub_Operation(A,H,TRUE); WHEN(5) A = Sub_Operation(A,L,TRUE); WHEN(6) A = Sub_Operation(A,GetMem(HL),TRUE); WHEN(7) A = Sub_Operation(A,A,TRUE); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_SBB; Do_SBI: PROCEDURE; A = Sub_Operation(A,Fetch(),TRUE); TState = TState + 7; END Do_SBI; Do_ANA: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = And_Operation(A,B); WHEN(1) A = And_Operation(A,C); WHEN(2) A = And_Operation(A,D); WHEN(3) A = And_Operation(A,E); WHEN(4) A = And_Operation(A,H); WHEN(5) A = And_Operation(A,L); WHEN(6) A = And_Operation(A,GetMem(HL)); WHEN(7) A = And_Operation(A,A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_ANA; Do_ANI: PROCEDURE; A = And_Operation(A,Fetch()); TState = TState + 7; END Do_ANI; Do_XRA: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Xor_Operation(A,B); WHEN(1) A = Xor_Operation(A,C); WHEN(2) A = Xor_Operation(A,D); WHEN(3) A = Xor_Operation(A,E); WHEN(4) A = Xor_Operation(A,H); WHEN(5) A = Xor_Operation(A,L); WHEN(6) A = Xor_Operation(A,GetMem(HL)); WHEN(7) A = Xor_Operation(A,A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_XRA; Do_XRI: PROCEDURE; A = Xor_Operation(A,Fetch()); TState = TState + 7; END Do_XRI; Do_ORA: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) A = Or_Operation(A,B); WHEN(1) A = Or_Operation(A,C); WHEN(2) A = Or_Operation(A,D); WHEN(3) A = Or_Operation(A,E); WHEN(4) A = Or_Operation(A,H); WHEN(5) A = Or_Operation(A,L); WHEN(6) A = Or_Operation(A,GetMem(HL)); WHEN(7) A = Or_Operation(A,A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_ORA; Do_ORI: PROCEDURE; A = Or_Operation(A,Fetch()); TState = TState + 7; END Do_ORI; Do_CMP: PROCEDURE(Reg); DECLARE Reg FIXED BINARY(7); SELECT(Reg); WHEN(0) CALL Cmp_Operation(A,B); WHEN(1) CALL Cmp_Operation(A,C); WHEN(2) CALL Cmp_Operation(A,D); WHEN(3) CALL Cmp_Operation(A,E); WHEN(4) CALL Cmp_Operation(A,H); WHEN(5) CALL Cmp_Operation(A,L); WHEN(6) CALL Cmp_Operation(A,GetMem(HL)); WHEN(7) CALL Cmp_Operation(A,A); END; /* of SELECT(Reg) */ IF Reg=6 THEN TState = TState + 7; ELSE TState = TSTate + 4; END Do_CMP; Do_CPI: PROCEDURE; CALL Cmp_Operation(A,Fetch()); TState = TState + 7; END Do_CPI; And_Operation: PROCEDURE(Val_1,Val_2) RETURNS(FIXED BINARY(7)); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE; DECLARE 1 Num1 UNION, 2 Num_1 FIXED BINARY(7), 2 Bits_1 BIT(8), 1 Num2 UNION, 2 Num_2 FIXED BINARY(7), 2 Bits_2 BIT(8); Num_1 = Val_1; Num_2 = Val_2; Flags(F_AuxCarry) = Substr(Bits_1,3,1) | Substr(Bits_2,3,1); Bits_1 = Bits_1 & Bits_2; Flags(F_Carry) = FALSE; CALL SetFlags(Num_1); RETURN(Num_1); END And_Operation; Or_Operation: PROCEDURE(Val_1,Val_2) RETURNS(FIXED BINARY(7)); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE; DECLARE 1 Num1 UNION, 2 Num_1 FIXED BINARY(7), 2 Bits_1 BIT(8), 1 Num2 UNION, 2 Num_2 FIXED BINARY(7), 2 Bits_2 BIT(8); Num_1 = Val_1; Num_2 = Val_2; Bits_1 = Bits_1 | Bits_2; Flags(F_Carry) = FALSE; Flags(F_AuxCarry) = FALSE; CALL SetFlags(Num_1); RETURN(Num_1); END Or_Operation; Xor_Operation: PROCEDURE(Val_1,Val_2) RETURNS(FIXED BINARY(7)); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE; DECLARE 1 Num1 UNION, 2 Num_1 FIXED BINARY(7), 2 Bits_1 BIT(8), 1 Num2 UNION, 2 Num_2 FIXED BINARY(7), 2 Bits_2 BIT(8); Num_1 = Val_1; Num_2 = Val_2; Bits_1 = BOOL(Bits_1,Bits_2,'0110'B); Flags(F_Carry) = FALSE; Flags(F_AuxCarry) = FALSE; CALL SetFlags(Num_1); RETURN(Num_1); END Xor_Operation; Add_Operation: PROCEDURE(Val_1,Val_2,Use_Carry) RETURNS(FIXED BINARY(7)); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE, Use_Carry BIT VALUE; DECLARE Result FIXED BINARY(15), Carry FIXED BINARY(15), Num_1 FIXED BINARY(15), Num_2 FIXED BINARY(15); IF Use_Carry & Flags(F_Carry) THEN Carry = 1; ELSE Carry = 0; Num_1 = UnFix8(Val_1); Num_2 = UnFix8(Val_2); Result = Num_1 + Num_2 + Carry; Flags(F_Carry) = (Result > 255); Flags(F_AuxCarry) = (MOD(Num_1,16) + MOD(Num_2,16) + Carry) > 15; CALL SetFlags(Fixed7(Result)); RETURN(Fixed7(Result)); END Add_Operation; Sub_Operation: PROCEDURE(Val_1,Val_2,Use_Borrow) RETURNS(FIXED BINARY(7)); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE, Use_Borrow BIT VALUE; DECLARE Result FIXED BINARY(15), Borrow FIXED BINARY(15), Num_1 FIXED BINARY(15), Num_2 FIXED BINARY(15); IF Use_Borrow & Flags(F_Carry) THEN Borrow = 1; ELSE Borrow = 0; Num_1 = UnFix8(Val_1); Num_2 = UnFix8(Val_2); Result = Num_1 - Num_2 - Borrow; Flags(F_Carry) = (Result < 0); Flags(F_AuxCarry) = (MOD(Num_1,16) - MOD(Num_2,16) - Borrow) < 0; CALL SetFlags(Fixed7(Result)); RETURN(Fixed7(Result)); END Sub_Operation; Cmp_Operation: PROCEDURE(Val_1,Val_2); DECLARE Val_1 FIXED BINARY(7) VALUE, Val_2 FIXED BINARY(7) VALUE; DECLARE Result FIXED BINARY(7); Result=Sub_Operation(Val_1,Val_2,FALSE); END Cmp_Operation; Do_POP: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) BC = Pop(); WHEN(1) DE = Pop(); WHEN(2) HL = Pop(); WHEN(3) PSW = Pop(); END; /* of SELECT(RegPair) */ TState = TState + 10; END Do_POP; Do_PUSH: PROCEDURE(RegPair); DECLARE RegPair FIXED BINARY(7) VALUE; SELECT(RegPair); WHEN(0) CALL Push(BC); WHEN(1) CALL Push(DE); WHEN(2) CALL Push(HL); WHEN(3) CALL Push(PSW); END; /* of SELECT(RegPair) */ TState = TState + 11; END Do_PUSH; Condition: PROCEDURE(Cond) RETURNS(BIT); DECLARE Cond FIXED BINARY(7) VALUE; SELECT(Cond); WHEN(0) RETURN(^Flags(F_Zero)); WHEN(1) RETURN( Flags(F_Zero)); WHEN(2) RETURN(^Flags(F_Carry)); WHEN(3) RETURN( Flags(F_Carry)); WHEN(4) RETURN(^Flags(F_Parity)); WHEN(5) RETURN( Flags(F_Parity)); WHEN(6) RETURN(^Flags(F_Sign)); WHEN(7) RETURN( Flags(F_Sign)); END; /* of SELECT(Cond) */ END Condition; Do_JMP: PROCEDURE; PC = Fetch2(); TState = TState + 10; END Do_JMP; Do_Cond_Jump: PROCEDURE(Cond); DECLARE Cond FIXED BINARY(7) VALUE; DECLARE Addr FIXED BINARY(15); IF Condition(Cond) THEN CALL Do_JMP; ELSE DO; Addr = Fetch2(); TState = TState + 10; END; END Do_Cond_Jump; Do_CALL: PROCEDURE; DECLARE Addr FIXED BINARY(15); Addr = Fetch2(); CALL Push(PC); PC = Addr; TState = TState + 17; END Do_CALL; Do_Cond_Call: PROCEDURE(Cond); DECLARE Cond FIXED BINARY(7) VALUE; DECLARE Addr FIXED BINARY(15); IF Condition(Cond) THEN CALL Do_CALL; ELSE DO; Addr = Fetch2(); TState = TState + 11; END; END Do_Cond_Call; Do_RET: PROCEDURE; PC = Pop(); TState = TState + 10; END Do_RET; Do_Cond_Return: PROCEDURE(Cond); DECLARE Cond FIXED BINARY(7) VALUE; IF Condition(Cond) THEN DO; CALL Do_RET; TState = TState + 1; END; ELSE TState = TState + 5; END Do_Cond_Return; Do_OUT: PROCEDURE; CALL Out_Port(Fetch(),A); TState = TState + 10; END Do_OUT; Do_IN: PROCEDURE; A = In_Port(Fetch()); TState = TState + 10; END Do_IN; Out_Port: PROCEDURE(Port,Val); DECLARE Port FIXED BINARY(7) VALUE, Val FIXED BINARY(7) VALUE; DECLARE LastWasCR STATIC BIT INIT(FALSE); IF Kern_IO THEN DO; PUT EDIT('Output to port ',UnFix8(Port),', value = ',UnFix8(Val)) (COL(1),A,B4(2),A,B4(2)); RETURN; END; SELECT(Port); WHEN(0) DO; IF Val=10 & LastWasCR THEN PUT SKIP; ELSE PUT EDIT(Byte(Val)) (A); LastWasCR = (Val=13); END; OTHERWISE; /* Ignore other ports for now */ END; /* of SELECT(Port) */ END Out_Port; In_Port: PROCEDURE(Port) RETURNS(FIXED BINARY(7)); DECLARE Port FIXED BINARY(7) VALUE; DECLARE InpVal CHAR(80) VARYING; IF Kern_IO THEN DO; PUT EDIT('Input from port ',UnFix8(Port)) (COL(1),A,B4(2)); DO UNTIL(InpVal^=''); CALL Input(InpVal,'',' value = ? '); END; RETURN(Fixed7(EvalHex(InpVal))); END; SELECT(Port); WHEN(0) IF TypeAhdCnt()=0 THEN RETURN(0); ELSE RETURN(FIXED7(Inkey())); WHEN(1) IF TypeAhdCnt()=0 THEN RETURN(0); ELSE RETURN(FIXED7(SenseChar())); OTHERWISE RETURN(0); /* Ignore other ports for now */ END; /* of SELECT(Port) */ END In_Port; Push: PROCEDURE(Word); DECLARE Word FIXED BINARY(15) VALUE; DECLARE 1 Bytes UNION, 2 TheWord FIXED BINARY(15), 2 TheBytes, 3 Low FIXED BINARY(7), 3 High FIXED BINARY(7); TheWord = Word; SP = SubOne(SP); CALL PutMem(SP,High); SP = SubOne(SP); CALL PutMem(SP,Low); END Push; Pop: PROCEDURE RETURNS(FIXED BINARY(15)); DECLARE 1 Bytes UNION, 2 TheWord FIXED BINARY(15), 2 TheBytes, 3 Low FIXED BINARY(7), 3 High FIXED BINARY(7); Low = GetMem(SP); SP = AddOne(SP); High = GetMem(SP); SP = AddOne(SP); RETURN(TheWord); END Pop; Fetch: PROCEDURE RETURNS(FIXED BINARY(7)); PC = AddOne(PC); RETURN(GetMem(SubOne(PC))); END Fetch; Fetch2: PROCEDURE RETURNS(FIXED BINARY(15)); DECLARE 1 Bytes UNION, 2 TheWord FIXED BINARY(15), 2 TheBytes, 3 Low FIXED BINARY(7), 3 High FIXED BINARY(7); Low = Fetch(); High = Fetch(); RETURN(TheWord); END Fetch2; SetFlags: PROCEDURE(Val); /* Sets the S, Z, and P flags according to val */ DECLARE Val FIXED BINARY(7) VALUE; DECLARE 1 BitTrick UNION, 2 Num FIXED BINARY(7), 2 Bits(8) BIT, I FIXED BINARY(7); Num = Val; Flags(F_Sign) = (Val<0); Flags(F_Zero) = (Val=0); Flags(F_Parity) = TRUE; DO I = 1 TO 8; IF Bits(I) THEN Flags(F_Parity)=^Flags(F_Parity); END; END SetFlags; ResetProcessor: PROCEDURE; PSW = 0; BC = 0; DE = 0; HL = 0; PC = 0; SP = 0; TState = 0; IntFlag = FALSE; TempIntDis = FALSE; Trace = FALSE; StepCnt = 0; TraceStep = FALSE; CALL ClearInts; END ResetProcessor; LoadMem: PROCEDURE; DECLARE FName CHAR(80) VARYING, Line CHAR(80) VARYING, Err BIT INIT(FALSE), Eof BIT INIT(FALSE), Addr FIXED BINARY(31), Word CHAR(80) VARYING, KernCmd CHAR(4); ON ERROR BEGIN; ErrVal=OnCode; Err=TRUE; END; ON ENDFILE(DataIn) Eof=TRUE; CALL GetWord(InpLine,FName); IF FName='' THEN DO; PUT EDIT('Filename required.') (COL(1),A); RETURN; END; OPEN FILE(DataIn) TITLE(FName); IF Err THEN DO; CALL ErrMsg; CLOSE FILE(DataIn); RETURN; END; Addr = 0; GET FILE(DataIn) EDIT(Line) (COL(1),A(80)); IF Index(KernCmds,Line)>0 THEN DO; DO WHILE(^Eof); IF Index(KernCmds,Line)>0 THEN DO; KernCmd = Line; END; ELSE SELECT(KernCmd); WHEN('TINT') CALL AddInt(EvalDec(SubStr(Line,1,9)), EvalDec(SubStr(Line,11,1))); WHEN('LADR') DO; Addr = EvalHex(Line); KernCmd = ' '; END; WHEN('XADR') PC = Fixed15(EvalHex(Line)); WHEN(' ') DO; CALL PutMem(Addr,EvalHex(Line)); Addr = Addr + 1; END; OTHERWISE; END; GET FILE(DataIn) EDIT(Line) (COL(1),A(80)); END; END; ELSE DO WHILE(^Eof & ^Err & ^Break); CALL GetWord(Line,Word); DO WHILE(Word^=''); EvalErr = FALSE; SELECT(Substr(Word,1,1)); WHEN(';') /* ';' comments out the rest of the line */ Line=''; WHEN(':') /* ':' sets the current load address */ Addr = EvalHex(Substr(Word,2)); OTHERWISE /* Otherwise look for a hex byte */ DO; CALL PutMem(Addr,EvalHex(Word)); Addr = Addr + 1; END; END; /* of SELECT(Substr(Word,1,1)) */ IF EvalErr THEN PUT EDIT('Illegal word in file: ',Word) (COL(1),A,A); CALL GetWord(Line,Word); END; GET FILE(DataIn) EDIT(Line) (COL(1),A(80)); END; IF Err THEN CALL ErrMsg; CLOSE FILE(DataIn); END LoadMem; SaveMem: PROCEDURE; DECLARE FName CHAR(80) VARYING, Err BIT INIT(FALSE), Addr1 FIXED BINARY(15), Addr2 FIXED BINARY(15), Count FIXED BINARY(7); ON ERROR BEGIN; ErrVal=OnCode; Err=TRUE; END; CALL GetWord(InpLine,FName); IF FName='' THEN DO; PUT EDIT('Filename required.') (COL(1),A); RETURN; END; Addr1 = Fixed15(EvalNum()); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; Addr2 = AddOne(EvalNum()); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; OPEN FILE(DataOut) TITLE(FName); IF Err THEN DO; CALL ErrMsg; CLOSE FILE(DataOut); RETURN; END; Count=0; DO UNTIL(Addr1=Addr2 | Break); IF Count=0 THEN PUT FILE(DataOut) EDIT(':',UnFix16(Addr1)) (COL(1),A,B4(4)); PUT FILE(DataOut) EDIT(' ',UnFix8(GetMem(Addr1))) (A,B4(2)); Addr1=AddOne(Addr1); Count=MOD(Count+1,16); END; PUT FILE(DataOut) EDIT('') (COL(1),A); CLOSE FILE(DataOut); END SaveMem; DumpMem: PROCEDURE; DECLARE Addr FIXED BINARY(31), Count FIXED BINARY(31), I FIXED BINARY(7), Key FIXED BINARY(15), AscLine CHAR(16), AscVal FIXED BINARY(15); /* Get parameters */ IF InpLine='' THEN Addr = NextAddr; ELSE DO; Addr = EvalNum(); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; END; IF InpLine='' THEN Count=128; ELSE DO; Count = EvalNum(); IF Count<=0 THEN Count=1; IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; END; DO WHILE(MOD(Count,16)^=0); Count=Count+1; END; DO WHILE(Count>0 & ^Break); PUT EDIT(UnFix16(Fixed15(Addr)),': ') (COL(1),B4(4),A); AscLine = ''; DO I = 0 TO 15; PUT EDIT(UnFix8(GetMem(Addr))) (B4(2)); IF I^=15 THEN PUT EDIT(' ') (A); IF I = 7 THEN PUT EDIT(' ') (A); AscVal = UnFix8(GetMem(Addr)); IF AscVal>=128 THEN AscVal = AscVal-128; IF AscVal<32 | AscVal=127 THEN AscVal = Rank('.'); Substr(AscLine,I+1,1)=Byte(AscVal); Addr = Addr + 1; END; PUT EDIT(AscLine) (X(2),A); Count = Count - 16; NextAddr = Fixed15(Addr); END; NextCmd = 'D'; END DumpMem; SetMem: PROCEDURE; DECLARE Addr FIXED BINARY(31), Val FIXED BINARY(31); Addr = EvalNum(); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; DO WHILE(^EvalErr & InpLine^=''); Val = EvalNum(); IF EvalErr THEN PUT EDIT('Operand error.') (COL(1),A); ELSE DO; CALL PutMem(Addr,Val); Addr=Addr+1; END; END; END SetMem; DumpRegs: PROCEDURE; DECLARE I FIXED BINARY(7); PUT EDIT('Register dump: SZxAxPxC') (COL(1),A); PUT EDIT(' A = ',UnFix8(A)) (COL(8) ,A,B4(2)); PUT EDIT(' F = ') (COL(20),A); DO I = 7 TO 0 BY -1; PUT EDIT(Flags(I)) (B); END; PUT EDIT('BC = ',UnFix16(BC)) (COL(8) ,A,B4(4)); PUT EDIT('PC = ',UnFix16(PC)) (COL(20),A,B4(4)); PUT EDIT('DE = ',UnFix16(DE)) (COL(8) ,A,B4(4)); PUT EDIT('SP = ',UnFix16(SP)) (COL(20),A,B4(4)); PUT EDIT('HL = ',UnFix16(HL)) (COL(8) ,A,B4(4)); PUT EDIT(' I = ',IntFlag) (COL(20),A,B1(1)); PUT EDIT('TState = ',STR$(TState)) (COL(12),A,A); END DumpRegs; TraceRegs: PROCEDURE; PUT EDIT('A=',UnFix8(A),' F=') (COL(1),A,B4(2),A); CALL DumpFlags; PUT EDIT(' BC=',UnFix16(BC),' DE=',UnFix16(DE),' HL=',UnFix16(HL), ' PC=',UnFix16(PC),' SP=',UnFix16(SP),' I=',IntFlag, ' T=',STR$(TState),' ') (A,B4(4),A,B4(4),A,B4(4),A,B4(4),A,B4(4),A,B1(1),A,A,A); END TraceRegs; DumpFlags: PROCEDURE; DECLARE I FIXED BINARY(15); DO I = 7 TO 0 BY -1; IF Flags(I) THEN PUT EDIT(SubStr('SZ1A1P1C',8-I,1)) (A); ELSE PUT EDIT(SubStr('sz-a-p-c',8-I,1)) (A); END; END DumpFlags; SetRegs: PROCEDURE; DECLARE RegName CHAR(10) VARYING, Val FIXED BINARY(31), TempRadix FIXED BINARY(15); CALL GetWord(InpLine,RegName); RegName = UpCase(RegName); TempRadix = DefRadix; IF RegName='TSTATE' | RegName = 'TS' THEN DefRadix = 10; Val = EvalNum(); DefRadix = TempRadix; IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; SELECT(RegName); WHEN('A') A = Fixed7(Val); WHEN('B') B = Fixed7(Val); WHEN('C') C = Fixed7(Val); WHEN('D') D = Fixed7(Val); WHEN('E') E = Fixed7(Val); WHEN('H') H = Fixed7(Val); WHEN('L') L = Fixed7(Val); WHEN('BC') BC = Fixed15(Val); WHEN('DE') DE = Fixed15(Val); WHEN('HL') HL = Fixed15(Val); WHEN('PC') PC = Fixed15(Val); WHEN('SP') SP = Fixed15(Val); WHEN('F','FLAGS') F = Fixed7(Val); WHEN('I') IntFlag = (Val ^= 0); WHEN('TI') TempIntDis = (Val ^= 0); WHEN('TSTATE','TS') TState = Val; OTHERWISE PUT EDIT('Register name error.') (COL(1),A); END; /* of SELECT(RegName) */ END SetRegs; GoAddr: PROCEDURE RETURNS(BIT); DECLARE Addr FIXED BINARY(15); IF InpLine='' THEN RETURN(TRUE); Addr=Fixed15(EvalNum()); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN(FALSE); END; PC=Addr; RETURN(TRUE); END GoAddr; GoTill: PROCEDURE RETURNS(BIT); DECLARE Addr FIXED BINARY(15); Addr=Fixed15(EvalNum()); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN(FALSE); END; GoBreakAddr = Addr; GoBreak = TRUE; RETURN(TRUE); END GoTill; SetStepCount: PROCEDURE RETURNS(BIT); DECLARE Count FIXED BINARY(31); IF InpLine='' THEN RETURN(TRUE); Count=EvalNumDec(); IF EvalErr | Count<=0 THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN(FALSE); END; StepCnt = Count; RETURN(TRUE); END SetStepCount; Disassemble: PROCEDURE; DECLARE Addr FIXED BINARY(15), Count FIXED BINARY(31), I FIXED BINARY(31), Key FIXED BINARY(15), DisLine CHAR(80) VARYING; IF InpLine='' THEN Addr=NextAddr; ELSE DO; Addr=Fixed15(EvalNum()); IF EvalErr THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; END; IF InpLine='' THEN Count=16; ELSE DO; Count=EvalNumDec(); IF EvalErr | Count<=0 THEN DO; PUT EDIT('Operand error.') (COL(1),A); RETURN; END; END; DO I = 1 TO Count WHILE(^Break); CALL DisOne(Addr,DisLine,TRUE,TRUE); PUT EDIT(DisLine) (COL(1),A); NextAddr = Addr; END; NextCmd = 'L'; END Disassemble; DisOne: PROCEDURE(Addr,DisLine,ShowAddr,ShowHex); DECLARE Addr FIXED BINARY(15), DisLine CHAR(*) VARYING, ShowAddr BIT, ShowHex BIT; DECLARE P1 FIXED BINARY(7), /* **xxxxxx bits */ P2 FIXED BINARY(7), /* xx***xxx bits */ P3 FIXED BINARY(7), /* xxxxx*** bits */ P4 FIXED BINARY(7), /* xx**xxxx bits */ P5 BIT, /* xxxx*xxx bit */ Byte(1:3) FIXED BINARY(8), NumBytes FIXED BINARY(7) INIT(1), Opcode CHAR(4) VARYING INIT('???'), Operand CHAR(16) VARYING INIT(''), I FIXED BINARY(15), CvtStr CHAR(4) VARYING, Reg1(0:7) CHAR(1) INIT('B','C','D','E','H','L','M','A'), Reg2(0:3) CHAR(2) VARYING INIT('B','D','H','SP'), Reg3(0:3) CHAR(3) VARYING INIT('B','D','H','PSW'), Arith(0:7) CHAR(3) INIT( 'ADD','ADC','SUB','SBB', 'ANA','XRA','ORA','CMP'), ArithI(0:7) CHAR(3) INIT( 'ADI','ACI','SUI','SBI', 'ANI','XRI','ORI','CPI'), Cond(0:7) CHAR(2) INIT('NZ','Z ','NC','C ','PO','PE','P ','M '), Shift(0:7) CHAR(3) INIT( 'RLC','RRC','RAL','RAR', 'DAA','CMA','STC','CMC'), Load(4:7) CHAR(4) INIT('SHLD','LHLD','STA ','LDA '); MakeHex: PROCEDURE(WhichByte) RETURNS(CHAR(2)); DECLARE WhichByte FIXED BINARY(7); DECLARE HexStr CHAR(2); PUT STRING(HexStr) EDIT(Byte(WhichByte)) (B4(2)); RETURN(HexStr); END MakeHex; AddWord: PROCEDURE; Operand = Operand || MakeHex(3) || MakeHex(2) || 'H'; NumBytes = 3; END AddWord; AddByte: PROCEDURE; Operand = Operand || MakeHex(2) || 'H'; NumBytes = 2; END AddByte; DO I=1 TO 3; Byte(I) = UnFix8(GetMem(Addr+I-1)); END; P1 = Byte(1)/64; P2 = MOD(FIXED(Byte(1)/8,7),8); P3 = MOD(Byte(1),8); P4 = MOD(FIXED(Byte(1)/16,7),4); P5 = MOD(P2,2)=1; SELECT(P1); WHEN(0) SELECT(P3); WHEN(0) IF P2=0 THEN Opcode = 'NOP'; WHEN(1) DO; IF P5 THEN Opcode = 'DAD'; ELSE Opcode = 'LXI'; Operand = Reg2(P4); IF ^P5 THEN DO; Operand = Operand || ','; CALL AddWord; END; END; WHEN(2) SELECT(P2); WHEN(0,1,2,3) DO; IF P5 THEN Opcode = 'LDAX'; ELSE Opcode = 'STAX'; Operand = Reg2(P4); END; WHEN(4,5,6,7) DO; Opcode = Load(P2); CALL AddWord; END; END; /* of SELECT(P2) */ WHEN(3) DO; IF P5 THEN Opcode = 'DCX'; ELSE Opcode = 'INX'; Operand = Reg2(P4); END; WHEN(4) DO; Opcode = 'INR'; Operand = Reg1(P2); END; WHEN(5) DO; Opcode = 'DCR'; Operand = Reg1(P2); END; WHEN(6) DO; Opcode = 'MVI'; Operand = Reg1(P2) || ','; CALL AddByte; END; WHEN(7) Opcode = Shift(P2); END; /* of SELECT(P3) */ WHEN(1) IF P2=6 & P3=6 THEN Opcode = 'HLT'; ELSE DO; Opcode = 'MOV'; Operand = Reg1(P2) || ',' || Reg1(P3); END; WHEN(2) DO; Opcode = Arith(P2); Operand = Reg1(P3); END; WHEN(3) SELECT(P3); WHEN(0) OpCode = Deblank('R' || Cond(P2)); WHEN(1) IF P5 THEN DO; SELECT(P4); WHEN(0) Opcode = 'RET'; WHEN(1); /* Opcode D9 is illegal */ WHEN(2) Opcode = 'PCHL'; WHEN(3) Opcode = 'SPHL'; END; /* of SELECT(P4) */ END; ELSE DO; Opcode = 'POP'; Operand = Reg3(P4); END; WHEN(2) DO; Opcode = 'J' || Cond(P2); CALL AddWord; END; WHEN(3) SELECT(P2); WHEN(0) DO; Opcode = 'JMP'; CALL AddWord; END; WHEN(1); /* Opcode CB is illegal */ WHEN(2,3) DO; IF P5 THEN Opcode = 'IN'; ELSE Opcode = 'OUT'; CALL AddByte; END; WHEN(4) Opcode = 'XTHL'; WHEN(5) Opcode = 'XCHG'; WHEN(6) Opcode = 'DI'; WHEN(7) Opcode = 'EI'; END; /* of SELECT(P2) */ WHEN(4) DO; Opcode = 'C' || Cond(P2); CALL AddWord; END; WHEN(5) IF P5 THEN DO; IF P4=0 THEN DO; Opcode = 'CALL'; CALL AddWord; END; END; ELSE DO; Opcode = 'PUSH'; Operand = Reg3(P4); END; WHEN(6) DO; Opcode = ArithI(P2); CALL AddByte; END; WHEN(7) DO; Opcode = 'RST'; Operand = Str$(P2); END; END; /* of SELECT(P3) */ END; /* of SELECT(P1) */ PUT STRING(CvtStr) EDIT(UnFix16(Addr)) (B4(4)); IF ShowAddr THEN DisLine = CvtStr || ': '; ELSE DisLine = ''; IF ShowHex THEN DO I=1 TO 3; IF NumBytes>=I THEN DO; PUT STRING(CvtStr) EDIT(Byte(I)) (B4(2)); DisLine = DisLine || CvtStr || ' '; END; ELSE DisLine = DisLine || ' '; END; DisLine = DisLine || Opcode; IF Operand^='' THEN DisLine = DisLine || Copy(' ',5-Length(Opcode)) || Operand; Addr = Fixed15(FIXED(Addr,31)+FIXED(NumBytes,31)); END DisOne; InitMemory: PROCEDURE; DECLARE I FIXED BINARY(15); DO I = 0 TO 255; MemPage(I) = NULL; Access(I) = FALSE; END; END InitMemory; ClearMemory: PROCEDURE; DECLARE I FIXED BINARY(31); DO I = 0 TO 255; IF MemPage(I)^=NULL THEN FREE MemPage(I)->Page; Access(I) = FALSE; END; END ClearMemory; ShowPages: PROCEDURE; DECLARE Row FIXED BINARY(15), Column FIXED BINARY(15); PUT EDIT(' 0 1 2 3 4 5 6 7 8 9 A B C D E F') (COL(1),A); PUT EDIT(' ---------------------------------') (COL(1),A); DO Row = 0 TO 15; PUT EDIT(SubStr('0123456789ABCDEF',Row+1,1),' |') (COL(1),A,A); DO Column = 0 TO 15; PUT EDIT(' ') (A); SELECT; WHEN(MemPage(Row*16+Column)^=NULL) PUT EDIT('*') (A); WHEN( Access(Row*16+Column)) PUT EDIT(':') (A); OTHERWISE PUT EDIT('.') (A); END; END; END; END ShowPages; GetMem: PROCEDURE(Addr) RETURNS(FIXED BINARY(7)); DECLARE Addr FIXED BINARY(31) VALUE; DECLARE TempAddr FIXED BINARY(31), PageNo FIXED BINARY(15), ByteNo FIXED BINARY(15); TempAddr = UnFix16(Fixed15(Addr)); PageNo = TempAddr/256; ByteNo = MOD(TempAddr,256); Access(PageNo) = TRUE; IF MemPage(PageNo)=NULL THEN RETURN(0); RETURN(MemPage(PageNo)->Page(ByteNo)); END GetMem; PutMem: PROCEDURE(Addr,Val); DECLARE Addr FIXED BINARY(31) VALUE, Val FIXED BINARY(31) VALUE; DECLARE TempAddr FIXED BINARY(31), PageNo FIXED BINARY(15), ByteNo FIXED BINARY(15); TempAddr = UnFix16(Fixed15(Addr)); PageNo = TempAddr/256; ByteNo = MOD(TempAddr,256); Access(PageNo) = TRUE; IF MemPage(PageNo)=NULL THEN /* IF Fixed7(Val)=0 THEN RETURN ELSE */ ALLOCATE Page SET(MemPage(PageNo)); MemPage(PageNo)->Page(ByteNo) = Fixed7(Val); END PutMem; IntCmd: PROCEDURE; DECLARE Word CHAR(80) VARYING, Time FIXED BINARY(31), RST_No FIXED BINARY(31); IF InpLine='' THEN CALL ShowInts; ELSE DO; CALL GetWord(InpLine,Word); IF Upcase(Word)='CLEAR' THEN CALL ClearInts; ELSE DO; EvalErr = FALSE; Time = EvalDec(Word); IF EvalErr THEN PUT EDIT('Operand error.') (COL(1),A); ELSE DO; RST_No = EvalNum(); IF EvalErr | Time=0 | RST_No<0 | RST_No>7 THEN PUT EDIT('Operand error.') (COL(1),A); ELSE IF Time>0 THEN CALL AddInt( Time,RST_No); ELSE CALL DelInt(-Time,RST_No); END; END; END; END IntCmd; 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; 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; DelInt: PROCEDURE(Time,RST_No); DECLARE Time FIXED BINARY(31) VALUE, RST_No FIXED BINARY(15) VALUE; DECLARE P POINTER, Q POINTER, Done BIT; Q = NULL; P = IntList; Done = FALSE; DO WHILE(P^=NULL & ^Done); Done = (Time = P->Int.Time) & (RST_No = P->Int.RST_No); IF ^Done THEN DO; Q = P; P = Q->Int.Next; END; END; IF P=NULL THEN DO; PUT EDIT('Interrupt not found.') (COL(1),A); RETURN; END; IF Q=NULL THEN IntList = P->Int.Next; ELSE Q->Int.Next = P->Int.Next; FREE P->Int; END DelInt; ClearInts: PROCEDURE; DECLARE P POINTER; IntList = NULL; DO WHILE(IntList^=NULL); P = IntList->Int.Next; FREE IntList->Int; IntList = P; END; END ClearInts; ShowInts: PROCEDURE; DECLARE P POINTER; P = IntList; IF P=NULL THEN DO; PUT EDIT('Interrupt queue empty.') (COL(1),A); END; DO WHILE(P^=NULL); PUT EDIT(P->Int.Time,P->Int.RST_No) (COL(1),F(11),X,F(1)); P = P->Int.Next; END; END ShowInts; Input: PROCEDURE(InpStr,Default,PromptStr); DECLARE InpStr CHAR(*) VARYING, Default CHAR(*), PromptStr CHAR(*) VARYING; DECLARE Eof BIT INIT(FALSE), Err BIT INIT(FALSE); ON ERROR BEGIN; ErrVal=OnCode; Err=TRUE; END; ON ENDFILE(SysIn) Eof=TRUE; DO UNTIL(^Err & ^Break); PUT EDIT('') (COL(1),A); Break = FALSE; Err = FALSE; GET FILE(SysIn) OPTIONS(PROMPT(PromptStr)) EDIT(InpStr) (COL(1),A(80)); IF Err THEN DO; PUT EDIT(' ') (COL(1),A); CALL ErrMsg; END; PUT EDIT('') (COL(1),A); END; IF Eof THEN DO; CLOSE FILE(SysIn); OPEN FILE(SysIn); InpStr=Default; END; END Input; YesNo: PROCEDURE(Default,PromptStr) RETURNS(BIT); DECLARE Default CHAR(*), PromptStr CHAR(*) VARYING; DECLARE InpStr CHAR(80) VARYING; DO UNTIL(Index('YyNn',Substr(InpStr,1,1))>0); DO UNTIL(Length(InpStr)>0); CALL Input(InpStr,Default,PromptStr); IF Length(InpStr)=0 THEN InpStr=Default; END; END; RETURN(Index('Yy',Substr(InpStr,1,1))>0); END YesNo; GetWord: PROCEDURE(Line,Word); DECLARE Line CHAR(*) VARYING, Word CHAR(*) VARYING; DECLARE P FIXED BINARY(15); Line = Deblank(Line); P = Index(Line,' '); IF P=0 THEN DO; Word = Line; Line = ''; END; ELSE DO; Word = Substr(Line,1,P-1); Line = Substr(Line,P+1); END; Line = Deblank(Line); END GetWord; OnOff: PROCEDURE(Flag); DECLARE Flag BIT; DECLARE Word CHAR(4) VARYING; CALL GetWord(InpLine,Word); SELECT(Upcase(Word)); WHEN('ON' ,'1') Flag = TRUE; WHEN('OFF','0') Flag = FALSE; OTHERWISE PUT EDIT('Illegal operand.') (COL(1),A); END; END OnOff; EvalNum: PROCEDURE RETURNS(FIXED BINARY(31)); DECLARE ValStr CHAR(80) VARYING, AscChr CHAR(1); /* Un-upcased 2nd chr of ValStr */ EvalErr = FALSE; CALL GetWord(InpLine,ValStr); IF Length(ValStr)>=2 THEN AscChr=Substr(ValStr,2,1); ValStr = UpCase(ValStr); EvalErr = (ValStr = '') | ((ValStr = '''') & (Length(ValStr) = 1)); IF ^EvalErr THEN SELECT(Substr(ValStr,1,1)); WHEN('$') RETURN(EvalHex(Substr(ValStr,2))); WHEN('&') RETURN(EvalDec(Substr(ValStr,2))); WHEN('''') RETURN(Rank(AscChr)); WHEN('H') RETURN(HL); WHEN('P') RETURN(PC); WHEN('S') RETURN(SP); WHEN('R') SELECT(Substr(ValStr,2)); WHEN('BC') RETURN(BC); WHEN('DE') RETURN(DE); WHEN('HL') RETURN(HL); WHEN('SP') RETURN(SP); WHEN('PC') RETURN(PC); OTHERWISE EvalErr = TRUE; END; OTHERWISE IF DefRadix = 10 THEN RETURN(EvalDec(ValStr)); ELSE RETURN(EvalHex(ValStr)); END; RETURN(0); END; EvalNumDec: PROCEDURE RETURNS(FIXED BINARY(31)); DECLARE TempRadix FIXED BINARY(15), Val FIXED BINARY(31); TempRadix = DefRadix; DefRadix = 10; Val = EvalNum(); DefRadix = TempRadix; END EvalNumDec; EvalHex: PROCEDURE(HexStr) RETURNS(FIXED BINARY(31)); DECLARE HexStr CHAR(*) VARYING; DECLARE HexVal FIXED BINARY(31), NewHexStr CHAR(8); IF Length(HexStr)<8 THEN NewHexStr = Copy('0',8-Length(HexStr)) || HexStr; ELSE NewHexStr = Substr(HexStr,Length(HexStr)-7,8); ON ERROR EvalErr = TRUE; GET STRING(NewHexStr) EDIT(HexVal) (B4(8)); RETURN(HexVal); END EvalHex; EvalDec: PROCEDURE(DecStr) RETURNS(FIXED BINARY(31)); DECLARE DecStr CHAR(*) VARYING; DECLARE DecVal FIXED BINARY(31), NewDecStr CHAR(10); NewDecStr = DecStr; ON ERROR EvalErr = TRUE; GET STRING(NewDecStr) EDIT(DecVal) (F(10)); RETURN(DecVal); END EvalDec; Deblank: PROCEDURE(String) RETURNS(CHAR(*)); DECLARE String CHAR(*) VARYING; RETURN(Trim(String,' ',' ')); END Deblank; Str$: PROCEDURE (Num) RETURNS(Char(*)); DECLARE Num FIXED BINARY(31) VALUE; RETURN(Deblank(CHARACTER(Num))); END Str$; UpCase: PROCEDURE(String) RETURNS(CHAR(*)); DECLARE String CHAR(*) VARYING; RETURN(Translate(String,'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 'abcdefghijklmnopqrstuvwxyz')); END UpCase; ErrMsg: PROCEDURE; DECLARE Status FIXED BINARY(31), Message CHAR(256), MsgLen FIXED BINARY(15); Status=SYS$GETMSG(ErrVal,MsgLen,Message,'1111'B,); PUT EDIT(Substr(Message,1,MsgLen)) (COL(1),A); END ErrMsg; 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; StartCtrlC: PROCEDURE; DECLARE Status FIXED BINARY(31); Status=SYS$ASSIGN('TT:',Chan,,); Break=FALSE; Status=SYS$QIOW(,Chan,IO$_SetMode+IO$M_CtrlCAst,,,,CtrlCAst,Brk,,,,); END StartCtrlC; CtrlCAst: PROCEDURE(Brkk); DECLARE 1 Brkk LIKE Brk; DECLARE Status FIXED BINARY(31); Status=SYS$QIOW(,Brkk.Chan,IO$_SetMode+IO$M_CtrlCAst,,,,CtrlCAst,Brkk,,,,); Brkk.Break=TRUE; END CtrlCAst; END Sim8080;