e _vߋt ***THIS VOLUME DOES NOT CONTAIN A HARDWARE BOOTABLE SYSTEM *** RZbjrt:#z xQz kzNNz*O:z INI -- INDEX FILE BIT MAP I/O ERROR INI -- INDEX FILE HEADER I/O ERROR INI -- STORAGE BITH8080G26FEB791334108080 [001,001] DECFILE11A '?.t:#z26FEB79133410\i. xQz26FEB79133410D. kz26FEB79133410A}.NNz26FEB79133410..*O:z26FEB791334104.vz26FEB79133500ޒ.̞z26FEB79133523.HE (26FEB7913380526FEB79133602 g. "E E 26FEB7913390626FEB79133845}e. 2E d26FEB7913395426FEB79133934oo. HKykQ26FEB7913404526FEB79134024;U. 3Oy_kQ26FEB7913413426FEB79134112Me. 5e"kQ26FEB7913422626FEB79134206#.<,\gkQ26FEB7913432026FEB79134300%.K;M(26FEB7913455726FEB79134433&9.j;ME 26FEB7913472626FEB79134700.(h;Md26FEB7913483026FEB79134804.HKykQ26FEB7913494026FEB79134913].3Oy_kQ26FEB7913505026FEB79135023h.5e"kQ26FEB7913515426FEB79135128. z12APR79110715t:#z xQz kzNNz*O:zvz̞zz&BE ( E E  E d KykQ Oy_kQ e"kQ,\gkQ;M(;ME ;MdKykQOy_kQe"kQCCC'C 8080/8085 ASSEMBLER VERSION 1.0MRC COPYRIGHT 1977C MICROTEC"C SUNNYVALE, CALIFORNIA 94088CCC6C THE VARIABLES PASSED IN COMMON ARE DEFINED BELOWCC'C ICRD = LOGICAL INPUT UNIT NUMBER(C IPRT = LOGICAL OUTPUT UNIT NUMBER/C IPCH = LOGICAL OBJECT MODULE UNIT NUMBER3C IMFLE = INTERMEDIATE FILE LOGICAL UNIT NUMBER3C MCFLE = MACRO SOURCE FILE LOGICAL UNIT NUMBER1C IMREC = RECORD NUMBER FOR INTERMEDIATE FILE1C MCREC = RECORD NUMBER FOR MACRO SOURCE FILEE2C IOREC = RECORD NUMBER FOR OBJECT MODULE FILE!C MSREC = MACRO RECORD NUMBER0!C ISN = INTERNAL LINE COUNT "C IPLEN = OBJECT RECORD LENGTHC LISN = OUTPUT LINE COUNTUC IPAGE = OUTPUT PAGE COUNTI'C LINE = OUTPUT LISTING LINE COUNTI$C IERRS = TOTAL NUMBER OF ERRORSC IERRF = MASTER ERROR FLAG $C IERR = ERROR STATUS INDICATOR'C NERR = SYMBOL ROUTINE ERROR FLAG (C IFCOL = FIRST SOURCE COLUMN NUMBER(C ICOL = INPUT BUFFER COLUMN POINTE&C IOLIN = NUMBER OF LINES PER PAGE'C MCOL = LAST SOURCE COLUMN NUMBERE0C MLAB = MAXIMUM LABEL LENGTH IN CHARACTERS1C MOPC = MAXIMUM OPCODE LENGTH IN CHARACTERSU3C IBIT = NUMBER OF BITS PER HOST COMPUTER WORD 9C ICCNT = NUMBER OF CHARACTERS PER HOST COMPUTER WORD 8C IWORD = NUMBER OF WORDS IN HOST COMPUTER PER LABEL0C MLCOL = MAXIMUM NUMBER OF COLUMNS TO PRINT&C MXMAC = MAXIMUM NUMBER OF MACROS*C ICHAR = ROUTINE TERMINATOR CHARACTER#C ICHK = OPCODE TYPE AND VALUE -C NH1 = VARIABLE FOR HEXADECIMAL OUTPUTU-C NH2 = VARIABLE FOR HEXADECIMAL OUTPUT %C MODE - GENERALIZED SYSTEM FLAGI'C MDIV = DIVISOR FOR SYMTA ROUTINEBC MVAL - BYTE VALUE!C NUMEX = NUMBER OF EXTERNALSU C IEXTI = EXTERNAL INDICATORC ITAB = SYMBOL TABLE4C ITABS = SYMBOL TYPE, EG. LOCAL,GLOBAL,SET,ETC.:C ITABV = NUMERIC VALUE OF SYMBOL (USUALLY AN ADDRESS))C INDEX = INDEX INTO THE SYMBOL TABLEN$C LTAB = LENGTH OF SYMBOL TABLEC NAME = SYMBOL BUFFER ,C ITABI = SYMBOL TYPE FROM LABEL ROUTINE&C LCCNT = SEGMENT PROGRAM COUNTERS$C LCLEN = CURRENT SEGMENT LENGTHC LTCNT = SEGMENT LENGTHSOC ISTKL = STACK LENGTH+C IRTYP = RELOCATION TYPE OF EXPRESSION &C MBYTF = MULTIBYTE DIRECTIVE FLAGC IHIGH = HIGH SYMBOL VALUEYC ILOW = LOW SYMBOL VALUE#C IEXTT = EXTERNAL SYMBOL VALUES!C IPUBT = PUBLIC SYMBOL VALUENC ISETT = SET SYMBOL VALUE"C IATYP = ABSOLUTE RECORD TYPEC ICTYP = CODE SEGMENT TYPE C IDTYP = DATA SEGMENT TYPEL)C NCONS = CONTENT RECORD SEGMENT TYPE $C NRELT = RELOCATION RECORD TYPE"C NEXTT = EXTERNAL RECORD TYPE&C NINTS = INTERSEGMENT RECORD TYPE$C NINTT = INTERSEGMENT RECORD ID$C NCPNT = CONTENT RECORD POINTER'C NRPNT = RELOCATION RECORD POINTER )C NIPNT = INTERSEGMENT RECORD POINTERX%C NEPNT = EXTERNAL RECORD POINTERL$C IRLEN = INTERNAL RECORD LENGTH!C ICNT = GENERALIZED COUNTERR(C ICKSM = CHECK SUM OF OBJECT RECORDC MNAME = MODULE NAMEE1C NRFLG = RELOCATION FLAGS FOR OUTPUT ROUTINE C IVAL = GENERALIZED VALUE C IVAL2 = GENERALIZED VALUER'C LODLC = ADDRESS FOR OBJECT RECORD /C LLEN = LENGTH OF BYTES IN ARGUMENT FIELD /C IBIN = ARRAY FOR ONE LINE OF OBJECT CODEO#C IREL = BYTE RELOCATION FLAGS @C IADDR = OUTPUT BUFFER FOR PROGRAM COUNTER AND SYMBOL TALBE4C LSOR = FLAG TO INDICATE SOURCE WILL BE LISTED>C LSYM = FLAG TO INDICATE THE SYMBOL TABLE WILL BE LISTED6C LMAC = FLAG TO INDICATE MACROS WILL BE EXPANDEDEC LIF = FLAG TO INDICATE WHETHER IF STATEMENTS WILL BE EXPANDED <C LOBJ = FLAG TO INDICATE OBJECT MODULE WILL BE PUNCHEDCC LREF = FLAG TO INDICATE CROSS REFERENCE TABLE WILL TO OUTPUTA?C LBUG = FLAG TO INDICATE SYMBOLS WILL BE PLACED IN MODULEG@C LGEN = FLAG TO INDICATE LOCAL SYMBOLS ARE IN SYMBOL TABLEC LC = LOCATION COUNTER(C IPVAL = TEMPORARY STROAGE LOCATION4C LEN = LENGTH OF CURRENT INSTRUCTION IN BYTES<C MAC = INDICATES A MACRO IS CURRENTLY BEING PROCESSED"C ISEGT = CURRENT SEGMENT TYPE-C IOPVA = NUMERIC VALUE OF CURRENT OPCODEN,C IARG = FIRST COLUMN OF ARGUMENT FIELD)C IERRI = ERROR INDICATORS FOR OUTPUTE%C ITYPE = INSTRUCTION TYPE NUMBER *C INDET = SYMBOL TABLE TEMPORARY INDEX%C IN = CARD IMAGE INPUT BUFFERM,C IDUM1 = DUMMY VARIABLE FOR PORTABILITY,C IDUM2 = DUMMY VARIABLE FOR PORTABILITY'C MBIN = GENERALIZED INTEGER ARRAYN$C NBIN = GENERALIZED REAL ARRAY+C MCSPT = MACRO BUFFER STARTING POINTER )C MCEPT = MACRO BUFFER ENDING POINTERV3C IPLUS = HOST REPRESENTATION OF PLUS CHARACTERI4C IMIN = HOST REPRESENTATION OF MINUS CHARACTER0C IMULT = HOST REPRESENTATION OF AN ASTERISK,C IDIV = HOST REPRESENTATION OF A SLASH=C IGRAT = HOST REPRESENTATION OF A GREATER THAN CHARACTERU:C ILESS = HOST REPRESENTATION OF A LESS THAN CHARACTER8C IRPAR = HOST REPRESENTATION OF A RIGHT PARENTHESIS7C ILPAR = HOST REPRESENTATION OF A LEFT PARENTHESIS ,C IBLNK = HOST REPRESENTATION OF A BLANK0C ISEMI = HOST REPRESENTATION OF A SEMICOLON,C ICOMM = HOST REPRESENTATION OF A COMMA*C ICTAB = HOST REPRESENTATION OF A TAB-C IPER = HOST REPRESENTATION OF A PERIOD ,C ICOLN = HOST REPRESENTATION OF A COLON6C IQUOT = HOST REPRESENTATION OF A QUOTE CHARACTER2C IDOLR = HOST REPRESENTATION OF A DOLLAR SIGN0C IAST = HOST REPRESENTATION OF AN ASTERISK/C ICAT = HOST REPRESENTATION OF AN AT SIGNO4C IQUES = HOST REPRESENTATION OF A QUESTION MARK1C IAMP = HOST REPRESENTATION OF AN AMPERSAND <C ICHRA - ICHRZ = HOST REPRESENTATIONS OF CHARACTERS A-Z%C IALPH = ASSEMBLER CHARACTER SETTC LTITL = ARRAY FOR TITLET9C MDISK = TABLE OF STARTING RECORD NUMBERS FOR MACROSC8C MPARC = NUMBER OF PARAMETERS IN A MACRO DEFINITIONC MCNAM = MACRO NAME TABLE2C MCNT = MACRO COUNT (TOTAL NUMBER OF MACROS)>C IFPAR = ARRAY FOR CONDITIONAL INFORMATION DURING NESTING C IEND = END CARD INDICATOR+C MXREF = SIZE OF CROSS REFERENCE TABLET#C IXTAB = CROSS REFERENCE ARRAY )C IXT = CROSS REFERENCE DISK RECORDH0C IXPNT = POINTER INTO CROSS REFERENCE TABLE-C IXCNT = NUMBER OF CROSS REFERENCE PAGES 0C IXPAG = CROSS REFERENCE MAXIMUM PAGE COUNTC IPASS = PASS INDICATORCIC 2C THE MAIN ROUTINE CALLS THE MAJOR SUBROUTINESC CT< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECSB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLO@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTTB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOCNBC THE FOLLOWING DEFINE FILE STATEMENTS DEFINE THE INTERMEDIATEGC FILE AND THE MACRO SOURCE FILE USED BY THIS ASSEMBLER. THESE ARETGC STANDARD IBM STATEMENTS. THE INTERMEDIATE FILE DEFINED (SYMBOLICIEC FILE NUMBER 7) CONSISTS OF 1000 95-WORD RECORDS. U INDICATES ALBC BINARY FILE. THE NAME IMREC IS THE RECORD INDEX. THE MACRO1C SOURCE FILE IS DEFINED IN A SIMILAR MANNER.MBC VARIOUS COMPUTERS DEFINE FILES IN DIFFERENT WAYS. THIS FILE<C MIGHT HAVE TO BE DEFINED DIFFERENTLY ON YOUR COMPUTER.@C ALSO NOTE THAT THE INTERMEDIATE FILE COULD BE A TAPE FILE.CS+C--> ROUTINE TO GET FILE NAME FROM OPERATORTC C FOR THE MOMENT ACE C SOURCE,OBJECT, & LISTING FILES2C WILL HAVE THE SAME NAME AND DIFFERENT EXTENSIONS+C I.E. PROGRAM.ASM,PROGRAM.OBS,PROGRAM.LSTYC *.ASM,*.OBS,*.LST ARE FIXEDECDC--> C LOCAL DATAC  LOGICAL*1 FILE(32) DATA FILE/30*"40,2*"0/C INTEGER*2 IQTC  WRITE(1,99900)I99900 FORMAT(' FILE: ',$)C " READ(1,99910) IQ,(FILE(I),I=1,IQ)99910 FORMAT(Q,22A1)C CO%C---> CALL ASSIGNMENTS FOR ASM80R.FTNBC CE C OBJECT FILE>CU FILE(IQ+1) = "56 ! "." FILE(IQ+2) = "117 ! "O"O FILE(IQ+3) = "102 ! "B", FILE(IQ+4) = "123 ! "S"V IIQ=IQ+4NC  CALL ASSIGN (4,FILE,IIQ) CE C SOURCE FILERCA FILE(IQ+2) = "101 ! "A", FILE(IQ+3) = "123 ! "S" FILE(IQ+4) = "115 ! "M"GCL CALL ASSIGN (5,FILE,IIQ)*C,C LISTING FILECR FILE(IQ+2) = "114 ! "L"I FILE(IQ+3) = "123 ! "S") FILE(IQ+4) = "124 ! "T"LC) CALL ASSIGN (6,FILE,IIQ)ACC TEMPORARY WORK FILEGCN FILE(IQ+2) = "124 ! "T" FILE(IQ+3) = "115 ! "M"Q FILE(IQ+4) = "120 ! "P"2C  CALL ASSIGN (7,FILE,IIQ) C2!C MACRO DEFINTION TEMPORARY FILEVCI FILE(IQ+2) = "115 ! "M"( FILE(IQ+3) = "104 ! "D"F FILE(IQ+3) = "106 ! "F"1C  CALL ASSIGN (8,FILE,IIQ) CCF$ DEFINE FILE 7(1000,95,U,IMREC)$ DEFINE FILE 8(200,128,U,MCREC)8C DEFINE FILE 4(200,72,U,IOREC) !!! NOT USED TWH 1/23/79C CALL INIT4 CALL PASS1 CALL PASS2 WRITE(IPRT,1020) IERRS,1020 FORMAT(//,21H ASSEMBLER ERRORS =,I5) IF(LSYM+LREF) 400,400,1001"100 WRITE(IPRT,1000) LTITL,IPAGE+1000 FORMAT(1H1,35X,50A1,9X,5HPAGE ,I4,//)V IF(LREF) 200,200,250200 WRITE(IPRT,1010)#1010 FORMAT(32X,12HSYMBOL TABLE,/) LINE = 4 GO TO 300250 WRITE(IPRT,1011)'1011 FORMAT(30X,15HCROSS REFERENCE,//,0, 1 15H LABEL VALUE,7X,9HREFERENCE,/) LINE = 6300 CALL SYMTA400 WRITE(IPRT,1001)1001 FORMAT(1H1)L CALL SPOOL(6,IERR)P CALL DELETE(7,IERR) CALL DELETE(8,IERR) CALL EXIT END  SUBROUTINE INIT0CC 1C THIS SUBROUTINE INITIALIZES ALL THE VARIOUSX%C VARIABLES USED BY THE ASSEMBLER)C0C0< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)" DIMENSION ISTYP(3),ICARR(26), DIMENSION NALPH(59),NTITL(29),IPRE(56)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOD EQUIVALENCE (LCABS,LCCNT(1)),(LTABS,LTCNT(1)),(IATYP,ISTYP(1))" EQUIVALENCE (ICARR(1),ICHRA)" EQUIVALENCE (IATYP,ISTYP(1))D EQUIVALENCE (NRFL1,NRFLG(1)),(NRFL2,NRFLG(2)),(NRFL3,NRFLG(3))D EQUIVALENCE (NRFL4,NRFLG(4)),(NRFL5,NRFLG(5)),(NRFL6,NRFLG(6))3 EQUIVALENCE (NRFL7,NRFLG(7)),(NRFL8,NRFLG(8)) CM@C SOME COMPUTERS DO NOT ACCEPT THE FULL ASCII CHARACTER SET.CC THEREFORE SOME OF THE CHARACTERS DEFINED BELOW MAY BE ILLEGALTCC ON YOUR MACHINE. IF THIS IS THE CASE, THE ILLEGAL CHARACTERS1HC SHOULD BE REPLACED BY VALID CHARACTERS. IF THE ILLEGAL CHARACTERSGC ARE NOT USED IN THE ASSEMBLER LANGUAGE, REPLACE THEM WITH BLANKS.RCC IF THE ILLEGAL CHARACTERS ARE USED IN THE ASSEMBLER LANGUAGE,R3C REPLACE THEM WITH ANY OTHER VALID CHARACTERS.FFC THE ILLEGAL CHARACTERS MUST BE CHANGED IN THE FOLLOWING TWO DATA C ARRAYS.HCCD DATA NALPH( 1),NALPH( 2),NALPH( 3),NALPH( 4) /1H0,1H1,1H2,1H3/D DATA NALPH( 5),NALPH( 6),NALPH( 7),NALPH( 8) /1H4,1H5,1H6,1H7/D DATA NALPH( 9),NALPH(10),NALPH(11),NALPH(12) /1H8,1H9,1HA,1HB/D DATA NALPH(13),NALPH(14),NALPH(15),NALPH(16) /1HC,1HD,1HE,1HF/D DATA NALPH(17),NALPH(18),NALPH(19),NALPH(20) /1HG,1HH,1HI,1HJ/D DATA NALPH(21),NALPH(22),NALPH(23),NALPH(24) /1HK,1HL,1HM,1HN/D DATA NALPH(25),NALPH(26),NALPH(27),NALPH(28) /1HO,1HP,1HQ,1HR/D DATA NALPH(29),NALPH(30),NALPH(31),NALPH(32) /1HS,1HT,1HU,1HV/D DATA NALPH(33),NALPH(34),NALPH(35),NALPH(36) /1HW,1HX,1HY,1HZ/? DATA NALPH(37),NALPH(38),NALPH(39),NALPH(40) /1H ,1H!,1H",1H#/ND DATA NALPH(41),NALPH(42),NALPH(43),NALPH(44) /1H$,1H%,1H&,1H'/D DATA NALPH(45),NALPH(46),NALPH(47),NALPH(48) /1H(,1H),1H*,1H+/D DATA NALPH(49),NALPH(50),NALPH(51),NALPH(52) /1H,,1H-,1H.,1H//D DATA NALPH(53),NALPH(54),NALPH(55),NALPH(56) /1H:,1H;,1H<,1H=/@ DATA NALPH(57),NALPH(58),NALPH(59) /1H>,1H?,1H@/G DATA NBLNK,NQUOT,NPLUS,NMIN,NGRAT,NLESS /1H ,1H',1H+,1H-,1H>,1HC OPERATION. A STANDARD READ OR WRITE AS USED BY IBM, DEC9C AND SOME OTHERS, AND A CALL TO A SYSTEM I/O ROUTINEE@C AS USED BY H.P. AND SOME OTHERS.(FOR INFORMATIVE PURPOSES)CC THE RECORD NUMBER (ASSOCIATED VARIABLE) FOR RANDOM ACCESS I/OT+C IS PASSED INTO THE ROUTINE VIA COMMONLC/CO< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)> DIMENSION NAMEI(3),NAMEM(3),NAMEP(3),MCBUF(80),IMBUF(95)$ DIMENSION MCORE(128),IPBUF(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT0B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO EQUIVALENCE(LC,IMBUF(1))" EQUIVALENCE (IN(1),MCBUF(1))" EQUIVALENCE (IPBUF(1),IN(1))$ EQUIVALENCE (MCORE(1),MBIN(1))6 DATA NAMEI(1),NAMEI(2),NAMEI(3) /2HIM,2HFL,2HE /6 DATA NAMEM(1),NAMEM(2),NAMEM(3) /2HMC,2HFL,2HE /6 DATA NAMEP(1),NAMEP(2),NAMEP(3) /2HOB,2HFL,2HE /CHC *ENTRY PARAMETERSMC NCTL - I/O CONTROL WORDC)C *EXIT PARAMETERS!C I/O READ OR WRITE PERFORMEDNC 1 = READ SOURCEM(C 2 = READ INTERMEDIATE FILE!C 3 = READ MACRO FILE+C 4 = READ CROSS REFERENCE FILEI)C 5 = WRITE INTERMEDIATE FILE "C 6 = WRITE MACRO FILE,C 7 = WRITE CROSS REFERENCE FILE*C 8 = WRITE OBJECT MODULE FILEC/C 1 GO TO(100,200,300,400,500,600,700,800),ICTL/CHC READ SOURCEM100 READ(ICRD,1000) IN1000 FORMAT(80A1) RETURNC READ INTERMEDIATE FILE200 READ(IMFLE'IMREC) IMBUF -C CALL EXEC(14,1091,IMBUF,95,NAMEI,IMREC)T RETURNC READ MACRO FILEF300 READ(MCFLE'MCREC) MCBUFO-C CALL EXEC(14,1091,MCBUF,80,NAMEM,MCREC)E RETURNC READ CROSS REFERENCE FILEI400 READ(MCFLE'MCREC) MCORES.C CALL EXEC(14,1091,MCORE,128,NAMEM,MCREC) RETURNC WRITE INTERMEDIATE FILE,500 WRITE(IMFLE'IMREC) IMBUF-C CALL EXEC(15,1091,IMBUF,95,NAMEI,IMREC)0 RETURNC WRITE MACRO FILE600 WRITE(MCFLE'MCREC) MCBUF-C CALL EXEC(15,1091,MCBUF,80,NAMEM,MCREC)9 RETURN C WRITE CROSS REFERENCE FILE+700 WRITE(MCFLE'MCREC) (IXTAB(I),I=1,128)O.C CALL EXEC(15,1091,IXTAB,128,NAMEM,MCREC) RETURNC WRITE OBJECT MODULE FILE)800 WRITE(IPCH,1000) (IPBUF(K),K=1,IPLEN)A-C CALL EXEC(15,1091,IPBUF,72,NAMEP,IOREC)E RETURN ENDD SUBROUTINE PASS1CLCMFC THIS SUBROUTINE EXECUTES THE PSEUDO-OPS THAT NEED TO BE EXECUTEDAC DURING PASS 1, PROCESSES SYMBOLS IN THE LABEL FIELD, STORESEGC INFORMATION IN THE INTERMEDIATE FILE WHICH IS USED DURING PASS 2,E@C STORES THE MACRO DEFINITIONS ON THE MACRO SOURCE FILE, ANDFC INCREMENTS THE LOCATION COUNTER FOR EACH INSTRUCTION MAKING ROOM$C FOR THE RESULTING OBJECT CODE.C)C1 REAL LENBS< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)# DIMENSION ISTYP(3),MCALL(512)D? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECMB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLD@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTNB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO3 EQUIVALENCE (IERR1,IERRI(1)),(IERR2,IERRI(2)) " EQUIVALENCE (ISTYP(1),IATYP)1 EQUIVALENCE (IBIN1,IBIN(1)),(IBIN2,IBIN(2))M% EQUIVALENCE (MCALL(1),IXTAB(1)),CE2C INITIALIZE IF STATEMENT NESTING LEVEL NUMBER IFSET = 0I IFON = 0"C INITIALIZE IF STATEMENT FLAG IFCTL = 2H!C INITIALIZE MACRO PARAMETERSI NEST = 0 LEVEL = 0O MCSPT = 1A MCEPT = 1)!C INITIALIZE ERROR INDICATORSM100 IERR1 = IBLNKX IERR2 = IBLNKO IOPVA = 0C LEN = 01 INDEX = 0) ITYPE = 0E(C INITIALIZE INDEX INTO SYMBOL TABLE INDET = 0I&C INITIALIZE CURRENT COLUMN NUMBER ICOL = IFCOL,C INITIALIZE BYTE COUNT FOR DS DIRECTIVE LENBS = 0  IF(MAC-1) 110,110,120TC READ SOURCE FROM CARDS110 CALL INOUT(1)N GO TO 130R'C READ SOURCE FROM MACRO DEFINITIONO120 CALL MCREF ICOL = IFCOL! IF(IERR2-IBLNK) 150,130,150C CHECK FOR A COMMENT 130 ICHAR = IN(ICOL)135 CONTINUE IF(ICHAR-IAST) 140,150,140!140 IF(ICHAR-ISEMI) 160,150,160I 150 IF(IFCTL-2) 2850,7900,2850C CHECK FOR A LABELT160 IF(ICHAR-IBLNK) 165,400,165L165 IF(ICHAR-ICTAB) 170,400,170 170 IF(INDET) 180,180,8200C GET AND PROCESS LABELT180 MODE = 0 CALL LABEL IF(IFCTL-2) 400,190,400 :C NEXT CHARACTER SOULD BE BLANK,TAB,COLON OR SEMICOLON!190 IF(ICHAR-IBLNK) 200,230,200I!200 IF(ICHAR-ICOLN) 205,220,205C!205 IF(ICHAR-ISEMI) 210,230,210I#210 IF(ICHAR-ICTAB) 8100,230,8100I220 ICOL = ICOL+1 (230 GO TO(8800,240,8100,260,8350),IERR240 DO 250 I=1,IWORD ITAB(I,INDEX) = NAME(I)F250 CONTINUE&260 ITABS(INDEX) = ISEGT+IPUBF*IPUBT ITABV(INDEX) = LC,300 INDET = INDEXN LDUP = IERR8"C GET AND PROCESS OPCODE FIELD400 CALL OPCOD IF(IFCTL-2) 430,410,430S,410 GO TO(600,8200,8200,7900,420,170),IERR/C NO OPCODE ON LINE, CHECK IF LABEL PRESENT 420 IF(INDET) 9000,8200,9000)C CHECK IF THIS IS A CONDITIONAL LOOP0$C CHECK FOR IF,ENDIF,ELSE OR END 430 IF(ICHK-1015) 440,2500,440 440 IF(ICHK-1018) 450,2800,450 450 IF(ICHK-1006) 460,1600,460!460 IF(ICHK-1014) 2850,470,2850I470 IF(IFSET-16) 480,8250,480L480 IFSET = IFSET+1N IFPAR(IFSET) = 0 GO TO 2850CPFC IF AN ASSEMBLER DIRECTIVE OR A MACRO REFERENCE WAS THE OPERATIONAC PROCESS IT NOW IF NECESSARY, OTHERWISE PROCESS IT IN PASS 2ICA600 IF(ITYPE-2) 800,4000,50000>800 GO TO(1100,1200,1300,1400,1500,1600,9000,1800,1900,2000,? 1 9000,2200,9000,2400,2500,2600,2700,2800,9000,3000,3100,41 2 3200,3300,3400,3500,3600,8250,2700),IOPVA 8C PROCESS ORIGIN *** ORG1100 CALL SCAN5 IF(IERRF) 1110,1110,80001110 IF(IRTYP) 1120,1140,1120$1120 IF(IRTYP-IEXTT) 1130,8550,1130$1130 IF(IRTYP-ISEGT) 8550,1140,85501140 LC = IVALR"C SET VALUE IF ORG HAS A LABEL$ IF(IERR1-ICHRD) 1150,8000,11501150 IF(INDET) 8000,8000,12608C PROCESS EQUATE DIRECTIVE *** EQU$1200 IF (IERR1-ICHRD) 1210,7900,12101210 IF(INDET) 8700,8700,12201220 LSET = 01230 IPVAL = 07 ITABV(INDET) = 0% ITABS(INDET) = IPUBF*IPUBT+LSET*1240 IPUBS = IPUBF CALL SCAN IF (IERRF) 1250,1250,8000$1250 IF (IRTYP-IEXTT) 1260,8550,12601260 IPVAL = IVAL ITABV(INDET) = IVALT+ ITABS(INDET) = IRTYP+IPUBS*IPUBT+LSET  GO TO 8000<C PROCESS DEFINE DATA *** DATA,DB1300 IBYTE = 1 1310 LEN = IBYTED" IF(IARG-MCOL) 1320,1320,86001320 CALL MSCAN(IPCNT,3)7 LEN = LLEN*IBYTE GO TO 90007C PROCESS DEFINE STORAGE *** DS1400 CALL SCAN) IF(IERRF) 8000,1410,80001410 IF(IRTYP) 8550,1420,85501420 LENBS = IVAL GO TO 8000<C PROCESS DEFINE WORD *** ACON,DW1500 IBYTE = 2N GO TO 13108C PROCESS END DIRECTIVE *** END1600 IEND = 1 I = ISEGT+1 LCCNT(I) = LC0 LTCNT(I) = LCLEN GO TO 90008C PROCESS DOUBLE BYTE DIRECTIVE *** DDB1800 IBYTE = 20 GO TO 13109C PROCESS LIST DIRECTIVE *** LIST)1900 LSET = 1 GO TO 2010:C PROCESS NLIST DIRECTIVE *** NLIST2000 LSET = 0"2010 IF (IARG-MCOL) 2020,2020,9000'2020 IF(IN(ICOL)-ICHRI) 2040,2030,2040 2030 LIF = LSET2040 ICOL1 = ICOL+1 ICOL = ICOL1+1( IF(IN(ICOL1)-ICOMM) 9000,2020,90008C PROCESS SET DIRECTIVE *** SET2200 IF(INDET) 8700,8700,2210$2210 IF(IERR1-IBLNK) 2220,2240,22202220 I = ITABI/128  I = I-(I/2)*2C IF (I) 7900,7900,22302230 IERR1 = IBLNK2240 LSET = ISETT GO TO 12407C PROCESS IF DIRECTIVE *** IFI2400 CALL SCAN0 IF(IERRF) 8000,2410,80002410 IF(IRTYP) 8550,2420,85502420 IFON = 2 IF(IVAL) 2440,2430,2440 2430 IFON = 12440 IFCTL = IFON! IF(IFSET-16) 2450,8250,82502450 IFSET = IFSET+1T IFPAR(IFSET) = IFON+IFON GO TO 8000:C PROCESS ENDIF DIRECTIVE *** ENDIF 2500 IF(IFSET-1) 8250,2510,25202510 IFCTL = 27 IFSET = 0R GO TO 90002520 IFSET = IFSET-1T IFCTL = IFPAR(IFSET)/2 GO TO 2840:C PROCESS THE MACRO DIRECTIVE *** MACRO2600 IF(INDET) 8700,8700,26052605 I = ITAB(1,INDET)  IF(LDUP-2) 2615,2610,261502610 ITAB(1,INDET) = 0  ITABS(INDET) = 02615 IERR1 = IBLNK MM = INDETF INDET =0 2620 IF(MAC-1) 8250,2630,8250#2630 IF(MCNT-MXMAC) 2640,8350,8350E2640 MCNT = MCNT+1  DO 2650 LL=1,IWORD MCNAM(LL,MCNT) = ITAB(LL,MM)T2650 CONTINUE MCNAM(1,MCNT) = I02660 CALL MCDEF IF(IEND) 2665,100,26652665 ISN = ISN-1  ITYPE = 1S GO TO 90009C PROCESS ENDM DIRECTIVE *** ENDM52700 IF(MAC-1) 8250,8250,2710 2710 IF(MCSPT-1) 2730,2730,27202720 MCEPT = MCSPT-1  MCSPT = MCALL(MCEPT) MCEPT = MCEPT-1E MCREC = MCALL(MCEPT) MCEPT = MCEPT-10 GO TO 27402730 MCEPT = 16 MAC = 1+2740 NEST = 0# IF(IERR1-IBLNK) 9000,100,9000L9C PROCESS ELSE DIRECTIVE *** ELSEL2800 IF(IFSET) 8250,8250,28102810 IFON = IFPAR(IFSET)/2 & IELSE = IFPAR(IFSET)-(IFON+IFON) IF(IFON) 2850,2850,2820 2820 IF(IELSE) 2830,2830,82502830 IFCTL = 3-IFON" IFPAR(IFSET) = IFCTL+IFCTL+1 GO TO 9000 2840 IF(IFCTL-1) 2850,2850,90002850 IF(LIF) 7900,100,7900E9C PROCESS ABSOLUTE SEGMENT *** ASEG 3000 I = 0  GO TO 32109C PROCESS CODE SEGMENT *** CSEG 3100 I = 1E GO TO 32109C PROCESS DATA SEGMENT *** DSEG0 3200 I = 2R3210 LL = ISEGT+1 LCCNT(LL) = LC LTCNT(LL) = LCLEN2 ISEGT = I8 I = I+18 LC = LCCNT(I)F LCLEN = LTCNT(I)C CHECK FOR PAGE TYPE  IF (I-1) 3220,9000,3220 3220 LL = 32 IF (ICOL-MCOL) 3230,3230,3250 3230 LL = 2 ' IF(IN(ICOL)-ICHRP) 3240,3250,3240 3240 LL = 1' IF(IN(ICOL)-ICHRI) 8600,3250,8600S!3250 IF(ISTYP(I)) 3270,3260,3270 3260 ISTYP(I) = LL  GO TO 9000$3270 IF(ISTYP(I)-LL) 8600,9000,8600C PROCESS PUBLIC SYMBOL3300 LSET = 63 GOTO 3405C PROCESS EXTERNAL SYMBOL3400 LSET = IEXTTC 3405 LL = 0S 3410 MODE = 0 CALL LABEL % GOTO (3420,3440,8600,3430,8350),IERR)%3420 IF(LSET+IPUBF-63) 3430,3422,3430 !3422 IF(ITABI-128) 3424,3430,3430I3424 K = ITABI - (ITABI/8) * 8 IF (K-IEXTT) 3426,3430,3426(C ALREADY DEFINED SYMBOL - SET TO PUBLIC3426 ITABS(INDEX) = ITABI+IPUBT GOTO 3460C SET DEFINED FLAG 3430 LL = 1Y GOTO 3460C PUT SYMBOL INTO TABLEF3440 DO 3445 I=1,IWORD ITAB(I,INDEX) = NAME(I) 3445 CONTINUE  ITABS(INDEX) = LSET IF (LSET-IEXTT) 3460,3450,3460 C SET EXTERNAL INDEX3450 ITABV(INDEX) = NUMEXE NUMEX = NUMEX+13460 IF (NERR-2) 3480,3470,8600(3470 ICOL = ICOL+1 GOTO 34103480 IF (LL) 8850,9000,885039C PROCESS NAME DIRECTIVE *** NAME3!3500 IF(MNAME(6)) 3510,8250,3510S"3510 IF(ICOL-MCOL) 3520,3520,86003520 CALL SYMBL IF(IERR-1) 8600,3530,8600 3530 MNAME(6) = 0 DO 3540 I=1,IWORD4 MNAME(I) = NAME(I)3540 CONTINUE GO TO 9000:C SET STACK LENGTH *** STKLN3600 CALL SCAND IF(IERRF) 3610,3610,80003610 IF(IRTYP) 8550,3620,85503620 ISTKL = IVAL GO TO 8000CG 7900 LEN = 0I ITYPE = -1 GO TO 9000CAC PROCESS MACRO REFERENCE C*4000 IF(MAC-1) 4020,4020,40054005 IF(NEST) 4010,4010,8450 2C NESTED MACRO CALLS - SAVE CURRENT PARAMETERS(4010 IF(MCEPT-(MXREF-3)) 4015,8450,84504015 MCEPT = MCEPT+1  MCALL(MCEPT) = MCREC MCEPT = MCEPT+10 MCALL(MCEPT) = MCSPT MCSPT = MCEPT+1  MAC = MAC+1A<C GET PARAMETER COUNT AND SET UP TABLE IF ANY PARAMETERS4020 MCEPT = MCSPT-1  MAC = MAC-1  IPCNT = MPARC(IOPVA)/40 # NOPAR = MPARC(IOPVA)-IPCNT*40  MM = NOPAR NEST = 1 MCREC = MDISK(IOPVA) IF(NOPAR) 4400,4400,4100C SET UP PARAMETER TABLE4100 ICOL = IARGE4110 ISTA = ICOL(" IF(ISTA-MCOL) 4120,4300,43004120 MCEPT = MCEPT+1L MCALL(MCEPT) = 0 CALL MSCAN(NOPAR,2)L ICOL1 = ICOL-1' IF(IN(ISTA)-ILESS) 4150,4130,4150 (4130 IF(IN(ICOL1)-IGRAT) 4150,4140,41504140 ISTA = ISTA+10 ICOL1 = ICOL1-1 4150 ID = ICOL1-ISTAP IF(ID) 4230,4200,4200 +4200 IF(MCEPT+ID-(MXREF-5)) 4210,4210,4510P4210 DO 4220 I=ISTA,ICOL1 MCEPT = MCEPT+1  MCALL(MCEPT) = IN(I)4220 CONTINUE%C CHECK FOR ADDITIONAL PARAMETERS 4230 MM = MM-1  IF(MM) 4400,4400,42400$4240 IF(ICHAR-ICOMM) 4310,4250,43104250 ICOL = ICOL+1L( IF(MCEPT-(MXREF-3)) 4110,4510,4510"C CHECK IF ANY NULL PARAMETERS4300 IF(MM) 4400,4400,4310 4310 IF(IPCNT) 4500,4500,4320(4320 IF(MCEPT-(MXREF-3)) 4330,4510,45104330 DO 4340 I=1,MM MCEPT = MCEPT+10 MCALL(MCEPT) = 04340 CONTINUE(C CHECK IF ANY LOCAL SYMBOLS DEFINED4400 IF(IPCNT) 4500,4500,44104410 DO 4430 I=1,IPCNT ( IF(MCEPT-(MXREF-8)) 4420,4510,45104420 MCEPT = MCEPT+1M MCALL(MCEPT) = 0 MCEPT = MCEPT+14 MCALL(MCEPT) = IQUES MCEPT = MCEPT+1E MCALL(MCEPT) = IQUES ID = 1000  L = LEVEL  LEVEL = LEVEL+1 DO 4430 LL=1,4 N = 1+L/ID MCEPT = MCEPT+14 MCALL(MCEPT) = IALPH(N) L = L-(N-1)*ID ID = ID/104430 CONTINUEC PUT IN LIST TERMINATOR4500 NEST = 04510 MCEPT = MCEPT+10 MCALL(MCEPT) = -1  IF(NEST) 9000,9000,8450EC)C SET LENGTH OF INSTRUCTIONCC+ 5000 LEN = 1( IF(ITYPE-8) 9000,5080,5010!5010 IF(ITYPE-11) 5090,5080,9000 5080 LEN = 2E GO TO 9000 5090 LEN = 3  GO TO 9000C C SET ERROR FLAGS CE/8000 GO TO(9000,8900,8600,8500,8400,8550),IERR C LABEL ERROR8100 IERR1 = ICHRLI 8150 LEN = 3  GO TO 9000C OPCODE ERROR 8200 LEN = 3 8250 IERR2 = ICHROT GO TO 9000C VALUE ERRORP8300 IERR2 = ICHRVP GO TO 9000C TABLE OVERFLOW ERROR8350 IERR2 = ICHRTN GO TO 9000C SYNTAX ERROR8400 IERR2 = ICHRS, GO TO 9000C NESTING ERROR 8450 IERR2 = ICHRN  GO TO 9000C UNDEFINED SYMBOL8500 IERR2 = ICHRUR GO TO 9000C RELOCATION ERROR8550 IERR2 = ICHRE  GO TO 9000C ARGUMENT ERROR8600 IERR2 = ICHRA  GO TO 90001C MISSING LABEL ON EQU,SET OR MACRO DIRECITVER8700 IERR1 = ICHRM GO TO 9000C DUPLICATE LABEL ERROR 8800 IERR1 = ICHRDL GO TO 300C DUPLICATE LABEL ERRORO8850 IERR1 = ICHRDX GO TO 9000C FORMAT ERROR8900 IERR2 = ICHRFN'C WRITE RECORD TO INTERMEDIATE FILET9000 IMREC = ISNI ISN = ISN+1E CALL INOUT(5)O IF(MAC) 9020,9010,9020 9010 MAC = 2 9020 IVAL = LEN LC = LC+IVAL+LENBS" IF(LC-65536.) 9040,9030,90309030 LC = LC-65536.!9040 IF(LC-LCLEN) 9060,9060,9050V9050 LCLEN = LCC CHECK FOR END CARD9060 IF(IEND) 9070,100,9070 9070 RETURN END  SUBROUTINE PASS2CTCADC THIS ROUTINE PROCESSES INSTRUCTION ARGUMENTS, GENERATES OBJECT?C CODE, EXECUTES ALL PSEUDO-OPS NOT EXECUTED IN PASS 1, AND#C GENERATES THE OUTPUT LISTING.EC C < REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)< DIMENSION IBOUT(80),LCTL(8),LISTS(8),NCODE(8),ISTYP(3) DIMENSION IEXTF(80)0? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECNB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLE@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTTB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO$ EQUIVALENCE (IBIN(1),NCODE(1))A EQUIVALENCE (IBIN1,IBIN(1)),(IBIN2,IBIN(2)),(IBIN3,IBIN(3))I3 EQUIVALENCE (IERR1,IERRI(1)),(IERR2,IERRI(2)),: EQUIVALENCE (IBOUT(1),MDISK(1)),(IEXTF(1),MPARC(15))1 EQUIVALENCE (LCTL(1),LSOR),(IATYP,ISTYP(1))M1 EQUIVALENCE (IREL1,IREL(1)),(IREL2,IREL(2))IA DATA LISTS(1),LISTS(2),LISTS(3),LISTS(4),LISTS(5),LISTS(6), ; 1 LISTS(7),LISTS(8) /1HS,1HT,1HM,1HI,1HO,1HX,1HB,1HG/C  IPASS = 2T ISN = 1N IERR = 1 IEND = 0 LINE = IOLIN10 IMREC = ISNA ISN = ISN+1)CI/C READ NEXT CARD FROM THE INTERMEDIATE FILE CR CALL INOUT(2)E(C CHECK IF LABEL FOR CROSS REFERENCE IF(LREF) 50,50,20)20 IF(INDET) 50,50,3030 MODE = -1S INDEX = INDETA ITABI = 0( CALL XREFT(0)50 IBIN1 = IOPVAI MBYTF = 0I ICOL = IARGT DO 80 I=2,8T NCODE(I) = 080 CONTINUE IF(ITYPE-1) 9000,100,5000TC C PROCESS DIRECTIVESC100 ITYPE = -1>200 GO TO(7000,1200,1300,1400,1500,1600,1700,1800,1900,2000,? 1 2100,2200,2300,7000,9000,9000,9000,9000,9000,9000,9000,O0 2 9000,7000,7000,9000,9000,9000,9000),IOPVA8C PROCESS EQU DIRECTIVE *** EQU1200 IF(INDET) 9000,9000,12101210 ITABV(INDET) = IPVAL IREL1 = ITABS(INDET) IOPVA = 100  GO TO 7000<C PROCESS DATA DB DIRECTIVES *** DB,DATA1300 IBCNT = 01 IECNT = 0 MBYTF = 1 1305 CALL SCAN0 IF(LLEN-1) 1395,1330,13101C HAVE A STRING01310 DO 1320 LL=1,LLEN  IBCNT = IBCNT+10 IBOUT(IBCNT) = NBIN(LL),1320 CONTINUE GO TO 1395C HAVE A SINGLE EXPRESSION1330 LL = IVAL/256. IVAL2 = LL IF(IRTYP) 1340,1360,1340#1340 IF(IRTYP-ILOW) 1350,1360,13601350 IRTYP = IRTYP+ILOW LL = 21360 IF(LL) 1370,1390,1370 1370 IF(LL-255) 1380,1390,1380 1380 IERR2 = ICHRVA1390 IBCNT = IBCNT+1  IECNT = IECNT+1T IEXTF(IECNT) = IEXTI LL = IVAL-IVAL2*256. IBOUT(IBCNT) = LL+IRTYP*2561395 ICOL = ICOL+1 IF(IERR-2) 1840,1305,1840U7C PROCESS DEFINE STORAGE *** DS 1400 ITYPE = 1  GO TO 9000<C PROCESS DEFINE WORD *** DW,ACON 1500 L1 = 0 L2 = 1 GO TO 18108C PROCESS END *** END1600 IPVAL = 0L IREL1 = 11 IATYP = 0  IEND = 1 ITYPE = 1" IF(IARG-MCOL) 1610,1610,90001610 CALL SCAN  IF(IERRF) 1620,1620,80001620 IPVAL = IVAL IATYP = 1I K = IRTYP-(IRTYP/8)*8, IREL1 = K IF(K-IEXTT) 8000,1630,80001630 IREL1 = 0 GO TO 86009C PROCESS EJEC DIRECTIVE *** EJEC 1700 MODE = 4 IF(LSOR) 1710,9005,17101710 LINE = 100 GO TO 90058C PROCESS DOUBLE BYTE DIRECTIVE *** DDB 1800 L1 = 1 L2 = 01810 IBCNT = 0D IECNT = 0  MBYTF = 2R1815 CALL SCAN, IF(LLEN-1) 1840,1820,1842I1820 IECNT = IECNT+16 IEXTF(IECNT) = IEXTI IBCNT = IBCNT+2- I1 = IBCNT-L1R I2 = IBCNT-L2I I = IRTYP*256 K = IVAL/256. IBOUT(I1) = K+I  IVAL2 = KR K = IVAL-256.*IVAL2* IBOUT(I2) = K+I4 ICOL = ICOL+1, IF(IERR-2) 1840,1815,1840 /1840 GO TO(1850,1850,1842,1844,1846,1848),IERR C ARGUMENT ERROR1842 IERR2 = ICHRA2 GO TO 1850C UNDEFINED SYMBOL1844 IERR2 = ICHRU5 GO TO 1850C SYNTAX ERROR1846 IERR2 = ICHRS  GO TO 1850C RELOCATION ERROR1848 IERR2 = ICHREC OUTPUT DATA BYTE"1850 IF(IBCNT-LEN) 1855,1865,18651855 IBCNT = IBCNT+1  DO 1860 LL=IBCNT,LEN IBOUT(LL) = 0 1860 CONTINUE1865 IBCNT = 0  IECNT = 0L ITYPE = 1  MODE = 11870 LLEN = 01872 LLEN = LLEN+12 IBCNT = IBCNT+1 K = IBOUT(IBCNT)/256% IBIN(LLEN) = IBOUT(IBCNT)-K*256  IREL(LLEN) = K IF(K) 1874,1874,1880"1874 IF(IBCNT-LEN) 1876,1890,18901876 IF(LLEN-4) 1872,1890,1890 1880 IF(LLEN-1) 1884,1884,1882 1882 IBCNT = IBCNT-1D LLEN = LLEN-1C GO TO 18901884 IECNT = IECNT + 1 IEXTI = IEXTF(IECNT)I IF(MBYTF-1) 1890,1890,18861886 IBCNT = IBCNT+1N LLEN = LLEN+1 % IBIN(LLEN) = IBOUT(IBCNT)-K*2568 IREL2 = 021890 CALL LOUT CALL OUT MODE = 2  IERR1 = IBLNK IERR2 = IBLNK IVAL = LLENC LC = LC+IVAL IF(IBCNT-LEN) 1870,10,109C PROCESS LIST DIRECTIVE *** LIST-1900 LSET = 1 GO TO 2010:C PROCESS NLIST DIRECTIVE *** NLIST2000 LSET = 0"2010 IF(IARG-MCOL) 2020,2020,82002020 DO 2030 LL=1,8+ IF(IN(IARG)-LISTS(LL)) 2030,2040,2030 2030 CONTINUE GO TO 82002040 LCTL(LL) = LSETI ICOL1 = IARG+1 IARG = ICOL1+1 ICHAR = IN(ICOL1)D$ IF(ICHAR-IBLNK) 2050,9000,2050$2050 IF(ICHAR-ICOMM) 2060,2020,2060$2060 IF(ICHAR-ICTAB) 8200,9000,82009C PROCESS SPAC DIRECTIVE *** SPAC92100 CALL SCAN  IF(IERRF) 2110,2110,80002110 IARG = IVAL  MODE = 3 GO TO 90058C PROCESS SET DIRECTIVE *** SET2200 GO TO 1200:C PROCESS TITLE DIRECTIVE *** TITLE 2300 N = 1C" IF(IARG-MCOL) 2310,2310,8200'2310 IF(IN(IARG)-IQUOT) 8200,2320,8200I2320 IARG = IARG+1R ICOL = IARG+49 DO 2350 J=IARG,ICOL0 IF(J-MCOL) 2330,2330,2360 $2330 IF(IN(J)-IQUOT) 2340,2360,23402340 LTITL(N) = IN(J) N = N+112350 CONTINUE2360 IF(N-50) 2370,2370,90002370 DO 2380 J=N,50 LTITL(J) = IBLNK2380 CONTINUE GO TO 9000C C PROCESS INSTRUCTIONSC0 5000 IF(ITYPE-3) 9000,9000,5010C GET OPERAND 1 5010 CALL SCAN IF(IERRF) 5020,5020,8000 5020 IREG = 80 IF(IVAL-8.) 5025,5030,503005025 IREG = IVAL 5030 IF(ITYPE-8) 5040,5050,5050-C CHECK OPERAND TYPE - SHOULD BE ABSOLUTEO5040 IF(IRTYP) 8600,5050,8600!5050 IF(ITYPE-10) 5100,5060,5060TC GET OPERAND 2 5060 IF(IERR-2) 8300,5070,8300N5070 IF(IRTYP) 8600,5080,86005080 ICOL = ICOL+1T CALL SCAN0 IF(IERRF) 5100,5100,80005100 MULT = 89 GO TO(9000,9000,9000,5400,5500,5600,5700,5820,5950,E 1 5900,5800,6000),ITYPEC C ACCUMULATOR GROUP0C05400 MULT = 1CVC INR,DCR,RST3C5500 IF(IREG-7) 5510,5510,850085510 IBIN1 = IBIN1+IREG*MULTP GO TO 8000CEC LDAX,STAX CI5600 MULT = 2 GO TO 5710C1C INX,DCX,DAD,PUSH,POPCP5700 MULT = 6"5710 IF(IREG-MULT) 5720,5720,8500(5720 IF(IREG-(IREG/2)*2) 8500,5730,85005730 IBIN1 = IBIN1+8*IREG GO TO 8000C0C 2 BYTE IMMEDIATECO5800 IF(IREG-7) 5810,5810,8500,5810 IBIN1 = IBIN1+8*IREG5820 LL = IVAL/256. IVAL2 = LL IBIN2 = IVAL-IVAL2*256. IF(IRTYP) 5830,5850,5830#5830 IF(IRTYP-ILOW) 5840,5850,5850B5840 IRTYP = IRTYP+ILOW LL = 25850 IREL2 = IRTYP  IF(LL) 8000,8000,5860O5860 IF(LL-255) 8400,8000,8400UCPC 3 BYTE INSTRUCTIONS0CF5900 IF(IREG-7) 5910,8500,8500 (5910 IF(IREG-(IREG/2)*2) 8500,5920,85005920 IBIN1 = IBIN1+IREG*85950 IBIN3 = IVAL/256.Y IVAL2 = IBIN30 IBIN2 = IVAL-IVAL2*256.8 IREL2 = IRTYPR GO TO 8000C5 C MOVVC 6000 IF(IREG-7) 6010,6010,85006 6010 IF(IVAL-7.) 6020,6020,85006020 IF(IRTYP) 8600,6030,86006030 LL = IVALY IBIN1 = IBIN1+8*IREG+LL8" IF(IBIN1-118) 8000,8500,8000C0C5C GET REFERENCES FOR PASS 28CU7000 IF(LREF) 9000,9000,701007010 CALL SCANE ICOL = ICOL+1 IF(IERR-2) 9000,7010,90002C PROCESS ERRORSCN/8000 GO TO(9000,8700,8200,8100,8300,8600),IERR C UNDEFINED SYMBOL8100 IERR2 = ICHRU  GO TO 9000C ARGUMENT ERROR8200 IERR2 = ICHRAF GO TO 9000C SYNTAX ERROR8300 IERR2 = ICHRS GO TO 9000C VALUE ERROR 8400 IERR2 = ICHRVN GO TO 9000C REGISTER ERROR8500 IERR2 = ICHRR GO TO 9000C RELOCATION ERROR8600 IERR2 = ICHRE0 GO TO 9000C FORMAT ERROR8700 IERR2 = ICHRFI9000 MODE = 1C OUTPUT CURRENT LINES9005 LLEN = LEN CALL LOUT0 IF(IEND) 9010,9010,9020I9010 IF(LLEN) 10,10,9020C9020 CALL OUT IF(IEND) 10,10,9100R 9100 RETURN END  SUBROUTINE OPCODCXCR>C THE FOLLOWING DATA TABLE DEFINES ALL LEGAL MNEMONICS AND>C PSEUDO-OPS. EACH DATA STATEMENT CONSISTS OF FOUR OR SIXDC CHARACTERS REPRESENTING THE MNEMONIC OR PSEUDO-OP, FOLLOWED BY>C THE INSTRUCTION TYPE AND ITS DECIMAL NUMERIC EQUIVALENT.CCCI< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)& DIMENSION INST(5,101),INSTE(7,9)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLS@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT(B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOF DATA INST(1, 1),INST(2, 1),INST(3, 1),INST(4, 1),INST(5, 1) 1 /1HM,1HO,1HV,1H ,12064/IF DATA INST(1, 2),INST(2, 2),INST(3, 2),INST(4, 2),INST(5, 2) 1 /1HM,1HV,1HI,1H ,11006/AF DATA INST(1, 3),INST(2, 3),INST(3, 3),INST(4, 3),INST(5, 3) 1 /1HL,1HX,1HI,1H ,10001/IF DATA INST(1, 4),INST(2, 4),INST(3, 4),INST(4, 4),INST(5, 4) 1 /1HA,1HD,1HD,1H , 4128/NF DATA INST(1, 5),INST(2, 5),INST(3, 5),INST(4, 5),INST(5, 5) 1 /1HA,1HD,1HC,1H , 4136/(F DATA INST(1, 6),INST(2, 6),INST(3, 6),INST(4, 6),INST(5, 6) 1 /1HS,1HU,1HB,1H , 4144/(F DATA INST(1, 7),INST(2, 7),INST(3, 7),INST(4, 7),INST(5, 7) 1 /1HS,1HB,1HB,1H , 4152/(F DATA INST(1, 8),INST(2, 8),INST(3, 8),INST(4, 8),INST(5, 8) 1 /1HA,1HN,1HA,1H , 4160/(F DATA INST(1, 9),INST(2, 9),INST(3, 9),INST(4, 9),INST(5, 9) 1 /1HX,1HR,1HA,1H , 4168/(F DATA INST(1, 10),INST(2, 10),INST(3, 10),INST(4, 10),INST(5, 10) 1 /1HO,1HR,1HA,1H , 4176/(F DATA INST(1, 11),INST(2, 11),INST(3, 11),INST(4, 11),INST(5, 11) 1 /1HC,1HM,1HP,1H , 4184/(F DATA INST(1, 12),INST(2, 12),INST(3, 12),INST(4, 12),INST(5, 12) 1 /1HI,1HN,1HR,1H , 5004/(F DATA INST(1, 13),INST(2, 13),INST(3, 13),INST(4, 13),INST(5, 13) 1 /1HD,1HC,1HR,1H , 5005/(F DATA INST(1, 14),INST(2, 14),INST(3, 14),INST(4, 14),INST(5, 14) 1 /1HR,1HS,1HT,1H , 5199/(F DATA INST(1, 15),INST(2, 15),INST(3, 15),INST(4, 15),INST(5, 15) 1 /1HS,1HT,1HA,1HX, 6002/(F DATA INST(1, 16),INST(2, 16),INST(3, 16),INST(4, 16),INST(5, 16) 1 /1HL,1HD,1HA,1HX, 6010/(F DATA INST(1, 17),INST(2, 17),INST(3, 17),INST(4, 17),INST(5, 17) 1 /1HI,1HN,1HX,1H , 7003/(F DATA INST(1, 18),INST(2, 18),INST(3, 18),INST(4, 18),INST(5, 18) 1 /1HD,1HC,1HX,1H , 7011/(F DATA INST(1, 19),INST(2, 19),INST(3, 19),INST(4, 19),INST(5, 19) 1 /1HD,1HA,1HD,1H , 7009/(F DATA INST(1, 20),INST(2, 20),INST(3, 20),INST(4, 20),INST(5, 20) 1 /1HP,1HU,1HS,1HH, 7197/(F DATA INST(1, 21),INST(2, 21),INST(3, 21),INST(4, 21),INST(5, 21) 1 /1HP,1HO,1HP,1H , 7193/(F DATA INST(1, 22),INST(2, 22),INST(3, 22),INST(4, 22),INST(5, 22) 1 /1HA,1HD,1HI,1H , 8198/(F DATA INST(1, 23),INST(2, 23),INST(3, 23),INST(4, 23),INST(5, 23) 1 /1HA,1HC,1HI,1H , 8206/(F DATA INST(1, 24),INST(2, 24),INST(3, 24),INST(4, 24),INST(5, 24) 1 /1HS,1HU,1HI,1H , 8214/(F DATA INST(1, 25),INST(2, 25),INST(3, 25),INST(4, 25),INST(5, 25) 1 /1HS,1HB,1HI,1H , 8222/(F DATA INST(1, 26),INST(2, 26),INST(3, 26),INST(4, 26),INST(5, 26) 1 /1HA,1HN,1HI,1H , 8230/(F DATA INST(1, 27),INST(2, 27),INST(3, 27),INST(4, 27),INST(5, 27) 1 /1HX,1HR,1HI,1H , 8238/(F DATA INST(1, 28),INST(2, 28),INST(3, 28),INST(4, 28),INST(5, 28) 1 /1HO,1HR,1HI,1H , 8246/(F DATA INST(1, 29),INST(2, 29),INST(3, 29),INST(4, 29),INST(5, 29) 1 /1HC,1HP,1HI,1H , 8254/(F DATA INST(1, 30),INST(2, 30),INST(3, 30),INST(4, 30),INST(5, 30) 1 /1HI,1HN,1H ,1H , 8219/(F DATA INST(1, 31),INST(2, 31),INST(3, 31),INST(4, 31),INST(5, 31) 1 /1HO,1HU,1HT,1H , 8211/(F DATA INST(1, 32),INST(2, 32),INST(3, 32),INST(4, 32),INST(5, 32) 1 /1HS,1HH,1HL,1HD, 9034/(F DATA INST(1, 33),INST(2, 33),INST(3, 33),INST(4, 33),INST(5, 33) 1 /1HL,1HH,1HL,1HD, 9042/(F DATA INST(1, 34),INST(2, 34),INST(3, 34),INST(4, 34),INST(5, 34) 1 /1HS,1HT,1HA,1H , 9050/(F DATA INST(1, 35),INST(2, 35),INST(3, 35),INST(4, 35),INST(5, 35) 1 /1HL,1HD,1HA,1H , 9058/(F DATA INST(1, 36),INST(2, 36),INST(3, 36),INST(4, 36),INST(5, 36) 1 /1HJ,1HM,1HP,1H , 9195/(F DATA INST(1, 37),INST(2, 37),INST(3, 37),INST(4, 37),INST(5, 37) 1 /1HC,1HA,1HL,1HL, 9205/(F DATA INST(1, 38),INST(2, 38),INST(3, 38),INST(4, 38),INST(5, 38) 1 /1HJ,1HN,1HZ,1H , 9194/(F DATA INST(1, 39),INST(2, 39),INST(3, 39),INST(4, 39),INST(5, 39) 1 /1HJ,1HZ,1H ,1H , 9202/(F DATA INST(1, 40),INST(2, 40),INST(3, 40),INST(4, 40),INST(5, 40) 1 /1HJ,1HN,1HC,1H , 9210/(F DATA INST(1, 41),INST(2, 41),INST(3, 41),INST(4, 41),INST(5, 41) 1 /1HJ,1HC,1H ,1H , 9218/(F DATA INST(1, 42),INST(2, 42),INST(3, 42),INST(4, 42),INST(5, 42) 1 /1HJ,1HP,1HO,1H , 9226/(F DATA INST(1, 43),INST(2, 43),INST(3, 43),INST(4, 43),INST(5, 43) 1 /1HJ,1HP,1HE,1H , 9234/(F DATA INST(1, 44),INST(2, 44),INST(3, 44),INST(4, 44),INST(5, 44) 1 /1HJ,1HP,1H ,1H , 9242/(F DATA INST(1, 45),INST(2, 45),INST(3, 45),INST(4, 45),INST(5, 45) 1 /1HJ,1HM,1H ,1H , 9250/(F DATA INST(1, 46),INST(2, 46),INST(3, 46),INST(4, 46),INST(5, 46) 1 /1HC,1HN,1HZ,1H , 9196/(F DATA INST(1, 47),INST(2, 47),INST(3, 47),INST(4, 47),INST(5, 47) 1 /1HC,1HZ,1H ,1H , 9204/(F DATA INST(1, 48),INST(2, 48),INST(3, 48),INST(4, 48),INST(5, 48) 1 /1HC,1HN,1HC,1H , 9212/(F DATA INST(1, 49),INST(2, 49),INST(3, 49),INST(4, 49),INST(5, 49) 1 /1HC,1HC,1H ,1H , 9220/(F DATA INST(1, 50),INST(2, 50),INST(3, 50),INST(4, 50),INST(5, 50) 1 /1HC,1HP,1HO,1H , 9228/(F DATA INST(1, 51),INST(2, 51),INST(3, 51),INST(4, 51),INST(5, 51) 1 /1HC,1HP,1HE,1H , 9236/(F DATA INST(1, 52),INST(2, 52),INST(3, 52),INST(4, 52),INST(5, 52) 1 /1HC,1HP,1H ,1H , 9244/(F DATA INST(1, 53),INST(2, 53),INST(3, 53),INST(4, 53),INST(5, 53) 1 /1HC,1HM,1H ,1H , 9252/(F DATA INST(1, 54),INST(2, 54),INST(3, 54),INST(4, 54),INST(5, 54) 1 /1HH,1HL,1HT,1H , 3118/(F DATA INST(1, 55),INST(2, 55),INST(3, 55),INST(4, 55),INST(5, 55) 1 /1HR,1HL,1HC,1H , 3007/(F DATA INST(1, 56),INST(2, 56),INST(3, 56),INST(4, 56),INST(5, 56) 1 /1HR,1HR,1HC,1H , 3015/(F DATA INST(1, 57),INST(2, 57),INST(3, 57),INST(4, 57),INST(5, 57) 1 /1HR,1HA,1HL,1H , 3023/(F DATA INST(1, 58),INST(2, 58),INST(3, 58),INST(4, 58),INST(5, 58) 1 /1HR,1HA,1HR,1H , 3031/(F DATA INST(1, 59),INST(2, 59),INST(3, 59),INST(4, 59),INST(5, 59) 1 /1HR,1HE,1HT,1H , 3201/(F DATA INST(1, 60),INST(2, 60),INST(3, 60),INST(4, 60),INST(5, 60) 1 /1HR,1HN,1HZ,1H , 3192/(F DATA INST(1, 61),INST(2, 61),INST(3, 61),INST(4, 61),INST(5, 61) 1 /1HR,1HZ,1H ,1H , 3200/(F DATA INST(1, 62),INST(2, 62),INST(3, 62),INST(4, 62),INST(5, 62) 1 /1HR,1HN,1HC,1H , 3208/(F DATA INST(1, 63),INST(2, 63),INST(3, 63),INST(4, 63),INST(5, 63) 1 /1HR,1HC,1H ,1H , 3216/(F DATA INST(1, 64),INST(2, 64),INST(3, 64),INST(4, 64),INST(5, 64) 1 /1HR,1HP,1HO,1H , 3224/(F DATA INST(1, 65),INST(2, 65),INST(3, 65),INST(4, 65),INST(5, 65) 1 /1HR,1HP,1HE,1H , 3232/(F DATA INST(1, 66),INST(2, 66),INST(3, 66),INST(4, 66),INST(5, 66) 1 /1HR,1HP,1H ,1H , 3240/(F DATA INST(1, 67),INST(2, 67),INST(3, 67),INST(4, 67),INST(5, 67) 1 /1HR,1HM,1H ,1H , 3248/(F DATA INST(1, 68),INST(2, 68),INST(3, 68),INST(4, 68),INST(5, 68) 1 /1HX,1HC,1HH,1HG, 3235/(F DATA INST(1, 69),INST(2, 69),INST(3, 69),INST(4, 69),INST(5, 69) 1 /1HX,1HT,1HH,1HL, 3227/(F DATA INST(1, 70),INST(2, 70),INST(3, 70),INST(4, 70),INST(5, 70) 1 /1HS,1HP,1HH,1HL, 3249/(F DATA INST(1, 71),INST(2, 71),INST(3, 71),INST(4, 71),INST(5, 71) 1 /1HP,1HC,1HH,1HL, 3233/(F DATA INST(1, 72),INST(2, 72),INST(3, 72),INST(4, 72),INST(5, 72) 1 /1HC,1HM,1HA,1H , 3047/(F DATA INST(1, 73),INST(2, 73),INST(3, 73),INST(4, 73),INST(5, 73) 1 /1HS,1HT,1HC,1H , 3055/(F DATA INST(1, 74),INST(2, 74),INST(3, 74),INST(4, 74),INST(5, 74) 1 /1HD,1HA,1HA,1H , 3039/(F DATA INST(1, 75),INST(2, 75),INST(3, 75),INST(4, 75),INST(5, 75) 1 /1HC,1HM,1HC,1H , 3063/(F DATA INST(1, 76),INST(2, 76),INST(3, 76),INST(4, 76),INST(5, 76) 1 /1HE,1HI,1H ,1H , 3251/(F DATA INST(1, 77),INST(2, 77),INST(3, 77),INST(4, 77),INST(5, 77) 1 /1HD,1HI,1H ,1H , 3243/(F DATA INST(1, 78),INST(2, 78),INST(3, 78),INST(4, 78),INST(5, 78) 1 /1HN,1HO,1HP,1H , 3000/(F DATA INST(1, 79),INST(2, 79),INST(3, 79),INST(4, 79),INST(5, 79) 1 /1HR,1HI,1HM,1H , 3032/(F DATA INST(1, 80),INST(2, 80),INST(3, 80),INST(4, 80),INST(5, 80) 1 /1HS,1HI,1HM,1H , 3048/(F DATA INST(1, 81),INST(2, 81),INST(3, 81),INST(4, 81),INST(5, 81) 1 /1HO,1HR,1HG,1H , 1001/(F DATA INST(1, 82),INST(2, 82),INST(3, 82),INST(4, 82),INST(5, 82) 1 /1HE,1HQ,1HU,1H , 1002/(F DATA INST(1, 83),INST(2, 83),INST(3, 83),INST(4, 83),INST(5, 83) 1 /1HD,1HA,1HT,1HA, 1003/(F DATA INST(1, 84),INST(2, 84),INST(3, 84),INST(4, 84),INST(5, 84) 1 /1HD,1HB,1H ,1H , 1003/(F DATA INST(1, 85),INST(2, 85),INST(3, 85),INST(4, 85),INST(5, 85) 1 /1HD,1HS,1H ,1H , 1004/(F DATA INST(1, 86),INST(2, 86),INST(3, 86),INST(4, 86),INST(5, 86) 1 /1HA,1HC,1HO,1HN, 1005/(F DATA INST(1, 87),INST(2, 87),INST(3, 87),INST(4, 87),INST(5, 87) 1 /1HD,1HW,1H ,1H , 1005/(F DATA INST(1, 88),INST(2, 88),INST(3, 88),INST(4, 88),INST(5, 88) 1 /1HE,1HN,1HD,1H , 1006/(F DATA INST(1, 89),INST(2, 89),INST(3, 89),INST(4, 89),INST(5, 89) 1 /1HE,1HJ,1HE,1HC, 1007/(F DATA INST(1, 90),INST(2, 90),INST(3, 90),INST(4, 90),INST(5, 90) 1 /1HD,1HD,1HB,1H , 1008/(F DATA INST(1, 91),INST(2, 91),INST(3, 91),INST(4, 91),INST(5, 91) 1 /1HL,1HI,1HS,1HT, 1009/(F DATA INST(1, 92),INST(2, 92),INST(3, 92),INST(4, 92),INST(5, 92) 1 /1HS,1HP,1HA,1HC, 1011/(F DATA INST(1, 93),INST(2, 93),INST(3, 93),INST(4, 93),INST(5, 93) 1 /1HS,1HE,1HT,1H , 1012/(F DATA INST(1, 94),INST(2, 94),INST(3, 94),INST(4, 94),INST(5, 94) 1 /1HI,1HF,1H ,1H , 1014/(F DATA INST(1, 95),INST(2, 95),INST(3, 95),INST(4, 95),INST(5, 95) 1 /1HE,1HN,1HD,1HM, 1017/(F DATA INST(1, 96),INST(2, 96),INST(3, 96),INST(4, 96),INST(5, 96) 1 /1HE,1HL,1HS,1HE,1018/F DATA INST(1, 97),INST(2, 97),INST(3, 97),INST(4, 97),INST(5, 97) 1 /1HA,1HS,1HE,1HG, 1020/SF DATA INST(1, 98),INST(2, 98),INST(3, 98),INST(4, 98),INST(5, 98) 1 /1HC,1HS,1HE,1HG, 1021/SF DATA INST(1, 99),INST(2, 99),INST(3, 99),INST(4, 99),INST(5, 99) 1 /1HD,1HS,1HE,1HG, 1022/SF DATA INST(1,100),INST(2,100),INST(3,100),INST(4,100),INST(5,100) 1 /1HN,1HA,1HM,1HE, 1025/SB DATA INSTE(1,1),INSTE(2,1),INSTE(3,1),INSTE(4,1),INSTE(5,1),< 1 INSTE(6,1),INSTE(7,1) /1HN,1HL,1HI,1HS,1HT,1H ,1010/B DATA INSTE(1,2),INSTE(2,2),INSTE(3,2),INSTE(4,2),INSTE(5,2),< 1 INSTE(6,2),INSTE(7,2) /1HE,1HN,1HD,1HI,1HF,1H ,1015/B DATA INSTE(1,3),INSTE(2,3),INSTE(3,3),INSTE(4,3),INSTE(5,3),< 1 INSTE(6,3),INSTE(7,3) /1HM,1HA,1HC,1HR,1HO,1H ,1016/B DATA INSTE(1,4),INSTE(2,4),INSTE(3,4),INSTE(4,4),INSTE(5,4),< 1 INSTE(6,4),INSTE(7,4) /1HP,1HU,1HB,1HL,1HI,1HC,1023/B DATA INSTE(1,5),INSTE(2,5),INSTE(3,5),INSTE(4,5),INSTE(5,5),< 1 INSTE(6,5),INSTE(7,5) /1HT,1HI,1HT,1HL,1HE,1H ,1013/B DATA INSTE(1,6),INSTE(2,6),INSTE(3,6),INSTE(4,6),INSTE(5,6),< 1 INSTE(6,6),INSTE(7,6) /1HE,1HX,1HT,1HR,1HN,1H ,1024/B DATA INSTE(1,7),INSTE(2,7),INSTE(3,7),INSTE(4,7),INSTE(5,7),< 1 INSTE(6,7),INSTE(7,7) /1HS,1HT,1HK,1HL,1HN,1H ,1026/B DATA INSTE(1,8),INSTE(2,8),INSTE(3,8),INSTE(4,8),INSTE(5,8),< 1 INSTE(6,8),INSTE(7,8) /1HL,1HO,1HC,1HA,1HL,1H ,1027/B DATA INSTE(1,9),INSTE(2,9),INSTE(3,9),INSTE(4,9),INSTE(5,9),< 1 INSTE(6,9),INSTE(7,9) /1HE,1HX,1HI,1HT,1HM,1H ,1028/CAC *ENTRY PARAMETERSS0C ICOL - STARTING COLUMN TO LOOK FOR OPCODECSC *EXIT PARAMETERS%C ICOL - START OF ARGUMENT FILEDNC IARG - SAME AS ICOLC IERR - RETURN STATUS(C 1 = VALID OPCODE%C 2 = PRESUMED MACRO NAMENC 3 = OPCODE ERRORC 4 = COMMENT LINE#C 5 = NO OPCODE ON LINE2;C 6 = SYMBOL ENDS WITH A LABEL - PRESUMED LABELS.C IOPVA - OPCODE VALUE OR DIRECTIVE NUMBERC ITYPE - OPCODE TYPEC -1 = COMMENT C 0 = ERRORMC 1 = DIRECTIVE C 2 = MACRO 0C 3 = 1 BYTE INSTRUCTION NO OPERANDS0C 4 = ACCUMULATOR GROUP INSTRUCTIONSC 5 = INR,DCR,RST C 6 = LDAX,STAXN&C 7 = INX,DCX,DAD,PUSH,POP"C 8 = 2 BYTE IMMEDIATE%C 9 = 3 BYTE INSTRUCTIONS C 10 = LXIAC 11 = MVISC 12 = MOVV+C ICHK - COMBINATIN OF ITYPE AND IOPVAECPC NUMOP = 101O ICHK = 0 ITYPE = 0 IOPVA = 0  IERR = 1 INSTT = 0R ILEN = 4C LOOK FOR START OF OPCODE100 ICHAR = IN(ICOL)! IF(ICHAR-IBLNK) 105,120,105 !105 IF(ICHAR-ICTAB) 110,120,110 C CHECK FOR COMMENT LINE!110 IF(ICHAR-ISEMI) 115,920,115 115 IF(ICHAR-IAST) 130,920,130120 ICOL = ICOL+1E IF(ICOL-MCOL) 100,100,930 .C FOUND START OF OPCODE, CHECK FOR A MACRO130 J1 = ICOL  CALL SYMBL! GO TO(140,910,200,910),IERR 140 IF(MCNT) 200,200,150150 DO 170 I=1,MCNTV L = MCNT+1-I DO 160 K=1,IWORD( IF(MCNAM(K,L)-NAME(K)) 170,160,170160 CONTINUE ITYPE = 2  IOPVA = L0 ICHK = 2000+LI GO TO 6002170 CONTINUE+C FIND END OF OPCODE AND CHECK IF VALID1!200 IF(ICHAR-ICOLN) 210,940,2100210 J2 = ICOL-J1 IF(J2-MOPC) 270,270,910 270 IF(J2-ILEN) 300,300,280 280 ILEN = 6 INSTT = 1  NUMOP = 9 ,C CHECK OPCODE AGAINST ALL LEGAL OPCODES300 DO 370 L=1,NUMOP DO 330 K=1,J2I K1 = J1+K-1  IF(INSTT) 310,310,320O&310 IF(IN(K1)-INST(K,L)) 370,330,370'320 IF(IN(K1)-INSTE(K,L)) 370,330,370 330 CONTINUE IF(J2-ILEN) 340,500,500T340 K2 = J2+1T IF(INSTT) 350,350,360E&350 IF(INST(K2,L)-IBLNK) 370,500,370'360 IF(INSTE(K2,L)-IBLNK) 370,500,370 370 CONTINUE GO TO 910 &C FETCH INSTRUCTION TYPE AND VALUE500 ICHK = INST(5,L) IF(INSTT) 550,550,510O510 ICHK = INSTE(7,L)D550 ITYPE = ICHK/1000P IOPVA = ICHK-ITYPE*10001%C SCAN TO START OF ARGUMENT FIELDO600 ICHAR = IN(ICOL)! IF(ICHAR-IBLNK) 610,620,610N!610 IF(ICHAR-ICTAB) 630,620,630N620 ICOL = ICOL+1  IF(ICOL-MCOL) 600,600,650 !630 IF(ICHAR-ISEMI) 650,640,650F640 ICOL = MCOL+10650 IARG = ICOLI GO TO 990 C OPCODE ERROR910 IERR = 3 GO TO 990 C FOUND COMMENT INDICATORE920 IERR = 4 GO TO 990FC NO OPCODE ON LINE 930 IERR = 5 GO TO 990 C PRESUMED LABEL940 IERR = 6 IARG = ICOLT ICOL = J1N 990 RETURN ENDN SUBROUTINE LABELCKC1=C THIS ROUTINE PROCESSES ALL SYMBOLS USED IN THE ASSEMBLYOBC PROGRAM. IT SCANS THE SYMBOL TABLE TO SEE IF A GIVEN SYMBOLC IS DEFINED OR NOT+CC < REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECCB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLE@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOCNC *ENTRY PARAMETERS8,C MODE - SYMBOL DEFINITION OR REFERENCEC 0 = DEFINITIONC 1 = REFERENCEN%C ICOL - STARTING COLUMN OF SCANTCAC *EXIT PARAMETERS%C ICOL - ENDING COLUMN OF SYMBOLIC IVAL - VALUE OF SYMBOLI"C ICHAR - TERMINATOR CHARACTERC ITABI - SYMBOL TYPEMC 0 = ABSOLUTEC 1 = CODEC 2 = DATAC 3 = STACKAC 4 = MEMORYC 5 = EXTERNALC BIT 3 - 1=LOWEC BIT 4 - 1=HIGHC BIT 5 - 1=PUBLICC BIT 6 - 1=SETN%C BIT 7 - 1=SYSTEM SYMBOLC.C IRTYP - SAME AS ITABI BUT NOT BITS 5,6,7C IPUBF - 1 = PUBLIC SYMBOLCC IERR - RETURN STATUS $C 1 = VALID SYMBOL FOUND%C 2 = SYMBOL NOT IN TABLETC 3 = SYMBOL ERROR(C 4 = PUBLIC NOT YET DEFINED#C 5 = SYMBOL TABLE FULL C C  IPUBF = 0  IVAL = 0 NOTRY = 0 C FETCH LABEL AND ITS INDEX  CALL SYMBL IF(IERR-4) 100,920,100 C CHECK IF LABEL IS IN TABLE100 INDEX = 3*INDEXT 110 IF(INDEX-LTAB) 130,130,120120 INDEX = INDEX-LTAB GO TO 110 #C CHECK FOR EMPTY SLOT IN TABLES#130 IF(ITAB(1,INDEX)) 140,910,140L140 DO 150 J=1,IWORD+ IF(ITAB(J,INDEX)-NAME(J)) 200,150,200B150 CONTINUE GO TO 800CC TRY NEXT SLOT IN TABLE200 NOTRY = NOTRY+1  INDEX = INDEX+1 IF(NOTRY-LTAB) 110,940,940#C VALID SYMBOL - GET PARAMETERS800 ITABI = ITABS(INDEX)! IRTYP = ITABI-(ITABI/64)*64L IPUBF = IRTYP/32 IF(IRTYP-63) 810,930,930810 IRTYP = IRTYP-IPUBF*32!C SYMBOL FOUND, GET ITS VALUE 900 IERR = 1 IVAL = ITABV(INDEX)F'902 IF(MODE+IPASS+LREF-4) 990,904,9900904 CALL XREFT(0)I GO TO 990(C SYMBOL NOT IN TABLET910 IERR = 2 GO TO 990 C SYMBOL ERROR920 IERR = 3 GO TO 990E#C PUBLIC SYMBOL NOT YET DEFINED0930 IERR = 4 IF(MODE) 990,990,902C SYMBOL TABLE FULLN940 IF(MODE) 945,945,910945 IERR = 5 990 RETURN END  SUBROUTINE SYMBLCC <C THIS SUBROUTINE IS USED TO FORM A SYMBOL AND ITS INDEXC INTO THE SYMBOL TABLEICVCD< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECRB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLL@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTAB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOCNC *ENTRY PARAMETERS8%C ICOL - STARTING COLUMN OF SCANSC NERR - SAME AS IERRCPC *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCANO%C NAME - CONTAINS ENCODED SYMBOLM"C ICHAR - TERMINATOR CHARACTERC IERR - RETURN STATUSO9C 1 = SYMBOL ENDS WITH BLANK,TAB OR SEMICOLON*C 2 = SYMBOL ENDS WITH A COMMA4C 3 = SYMBOL ENDS WITH OTHER THAN 1 OR 2C 4 = SYMBOL ERRORCMCM INDEX = 0X LABCT = 0A DO 10 J=1,IWORDT NAME(J) = 0 10 CONTINUE IC1 = 1A IC2 = 1 C CHECK FOR VALID CHARACTERA100 ICHAR = IN(ICOL) DO 110 J=1,36O$ IF(ICHAR-IALPH(J)) 110,130,110110 CONTINUE J = 58! IF(ICHAR-IQUES) 111,130,111U 111 J = 59 IF(ICHAR-ICAT) 112,130,112,C END OF SCAN IF FOUND INVALID CHARACTER112 IF(LABCT) 115,930,115 115 IF(IC2-ICCNT) 116,116,120R116 DO 117 J=IC2,ICCNT NAME(IC1) = NAME(IC1)*256X117 CONTINUEC CHECK FOR BLANK OR COMMA!120 IF(ICHAR-IBLNK) 122,900,122 !122 IF(ICHAR-ISEMI) 124,900,124H!124 IF(ICHAR-ICOMM) 126,910,126A!126 IF(ICHAR-ICTAB) 920,900,9204C CHECK IF MORE CHARACTER THAN WILL FIT IN TABLE 130 IF(LABCT-MLAB) 132,160,160132 IF(LABCT) 134,134,140134 IF(J-10) 930,930,140140 LABCT = LABCT+1 'C CALCULATE INDEX INTO SYMBOL TABLET INDEX = INDEX+JF IF(IC2-ICCNT) 150,150,142O142 IC1 = IC1+1 IC2 = 1 150 IC2 = IC2+1 (C FORM SYMBOL FOR PLACEMENT IN TABLE! NAME(IC1) = NAME(IC1)*256+J 160 ICHAR = IBLNKI IF(ICOL-MCOL) 162,115,115O162 ICOL = ICOL+1  GO TO 100 +C SYMBOL ENDS WITH A BLANK OR SEMICOLONH900 IERR = 1 GO TO 990BC SYMBOL ENDS WITH A COMMA910 IERR = 2 GO TO 990)>C SYMBOL ENDS WITH OTHER THAN A BLANK, COMMA, OR SEMICOLON920 IERR = 3 GO TO 990EC SYMBOL ERROR930 IERR = 4990 NERR = IERR+ RETURN END  SUBROUTINE SCANMCMC >C THIS SUBROUTINE IS USED TO EVALUATE A GENERAL EXPRESSION<C AND RETURNS A VALUE REPRESENTING THE EXPRESSION TO THE:C CALLING PROGRAM. THE METHOD USED IS INFIX TO POLISH<C CONVERSION AND THEN AN EVALUATION OF THE POLISH STRINGCDCI REAL IOP1,IOP2,ISTK2(80)< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)5 DIMENSION IOPER(8),IPREC(8),ISYM(13),NOPER(5,2)E4 DIMENSION ITERM(4),NUMTY(5),NUMVA(5),ISTK1(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECAB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLI@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT8B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO" EQUIVALENCE (IOPER(1),IPLUS) EQUIVALENCE(ISYM(1),IPLUS)" EQUIVALENCE (ITERM(1),IBLNK)7 EQUIVALENCE (ISTK2(1),NBIN(2)),(ISTK1(1),MBIN(1))O@ DATA NUMTY(1),NUMTY(2),NUMTY(3),NUMTY(4) /1HB,1HD,1HO,1HQ/; DATA NUMTY(5),NUMVA(1),NUMVA(2),NUMVA(3) /1HH,2,10,8/L# DATA NUMVA(4),NUMVA(5) /8,16/8 DATA IPREC(1),IPREC(2),IPREC(3),IPREC(4) /1,1,3,3/8 DATA IPREC(5),IPREC(6),IPREC(7),IPREC(8) /7,7,0,9/9 DATA NOPER(1,1),NOPER(2,1),NOPER(3,1) /1HH,1HI,1HG/,9 DATA NOPER(4,1),NOPER(5,1),NOPER(1,2) /1HH,1H.,1HL/C9 DATA NOPER(2,2),NOPER(3,2),NOPER(4,2) /1HO,1HW,1H./ 1 DATA NOPER(5,2) /1H /C C *ENTRY PARAMETERSN%C ICOL - STARTING COLUMN OF SCAN CAC *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCANA+C IVAL - VALUE OF EXPRESSION ON RETURNCC IERR - RETURN STATUS)C 1 = NO ERRORS53C 2 = NO ERROR, SCAN ENDED WITH A COMMAP C 3 = ARGUMENT ERROR"C 4 = UNDEFINED SYMBOLC 5 = SYNTAX ERROR"C 6 = RELOCATION ERRORC IERRF - ERROR FLAG(C 0 = NO ERROR, 1 OR 2 ABOVEC 1 = ERRORT;C IRTYP - RELOCATION TYPE OF EXPRESSION - SAME AS LABEL "C LLEN - LENGTH OF EXPRESSIONCICC IF(ICOL-MCOL) 10,10,935A10 NEXP = -2  NUARY = 1  NEND = 0 IVAL = 0 IERRF = 0R NPNTO = 80 IEXTI = -1 NPRCS = 0M IPNTS = 1  LLEN = 0 ISTK1(1) = 0 ISTK2(1) = 0100 ICHAR = IN(ICOL) IF(ICOL-MCOL) 110,110,130IC CHECK FOR SCAN TERMINATORG110 DO 120 I=1,4$ IF(ICHAR-ITERM(I)) 120,130,120120 CONTINUE GO TO 140I)C HAVE A TERMINATOR - GET FINAL VALUE 130 NPRCI = 0O NEND = 1 GO TO 450OC CHECK FOR AN OPERATORP140 DO 150 L=1,8$ IF(ICHAR-IOPER(L)) 150,350,150150 CONTINUE-C CHECK FOR OPERATOR DELIMITED BY PERIODSC IF(ICHAR-IPER) 200,160,200160 ICOL1 = ICOL J = 1 165 ICOL = ICOL+1C# IF(IN(ICOL)-IPER) 170,175,1701 170 J = J+1  IF(J-5) 165,165,950GC CHECK IF A VALID OPERATORH175 DO 190 LL=1,21 DO 180 N=1,J L = ICOL1+N ' IF(IN(L)-NOPER(N,LL)) 190,180,190180 CONTINUE(C VALID OPERATOR, SET OPERATOR INDEX L = 7-LL GO TO 3501190 CONTINUE GO TO 935)C0C CHECK FOR AN OPERANDC 200 NUARY = 0R IRTYP = 0I IVAL = 0 IF(NEXP+1) 205,950,205C CHECK FOR A NUMERIC205 DO 210 J=1,10$ IF(ICHAR-IALPH(J)) 210,215,210210 CONTINUE GO TO 270,(C FOUND NUMERIC, LOOK FOR TERMINATOR215 N1 = ICOL=220 ICOL = ICOL+11 IF(ICOL-MCOL) 225,225,235I225 ICHAR = IN(ICOL) DO 230 LL=1,13$ IF(ISYM(LL)-ICHAR) 230,235,230230 CONTINUE GO TO 220 235 ICOL1 = ICOL-1)C CHECK FOR CONSTANT TYPE (B,D,O,Q,H)E DO 240 J=1,5( IF(IN(ICOL1)-NUMTY(J)) 240,245,240240 CONTINUE J = 2 ICOL1 = ICOL245 IFACT = NUMVA(J) ICOL1 = ICOL1-1LC FORM NUMERIC VALUE IOP1 = IFACT DO 260 LL=N1,ICOL1 DO 250 K=1,IFACT% IF(IN(LL)-IALPH(K)) 250,255,250250 CONTINUE GO TO 935255 IOP2 = K-1 IVAL = IVAL*IOP1+IOP2 260 CONTINUE GO TO 3300*C CHECK FOR LOCATION COUNTER REFERENCE!270 IF(ICHAR-IDOLR) 280,275,280A275 IVAL = LCH ICOL = ICOL+15 IRTYP = ISEGTN GO TO 3302C CHECK FOR A STRING280 CALL CONST! GO TO(285,935,310,950),IERR 285 IF(LLEN-1) 935,330,290290 IF(NEXP+2) 930,295,930295 IF(MBYTF) 930,930,300O300 DO 305 J=1,4' IF(IN(ICOL)-ITERM(J)) 305,910,305,305 CONTINUE GO TO 935 C CHECK IF SYMBOLIC OPERANDL310 MODE = 1 CALL LABEL% GO TO(315,940,935,940,940),IERRAC VALID SYMBOL!315 IF(IRTYP-IEXTT) 330,320,3308C HAVE EXTERNAL SYMBOL320 IF(IEXTI) 325,960,960 325 IEXTI = IVAL IVAL = 0(C HAVE OPERAND, PUT INTO INPUT STACK330 NPNTO = NPNTO-1R ISTK1(NPNTO) = IRTYP ISTK2(NPNTO) = IVAL2 NEXP = -1M GO TO 100OC0.C HAVE AN OPERATOR, PLACE INTO INPUT STACKC1350 NPRCI = IPREC(L) IF(NPRCI-NEXP) 355,950,355355 IF (L-7) 360,370,365360 NEXP = NPRCI GOTO 370 365 NUARY = 1, NEXP = 50370 IF(NUARY) 375,450,3751375 IF(NPRCI-1) 450,380,4508380 NPRCI = 5R L = L+6 (C PERFORM INFIX TO POLISH CONVERSION450 IF(IPNTS) 455,935,455E!455 IF(NPRCI-NPRCS) 460,470,480 ;C STACK PRECEDENCE GREATER THAN INPUT STRING PRECEDENCEP460 NPNTO = NPNTO-1P! ISTK1(NPNTO) = ISTK1(IPNTS)  ISTK2(NPNTO) = 0 IPNTS = IPNTS-15 NPRCS = ISTK2(IPNTS) GO TO 45057C STACK PRECEDENCE EQUAL TO INPUT STRING PRECEDENCET470 IPNTS = IPNTS-1 IF(NEND-1) 472,476,472472 IF(IPNTS) 950,950,414 414 NPRCS = ISTK2(IPNTS) GO TO 490 476 IF(IPNTS-1) 478,950,950 )C PLACE END INDICATOR IN OUTPUT STACK5478 NPNTO = NPNTO-1, ISTK1(NPNTO) = -1000 GO TO 500 8C STACK PRECEDENCE LESS THAN INPUT STRING PRECEDENCE480 IPNTS = IPNTS+1S ISTK1(IPNTS) = L*256 IF(NPRCI-9) 484,482,484P482 NPRCI = -1484 NPRCS = NPRCI+1  ISTK2(IPNTS) = NPRCS490 ICOL = ICOL+1C GO TO 100 CTC EVALUATE EXPRESSION4C4$C CHECK IF OUTPUT STACK IS EMPTY500 NPNTE = 0P IF(NPNTO-79) 505,935,935505 NPNTO = 80C GET NEXT ENTRY IN STACK 510 NPNTO = NPNTO-1  ICHAR = ISTK1(NPNTO)/256 IF(ICHAR) 520,540,560 6C END OF STACK - CHECK FOR ONLY ONE ENTRY IN STACK520 IF(NPNTE-1) 950,530,950 530 IVAL = ISTK2(1) IRTYP = ISTK1(1) LLEN = 1 GO TO 910P0C HAVE AN OPERAND, PLACE IN EVALUATION STACK540 NPNTE = NPNTE+1O IVAL = ISTK2(NPNTO)E ITY1 = ISTK1(NPNTO)C GO TO 870 3C HAVE AN OPERATOR, PERFORM NECESSARY OPERATION5560 IF(NPNTE-1) 950,562,564E562 IF(ICHAR-4) 950,950,566P564 NPNT1 = NPNTE-1C IOP2 = ISTK2(NPNT1)  ITY2 = ISTK1(NPNT1) 566 IOP1 = ISTK2(NPNTE)R ITY1 = ISTK1(NPNTE)2 IVAL = 03 GO TO (570,580,590,600,610,620,630,640),ICHARSC ADDITION570 NPNTE = NPNT11 IVAL = IOP1+IOP2 GO TO 810AC SUBTRACTIONP580 NPNTE = NPNT1  IVAL = IOP2-IOP1 GO TO 820NC MULTIPLICATION590 NPNTE = NPNT1R IVAL = IOP1*IOP2 GO TO 800 C DIVISION600 NPNTE = NPNT1H IF(IOP1) 602,800,602602 J = IOP2/IOP1  IVAL = J GO TO 800=C LOW - (GET LOW BYTE)610 J = IOP1/256.  IOP2 = J IVAL = IOP1-256.*IOP2O J = ILOW GO TO 8306C HIGH - (GET HIGH BYTE)620 J = IOP1/256.  IVAL = J J = IHIGH  GO TO 830AC UNARY ADDITION630 ITY2 = 0 IVAL = IOP1  GO TO 810 C UNARY SUBTRACTIONP640 ITY2 = 0 IVAL = -IOP1 GO TO 820 C %C CHECK RELOCATION TYPE OF RESULT CFC BOTH OPERAND ABSOLUTE 800 IF(ITY1+ITY2) 960,870,960 C CHECK ADDITION810 ITY1 = ITY1+ITY2 IF(ITY2) 825,870,825C CHECK SUBTRACTION.820 ITY1 = ITY2-ITY1 IF(ITY1) 960,870,825825 IF(ITY1-ITY2) 960,870,9601C CHECK HIGH AND LOW830 IF(ITY1) 835,870,835835 ITY1 = J+ITY1-(ITY1/8)*8C PUT VALUE ONTO STACK870 J = IVAL/65536.  IVAL2 = JT IVAL = IVAL-IVAL2*65536. IF(IVAL) 875,880,880875 IVAL = IVAL+65536.880 ISTK2(NPNTE) = IVAL  ISTK1(NPNTE) = ITY1  GO TO 5106C7C SET EXIT OR ERROR STATUSC 910 IERR = 1$ IF(IN(ICOL)-ICOMM) 990,915,990915 IERR = 2 GO TO 990YC ARGUMENT ERROR930 LLEN = 0935 IERR = 3 GO TO 980 C UNDEFINED SYMBOL940 IERR = 4 GO TO 980 C SYNTAX ERROR950 IERR = 5 GO TO 980C RELOCATION ERROR960 IERR = 6 980 IERRF = 1I IRTYP = 0 IVAL = 0 990 RETURN END7 SUBROUTINE CONSTC CS;C THIS SUBROUTINE PROCESSES ALL CONSTANT STRINGS IN THE1BC ARGUMENT FIELD. THESE STRINGS ARE CONVERTED TO OBJECT CODE.C(CL< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80), DIMENSION IASCI(59),IEBCD(59),NUMS(16)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTCB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO$ EQUIVALENCE (NUMS(1),IALPH(1))@ DATA IASCI( 1),IASCI( 2),IASCI( 3),IASCI( 4) /48,49,50,51/@ DATA IASCI( 5),IASCI( 6),IASCI( 7),IASCI( 8) /52,53,54,55/@ DATA IASCI( 9),IASCI(10),IASCI(11),IASCI(12) /56,57,65,66/@ DATA IASCI(13),IASCI(14),IASCI(15),IASCI(16) /67,68,69,70/@ DATA IASCI(17),IASCI(18),IASCI(19),IASCI(20) /71,72,73,74/@ DATA IASCI(21),IASCI(22),IASCI(23),IASCI(24) /75,76,77,78/@ DATA IASCI(25),IASCI(26),IASCI(27),IASCI(28) /79,80,81,82/@ DATA IASCI(29),IASCI(30),IASCI(31),IASCI(32) /83,84,85,86/@ DATA IASCI(33),IASCI(34),IASCI(35),IASCI(36) /87,88,89,90/@ DATA IASCI(37),IASCI(38),IASCI(39),IASCI(40) /32,33,34,35/@ DATA IASCI(41),IASCI(42),IASCI(43),IASCI(44) /36,37,38,39/@ DATA IASCI(45),IASCI(46),IASCI(47),IASCI(48) /40,41,42,43/@ DATA IASCI(49),IASCI(50),IASCI(51),IASCI(52) /44,45,46,47/@ DATA IASCI(53),IASCI(54),IASCI(55),IASCI(56) /58,59,60,61/3 DATA IASCI(57),IASCI(58),IASCI(59) /62,63,64/ D DATA IEBCD( 1),IEBCD( 2),IEBCD( 3),IEBCD( 4) /240,241,242,243/D DATA IEBCD( 5),IEBCD( 6),IEBCD( 7),IEBCD( 8) /244,245,246,247/D DATA IEBCD( 9),IEBCD(10),IEBCD(11),IEBCD(12) /248,249,193,194/D DATA IEBCD(13),IEBCD(14),IEBCD(15),IEBCD(16) /195,196,197,198/D DATA IEBCD(17),IEBCD(18),IEBCD(19),IEBCD(20) /199,200,201,209/D DATA IEBCD(21),IEBCD(22),IEBCD(23),IEBCD(24) /210,211,212,213/D DATA IEBCD(25),IEBCD(26),IEBCD(27),IEBCD(28) /214,215,216,217/D DATA IEBCD(29),IEBCD(30),IEBCD(31),IEBCD(32) /226,227,228,229/D DATA IEBCD(33),IEBCD(34),IEBCD(35),IEBCD(36) /230,231,232,233/B DATA IEBCD(37),IEBCD(38),IEBCD(39),IEBCD(40) /64,90,127,123/B DATA IEBCD(41),IEBCD(42),IEBCD(43),IEBCD(44) /91,108,80,125/@ DATA IEBCD(45),IEBCD(46),IEBCD(47),IEBCD(48) /77,93,92,78/A DATA IEBCD(49),IEBCD(50),IEBCD(51),IEBCD(52) /107,96,75,97/DB DATA IEBCD(53),IEBCD(54),IEBCD(55),IEBCD(56) /122,94,76,126/6 DATA IEBCD(57),IEBCD(58),IEBCD(59) /110,111,124/CBC *ENTRY PARAMETERS)%C ICOL - STARTING COLUMN OF SCAN)CBC *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCAND*C IVAL - 1ST BYTE OF STRING ON RETURN&C NBIN - ARRAY OF CONSTANT VALUESC IERR - RETURN STATUS,'C 1 = FOUND VALID CONSTANTSDC 2 = ERROR74C 3 = THIS IS NOT CONSTANT STRING FORMAT"C 4 = EXPRESSION ERRORCICD NBIN(1) = 0D LLEN = 0 IF(ICOL-MCOL) 10,10,930DC CHECK FOR A LITERAL/10 ICOL1 = ICOL+1 NCHAR = IN(ICOL) IFACT = 1F IF(NCHAR-IQUOT) 15,200,15S$15 IF(IN(ICOL1)-IQUOT) 920,20,92020 ICOL = ICOL1C ASCII CONSTANT60 IFACT = 1  IF(NCHAR-ICHRA) 70,200,70EC EBCDIC CONSTANT 70 IFACT = 2O! IF(NCHAR-ICHRE) 930,200,930 C 'C PROCESS ASCII OR EBCDIC CONSTANTSSCT200 ICOL = ICOL+1  IF(ICOL-MCOL) 202,202,930C)C CHECK IF QUOTE IS USED AS CHARACTERF?C I.E. TO USE AS CHARACTER MUST BE USED TWICE IN SUCCESSION $202 IF(IN(ICOL)-IQUOT) 210,204,210204 ICOL1 = ICOL+1% IF(IN(ICOL1)-IQUOT) 900,206,900L206 ICOL = ICOL1210 LLEN = LLEN+1 DO 220 J=1,59' IF(IN(ICOL)-IALPH(J)) 220,250,2200220 CONTINUE GO TO 930250 IF(IFACT-1) 260,260,270RC ASCII CONSTANT260 NBIN(LLEN) = IASCI(J)C GO TO 200TC EBCDIC CONSTANT270 NBIN(LLEN) = IEBCD(J)3 GO TO 200CCFC FOUND VALID DATA900 ICOL = ICOL+1S IERR = 1 IF(LLEN) 930,930,950'C ERROR IN STRING FORMAT - NO QUOTE0920 IERR = 3 GO TO 950I$C ERROR IN DATA OR NO DATA FOUND930 IERR = 2 GO TO 950C EXPRESSION ERROR940 IERR = 4950 IVAL = NBIN(1) RETURN ENDO SUBROUTINE MCDEFC C,@C THIS ROUTINE IS USED FOR MACRO DEFINITIONS. IT SCANS EACH<C MODEL LINE AND CHECKS FOR MACRO PARAMETERS. IT PLACES9C PARAMETER MARKERS AT THESE LOCATIONS SO THEY CAN BECAC REFERENCED DURING MACRO EXPANSIONS AND REPLACED WITH ACTUALOC PARAMETERS.-C CT< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)$ DIMENSION MACIN(80),MCPAR(200)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLA@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTNB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO8 EQUIVALENCE (MACIN(1),MBIN(1)),(MCPAR(1),IXTAB(1))3 EQUIVALENCE (IERR1,IERRI(1)),(IERR2,IERRI(2))ICKC *ENTRY PARAMETERSMC MCNT - MACRO NUMBER)C MSREC - NEXT POSITION IN MACRO FILEICBC *EXIT PARAMETERS%C IEND - 1 = END DIRECTIVE FOUNDI-C MDISK - STARTING RECORD NUMBER OF MACRO)C MSREC - NEXT POSITION IN MACRO FILE5#C MPARC - MACRO PARAMETER COUNTMCCC) ICHK = 0 IEND = 0 IPCNT = 0R MDISK(MCNT) = MSRECN IPCN1 = 0  ICNT = 0 LOC = 01AC SCAN PROTOTYPE LINE FOR PARAMETERS AND FORM PARAMETER TABLEE20 IF(IARG-MCOL) 30,30,140M30 ICOL = IARG 100 CALL SYMBL IF(IERR-3) 110,130,130-C FOUND VALID PARAMETER, ENTER INTO TABLEE110 IPCNT = IPCNT+1  DO 120 LL=1,IWORDR ICNT = ICNT+1  MCPAR(ICNT) = NAME(LL)120 CONTINUE ICOL = ICOL+1A IF(IERR-2) 140,100,140C ILLEGAL PARAMETER LIST130 IERR2 = ICHRA 140 IF(IPCN1) 560,150,560 150 IPCN1 = IPCNT+1T GO TO 560 8C READ NEXT MODEL STATEMENT AND CHECK FOR PARAMETERS8C SUBSTITUTE A PARAMETER MARKER TO INDICATE RELATIVE/C POSITION OF PARAMETER FOR MACRO REFERENCE0200 CALL INOUT(1)I ITYPE = -1 IERR1 = IBLNKP IERR2 = IBLNK  DO 210 LL=1,80 MACIN(LL) = IN(LL)210 CONTINUEC CHECK FOR A COMMENT LINE ICOL = IFCOL$ IF(IN(IFCOL)-IAST) 220,500,220%220 IF(IN(IFCOL)-ISEMI) 230,500,2304230 IF(IPCNT) 400,400,2405240 CALL MSCAN(IPCNT,1) C GET OPCODE FILED ICOL = IFCOL$400 IF(IN(ICOL)-IBLNK) 410,450,410$410 IF(IN(ICOL)-ICTAB) 420,450,420C SKIP OVER LABEL FILEDA420 ICOL = ICOL+1E ICHAR = IN(ICOL)! IF(ICHAR-IBLNK) 425,470,425 !425 IF(ICHAR-ICTAB) 430,470,430 !430 IF(ICHAR-ICOLN) 440,470,440N440 IF(ICOL-MCOL) 420,500,500 450 CALL OPCOD IF(IERR-6) 475,460,475460 ICOL = IARG0470 ICOL = ICOL+1( CALL OPCOD475 IF(ICHK-1027) 500,480,500,480 IF(LOC) 500,490,500T490 DO 495 LL=1,80 IN(LL) = MACIN(LL)495 CONTINUE GO TO 20C4?C THE FOLLOWING STATEMENT WRITES INTO THE MACRO SOURCE FILEICA500 MCREC = MSRECE MSREC = MSREC+1) LOC = 1R CALL INOUT(6)<C WRITE STATEMENT TO INTERMEDIATE FILE FOR USE BY PASS 2;C SET LINE SO THAT IT LOOKS LIKE A COMMENT FOR PRINTOUT550 DO 555 LL=1,80 IN(LL) = MACIN(LL)555 CONTINUE 560 LEN = 0A IMREC = ISNI ITYPE = -1 ISN = ISN+1 C,FC THE INTERMEDIATE FILE IS WRITTEN INTO BY THE FOLLOWING STATEMENTC  CALL INOUT(5) (C CHECK FOR ENDM OR END INSTRUCTIONS IF(ICHK-1017) 570,590,570E570 IF(ICHK-1006) 200,580,200)580 IEND = 1590 IPCN1 = IPCN1-1 IPCNT = IPCNT-IPCN1T" MPARC(MCNT) = 40*IPCNT+IPCN1 RETURN ENDO SUBROUTINE MCREFCTCCC THIS SUBROUTINE IS USED TO EXPAND A MACRO WHENEVER THERE IS A BC REFERENCE TO IT. REPLACE PARAMETERS BY ACTUAL CHARACTERS OF9C CALL PARAMETERS. THUS TO PASS 1 IT LOOKS AS THOUGHL(C IT IS JUST READING IN ANOTHER CARDC C < REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)$ DIMENSION MACIN(80),MCALL(512)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECCB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTNB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO8 EQUIVALENCE (MACIN(1),MBIN(1)),(MCALL(1),IXTAB(1))" EQUIVALENCE (IERR2,IERRI(2))CSC *ENTRY PARAMETERS+C MCREC - RECORD NUMBER OF MACRO SOURCELCAC *EXIT PARAMETERS C MCREC - SET TO NEXT RECORD"C IN - LINE TO BE PROCESSED(C IERR2 - NON BLANK IF LINE OVERFLOWCHCI NREC = MCREC INPNT = 1I MCPNT = 15CL?C THE FOLLOWING STATEMENT READS FROM THE MACRO SOURCE FILE.(C, CALL INOUT(3)R NREC = NREC+1N MCREC = NREC DO 10 LL=1,80M MACIN(LL) = IN(LL)10 CONTINUE?C PLACE ARGUMENTS FROM MACRO CALL INTO MODEL STATEMENTS AND ,C INTO INPUT BUFFER TO BE USED BY PASS 120 IPARN = MACIN(MCPNT) ISAVE = IPARN  IF(IPARN-255) 30,140,14030 IF(IPARN) 140,40,40OC SCAN TO PARAMETER40 LL = MCSPT-145 LL = LL+1N IF(MCALL(LL)) 50,55,5050 IF(MCALL(LL)+1) 45,130,45D55 IPARN = IPARN-1  IF(IPARN) 60,60,45C GET END OF PARAMETER60 ISTA = LLR IFIN = ISTA165 IFIN = IFIN+1  IF(MCALL(IFIN)) 70,75,70 70 IF(MCALL(IFIN)+1) 65,75,6575 ISTA = ISTA+1N IFIN = IFIN-1BC CHECK FOR NULL PARAMETER IF(ISTA-IFIN) 100,100,130V,100 IF((INPNT+IFIN-ISTA)-MCOL) 110,110,9107C SUBSTITUTE ACTUAL PARAMETER FOR PARAMETER MARKERS 110 DO 120 KK=ISTA,IFIN+ IN(INPNT) = MCALL(KK), INPNT = INPNT+11120 CONTINUE C SCAN OVER PARAMETER MARKER130 MCPNT = MCPNT+1 & IF(MACIN(MCPNT)-ISAVE) 20,130,20140 IN(INPNT) = MACIN(MCPNT) IF(INPNT-80) 142,170,170142 IF(MCPNT-80) 144,150,150144 INPNT = INPNT+1T MCPNT = MCPNT+1- GO TO 20150 ISTA = INPNT+1155 DO 160 INPNT=ISTA,80 IN(INPNT) = IBLNKI160 CONTINUE<C MODEL STATEMENT NOW LOOKS LIKE A STANDARD LINE AND CANC BE PROCESSED BY PASS 1 170 RETURN5C INSERTION OF PARAMETERS TOO LONG FOR CARD IMAGEE910 IERR2 = ICHRCA ISTA = INPNT GO TO 155 ENDC" SUBROUTINE MSCAN(IPCNT,NSGO)CPC @C THIS SUBROUTINE IS USED TO SCAN MODEL STATEMENTS FOR MACRO=C PARAMETERS AND TO FORM THE PARAMETERS PASSED IN A MACRO ;C CALL INTO THE MODEL STATEMENTS, ALSO TO CALCULATE THE0>C NUMBER OF BYTES NEEDED FOR DATA,DB,DW OR ACON DIRECTIVESCOCO< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80) DIMENSION IOPER(8)# DIMENSION ISYM(13),MCPAR(200)S? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECIB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLA@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT,B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO" EQUIVALENCE (IOPER(1),IPLUS)5 EQUIVALENCE (ISYM(1),IPLUS),(MCPAR(1),IXTAB(1))TCEC *ENTRY PARAMETERSI%C ICOL - STARTING COLUMN OF SCANQC NSGO - CONTROL PARAMETER DC 1 = SCAN MODEL STATEMENTS AND PUT PARAMETER MARKERS IN8C 2 = SCAN PARAMETER LIST OF MACRO REFERENCEDC 3 = SCAN FOR NUMBER OF BYTES IN DATA,DB,DW, DIRECTIVES5C IPCNT - NUMBER OF PARAMETERS IN MACRO PROTOTYPEE2C MCPAR - LIST OF MACRO PARAMETERS IF NSGO = 1C,C *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCAN %C ICHAR - FINAL CHARACTER SCANNEDE*C LLEN - LENGTH OF ARGUMENT IF NSGO=3CICC LLEN = 1# IF(IN(ICOL)-ILESS) 100,10,100 10 IF(NSGO-2) 100,500,100100 ICHAR = IN(ICOL) IERR = 1! IF(ICHAR-IBLNK) 110,118,110F!110 IF(ICHAR-ICTAB) 112,118,112 !112 IF(ICHAR-ISEMI) 114,900,114,!114 IF(ICHAR-ICOMM) 160,120,160R118 IF(NSGO-1) 140,140,900120 IF(NSGO-2) 130,900,130130 LLEN = LLEN+1O140 ICOL = ICOL+1 150 IF (ICOL-MCOL) 100,900,900160 DO 170 K=1,8$ IF(ICHAR-IOPER(K)) 170,140,170170 CONTINUE IF(ICHAR-IPER) 200,140,200C CHECK FOR NUMERICS200 DO 220 K=1,100' IF(IN(ICOL)-IALPH(K)) 220,230,2200220 CONTINUE GO TO 300=230 ICOL = ICOL+1L!C SCAN FOR NUMERIC TERMINATORT DO 240 K=1,13 " IF (ISYM(K)-IN(ICOL)) 240,150,240 240 CONTINUE IF(ICOL-MCOL) 230,900,900)C CHECK FOR CONSTANT STRING0300 ICOL1 = ICOL+1! IF(ICHAR-IQUOT) 305,302,305 302 ICOL = ICOL-10 GO TO 400K%305 IF(IN(ICOL1)-IQUOT) 310,400,3101310 ISTA = ICOL C CHECK FOR AND FETCH SYMBOL CALL SYMBL IF(IERR-4) 320,140,3206C CHECK WHETHER PARAMETER MARKERS SHOULD BE PUT IN320 IF (NSGO-1) 150,350,150L=C CHECK IF THIS SYMBOL IS A PARAMETER PASSED IN PROTOTYPE1350 DO 365 K=1,IPCNT LL = (K-1)*IWORD DO 360 J=1,IWORD LL = LL+1' IF(NAME(J)-MCPAR(LL)) 365,360,365C360 CONTINUE GO TO 370T365 CONTINUE 365 CONTINUE GOTO 150 370 IF(ISTA-1) 380,380,372372 ICOL1 = ISTA-1$ IF(IN(ICOL1)-IAMP) 380,375,380375 ISTA = ICOL1 380 IF(ICHAR-IAMP) 390,385,390385 ICOL = ICOL+1C390 IFIN = ICOL-1A IMARK = KU DO 395 K=ISTA,IFIN IN(K) = IMARK 395 CONTINUE GO TO 100SC PROCESS STRING CONSTANTS400 LLEN = LLEN-2(410 ICOL = ICOL+13420 ICOL = ICOL+1L430 LLEN = LLEN+1M IF(ICOL-MCOL) 450,450,900 C SCAN FOR TERMINATING QUOTE$450 IF(IN(ICOL)-IQUOT) 420,455,420455 ICOL1 = ICOL+1% IF(IN(ICOL1)-IQUOT) 140,410,140ICC/C GET PARAMETER DELIMITED BY ANGLE BRACKETS 500 ICOL = ICOL+15$ IF(IN(ICOL)-ILESS) 520,510,520510 LLEN = LLEN+1R GO TO 5003C SCAN FOR CLOSING BRACKET$520 IF(IN(ICOL)-IGRAT) 540,530,540530 LLEN = LLEN-1G IF(LLEN) 540,140,540540 ICOL = ICOL+1O IF(ICOL-MCOL) 520,520,900 CN 900 RETURN END- SUBROUTINE LOUT CCCF=C THIS SUBROUTINE IS USED TO OUTPUT THE ASSEMBLER LISTING CCC  INTEGER OBIN(2,4)L< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80) DIMENSION NUMS(16)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECRB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTLB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO$ EQUIVALENCE (NUMS(1),IALPH(1))3 EQUIVALENCE (IERR1,IERRI(1)),(IERR2,IERRI(2))T! EQUIVALENCE (IREL1,IREL(1)) COC *ENTRY PARAMETERSLC MODE - LINE TYPEQC 1 = NORMAL LINEH5C 2 = EXTRA LINES FOR DB,DW,DATA,ACON,DDBM C 3 = SPAC DIRECTIVE C 4 = EJEC DIRECTIVE%C LLEN - NUMBER OF BYTES ON LINEIC LSOR - SOURCE LIST FLAG"C 0 = DONT LIST SOURCEC LMAC - MACRO LIST FLAG5,C 0 = DONT LIST MACRO EXPANSIONS!C IOPVA - = 100 IF EQU OR SETI,C IREL1 - RELOCATION TYPE FOR EQU OR SETC C *EXIT PARAMETERSC LISN - LINE NUMBERMCRC LISN = LISN+1P IRTYP = 0  IERRF = 0.C CONVERT VALUES TO HEXADECIMAL FOR OUTPUT DO 30 J=1,4  IF(J-LLEN) 10,10,20 10 MVAL = IBIN(J) IRTYP = IRTYP+IREL(J)  CALL VHEX  OBIN(1,J) = NH1  OBIN(2,J) = NH2  GO TO 3020 OBIN(1,J) = IBLNKT OBIN(2,J) = IBLNK 30 CONTINUE IMACP = IBLNKV IF(MAC-2) 50,40,5040 IMACP = IPLUSIC CHECK FOR AN ERROR50 IF(IERR1-IBLNK) 60,70,6060 IERRS = IERRS+1R IERRF = 1=70 IF (IERR2-IBLNK) 80,85,8080 IERRS = IERRS+1 IERRF = 185 IF (IERRF) 90,90,200U90 IF (LSOR) 700,700,100100 IF (MAC-1) 200,200,110)C CHECK FOR OUTPUT OF MACRO EXPANSIONR110 IF(LMAC) 200,700,200C CHECK OUTPUT LINE COUNTN200 LINE = LINE+1O IF(LINE-IOLIN) 400,400,210)C EJECT TO NEXT PAGE AND WRITE HEADER "210 WRITE(IPRT,1001) LTITL,IPAGEE1001 FORMAT(28H1ERR LINE ADDR B1 B2 B3 B4,8X,50A1,9X,5HPAGE ,I4,/)1 IPAGE = IPAGE+1  LINE = 3"400 GO TO (410,410,600,700),MODE<C LEAVE ADDRESS BLANK IF TYPE = -1 EXCEPT FOR EQU OR SET410 IF(ITYPE) 420,440,4400420 IF(IOPVA-100) 460,430,460430 IVAL = IPVAL IRTYP = IREL1R GO TO 4502440 IVAL = LC 450 INDET = 1  CALL AHEXE GO TO 500 460 DO 470 J=1,4 IADDR(1,J) = IBLNK470 CONTINUE%500 IRTYP = 1 + IRTYP - (IRTYP/8) * 8I IROUT = NRFLG(IRTYP)E IF (MODE-2) 510,520,510510 IIIQ=LENSTR(IN,80)6 WRITE(IPRT,1002) IERR1,IERR2,LISN,(IADDR(1,K),K=1,4),? 1 (OBIN(1,K),OBIN(2,K),K=1,4),IROUT,IMACP,(IN(J),J=1,IIIQ)C<1002 FORMAT(1X,2A1,2X,I4,2X,4A1,2X,4(2A1,1X),2X,A1,2X,81A1) RETURN;520 WRITE(IPRT,1002) IBLNK,IBLNK,LISN,(IADDR(1,K),K=1,4), ( 1 (OBIN(1,K),OBIN(2,K),K=1,4),IROUT RETURNC PROCESS SPAC DIRECTIVE600 LINE = LINE+1D IF(LINE-IOLIN) 610,610,200610 WRITE(IPRT,1003)1003 FORMAT(1X) IARG = IARG-1I IF(IARG) 700,700,600 700 RETURN ENDE SUBROUTINE OUTCIC(3C THIS ROUTINE IS USED TO FORM THE RECORD WHICH) C COMPRISE THE OBJECT MODULEC CM REAL LTCS(3)< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)7 DIMENSION NCBUF(40),NIBUF(40),NRBUF(40),NEBUF(40)E) DIMENSION ISTYP(3),NPNT(3),MRFLG(8)I DIMENSION IRBUF(160)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO' EQUIVALENCE (IRBUF(1),MCNAM(1,1))P: EQUIVALENCE (NCBUF(1),IRBUF(1)),(NRBUF(1),IRBUF(41))< EQUIVALENCE (NIBUF(1),IRBUF(81)),(NEBUF(1),IRBUF(121))5 EQUIVALENCE (ISTYP(1),ICTYP),(LTCS(1),LTCNT(2))I2 EQUIVALENCE (NPNT(1),NRPNT),(MRFLG(1),NRELT)! EQUIVALENCE (IREL1,IREL(1))HD EQUIVALENCE (NCBU1,NCBUF(1)),(NCBU4,NCBUF(4)),(NCBU5,NCBUF(5))3 EQUIVALENCE (NCBU6,NCBUF(6)),(NCBU7,NCBUF(7)))3 EQUIVALENCE (NRBU1,NRBUF(1)),(NRBU4,NRBUF(4))XD EQUIVALENCE (NIBU1,NIBUF(1)),(NIBU4,NIBUF(4)),(NIBU5,NIBUF(5))3 EQUIVALENCE (NEBU1,NEBUF(1)),(NEBU4,NEBUF(4))(C)C *ENTRY PARAMETERSF.C LOBJ - OBJECT LIST FLAG, 0 = DON'T LIST C IREL - RELOCATION MARKERSC IBIN - OBJECT CODEC"C LODLC - CURRENT LOAD ADDRESS.C LC - CURRENT ASSEMBLY PROGRAM COUNTER"C ISEGT - CURRENT SEGMENT TYPEC,C *EXIT PARAMETERS"C LODLC - UPDATED LOAD ADDRESSCUC) IF(LOBJ) 9000,9000,100100 IF(LODLC) 1000,4000,40007C FIRST CALL - INITIALIZE AND OUTPUT HEADER RECORDSB1000 LODLC = LC NCBU1 = 2B NCBU4 = MLAB NCBU5 = -10000 NCBU6 = 0  NCBU7 = 0L ISTYP(3) = 3 ICNT = 8 DO 1030 I=1,3S NCBUF(ICNT) = IC ICNT = ICNT+1U K = LTCS(I)/256. IVAL = K% NCBUF(ICNT) = LTCS(I)-IVAL*256.  ICNT = ICNT+1E NCBUF(ICNT) = KE ICNT = ICNT+1P K = ISTYP(I) IF(K) 1010,1010,1020 1010 K = 3 1020 NCBUF(ICNT) = K0 ICNT = ICNT+1-1030 CONTINUE NCBUF(20) = 4B NCBUF(21) = 0  NCBUF(22) = 0  NCBUF(23) = 3C ICNT = 1 IRLEN = 23 CALL ROUT C C OUTPUT EXTERNALSC8 IRLEN = 3= MM = 8 NCBU1 = 24 IEXTN = 0U2000 DO 2500 I=1,LTAB" IF(ITAB(1,I)) 2100,2500,2100%2100 INDEX = ITABS(I)-(ITABS(I)/8)*8+$ IF(INDEX-IEXTT) 2500,2200,25002200 K = ITABV(I) IF(K-IEXTN) 2500,2300,25002300 IEXTN = IEXTN+10 IRLEN = IRLEN+1  NCBUF(IRLEN) = MLABT IRLEN = IRLEN+1  NCBUF(IRLEN) = -I IRLEN = IRLEN+1  NCBUF(IRLEN) = 0 MM = MM+MLAB+4% IF(MM-(66-MLAB)) 2500,2400,2400PC RECORD FULL - OUTPUT2400 ICNT = 1 CALL ROUT  IRLEN = 3 MM = 82500 CONTINUE$ IF(IEXTN-NUMEX) 2000,2600,2600 2600 IF(IRLEN-3) 3000,3000,27002700 ICNT = 1 CALL ROUT0C5C OUTPUT PUBLICSC 3000 IPUBF = 15 NCBU1 = 223100 DO 3800 LL=1,5 IRLEN = 4+ MM = 10( NCBU4 = LL-1 DO 3600 I=1,LTAB" IF(ITAB(1,I)) 3200,3600,32003200 INDEX = ITABS(I)" IF(INDEX-256) 3250,3600,36003250 K = INDEX/32 K = K-(K/2)*2 IF(K-IPUBF) 3600,3300,33003300 INDEX = INDEX-(INDEX/8)*8 % IF(INDEX-(LL-1)) 3600,3400,3600 #3400 IF (LGEN+IPUBF) 3410,3420,342003410 K = ITAB(1,I)/MDIV' IF(IALPH(K)-IQUES) 3420,3600,34203420 K = ITABV(I)/256. IVAL = K IRLEN = IRLEN+10' NCBUF(IRLEN) = ITABV(I)-IVAL*256.  IRLEN = IRLEN+1  NCBUF(IRLEN) = K IRLEN = IRLEN+1) NCBUF(IRLEN) = MLABE IRLEN = IRLEN+1I NCBUF(IRLEN) = -I IRLEN = IRLEN+1  NCBUF(IRLEN) = 0 MM = MM+MLAB+8% IF(MM-(62-MLAB)) 3600,3600,35003500 ICNT = 1 CALL ROUT3 IRLEN = 4E MM = 1043600 CONTINUE IF(IRLEN-4) 3800,3800,37003700 ICNT = 1 CALL ROUT 3800 CONTINUE IF(IPUBF) 7000,7000,39003900 IF(LBUG) 7000,7000,3910=3910 IPUBF = -1 NCBU1 = 18 GO TO 3100C(C PROCESS OBJECT BYTESC+4000 IF(IEND) 4010,4010,40054005 LODLC = IPVALI GO TO 61004010 IF(LLEN) 9000,9000,4020 C CHECK FOR A PROGRAM GAP !4020 IF(LC-LODLC) 6000,4030,6000BC CHECK FOR SEGMENT CHANGE$4030 IF(ISEGT-NCONS) 6000,4040,6000$C CHECK IF RECORD WILL BE FILLED(4040 IF((NCPNT+LLEN)-35) 4050,6100,61001C CHECK FOR ANY RELOCATION TERMS IN THIS CODEF4050 IRTYP = 0 DO 4060 I=1,LLEN IRTYP = IRTYP+IREL(I) 4060 CONTINUE IF(IRTYP) 5000,5000,4070.C HAVE A RELOCATABLE BYTE - GET SEGMENT ID4070 ID = IRTYP/8 IRTYP = IRTYP-ID*8 ID = ID-(ID/4)*4$ IF(IRTYP-NCONS) 4200,4080,42003C RELOCATABLE WITHIN CURRENT SEGMENT - CHECK IDE!4080 IF(ID-NRELT) 4090,5000,4090 4090 IF(NRELT) 4100,6100,6100/C FIRST ENTRY, INITIALIZE RELOCATION RECORD04100 NRELT = ID NRBU1 = 34 IF(ID) 4120,4110,4120 4110 ID = 34120 NRBU4 = ID NRPNT = 4R GO TO 5000!C CHECK IF EXTERNAL REFERENCE $4200 IF(IRTYP-IEXTT) 4300,4210,4300!4210 IF(ID-NEXTT) 4230,4220,4230=C CHECK IF ROOM IN RECORDD!4220 IF(NEPNT-30) 5000,5000,6100F4230 IF(NEXTT) 4240,6100,61008C FIRST ENTRY - INITIALIZE EXTERNAL REFERENCE RECORD4240 NEXTT = ID NEBU1 = 32 IF(ID) 4260,4250,4260 4250 ID = 34260 NEBU4 = ID NEPNT = 40 GO TO 50006C HAVE INTERSEGMENT REFERENCE - CHECK SEGMENT TYPE$4300 IF(IRTYP-NINTS) 4310,4320,43104310 IF(NINTS) 4340,6100,6100!4320 IF(ID-NINTT) 6100,4330,6100PC CHECK IF RECORD FULL!4330 IF(NIPNT-32) 5000,5000,6100 2C FIRST ENTRY - INITIALIZE INTERSEGMENT RECORD4340 NINTS = IRTYPN NINTT = ID NIBU1 = 36 NIBU4 = IRTYPR IF(ID) 4360,4350,4360E 4350 ID = 34360 NIBU5 = ID NIPNT = 50C6)C PUT OBJECT CODE INTO OBJECT RECORDSEC 5000 DO 5500 I=1,LLEN NCPNT = NCPNT+1  NCBUF(NCPNT) = IBIN(I)# IRTYP = IREL(I)-(IREL(I)/8)*80 LODLC = LODLC+1. IF(IRTYP) 5100,5500,51005100 NH1 = (LODLC-1.)/256.R IVAL = NH1 NH2 = (LODLC-1.)-IVAL*256.$ IF(IRTYP-NCONS) 5300,5200,5300C HAVE RELOCATION REFERENCE 5200 NRPNT = NRPNT+1I NRBUF(NRPNT) = NH2 NRPNT = NRPNT+1, NRBUF(NRPNT) = NH1 GO TO 5500$5300 IF(IRTYP-IEXTT) 5310,5400,5310!C HAVE INTERSEGMENT REFERENCE05310 NIPNT = NIPNT+1  NIBUF(NIPNT) = NH2 NIPNT = NIPNT+1 NIBUF(NIPNT) = NH1 GO TO 5500C HAVE EXTERNAL REFERENCEP5400 NEPNT = NEPNT+1  K = IEXTI/256R NEBUF(NEPNT) = IEXTI-K*256 NEPNT = NEPNT+1  NEBUF(NEPNT) = K NEPNT = NEPNT+1L NEBUF(NEPNT) = NH2 NEPNT = NEPNT+1  NEBUF(NEPNT) = NH15500 CONTINUE GO TO 9000C=C OUTPUT CURRENT RECORDSCI6000 LODLC = LC 6100 IF(NCPNT-4) 7000,7000,61106110 ICNT = 1 IRLEN = NCPNT  CALL ROUT= DO 6130 I=1,3I IRLEN = NPNT(I)N IF(IRLEN) 6130,6120,61206120 ICNT = I*40+1E CALL ROUT 6130 CONTINUE C INITIALIZE FOR NEXT RECORD7000 DO 7010 I=1,8  MRFLG(I) = -1 7010 CONTINUE NCONS = ISEGTE NH1 = LODLC/256. IVAL = NH1 NH2 = LODLC-IVAL*256.E IF(IEND) 7020,7020,7100 7020 NCBU1 = 6 NCBU4 = ISEGTR NCBU5 = NH2O NCBU6 = NH1N NCPNT = 6, GO TO 4000*C END OF ASSEMBLY - OUTPUT END RECORDS7100 NCBU1 = 4, NCBU4 = IATYPT NCBU5 = IREL1  NCBU6 = NH20 NCBU7 = NH1  ICNT = 1 IRLEN = 7  CALL ROUTR NCBU1 = 14 IRLEN = 3 ICNT = 1 CALL ROUTN 9000 RETURN END SUBROUTINE ROUTC CV8C THIS ROUTINE IS USED TO OUTPUT THE OBJECT RECORDS.C0C7< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)$ DIMENSION IRBUF(160),IPBUF(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSRECTB COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL4@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTNB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO! EQUIVALENCE (NAME1,NAME(1))I8 EQUIVALENCE (IRBUF(1),MCNAM(1,1)),(IPBUF(1),IN(1))CSC *ENTRY PARAMETERS(C IRLEN - LENGTH OF RECORD TO OUTPUT5C ICNT - STARTING POINT OF RECORD IN ARRAY IRBUFHCIC *EXIT PARAMETERSC RECORD OUTPUTMCICJ ICKSM = 0M I = ICNT+1 IRBUF(I) = 0 I = I+1H IRBUF(I) = 0 IPLEN = 0  IRLEN = IRLEN+1A DO 400 LL=1,IRLENF INDEX = IRBUF(ICNT)M IF(INDEX) 100,200,200NC PUT SYMBOL INTO RECORD 100 MM = 0 INDEX = -INDEX DO 160 I=1,IWORD ID = MDIV)! IF(INDEX-10000) 110,115,110 110 NAME1 = ITAB(I,INDEX)  GO TO 120TC USE MODULE NAMEE115 NAME1 = MNAME(I)120 DO 160 L=1,ICCNT MM = MM+1T NN = NAME1/IDC ICKSM = ICKSM+NN IPLEN = IPLEN+1 IF(NN) 140,130,140130 IPBUF(IPLEN) = IAST GO TO 150E140 IPBUF(IPLEN) = IALPH(NN) NAME1 = NAME1-NN*ID ID = ID/256,150 IF(MM-MLAB) 160,300,300 160 CONTINUE GO TO 300 !C PUT DATA INTO OUTPUT RECORD 200 ICKSM = ICKSM+INDEXD MVAL = INDEX CALL VHEX  IPLEN = IPLEN+1O IPBUF(IPLEN) = NH1 IPLEN = IPLEN+1N IPBUF(IPLEN) = NH2300 ICNT = ICNT+1T" IF(LL-(IRLEN-1)) 400,350,400350 ICKSM = ICKSM+IPLEN-4E/ IRBUF(ICNT) = 256-(ICKSM-(ICKSM/256)*256))400 CONTINUE MVAL = IPLEN-6 CALL VHEXN IPBUF(3) = NH1 IPBUF(4) = NH2 IF(IPLEN-72) 500,600,600500 MM = IPLEN+1 DO 510 I=MM,72 IPBUF(I) = IBLNK510 CONTINUE600 MM = IOREC CALL INOUT(8)D IOREC = MM+1 900 RETURN END SUBROUTINE SYMTAC C =C THIS SUBROUTINE IS USED TO OUTPUT A SYMBOL TABLE OF ALLT6C SYMBOL USED IN THE PROGRAM AND DEFINED IN MACROSCPC-< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)/ DIMENSION LLAB(4,10),IXOUT(10),MCORE(128)N? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC5B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT3B COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO5 EQUIVALENCE (IXOUT(1),IN(1)),(MBIN(1),MCORE(1)) ! EQUIVALENCE (IBIN1,IBIN(1))T$ EQUIVALENCE (LLAB(1,1),IN(30))CMC *ENTRY PARAMETERS,C SYMBOL TABLE,C LREF - 1 = LIST CROSS REFERENCE TABLECDCH MXLAB = 60*MDIVH ISTA = 1 IFIN = 1 IGX = 0I IF(LREF) 8,8,66 IF(IXT) 7,8,8I7 IXT = -IXT WRITE(IPRT,1010) IXT61010 FORMAT(34H CROSS REFERENCE OVERFLOW AT LINE ,I5) LINE = 8 IXT = 0,8 DO 70 L=1,LTAB IF(ITAB(1,L)) 10,70,1010 IF(ISTA) 30,20,30R20 ISTA = L30 IFIN = L70 CONTINUE4C ALPHABETIZE AND OUTPUT SYMBOLS BY LEVEL NUMBER 140 MM = 0145 NAME(1) = MXLABRC GET NEXT SYMBOLF LIND = 0 DO 260 L=ISTA,IFIN IF(ITAB(1,L)) 210,260,2101210 DO 230 K=1,IWORD' IF(ITAB(K,L)-NAME(K)) 240,230,260 230 CONTINUE240 DO 250 K=1,IWORD NAME(K) = ITAB(K,L)F250 CONTINUE LIND = L260 CONTINUE IF(LIND) 300,270,300270 IF(MM) 900,900,400300 ITAB(1,LIND) = 0 L = ITABS(LIND)A L = L-(L/64)*640 IF(L-63) 305,145,145305 MM = MM+1M IRTYP = 1+L-(L/8)*8  IBIN(MM) = NRFLG(IRTYP) ICNT = 05C DECODE VALUE IN TABLE TO FORM OUTPUT CHARACTERS  DO 350 K=1,IWORD ID = MDIVK DO 350 L=1,ICCNT ICNT = ICNT+1, NN = NAME(K)/ID4 IF(NN) 310,310,320310 LLAB(MM,ICNT) = IBLNK  GO TO 330I320 NAME(K) = NAME(K)-NN*IDF ID = ID/256 LLAB(MM,ICNT) = IALPH(NN)T330 IF(ICNT-MLAB) 350,360,360I350 CONTINUEC GET SYMBOL VALUE360 IF(LGEN) 365,365,380&365 IF(LLAB(MM,1)-IQUES) 380,370,380370 MM = MM-1G GO TO 145C380 IVAL = ITABV(LIND) INDET = MM CALL AHEX  IF(LREF) 390,390,500390 IF(MM-4) 145,400,400400 LINE = LINE+1T IF(LINE-IOLIN) 420,420,410410 WRITE(IPRT,1002)1002 FORMAT(1H1)C LINE = 3&C OUTPUT NEXT LINE OF SYMBOL TABLE7420 WRITE(IPRT,1003) ((LLAB(II,K),K=1,ICNT),IBIN(II),N% 1 (IADDR(II,L),L=1,4), II=1,MM)5'1003 FORMAT(1X,4(6A1,2X,A1,1X,4A1,5X))  IF(LIND) 900,900,140 C FORM CROSS REFERENCE TABLE,C WRITE LAST RECORD TO FILE IF NECESSARY500 IF(IGX) 530,510,530E510 IF(IXPNT) 530,530,515 515 IF(IXCNT) 530,530,520 520 MODE = 1 CALL XREFT(1)N 530 IGX = 1L LEN = 04 LLEN = 0 ITCNT = MXREF*IXCNT+IXPNTC! IF(ITCNT-MXREF) 580,580,540 C READ PAGE FROM FILE 540 IXT = 1)550 L = MXREF/128T I1 = 0 DO 570 I=1,L MCREC = IXTC3=C THE FOLLOWING STATEMENTS READS THE CROSS REFERENCE FILE0C  CALL INOUT(4)N IXT = IXT+1T DO 560 M1=1,128F M2 = M1+I1 IXTAB(M2) = MCORE(M1)F560 CONTINUE I1 = I1+128T570 CONTINUE580 LL = MXREF! IF(ITCNT-MXREF) 590,600,600590 LL = ITCNT 600 I = 0 610 I = I+1X# IF(IXTAB(I)-LIND) 630,620,630F620 LEN = LEN+1  LLEN = LLEN+1  I1 = I+1 IXOUT(LEN) = IXTAB(I1) 630 I = I+1O IF(LEN-8) 640,830,830640 IF(I-LL) 610,650,650650 ITCNT = ITCNT-MXREFF IF(ITCNT) 800,800,550IC OUTPUT REFERENCES+800 IF(LLEN) 810,810,820 810 LEN = 11 IXOUT(1) = 0820 IF(LEN) 140,140,830830 LINE = LINE+17 IF(LINE-IOLIN) 850,840,840840 WRITE(IPRT,1002) LINE = 32850 WRITE(IPRT,1005) (LLAB(1,K),K=1,ICNT),IBIN1,- 1 (IADDR(1,K),K=1,4),(IXOUT(K),K=1,LEN)(1005 FORMAT(1X,6A1,2X,A1,1X,4A1,6X,8I6) IF(ITCNT) 140,140,860 860 LEN = 0  IBIN1 = IBLNK3 DO 870 K=1,4 IADDR(1,K) = IBLNK870 CONTINUE DO 880 K=1,MLAB5 LLAB(1,K) = IBLNKE880 CONTINUE GO TO 6101 900 RETURN END( SUBROUTINE XREFT(NCTL)CC32C THIS SUBROUTINE ACCUMULATES CROSS REFERENCESC4C < REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC1B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOLO@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTEB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSOCNC *ENTRY PARAMETERS8C MODE - REFERENCE MODEC -1 = DEFINITIONC 1 = REFERENCEE'C NCTL - 1 = DO ONLY WRITE TO DISKQ*C IXCNT - CURRENT REFERENCE PAGE COUNT*C IXPNT - POINTER INTO REFERENCE ARRAY!C LISN - CURRENT LINE NUMBERK)C IXT - NEGATIVE IMPLIES TABLE FULLC ITABI - SYMBOL TYPEHCIC *EXIT PARAMETERS5C IXPNT - INCREMENTED BY 2 IF ENTRY MADE IN TABLEA,C IXT - SET NEGATIVE IF TABLE OVERFLOWCNCX IF(IXT) 110,10,10 10 IF (IXCNT-IXPAG) 20,20,4020 IF(NCTL) 25,25,50 25 IF(ITABI-256) 30,110,11030 IF(IXPNT-MXREF) 100,50,50L40 IXT = -(LISN+MODE) RETURNC WRITE OUT PAGE TO FILE50 K = MXREF/128O I1 = 0 DO 70 I=1,K  DO 60 M1 = 1,128 M2 = I1+M1 IXTAB(M1) = IXTAB(M2)60 CONTINUE MCREC = IXT C 1C THE CROSS REFERENCE FILE IS WRITTEN INTO BY C THE FOLLOWING STATEMENT C  CALL INOUT(7)  I1 = I1+128  IXT = IXT+1170 CONTINUE IF(NCTL) 80,80,11080 IXCNT = IXCNT+1  IXPNT = 01 IF(IXCNT-IXPAG) 100,40,40,*C PUT DEFINITION OR REFERENCE IN TABLE100 IXPNT = IXPNT+1E IXTAB(IXPNT) = INDEX IXPNT = IXPNT+1 " IXTAB(IXPNT) = (LISN+1)*MODE 110 RETURN END  SUBROUTINE VHEXC CO:C THIS ROUTINE CONVERTS A VALUE BETWEEN 0 - 255 TO TWO<C HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE AREC CONVERTED TO ZEROSC=C+< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80) DIMENSION NUMS(16)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL @ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTLB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO# EQUIVALENCE(NUMS(1),IALPH(1)),CPC *ENTRY PARAMETERSLC MVAL - VALUE TO CONVERTCRC *EXIT PARAMETERS/C MVAL - SET TO ZERO IF VALUE OUT OF RANGEI"C NH1 - HIGH ORDER CHARACTER!C NH2 - LOW ORDER CHARACTERICHCH IF(MVAL-256) 10,30,30I10 IF(MVAL) 30,100,100P30 MVAL = 0100 NH1 = 1+MVAL/16I NH2 = MVAL-(NH1-1)*16+1 NH1 = NUMS(NH1)M NH2 = NUMS(NH2)N RETURN ENDO SUBROUTINE AHEXXCXC,>C THIS SUBROUTINE CONVERTS A VALUE BETWEEN 0 -65535 INTO 4EC HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE ARE RETURNED C AS ASTERISKSC CE REAL IHVAL,J1T< REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2$ REAL ISTKL,ITABV(200),NBIN(80) DIMENSION NUMS(16)? COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC B COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL= COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL@ COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTIB COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,LTAB,NAME(3),ITABIA COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTTLB COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTTA COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSMTD COMMON MNAME(6),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4)> COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGENC COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDETH9 COMMON IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT0F COMMON IPLUS,IMIN,IMULT,IDIV,IGRAT,ILESS,IRPAR,ILPAR,IBLNK,ISEMID COMMON ICOMM,ICTAB,IPER,ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,IAMPB COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRIB COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR8 COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(59),LTITL(50)@ COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND9 COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASSO$ EQUIVALENCE (NUMS(1),IALPH(1))CPC *ENTRY PARAMETERSLC IVAL - VALUE TO CONVERT2C INDET - INDEX OF ARRAY TO STORAGE CHARACTERS,C IADDR(INDET, ) - CONTAINS 4 CHARACTERSCOC *EXIT PARAMETERS)C CHARACTERS SET TO * IF OUT OF RANGEOCNCH J1 = 4096. IF(IVAL) 20,5,5H5 IF(IVAL-65536.) 10,20,2010 IHVAL = IVAL DO 15 J=1,4  M1 = IHVAL/J1A IVAL2 = M1 IHVAL = IHVAL-IVAL2*J1 J1 = J1/16.2 M1 = M1+1, IADDR(INDET,J) = NUMS(M1)N15 CONTINUE RETURN20 DO 25 J=1,4  IADDR(INDET,J) = IAST25 CONTINUE RETURN ENDHARACTERS,C IADDR(INDET, ) - CONTAINS 4 CHARACTERSCOC *EXIT PARAMETERS)C CHARACTERS SET TO * IF OUT OF RANGEOCNCH J1 = 4096. IF(IVAL) 20,5,5H5 IF(IVAL-65536.) 10,20,2010 IHVAL = IVAL DO 15 J=1,4  M1 = IHVAL/J1A IVAL2 = M1 IHVAL = IHVAL-IVAL2*J1 J1 = J; FILE ASMASM.CMD"FOR OB:ASM,LI:ASM=SR:ASM/NOSN/NOVAMAC OB:SPOOL,LI:SPOOL=SR:SPOOL!MAC OB:LENSTR,LI:LENSTR=SR:LENSTR!MAC OB:DELETE,LI:DELETE=SR:DELETE!MAC OB:GETPUT,LI:GETPUT=SR:GETPUT; END OF ASMASM.CMD2TK:ASM,MP:ASM/MA=OB:ASM,DELETE,SPOOL,GETPUT,LENSTRLB:[1,1]SYSLIB/LB:$SHORT/ACTFIL=6UNITS=9 MAXBUF=256ASG=TI:1ASG=SY:4,SY:5,SY:6,SY:7,SY:8//% .TITLE LENSTR (ARRAY,MAXLEN);+; LENSTR.MAC - 3/21/78%; SOUTH COBB - PROJECT NUMBER 7701008*; RSX-11M BL22 V3.1/PROJECT COMMON ROUTINE0; M.SORRELL - 3/21/78 REV. 9/14/78 RD VICKERS,; FUNCTION: ACCEPTS AN ARRAY AND COUNTS THEC; NUMBER OF CHARACTERS IN THE INPUT STRING. RESULT IS @; REACHED BY COUNTING RIGHT TO LEFT UNTIL A CHARACTER@; OTHER THAN "0 (NULL) OR "40 (SPACE) IS ENCOUNTERED.8; RESULT RETURNED (NUM) IS NEVER LESS THAN 1.@; CALLING STRUCTURE: LENSTR.MAC IS A FORTRAN CALLABLE FUNCTION.3; IT MAKES NO SUBROUTINE CALLS.-@; CALLING PROCEDURE/PARAMETER LIST: FORTRAN CALL IN THE FORM: '; NUM = LENSTR(ARRAY,MAXLEN)SC; ARRAY IS A LOGICAL STRING OF LENGTH MAXLEN (INTEGER). P&; RESULT IS RETURNED IN R0.;-'LENSTR:: CLR R0 A5 MOV 2(R5),R2 ;ARRAY ADDRESSI6 MOV 4(R5),R3 ;MAXLEN ADDRESS? ADD (R3),R2 ;MAXLEN+ADDRESS OF ARRAYA8 MOV 2(R5),R3 ;STARTING ADDRESS6LOOP: DEC R2 ;WORK BACKWARDS4 CMP R3,R2 ;END OF DATA?7 BEQ HERE ;BRANCH IF EQUALG: CMPB (R2),#0 ;IS CHARACTER NULL?: BNE THERE ;BRANCH IF NOT NULL< BR LOOP ;CHECK NEXT CHARACTER=THERE: CMPB (R2),#40 ;IS CHARACTER A SPACE? ; BNE HERE ;BRANCH IF NOT SPACE5A BR LOOP ;BRANCH FOR NEXT CHARACTER HHERE: INC R2 ;INCREMENT START ADDR+MAXLEN BY 1H SUB R3,R2 ;SUBTR START ADDR TO FIND RESULT 7 MOV R2,R0 ;MOVE FOR RETURN . RTS PC ;RETURN .END LOOP ;CHECK NEXT CHARACTER=THERE: CMPB (R2),#40 ;IS CHARACTER A S& .TITLE SPOOL - FORTRAN PRINT SPOOLING;S .IDENT /V02/ ;U; FORTRAN CALL:U;#; CALL SPOOL(LUN,IERR,IFCSER,IDSW); CALL SPOOL(LUN,IERR,,IDSW)O; CALL SPOOL(LUN,IERR,IFCSER); CALL SPOOL(LUN,IERR);;A#; WHERE LUN = LOGICAL UNIT NUMBER ;T ; RETURN:;$#; IERR = SPOOLING ERROR SEMAPHORE$; IFCSER = FCS ERROR CODE FROM FDB ; IDSW = DIRECTIVE STATUS WORD; ;I;E; NOTE:?;B#; FILE MUST BE OPEN AT TIME OF THE ; '; CALL TO SPOOL. SPOOL WILL CLOSE THEE#; FILE AND MAKE THE LUN RE-USABLE.T; ;N); INVALID LUN'S WILL RESULT IN A FORTRANA&; ERROR TRAPPED BY THE FCHNL ROUTINE.;,; REGISTER USAGE:O;U; R0 = RSX FDB ; R1 = LOOP COUNTER ; R2 = LUNL; R3 = OTS WORK AREA; R4 = FORTRAN FDBA;N;N& .GLOBL $FCHNL,$OTSV,$DSW,F.ERR,.PRINT;L .ENABL LSBA;RSPOOL:: MOV @2(R5),R2 ;GET LUNR' MOV @#$OTSV,R3 ;GET WORK AREA ADDRESS CALL $FCHNL ;FIND FDB ADDRESS( MOV R0,R4 ;SAV ADDRESS OF FORTRAN FDB ADD #14,R0 ;GET TO RSX FDBE$ CLR @4(R5) ;CLEAR ERROR SEMAPHORE" CALL .PRINT ;QUEUE FOR SPOOLING BCS ERR ;ERROR?0 MOV #66,R1 ;NO, MAKE FORTRAN FDB REUSEABLE+1$: CLR (R4)+ ;(ALSO SETS F.ERR TO ZEROP DEC R1 BNE 1$! BR 2$ ;BR ARROUND ERROR CODET!ERR: INC @4(R5) ;SET ERROR FLAGT&2$: MOVB (R5),R1 ;GET ARGUMENT COUNT% SUB #2,R1 ;MORE THAN TWO ARGUMENTSM BEQ RET ;NO RETURNK TST @6(R5) ;IFCSER PRESENT? BLE 3$ ;NOS2 MOV F.ERR(R0),@6(R5) ;YES RETURN FCS ERROR CODE(3$: DEC R1 ;MORE THAN THREE AGRUMENTS? BEQ RET ;NO RETURNL3 MOV @#$DSW,@10(R5) ;YES RETURN DIRECTIVE STATUS ;VRET: RTS PC ;RETURN TO CALLERR;E .DSABL LSBL .END ;(ALSO SETS F.ERR TO ZEROP DEC R1 BNE 1$! BR 2$ ;BR ARROUND ERROR CODET!ERR: INC @4(R5) ;SET ERROR FLAGT&2$: MOVB (R5),R1 ;GET ARGUMENT COUNT% SUB #2,R1 ;MORE THAN TWO ARGUMENTSM BEQ RET ;NO RETURNK TST @6(R5) ;IFCSER PRESENT? BLE 3$ ;NOS2 MOV F.ERR(R0),@6(R5) ;YES RETURN FCS ERROR CODE(3$: DEC R1 ;MORE THAN THREE AGRUME% .TITLE DELETE SUBROUTINE FOR FORTRAN;; FORTRAN CALL; CALL DELETE(LUN,ERR);; WHERE LUN=LOGICAL UNIT NUMBER; RETURN ;ERR=FCS ERROR CODE FROM FDB.;; NOTE5; FILE MUST BE OPEN OR FDBSET AND ASSIGN MUST BE USED; .MCALL DELET$ .GLOBL $FCHNL,$OTSV .ENABL LSBDELETE::MOV @2(R5),R2 MOV @#$OTSV,R3 JSR PC,$FCHNL MOV R0,R1 ADD #14,R0 DELET$ R0 BCS ERR MOV #66,R0 1$: CLR(R1)+ DEC R0 BNE 1$2$: MOV R0,@4(R5) RTS PCERR: MOVB F.ERR(R0),R0 BR 2$ .DSABL LSB  .ENDSUBROUTINE FOR FORTRAN;; FORTRAN CALL; CALL DELETE(LUN,ERR);; WHERE LUN=LOGICAL UNIT NUMBER; RETURN ;ERR=FCS ERROR CODE FROM FDB.;; NOTE5; FILE MUST BE OPEN OR FDBSET AND ASSIGN MUST BE USED; .MCALL DELET$ .GLOBL $FCHNL,$OTSV .ENABL LSBDELETE::MOV @2(R5),R2 MOV @#$OTSV,R3 JSR PC,$FCHNL MOV R0,R1 ADD #14,R0 DELET$ R0 BCS ERR MOV #66,R0 1$: CLR(R1)+ DEC R0 BNE 1$2$: MOV R0,@4(R5) RTS PCERR: MOVB F.ERR(R0),R0 BR 2$ . .TITLE GETPUT.GETSQ::JMP .GET.PUTSQ::JMP .PUT .ENDCCC*C 8080/8085 LINKING LOADER VERSION 1.0C COPYRIGHT 1977C MICROTECC SUNNYVALE, CA. 94086CC2C THE FOLLOWING VARIABLES ARE PASSED IN COMMONC4C ICRD = DEVICE NUMBER FOR COMMAND INPUT STREAM*C IPRT = DEVICE NUMBER OF LIST DEVICE2C IPCH = DEVICE NUMBER OF OBJECT PUNCH DEVICE6C IRDR = DEVICE NUMBER FOR READING OBJECT MODULES(C IFIL = DEFAULT OBJECT FILE NUMBER&C IMFLE = INTERMEDIATE FILE NUMBER-C IMREC = INTERMEDIATE FILE RECORD NUMBER%C MREC = TEMPORARY RECORD NUMBERI'C IPREC = OBJECT FILE RECORD NUMBERT.C IPLEN = LENGTH OF OBJECT RECORD TO OUTUT'C IFREC = OBJECT FILE RECORD NUMBERN-C IBIT = NUMBER OF BITS IN COMPUTER WORDN.C ISBIT = BIT SIZE FOR INTERNAL PROCESSING1C IWORD = NUMBER OF WORDS NEEDED FOR A SYMBOL 7C ICCNT = NUMBER OF CHARACTERS IN AN ENCODED SYMBOLD>C ICHWD = NUMBER OF CHARACTERS PER WORD FOR EQUATE ROUTINE2C ICHBT = NUMBER OF BITS IN INTERNAL CHARACTER'C MDIV = DIVISOR TO DECODE SYMBOLSR5C MCOL = MAXIMUM NUMBER OF SOURCE COLUMS SCANNEDE6C MLAB = MAXIMUM NUMBER OF CHARACTERS IN A SYMBOL4C NCCOM = ONES MASK FOR COMPLEMENTING CHARACTERS9C IDIF = NUMBER OF EXCESS BITS FOR CHARACTER PACKINGI6C MXEXT = MAXIMUM NUMBER OF EXTERNAL NAMES ALLOWED#C MODCT = OBJECT MODULE COUNTEROC IEND = END FLAG C IEOM = END OF MODULE FLAG"C MESSN = ERROR MESSAGE NUMBER&C MESSF = FIRST ERROR MESSAGE FLAG$C LSTAB = SYMBOL TABLE LIST FLAG1C LSYM = PLACE SYMBOLS IN OBJECT MODULE FLAGO4C LPUR = PURGE SYMBOLS FROM OBJECT MODULES FLAG2C LOBJ = DONT OUTPUT FINAL OBJECT MODULE FLAGC ITAB = SYMBOL TABLEC ITABS = SYMBOL TYPE TABLEB C ITABV = SYMBOL VALUE TABLE$C LTAB = LENGTH OF SYMBOL TABLE$C NAME = GENERALIZED NAME ARRAY,C INDET = GENERALIZED SYMBOL TABLE INDEX%C INDEX = INDEX INTO SYMBOL TABLER!C NPAGE = SEGMENT PAGING FLAGI"C NBASE = SEGMENT BASE ADDRESS!C NBEND = SEGMENT END ADDRESSMC MODE = MODE FLAGC,C MDADD = OUTPUT MODULE STARTING ADDRESS#C MDID = OUTPUT MODULE ID FLAG 'C IRLEN = GENERALIZED RECORD LENGTH )C NH1 = HEXADECIMAL OUTPUT VARIABLEL)C NH2 = HEXADECIMAL OUTPUT VARIABLEB!C ISEGT = RECORD SEGMENT TYPET)C ISTKF = STACK LENGTH SPECIFIED FLAG$C ID = GENERALIZED SEGMENT ID&C MDNAM = FINAL OUTPUT MODULE NAME!C IORDR = SEGMENT ORDER ARRAYG-C NMAIN = NUMBER OF MAIN PROGRAMS COUNTER $C IBAT = INTERACTIVE/BATCH FLAG'C MNAME = CURRENT INPUT MODULE NAMEM$C IERR = GENERALIZED ERROR FLAGC IERRI = MASTER ERROR FLAGE!C ICKSM = CHECKSUM FOR RECORD C NCKSM = SYMBOL CHECKSUMRC IPASS = PASS FLAGA*C ICOL = CURRENT COLUMN OF INPUT LINE&C ICOLE = CURRENT COLUMN FOR ERROR)C JCOL = LOAD COMMAND COLUMN POINTERI,C ICHAR = GENERALIZED CHARACTER VARIABLE&C IVAL = GENERALIZED 16 BIT VALUE&C IVAL1 = GENERALIZED 16 BIT VALUE%C MVAL = GENERALIZED 8 BIT VALUE/-C LODSA = CONTENT RECORD STARTING ADDRESSN&C LODLC = OUTPUT MODULE LOAD POINT$C LCNT = SYMBOL PROCESSING FLAG*C ISLEN = SEGMENT LENGTHS FOR A MODULE(C ISTYP = SEGMENT TYPES FOR A MODULE9C NHI = GENERALIZED HIGH ORDER PART OF 16 BIT VALUEC8C NLOW = GENERALIZED LOW ORDER PART OF 16 BIT VALUE%C NBHI = HIGH ORDER BASE ADDRESSI$C NBLOW = LOW ORDER BASE ADDRESS,C LCLEN = CURRENT MODULE SEGMENT LENGTHS0C IADDR = ADDRESS VALUES IN HOLLERITH FORMAT*C NAMEF = INPUT OBJECT FILE NAME ARRAY4C IN = COMMAND AND OBJECT RECORD INPUT BUFFER'C INC = LOAD COMMAND INPUT BUFFER (C IRBUF = OBJECT MODULE INPUT BUFFER)C IPBUF = OBJECT MODULE OUTPUT BUFFER #C NCBUF = CONTENT RECORD BUFFER )C IEXTP = EXTERNAL NAME POINTER TABLE *C LSADD = GENERALIZED STARTING ADDRESS(C LEADD = GENERALIZED ENDING ADDRESS#C NCCNT = CONTENT RECORD LENGTH #C LLEN = CONTENT RECORD LENGTH )C NRCNT = OBJECT MODULE RECORD LENGTH"C IEXTN = EXTERNAL NAME NUMBER%C IUNDF = UNDEFINED EXTERNAL FLAGTC IAST = ASTERISKC ICOMM = COMMAAC ICAT = AT SIGN C IQUES = QUESTION MARKUC ICOLN = COLONBC IBLNK = BLANKFC IEQUL = EQUAL SIGN C IALPH = ALPHANUMERIC ARRAYCNCN6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)= DIMENSION LLAB(4,10),LCTL(4),LISTS(4),LORDR(4),NORDR(4)NB COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2LC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)AD COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT0 LOGICAL*1 FILNAM(12),MCRBUF(80) ! ADDED 2/2/79C ! EQUIVALENCE (LCTL(1),LSTAB)D! EQUIVALENCE (LLAB(1),IN(1))O@ DATA LORDR(1),LORDR(2),LORDR(3),LORDR(4) /1HC,1HD,1HS,1HM/@ DATA LISTS(1),LISTS(2),LISTS(3),LISTS(4) /1HT,1HS,1HP,1HO/$ DATA FILNAM/12*"40/ ! ADDED 2/2/79CFC,CC---> THE FOLLOWING WILL GET AN MCR LINE, AND DETERMMINE IF THE OP.,CC---> WANTS TO INTERACTIVELY USE THE LINKER, OR, USE THE LINKER VIAOC---> A COMMAND FILECSCO CALL GETMCR(MCRBUF) DO 882 J=1,80<882 IF(MCRBUF(J).EQ."100)GOTO 884 ! BR FOR COMMAND FILE MODECIFC---> FALL THRU FOR INTERACTIVE MODE. ASSIGN 'TI:' TO LUN #5, AND, SET<C---> THE MODE FLAG, IBAT, TO THE INTERACTIVE MODE, I.E. "0"CA IBAT=0,; ICRD=5 ! SET THE DEVICE FOR THE COMMAND INPUT STREAM TO 5*C/6C---> NOW, WRITE OUT A PROMPT, AND LEAVE CURSOR AT ENDCC WRITE(5,883)E883 FORMAT(/,$,2X,'LNK>')A GOTO 889 ! BR TO NEXT SECTIONECOKC---> REACH HERE FOR THE COMMAND FILE MODE. PUT THE FILENAME OF THE COMMANDDIC---> FILE INTO THE FILNAM ARRAY,AND CALL ASSIGN THAT FILENAME TO LUN #8.>C---> ALSO, SET THE IBAT FLAG TO THE BATCH MODE, I.E. IBAT="1"CN 884 J=J+1- ICRD=8E4 DO 885 JJ=1,12 ! ALLOW FOR A FILENAME LENGTH OF 12@ IF((MCRBUF(J+JJ-1).LT."56).OR.(MCRBUF(J+JJ-1).GT."132))GOTO 887885 FILNAM(JJ)=MCRBUF(J+JJ-1)P IFFLN=12L GOTO 888 887 IFFLN=JJ-1:888 CALL ASSIGN(8,FILNAM,IFFLN) ! ASSIGN THE COMMAND FILE2 IBAT=1 ! SET THE FLAG INDICATING BATCH MODEC CECUCHCI7C THE FOLLOWING DEFINE STATEMENT DEFINES THE RANDOMA7C ACCESS INTERMEDIATE FILE USED TO WRITE THE OBJECT 7C MODULE RECORDS FOR USED BY PASS TWO OF THE LOADER=#C THIS CAN BE A SEQUENTIAL FILELCFCA)C---> ASSIGN LUN #7 TO THE TEMPORARY FILE.C 2/2/79 889 CALL ASSIGN(7,'SY0:LNK.TMP')C8CI# DEFINE FILE 7(500,80,U,IMREC)CTC INITIALIZE PROGRAM CALL INITI WRITE(IPRT,10001) 710001 FORMAT(1H1,15X,27H8080 LINKING LOADER VER 1.0,//,C# 1 3X,17H**LOADER COMMANDS,//) .C READ NEXT COMMAND LINE AND CHECK COMMAND100 CALL INOUT(1)I CALL COMIN MVAL = 0 IF(IERR-1) 120,9300,110 110 IF (INDEX-13) 9200,120,120>120 GO TO(1000,1500,2000,2000,2000,2000,2500,3000,3500,4000,& 1 4500,5000,6000,100,5500),INDEXCS9C SET MODULE NAME *** NAMEICCCCC---> "ICOL" IS THE START COLUMN OF THE ARGUMENT, IN THIS CASE, THE1EC---> FILENAME OF THE OUTPUT FILE. THE PURPOSE OF THE FOLLOWING IS TOXDC---> TRANSFER THE FIRST SIX CHARACTERS, OR ANY NUMBER OF CHARACTERSFC---> UP TO SIX, INTO THE FILENAME ARRAY. THIS CHARACTER STRING IN THEGC---> ARRAY "FILENAME" WILL BE USED TO NAME THE 'OBJECT FILE',(LUN #4),0&C---> AND, THE 'LISTING FILE',(LUN #6)C1000 DO 776 J=1,10776 FILNAM(J)="40C DO 777 J=1,6E6 IF(IN(ICOL+(J-1)).LE."40)GOTO 778 ! BR IF END OF NAME777 FILNAM(J)=IN(ICOL+(J-1)) J=J+1778 FILNAM(J)="56E9 IFFLN=J+3 ! SET THE LENGTH OF FILE INTO TEMP. VARIABLEHCO:C---> CALL ASSIGN THE OBJECT FILE ACCORDING TO THE 'NAME'C  FILNAM(J+1)="117 ! "O"  FILNAM(J+2)="102 ! "B"E FILNAM(J+3)="123 ! "S"NCN CALL ASSIGN(4,FILNAM,IFFLN)C CU6C---> CALL ASSIGN THE LISTING FILE ACCORDING TO 'NAME'CICNCC--- THE BELOW WAS DISABLED FOR THE TIME BEING, THIS WILL ALLOW THE C---> COMMANDS TO BE LISTED.C.C FILNAM(J+1)="114 ! "L"C FILNAM(J+2)="123 ! "S"C FILNAM(J+3)="124 ! "T"C5C CALL ASSIGN(6,FILNAM,IFFLN)TCFCLCN GO TO 100HCO:C SPECIFY STARTING ADDRESS *** STARTC 1500 CALL SCAN1 IF(IERR) 9200,1510,9200 1510 MDADD = IVAL MDID = 0 GO TO 1004CLCC SET BASE ADDRESS *** CODE,DATA, ...NC'2000 IF(MODCT) 2010,2010,94002010 CALL SCANE IF(IERR) 9200,2020,9200-2020 I = INDEX-2L NBASE(I) = IVAL1 LCLEN(I) = IVALM GO TO 100"C :C SET STACK SIZE *** STKLNCF2500 CALL SCANO IF(IERR) 9200,2520,9200R2520 ISTKF = 0  LCLEN(3) = IVAL GO TO 100AC:C SET SEGMENT ORDER *** ORDERC=3000 DO 3010 I=1,4 NORDR(I) = 03010 CONTINUE DO 3200 I=1,4C DO 3100 J=1,40* IF(IN(ICOL)-LORDR(J)) 3100,3110,31003100 CONTINUE GO TO 9200!3110 IF(NORDR(J)) 9200,3120,9200)3120 NORDR(J) = I ICOL = ICOL+1O IF(I-4) 3130,3200,3200'3130 IF(IN(ICOL)-ICOMM) 9200,3140,9200N3140 ICOL = ICOL+1O3200 CONTINUE)C CHECK IF SOME SEGMENT NOT SEPCIFIEDC DO 3300 I=1,4 ! IF(NORDR(I)) 3300,9200,3300R3300 CONTINUE DO 3310 I=1,4R IORDR(I) = NORDR(I)3310 CONTINUE GO TO 100EC 9C SET LIST FLAG *** LIST-CD3500 LSET = 1 GO TO 4010C:C CLEAR LIST FLAG *** NLISTCD4000 LSET = 0!4010 IF(ICOL-MCOL) 4020,4020,10034020 DO 4100 I=1,4(* IF(IN(ICOL)-LISTS(I)) 4100,4200,41004100 CONTINUE GO TO 92004200 LCTL(I) = LSET ICOL = ICOL+13 ICHAR = IN(ICOL)# IF(ICHAR-IBLNK) 4210,100,4210E4210 ICOL = ICOL+1R$ IF(ICHAR-ICOMM) 9200,4010,9200CN;C SET PUBLIC NAME *** PUBLIC C 4500 LCNT = 0 INDET = 0T CALL LABEL LL = IERRL* GO TO(4600,4600,9100,9100,9500),IERRC GET SYMBOL VALUE'4600 IF(IN(ICOL)-IEQUL) 9200,4610,920004610 ICOL = ICOL+1 4650 MVAL = 0 CALL SCAN0 IF(IERR) 9200,4700,9200O4700 IF(LL-2) 4740,4710,4710C PUT SYMBOL INTO TABLEC4710 DO 4720 I=1,IWORDI ITAB(I,INDEX) = NAME(I)04720 CONTINUE4740 ITABV(INDEX) = IVAL0 ITABS(INDEX) = 0% IF(IN(ICOL)-ICOMM) 100,4800,100 4800 ICOL = ICOL+10 GO TO 4500CE9C LOAD OBJECT FILE *** LOAD0C05000 DO 5010 I=1,80 INC(I) = IN(I)5010 CONTINUE5050 JCOL = ICOL6 MVAL = 80C CALL SCAN0 IF(IERR) 5100,5100,5200 !C READ MODULE FROM I/O DEVICE 5100 IRDR = IVAL4 JCOL = ICOLB GO TO 5300C GET FILE NAMEI5200 CALL EQUAT IF(IERR) 9700,5210,97005210 IRDR = -IRDR5300 CALL OBJ& IF(INC(JCOL)-ICOMM) 100,5310,1005310 ICOL = JCOL+1  GO TO 5050C 9C PROCESS EXIT COMMANDS *** EXIT C 5500 GO TO 6700C 8C PROCESS END *** ENDCC6000 IF(IBAT) 6002,6005,6002 6002 IF(IERRI) 6700,6005,6700%C FORM BASE ADDRESSES OF SEGMENTSI6005 LSADD = 0 ! IF(NBASE(3)) 6008,6006,6006 6006 IVAL = LCLEN(3)E LCLEN(3) = NBASE(3)U NBASE(3) = NBASE(3)-IVAL6008 DO 6090 I=1,4R ID = IORDR(I)  ISLEN(ID) = 0 #C CHECK IF USER DEFINED ADDRESS " IF(NBASE(ID)) 6010,6060,6060"6010 IF(NPAGE(ID)) 6040,6040,6020;C PAGE OR INPAGE SPECIFIED - MOVE TO NEXT PAGE BOUNDARY 6020 K = LSADD/256. IVAL1 = K  K = LSADD-IVAL1*256. IF(K) 6030,6040,60306030 LSADD = (IVAL1+1.)*256.S6040 NBASE(ID) = LSADD  ISLEN(ID) = LSADD,!6060 LSADD = ISLEN(ID)+LCLEN(ID)6070 NBEND(ID) = LSADDU LCLEN(ID) = NBASE(ID)V% IF(LSADD-65536.) 6090,6100,6100R6090 CONTINUE GO TO 6105C MODULE TOO LARGE6100 MESSN = 1015 GO TO 6700C PRINT LOAD MAP6105 IF(MODCT) 9990,9990,61106110 WRITE(IPRT,10002)V@10002 FORMAT(15H1 **LOAD MAP**,//,5X,20HMODULE CODE DATA,/) DO 6150 I=1,MODCT. INDEX = LTAB-I+1 INDET = 1 ID = -16 MODE = 0 CALL NAMES" IVAL = ITABV(INDEX)+ISLEN(1) INDET = 1D CALL AHEXD IVAL = ITABS(INDEX)  IF(IVAL) 6120,6130,613056120 IVAL = IVAL+65536.6130 IVAL = IVAL+ISLEN(2) INDET = 2O CALL AHEXS- WRITE(IPRT,10003) (LLAB(1,K),K=1,MLAB),P- 1 (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4)P"10003 FORMAT(5X,6A1,4X,4A1,2X,4A1)6150 CONTINUE IVAL = NBEND(2)) CALL AHEX= INDET = 1N IVAL = NBEND(1)N CALL AHEXD= WRITE(IPRT,10006) (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4)D#10006 FORMAT(5X,2H//,8X,4A1,2X,4A1)  DO 6160 I=3,4L IVAL = NBASE(I)  CALL AHEX0 INDET = INDET+1A IVAL = NBEND(I)I CALL AHEX  INDET = INDET+1L6160 CONTINUE> WRITE(IPRT,10004) (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4),- 1 (IADDR(3,K),K=1,4),(IADDR(4,K),K=1,4)4210004 FORMAT(5X,5HSTACK,5X,4A1,/,5X,2H//,8X,4A1,/,, 1 5X,6HMEMORY,4X,4A1,/,5X,2H//,8X,4A1)(C ADJUST SYMBOLS TO PROPER ADDRESSES LL = LTAB-MODCTK DO 6250 I=1,LL" IF(ITAB(1,I)) 6210,6260,6210!6210 K = ITABS(I)-(ITABS(I)/8)*8  IF(K) 6250,6250,62206220 IVAL = ITABV(I)+NBASE(K)$ IF(IVAL-65536.) 6240,6230,62306230 IVAL = IVAL-65536.6240 ITABV(I) = IVAL 6250 CONTINUE#C CHECK FOR ANY SEGMENT OVERLAP16260 DO 6370 I=1,43 IVAL = NBASE(I)K IVAL1 = NBEND(I)-1.T# IF(IVAL-IVAL1) 6300,6300,637016300 DO 6360 K=1,4/ IF(I-K) 6310,6360,63106310 LSADD = NBASE(K) LEADD = NBEND(K)-1.K# IF(IVAL-LSADD) 6330,6320,6320(#6320 IF(IVAL-LEADD) 6380,6380,6330($6330 IF(IVAL1-LSADD) 6360,6340,6340$6340 IF(IVAL1-LEADD) 6380,6360,63606360 CONTINUE6370 CONTINUE GO TO 6400C HAVE A SEGMENT OVERLAP6380 WRITE(IPRT,10005)E(10005 FORMAT(//,3X,17H**SEGMENT OVERLAP)C OUTPUT SYMBOL TABLES6400 IF(LSTAB) 6410,6600,6410 6410 ID = 0 WRITE(IPRT,10011)3'10011 FORMAT(19H1 **PUBLIC SYMBOLS,//)I6420 INDEX = 106430 INDET = 1B6440 CALL NAMES INDEX = INDEX+1  IF(IERR) 6460,6450,64606450 INDET = INDET+18 IF(INDET-4) 6440,6440,64606460 INDET = INDET-1  IF(INDET) 6520,6520,6500C OUTPUT NEXT LINE/6500 WRITE(IPRT,10007) ((LLAB(II,K),K=1,MLAB),E' 1 (IADDR(II,L),L=1,4),II=1,INDET)M!10007 FORMAT(1X,4(6A1,2X,4A1,6X))  IF(IERR) 6430,6430,6520F6520 IF(ID) 6600,6530,6600 6530 ID = 1 WRITE(IPRT,10008) *10008 FORMAT(///,18H **LOCAL SYMBOLS,//) GO TO 64201C PERFORM PASS2 OF LOAD AND FORM FINAL MODULE6600 IPASS = 26 DO 6610 I=1,8N IN(I) = IALPH(1)6610 CONTINUE IN(2) = IALPH(2) CALL INOUT(4)DC REWIND IMFLE CALL OBJ WRITE(IPRT,10009)1-10009 FORMAT(//,3X,16H**LOAD COMPLETED,/,1H1)I GO TO 99906700 WRITE(IPRT,10010)(110010 FORMAT(//,3X,20H**LOAD NOT COMPLETED,/,1H1)5 GO TO 9990C6C SET ERROR CONDITIONSC INVALID SYMBOL9100 MESSN = 1006 GO TO 9900C INVALID OPERAND OR VALUE9200 MESSN = 1016 GO TO 9900C INVALID COMMAND 9300 MESSN = 1017 GO TO 9900#C COMMAND NOT ALLOWED - IGNOREDP9400 MESSN = 1018 GO TO 9900C SYMBOL TABLE FULL9500 MESSN = 1012 GO TO 9900C MODULE GREATER THAN 64K19600 MESSN = 1015 GO TO 9900C FILE NOT FOUND9700 MESSN = 10199900 CALL ERROR IERRI = IERRI+IBAT GO TO 100D9990 CALL SPOOL(6,IERR)B CALL DELETE(7,IERR) CALL DELETE(6,IERR) STOPA END  SUBROUTINE INIT C6C :C THIS ROUTINE INITIALIZES THE VARIABLES NEEDED BY THE C LOADERCC 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) DIMENSION NALPH(39) B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2C COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)DD COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTD DATA NALPH( 1),NALPH( 2),NALPH( 3),NALPH( 4) /1H0,1H1,1H2,1H3/D DATA NALPH( 5),NALPH( 6),NALPH( 7),NALPH( 8) /1H4,1H5,1H6,1H7/D DATA NALPH( 9),NALPH(10),NALPH(11),NALPH(12) /1H8,1H9,1HA,1HB/D DATA NALPH(13),NALPH(14),NALPH(15),NALPH(16) /1HC,1HD,1HE,1HF/D DATA NALPH(17),NALPH(18),NALPH(19),NALPH(20) /1HG,1HH,1HI,1HJ/D DATA NALPH(21),NALPH(22),NALPH(23),NALPH(24) /1HK,1HL,1HM,1HN/D DATA NALPH(25),NALPH(26),NALPH(27),NALPH(28) /1HO,1HP,1HQ,1HR/D DATA NALPH(29),NALPH(30),NALPH(31),NALPH(32) /1HS,1HT,1HU,1HV/D DATA NALPH(33),NALPH(34),NALPH(35),NALPH(36) /1HW,1HX,1HY,1HZ/@ DATA NALPH(37),NALPH(38),NALPH(39) /1H ,1H?,1H@/< DATA NCAT,NQUES,NAST,NBLNK,NCOMM /1H@,1H?,1H*,1H ,1H,/ DATA NCOLN,NEQUL /1H:,1H=/C C $C SET I/O LOGICAL DEVICE NUMBERS IPCH = 4C,AC---> THIS COMMENT REPLACES THE ASSIGNMENT OF THE VARIABLE 'ICRD'H9C---> THIS ASSIGNMENT NOW TAKES PLACE IN THE MAIN ROUTINE/C, IPRT = 6 IMFLE = 7) IFIL = 1833C SET PARAMETERS FOR INTERNAL SYMBOL PROCESSINGN IBIT = 16) MLAB = 6 ICCNT = IBIT/8 IWORD = 1+(MLAB-1)/ICCNT MDIV = 256**(ICCNT-1) CA'C SET PARAMETERS FOR EQUATE ROUTINEHC ISBIT = COMPUTER BIT SIZEL*C ICHBT = NUMBER OF BITS PER CHARACTER2C E.G. MOST MINIS=8, 370=8,PDP 10=7,CDC 6600=6 ISBIT = 16 ICHBT = 8I ICHWD = ISBIT/ICHBTS IDIF = ISBIT-ICHWD*ICHBTT NCCOM = -1+2**ICHBT CT IPASS = 1  MXEXT = 2001 IERRI = 0A NCKSM = 0A NMAIN = 0N IMREC = 11 IPREC = 16 ISTKF = -1 MDNAM(10) = -1 MDADD = -1 LSTAB = 0I LSYM = 0 LPUR = 1 LOBJ = 1 LODLC = -1 LTAB = 500CLIC---> THIS REPLACEMENT SIMPLY DISABLES THE INITIAL DEFAULT SETTING OF THE8EC---> MODE FLAG 'IBAT', THE DEFAULT SETTING BEING THE BATCH MODE. THE GC---> SETTING IS NOW TAKEN CARE OF IN THE BEGINNING OF THE MAIN ROUTINEC  ISEGT = 0  MCOL = 72  IEND = 0 MODCT = 0 MDADD = 0 MDID = -1 ICAT = NCAT  IQUES = NQUES  IAST = NAST  IEQUL = NEQULS IBLNK = NBLNK= ICOMM = NCOMM  ICOLN = NCOLNOC INITIALIZE SYMBOL TABLE DO 100 I=1,LTABS ITAB(1,I) = 0I ITABS(I) = 0100 CONTINUEC INITIALIZE MODULE NAME DO 110 I=1,9 MNAME(I) = IBLNK110 CONTINUE MNAME(10) = 6I<C INITIALIZE MODULE LENGTH, PAGING FLAGS, BASE ADDRESSESC AND SEGMENT ORDER  DO 120 I=1,4 LCLEN(I) = 0.D NPAGE(I) = -1N NBASE(I) = -1Q IORDR(I) = I120 CONTINUE&C INITIALIZE ALPHABETIC CHARACTERS DO 130 I=1,39  IALPH(I) = NALPH(I)A130 CONTINUE RETURN ENDS SUBROUTINE INOUT(INDX)CBC):C THIS ROUTINE PERFORMS ALL I/O FOR THE PROGRAM EXCEPT<C FOR THE HEADINGS AND ERROR MESSAGES. THESE STATEMENTS;C MAY HAVE TO CHANGE ON SOME MACHINES PARTICULARILY FORE;C DISK I/O. TWO STATEMENTS ARE SHOWN FOR EACH DISK I/O :C OPERATION. A STANDARD READ OR WRITE AS USED BY IBM,=C DEC AND SOME OTHERS, AND A CALL TO A SYSTEM I/O ROUTINEI@C AS USED BY H.P. AND SOME OTHERS (FOR INFORMATIVE PURPOSES)8C THE RECORD NUMBER (ASSOCIATED VARIABLE) FOR RAMDOM6C ACCESS I/O IS PASSED INTO THE ROUTINE VIA COMMONC C 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)! DIMENSION NAMEI(3),NAMEP(3)IB COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2OC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT6 DATA NAMEI(1),NAMEI(2),NAMEI(3) /2HIM,2HFL,2HE /6 DATA NAMEP(1),NAMEP(2),NAMEP(3) /2HOB,2HFL,2HE /CC *ENTRY PARAMETERS,C INDX - I/O CONTROL WORD#C 1 = READ COMMAND LINE,"C 2 = READ OBJECT FILE(C 3 = READ INTERMEDIATE FILE)C 4 = WRITE INTERMEDIATE FILEI+C 5 = WRITE FINAL OBJECT MODULE,CDC *EXIT PARAMETERS!C I/O READ OR WRITE PERFORMEDOCNCS% GO TO(100,200,300,400,500),INDXLC3C READ COMMAND STATEMENTSMC1100 READ(ICRD,1000) IN!C CHECK IF COMMAND IS PRINTEDEC)GC---> THE CHECK IN THIS POSITION WAS DISABLED TO ALLOW FOR THE COMMANDS/!C---> TO BE ECHOED IN THE LISTINGECC150 WRITE(IPRT,1001) IN 1001 FORMAT(1X,80A1) 1000 FORMAT(80A1) 190 RETURNCEC READ OBJECT MODULECE3C FOR MOST COMPUTERS THE READ STATEMENTS NEEDEDM6C TO READ THE OBJECT MODULE FROM A FILE OR FROM AN>C I/O DEVICE IS THE SAME AND THE I/O STATEMENTS AT 200 AND9C 250 ARE THE SAME. FOR SOME COMPUTERS THE READS ARE0>C DIFFERENT AND THESE STATEMENTS MAY HAVE TO BE DIFFERENT.CI(C READ OBJECT MODULE FROM I/O DEVICE200 IF(IRDR) 250,210,210210 READ(IRDR,1000) IN RETURN"C READ OBJECT MODULE FROM FILE250 IRDR = -IRDR READ(IRDR,1000) IN*C CALL EXEC(14,1091,IN,80,NAMEF,IFREC) IRDR = -IRDR RETURNCOC READ INTERMEDIATE FILECL300 IMREC = IFREC/ READ(IMFLE'IMREC) IN*C CALL EXEC(14,1091,IN,80,NAMEI,IMREC) RETURNC C WRITE INTERMEDIATE FILE CF400 WRITE(IMFLE'IMREC) INY*C CALL EXEC(15,1091,IN,80,NAMEI,IMREC) RETURNC C WRITE FINAL OBJECT MODULE0C1500 I = IPREC0+ WRITE(IPCH,1000) (IPBUF(I),I=1,IPLEN)F-C CALL EXEC(15,1091,IPBUF,72,NAMEP,IPREC)0 IPREC = I+1E RETURN ENDF SUBROUTINE OBJCC 5C THIS ROUTINE PROCESS AN OBJECT MODULE AND FORMSM7C THE FINAL ABSOLUTE MODULE WITH ALL MODULES LINKED(6C TOGETHER AND ALL RELOCATABLE ADDRESSES RESOLVED.6C IT ALSO PLACES ALL SYMBOLS INTO THE SYMBOL TABLE#C TO BE USED BY OTHER ROUTINES.MC)C 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2BC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT3 EQUIVALENCE (IRBU1,IRBUF(1)),(IRBU2,IRBUF(2)) 3 EQUIVALENCE (IRBU3,IRBUF(3)),(IRBU4,IRBUF(4))N" EQUIVALENCE (NCBU1,NCBUF(1))C,C ENTRY PARAMETERSC IN - CONTAINS OBJECTA!C IPASS - PASS FLAG, 1=PASS 1P'C LCLEN - STARTING MODULE ADDRESSESE$C NBASE - SEGMENT BASE ADDRESSESC C *EXIT PARAMETERS%C LCLEN - UPDATED SEGMENT LENGTHS7C NPAGE - POSITIVE IMPLIES INPAGE OR PAGE OPERATIONMCIC,*C INITIALIZE SEGMENT LENGTHS AND TYPES MREC = 0C NCBU1 = -1I10 DO 20 I=1,4F ISLEN(I) = 0 ISTYP(I) = 020 CONTINUE DO 30 I=1,MLAB MNAME(I) = IBLNK 30 CONTINUE, 50 MESSF = 0 IEOM = 0 IHEAD = 0 IEXTN = 0 IUNDF = 0CPC READ NEXT OBJECT RECORD CC100 ITYPE = IPASS+1D MREC = MREC+1  IFREC = MREC CALL INOUT(ITYPE)A IF(IPASS-1) 115,110,115E'C WRITE RECORD TO INTERMEDIATE FILEP110 I = IMRECG CALL INOUT(4) IMREC = I+1GC GET RECORD TYPE115 ICOL = 1 ICKSM = 0O CALL HEXIN IF(IERR) 9000,120,9000120 NTYP = MVAL.C CHECK IF FIRST RECORD IS A HEADER RECORD IF(IPASS-2) 122,140,122 122 IF(MREC-1) 130,125,130125 IF(NTYP-2) 9200,140,9200130 IF(IEOM) 140,140,135135 IF(NTYP-14) 9150,140,9150+C GET RECORD COUNT140 CALL HEXIN IF(IERR) 9000,150,9000150 IF(MVAL-72) 160,160,9300160 NRCNT = MVAL CALL HEXIN IF(IERR) 9000,170,9000170 IF(MVAL) 9300,200,9300:C PROCESS RECORD TYPES AND CHECK FOR PURE DATA RECORDS200 IF(NTYP-2) 2500,1000,210210 IF(NTYP-4) 9400,500,220F220 IF(NTYP-6) 9400,500,230230 IF(NTYP-14) 9400,500,240240 IF(NTYP-18) 9400,3000,250 250 IF(NTYP-22) 9400,3500,260 260 IF(NTYP-24) 9400,6000,270Y270 IF(NTYP-32) 9400,500,280280 IF(NTYP-34) 9400,500,290290 IF(NTYP-36) 9400,500,9400 #C HAVE PURE DATA RECORD, UNPACKN500 NRCNT = NRCNT/2X DO 520 I=1,NRCNT CALL HEXIN IF(IERR) 9000,510,9000510 IRBUF(I) = MVALC520 CONTINUE# ICKSM = ICKSM-(ICKSM/256)*2560 IF(ICKSM) 9100,610,9100,610 IF(NTYP-4) 4000,4000,620620 IF(NTYP-14) 5000,2000,6302 630 IF(NTYP-34) 7000,8000,8500C!C ***** PROCESS HEADER RECORD6C 1000 IF(IHEAD) 9200,1010,92001010 IHEAD = IHEAD+12 CALL HEXIN IF(IERR) 9000,1020,9000-1020 DO 1050 I=1,MVAL K = ICOL+I-1 LL = IN(K) IF(LL-IAST) 1040,1030,10401030 LL = IBLNK1040 MNAME(I) = LLR1050 CONTINUE MNAME(10) = MVAL" IF(MDNAM(10)) 1060,1080,10801060 DO 1070 I=1,MVAL MDNAM(I) = MNAME(I)1070 CONTINUE MDNAM(10) = MVAL1080 LCNT = MVAL, CALL SYMBL IF(IERR-4) 1090,9500,1090* 1090 IF(IPASS-1) 1115,1100,1115C PUT NAME INTO TABLE01100 LL = LTAB-MODCT2 DO 1110 K=1,IWORD  ITAB(K,LL) = NAME(K)1110 CONTINUE MODCT = MODCT+111115 CALL HEXIN IF(IERR) 9000,1120,900001120 CALL HEXIN IF(IERR) 9000,1130,9000 $C GET SEGMENT ID,LENGTH AND TYPE1130 NN = (NRCNT-LCNT-8)/80 IF(NN) 1400,1400,1150 1150 DO 1290 I=1,NN CALL HEXIN IF(IERR) 9000,1210,9000C1210 IF(MVAL) 9600,9600,1220 1220 IF(MVAL-4) 1230,1230,960001230 ID = MVAL1 CALL HEXIN IF(IERR) 9000,1240,9000L1240 IVAL = MVAL  CALL HEXIN IF(IERR) 9000,1250,90001250 IVAL1 = MVAL CALL HEXIN IF(IERR) 9000,1260,9000R1260 IF(MVAL) 9600,9600,1270H1270 IF(MVAL-3) 1280,1280,96000!1280 ISLEN(ID) = IVAL1*256.+IVAL  ISTYP(ID) = MVAL1290 CONTINUE2C CHECK IF ANY INPAGE OR PAGE RELOCATION TYPES DO 1370 I=1,2F NHI = ISLEN(I)/256.0 IVAL = NHI NLOW = ISLEN(I)-IVAL*256.2 NBHI = LCLEN(I)/256. IVAL = NBHI NBLOW = LCLEN(I)-256.*IVAL ID = ISTYP(I)  IF(ID) 1310,1370,131001310 IF(ID-2) 1320,1350,1370LC CHECK INPAGE RELOCATIONR1320 IF (NHI) 1350,1330,13501330 NPAGE(I) = 1) IF((NLOW+NBLOW)-256) 1370,1350,1350SC FORCE TO NEXT PAGE1350 NPAGE(I) = 2 IF(NBLOW) 1360,1370,13601360 NBHI = NBHI+1G NBLOW = 0S LCLEN(I) = (IVAL+1.)*256. IF (MODCT-1) 1370,1362,1370!1362 IF (NBASE(I)) 1370,1364,1364V1364 NBASE(I) = LCLEN(I)1370 CONTINUE IF(IPASS-1) 1400,1380,14001380 LL = LTAB-MODCT+1= ITABV(LL) = LCLEN(1) IVAL = LCLEN(2)I$ IF(IVAL-32768.) 1395,1390,13901390 IVAL = IVAL-65536.1395 ITABS(LL) = IVALC CHECK CHECKSUM1400 CALL HEXIN IF(IERR) 9000,1410,9000 #1410 ICKSM = ICKSM-(ICKSM/256)*256  IF(ICKSM) 9100,100,91000CB1C ***** PROCESS END OF MODULE AND FILE RECORD.C52000 IF (IPASS-1) 50,9990,50C 2500 IF(IPASS-1) 2510,9400,25102510 IF(NCBU1) 2540,2520,25202520 LLEN = NCCNT CALL OUT2540 IEND = 1 CALL OUT GO TO 9990C !C ***** PROCESS SYMBOL RECORD C 3000 IADDS = 2565 INDET = 1  IF(LPUR) 3510,100,3510CL-C ***** PROCESS PUBLIC DECLARATION RECORDNC 3500 IADDS = 0, INDET = 0 3510 IF(IPASS-2) 3520,100,3520 C GET SEGMENT ID3520 CALL HEXIN IF(IERR) 9000,3530,9000 3530 IF(MVAL-4) 3540,3540,960013540 ID = MVALC GET OFFSET AND NAME,3600 CALL HEXIN IF(IERR) 9000,3610,9000=3610 IVAL = MVALO CALL HEXIN IF(IERR) 9000,3620,900093620 IVAL1 = MVAL IVAL = IVAL1*256.+IVAL CALL HEXIN IF(IERR) 9000,3640,9000)3640 LCNT = MVAL ICOLE = ICOL CALL LABEL' GOTO (3690,3660,9500,3660,9250) , IERRE"C SYMBOL NOT IN TABLE - PUT IN3660 DO 3670 I=1,IWORDD ITAB(I,INDEX) = NAME(I)R3670 CONTINUE IF(ID) 3675,3685,36750%3675 IVAL = IVAL+LCLEN(ID)-NBASE(ID)S" IF(NBASE(ID)) 3680,3685,36853680 IVAL = IVAL-1.3685 ITABV(INDEX) = IVAL  ITABS(INDEX) = ID+IADDS9 GO TO 3700C DUPLICATE PUBLIC NAME=3690 MESSN = 14 CALL ERROR3700 CALL HEXIN IF(IERR) 9000,3710,9000'3710 IF(ICOL-(NRCNT+5)) 3600,3720,3720GC GET CHECKSUM3720 CALL HEXIN IF(IERR) 9000,3730,9000U#3730 ICKSM = ICKSM-(ICKSM/256)*256  IF(ICKSM) 9100,100,9100 CTC ***** PROCESS END RECORDC4000 DO 4020 I=1,3 LCLEN(I) = LCLEN(I)+ISLEN(I)A$ IF (LCLEN(I)-65536.) 4020,9350,9350 4020 CONTINUET IEOM = 1= IF(IPASS-2) 100,4100,1004100 IF(IRBU1) 4200,4200,41104110 IF(NMAIN) 4120,4120,42004120 NMAIN = 1A MDID = IRBU2 IVAL = IRBU3 IVAL1 = IRBU47 MDADD = IVAL1*256.+IVAL0 IF(MDID) 4140,4200,41400+4140 MDADD = MDADD+LCLEN(MDID)-ISLEN(MDID)% IF(MDADD-65536.) 4200,4150,4150 4150 MDADD = MDADD-65536.4200 IHEAD = 0  IEXTN = 0D GO TO 1000C1"C ***** PROCESS CONTENT RECORDC 5000 IF(IPASS-1) 5050,5230,50505050 IF(NCBU1) 5200,5100,51005100 LLEN = NCCNT CALL OUT5200 NCCNT = NRCNT-4 DO 5220 I=1,NCCNT, K = I+3I NCBUF(I) = IRBUF(K)5220 CONTINUE5230 IVAL = IRBU2 LSADD = IRBU3V LSADD = LSADD*256.+IVAL4 IVAL = NRCNT-5 LEADD = LSADD+IVAL ISEGT = IRBU1F NCBU1 = IRBU41 LODSA = LSADD  IF(ISEGT) 5240,100,5240 5240 IF(ISEGT-2) 5300,5300,9600?C CHECK IF ADDRESS WITHIN BOUNDS SPECIFIED IN HEADER RECORD +5300 IF(ISLEN(ISEGT)-LEADD) 9700,5310,53100 5310 LODSA = LSADD+LCLEN(ISEGT) GO TO 100 CN(C ***** PROCESS EXTERNAL NAME RECORDCI6000 CALL HEXIN IF(IERR) 9000,6020,900006020 LCNT = MVAL  INDET = 0 CALL LABEL* GO TO(6040,6030,9500,6030,6030),IERR0C EXTERNAL NOT IN TABLE - SET UNDEFINED FLAG6030 INDEX = 0 6040 IF(IPASS-1) 6050,6070,60506050 IEXTN = IEXTN+1I$ IF(IEXTN-MXEXT) 6060,9050,90506060 IEXTP(IEXTN) = INDEX6070 CALL HEXIN IF(IERR) 9000,6080,9000D'6080 IF(ICOL-(NRCNT-5)) 6000,6000,6090CC GET CHECKSUM6090 CALL HEXIN IF(IERR) 9000,6100,9000E#6100 ICKSM = ICKSM-(ICKSM/256)*256I IF(ICKSM) 9100,100,9100TCM&C ***** PROCESS EXTERNAL REFERENCEC 7000 IPNT = 1 LOHI = IRBU1 IF(LOHI) 9600,9600,7010L7010 IF(LOHI-3) 7020,7020,9600E7020 NRCNT = (NRCNT-2)/40 DO 7300 LL=1,NRCNT IPNT = IPNT+1I IPNT1 = IPNT+1* INDEX = IRBUF(IPNT)+IRBUF(IPNT1)*256 IPNT = IPNT+2) IVAL = IRBUF(IPNT) IPNT = IPNT+1, IVAL1 = IRBUF(IPNT)S IVAL = IVAL1*256.+IVAL# IF(IVAL-LSADD) 9700,7040,7040 #7040 IF(IVAL-LEADD) 7050,7050,9700M7050 ICPNT = IVAL-LSADD+1.* IF(IPASS-1) 7060,7300,7060!C CHECK IF UNDEFINED EXTERNAL1$7060 IF(INDEX-IEXTN) 7070,7070,98007070 INDEX = INDEX+19 INDEX = IEXTP(INDEX) IF(INDEX) 7100,7100,7200C HAVE UNDEFINED EXTERNALT7100 MESSN = 13 CALL ERROR IUNDF = IUNDF+1  NBHI = 0 NBLOW = 0B GO TO 72207200 NBHI = ITABV(INDEX)/256. IVAL1 = NBHI% NBLOW = ITABV(INDEX)-IVAL1*256.)7220 MVAL = NBLOW IF(LOHI-2) 7250,7240,7250M7240 MVAL = NBHIL7250 MVAL = NCBUF(ICPNT)+MVAL IC = MVAL/256H NCBUF(ICPNT) = MVAL-IC*256 IF(LOHI-3) 7300,7260,730007260 ICPNT = ICPNT+1 ! MVAL = NCBUF(ICPNT)+NBHI+ICI IC = MVAL/256 NCBUF(ICPNT) = MVAL-IC*2567300 CONTINUE GO TO 100C %C ***** PROCESS RELOCATION RECORD CB8000 ID = ISEGT IPNT = 2 GO TO 8505C5'C ***** PROCESS INTERSEGMENT RECORDBCN8500 ID = IRBU1 IPNT = 38505 IF(NCBU1) 9150,8510,85108510 IF (ID) 8515,9150,851508515 NRCNT = (NRCNT-IPNT)/2 IVAL1 = LCLEN(ID)  IF(ID-3) 8530,8520,8525 8520 IVAL1 = NBEND(3) GO TO 85308525 IVAL1 = NBASE(4)8530 NBHI = IVAL1/256.  IVAL = NBHI NBLOW = IVAL1-IVAL*256.6 IPNT = IPNT-1  LOHI = IRBUF(IPNT) IF(LOHI) 9600,9600,85328532 IF(LOHI-3) 8534,8534,9600=8534 DO 8600 LL=1,NRCNT IPNT = IPNT+1N IVAL = IRBUF(IPNT) IPNT = IPNT+1  IVAL1 = IRBUF(IPNT)1 IVAL = IVAL1*256.+IVAL# IF(IVAL-LSADD) 9700,8540,8540N#8540 IF(IVAL-LEADD) 8550,8550,9700 %C POINT TO CONTENT BYTE TO MODIFY 8550 IF(IPASS-1) 8555,8600,85558555 ICPNT = IVAL-LSADD+1.= MVAL = NBLOW IF(LOHI-2) 8570,8560,8570-8560 MVAL = NBHIP8570 MVAL = NCBUF(ICPNT)+MVAL IC = MVAL/256) NCBUF(ICPNT) = MVAL-IC*256 IF(LOHI-3) 8600,8580,8600L8580 ICPNT = ICPNT+1I! MVAL = NCBUF(ICPNT)+NBHI+IC  IC = MVAL/256 NCBUF(ICPNT) = MVAL-IC*2568600 CONTINUE GO TO 100ACSC ERROR CONDITIONSC #C ILLEGAL HEXADECIMAL CHARACTER 9000 MESSN = 1B GO TO 9900C EXTERNAL TABLE FILLED59050 MESSN = 10 GO TO 9900C INVALID CHECKSUM9100 MESSN = 20 GO TO 9900C RECORD OUT OF SEQUENCE9150 MESSN = 11 GO TO 9900C HEADER RECORD ERROR29200 MESSN = 3- GO TO 9900C SYMBOL TABLE FULL9250 MESSN = 12 GO TO 9900C RECORD TOO LARGE9300 MESSN = 4= GO TO 9900C MODULE GREATER THAN 64KS9350 MESSN = 15 GO TO 9900C INVALID RECORD TYPEE9400 MESSN = 5  GO TO 9900C INVALID SYMBOL9500 MESSN = 6  GO TO 9900*C INVALID SYMBOL ID OR RELOCATION TYPE9600 MESSN = 7O GO TO 9900C ADDRESS OUT OF RANGE9700 MESSN = 8  GO TO 9900!C EXTERNAL INDEX OUT OF RANGE 9800 MESSN = 999900 CALL ERROR IERRI = 1  IF(IEOM) 100,100,9990 9990 RETURN END3 SUBROUTINE LABELC C09C THE ROUTINE FORMS A SYMBOL AND CHECKS IF THE SYMBOLO,C IS IN THE SYMBOL TABLE AND IS A PUBLICC C 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 C COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTC,C *ENTRY PARAMETERSI%C ICOL - STARTING COLUMN OF SCANTC INDET - SYMBOL FLAGAC 0 = FIND PUBLICN#C 1 = FIND END OF TABLEOCJC *EXIT PARAMETERS%C ICOL - ENDING COLUMN OF SYMBOLIC INDEX - INDEX OF SYMBOLN C ICKSM - CHECKSUM OF SYMBOLC IERR - RETURN STATUSN$C 1 = VALID SYMBOL FOUND%C 2 = SYMBOL NOT IN TABLEEC 3 = SYMBOL ERRORC 4 = NOT USED#C 5 = SYMBOL TABLE FULL CTC, NOTRY = 0RC FETCH LABELL CALL SYMBL IF(IERR-4) 100,920,100 C CHECK IF LABEL IS IN TABLE100 INDEX = 1 #C CHECK FOR EMPTY SLOT IN TABLE #130 IF(ITAB(1,INDEX)) 140,910,140G140 DO 150 J=1,IWORD+ IF(ITAB(J,INDEX)-NAME(J)) 200,150,200C150 CONTINUE IF(INDET) 200,800,200C TRY NEXT SLOT IN TABLE200 NOTRY = NOTRY+1  INDEX = INDEX+1( IF(NOTRY-(LTAB-MODCT)) 130,940,940#C VALID SYMBOL - GET PARAMETERSY800 ITABI = ITABS(INDEX) IF(ITABI-256) 900,200,200L!C SYMBOL FOUND, GET ITS VALUE)900 IERR = 1 GO TO 990LC SYMBOL NOT IN TABLE 910 IERR = 2 GO TO 990 C SYMBOL ERROR920 IERR = 3 GO TO 990OC SYMBOL TABLE FULLI940 IERR = 5 990 RETURN END  SUBROUTINE SYMBLC0C0<C THIS SUBROUTINE IS USED TO FORM A SYMBOL AND ITS INDEXC INTO THE SYMBOL TABLE CNCY6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2DC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTC,C *ENTRY PARAMETERSI%C ICOL - STARTING COLUMN OF SCANTCI(C ICKSM - CURRENT CHECKSUM OF RECORDC LCNT - SYMBOL SCAN FLAG'C 0 = SCAN TO END OF SYMBOL )C >0 = USE ONLY LCNT CHRACTERSNC *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCANN%C NAME - CONTAINS ENCODED SYMBOLB-C ICHAR - TERMINATOR CHARACTER (LCNT = 0)DC ICKSM - UPDATED CHECKSUMC IERR - RETURN STATUSM9C 1 = SYMBOL ENDS WITH BLANK,TAB OR SEMICOLONO*C 2 = SYMBOL ENDS WITH A COMMA4C 3 = SYMBOL ENDS WITH OTHER THAN 1 OR 2C 4 = SYMBOL ERRORCTC  INDEX = 0 LABCT = 0  DO 10 J=1,IWORD NAME(J) = 0S10 CONTINUE IC1 = 1E IC2 = 1C CHECK FOR VALID CHARACTERA100 ICHAR = IN(ICOL) DO 110 J=1,36 $ IF(ICHAR-IALPH(J)) 110,300,110110 CONTINUE J = 58! IF(ICHAR-IQUES) 120,300,120U 120 J = 59 IF(ICHAR-ICAT) 130,300,130,C END OF SCAN IF FOUND INVALID CHARACTER130 IF(LABCT) 140,930,140 140 IF(IC2-ICCNT) 150,150,200R150 DO 160 J=IC2,ICCNT NAME(IC1) = NAME(IC1)*256160 CONTINUEC CHECK FOR BLANK OR COMMA200 IF(LCNT) 210,210,400!210 IF(ICHAR-IBLNK) 220,900,220!220 IF(ICHAR-ICOMM) 920,910,92004C CHECK IF MORE CHARACTER THAN WILL FIT IN TABLE 300 IF(LABCT-MLAB) 310,360,360310 IF(LABCT) 320,320,330 320 IF(J-10) 930,930,330330 INDEX = INDEX+JF IF(IC2-ICCNT) 350,350,340N340 IC1 = IC1+1I IC2 = 1R350 IC2 = IC2+14(C FORM SYMBOL FOR PLACEMENT IN TABLE! NAME(IC1) = NAME(IC1)*256+J 360 LABCT = LABCT+15 ICHAR = IBLNK  IF(ICOL-MCOL) 370,140,140 370 ICOL = ICOL+10 IF(LCNT) 380,100,380 380 IF(LABCT-LCNT) 100,900,900C CHECK FOR ANY ASTERISKS 400 ICHAR = IN(ICOL) IF(ICHAR-IAST) 930,410,930410 LABCT = LABCT+1T ICOL = ICOL+1 IF(LABCT-LCNT) 400,900,900+C SYMBOL ENDS WITH A BLANK OR SEMICOLON900 IERR = 1 GO TO 990RC SYMBOL ENDS WITH A COMMA910 IERR = 2 GO TO 990 >C SYMBOL ENDS WITH OTHER THAN A BLANK, COMMA, OR SEMICOLON920 IERR = 3 GO TO 990LC SYMBOL ERROR930 IERR = 4990 ICKSM = ICKSM+INDEX0 RETURN END0 SUBROUTINE SCANOCNCS=C THIS ROUTINE FORM A VALUE FROM THE INPUT CODMMAND LINE.9;C THE VALUE MAY BE DECIMAL OR HEXADECIMAL. HEXADECIMALBC CONSTANTS END WITH A H.BCEC # DIMENSION NUMS(16),INBUF(160)R6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2HC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT5 EQUIVALENCE (INBUF(1),IN(1)),(NUMS(1),IALPH(1))O DATA ICHRH /1HH/C0C *ENTRY PARAMETERSM%C ICOL - STARTING COLUMN OF SCANC,C MVAL - VALUE TO ADD TO BUFFER POINTERCNC *EXIT PARAMETERS#C ICOL - ENDING COLUMN OF SCANOC IVAL - VALUE OF CONSTANTNC IERR - RETURN STATUS C 0 = NO ERROR6C 1 = ILLEGAL CHARACTER OR VALUE TOO LARGECRC, IERR = 1 IVAL = 0.S IFACT = 10 RFACT = 10.IH K = ICOL-1+MVAL 00 100 K = K+1A$ IF(INBUF(K)-IBLNK) 105,120,105$105 IF(INBUF(K)-ICOMM) 110,120,110#110 IF(K-(MCOL+MVAL)) 100,100,120 )C GET LAST CHARACTER AND CHECK IF HEX 120 LL = K K = K-1F$ IF(INBUF(K)-ICHRH) 200,130,200130 IFACT = 16 RFACT = 16. K = K-1OC FORM VALUE200 J = ICOL+MVALC IF(J-K) 210,210,900210 DO 290 I=J,K DO 220 L=1,IFACT& IF(INBUF(I)-NUMS(L)) 220,250,220220 CONTINUE GO TO 900 250 IVAL1 = L-1  IVAL = IVAL*RFACT+IVAL1 290 CONTINUEC CHECK VALUE0! IF(IVAL-65536.) 300,900,900300 IERR = 0CA900 ICOL = LL-MVAL RETURN ENDC SUBROUTINE NAMESCC 1C THIS ROUTINE DECODES A SYMBOL IN THE SYMBOL3/C TABLE INTO A FORMAT SUITABLE FOR PRINTINGOC C 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) DIMENSION LLAB(4,10)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2FC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)DD COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT! EQUIVALENCE (LLAB(1),IN(1))E! EQUIVALENCE (NAME1,NAME(1))FC,C *ENTRY PARRAMETERSC MODE - SYMBOL FILL FLAGC 0 = BLANK FILLC 1 = ASTERISK FILLM#C INDET - INDEX TO STORE RESULTIC ID - SYMBOL TYPEMC -1 = ANY SYMBOLC 0 = PUBLIC SYMBOLOC 1 = LOCAL SYMBOLCIC *EXIT PARAMETERSC LLAB - SYMBOL CHARACTERST C NCKSM - CHECKSUM OF SYMBOLC IADDR - VALUE OF SYMBOLLC IERR - RETURN STATUS C 0 = SYMBOL FOUNDC 1 = END OF TABLECC IERR = 1Y IF (ID) 200,100,100(100 IF(INDEX-(LTAB-MODCT)) 110,110,900#110 IF(ITAB(1,INDEX)) 120,130,120K120 K = ITABS(INDEX)/256 IF(K-ID) 130,200,130130 INDEX = INDEX+1  GO TO 100YC DECODE SYMBOL 200 KCNT = 0 DO 280 K=1,IWORD NAME1 = ITAB(K,INDEX)A IDD = MDIV DO 280 L=1,ICCNT KCNT = KCNT+1 NN = NAME1/IDD IF(NN) 210,210,240210 IF(MODE) 230,220,230220 ICHAR = IBLNK  GO TO 270 230 ICHAR = IAST GO TO 270240 NAME1 = NAME1-NN*IDD IDD = IDD/256( IF(NN-58) 260,250,250 250 NN = NN-20260 ICHAR = IALPH(NN) 270 LLAB(INDET,KCNT) = ICHAR IF (KCNT-MLAB) 280,300,300 280 CONTINUE300 IVAL = ITABV(INDEX)M CALL AHEX0 IERR = 0 900 RETURN ENDT SUBROUTINE COMINCDC:C THIS ROUTINE CHECKS TO SEE IF A COMMAND IS LEGAL AND9C RETURNS AN INDEX THAT SPECIFIES THE COMMAND NUMBER. CCC  INTEGER COMLS(7,15)6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2MC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTG DATA COMLS(1, 1),COMLS(2, 1),COMLS(3, 1),COMLS(4, 1),COMLS(5, 1),I= 1 COMLS(6, 1),COMLS(7, 1) /1HN,1HA,1HM,1HE,1H ,1H ,1H /EG DATA COMLS(1, 2),COMLS(2, 2),COMLS(3, 2),COMLS(4, 2),COMLS(5, 2),,= 1 COMLS(6, 2),COMLS(7, 2) /1HS,1HT,1HA,1HR,1HT,1H ,1H /OG DATA COMLS(1, 3),COMLS(2, 3),COMLS(3, 3),COMLS(4, 3),COMLS(5, 3),7= 1 COMLS(6, 3),COMLS(7, 3) /1HC,1HO,1HD,1HE,1H ,1H ,1H /RG DATA COMLS(1, 4),COMLS(2, 4),COMLS(3, 4),COMLS(4, 4),COMLS(5, 4),L= 1 COMLS(6, 4),COMLS(7, 4) /1HD,1HA,1HT,1HA,1H ,1H ,1H /MG DATA COMLS(1, 5),COMLS(2, 5),COMLS(3, 5),COMLS(4, 5),COMLS(5, 5),1= 1 COMLS(6, 5),COMLS(7, 5) /1HS,1HT,1HA,1HC,1HK,1H ,1H /MG DATA COMLS(1, 6),COMLS(2, 6),COMLS(3, 6),COMLS(4, 6),COMLS(5, 6),1= 1 COMLS(6, 6),COMLS(7, 6) /1HM,1HE,1HM,1HO,1HR,1HY,1H /MG DATA COMLS(1, 7),COMLS(2, 7),COMLS(3, 7),COMLS(4, 7),COMLS(5, 7),1= 1 COMLS(6, 7),COMLS(7, 7) /1HS,1HT,1HK,1HL,1HN,1H ,1H /MG DATA COMLS(1, 8),COMLS(2, 8),COMLS(3, 8),COMLS(4, 8),COMLS(5, 8),1= 1 COMLS(6, 8),COMLS(7, 8) /1HO,1HR,1HD,1HE,1HR,1H ,1H /MG DATA COMLS(1, 9),COMLS(2, 9),COMLS(3, 9),COMLS(4, 9),COMLS(5, 9),1= 1 COMLS(6, 9),COMLS(7, 9) /1HL,1HI,1HS,1HT,1H ,1H ,1H /MG DATA COMLS(1,10),COMLS(2,10),COMLS(3,10),COMLS(4,10),COMLS(5,10),1= 1 COMLS(6,10),COMLS(7,10) /1HN,1HL,1HI,1HS,1HT,1H ,1H /MG DATA COMLS(1,11),COMLS(2,11),COMLS(3,11),COMLS(4,11),COMLS(5,11),1= 1 COMLS(6,11),COMLS(7,11) /1HP,1HU,1HB,1HL,1HI,1HC,1H /MG DATA COMLS(1,12),COMLS(2,12),COMLS(3,12),COMLS(4,12),COMLS(5,12),1= 1 COMLS(6,12),COMLS(7,12) /1HL,1HO,1HA,1HD,1H ,1H ,1H /MG DATA COMLS(1,13),COMLS(2,13),COMLS(3,13),COMLS(4,13),COMLS(5,13),1= 1 COMLS(6,13),COMLS(7,13) /1HE,1HN,1HD,1H ,1H ,1H ,1H /MG DATA COMLS(1,14),COMLS(2,14),COMLS(3,14),COMLS(4,14),COMLS(5,14),1= 1 COMLS(6,14),COMLS(7,14) /1H*,1H ,1H ,1H ,1H ,1H ,1H /MG DATA COMLS(1,15),COMLS(2,15),COMLS(3,15),COMLS(4,15),COMLS(5,15),1= 1 COMLS(6,15),COMLS(7,15) /1HE,1HX,1HI,1HT,1H ,1H ,1H /MC3C *ENTRY PARAMETERS1'C IN - BUFFER THAT CONTAINS LINELCOC *EXIT PARAMETERSC INDEX - COMMAND NUMBERC ICOL - START OF ARGUMENTSC IERR - RETURN STATUS,C 0 = NO ERROR!C 1 = ILLEGAL COMMAND1'C 2 = NO COMMAND PARAMETERSMC5C) IERR = 0C CHECK FOR LEGAL COMMAND  DO 300 I=1,15  DO 250 J=1,7& IF(COMLS(J,I)-IN(J)) 300,210,300!210 IF(IN(J)-IBLNK) 250,400,250L250 CONTINUE GO TO 4001300 CONTINUEC COMMAND NOT IN TABLE IERR = 1 GO TO 990C SCAN TO ARGUMENT FIELD400 INDEX = IN ICOL = J+1$410 IF(IN(ICOL)-IBLNK) 990,450,990450 ICOL = ICOL+1  IF(ICOL-MCOL) 410,410,500 500 IERR = 2 990 RETURN END  SUBROUTINE OUTCC?C THIS SUBROUTINE OUTPUTS THE OBJECT MODULE PRODUCED BY THEI:C EACH CARD CONTAINS A RECORD LENGTH OF UP TO 30 BYTESC3C6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)$ DIMENSION IOBIN(72),LLAB(4,10)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2TC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT% EQUIVALENCE (IOBIN(1),IPBUF(1))H3 EQUIVALENCE (NUMS1,IALPH(1)),(NUMS2,IALPH(2)))! EQUIVALENCE (LLAB(1),IN(1))NCRC *ENTRY PARAMETERS,$C NCBUF - OBJECT BYTES TO OUTPUT$C LLEN - NUMBER OF OBJECT BYTES-C LODSA - CONTENT RECORD STARTING ADDRESS, C LODLC - LOAD POINT ADDRESSC LOBJ - OBJECT LIST FLAG,C 0 = DONT PRODUCE OBJECT MODULE&C 1 = OUTPUT OBJECT MODULEC IEND - END FLAGCTC *EXIT PARAMETERSC LODLC - UPDATE LOAD POINTQ'C OBJECT RECORD OUTPUT IF NECESSARYICEC  IF(LOBJ) 900,900,40P 40 N = 1 'C CHECK FOR GAP IN LOCATION COUNTERE50 IF(LODSA-LODLC) 60,90,6060 IF(LODLC) 70,80,8070 LODLC = LODSA  GO TO 220 80 LODLC = LODSAO GO TO 200SC CHECK FOR END OF ASSEMBLYE90 IF(IEND) 100,100,200=C SET BYTES OF OBJECT CODE INTO HEXADECIMAL OUTPUT RECORD #C CHECK FOR MAXIMUM RECORD SIZEE100 IF(IRLEN-30) 110,200,200110 MVAL = NCBUF(N)  NCKSM = NCKSM+MVAL IRLEN = IRLEN+1I CALL VHEX IOBIN(ICNT) = NH10 ICNT = ICNT+1  IOBIN(ICNT) = NH2T ICNT = ICNT+1F LODLC = LODLC+1. N = N+1  IF(N-LLEN) 100,100,900-C SET RECORD LENGTH AND OUTPUT NEW RECORD 200 IF(IRLEN) 300,300,210N210 MVAL = IRLEN CALL VHEX0 NCKSM = NCKSM+IRLENJ IOBIN(2) = NH1 IOBIN(3) = NH2C SET CHECKSUM J = NCKSM/256  MVAL = 256-(NCKSM-J*256) CALL VHEX IOBIN(ICNT) = NH1 ICNT = ICNT+1I IOBIN(ICNT) = NH2  IPLEN = ICNT CALL INOUT(5) GO TO 300 &C CHECK FOR OUTPUT OF SYMBOL TABLE220 IF(LSYM) 225,300,225 225 ID = 1 INDEX = 1 MODE = 0230 INDET = 1T235 CALL NAMES INDEX = INDEX+1N IF(IERR) 245,240,245240 INDET = INDET+1  IF(INDET-4) 235,235,245=245 INDET = INDET-1N IF(INDET) 300,300,250 C OUTPUT NEXT LINE250 DO 255 I=1,72) IPBUF(I) = IBLNK255 CONTINUE LL = 0 DO 270 I=1,INDET DO 260 K=1,MLABP LL = LL+1  IPBUF(LL) = LLAB(I,K)0260 CONTINUE LL = LL+3B IPBUF(LL) = IALPH(1) DO 265 K=1,4 LL = LL+1  IPBUF(LL) = IADDR(I,K)265 CONTINUE LL = LL+1N IPBUF(LL) = IALPH(18)) LL = LL+2 270 CONTINUE IPLEN = 64 CALL INOUT(5)  IF(IERR) 230,230,300 C INITIALIZE FOR NEXT RECORD300 NCKSM = 0  IRLEN = 0  ICNT = 10L DO 350 J=1,72  IOBIN(J) = IBLNK350 CONTINUE1C INITIALIZE COLON INDICATING START OF RECORDL IOBIN(1) = ICOLNC CHECK FOR END CARD IF(IEND) 410,410,400C SET ADDRESS INTO RECORDL400 LODLC = MDADD 410 MVAL = LODLC/256.N NCKSM = NCKSM+MVAL CALL VHEXP IOBIN(4) = NH1 IOBIN(5) = NH2 IVAL = MVAL  MVAL = LODLC-IVAL*256. NCKSM = NCKSM+MVAL CALL VHEXE IOBIN(6) = NH1 IOBIN(7) = NH2 IOBIN(8) = NUMS1 IOBIN(9) = NUMS1 IF(IEND) 100,100,700,C PUT OUT RECORD TO INDICATE END OF FILE700 IOBIN(2) = NUMS1 IOBIN(3) = NUMS1 IOBIN(9) = NUMS2 NCKSM = NCKSM+1  J = NCKSM/256 MVAL = 256-(NCKSM-J*256) CALL VHEX  IOBIN(10) = NH1 IOBIN(11 )= NH2  IPLEN = 11 CALL INOUT(5) 900 RETURN ENDV SUBROUTINE HEXINC CS6C THIS SUBROUTINE WILL READ THE NEXT 2 HEXADECIMAL>C CHARACTERS FROM THE INPUT RECORD AND CONVERT TO DECIMAL.C1C 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 C COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTC,C *ENTRY PARAMETERSI'C ICOL - STARTING CHARACTER COLUMNFC IN - RECORD BUFFERI)C ICKSM - CURRENT CHECKSUM FOR RECORDSCCC *EXIT PARAMETERS+C ICOL - POINTS AFTER SECOND CHARACTEROC MVAL - VALUE4C ICKSM - UPDATED CHECKSUMC IERR - RETURN STATUS,"C 0 = VALID CHARACTERS+C 1 = NON HEXADECIMAL CHARACTERDC C  MVAL = 0 IERR = 1 DO 200 K=1,2 ICHAR = IN(ICOL) DO 100 I=1,16L$ IF(ICHAR-IALPH(I)) 100,110,100100 CONTINUE GO TO 900I110 MVAL = MVAL*16+I-1 ICOL = ICOL+1E200 CONTINUE ICKSM = ICKSM+MVAL IERR = 0 900 RETURN ENDC SUBROUTINE VHEXNCHCC:C THIS ROUTINE CONVERTS A VALUE BETWEEN 0 - 255 TO TWO<C HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE AREC CONVERTED TO ZEROSCACI6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) DIMENSION NUMS(16)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2VC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)AD COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT# EQUIVALENCE(NUMS(1),IALPH(1)),C,C *ENTRY PARAMETERSIC MVAL - VALUE TO CONVERTCAC *EXIT PARAMETERS/C MVAL - SET TO ZERO IF VALUE OUT OF RANGEC"C NH1 - HIGH ORDER CHARACTER!C NH2 - LOW ORDER CHARACTERLCC  IF(MVAL-256) 10,30,30D10 IF(MVAL) 30,100,100830 MVAL = 0100 NH1 = 1+MVAL/16B NH2 = MVAL-(NH1-1)*16+1 NH1 = NUMS(NH1), NH2 = NUMS(NH2) RETURN ENDC SUBROUTINE AHEXQCICH>C THIS SUBROUTINE CONVERTS A VALUE BETWEEN 0 -65535 INTO 4EC HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE ARE RETURNED C AS ASTERISKSC CE REAL IHVAL,IVAL2,J1A6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) DIMENSION NUMS(16)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 C COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10)AD COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNT$ EQUIVALENCE (NUMS(1),IALPH(1))C,C *ENTRY PARAMETERSIC IVAL - VALUE TO CONVERT2C INDET - INDEX OF ARRAY TO STORAGE CHARACTERS,C IADDR(INDET, ) - CONTAINS 4 CHARACTERSCIC *EXIT PARAMETERS)C CHARACTERS SET TO * IF OUT OF RANGEHCBC, J1 = 4096. IF(IVAL) 20,5,55 IF(IVAL-65536.) 10,20,2010 IHVAL = IVAL DO 15 J=1,4  M1 = IHVAL/J1R IVAL2 = M1 IHVAL = IHVAL-IVAL2*J1 J1 = J1/16.K M1 = M1+1 IADDR(INDET,J) = NUMS(M1)N15 CONTINUE RETURN20 DO 25 J=1,4  IADDR(INDET,J) = IAST25 CONTINUE RETURN ENDH SUBROUTINE EQUATC,C-AC THIS ROUTINE EQUATES A LOGICAL DEVICE NUMBER TO A FILE NAMES<C SO THAT AN OBJECT MODULE MAY BE READ FROM A DISK FILE.=C THIS ROUTINE MAY HAVE TO BE CHANGED FOR SOME COMPUTERS.V)C SEE THE OPERATION NOTES FOR DETAILSRC 6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2VC COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTC,C *ENTRY PARAMETERSI,C INC - BUFFER THAT CONTAINS FILE NAME$C JCOL - STARTING POINT OF NAMECC *EXIT PARAMETERS5C NAMEF - CONTAINS ARRAY NAME IN PACKED HOLLERITHM(C JCOL - ENDING COLUMN OF FILE NAME-C IPBUF - CONTAINS FILE NAME IN A1 FORMATDC IERR - RETURN STATUS)"C 0 = VALID FILE FOUND C 1 = FILE NOT FOUNDC ;C---> SIMPLIFIED EQUAT AS RECOMMENDED IN INSTALLATION NOTES,C ENHANCED BY ADDING EXTENSIONCI LOGICAL*1 JNAME(22) DO 11 K=1,2211 JNAME(K)="40 C C  IERR=1R K=1=100 IF((INC(JCOL).EQ.IBLNK).OR.(INC(JCOL).EQ.ICOMM)) GOTO 200 IF(INC(JCOL).EQ.ICTAB) GOTO 200 IF(K.GT.18) GOTO 900N JNAME(K)=INC(JCOL)  IPBUF(K)=INC(JCOL)L K=K+1 JCOL=JCOL+1 GOTO 100OCI200 JNAME(K)=IBLNK IN(K)=IBLNK IIQ=LENSTR(JNAME,18) JNAME(IIQ+1)= "56 ! "."E JNAME(IIQ+2)= "117 ! "O" JNAME(IIQ+3)= "102 ! "B" JNAME(IIQ+4)= "123 ! "S" IIQ=IIQ+4 CALL CLOSE(IFIL)C CALL ASSIGN(IFIL,JNAME,IIQ) IRDR=IFIL IERR=0DC1 900 RETURNCA END SUBROUTINE ERRORC15C THIS ROUTINE OUTPUTS ALL LOADER ERROR MESSAGES.G3C IF THIS IS THE FIRST ERROR FOR A GIVEN MODULE1+C THEN THE MODULE NAME IS ALSO PRINTED.=C(CL6 REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA6 REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4)B COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEND COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLABD COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF,LSTAB,LSYMF COMMON LPUR,LOBJ,ITAB(3,500),ITABS(500),ITABV,LTAB,NAME(3),INDETE COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 C COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10),D COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL@ COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW@ COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80)A COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADDD. COMMON NCCNT,LLEN,NRCNT,IEXTN,IUNDF,IBUG> COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IALPH(39) COMMON ICNTC,C *ENTRY PARMATERSC MESSN - MESSAGE NUMBER2C MESSF - MESSAGE FLAG, 0= NO PREVIOUS MESSAGEC0C *EXIT PARAMETERSC MESSF - SET TO 1CICE IGO = MESSN  IF(MESSN-1000) 30,30,20L20 IGO = MESSN-1000 GO TO 8030 IF(MESSF) 80,40,80C OUTPUT MODULE NAME40 MVAL = MNAME(10)) WRITE(IPRT,41) (MNAME(I),I=1,MVAL)E$41 FORMAT(//,9H **MODULE,3X,10A1) MESSF = 1 580 GO TO(100,200,300,400,500,600,700,800,900,1000,H9 1 1100,1200,1300,1400,1500,1600,1700,1800,1900),IGO CE#C ILLEGAL HEXADECIMAL CHARACTERL100 WRITE(IPRT,110)A%110 FORMAT(4X,17HINVALID HEX DIGIT)E GO TO 9000C INVALID CHECKSUM200 WRITE(IPRT,210)3$210 FORMAT(4X,16HINVALID CHECKSUM) GO TO 9000C HEADER RECORD ERRORU300 WRITE(IPRT,310) '310 FORMAT(4X,19HHEADER RECORD ERROR)M GO TO 9000C RECORD TOO LARGE400 WRITE(IPRT,410)E$410 FORMAT(4X,16HRECORD TOO LARGE) GO TO 9000C INVALID RECORD TYPE,500 WRITE(IPRT,510)0'510 FORMAT(4X,19HINVALID RECORD TYPE)E GO TO 9000C INVALID SYMBOL600 WRITE(IPRT,610)V"610 FORMAT(4X,14HINVALID SYMBOL) GO TO 9000C INVALID ID OR TYPE700 WRITE(IPRT,710)I&710 FORMAT(4X,18HINVALID ID OR TYPE) GO TO 9000C ADDRESS OUT OF RANGE800 WRITE(IPRT,810)A(810 FORMAT(4X,20HADDRESS OUT OF RANGE) GO TO 9000!C EXTERNAL INDEX OUT OF RANGEM900 WRITE(IPRT,910)G/910 FORMAT(4X,27HEXTERNAL INDEX OUT OF RANGE) GO TO 9000C EXTERNAL TABLE FULLV1000 WRITE(IPRT,1010)'1010 FORMAT(4X,19HEXTERNAL TABLE FULL)  GO TO 9000C RECORD OUT OF SEQUENCE1100 WRITE(IPRT,1110)*1110 FORMAT(4X,22HRECORD OUT OF SEQUENCE) GO TO 9000C SYMBOL TABLE FULL)1200 WRITE(IPRT,1210)%1210 FORMAT(4X,17HSYMBOL TABLE FULL)T GO TO 9100C UNDEFINED EXTERNAL1300 IF(IUNDF) 1350,1310,13501310 WRITE(IPRT,1320)'1320 FORMAT(4X,19HUNDEFINED EXTERNALS)41350 INDET = 1E CALL AHEX) WRITE(IPRT,1360) (IADDR(1,I),I=1,4)V1360 FORMAT(4X,4A1) GO TO 9100C DUPLICATE PUBLIC NAME 1400 K = ICOLE+LCNT-1( WRITE(IPRT,1410) (IN(I),I=ICOLE,K)11410 FORMAT(4X,24HDUPLICATE PUBLIC NAME = ,10A1)  GO TO 9100C MODULE GREATER THAN 64K)1500 WRITE(IPRT,1510)+1510 FORMAT(4X,23HMODULE GREATER THAN 64K)0 GO TO 9000C INVALID OPERAND OR VALUE1600 WRITE(IPRT,1610)#1610 FORMAT(4X,15HINVALID OPERAND)D GO TO 9100C INVALID COMMANDL1700 WRITE(IPRT,1710)#1710 FORMAT(4X,15HINVALID COMMAND)M GO TO 9100C COMMAND NOT ALLOWED 1800 WRITE(IPRT,1810)'1810 FORMAT(4X,19HCOMMAND NOT ALLOWED)I GO TO 9100C FILE NOT FOUND'1900 WRITE(IPRT,1910) (IPBUF(I),I=1,8)0*1910 FORMAT(4X,17HFILE NOT FOUND - ,15A1) GO TO 9100COCT#9000 IF(MESSN-1000) 9010,9010,9100 *9010 WRITE(IPRT,9021) MREC,(IN(J),J=1,72)'9021 FORMAT(4X,6HRECORD,I5,3H - ,72A1), 9100 RETURN END GO TO 9100C INVALID COMMANDL1700 WRITE(IPRT,1710)#1710 FORMAT(4X,15HINVALID COMMAND)M GO TO 9100C COMMAND NOT ALLOWED 1800 WRITE(IPRT,1810)'1810 FORMAT(4X,19HCOMMAND NOT ALLOWED)I GO TO 9100C FILE NOT FOUND'1900 WRITE(IPRT,1910) (IPBUF(I),I=1,8)0*1910 FORMAT(4X,17HFILE NOT FOUND - ,15A1) GO TO 9100COFOR LNK,LI:LNK=LNKMAC LENSTR,LI:LENSTR=LENSTRMAC SPOOL,LI:SPOOL=SPOOLMAC DELETE,LI:DELETE=DELETE(SY:LNK/CP,MP:LNK=LNK,LENSTR,SPOOL,DELETE/ MAXBUF=512UNITS=18 ACTFIL=10ASG=SY0:4:6:7:8:18//% .TITLE LENSTR (ARRAY,MAXLEN);+; LENSTR.MAC - 3/21/78%; SOUTH COBB - PROJECT NUMBER 7701008*; RSX-11M BL22 V3.1/PROJECT COMMON ROUTINE0; M.SORRELL - 3/21/78 REV. 9/14/78 RD VICKERS,; FUNCTION: ACCEPTS AN ARRAY AND COUNTS THEC; NUMBER OF CHARACTERS IN THE INPUT STRING. RESULT IS @; REACHED BY COUNTING RIGHT TO LEFT UNTIL A CHARACTER@; OTHER THAN "0 (NULL) OR "40 (SPACE) IS ENCOUNTERED.8; RESULT RETURNED (NUM) IS NEVER LESS THAN 1.@; CALLING STRUCTURE: LENSTR.MAC IS A FORTRAN CALLABLE FUNCTION.3; IT MAKES NO SUBROUTINE CALLS.-@; CALLING PROCEDURE/PARAMETER LIST: FORTRAN CALL IN THE FORM: '; NUM = LENSTR(ARRAY,MAXLEN)SC; ARRAY IS A LOGICAL STRING OF LENGTH MAXLEN (INTEGER). P&; RESULT IS RETURNED IN R0.;-'LENSTR:: CLR R0 A5 MOV 2(R5),R2 ;ARRAY ADDRESSI6 MOV 4(R5),R3 ;MAXLEN ADDRESS? ADD (R3),R2 ;MAXLEN+ADDRESS OF ARRAYA8 MOV 2(R5),R3 ;STARTING ADDRESS6LOOP: DEC R2 ;WORK BACKWARDS4 CMP R3,R2 ;END OF DATA?7 BEQ HERE ;BRANCH IF EQUALG: CMPB (R2),#0 ;IS CHARACTER NULL?: BNE THERE ;BRANCH IF NOT NULL< BR LOOP ;CHECK NEXT CHARACTER=THERE: CMPB (R2),#40 ;IS CHARACTER A SPACE? ; BNE HERE ;BRANCH IF NOT SPACE5A BR LOOP ;BRANCH FOR NEXT CHARACTER HHERE: INC R2 ;INCREMENT START ADDR+MAXLEN BY 1H SUB R3,R2 ;SUBTR START ADDR TO FIND RESULT 7 MOV R2,R0 ;MOVE FOR RETURN . RTS PC ;RETURN .END LOOP ;CHECK NEXT CHARACTER=THERE: CMPB (R2),#40 ;IS CHARACTER A S& .TITLE SPOOL - FORTRAN PRINT SPOOLING;S .IDENT /V02/ ;U; FORTRAN CALL:U;#; CALL SPOOL(LUN,IERR,IFCSER,IDSW); CALL SPOOL(LUN,IERR,,IDSW)O; CALL SPOOL(LUN,IERR,IFCSER); CALL SPOOL(LUN,IERR);;A#; WHERE LUN = LOGICAL UNIT NUMBER ;T ; RETURN:;$#; IERR = SPOOLING ERROR SEMAPHORE$; IFCSER = FCS ERROR CODE FROM FDB ; IDSW = DIRECTIVE STATUS WORD; ;I;E; NOTE:?;B#; FILE MUST BE OPEN AT TIME OF THE ; '; CALL TO SPOOL. SPOOL WILL CLOSE THEE#; FILE AND MAKE THE LUN RE-USABLE.T; ;N); INVALID LUN'S WILL RESULT IN A FORTRANA&; ERROR TRAPPED BY THE FCHNL ROUTINE.;,; REGISTER USAGE:O;U; R0 = RSX FDB ; R1 = LOOP COUNTER ; R2 = LUNL; R3 = OTS WORK AREA; R4 = FORTRAN FDBA;N;N& .GLOBL $FCHNL,$OTSV,$DSW,F.ERR,.PRINT;L .ENABL LSBA;RSPOOL:: MOV @2(R5),R2 ;GET LUNR' MOV @#$OTSV,R3 ;GET WORK AREA ADDRESS CALL $FCHNL ;FIND FDB ADDRESS( MOV R0,R4 ;SAV ADDRESS OF FORTRAN FDB ADD #14,R0 ;GET TO RSX FDBE$ CLR @4(R5) ;CLEAR ERROR SEMAPHORE" CALL .PRINT ;QUEUE FOR SPOOLING BCS ERR ;ERROR?0 MOV #66,R1 ;NO, MAKE FORTRAN FDB REUSEABLE+1$: CLR (R4)+ ;(ALSO SETS F.ERR TO ZEROP DEC R1 BNE 1$! BR 2$ ;BR ARROUND ERROR CODET!ERR: INC @4(R5) ;SET ERROR FLAGT&2$: MOVB (R5),R1 ;GET ARGUMENT COUNT% SUB #2,R1 ;MORE THAN TWO ARGUMENTSM BEQ RET ;NO RETURNK TST @6(R5) ;IFCSER PRESENT? BLE 3$ ;NOS2 MOV F.ERR(R0),@6(R5) ;YES RETURN FCS ERROR CODE(3$: DEC R1 ;MORE THAN THREE AGRUMENTS? BEQ RET ;NO RETURNL3 MOV @#$DSW,@10(R5) ;YES RETURN DIRECTIVE STATUS ;VRET: RTS PC ;RETURN TO CALLERR;E .DSABL LSBL .END ;(ALSO SETS F.ERR TO ZEROP DEC R1 BNE 1$! BR 2$ ;BR ARROUND ERROR CODET!ERR: INC @4(R5) ;SET ERROR FLAGT&2$: MOVB (R5),R1 ;GET ARGUMENT COUNT% SUB #2,R1 ;MORE THAN TWO ARGUMENTSM BEQ RET ;NO RETURNK TST @6(R5) ;IFCSER PRESENT? BLE 3$ ;NOS2 MOV F.ERR(R0),@6(R5) ;YES RETURN FCS ERROR CODE(3$: DEC R1 ;MORE THAN THREE AGRUME% .TITLE DELETE SUBROUTINE FOR FORTRAN;; FORTRAN CALL; CALL DELETE(LUN,ERR);; WHERE LUN=LOGICAL UNIT NUMBER; RETURN ;ERR=FCS ERROR CODE FROM FDB.;; NOTE5; FILE MUST BE OPEN OR FDBSET AND ASSIGN MUST BE USED; .MCALL DELET$ .GLOBL $FCHNL,$OTSV .ENABL LSBDELETE::MOV @2(R5),R2 MOV @#$OTSV,R3 JSR PC,$FCHNL MOV R0,R1 ADD #14,R0 DELET$ R0 BCS ERR MOV #66,R0 1$: CLR(R1)+ DEC R0 BNE 1$2$: MOV R0,@4(R5) RTS PCERR: MOVB F.ERR(R0),R0 BR 2$ .DSABL LSB  .ENDSUBROUTINE FOR FORTRAN;; FORTRAN CALL; CALL DELETE(LUN,ERR);; WHERE LUN=LOGICAL UNIT NUMBER; RETURN ;ERR=FCS ERROR CODE FROM FDB.;; NOTE5; FILE MUST BE OPEN OR FDBSET AND ASSIGN MUST BE USED; .MCALL DELET$ .GLOBL $FCHNL,$OTSV .ENABL LSBDELETE::MOV @2(R5),R2 MOV @#$OTSV,R3 JSR PC,$FCHNL MOV R0,R1 ADD #14,R0 DELET$ R0 BCS ERR MOV #66,R0 1$: CLR(R1)+ DEC R0 BNE 1$2$: MOV R0,@4(R5) RTS PCERR: MOVB F.ERR(R0),R0 BR 2$ ._kQ!_YM(;!^kQ!y:kQZI9kQfTkQ/|Q2E |Q2E . V_kQ12APR7911120212APR79110952m. <!_12APR7911220212APR79112115. CYM(;12APR7911234212APR791122501. :!^kQ!12APR7911252012APR79112430. 2y:kQ12APR7911265612APR791126092a. 8ZI9kQ12APR7911283612APR79112746Oi. .@fTkQ/12APR7911301512APR79112925_. @##|Q2E 24APR7913271724APR79132610". D |Q2E 24APR7913295024APR79132854 m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶ .PSECT DRCOM .=.+70DRCSR:: .BLKW 1DROUT:: .BLKW 1DRIN:: .BLKW 1 .ENDEPROM=LOADER,INITZ,EPROG,VERIFY/COMMON=DRCOM:RW//:C EXTRACT INFORMATION FROM LINKER OBJECT MODULE AND FORMAT7C THE OUTPUT TO BE COMPATIBLE WITH PROM PROGRAMMER I/O.C" COMMON IALPH ,IN , ICOL,MVAL,IERR' INTEGER*2 IPAR(4),ISTA,ICTR,IBUF(1024) LOGICAL*1 IALPH(16) LOGICAL*1 IN(80): DATA IALPH(1),IALPH(2),IALPH(3),IALPH(4)/1H0,1H1,1H2,1H3/: DATA IALPH(5),IALPH(6),IALPH(7),IALPH(8)/1H4,1H5,1H6,1H7/= DATA IALPH(9),IALPH(10),IALPH(11),IALPH(12)/1H8,1H9,1HA,1HB/> DATA IALPH(13),IALPH(14),IALPH(15),IALPH(16)/1HC,1HD,1HE,1HF/"C ACCEPT COMMAND FROM THE OPERATORC GET FILE NAMEE DO 1 I=1 , 80 1 IN(I)="40  CALL ASSIGN(3,'TI:')I WRITE (3,1000)G,1000 FORMAT(2X,22HPROM BLASTING ROUTINE ) WRITE (3,1001)2(1001 FORMAT($,2X,16HENTER FILE NAME: )# READ(3,1002)ILEN,(IN(I), I=1,ILEN)T1002 FORMAT(Q,40A1)A WRITE(3,1003).1003 FORMAT($,2X,20HENTER STARTING ADDR. ) READ(3,1004) IPAD IPADR=IPADT IFLAG=11004 FORMAT(I4)1 WRITE(3,1005)01005 FORMAT($,2X,25HENTER NUMBER OF BYTES ) READ(3,1006)ICOUNTH1006 FORMAT(I4)C ICTR=ICOUNT;1008 FORMAT($,2X,32HENTER ROM STARTING ADDRESS )C300 WRITE(3,1008)I READ(3,1009)ISTA1009 FORMAT(I4)H IF (ISTA .GT. 1024) GOTO 300I IPROM=1C INITIALIZE IBUF TO FF IN HEX DO 180 I=1 , 1024180 IBUF(I)="377 CALL ASSIGN(4,IN,ILEN)("C READ ONE RECORD FROM OBJECT FILE15 DO 20 I=1 , 80R 20 IN(I)="40" READ(4,1500)ILEN,(IN(I),I=1,ILEN)1500 FORMAT(Q,80A1)A"C CHECK NUMBER OF BYTES PER RECORD ICOL=2N CALL HEXINT NBYTE=MVAL IF (IERR .EQ. 1) GOTO 25F IF (NBYTE .NE. 0) GOTO 30 WRITE(3,1105)(1105 FORMAT(2X,18HERROR-END OF FILE ) GOTO 999925 WRITE (3,1100)081100 FORMAT(2X,32HERROR-NON HEX. CHARACTER IN FILE ) GOTO 999930 CALL HEXINT IF(IERR .NE. 0) GOTO 25 IADRH=MVAL CALL HEXINT IF(IERR .NE. 0) GOTO 25 IADDR=IADRH*256+MVALO-C FOUND THE STARTING ADDRESS TO BE PROGRAMMEDR% IF ((IADDR+NBYTE) .LT. IPAD) GOTO 15F2C IF IN THE MIDDLE OF THIS RECORD,SKIP UNTIL THERE IF (IFLAG .EQ. 0) GOTO 100E IF (IPAD .EQ. IADDR) GOTO 100 JN=IPAD-IADDR DO 40 K=1 , JNW NBYTE=NBYTE-140 CALL HEXINT0C CONVERT OBJECT CODES AND STORE IN ARRAY BUFFER100 CALL HEXINT( IFLAG=0 DO 200 I=1 , NBYTEI CALL HEXINT IF (IERR .NE. 0) GOTO 25 IBUF(IPROM)=MVALT IPROM=IPROM+1 ICOUNT=ICOUNT-1 IF(ICOUNT .EQ. 0) GOTO 2000 200 CONTINUE GOTO 15,C GET HERE IF IBUF CONTAINS PURE BINARY CODE2000 CALL INITZ.C INITIALIZE DR-11 WRITE(3,3000)B3000 FORMAT($,2X,36HTURN ON 26VDC,TYPE IN 0 WHEN DONE ) READ(3,3001)IIR3001 FORMAT(I2)P CALL GETADR(IPAR(1),IBUF(1))Y IPAR(2)=ICTRC IPAR(3)=ISTAO WRITE(3,3004))3004 FORMAT(2X,20HPLEASE WAIT!!!.... )N$ CALL EPROG(IPAR(1),IPAR(2),IPAR(3)) WRITE(3,3003)63003 FORMAT(2X,30HDONE...TURN OFF POWER... ) WRITE(3,3010)C3010 FORMAT(2X,41HMOVE ROM TO READ SOCKET FOR VERIFICATION )E WRITE(3,3011)/3011 FORMAT($,2X,20HTYPE IN 1 WHEN DONE //)E READ(3,3001)II3% CALL VERIFY(IPAR(1),IPAR(2),IPAR(3)),9999 CALL EXIT STOP  END SUBROUTINE HEXINT! COMMON IALPH ,IN ,ICOL,MVAL,IERRA LOGICAL*1 IN(80),IALPH(16)C C ENTER WITH:O*C ICOL=STARTING COLUMN COUNT FOR THIS TEXTC IN=ARRAY OF HEX CHARACTERSC RETURN WITH:,C IERR=RETURN STATUS=0 IF VALID OTHERWISE,=1,C MVAL=ACTUAL BINARY VALUE OF HEX CHARACTERS MVAL=00 IERR=1X DO 200 K=1,2  ICHAR=IN(ICOL)E DO 100 I=1 ,16  IF(ICHAR-IALPH(I)) 100,110,100, 100 CONTINUE GOTO 1000110 MVAL=MVAL*16+I-1 ICOL=ICOL+1 200 CONTINUE IERR=0A 1000 RETURNC ENDIT STOP  END SUBROUTINE HEXINT! COMMON IALPH ,IN ,ICOL,MVAL$; PROGRAMMING ROUTINE FOR 2708 EPROM; CALLING SEQUENCE:; CALL EPROG(N1,N2,N3); WHERE:"; N1=STARTING ADDR. OF DATA BUFFER$; N2=NUMBER OF BYTE TO BE PROGRAMMED; N3=STARTNG ROM ADDR.; .GLOBL EPROG)EPROG: MOV @2(R5),R1 ;R1=ADDR. OF BUFFER MOV R1,BUFAD MOV @4(R5),R2 MOV R2,BCOUNT& MOV @6(R5),R3 ;R3=ROM STARTING ADDR.% MOV #170,R0 ;R0=PROGRAMMING PASSESLOOP: TST R3 ;ROM START AT 0?+ BEQ SKIP ;SKIP ROM ADDR. COUNTER ADVANCE'; ADVANCE ROM ADDR. TO DESIRED LOCATION) MOV R3,R4 ;R4=COUNTER VALUE TO ADVANCEM ADVN: NOP 0 BIC #CLKMSK,DROUT ;SET CLOCK LINE LO TO ADVANCE NOP NOP NOP NOP! BIS #CLKMSK,DROUT ;THEN HI AGAINR NOP NOP NOP NOP NOP NOP NOP# DEC R4 ;ADVANCE TO NEXT LOCATION= BNE ADVNF(SKIP: NOP ;R4=PROGRAMMING PASSES; START OF PROGRAMMING PASSR1START1: MOV (R1),R5 ;R5=CONTENT TO BE PROGRAMMEDG( BIC #177000,R5 ;STRIP OFF HI ORDER BITS INC R1 ;ADVANCE TO NEXT BYTEN INC R1C( BIS #CTRMSK,R5 ;MOVE CONTROL BITS OVER MOV R5,DROUT ;AND OUTPUT ITL NOP NOP NOP NOP NOP NOP NOP NOP NOP( BIC #TRGMSK,DROUT ;SET TRIGGER LINE LO NOP NOP NOP NOP/ BIS #TRGMSK,DROUT ;THEN HI AFTER 5 MICROSECS.N NOP NOP NOP NOP'; WAIT UNTIL READY TO PROGRAM NEXT BYTE  MOV #100,R4 ;LOAD DELAY TIMERS DELAY: DEC R4O BNE DELAY)WATSET: BIT #RESMSK,DRIN ;WAIT FOR CLEARP NOP BNE WATSET7; PREPARE TO PROGRAM NEXT BYTE'; RESET READY LINE FOR NEXT TIME AROUNDR; DELAY FOR 50% DUTY CYCLE MOV #30,R4 ;LOAD COUNTER TLOP: DEC R4 BNE TLOP ;WAIT UNTIL TIMED OUT: BIC #CLLMSK,DROUT ;ADVANCE TO NEXT ROM LOCATIO NOP NOP NOP NOP NOP BIS #CLLMSK,DROUT NOP NOP NOP NOP NOP DEC R2 ;DECREMENT BYTE COUNTT BNE START1 ;GOTO NEXT BYTET-; FINISH ONE PASS,TRY THE NEXT ONE UNTIL DONEC DEC R0E BEQ DONES, MOV BUFAD,R1 ;RESTORE BUFFER ADDR. POINTER$ MOV BCOUNT,R2 ;AND NUMBER OF BYTES#; RESET ROM ADDRESS COUNTER TO ZEROI BIC #CLKMSK,DROUT NOP NOP) BIS #130000,DROUT ;SET ALL CONTROL BITSE NOP NOP NOP NOP! BIC #RESMSK,DROUT ;AND CONTINUE  NOP NOP BIS #CLKMSK,DROUT NOP NOP NOP NOP JMP LOOPP; FINISH,GET OUT DONE: RTS PC ;RETURN TO CALLERBUFAD: .WORD 0 ;TEMP. STORAGEBCOUNT: .WORD 0T; MASK FOR ALL CONTROL BITSSCLIMSK=10000 ;CLEAR I SET$TRGMSK=20000 ;TRIGGER LINE SET HICLKMSK=40000 ;CLOCK LINE HIRESMSK=100000 ;RESET LINE HIT&ABSMSK=170000 ;ALL CONTROL BITS SETCTRMSK=70000 ;RESET LO ONLY%CLLMSK=50000 ;CLOCK AND CLEAR I HIB .END OP NOP NOP! BIC #RESMSK,DROUT ;AND CONTINUE  NOP NOP BIS #CLKMSK,DROUT NOP NOP NOP NOP JMP LOOPP; FINISH,GET OUT DONE: RTS PC ;RETURN TO CALLERBUFAD: .WORD 0 ;TEMP. STORAGEBCOUNT: .WORD 0T; MASK FOR ALL CONTROL BITSSCLIMSK=10000 ;CLEAR I SET$TRGMSK=20000 ;TRIGGER LINE SET HICLKMSK=40000 ;CLOCK LINE HIRESMSK=100000 ;RESET LINE HIT&ABSMSK=170000 ;ALL CONTROL BITS SETCTRMSK=70000 ;RESET LO ONLY%CLLMSK=50000 ;CLOCK AND C2; INITIALIZATION ROUTINE FOR 2708 EPROM PROGRAMMER;INITZ::# MOV #0,DROUT ;SET CONTROLLER TO 0# MOV #160000,DROUT ;SET ALL BIT HI NOP NOP NOP NOP NOP! MOV #70000,DROUT ;RESET LINE LO RTS PC ;RETURN .END 2; SUBROUTINE TO VERIFY ROM CONTENTS AFTER BLASTING ; CALLING SEQUENCE:; CALL VERIFY(N1,N2,N3); N1=ADDRESS OF BUFFER%; N2=NUMBER OF BYTES TO BE PROGRAMMED; N3=ROM STARTING ADDR.; .MCALL QIOW$CVERIFY:: MOV @2(R5),R3 ;R3=BUFFER ADDR. MOV @4(R5),R4 ;R4=BYTE COUNT% MOV @6(R5),R5 ;R5=ROM STARTING ADDR; RESET ROM ADDRESS TO ZERO& MOV #140000,DROUT ;SET RESET LINE HI NOP NOP NOP NOP NOP! MOV #40000,DROUT ;THEN LO AGAIN8; TEST FOR ROM STARTING ADDR. ADVANCE ADDR. IF NECESSARY TST R5I% BEQ READ ;SKIP IF STARTING AT ZEROA*; ADVANCE ROM ADDR TO THE DESIRED LOCATION MOV R5,R0 ;R0=DUMMY COUNTER ADVC: NOPS% BIC #40000,DROUT ;SET CLOCK LINE LOD NOP NOP NOP NOP! BIS #40000,DROUT ;THEN HI AGAINF NOP NOP NOP NOP NOP DEC R0 ;FINISH ?5 BNE ADVCO; READING DATA FROM ROM READ: MOV DRIN,R0 ;GET DATA0$ ASR R0 ;DISCARD LO ORDER TWO BITS ASR R0 BIC #177400,R0 ;CLEAR HI BYTEH( BIC #177400,(R3) ;CLEAR BUFFER HI BYTE CMP (R3),R0 ;CHECK IF EQUAL# BNE OUTMSG ;ERROR,OUTPUT MESSAGE ; ADVANCE TO NEXT ROM LOCATION*NEXT: MOV #0,DROUT ;ADVANCE ADDR. COUNTER$ INC R5 ;ADVANCE ROM ADDR. POINTER! INC R3 ;ADVANCE BUFFER POINTER INC R3P NOP" MOV #40000,DROUT ;CLOCK LINE HI  NOP NOP NOP NOP DEC R4 ;FINISH ?5 BNE READO; DONE TESTING,RETURN TO CALLER $DONE: QIOW$C IO.WVB,3,6,,,, RTS PC ;RETURN '; BAD CONTENT ON ROM,OUPUT MESSAGE AS :I-; BAD ROM ADDR. ACTUAL VALUE ROM VALUEE&OUTMSG: QIOW$C IO.WVB,3,6,,,,; OUTPUT ROM ADDR IN DECIMAL( MOV #NUMBR,R0 ;R0=ASCII BUFFER POINTER# MOV #1,R2 ;DO NOT SUPPRESS ZEROSI MOV R5,R1 ;R1=ROM ADDRP# CALL $CBDMG ;CCONVERT TO DECIMALN! QIOW$C IO.WVB,3,6,,,,R; OUTPUT ACTUAL VALUEN% MOV (R3),R1 ;GET VALUE FROM BUFFER MOV #NUM1,R0 MOV #1,R2 CALL $CBTMG ;CONVERT TO OCTAL QIOW$C IO.WVB,3,6,,,,; OUTPUT ROM CONTENT MOV DRIN,R1 ASR R1E ASR R1  BIC #177400,R1  MOV #NUMBR1,R0O MOV #1,R2 CALL $CBTMG" QIOW$C IO.WVB,3,6,,,, JMP NEXT ;CONTINUE#; DATA STORAGE SECTIONDON: .ASCII /DONE /BAD: .ASCII /BAD /NUMBR: .BYTE 0,0,0,0,0,40,40NUM1: .BYTE 0,0,0,40,40ENUMBR1: .BYTE 0,0,0,12,15W .END,,,R; OUTPUT ACTUAL VALUEN% MOV (R3),R1 ;GET VALUE FROM BUFFER MOV #NUM1,R0 MOV #1,R2 CALL $CBTMG ;CONVERT TO OCTAL QIOW$C IO.WVB,3,6,,,,; OUTPUT ROM CONTENT MOV DRIN,R1 ASR R1E ASR R1  BIC #177400,R1  MOV #NUMBR1,R0O MOV #1,R2 CALL $CBT; PROM VERIFICATION ROUTINE!; TEST FOR PROPER ERASURE OF PROM; PLACE PROM IN READ SOCKET .MCALL ALUN$C,QIOW$C,EXIT$SPROMV::* MOV #0,DRCSR ;RESET CSR,DISABLE INTERRUPT' MOV #0,R1 ;SET ROM ADDR. COUNTER TO 0( MOV #140000,DROUT ;RESET ROM ADDR. TO 0 NOP ;WAIT NOP NOP& MOV #40000,DROUT ;MAKE RESET LINE LOW.PRCMP: MOV DRIN,R3 ;TEST DATA FOR ALL BIT SET) ASR R3 ;MOVE OVER TWO BITS TO THE RIGHT, ASR R3 ;TO COMPENSATE FOR HARDWARE FAILURE" BIC #177400,R3 ;STRIP OFF HI BYTE% CMPB #377,R3 ;CHECK FOR ALL BIT SET% BNE OUTMSG ;OUTPUT MESSAGE IF ERRORL NOP)ADVCTR: INC R1 ;ADVANCE TO NEXT LOCATIONX! MOV #0,DROUT ;SET CLOCK LINE LOWT NOP NOP NOP' MOV #40000,DROUT ;THEN SET IT HI AGAINT CMP #1024.,R1 ;FINISH?; BNE PRCMP ;NO ,CONTINUE $DONE: QIOW$C IO.WVB,2,6,,,, EXIT$S ;EXIT FROM TASK:&OUTMSG: QIOW$C IO.WVB,2,6,,,, MOV R1,R3 ;SAVE R1) MOV #NUMBR,R0 ;R0 POINTS TO ASCII BUFFERS" MOV #1,R2 ;DO NOT SUPPRESS ZEROS' CALL $CBDMG ;CONVERT ADDR. TO DECIMAL; MOV R3,R1 ;RESTORE R1B! QIOW$C IO.WVB,2,6,,,,L MOV R1,R3 ;SAVE R1 AGAIN+ MOV DRIN,R1 ;R1 HAS VALUE OF PROM CONTENTO ASR R1 ;MOVE OVER TWO BITS ASR R10" BIC #177400,R1 ;STRIP OFF HI BYTE) MOV #NUMBR1,R0 ;R0 PONTS TO ASCII BUFFERN" MOV #1,R2 ;DO NOT SUPPRESS ZEROS CALL $CBTMG ;CONVERT TO OCTALS MOV R3,R1 ;RESTORE R1,. QIOW$C IO.WVB,2,6,,,, ;OUTPUT IT$ JMP ADVCTR ;GO ON TO NEXT LOCATIONDON: .ASCII /DONE /BAD: .ASCII /BAD /NUMBR: .BYTE 5 .BYTE 0,0,0,0,40,40NUMBR1: .BYTE 0,0,0,12,15  .END PROMVMBR,7,0>L MOV R1,R3 ;SAVE R1 AGAIN+ MOV DRIN,R1 ;R1 HAS VALUE OF PROM CONTENTO ASR R1 ;MOVE OVER TWO BITS ASR R10" BIC #177400,R1 ;STRIP OFF HI BYTE) MOV #NUMBR1,R0 ;R0 PONTS TO ASCII BUFFERN" MOV #1,R2 ;DO NOT SUPPRESS ZEROS CALL $CBTMG ;CONVERT TO OCTALS MOV R3,R1 ;RESTORE R1,. QIOW$C IO.WVB,2,6,,,, ;OUTPUT IT$ JMP ADVCTR ;GO ON TO NEXT LOCATIONDON: .ASCII /DONE /BAD: .ASCII /BAD /NUMBR: .BYTE 5 .;O); TURBITROL 8080/8085 MATHEMATIC PACKAGE. ;E;A'; FLOATING POINT NUMBER REPRESENTATION:I;A:; FLOATING POINT NUMBER ARE STORED IN MEMORY IN 3 ADJACENT; MEMORY BYTES:L; 1ST BYTE =EXPONENT 0-FFR?; 2ND BYTE =MANTISSA HI ORDER BYTE WITH BIT 7 AS SIGN BIT (SET)"; 3RD BYTE =MANTISSA LO ORDER BYTE;T@; ABSOLUTE VALUE FOR THIS FORMAT RANGES FROM 1E-38 TO 1E+38 DEC.=; ALL ARITHMETIC ROUTINES USE REGISTERS TO STORE OPERANDS.THEO@; DE.H REGISTERS AND BC.L RESGISTERS ARE USED TO STORE OPERANDS.=; UPON RETURNING FROM ARITHMETIC ROUTINES,DE.H WILL HAVE THE A:; RESULT OF THE OPERATION,AND BC.L ARE NORMALLY PRESERVED.; ; CSEG PAGE; PUBLIC @FSUB,@FADD,@FMUL,@FDIV,@FLO,@FIX,@BMUL,@BDIV,@SWAP0) PUBLIC @FLOD,@BMULT,@BDIVT,@FMULT,@FDIVTT' PUBLIC @AFCON,@FACON,@QNUM,@GETD,@PUTDA PUBLIC @C2DE,@C2BC,@C1DE,@C1BCU; MACRO DEFINITIONS:;R#; CHANGE SIGN BIT OF REGISTER PAIRS CSIGN MACRO REGE MOV A,REG XRI 80H MOV REG,A ENDM ;H+; MOVE FLOATING POINT OPERAND FROM R1 TO R2OMOVF MACRO R2,R1 MOV R2,R1 MOV R2+1,R1+1 MOV 5-R2/2,5-R1/2 ENDME;&; SAVE CONTENTS OF BC.L FOR FUTURE USESAVE MACRO REG PUSH B  PUSH HA ENDMB; +; SET MOST SIGNIFICANT BIT IN (BC) AND (DE), SETMSB MACRO  MOV A,B ORI 80H MOV B,A MOV A,D ORI 80H MOV D,A ENDMT;P!; FLOATING POINT SUBSTRACT: @FSUBB; (DE.H)=(DE.H)-(BC.L); ; CARRY SET IF OVERFLOW.@FSUB: SAVE BC.L CSIGN B ;CHANGE SIGN OF BC.L& CALL @FADD ;PERFORM REGULAR ADDITION POP B ;GET BC.L BACK MOV L,C POP B RET ;DONE,RETURN; FLOATING POINT ADD: @FADD-; (DE.H)=(DE.H)+(BC.L)1; CARRY SET FOR OVER FLOW-(BC.L) IS PRESERVED....P@FADD: MOV A,L ;GET EXPONENT  ORA A ;CHECK FOR ZEROI RZ ;NO ADD IF ZEROB MOV A,H ;GET EXPONENT8 ORA A ;=ZERO?V JNZ FADD2 ;(DE.H) .NE. 0&FADD1 MOVF D,B ;LOAD DE.H WITH (BC.L) RET FADD2: SUB L JC FADD3 ;(BC.L)>(DE.H)F CPI 17 ;CHECK FOR SMALL (BC.L) RNC ;IGNORE IT IF TOO SMALL MOV A,H ;GET EXPONENT AGAINI JMP FADD4#FADD3: CPI -16 ;(DE.H) << (BC.L) ?T CMC% JNC FADD1 ;RESULT IS (BC.L) IF TRUE- MOV A,LFADD4: SAVE BC.L ;SAVE (BC.L) PUSH PSWB MOV A,B" XRA D ;PERFORM SUBSTRACTION HERE MOV A,B JP FADD5 ;SAME SIGNI ANA B ;DIFFERENT SIGN CP @SWAP ;SWAP VALUE CALL ALING O MOV A,H SUB L MOV H,A MOV A,E SUB C MOV E,A MOV A,D SBB B MOV D,A PUSH PSW ;SAVE RESULT SIGN JP FADD6 ;NO COMPLEMENT NEEDED CALL @C1DE ;COMPLEMENT (DE)S MOV A,H CMA INR A MOV H,A JNZ FADD6 INX D JMP FADD6FADD5: PUSH PSW CALL ALINGC MOV A,H ADD L MOV H,A ;ADD MANTISSAL MOV A,E ADC C MOV E,A MOV A,D ADC B MOV D,A FADD6: XRA A MOV L,A ORA D ORA E ORA H JNZ FADD7  POP PSW POP PSW ORA A JMP FADD8; RESULT IS NOT ZERO%FADD7: CALL NORMLD ;NORMALIZE RESULT POP PSW ANI 80H ORA D MOV D,A  MOV H,B MVI L,81H POP PSW CALL XADD ;ADD EXPONENTOFADD8: POP B ;DONE ,RETURN MOV L,C POP B RET;A&; FLOATING POINT MULTIPLICATION: @FMUL; (DE.H)=(DE.H)*(BC.L)$; CARRY SET IF OVERFLOW OR UNDERFLOW; (BC.L) IS DESTROYEDM;I@FMUL: MOV A,H) ORA A ;IF MULTIPLY WITH (DE.H)=0,RETURNA RZD MOV A,L# ORA A ;IF MULTIPLICAND=0,RESULT=0Z JNZ FMUL1; SET RESULT=0 MOV H,L RETFMUL1: MOV A,D XRA B ;TAKE CARE OF SIGN BIT PUSH BE PUSH H* PUSH PSW ;SAVE ORIGINAL CONTENT ON STACK# SETMSB ;SET MOST SIGNIFICANT BITD% CALL @BMUL ;PERFORM BINARY MULTIPLY,* CALL NORMLD ;NORMALIZE RESULT TO 16 BITS POP PSW ANI 80H ORA D MOV D,A ;MERGE SIGN BIT MOV A,B POP H POP BXADD: ADD H ;NOW ADD EXPONENTSM PUSH PSW: ADD L MOV H,A JC XADD1 ;RESULT OK) ; UNDERFLOWR POP PSW CMC RNC ;IN RANGE-NOT UNDERFLOW! MVI H,0 ;UNDERFLOW,SET RESULT=0V RETXADD1: POP PSW RNC ;RETURN IF RESULT OKI ; OVERFLOW2OVERFL: MVI H,0FFH ;SET RESULT TO MAX IF OVERFLOW MOV E,H MOV A,D ORI 7FH ;PRESERVE SIGN BIT MOV D,A STC ;SET CARRY ON RETURNL RET; ;R; FLOATING POINT DIVIDE: @FDIV; (DE.H)=(DE.H)/(BC.L)>; CARRY SET IF OVERFLOW.DIVISION BY 0 CAUSE OVERFLOW CONDITION;O@FDIV: MOV A,H( ORA A ;CHECK FOR 0 DIVIDED BY ANYTHING RZ ;EQUAL TO ZERO O FD1: MOV A,L ORA A- JZ OVERFL ;IF DIVIDED BY ZERO WILL OVERFLOWL MOV A,D XRA B PUSH BD PUSH HW PUSH PSWE SETMSB ;SET MSB MOV A,D RAR MOV D,A" MOV A,E ;ROTATE RIGHT WITH CARRY RAR MOV E,A MVI L,0 MOV A,L RAR MOV H,A ;LAST BITS# CALL @BDIV ;PERFORM BINARY DIVIDE PUSH D ;SAVE QUOTIENTD LXI D,0( CALL @C2BC ;TAKE 2' COMPLEMENT ON (BC) MVI A,-2I$FD2: PUSH PSW ;SAVE ITERATION COUNT DAD H RAR XCHGA DAD H XCHGD JNC FD3 INX HFD3: RAL JC FD4E MOV A,L ADD C MOV A,H ADC B JNC FD5 FD4: DAD B INX D'FD5: POP PSW ;GET BACK ITERATION COUNTS INR A JM FD2 ;CONTINUE MOV A,E RRC RRC MOV H,A POP D CALL NORMLD ;NORMALLIZE RESULT INR B POP PSW POP H PUSH HR ANI 80H ORA D MOV D,A MOV A,L ;FORM RESULT CMA INR A MOV L,B CALL XADD ;ADD EXPONENTS MOV A,H POP H MOV H,A POP B RET ;DONE RETURNS;S; FLOATING POINT MULTIPLY BY 10; (DE)=(DE)*10@FMULT: SAVE BC.LF( LXI B,2000H ;LOAD 10 IN FLOATING POINT MVI L,84H CALL @FMUL POP B ;GET BACK BC.L MOV L,C POP B RET;C;T; FLOATING POINT DIVIDE BY 10 ; (DE)=(DE)/10;E@FDIVT: SAVE BC.L ;SAVE BC.L$ LXI B,4CCDH ;LOAD BC.L WITH 0.1000 MVI L,80H-3 CALL @FMUL  POP B MOV L,C POP B RET;V;L;F; ; ; CONVERSION ROUTINESL;;L>; CONVERT A POSTIVE UNSIGNED INTEGER IN (DE) TO FLOATING POINT ; IN (DE.H)R @FLOD: XRA A MOV H,A ;SET EXPONENT =0 JMP FLOAT1 ;CONVERT ;E9; CONVERT 16 BIT SIGNED INTEGER IN (DE) TO FLOATING POINTH; FORMAT IN (DE.H): @FLO;C @FLO: MVI H,0 ;START OUT WITH 0 MOV A,D ANI 80H ;SAVE SIGN BITFLOAT1: PUSH PSW CM @C2DE ;COMPLEMENT (DE)B MOV A,D ORA E JZ FLOAT3 ;VALUE=0 MVI H,90H ;BINARY POINT=16THFLOAT2: MOV A,D ORA A JP FLOAT4 ;KEEP ON NORMALIZING ANI 7FH ;STRIP OFF SIGN BITR MOV D,A'FLOAT3: POP PSW ;GET ORIGINAL SIGN BITI ORA D MOV D,A RET FLOAT4: XCHG DAD H ;SHIFT LEFT XCHGO DCR H ;BINARY POINT ADJUST JMP FLOAT2 ;E; 2; CONVERT FLOATING POINT VALUE IN (DE.H) TO 16 BIT ; SIGNED INTEGER IN (DE): @FIX;H @FIX: MOV A,HA ORA A JNZ FIX1 ;NO ZERO VALUEH$FIX0: XRA A ;RETURN WITH ZERO VALUE MOV D,A MOV E,D RET.FIX1: JP FIX0 ;NO INTEGER PART,SMALLER THAN 0 SUI 81H* JM FIX0 ;VALUE LESS THAN 1,RETURN WITH 0 SUI 15 ;IN 16 BIT RANGE? JNZ FIX2 ;VALUE <32768 MOV A,D SUI 80H STC I RNZ ORA E RZ ;EXACTLY -32768C STC ;OVERFLOW,SET CARRY BIT RET FIX2: CMC  RC ;SET CARRY IF OVER FLOW MOV H,A MOV A,D PUSH PSWL ORI 80H ;MERGE BINARY POINTD MOV D,A FIX3: ORA AX MOV A,D ;SHIFT RIGHT RAR MOV D,A MOV A,E RAR MOV E,A" INR H ;ADJUST EXPONENT FOR SHIFT JM FIX3 ;NOT FINISH1 POP PSW ORA A RP ;RETURN IF POSITIVES& JMP @C2DE ;OTHERWISE,INSERT SIGN BIT; /; FLOATING POINT MATH INTERNAL UTILITY ROUTINESA; ; SWAP FLOATING POINT OPERANDS@SWAP: MOV A,B MOV B,D MOV D,A MOV A,C MOV C,E MOV E,A MOV A,L MOV L,H MOV H,A RET;R6; NORMALIZE 32 BIT VALUE AND ROUND OFF TO 16 BIT VALUENORMLD: MVI B,80HO MOV A,D ORA A JM NORM2 ORA E ORA H ORA L STC RZ ;IF VALUE=0,RETURN NORM1: DCR B" DAD H ;SHIFT (DEHL) LEFT ONE BIT MOV A,E RAL MOV E,A MOV A,D RAL MOV D,A ORA A JP NORM1@NORM2: ANI 7FH MOV D,A ;DISCARD HI ORDER BITS MOV A,H ORA A RP ;NO NEED FOR ROUNDING OFFO INR E RNZ INR D RP: INR B MOV D,E RET;A;M; ALIGN OPERANDS FOR @FADD;VALING: MOV A,H SUB L ORA A PUSH PSWL MOV A,B ORI 80H RAR MOV B,A MOV A,C RAR MOV C,A MVI A,0 RAR MOV L,A MOV A,D ORI 80H RAR MOV D,A MOV A,E RAR MOV E,A MVI A,0 RAR MOV H,AALING1: POP PSWT RZ ;ALIGNED,RETURN JP ALING2 INR A PUSH PSWV MOV A,D RAR MOV D,A MOV A,E RAR MOV E,A MOV A,H RAR MOV H,A JMP ALING1A ALING2: DCR AD PUSH PSWN MOV A,B RAR MOV B,A MOV A,C RAR MOV C,A MOV A,L RAR MOV L,A JMP ALING1A;;;N;M; INTEGER ARITHMETIC ROUTINESS;; BINARY MULTIPLY: 16 X 16 V; (DEHL)=(DE)*(BC);M@BMUL: PUSH PSW LXI H,0 ;CLEAR ACCM.! MVI A,-16 ;LOAD ITERATION COUNTE&BMUL1: PUSH PSW ;SAVE ITERATION COUNT DAD H ;SHIFT LEFT MOV A,E RAL MOV E,A MOV A,D RAL MOV D,A JNC BMUL2 DAD B ;ADD IN MULTIPLICAND JNC BMUL2 ;NO OVER FLOWR INX DBMUL2: POP PSW ;GET COUNT INR A JM BMUL1 ;KEEP LOOPING POP PSW RET ;DONE;M;C5; BINARY MULTIPLY BY 10: (HL)=(HL)*10 MODULO 65536;@BMULT: PUSH D ;SAVE DI MOV D,H MOV E,L ;COPY (HL) TO (DE) DAD D ;*2* DAD H ;*4U DAD D ;*5 DAD H ;*10 POP D RET;-; #; BINARY DIVIDE BY 10: (HL)=(HL)/10S; REMAINDER APPEARS IN (A)@BDIVT: PUSH B ;SAVE BC MVI C,10 ;DIVISORMBDI1: XRA A ;CLEAR ACC. MVI B,-16 ;GET ITERATION COUNT BDI2: DAD HU RAL ;SHIFT TO DIVIDED JC BDI3 CMP C JC BDI4 ;NO BIT BDI3: SUB CE INX H BDI4: INR B JM BDI2 ;NOT FINISH  ORA A POP B RET ;RETURN;0; BINARY DIVIDE: 32/16; (DE)=(DEHL)/(BC),; REMAINDER IS IN (HL),IF OVERFLOW SET CARRY;D@BDIV: PUSH PSW* MOV A,E ;CHECK FOR OVERFLOW SUB C MOV A,D SBB B JC BDIV1  POP PSW ;RESTORE (A) STC ;MARK OVERFLOW) RET ;RETURN BDIV1: PUSH BI CALL @C2BCO XCHG1# MVI A,-16 ;SET UP ITERATION COUNTTBDIV2: PUSH PSW DAD H ;SHIFT LEFT; RAR XCHGD DAD H XCHGC JNC BDIV3 INX H BDIV3: RAL JC BDIV4X MOV A,L ADD C MOV A,H ADC B JNC BDIV5 BDIV4: DAD B INX DBDIV5: POP PSW INR A JM BDIV2D POP B POP PSW ORA A ;CLEAR CARRY,NO OVERFLOW RET;;; 2' COMPLEMENT OF (BC)E @C2BC: DCX B; 1' COMPLEMENT OF (BC)D@C1BC: MOV A,C CMA MOV C,A MOV A,B CMA MOV B,A RET;);R; ;E; 2' COMPLEMENT OF (DE)L @C2DE: DCX D;; 1' COMPLEMENT OF (DE)T@C1DE: MOV A,E CMA ;TAKE COMPLEMENTI MOV E,A MOV A,D CMA MOV D,A RET;B;3 CSEG PAGE;:;L%; I/O ROUTINE FOR FLOATING POINT MATHH;A;B;J5; CONVERSION ROUTINE: ASCII TO FLOATING POINT FORMAT; >; CONVERT A DECIMAL CHARACTER STRING (0-9,+,-,.) INTO FLOATING@; POINT FORMAT IN (DE.H).THE CHARACTER STRING MUST BE TERMINATED ; BY 0FFH. ; ENTER WITH:C6; (BC)=ADDRESS OF THE START OF CHARACTER STRING BUFFER ; EXIT WITH:"; (DE.H)=FLOATING POINT EQUIVALENT>; CARRY BIT SET IF OVERFLOW OR ILLEGAL CHARACTER IN THE STRING=; (A)=FF IF SUCCESSFUL CONVERSION,OTHERWISE,ILLEGAL CHARACTERE; ALL REGISTERS ARE VOLATILE;I;P,@AFCON: CALL @GETD ;GET A DIGIT FROM BUFFER CPI '+' ;IF POSITIVE,DEFAULT JZ @AFCON LXI H,0 ;INITIALIZE MANTISSA1 MVI D,40H ;EXPONENT=40H FOR SCIENTIFIC NOTATIONT# CALL @QNUM ;CHECK FOR VALID DIGITD JNC AF6 ;INITIAL DIGIT IS IN A" CPI '.' ;INITIAL DECIMAL POINT ? JZ AF1U CPI '-' ;NEGATIVE NUMBER?F JNZ AFER ;NONE,ERROR IN STRING=; NEGATIVE NUMBER,PROCEDD AS IF POSITIVE THEN CHANGE SIGN BITF# CALL @AFCON ;RECURSIVE CONVERSIONL PUSH PSW ;SAVE LAST CHARATER MOV A,D ;CHANGE SIGN XRI 80H MOV D,A" POP PSW ;GET BACK LAST CHARACTER RET(; PROCESS DIGITS AFTER THE DECIMAL POINTAF1: CALL @GETD CALL @QNUME" JC AFER ;ILLEGAL DIGIT AFTER DP.AF4: ANI 0FH ;MASK OFF DIGIT  DCR D ;ADJUST EXPONENT ADD L MOV L,A ;ADD TO MANTISSA MOV A,H ACI 0 MOV H,A JNC AF3 ;NO OVERFLOW LXI H,6554 ;SET TO MAX INR DAF3: CALL @GETDM CALL @QNUMS# JC AFCK ;;CHECK FOR END OF BUFFERC CALL QMAX ;CHECK FOR >6554' JC AF3 ;NO MORE ROOM FOR DIGIT,IGNOREV CALL @BMULT ;MULTILPY BY 10M JMP AF4 ;CONTINUETAF2: INR D ;INCORPORATE DIGIT CALL @GETDA CALL @QNUMM JNC AF2 CPI '.' JNZ AFCK ;CHECK FOR ENDF JMP AF3*AF5: CALL QMAX ;DIGIT TO THE LEFT OF D.P. JC AF2D CALL @BMULT AF6: ANI 0FH ;MASK OFF BCD ONLY ADD L MOV L,A ;ADD TO MANTISSA MOV A,H ACI 0 MOV H,A JNC AF7 ;NO OVER FLOW% LXI H,65535 ;SET TO MAX IF OVERFLOWAF7: CALL @GETD CALL @QNUMF JNC AF5 CPI '.' ;DECIMAL POINT?J JZ AF3 ;YES,PROCESS IT); ERROR IN BUFFER,CHECK FOR END OF BUFFERMAFCK: CPI 0FFH ;END CODE? JZ AF8IAFER: STC ;SET CARRY RET ;AND RETURN; END OF BUFFER,DO CONVERSION 8AF8: MOV A,D ;CONVERT FROM SCIENTIFIC TO FLOATING POINT MOV D,H MOV E,L MOV H,A CALL UNFIXA RET ;DONE; ; .; CONVERSION ROUTINE: FLOATING POINT TO ASCII;=; CONVERT A FLOATING POINT VALUE INTO ASCII DECIMAL STRING OFT<; A MAXIMUM OF 7 DIGITS PLUS SIGN AND DECIMAL POINT.POSITIVE=; SIGN IS AUTOMATICALLY SUPPRESSED AS WELL AS LEADING ZEROES.N;F ; ENTER WITH:N"; (BC)=ADDRESS OF CHARACTER BUFFER; (DE.H)=FLOATING POINT VALUET ; EXIT WITH:%; (BC)=NEXT AVAILABLE SPACE IN BUFFERS; CARRY BIT CLEAR IF SUCESSFUL. 0; CARRY BIT SET AND A=0FFH--->OVERFLOW CONDITION/; CARRY BIT SET AND A=0---->UNDERFLOW CONDITIONO; ALL REGISTERS ARE VOLATILE; ;A2@FACON: CALL FFIX ;CONVERT TO SCIENTIFIC NOTATION MOV A,H ;GET EXPONENT  ANI 80H JP FA1 MVI A,'-' ;STORE NEGATIVE SIGN CALL @PUTD &FA1: MOV A,H ;STRIP OFF EXPONENT SIGN ANI 7FH SUI 40H-6 MOV H,A% XCHG ;VALUE IS IN (HL),EXP. IN (D)  MVI E,6 ;LOAD COUNTERU FA2: DCR E JZ FADON ;DONE V DCR D JZ FA7 ;DECIMAL POINT IS HEREA JM FA7 ;OR VALUE <1.0  CALL EXDG ;EXTRACT ONE DIGIT JZ FA2 ;SUPPRESS LEADING ZEROS#FA3: CALL @PUTD ;OUTPUT THAT DIGITT DCR D JNZ FA4 ;MORE DIGITS TO GO MVI A,'.' ;HIT DECIMAL POINT CALL @PUTD ;OUPUT ITFA4: DCR E ;CHECK DIGIT COUNT JZ FA5 ;ALL LISTED.V CALL EXDG ;OTHERWISE,CONTINUEH JMP FA3 FA5: XRA A SUB D JP FADON1 ;DONE,GET OUTA ADI 3 JM FA6 ;OVERFLOW/ MVI A,'0' ;FILL THE REST WITH ZERO,TRUNCATED E CALL @PUTD; DCR D JMP FA5 ;KEEP GOINGA#; OVERFLOW---SET CARRY AND (A)=0FFH<"FA6: MVI A,0FFH ;STORE TERMINATOR CALL @PUTDU STC RET$; PROCESS DIGITS AFTER DECIMAL POINT%FA7: MVI A,'.' ;OUTPUT DECIMAL POINTS CALL @PUTDA FA8: MOV A,D ORA A JZ FA9 ;ZERO EXPONENTT ADI 3 JM FA9E% MVI A,'0' ;EXP. RANGE FROM -1 TO -4 CALL @PUTD ;FILL WITH ZERO INR D JMP FA8"FA9: CALL EXDG ;EXTRACT ONE DIGIT CALL @PUTD ;OUPUT IT DCR E JNZ FA9 XRA A MOV H,A SUB D MOV L,A JZ FADON1 ;DONE;!; UNDERFLOW---SET CARRY AND (A)=0  MVI A,0FFH ;STORE TERMINATOR CALL @PUTDA MVI A,0 STC RET FADON: MVI A,'0' ;OUTPUT A ZERO CALL @PUTDAFADON1: MVI A,0FFH CALL @PUTD ;OUPUT TERMINATOR STC CMC ;CLEAR CARRYM RET;O;A*; UTILITY ROUTINES FOR I/O MATH CONVERSION;M;A1; CHECK FOR VALID BCD CHARATER IN (A) (0-9 ASCII)L"; RETURN WITH CARRY SET IF NOT BCD@QNUM: CPI '9'+1 CMC RC ;NON NUMERIC CPI '0' RET;J; CHECK (HL) FOR VALUE <6554; CARRY SET IF GREATER QMAX: PUSH B MOV B,A MOV A,L SUI 9AH ;6554 MOD 256; MOV A,H SBI 6554/256P CMC MOV A,B POP B RET;:8; GET ONE BYTE FROM BUFFER POINTED BY (BC) AND INCREMENT; (BC) AFTERWARD.U; @GETD: LDAX B ;GET BYTE INX B ;INCREMENT POINTER RET ;RETURN;F;I7; CONVERSION FROM SCIENTIFIC NOTATION TO FLOATING POINTR;; SCIENTIFIC NOTATION CONSISTS OF A 16 BIT POSITIVE INTEGERU=; AND (0-65535) AND A 7 BIT OFFSET BINARY AS EXPONENT BASE 10H:; THE EIGHTH BIT OF THE EXPONENT REPRESENT THE SIGN OF THE6; NUMBER.THIS NOTATION SPEED UP THE CONVERSION PROCESS*; BETWEEN FLOATING POINT TO ASCII DECIMAL.;T2; SCIENTIFIC NOTATION TO FLOATING POINT CONVERSION; (DE.H)=(HL.D));T UNFIX: PUSH BG PUSH H ;SAVE BC,HL PUSH PSWI MOV A,H ANI 80H MOV B,A ;SAVE SIGN OF RESULT MOV A,H ANI 7FH SUI 40H ;GET EXPONENTR MOV C,A ;DECIMAL POSITION IN C6 CALL @FLOD ;CONVERT BINARY IN (DE) TO FLOATING POINT MOV A,H ORA A JZ UNFIX4 ;ZERO VALUE  MOV A,D ORA B MOV D,A MOV A,C ;GET DECIMAL POINT ORA A,UNFIX1: JZ UNFIX4 ;REDUCE TO FLOATING POINT JM UNFIX3 ;NEGATIVE EXPONENT' CALL @FMULT ;MULTIPLY BY 10 EACH TIMEO DCR C JNC UNFIX1N+UNFIX2: POP PSW ;OUT OF RANGE,SET OVERFLOW  STC JMP UNFIX5S0UNFIX3: CALL @FDIVT ;NEG. EXPONENT,DIVIDE BY 10 INR C JNC UNFIX1 ;KEEP GOING JMP UNFIX2 ;UNDER FLOWUNFIX4: POP PSWS ORA A ;RESET CARRY,NO OVERFLOWUNFIX5: POP B ;RESTORE BC.L MOV L,C POP B RET;N;47; CONVERSION FROM FLOATING POINT TO SCIENTIFIC NOTATIONT;C; (DE.H)=(DE.H)A;N FFIX: MOV A,H  ORA A JNZ FFIX1 ;NOT ZERO ' MVI H,40H ;OTHERWISE,RETURN WITH ZERO  LXI D,0 RETFFIX1: CPI 91H PUSH BU" MVI B,40H ;UNIT DECIMAL EXPONENT JNC FFIX5 ; >65535 CPI 8EH* JNC FFIX6 ;TREAT AS LEFT SHIFTED INTEGERFFIX2: CALL @FMULT ; <32768 DCR B MOV A,H SUI 90H" JC FFIX2 ;HAS FRACTIONAL SEGMENT JNZ FFIX5FFIX3: MOV A,D ANI 80H ;EXTRACT SIGN  ORA B MOV H,A MOV A,D ORI 80H MOV D,A POP B RET#FFIX5: CALL @FDIVT ;INTEGER >65535 INR B MOV A,HFFIX6: SUI 90H JZ FFIX3 JNC FFIX5 MOV H,A ;RANGE -1 TO -4H MOV A,D ANI 80H ;MERGE SIGN0 ORA B MOV B,A MOV A,D ORI 80H MOV D,AFFIX7: ORA A ;RESET CARRY MOV A,D RAR MOV D,A ;SHIFT RIGHT (DE)A MOV A,E RAR MOV E,A INR H) JNZ FFIX7 ;SHIFT OUT FRACTIONAL SEGMENT9 JNC FFIX8 INX DFFIX8: MOV H,B POP B ORA A ;RESET CARRY RET;H;E#; EXTRACT A DECIMAL DIGIT FROM (HL)A6; ASCII DIGIT RETURN IN (A) ,ZERO FLAG SET IF RESULT=0;I EXDG: PUSH H PUSH B PUSH D!EXDG1: CALL @BDIVT ;DIVIDE BY 10I DCR E JNZ EXDG1 ADI '0' CPI '0' POP D POP B POP H RET;;V*; PUT A BYTE INTO A BUFFER POINTED BY (BC)0; (BC) IS INCREMENTED BY ONE,AND PUSHED ON STACK;R@PUTD: STAX B ;STORE BYTE INX B ;INCREMENT ITF RET END OUT FRACTIONAL SEGMENT9 JNC FFIX8 INX DFFIX8: MOV H,B POP B ORA A ;RESET CARRY RET;H;E#; EXTRACT A DECIMA;:; DOCUMENTATION FOR TURBITROL 8080/8085 MATHEMATIC PACKAGE;;;;@; THE 8080/8085 MATH PACK IS A COLLECTION OF ARITHMETIC ROUTINES>; TO PERFORM BINARY AND FLOATING POINT (REAL) COMPUTATIONS,ANDA; CONVERSION ROUTINES FOR DIFFERENT NUMBER BASES,INPUT AND OUTPUT; REPRESENTATION.=; ALL ROUTINES ARE RE-ENTRANCE AND USE ONLY ASSIGNED STACK AS?; TEMPORARY STORAGE.AN EXTRA 32 BYTES FOR THE STACK LENGTH WILL>; BE SUFFICIENT FOR NORMAL OPERATION.FLOATING POINT ARITHMETICA; ROUTINES ARE FAST.MOST OPERATIONS ARE DONE IN LESS THAN 2 MILI-AB; SECONDS ON 1 MICROSECOND SYSTEM CLOCK RATE,EXCEPT DIVISION WHICH; TAKES ABOUT 4 MILISECONS.S; ; CALLING SEQUENSE: ;A; LOAD ALL REQUIRED REGISTERS ; CALL APPROPRIATE ROUTINE; CHECK FOR ERROR ;S; NOTE:D;T&; (BC)==>CONTENT OF REGISTER PAIRS B,C&; (DE)==> D,E&; (HL)==> H,L; (A) ==>CONTENT OF ACCUMULATOR?; (BC.L)===>FLOATING POINT VALUE WITH MANTISSA IN B (HI),C (LO)+; AND EXPONENT IN LI?; (DE.H)===>FLOATING POINT VALUE WITH MANTISSA IN D (HI),C (LO)E; AND EXPONENT IN H 4; SYMBOL WHICH STARTS WITH AN @ IS A PUBLIC SYMBOL .;#; SUMMARY OF AVAILABLE SUBROUTINES:L;P.; ********** BINARY MATHEMATIC ***********;; @BDIV BINARY DIVISION. (DE)=(DEHL)/(BC) D0 REMAINDER IS IN (HL),CARRY BIT SET IF OVERFLOW VOLATILE REGISTERS: F,D,E,H,L=1 DIVISOR,REMAINDER,AND QUOTIENT RANGE 0 TO 65535T$ DIVIDEND RANGE FROM 0 TO 4295*10^6; ; -; @BMUL UNSIGNED 16 BIT BINARY MULTIPLICATION); (DEHL)=(DE)*(BC)L ; OPERAND RANGE FROM 0 TO 65535#; RESULT RANGE FROM 0 TO 4295*10^6W; VOLATILE REGISTERS: D,E,H,L;Y;L @BDIVT BINARY DIVIDE BY 10E (HL)=(HL)/10< REMAINDER IS IN (A),FLAGS WILL BE SET DEPENDING ON RESULT. VOLATILE REGISTERS: A,F,H,LL;B;D' @BMULT BINARY MULTIPLY BY 10 (DECIMAL)  (HL)=(HL)*10 NO TEST FOR OVERFLOW.....  VOLATILE REGISTERS: F,H,LT;N;0 @C2BC 2' COMPLEMENT OF (BC)0 THE CONTENT OF (BC) IS COMPLEMENTED AND PLUS 1 VOLATILE REGISTERS: A,B,C(;L;D @C1BC 1' COMPLEMENT OF (BC)& THE CONTENT OF (BC) IS COMPLEMENTED. VOLATILE REGISTERS: A,B,CT;:;E @C2DE 2' COMPLEMENT OF (DE)0 THE CONTENT OF (DE) IS COMPLEMENTED AND PLUS 1 VOLATILE REGISTERS: A,D,E ;R;L @C1DE 1' COMPLEMENT OF (DE)& THE CONTENT OF (DE) IS COMPLEMENTED. VOLATILE REGISTERS: A,D,E0; ;T; 4 ********** FLOATING POINT ARITHMETIC **********;;2;2;O>; THE FLOATING POINT REPRESENTATION IN THIS SYSTEM CAN EXPRESS?; VALUE FROM 0.2 *10^-38 TO 1.7 *10^+38,TOGETHER WITH SIGN WITH ,; APPROXIMATELY 4.8 DECIMAL DIGITS ACCURACY.C; A NUMBER IS REPRESENTED BY A UNIPOLAR 16 BIT MANTISSA WHOSE VALUE C; IS FROM 1.0 TO -1.0.THE MSB OF THE MANTISSA ,IF SET,INDICATES THE A; NUMBER IS NEGATIVE.SINCE ALL NUMBER ARE OFFSET BY THIS BIT,THE A; BINARY POINT POSITION IS ASSUMED BETWEEN BIT 15 AND 14.THUS THE*B; MSB OF THE NUMBER IS ASSUMED TO BE SET ALL THE TIME AND NEED NOTD; BE PRESENTED.THE EXPONENT IS A BIPOLAR 8 BIT VALUE (OFFSET BY 80H)@; BINARY EXPONENT OF THE MANTISSA.THUS A VALUE OF 80H REPRESENTS9; ZERO, 01H REPRESENTS 2^-127 ,AND 0FFH REPRSENTS 2^+127. ;AD; IN MEMORY,A FLOATING POINT NUMBER IS NORMALLY STORED IN 3 ADJACENT; BYTES AS FOLLOWS:E#; LOWEST ADDRESS EXPONENTE2; NEXT ADDRESS MOST SIGNIFICANT BYTE OF MANTISSA'; LAST ADDRESS LEAST SIGNIFICANT BYTET; C; IN ALL FLOATING POINT ARITHMETIC ROUTINES,FLOATING POINT OPERANDSM ; ARE STORED IN (BC.L) OR (DE.H);P;N" @FSUB FLOATING POINT SUBSTRACTION (DE.H)=(DE.H)-(BC.L)8 CARRY SET IF OVERFLOW /UNDERFLOW,EXTREME VALUE RETURN. VOLATILE REGISTERS: A,F,D,E,HE;E;  @FADD FLOATING POINT ADDITION (DE.H)=(DE.H)+(BC.L)7 CARRY SET IF OVERFLOW/UNDERFLOW,EXTREME VALUE RETURN.S VOLATILE REGISTERS: A,F,D,E,HN; ;R# @FMUL FLOATING POINT MULTIPLCATIONA (DE.H)=(DE.H)*(BC.L)7 CARRY SET IF OVERFLOW/UNDERFLOW,EXTREME VALUE RETURN.C VOLATILE REGISTERS: A,F,D,E,HM; ;  @FDIV FLOATING POINT DIVISION (DE.H)=(DE.H)/(BC.L)7 CARRY SET IF OVERFLOW/UNDERFLOW,EXTREME VALUE RETURN.E VOLATILE REGISTERS: A,F,D,E,HT;.; - @FMULT FLOATING POINT MULTIPLY BY 10 DECIMALF (DE.H)=(DE.H)*10.07 CARRY SET IF OVERFLOW/UNDERFLOW,EXTREME VALUE RETURN.O VOLATILE REGISTERS: A,F,D,E,HI;R;S+ @FDIVT FLOATING POINT DIVIDE BY 10 DECIMALN (DE.H))=(DE.H)/10.0.7 CARRY SET IF OVERFLOW/UNDERFLOW,EXTREME VALUE RETURN.M VOLATILE REGISTERS: A,F,D,E,HS;S;,;,;M< ********** NUMBER BASE CONVERSION AND UTILITY **********;;A; ; ;O;F;/: @FLOD CONVERT 16 BIT POSITIVE INTEGER INTO FLOATING POINT. (DE.H)=(DE)...ENTER WITH (DE)=16 BIT NUMBER. VOLATILE REGISTERS: A,F,D,E,H0;;A? @FLO CONVERT 16 BIT SIGNED INTEGER IN (DE) INTO FLOATING POINTR. (DE.H)=(DE)...ENTER WITH (DE)=16 BIT NUMBER. VOLATILE REGIATERS: A,F,D,E,H.;=;.@ @FIX CONVERT FLOATING POINT IN (DE.H) INTO 16 BIT SIGNED NUMBER0 (DE)=(DE.H)...ENTER WITH (DE.H)=FLOATING POINT VOLATILE REGISTERS: A,F,D,E,HR;N;D# @SWAP SWAP FLOATING POINT OPERANDS (DE.H)=(BC.L),(BC.L)=(DE.H)I VOLATILE REGISTERS: AL;I;P;T; ;; ********** INPUT/OUPUT CONVERSION ROUTINES **********S;S;,;,;0: @AFCON CONVERT A DECIMAL ASCII NUMBER INTO FLOATING POINT ENTER WITH:5 (BC) POINTS TO THE START OF BUFFER FOR ASCII STRINGI EXIT WITH:" (DE.H)=FLOATING POINT EQUIVALENT7 CARRY SET IF OVERFLOW OR ILLEGAL CHARACTER IN BUFFER.(< (A)=0FFH IF SUCCESSFUL,OTHERWISE,SET TO ILLEGAL CHARACTER. VOLATILE REGISTERS: ALL.< --NOTE: ASCII BUFFER MUST BE ENDED BY 0FFH AS TERMINATOR--; ;A< @FACON CONVERT FLOATING POINT INTO DECIMAL ASCII EQUIVALENT ENTER WITH:T (DE.H)=FLOATING POINT VALUE5 (BC) POINT TO THE START OF ASCII BUFFER FOR RESULT.G EXIT WITH:8 CARRY SET AND (A)=0FFH--->OVERFLOW CONDITION(>9999999)2 CARRY SET AND (A)=000H--->UNDERFLOW (<0.00000) CARRY CLEAR IF SUCCESSFUL.> RESULT IS STORED IN ASCII,IN BUFFER WITH 0FFH AS TERMINATOR. VOLATILE REGISTERS: ALLER. VOLATILE REGISTERS: ALL.< --NOm۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶m۶