/FILE 12 NAME(Z80.OBJ) NR(4000) NEW(REPL) /FILE 8 DUMMY /SYS REGION=300K /LOAD FORTG1 /OPT DECK,SYSPUN=12,NAME=Z80 /JOB NOGO C ****************************************************************** C * * C * Z 8 0 S I M U L A T O R * C * * C * (c) Peter Coghlan & Niall Downey 1988 * C * * C ****************************************************************** C C This is a Z80 simulator which reads in hexadecimal machine code C from a file which is VC and records less than 105 characters long C and has a # in the second position of each line and a & as the C third last character on each line. The file should be terminated C with a $ in the second position of the last line. C Options to be used by the simulator can be passed to the program C on the command line when it is called, these options are, C C name1 IN name2 OUT name3 LIST name4 NMI nnn INT nnn EX nnnn C C Where 'name1' is the name of the hexadecimal machine code file, C 'name2' is the name of a file from which IN insts. can read, C 'name3' is the name of a file to which OUT insts. can write, C 'name4' is the name of a trace file, C NMI nnn causes NMI's every nnn instructions, C INT nnn causes INT's every nnn instructions, C EX nnnn starts the machine code program at address nnnn hex. C The name of the machine code file must be specified i.e. 'name1', C C Initialise variables and 'memory' C IMPLICIT INTEGER (A-Z) INTEGER REG(7),TREG(7),MEM*2(65536),INDEX(2),OPTLEN(6),POS(104) INTEGER SREG(7),DREG(4),IREG(2),CONDS(9) LOGICAL*1 BUFFER(104),STRING(21),CONT LOGICAL*1 PFILE(22),IPFILE(22),OPFILE(22),SCRFLE(22),OPTS(23) LOGICAL COND,IPFLAG,OPFLAG,EQUAL,EQUALB,FLAG,PCFLAG COMMON PC,BYTES DATA MEM/32767*0,32767*0,2*0/ DATA REG,TREG,C,V,S,N,H,Z,INDEX,I/23*0/ DATA NMICNT,INTCNT,IMODE,IFF1,IFF2,NMI,INT/7*0/ DATA SP/ZFFFF/ DATA CONT/.TRUE./ C DATA PFILE,IPFILE/22*' ','Z','8','0','.','I','N',16*' '/ DATA OPFILE/'Z','8','0','.','O','U','T',15*' '/ DATA OPTS/'NMI INT OUT IN EX LIST '/ DATA BUFFER,OPTLEN/104*' ',4,4,4,3,3,5/ DATA IPFLAG,OPFLAG/2*.FALSE./ C DATA SREG/'A','H','L','D','E','B','C'/ DATA DREG,IREG/'BC','DE','HL','SP','IX','IY'/ DATA CONDS/'NZ','Z','NC','C','PO','PE','P','M',' '/ C CALL REREAD CALL NPRMPT CALL NOECHO C C ###################################################################### C C Get option parameters from command line. C CALL PARM(BUFFER,80,LEN) IF (LEN.NE.0) GOTO 2 WRITE(6,1) 1 FORMAT(/' *Error : program file not specified') CALL EOJ(80) 2 BUFPOS=1 PCFLAG=.TRUE. CALL FILNME(BUFFER,BUFPOS,PFILE) 3 IF (BUFPOS.GE.LEN) GOTO 100 IF (.NOT.EQUAL(BUFFER(BUFPOS),' ',1)) GOTO 4 BUFPOS=BUFPOS+1 IF (BUFPOS.GT.80) GOTO 8 GOTO 3 4 OPTPOS=1 OPTN=1 5 IF (OPTN.GT.6) GOTO 6 FLAG=EQUALB(BUFFER,BUFPOS,OPTS,OPTPOS,OPTLEN(OPTN)) OPTPOS=OPTPOS+OPTLEN(OPTN) OPTN=OPTN+1 IF (.NOT.FLAG) GOTO 5 BUFPOS=BUFPOS+OPTLEN(OPTN-1) IF (BUFPOS.GT.80) GOTO 8 IF (OPTN.EQ.2) NMI=NUMBER(10,BUFFER,BUFPOS) IF (OPTN.EQ.3) INT=NUMBER(10,BUFFER,BUFPOS) IF (OPTN.EQ.4) CALL FILNME(BUFFER,BUFPOS,OPFILE) IF (OPTN.EQ.5) CALL FILNME(BUFFER,BUFPOS,IPFILE) IF (OPTN.EQ.6) PC=NUMBER(16,BUFFER,BUFPOS) IF (OPTN.EQ.6) PCFLAG=.FALSE. IF (OPTN.NE.7) GOTO 3 CALL SETINF(6,-100,80,'FC','PRIV.') CALL FILNME(BUFFER,BUFPOS,SCRFLE) CALL OPNFIL(8,RET,SCRFLE,'OKNEW OKOLD WROK.') CALL FILMSG(RET,6) GOTO 3 6 WRITE (6,7) 7 FORMAT(/' *Error : Unknown options on command line') CALL EOJ(81) 8 WRITE (6,9) 9 FORMAT(/' *Error : Command line too long') CALL EOJ(82) C C ###################################################################### C C Read machine code program into memory at appropriate location C 100 CALL OPNFIL(10,RET,PFILE,'OKOLD RDOK.') IF (RET.NE.30) GOTO 102 WRITE(6,101)PFILE 101 FORMAT(/' *Error : File not found ',22A1) CALL EOJ(30) 102 CALL FILMSG(RET,10) 103 READ(10,104,END=110) BUFFER 104 FORMAT(1X,104A1) CALL VERALL(BUFFER,104,'0123456789ABCDEF ',17,POS,NUMPOS) IF (NUMPOS.NE.2) GOTO 106 END=(POS(2)-POS(1)-5)/2 READ(99,105) PTR,(MEM(PTR+I),I=1,END) 105 FORMAT(2X,Z4,48Z2) IF (PCFLAG) PC=PTR PCFLAG=.FALSE. GOTO 103 106 IF (NUMPOS.EQ.1.AND.POS(1).EQ.1.AND.EQUAL(BUFFER(1),'$',1))GOTO110 IF (NUMPOS.GT.2.AND.EQUAL(BUFFER(2),'R',1)) GOTO 108 WRITE(6,107) PFILE 107 FORMAT(/' *Error : Assembled program corrupted ',22A1) CALL EOJ(83) 108 WRITE(6,109) 109 FORMAT(/' *Error : org address missing from assembly program') CALL EOJ(84) 110 WRITE(6,111)PFILE,PC WRITE(8,111)PFILE,PC 111 FORMAT(/' Program file : ',22A1/ * ' Starting execution at ',Z4,' hex') C C Clear screen and print header C 10000 LINES=0 WRITE(6,10001) WRITE(8,10001) 10001 FORMAT('1 PC Instruction Assembly', *T36,'A B C D E H L IX IY SP SZHVNC'/) C C Read opcodes from memory and execute - start of main loop C 20000 BYTES=0 R=R+1 CALL FILL(STRING,21,' ') INTCNT=INTCNT+1 NMICNT=NMICNT+1 OLDPC=PC OP=MEM(PC+1) CALL PCPLUS(1) C C ***** Indexed instruction set (DD - IX, FD - IY) ********************* C INDREG=0 IF (OP.NE.221.AND.OP.NE.253) GOTO 20001 INDREG=1 IF (OP.EQ.253) INDREG=2 OP=MEM(PC+1) CALL PCPLUS(1) IF (OP.LT.48.OR.OP.EQ.73.OR.OP.GT.208) GOTO 20001 OFF=MEM(PC+1) CALL PCPLUS(1) 20001 IF (OP.NE.203) GOTO 30000 C C****** Bit-type instruction set (CB) ********************************** C OP=MEM(PC+1) CALL PCPLUS(1) J=LXOR(LAND(OP,7),6) IF (J.NE.0)GOTO 20004 IF (INDREG.EQ.0) GOTO 20002 K=LAND(INDEX(INDREG)+OFF,65535)+1 GOTO 20003 20002 K=LAND(REG(2)*256+REG(3),65535)+1 20003 M=MEM(K) GOTO 20005 20004 M=REG(J) 20005 IF (OP.GE.8) GOTO 90012 C RLC r ------------------------------------------------------------ C=LAND(M,128)/128 M=M*2+C IF (J.NE.0)GOTO 90015 CALL JOIN('RLC',OFF,0,2,1,INDREG,STRING) GOTO 90016 90015 CALL JOIN('RLC',SREG(J),0,2,0,-1,STRING) 90016 GOTO 29000 C RRC r ------------------------------------------------------------- 90012 IF (OP.GE.16) GOTO 90018 C=LAND(M,1) M=LAND(M,255)/2+C*128 IF (J.NE.0) GOTO 90020 CALL JOIN('RRC',OFF,0,2,1,INDREG,STRING) GOTO 90021 90020 CALL JOIN('RRC',SREG(J),0,2,0,-1,STRING) 90021 GOTO 29000 90018 IF (OP.GE.24) GOTO 90023 C RL r ------------------------------------------------------------- M=M*2+C C=LAND(M,256)/256 IF (J.NE.0) GOTO 90025 CALL JOIN('RL',OFF,0,2,1,INDREG,STRING) GOTO 90026 90025 CALL JOIN('RL',SREG(J),0,2,0,-1,STRING) 90026 GOTO 29000 90023 IF (OP.GE.32) GOTO 90028 C RR r -------------------------------------------------------------- M=LAND(M,255)+C*256 C=LAND(M,1) M=M/2 IF (J.NE.0)GOTO 90030 CALL JOIN('RR',OFF,0,2,1,INDREG,STRING) GOTO 90031 90030 CALL JOIN('RR',SREG(J),0,2,0,-1,STRING) 90031 GOTO 29000 90028 IF (OP.GE.40) GOTO 90033 C SLA r ------------------------------------------------------------ M=M*2 C=LAND(M,256)/256 IF (J.NE.0)GOTO 90035 CALL JOIN('SLA',OFF,0,2,1,INDREG,STRING) GOTO 90036 90035 CALL JOIN('SLA',SREG(J),0,2,0,-1,STRING) 90036 GOTO 29000 90033 IF (OP.GE.48) GOTO 90041 C SRA r ------------------------------------------------------------ C=LAND(M,1) M=LAND(M,255)/2+LAND(M,128) IF (J.NE.0)GOTO 90043 CALL JOIN('SRA',OFF,0,2,1,INDREG,STRING) GOTO 90044 90043 CALL JOIN('SRA',SREG(J),0,2,0,-1,STRING) 90044 GOTO 29000 90041 IF (OP.LT.56) GOTO 99999 IF (OP.GE.64) GOTO 90049 C SRL r ------------------------------------------------------------ C=LAND(M,1) M=LAND(M,255)/2 IF (J.NE.0)GOTO 90051 CALL JOIN('SRL',OFF,0,2,1,INDREG,STRING) GOTO 29000 90051 CALL JOIN('SRL',SREG(J),0,2,0,-1,STRING) C C Store result of shift / rotate instructions and set flags C 29000 IF (J.NE.0) GOTO 29001 MEM(K)=LAND(M,255) GOTO 29002 29001 REG(J)=LAND(M,255) 29002 V=PARITY(M) S=SGN(M,8) N=0 H=0 Z=ZERO(M,8) GOTO 99999 90049 IF (OP.GE.128) GOTO 90057 C BIT b,r ------------------------------------------------------------ BIT=LAND(OP,56)/8 Z=ZERO(LAND(M,2**BIT),8) IF (J.NE.0)GOTO 90059 CALL JOIN('BIT',BIT+240,OFF,3,2,INDREG,STRING) GOTO 90060 90059 CALL JOIN('BIT',BIT+240,SREG(J),3,0,-1,STRING) 90060 N=0 H=1 GOTO 99999 90057 IF (OP.GE.192) GOTO 90065 C RES b,r ------------------------------------------------------------ BIT=LAND(OP,56)/8 M=LAND(M,255-2**BIT) IF (J.NE.0)GOTO 90067 MEM(K)=M CALL JOIN('RES',BIT+240,OFF,3,2,INDREG,STRING) GOTO 90068 90067 REG(J)=M CALL JOIN('RES',BIT+240,SREG(J),3,0,-1,STRING) 90068 GOTO 99999 C SET b,r ------------------------------------------------------------ 90065 BIT=LAND(OP,56)/8 M=LOR(M,2**BIT) IF (J.NE.0) GOTO 90075 MEM(K)=LAND(M,255) CALL JOIN('SET',BIT+240,OFF,3,2,INDREG,STRING) GOTO 99999 90075 REG(J)=LAND(M,255) CALL JOIN('SET',BIT+240,SREG(J),3,0,-1,STRING) GOTO 99999 C C ***** Main instruction set ******************************************* C 30000 IF (OP.GE.1) GOTO 90081 C NOP -------------------------------------------------------------- CALL JOIN('NOP',0,0,1,0,-1,STRING) GOTO 99999 90081 IF ((OP.NE.2).AND.(OP.NE.18)) GOTO 90083 C LD (rr),A ---------------------------------------------------------- MEM(LAND(DOUBLE(OP,REG,SP),65535)+1)=REG(1) CALL JOIN('LD',DREG(LAND(OP/16,3)+1),'A',3,1,-1,STRING) GOTO 99999 90083 IF (OP.NE.8) GOTO 90085 C EX AF,AF' ---------------------------------------------------------- TEMP=REG(1) REG(1)=TREG(1) TREG(1)=TEMP TEMP=C+N*2+V*4+H*16+Z*64+S*128 C=LAND(TFLAG,1) N=LAND(TFLAG,2)/2 V=LAND(TFLAG,4)/4 H=LAND(TFLAG,16)/16 Z=LAND(TFLAG,64)/64 S=LAND(TFLAG,128)/128 TFLAG=TEMP CALL JOIN('EX','AF','AF''',3,0,-1,STRING) GOTO 99999 90085 IF (LAND(OP,207).NE.9) GOTO 90087 C ADD HL,rr ----------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90089 CALL SUM(16,INDEX(INDREG),DOUBLE(OP,REG,SP),0,INDEX(INDREG), * C,X,X,N,H,X) CALL JOIN('ADD',IREG(INDREG),DREG(LAND(OP/16,3)+1),3,0,-1,STRING) GOTO 99999 90089 K=REG(2)*256+REG(3) CALL JOIN('ADD','HL',DREG(LAND(OP/16,3)+1),3,0,-1,STRING) 90090 CALL SUM(16,K,DOUBLE(OP,REG,SP),0,J,C,X,X,N,H,X) CALL SINGLE(J,32,REG,SP) GOTO 99999 90087 IF ((OP.NE.10).AND.(OP.NE.26)) GOTO 90092 C LD A,(rr) ---------------------------------------------------------- REG(1)=MEM(LAND(DOUBLE(OP,REG,SP),65535)+1) CALL JOIN('LD','A',DREG(LAND(OP/16,3)+1),3,2,-1,STRING) GOTO 99999 90092 IF (LAND(OP,207).NE.1)GOTO 90094 C LD rr,dd ----------------------------------------------------------- IMM=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) CALL PCPLUS(2) IF (INDREG.EQ.0) GOTO 90096 INDEX(INDREG)=IMM CALL JOIN('LD',IREG(INDREG),HEX(IMM,2),3,0,-1,STRING) GOTO 90097 90096 CALL SINGLE(IMM,OP,REG,SP) CALL JOIN('LD',DREG(LAND(OP/16,3)+1),HEX(IMM,2),3,0,-1,STRING) 90097 GOTO 99999 90094 IF (LAND(OP,207).NE.3) GOTO 90099 C INC rr ----------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90101 CALL SUM(16,INDEX(INDREG),1,0,INDEX(INDREG),X,X,X,X,X,X) CALL JOIN('INC',IREG(INDREG),0,2,0,-1,STRING) GOTO 90102 90101 CALL SUM(16,DOUBLE(OP,REG,SP),1,0,K,X,X,X,X,X,X) CALL SINGLE(K,OP,REG,SP) CALL JOIN('INC',DREG(LAND(OP/16,3)+1),0,2,0,-1,STRING) 90102 GOTO 99999 90099 IF (LAND(OP,231).NE.32.AND.OP.NE.24) GOTO 90104 C JR c,h ----------------------------------------------------------- K=MEM(PC+1) IF (K.GT.127) K=K-256 CALL PCPLUS(1) K=LAND(PC+K,65535) IF (.NOT.COND(LAND(OP,24),24,C,V,S,Z)) GOTO 90106 PC=K 90106 IF (OP.NE.24) * CALL JOIN('JR',CONDS(LAND(OP,24)/8+1),HEX(K,2),3,0,-1,STRING) IF (OP.EQ.24) CALL JOIN('JR',HEX(K,2),0,2,0,-1,STRING) GOTO 99999 90104 IF (LAND(OP,199).NE.4) GOTO 90109 C INC r ----------------------------------------------------------- J=LXOR(LAND(OP,56)/8,6) IF (J.NE.0)GOTO 90111 IF (INDREG.NE.0) GOTO 90114 K=LAND(REG(2)*256+REG(3),65535)+1 GOTO 90115 90114 K=LAND(INDEX(INDREG)+OFF,65535)+1 90115 M=MEM(K) CALL SUM(8,M,1,0,M,X,V,S,N,H,Z) MEM(K)=M CALL JOIN('INC',OFF,0,2,1,INDREG,STRING) GOTO 90112 90111 CALL SUM(8,REG(J),1,0,REG(J),X,V,S,N,H,Z) CALL JOIN('INC',SREG(J),0,2,0,-1,STRING) 90112 GOTO 99999 90109 IF (LAND(OP,199).NE.5) GOTO 90117 C DEC r -------------------------------------------------------------- J=LXOR(LAND(OP,56)/8,6) IF (J.NE.0)GOTO 90119 IF (INDREG.NE.0) GOTO 90122 K=LAND(REG(2)*256+REG(3),65535)+1 GOTO 90123 90122 K=LAND(INDEX(INDREG)+OFF,65535)+1 90123 M=MEM(K) CALL DIFF(8,M,1,0,M,X,V,S,N,H,Z) MEM(K)=M CALL JOIN('DEC',OFF,0,2,1,INDREG,STRING) GOTO 90120 90119 CALL DIFF(8,REG(J),1,0,REG(J),X,V,S,N,H,Z) CALL JOIN('DEC',SREG(J),0,2,0,-1,STRING) 90120 GOTO 99999 90117 IF (LAND(OP,199).NE.6) GOTO 90125 C LD r,d -------------------------------------------------------------- J=LXOR(LAND(OP,56)/8,6) IMM=MEM(PC+1) CALL PCPLUS(1) IF (J.NE.0)GOTO 90127 IF (INDREG.NE.0) GOTO 90130 K=LAND(REG(2)*256+REG(3),65535)+1 GOTO 90131 90130 K=LAND(INDEX(INDREG)+OFF,65535)+1 90131 MEM(K)=IMM CALL JOIN('LD',OFF,HEX(IMM,1),3,1,INDREG,STRING) GOTO 90128 90127 REG(J)=IMM CALL JOIN('LD',SREG(J),HEX(IMM,1),3,0,-1,STRING) 90128 GOTO 99999 90125 IF (OP.NE.7) GOTO 90133 C RLCA -------------------------------------------------------------- C=LAND(REG(1),128)/128 REG(1)=LAND(REG(1)*2+C,255) H=0 N=0 CALL JOIN('RLCA',0,0,1,0,-1,STRING) GOTO 99999 90133 IF (OP.NE.16) GOTO 90135 C DJNZ h -------------------------------------------------------------- CALL DIFF(8,REG(6),1,0,REG(6),X,X,X,X,X,ZTEMP) K=MEM(LAND(PC,65535)+1) IF (K.GT.127) K=K-256 CALL PCPLUS(1) K=LAND(PC+K,65535) IF (ZTEMP.EQ.1) GOTO 90137 PC=K 90137 CALL JOIN('DJNZ',HEX(K,2),0,2,0,-1,STRING) GOTO 99999 90135 IF (OP.NE.23) GOTO 90140 C RLA -------------------------------------------------------------- REG(1)=REG(1)*2+C C=LAND(REG(1),256)/256 REG(1)=LAND(REG(1),255) H=0 N=0 CALL JOIN('RLA',0,0,1,0,-1,STRING) GOTO 99999 90140 IF (OP.NE.55) GOTO 90142 C SCF -------------------------------------------------------------- C=1 H=0 N=0 CALL JOIN('SCF',0,0,1,0,-1,STRING) GOTO 99999 90142 IF (LAND(OP,207).NE.11) GOTO 90144 C DEC rr -------------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90146 CALL DIFF(16,INDEX(INDREG),1,0,INDEX(INDREG),X,X,X,X,X,X) CALL JOIN('DEC',IREG(INDREG),0,2,0,-1,STRING) GOTO 90147 90146 CALL DIFF(16,DOUBLE(OP,REG,SP),1,0,K,X,X,X,X,X,X) CALL SINGLE(K,OP,REG,SP) CALL JOIN('DEC',DREG(LAND(OP/16,3)+1),0,2,0,-1,STRING) 90147 GOTO 99999 90144 IF (OP.NE.15) GOTO 90149 C RRCA -------------------------------------------------------------- C=LAND(REG(1),1) REG(1)=LAND(REG(1),255)/2+C*128 H=0 N=0 CALL JOIN('RRCA',0,0,1,0,-1,STRING) GOTO 99999 90149 IF (OP.NE.34) GOTO 90151 C LD (nn),HL ---------------------------------------------------------- K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) IF (INDREG.EQ.0) GOTO 90153 MEM(LAND(K,65535)+1)=LAND(INDEX(INDREG),255) MEM(LAND(K+1,65535)+1)=LAND(INDEX(INDREG),65280)/256 CALL JOIN('LD',HEX(K,2),IREG(INDREG),3,1,-1,STRING) GOTO 90154 90153 MEM(LAND(K,65535)+1)=REG(3) MEM(LAND(K+1,65535)+1)=REG(2) CALL JOIN('LD',HEX(K,2),'HL',3,1,-1,STRING) 90154 CALL PCPLUS(2) GOTO 99999 90151 IF (OP.NE.31) GOTO 90156 C RRA -------------------------------------------------------------- M=LAND(REG(1),255)+C*256 C=LAND(M,1) REG(1)=LAND(M,255)/2 H=0 N=0 CALL JOIN('RRA',0,0,1,0,-1,STRING) GOTO 99999 90156 IF (OP.NE.39) GOTO 90158 C DAA -------------------------------------------------------------- ADJ=0 CT=0 IF (N.NE.0) GOTO 90160 IF (LAND(REG(1),15).GT.9.OR.H.EQ.1) ADJ=6 IF (LAND(REG(1),240).GT.144.OR.C.EQ.1) ADJ=ADJ+96 IF (ADJ.GT.0) CALL SUM(8,REG(1),ADJ,0,REG(1),CT,X,S,X,H,Z) GOTO 90161 90160 IF (H.EQ.1) ADJ=6 IF (C.EQ.1) ADJ=ADJ+96 IF (ADJ.GT.0) CALL DIFF(8,REG(1),ADJ,0,REG(1),CT,X,S,X,H,Z) 90161 V=PARITY(REG(1)) C=LOR(C,CT) CALL JOIN('DAA',0,0,1,0,-1,STRING) GOTO 99999 90158 IF (OP.NE.42) GOTO 90169 C LD HL,(nn) ---------------------------------------------------------- K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) IF (INDREG.EQ.0) GOTO 90171 INDEX(INDREG)=MEM(LAND(K,65535)+1)+256*MEM(LAND(K+1,65535)+1) CALL JOIN('LD',IREG(INDREG),HEX(K,2),3,2,-1,STRING) GOTO 90172 90171 REG(3)=MEM(LAND(K,65535)+1) REG(2)=MEM(LAND(K+1,65535)+1) CALL JOIN('LD','HL',HEX(K,2),3,2,-1,STRING) 90172 CALL PCPLUS(2) GOTO 99999 90169 IF (OP.NE.47) GOTO 90174 C CPL -------------------------------------------------------------- REG(1)=LXOR(REG(1),255) H=1 N=1 CALL JOIN('CPL',0,0,1,0,-1,STRING) GOTO 99999 90174 IF (OP.NE.50) GOTO 90176 C LD (nn),A ------------------------------------------------------------ K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) MEM(LAND(K,65535)+1)=REG(1) CALL PCPLUS(2) CALL JOIN('LD',HEX(K,2),'A',3,1,-1,STRING) GOTO 99999 90176 IF (OP.NE.58) GOTO 90178 C LD A,(nn) ------------------------------------------------------------ K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) REG(1)=MEM(LAND(K,65535)+1) CALL PCPLUS(2) CALL JOIN('LD','A',HEX(K,2),3,2,-1,STRING) GOTO 99999 90178 IF (OP.NE.63) GOTO 90180 C CCF -------------------------------------------------------------- H=C C=LXOR(C,1) N=0 CALL JOIN('CCF',0,0,1,0,-1,STRING) GOTO 99999 C HALT -------------------------------------------------------------- 90180 IF (OP.NE.118) GOTO 90181 CALL JOIN('HALT',0,0,1,0,-1,STRING) GOTO 99999 90181 IF (OP.GE.128) GOTO 90182 C LD r,r -------------------------------------------------------------- K=LXOR(LAND(OP,56)/8,6) J=LXOR(LAND(OP,7),6) IF (K.NE.0) GOTO 90184 IF (INDREG.NE.0) GOTO 90187 MEM(LAND(REG(2)*256+REG(3),65535)+1)=REG(J) GOTO 90188 90187 MEM(LAND(INDEX(INDREG)+OFF,65535)+1)=REG(J) 90188 CALL JOIN('LD',OFF,SREG(J),3,1,INDREG,STRING) GOTO 90185 90184 IF (J.NE.0) GOTO 90190 IF (INDREG.NE.0) GOTO 90192 REG(K)=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90193 90192 REG(K)=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90193 CALL JOIN('LD',SREG(K),OFF,3,2,INDREG,STRING) GOTO 90185 90190 REG(K)=REG(J) CALL JOIN('LD',SREG(K),SREG(J),3,0,-1,STRING) 90185 GOTO 99999 90182 IF ((OP.GE.144).AND.(LAND(OP,247).NE.198)) GOTO 90195 C ADD A,r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (LAND(OP,247).NE.198) GOTO 90197 C ADD A,d or ADC A,d K=MEM(PC+1) CALL PCPLUS(1) CALL JOIN('ADD','A',HEX(K,1),3,0,-1,STRING) GOTO 90198 90197 IF (J.NE.0) GOTO 90200 IF (INDREG.NE.0) GOTO 90202 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90203 90202 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90203 CALL JOIN('ADD','A',OFF,3,2,INDREG,STRING) GOTO 90198 90200 K=REG(J) CALL JOIN('ADD','A',SREG(J),3,0,-1,STRING) 90198 CALL SUM(8,REG(1),K,OP,REG(1),C,V,S,N,H,Z) IF (LAND(OP,8).EQ.8) CALL LMOVE('C',STRING(3),1) GOTO 99999 90195 IF ((OP.GE.160).AND.(LAND(OP,247).NE.214)) GOTO 90205 C SUB r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (LAND(OP,247).NE.214) GOTO 90207 C SUB d or SBC A,d K=MEM(PC+1) CALL PCPLUS(1) IF (LAND(OP,8).NE.8) CALL JOIN('SUB',HEX(K,1),0,2,0,-1,STRING) IF (LAND(OP,8).EQ.8) CALL JOIN('SBC','A',HEX(K,1),3,0,-1,STRING) GOTO 90208 90207 IF (J.NE.0) GOTO 90210 IF (INDREG.NE.0) GOTO 90212 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90213 90212 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90213 IF (LAND(OP,8).NE.8) CALL JOIN('SUB',OFF,0,2,1,INDREG,STRING) IF (LAND(OP,8).EQ.8) CALL JOIN('SBC','A',OFF,3,2,INDREG,STRING) GOTO 90208 90210 K=REG(J) IF (LAND(OP,8).NE.8) CALL JOIN('SUB',SREG(J),0,2,0,-1,STRING) IF (LAND(OP,8).EQ.8) CALL JOIN('SBC','A',SREG(J),3,0,-1,STRING) 90208 CALL DIFF(8,REG(1),K,OP,REG(1),C,V,S,N,H,Z) GOTO 99999 90205 IF ((OP.GE.168).AND.(OP.NE.230)) GOTO 90215 C AND r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (OP.NE.230)GOTO 90217 C AND d K=MEM(PC+1) CALL PCPLUS(1) CALL JOIN('AND',HEX(K,1),0,2,0,-1,STRING) GOTO 90218 90217 IF (J.NE.0) GOTO 90220 IF (INDREG.NE.0) GOTO 90222 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90223 90222 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90223 CALL JOIN('AND',OFF,0,2,1,INDREG,STRING) GOTO 90218 90220 K=REG(J) CALL JOIN('AND',SREG(J),0,2,0,-1,STRING) 90218 REG(1)=LAND(REG(1),K) C=0 V=PARITY(REG(1)) S=SGN(REG(1),8) N=0 H=1 Z=ZERO(REG(1),8) GOTO 99999 90215 IF ((OP.GE.176).AND.(OP.NE.238)) GOTO 90225 C XOR r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (OP.NE.238) GOTO 90227 C XOR d K=MEM(PC+1) CALL PCPLUS(1) CALL JOIN('XOR',HEX(K,1),0,2,0,-1,STRING) GOTO 90228 90227 IF (J.NE.0) GOTO 90230 IF (INDREG.NE.0) GOTO 90232 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90233 90232 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90233 CALL JOIN('XOR',OFF,0,2,1,INDREG,STRING) GOTO 90228 90230 K=REG(J) CALL JOIN('XOR',SREG(J),0,2,0,-1,STRING) 90228 REG(1)=LXOR(REG(1),K) C=0 V=PARITY(REG(1)) S=SGN(REG(1),8) N=0 H=0 Z=ZERO(REG(1),8) GOTO 99999 90225 IF ((OP.GE.184).AND.(OP.NE.246)) GOTO 90235 C OR r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (OP.NE.246) GOTO 90237 C OR d K=MEM(PC+1) CALL PCPLUS(1) CALL JOIN('OR',HEX(K,1),0,2,0,-1,STRING) GOTO 90238 90237 IF (J.NE.0) GOTO 90240 IF (INDREG.NE.0) GOTO 90242 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90243 90242 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90243 CALL JOIN('OR',OFF,0,2,1,INDREG,STRING) GOTO 90238 90240 K=REG(J) CALL JOIN('OR',SREG(J),0,2,0,-1,STRING) 90238 REG(1)=LOR(REG(1),K) C=0 V=PARITY(REG(1)) S=SGN(REG(1),8) N=0 H=1 Z=ZERO(REG(1),8) GOTO 99999 90235 IF ((OP.GE.192).AND.(OP.NE.254)) GOTO 90245 C CP r -------------------------------------------------------------- J=LXOR(LAND(OP,7),6) IF (OP.NE.254) GOTO 90247 C CP d K=MEM(PC+1) CALL PCPLUS(1) CALL JOIN('CP',HEX(K,1),0,2,0,-1,STRING) GOTO 90248 90247 IF (J.NE.0) GOTO 90250 IF (INDREG.NE.0) GOTO 90252 90251 K=MEM(LAND(REG(2)*256+REG(3),65535)+1) GOTO 90253 90252 K=MEM(LAND(INDEX(INDREG)+OFF,65535)+1) 90253 CALL JOIN('CP',OFF,0,2,1,INDREG,STRING) GOTO 90248 90250 K=REG(J) CALL JOIN('CP',SREG(J),0,2,0,-1,STRING) 90248 CALL DIFF(8,REG(1),K,0,K,C,V,S,N,H,Z) GOTO 99999 90245 IF (LAND(OP,199).NE.192.AND.OP.NE.201) GOTO 90255 C RET c -------------------------------------------------------------- IF (.NOT.COND(OP,201,C,V,S,Z)) GOTO 90258 PC=MEM(LAND(SP,65535)+1)+256*MEM(LAND(SP+1,65535)+1) SP=SP+2 90258 J=LAND(OP,56)/8+1+LAND(OP,1)*7 CALL JOIN('RET',CONDS(J),0,2,0,-1,STRING) GOTO 99999 90255 IF (LAND(OP,207).NE.193) GOTO 90260 C POP rr -------------------------------------------------------------- K=MEM(LAND(SP+0,65535)+1)+256*MEM(LAND(SP+1,65535)+1) IF (INDREG.EQ.0) GOTO 90262 INDEX(INDREG)=K CALL JOIN('POP',IREG(INDREG),0,2,0,-1,STRING) GOTO 90266 90262 IF (OP.NE.241) GOTO 90265 REG(1)=LAND(K,65280)/256 S=LAND(K,128)/128 Z=LAND(K,64)/64 H=LAND(K,16)/16 V=LAND(K,4)/4 N=LAND(K,2)/2 C=LAND(K,1) CALL JOIN('POP','AF',0,2,0,-1,STRING) GOTO 90266 90265 CALL SINGLE(K,OP,REG,SP) CALL JOIN('POP',DREG(LAND(OP/16,3)+1),0,2,0,-1,STRING) 90266 SP=SP+2 GOTO 99999 90260 IF (OP.NE.233) GOTO 90270 C JP (HL) -------------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90273 K=INDEX(INDREG) CALL JOIN('JP',IREG(INDREG),0,2,1,-1,STRING) GOTO 90274 90273 K=REG(2)*256+REG(3) CALL JOIN('JP','HL',0,2,1,-1,STRING) 90274 K=MEM(LAND(K,65535)+1)+256*MEM(LAND(K+1,65535)+1) PC=LAND(K,65535) GOTO 99999 90270 IF (LAND(OP,199).NE.194.AND.OP.NE.195) GOTO 90268 C JP c,nn -------------------------------------------------------------- K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) K=LAND(K,65535) CALL PCPLUS(2) IF (.NOT.COND(OP,195,C,V,S,Z)) GOTO 90269 PC=K 90269 IF (OP.NE.195) * CALL JOIN('JP',CONDS(LAND(OP,56)/8+1),HEX(K,2),3,0,-1,STRING) IF (OP.EQ.195) CALL JOIN('JP',HEX(K,2),0,2,0,-1,STRING) GOTO 99999 90268 IF (LAND(OP,199).NE.196.AND.OP.NE.205) GOTO 90276 C CALL c,nn ----------------------------------------------------------- K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) K=LAND(K,65535) CALL PCPLUS(2) IF (.NOT.COND(OP,205,C,V,S,Z)) GOTO 90278 MEM(LAND(SP-1,65535)+1)=LAND(PC/256,255) MEM(LAND(SP-2,65535)+1)=LAND(PC,255) SP=SP-2 PC=K 90278 IF (OP.NE.205) * CALL JOIN('CALL',CONDS(LAND(OP,56)/8+1),HEX(K,2),3,0,-1,STRING) IF (OP.EQ.205) CALL JOIN('CALL',HEX(K,2),0,2,0,-1,STRING) GOTO 99999 90276 IF (LAND(OP,207).NE.197) GOTO 90281 C PUSH rr -------------------------------------------------------------- IF (INDREG.EQ.0)GOTO 90283 K=LAND(INDEX(INDREG),65535) CALL JOIN('PUSH',IREG(INDREG),0,2,0,-1,STRING) GOTO 90287 90283 IF (OP.NE.245) GOTO 90286 K=REG(1)*256+S*128+Z*64+0*32+H*16+0*8+V*4+N*2+C CALL JOIN('PUSH','AF',0,2,0,-1,STRING) GOTO 90287 90286 K=DOUBLE(OP,REG,SP) CALL JOIN('PUSH',DREG(LAND(OP/16,3)+1),0,2,0,-1,STRING) 90287 SP=SP-2 MEM(LAND(SP+1,65535)+1)=LAND(K,65280)/256 MEM(LAND(SP+0,65535)+1)=LAND(K,255) GOTO 99999 90281 IF (LAND(OP,199).NE.199) GOTO 90289 C RST n -------------------------------------------------------------- J=LAND(OP,56) MEM(LAND(SP-1,65535)+1)=LAND(PC/256,255) MEM(LAND(SP-2,65535)+1)=LAND(PC,255) PC=J SP=SP-2 CALL JOIN('RST',HEX(J,1),0,2,0,-1,STRING) GOTO 99999 90289 IF (OP.NE.217) GOTO 90291 C EXX -------------------------------------------------------------- DO 555 J=2,7 TEMP=REG(J) REG(J)=TREG(J) TREG(J)=TEMP 555 CONTINUE CALL JOIN('EXX',0,0,1,0,-1,STRING) GOTO 99999 90291 IF (OP.NE.219) GOTO 90294 C IN A,(n) ------------------------------------------------------------- ADDR=MEM(PC+1) REG(1)=PORTI(ADDR,R,IPFLAG,IPFILE,LINES) CALL PCPLUS(1) CALL JOIN('IN','A',HEX(ADDR,1),3,2,-1,STRING) GOTO 99999 90294 IF (OP.NE.227) GOTO 90296 C EX (SP),HL ---------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90298 TIND=INDEX(INDREG) TEMP=MEM(LAND(SP+1,65535)+1)*256+MEM(LAND(SP,65535)+1) INDEX(INDREG)=TEMP MEM(LAND(SP+1,65535)+1)=LAND(TIND,65280)/256 MEM(LAND(SP,65535)+1)=LAND(TIND,255) CALL JOIN('EX','SP',IREG(INDREG),3,1,-1,STRING) GOTO 90299 90298 HTEMP=REG(2) LTEMP=REG(3) REG(2)=MEM(LAND(SP+1,65535)+1) REG(3)=MEM(LAND(SP,65535)+1) MEM(LAND(SP+1,65535)+1)=HTEMP MEM(LAND(SP,65535)+1)=LTEMP CALL JOIN('EX','SP','HL',3,1,-1,STRING) 90299 GOTO 99999 90296 IF (OP.NE.235) GOTO 90301 C EX DE,HL ------------------------------------------------------------- HTEMP=REG(2) LTEMP=REG(3) REG(2)=REG(4) REG(3)=REG(5) REG(4)=HTEMP REG(5)=LTEMP CALL JOIN('EX','DE','HL',3,0,-1,STRING) GOTO 99999 90301 IF (OP.NE.249) GOTO 90303 C LD SP,HL ------------------------------------------------------------- IF (INDREG.EQ.0) GOTO 90305 SP=INDEX(INDREG) CALL JOIN('LD','SP',IREG(INDREG),3,0,-1,STRING) GOTO 90306 90305 SP=REG(2)*256+REG(3) CALL JOIN('LD','SP','HL',3,0,-1,STRING) 90306 GOTO 99999 90303 IF (OP.NE.211) GOTO 90308 C OUT (n),A ------------------------------------------------------------ K=MEM(PC+1) CALL PORTO(K,REG(1),OPFLAG,OPFILE,LINES) CALL PCPLUS(1) CALL JOIN('OUT',HEX(K,1),'A',3,1,-1,STRING) GOTO 99999 90308 IF (OP.NE.251) GOTO 90310 C EI -------------------------------------------------------------- IFF1=1 IFF2=1 CALL JOIN('EI',0,0,1,0,-1,STRING) GOTO 99999 90310 IF (OP.NE.243) GOTO 40000 C DI -------------------------------------------------------------- IFF1=0 IFF2=0 CALL JOIN('DI',0,0,1,0,-1,STRING) GOTO 99999 C C ***** Auxillary instruction set (ED) ******************************** C 40000 IF (OP.NE.237) GOTO 99999 OP=MEM(PC+1) CALL PCPLUS(1) IF (LAND(OP,199).NE.65) GOTO 90316 C OUT (C),r ----------------------------------------------------------- ADDR=REG(7) J=LXOR(LAND(OP,56)/8,6) CALL PORTO(ADDR,REG(J),OPFLAG,OPFILE,LINES) CALL JOIN('OUT','C',SREG(J),3,1,-1,STRING) GOTO 99999 90316 IF (LAND(OP,199).NE.64)GOTO 90319 C IN r,(C) ----------------------------------------------------------- J=LXOR(LAND(OP,56)/8,6) K=REG(7) REG(J)=PORTI(K,R,IPFLAG,IPFILE,LINES) V=PARITY(REG(J)) S=SGN(REG(J),8) N=0 H=0 Z=ZERO(REG(J),8) CALL JOIN('IN',SREG(J),'C',3,2,-1,STRING) GOTO 99999 90319 IF (LAND(OP,207).NE.75) GOTO 90323 C LD rr,(nn) ----------------------------------------------------------- K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) L=MEM(LAND(K,65535)+1)+256*MEM(LAND(K+1,65535)+1) CALL SINGLE(L,OP,REG,SP) CALL JOIN('LD',DREG(LAND(OP/16,3)+1),HEX(K,2),3,2,-1,STRING) CALL PCPLUS(2) GOTO 99999 90323 IF (LAND(OP,207).NE.67) GOTO 90321 C LD (nn),rr ----------------------------------------------------------- D=DOUBLE(OP,REG,SP) K=MEM(PC+1)+256*MEM(LAND(PC+1,65535)+1) MEM(LAND(K,65535)+1)=LAND(D,255) MEM(LAND(K+1,65535)+1)=LAND(D,65280)/256 CALL JOIN('LD',HEX(K,2),DREG(LAND(OP/16,3)+1),3,1,-1,STRING) CALL PCPLUS(2) GOTO 99999 90321 IF (OP.NE.68) GOTO 90326 C NEG ------------------------------------------------------------ CALL DIFF(8,0,REG(1),0,REG(1),C,V,S,N,H,Z) CALL JOIN('NEG',0,0,1,0,-1,STRING) GOTO 99999 90326 IF (LAND(OP,207).NE.66) GOTO 90328 C SBC HL,rr ---------------------------------------------------------- HL=REG(2)*256+REG(3) CALL DIFF(16,HL,DOUBLE(OP,REG,SP),8,K,C,V,S,N,H,Z) CALL SINGLE(K,32,REG,SP) CALL JOIN('SBC','HL',DREG(LAND(OP/16,3)+1),3,0,-1,STRING) GOTO 99999 90328 IF ((OP.NE.70).AND.(OP.NE.86).AND.(OP.NE.94)) GOTO 90330 C IM 0,1,2 ------------------------------------------------------------ IMODE=LAND(OP,8)/8+LAND(OP,16)/16 CALL JOIN('IM',IMODE+240,0,2,0,-1,STRING) GOTO 99999 90330 IF (OP.NE.69) GOTO 90332 C RETN ------------------------------------------------------------ PC=MEM(LAND(SP,65535)+1)+256*MEM(LAND(SP+1,65535)+1) SP=SP+2 IFF1=IFF2 CALL JOIN('RETN',0,0,1,0,-1,STRING) GOTO 99999 90332 IF (OP.NE.71) GOTO 90334 C LD I,A ------------------------------------------------------------ I=REG(1) CALL JOIN('LD','I','A',3,0,-1,STRING) GOTO 99999 90334 IF (OP.NE.77) GOTO 90336 C RETI ------------------------------------------------------------ PC=MEM(LAND(SP,65535)+1)+256*MEM(LAND(SP+1,65535)+1) SP=SP+2 CALL JOIN('RETI',0,0,1,0,-1,STRING) GOTO 99999 90336 IF (LAND(OP,207).NE.74) GOTO 90338 C ADC HL,rr ------------------------------------------------------------ HL=REG(2)*256+REG(3) CALL SUM(16,HL,DOUBLE(OP,REG,SP),8,K,C,V,S,N,H,Z) CALL SINGLE(K,32,REG,SP) CALL JOIN('ADC','HL',DREG(LAND(OP/16,3)+1),3,0,-1,STRING) GOTO 99999 90338 IF (OP.NE.87) GOTO 90340 C LD A,I ------------------------------------------------------------ REG(1)=I H=0 N=0 S=SGN(REG(1),8) Z=ZERO(REG(1),8) V=IFF2 CALL JOIN('LD','A','I',3,0,-1,STRING) GOTO 99999 90340 IF (OP.NE.95) GOTO 90342 C LD A,R ------------------------------------------------------------ REG(1)=LAND(R,255) H=0 N=0 S=SGN(R,8) Z=ZERO(R,8) V=IFF2 CALL JOIN('LD','A','R',3,0,-1,STRING) GOTO 99999 90342 IF (OP.NE.79) GOTO 90344 C LD R,A ------------------------------------------------------------ R=REG(1) CALL JOIN('LD','R','A',3,0,-1,STRING) GOTO 99999 90344 IF (OP.NE.103) GOTO 90346 C RRD ------------------------------------------------------------ K=LAND(REG(2)*256+REG(3),65535)+1 LACC=LAND(REG(1),15) TEMP=MEM(K) REG(1)=LAND(TEMP,15)+LAND(REG(1),240) MEM(K)=LAND(TEMP,240)/16+LACC*16 H=0 N=0 V=PARITY(REG(1)) Z=ZERO(REG(1),8) S=SGN(REG(1),8) CALL JOIN('RRD',0,0,1,0,-1,STRING) GOTO 99999 90346 IF (OP.NE.111) GOTO 90348 C RLD ------------------------------------------------------------ K=LAND(REG(2)*256+REG(3),65535)+1 LACC=LAND(REG(1),15) TEMP=MEM(K) REG(1)=LAND(TEMP,240)/16+LAND(REG(1),240) MEM(K)=LAND(TEMP,15)*16+LACC H=0 N=0 V=PARITY(REG(1)) Z=ZERO(REG(1),8) S=SGN(REG(1),8) CALL JOIN('RLD',0,0,1,0,-1,STRING) GOTO 99999 90348 ID=1-LAND(OP,8)/4 BC=LAND(REG(6)*256+REG(7),65535) HL=LAND(REG(2)*256+REG(3),65535) IF (LAND(OP,231).NE.160) GOTO 90350 C LDI ------------------------------------------------------------ DE=LAND(REG(4)*256+REG(5),65535) MEM(DE+1)=MEM(HL+1) CALL SINGLE(LAND(DE+ID,65535),16,REG,SP) CALL SINGLE(LAND(HL+ID,65535),32,REG,SP) CALL SINGLE(LAND(BC-1,65535),0,REG,SP) N=0 H=0 V=LXOR(ZERO(BC-1,16),1) CALL JOIN('LDI',0,0,1,0,-1,STRING) GOTO 49999 90350 IF (LAND(OP,231).NE.161) GOTO 90352 C CPI ------------------------------------------------------------ K=MEM(HL+1) CALL DIFF(8,REG(1),K,0,K,X,X,S,N,H,Z) CALL SINGLE(LAND(HL+ID,65535),32,REG,SP) CALL SINGLE(LAND(BC-1,65535),0,REG,SP) V=LXOR(ZERO(BC-1,16),1) IF (Z.EQ.1) CONT=.FALSE. CALL JOIN('CPI',0,0,1,0,-1,STRING) GOTO 49999 90352 IF (LAND(OP,231).NE.162) GOTO 90354 C INI ------------------------------------------------------------ MEM(HL+1)=PORTI(LAND(REG(7),255),R,IPFLAG,IPFILE,LINES) CALL SINGLE(LAND(HL+ID,65535),32,REG,SP) REG(6)=LAND(REG(6)-1,255) N=1 Z=ZERO(REG(6),8) V=LXOR(Z,1) CALL JOIN('INI',0,0,1,0,-1,STRING) GOTO 49999 90354 IF (LAND(OP,231).NE.163) GOTO 99999 C OUTI ------------------------------------------------------------ K=MEM(HL+1) CALL PORTO(LAND(REG(7),255),K,OPFLAG,OPFILE,LINES) CALL SINGLE(LAND(HL+ID,65535),32,REG,SP) REG(6)=LAND(REG(6)-1,255) N=1 Z=ZERO(REG(6),8) V=LXOR(Z,1) CALL JOIN('OUTI',0,0,1,0,-1,STRING) IF (OP.EQ.171) CALL LMOVE('D',STRING(4),1) IF (LAND(OP,16).EQ.16) CALL LMOVE('TI',STRING(2),2) 49999 IF (V.EQ.1.AND.CONT.AND.LAND(OP,16).EQ.16)PC=LAND(PC-2,65535) IF (ID.EQ.-1.AND.OP.NE.171) CALL LMOVE('D',STRING(3),1) IF (LAND(OP,16).EQ.16) CALL LMOVE('R',STRING(4),1) CONT=.TRUE. C C Display instruction, registers and flags on screen C 99999 LINES=LINES+1 GOTO (1001,1002,1003,1004),BYTES 1001 WRITE(6,1005)OLDPC,MEM(LAND(OLDPC,65535)+1),(STRING(J),J=1,15), * REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C WRITE(8,1005)OLDPC,MEM(LAND(OLDPC,65535)+1),(STRING(J),J=1,15), * REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C GOTO 2000 1002 WRITE(6,1006)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,2),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C WRITE(8,1006)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,2),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C GOTO 2000 1003 WRITE(6,1007)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,3),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C WRITE(8,1007)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,3),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C GOTO 2000 1004 WRITE(6,1008)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,4),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C WRITE(8,1008)OLDPC,(MEM(LAND(OLDPC+J-1,65535)+1),J=1,4),(STRING( * J),J=1,15),REG(1),(REG(LXOR(J-1,6)),J=1,6),INDEX,SP,S,Z,H,V,N,C 1005 FORMAT(1X,Z4,1X,Z2,11X,15A1,1X,7(Z2,1X),2(1X,Z4),2X,Z4,2X,6I1) 1006 FORMAT(1X,Z4,2(1X,Z2),8X,15A1,1X,7(Z2,1X),2(1X,Z4),2X,Z4,2X,6I1) 1007 FORMAT(1X,Z4,3(1X,Z2),5X,15A1,1X,7(Z2,1X),2(1X,Z4),2X,Z4,2X,6I1) 1008 FORMAT(1X,Z4,4(1X,Z2),2X,15A1,1X,7(Z2,1X),2(1X,Z4),2X,Z4,2X,6I1) C C Check for interrupt condition and take appropriate action C 2000 IF (NMICNT.NE.NMI) GOTO 2002 WRITE (6,2001) WRITE (8,2001) 2001 FORMAT(' * NMI acknowledge *') LINES=LINES+1 MEM(LAND(SP-1,65535)+1)=LAND(PC/256,255) MEM(LAND(SP-2,65535)+1)=LAND(PC,255) SP=SP-2 IFF2=IFF1 IFF1=0 NMICNT=0 PC=102 GOTO 3000 2002 IF(INTCNT.LT.INT.OR.INT.EQ.0.OR.IFF1.NE.1.OR.OP.EQ.251) GOTO3000 INTCNT=0 LINES=LINES+1 IF (IMODE.NE.0) GOTO 2005 WRITE(6,2003) WRITE(8,2003) 2003 FORMAT(' * MODE 0 interrupts not available *') GOTO 3000 2005 WRITE (6,2004)IMODE WRITE (8,2004)IMODE 2004 FORMAT(' * Mode ',I1,' INT acknowledge *') IFF1=0 IFF2=0 IF (IMODE.NE.1) GOTO 2006 MEM(LAND(SP-1,65535)+1)=LAND(PC/256,255) MEM(LAND(SP-2,65535)+1)=LAND(PC,255) SP=SP-2 PC=56 GOTO 3000 2006 IF (IMODE.NE.2) GOTO 3000 MEM(LAND(SP-1,65535)+1)=LAND(PC/256,255) MEM(LAND(SP-2,65535)+1)=LAND(PC,255) SP=SP-2 WRITE(6,2007) 2007 FORMAT(' *Enter low byte of address for mode 2 INT :') LINES=LINES+1 READ(9,2008) BUFFER 2008 FORMAT(104A1) BUFPOS=1 K=NUMBER(16,BUFFER,BUFPOS) K=LAND(I,255)*256+LAND(K,254) WRITE(8,2009)K 2009 FORMAT(' *Mode 2 INT table address : ',Z4,'*') K=MEM(K+1)+MEM(LAND(K+1,65535)+1)*256 PC=LAND(K,65535) 3000 IF (OP.NE.118.AND.LINES.LE.56) GOTO 20000 C C End of main instruction loop C 3001 WRITE(6,3002) 3002 FORMAT(/' Press return to continue, D for memory dump, Q to fi *nish.'/) READ (9,3003)BUFFER 3003 FORMAT(104A1) IF (EQUAL(BUFFER(1),'Q',1)) CALL EOJ(0) IF (.NOT.EQUAL(BUFFER(1),'D',1)) GOTO 10000 BUFPOS=2 CALL VERIFY(BUFFER(2),79,' ',1,NONSPC) IF (NONSPC.NE.0) GOTO 3005 WRITE(6,3004) 3004 FORMAT(' Enter start address for memory dump ( hex ) :'/) READ(9,3003)BUFFER BUFPOS=1 3005 PTR=NUMBER(16,BUFFER,BUFPOS) IF (PTR.GT.65535) GOTO 3011 CALL VERIFY(BUFFER(BUFPOS),80-BUFPOS,' ',1,NONSPC) IF (NONSPC.NE.0) GOTO 3007 WRITE(6,3006) 3006 FORMAT(' Enter finish address ( hex ) :'/) READ(9,3003)BUFFER BUFPOS=1 3007 END=NUMBER(16,BUFFER,BUFPOS) IF (END.GT.65536.OR.PTR.GE.END) GOTO 3011 WRITE(8,3008)PTR,END 3008 FORMAT(/,' Memory dump ',Z4,' - ',Z4/) 3009 PTR1=PTR+1 PTR2=PTR+16 IF (PTR2.GE.65536) PTR2=65536 WRITE(6,3010)PTR,(MEM(J),J=PTR1,PTR2) WRITE(8,3010)PTR,(MEM(J),J=PTR1,PTR2) 3010 FORMAT(1X,Z4,5X,4(4(1X,Z2),3X)) PTR=PTR+16 IF (PTR.LT.END+1) GOTO 3009 GOTO 3001 3011 WRITE(6,3012) 3012 FORMAT(/' *Error : Address out of range') CALL EOJ(85) END C C ###################################################################### C C Subroutines and functions C C Sum I and J into K (& carry if appropriate). Set flags. C B = no. of bits. C SUBROUTINE SUM(B,I,J,OP,K,C,V,S,N,H,Z) IMPLICIT INTEGER (A-Z) K=LAND(I,2**B-1)+LAND(J,2**B-1) IF (LAND(OP,8).EQ.8) K=K+C C=LAND(K,2**B)/2**B K=LAND(K,2**B-1) V=OVER(B,I,J,K) S=SGN(K,B) N=0 H=LAND(LAND(I,2**(B-4)-1)+LAND(J,2**(B-4)-1),2**(B-4))/2**(B-4) Z=ZERO(K,B) RETURN END C C Subtract J from I put in K (& carry if appropriate). Set flags. C B = no. of bits. C SUBROUTINE DIFF(B,I,J,OP,K,C,V,S,N,H,Z) IMPLICIT INTEGER (A-Z) K=LAND(I,2**B-1)-LAND(J,2**B-1) IF (LAND(OP,8).EQ.8) K=K-C C=LAND(K,2**B)/2**B K=LAND(K,2**B-1) V=OVER(B,I,-J,K) S=SGN(K,B) N=1 H=LAND(LAND(I,2**(B-4)-1)-LAND(J,2**(B-4)-1),2**(B-4))/2**(B-4) Z=ZERO(K,B) RETURN END C C Check for 2's compliment overflow to set P/V flag C FUNCTION OVER(L,I,J,K) INTEGER SGN,OVER OVER=0 IF (SGN(I,L).EQ.SGN(J,L).AND.SGN(K,L).NE.SGN(I,L)) OVER=1 RETURN END C C Find sign of an 8 or 16 bit number for S flag C FUNCTION SGN(I,J) INTEGER SGN SGN=LAND(I,2**(J-1))/2**(J-1) RETURN END C C Check for an 8 or 16 bit number being zero for Z flag C FUNCTION ZERO(I,J) INTEGER ZERO ZERO=0 IF (LAND(I,2**J-1).EQ.0) ZERO=1 RETURN END C C Calculate parity for an 8 bit number C FUNCTION PARITY(I) INTEGER PARITY K=0 DO 1 J=1,8 K=K+(LAND(I,2**(J-1))/2**(J-1)) 1 CONTINUE PARITY=LXOR(LAND(K,1),1) RETURN END C C Get a byte from port ADDR at time TIME C FUNCTION PORTI(ADDR,TIME,IPFLAG,IPFILE,LINES) INTEGER ADDR,PORTI,TIME,RET LOGICAL IPFLAG,IPFILE*1(22),BUFFER*1(104) IF (ADDR.NE.1) GOTO 4 IF (IPFLAG) GOTO 1 CALL OPNFIL(3,RET,IPFILE,'OKOLD RDOK.') IF (RET.EQ.30) GOTO 13 CALL FILMSG(RET,3) IPFLAG=.TRUE. 1 READ(3,2,END=15) PORTI 2 FORMAT(Z2) WRITE(6,3)PORTI,ADDR,IPFILE WRITE(8,3)PORTI,ADDR,IPFILE 3 FORMAT(' * ',Z2,' input through port ',Z2,' file ',22A1) LINES=LINES+1 RETURN 4 IF (ADDR.NE.2) GOTO 6 PORTI= * IFIX(127.5+127.5*SIN(2.0*3.14159*(FLOAT(TIME)/200.0))) WRITE(6,5)PORTI,ADDR WRITE(8,5)PORTI,ADDR 5 FORMAT(' * ',Z2,' input through port ',Z2,' ( sine ) *') LINES=LINES+1 RETURN 6 IF (ADDR.NE.3) GOTO 8 PORTI=127 WRITE(6,7)PORTI,ADDR WRITE(8,7)PORTI,ADDR 7 FORMAT(' * ',Z2,' input through port ',Z2,' (constant) *') LINES=LINES+1 RETURN 8 WRITE(6,9)ADDR 9 FORMAT(' *Enter input for port ',Z2,' *') LINES=LINES+1 READ(9,10)BUFFER 10 FORMAT(104A1) J=1 PORTI=NUMBER(16,BUFFER,J) WRITE(8,11)PORTI,ADDR 11 FORMAT(' * ',Z2,' input through port ',Z2,' from keyboard *') IF (PORTI.LT.256) RETURN WRITE(6,12) 12 FORMAT(/' *Error : Input out of range (0-FF)') CALL EOJ(86) 13 WRITE(6,14)IPFILE 14 FORMAT(/' *Error : File not found ',22A1) CALL EOJ(30) 15 WRITE(6,16)IPFILE 16 FORMAT(' *End of input file ',22A1) GOTO 8 END C C Output a byte to port ADDR C SUBROUTINE PORTO(ADDR,REG,OPFLAG,OPFILE,LINES) INTEGER ADDR,REG,R,RET LOGICAL OPFLAG,OPFILE*1(22) IF (ADDR.NE.1) GOTO 3 IF (OPFLAG) GOTO 1 CALL SETINF(6,-100,80,'FC','PRIV.') CALL OPNFIL(11,RET,OPFILE,'OKOLD OKNEW WROK.') CALL FILMSG(RET,11) OPFLAG=.TRUE. 1 WRITE(11,4) REG,ADDR WRITE(6,2) REG,ADDR,OPFILE WRITE(8,2) REG,ADDR,OPFILE 2 FORMAT(' * ',Z2,' Output to port ',Z2,' file ',22A1) LINES=LINES+1 RETURN 3 WRITE(6,4) REG,ADDR WRITE(8,4) REG,ADDR 4 FORMAT(' * ',Z2,' Output to port ',Z2,' *') LINES=LINES+1 RETURN END C C Check flags for condition specified by OP and return true or false C Automatically return true if the unconditional OP is specified C FUNCTION COND(OP,NONCND,C,V,S,Z) LOGICAL COND INTEGER OP,NONCND,C,V,S,Z J=LAND(OP,56)/8 I=LAND(J,6) IF (I.NE.0) GOTO 1 K=Z GOTO 4 1 IF (I.NE.2) GOTO 2 K=C GOTO 4 2 IF (I.NE.4) GOTO 3 K=V GOTO 4 3 K=S 4 K=LXOR(K,J-I) COND=.TRUE. IF (K.NE.0.AND.OP.NE.NONCND) COND=.FALSE. RETURN END C C Read double byte from two registers or stack pointer C depending on opcode being executed C FUNCTION DOUBLE(OP,REG,SP) INTEGER OP,REG(7),DOUBLE,SP J=LXOR(LAND(OP/8,6),6) IF (J.NE.0) GOTO 1 DOUBLE=SP RETURN 1 DOUBLE=REG(J+1)+256*REG(J) RETURN END C C Write double byte number out to two registers or stack pointer C depending on opcode being executed C SUBROUTINE SINGLE(D,OP,REG,SP) INTEGER D,OP,REG(7),SP J=LXOR(LAND(OP/8,6),6) IF (J.NE.0) GOTO 1 SP=D RETURN 1 REG(J)=LAND(D,65280)/256 REG(J+1)=LAND(D,255) RETURN END C C Increment PC and operands counter by INC C SUBROUTINE PCPLUS(INC) COMMON PC,BYTES INTEGER PC,BYTES,INC PC=LAND(PC+INC,65535) BYTES=BYTES+INC RETURN END C C Function to extract a decimal or hex number from the command line C options or a string read in from the keyboard C FUNCTION NUMBER(BASE,BUFFER,BUFPOS) INTEGER NUMBER,BASE,BUFPOS,CHAR LOGICAL*1 EQUALB,BUFFER(104) NUMBER=0 CHAR=0 1 IF (.NOT.EQUALB(BUFFER,BUFPOS,' ',1,1)) GOTO 2 BUFPOS=BUFPOS+1 IF (BUFPOS.GT.80) GOTO 3 GOTO 1 2 CALL LBMOVE(BUFFER,BUFPOS,CHAR,4,1) BUFPOS=BUFPOS+1 IF (CHAR.EQ.64.OR.CHAR.EQ.107) GOTO 3 IF (CHAR.LT.193.OR.(CHAR.GT.198.AND.CHAR.LT.240).OR.CHAR.GT.249) * GOTO 4 IF (CHAR.LT.240.AND.BASE.EQ.10) GOTO 4 NUMBER=NUMBER*BASE+LAND(CHAR,15) IF (CHAR.LE.198) NUMBER=NUMBER+9 IF (BUFPOS.LE.80) GOTO 2 3 RETURN 4 WRITE(6,5) 5 FORMAT(/' *Error : Input contains illegal numerical characters') CALL EOJ(87) END C C Subroutine to extract a filename from the command line options C SUBROUTINE FILNME(BUFFER,I,FNAME) LOGICAL*1 BUFFER(104),FNAME(22),EQUAL CALL FILL(FNAME,22,' ') 1 IF (.NOT.EQUAL(BUFFER(I),' ',1)) GOTO 2 I=I+1 IF (I.GT.80) GOTO 4 GOTO 1 2 J=1 3 FNAME(J)=BUFFER(I) I=I+1 J=J+1 IF (EQUAL(BUFFER(I),' ',1).OR.EQUAL(BUFFER(I),',',1)) GOTO 6 IF (J.EQ.23) GOTO 4 IF (I.LE.80) GOTO 3 4 WRITE(6,5) 5 FORMAT(/' *Error : Invalid filename') CALL EOJ(12) 6 I=I+1 RETURN END C C Join the opcode and operands together to form a single string C SUBROUTINE JOIN(OP,OP1,OP2,N,B,INDREG,RESULT) LOGICAL*1 RESULT(21),OP(4),OP1(4),OP2(4),INDEX(7) INTEGER POS(21),SPACE*2,B,HEX SPACE=64+256*0 IF (INDREG.EQ.0) CALL LMOVE('(HL )',INDEX,7) IF (INDREG.EQ.1) CALL LMOVE('(IX+ )',INDEX,7) IF (INDREG.EQ.2) CALL LMOVE('(IY+ )',INDEX,7) CALL LMOVE(OP,RESULT(1),4) IF (N.EQ.1) GOTO 8 IF (B.NE.1) GOTO 3 IF (INDREG.EQ.-1) GOTO 2 IF (INDREG.EQ.0) GOTO 1 CALL LMOVE(HEX(OP1,1),INDEX(5),2) 1 CALL LMOVE(INDEX,RESULT(6),7) GOTO 4 2 CALL LMOVE('( )',RESULT(6),6) 3 CALL LMOVE(OP1,RESULT(7),4) 4 IF (N.EQ.2) GOTO 8 CALL LMOVE(',',RESULT(13),1) IF (B.NE.2) GOTO 7 IF (INDREG.EQ.-1) GOTO 6 IF (INDREG.EQ.0) GOTO 5 CALL LMOVE(HEX(OP2,1),INDEX(5),2) 5 CALL LMOVE(INDEX,RESULT(14),7) GOTO 8 6 CALL LMOVE('( )',RESULT(14),6) 7 CALL LMOVE(OP2,RESULT(15),4) 8 CALL FNDALL(RESULT,21,SPACE,2,POS,NUMPOS) 9 I=POS(NUMPOS-1) NUMPOS=NUMPOS-1 IF (I.LE.5) GOTO 11 DO 10 J=I,20 RESULT(J)=RESULT(J+1) 10 CONTINUE GOTO 9 11 RETURN END C C Function to convert a 1 or 2 byte number into a 2 or 4 byte C hexadecimal character string C FUNCTION HEX(NUM,BYTES) INTEGER HEX,HEXSTR*2(4),BYTES CALL FILL(HEX,4,' ') CALL I2X(NUM,HEXSTR) CALL LMOVE(HEXSTR(5-BYTES),HEX,BYTES*2) RETURN END