MPU 31 A@@@@@SRC B@@@@@SRC C@@@@@SRC D@@@@@SRC DECK@@SRC E@@@@@SRC F@@@@@SRC G@@@@@SRC H@@@@@SRC I@@@@@SRC J@@@@@SRC K@@@@@SRC L@@@@@SRC M68...002 M6809@015 M@@@@@SRC MPU@@@JOB MPURSXPRM N@@@@@SRC O@@@@@SRC P@@@@@SRC Q@@@@@SRC R@@@@@SRC S@@@@@SRC T@@@@@SRC U@@@@@SRC V@@@@@SRC W@@@@@SRC X@@@@@SRC Y@@@@@SRC Z@@@@@SRC [\]. A@@@@@SRC C .TITLE M6800 C C 31 JAN 78 (PDH) CONVERT TO A SUBROUTINE TO BE CALLED BY A C TDV FUNCTION INTERFACE SO IT CAN RUN AS SUCH C UNDER MULTIACCESS. C 12 DEC 77 (PDH) CHANGE 'LULT' TO 6; CHANGE 'IPGLOL' TO 121, C WHICH EFFECTIVELY WIDENS THE PRINT BUFFER. C 12 OCT 76 (PDH) CHANGE 'LUSI' TO 12 IN AN ATTEMPT TO PREVENT C RSX BATCH FROM HANGING. C 13 AUG 76 (PDH) CHANGE 'LUOT' BACK TO 7 C 27 JUL 76 (PDH) CHANGE 'LUIO2' TO LUN 9. C 26 JUL 76 (PDH) CONVERT FOR USE WITH RSX C 3 JUN 76 (PDH) CHANGE SECONDARY INPUT EXTENSION TO 'PS2' C 1 JUN 76 (PDH) CHANGE TO 55 LINES PER PAGE ON LISTING C 24 FEB 76 (PDH) PASS 1 INPUT FROM CARDS, PASS 2 UNPACKED INPUT FROM DISK C 13 FEB 76 (PDH) REMOVE UNNECESSARY SECTIONS AND ROUTINES CONVERTED C TO ASSEMBLER: 'MPUBSM', 'MPUCA1', 'MPUCA2', 'MPUCVC', C 'MPUNEG', 'MPUOVF', 'MPUXBS', 'MPUXBY', 'MPVDIV', 'MPVMUL' C 12 FEB 76 (PDH) ARRANGE SUBROUTINES IN ALPHABETICAL ORDER C 11 FEB 76 - MODIFIED BY PAUL HENDERSON TO RUN WITH PDP-9 WATRAN C C PROGRAM MPAM C+ NAM: MPAM VER: 1.0 DAT: 10-01-74 CMP: SIGMA-9 C PGM: MAIN ROUTINE FOR SYSTEM M68SAM C C SYS: M68SAM C C FNC: THIS ROUTINE CONTAINS ALL COMMON VARIABLES WHICH ARE C C ************************************************ C *** *** C *** COPYRIGHT 1975 BY MOTOROLA INC *** C *** *** C ************************************************ C* SUBROUTINE M6800 (PGNM) REAL PGNM,PROGNM INTEGER KCOMON(1375),IMAGE(40) COMMON /PG/ LUIO2,LUTT,PROGNM,EXTSRC,EXTLST,EXTOBJ,EXTPS2 COMMON ICOMON,LULT,LUSI,LUOT,LLSPSP,ICSHF,IA2SHF,IA1SHF COMMON IBPWD,KCFOTB(16),KCFF,KC7F7F,KCFFFF,KC80,KEATB(64) COMMON KAETB(64),ISIBUF(80),NB(121),INX,LABEL(4),LABESW COMMON IOPCOD(3),NPNAM(3),NPGNO,IPGLOL,IPGLEN,NPLCT COMMON IOTBUF(80),IOTINX,IOTSW,IOTCKS,NOTADR,NAM(4) COMMON ISIMBF(43),IC,NC,ICSW,IPASS,IOPCLS,IOPIXB,IOPBIN COMMON IOPAN1,IPCT,ITERR,NRTSW,NSSCOL,NSOSCH,NAMSW,LSCM COMMON LIMA,LDRA,LSBH,LSBO,LSBB,LSPCT,LSASC,NOPT(2) COMMON NOPC(4),NOPCL,IXBASE,LSPSP,L8SP,L10,L16,LSP,LASK COMMON LPOS,LCOMA,LMNS,LSLASH,L0,L1,L9,LA,LB,LD,LF,LH,LN COMMON LO,LQ,LR,LS,LX,LZ,NOSYM,ISYM(813),LSYM COMMON /A/ NOPCD(246),IOPBC2(51),IOPBC3(16) COMMON /A/ IOPBC4(116),IOPBC5(22) EQUIVALENCE (KCOMON(1),ICOMON),(N1,NAM(1)),(N2,NAM(2)) EQUIVALENCE (N3,NAM(3)),(N4,NAM(4)),(ISILN,ISIMBF(2)) EQUIVALENCE (ISIFCH,ISIMBF(3)),(IMAGE(1),ISIMBF(4)) EQUIVALENCE (NOPBAS,NOPT(1)),(NOPLI,NOPT(2)) DATA EXT1,EXT2,EXT3,EXT4/'SRC','LST','OBJ','PS2'/ C KCOMON(1)=1375 C LUTT = 13 LUSI = 15 LULT = 16 LUOT = 17 LUIO2 = 18 PROGNM = PGNM EXTSRC = EXT1 EXTLST = EXT2 EXTOBJ = EXT3 EXTPS2 = EXT4 C LLSPSP=65536 ICSHF=256 IA2SHF=128 IA1SHF=2048 IBPWD=18 KCFOTB(1)=1 KCFOTB(2)=2 KCFOTB(3)=4 KCFOTB(4)=8 KCFOTB(5)=16 KCFOTB(6)=32 KCFOTB(7)=64 KCFOTB(8)=128 KCFOTB(9)=256 KCFOTB(10)=512 KCFOTB(11)=1024 KCFOTB(12)=2048 KCFOTB(13)=4096 KCFOTB(14)=8192 KCFOTB(15)=16384 KCFOTB(16)=32768 KCFF=255 KC7F7F=32639 KCFFFF=65535 KC80=128 LABESW=1 NPGNO=0 IPGLOL = 121 IPGLEN=55 NPLCT=200 ISIMBF(1)=0 ISILN=0 IPCT=0 ITERR=0 NRTSW=1 NAMSW=1 LSCM=42 LIMA=35 LDRA=0 LSBH=36 LSBO=64 LSBB=37 LSPCT=42 LSASC=39 NOPBAS=16 NOPLI=2 NOPC(1)=17474 NOPC(2)=16723 NOPC(3)=19529 NOPC(4)=21332 NOPCL=4 IXBASE=3 LSPSP=8224 L8SP=14368 L10=12592 L16=12598 LSP=32 LASK=42 LPOS=43 LCOMA=44 LMNS=45 LSLASH=47 L0=48 L1=49 L9=57 LA=65 LB=66 LD=68 LF=70 LH=72 LN=78 LO=79 LQ=81 LR=82 LS=83 LX=88 LZ=90 NOSYM=3 ISYM(1)=16672 ISYM(2)=8224 ISYM(3)=8224 ISYM(4)=32767 ISYM(5)=16928 ISYM(6)=8224 ISYM(7)=8224 ISYM(8)=32767 ISYM(9)=22560 ISYM(10)=8224 ISYM(11)=8224 ISYM(12)=32767 ISYM(13)=0 LSYM=813 CALL MPAM0 RETURN END [\]. B@@@@@SRC C.MPAERR (B) SUBROUTINE MPAERR (JER) C+ NAM: MPAERR VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: CROSS-ASSEMBLER ERROR ROUTINE C C SYS: M68SAM C C ENT: JER - ERROR NUMBER TO PRINT C C RTN: JER - N/C C C FNC: PRINT THE ERROR MESSAGE IF THE OPTIONS ARE SET. C SHORT ERRORS PRINT ONLY THE ERROR CODE LONG C ERROR PRINT THE LAST 6 CHAR WHERE THE SCAN HAS C STOP AT. C* INTEGER JB(3),IEB(6) REAL EB(3) COMMON ICOMON,LULT,LUSI(3),ICSHF,IA2SHF(499),IC,NC(8) COMMON ITERR,NRTSW(20),LSPSP,L8SP(3),LSP EQUIVALENCE (EB(1),IEB(1)) C*** PRINT THE ERROR MESSAGE DO 100 I=1,3 JB(I)=LSPSP 100 CONTINUE C*** PRINT LONG ERROR MESSAGES JSIC=IC IC=JSIC-6 IF(IC.LT.0) IC=0 I=1 200 CALL MPUGNC (J) JB(I)=J*ICSHF+LSP IF(IC.EQ.JSIC) GO TO 300 CALL MPUGNC (J) JB(I)=JB(I)-LSP+J I=I+1 IF(IC.LT.JSIC) GO TO 200 C*** PRINT THE ERROR MESSAGE 300 CALL MPUCA2 (JB,3) DO 302 I=1,3 K = I*2 - 1 IEB(K) = JB(I) 302 CONTINUE WRITE (LULT,301) JER,EB 301 FORMAT(10H ****ERROR,I4,2X,3A2) CALL MPAPAG (1) ITERR=ITERR+1 RETURN END [\]. C@@@@@SRC C.MPAFOP (C) SUBROUTINE MPAFOP C+ NAM: MPAFOP VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: SEARCH THE OPCODE TABLES C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: SEARCH THE OPCODE TABLES. IF THE OPCODE IS FOUND, C ITS INDEX IS RETURNED IN 'IOPIXB'. IF NOT FOUND, C 'IOPIXB' AND 'IOPCLS' (CLASS) ARE SET TO 1. C* COMMON ICOMON(364),IOPCOD(3),NPNAM(142),IOPCLS,IOPIXB COMMON IOPBIN COMMON /A/ NOPCD(246),IOPBC2(51),IOPBC3(16) COMMON /A/ IOPBC4(116),IOPBC5(22) DATA LASK0/10800/,LASK9/10809/ IOPCLS=0 IOPIXB=1 I=1 240 N=NOPCD(I) I=I+1 IF(IOPCOD(1).EQ.N) GO TO 245 IF(N.LT.LASK0.OR.N.GT.LASK9) GO TO 250 C*** NEW OPCODE CLASS FOUND IOPCLS=IOPCLS+1 IOPIXB=1 IF(N.NE.LASK9) GO TO 240 C*** UNDEFINED OPCODE (SET INDEX TO UNDEFINED OPCODE) IOPCLS=1 GO TO 255 245 N=NOPCD(I) IF(IOPCOD(2).EQ.N) GO TO 255 250 I=I+1 IOPIXB=IOPIXB+1 GO TO 240 C*** OPCODE FOUND (PLACE THE OPCODE BINARY IN IOPBIN) 255 IOPBIN=0 RETURN END [\]. D@@@@@SRC C.MPAFSY (D) SUBROUTINE MPAFSY (JNM,JRS,JSI) C+ NAM: MPAFSY VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: FIND SYMBOL IN THE SYMBOL TABLE C C SYS: M68SAM C C C ENT: JNM - 6 CHAR SYMBOL TO FIND IN SYSTEM'S R2 FORMAT C JRS - N/A C JSI - N/A C C RTN: JNM - WORDS 1 TO 3 N/C C - 4TH WORD EQUALS THE SYMBOLS VALUE IF FOUND C JRS - 1 => SYMBOL FOUND C - 2 => SYMBOL FOUND, BUT ERROR FLAG SET C - 3 => SYMBOL NOT IN THE TABLE C JSI - SYMBOL TABLE INDEX TO WORD 1 (IF FOUND) C C FNC: SEARCH THE SYMBOL TABLE FOR 6 CHARACTER SYMBOL C SYSTEM'S R2 ASCII FORMAT (WORDS 1-3 OF JNM) C AND RETURN IT'S VALUE IN WORD 4 IF FOUND. C* INTEGER JNM(4) COMMON ICOMON(26),KC7F7F,KCFFFF,KC80,KEATB(532),ISYM(813) COMMON LSYM DO 100 I=1,LSYM,4 J=ISYM(I) IF(J.EQ.0) GO TO 110 IF(JNM(1).NE.IAND(J,KC7F7F)) GO TO 100 IF(JNM(2).NE.ISYM(I+1)) GO TO 100 IF(JNM(3).EQ.ISYM(I+2)) GO TO 120 100 CONTINUE I=LSYM C*** SYMBOL NOT FOUND 110 JRS=3 GO TO 130 C*** SYMBOL WAS FOUND 120 JRS=1 IF(IAND(J,KC80).NE.0) JRS=2 JNM(4)=ISYM(I+3) 130 JSI=I RETURN END [\]. DECK@@SRC NAM DECK *+ NAM: M68PGM VER: 1.0 DAT: 11-15-74 CMP: M6800 ORG 256 COUNT EQU @3 START LDS #STACK INZ STACK POINTER LDX ADDR LDA B #COUNT IMMEDIATE ADDRESSING BACK LDA A 10 DIRECT ADDRESSING CMP A 2,X INDEXED ADDRESSING BEQ FOUND RELATIVE ADDRESSING DEX IMPLIED ADDRESSING DEC B ACCUMULATOR ONLY ADDRESSING BNE BACK WAI WAIT FOR INTERRUPT SPC 1 FOUND JSR SUBRTN JUMP TO SUBROUTINE JMP START EXTENDED ADDRESSING * COMMENT STATEMENT NOT TRUNCATION 01234567890123456789 SUBRTN TAB COMMENT FIELD TRUNCATION0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ012345678 ORA A BYTE SET MOST SIGNIFICANT BIT RTS RETURN FROM SUBROUTINE SPC 2 RMB 20 SCRATCH AREA FOR STACK STACK RMB 1 START OF STACK BYTE FCB $80 FORM CONSTANT BYTE ADDR FDB DATA FORM CONSTANT DOUBLE BYTE DATA FCC 'SET' FORM CONSTANT DATA STRING (ASCII) END [\]. E@@@@@SRC C.MPAGAM (E) SUBROUTINE MPAGAM (JM,JSW) C+ NAM: MPAGAM VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: GET ADDRESS MODE C C SYS: M68SAM C C ENT: JM - N/A C JSW - N/A C C RTN: JM - 1=> DIRECT ADDRESS MODE C - 2=> INDEXED ADDRESS MODE C - 3=> IMMEDIATE ADDRESS MODE C - 4=> EXTENDED ADDRESS MODE C JSW - SEE 'MPAOPR' FOR 'JSW' SETTINGS C C FNC: GET THE INSTRUCTIONS ADDRESS MODE C* COMMON ICOMON(505),IC,NC,ICSW,IPASS(4),IOPAN1,IPCT(7) COMMON LIMA,LDRA,LSBH(17),LSP,LASK(18),LX IOPAN1=0 JSW=1 JC=NC CALL MPUGNC(NC) JM=3 IF(LIMA.EQ.JC) GO TO 10 JM=1 IF(LDRA.EQ.JC) GO TO 10 IF(JC.EQ.LX.AND.NC.EQ.LSP) GO TO 40 JM=0 IC=IC-2 CALL MPUGNC(NC) 10 CALL MPAOPR (IOPAN1,JSW) GO TO (50,30,20,20,20,50),ICSW C*** ERROR IN OPERAND 20 JM=4 JSW=5 GO TO 60 C*** OPERAND ENDS WITH A COMMA ',' 30 CALL MPUGNC(JC) CALL MPUGNC(NC) IF(JC.NE.LX.OR.NC.NE.LSP) GO TO 20 C*** INDEXED ADDRESS MODE 40 JM=2 50 IF(JM.NE.0) GO TO 60 C*** MODE IS BY WORD LENGTH JM=1 IF(JSW.NE.1) JM=4 60 RETURN END [\]. F@@@@@SRC C.MPAM0 (F) C C 21 MAR 78 (PDH) ATTACH LISTING AND 'PAPER TAPE' DEVICES; IGNORE C IEV = -6 VALUES. C 10 MAR 78 (PDH) CLOSE SOURCE INPUT FILE AFTER ASSEMBLY; 'CALL RSREAD' C 9 MAR 78 (PDH) 'FILE NOT FOUND' IS -11 DECIMAL C 31 JAN 78 (PDH) MAKE SOME CHANGES FOR USE UNDER MULTIACCESS C AS A TDV FUNCTION. C 12 DEC 77 (PDH) DELETE DOES WORK IF YOU KNOW HOW! PUT IT BACK. C 15 OCT 76 (PDH) REMOVE LINE PRINTER FLUSH - NOT NEEDED IN BATCH C 9 SEP 76 (PDH) DELETE DOESN'T WORK! SIMULATE IT (NEARLY) BY C WRITING OUT A VERY SHORT FILE OF THE SAME NAME. C 27 JUL 76 (PDH) DELETE SECONDARY FILE AFTER USE; CHANGE TO RSX C FILE NAME SPECIFICATION; FLUSH PRINTER WHEN DONE. C 26 JUL 76 (PDH) CONVERT TO RSX C 2 MAR 76 (PDH) SEPARATE PASS 1 ERRORS FROM PASS 2 LISTING C 24 FEB 76 (PDH) OPEN FILE TO STORE UNPACKED INPUT FOR PASS 2 C 17 FEB 76 (PDH) SPECIFY INPUT FILE NAME AND OPEN THE FILE C SUBROUTINE MPAM0 C+ NAM: MPAM0 VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: MAIN ROUTINE FOR THE CROSS-ASSEMBLER C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: MAIN CONTROL ROUTINE FOR THE CROSS-ASSEMBLER. C* COMMON /PG/ LUIO2,LUTT,PROGNM,EXTSRC,EXTLST,EXTOBJ,EXTPS2 COMMON ICOMON,LULT,LUSI,LUOT,LLSPSP,ICSHF(362),NPNAM(3) COMMON NPGNO(138),IPASS,IOPCLS(5),ITERR,NRTSW(12),NOPT(2) COMMON NOPC(5),IXBASE EQUIVALENCE (NOPBAS,NOPT(1)),(NOPLI,NOPT(2)) C*** INITIALIZE THE ASSEMBLER C CALL SEEK (LUSI,PROGNM,EXTSRC,IEV) CALL WAITFR (IEV) IF (IEV .GT. 0) GO TO 5 IF (IEV .EQ. (-11)) GO TO 4 IF (IEV .EQ. ( -6)) GO TO 5 WRITE (LUTT,598) IEV RETURN 4 WRITE (LUTT,599) PROGNM RETURN 599 FORMAT (' FILE ',A5,' SRC NOT FOUND') 598 FORMAT (' SEEK ERROR',I7,' (DECIMAL)') C C IN ORDER TO PREVENT POSSIBLE CONFUSING OCCURRENCES, IT IS C CONSIDERED PRUDENT TO ATTACH THE LISTING AND OBJECT DEVICES. C 5 CALL ATTACH (LULT,IEV) CALL WAITFR (IEV) CALL ENTER (LULT,PROGNM,EXTLST) CALL ATTACH (LUOT,IEV) CALL WAITFR (IEV) CALL ENTER (LUOT,PROGNM,EXTOBJ) CALL ENTER(LUIO2,PROGNM,EXTPS2) C C RESET THE 'READ' SUBROUTINE IN CASE THIS IS NOT THE 1ST TIME. C CALL RSREAD C C*** SPACE THE PAGE HEADER'S PROGRAM NAME DO 10 I=1,3 NPNAM(I)=LLSPSP 10 CONTINUE C C NO LINE COUNT FOR PASS 1 C NOPLI = 1 C*** CALL PASS 1 BUILD SYMBOL TABLE IPASS=1 CALL MPAM1 C*** INITIALIZE PASS 2. ISSUE TOP OF FORM TO CLEAR PRINTER PAPER. NOPLI=2 CALL MPAPAG (-1) IXBASE=3 NOPBAS=16 C*** CALL PASS 2 OUTPUT LISTING AND TAPE FILE IPASS=2 CALL MPAM2 C*** CALL PASS 3 LISTING SYMBOL TABLE AND CLOSE FILES CALL MPAM3 CALL CLOSE (LUSI) C C HAVE TO USE NAME & EXT TO BE ABLE TO MAKE USE OF 'IEV' C CALL CLOSE (LULT,PROGNM,EXTLST,IEV) CALL WAITFR (IEV) CALL CLOSE (LUIO2) CALL DELETE (LUIO2,PROGNM,EXTPS2,IEV) CALL WAITFR (IEV) RETURN END [\]. G@@@@@SRC C.MPAM1 (G) C C 31 JAN 78 (PDH) CHANGE COMMON 'PG' FOR MULTIACCESS C 24 FEB 76 (PDH) NO MORE '/*'; USE SUBROUTINE 'READ'; STORE C UNPACKED INPUT ON DISK FOR PASS 2 C 17 FEB 76 (PDH) CHANGE 'END= ' TO CHECK FOR '/*' C SUBROUTINE MPAM1 C+ NAM: MPAM1 VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: PASS ONE OF THE MPU CROSS ASSEMBLER C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: BUILD THE SYMBOL TABLE C* COMMON /PG/LUIO2 COMMON ICOMON(2),LUSI,LUOT,LLSPSP,ICSHF(152),ISIBUF(80) COMMON NB(122),LABEL(4),LABESW,IOPCOD(3),NPNAM(3) COMMON NPGNO(92),ISIMBF(43),IC,NC,ICSW,IPASS,IOPCLS COMMON IOPIXB,IOPBIN(2),IPCT,ITERR,NRTSW(3),NAMSW,LSCM COMMON LIMA(15),LSPSP,L8SP(3),LSP,LASK(8),LA,LB COMMON /A/ NOPCD(246),IOPBC2(51),IOPBC3(16) COMMON /A/ IOPBC4(116),IOPBC5(22) EQUIVALENCE (ISILN,ISIMBF(2)) DATA K0/0/,K1/1/ C IE=204 JRDNO=0 JRLNSW=2 C*** SETUP THE P.T. FILE CALL MPUPTS (K1,K0,K0) GO TO 140 C*** ERROR '206' SYMBOL HAS BEEN DEFINED, (DOUBLE DEFINDED) 100 IF(LABESW.EQ.2) CALL MPAERR (206) LABESW=1 GO TO (110,120),NAMSW C*** ERROR '201' NO NAM RECORD OR MULT NAM RECORDS 110 CALL MPAERR (201) NAMSW=2 120 IF(ITERR.NE.JTERR) CALL MPAPRL (545) 140 JTERR=ITERR DO 150 I=1,80 ISIBUF(I)=LLSPSP 150 CONTINUE C C*** READ IN ONE SOURCE STATEMENT C CALL READ (ISIBUF,LUSI) 153 JRDNO=JRDNO+1 ISILN=JRDNO C*** PACK THE SOURCE RECORD INTO THE SOURCE IMAGE BUFFER CALL MPUPIB (ISIBUF,JRLNSW) WRITE (LUIO2) ISIMBF,IC,NC,JRLNSW,ICSW LEVEL=1 LABEL(1)=0 LABEL(4)=0 GO TO 180 C*** GET THE NEXT CHAR 170 CALL MPUGNC (NC) 180 GO TO (190,260,280,310),LEVEL 190 GO TO (250,220,200,240,230,210),ICSW C*** ERROR '202' LABEL OR OPCODE MUST START WITH A ALPHA CHAR 200 IE=IE-1 C*** ERROR '203' BLANK RECORD OR THE RECORD ONLY CONTAINS A LABEL 210 IE=IE-1 C*** ERROR '204' SYNTAX ERROR 220 CALL MPAERR (IE) IE=204 GO TO 440 230 IF (NC.NE.LSCM) GO TO 220 C*** RECORD IS A COMMENT RECORD (SKIPIT) GO TO 100 C*** GET THE STATEMENT'S LABEL 240 CALL MPUBNM (LABEL) C*** ERROR '205' ILLEGAL STATEMENT LABEL (MUST END WITH A SPACE) IF (ICSW.NE.1) CALL MPAERR (205) C*** STORE THE LABEL IN THE SYMBOL TABLE LABEL(4)=IPCT CALL MPASSY (LABEL,1,LABESW) 250 LEVEL=2 C*** LEVEL 2 SCAN FOR START OF OPCODE FIELD 260 GO TO (170,200,200,270,200,210),ICSW C*** GET THE OPCODE 270 CALL MPUBNM (IOPCOD) IF(ICSW.NE.1) GO TO 220 CALL MPAFOP IF(IOPCLS.EQ.2) GO TO 460 LEVEL=3 C LEVEL 3 SCAN FOR 'A ' OR 'B ' 280 GO TO (170,320,320,290,320,320),ICSW 290 IF(NC.NE.LA.AND.NC.NE.LB) GO TO 320 JC=NC CALL MPUGNC(NC) IF(ICSW.EQ.1) GO TO 300 IC=IC-2 CALL MPUGNC(NC) GO TO 320 C*** OPCODE IS 'CCC X ' WHERE) X= A OR B 300 IOPCOD(2)=IOPCOD(2)-LSP+JC CALL MPAFOP IF(IOPCLS.EQ.2) GO TO 460 C*** SCAN TO THE START OF THE OPERAND FIELD LEVEL=4 310 GO TO (170,320,320,320,320,320),ICSW 320 GO TO (330,460,450,420,400),IOPCLS C C*** DIRECTIVE OPCODES C C*** ASSEMBLER CLASS 1 330 IF(IOPIXB.GT.4) GO TO 390 GO TO (340,350,360,340),IOPIXB C*** ERROR '207' UNDEFINED OPCODE 340 CALL MPAERR (207) GO TO 440 C*** 'NAM' OPCODE 350 IF(NAMSW.EQ.2) GO TO 110 CALL MPUBNM(NPNAM) NAMSW=2 IF(NPNAM(1).EQ.LSPSP) GO TO 220 CALL MPUCA2(NPNAM,3) GO TO 100 C*** 'END' OPCODE 360 RETURN C*** GO TO THE DIRECTIVE OPCODE PROCCESSOR 390 CALL MPAPSC IF(IPCT.EQ.0) GO TO 120 GO TO 100 C C*** 2 OR 3 BYTE INSTRUCTION (INDEXED AND EXTENDED MODE ONLY) C C*** ASSEMBLER CLASS 5 400 CALL MPAGAM (IAMOD,JOPRSW) IF(JOPRSW.GT.4) GO TO 220 GO TO (440,450,410,440),IAMOD 410 CALL MPAERR (209) GO TO 440 C C*** 2 OR 3 BYTE INSTRUCTION C C*** ASSEMBLER CLASS 4 420 CALL MPAGAM (IAMOD,JOPRSW) IF(JOPRSW.GT.4) GO TO 220 IOPIXB=IOPIXB*4-4+IAMOD IF(IOPBC4(IOPIXB).LT.0) GO TO 410 IF(IOPIXB.LT.13.AND.IAMOD.EQ.3) GO TO 440 GO TO (430,450,450,440),IAMOD 430 IF(IOPIXB.NE.21.AND.IOPIXB.NE.25) GO TO 450 C*** 3 WORD OPCODES 440 IPCT=IPCT+1 C*** 2 WORD OPCODES 450 IPCT=IPCT+1 C*** 1 WORD OPCODES 460 IPCT=IPCT+1 GO TO 100 END [\]. H@@@@@SRC C.MPAM2 (H) C C 31 JUL 78 (PDH) WAIT FOR 'PUNCH' TO FINISH CLOSING C 31 JAN 78 (PDH) CHANGE COMMON 'PG' FOR MULTIACCESS C 24 FEB 76 (PDH) READ UNPACKED INPUT FROM DISK C 18 FEB 76 (PDH) CLOSE PAPER TAPE PUNCH C 17 FEB 76 (PDH) REMOVE 'END= ' AND OPEN SPECIFIED FILE FOR PASS 2 C SUBROUTINE MPAM2 C+ NAM: MPAM2 VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: PASS TWO OF THE MPU CROSS-ASSEMBLER C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: C* COMMON /PG/ LUIO2,LUTT,PROGNM,EXT(3),EXTPS2 COMMON ICOMON(2),LUSI,LUOT,LLSPSP,ICSHF(152),ISIBUF(80) COMMON NB(122),LABEL(4),LABESW,IOPCOD(3),NPNAM(95) COMMON ISIMBF(43),IC,NC,ICSW,IPASS,IOPCLS,IOPIXB,IOPBIN COMMON IOPAN1,IPCT,ITERR,NRTSW,NSSCOL,NSOSCH,NAMSW,LSCM COMMON LIMA(19),LSP,LASK(8),LA,LB COMMON /A/ NOPCD(246),IOPBC2(51),IOPBC3(16) COMMON /A/ IOPBC4(116),IOPBC5(22) EQUIVALENCE (ISILN,ISIMBF(2)) DATA K0/0/,K2/2/,K3/3/ C IE=204 IPCT=0 JRLNSW=2 C*** REWIND THE SOURCE INPUT FILE CALL CLOSE (LUIO2) CALL SEEK (LUIO2,PROGNM,EXTPS2) C C*** READ IN THE NEXT SOURCE RECORD C 100 READ (LUIO2) ISIMBF,IC,NC,JRLNSW,ICSW LEVEL=1 NRTSW=1 NSOSCH=LSP IOPAN1=0 LABEL(1)=0 GO TO 120 C*** GET THE NEXT CHAR 110 CALL MPUGNC (NC) 120 GO TO (130,220,240,280),LEVEL 130 GO TO (210,160,140,200,180,150),ICSW C*** ERROR '202' LABEL OR OPCODE MUST START WITH A ALPHA CHAR 140 IE=IE-1 C*** ERROR '203' BLANK RECORD OR THE RECORD ONLY CONTAINS A LABEL 150 IE=IE-1 C*** ERROR '204' SYNTAX ERROR 160 CALL MPAERR (IE) IE=204 170 IOPBIN=0 IOPAN1=0 NRTSW=1 CALL MPAPRL(311) IPCT=IPCT+3 GO TO 100 180 IF(NC.NE.LSCM) GO TO 160 C*** RECORD IS A COMMENT RECORD (SKIPIT) 190 CALL MPAPRL(33) GO TO 100 C*** GET THE STATEMENT'S LABEL 200 CALL MPUBNM (LABEL) 210 LEVEL=2 GO TO 110 C*** LEVEL 2 SCAN FOR START OF OPCODE FIELD 220 GO TO (110,140,140,230,140,150),ICSW C*** GET THE OPCODE 230 CALL MPUBNM (IOPCOD) IF(ICSW.NE.1) GO TO 160 CALL MPAFOP IF(IOPCLS.EQ.2) GO TO 300 LEVEL=3 C*** LEVEL 3 SCAN FOR 'A ' OR 'B ' 240 GO TO (110,290,290,250,280,290),ICSW 250 IF(NC.NE.LA.AND.NC.NE.LB) GO TO 290 JC=NC CALL MPUGNC(NC) IF(ICSW.EQ.1) GO TO 260 IC=IC-2 CALL MPUGNC(NC) GO TO 270 C*** OPCODE IS 'CCC X ' WHERE: X= A OR B 260 IOPCOD(2)=IOPCOD(2)-LSP+JC CALL MPAFOP IF(IOPCLS.EQ.2) GO TO 300 270 LEVEL=4 C*** LEVEL 4 SCAN TO THE START OF THE OPERAND 280 GO TO (110,290,290,290,290,290),ICSW 290 NRTSW=3 300 NSSCOL=IC IF(LABEL(1).EQ.0.OR.IOPCLS.EQ.1) GO TO 310 CALL MPAFSY (LABEL,J,I) IF(LABEL(4).EQ.IPCT) GO TO 310 C*** ERROR '220' PHASING ERROR CALL MPAERR (220) IPCT=LABEL(4) 310 GO TO (320,370,380,390,480),IOPCLS C C*** DIRECTIVE OPCODES C C*** ASSEMBLER CLASS 1 320 IF(IOPIXB.GT.4) GO TO 360 GO TO (330,190,340,340),IOPIXB C*** ERROR '207' UNDEFINED OPCODE 330 CALL MPAERR (207) GO TO 170 C*** 'END' OPCODE 340 CALL MPAPRL(33) C*** OUTPUT THE LAST P.T. RECORD CALL MPUPTS (K3,K0,K0) C C HAVE TO INCLUDE FILE NAME, EXTENSION, TO BE ABLE TO USE 'IEV' C CALL CLOSE (LUOT,PROGNM,EXT(3),IEV) CALL WAITFR (IEV) RETURN C*** GO TO THE DIRECTIVE OPCODE PROCCESSOR 360 CALL MPAPSC GO TO 100 C C*** 1 BYTE INSTURCTIONS C C*** ASSEMBLER CLASS 2 370 IOPBIN=IOPBC2(IOPIXB) NRTSW=2 CALL MPAPRL(295) IPCT=IPCT+1 GO TO 100 C C*** 2 BYTE RELATIVE INSTRUCTIONS C C*** ASSEMBLER CLASS 3 380 IOPBIN=IOPBC3(IOPIXB) CALL MPAOPR (IOPAN1,JOPRSW) C*** ERROR '208' RELATIVE BRANCH OUT OF RANGE IF(IOPAN1.LT.(IPCT-125).OR.IOPAN1.GT.(IPCT+129)) CALL MPAERR (208) CALL MPUADR (IOPAN1,K2,IPCT,JSW) CALL MPUADR (IOPAN1,K2,K2,JSW) CALL MPAPRL(303) IPCT=IPCT+2 GO TO 100 C C*** 2 OR 3 BYTE INSTRUCTIONS C C*** ASSEMBLER CLASS 4 390 CALL MPAGAM (IAMOD,JOPRSW) IF(JOPRSW.GT.4) GO TO 160 IOPIXB=IOPIXB*4-4+IAMOD IOPBIN=IOPBC4(IOPIXB) IF(IOPBIN.GE.0) GO TO (410,420,450,460),IAMOD C*** ERROR '209' ILLEGAL ADDRESS MODE 400 CALL MPAERR (209) IOPBIN=0 GO TO 470 C*** DIRECT ADDRESS MODE C*** CHANGE MODE FOR 'JMP' AND 'JSR' TO EXTENDED 410 IF(IOPIXB.EQ.21.OR.IOPIXB.EQ.25) GO TO 460 GO TO 430 C*** INDEXED ADDRESS MODE 420 CONTINUE 430 IF(JOPRSW.EQ.1) GO TO 440 C*** ERROR '210' BYTE OVERFLOW (> 256) CALL MPAERR (210) IOPAN1=255 440 CALL MPAPRL(303) IPCT=IPCT+2 GO TO 100 C*** IMMEDIATE ADDRESS MODE 450 IF(IOPIXB.LT.13) GO TO 470 GO TO 430 C*** EXTENDED ADDRESS MODE 460 CONTINUE 470 CONTINUE CALL MPAPRL(311) IPCT=IPCT+3 GO TO 100 C C*** 2 OR 3 BYTE INSTRUCTIONS (INDEXED OR EXTENDED MODE ONLY) C C*** ASSEMBLER CLASS 5 480 IOPIXB=IOPIXB*2-1 CALL MPAGAM (IAMOD,JOPRSW) IF(JOPRSW.GT.4) GO TO 160 GO TO (500,490,400,500),IAMOD 490 IOPBIN=IOPBC5(IOPIXB) GO TO 430 500 IOPBIN=IOPBC5(IOPIXB+1) GO TO 470 END [\]. I@@@@@SRC C.MPAM3 (I) C C 7 MAR 78 (PDH) KEEP SYMBOL TABLE UNDER 80 COLUMNS C SUBROUTINE MPAM3 C+ NAM: MPAM3 VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: PASS THREE OF THE MPU CROSS-ASSEMBLER C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: PRINT THE SYMBOL TABLE C* INTEGER JLDF(3) COMMON ICOMON,LULT,LUSI(3),ICSHF,IA2SHF(19),KCFF,KC7F7F COMMON KCFFFF(210),NB(121),INX,LABEL(12),IPGLOL,IPGLEN COMMON NPLCT,IOTBUF(84),NAM(4),ISIMBF(52),ITERR,NRTSW(12) COMMON NOPT(2),NOPC(5),IXBASE,LSPSP(4),LSP,LASK(20),NOSYM COMMON ISYM(813) EQUIVALENCE (NOPBAS,NOPT(1)),(NOPLI,NOPT(2)) DATA JLDF(1)/6/,JLDF(2)/5/,JLDF(3)/4/ IF(NOPLI.EQ.1.OR.NOSYM.LT.4) GO TO 150 JLF=JLDF(IXBASE) NL = MIN0 (IPGLOL,72)/(JLF+9) IF(NPLCT.LT.10) GO TO 100 IF(NOSYM/NL+NPLCT+10.GT.IPGLEN) CALL MPAPAG(0) 100 WRITE (LULT,101) WRITE (LULT,101) 101 FORMAT (1H ) WRITE (LULT,105) 105 FORMAT (13H SYMBOL TABLE) WRITE (LULT,101) WRITE (LULT,101) CALL MPAPAG (5) N=3 110 L=0 INX=0 120 N=N+1 J=N*4-3 NAM(1)=IAND(KC7F7F,ISYM(J)) NAM(2)=ISYM(J+1) NAM(3)=ISYM(J+2) NAM(4)=ISYM(J+3) CALL MPUSNC(LSP) DO 130 I=1,3 J=NAM(I)/ICSHF CALL MPUSNC(J) J=IAND(KCFF,NAM(I)) CALL MPUSNC(J) 130 CONTINUE CALL MPUSNC(LSP) CALL MPUCNA (NAM(4),NOPBAS,JLF) CALL MPUSNC(LSP) L=L+1 IF(N.GE.NOSYM) GO TO 140 IF(L.LT.NL) GO TO 120 140 CALL MPAPA1 (2,NB,INX) CALL MPAPAG (1) IF(N.LT.NOSYM) GO TO 110 150 IF(ITERR.EQ.0) GO TO 165 WRITE (LULT,101) WRITE (LULT,101) WRITE (LULT,160) ITERR 160 FORMAT (13H TOTAL ERRORS,I4) C C CLOSE LISTING DEVICE C 165 CALL CLOSE (LULT) RETURN END [\]. J@@@@@SRC C.MPAOPR (J) SUBROUTINE MPAOPR (JV,JSW) C+ NAM: MPAOPR VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: FORM THE OPERAND'S VALUE C C SYS: M68SAM C C ENT: JV - N/A C JSW - N/A C C RTN: JV - VAULE OF THE OPERAND C JSW - OPERAND VAULE STATUS: C - 1=> 8 BIT VAULE C - 2=> 16 BIT VAULE C - 3=> VALUE OVERFLOWED 16 BITS C - 4=> UNDEFINED SYMBOLS IN THE OPERAND FIELD C - 5=> SYNTAX ERROR IN THE FILED C C FNC: THE ROUTINE SCANS TO THE START OF THE OPERAND FIELD C AND THEN FORMS THE VALUE OF THE OPERAND BY THE C OPERATIONAL SIGNS IN THE FIELD. OPERATIONS ARE C PERFORMED IN A LEFT TO RIGHT SCAN. C* COMMON ICOMON(458),NAM(4),ISIMBF(44),NC,ICSW,IPASS COMMON IOPCLS(4),IPCT,ITERR(8),LSBH,LSBO,LSBB,LSPCT,LSASC COMMON NOPT(13),LASK,LPOS,LCOMA,LMNS,LSLASH JV=0 NS=1 JSW=1 LEVS=1 JBRSW=2 GO TO 110 100 CALL MPUGNC (NC) 110 GO TO (120,150,160),LEVS C*** * * * ' ' ',' 0-9 A-Z SPE 120 GO TO (170,175,280,180,190,170),ICSW C*** SYNTAX ERROR 130 JSW=5 140 LEVS=2 150 GO TO (170,170,100,100,100,170),ICSW 160 GO TO (170,170,130,130,190,170),ICSW C*** END OF THE OPERAND 170 IF(JBRSW.EQ.2.AND.JSW.EQ.1) JSW=5 175 RETURN C*** BUILD SYMBOL AND LOOK IT UP IN THE SYMBOL TABLE 180 CALL MPUBNM (NAM) CALL MPAFSY (NAM,I,J) N=NAM(4) JBRSW=1 C*** ERROR '222' A ERROR IN THE SYMBOL (SYMBOL WAS REDEFINED C*** OR A SYNTAX ERROR IN A 'EQU') IF(IPASS.EQ.2.AND.I.EQ.2) CALL MPAERR (222) IF(I.LT.3) GO TO 300 C*** ERROR '211' UNDEFINED SYMBOL IF(IPASS.EQ.2) CALL MPAERR (211) JSW=4 GO TO 140 C*** SPECIAL CHARACTER 190 IF(NS.EQ.0) GO TO 200 C*** A SIGN HAS BEEN DEFINED IF(NC.NE.LSPCT) GO TO 200 C*** USE CURRENT P COUNTER N=IPCT GO TO 260 200 IF(NC.EQ.LPOS) GO TO 230 IF(NS.GT.1) GO TO 250 IF(NC.EQ.LMNS) GO TO 220 IF(NC.EQ.LASK) GO TO 210 IF(NC.NE.LSLASH) GO TO 250 C*** OPERATION SIGN CHARACTER NS=4 GO TO 240 210 NS=3 GO TO 240 220 NS=2 GO TO 240 230 NS=1 240 LEVS=1 GO TO 100 250 IF(NC.NE.LSASC) GO TO 270 C*** ASCII CHARACTER CALL MPUGNC(N) 260 CALL MPUGNC(NC) GO TO 290 270 IF(NC.NE.LSBH.AND.NC.NE.LSBO.AND.NC.NE.LSBB) GO TO 130 280 CALL MPUFNO(N,I) IF(I.EQ.2) GO TO 130 290 JBRSW=1 C*** END OF FIELD 300 IF(NS.EQ.0) GO TO 130 CALL MPUADR (JV,NS,N,JSW) IF(JSW.GT.2) GO TO 140 NS=0 LEVS=3 GO TO 110 END [\]. K@@@@@SRC C.MPAOPT (K) SUBROUTINE MPAOPT C+ NAM: MPAOPT VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: CROSS-ASSMEBLER OPTION DIRECTIVE SCAN ROUTINE C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: SCAN THE 'OPT' OPERAND FIELD AN SET THE REQUESTED C OPTIONS FOUND 1=> NO, 2=>YES. C* INTEGER JPT(3) COMMON ICOMON(5),ICSHF,IA2SHF(452),NAM(4),ISIMBF(44),NC COMMON ICSW,IPASS(19),NOPT(2),NOPC(4),NOPCL,IXBASE,LSPSP COMMON L8SP,L10,L16,LSP(14),LN,LO EQUIVALENCE (N1,NAM(1)),(N2,NAM(2)),(N3,NAM(3)) EQUIVALENCE (NOPBAS,NOPT(1)) DATA KC1000/4096/,KC800/2048/ 100 IANS=2 IF(NC.NE.LN) GO TO 110 C*** 'N' OR 'NO' => TURN THE OPTION OFF IANS=1 CALL MPUGNC(NC) IF(NC.EQ.LO) CALL MPUGNC(NC) 110 CALL MPUBNM(NAM) C*** LOOK-UP THE OPTION DO 120I=1,NOPCL,2 IF(N1.EQ.NOPC(I).AND.N2.EQ.NOPC(I+1)) GO TO 180 120 CONTINUE N=N1/ICSHF DO 130I=1,NOPCL,2 IF(N.EQ.NOPC(I)/ICSHF) GO TO 180 130 CONTINUE C*** ERROR '217' UNDEFINED OPTION OR SYNTAX IN OPTION FORMAT 140 CALL MPAERR (217) 150 GO TO (170,160,165,100,165,170),ICSW C*** SKIP TO START OF THE NEXT FIELD 160 CALL MPUGNC(NC) GO TO 150 165 CALL MPUGNC (NC) GO TO 140 180 NOPCMD=I/2+1 IF(NOPCMD.EQ.1) GO TO 190 NOPT(NOPCMD)=IANS GO TO 150 C*** CHANGE DISPLAY NUMBER BASE 190 N=N2 IF(N3.NE.LSPSP) N=N3 I=8 IF(N.EQ.L8SP) GO TO 210 IF(N.EQ.L10) GO TO 200 IF(N.NE.L16) GO TO 140 I=I+6 200 I=I+2 210 NOPBAS=I IXBASE=I/5 GO TO 150 170 RETURN END [\]. L@@@@@SRC C.MPAPAG (L) C C 27 JUL 76 (PDH) RE-DO THE INITIALIZATION FOR RSX C 2 MAR 76 (PDH) TIDY UP INITIALIZATION AND LINE COUNTING C 18 FEB 76 (PDH) CHANGE 'JPVFCC' TO 'PVFCC' C SUBROUTINE MPAPAG (JNL) C+ NAM: MPAPAG VER: 1.1 DAT: 04-18-75 CMP: ALL C C SYS: M68SAM C C ENT: JNL - 0 GO TO TOP OF PAGE C - >0 NUMBER OF LINES PRINTED C C RTN: JNL - N/C C C FNC: COUNT EACH LINE PRINTED AND GO TO TOP OF THE C PAGE EACH TIME WHEN THE PAGE OVERFLOWS. C C REV: N/A C* INTEGER INAME(6) REAL PNAME(3) COMMON ICOMON,LULT,LUSI(365),NPNAM(3),NPGNO,IPGLOL,IPGLEN COMMON NPLCT,IOTBUF(153),NOPT(2) EQUIVALENCE (NOPLI,NOPT(2)) EQUIVALENCE (INAME(1),PNAME(1)) DATA PVFCC/1H1/ C IF(NOPLI.EQ.1) RETURN IF (JNL) 240,250,230 230 NPLCT=NPLCT+JNL IF (NPLCT-IPGLEN) 280,280,250 C C INITIALIZE HEADER ON PAGE 1 C 240 NPGNO = 0 C C*** PAGE OVERFLOW, GO TO TOP OF THE NEXT PAGE C 250 NPGNO=NPGNO+1 DO 251 I=1,3 K = I*2 - 1 INAME(K) = NPNAM(I) 251 CONTINUE WRITE (LULT,299) PVFCC,PNAME,NPGNO 260 DO 270 I=1,3 WRITE (LULT,298) 270 CONTINUE NPLCT=4 280 RETURN 298 FORMAT (1H ) 299 FORMAT (A2,3A2,9X,30HMOTOROLA M6800 CROSS-ASSEMBLER,9X,4HPAGE,I3) END [\]. M68...002 .TITLE M68... / / 9 MAR 78 (002; PDH) FORGOT THE LITERAL AFTER 'GC4' / 31 JAN 78 - PAUL HENDERSON / / MAINLINE FOR THE MOTOROLA CROSS ASSEMBLER. THIS MAINLINE IS / NECESARY IF THE CROSS ASSEMBLER IS TO BE USED AS A TDV FUNCTION. / UNDER MULTIACCESS, THIS IS THE ONLY PRACTICAL WAY TO PROCEED. / THIS HAS SIMILAR INVOCATION AND LUN USAGE TO THE PDP-15 ASSEMBLER. / AT PRESENT THE LUN'S HAVE THE FOLLOWING USE: / / 13 - ERROR MESSAGES / 15 - SOURCE FILE INPUT FOR PASS 1 / 16 - LISTING OUTPUT / 17 - OBJECT FILE OUTPUT / 18 - INTERNAL CODE OUTPUT ON PASS 1 FOR INPUT AT PASS 2 / / COMMAND STRING: / / M89 O_NAME1,NAME2, . . . / / WHERE 'O' IS PRESENTLY NOT RECOGNIZED, BUT WOULD BE 'B' &/OR 'L'. / NAME1,NAME2 ARE FILE NAMES OF THE PROGRAMS TO BE ASSEMBLED. / THE FILE NAMES MAY BE ONLY 5 CHARACTERS MAXIMUM, AND / THE EXTENSION MUST BE 'SRC' / IDX=ISZ / .GLOBL M6800,PACK / .EJECT M68... CAL XFRCMD / GET COMMAND LINE CAL WAITFR LAC (CMDLIN+2 DAC CHPNT / SET UP THE CHARACTER GETTER LAC (G1 DAC DSPCH / GC1 JMS GETCHR / FLUSH COMMAND STRING THROUGH SAD (40 / FIRST SPACE JMP GC2 JMP GC1 / GC2 JMS GETCHR / NOW FLUSH EXTRA SPACES SAD (40 JMP GC2 / / AT THIS POINT ONE WOULD CHECK FOR OPTIONS. THE PRESENT IMPLEMENTATION / ALWAYS GENERATES 'B,L,S'. THE DELIMITER '_' IS REQUIRED. / SAD (137 / '_' OPTION DELIMITER? JMP GC3 JMP GC2 / FLUSH CHARACTERS BEFORE DELIMITER / .EJECT GC3 CLX LAC (5 PAL DZM NAME,X / CLEAR FILE NAME BUFFER AXS 1 JMP .-2 LAW -1 / WE SET XR TO -1 BECAUSE WE PAX / 'AXS' BEFORE WE 'DAC NAME,X'. / GC4 JMS GETCHR / GET CHARACTERS AND CHECK FOR SAD (54 / COMMA CLA SAD (15 / CARRIAGE RETURN /(002) LAW -1 SAD (175 / AND ALT MODE LAW -1 DAC EXITFL / SAVE FOR LATER CHECK SPA!SNA / SPA&SNA JMP GOTNAM / NEGATIVE OR ZERO MEANS END OF FILE NAME AXS 1 DAC NAME,X / STORE ONLY FIRST 5 CHARACTERS JMP GC4 / GOTNAM LAC (NAME DAC PCK+1 / SET UP THE 'PACK' ROUTINE DAC PCK+2 PCK JMS* PACK / PACK UP THE FILE NAME 0; 0 JMS* M6800 / GO AND ASSEMBLE THE JMP .+2 NAME / SPECIFIED FILE. LAC EXITFL / DO WE HAVE MORE FILE TO ASSEMBLE? SMA JMP GC3 / YES. GO AND DO IT. CAL (10 / NO. EXIT THE TASK. / .EJECT / THIS ROUTINE WAS WRITTEN TO EXTRACT CHARACTERS FROM THE COMMAND / LINE. IT WAS WRITTEN SO THAT NO ASSUMPTIONS ARE MADE ABOUT THE CONTENTS / OF THE MQ, BECAUSE WE DO NOT KNOW WHEN THE END OF FILE NAME WILL / BE ENCOUNTERED, AND THIS ROUTINE MUST BE READY TO PICK UP THE / CHARACTER GETTING AT ANY POINT. / GETCHR XX JMP* DSPCH / DSPCH G1 AND (177 / TRIM TO 7-BITS AND JMP* GETCHR / LEAVE WITH CHARACTER IN AC / G1 LAC* CHPNT / 1ST CHARACTER LRS 13 JMS DSPCH G2 LAC* CHPNT LRS 4 JMS DSPCH G3 LAC* CHPNT IDX CHPNT DAC DSPCH / TEMPORARILY SAVE 1ST HALF LAC* CHPNT LMQ / 2ND HALF GOES IN MQ LAC DSPCH LLS 3 JMS DSPCH G4 LAC* CHPNT LRS 10 JMS DSPCH G5 LAC* CHPNT IDX CHPNT RAR JMS DSPCH JMP G1 / NAME .BLOCK 5 CMDLIN .BLOCK 42; .ASCII <15>; .LOC .-1 EV;CHPNT;EXITFL XFRCMD 37; EV; CMDLIN; 42 WAITFR 20; EV .END M68... [\]. M6809@015 .TITLE M6809 / / 21 MAR 78 (015; PDH) MUST WAIT AFTER 'HINF' IN SUBROUTINE 'READ' / 17 MAR 78 (014; PDH) ERROR MESSAGES IN 'READ' GO TO LUN 13 / 11 MAR 78 (013; PDH) ADD ENTRY POINT 'RSREAD' FOR MULTIPLE ASEMBLIES. / 6 MAR 78 (011; PDH) MAKE SURE CHECKSUM WORD IN 'PCHBUF' IS ZERO / 31 JAN 78 (010; PDH) MAKE CHANGES IN 'READ' FOR MULTIACCESS / 7 OCT 76 (009; PDH) THROW AWAY LINE FEEDS IN SUBROUTINE READ / 26 JUL 76 (007: PDH) CONDITIONALIZE FOR RSX / 1 JUN 76 (006: PDH) ADD CONDITIONAL ASSEMBLY FOR DOS / 24 FEB 76 (PDH) ADD SUBROUTINE 'READ' FOR CARD INPUT / 19 FEB 76 (PDH) ADD NEW ROUTINE 'PNCHR1' FOR PAPER TAPE / 18 FEB 76 (PDH) RETRO-FIT TO DEC FORTRAN / 13 FEB 76 (PDH) INCLUDE 'MPUBSM', 'MPUCA1', 'MPUCA2', 'MPUCVC', / 'MPUNEG', 'MPUOVF', 'MPUXBS', 'MPUXBY' / 12 FEB 76 - PAUL HENDERSON: 'IAND' / / THIS PACKAGE IS A GROUP OF SUPPORTING ROUTINES FOR / THE PROGRAM 'M6800', THE CROSS-ASSEMBLER FOR THE M6800 / MICRO-PROCESSOR. THESE ROUTINES ARE INTENDED TO REPLACE / SELECTED SUBROUTINES AND FUNCTIONS IN AN EFFORT TO INCREASE / THE SPEED OF THE CROSS-ASSEMBLER. / / TO ASSEMBLE FOR DEC FORTRAN, THE SYMBOL 'F4=1' MUST BE DEFINED. / TO ASSEMBLE FOR DEC FORTRAN ON THE PDP-15, THE SYMBOL / 'DOS=1' MUST BE DEFINED.L TO ASSEMBLE FOR USE UNDER RSX, / THE SYMBOL / RSX=1 / MUST BE DEFINED. THIS AUTOMATICALLY / / DEFINES 'DOS' AND 'F4'. / IDX=ISZ / INDEX POINTER, SKIP NOT INTENDED SET=ISZ / SET A FLAG TO A NON-ZERO VALUE / .EJECT / GLOBALS AND COMMON ROUTINES: / .IFDEF RSX DOS=1 .ENDC .IFDEF DOS F4=1 .ENDC .IFUND F4 .GLOBL .ARG,.INT1,.INT2,.MODEA / .DEFIN PUTINT JMS SETINT .ENDM / / THE FOLLOWING IS A SUBROUTINE COMMON TO ALL INTEGER FUNCTIONS / TO SET THE INTEGER ACCUMULATOR. / SETINT XX DZM* .INT1 / ZERO MOST SIGNIFICANT WORD DAC* .INT2 / RETURN THE VALUE TO LEAST SIGNIFICANT DZM* .MODEA / INDICATE MODE OF RESULT IS INTEGER JMP* SETINT .ENDC / .IFDEF F4 .GLOBL .DA .ARG=.DA / .DEFIN PUTINT .ENDM / ASSEMBLES NOTHING .ENDC / .TITLE FUNCTION IAND (A,B) / / FUNCTION TO PERFORM THE LOGICAL 'AND' OPERATION BETWEEN / THE TWO ARGUMENTS. / / CALLING SEQUENCE: / / INTEGER A,B,C / - - - / C = IAND (A,B) / - - - / .GLOBL IAND / IAND XX JMS* .ARG JMP .+3 A B LAC* A AND* B PUTINT / STORE RESULT IN INTEGER ACCUMULATOR JMP* IAND / .TITLE FUNCTION MPUBSM (JWD,JSB,JMK) / / FUNCTION TO SHIFT AND MASK BITS. THE ORIGINAL FORTRAN CODING / CALLED FUNCTION 'MPUXBS', BUT THIS IMPLEMENTATION USES ITS OWN / ABBREVIATED VERSION OF 'MPUXBS'. / .GLOBL MPUBSM / MPUBSM XX JMS* .ARG JMP .+4 JWD JSB JMK LAW -1 TAD* JSB AND (77 XOR (LRSS / BUILD SHIFT INSTRUCTION OF CORRECT VALUE DAC SHIFT2 LAC* JWD / GET WORD TO BE SHIFTED SHIFT2 XX / SHIFT IT. AND* JMK PUTINT / RETURN THE VALUE JMP* MPUBSM / .TITLE SUBROUTINE MPUCA1 (JLST,JN) / / SUBROUTINE TO CONVERT AN ARRAY FROM THE INTERNAL R1 FORMAT / TO A1 FORMAT. / / ENT: JLST - ARRAY IN R1 FORMAT TO BE CONVERTED / JN - NUMBER OF WORDS TO BE CONVERTED / / RTN: JLST - ARRAY CONVERTED TO A1 FORMAT / JN - N/C / .GLOBL MPUCA1 / MPUCA1 XX JMS* .ARG JMP .+3 JLST JN LAW -1 TAD* JN CMA DAC JN / HANDY PLACE TO USE AS A COUNTER .IFUND DOS .IFDEF F4 LAC* JLST / MUST FETCH DOUBLE INDIRECT DAC JLST .ENDC .ENDC CA1L LAC* JLST / GET WORD IN 'R1' ALSS 13 / CONVERT TO 'A1' DAC* JLST / REPLACE IN ARRAY IDX JLST / POINT TO NEXT WORD ISZ JN JMP CA1L JMP* MPUCA1 / .TITLE SUBROUTINE MPUCA2 (JLST2,JN2) / / SUBROUTINE TO CONVERT AN ARRAY FROM THE INTERNAL R2 FORMAT / TO A2 FORMAT. / / ENT: JLST2 - ARRAY IN R2 TO BE CONVERTED / JN2 - NUMBER OF WORDS TO BE CONVERTED / / RTN: JLST2 - ARRAY CONVERTED TO A2 FORMAT / JN2 - N/C / .GLOBL MPUCA2 / MPUCA2 XX JMS* .ARG JMP .+3 JLST2 JN2 LAW -1 TAD* JN2 CMA DAC JN2 .IFUND DOS .IFDEF F4 LAC* JLST2 / MUST FETCH DOUBLE INDIRECT FOR F4 DAC JLST2 .ENDC .ENDC CA2L LAC* JLST2 / GET WORD IN 'R2' LMQ LLSS 13 RCR / NOW HAVE 7-BIT ASCII IN AC11 - MQ6 LLSS 13 / CONVERT TO 'A2' DAC* JLST2 / REPLACE IN ARRAY IDX JLST2 ISZ JN2 JMP CA2L JMP* MPUCA2 / .TITLE SUBROUTINE MPUCVC (JW,JC) / / SUBROUTINE TO CONVERT A SINGLE CHARACTER / FROM A1 TO R1 FORMAT / / ENT: JW - WORD IN A1 FORMAT / JC - N/A / / RTN: JW - N/C / JC - CHARACTER CONVERTED TO R1 FORMAT / .GLOBL MPUCVC / MPUCVC XX JMS* .ARG JMP .+3 JW JC LAC* JW / GET 'A1' CHARACTER CLL LRS 13 / CONVERT TO 'R1' DAC* JC / RETURN TO CALLER JMP* MPUCVC / .TITLE SUBROUTINE MPUNEG (JNBR) / / SUBROUTINE TO CONVERT A NUMBER TO ITS 2'S COMPLEMENT, 16 BIT FORM, / IF IT IS NEGATIVE. / .GLOBL MPUNEG / MPUNEG XX JMS* .ARG JMP .+2 JNBR LAC* JNBR SMA JMP* MPUNEG / RETURN IF POSITIVE .DEC TAD (65536 .OCT DAC* JNBR JMP* MPUNEG / .TITLE SUBROUTINE MPUOVF (JNBRO,JOVF) / / SUBROUTINE TO TEST FOR OVERFLOW IN 16-BIT NUMBER, AND / TRUNCATE TO 16-BIT RESULT, IF OVERFLOW. / / ENT: JNBRO - NUMBER TO BE TESTED FOR OVERFLOW / JOVF - FUNCTION TO PERFORM / 1 - RESET OVERFLOW INDICATOR / 2,3, ETC - TEST FOR OVERFLOW / / RTN: JNBRO - NUMBER, ADJUSTED TO 16-BIT REPRESENTATION, IF NECESSARY / JOVF - 0: NO OVERFLOW / 1: OVERFLOW / .GLOBL MPUOVF / MPUOVF XX JMS* .ARG JMP .+3 JNBRO JOVF LAC* JOVF / GET FUNCTION CODE DZM* JOVF SAD (1 / IS IT THE 'RESET' FUNCTION? JMP* MPUOVF / YES. / LAC* JNBRO / GET NUMBER TO BE TESTED SPA JMP TSTNEG / NEGATIVE NUMBERS GET SPECIAL ATTENTION AND (600000 SNA / TEST FOR OVERFLOWED BITS JMP* MPUOVF / NO OVERFLOW IDX* JOVF / SET OVERFLOW INDICATOR LAC* JNBRO AND (17777 / CHOP TO 16 BITS DAC* JNBRO JMP* MPUOVF / TSTNEG CMA TAD (1 DAC JWORD / SAVE POSITIVE VALUE AND (600000 SNA / TEST FOR OVERFLOWED BITS JMP* MPUOVF IDX* JOVF / SET OVERFLOW INDICATOR LAC JWORD / RETRIEVE NUMBER AND (17777 CMA TAD (1 DAC* JNBRO / RETURN ADJUSTED VALUE JMP* MPUOVF / .TITLE FUNCTION MPUXBS (JWORD,JMSB,JLSB) / / FUNCTION TO EXTRACT A BIT STRING FROM A SPECIFIED WORD. / THE RESULTING BIT STRING IS RIGHT-ADJUSTED. / / ENT: JWORD - WORD FROM WHICH TO EXTRACT BIT STRING / JMSB - BIT NUMBER OF MSB / JLSB - BIT NUMBER OF LSB / / RTN: JWORD - N/C / JMSB - N/C / JLSB - N/C / / NOTE: BIT 16 (OR 18) IS MSB. BIT 1 IS LSB. / .GLOBL MPUXBS / MPUXBS XX JMS* .ARG JMP .+4 JWORD JMSB JLSB LAW -1 TAD* JLSB AND (77 / IN CASE CALLER IS INCORRECT XOR (LRSS / DETERMINE HOW FAR TO SHIFT 'JWORD' DAC SHIFT LAW -2 TAD* JLSB CMA TAD* JMSB / THIS DETERMINES HOW MANY BITS IN THE AND (77 / MASK TO BE APPLIED AFTER THE SHIFT XOR (LLSS DAC MASK CLQ!CMQ!1000 / CLEAR AC, SET MQ=-1 MASK XX / SHIFT IN PROPER NUMBER OF MASK BITS DAC MASK / SAVE MASK LAC* JWORD / GET WORD FROM WHICH WE ARE TO SHIFT XX / EXTRACT THE BIT STRING AND MASK / SELECT ONLY DESIRED PORTION PUTINT / RETURN THE RESULT JMP* MPUXBS / .TITLE SUBROUTINE MPUXBY (JWRDBY,JBYTE1,JBYTE2) / / SUBROUTINE TO EXTRACT UPPER AND LOWER BYTES FROM A WORD / / ENT: JWRDBY - WORD FROM WHICH BYTES ARE TO BE EXTRACTED / JBYTE1 - N/A / JBYTE2 - N/A / / RTN: JWRDBY - N/C / JBYTE1 - UPPER BYTE OF 'JWRDBY' (RIGHT ADJUSTED) / JBYTE2 - LOWER BYTE OF 'JWRDBY' (RIGHT ADJUSTED) / .GLOBL MPUXBY / MPUXBY XX JMS* .ARG JMP .+4 JWRDBY JBYTE1 JBYTE2 LAC* JWRDBY LRSS 10 / MOVE UPPER BYTE TO AC 10-17 DAC* JBYTE1 LLSS!1000 10 / CLEAR UPPER BYTE AND SHIFT LOWER BYTE BACK DAC* JBYTE2 JMP* MPUXBY / .TITLE SUBROUTINE PNCHR1 (LUOT,IOTBUF,IOTINX) / / SUBROUTINE TO PUNCH AABUFFER PRESENTLY STORED IN 'R1' FORMAT. THIS / IS THE SAME AS IMAGE ASCII MODE. / / ENT: LUOT - LOGICAL UNIT (.DAT) FOR PUNCH / IOTBUF - INTEGER ARRAY CONTAINING THE ASCII IN 'R1' / IOTINX - NUMBER OF CHARACTERS IN ARRAY / / RTN: LUOT - N/C / IOTBUF - MAY HAVE <15> AFTER THE "IOTINX'TH" CHARACTER / IOTINX - N/C / / COMMENT: BECAUSE THE COMMON AREAS ARE ARRANGED IN THE CALLING / PROGRAM SO THAT 'IOTINX' IMMEDIATELY FOLLOWS 'IOTBUF(80)', IT / IS POSSIBLE THAT THE APPENDED CARRIAGE RETURN WILL FALL / ON 'IOTINX'. FOR THIS REASON, 'IOTINX' WILL BE SAVED AND / RESTORED AFTER THE ARRAY IS PACKED UP INTO 5/7 ASCII. / .GLOBL PNCHR1,PACK / PNCHR1 XX JMS* .ARG JMP .+4 LUOT IOTBUF IOTINX LAC* LUOT / GET .DAT SLOT NUMBER .IFUND RSX DAC WAITPP / ' .WAIT LUOT' XOR (2000 .ENDC DAC WRPP / ' .WRITE LUOT,2, . , . .IFUND DOS .IFDEF F4 LAC* IOTBUF DAC IOTBUF / DOUBLE INDIRECT FOR DEC FORTRAN .ENDC .ENDC LAC* IOTINX DAC LUOT / SAVE VALUE FOR LATER RESTORATION TAD IOTBUF DAC JWORD / POINTS TO 'IOTBUF(IOTINX+1)' LAW 15 DAC* JWORD / APPEND CARRIAGE RETURN TO END OF LINE LAC IOTBUF DAC PCK+1 / FIX UP POINTERS FOR 'PACK' LAC (PCHBUF+2 DAC PCK+2 / .EJECT .IFDEF RSX CAL WTP / WAIT IN CASE I/O STILL UNDERWAY .ENDC .IFUND RSX WAITPP .WAIT 0 / IN CASE PREVIOUS I/O STILL UNDERWAY .ENDC PCK JMS* PACK 0; 0 SMA!CLC JMP PCK TAD (PCHBUF /(012) CMA /(012) TAD PCK+2 ALSS 10 / WORD PAIR COUNT FOR HEADER XOR (2 / IOPS ASCII DAC PCHBUF .IFDEF RSX CAL WRITEP .ENDC .IFUND RSX WRPP .WRITE 0,2,PCHBUF,0 .ENDC LAC LUOT DAC* IOTINX / RESTORE 'IOTINX' IN CASE OF CLOBBER JMP* PNCHR1 / PCHBUF 0; 0; .LOC PCHBUF / CHECKSUM WORD MUST BE ZERO /(011) .BLOCK 120/5*2+4 / .IFDEF RSX EVPP 1 / INITIALLY 1 SO THE 1ST WAIT FALLS THROUGH WTP 20; EVPP / CPB FOR WAIT ON PUNCH WRITEP 2700; EVPP;WRPP; 2; PCHBUF .ENDC .TITLE RSREAD /(013) / / SUBROUTINE TO RESET THE 'READ' ROUTINE SO THAT MULTIPLE ASSEMBLIES / FROM THE SAME TDV COMMAND STRING CAN BE PROCESSED. WITHOUT SOME / MEANS OF RESETTING THE ROUTINE, ONLY THE STRING ' END' WILL BE / RETURNED AFTER THE FIRST ASSEMBLY. THIS IS CONSIDERED TO BE / SOMEWHAT LESS THAN DESIREABLE. / .GLOBL RSREAD / RSREAD XX /(013) LAC (NOP /(013) DAC SETUP / ENABLE THE SETUP SECTION /(013) JMP* RSREAD /(013) .TITLE SUBROUTINE READ (ISIBUF,LUSI) / / SUBROUTINE TO DOUBLE BUFFER THE SOURCE INPUT. WHEN END OF FILE / IS ENCOUNTERED, THE STRING ' END' IS RETURNED TO THE CROSS / ASSEMBLER. / / ENT: ISIBUF - N/A / LUSI - FIRST TIME ONLY, SET UP '.INIT', ETC / - AFTER FIRST TIME, N/A / / RTN: ISIBUF - ARRAY OF UP TO 80 CHARACTERS IN 'A1' FORMAT / LUSI - N/C / .GLOBL READ / READ XX JMS* .ARG JMP SETUP ISIBUF LUSI SETUP NOP /(013) LAC* LUSI / GET .DAT NUMBER DAC INITCD / .INIT LUSI,0 DAC WAITCD / .WAIT LUSI .IFUND RSX DAC SEEKCD / .SEEK LUSI, . . . XOR (2000 DAC READC1 / .READ LUSI,2, . . . .ENDC DAC READCD .IFDEF RSX CAL HINF / FIND OUT ABOUT INPUT HANDLER CAL WAITR /(015) LAC EVCD / GET RETURNED STATUS SPA!RAL JMP HNFERR / 'HINF ERROR' SMA!RTL / IS IT AN INPUT DEVICE? JMP DEVERR / CANNOT INPUT FROM INPUT DEVICE! SMA / IS DEVICE DIRECTORIED? CAL ATTACH / NOT DIRECTORIED. ATTACH DEVICE. / READC1 CAL READC / READ 1ST CARD LAC BYPASS DAC SETUP / BYPASS SETUP AFTER 1ST TIME. BYPASS JMP WAITC / .EJECT WAITC CAL WAITR / WAIT FOR INPUT TO BE READY. .ENDC .IFUND RSX INITCD .INIT 0,0 SEEKCD .SEEK 0,NAMEIN / 'MP6800 INP' READC1 .READ 0,2,ILINE,34 / READ FIRST CARD LAC BYPASS DAC SETUP / BYPASS SETUP AFTER 1ST TIME BYPASS JMP WAITCD / WAITCD .WAIT 0 / WAIT FOR PREVIOUS INPUT TO FINISH .ENDC .IFUND DOS .IFDEF F4 LAC* ISIBUF / PERFORM DOUBLE INDIRECT FOR DEC FORTRAN DAC ISIBUF .ENDC .ENDC LAC ILINE AND (7 SAD (2 / CHECK FOR END-OF-FILE SKP JMP READ3 / END-OF-FILE EXIT LAC (ILINE+1 DAC FPOINT / POINT AT LINE JUST READ IN JMP G4 / READ2 LAC* FPOINT / GET PACKED WORD OF CHARACTERS JMP* GET2 / DISPATCH TO CORRECT SPOT / GET2 XX AND (774000 / TRIM TO 'A1' FORMAT SAD LF JMP READ2 / IGNORE LINE FEEDS SAD CR / IS IT END OF LINE JMP READ4 DAC* ISIBUF / STORE CHARACTER AWAY IDX ISIBUF JMP READ2 / .EJECT G4 IDX FPOINT / INDEX TO NEXT CHARACTER LAC* FPOINT / GET 1ST CHARACTER JMS GET2 LLS 7 / 2ND CHARACTER JMS GET2 DAC GET2 / SAVE 1ST HALF OF 3RD CHARACTER IDX FPOINT LAC* FPOINT LMQ LAC GET2 / RETRIEVE 1ST HALF LRS 4 LACQ / 3RD CHARACTER JMS GET2 LLS 3 / 4TH CHARACTER JMS GET2 LLS 12 / 5TH CHARACTER JMS GET2 JMP G4 / READ3 SET ENDFIL / SET END-OF-FILE MARKER LAC (END-1 DAC FPOINT / PREPARE TO RETURN ' END' JMP G4 / READ4 LAC ENDFIL / CHECK FOR END-OF-FILE SZA JMP* READ / DO NOT READ NEXT LINE IF END-OF-FILE .IFDEF RSX CAL READC / READ NEXT CARD .ENDC .IFUND RSX READCD .READ 0,2,ILINE,34 / READ NEXT LINE .ENDC / .EJECT JMP* READ ILINE .BLOCK 42 CR .ASCII <15> ; .LOC .-1 LF .ASCII <12> ; .LOC .-1 END .ASCII ' END'<15> .IFDEF RSX HNFERR LAC MSG1+1 / GET APPROPRIATE MESSAGE ADDRESS SKP DEVERR LAC MSG2+1 DAC ERRBP / PUT IN ERROR BUFFER POINTER CAL ERRCPB / ANNOUNCE ERROR ON MCR TERMINAL CAL ERWAIT / WAIT FOR IT TO FINISH CAL (10 / THEN EXIT. / ERRCPB 2700; EVERR; 13; 2;ERRBP /(014) ERWAIT 20; EVERR EVERR MSG1 5002; MSG1 .ASCII 'M6800: HINF ERROR'<15> MSG2 5002; MSG2 .ASCII 'M6800: CANNOT INPUT FROM INPUT DEVICE!'<15> EVCD WAITR 20; EVCD HINF 3600; EVCD;INITCD ATTACH 2400; EVCD;WAITCD READC 2600; EVCD;READCD; 2; ILINE; 42 .ENDC .IFUND RSX NAMEIN .SIXBT 'M6800@INP' .ENDC FPOINT;ENDFIL .END [\]. M@@@@@SRC C.MPAPA1 (M) SUBROUTINE MPAPA1 (JPSW,JBUF,JLEN) C+ NAM: MPAPA1 VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: PRINT BUFFER IN 'A1' FORMAT C C SYS: M68SAM C C ENT: JPSW - 1=> DONOT PRINT C - 2=> PRINT C JBUF - BUFFER TO PRINT C JLEN - MAX NUMBER OF CHARACTERS IN JBUF C C RTN: JPSW - N/C C JBUF - BUFFER CONVERTED TO COMPUTER'S A1 FORMAT C JLEN - N/C C C FNC: CONVERT THE BUFFER FROM SYSTEM'S R1 FORMAT TO C THE COMPUTER'S A1 FORMAT AND THEN PRINT ONLY C THE NON-SPACES (SKIP TRAILING BLANKS). C* INTEGER JBUF(140),IJBUF(280) COMMON ICOMON,LULT,LUSI(2),LLSPSP COMMON /DECF4/ RBUF(140) EQUIVALENCE (RBUF(1),IJBUF(1)) CALL MPUCA1 (JBUF,JLEN) DO 10 I=1,JLEN L = JLEN - I + 1 IF (JBUF(L) .NE. LLSPSP) GO TO 101 10 CONTINUE 101 DO 102 I=1,L K = I*2 - 1 IJBUF(K) = JBUF(I) 102 CONTINUE WRITE (LULT,11) (RBUF(I),I=1,L) 11 FORMAT (140A1) RETURN END [\]. MPU@@@JOB $JOB 73 T=15 UFD=RK1 $MSG ASSEMBLE, COMPILE, AND TASK BUILD MOROTOLA CROSS-ASSEMBLER $FOR BR_F,H $FOR BR_A,B,C,D,E,F,G,H,I,J,K,L,M $FOR BR_N,O,P,Q,R,S,T,U,V,W,X,Y,Z $MAC BREF_MPURSX PRM,M6809 015 $MAC ERB_M68... 002 $TKB NRM,UL:DUMMY} M68...} 350} TDV } M68...,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P, Q,R,S,T,U,V,W,X,Y,Z,M6809 } } $END [\]. MPURSXPRM RSX=1 .EOT [\]. N@@@@@SRC C.MPAPRL (N) SUBROUTINE MPAPRL (JDOSW) C+ NAM: MPAPRL VER: 1.1 DAT: 04-18-75 CMP: ALL C PGM: PRINT AND OUTPUT THE SOURCE LIST C C SYS: M68SAM C C ENT: JDOSW - PRINT AND OUTPUT FUNCTION AS BIT SETTING: C 1) 1=> LINE NUMBER C 2) 2=> P COUNTER C 3) 4=> OPCODE C 4) 8=> OPERAND 1 C 5) 16=> OPERAND 2 C 6) 32=> STATEMENT C 7) 64=> DATA BYTE 1 C 8) 128=> DATA BYTE 2 C 9) 256=> OUTPUT BINARY CODE C 10) 512=> PRINT IN PASS ONE C C RTN: JDOSW - N/C C C FNC: PRINT THE SOURCE LINE AS THE SETTING OF 'JDOSW' C AND THEN OUTPUT BINARY CODE TO THE MEMORY FILE. C* INTEGER JLDF(6),JSDF(6),JSSDF(3) COMMON ICOMON(5),ICSHF,IA2SHF(231),NB(121),INX,LABEL(5) COMMON IOPCOD(3),NPNAM(4),IPGLOL,IPGLEN(90),ISIMBF(43),IC COMMON NC,ICSW,IPASS,IOPCLS(2),IOPBIN,IOPAN1,IPCT,ITERR COMMON NRTSW,NSSCOL,NSOSCH,NAMSW(9),NOPT(2),NOPC(5) COMMON IXBASE,LSPSP(4),LSP EQUIVALENCE (ISILN,ISIMBF(2)),(NOPBAS,NOPT(1)) EQUIVALENCE (NOPLI,NOPT(2)) DATA JLDF(1)/3/,JLDF(2)/3/,JLDF(3)/2/,JLDF(4)/6/,JLDF(5)/5/ DATA JLDF(6)/4/,JSDF(1)/14/,JSDF(2)/13/,JSDF(3)/12/,JSDF(4)/18/ DATA JSDF(5)/17/,JSDF(6)/15/ DATA JSSDF(1)/25/,JSSDF(2)/23/,JSSDF(3)/20/ DATA K1/1/,K2/2/,K5/5/,K10/10/ C JPP1SW=MPUBSM(JDOSW,K10,K1) IF(JPP1SW.EQ.0.AND.IPASS.EQ.1) RETURN JDSW=JDOSW GO TO (350,100),NOPLI 100 DO 110I=1,IPGLOL NB(I)=LSP 110 CONTINUE DO 340N=1,8 I=IAND(JDSW,K1) JDSW=JDSW/2 IF (I.EQ.0) GO TO 340 I=0 K=0 J=IOPAN1 GO TO (120,130,140,160,150,200,180,170),N C*** FORMAT THE LINE NUMBER 120 INX=1 CALL MPUCNA (ISILN,K10,K5) GO TO 340 C*** FORMAT THE P COUNTER (ADR) 130 K=3 INX=7 J=IPCT GO TO 190 C*** FORMAT THE OPCODE 140 J=IOPBIN GO TO 180 C*** FORMAT OPERAND 2 150 K=3 C*** FORMAT OPERAND 1 160 I=3 GO TO 180 C*** FORMAT DATA BYTE 2 170 K=3 C*** FORMAT DATA BYTE 1 180 I=I+IXBASE INX=JSDF(I) 190 K=K+IXBASE I=JLDF(K) CALL MPUCNA (J,NOPBAS,I) GO TO 340 C C*** MOVE THE STATEMENT TO THE PRINT BUFFER C 200 INX=JSSDF(IXBASE) JSIX=INX ISIC=IC-1 IC=0 IF(NRTSW.EQ.1) GO TO 310 C*** MOVE THE LABEL FIELD 210 CALL MPUGNC(NC) IF(IC.LT.7) CALL MPUSNC(NC) IF(ICSW.EQ.1.OR.ICSW.EQ.6) GO TO 220 GO TO 210 C*** FORMAT THE OPCODE 220 IF(INX-JSIX.LT.7) INX=JSIX+7 I=IOPCOD(1)/ICSHF CALL MPUSNC(I) I=IOPCOD(1)-I*ICSHF CALL MPUSNC(I) I=IOPCOD(2)/ICSHF CALL MPUSNC(I) INX=INX+1 I=IOPCOD(2)-I*ICSHF CALL MPUSNC(I) C*** FIND THE START OF THE NEXT FIELD IC=NSSCOL-1 LEVS=0 230 INX=INX+2 240 LEVS=LEVS+1 250 CALL MPUGNC(NC) 260 GO TO (270,280,280,270,300),LEVS 270 IF(ICSW.EQ.1) GO TO 250 IF(ICSW.EQ.6) GO TO 330 LEVS=LEVS+1 GO TO 260 280 IF(NRTSW.EQ.2) GO TO 300 C*** MOVE THE OPERAND FIELD IF(INX.GE.IPGLOL) GO TO 330 CALL MPUSNC(NC) IF(NRTSW.NE.4) GO TO 290 C*** OPCODE 'FCC N,' NSOSCH=NSOSCH-1 IF(NSOSCH.EQ.0) GO TO 230 GO TO 250 290 IF(LEVS.EQ.2) GO TO 240 IF(NSOSCH.EQ.NC) GO TO 230 GO TO 250 C*** MOVE THE COMMENT FIELD 300 IF(INX-JSIX.LT.23) INX=JSIX+23 IC=IC-1 310 L=IPGLOL-INX DO 320I=1,L CALL MPUGNC(NC) CALL MPUSNC(NC) 320 CONTINUE 330 IC=ISIC CALL MPUGNC(NC) 340 CONTINUE C*** PRINT THE LINE CALL MPAPA1 (K2,NB,IPGLOL) CALL MPAPAG(K1) C C*** STORE THE INSTRUCTION IN THE TAPE FILE C 350 IF(JPP1SW.EQ.1) GO TO 380 JDSW=JDOSW IF(MPUBSM(JDSW,9,1).EQ.0) GO TO 380 JADR=IPCT IF(MPUBSM(JDSW,3,1).EQ.0) GO TO 360 CALL MPUPTS (K2,JADR,IOPBIN) JADR=JADR+1 360 JV=IOPAN1 IF(MPUBSM(JDSW,4,9).EQ.0) GO TO 370 IF(JV.LT.0) JV=256-IABS(JV) CALL MPUPTS (K2,JADR,JV) GO TO 380 370 IF(MPUBSM(JDSW,5,9).EQ.0) GO TO 380 CALL MPUNEG(JV) CALL MPUXBY(JV, JV1, JV2) CALL MPUPTS (K2,JADR,JV1) JADR=JADR+1 CALL MPUPTS (K2,JADR,JV2) 380 RETURN END [\]. O@@@@@SRC C.MPAPSC (O) SUBROUTINE MPAPSC C+ NAM: MPAPSC VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: DIRECTIVE OPCODES DECODE C C SYS: M68SAM C C ENT: N/A C RTN: N/A C C FNC: DIRECTIVE OPCODE PROCCESSOR C* COMMON ICOMON(359),LABEL(4),LABESW,IOPCOD(9),NPLCT COMMON IOTBUF(131),IC,NC,ICSW,IPASS,IOPCLS,IOPIXB,IOPBIN COMMON IOPAN1,IPCT,ITERR,NRTSW,NSSCOL,NSOSCH I=IOPIXB-4 C*** * * * PAG ORG EQU FCB FCC FDB RMB SPC OPT GO TO (250,100,130,170,190,220,240,260,280),I C C*** 'ORG' ASSIGN PROGRAM COUNTER C 100 CALL MPAOPR (IOPAN1,JOPRSW) IF(JOPRSW.GT.2) GO TO 120 IPCT=IOPAN1 JDOSW=35 GO TO 310 C*** ERROR '216' SYNTAX ERROR IN DIRECTIVE'S OPERAND 120 CALL MPAERR (216) CALL MPAPRL (35) RETURN C C*** 'EQU' EQUATE SYMBOL C 130 CALL MPAFSY (LABEL,I,J) IF(I.NE.1.AND.IPASS.EQ.1) RETURN CALL MPAOPR (IOPAN1,JOPRSW) IF(JOPRSW.LT.3.AND.I.EQ.1) GO TO 140 C*** '213' NO LABEL, SYNTAX OR REDEFINED EQU DIRECTIVE CALL MPAERR (213) C*** SET THE SYMBOL'S ERROR CODE BIT 135 CALL MPASSY (LABEL,3,I) GO TO 150 140 GO TO (145,150),IPASS C*** STORE THE SYMBOL VALUE (NO STORE IF SYMBOL IS IN ERR) 145 IF(LABESW.EQ.2.AND.LABEL(4).NE.IOPAN1) GO TO 135 LABEL(4)=IOPAN1 CALL MPASSY (LABEL,2,LABESW) RETURN C*** PRINT THE SOURCE LINE 150 CALL MPAPRL (161) RETURN C C*** 'FCB' FORM CONSTANT BYTE C 170 I=355 180 CALL MPAOPR (IOPAN1,JOPRSW) GO TO (185,182),IPASS C*** ERROR '210' BYTE OVERFLOW (> 255) 182 IF(JOPRSW.EQ.2.OR.JOPRSW.EQ.3) CALL MPAERR (210) C*** ERROR '214' SYNTAX ERROR IN FCB DIRECTIVE IF(JOPRSW.EQ.5) CALL MPAERR (214) CALL MPAPRL(I) I=322 185 IPCT=IPCT+1 IF(ICSW.NE.2) RETURN CALL MPUGNC(NC) GO TO 180 C C*** 'FCC' FORM CONSTANT CHARACTERS C 190 JSIC=IC NSOSCH=NC CALL MPUFNO(JV,I) IF(JV.EQ.0.AND.I.EQ.2.OR.ICSW.NE.2) GO TO 200 C*** 'FCC N,TEXT' IF(I.NE.1.OR.JV.GT.255.OR.JV.LT.1) GO TO 120 NRTSW=4 NS0SCH=JV+IC+1-JSIC JSIC=IC C*** 'FCC /TEXT/' 200 I=355 IC=JSIC 210 CALL MPUGNC(IOPAN1) IF(NRTSW.NE.4.AND.ICSW.EQ.6.OR.IOPAN1.EQ.NSOSCH) RETURN CALL MPAPRL(I) I=322 IPCT=IPCT+1 IF(NRTSW.NE.4) GO TO 210 JV=JV-1 IF(JV.EQ.0) RETURN GO TO 210 C C*** 'FDB' FORM DOUBLE CONSTANT BYTE C 220 I=419 230 CALL MPAOPR(IOPAN1,JOPRSW) GO TO (235,232),IPASS C*** ERROR '215' SYNTAX ERROR IN FDB DIRECTIVE 232 IF(JOPRSW.EQ.3.OR.JOPRSW.EQ.5) CALL MPAERR (215) CALL MPAPRL(I) I=386 235 IPCT=IPCT+2 IF(ICSW.NE.2) RETURN CALL MPUGNC(NC) GO TO 230 C C*** 'RMB' RESERVE MEMORY BYTES C 240 CALL MPAOPR (IOPAN1,JOPRSW) IF(JOPRSW.GT.2) GO TO 120 CALL MPAPRL(163) IPCT=IPCT+IOPAN1 RETURN C C C*** 'PAGE' PLACE PAGE AT TOP OF THE NEXT PAGE (PASS 2 ONLY) C 250 IF(IPASS.EQ.1) GO TO 300 IF(NPLCT.GT.8) CALL MPAPAG(0) GO TO 300 C C*** 'SPC' SPACE 'N' LINES C 260 CALL MPAOPR (JV,JOPRSW) IF(JOPRSW.GT.2) GO TO 120 C*** STOP SPACING AT THE TOP OF A PAGE OR WHEN COUNT = 0 270 IF(JV.LT.1.OR.NPLCT.LT.5) GO TO 300 CALL MPAPRL (0) JV=JV-1 GO TO 270 C C*** 'OPT' OPTION RECORD C 280 CALL MPAOPT JDOSW=33 GO TO 310 C*** CHECK FOR LABEL ON DIRECTIVES WHICH SHOULD NOT HAVE ANY 300 JDOSW=0 310 IF(LABEL(1).EQ.0) GO TO 320 C*** ERROR '223' DIRECTIVE SHOULD NOT HAVE A LABEL CALL MPAERR (223) LABEL(4)=0 CALL MPASSY (LABEL,2,I) CALL MPASSY (LABEL,3,I) IF(JDOSW.EQ.0) JDOSW=33 320 IF(JDOSW.NE.0) CALL MPAPRL (JDOSW) RETURN END [\]. P@@@@@SRC C.MPASSY (P) SUBROUTINE MPASSY (JNAM,JDSW,JRSW) C+ NAM: MPASSY VER: 1.0 DAT: 10-01-74 CMP: ALL C PGM: STORE INTO THE SYMBOL TABLE C C SYS: M68SAM C C C ENT: JNAM - 4 WORD SYMBOL TO STORE C - WORDS 1 TO 3 SYMBOL IN SYSTEM'S R2 FORMAT C - WORD 4 SYMBOL'S VALUE C JDSW - 1 => STORE THE SYMBOL C - 2 => FIND THE SYMBOL AND CHANGE WORD 4 C - 3 => SET THE SYMBOL'S DEFINATION ERROR FLAG C JRSW - N/A C C RTN: JNAM - N/C C JDSW - N/C C JRSW - 1 => OPERATION COMPLETED OK C - 2 => SYMBOL IS IN THE SYMBOL TABLE C - 3 => ERROR, ERROR CODE BIT SET, SYMBOL TABLE C OVERFLOW, OR ENDEFINE SYMBOL (JDSW 2&3) C C FNC: SEARCH THE SYMBOL TABLE FOR THE SYMBOL AND THEN C STORE THE SYMBOL OR CHANGE IT'S VALUE OR SET C IT'S ERROR FLAG. C* INTEGER JNAM(4) COMMON ICOMON(26),KC7F7F,KCFFFF,KC80,KEATB(531),NOSYM COMMON ISYM(813),LSYM JRSW=1 JV=JNAM(4) CALL MPAFSY (JNAM,J,I) GO TO (100,200,300),JDSW C*** STORE THE SYMBOL INTO THE SYMBOL TABLE 100 GO TO (102,400,105),J C*** SYMBOL IS IN THE TABLE 102 IF(ISYM(I+3).EQ.JV) RETURN JRSW=2 RETURN C*** THE SYMBOL IS NOT IN THE TABLE 105 IF(I+4.LT.LSYM) GO TO 110 C*** ERROR '221' SYMBOL TABLE OVERFLOW CALL MPAERR (221) GO TO 400 C*** STORE THE SYMBOL 110 NOSYM=NOSYM+1 ISYM(I)=JNAM(1) ISYM(I+1)=JNAM(2) ISYM(I+2)=JNAM(3) ISYM(I+4)=0 120 ISYM(I+3)=JV RETURN C*** CHANGE THE SYMBOL'S VALUE (WORD 4) 200 IF(J.EQ.1) GO TO 120 C*** SYMBOL IS IN ERROR OR NOT IN THE TABLE GO TO 400 C*** SET THE SYMBOL'S ERROR FLAG 300 IF(J.EQ.3) GO TO 400 ISYM(I)=IAND(ISYM(I),KC7F7F)+KC80 RETURN 400 JRSW=3 RETURN END [\]. Q@@@@@SRC C.MPUADR (Q) SUBROUTINE MPUADR(JP1, JS, JP2, JSW) C+ NAM: MPUADR VER: 1.1 DAT: 03-18-75 CMP: ALL C PGM: 16 BIT 2'S COMPLEMENT ADDER C C SYS: ALL C C ENT: JP1 - OPERAND 1 C JS - FUNCTION TO PERFORM C 1 => ADD C 2 => SUBTRACT C 3 => MULTIPLY C 4 => DIVIDE C JP2 - OPERAND 2 C JSW - N/A C C RTN: JP1 - RESULT OF OPERATION C JS - N/C C JP2 - N/C C JSW - STATUS OF OPERATION C 1 => 8 BITS C 2 => 16 BITS C 3 => OVERFLOW C C FNC: PERFORMS REQUESTED ARITHMETIC FUNCTION AND DETERMINES C BIT SIZE OF RESULT. 16 BIT OVERFLOW IS CHECKED. C C REV: 1.1 - FIXED 16-BIT ARITH PROBLEM C* COMMON ICOMON(8),IBPWD DATA K1/1/ C C*** RESET OVERFLOW INDICATOR C CALL MPUOVF(JP1,K1) JSW = 1 JOVF = 2 C C*** ADDER FOR MACHINES WITH WORDSIZE > 16 BITS. C 100 GO TO (110, 120, 130, 140), JS 110 JP1 = JP1 + JP2 GO TO 150 120 JP1 = JP1 - JP2 GO TO 150 130 JP1 = JP1*JP2 JOVF=3 GO TO 150 140 JP1 = JP1/JP2 150 IF (IABS(JP1) .GE. 256) JSW = 2 C C*** TEST FOR OVERFLOW C 160 CALL MPUOVF(JP1, JOVF) IF (JOVF .NE. 0) JSW = 3 RETURN END [\]. R@@@@@SRC C.MPUBNM (R) SUBROUTINE MPUBNM (JNAM) C+ NAM: MPUBNM VER: 1.0 DAT: 12-29-73 CMP: ALL C PGM: P# C C SYS: ALL C C ENT: N/A C C RTN: N/A C C FNC: C GEN: C C REV: N/A C* INTEGER JNAM(3) COMMON ICOMON(506),NC,ICSW,IPASS(27),LSPSP,L8SP(3),LSP C C BUILD 1 TO 6 CHARACTER ALPHA NUMERIC SYMBOL C SYMBOL MUST START WITH A ALPHA CHAR 'A' - 'Z' C DO 10 I=1,3 10 JNAM(I)=LSPSP I=1 IF(ICSW.EQ.4) GO TO 30 RETURN 20 CALL MPUGNC (NC) IF(ICSW.LT.3.OR.ICSW.GT.4) RETURN 30 JC=NC*256 JNAM(I)=JC+LSP CALL MPUGNC (NC) IF(ICSW.LT.3.OR.ICSW.GT.4) RETURN JNAM(I)=JC+NC I=I+1 IF(I.LT.4) GO TO 20 C SKIP TO THE END OF THE SYMBOL 40 CALL MPUGNC (NC) IF(ICSW.LT.3.OR.ICSW.GT.4) RETURN GO TO 40 END [\]. S@@@@@SRC C.MPUCNA (S) SUBROUTINE MPUCNA(JN,JBAS,JCOL) C+ NAM: MPUCNA VER: 1.3 DAT: 03-18-75 CMP: ALL C PGM: CONVERT BINARY NUMBER TO ASCII C C SYS: ALL C C ENT: JN -BINARY NUMBER TO BE CONVERTED C JBAS-BASE TO USE IN CONVERSION C JCOL-NUMBER OF COLUMNS OF CONVERTED OUTPUT C C RTN: JN -N/C C JBAS-N/C C JCOL-N/C C C FNC: ROUTINE CONVERTS BINARY INTEGER TO ASCII OUTPUT IN C THE REQUESTED BASE. ASCII OUTPUT IS PLACE IN ARRAY C "NB" BY ROUTINE MPUSNC. C C REV: 1.1 - ROUTINE WAS MADE MACHINE INDEPENDENT C 1.2 - FIX CODE FOR 1.1 CHANGE C 1.3 - IMPLEMENTED MPVMUL/MPVDIV ROUTINES C* INTEGER ID(6) COMMON ICOMON(8),IBPWD,KCFOTB(18),KCFFFF,KC80(517),L0 NN = IAND(JN, KCFFFF) C C*** CONVERSION FOR MACHINES WITH WORDSIZE > 16 BITS C 20 DO 30 I = 1, JCOL J=NN/JBAS ID(I)=NN-(J*JBAS) NN=J 30 CONTINUE 40 I = JCOL 50 NN = ID(I) IF(NN.GT.9) NN=NN+7 CALL MPUSNC (NN+L0) I=I-1 IF(I.GT.0) GO TO 50 RETURN END [\]. T@@@@@SRC C.MPUFNO (T) SUBROUTINE MPUFNO (JN,JER) C+ NAM: MPUFNO VER: 1.2 DAT: 03-18-75 CMP: ALL C PGM: FORM A INTEGER NUMBER FROM THE IMAGE BUFFER C C SYS: ALL C C ENT: JN - N/A C JER - N/A C C RTN: JN - INTEGER NUMBER THAT WAS SCANNED FROM THE BUFFER C JER - 1 => NO ERROR, OK C - 2 => SYNTAX ERROR IN THE NUMBER OR THE BASE C SELECT CHAR WAS NOT %, @ OR $ C C C FNC: THE ROUTINE WILL START THE SCAN AT THE PRESENT CHAR C IN THE 'NC' BUFFER AND SCAN OUT THE NEXT INTEGER C NUMBER. THE NUMBER MAYBE IN BASE BINARY, OCTAL, C DECIMAL OR HEX. SEE FORMAT. THE SCAN WILL STOP AT C THE NEXT NON-NUMERIC CHAR. THE CHAR WILL BE RETURNED C IN THE 'NC' BUFFER. C C GEN: FORMAT: C %N OR NB => BINARY (N = 0-1) C @N NQ OR NO => OCTAL (N = 0-7) C N OR ND => DECIMAL (N = 0-9) C $N OR 0NH => HEX (N = 0-9 OR A-F) C C REV: 1.1 - BASE CHAR WITHOUT A DIGIT ARE FLAGGED AS ERRORS C 1.2 - FIXED 16-BIT ARITH PROBLEM C* INTEGER JNB(4) COMMON ICOMON(506),NC,ICSW,IPASS(14),LSBH,LSBO,LSBB COMMON LSPCT(20),L0,L1(2),LA,LB,LD,LF,LH,LN,LO,LQ EQUIVALENCE (JNB(1),JN2),(JNB(2),JN8) EQUIVALENCE (JNB(3),JN10),(JNB(4),JN16) JSB=0 DO 90 N=1,4 JNB(N)=0 90 CONTINUE JER=2 JNSB=1 LEVS=1 GO TO 110 100 CALL MPUGNC (NC) 110 JNCSW=1 GO TO (120,190),LEVS C*** * * * SP , 0-9 A-Z SPC END 120 GO TO (140,140,180,140,130,140),ICSW 130 JSB=1 IF(NC.EQ.LSBH) GO TO 150 IF(NC.EQ.LSBO) GO TO 160 IF(NC.EQ.LSBB) GO TO 170 C*** ILLEGAL CHAR IN THE NUMBER FIELD 140 JN=0 JER=2 RETURN 150 JSB=JSB+2 160 JSB=JSB+1 170 LEVS=2 GO TO 100 C*** BUILD NUMBER (LEVEL 2) 180 LEVS=2 190 GO TO (300,300,200,250,300,300),ICSW C*** CHAR IS '0' TO '9' 200 N=NC-L0 GO TO (210,220,230,240),JNSB 210 IF(N.GT.1) JNSB=2 JN2 = JN2*2 + N 220 IF(N.GT.7) JNSB=3 JN8 = JN8*8 + N 230 IF(N.GT.9) JNSB=4 JN10 = JN10*10 + N 240 JN16 = JN16*16 + N JER=1 GO TO (100,110),JNCSW C*** CHAR IS 'A' TO 'Z' 250 JC=NC JNCSW=2 CALL MPUGNC(NC) IF(JC.GT.LF) GO TO 260 N=JC-LA+10 IF(JNSB.EQ.4) GO TO 240 IF(JC.NE.LB.AND.JC.NE.LD.OR.JSB.NE.0) GO TO 230 IF(ICSW.EQ.3.OR.ICSW.EQ.4) GO TO 230 260 JSB=1 IF(JC.EQ.LB) GO TO 290 IF(JC.EQ.LQ.OR.JC.EQ.LO) GO TO 280 IF(JC.EQ.LD) GO TO 270 IF(JC.NE.LH) GO TO 140 JSB=JSB+1 270 JSB=JSB+1 280 JSB=JSB+1 290 IF(ICSW.EQ.3.OR.ICSW.EQ.4) GO TO 140 C*** END OF THE NUMBER FIELD 300 IF(JSB.NE.0) GO TO 310 JSB=3 IF(JNSB.EQ.4) JSB=4 310 IF(JSB.LT.JNSB) GO TO 140 JN=JNB(JSB) RETURN END [\]. U@@@@@SRC C.MPUGNC (U) SUBROUTINE MPUGNC (JC) C+ NAM: MPUGNC VER: 1.1 DAT: 08-12-74 CMP: ALL C PGM: GET NEXT CHARACTER FROM IMAGE BUFFER C C SYS: ALL C C ENT: JC - N/A C C RTN: JC - NEXT CHARACTER FORM THE IMAGE BUFFER C C FNC: GET THE NEXT CHARACTER AND RETURN IT IN 'NC' AND 'JC' C ALSO SET 'ICSW' FOR TYPE OF CHARACTER. 'IC=IC+1' C C GEN: ICSW IS SET AS FOLLOWS FOR THE CHARACTER RETURNED: C ICSW IS SET TO) C 1 => SPACE ' ' C 2 => COMMA ',' C 3 => '0' - '9' C 4 => 'A' - 'Z' C 5 => SPECIAL CHAR C 6 => END OF STATEMENT C NOTE: IF THE CHAR. IS NOT WITHIN 20 TO 60 HEX ICSW=1 C C REV: 1.1 - TRAILING SPACES ARE NOT RETURNED C* INTEGER IMAGE(40) COMMON ICOMON(5),ICSHF,IA2SHF(456),ISIMBF(43),IC,NC,ICSW COMMON IPASS(31),LSP,LASK(2),LCOMA,LMNS(2),L0,L1,L9,LA COMMON LB(10),LZ EQUIVALENCE (IMAGE(1),ISIMBF(4)) IF(IC.LE.ISIMBF(1)*2-6) GO TO 10 NC=LSP JC=LSP ICSW=6 RETURN 10 I=IC/2 IW=IMAGE(I+1) I=IC-I*2 IC=IC+1 NC=IW/ICSHF IF(I.NE.0) NC=IW-(NC*ICSHF) JC=NC IF(NC.NE.LSP) GO TO 20 C*** CHAR IS A ' ' (SPACE) 15 ICSW=1 RETURN 20 IF(NC.NE.LCOMA) GO TO 30 C*** CHAR IS A ',' (COMMA) ICSW=2 RETURN 30 IF(NC.LT.L0.OR.NC.GT.L9) GO TO 40 C*** ** CHAR IS '0' - '9' ICSW=3 RETURN 40 IF(NC.LT.LA.OR.NC.GT.LZ) GO TO 50 C*** CHAR IS 'A' - 'Z' ICSW=4 RETURN 50 IF(NC.LT.LSP.OR.NC.GT.95) GO TO 15 ICSW=5 RETURN END [\]. V@@@@@SRC C.MPUPIB (V) SUBROUTINE MPUPIB (JB,JLSW) C+ NAM: MPUPIB VER: 1.4 DAT: 03-18-75 CMP: ALL C PGM: PACK SOURCE IMAGE BUFFER C C SYS: ALL C C ENT: JB - 80 WORD BUFFER IN COMPUTER'S A1 FORMAT TO BE C CONVERTED AND PACKED C JLSW - 1 => NO LINE NUMBERS IN THE BUFFER C - 2 => LINE NUMBER IN THE BUFFER C C RTN: JB - N/C C 'JB' WAS NOT WITHIN THE RANGE '0' TO '9' C JLSW - SET TO 1 IF THE 1ST CHARACTER OF THE BUFFER C C FNC: CONVERT THE BUFFER 'JB' FROM THE COMPUTER'S A1 C FORMAT AND THEN REMOVE THE LINE NUMBER IF IT HAS C ONE (CONVERTING IT TO BINARY) AND PACKING THE BUFFER C INTO THE SYSTEM'S R2 FORMAT. THE OUTPUT IS A PACKED C 'ISIMBF(43)' BUFFER IN THE FOLLOWING FORMAT: C C WORD 1 NUMBER OF WORDS+3 TO END OF TEXT (TRAILING C SPACES ARE NOT INCLUDED). C WORD 2 BINARY LINE NUMBER OF THE RECORD C WORD 3 1ST CHARACTER IN SYSTEM'S R1 FORMAT IF THE C RECORD'S LINE NUMBER WAS NOT FOLLOWED BY A C SPACE. OTHER WISE IT IS A SPACE. C WORDS 4 TO 43 ARE THE TEXT OF THE RECORD IN SYSTEM'S C R2 FORMAT. C C GEN: THE 1ST CHARACTER IS RETURN BY A CALL TO 'MPUGNC' C AFTER THE BUFFER IS PACKED UP. THE 1ST CHARACTER C AFTER THE LINE NUMBER IS CHARACTER 1 IF IT IS NOT C A SPACE, OTHERWISE IT IS THE 2ND ONE C C REV: 1.1 - 1ST CHAR RETURNED IN 'ISIMBF(3)' C 1.2 - IF NO LINE 'ISILN' IS NOT CHANGED, MPURA1 C PLACES THE LINE NUMBER IN 'ISILN' C 1.3 - BLANK LINE WILL BE 2 SPACE LONG C 1.4 - FIX 16-BIT ARITH PROBLEM C* INTEGER JB(80) COMMON ICOMON(4),LLSPSP,ICSHF,IA2SHF(456),ISIMBF(43),IC COMMON NC,ICSW(28),LSPSP,L8SP(3),LSP,LASK(5),L0,L1,L9 EQUIVALENCE (ISILN,ISIMBF(2)) CALL MPUCVC (JB(1),JC) IF(JC.LT.L0.OR.JC.GT.L9) JLSW=1 ISIMBF(3)=LSP IF(JLSW.EQ.2) ISIMBF(3)=JC JULSW=1 N=0 J=3 ISIMBF(1)=4 DO 200 I=1,80 JC=LSP JW=JB(I) IF(JW.NE.LLSPSP) CALL MPUCVC (JW,JC) GO TO (120,160,170),JULSW 120 GO TO (160,140),JLSW C*** BUILD THE LINE NUMBER 140 IF(JC.LT.L0.OR.JC.GT.L9) GO TO 150 N = N*10 + (JC - L0) GO TO 200 C*** SAVE THE LINE NUMBER AND THE 1ST CHAR. AFTER IT 150 ISILN=N ISIMBF(3)=JC IF(JC.EQ.LSP) GO TO 180 160 J=J+1 ISIMBF(J)=JC*ICSHF+LSP JULSW=3 GO TO 190 170 ISIMBF(J)=ISIMBF(J)-LSP+JC 180 JULSW=2 C*** SAVE THE END OF IMAGE INDEX 190 IF(JC.NE.LSP) ISIMBF(1)=J 200 CONTINUE C*** SPACE FILL THE REMAINING PART OF THE BUFFER 210 J=J+1 IF(J.GT.43) GO TO 220 ISIMBF(J)=LSPSP GO TO 210 C*** GET THE 1ST CHARACTER AND RETURN IT 220 IC=0 CALL MPUGNC(NC) RETURN END [\]. W@@@@@SRC C.MPUPTS (W) C C 6 MAR 78 (PDH) INCLUDE 'K0' IN DATA STATEMENT C 31 JAN 78 (PDH) OUTPUT ASCII CODE 33 (ESC) WITH INITIALIZATION. C 3 FEB 77 (PDH) CHANGE INITIAL LINE TO DISPLAY A DIRECTION ARROW C 1 JUN 76 (PDH) CHANGE BLANK LINE TO 'L ' FOR REMOTE LOADING C 19 FEB 76 (PDH) OUTPUT BLANK LINE TO 'LUOT' TO INITIALIZE DEVICE C SUBROUTINE MPUPTS (JDSW,JADR,JBYT) C+ NAM: MPUPTS VER: 1.0 DAT: 09-15-74 CMP: ALL C PGM: MEMORY OUTPUT TO PAPER TAPE FILE SETUP ROUTINE C C SYS: ALL C C ENT: JDSW - 1=> OPEN THE ROUTINE C - 2=> STORE BYTE INTO PT BUFFER C - 3=> CLOSE THE ROUTINE C JADR - IF JDSW=2, ADDRESS OF THE BYTE TO STORE C JBYT - IF JDSW=2, BYTE TO STORE AT ADDRESS JADR C C RTN: JDSW - N/C C JADR - N/C C JBYT - N/C C C FNC: THIS ROUTINE IS USE TO SETUP AND THEN OUTPUT C ONE BYTE AT A TIME TO THE 'IOTBUF' BUFFER C THE ROUTINE WILL OUTPUT THE RECORD WHEN IT IS FULL C AND ALSO CHANGE BYTE ADDRESSES IF THE NEXT C ADDRESS IS NOT EQUAL TO 'JADR'. THE LAST CALL C (JDSW=3) WILL OUTPUT THE LAST RECORD AND END OF C P.T. FILE RECORD (S9). C C REV: N/A C* COMMON ICOMON(3),LUOT,LLSPSP(451),IOTSW,IOTCKS,NOTADR,NAM(87) COMMON L0,L1,L9,LA(2),LD,LF,LH,LN(3),LR C C THE FOLLOWING IS SOME GAME PLAYING TO OUTPUT CODE '33' (ESC) C FROM THE FORTRAN PROGRAM. THE VALUE 55296 IS ASCII 33(OCTAL) IN A1 C EQUIVALENCE (ESC,IESC) DATA IESC/55296/ C DATA K0/0/,K1/1/,K2/2/,K3/3/,K4/4/ C GO TO (100,200,300),JDSW C C*** OPEN THE ROUTINE BY OUTPUTTING 'HDR' RECORD C 100 WRITE (LUOT,101) ESC 101 FORMAT (' @@@@@@@@@@DFMDDDDD@@@@@@@@@@L',A1) CALL MPUPTW (K1,L0) CALL MPUPTW (K2,K0) CALL MPUPTW (K3,LH) CALL MPUPTW (K3,LD) CALL MPUPTW (K3,LR) CALL MPUPTW (K4,K0) RETURN C C*** STORE THE BYTE INTO THE P.T. BUFFER C 200 GO TO (220,210),IOTSW C*** RECORD CONTAINS PART OF A RECORD 210 IF(JADR.EQ.NOTADR.AND.IAND(NOTADR,15).NE.0) GO TO 230 C*** OUTPUT THE LAST RECORD CALL MPUPTW (K4,K0) C*** START OF A NEW RECORD 220 NOTADR=JADR CALL MPUPTW (K1,L1) CALL MPUPTW (K2,NOTADR) C*** SET THE 'OT' BUFFER SW 2=> BUFFER CONTAINS A RECORD IOTSW=2 C*** STORE THE BYTE INTO THE P.T. RECORD BUFFER 230 CALL MPUPTW (K3,JBYT) NOTADR=NOTADR+1 RETURN C C*** CLOSE THE ROUTINE, OUTPUT THE 'S9' RECORD C 300 IF(IOTSW.NE.1) CALL MPUPTW (K4,K0) CALL MPUPTW (K1,L9) CALL MPUPTW (K2,K0) CALL MPUPTW (K4,K0) RETURN END .EOT C*** START OF A NEW RECORD 220 NOTADR=JADR CALL MPUPTW (K1,L1) CALL MPUPTW (K2,NOTADR) C*** SET THE 'OT' BUFFER SW 2=> BUFFER CONTAINS A RECORD IOTSW=2 C*** STORE THE BYTE INTO THE P.T. RECORD BUFFER 230 CALL MPUPTW (K3,JBYT) NOTADR=NOTADR+1 RETURN C C*** CLOSE THE ROUTINE, OUTPUT THE 'S9' RECORD C 300 IF(IOTSW.NE.1) CALL MPUPTW (K4,K0) CALL MPUPTW (K1,L9) CALL MPUPTW (K2,K0) CALL MPUPTW (K4,K0) RETURN END [\]. X@@@@@SRC C.MPUPTW (X) C C 19 FEB 76 (PDH) CONVERT TO NEW ROUTINE 'PNCHR1' FOR PAPER TAPE C SUBROUTINE MPUPTW (JSW,JAD) C+ NAM: MPUPTW VER: 1.2 DAT: 04-18-75 CMP: ALL C PGM: BUILD AND WRITE OUT PAPER TAPE FILE RECORDS C C SYS: ALL C C ENT: JSW - 1=> INITIALIZE, 'LX' WHERE: X IS JAD C - 2=> STORE P.T. RECORD'S 1ST BYTE ADDRESS C - 3=> STORE 8 BIT BYTE C - 4=> END OF RECORD, OUTPUT IT C JAD - CHAR, ADDRESS OR BYTE TO BE STORED IN THE C P.T. FILE RECORD. C C RTN: JSW - N/C C JAD - N/C C C FNC: BUILD A P.T. FILE RECORD A BYTE AT A TIME AND C OUTPUT THE RECORD TO THE 'OT' FILE. C C REV: 1.0 - JCKSUM CHANGED TO ITOCKS AND IS IN COMMON C 1.1 - FIX FOR 16-BIT ARITH PROBLEMS C 1.2 - ADDED 2 LEADING SPACES TO EACH OT RECORD C* COMMON ICOMON(3),LUOT,LLSPSP(21),KCFF,KC7F7F(211),NB(121) COMMON INX,LABEL(15),IOTBUF(80),IOTINX,IOTSW,IOTCKS COMMON NOTADR(100),LS DATA K2/2/,K16/16/ GO TO (100,200,300,400),JSW C*** INITIALIZE THE BUFFER WITH 'SX' 100 IOTBUF(1)=LS IOTBUF(2)=JAD RETURN C*** STORE THE ADDRESS OF THE 1ST BYTE OF THE RECORD 200 IOTCKS = JAD/256 + IAND(JAD, KCFF) L=4 IOTINX=4 GO TO 310 C*** STORE THE NEXT BYTE IN THE RECORD 300 IOTCKS=IOTCKS+JAD L=2 310 INX=0 CALL MPUCNA (JAD,K16,L) DO 320 J=1,L IOTINX=IOTINX+1 IOTBUF(IOTINX)=NB(J) 320 CONTINUE RETURN C*** END OF THE RECORD, ADD THE BYTE COUNT AND CHECKSUM 400 J=(IOTINX-2)/2 IOTCKS=KCFF-IAND(IOTCKS+J,KCFF) INX=0 CALL MPUCNA (J,K16,K2) IOTBUF(3)=NB(1) IOTBUF(4)=NB(2) CALL MPUCNA (IOTCKS,K16,K2) IOTINX=IOTINX+1 IOTBUF(IOTINX)=NB(3) IOTINX=IOTINX+1 IOTBUF(IOTINX)=NB(4) CALL PNCHR1 (LUOT,IOTBUF,IOTINX) C*** RESET 'OT' BUFFER SWITCH, 1=> BUFFER EMPTY IOTSW=1 RETURN END [\]. Y@@@@@SRC C.MPUSNC (Y) SUBROUTINE MPUSNC (JCHR) C+ NAM: MPUSNC VER: 1.0 DAT: 12-29-73 CMP: ALL C PGM: P# C C SYS: ALL C C ENT: N/A C C RTN: N/A C C FNC: C C GEN: C C REV: N/A C* COMMON ICOMON(237),NB(121),INX INX=INX+1 NB(INX)=JCHR RETURN END [\]. Z@@@@@SRC C.BDATA1 (Z) C C 31 JAN 78 (PDH) CHANGE VALUE OF 'NOP' OPCODE TO 01 FROM 02 C BLOCK DATA C NAM: MPADBK VER: 1.0 DAT: 10-01-74 CMP: SIGMA-9 C PGM: LABELED COMMON FOR 'M68SAM' C C SYS: 'M68SAM' COMMON /A/ NOPCD(246),IOPBC2(51),IOPBC3(16) COMMON /A/ IOPBC4(116),IOPBC5(22) DATA NOPCD(1)/10801/,NOPCD(2)/23130/ DATA NOPCD(3)/23072/,NOPCD(4)/20033/,NOPCD(5)/19744/ DATA NOPCD(6)/17742/,NOPCD(7)/17440/,NOPCD(8)/19791/ DATA NOPCD(9)/20000/,NOPCD(10)/20545/,NOPCD(11)/18245/ DATA NOPCD(12)/20306/,NOPCD(13)/18208/,NOPCD(14)/17745/ DATA NOPCD(15)/21792/,NOPCD(16)/17987/,NOPCD(17)/16928/ DATA NOPCD(18)/17987/,NOPCD(19)/17184/,NOPCD(20)/17988/ DATA NOPCD(21)/16928/,NOPCD(22)/21069/,NOPCD(23)/16928/ DATA NOPCD(24)/21328/,NOPCD(25)/17184/,NOPCD(26)/20304/ DATA NOPCD(27)/21536/,NOPCD(28)/10802/,NOPCD(29)/20047/ DATA NOPCD(30)/20512/,NOPCD(31)/21569/,NOPCD(32)/20512/ DATA NOPCD(33)/21584/,NOPCD(34)/16672/,NOPCD(35)/18766/ DATA NOPCD(36)/22560/,NOPCD(37)/17477/,NOPCD(38)/22560/ DATA NOPCD(39)/17228/,NOPCD(40)/22048/,NOPCD(41)/21317/ DATA NOPCD(42)/22048/,NOPCD(43)/17228/,NOPCD(44)/17184/ DATA NOPCD(45)/21317/,NOPCD(46)/17184/,NOPCD(47)/17228/ DATA NOPCD(48)/18720/,NOPCD(49)/21317/,NOPCD(50)/18720/ DATA NOPCD(51)/21314/,NOPCD(52)/16672/,NOPCD(53)/17218/ DATA NOPCD(54)/16672/,NOPCD(55)/21569/,NOPCD(56)/16928/ DATA NOPCD(57)/21570/,NOPCD(58)/16672/,NOPCD(59)/17473/ DATA NOPCD(60)/16672/,NOPCD(61)/16706/,NOPCD(62)/16672/ DATA NOPCD(63)/21587/,NOPCD(64)/22560/,NOPCD(65)/18766/ DATA NOPCD(66)/21280/,NOPCD(67)/20565/,NOPCD(68)/19521/ DATA NOPCD(69)/20565/,NOPCD(70)/19522/,NOPCD(71)/17477/ DATA NOPCD(72)/21280/,NOPCD(73)/21592/,NOPCD(74)/21280/ DATA NOPCD(75)/20563/,NOPCD(76)/18497/,NOPCD(77)/20563/ DATA NOPCD(78)/18498/,NOPCD(79)/21076/,NOPCD(80)/21280/ DATA NOPCD(81)/21076/,NOPCD(82)/18720/,NOPCD(83)/22337/ DATA NOPCD(84)/18720/,NOPCD(85)/21335/,NOPCD(86)/18720/ DATA NOPCD(87)/20037/,NOPCD(88)/18241/,NOPCD(89)/17231/ DATA NOPCD(90)/19777/,NOPCD(91)/19539/,NOPCD(92)/21057/ DATA NOPCD(93)/21071/,NOPCD(94)/21057/,NOPCD(95)/16723/ DATA NOPCD(96)/21057/,NOPCD(97)/16723/,NOPCD(98)/19521/ DATA NOPCD(99)/21071/,NOPCD(100)/19521/,NOPCD(101)/17477/ DATA NOPCD(102)/17217/,NOPCD(103)/18766/ DATA NOPCD(104)/17217/,NOPCD(105)/21587/ DATA NOPCD(106)/21569/,NOPCD(107)/17228/ DATA NOPCD(108)/21057/,NOPCD(109)/20037/ DATA NOPCD(110)/18242/,NOPCD(111)/17231/ DATA NOPCD(112)/19778/,NOPCD(113)/19539/ DATA NOPCD(114)/21058/,NOPCD(115)/21071/ DATA NOPCD(116)/21058/,NOPCD(117)/16723/ DATA NOPCD(118)/21058/,NOPCD(119)/16723/ DATA NOPCD(120)/19522/,NOPCD(121)/21071/ DATA NOPCD(122)/19522/,NOPCD(123)/17477/ DATA NOPCD(124)/17218/,NOPCD(125)/18766/ DATA NOPCD(126)/17218/,NOPCD(127)/21587/ DATA NOPCD(128)/21570/,NOPCD(129)/17228/ DATA NOPCD(130)/21058/,NOPCD(131)/10803/ DATA NOPCD(132)/16979/,NOPCD(133)/21024/ DATA NOPCD(134)/16978/,NOPCD(135)/16672/ DATA NOPCD(136)/16968/,NOPCD(137)/18720/ DATA NOPCD(138)/16972/,NOPCD(139)/21280/ DATA NOPCD(140)/16963/,NOPCD(141)/17184/ DATA NOPCD(142)/16963/,NOPCD(143)/21280/ DATA NOPCD(144)/16974/,NOPCD(145)/17696/ DATA NOPCD(146)/16965/,NOPCD(147)/20768/ DATA NOPCD(148)/16982/,NOPCD(149)/17184/ DATA NOPCD(150)/16982/,NOPCD(151)/21280/ DATA NOPCD(152)/16976/,NOPCD(153)/19488/ DATA NOPCD(154)/16973/,NOPCD(155)/18720/ DATA NOPCD(156)/16967/,NOPCD(157)/17696/ DATA NOPCD(158)/16972/,NOPCD(159)/21536/ DATA NOPCD(160)/16967/,NOPCD(161)/21536/ DATA NOPCD(162)/16972/,NOPCD(163)/17696/ DATA NOPCD(164)/10804/,NOPCD(165)/19524/ DATA NOPCD(166)/21280/,NOPCD(167)/19524/ DATA NOPCD(168)/22560/,NOPCD(169)/17232/ DATA NOPCD(170)/22560/,NOPCD(171)/21332/ DATA NOPCD(172)/21280/,NOPCD(173)/21332/ DATA NOPCD(174)/22560/,NOPCD(175)/19021/ DATA NOPCD(176)/20512/,NOPCD(177)/19027/ DATA NOPCD(178)/21024/,NOPCD(179)/21333/ DATA NOPCD(180)/16961/,NOPCD(181)/17229/ DATA NOPCD(182)/20545/,NOPCD(183)/21314/ DATA NOPCD(184)/17217/,NOPCD(185)/16718/ DATA NOPCD(186)/17473/,NOPCD(187)/16969/ DATA NOPCD(188)/21569/,NOPCD(189)/19524/ DATA NOPCD(190)/16705/,NOPCD(191)/21332/ DATA NOPCD(192)/16705/,NOPCD(193)/17743/ DATA NOPCD(194)/21057/,NOPCD(195)/16708/ DATA NOPCD(196)/17217/,NOPCD(197)/20306/ DATA NOPCD(198)/16705/,NOPCD(199)/16708/ DATA NOPCD(200)/17473/,NOPCD(201)/21333/ DATA NOPCD(202)/16962/,NOPCD(203)/17229/ DATA NOPCD(204)/20546/,NOPCD(205)/21314/ DATA NOPCD(206)/17218/,NOPCD(207)/16718/ DATA NOPCD(208)/17474/,NOPCD(209)/16969/ DATA NOPCD(210)/21570/,NOPCD(211)/19524/ DATA NOPCD(212)/16706/,NOPCD(213)/21332/ DATA NOPCD(214)/16706/,NOPCD(215)/17743/ DATA NOPCD(216)/21058/,NOPCD(217)/16708/ DATA NOPCD(218)/17218/,NOPCD(219)/20306/ DATA NOPCD(220)/16706/,NOPCD(221)/16708/ DATA NOPCD(222)/17474/,NOPCD(223)/10805/ DATA NOPCD(224)/20037/,NOPCD(225)/18208/ DATA NOPCD(226)/17231/,NOPCD(227)/19744/ DATA NOPCD(228)/19539/,NOPCD(229)/21024/ DATA NOPCD(230)/21071/,NOPCD(231)/21024/ DATA NOPCD(232)/16723/,NOPCD(233)/21024/ DATA NOPCD(234)/16723/,NOPCD(235)/19488/ DATA NOPCD(236)/21071/,NOPCD(237)/19488/ DATA NOPCD(238)/17477/,NOPCD(239)/17184/ DATA NOPCD(240)/18766/,NOPCD(241)/17184/ DATA NOPCD(242)/21587/,NOPCD(243)/21536/ DATA NOPCD(244)/17228/,NOPCD(245)/21024/ DATA NOPCD(246)/10809/,IOPBC2(1)/1/,IOPBC2(2)/6/ DATA IOPBC2(3)/7/,IOPBC2(4)/8/,IOPBC2(5)/9/,IOPBC2(6)/10/ DATA IOPBC2(7)/11/,IOPBC2(8)/12/,IOPBC2(9)/13/ DATA IOPBC2(10)/14/,IOPBC2(11)/15/,IOPBC2(12)/16/ DATA IOPBC2(13)/17/,IOPBC2(14)/22/,IOPBC2(15)/23/ DATA IOPBC2(16)/25/,IOPBC2(17)/27/,IOPBC2(18)/48/ DATA IOPBC2(19)/49/,IOPBC2(20)/50/,IOPBC2(21)/51/ DATA IOPBC2(22)/52/,IOPBC2(23)/53/,IOPBC2(24)/54/ DATA IOPBC2(25)/55/,IOPBC2(26)/57/,IOPBC2(27)/59/ DATA IOPBC2(28)/62/,IOPBC2(29)/63/,IOPBC2(30)/64/ DATA IOPBC2(31)/67/,IOPBC2(32)/68/,IOPBC2(33)/70/ DATA IOPBC2(34)/71/,IOPBC2(35)/72/,IOPBC2(36)/73/ DATA IOPBC2(37)/74/,IOPBC2(38)/76/,IOPBC2(39)/77/ DATA IOPBC2(40)/79/,IOPBC2(41)/80/,IOPBC2(42)/83/ DATA IOPBC2(43)/84/,IOPBC2(44)/86/,IOPBC2(45)/87/ DATA IOPBC2(46)/88/,IOPBC2(47)/89/,IOPBC2(48)/90/ DATA IOPBC2(49)/92/,IOPBC2(50)/93/,IOPBC2(51)/95/ DATA IOPBC3(1)/141/,IOPBC3(2)/32/,IOPBC3(3)/34/ DATA IOPBC3(4)/35/,IOPBC3(5)/36/,IOPBC3(6)/37/ DATA IOPBC3(7)/38/,IOPBC3(8)/39/,IOPBC3(9)/40/ DATA IOPBC3(10)/41/,IOPBC3(11)/42/,IOPBC3(12)/43/ DATA IOPBC3(13)/44/,IOPBC3(14)/45/,IOPBC3(15)/46/ DATA IOPBC3(16)/47/,IOPBC4(1)/158/,IOPBC4(2)/174/ DATA IOPBC4(3)/142/,IOPBC4(4)/190/,IOPBC4(5)/222/ DATA IOPBC4(6)/238/,IOPBC4(7)/206/,IOPBC4(8)/254/ DATA IOPBC4(9)/156/,IOPBC4(10)/172/,IOPBC4(11)/140/ DATA IOPBC4(12)/188/,IOPBC4(13)/159/,IOPBC4(14)/175/ DATA IOPBC4(15)/1/,IOPBC4(16)/191/,IOPBC4(17)/223/ DATA IOPBC4(18)/239/,IOPBC4(19)/1/,IOPBC4(20)/255/ DATA IOPBC4(21)/126/,IOPBC4(22)/110/,IOPBC4(23)/1/ DATA IOPBC4(24)/126/,IOPBC4(25)/189/,IOPBC4(26)/173/ DATA IOPBC4(27)/1/,IOPBC4(28)/189/,IOPBC4(29)/144/ DATA IOPBC4(30)/160/,IOPBC4(31)/128/,IOPBC4(32)/176/ DATA IOPBC4(33)/145/,IOPBC4(34)/161/,IOPBC4(35)/129/ DATA IOPBC4(36)/177/,IOPBC4(37)/146/,IOPBC4(38)/162/ DATA IOPBC4(39)/130/,IOPBC4(40)/178/,IOPBC4(41)/148/ DATA IOPBC4(42)/164/,IOPBC4(43)/132/,IOPBC4(44)/180/ DATA IOPBC4(45)/149/,IOPBC4(46)/165/,IOPBC4(47)/133/ DATA IOPBC4(48)/181/,IOPBC4(49)/150/,IOPBC4(50)/166/ DATA IOPBC4(51)/134/,IOPBC4(52)/182/,IOPBC4(53)/151/ DATA IOPBC4(54)/167/,IOPBC4(55)/1/,IOPBC4(56)/183/ DATA IOPBC4(57)/152/,IOPBC4(58)/168/,IOPBC4(59)/136/ DATA IOPBC4(60)/184/,IOPBC4(61)/153/,IOPBC4(62)/169/ DATA IOPBC4(63)/137/,IOPBC4(64)/185/,IOPBC4(65)/154/ DATA IOPBC4(66)/170/,IOPBC4(67)/138/,IOPBC4(68)/186/ DATA IOPBC4(69)/155/,IOPBC4(70)/171/,IOPBC4(71)/139/ DATA IOPBC4(72)/187/,IOPBC4(73)/208/,IOPBC4(74)/224/ DATA IOPBC4(75)/192/,IOPBC4(76)/240/,IOPBC4(77)/209/ DATA IOPBC4(78)/225/,IOPBC4(79)/193/,IOPBC4(80)/241/ DATA IOPBC4(81)/210/,IOPBC4(82)/226/,IOPBC4(83)/194/ DATA IOPBC4(84)/242/,IOPBC4(85)/212/,IOPBC4(86)/228/ DATA IOPBC4(87)/196/,IOPBC4(88)/244/,IOPBC4(89)/213/ DATA IOPBC4(90)/229/,IOPBC4(91)/197/,IOPBC4(92)/245/ DATA IOPBC4(93)/214/,IOPBC4(94)/230/,IOPBC4(95)/198/ DATA IOPBC4(96)/246/,IOPBC4(97)/215/,IOPBC4(98)/231/ DATA IOPBC4(99)/1/,IOPBC4(100)/247/,IOPBC4(101)/216/ DATA IOPBC4(102)/232/,IOPBC4(103)/200/,IOPBC4(104)/248/ DATA IOPBC4(105)/217/,IOPBC4(106)/233/,IOPBC4(107)/201/ DATA IOPBC4(108)/249/,IOPBC4(109)/218/,IOPBC4(110)/234/ DATA IOPBC4(111)/202/,IOPBC4(112)/250/,IOPBC4(113)/219/ DATA IOPBC4(114)/235/,IOPBC4(115)/203/,IOPBC4(116)/251/ DATA IOPBC5(1)/96/,IOPBC5(2)/112/,IOPBC5(3)/99/ DATA IOPBC5(4)/115/,IOPBC5(5)/100/,IOPBC5(6)/116/ DATA IOPBC5(7)/102/,IOPBC5(8)/118/,IOPBC5(9)/103/ DATA IOPBC5(10)/119/,IOPBC5(11)/104/,IOPBC5(12)/120/ DATA IOPBC5(13)/105/,IOPBC5(14)/121/,IOPBC5(15)/106/ DATA IOPBC5(16)/122/,IOPBC5(17)/108/,IOPBC5(18)/124/ DATA IOPBC5(19)/109/,IOPBC5(20)/125/,IOPBC5(21)/111/ DATA IOPBC5(22)/127/ C C*** 'EBCDIC' TO ASCII AND ASCII TO 'EBCDIC' TRNSLATE TABLES C C THESE TABLES DELETED ON PDP-9 C END [\].