MPU
32
A@@@@@SRC
B@@@@@SRC
C@@@@@SRC
D@@@@@SRC
DECK@@OBJ
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@@OBJ
@@@@@@@@@@DFMDDDDD@@@@@@@@@@L
S00600004844521B
S11301008E0132FE0134C603960AA1022705095A5C
S111011026F63EBD01197E010016BA013339F0
S10901338001365345541F
S9030000FC
[\].
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)
CALL CLOSE (LULT)
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 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)
CALL CLOSE (LUOT)
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<MPU>
$MSG ASSEMBLE, COMPILE, AND TASK BUILD MOROTOLA CROSS-ASSEMBLER
$FOR BR_I
$FOR B_A,B,C,D,E,F,G,H,I,J,K,L,M
$FOR B_N,O,P,Q,R,S,T,U,V,W,X,Y,Z
$MAC BREF_MPURSX PRM,M6809 012
$MAC BRE_M68... 001
$TKB
NRM,UL:F4LIB}
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
[\].