C MOTOROLA 6800 CROSS-ASSEMBLER V01.X FEB 1979 C C A CROSS ASSEMBLER FOR 6800 MICROCOMPUTERS C WRITTEN IN FORTRAN IV PLUS FOR USE ON PDP11 UNDER C RSX11M OPERATING SYSTEM C C NOTE THAT IF THE FILE OPEN COMMANDS AND SPOOLING COMMANDS C ARE CHANGED IT MAY WORK UNDER OTHER FORTRANS. BYTE C VARIABLES MAY NEED TO BE CHANGED TO LOGICAL*1 C C **** C THE COPYRIGHT IN THIS VERSION BELONGS TO: C The C European Molecular Biology Laboratory C Hamburg Outstation C Notkestr. 85 C 2000 Hamburg 52 C West Germany C who are unable to provide support for this software C ***** C COMMON /SYSTAB/ SYTAB,SYVAL,ISYS COMMON /HOUSE/ PAGE,BUFF,J,LINENO,LLNO,APC,PASS BYTE HEXB(12),BUFF(80) C NOTE THAT THE DIMENSIONS OF ARRAY SYTAB AND SYVAL, AND THE C DATA VALUE ISYS MUST CORRESPOND. C FURTHER REFERENCES TO SYTAB,SYVAL AND ISYS IN SUBROUTINES C MUST ALSO BE CHANGED IF THE SYMBOL TABLE SIZE IS CHANGED C C IT SIMPLIFIES THE SYMBOL TABLE IF THIS VALUE IS EXACTLY C DIVISIBLE BY 3 REAL*8 SYTAB(300),LSTRNG,OSTRNG INTEGER*2 PAGE,PASS,LINENO INTEGER*4 SYVAL(300),VALUE,VAL(3),PSEUDO(7),APC,OPR,SIXT INTEGER*4 SVAL(51),RVAL(16),MVAL(40) INTEGER*4 SIMPLE(51),REL(16),MULTI(40) EQUIVALENCE (HEXB(1),VAL(1) ) EQUIVALENCE (OPR,OSTRNG) DATA SIXT /"200000/ DATA ISYS /300/ DATA PSEUDO 1 /'ORG ','EQU ','FCB ','FDB ','END ','FCC ','RMB '/ DATA SIMPLE 1 /'ABA ','CLRA','CLRB','CBA ','COMA','COMB','NEGA','NEGB', 1 'DAA ','DECA','DECB','INCA','INCB','PSHA','PSHB','PULA', 1 'PULB','ROLA','ROLB','RORA','RORB','ASLA','ASLB','ASRA', 1 'ASRB','LSRA','LSRB','SBA ','TAB ','TBA ','TSTA','TSTB', 1 'DEX ','DES ','INX ','INS ','TXS ','TSX ','NOP ','RTI ', 1 'RTS ','SWI ','WAI ','CLC ','CLI ','CLV ','SEC ','SEI ', 1 'SEV ','TAP ','TPA '/ DATA SVAL 1 /"033,"117,"137,"021,"103,"123,"100,"120, 1 "031,"112,"132,"114,"134,"066,"067,"062, 1 "063,"111,"131,"106,"126,"110,"130,"107, 1 "127,"104,"124,"020,"026,"027,"115,"135, 1 "011,"064,"010,"061,"065,"060,"001,"073, 1 "071,"077,"076,"014,"016,"012,"015,"017, 1 "013,"006,"007/ DATA REL 1 /'BRA ','BCC ','BCS ','BEQ ','BGE ','BGT ','BHI ','BLE ', 1 'BLS ','BLT ','BMI ','BNE ','BVC ','BVS ','BPL ','BSR '/ DATA RVAL 1 /"040,"044,"045,"047,"054,"056,"042,"057, 1 "043,"055,"053,"046,"050,"051,"052,"215/ C NOTE THAT THE FIRST 3 ITEMS IN THIS TABLE HAVE 3 BYTE IMMEDIATE C AND FROM NUMBER 28 ONWARDS HAVE NO DIRECT OR IMMEDIATE FORM DATA MULTI 1 /'CPX ','LDX ','LDS ','ADDA','ADDB','ADCA','ADCB','ANDA', 1 'ANDB','BITA','BITB','CMPA','CMPB','EORA','EORB','LDAA', 1 'LDAB','ORAA','ORAB','STAA','STAB','SUBA','SUBB','SBCA', 1 'SBCB','STX ','STS ','JMP ','JSR ','COM ','CLR ','NEG ', 1 'DEC ','INC ','ROL ','ROR ','ASL ','ASR ','LSR ','TST '/ DATA MVAL 1 /"214,"316,"216,"213,"313,"211,"311,"204, 1 "304,"205,"305,"201,"301,"210,"310,"206, 1 "306,"212,"312,"207,"307,"200,"300,"202, 1 "302,"317,"217,"116,"216,"103,"117,"100, 1 "112,"114,"111,"106,"110,"107,"104,"115/ PASS=1 PAGE=1 LINENO=0 CALL OPEN14 (BUFF,'ASS ',I3,I4) DO 2 I=1,ISYS 2 SYTAB(I)=0.0 4 APC=0 5 READ (1,1000,END=50) J,(BUFF(I),I=1,J) 1000 FORMAT (Q,80A1) IF (J.EQ.0) GOTO 5 LINENO=LINENO+1 CALL PARSER (BUFF,J,LABEL,IOPR,IPARAM,MODE) VALUE=0 LABEL1=LABEL IOPR1=IOPR IPARA1=IPARAM IF (LABEL.NE.0) CALL PACKER (BUFF,LABEL1,J,LSTRNG) IF (IOPR.NE.0) CALL PACKER (BUFF,IOPR1,J,OSTRNG) IF (IOPR.NE.0) GOTO 7 C - - - - - - - DEAL WITH COMMENT LINES... IF (LABEL.NE.0) CALL PUTTER (SYTAB,SYVAL,ISYS,LSTRNG,APC) IF (I4.EQ.1) CALL PRINT (-1,-1,-1) GOTO 5 C ============= DEAL WITH PSEUDO OPS 7 CALL FINDER (PSEUDO,7,OPR,I) IF (IPARAM.NE.0 .AND. I.NE.6) CALL PARAM (BUFF,IPARA1,J,VALUE) IF (I.EQ.0) GOTO 100 IF (I.EQ.1) GOTO 10 IF (I.EQ.2) GOTO 20 IF (LABEL.NE.0) CALL PUTTER (SYTAB,SYVAL,ISYS,LSTRNG,APC) GOTO (30,40,50,60,90) I-2 C ------------- ORIGIN 10 APC=VALUE IF (I4.EQ.1) CALL PRINT (-1,-1,-1) IF (LABEL.EQ.0) GOTO 5 CALL PUTTER (SYTAB,SYVAL,ISYS,LSTRNG,APC) GOTO 5 C ------------- EQUIVALENCE 20 CALL PUTTER (SYTAB,SYVAL,ISYS,LSTRNG,VALUE) IF (I4.EQ.1) CALL PRINT (-1,-1,-1) GOTO 5 C ------------- FILL CONSTANT BYTE 30 IF (I4.EQ.1) CALL PRINT (VALUE,-1,-1) IF (I3.EQ.1) CALL PUNCH (VALUE,-1,-1) APC=APC+1 GOTO 5 C ------------- FILL DOUBLE BYTE 40 IF (I4.EQ.1) CALL PRINT (VALUE/256,JMOD(VALUE,256),-1) IF (I3.EQ.1) CALL PUNCH (VALUE/256,JMOD(VALUE,256),-1) APC=APC+2 GOTO 5 C ------------- END THING (READING CTRL-Z COMES HERE TOO) 50 CALL PUTTER (SYTAB,SYVAL,ISYS,'.END. ',APC) IF (I4.EQ.1) CALL PRINT (-1,-1,-1) GOTO 850 C ------------- ASCII STRING 60 IOPR1=IOPR1+1 IF (IOPR1.GT.J) GOTO 5 IF (BUFF(IOPR1).NE.9 .AND. BUFF(IOPR1).NE.32) GOTO 65 GOTO 60 65 DELIM=BUFF(IOPR1) IOPR1=IOPR1+1 IF (I4.EQ.1) CALL PRINT (-1,-1,-1) 70 DO 75 IJ=0,2 IF (IOPR1.GT.J) GOTO 80 IF (BUFF(IOPR1+IJ).EQ.DELIM) GOTO 80 75 VAL(IJ+1)=BUFF(IOPR1+IJ) IF (I4.EQ.1) CALL PRINT (VAL(1),VAL(2),VAL(3) ) IF (I3.EQ.1) CALL PUNCH (VAL(1),VAL(2),VAL(3) ) IOPR1=IOPR1+3 APC=APC+3 GOTO 70 80 IF (IJ.EQ.1 .AND. I4.EQ.1) CALL PRINT (VAL(1),-1,-1) IF (IJ.EQ.2 .AND. I4.EQ.1) CALL PRINT (VAL(1),VAL(2),-1) IF (IJ.EQ.1 .AND. I3.EQ.1) CALL PUNCH (VAL(1),-1,-1) IF (IJ.EQ.2 .AND. I3.EQ.1) CALL PUNCH (VAL(1),VAL(2),-1) APC=APC+IJ GOTO 5 C - - - - - - - RESERVE MEMORY BLOCK 90 IF (I4.EQ.1) CALL PRINT (-1,-1,-1) APC=APC+VALUE GOTO 5 C ============= DEAL WITH OPCODES C ------------- OPCODES WITH INHERENT MODE ONLY 100 IF (LABEL.NE.0) CALL PUTTER (SYTAB,SYVAL,ISYS,LSTRNG,APC) CALL FINDER (SIMPLE,51,OPR,I) IF (I.EQ.0) GOTO 200 IF (I4.EQ.1) CALL PRINT (SVAL(I),-1,-1) IF (I3.EQ.1) CALL PUNCH (SVAL(I),-1,-1) APC=APC+1 GOTO 5 C ------------- OPCODES WITH RELATIVE MODE ONLY 200 CALL FINDER (REL,16,OPR,I) IF (I.EQ.0) GOTO 300 IF (VALUE.EQ.-1) VALUE = APC VALUE=VALUE-2-APC IF (VALUE.GE.-128 .AND. VALUE.LE.127) GOTO 210 IF (PASS.EQ.2) WRITE (4,1200) LINENO 1200 FORMAT (' BRANCH OUT OF RANGE AT LINE',I5) 210 IF (VALUE.LT.0) VALUE=VALUE+SIXT IF (I4.EQ.1) CALL PRINT (RVAL(I),VALUE,-1 ) IF (I3.EQ.1) CALL PUNCH (RVAL(I),VALUE,-1 ) APC=APC+2 GOTO 5 C ------------- OPCODES WITH MORE THAN ONE MODE 300 CALL FINDER (MULTI,40,OPR,I) IF (I.EQ.0) GOTO 400 IF (BUFF(IPARAM).EQ.1H#) GOTO 320 IF (IPARA1.GT.J) GOTO 310 IF (BUFF(IPARA1).EQ.1H,) GOTO 340 310 IF (VALUE.GT.255) GOTO 380 GOTO 360 C - - - - - - - IMMEDIATE MODE 320 IF (I.LT.4) GOTO 330 IF (I4.EQ.1) CALL PRINT (MVAL(I),VALUE,-1) IF (I3.EQ.1) CALL PUNCH (MVAL(I),VALUE,-1) APC=APC+2 GOTO 5 330 IF (I4.EQ.1) CALL PRINT (MVAL(I),VALUE/256,JMOD(VALUE,256) ) IF (I3.EQ.1) CALL PUNCH (MVAL(I),VALUE/256,JMOD(VALUE,256) ) APC=APC+3 GOTO 5 C - - - - - - - INDEX MODE 340 IF (I4.EQ.1) CALL PRINT (MVAL(I)+"40,VALUE,-1) IF (I3.EQ.1) CALL PUNCH (MVAL(I)+"40,VALUE,-1) APC=APC+2 GOTO 5 C - - - - - - - DIRECT MODE 360 IF (I.GE.28) GOTO 380 IF (VALUE.EQ.-1) GOTO 370 IF (I4.EQ.1) CALL PRINT (MVAL(I)+"20,VALUE,-1) IF (I3.EQ.1) CALL PUNCH (MVAL(I)+"20,VALUE,-1) APC=APC+2 GOTO 5 370 VALUE=APC C - - - - - - - EXTENDED MODE 380 IF (I4.EQ.1) CALL PRINT (MVAL(I)+"60,VALUE/256,JMOD(VALUE,256) ) IF (I3.EQ.1) CALL PUNCH (MVAL(I)+"60,VALUE/256,JMOD(VALUE,256) ) APC=APC+3 GOTO 5 400 WRITE (4,1400) LSTRNG,LINENO 1400 FORMAT (' UNKNOWN OPCODE [',A8,'] AT LINE',I5) GOTO 5 C ============= END OF PASS 1850 FORMAT (3(2X,A8,2X,A4)) 850 PASS=PASS+1 IF (PASS.EQ.3) GOTO 900 REWIND (1) LINENO=0 DO 860 I=1,ISYS,3 IF (I.EQ.1) GOTO 855 IF (SYTAB(I-2).EQ.0) GOTO 870 IF (SYTAB(I-1).EQ.0) GOTO 870 855 IF (SYTAB(I).EQ.0) GOTO 870 DO 857 J=0,2 CALL HEX(HEXB,1+4*J,SYVAL(I+J)/256 ) CALL HEX (HEXB,3+4*J,JMOD(SYVAL(I+J),256) ) 857 CONTINUE IF (IMOD(LINENO,50).EQ.0) WRITE (4,1860) 1860 FORMAT ('1 6800 CROSS ASSEMBLER V01.X',/, 1 ' SYMBOL TABLE IN ADDRESS ORDER',//) WRITE (4,1850) (SYTAB(I+J),VAL(1+J),J=0,2) LINENO=LINENO+1 860 CONTINUE 870 LINENO=0 GOTO 4 900 IF (I3.EQ.1) WRITE (3,1900) 1900 FORMAT (' S9',//) CALL EXIT END