P PPC PPC PPC PPC Z80 RELOCATABLE MACRO ASSEMBLER VER. 3.0MR PPC COPYRIGHT 1979 PPC MICROTEC PPC SUNNYVALE, CALIFORNIA 94088 PPC PPC PPC PPC THE VARIABLES PASSED IN COMMON ARE DEFINED BELOW PPC PPC PPC IADDR = OUTPUT BUFFER FOR PROGRAM COUNTER AND SYMBOL TABLE PPC IALPH = ASSEMBLER CHARACTER SET PPC IAMP = HOST REPRESENTATION OF AN AMPERSAND PPC IARG = FIRST COLUMN OF ARGUMENT FIELD PPC IAST = HOST REPRESENTATION OF AN ASTERISK PPC IATYP = ABSOLUTE RECORD TYPE PPC IBIN = ARRAY FOR ONE LINE OF OBJECT CODE PPC IBIT = NUMBER OF BITS PER HOST COMPUTER WORD PPC IBLNK = HOST REPRESENTATION OF A BLANK PPC ICAT = HOST REPRESENTATION OF AN AT SIGN PPC ICCNT = NUMBER OF CHARACTERS PER HOST COMPUTER WORD PPC ICHAR = ROUTINE TERMINATOR CHARACTER PPC ICHK = OPCODE TYPE AND VALUE PPC ICHRA - ICHRZ = HOST REPRESENTATIONS OF CHARACTERS A-Z PPC ICKSM = CHECK SUM OF OBJECT RECORD PPC ICNT = GENERALIZED COUNTER PPC ICOL = INPUT BUFFER COLUMN POINTE PPC ICOLN = HOST REPRESENTATION OF A COLON PPC ICOMM = HOST REPRESENTATION OF A COMMA PPC ICRD = LOGICAL INPUT UNIT NUMBER PPC ICTAB = HOST REPRESENTATION OF A TAB PPC ICTYP = CODE SEGMENT TYPE PPC IDIV = HOST REPRESENTATION OF A SLASH PPC IDOLR = HOST REPRESENTATION OF A DOLLAR SIGN PPC IDTYP = DATA SEGMENT TYPE PPC IDUM1 = DUMMY VARIABLE FOR PORTABILITY PPC IDUM2 = DUMMY VARIABLE FOR PORTABILITY PPC IEND = END CARD INDICATOR PPC IEXTI = EXTERNAL INDICATOR PPC IEXTT = EXTERNAL SYMBOL VALUE PPC IERR = ERROR STATUS INDICATOR PPC IERRF = MASTER ERROR FLAG PPC IERRI = ERROR INDICATORS FOR OUTPUT PPC IERRS = TOTAL NUMBER OF ERRORS PPC IFCOL = FIRST SOURCE COLUMN NUMBER PPC IFPAR = ARRAY FOR CONDITIONAL INFORMATION DURING NESTING PPC IGRAT = HOST REPRESENTATION OF A GREATER THAN CHARACTER PPC IHIGH = HIGH SYMBOL VALUE PPC ILESS = HOST REPRESENTATION OF A LESS THAN CHARACTER PPC ILOW = LOW SYMBOL VALUE PPC ILPAR = HOST REPRESENTATION OF A LEFT PARENTHESIS PPC IMBLK = INTERMEDIATE BLOCK ARRAY PPC IMFLE = INTERMEDIATE FILE LOGICAL UNIT NUMBER PPC IMIN = HOST REPRESENTATION OF MINUS CHARACTER PPC IMREC = RECORD NUMBER FOR INTERMEDIATE FILE PPC IMULT = HOST REPRESENTATION OF AN ASTERISK PPC IN = CARD IMAGE INPUT BUFFER PPC INDET = SYMBOL TABLE TEMPORARY INDEX PPC INDEX = INDEX INTO THE SYMBOL TABLE PPC IOLIN = NUMBER OF LINES PER PAGE PPC IOPVA = NUMERIC VALUE OF CURRENT OPCODE PPC IOREC = RECORD NUMBER FOR OBJECT MODULE FILE PPC IPAGE = OUTPUT PAGE COUNT PPC IPASS = PASS INDICATOR PPC IPCH = LOGICAL OBJECT MODULE UNIT NUMBER PPC IPER = HOST REPRESENTATION OF A PERIOD PPC IPLEN = OBJECT RECORD LENGTH PPC IPLUS = HOST REPRESENTATION OF PLUS CHARACTER PPC IPRT = LOGICAL OUTPUT UNIT NUMBER PPC IPUBT = PUBLIC SYMBOL VALUE PPC IPVAL = TEMPORARY STROAGE LOCATION PPC IQUES = HOST REPRESENTATION OF A QUESTION MARK PPC IQUOT = HOST REPRESENTATION OF A QUOTE CHARACTER PPC IREL = BYTE RELOCATION FLAGS PPC IRLEN = INTERNAL RECORD LENGTH PPC IRPAR = HOST REPRESENTATION OF A RIGHT PARENTHESIS PPC IRSLA = HOST REPRESENTATION OF REVERSE SLASH PPC IRTYP = RELOCATION TYPE OF EXPRESSION PPC ISEGT = CURRENT SEGMENT TYPE PPC ISEMI = HOST REPRESENTATION OF A SEMICOLON PPC ISETT = SET SYMBOL VALUE PPC ISHRP = HOST REPRESENTATION OF SHARP SIGN PPC ISN = INTERNAL LINE COUNT PPC ISTKL = STACK LENGTH PPC ITAB = SYMBOL TABLE PPC ITABI = SYMBOL TYPE FROM LABEL ROUTINE PPC ITABS = SYMBOL TYPE, EG. LOCAL,GLOBAL,SET,ETC. PPC ITABV = NUMERIC VALUE OF SYMBOL (USUALLY AN ADDRESS) PPC ITYPE = INSTRUCTION TYPE NUMBER PPC IVAL = GENERALIZED VALUE PPC IVAL2 = GENERALIZED VALUE PPC IVBAR = HOST REPRESENTATION OF VERTICAL BAR PPC IWORD = NUMBER OF WORDS IN HOST COMPUTER PER LABEL PPC IXCNT = NUMBER OF CROSS REFERENCE PAGES PPC IXPAG = CROSS REFERENCE MAXIMUM PAGE COUNT PPC IXPNT = POINTER INTO CROSS REFERENCE TABLE PPC IXT = CROSS REFERENCE DISK RECORD PPC IXTAB = CROSS REFERENCE ARRAY PPC KTERM = ERROR FILE UNIT NUMBER PPC KWIND = KEYWORD INDEX PPC KWTYP = KEYWORD TYPE PPC KWVAL = KEYWORD VALUE PPC LABCT = SYMBOL CHARACTER COUNT PPC LABS = ABSOLUTE ASSEMBLY LIST FLAG PPC LBUG = FLAG TO INDICATE SYMBOLS WILL BE PLACED IN MODULE PPC LC = LOCATION COUNTER PPC LCCNT = SEGMENT PROGRAM COUNTERS PPC LCLEN = CURRENT SEGMENT LENGTH PPC LDATA = LIST ADDITIONAL DATA LINES FLAG PPC LEN = LENGTH OF CURRENT INSTRUCTION IN BYTES PPC LERR = ERROR FILE LIST FLAG PPC LGEN = FLAG TO INDICATE LOCAL SYMBOLS ARE IN SYMBOL TABLE PPC LIF = FLAG TO INDICATE WHETHER IF STATEMENTS WILL BE EXPANDED PPC LINE = OUTPUT LISTING LINE COUNT PPC LISN = OUTPUT LINE COUNT PPC LLEN = LENGTH OF BYTES IN ARGUMENT FIELD PPC LMAC = FLAG TO INDICATE MACROS WILL BE EXPANDED PPC LOBJ = FLAG TO INDICATE OBJECT MODULE WILL BE PUNCHED PPC LODLC = ADDRESS FOR OBJECT RECORD PPC LPAR = LEADING PARENTHESIS FOR KEYWORD FLAG PPC LREF = FLAG TO INDICATE CROSS REFERENCE TABLE WILL TO OUTPUT PPC LREL = FLAG TO INDICATE TYPE OF RELATIVE ADDRESSING PPC LSOR = FLAG TO INDICATE SOURCE WILL BE LISTED PPC LSYM = FLAG TO INDICATE THE SYMBOL TABLE WILL BE LISTED PPC LTAB = LENGTH OF SYMBOL TABLE PPC LTBLK = LAST NON BLANK CHARACTER IN SOURCE LINE POINTER PPC LTCNT = SEGMENT LENGTHS PPC LTITL = ARRAY FOR TITLE PPC MAC = INDICATES A MACRO IS CURRENTLY BEING PROCESSED PPC MBIN = GENERALIZED INTEGER ARRAY PPC MBYTF = MULTIBYTE DIRECTIVE FLAG PPC MCBLK = MACRO BLOCK ARRAY PPC MCEPT = MACRO BUFFER ENDING POINTER PPC MCFLE = MACRO SOURCE FILE LOGICAL UNIT NUMBER PPC MCNAM = MACRO NAME TABLE PPC MCNT = MACRO COUNT (TOTAL NUMBER OF MACROS) PPC MCOL = LAST SOURCE COLUMN NUMBER PPC MCREC = RECORD NUMBER FOR MACRO SOURCE FILE PPC MCSPT = MACRO BUFFER STARTING POINTER PPC MDISK = TABLE OF STARTING RECORD NUMBERS FOR MACROS PPC MDIV = DIVISOR FOR SYMTA ROUTINE PPC MLAB = MAXIMUM LABEL LENGTH IN CHARACTERS PPC MLCOL = MAXIMUM NUMBER OF COLUMNS TO PRINT PPC MNAME = MODULE NAME PPC MODE = GENERALIZED SYSTEM FLAG PPC MOPC = MAXIMUM OPCODE LENGTH IN CHARACTERS PPC MPARC = NUMBER OF PARAMETERS IN A MACRO DEFINITION PPC MSIZE = DISK SECTOR SIZE PPC MSREC = MACRO RECORD NUMBER PPC MVAL = BYTE VALUE PPC MXMAC = MAXIMUM NUMBER OF MACROS PPC MXREF = SIZE OF CROSS REFERENCE TABLE PPC MXRCT = NUMBER OF READS/WRITES FOR CROSS REFERENCE PAGE PPC NAME = SYMBOL BUFFER PPC NBIN = GENERALIZED REAL ARRAY PPC NCONS = CONTENT RECORD SEGMENT TYPE PPC NCPNT = CONTENT RECORD POINTER PPC NERR = SYMBOL ROUTINE ERROR FLAG PPC NEPNT = EXTERNAL RECORD POINTER PPC NEXTT = EXTERNAL RECORD TYPE PPC NH1 = VARIABLE FOR HEXADECIMAL OUTPUT PPC NH2 = VARIABLE FOR HEXADECIMAL OUTPUT PPC NINTS = INTERSEGMENT RECORD TYPE PPC NINTT = INTERSEGMENT RECORD ID PPC NIPNT = INTERSEGMENT RECORD POINTER PPC NJMP = INSTRUCTION TYPE FLAG PPC NMSYM = ARRAY FOR SYSTEM MACRO LEVEL NUMBER PPC NRELT = RELOCATION RECORD TYPE PPC NREM = REMAINDER FOR HIGH OPERATOR PPC NRPNT = RELOCATION RECORD POINTER PPC NRFLG = RELOCATION FLAGS FOR OUTPUT ROUTINE PPC NSPAR = SCAN LEADING PARENTHESIS FLAG PPC NUMEX = NUMBER OF EXTERNALS PPC PPC PPC THE MAIN ROUTINE CALLS THE MAJOR SUBROUTINES PPC PPC PP REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2 PP REAL ISTKL,ITABV(200),NBIN(80) PP COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC PP COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL PP COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL,LTAB PP COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTI PP COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,NAME(3),NMSYM(4),ITABI PP COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT PP COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTT PP COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSM PP COMMON MNAME(3),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4) PP COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGEN,LREL PP COMMON LDATA,LABS,LERR,KWTYP,KWVAL,KWIND,NJMP,LPAR,MNFLG,LAIND PP COMMON LABCT,NSPAR,MSIZE,MXRCT,KTERM,NREM,LCNT PP COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDET PP COMMON NARG,LTBLK,IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT PP COMMON IPLUS,IMIN,IMULT,IDIV,IRPAR,ILPAR,IRSLA,IEQUL PP COMMON IGRAT,ILESS,IAMP,IVBAR,IBLNK,ISEMI,ICOMM,ICTAB,IPER PP COMMON ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,ISHRP PP COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRI PP COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR PP COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(62),LTITL(50) PP COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND PP COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASS PPC PPC THE FOLLOWING DEFINE FILE STATEMENTS DEFINE THE INTERMEDIATE PPC FILE AND THE MACRO SOURCE FILE USED BY THIS ASSEMBLER. THESE ARE PPC STANDARD IBM STATEMENTS. THE INTERMEDIATE FILE DEFINED (SYMBOLIC PPC FILE NUMBER 7) CONSISTS OF 1000 97-WORD RECORDS. U INDICATES A PPC BINARY FILE. THE NAME IMREC IS THE RECORD INDEX. THE MACRO PPC SOURCE FILE IS DEFINED IN A SIMILAR MANNER. PPC VARIOUS COMPUTERS DEFINE FILES IN DIFFERENT WAYS. THESE FILES PPC MIGHT HAVE TO BE DEFINED DIFFERENTLY ON YOUR COMPUTER. PPC ALSO NOTE THAT THE INTERMEDIATE FILE COULD BE A SEQUENTIAL FILE PPC PP DEFINE FILE 7(1000,97,U,IMREC) PP DEFINE FILE 8(500,128,U,MCREC) PPC PP CALL INIT PP CALL PASS1 PPC REWIND INTERMEDIATE FILE IF SEQUENTIAL PPC REWIND IMFLE PP CALL PASS2 PP WRITE(IPRT,1020) IERRS PP1020 FORMAT(//,21H ASSEMBLER ERRORS =,I5) PP IF(LSYM+LREF) 400,400,100 PP100 WRITE(IPRT,1000) LTITL,IPAGE PP1000 FORMAT(1H1,35X,50A1,9X,5HPAGE ,I4,//) PP IF(LREF) 200,200,250 PP200 WRITE(IPRT,1010) PP1010 FORMAT(32X,12HSYMBOL TABLE,/) PP LINE = 6 PP GO TO 300 PP250 WRITE(IPRT,1011) PP1011 FORMAT(30X,15HCROSS REFERENCE,//, PP 1 15H LABEL VALUE,8X,9HREFERENCE,/) PP LINE = 8 PP300 CALL SYMTA PP400 WRITE(IPRT,1001) PP1001 FORMAT(1H1) PP STOP PP END PP SUBROUTINE INIT PPC PPC PPC THIS SUBROUTINE INITIALIZES ALL THE VARIOUS PPC VARIABLES USED BY THE ASSEMBLER PPC PPC PP DIMENSION ISTYP(3),ICARR(26) PP DIMENSION NALPH(62),NTITL(23),IREG(28),IREGS(4) PP REAL LC,LCLEN,LCCNT(3),LTCNT(3),LODLC,IPVAL,IVAL,IVAL2 PP REAL ISTKL,ITABV(200),NBIN(80) PP COMMON ICRD,IPRT,IPCH,IMFLE,MCFLE,IMREC,MCREC,IOREC,MSREC PP COMMON ISN,IPLEN,LISN,IPAGE,LINE,IERRS,IERRF,IERR,NERR,IFCOL PP COMMON ICOL,IOLIN,MCOL,MLAB,MOPC,IBIT,ICCNT,IWORD,MLCOL,LTAB PP COMMON MXMAC,ICHAR,ICHK,NH1,NH2,MODE,MDIV,MVAL,NUMEX,IEXTI PP COMMON ITAB(3,200),ITABS(200),ITABV,INDEX,NAME(3),NMSYM(4),ITABI PP COMMON LCCNT,LCLEN,LTCNT,ISTKL,IRTYP,MBYTF,IHIGH,ILOW,IEXTT PP COMMON IPUBT,IPUBF,ISETT,IATYP,ICTYP,IDTYP,NCONS,NRELT,NEXTT PP COMMON NINTS,NINTT,NCPNT,NRPNT,NIPNT,NEPNT,IRLEN,ICNT,ICKSM PP COMMON MNAME(3),NRFLG(8),IVAL,IVAL2,LODLC,LLEN,IBIN(4),IREL(4) PP COMMON IADDR(4,4),LSOR,LSYM,LMAC,LIF,LOBJ,LREF,LBUG,LGEN,LREL PP COMMON LDATA,LABS,LERR,KWTYP,KWVAL,KWIND,NJMP,LPAR,MNFLG,LAIND PP COMMON LABCT,NSPAR,MSIZE,MXRCT,KTERM,NREM,LCNT PP COMMON LC,IPVAL,LEN,MAC,ISEGT,IOPVA,IARG,IERRI(4),ITYPE,INDET PP COMMON NARG,LTBLK,IN(80),IDUM1,IDUM2,MBIN(80),NBIN,MCSPT,MCEPT PP COMMON IPLUS,IMIN,IMULT,IDIV,IRPAR,ILPAR,IRSLA,IEQUL PP COMMON IGRAT,ILESS,IAMP,IVBAR,IBLNK,ISEMI,ICOMM,ICTAB,IPER PP COMMON ICOLN,IQUOT,IDOLR,IAST,ICAT,IQUES,ISHRP PP COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRE,ICHRF,ICHRG,ICHRH,ICHRI PP COMMON ICHRJ,ICHRK,ICHRL,ICHRM,ICHRN,ICHRO,ICHRP,ICHRQ,ICHRR PP COMMON ICHRS,ICHRT,ICHRU,ICHRV,IALPH(62),LTITL(50) PP COMMON MDISK(55),MPARC(55),MCNAM(3,55),MCNT,IFPAR(16),IEND PP COMMON MXREF,IXTAB(512),IXT,IXPNT,IXCNT,IXPAG,IPASS PP EQUIVALENCE (LCABS,LCCNT(1)),(LTABS,LTCNT(1)),(IATYP,ISTYP(1)) PP EQUIVALENCE (ICARR(1),ICHRA) PP EQUIVALENCE (NRFL1,NRFLG(1)),(NRFL2,NRFLG(2)),(NRFL3,NRFLG(3)) PP EQUIVALENCE (NRFL4,NRFLG(4)),(NRFL5,NRFLG(5)),(NRFL6,NRFLG(6)) PP EQUIVALENCE (NRFL7,NRFLG(7)),(NRFL8,NRFLG(8)) PPC PPC SOME COMPUTERS DO NOT ACCEPT THE FULL ASCII CHARACTER SET. PPC THEREFORE SOME OF THE CHARACTERS DEFINED BELOW MAY BE ILLEGAL PPC ON YOUR MACHINE. IF THIS IS THE CASE, THE ILLEGAL CHARACTERS PPC SHOULD BE REPLACED BY VALID CHARACTERS. IF THE ILLEGAL CHARACTERS PPC ARE NOT USED IN THE ASSEMBLER LANGUAGE, REPLACE THEM WITH BLANKS. PPC IF THE ILLEGAL CHARACTERS ARE USED IN THE ASSEMBLER LANGUAGE, PPC REPLACE THEM WITH ANY OTHER VALID CHARACTERS. PPC THE ILLEGAL CHARACTERS MUST BE CHANGED IN THE FOLLOWING TWO DATA PPC ARRAYS. PPC PP DATA NALPH( 1),NALPH( 2),NALPH( 3),NALPH( 4) /1H0,1H1,1H2,1H3/ PP DATA NALPH( 5),NALPH( 6),NALPH( 7),NALPH( 8) /1H4,1H5,1H6,1H7/ PP DATA NALPH( 9),NALPH(10),NALPH(11),NALPH(12) /1H8,1H9,1HA,1HB/ PP DATA NALPH(13),NALPH(14),NALPH(15),NALPH(16) /1HC,1HD,1HE,1HF/ PP DATA NALPH(17),NALPH(18),NALPH(19),NALPH(20) /1HG,1HH,1HI,1HJ/ PP DATA NALPH(21),NALPH(22),NALPH(23),NALPH(24) /1HK,1HL,1HM,1HN/ PP DATA NALPH(25),NALPH(26),NALPH(27),NALPH(28) /1HO,1HP,1HQ,1HR/ PP DATA NALPH(29),NALPH(30),NALPH(31),NALPH(32) /1HS,1HT,1HU,1HV/ PP DATA NALPH(33),NALPH(34),NALPH(35),NALPH(36) /1HW,1HX,1HY,1HZ/ PP DATA NALPH(37),NALPH(38),NALPH(39),NALPH(40) /1H!,1H%,1H_,1H / PP DATA NALPH(41),NALPH(42),NALPH(43),NALPH(44) /1H",1H#,1H$,1H&/ PP DATA NALPH(45),NALPH(46),NALPH(47),NALPH(48) /1H',1H(,1H),1H*/ PP DATA NALPH(49),NALPH(50),NALPH(51),NALPH(52) /1H+,1H,,1H-,1H./ PP DATA NALPH(53),NALPH(54),NALPH(55),NALPH(56) /1H/,1H:,1H;,1H/ PP DATA NALPH(61),NALPH(62) /1H\,1H^/ PP DATA NBLNK,NQUOT,NPLUS,NMIN,NGRAT,NLESS /1H ,1H',1H+,1H-,1H>,1H?@' PP DEFM 'ABCDEFGHIJKLM' PP DEFM 'NOPQRSTUVWXYZ' PP DEFM '\^_' PP CSEG ;RESTORE CODE SEGMENT PP; PP; DEFINE A MACRO PP; NOTE USE OF LOCAL SYMBOLS AND CONCATENATION PP; PPMACRO1 MACR #X,#Y,#Z PP LOCAL #SYM1 PP SUB (IX+5) PP LD #X,#Y&+2 PP #Z PPL#$YM CPL PP#SYM1 LD H,'A' PP ENDM PP; CALL THE MACRO. PP; NOTE THAT MACROS ARE NORMALLY EXPANDED PP MACRO1 D,5,RRCA PP MACRO1 A,6,'ADD A,5' CALL MACRO AGAIN PP; CHECK CONDITIONAL ASSEMBLY PPCTRL EQU 1 PP IF CTRL PP LD A,(HL) PP ADD A,22 PP ADD HL,DE PP ELSE PP RLA PP ADD A,B PP ENDIF PP COND CTRL-1 PP LD A,(HL) PP ADD A,8FH PP ADD HL,DE PP ELSE PP RLA PP ADD A,E PP ENDC PP ASEG ;ABSOLUTE SEGMENT PP ORG 3E0H PPNN DEFS 2 PPIND EQU 5 PPN EQU 20H PPREL EQU 30H PP END PP PPC PPC PPC PPC Z80 LINKING LOADER VERSION 3.0 PPC COPYRIGHT 1979 PPC MICROTEC PPC SUNNYVALE, CA. 94086 PPC PPC PPC THE FOLLOWING VARIABLES ARE PASSED IN COMMON PPC PPC IACNT = ABSOLUTE SEGMENT POINTER PPC IADDR = ADDRESS VALUES IN HOLLERITH FORMAT PPC IALPH = ALPHANUMERIC ARRAY PPC IAST = ASTERISK PPC IBAT = INTERACTIVE/BATCH FLAG PPC IBIT = NUMBER OF BITS IN COMPUTER WORD PPC IBLNK = BLANK PPC ICAT = AT SIGN PPC ICCNT = NUMBER OF CHARACTERS IN AN ENCODED SYMBOL PPC ICNT = OUTPUT ROUTINE POINTER PPC ICHAR = GENERALIZED CHARACTER VARIABLE PPC ICHBT = NUMBER OF BITS IN INTERNAL CHARACTER PPC ICHWD = NUMBER OF CHARACTERS PER WORD FOR EQUATE ROUTINE PPC ICKSM = CHECKSUM FOR RECORD PPC ICOL = CURRENT COLUMN OF INPUT LINE PPC ICOLE = CURRENT COLUMN FOR ERROR PPC ICOLN = COLON PPC ICOMM = COMMA PPC ICRD = DEVICE NUMBER FOR COMMAND INPUT STREAM PPC ID = GENERALIZED SEGMENT ID PPC IDIF = NUMBER OF EXCESS BITS FOR CHARACTER PACKING PPC IEND = END FLAG PPC IEOM = END OF MODULE FLAG PPC IEQUL = EQUAL SIGN PPC IERR = GENERALIZED ERROR FLAG PPC IERRI = MASTER ERROR FLAG PPC IEXTP = EXTERNAL NAME POINTER TABLE PPC IEXTN = EXTERNAL NAME NUMBER PPC IFIL = DEFAULT OBJECT FILE NUMBER PPC IFREC = OBJECT FILE RECORD NUMBER PPC IGBUF = GENERALIZED CHARACTER BUFFER PPC IMFLE = INTERMEDIATE FILE NUMBER PPC IMREC = INTERMEDIATE FILE RECORD NUMBER PPC IN = COMMAND AND OBJECT RECORD INPUT BUFFER PPC INC = LOAD COMMAND INPUT BUFFER PPC INDET = GENERALIZED SYMBOL TABLE INDEX PPC INDEX = INDEX INTO SYMBOL TABLE PPC IORDR = SEGMENT ORDER ARRAY PPC IPASS = PASS FLAG PPC IPBUF = OBJECT MODULE OUTPUT BUFFER PPC IPCH = DEVICE NUMBER OF OBJECT PUNCH DEVICE PPC IPLEN = LENGTH OF OBJECT RECORD TO OUTUT PPC IPREC = OBJECT FILE RECORD NUMBER PPC IPRT = DEVICE NUMBER OF LIST DEVICE PPC IQUES = QUESTION MARK PPC IRBUF = OBJECT MODULE INPUT BUFFER PPC IRDR = DEVICE NUMBER FOR READING OBJECT MODULES PPC IRLEN = GENERALIZED RECORD LENGTH PPC ISBIT = BIT SIZE FOR INTERNAL PROCESSING PPC ISEGT = RECORD SEGMENT TYPE PPC ISLEN = SEGMENT LENGTHS FOR A MODULE PPC ISTKF = STACK LENGTH SPECIFIED FLAG PPC ISTYP = SEGMENT TYPES FOR A MODULE PPC ITAB = SYMBOL TABLE PPC ITABS = SYMBOL TYPE TABLE PPC ITABV = SYMBOL VALUE TABLE PPC IUNDF = UNDEFINED EXTERNAL FLAG PPC IVAL = GENERALIZED 16 BIT VALUE PPC IVAL1 = GENERALIZED 16 BIT VALUE PPC IWORD = NUMBER OF WORDS NEEDED FOR A SYMBOL PPC JCOL = LOAD COMMAND COLUMN POINTER PPC LCLEN = CURRENT MODULE SEGMENT LENGTHS PPC LCNT = SYMBOL PROCESSING FLAG PPC LEADD = GENERALIZED ENDING ADDRESS PPC LFPAG = PAGE COMMAND INDICATORS PPC LLEN = CONTENT RECORD LENGTH PPC LOBJ = DONT OUTPUT FINAL OBJECT MODULE FLAG PPC LODLC = OUTPUT MODULE LOAD POINT PPC LODSA = CONTENT RECORD STARTING ADDRESS PPC LPUR = PURGE SYMBOLS FROM OBJECT MODULES FLAG PPC LPUBM = PUT PUBLIC SYMBOLS IN OBJECT MODULE FLAG PPC LPUBT = LIST PUBLIC SYMBOLS IN SYMBOL TABLE FLAG PPC LSADD = GENERALIZED STARTING ADDRESS PPC LSTAB = SYMBOL TABLE LIST FLAG PPC LSYM = PLACE SYMBOLS IN OBJECT MODULE FLAG PPC LTAB = LENGTH OF SYMBOL TABLE PPC MCOL = MAXIMUM NUMBER OF SOURCE COLUMS SCANNED PPC MDADD = OUTPUT MODULE STARTING ADDRESS PPC MDID = OUTPUT MODULE ID FLAG PPC MDIV = DIVISOR TO DECODE SYMBOLS PPC MDNAM = FINAL OUTPUT MODULE NAME PPC MESSF = FIRST ERROR MESSAGE FLAG PPC MESSN = ERROR MESSAGE NUMBER PPC MLAB = MAXIMUM NUMBER OF CHARACTERS IN A SYMBOL PPC MNAME = CURRENT INPUT MODULE NAME PPC MODCT = OBJECT MODULE COUNTER PPC MODE = MODE FLAG PPC MREC = TEMPORARY RECORD NUMBER PPC MVAL = GENERALIZED 8 BIT VALUE PPC MXEXT = MAXIMUM NUMBER OF EXTERNAL NAMES ALLOWED PPC NAME = GENERALIZED NAME ARRAY PPC NAMEF = INPUT OBJECT FILE NAME ARRAY PPC NBASE = SEGMENT BASE ADDRESS PPC NBEND = SEGMENT END ADDRESS PPC NBHI = HIGH ORDER BASE ADDRESS PPC NBLOW = LOW ORDER BASE ADDRESS PPC NCBUF = CONTENT RECORD BUFFER PPC NCCNT = CONTENT RECORD LENGTH PPC NCCOM = ONES MASK FOR COMPLEMENTING CHARACTERS PPC NCKSM = SYMBOL CHECKSUM PPC NEXUM = NUMBER OF UNDEFINED EXTERNALS IN TABLE PPC NHI = GENERALIZED HIGH ORDER PART OF 16 BIT VALUE PPC NH1 = HEXADECIMAL OUTPUT VARIABLE PPC NH2 = HEXADECIMAL OUTPUT VARIABLE PPC NLOW = GENERALIZED LOW ORDER PART OF 16 BIT VALUE PPC NMAIN = NUMBER OF MAIN PROGRAMS COUNTER PPC NPAGE = SEGMENT PAGING FLAG PPC NRCNT = OBJECT MODULE RECORD LENGTH PPC NULAB = NUMBER OF SYMBOLS IN SYMBOL TABLE PPC PPC PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP DATA IMIN /1H-/ PPC PPC PPC PPC THE FOLLOWING DEFINE FILE STATEMENT DEFINES THE PPC RANDOM ACCESS INTERMEDIATE FILE USED TO WRITE THE PPC OBJECT MODULE RECORDS FOR USE BY PASS TWO OF THE PPC LOADER. THIS FILE CAN BE A SEQUENTIAL FILE WHICH IS PPC SUGGESTED IF POSSIBLE. THIS WILL TYPICALLY SAVE PPC BOTH DISK FILE SPACE AND I/O TIME. IN THIS CASE PPC THE REWIND STATEMENT NEAR STATEMENT 1000 SHOULD PPC BE USED. PPC PP DEFINE FILE 7(500,80,U,IMREC) PPC PPC INITIALIZE PROGRAM PPC PP CALL INIT PP WRITE(IPRT,10001) PP10001 FORMAT(1H1,15X,26HZ80 LINKING LOADER VER 3.0,//, PP 1 3X,17H**LOADER COMMANDS,//) PPC READ NEXT COMMAND LINE AND CHECK COMMAND PP100 CALL INOUT(1) PP CALL COMIN PP MVAL = 0 PP IF(IERR-1) 120,9100,110 PP110 IF(INDEX-13) 9400,120,120 PPC CHECK FOR LOAD COMMAND PP120 IF(INDEX-1) 200,5000,200 PPC PROCESS COMMANDS PP200 CALL COMM PP IF(IERR-1) 100,9960,1000 PPC PERFORM PASS 2 OF LOAD AND FORM FINAL OBJECT MODULE PP1000 IPASS = 2 PPC REWIND IMFLE PP CALL OBJ PP GO TO 9950 PPC PPC LOAD OBJECT FILE *** LOAD PPC PP5000 DO 5010 I=1,80 PP INC(I) = IN(I) PP5010 CONTINUE PP5050 NREAD = 0 PP IF(INC(ICOL)-IMIN) 5070,5060,5070 PP5060 ICOL = ICOL+1 PP NREAD = 1 PP5070 JCOL = ICOL PP MVAL = 80 PP CALL SCAN PP IF(IERR) 5100,5100,5200 PPC READ MODULE FROM I/O DEVICE PP5100 IRDR = IVAL PP JCOL = ICOL PP GO TO 5300 PPC GET FILE NAME PP5200 CALL EQUAT PP IF(IERR) 9200,5210,9200 PP5210 IRDR = -IRDR PP5300 CALL OBJ PP IF(IERR) 5310,5310,5400 PP5310 IF(NREAD) 5320,5320,5300 PP5320 IF(INC(JCOL)-ICOMM) 100,5330,100 PP5330 ICOL = JCOL+1 PP GO TO 5050 PP5400 IF(MREC-1) 9300,5410,9300 PP5410 IF(NREAD) 9300,9300,5320 PPC PPC OUTPUT ERROR MESSAGES PPC PPC INVALID COMMAND PP9100 MESSN = 1017 PP GO TO 9900 PPC FILE NOT FOUND PP9200 MESSN = 1019 PP GO TO 9900 PPC UNEXPECTED END OF MODULE PP9300 MESSN = 1021 PP GO TO 9900 PPC INVALID OPERAND PP9400 MESSN = 16 PP9900 CALL ERROR PP IERRI = IERRI+IBAT PP IF(MESSN-1021) 100,9960,100 PPC LOAD COMPLETE PP9950 WRITE(IPRT,10009) PP10009 FORMAT(//,3X,16H**LOAD COMPLETED,/,1H1) PP GO TO 9990 PPC LOAD NOT COMPLETED PP9960 WRITE(IPRT,10010) PP10010 FORMAT(//,3X,20H**LOAD NOT COMPLETED,/,1H1) PP9990 STOP PP END PP SUBROUTINE INIT PPC PPC PPC THIS ROUTINE INITIALIZES THE VARIABLES NEEDED BY THE PPC LOADER PPC PPC PP DIMENSION NALPH(42) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP DATA NALPH( 1),NALPH( 2),NALPH( 3),NALPH( 4) /1H0,1H1,1H2,1H3/ PP DATA NALPH( 5),NALPH( 6),NALPH( 7),NALPH( 8) /1H4,1H5,1H6,1H7/ PP DATA NALPH( 9),NALPH(10),NALPH(11),NALPH(12) /1H8,1H9,1HA,1HB/ PP DATA NALPH(13),NALPH(14),NALPH(15),NALPH(16) /1HC,1HD,1HE,1HF/ PP DATA NALPH(17),NALPH(18),NALPH(19),NALPH(20) /1HG,1HH,1HI,1HJ/ PP DATA NALPH(21),NALPH(22),NALPH(23),NALPH(24) /1HK,1HL,1HM,1HN/ PP DATA NALPH(25),NALPH(26),NALPH(27),NALPH(28) /1HO,1HP,1HQ,1HR/ PP DATA NALPH(29),NALPH(30),NALPH(31),NALPH(32) /1HS,1HT,1HU,1HV/ PP DATA NALPH(33),NALPH(34),NALPH(35),NALPH(36) /1HW,1HX,1HY,1HZ/ PP DATA NALPH(37),NALPH(38),NALPH(39),NALPH(40) /1H!,1H%,1H_,1H / PP DATA NALPH(41),NALPH(42) /1H?,1H@/ PP DATA NCAT,NQUES,NAST,NBLNK,NCOMM /1H@,1H?,1H*,1H ,1H,/ PP DATA NCOLN,NEQUL,NDOLR /1H:,1H=,1H$/ PPC PPC PPC SET I/O LOGICAL DEVICE NUMBERS PP IPCH = 4 PP ICRD = 5 PP IPRT = 6 PP IMFLE = 7 PP IFIL = 18 PPC SET PARAMETERS FOR INTERNAL SYMBOL PROCESSING PP IBIT = 16 PP MLAB = 8 PP ICCNT = IBIT/8 PP IWORD = 1+(MLAB-1)/ICCNT PP MDIV = 256**(ICCNT-1) PPC PPC SET PARAMETERS FOR EQUATE ROUTINE PPC ISBIT = COMPUTER BIT SIZE PPC ICHBT = NUMBER OF BITS PER CHARACTER PPC E.G. MOST MINIS=8, 370=8,PDP 10=7,CDC 6600=6 PP ISBIT = 16 PP ICHBT = 8 PP ICHWD = ISBIT/ICHBT PP IDIF = ISBIT-ICHWD*ICHBT PP NCCOM = -1+2**ICHBT PPC PP IPASS = 1 PP MXEXT = 200 PP IERRI = 0 PP NCKSM = 0 PP NMAIN = 0 PP IMREC = 1 PP IPREC = 1 PP ISTKF = -1 PP ISTKL = 0 PP MDNAM(10) = -1 PP MDADD = -1 PP LSTAB = 0 PP LSYM = 0 PP LPUR = 1 PP LOBJ = 1 PP LPUBT = 0 PP LPUBM = 0 PP LODLC = -1 PP LTAB = 500 PP IBAT = 1 PP ISEGT = 0 PP MCOL = 72 PP IEND = 0 PP LFPAG(1) = 0 PP LFPAG(2) = 0 PP MODCT = 0 PP MDADD = 0 PP MDID = -1 PP NULAB = 0 PP IACNT = 0 PP NEXUN = 1 PP ICAT = NCAT PP IQUES = NQUES PP IAST = NAST PP IEQUL = NEQUL PP IBLNK = NBLNK PP ICOMM = NCOMM PP ICOLN = NCOLN PP IDOLR = NDOLR PPC INITIALIZE SYMBOL TABLE PP DO 100 I=1,LTAB PP ITAB(1,I) = 0 PP ITABS(I) = 0 PP100 CONTINUE PPC INITIALIZE MODULE NAME PP DO 110 I=1,9 PP MNAME(I) = IBLNK PP110 CONTINUE PP MNAME(10) = 6 PPC INITIALIZE MODULE LENGTH, PAGING FLAGS, BASE ADDRESSES PPC AND SEGMENT ORDER PP DO 120 I=1,4 PP LCLEN(I) = 0. PP NBEND(I) = 0. PP NPAGE(I) = -1 PP NBASE(I) = -1 PP IORDR(I) = I PP120 CONTINUE PPC INITIALIZE ALPHABETIC CHARACTERS PP DO 130 I=1,42 PP IALPH(I) = NALPH(I) PP130 CONTINUE PP RETURN PP END PP SUBROUTINE INOUT(INDX) PPC PPC PPC THIS ROUTINE PERFORMS ALL I/O FOR THE PROGRAM EXCEPT PPC FOR THE HEADINGS AND ERROR MESSAGES. THESE STATEMENTS PPC MAY HAVE TO CHANGE ON SOME MACHINES PARTICULARILY FOR PPC DISK I/O. TWO STATEMENTS ARE SHOWN FOR EACH DISK I/O PPC OPERATION. A STANDARD READ OR WRITE AS USED BY IBM, PPC DEC AND SOME OTHERS, AND A CALL TO A SYSTEM I/O ROUTINE PPC AS USED BY H.P. AND SOME OTHERS (FOR INFORMATIVE PURPOSES) PPC THE RECORD NUMBER (ASSOCIATED VARIABLE) FOR RAMDOM PPC ACCESS I/O IS PASSED INTO THE ROUTINE VIA COMMON PPC PPC PP DIMENSION NAMEI(3),NAMEP(3),NEND(3) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP DATA NEND(1),NEND(2),NEND(3) /1HE,1HN,1HD/ PP DATA NAMEI(1),NAMEI(2),NAMEI(3) /2HIM,2HFL,2HE / PP DATA NAMEP(1),NAMEP(2),NAMEP(3) /2HOB,2HFL,2HE / PPC PPC *ENTRY PARAMETERS PPC INDX - I/O CONTROL WORD PPC 1 = READ COMMAND LINE PPC 2 = READ OBJECT FILE PPC 3 = READ INTERMEDIATE FILE PPC 4 = WRITE INTERMEDIATE FILE PPC 5 = WRITE FINAL OBJECT MODULE PPC PPC *EXIT PARAMETERS PPC I/O READ OR WRITE PERFORMED PPC IERR - RETURN STATUS FOR INDX = 2 PPC 0 = NOT END OF FILE PPC 1 = END OF FILE PPC PPC PP GO TO(100,200,300,400,500),INDX PPC PPC READ COMMAND STATEMENTS PPC PP100 READ(ICRD,1000) IN PPC IF END OF FILE (EOF) CAN BE DETECTED BRANCH TO STATEMENT PPC 110 ON EOF. FOR MOST COMPUTERS THE FOLLOWING STATEMENT PPC IS VALID. PPC100 READ(ICRD,1000,END=110) IN PP GO TO 140 PPC GET HERE FOR END OF FILE PP110 DO 120 I=4,72 PP IN(I) = IBLNK PP120 CONTINUE PP DO 130 I=1,3 PP IN(I) = NEND(I) PP130 CONTINUE PPC CHECK IF COMMAND IS PRINTED PP140 IF(IBAT) 150,190,150 PP150 DO 160 I=1,72 PP IX = 73-I PP IF(IN(IX)-IBLNK) 170,160,170 PP160 CONTINUE PP170 WRITE(IPRT,1001) (IN(I),I=1,IX) PP1001 FORMAT(1X,80A1) PP1000 FORMAT(80A1) PP190 RETURN PPC PPC READ OBJECT MODULE PPC PPC FOR MOST COMPUTERS THE READ STATEMENTS NEEDED PPC TO READ THE OBJECT MODULE FROM A FILE OR FROM AN PPC I/O DEVICE IS THE SAME AND THE I/O STATEMENTS AT 200 AND PPC 250 ARE THE SAME. FOR SOME COMPUTERS THE READS ARE PPC DIFFERENT AND THESE STATEMENTS MAY HAVE TO BE DIFFERENT. PPC PPC READ OBJECT MODULE FROM I/O DEVICE PP200 IERR = 0 PP IF(IRDR) 250,210,210 PP210 READ(IRDR,1000) IN PPC IF END OF FILE (EOF) CAN BE DETECTED BRANCH TO STATEMENT PPC 220 ON EOF. FOR MOST COMPUTERS THE FOLLOWNG STATEMENT PPC IS VALID. PPC210 READ(IRDR,1000,END=220) IN PP RETURN PPC GET HERE FOR END OF FILE PP220 IERR = 1 PP RETURN PPC READ OBJECT MODULE FROM FILE PP250 IRDR = -IRDR PP READ(IRDR,1000) IN PPC IF END OF FILE (EOF) CAN BE DETECTED BRANCH TO STATEMENT PPC 260 ON EOF. FOR MOST COMPUTERS THE FOLLOWING STATEMENT PPC IS VALID. PPC READ(IRDR,1000,END=260) IN PPC CALL EXEC(14,1091,IN,80,NAMEF,IFREC) PP IRDR = -IRDR PP RETURN PPC GET HERE FOR END OF FILE PP260 IERR = 1 PP IRDR = -IRDR PP RETURN PPC PPC READ INTERMEDIATE FILE PPC PP300 IMREC = IFREC PP READ(IMFLE'IMREC) IN PPC CALL EXEC(14,1091,IN,80,NAMEI,IMREC) PP RETURN PPC PPC WRITE INTERMEDIATE FILE PPC PP400 WRITE(IMFLE'IMREC) IN PPC CALL EXEC(15,1091,IN,80,NAMEI,IMREC) PP RETURN PPC PPC WRITE FINAL OBJECT MODULE PPC PP500 I = IPREC PP WRITE(IPCH,1000) (IPBUF(I),I=1,IPLEN) PPC CALL EXEC(15,1091,IPBUF,72,NAMEP,IPREC) PP IPREC = I+1 PP RETURN PP END PP SUBROUTINE COMM PPC PPC PPC THIS ROUTINE PROCESSES THE LOADER COMMANDS PPC PPC PP REAL IASEG(100) PP DIMENSION LLAB(4,10),LCTL(6),LISTS(6),LORDR(4),NORDR(4) PP DIMENSION NON(3),KORDR(4) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (LCTL(1),LSTAB),(IASEG(1),IEXTP(1)) PP EQUIVALENCE (LLAB(1,1),IGBUF(1)) PP DATA LORDR(1),LORDR(2),LORDR(3),LORDR(4) /1HC,1HD,1HS,1HM/ PP DATA LISTS(1),LISTS(2),LISTS(3),LISTS(4) /1HT,1HS,1HP,1HO/ PP DATA LISTS(5),LISTS(6) /1HX,1HD/ PP DATA NON(1),NON(2),NON(3) /1HP,1HB,1HI/ PPC PPC *ENTRY PARAMETERS PPC INDEX - COMMAND NUMBER PPC PPC *EXIT PARAMETERS PPC IERR - RETURN STATUS PPC 0 = NORMAL RETURN PPC 1 = FATAL ERROR, LOAD NOT COMPLETED PPC 2 = PERFORM PASS 2 OF LOAD PPC PPC PP GO TO(9980,1500,2000,2000,2000,2000,2500,3000,3500,4000, PP 1 4500,1000,6000,9980,5500,7000,7000),INDEX PPC PPC SET MODULE NAME *** NAME PPC PP1000 LCNT = 0 PP CALL SYMBL PP IF(IERR-1) 9100,1010,9100 PP1010 DO 1020 I=1,IWORD PP MDNAM(I) = NAME(I) PP1020 CONTINUE PP MDNAM(10) = MLAB PP GO TO 9980 PPC PPC SPECIFY STARTING ADDRESS *** START PPC PP1500 CALL SCAN PP IF(IERR) 9200,1510,9200 PP1510 MDADD = IVAL PP MDID = 0 PP GO TO 9980 PPC PPC SET BASE ADDRESS *** CODE,DATA, ... PPC PP2000 IF(MODCT) 2010,2010,9400 PP2010 CALL SCAN PP IF(IERR) 9200,2020,9200 PP2020 I = INDEX-2 PP NBASE(I) = IVAL PP LCLEN(I) = IVAL PP GO TO 9980 PPC PPC SET STACK SIZE *** STKLN PPC PP2500 CALL SCAN PP IF(IERR) 9200,2520,9200 PP2520 ISTKF = 0 PP ISTKL = IVAL PP GO TO 9980 PPC PPC SET SEGMENT ORDER *** ORDER PPC PP3000 DO 3010 I=1,4 PP NORDR(I) = 0 PP KORDR(I) = 0 PP3010 CONTINUE PP DO 3200 I=1,4 PP DO 3100 J=1,4 PP IF(IN(ICOL)-LORDR(J)) 3100,3110,3100 PP3100 CONTINUE PP GO TO 9200 PP3110 IF(KORDR(J)) 9200,3120,9200 PP3120 NORDR(I) = J PP KORDR(J) = 1 PP ICOL = ICOL+1 PP IF(I-4) 3130,3200,3200 PP3130 IF(IN(ICOL)-ICOMM) 9200,3140,9200 PP3140 ICOL = ICOL+1 PP3200 CONTINUE PP DO 3310 I=1,4 PP IORDR(I) = NORDR(I) PP3310 CONTINUE PP GO TO 9980 PPC PPC SET LIST FLAG *** LIST PPC PP3500 LSET = 1 PP GO TO 4010 PPC PPC CLEAR LIST FLAG *** NLIST PPC PP4000 LSET = 0 PP4010 IF(ICOL-MCOL) 4020,4020,9980 PP4020 DO 4100 I=1,6 PP IF(IN(ICOL)-LISTS(I)) 4100,4200,4100 PP4100 CONTINUE PP GO TO 9200 PP4200 LCTL(I) = LSET PP ICOL = ICOL+1 PP ICHAR = IN(ICOL) PP IF(ICHAR-IBLNK) 4210,9980,4210 PP4210 ICOL = ICOL+1 PP IF(ICHAR-ICOMM) 9200,4010,9200 PPC PPC SET PUBLIC NAME *** PUBLIC PPC PP4500 LCNT = 0 PP INDET = 0 PP CALL LABEL PP LL = IERR PP GO TO(4600,4600,9100,9100,9500),IERR PPC GET SYMBOL VALUE PP4600 IF(IN(ICOL)-IEQUL) 9200,4610,9200 PP4610 ICOL = ICOL+1 PP4650 MVAL = 0 PP CALL SCAN PP IF(IERR) 9200,4700,9200 PP4700 IF(LL-2) 4740,4710,4710 PPC PUT SYMBOL INTO TABLE PP4710 DO 4720 I=1,IWORD PP ITAB(I,INDEX) = NAME(I) PP4720 CONTINUE PP NULAB = NULAB+1 PP4740 ITABV(INDEX) = IVAL PP ITABS(INDEX) = 0 PP IF(IN(ICOL)-ICOMM) 9980,4800,9980 PP4800 ICOL = ICOL+1 PP GO TO 4500 PPC PPC PROCESS EXIT COMMANDS *** EXIT PPC PP5500 GO TO 6700 PPC PPC PROCESS END *** END PPC PP6000 IF(IBAT) 6002,6005,6002 PP6002 IF(IERRI) 6700,6005,6700 PPC FORM BASE ADDRESSES OF SEGMENTS PP6005 LSADD = 0 PP LCLEN(3) = ISTKL PP IF(NBASE(3)) 6008,6006,6006 PP6006 LCLEN(3) = NBASE(3) PP NBASE(3) = NBASE(3)-ISTKL PP6008 DO 6090 I=1,4 PP ID = IORDR(I) PP ISLEN(ID) = 0 PPC CHECK IF USER DEFINED ADDRESS PP IF(NBASE(ID)) 6010,6060,6060 PP6010 IF(NPAGE(ID)) 6040,6040,6020 PPC PAGE OR INPAGE SPECIFIED - MOVE TO NEXT PAGE BOUNDARY PP6020 K = LSADD/256. PP IVAL1 = K PP K = LSADD-IVAL1*256. PP IF(K) 6030,6040,6030 PP6030 LSADD = (IVAL1+1.)*256. PP6040 NBASE(ID) = LSADD PP ISLEN(ID) = LSADD PP6060 LSADD = ISLEN(ID)+LCLEN(ID) PP6070 NBEND(ID) = LSADD PP LCLEN(ID) = NBASE(ID) PP IF(LSADD-65536.) 6090,6100,6100 PP6090 CONTINUE PP GO TO 6105 PPC MODULE TOO LARGE PP6100 MESSN = 1015 PP CALL ERROR PP GO TO 6700 PPC PRINT LOAD MAP PP6105 IF(MODCT) 6700,6700,6110 PP6110 WRITE(IPRT,10002) PP10002 FORMAT(15H1 **LOAD MAP**,//,5X,22HMODULE CODE DATA,/) PP DO 6150 I=1,MODCT PP INDEX = LTAB-I+1 PP INDET = 1 PP ID = -1 PP MODE = 0 PP CALL NAMES PP IVAL = ITABV(INDEX)+ISLEN(1) PP INDET = 1 PP CALL AHEX PP IVAL = ITABS(INDEX) PP IF(IVAL) 6120,6130,6130 PP6120 IVAL = IVAL+65536. PP6130 IVAL = IVAL+ISLEN(2) PP INDET = 2 PP CALL AHEX PP WRITE(IPRT,10003) (LLAB(1,K),K=1,MLAB), PP 1 (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4) PP10003 FORMAT(5X,8A1,4X,4A1,2X,4A1) PP6150 CONTINUE PP IVAL = NBEND(2) PP CALL AHEX PP INDET = 1 PP IVAL = NBEND(1) PP CALL AHEX PP WRITE(IPRT,10006) (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4) PP10006 FORMAT(5X,2H//,10X,4A1,2X,4A1) PP DO 6160 I=3,4 PP IVAL = NBASE(I) PP CALL AHEX PP INDET = INDET+1 PP IVAL = NBEND(I) PP CALL AHEX PP INDET = INDET+1 PP6160 CONTINUE PP WRITE(IPRT,10004) (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4), PP 1 (IADDR(3,K),K=1,4),(IADDR(4,K),K=1,4) PP10004 FORMAT(5X,5HSTACK,7X,4A1,/,5X,2H//,10X,4A1,/, PP 1 5X,6HMEMORY,6X,4A1,/,5X,2H//,10X,4A1) PPC PUT ABSOLUTE SEGMENTS IN ORDER AND OUTPUT PP IACNT = IACNT/2 PP IACN1 = IACNT-1 PP IF(IACN1) 6200,6180,6170 PP6170 DO 6176 I=1,IACN1 PP INDET = 0 PP J1 = I+I-1 PP I1 = I+1 PP DO 6174 LL=I1,IACNT PP J2 = LL+LL-1 PP IF(IASEG(J1)-IASEG(J2)) 6174,6174,6172 PPC SWAP SEGMENTS PP6172 IVAL = IASEG(J2) PP IASEG(J2) = IASEG(J1) PP IASEG(J1) = IVAL PP J1 = J1+1 PP J2 = J2+1 PP IVAL = IASEG(J2) PP IASEG(J2) = IASEG(J1) PP IASEG(J1) = IVAL PP J1 = J1-1 PP6174 CONTINUE PP IF(INDET) 6176,6180,6176 PP6176 CONTINUE PP6180 WRITE(IPRT,10020) PP10020 FORMAT(//,5X,17HABSOLUTE SEGMENTS,/) PP DO 6185 I=1,IACNT PP J1 = I+I-1 PP INDET = 1 PP IVAL = IASEG(J1) PP CALL AHEX PP J1 = J1+1 PP INDET = 2 PP IVAL = IASEG(J1) PP CALL AHEX PP WRITE(IPRT,10021) (IADDR(1,K),K=1,4),(IADDR(2,K),K=1,4) PP10021 FORMAT(17X,4A1,2X,4A1) PP6185 CONTINUE PPC ADJUST SYMBOLS TO PROPER ADDRESSES PP6200 LL = LTAB-MODCT PP DO 6250 I=1,LL PP IF(ITAB(1,I)) 6210,6260,6210 PP6210 K = ITABS(I)-(ITABS(I)/8)*8 PP IF(K) 6250,6250,6220 PP6220 IVAL = ITABV(I)+NBASE(K) PP IF(IVAL-65536.) 6240,6230,6230 PP6230 IVAL = IVAL-65536. PP6240 ITABV(I) = IVAL PP6250 CONTINUE PPC CHECK FOR ANY SEGMENT OVERLAP PP6260 DO 6370 I=1,4 PP IVAL = NBASE(I) PP IVAL1 = NBEND(I)-1. PP IF(IVAL-IVAL1) 6300,6300,6370 PP6300 DO 6335 K=1,4 PP IF(I-K) 6310,6335,6310 PP6310 LSADD = NBASE(K) PP LEADD = NBEND(K)-1. PP IF(IVAL-LSADD) 6325,6320,6320 PP6320 IF(IVAL-LEADD) 6380,6380,6325 PP6325 IF(IVAL1-LSADD) 6335,6330,6330 PP6330 IF(IVAL1-LEADD) 6380,6380,6335 PP6335 CONTINUE PPC CHECK ABSOLUTE SEGMENTS PP IF(IACNT) 6370,6370,6340 PP6340 DO 6360 K=1,IACNT PP J1 = K+K-1 PP J2 = J1+1 PP IF(IVAL-IASEG(J1)) 6350,6345,6345 PP6345 IF(IVAL-IASEG(J2)) 6380,6380,6350 PP6350 IF(IVAL1-IASEG(J1)) 6360,6355,6355 PP6355 IF(IVAL1-IASEG(J2)) 6380,6380,6360 PP6360 CONTINUE PP6370 CONTINUE PP GO TO 6400 PPC HAVE A SEGMENT OVERLAP PP6380 WRITE(IPRT,10005) PP10005 FORMAT(//,3X,17H**SEGMENT OVERLAP) PPC OUTPUT SYMBOL TABLES PP6400 NU1 = NULAB-1 PP IF(NU1) 6430,6430,6405 PP6405 DO 6425 I=1,NU1 PP INDET = 0 PP I1 = NULAB-I PP DO 6420 J1=1,I1 PP J2 = J1+1 PP DO 6410 LL=1,IWORD PP IF(ITAB(LL,J1)-ITAB(LL,J2)) 6420,6410,6412 PP6410 CONTINUE PP GO TO 6420 PPC SWAP POSITIONS PP6412 DO 6415 LL=1,IWORD PP L = ITAB(LL,J2) PP ITAB(LL,J2) = ITAB(LL,J1) PP ITAB(LL,J1) = L PP6415 CONTINUE PP L = ITABS(J2) PP ITABS(J2) = ITABS(J1) PP ITABS(J1) = L PP IVAL = ITABV(J2) PP ITABV(J2) = ITABV(J1) PP ITABV(J1) = IVAL PP INDET = 1 PP6420 CONTINUE PP IF(INDET) 6430,6430,6425 PP6425 CONTINUE PP6430 IF(LPUBT) 6435,6530,6435 PP6435 ID = 0 PP WRITE(IPRT,10011) PP10011 FORMAT(19H1 **PUBLIC SYMBOLS,//) PP6440 INDEX = 1 PP6450 INDET = 1 PP6460 CALL NAMES PP INDEX = INDEX+1 PP IF(IERR) 6480,6470,6480 PP6470 INDET = INDET+1 PP IF(INDET-4) 6460,6460,6480 PP6480 INDET = INDET-1 PP IF(INDET) 6520,6520,6500 PPC OUTPUT NEXT LINE PP6500 WRITE(IPRT,10007) ((LLAB(II,K),K=1,MLAB), PP 1 (IADDR(II,L),L=1,4),II=1,INDET) PP10007 FORMAT(1X,4(8A1,2X,4A1,5X)) PP IF(IERR) 6450,6450,6520 PP6520 IF(ID) 6600,6530,6600 PP6530 IF(LSTAB) 6540,6600,6540 PP6540 ID = 1 PP WRITE(IPRT,10008) PP10008 FORMAT(///,18H **LOCAL SYMBOLS,//) PP GO TO 6440 PPC PERFORM PASS2 OF LOAD AND FORM FINAL MODULE PP6600 IERR = 2 PP DO 6610 I=1,8 PP IN(I) = IALPH(1) PP6610 CONTINUE PP IN(2) = IALPH(2) PP LFPAG(1) = 0 PP LFPAG(2) = 0 PP CALL INOUT(4) PP GO TO 9990 PP6700 IERR = 1 PP GO TO 9990 PPC PPC PROCESS PAGE COMMANDS *** CPAGE,DPAGE PPC PP7000 LL = 0 PP IF(IERR-2) 7010,7100,7010 PP7010 DO 7030 LL=1,3 PP IF(IN(ICOL)-NON(LL)) 7030,7100,7030 PP7030 CONTINUE PP GO TO 9200 PPC VALID COMMAND - SET PAGE FLAG PP7100 K = INDEX-15 PP LFPAG(K) = LL PP IN(1) = IALPH(12) PP IN(2) = IALPH(12) PP IN(3) = IALPH(K) PP LL = LL+1 PP IN(4) = IALPH(LL) PP IN(5) = IALPH(1) PP IN(6) = IALPH(1) PP IN(7) = IALPH(13) PP IN(8) = IALPH(13) PP I = IMREC PP CALL INOUT(4) PP IMREC = I+1 PP GO TO 9980 PPC PPC PRINT ERROR MESSAGE PPC PPC INVALID SYMBOL PP9100 MESSN = 1006 PP GO TO 9900 PPC INVALID OPERAND OR VALUE PP9200 MESSN = 1016 PP GO TO 9900 PPC COMMAND NOT ALLOWED - IGNORED PP9400 MESSN = 1018 PP GO TO 9900 PPC SYMBOL TABLE FULL PP9500 MESSN = 1012 PP GO TO 9900 PPC MODULE GREATER THAN 64K PP9600 MESSN = 1015 PP GO TO 9900 PP9900 CALL ERROR PP IERRI = IERRI+IBAT PP9980 IERR = 0 PP9990 RETURN PP END PP SUBROUTINE OBJ PPC PPC PPC THIS ROUTINE PROCESS AN OBJECT MODULE AND FORMS PPC THE FINAL ABSOLUTE MODULE WITH ALL MODULES LINKED PPC TOGETHER AND ALL RELOCATABLE ADDRESSES RESOLVED. PPC IT ALSO PLACES ALL SYMBOLS INTO THE SYMBOL TABLE PPC TO BE USED BY OTHER ROUTINES. PPC PPC PP REAL IASEG(100) PP DIMENSION LLAB(4,10) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (IRBU1,IRBUF(1)),(IRBU2,IRBUF(2)) PP EQUIVALENCE (IRBU3,IRBUF(3)),(IRBU4,IRBUF(4)) PP EQUIVALENCE (NCBU1,NCBUF(1)) PP EQUIVALENCE (LLAB(1,1),IGBUF(1)),(IASEG(1),IEXTP(1)) PPC PPC ENTRY PARAMETERS PPC IN - CONTAINS OBJECT PPC IPASS - PASS FLAG, 1=PASS 1 PPC LCLEN - STARTING MODULE ADDRESSES PPC NBASE - SEGMENT BASE ADDRESSES PPC PPC *EXIT PARAMETERS PPC LCLEN - UPDATED SEGMENT LENGTHS PPC NPAGE - POSITIVE IMPLIES INPAGE OR PAGE OPERATION PPC PPC PPC INITIALIZE SEGMENT LENGTHS AND TYPES PP MREC = 0 PP NCBU1 = -1 PP10 DO 20 I=1,4 PP ISLEN(I) = 0 PP ISTYP(I) = 0 PP20 CONTINUE PP DO 30 I=1,MLAB PP MNAME(I) = IBLNK PP30 CONTINUE PP50 MESSF = 0 PP IEOM = 0 PP IHEAD = 0 PP IPTYP = 0 PP IEXTN = 0 PP IUNDF = 0 PPC PPC READ NEXT OBJECT RECORD PPC PP100 ITYPE = IPASS+1 PP MREC = MREC+1 PP IFREC = MREC PP CALL INOUT(ITYPE) PP IF(IPASS-1) 115,110,115 PPC WRITE RECORD TO INTERMEDIATE FILE PP110 I = IMREC PP IF(IERR) 112,112,9995 PP112 CALL INOUT(4) PP IMREC = I+1 PPC GET RECORD TYPE PP115 ICOL = 1 PP ICKSM = 0 PP CALL HEXIN PP IF(IERR) 9000,120,9000 PP120 NTYP = MVAL PPC CHECK IF FIRST RECORD IS A HEADER RECORD PP IF(IPASS-2) 122,140,122 PP122 IF(MREC-1) 130,125,130 PP125 IF(NTYP-2) 9200,140,9200 PP130 IF(IEOM) 140,140,135 PP135 IF(NTYP-14) 9150,140,9150 PPC GET RECORD COUNT PP140 CALL HEXIN PP IF(IERR) 9000,150,9000 PP150 IF(MVAL-72) 160,160,9300 PP160 NRCNT = MVAL PP CALL HEXIN PP IF(IERR) 9000,170,9000 PP170 IF(MVAL) 9300,200,9300 PPC PROCESS RECORD TYPES AND CHECK FOR PURE DATA RECORDS PP200 IF(NTYP-2) 2500,1000,210 PP210 IF(NTYP-4) 9400,500,220 PP220 IF(NTYP-6) 9400,500,230 PP230 IF(NTYP-14) 9400,500,240 PP240 IF(NTYP-18) 9400,3000,250 PP250 IF(NTYP-22) 9400,3500,260 PP260 IF(NTYP-24) 9400,6000,270 PP270 IF(NTYP-32) 9400,500,280 PP280 IF(NTYP-34) 9400,500,290 PP290 IF(NTYP-36) 9400,500,300 PP300 IF(NTYP-187) 9400,700,9400 PPC HAVE PURE DATA RECORD, UNPACK PP500 NRCNT = NRCNT/2 PP DO 520 I=1,NRCNT PP CALL HEXIN PP IF(IERR) 9000,510,9000 PP510 IRBUF(I) = MVAL PP520 CONTINUE PP ICKSM = ICKSM-(ICKSM/256)*256 PP IF(ICKSM) 9100,610,9100 PP610 IF(NTYP-4) 4000,4000,620 PP620 IF(NTYP-14) 5000,2000,630 PP630 IF(NTYP-34) 7000,8000,8500 PPC PPC ***** PROCESS PAGE COMMAND PPC PP700 CALL HEXIN PP IF(IERR) 9000,710,9000 PP710 IF(MVAL-204) 9400,720,9400 PP720 K = 1+NRCNT/16 PP L = NRCNT-16*(K-1) PP LFPAG(K) = L PP GO TO 100 PPC PPC ***** PROCESS HEADER RECORD PPC PP1000 IF(IHEAD) 9200,1010,9200 PP1010 IHEAD = IHEAD+1 PP CALL HEXIN PP IF(IERR) 9000,1020,9000 PP1020 DO 1050 I=1,MVAL PP K = ICOL+I-1 PP LL = IN(K) PP IF(LL-IAST) 1040,1030,1040 PP1030 LL = IBLNK PP1040 MNAME(I) = LL PP1050 CONTINUE PP MNAME(10) = MVAL PP IF(MDNAM(10)) 1060,1080,1080 PP1060 DO 1070 I=1,MVAL PP MDNAM(I) = MNAME(I) PP1070 CONTINUE PP MDNAM(10) = MVAL PP1080 LCNT = MVAL PP CALL SYMBL PP IF(IERR-4) 1090,9500,1090 PP1090 IF(IPASS-1) 1115,1100,1115 PPC PUT NAME INTO TABLE PP1100 LL = LTAB-MODCT PP IF(LL-NULAB) 9250,9250,1105 PP1105 DO 1110 K=1,IWORD PP ITAB(K,LL) = NAME(K) PP1110 CONTINUE PP MODCT = MODCT+1 PP1115 CALL HEXIN PP IF(IERR) 9000,1120,9000 PP1120 IF(IPTYP .GE. 2) GO TO 9200 PP IPTYP = MVAL PP CALL HEXIN PP IF(IERR) 9000,1130,9000 PPC GET SEGMENT ID,LENGTH AND TYPE PP1130 NN = (NRCNT-LCNT-8)/8 PP IF(NN) 1400,1400,1150 PP1150 DO 1290 I=1,NN PP CALL HEXIN PP IF(IERR) 9000,1210,9000 PP1210 IF(MVAL) 9600,9600,1220 PP1220 IF(MVAL-4) 1230,1230,9600 PP1230 ID = MVAL PP CALL HEXIN PP IF(IERR) 9000,1240,9000 PP1240 IVAL = MVAL PP CALL HEXIN PP IF(IERR) 9000,1250,9000 PP1250 IVAL1 = MVAL PP CALL HEXIN PP IF(IERR) 9000,1260,9000 PP1260 IF(MVAL) 9600,9600,1270 PP1270 IF(MVAL-3) 1280,1280,9600 PP1280 ISLEN(ID) = IVAL1*256.+IVAL PP ISTYP(ID) = MVAL PP1290 CONTINUE PPC CHECK IF ANY INPAGE OR PAGE RELOCATION TYPES PP DO 1370 I=1,2 PP NHI = ISLEN(I)/256. PP IVAL = NHI PP NLOW = ISLEN(I)-IVAL*256. PP NBHI = LCLEN(I)/256. PP IVAL = NBHI PP NBLOW = LCLEN(I)-256.*IVAL PPC CHECK IF ANY PAGE COMMAND SPECIFIED PP IF(LFPAG(I)) 1310,1310,1300 PP1300 IF(LFPAG(I)-2) 1350,1370,1320 PP1310 ID = ISTYP(I) PP IF(ID-2) 1320,1350,1370 PPC CHECK INPAGE RELOCATION PP1320 IF(NHI) 1350,1330,1350 PP1330 NPAGE(I) = 1 PP IF(NLOW+NBLOW-256) 1370,1370,1350 PPC FORCE TO NEXT PAGE PP1350 NPAGE(I) = 2 PP IF(NBLOW) 1360,1370,1360 PP1360 NBHI = NBHI+1 PP NBLOW = 0 PP LCLEN(I) = (IVAL+1.)*256. PP IF(MODCT-1) 1370,1362,1370 PP1362 IF(NBASE(I)) 1370,1364,1364 PP1364 NBASE(I) = LCLEN(I) PP1370 CONTINUE PP IF(IPASS-1) 1400,1380,1400 PP1380 LL = LTAB-MODCT+1 PP ITABV(LL) = LCLEN(1) PP IVAL = LCLEN(2) PP IF(IVAL-32768.) 1395,1390,1390 PP1390 IVAL = IVAL-65536. PP1395 ITABS(LL) = IVAL PPC CHECK CHECKSUM PP1400 CALL HEXIN PP IF(IERR) 9000,1410,9000 PP1410 ICKSM = ICKSM-(ICKSM/256)*256 PP IF(ICKSM) 9100,100,9100 PPC PPC ***** PROCESS END OF MODULE AND FILE RECORD PPC PP2000 IF(IPASS-1) 50,9990,50 PPC PP2500 IF(IPASS-1) 2510,9400,2510 PP2510 IF(NCBU1) 2540,2520,2520 PP2520 LLEN = NCCNT PP CALL OUT PP2540 IEND = 1 PP CALL OUT PP GO TO 9990 PPC PPC ***** PROCESS SYMBOL RECORD PPC PP3000 IADDS = 256 PP INDET = 1 PP IF(LPUR) 3510,100,3510 PPC PPC ***** PROCESS PUBLIC DECLARATION RECORD PPC PP3500 IADDS = 0 PP INDET = 0 PP3510 IF(IPASS-2) 3520,100,3520 PPC GET SEGMENT ID PP3520 CALL HEXIN PP IF(IERR) 9000,3530,9000 PP3530 IF(MVAL-4) 3540,3540,9600 PP3540 ID = MVAL PPC GET OFFSET AND NAME PP3600 CALL HEXIN PP IF(IERR) 9000,3610,9000 PP3610 IVAL = MVAL PP CALL HEXIN PP IF(IERR) 9000,3620,9000 PP3620 IVAL1 = MVAL PP IVAL = IVAL1*256.+IVAL PP CALL HEXIN PP IF(IERR) 9000,3640,9000 PP3640 LCNT = MVAL PP ICOLE = ICOL PP CALL LABEL PP GO TO(3690,3660,9500,3660,9250),IERR PPC SYMBOL NOT IN TABLE - PUT IN PP3660 DO 3670 I=1,IWORD PP ITAB(I,INDEX) = NAME(I) PP3670 CONTINUE PP NULAB = NULAB+1 PP IF(ID) 3675,3685,3675 PP3675 IVAL = IVAL+LCLEN(ID)-NBASE(ID) PP IF(NBASE(ID)) 3680,3685,3685 PP3680 IVAL = IVAL-1. PP3685 ITABV(INDEX) = IVAL PP ITABS(INDEX) = ID+IADDS PP GO TO 3700 PPC DUPLICATE PUBLIC NAME PP3690 MESSN = 14 PP CALL ERROR PP3700 CALL HEXIN PP IF(IERR) 9000,3710,9000 PP3710 IF(ICOL-(NRCNT+5)) 3600,3720,3720 PPC GET CHECKSUM PP3720 CALL HEXIN PP IF(IERR) 9000,3730,9000 PP3730 ICKSM = ICKSM-(ICKSM/256)*256 PP IF(ICKSM) 9100,100,9100 PPC PPC ***** PROCESS END RECORD PPC PP4000 DO 4020 I=1,2 PP LCLEN(I) = LCLEN(I)+ISLEN(I) PP IF(LCLEN(I)-65536.) 4020,9350,9350 PP4020 CONTINUE PPC CHECK STACK LENGTH PP IF(ISTKF .EQ. 0) GO TO 4040 PP IF(ISTKL .GE. ISLEN(3)) GO TO 4040 PP ISTKL = ISLEN(3) PP4040 IEOM = 1 PP IF(IPASS-2) 100,4100,100 PP4100 IF(IRBU1) 4200,4200,4110 PP4110 IF(NMAIN) 4120,4120,4200 PP4120 NMAIN = 1 PP MDID = IRBU2 PP IVAL = IRBU3 PP IVAL1 = IRBU4 PP MDADD = IVAL1*256.+IVAL PP IF(MDID) 4140,4200,4140 PP4140 MDADD = MDADD+LCLEN(MDID)-ISLEN(MDID) PP IF(MDADD-65536.) 4200,4150,4150 PP4150 MDADD = MDADD-65536. PP4200 IHEAD = 0 PP IEXTN = 0 PP GO TO 100 PPC PPC ***** PROCESS CONTENT RECORD PPC PP5000 IF(IPASS-1) 5050,5230,5050 PP5050 IF(NCBU1) 5200,5100,5100 PP5100 LLEN = NCCNT PP CALL OUT PP5200 NCCNT = NRCNT-4 PP DO 5220 I=1,NCCNT PP K = I+3 PP NCBUF(I) = IRBUF(K) PP5220 CONTINUE PP5230 IVAL = IRBU2 PP LSADD = IRBU3 PP LSADD = LSADD*256.+IVAL PP IVAL = NRCNT-5 PP LEADD = LSADD+IVAL PP ISEGT = IRBU1 PP NCBU1 = IRBU4 PP LODSA = LSADD PP IF(ISEGT) 5240,5400,5240 PP5240 IF(ISEGT-2) 5300,5300,9600 PPC CHECK IF ADDRESS WITHIN BOUNDS SPECIFIED IN HEADER RECORD PP5300 IF(ISLEN(ISEGT)-LEADD) 9700,5310,5310 PP5310 LODSA = LSADD+LCLEN(ISEGT) PP GO TO 100 PPC HAVE ABSOLUTE SEGMENT - CHECK RANGE PP5400 IF(IPASS-1) 100,5410,100 PP5410 IF(IACNT) 5420,5430,5420 PP5420 IF(IASEG(IACNT)+1.-LSADD) 5430,5450,5430 PP5430 IF((IACNT+IACNT+1)-MXEXT) 5440,100,100 PP5440 IACNT = IACNT+1 PP IASEG(IACNT) = LSADD PP IACNT = IACNT+1 PP5450 IASEG(IACNT) = LEADD PP GO TO 100 PPC PPC ***** PROCESS EXTERNAL NAME RECORD PPC PP6000 CALL HEXIN PP IF(IERR) 9000,6020,9000 PP6020 LCNT = MVAL PP INDET = 0 PP CALL LABEL PP GO TO(6030,6040,9500,6040,6040),IERR PPC EXTERNAL NOT IN TABLE - SET UNDEFINED FLAG PP6030 INDET = INDEX PP6040 IF(IPASS-1) 6050,6070,6050 PP6050 IEXTN = IEXTN+1 PP IF(IEXTN-MXEXT) 6060,9050,9050 PP6060 IF(INDET) 6068,6062,6068 PPC PUT UNDEFINED SYMBOL INTO TABLE PP6062 INDEX = NULAB+NEXUN PP IF(INDEX-LTAB) 6064,6068,6068 PP6064 NEXUN = NEXUN+1 PP INDET = INDEX+1 PP DO 6066 I=1,IWORD PP ITAB(I,INDET) = NAME(I) PP6066 CONTINUE PP INDET = -INDET PP6068 IEXTP(IEXTN) = INDET PP6070 CALL HEXIN PP IF(IERR) 9000,6080,9000 PP6080 IF(ICOL-(NRCNT-5)) 6000,6000,6090 PPC GET CHECKSUM PP6090 CALL HEXIN PP IF(IERR) 9000,6100,9000 PP6100 ICKSM = ICKSM-(ICKSM/256)*256 PP IF(ICKSM) 9100,100,9100 PPC PPC ***** PROCESS EXTERNAL REFERENCE PPC PP7000 IPNT = 1 PP LOHI = IRBU1 PP IC = 4 PP IF(LOHI-1) 9600,7030,7010 PP7010 IF(LOHI-3) 7020,7030,9600 PP7020 IC = 4+IPTYP PP7030 NRCNT = (NRCNT-2)/IC PP DO 7300 LL=1,NRCNT PP IPNT = IPNT+1 PP IPNT1 = IPNT+1 PP INDEX = IRBUF(IPNT)+IRBUF(IPNT1)*256 PP IPNT = IPNT+2 PP IVAL = IRBUF(IPNT) PP IPNT = IPNT+1 PP IVAL1 = IRBUF(IPNT) PP IVAL = IVAL1*256.+IVAL PP IF(IVAL-LSADD) 9700,7040,7040 PP7040 IF(IVAL-LEADD) 7050,7050,9700 PP7050 ICPNT = IVAL-LSADD+1. PP IF(LOHI-2) 7054,7052,7054 PP7052 IPNT = IPNT+IPTYP PP7054 IF(IPASS-1) 7060,7300,7060 PPC CHECK IF UNDEFINED EXTERNAL PP7060 IF(INDEX-IEXTN) 7070,7070,9800 PP7070 INDEX = INDEX+1 PP INDEX = IEXTP(INDEX) PP IF(INDEX) 7100,7150,7200 PPC HAVE UNDEFINED EXTERNAL PP7100 MODE = -1 PP ID = -1 PP INDET = 1 PP INDEX = -INDEX PP CALL NAMES PP GO TO 7170 PPC TABLE FULL, SET NAME TO BLANKS PP7150 DO 7160 I=1,MLAB PP LLAB(1,I) = IBLNK PP7160 CONTINUE PP7170 MESSN = 13 PP CALL ERROR PP IUNDF = IUNDF+1 PP NBHI = 0 PP NBLOW = 0 PP GO TO 7220 PP7200 NBHI = ITABV(INDEX)/256. PP IVAL1 = NBHI PP NBLOW = ITABV(INDEX)-IVAL1*256. PP7220 MVAL = NBLOW PP IF(LOHI-2) 7250,7240,7250 PP7240 MVAL = NBHI PP IF(IPTYP .EQ. 0) GO TO 7250 PP MVAL = MVAL+(NBLOW+IRBUF(IPNT))/256 PP7250 MVAL = NCBUF(ICPNT)+MVAL PP IC = MVAL/256 PP NCBUF(ICPNT) = MVAL-IC*256 PP IF(LOHI-3) 7300,7260,7300 PP7260 ICPNT = ICPNT+1 PP MVAL = NCBUF(ICPNT)+NBHI+IC PP IC = MVAL/256 PP NCBUF(ICPNT) = MVAL-IC*256 PP7300 CONTINUE PP GO TO 100 PPC PPC ***** PROCESS RELOCATION RECORD PPC PP8000 ID = ISEGT PP IPNT = 2 PP GO TO 8505 PPC PPC ***** PROCESS INTERSEGMENT RECORD PPC PP8500 ID = IRBU1 PP IPNT = 3 PP8505 IF(NCBU1) 9150,8510,8510 PP8510 IF(ID) 8515,9150,8515 PP8515 IVAL1 = LCLEN(ID) PP IF(ID-3) 8530,8520,8525 PP8520 IVAL1 = NBEND(3) PP GO TO 8530 PP8525 IVAL1 = NBASE(4) PP8530 NBHI = IVAL1/256. PP IVAL = NBHI PP NBLOW = IVAL1-IVAL*256. PP IPNT = IPNT-1 PP LOHI = IRBUF(IPNT) PP IC = 2 PP IF(LOHI-1) 9600,8536,8532 PP8532 IF(LOHI-3) 8534,8536,9600 PP8534 IC = 2+IPTYP PP8536 NRCNT = (NRCNT-IPNT)/IC PP DO 8600 LL=1,NRCNT PP IPNT = IPNT+1 PP IVAL = IRBUF(IPNT) PP IPNT = IPNT+1 PP IVAL1 = IRBUF(IPNT) PP IVAL = IVAL1*256.+IVAL PP IF(IVAL-LSADD) 9700,8540,8540 PP8540 IF(IVAL-LEADD) 8542,8542,9700 PP8542 IF(LOHI-2) 8550,8544,8550 PP8544 IPNT = IPNT+IPTYP PPC POINT TO CONTENT BYTE TO MODIFY PP8550 IF(IPASS-1) 8555,8600,8555 PP8555 ICPNT = IVAL-LSADD+1. PP MVAL = NBLOW PP IF(LOHI-2) 8570,8560,8570 PP8560 MVAL = NBHI PP IF(IPTYP .EQ. 0) GO TO 8570 PP MVAL = MVAL+(NBLOW+IRBUF(IPNT))/256 PP8570 MVAL = NCBUF(ICPNT)+MVAL PP IC = MVAL/256 PP NCBUF(ICPNT) = MVAL-IC*256 PP IF(LOHI-3) 8600,8580,8600 PP8580 ICPNT = ICPNT+1 PP MVAL = NCBUF(ICPNT)+NBHI+IC PP IC = MVAL/256 PP NCBUF(ICPNT) = MVAL-IC*256 PP8600 CONTINUE PP GO TO 100 PPC PPC ERROR CONDITIONS PPC PPC ILLEGAL HEXADECIMAL CHARACTER PP9000 MESSN = 1 PP GO TO 9900 PPC EXTERNAL TABLE FILLED PP9050 MESSN = 10 PP GO TO 9900 PPC INVALID CHECKSUM PP9100 MESSN = 2 PP GO TO 9900 PPC RECORD OUT OF SEQUENCE PP9150 MESSN = 11 PP GO TO 9900 PPC HEADER RECORD ERROR PP9200 MESSN = 3 PP GO TO 9900 PPC SYMBOL TABLE FULL PP9250 MESSN = 12 PP GO TO 9900 PPC RECORD TOO LARGE PP9300 MESSN = 4 PP GO TO 9900 PPC MODULE GREATER THAN 64K PP9350 MESSN = 1015 PP GO TO 9900 PPC INVALID RECORD TYPE PP9400 MESSN = 5 PP GO TO 9900 PPC INVALID SYMBOL PP9500 MESSN = 6 PP GO TO 9900 PPC INVALID SYMBOL ID OR RELOCATION TYPE PP9600 MESSN = 7 PP GO TO 9900 PPC ADDRESS OUT OF RANGE PP9700 MESSN = 8 PP GO TO 9900 PPC EXTERNAL INDEX OUT OF RANGE PP9800 MESSN = 9 PP9900 CALL ERROR PP IERRI = 1 PP IF(IEOM) 100,100,9990 PP9990 IERR = 0 PP9995 RETURN PP END PP SUBROUTINE LABEL PPC PPC PPC THE ROUTINE FORMS A SYMBOL AND CHECKS IF THE SYMBOL PPC IS IN THE SYMBOL TABLE AND IS A PUBLIC PPC PPC PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PPC PPC *ENTRY PARAMETERS PPC ICOL - STARTING COLUMN OF SCAN PPC INDET - SYMBOL FLAG PPC 0 = FIND PUBLIC PPC 1 = FIND END OF TABLE PPC PPC *EXIT PARAMETERS PPC ICOL - ENDING COLUMN OF SYMBOL PPC INDEX - INDEX OF SYMBOL PPC ICKSM - CHECKSUM OF SYMBOL PPC IERR - RETURN STATUS PPC 1 = VALID SYMBOL FOUND PPC 2 = SYMBOL NOT IN TABLE PPC 3 = SYMBOL ERROR PPC 4 = NOT USED PPC 5 = SYMBOL TABLE FULL PPC PPC PP NOTRY = 0 PPC FETCH LABEL PP CALL SYMBL PP IF(IERR-4) 100,920,100 PPC CHECK IF LABEL IS IN TABLE PP100 IF(INDET) 110,110,950 PP110 INDEX = 1 PPC CHECK FOR EMPTY SLOT IN TABLE PP130 IF(INDEX-NULAB) 140,140,910 PP140 DO 150 J=1,IWORD PP IF(ITAB(J,INDEX)-NAME(J)) 200,150,200 PP150 CONTINUE PP IF(INDET) 200,800,200 PPC TRY NEXT SLOT IN TABLE PP200 NOTRY = NOTRY+1 PP INDEX = INDEX+1 PP IF(NOTRY-(LTAB-MODCT)) 130,940,940 PPC VALID SYMBOL - GET PARAMETERS PP800 ITABI = ITABS(INDEX) PP IF(ITABI-256) 900,200,200 PPC SYMBOL FOUND, GET ITS VALUE PP900 IERR = 1 PP GO TO 990 PPC SYMBOL NOT IN TABLE PP910 IERR = 2 PP GO TO 990 PPC SYMBOL ERROR PP920 IERR = 3 PP GO TO 990 PPC SYMBOL TABLE FULL PP940 IERR = 5 PP GO TO 990 PPC SET END OF TABLE INDEX PP950 IERR = 2 PP INDEX = NULAB+1 PP990 RETURN PP END PP SUBROUTINE SYMBL PPC PPC PPC THIS SUBROUTINE IS USED TO FORM A SYMBOL AND ITS INDEX PPC INTO THE SYMBOL TABLE PPC PPC PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PPC PPC *ENTRY PARAMETERS PPC ICOL - STARTING COLUMN OF SCAN PPC ICKSM - CURRENT CHECKSUM OF RECORD PPC LCNT - SYMBOL SCAN FLAG PPC 0 = SCAN TO END OF SYMBOL PPC >0 = USE ONLY LCNT CHRACTERS PPC *EXIT PARAMETERS PPC ICOL - ENDING COLUMN OF SCAN PPC NAME - CONTAINS ENCODED SYMBOL PPC ICHAR - TERMINATOR CHARACTER (LCNT = 0) PPC ICKSM - UPDATED CHECKSUM PPC IERR - RETURN STATUS PPC 1 = SYMBOL ENDS WITH BLANK,TAB OR SEMICOLON PPC 2 = SYMBOL ENDS WITH A COMMA PPC 3 = SYMBOL ENDS WITH OTHER THAN 1 OR 2 PPC 4 = SYMBOL ERROR PPC PPC PP INDEX = 0 PP LABCT = 0 PP DO 10 J=1,IWORD PP NAME(J) = 0 PP10 CONTINUE PP IC1 = 1 PP IC2 = 1 PPC CHECK FOR VALID CHARACTER PP100 ICHAR = IN(ICOL) PP DO 110 J=1,39 PP IF(ICHAR-IALPH(J)) 110,300,110 PP110 CONTINUE PP J = 58 PP IF(ICHAR-IQUES) 120,300,120 PP120 J = 59 PP IF(ICHAR-ICAT) 130,300,130 PPC END OF SCAN IF FOUND INVALID CHARACTER PP130 IF(LABCT) 140,930,140 PP140 IF(IC2-ICCNT) 150,150,200 PP150 DO 160 J=IC2,ICCNT PP NAME(IC1) = NAME(IC1)*256 PP160 CONTINUE PPC CHECK FOR BLANK OR COMMA PP200 IF(LCNT) 210,210,400 PP210 IF(ICHAR-IBLNK) 220,900,220 PP220 IF(ICHAR-ICOMM) 920,910,920 PPC CHECK IF MORE CHARACTER THAN WILL FIT IN TABLE PP300 IF(LABCT-MLAB) 310,360,360 PP310 IF(LABCT) 320,320,330 PP320 IF(J-10) 930,930,330 PP330 INDEX = INDEX+J PP IF(IC2-ICCNT) 350,350,340 PP340 IC1 = IC1+1 PP IC2 = 1 PP350 IC2 = IC2+1 PPC FORM SYMBOL FOR PLACEMENT IN TABLE PP NAME(IC1) = NAME(IC1)*256+J PP360 LABCT = LABCT+1 PP ICHAR = IBLNK PP IF(ICOL-MCOL) 370,140,140 PP370 ICOL = ICOL+1 PP IF(LCNT) 380,100,380 PP380 IF(LABCT-LCNT) 100,390,390 PP390 IF(IC2-ICCNT) 395,395,900 PP395 DO 396 J=IC2,ICCNT PP NAME(IC1) = NAME(IC1)*256 PP396 CONTINUE PP GO TO 900 PPC CHECK FOR ANY ASTERISKS PP400 ICHAR = IN(ICOL) PP IF(ICHAR-IAST) 930,410,930 PP410 LABCT = LABCT+1 PP ICOL = ICOL+1 PP IF(LABCT-LCNT) 400,900,900 PPC SYMBOL ENDS WITH A BLANK OR SEMICOLON PP900 IERR = 1 PP GO TO 990 PPC SYMBOL ENDS WITH A COMMA PP910 IERR = 2 PP GO TO 990 PPC SYMBOL ENDS WITH OTHER THAN A BLANK, COMMA, OR SEMICOLON PP920 IERR = 3 PP GO TO 990 PPC SYMBOL ERROR PP930 IERR = 4 PP990 ICKSM = ICKSM+INDEX PP RETURN PP END PP SUBROUTINE SCAN PPC PPC PPC THIS ROUTINE FORM A VALUE FROM THE INPUT CODMMAND LINE. PPC THE VALUE MAY BE DECIMAL OR HEXADECIMAL. HEXADECIMAL PPC CONSTANTS END WITH A H. PPC PPC PP DIMENSION NUMS(16),INBUF(160) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (INBUF(1),IN(1)),(NUMS(1),IALPH(1)) PP DATA ICHRH /1HH/ PPC PPC *ENTRY PARAMETERS PPC ICOL - STARTING COLUMN OF SCAN PPC MVAL - VALUE TO ADD TO BUFFER POINTER PPC PPC *EXIT PARAMETERS PPC ICOL - ENDING COLUMN OF SCAN PPC IVAL - VALUE OF CONSTANT PPC IERR - RETURN STATUS PPC 0 = NO ERROR PPC 1 = ILLEGAL CHARACTER OR VALUE TOO LARGE PPC PPC PP IERR = 1 PP IVAL = 0. PP IFACT = 10 PP RFACT = 10. PP K = ICOL-1+MVAL PP100 K = K+1 PP IF(INBUF(K)-IBLNK) 105,120,105 PP105 IF(INBUF(K)-ICOMM) 110,120,110 PP110 IF(K-(MCOL+MVAL)) 100,100,120 PPC GET LAST CHARACTER AND CHECK IF HEX PP120 LL = K PP K = K-1 PP IF(INBUF(K)-ICHRH) 200,130,200 PP130 IFACT = 16 PP RFACT = 16. PP K = K-1 PPC FORM VALUE PP200 J = ICOL+MVAL PP IF(J-K) 210,210,900 PP210 DO 290 I=J,K PP DO 220 L=1,IFACT PP IF(INBUF(I)-NUMS(L)) 220,250,220 PP220 CONTINUE PP GO TO 900 PP250 IVAL1 = L-1 PP IVAL = IVAL*RFACT+IVAL1 PP290 CONTINUE PPC CHECK VALUE PP IF(IVAL-65536.) 300,900,900 PP300 IERR = 0 PPC PP900 ICOL = LL-MVAL PP RETURN PP END PP SUBROUTINE NAMES PPC PPC PPC THIS ROUTINE DECODES A SYMBOL IN THE SYMBOL PPC TABLE INTO A FORMAT SUITABLE FOR PRINTING PPC PPC PP DIMENSION LLAB(4,10) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (LLAB(1,1),IGBUF(1)) PP EQUIVALENCE (NAME1,NAME(1)) PPC PPC *ENTRY PARAMETERS PPC MODE - SYMBOL FILL FLAG PPC -1 = BLANK FILL NO VALUE FOR SYMBOL PPC 0 = BLANK FILL PPC 1 = ASTERISK FILL PPC INDET - INDEX TO STORE RESULT PPC INDEX - SYMBOL TABLE INDEX PPC ID - SYMBOL TYPE PPC -1 = ANY SYMBOL PPC 0 = PUBLIC SYMBOL PPC 1 = LOCAL SYMBOL PPC NULAB - NUMBER OF ENTRIES IN SYMBOL TABLE PPC PPC *EXIT PARAMETERS PPC LLAB - SYMBOL CHARACTERS PPC NCKSM - CHECKSUM OF SYMBOL PPC IADDR - VALUE OF SYMBOL PPC IERR - RETURN STATUS PPC 0 = SYMBOL FOUND PPC 1 = END OF TABLE PPC PPC PP IERR = 1 PP IF(ID) 200,100,100 PP100 IF(INDEX-NULAB) 110,110,900 PP110 IF(ITAB(1,INDEX)) 120,130,120 PP120 K = ITABS(INDEX)/256 PP IF(K-ID) 130,200,130 PP130 INDEX = INDEX+1 PP GO TO 100 PPC DECODE SYMBOL PP200 KCNT = 0 PP DO 280 K=1,IWORD PP NAME1 = ITAB(K,INDEX) PP IDD = MDIV PP DO 280 L=1,ICCNT PP KCNT = KCNT+1 PP NN = NAME1/IDD PP IF(NN) 210,210,240 PP210 IF(MODE) 220,220,230 PP220 ICHAR = IBLNK PP GO TO 270 PP230 ICHAR = IAST PP GO TO 270 PP240 NAME1 = NAME1-NN*IDD PP IDD = IDD/256 PP IF(NN-58) 260,250,250 PP250 NN = NN-17 PP260 ICHAR = IALPH(NN) PP270 LLAB(INDET,KCNT) = ICHAR PP IF(KCNT-MLAB) 280,300,300 PP280 CONTINUE PP300 IF(MODE) 900,310,310 PP310 IVAL = ITABV(INDEX) PP CALL AHEX PP IERR = 0 PP900 RETURN PP END PP SUBROUTINE COMIN PPC PPC PPC THIS ROUTINE CHECKS TO SEE IF A COMMAND IS LEGAL AND PPC RETURNS AN INDEX THAT SPECIFIES THE COMMAND NUMBER. PPC PPC PP INTEGER COMLS(7,17) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP DATA COMLS(1, 1),COMLS(2, 1),COMLS(3, 1),COMLS(4, 1),COMLS(5, 1), PP 1 COMLS(6, 1),COMLS(7, 1) /1HL,1HO,1HA,1HD,1H ,1H ,1H / PP DATA COMLS(1, 2),COMLS(2, 2),COMLS(3, 2),COMLS(4, 2),COMLS(5, 2), PP 1 COMLS(6, 2),COMLS(7, 2) /1HS,1HT,1HA,1HR,1HT,1H ,1H / PP DATA COMLS(1, 3),COMLS(2, 3),COMLS(3, 3),COMLS(4, 3),COMLS(5, 3), PP 1 COMLS(6, 3),COMLS(7, 3) /1HC,1HO,1HD,1HE,1H ,1H ,1H / PP DATA COMLS(1, 4),COMLS(2, 4),COMLS(3, 4),COMLS(4, 4),COMLS(5, 4), PP 1 COMLS(6, 4),COMLS(7, 4) /1HD,1HA,1HT,1HA,1H ,1H ,1H / PP DATA COMLS(1, 5),COMLS(2, 5),COMLS(3, 5),COMLS(4, 5),COMLS(5, 5), PP 1 COMLS(6, 5),COMLS(7, 5) /1HS,1HT,1HA,1HC,1HK,1H ,1H / PP DATA COMLS(1, 6),COMLS(2, 6),COMLS(3, 6),COMLS(4, 6),COMLS(5, 6), PP 1 COMLS(6, 6),COMLS(7, 6) /1HM,1HE,1HM,1HO,1HR,1HY,1H / PP DATA COMLS(1, 7),COMLS(2, 7),COMLS(3, 7),COMLS(4, 7),COMLS(5, 7), PP 1 COMLS(6, 7),COMLS(7, 7) /1HS,1HT,1HK,1HL,1HN,1H ,1H / PP DATA COMLS(1, 8),COMLS(2, 8),COMLS(3, 8),COMLS(4, 8),COMLS(5, 8), PP 1 COMLS(6, 8),COMLS(7, 8) /1HO,1HR,1HD,1HE,1HR,1H ,1H / PP DATA COMLS(1, 9),COMLS(2, 9),COMLS(3, 9),COMLS(4, 9),COMLS(5, 9), PP 1 COMLS(6, 9),COMLS(7, 9) /1HL,1HI,1HS,1HT,1H ,1H ,1H / PP DATA COMLS(1,10),COMLS(2,10),COMLS(3,10),COMLS(4,10),COMLS(5,10), PP 1 COMLS(6,10),COMLS(7,10) /1HN,1HL,1HI,1HS,1HT,1H ,1H / PP DATA COMLS(1,11),COMLS(2,11),COMLS(3,11),COMLS(4,11),COMLS(5,11), PP 1 COMLS(6,11),COMLS(7,11) /1HP,1HU,1HB,1HL,1HI,1HC,1H / PP DATA COMLS(1,12),COMLS(2,12),COMLS(3,12),COMLS(4,12),COMLS(5,12), PP 1 COMLS(6,12),COMLS(7,12) /1HN,1HA,1HM,1HE,1H ,1H ,1H / PP DATA COMLS(1,13),COMLS(2,13),COMLS(3,13),COMLS(4,13),COMLS(5,13), PP 1 COMLS(6,13),COMLS(7,13) /1HE,1HN,1HD,1H ,1H ,1H ,1H / PP DATA COMLS(1,14),COMLS(2,14),COMLS(3,14),COMLS(4,14),COMLS(5,14), PP 1 COMLS(6,14),COMLS(7,14) /1H*,1H ,1H ,1H ,1H ,1H ,1H / PP DATA COMLS(1,15),COMLS(2,15),COMLS(3,15),COMLS(4,15),COMLS(5,15), PP 1 COMLS(6,15),COMLS(7,15) /1HE,1HX,1HI,1HT,1H ,1H ,1H / PP DATA COMLS(1,16),COMLS(2,16),COMLS(3,16),COMLS(4,16),COMLS(5,16), PP 1 COMLS(6,16),COMLS(7,16) /1HC,1HP,1HA,1HG,1HE,1H ,1H / PP DATA COMLS(1,17),COMLS(2,17),COMLS(3,17),COMLS(4,17),COMLS(5,17), PP 1 COMLS(6,17),COMLS(7,17) /1HD,1HP,1HA,1HG,1HE,1H ,1H / PPC PPC *ENTRY PARAMETERS PPC IN - BUFFER THAT CONTAINS LINE PPC PPC *EXIT PARAMETERS PPC INDEX - COMMAND NUMBER PPC ICOL - START OF ARGUMENT PPC IERR - RETURN STATUS PPC 0 = NO ERROR PPC 1 = ILLEGAL COMMAND PPC 2 = NO COMMAND PARAMETERS PPC PPC PP IERR = 0 PP INDEX = 14 PP IF(IN(1) .EQ. IAST) GO TO 990 PPC CHECK FOR LEGAL COMMAND PP DO 300 I=1,17 PP DO 250 J=1,7 PP IF(COMLS(J,I)-IN(J)) 300,210,300 PP210 IF(IN(J)-IBLNK) 250,400,250 PP250 CONTINUE PP GO TO 400 PP300 CONTINUE PPC COMMAND NOT IN TABLE PP IERR = 1 PP GO TO 990 PPC SCAN TO ARGUMENT FIELD PP400 INDEX = I PP ICOL = J+1 PP410 IF(IN(ICOL)-IBLNK) 990,450,990 PP450 ICOL = ICOL+1 PP IF(ICOL-MCOL) 410,410,500 PP500 IERR = 2 PP990 RETURN PP END PP SUBROUTINE OUT PPC PPC PPC THIS SUBROUTINE OUTPUTS THE OBJECT MODULE PPC EACH CARD CONTAINS A RECORD LENGTH OF UP TO 30 BYTES PPC PPC PP DIMENSION IOBIN(72),LLAB(4,10) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (IOBIN(1),IPBUF(1)) PP EQUIVALENCE (NUMS1,IALPH(1)),(NUMS2,IALPH(2)) PP EQUIVALENCE (IPBU1,IPBUF(1)),(IPBU2,IPBUF(2)) PP EQUIVALENCE (LLAB(1,1),IGBUF(1)) PPC PPC *ENTRY PARAMETERS PPC NCBUF - OBJECT BYTES TO OUTPUT PPC LLEN - NUMBER OF OBJECT BYTES PPC LODSA - CONTENT RECORD STARTING ADDRESS PPC LODLC - LOAD POINT ADDRESS PPC LOBJ - OBJECT LIST FLAG PPC 0 = DONT PRODUCE OBJECT MODULE PPC 1 = OUTPUT OBJECT MODULE PPC IEND - END FLAG PPC PPC *EXIT PARAMETERS PPC LODLC - UPDATE LOAD POINT PPC OBJECT RECORD OUTPUT IF NECESSARY PPC PPC PP IF(LOBJ) 900,900,40 PP40 N = 1 PPC CHECK FOR GAP IN LOCATION COUNTER PP50 IF(LODSA-LODLC) 60,90,60 PP60 IF(LODLC) 70,80,80 PP70 LODLC = LODSA PP GO TO 220 PP80 LODLC = LODSA PP GO TO 200 PPC CHECK FOR END OF ASSEMBLY PP90 IF(IEND) 100,100,200 PPC SET BYTES OF OBJECT CODE INTO HEXADECIMAL OUTPUT RECORD PPC CHECK FOR MAXIMUM RECORD SIZE PP100 IF(IRLEN-16) 110,200,200 PP110 MVAL = NCBUF(N) PP NCKSM = NCKSM+MVAL PP IRLEN = IRLEN+1 PP CALL VHEX PP IOBIN(ICNT) = NH1 PP ICNT = ICNT+1 PP IOBIN(ICNT) = NH2 PP ICNT = ICNT+1 PP LODLC = LODLC+1. PP N = N+1 PP IF(N-LLEN) 100,100,900 PPC SET RECORD LENGTH AND OUTPUT NEW RECORD PP200 IF(IRLEN) 300,300,210 PP210 MVAL = IRLEN PP CALL VHEX PP NCKSM = NCKSM+IRLEN PP IOBIN(2) = NH1 PP IOBIN(3) = NH2 PPC SET CHECKSUM PP J = NCKSM/256 PP MVAL = 256-(NCKSM-J*256) PP CALL VHEX PP IOBIN(ICNT) = NH1 PP ICNT = ICNT+1 PP IOBIN(ICNT) = NH2 PP IPLEN = ICNT PP CALL INOUT(5) PP GO TO 300 PPC CHECK FOR OUTPUT OF SYMBOL TABLE PP220 ID = 0 PP IPLEN = 2 PP IPBU1 = IDOLR PP IPBU2 = IDOLR PP CALL INOUT(5) PP IF(NULAB) 290,290,222 PP222 IF(LPUBM) 228,280,228 PP228 INDEX = 1 PP MODE = 0 PP230 INDET = 1 PP235 CALL NAMES PP INDEX = INDEX+1 PP IF(IERR) 245,240,245 PP240 INDET = INDET+1 PP IF(INDET-4) 235,235,245 PP245 INDET = INDET-1 PP IF(INDET) 280,280,250 PPC OUTPUT NEXT LINE PP250 DO 255 I=1,72 PP IPBUF(I) = IBLNK PP255 CONTINUE PP LL = 1 PP DO 270 I=1,INDET PP DO 260 K=1,MLAB PP LL = LL+1 PP IPBUF(LL) = LLAB(I,K) PP260 CONTINUE PP LL = LL+2 PP IPBUF(LL) = IALPH(1) PP DO 265 K=1,4 PP LL = LL+1 PP IPBUF(LL) = IADDR(I,K) PP265 CONTINUE PP LL = LL+1 PP IPBUF(LL) = IALPH(18) PP LL = LL+2 PP270 CONTINUE PP IPLEN = LL PP CALL INOUT(5) PP IF(IERR) 230,230,280 PP280 IF(ID) 290,282,290 PP282 IF(LSYM) 284,290,284 PP284 ID = 1 PP GO TO 228 PP290 IPLEN = 2 PP IPBU1 = IDOLR PP IPBU2 = IDOLR PP CALL INOUT(5) PPC INITIALIZE FOR NEXT RECORD PP300 NCKSM = 0 PP IRLEN = 0 PP ICNT = 10 PP DO 350 J=1,72 PP IOBIN(J) = IBLNK PP350 CONTINUE PPC INITIALIZE COLON INDICATING START OF RECORD PP IOBIN(1) = ICOLN PPC CHECK FOR END CARD PP IF(IEND) 410,410,400 PPC SET ADDRESS INTO RECORD PP400 LODLC = MDADD PP410 MVAL = LODLC/256. PP NCKSM = NCKSM+MVAL PP CALL VHEX PP IOBIN(4) = NH1 PP IOBIN(5) = NH2 PP IVAL = MVAL PP MVAL = LODLC-IVAL*256. PP NCKSM = NCKSM+MVAL PP CALL VHEX PP IOBIN(6) = NH1 PP IOBIN(7) = NH2 PP IOBIN(8) = NUMS1 PP IOBIN(9) = NUMS1 PP IF(IEND) 100,100,700 PPC PUT OUT RECORD TO INDICATE END OF FILE PP700 IOBIN(2) = NUMS1 PP IOBIN(3) = NUMS1 PP IOBIN(9) = NUMS2 PP NCKSM = NCKSM+1 PP J = NCKSM/256 PP MVAL = 256-(NCKSM-J*256) PP CALL VHEX PP IOBIN(10) = NH1 PP IOBIN(11 )= NH2 PP IPLEN = 11 PP CALL INOUT(5) PP900 RETURN PP END PP SUBROUTINE HEXIN PPC PPC PPC THIS SUBROUTINE WILL READ THE NEXT 2 HEXADECIMAL PPC CHARACTERS FROM THE INPUT RECORD AND CONVERT TO DECIMAL. PPC PPC PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PPC PPC *ENTRY PARAMETERS PPC ICOL - STARTING CHARACTER COLUMN PPC IN - RECORD BUFFER PPC ICKSM - CURRENT CHECKSUM FOR RECORD PPC PPC *EXIT PARAMETERS PPC ICOL - POINTS AFTER SECOND CHARACTER PPC MVAL - VALUE PPC ICKSM - UPDATED CHECKSUM PPC IERR - RETURN STATUS PPC 0 = VALID CHARACTERS PPC 1 = NON HEXADECIMAL CHARACTER PPC PPC PP MVAL = 0 PP IERR = 1 PP DO 200 K=1,2 PP ICHAR = IN(ICOL) PP DO 100 I=1,16 PP IF(ICHAR-IALPH(I)) 100,110,100 PP100 CONTINUE PP GO TO 900 PP110 MVAL = MVAL*16+I-1 PP ICOL = ICOL+1 PP200 CONTINUE PP ICKSM = ICKSM+MVAL PP IERR = 0 PP900 RETURN PP END PP SUBROUTINE VHEX PPC PPC PPC THIS ROUTINE CONVERTS A VALUE BETWEEN 0 - 255 TO TWO PPC HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE ARE PPC CONVERTED TO ZEROS PPC PPC PP DIMENSION NUMS(16) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE(NUMS(1),IALPH(1)) PPC PPC *ENTRY PARAMETERS PPC MVAL - VALUE TO CONVERT PPC PPC *EXIT PARAMETERS PPC MVAL - SET TO ZERO IF VALUE OUT OF RANGE PPC NH1 - HIGH ORDER CHARACTER PPC NH2 - LOW ORDER CHARACTER PPC PPC PP IF(MVAL-256) 10,30,30 PP10 IF(MVAL) 30,100,100 PP30 MVAL = 0 PP100 NH1 = 1+MVAL/16 PP NH2 = MVAL-(NH1-1)*16+1 PP NH1 = NUMS(NH1) PP NH2 = NUMS(NH2) PP RETURN PP END PP SUBROUTINE AHEX PPC PPC PPC THIS SUBROUTINE CONVERTS A VALUE BETWEEN 0 -65535 INTO 4 PPC HEXADECIMAL CHARACTERS. VALUES OUTSIDE THIS RANGE ARE RETURNED PPC AS ASTERISKS PPC PPC PP REAL IHVAL,IVAL2,J1 PP DIMENSION NUMS(16) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (NUMS(1),IALPH(1)) PPC PPC *ENTRY PARAMETERS PPC IVAL - VALUE TO CONVERT PPC INDET - INDEX OF ARRAY TO STORAGE CHARACTERS PPC IADDR(INDET, ) - CONTAINS 4 CHARACTERS PPC PPC *EXIT PARAMETERS PPC CHARACTERS SET TO * IF OUT OF RANGE PPC PPC PP J1 = 4096. PP IF(IVAL) 20,5,5 PP5 IF(IVAL-65536.) 10,20,20 PP10 IHVAL = IVAL PP DO 15 J=1,4 PP M1 = IHVAL/J1 PP IVAL2 = M1 PP IHVAL = IHVAL-IVAL2*J1 PP J1 = J1/16. PP M1 = M1+1 PP IADDR(INDET,J) = NUMS(M1) PP15 CONTINUE PP RETURN PP20 DO 25 J=1,4 PP IADDR(INDET,J) = IAST PP25 CONTINUE PP RETURN PP END PP SUBROUTINE EQUAT PPC PPC PPC THIS ROUTINE EQUATES A LOGICAL DEVICE NUMBER TO A FILE NAME PPC SO THAT AN OBJECT MODULE MAY BE READ FROM A DISK FILE. PPC THIS ROUTINE MAY HAVE TO BE CHANGED FOR SOME COMPUTERS. PPC SEE THE OPERATION NOTES FOR DETAILS PPC PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PPC PPC *ENTRY PARAMETERS PPC INC - BUFFER THAT CONTAINS FILE NAME PPC JCOL - STARTING POINT OF NAME PPC PPC *EXIT PARAMETERS PPC NAMEF - CONTAINS ARRAY NAME IN PACKED HOLLERITH PPC JCOL - ENDING COLUMN OF FILE NAME PPC IPBUF - CONTAINS FILE NAME IN A1 FORMAT PPC IERR - RETURN STATUS PPC 0 = VALID FILE FOUND PPC 1 = FILE NOT FOUND PPC PPC PPC THE FOLLOWING CODE PACKS THE FILE NAME INTO AN ARRAY PPC IN A PACKED HOLLERITH FORMAT WHICH IS TYPICALLY NEEDED PPC WHEN EQUATING A FILE NAME. THE PACKED FILE NAME PPC IS IN ARRAY NAMEF AND CONSISTS OF 4 WORDS WITH BLANK PPC FILL. PPC PP NDIV = 2**(ISBIT-ICHBT) PP IERR = 0 PP K = 0 PP DO 500 I=1,4 PP DO 400 J=1,ICHWD PP IF(JCOL-MCOL) 120,120,110 PP110 JCOL = JCOL-1 PP GO TO 140 PPC GET NEXT CHARACTER PP120 ICHAR = INC(JCOL) PP IF(ICHAR-IBLNK) 130,140,130 PP130 IF(ICHAR-ICOMM) 150,140,150 PP140 ICHAR = IBLNK PP JCOL = JCOL-1 PP150 IF(J-1) 200,160,200 PP160 MVAL = 0 PP NFLG = 0 PPC CHECK IF NEGATIVE OR POSITIVE PP IF(ICHAR) 170,200,200 PP170 NFLG = 1 PP200 NSIGN = 0 PP K = K+1 PP IGBUF(K) = ICHAR PP ICHAR = ICHAR+1 PP IF(ICHAR) 210,220,220 PPC CHARACTER IS NEGATIVE PP210 NSIGN = 1 PP ICHAR = -ICHAR PP220 ICHAR = ICHAR/NDIV PP IF(NSIGN-NFLG) 230,300,230 PPC CHARACTERS DIFFERENT SIGN, COMPLEMENT PP230 ICHAR = NCCOM-ICHAR PP300 MVAL = ICHAR+MVAL*(2**ICHBT) PP JCOL = JCOL+1 PP400 CONTINUE PPC CHECK FOR ANY EXTRA BITS ON RIGHT (E.G. PDP 10) PP IF(IDIF) 420,420,410 PP410 MVAL = MVAL*(2**IDIF) PPC CHECK IF FINAL CHARACTERS NEGATIVE PP420 IF(NFLG) 450,450,430 PPC PPC FOR A ONE'S COMPLEMENT MACHINE, CHANGE STATEMENT 430 TO THE PPC FOLLOWING. PPC 430 MVAL = -MVAL PPC FOR 60 BIT CDC (CONTROL DATA) MACHINES, CHANGE STATEMENTS PPC 220 AND 300 TO THE FOLLOWING. PPC 220 ICHAR = SHIFT(ICHAR,-54) PPC 300 MVAL = ICHAR+SHIFT(MVAL,6) PPC PP430 MVAL = -MVAL-1 PP450 NAMEF(I) = MVAL PP500 CONTINUE PPC PPC ASSOCIATE A FILE NAME WITH A LOGICAL UNIT NUMBER. PPC THIS STATEMENT WILL PROBABLY HAVE TO BE CHANGED ON YOUR PPC COMPUTER. PPC SEE THE OPERATION NOTES FOR DETAILS. PPC PP IPARA = 0 PP ISTAT = 0 PPC CALL ASSIGN(IFIL,NAMEF) PPC CALL ATTPF(IFIL,NAMEF,IPARA,ISTAT) PP IRDR = IFIL PPC CHECK STATUS TO SEE IF FILE EXISTS PP IF(ISTAT) 600,900,600 PP600 IERR = 1 PP900 RETURN PP END PP SUBROUTINE ERROR PPC PPC THIS ROUTINE OUTPUTS ALL LOADER ERROR MESSAGES. PPC IF THIS IS THE FIRST ERROR FOR A GIVEN MODULE PPC THEN THE MODULE NAME IS ALSO PRINTED. PPC PPC PP DIMENSION LLAB(4,10),NRFLG(3) PP REAL ISLEN(4),ITABV(500),MDADD,LSADD,LEADD,LODSA,ISTKL PP REAL LCLEN(4),IVAL,IVAL1,LODLC,NBASE(4),NBEND(4) PP COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMFLE,IMREC,MREC,IPREC,IPLEN PP COMMON IFREC,IBIT,ISBIT,IWORD,ICCNT,ICHWD,ICHBT,MDIV,MCOL,MLAB PP COMMON NCCOM,IDIF,MXEXT,MODCT,IEND,IEOM,MESSN,MESSF PP COMMON LSTAB,LSYM,LPUR,LOBJ,LPUBT,LPUBM,INDET PP COMMON ITAB(4,500),ITABS(500),ITABV,LTAB,NAME(4) PP COMMON INDEX,NPAGE(4),NBASE,NBEND,MODE,MDADD,MDID,IRLEN,NH1,NH2 PP COMMON ISEGT,ISTKF,ID,MDNAM(10),IORDR(4),NMAIN,IBAT,MNAME(10) PP COMMON IERR,IERRI,ICKSM,NCKSM,IPASS,ICOL,ICOLE,JCOL,ICHAR,IVAL PP COMMON IVAL1,MVAL,LODSA,LODLC,LCNT,ISLEN,ISTYP(4),NHI,NLOW PP COMMON NBHI,NBLOW,LCLEN,IADDR(4,4),NAMEF(4),IN(80),INC(80) PP COMMON IRBUF(80),IPBUF(72),NCBUF(40),IEXTP(200),LSADD,LEADD PP COMMON NCCNT,LLEN,NRCNT,IACNT,IEXTN,IUNDF,IBUG PP COMMON IAST,ICOMM,ICAT,IQUES,ICOLN,IBLNK,IEQUL,IDOLR,IALPH(42) PP COMMON LFPAG(2),NULAB,NEXUN,ICNT,IGBUF(40),ISTKL PP EQUIVALENCE (LLAB(1,1),IGBUF(1)) PP DATA NRFLG(1),NRFLG(2),NRFLG(3) /1H ,1HC,1HD/ PPC PPC *ENTRY PARMATERS PPC MESSN - MESSAGE NUMBER PPC MESSF - MESSAGE FLAG, 0= NO PREVIOUS MESSAGE PPC PPC *EXIT PARAMETERS PPC MESSF - SET TO 1 PPC PPC PP IGO = MESSN PP IF(MESSN-1000) 30,30,20 PP20 IGO = MESSN-1000 PP GO TO 80 PP30 IF(MESSF) 80,40,80 PPC OUTPUT MODULE NAME PP40 MVAL = MNAME(10) PP WRITE(IPRT,41) (MNAME(I),I=1,MVAL) PP41 FORMAT(//,9H **MODULE,3X,10A1) PP MESSF = 1 PP80 GO TO(100,200,300,400,500,600,700,800,900,1000, PP 1 1100,1200,1300,1400,1500,1600,1700,1800,1900,2100,2100),IGO PPC PPC ILLEGAL HEXADECIMAL CHARACTER PP100 WRITE(IPRT,110) PP110 FORMAT(4X,17HINVALID HEX DIGIT) PP GO TO 9000 PPC INVALID CHECKSUM PP200 WRITE(IPRT,210) PP210 FORMAT(4X,16HINVALID CHECKSUM) PP GO TO 9000 PPC HEADER RECORD ERROR PP300 WRITE(IPRT,310) PP310 FORMAT(4X,19HHEADER RECORD ERROR) PP GO TO 9000 PPC RECORD TOO LARGE PP400 WRITE(IPRT,410) PP410 FORMAT(4X,16HRECORD TOO LARGE) PP GO TO 9000 PPC INVALID RECORD TYPE PP500 WRITE(IPRT,510) PP510 FORMAT(4X,19HINVALID RECORD TYPE) PP GO TO 9000 PPC INVALID SYMBOL PP600 WRITE(IPRT,610) PP610 FORMAT(4X,14HINVALID SYMBOL) PP GO TO 9000 PPC INVALID ID OR TYPE PP700 WRITE(IPRT,710) PP710 FORMAT(4X,18HINVALID ID OR TYPE) PP GO TO 9000 PPC ADDRESS OUT OF RANGE PP800 WRITE(IPRT,810) PP810 FORMAT(4X,20HADDRESS OUT OF RANGE) PP GO TO 9000 PPC EXTERNAL INDEX OUT OF RANGE PP900 WRITE(IPRT,910) PP910 FORMAT(4X,27HEXTERNAL INDEX OUT OF RANGE) PP GO TO 9000 PPC EXTERNAL TABLE FULL PP1000 WRITE(IPRT,1010) PP1010 FORMAT(4X,19HEXTERNAL TABLE FULL) PP GO TO 9000 PPC RECORD OUT OF SEQUENCE PP1100 WRITE(IPRT,1110) PP1110 FORMAT(4X,22HRECORD OUT OF SEQUENCE) PP GO TO 9000 PPC SYMBOL TABLE FULL PP1200 WRITE(IPRT,1210) PP1210 FORMAT(4X,17HSYMBOL TABLE FULL) PP GO TO 9100 PPC UNDEFINED EXTERNAL PP1300 IF(IUNDF) 1350,1310,1350 PP1310 WRITE(IPRT,1320) PP1320 FORMAT(4X,19HUNDEFINED EXTERNALS) PP1350 INDET = 1 PP CALL AHEX PP K = ISEGT+1 PP WRITE(IPRT,1360) (IADDR(1,I),I=1,4),NRFLG(K), PP 1 (LLAB(1,I),I=1,MLAB) PP1360 FORMAT(4X,4A1,1X,A1,3H - ,10A1) PP GO TO 9100 PPC DUPLICATE PUBLIC NAME PP1400 K = ICOLE+LCNT-1 PP WRITE(IPRT,1410) (IN(I),I=ICOLE,K) PP1410 FORMAT(4X,24HDUPLICATE PUBLIC NAME = ,10A1) PP GO TO 9100 PPC MODULE GREATER THAN 64K) PP1500 WRITE(IPRT,1510) PP1510 FORMAT(4X,23HMODULE GREATER THAN 64K) PP GO TO 9000 PPC INVALID OPERAND OR VALUE PP1600 WRITE(IPRT,1610) PP1610 FORMAT(4X,15HINVALID OPERAND) PP GO TO 9100 PPC INVALID COMMAND PP1700 WRITE(IPRT,1710) PP1710 FORMAT(4X,15HINVALID COMMAND) PP GO TO 9100 PPC COMMAND NOT ALLOWED PP1800 WRITE(IPRT,1810) PP1810 FORMAT(4X,19HCOMMAND NOT ALLOWED) PP GO TO 9100 PPC FILE NOT FOUND PP1900 WRITE(IPRT,1910) (IGBUF(I),I=1,15) PP1910 FORMAT(4X,17HFILE NOT FOUND - ,15A1) PP GO TO 9100 PPC UNEXPECTED END OF MODULE PP2100 WRITE(IPRT,2110) PP2110 FORMAT(4X,24HUNEXPECTED END OF MODULE) PP GO TO 9100 PPC PPC PP9000 IF(MESSN-1000) 9010,9010,9100 PP9010 WRITE(IPRT,9021) MREC,(IN(J),J=1,72) PP9021 FORMAT(4X,6HRECORD,I5,3H - ,72A1) PP9100 RETURN PP END PP**LOADER COMMANDS PP* PP* TEST PROGRAM FOR Z80 LINKING LOADER VER 3.0 PP* PP* NOTE THE OBJECT MODULES ARE READ FROM THE SAME PP* DEVICE AS THE COMMAND STREAM. TO READ THE OBJECT PP* MODULES FROM A DIFFERENT DEVICE, THE LOAD COMMANDS MUST BE PP* CHANGED TO THE NEW FILE NAME. AND THE OBJECT MODULES PLACED PP* IN THESE FILES. PP* PPLIST T,S,X PPDATA 407H PPCODE 605H PPORDER C,S,D,M PPSTACK A00H PPSTKLN 12 PP* LOAD FIRST TWO OBJECT MODULES PPLOAD 5,5 PP022E0006MAIN**0000013A0003025100030300000304000003DC PP18160006READ**0006SCAN**0035 PP162E0001170006TIN***002F0006CRLF**00240006TOUT**0033 PP162E0002500006ECHO**00000006INBUF*00500006IBUFEN00E6 PP061400010000310000CD0000E7 PP240A0003030100CB PP200C000300000400CD PP0640000106002100007EFE2023C20900CD000023C30000DB00E602CA1700DB00E67F71 PP221000030E0015001C008C PP240A0002030700C6 PP200C000301001100BF PP06380001220047C9DB00E601CA240078D300C9060DCD2400060ACD2400C9FD PP2210000329003200370039 PP040A0001010000F0 PP0E0200F0 PP022E0006READ**0000015400030200000303000003040000031C PP183E0006CRLF**0006TIN***0006TOUT**0006ECHO**0006INBUF*0006IBUFEN0058 PP16120001000006READ**008D PP123C0000080006TAB***00080006BSPA**00200006BLNK**000D0006ASCR**003A PP123C0001050006READ1000130006READ2000200006READ30002A0006READ400015 PP123C0001340006READ50003E0006READ6000410006READ7000470006READ80006D PP12120001000006READ**0091 PP063C000100002100001E00CD0000FE18C21300CD0000C30000FE0DC220007BB717 PP221000030B001100160099 PP201C0003040001000100060000000E00A7 PP064000011A00CA0500360DC9FE7FC234007BB7CA05002B1D0608CD0000C34100FE0823 PP221400031B002300280032002F PP200C000302002F00A0 PP062A00013600CA3E00FE20DA410077241C7BFE00CA2A0034 PP2210000337003C00450013 PP200C0001050043008B PP0622000147003A0000B7CA0500CD0000C305003B PP220C00034C00520031 PP201400030300480002004F002D PP040A0000010000F1 PP0E0200F0 PP* LOAD LAST OBJECT MODULE PPLOAD 5 PP022E0006MODULE000001110003020F0002030000030400000313 PP061800000800E5C52A0B00C3000137 PP240A0002030B00C2 PP062A00010000002100003A0B00B7C20D00002F210E00760F PP220800030900CA PP240E00020305000E00B6 PP061A00020000C30D00010B00800D0075 PP220800030400CF PP240E00010301000700C2 PP0614000209000B0005060D00B8 PP220800010900CC PP240A0001010D00C3 PP040A0000010000F1 PP0E0200F0 PPEND PP PP PP PPC PPC PPC INTEL TO TEKTRONIX HEX OBJECT CONVERSION PROGRAM PPC PPC WRITTEN BY PPC MICROTEC PPC P.O. BOX 60337 PPC SUNNYVALE, CA. 94088 PPC PPC PPC THIS PROGRAM IS DESIGNED TO READ IN A RECORD OF OBJECT PPC CODE IN INTEL HEX FORMAT AND CONVERT IT TO THE PPC EQUIVALENT OBJECT RECORD IN TEKTRONIX FORMAT. PPC THE DEVICES USED TO INPUT AND OUTPUT ARE SPECIFIED BELOW. PPC PPC PPC PP DIMENSION IN(80),IOUT(80),NUMS(16),NNUM(70) PP DATA ICOLN,ISLAS /1H:,1H// PP DATA NUMS( 1),NUMS( 2),NUMS( 3),NUMS( 4) /1H0,1H1,1H2,1H3/ PP DATA NUMS( 5),NUMS( 6),NUMS( 7),NUMS( 8) /1H4,1H5,1H6,1H7/ PP DATA NUMS( 9),NUMS(10),NUMS(11),NUMS(12) /1H8,1H9,1HA,1HB/ PP DATA NUMS(13),NUMS(14),NUMS(15),NUMS(16) /1HC,1HD,1HE,1HF/ PPC PPC SET I/O DEVICES PPC OUTPUT LISTING PP IPRT = 6 PPC OBJECT INPUT PP IRDR = 4 PPC OBJECT OUTPUT PP IPCH = 7 PPC PP NREC = 0 PPC READ NEXT INTEL OBJECT RECORD PP100 NREC = NREC+1 PP READ(IRDR,1000) IN PP1000 FORMAT(80A1) PP IF(IN(1) .NE. ICOLN) GO TO 100 PP ICOL = 2 PP NSUM = 0 PP KK = 0 PPC GET BYTES PP120 MVAL = 0 PP DO 140 L=1,2 PP DO 130 K=1,16 PP IF(IN(ICOL) .EQ. NUMS(K)) GO TO 135 PP130 CONTINUE PP GO TO 910 PP135 MVAL = MVAL*16+K-1 PP ICOL = ICOL+1 PP140 CONTINUE PPC CHECK IF DATA COUNT PP IF(KK .NE. 0) GO TO 150 PP NUM = MVAL+MVAL+8 PP150 KK = KK+1 PP NNUM(KK) = MVAL/16 PP KK = KK+1 PP NNUM(KK) = MVAL-NNUM(KK-1)*16 PP NSUM = NSUM+MVAL PPC CHECK IF ALL DATA READ PP IF(KK .LE. NUM) GO TO 120 PPC CHECK IF VALID CHECKSUM PP NSUM = NSUM-(NSUM/256)*256 PP IF(NSUM .NE. 0) GO TO 920 PPC PPC OUTPUT RECORD IN TEKTRONIX FORMAT PPC PP IOUT(1) = ISLAS PP MVAL = 0 PPC GET ADDRESS PP200 DO 210 I=2,5 PP K = I+2 PP IOUT(I) = IN(K) PP MVAL = MVAL+NNUM(K-1) PP210 CONTINUE PP IOUT(6) = IN(2) PP IOUT(7) = IN(3) PP MVAL = MVAL+NNUM(1)+NNUM(2) PPC FORM FIRST CHECKSUM PP MVAL = MVAL-(MVAL/256)*256 PP I1 = 1+MVAL/16 PP I2 = 1+MVAL-(I1-1)*16 PP IOUT(8) = NUMS(I1) PP IOUT(9) = NUMS(I2) PPC GET DATA BYTES PP MVAL = 0 PP LEN = 9 PP IF(NUM .EQ. 8) GO TO 300 PP NUM = NUM+1 PP DO 240 I=10,NUM PP IOUT(I) = IN(I) PP MVAL = MVAL+NNUM(I-1) PP240 CONTINUE PPC FORM SECOND CHECKSUM PP MVAL = MVAL-(MVAL/256)*256 PP I1 = 1+MVAL/16 PP I2 = 1+MVAL-(I1-1)*16 PP IOUT(NUM+1) = NUMS(I1) PP IOUT(NUM+2) = NUMS(I2) PP LEN = NUM+2 PP300 WRITE(IPCH,1000) (IOUT(I),I=1,LEN) PP IF(NUM .GT. 8) GO TO 100 PP GO TO 990 PPC PPC MESSAGES PPC PP910 WRITE(IPRT,911) PP911 FORMAT(19H *INVALID CHARACTER) PP GO TO 950 PPC CHECKSUM ERROR PP920 WRITE(IPRT,921) PP921 FORMAT(16H *CHECKSUM ERROR) PP GO TO 950 PPC END OF FILE PP930 WRITE(IPRT,931) PP931 FORMAT(13H *END OF FILE) PP GO TO 990 PP950 WRITE(IPRT,951) NREC,IN PP951 FORMAT(8H RECORD ,I4,3H = ,80A1) PP990 STOP PP END PPC PPC PPC PPC PPC TEKTRONIX OBJECT MODULE DOWNLOADING PROGRAM PPC MICROTEC PPC P.O. BOX 60337 PPC SUNNYVALE, CA. 94088 PPC PPC PPC PPC THIS PROGRAM IS USED TO TRANSMIT A TEKTRONIX OBJECT PPC MODULE FILE TO A TEKTRONIX 8001 OR 8002 MICROPROCESSOR PPC LAB. THIS PROGRAM USES THE PROTOCOL SPECIFIED FOR THE PPC 8001/8002. PPC PPC THIS PROGRAM OFTEN IS USED TO TRANSMIT FILES TO THE PPC MILLENNIUM STAND-ALONE ICE UNIT. PPC PPC THE PROGRAM CAN TRANSMIT RECORDS IN EITHER THE TEK1 OR PPC TEK2 FORMATS. TEK1 RECORDS ARE INTRODUCED BY FORWARD OR BACK- PPC SLASHES, WHILE TEK2 RECORDS ARE INTRODUCED BY PERCENT SIGNS PPC PPC THE PROGRAM OPERATES IN THE FOLLOWING MANNER. PPC PPC 1. OBJECT RECORD IS READ FROM FILE (UNIT IOBJ) PPC 2. IF EOF IS DETECTED, GENERATE TERMINATION RECORD PPC 3. RECORD IS TRANSMITTED TO 8001/8002 (UNIT ISEND) PPC 4. ACKNOWLEDGEMENT IS READ FROM 8001/8002 (UNIT IREC) PPC 5. IF POSITIVE ACKNOWLEDGEMENT IS RECEIVED, DO THE FOLLOWING PPC A. IF TERMINATOR BLOCK WAS JUST TRANSMITTED, EXIT PROGRAM PPC B. OTHERWISE GO BACK TO STEP 1 PPC 6. IF NEGATIVE ACKNOWLEDGEMENT GO TO STEP 3. AFTER 5 PPC NEGATIVE ACKNOWLEDGEMENTS, GO TO STEP 7 PPC 7. SEND ABORT MESSAGE TO 8001/8002 AND EXIT PROGRAM PPC PPC PPC THE VARIABLES USED IN THE PROGRAM ARE AS FOLLOWS PPC PPC IACK - POSITIVE ACKNOWLEDGEMENT CHARACTER - A 0 PPC IBLNK - BLANK PPC ICNT - OBJECT MODULE RECORD COUNT PPC IOBJ - LOGICAL DEVICE NUMBER OF OBJECT MODULE PPC IPRT - LOGICAL DEVICE NUMBER FOR LIST FILE (TYPICALLY PRINTER) PPC IREC - LOGICAL DEVICE NUMBER TO RECEIVE FROM 8001/8002 PPC ISEND - LOGICAL DEVICE NUMBER TO SEND TO 8001/8002 PPC ISLA - DIVIDE SIGN PPC IBKSL - BACK-SLASH (EXTENSION RECORD FOR 8086) PPC IPERC - PERCENT SIGN, INTRODUCES TEK2 FORMATTED RECORDS PPC IZERO - CHARACTER 0 PPC MESS - BUFFER FOR OBJECT MODULE RECORD PPC NAKCT - NEGATIVE ACKNOWLEDGEMENT COUNTER PPC NNAKS - NUMBER OF NEGATIVE ACKNOWLEDGEMENTS BEFORE ABORT PPC PP DIMENSION MESS(80) PP DATA IZERO,IACK,IBLNK,ISLA,IBKSL /1H0,1H0,1H ,1H/,1H\/ PP DATA IPERC /1H%/ PPC PPC INITIALIZE VARIABLES PPC PP IPRT = 4 PP IREC = 5 PP ISEND = 6 PP IOBJ = 7 PP NNAKS = 5 PP ICNT = 0 PPC PPC INITIALIZE ACKNOWLEDGEMENT COUNT PP100 NAKCT = 0 PPC READ NEXT OBJECT MODULE RECORD PP READ(IOBJ,1001) MESS PP1001 FORMAT(80A1) PPC THE FOLLOWING STATEMENT IS TYPICALLY USED TO DETECT THE EOF PPC READ(IOBJ,1001,END=105) MESS PP ICNT = ICNT+1 PP GO TO 120 PPC GET HERE FOR END OF FILE, GENERATE TERMINATOR RECORD PP105 MESS(1) = ISLA PP DO 110 L=2,9 PP MESS(L) = IZERO PP110 CONTINUE PPC CHECK IF VALID RECORD PP120 IF(MESS(1) .EQ. ISLA) GO TO 125 PP IF(MESS(1) .EQ. IPERC) GO TO 125 PP IF(MESS(1) .NE. IBKSL) GO TO 100 PP125 DO 130 L=1,80 PP NUM = 81-L PP IF(MESS(NUM) .NE. IBLNK) GO TO 140 PP130 CONTINUE PP GO TO 100 PPC OUTPUT RECORD TO MICROPROCESSOR LAB PP140 WRITE(ISEND,1001) (MESS(L),L=1,NUM) PPC READ ACKNOWLEDGEMENT PP READ(IREC,1001) IREP PP IF(IREP .NE. IACK) GO TO 200 PPC VALID REPLAY, CHECK IF LAST RECORD WAS TERMINATOR PP IF(MESS(6) .NE. IZERO) GO TO 100 PP IF(MESS(7) .NE. IZERO) GO TO 100 PPC END OF TRANSMISSION, EXIT PROGRAM PP WRITE(IPRT,1002) PP1002 FORMAT(17H PROGRAM COMPLETE) PP GO TO 300 PPC HAVE NEGATIVE ACKNOWLEDGEMENT, CHECK COUNT AND TRY AGAIN PP200 NAKCT = NAKCT+1 PP IF(NAKCT .LT. NNAKS) GO TO 140 PPC TOO MANY TRIES, ABORT PROGRAM PP WRITE(ISEND,1003) PP1003 FORMAT(18H//DOWNLOAD ABORTED) PP WRITE(IPRT,1004) ICNT PP1004 FORMAT(36H PROGRAM TERMINATED, OBJECT RECORD =,I5) PP300 STOP PP END P