(*$L-*) (************************************************************************ * * * * * PCODE_ASSEMBLER * * --------------- * * * * * * COPYRIGHT 1978, STANFORD LINEAR ACCELERATOR CENTER. * * * * * * THIS PROGRAM ASSEMBLES THE OUTPUT OF THE SLAC 'PASCAL' COMPILER * * AS GENERATED BY 'WYL.CG.PAS.PASZMOD', INTO THE SO CALLED I_CODE, * * A COMPACT INTERPRETIVE CODE DESIGNED FOR A MICRO PROCESSOR * * ENVIRONMENT. * * * * THE ASSEMBLER READS IN THE 'PRR' OUTPUT OF THE PASCAL COMPILER * * (AS 'INPUT' , THE MAIN INPUT FILE) AND THE CALL FREQUENCY TABLE * * FILE 'QRR' (AS ITS 'PRD' INPUT FILE) AND SENDS ITS MAIN * * OUTPUT , AN "INTEL" LOAD FORMAT OBJECT, TO 'PRR' OUTPUT FILE. * * OTHER MESSAGES AND RELATED STATISTICS APPEAR ON THE 'OUTPUT' * * FILE, * * * * IN ADDITION, THE ASSEMBLER SWITCH 'TRACE' CAUSES EACH * * INSTRUCTION TO BE PRINTED ON THE OUTPUT FILE, AS IT IS BEING * * PROCESSED AND THE 'DUMP' SWITCH WILL GENERATE A DECIMAL (AS * * OPPOSED TO HEXADECIMAL) VERSION OF THE OBJECT CODE. THE * * P_INSTRUCTIONS 'TON' AND 'TOF' MAY BE USED TO SELECTIVELY * * SET/RESET THE 'TRACE' SWITCH, IF ONE WANTS TO EXAMINE THE * * TRANSLATION OF A PART OF THE PROGRAM WITHOUT GENERATING A LARGE * * NUMBER OF OUTPUT RECORDS. * * * * THOUGH THE OBJECT CODE IS ENTIRELY RELOCATABLE, THE ASSEMBLER * * CONSTANT 'CODE_ORG' DETERMINES THE LOADING ADDRESS FOR THE CODE, * * AND THE "PROEDURE ADDRESS TABLE" IMMEDIATELY FOLLOWS THE THE * * OBJECT CODE. * * A SMALL TABLE WITH FOUR ENTRIES IS APPENDED TO THE END OF THE * * "OBJECT" FILE. THE ENTRIES OF THIS TABLE POINT TO THE ENTRY POINT * * OF THE "MAINBLK", THE BEGINING OF THE PROCEDURE ADDRESS TABLE, * * THE END OF THE PROCEDURE ADDRESS TABLE AND THE END OF THE "STAK" * * (OR THE BEGINING OF THE HEAP) OF THE SIMULATED MACHINE. * * * * * * THE ERROR MESSAGES OF THE THIS PROGRAM MAY BE INTERPRETED * * ACCORDING TO THE FOLLOWING TABLE. * * * * * * ERROR(101 --> 'LOD' REAL OPERAND. * * ERROR(102 --> 'LOD' OFFSET TOO LARGE. * * ERROR(104 --> 'STR' OFFSET TOO LARGE. * * ERROR(105 --> STRING TOO LONG. * * ERROR(106 --> 'LDA' OFFSET TOO LARGE. * * ERROR(107 --> 'IND R' REAL OPERAND. * * ERROR(108 --> 'STR R' REAL OPERAND. * * ERROR(110 --> 'IND ' OFFSET TOO LARGE. * * ERROR(112 --> UNDEFINED PROC. * * ERROR(113 --> UNDEFINIED CSP. * * ERROR(114 --> 'MOV' OPERAND TOO LARGE. * * ERROR(118 --> LABEL TOO LARGE , IN UPDATELBL. * * ERROR(119 --> DUPLICATE LABEL DEF. * * ERROR(122 --> MULTIPLE DEFS. * * ERROR(123 --> SET TYPE PROCEDURE. * * ERROR(124 --> REAL TYPE PROCEDURE. * * ERROR(125 --> INCORRECT VARIABLE ALIGNMENT (ODD DISPLACEMENT). * * ERROR(127 --> PROCEDURE NEST LEVEL TOO DEEP. * * ERROR(128 --> BAD CODE 'BYTE' DETECTED WHILE OUTPUTING OBJECT. * * ERROR(130 --> COMPARE REAL OPERANDS. * * ERROR(135 --> NEGATIVE CONST. * * ERROR(140 --> 'LDC R' REAL OPERAND. * * ERROR(141 --> 'CHK' INSTR. * * ERROR(144 --> '''' IN STRING. * * ERROR(146 --> 'NEW' OPERAND TOO LARGE. * * ERROR(152 --> INSTRUCTION NOT YET IMPLEMENTED. * * ERROR(154 --> REAL ARITHMETIC INSTRUCTIONS. * * ERROR(160 --> UNDEFINED/ILLEGAL OPCODE. * * * * * * * * * * * * * * SASSAN HAZEGHI * * * * COMPUTATION RESEARCH GROUP * * STANFORD LINEAR ACCELERATOR CENTER * * STANFORD, CA. 94305. * * * * * * * * UPDATED : 15-JAN-78 * * 3-FEB-78 * * 12-MAY-78 * * * * * ************************************************************************) PROGRAM PCODE_ASSEMBLER; (*----------------------------------------------------------------------------*) CONST CODE_ORG = 3584 ; (* LOADING ADR. FOR CODE / AS IN INTERPRETER *) FIX_AREA = 8 ; (* SIZE OF THE TABLE PRECEDDING CODE *) STK_LEN = 4096 ; (* ESTIMATED SIZE OF RUNTIME STACK *) HEAP_END = 31232 ; (* END OF HEAP RELATIVE TO PCODE_ORG *) LNKAREA = 8 ; (* SIZE OF PROC. LINKAGE AREA *) ICMAX = 4000; (* PROCEDURE SIZE LIMIT *) LARGEINT = 32767 ; (* = 2**15 -1 *) MAXINT = 32768 ; (* = 2**15 -1 *) MAXADR = MAXINT ; MAXSLEN = 20 ; MAXPROC = 99 ; MINPROC = 0 ; MINLBL = 0 ; MAXLBL = 220 ; SPCNT = 30 ; (* COUNT OF STANDARD PROCS *) PTRSIZE = 2 ; (* HAS TO BE UPDATED FOR DIFFERENT DATA SIZES*) FUNCRSLT = 0 ; (* LOCATION (OFF MP) OF THE FUNC RESULT *) GLOBAL = 0 ; (* GLOBAL LEVEL*) BLNK3 = ' ' ; BLNK8 = ' ' ; ABS = 32 ; (* CURRENT VALUE OF THE ASCII BIASS *) (* P-CODE INSTRUCTION MNEMONICS *) " PABI = 0 ; PABR = 1 ; PADI = 2 ; PADR = 3 ; PAND = 4 ; PCHK = 5 ; PCHR = 6 ; PCSP = 7 ; PCUP = 8 ; PDEC = 9 ; PDEF = 10 ; PDIF = 11 ; PDVI = 12 ; PDVR = 13 ; PENT = 14 ; PEOF = 15 ; PEQU = 16 ; PFJP = 17 ; PFLO = 18 ; PFLT = 19 ; PGEQ = 20 ; PGRT = 21 ; PINC = 22 ; PIND = 23 ; PINN = 24 ; PINT = 25 ; PIOR = 26 ; PIXA = 27 ; PLAO = 28 ; PLCA = 29 ; PLDA = 30 ; PLDC = 31 ; PLDO = 32 ; PLEQ = 33 ; PLES = 34 ; PLOC = 35 ; PLOD = 36 ; PMOD = 37 ; PMOV = 38 ; PMPI = 39 ; PMPR = 40 ; PMST = 41 ; PNEQ = 42 ; PNEW = 43 ; PNGI = 44 ; PNGR = 45 ; PNOT = 46 ; PODD = 47 ; PORD = 48 ; PPRE = 49 ; PRET = 50 ; PRST = 51 ; PSAV = 52 ; PSBI = 53 ; PSBR = 54 ; PSGS = 55 ; PSQI = 56 ; PSQR = 57 ; PSRO = 58 ; PSTO = 59 ; PLSA = 60 ; PSTR = 61 ; PUJP = 62 ; PXJP = 63 ; PTON = 64 ; PTRC = 65 ; PSUC = 66 ; PUNI = 67 ; PTOF = 68 ; PLCI = 69 ; PSTP = 70 ; PBGN = 71 ; PNOP = 72 ; " QGET = 1 ; QPUT = 2 ; QRES = 3 ; QREW = 4 ; QRDC = 5 ; QWRI = 6 ; QWRO = 7 ; QWRR = 8 ; QWRC = 9 ; QWRS = 10 ; QPAK = 11 ; QRDB = 12 ; QWRB = 13 ; QRDR = 14 ; QSIN = 15 ; QCOS = 16 ; QEXP = 17 ; QSQT = 18 ; QLOG = 19 ; QATN = 20 ; QCLK = 21 ; QWLN = 22 ; QRLN = 23 ; QRDI = 24 ; QEOF = 25 ; QELN = 26 ; QRDS = 27 ; QTRP = 28 ; QXIT = 29 ; QEIO = 30 ; QNOP = 24 ; PABI = 0 ; PABR = 1 ; PADI = 2 ; PADR = 3 ; PAND = 4 ; PDIF = 5 ; PDVI = 6 ; PDVR = 7 ; PSBR = 8 ; PFLO = 9 ; PFLT = 10 ; PINN = 11 ; PINT = 12 ; PIOR = 13 ; PMOD = 14 ; PMPI = 15 ; PMPR = 16 ; PNGI = 17 ; PNGR = 18 ; PNOT = 19 ; PODD = 20 ; PSBI = 21 ; PDEC = 22 ; PINC = 23 ; PSQI = 24 ; PSQR = 25 ; PSTO = 26 ; PTRC = 27 ; PUNI = 28 ; PSGS = 29 ; PCSP = 30 ; PLOC = 31 ; PENT = 32 ; PFJP = 33 ; PUJP = 34 ; PIND = 35 ; PIXA = 36 ; PLSA = 37 ; PLCA = 38 ; PTON = 39 ; PMOV = 40 ; PMST = 41 ; PRET = 42 ; PSTP = 43 ; PXJP = 44 ; PCHK = 45 ; PCUP = 46 ; PEQU = 47 ; PGEQ = 48 ; PGRT = 49 ; PLDA = 50 ; PLDC = 51 ; PLEQ = 52 ; PLES = 53 ; PLOD = 54 ; PNEQ = 55 ; PSTR = 56 ; PTOF = 57 ; PNEW = 58 ; PSAV = 59 ; PRST = 60 ; PORD = 61 ; PCHR = 62 ; PDEF = 63 ; PNOP = 64 ; (* Z- OPCODES MNEMONICS *) ZLDC1 = 0 ; ZLDC2 = 32 ; ZLDC = 33 ; ZLDC8 = 34 ; ZLODG2 = 35 ; ZLOD = 36 ; ZLOD8 = 37 ; ZREAL = 38 ; ZSTP = 39 ; ZCUP = 40 ; ZCSP = 41 ; ZIND = 42 ; ZINDS = 43 ; ZLDALG = 44 ; " ZLDAL = 45 ; " ZIXA = 46 ; ZSPWRP = 47 ; ZSTRLG = 48 ; ZSTR = 49 ; ZSTRS = 50 ; ZMVP = 51 ; ZADIC = 52 ; ZLDA = 53 ; ZLCA = 54 ; ZXJP = 55 ; ZCMPM = 56 ; ZEQU = 57 ; ZNEQ = 58 ; ZLEQ = 59 ; ZLES = 60 ; ZGEQ = 61 ; ZGRT = 62 ; ZCMPRS = 63 ; (* UNUSED OPCODE, TRANSLATES TO ZCMPM *) ZMSTF8 = 64 ; ZMOV = 65 ; ZMST = 66 ; ZRET = 67 ; ZSTO = 68 ; ZSTOS = 69 ; ZRETF8 = 70 ; ZORD = 71 ; ZCHR = 72 ; ZADI = 73 ; ZSBI = 74 ; ZDVI = 75 ; ZMOD = 76 ; ZMPI = 77 ; ZNGI = 78 ; ZRST = 79 ; " ZSAV = 80 ; " ZDEC1 = 80 ; ZODD = 81 ; "ZFLT = 82 ;" "ZFLO = 83 ;" ZABI = 84 ; ZSGS = 85 ; ZINN = 86 ; ZUNI = 87 ; ZINT = 88 ; ZDIF = 89 ; ZNEW = 90 ; ZAND = 91 ; ZIOR = 92 ; ZNOT = 93 ; ZMSTF = 94 ; ZRETF = 95 ; ZCUP1 = 96 ; ZCSP1 = 112 ; ZFJP = 128 ; ZUJP = 144 ; ZIND1 = 160 ; ZIXA1 = 176 ; ZLODG = 192 ; ZABR = 0 ; ZNGR = 1 ; ZFLT = 2 ; ZFLO = 3 ; ZTRC = 4 ; ZRND = 5 ; ZADR = 225 ; ZSBR = 226 ; ZMPR = 227 ; ZDVR = 228 ; ZLODL = 224 ; ZENT = 254 ; (* NON EXISTING OPCODE *) OPCNT = 64 ; (* COUNT OF P_INSTRUCTIONS *) ZOPCNT=255 ; UNDEF = 0 ; INT = 1 ; REEL = 2 ; BOOL = 3 ; SETT = 4 ; ADR = 5 ; MARK = 6 ; INDEX= 7 ; (*----------------------------------------------------------------------------*) TYPE BYTE = 0..255 ; DATATYPE = UNDEF..INDEX; LBLRNG = MINLBL..MAXLBL ; ICRNG = 0..ICMAX ; ADRRNG = 0..MAXADR ; ALFA = PACKED ARRAY [1..8] OF CHAR ; SHRTALFA = PACKED ARRAY [1..3] OF CHAR ; BETA = PACKED ARRAY[1..20] OF CHAR; (*ERROR MESSAGE*) COUNTER = 0..MAXINT ; LABELST = (ENTERED,DEFINED); (* LABEL SITUATION *) PROCRNG = 0..MAXPROC ; LABELREC = RECORD VAL: 0..MAXADR ; ST: LABELST END ; TEXT = FILE OF CHAR ; (*----------------------------------------------------------------------------*) VAR (* INSTRUCTION REGISTER *) OP : -1..OPCNT ; IC, PC : ICRNG ; (*PROGRAM ADDRESS REGISTER*) P,CURLVL : 0..32; Q : INTEGER; T : DATATYPE ; GIC, GPC : 0..MAXADR; PACKSTRNG : BOOLEAN; (*PACK THE STRING*) LEVEL : 0..7 ; (* LEVEL OF CURRENT PROC *) GENCODE, TRACE, DUMP : BOOLEAN ; (* TRACE OPTION FLAGS *) TIMER : INTEGER ; (* TIMER FOR LOADING/EXECUTION *) ERRCNT : INTEGER ; (* COUNT OF ASSEMBLY ERROR *) NEEDOPNDS : SET OF 0..63 ; (* OPCODES THAT HAVE OPERANDS *) " NAME : SHRTALFA ; " (* SYMBOLIC OPCODE OF CUR INSTR. *) LCALEN : ADRRNG ; (* TOTAL LEN OF 'LCA' INST *) OLDIC : ICRNG ; CODE : ARRAY[ICRNG] OF 0..4096 ; ZCNV : ARRAY [PABI..PNOP] OF BYTE ; (* P TO Z CONVERSION *) INSTR : ARRAY[0..OPCNT] OF SHRTALFA; (* MNEMONIC INST. CODES *) SPTABLE : ARRAY[0..SPCNT] OF SHRTALFA; (* STANDARD FNS AND PROCS *) SPCODE : ARRAY[0..SPCNT] OF 0..SPCNT ; (* INTERNAL CODE FOR SP'S *) "IVECTOR : ARRAY['A'..'Z'] OF BYTE ;" "HEX : ARRAY [0..15] OF CHAR ;" "ASCII : ARRAY[CHAR] OF 32..95 ;" CMPOP : ARRAY [PEQU..PNEQ] OF 0..5 ; PROC_CNT : PROCRNG ; CALL_CNT : ARRAY [PROCRNG] OF 0..1000 ; PROC_ID : ARRAY [PROCRNG] OF ARRAY[1..7] OF CHAR ; PROC_INX : ARRAY [PROCRNG] OF BYTE ; PROC_ADR : ARRAY [PROCRNG] OF ADRRNG ; PROC_DATA : ARRAY [PROCRNG] OF ADRRNG ; ZCNT : ARRAY [BYTE] OF COUNTER ; ZLEN : ARRAY [BYTE] OF 0..32 ; " PFILE : TEXT ; (* P_CODE INPUT FILE *) PROCFILE : TEXT ; ZFILE : TEXT ; (* 'INTEL' FORMAT OBJECT FILE *) SYMFILE : TEXT ; " (* SYMBOL TABLE FILE FOR SIM80 *) (*----------------------------------------------------------------------------*) PROCEDURE LOAD; VAR CH : CHAR ; I, J, K, L : INTEGER ; " NXTPROC," CURPROC : MINPROC..MAXPROC ; LABELVALUE: ICRNG ; LABELTAB : ARRAY [LBLRNG] OF LABELREC ; PROCEDURE INIT ; VAR I, J, K : INTEGER; BEGIN INSTR[PABI]:='ABI'; INSTR[PABR]:='ABR'; INSTR[PADI]:='ADI'; INSTR[PADR]:='ADR'; INSTR[PAND]:='AND'; INSTR[PCHK]:='CHK'; INSTR[PCHR]:='CHR'; INSTR[PCSP]:='CSP'; INSTR[PCUP]:='CUP'; INSTR[PDEC]:='DEC'; INSTR[PDEF]:='DEF'; INSTR[PDIF]:='DIF'; INSTR[PDVI]:='DVI'; INSTR[PDVR]:='DVR'; INSTR[PENT]:='ENT';"INSTR[PEOF]:='EOF';" INSTR[PEQU]:='EQU'; INSTR[PFJP]:='FJP'; INSTR[PFLO]:='FLO'; INSTR[PFLT]:='FLT'; INSTR[PGEQ]:='GEQ'; INSTR[PGRT]:='GRT'; INSTR[PINC]:='INC'; INSTR[PIND]:='IND'; INSTR[PINN]:='INN'; INSTR[PINT]:='INT'; INSTR[PIOR]:='IOR'; INSTR[PIXA]:='IXA'; "INSTR[PLAO]:='LAO';"INSTR[PLCA]:='LCA'; INSTR[PLDA]:='LDA'; INSTR[PLDC]:='LDC'; "INSTR[PLDO]:='LDO';"INSTR[PLEQ]:='LEQ'; INSTR[PLES]:='LES'; INSTR[PLOC]:='LOC'; INSTR[PLOD]:='LOD'; INSTR[PMOD]:='MOD'; INSTR[PMOV]:='MOV'; INSTR[PMPI]:='MPI'; INSTR[PMPR]:='MPR'; INSTR[PMST]:='MST'; INSTR[PNEQ]:='NEQ'; INSTR[PNEW]:='NEW'; INSTR[PNGI]:='NGI'; INSTR[PNGR]:='NGR'; INSTR[PNOT]:='NOT'; INSTR[PODD]:='ODD'; INSTR[PORD]:='ORD';"INSTR[PPRE]:='PRE';" INSTR[PRET]:='RET'; INSTR[PRST]:='RST'; INSTR[PSAV]:='SAV'; INSTR[PSBI]:='SBI'; INSTR[PSBR]:='SBR'; INSTR[PSGS]:='SGS'; INSTR[PSQI]:='SQI'; INSTR[PSQR]:='SQR'; "INSTR[PSRO]:='SRO';"INSTR[PSTO]:='STO'; INSTR[PSTP]:='STP'; INSTR[PSTR]:='STR'; "INSTR[PSUC]:='SUC';"INSTR[PTOF]:='TOF'; INSTR[PTON]:='TON'; INSTR[PTRC]:='TRC'; INSTR[PUJP]:='UJP'; INSTR[PUNI]:='UNI'; INSTR[PXJP]:='XJP';"INSTR[PLCI]:='...';" "INSTR[PBGN]:='BGN';"INSTR[PLSA]:='LSA'; SPTABLE[ 0]:='GET'; SPTABLE[ 1]:='PUT'; SPTABLE[ 2]:='RLN'; SPTABLE[ 3]:='WLN'; SPTABLE[ 4]:='RDC'; SPTABLE[ 5]:='WRC'; SPTABLE[ 6]:='RDS'; SPTABLE[ 7]:='WRS'; SPTABLE[ 8]:='RDI'; SPTABLE[ 9]:='WRI'; SPTABLE[10]:='EOF'; SPTABLE[11]:='ELN'; SPTABLE[12]:='EIO'; SPTABLE[13]:='XIT'; SPTABLE[14]:='RES'; SPTABLE[15]:='REW'; SPTABLE[16]:='SIN'; SPTABLE[17]:='COS'; SPTABLE[18]:='EXP'; SPTABLE[19]:='LOG'; SPTABLE[20]:='SQT'; SPTABLE[21]:='ATN'; "SPTABLE[22]:='WRP';" SPTABLE[23]:='CLK'; SPTABLE[24]:='NOP'; SPCODE[QGET]:= 0 ; SPCODE[QPUT]:= 1 ; SPCODE[QRLN]:= 2 ; SPCODE[QWLN]:= 3 ; SPCODE[QRDC]:= 4 ; SPCODE[QWRC]:= 5 ; SPCODE[QRDS]:= 6 ; SPCODE[QWRS]:= 7 ; SPCODE[QRDI]:= 8 ; SPCODE[QWRI]:= 9 ; SPCODE[QEOF]:= 10 ; SPCODE[QELN]:= 11 ; SPCODE[QEIO]:= 12 ; SPCODE[QXIT]:= 13 ; SPCODE[QRES]:= 14 ; SPCODE[QREW]:= 15 ; SPCODE[QSIN]:= 16 ; SPCODE[QCOS]:= 17 ; SPCODE[QEXP]:= 18 ; SPCODE[QLOG]:= 19 ; SPCODE[QSQT]:= 20 ; SPCODE[QATN]:= 21 ; "SPCODE[QWRP]:= 22 ;" SPCODE[QCLK]:= 23 ; SPCODE[QRDR]:= 24 ; SPCODE[QWRR]:= 24 ; SPCODE[QRDB]:= 24 ; SPCODE[QWRB]:= 24 ; SPCODE[QTRP]:= 24 ; SPCODE[QPAK]:= 24 ; SPCODE[QWRO]:= 24 ; " FOR CH := 'A' TO 'Z' DO IVECTOR[CH] := 0 ; IVECTOR['A'] := PABI ; IVECTOR['C'] := PCHK ; IVECTOR['D'] := PDEC ; IVECTOR['E'] := PENT ; IVECTOR['F'] := PFJP ; IVECTOR['G'] := PGEQ ; IVECTOR['I'] := PINC ; IVECTOR['L'] := PLAO ; IVECTOR['M'] := PMOD ; IVECTOR['N'] := PNEQ ; IVECTOR['O'] := PODD ; IVECTOR['P'] := PPRE ; IVECTOR['R'] := PRET ; IVECTOR['S'] 2= PSAV ; IVECTOR['T'] := PTON ; IVECTOR['U'] :5 PUJP 3 AVECTOR['X'] :5 PXBP ; " (* P-CODE TG Z-CODE TRANSLATION TABLE *) " ZCNV[PORD] := ZORD ; ZCNV[PCHR] := ZCHR ; " ZCNV[PABI] := ZABI ; ZCNV[PADI] := ZADI ; ZCNV[PSBI] := ZSBI ; ZCNV[PMPI] := ZMPI ; ZCNV[PDVI] := ZDVI ; ZCNV[PMOD] := ZMOD ; " ZCNV[PSQI] := ZSQI ; " ZCNV[PNGI] := ZNGI ; ZCNV[PODD] := ZODD ; ZCNV[PRST] := ZRST ; " ZCNV[PSAV] := ZSAV ; " ZCNV[PAND] := ZAND ; ZCNV[PIOR] := ZIOR ; ZCNV[PNOT] := ZNOT ; ZCNV[PSGS] := ZSGS ; ZCNV[PINN] := ZINN ; ZCNV[PINT] := ZINT ; ZCNV[PUNI] := ZUNI ; ZCNV[PDIF] := ZDIF ; ZCNV[PADR] := ZADR ; ZCNV[PSBR] := ZSBR ; ZCNV[PMPR] := ZMPR ; ZCNV[PDVR] := ZDVR ; ZCNV[PABR] := ZABR ; ZCNV[PNGR] := ZNGR ; "ZCNV[PRND] := ZRND ;" ZCNV[PFLO] := ZFLO ; ZCNV[PFLT] := ZFLT ; ZCNV[PTRC] := ZTRC ; NEEDOPNDS := [PCHK,PCSP,PCUP,PDEC,PENT,PEQU,PFJP,PGEQ,PGRT,PINC,PIND, PIXA,PLCA,PLDA,PLDC,PLEQ,PLES,PLOC,PLOD,PLSA, PMOV,PMST,PNEQ,PNEW,PRET,PSTO,PSTR,PUJP,PXJP] ; "NAME := BLNK3 ;" LCALEN := 0 ; PROC_CNT := MINPROC ; " RESET(PRD) ; " WHILE NOT EOF(PRD) DO BEGIN READLN(PRD,"PROC_ID[PROC_CNT]," CALL_CNT[PROC_CNT]) ; PROC_CNT := PROC_CNT+1 ; END ; (* NOTE THAT CALL_CNT[0] = 0 . I.E NO CALL TO $MAINBLOC *) PROC_INX[MINPROC] := PROC_CNT ; CALL_CNT[PROC_CNT] := 0 ; FOR I := MINPROC TO PROC_CNT-1 DO BEGIN J := CALL_CNT[I] ; K := MINPROC-1 ; REPEAT K := K+1 UNTIL CALL_CNT[PROC_INX[K]] <= J ; FOR J := I DOWNTO K DO PROC_INX[J+1] := PROC_INX[J] ; PROC_INX[K] := I ; END (* FOR I := ... *) ; PROC_CNT := PROC_CNT-1 ; " FOR I := MINPROC TO PROC_CNT DO (* PRINT PROC TABLE *) WRITELN(OUTPUT, I, PROC_INX[I], CALL_CNT[ PROC_INX[I] ]) ; WRITELN(OUTPUT) ; WRITELN(OUTPUT) ; " (* FOR CH := '0' TO '9' DO ASCII[CH] := (ORD(CH)-ORD('0'))+48 ; FOR CH := 'A' TO 'Z' DO ASCII[CH] := ORD(CH)-ORD('A')+64+1 ; ASCII[' '] := 32 ; ASCII['!'] := 33 ; ASCII['"'] := 34 ; ASCII['#'] := 35 ; ASCII['$'] := 36 ; ASCII['%'] := 37 ; ASCII['&'] := 38 ; ASCII[''''] := 39 ; ASCII['('] := 40 ; ASCII[')'] := 41 ; ASCII['*'] := 42 ; ASCII['+'] := 43 ; ASCII[','] := 44 ; ASCII['-'] := 45 ; ASCII['.'] := 46 ; ASCII['/'] := 47 ; ASCII[':'] := 58 ; ASCII[';'] := 59 ; ASCII['<'] := 60 ; ASCII['='] := 61 ; ASCII['>'] := 62 ; ASCII['?'] := 63 ; ASCII['@'] := 64 ; ASCII['['] := 91 ; ASCII['|'] := 92 ; ASCII[']'] := 93 ; ASCII['~'] := 94 ; ASCII['_'] := 95 ; *) " FOR I := 0 TO 9 DO HEX[I] := CHR(I+ORD('0') ) ; " " FOR I := 10 TO 15 DO HEX[I] := CHR( I+ORD('A')-10 ) ; " FOR I:= MINLBL TO MAXLBL DO WITH LABELTAB[I] DO BEGIN VAL:= 0; ST:= ENTERED END; FOR I := 0 TO ZOPCNT DO ZCNT[I] := 0 ; CMPOP[PEQU] := 0 ; CMPOP[PNEQ] := 1 ; CMPOP[PLEQ] := 2 ; CMPOP[PLES] := 3 ; CMPOP[PGEQ] := 4 ; CMPOP[PGRT] := 5 ; IC := 0 ; " OLDIC := 0 ;" GIC := 0 ; LEVEL := 1 ; PC := 0 ; GPC := 0 ; PACKSTRNG := FALSE ; ERRCNT := 0 ; TRACE:= FALSE; DUMP := FALSE ; GENCODE := TRUE ; (* IF GENCODE THEN REWRITE(PRR) ; *) END (*INIT*) ; (*----------------------------------------------------------------------------*) PROCEDURE ERROR(EC : BYTE) ; BEGIN WRITELN( OUTPUT ) ; WRITELN(OUTPUT, ' **** I_ERROR :' , EC:6,' NEAR:', PC:5, PROC_ID[CURPROC]:9) ; ERRCNT := ERRCNT+1 ; END (*ERROR*) ; " PROCEDURE ERRORL(STRING: BETA); (*ERROR IN LOADING*) BEGIN WRITELN() ; WRITELN('**** ':12, STRING); EXIT(1001) (* TO END PROGRAM PCODE*) END; (*ERRORL*) " (*----------------------------------------------------------------------------*) PROCEDURE UPDATELBL(X: LBLRNG); (*WHEN A LABEL DEFINITION LX IS FOUND*) VAR CURR,SUCC: ICRNG ; (*RESP. CURRENT ELEMENT AND SUCCESSOR ELEMENT OF A LIST OF FUTURE REFERENCE*) ENDLIST: BOOLEAN; BEGIN IF X > MAXLBL THEN ERROR(118 (* LABEL TO LARGE , IN UPDATELBL *) ) ELSE IF LABELTAB[X].ST=DEFINED THEN BEGIN WRITELN(OUTPUT,X) ; ERROR(119 (* DUPLICATE LABEL DEF *) ) END ELSE BEGIN IF LABELTAB[X].VAL <> 0 THEN (*FORWARD REFERENCE(S)*) BEGIN CURR:= LABELTAB[X].VAL; ENDLIST:= FALSE; REPEAT SUCC := CODE[CURR] ; CODE[CURR] := LABELVALUE MOD 256 ; CODE[CURR-1] := LABELVALUE DIV 256 + CODE[CURR-1] ; IF SUCC = 0 THEN ENDLIST:= TRUE ELSE CURR:= SUCC UNTIL ENDLIST ; END; LABELTAB[X].ST:= DEFINED; LABELTAB[X].VAL:= LABELVALUE; END ; END;(*UPDATE*) (*----------------------------------------------------------------------------*) " PROCEDURE DUMP ; VAR I: INTEGER ; BEGIN FOR I := 0 TO IC-1 DO WITH CODE [I] DO BEGIN WRITELN(OUTPUT,I:6,OP1 MOD 256 :5,INSTR[OP1 MOD 256]:5, OP1 DIV (65536):6,(OP1 DIV 256) MOD 256:4,Q1:10) ; END END (* DUMP *) ; " (*----------------------------------------------------------------------------*) PROCEDURE ASSEMBLE; FORWARD; (*----------------------------------------------------------------------------*) PROCEDURE GENERATE;(*GENERATE SEGMENT OF CODE*) VAR X: INTEGER; (* LABEL NUMBER *) (*----------------------------------------------------------------------------*) """ PROCEDURE OUTPUT_CODE ; (* TO GENERATE INTEL LOAD FORMAT OBJECT *) VAR I : ICRNG ; J, K, CSUM : INTEGER ; OBJLINE : ARRAY[1..80] OF CHAR ; BEGIN WRITELN(OUTPUT) ; WRITELN(OUTPUT,' **** PROC: ':14, PROC_ID[CURPROC], ' DATA AREA:',PROC_DATA[CURPROC]:6, ' PCNT, T: ', PC:6, GPC+PC-1:6, ' SIZE, T:', IC:5, GIC+IC:6) ; (* WRITELN(OUTPUT) ; *) IF DUMP THEN BEGIN FOR I := 0 TO IC-1 DO BEGIN IF (I MOD 16) = 0 THEN BEGIN WRITELN(OUTPUT) ; WRITE(OUTPUT,I:6,':') ; END ; WRITE(CODE[I]:4) END ; WRITELN(OUTPUT) ; WRITELN(OUTPUT, '1') ; END ; (* OUTPUT THE 'OBJECT' FOR THE CURRENT PROC *) IF GENCODE THEN BEGIN (* WRITELN(PRR, '**** ', PROC_ID[CURPROC]) ; *) OBJLINE[1] := ':' ; OBJLINE[2] := HEX[2] ; OBJLINE[3] := HEX[0] ; (* LENGTH = 32 *) OBJLINE[8] := HEX[0] ; OBJLINE[9] := HEX[0] ; (* TYPE *) (* APPEND THE NAME OF THIS PROC TO THE OBJECT CODE LINE *) FOR I := 1 TO 5 DO OBJLINE[I+75] := ' ' (*PROC_ID[CURPROC,I]*); J := 74 ; FOR I := 0 TO IC-1 DO BEGIN IF J >= 74 THEN (* LINE FULL *) BEGIN K := CODE_ORG + FIX_AREA + GIC + I ; CSUM := (K DIV 256)+ (K MOD 256) ; OBJLINE[4] := HEX[K DIV 4096] ; K := K MOD 4096 ; OBJLINE[5] := HEX[K DIV 256 ] ; K := K MOD 256 ; OBJLINE[6] := HEX[K DIV 16 ] ; OBJLINE[7] := HEX[K MOD 16 ] ; J := 10 ; END ; IF (CODE[I] < 0) OR (CODE[I] > 255) THEN ERROR(128 (* BAD CODE BYTE DETECTED *) ) ; OBJLINE[J] := HEX[CODE[I] DIV 16] ; OBJLINE[J+1] := HEX[ CODE[I] MOD 16 ] ; CSUM := CSUM+CODE[I] ; J := J+2 ; IF J >= 74 THEN (* OUTPUT THE FULL LINE BUFFER *) BEGIN CSUM := 256-((CSUM+32) MOD 256) ; (* ADD LEN TO CHECKSUM *) OBJLINE[74] := HEX[ (CSUM MOD 256) DIV 16 ] ; OBJLINE[75] := HEX[CSUM MOD 16] ; WRITELN(PRR, OBJLINE) ; END ; END (* FOR I := 0... *) ; IF J < 74 THEN (* FLUSH THE PARTIAL LINE *) BEGIN K := (J-10) DIV 2 ; OBJLINE[2] := HEX[K DIV 16] ; OBJLINE[3] := HEX[K MOD 16] ; CSUM := 256-((CSUM+K) MOD 256) ; OBJLINE[J] := HEX[ (CSUM MOD 256) DIV 16 ] ; OBJLINE[J+1] := HEX[CSUM MOD 16] ; FOR J := J+2 TO 75 DO OBJLINE[J] := ' ' ; WRITELN(PRR, OBJLINE) ; END ; GIC := GIC+IC ; (* GLOBAL LOCATION COUNT *) (* IF $MAINBLK, OUTPUT SEGMENT TABLE *) IF LEVEL = 0 THEN BEGIN (*WRITELN(PRR, '**** $STBL') ; *) (* RESET LENGTH TO 32 *) OBJLINE[2] := HEX[2] ; OBJLINE[3] := HEX[0] ; (* OBJLINE[76] := '$' ;*) (* APPEND LINE IDENTIFICATION *) OBJLINE[77] := 'S' ; OBJLINE[78] := 'T' ; OBJLINE[79] := 'B' ; OBJLINE[80] := 'L' ; *) IF ODD(GIC) THEN GIC := GIC+1 ; J := 74 ; FOR I := MINPROC TO PROC_CNT DO BEGIN IF J >= 74 THEN (* LINE FULL *) BEGIN K := (I+I) + GIC + CODE_ORG + FIX_AREA ; CSUM := (K DIV 256)+ (K MOD 256) ; OBJLINE[4] := HEX[K DIV 4096] ; K := K MOD 4096 ; OBJLINE[5] := HEX[K DIV 256 ] ; K := K MOD 256 ; OBJLINE[6] := HEX[K DIV 16 ] ; OBJLINE[7] := HEX[K MOD 16 ] ; J := 10 ; END ; L := PROC_ADR[ PROC_INX[I] ] + FIX_AREA ; K := L DIV 256 ; OBJLINE[J+2] := HEX[K DIV 16] ; OBJLINE[J+3] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; K := L MOD 256 ; OBJLINE[J ] := HEX[K DIV 16] ; OBJLINE[J+1] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; J := J+4 ; IF J >= 74 THEN (* OUTPUT THE FULL LINE BUFFER *) BEGIN CSUM := 256-((CSUM+32) MOD 256) ; (* ADD LEN TO CSUM *) OBJLINE[74] := HEX[ (CSUM MOD 256) DIV 16 ] ; OBJLINE[75] := HEX[CSUM MOD 16] ; WRITELN(PRR, OBJLINE) ; END ; END (* FOR I := MINPROC TO PROC_CNT *) ; IF J < 74 THEN (* FLUSH THE PARTIAL LINE *) BEGIN K := (J-10) DIV 2 ; OBJLINE[2] := HEX[K DIV 16] ; OBJLINE[3] := HEX[K MOD 16] ; CSUM := 256-((CSUM+K) MOD 256) ; OBJLINE[J] := HEX[ (CSUM MOD 256) DIV 16 ] ; OBJLINE[J+1] := HEX[ CSUM MOD 16 ] ; FOR J := J+2 TO 75 DO OBJLINE[J] := ' ' ; WRITELN(PRR, OBJLINE) ; END ; (* OUTPUT ENTRY POINT ADDRESS *) OBJLINE[2] := HEX[0] ; OBJLINE[3] := HEX[8] ; (* LENGTH *) K := CODE_ORG ; (* LOADING ADRESS *) CSUM := (K DIV 256)+ (K MOD 256) ; OBJLINE[4] := HEX[ K DIV 4096] ; K := K MOD 4096 ; OBJLINE[5] := HEX[ K DIV 256 ] ; K := K MOD 256 ; OBJLINE[6] := HEX[ K DIV 16 ] ; OBJLINE[7] := HEX[ K MOD 16 ] ; L := PROC_ADR[ PROC_INX[PROC_CNT] ] + FIX_AREA ; K := L MOD 256 ; (* REL. ENTRY POINT ADR. *) OBJLINE[10] := HEX[ K DIV 16 ] ; OBJLINE[11] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; K := L DIV 256 ; OBJLINE[12] := HEX[ K DIV 16 ] ; OBJLINE[13] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; L := GIC + FIX_AREA ; (* REL. PROC. TBL. ADR. *) K := L MOD 256 ; OBJLINE[14] := HEX[ K DIV 16 ] ; OBJLINE[15] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; K := L DIV 256 ; OBJLINE[16] := HEX[ K DIV 16 ] ; OBJLINE[17] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; L := L + (PROC_CNT+1)*2 ; (* REL. PROC. TBL. ADR. *) K := L MOD 256 ; OBJLINE[18] := HEX[ K DIV 16 ] ; OBJLINE[19] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; K := L DIV 256 ; OBJLINE[20] := HEX[ K DIV 16 ] ; OBJLINE[21] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; L := HEAP_END ; (* REL. HEAP ADR. *) K := (*L MOD 256*) 0 ; OBJLINE[22] := HEX[ K DIV 16 ] ; OBJLINE[23] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; K := L DIV 256 ; OBJLINE[24] := HEX[ K DIV 16 ] ; OBJLINE[25] := HEX[ K MOD 16 ] ; CSUM := CSUM+K ; CSUM := 256-((CSUM+8) MOD 256) ; (* ADD LEN TO CSUM *) OBJLINE[26] := HEX[ (CSUM MOD 256) DIV 16 ] ; OBJLINE[27] := HEX[CSUM MOD 16] ; FOR J := 28 TO 75 DO OBJLINE[J] := ' ' ; WRITELN(PRR, OBJLINE) ; WRITELN(PRR, ':0000000000') ; PROC_ID[PROC_INX[PROC_CNT]] [1] := ' ' ; (* '$' <= ' ' *) END (* IF LEVEL = 0 *) ; END (* IF GENCODE *) ; END (* OUTPUT_CODE *) ; """ (*----------------------------------------------------------------------------*) PROCEDURE OUTPUT_CODE1 ; VAR I, J : INTEGER ; OBJLINE : ARRAY [1..80] OF CHAR ; BEGIN WRITELN(OUTPUT) ; " WRITELN(OUTPUT,'**** PROC: ', PROC_ID[CURPROC], ' DATA AREA:',PROC_DATA[CURPROC]:6, ' PCNT, T: ', PC:6, GPC+PC-1:6, ' SIZE, T:', IC:5, GIC+IC:6) ; " " I := GIC+CODE_ORG+FIX_AREA ; (* LOADING ADDRESS FOR THIS PROC *) (* PRINT HEADER ==> LENGTH, LOAD ADR. *) WRITE(PRR, CHR(IC MOD 256 -ABS), CHR(IC DIV 256 -ABS), CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ); " J := 0 ; FOR I := 0 TO IC-1 DO BEGIN J := J+1 ; OBJLINE[J] := CHR(CODE[I]-ABS) ; IF J >= 80 THEN BEGIN WRITE(PRR, OBJLINE) ; J := 0 ; END ; END (* FOR I := ... *) ; IF J > 0 THEN WRITE(PRR,OBJLINE:J) ; (* SEE IF END OF MAINBLK *) GIC := GIC+IC ; IF LEVEL = 0 THEN BEGIN IF ODD(GIC) THEN BEGIN GIC := GIC+1 ; WRITE(PRR, CHR(256 -ABS)) END ; " I := PROC_CNT + PROC_CNT + 2 ; (* PROC TABLE LENGTH *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; (* PROC TABLE LOAD ADR *) I := GIC+CODE_ORG+FIX_AREA ; WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; " FOR I := MINPROC TO PROC_CNT DO BEGIN J := PROC_ADR[ PROC_INX[I] ] + FIX_AREA ; WRITE(PRR, CHR(J MOD 256 -ABS), CHR(J DIV 256 -ABS)) ; END ; (* WRITE THE LENGTH TABLES (I.E. FIX_AREA CONTENTS) *) " WRITE(PRR, CHR(FIX_AREA MOD 256 -ABS), CHR(FIX_AREA DIV 256 -ABS), CHR(CODE_ORG MOD 256 -ABS), CHR(CODE_ORG DIV 256 -ABS) ) ; " I := PROC_ADR[ PROC_INX[PROC_CNT] ] + FIX_AREA ; (* ENTRY POINT ADR *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; I := GIC+ FIX_AREA ; (* END OF PROGRAM / START OF PROC_TABLE *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; I := I+ PROC_CNT+PROC_CNT+2 ;(* END OF PROC_TABLE *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; I := 0 ; (* HEAP ADDRESS, TO BE SET BY INTERP. *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; " (* WRITE THE END RECORD FOR PTDOS LOADER *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; I := 256 ; (* TO MAKE PTDOS HAPPY *) WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; " END (* IF LEVEL = 0 *) ; END (* OUTPUT_CODE1 *) ; (*----------------------------------------------------------------------------*) """ PROCEDURE PRINTCOUNTS ; (* TO PRINT OUT P_CODE RELATED STATISTICS *) (* -------------------------------------- *) VAR I, J, K, L, M, N, TZCNT : INTEGER ; ZINX : ARRAY [0..ZOPCNT] OF 0..ZOPCNT ; ZINSTR : ARRAY [0..ZOPCNT] OF ARRAY [1..5] OF CHAR ; BEGIN (* INITIALZE INSTRUCTION NAME TABLE *) ZINSTR[ZLDC1 ] := 'LDC1 ' ; ZLEN[ZLDC1 ] := 1 ; ZINSTR[ZLDC2 ] := 'LDC2 ' ; ZLEN[ZLDC2 ] := 2 ; ZINSTR[ZLDC ] := 'LDC ' ; ZLEN[ZLDC ] := 3 ; ZINSTR[ZLDC8 ] := 'LDC8 ' ; ZLEN[ZLDC8 ] := 9 ; (* ZINSTR[ZLDCR ] := 'LDCR ' ; ZLEN[ZLDCR ] := 9 ; *) ZINSTR[ZLODG2] := 'LODG2' ; ZLEN[ZLODG2] := 2 ; ZINSTR[ZLOD ] := 'LOD ' ; ZLEN[ZLOD ] := 3 ; ZINSTR[ZLOD8 ] := 'LOD8 ' ; ZLEN[ZLOD8 ] := 3 ; (* ZINSTR[ZLODR ] := 'LODR ' ; ZLEN[ZLODR ] := 3 ; *) ZINSTR[ZCUP ] := 'CUP ' ; ZLEN[ZCUP ] := 2 ; ZINSTR[ZCSP ] := 'CSP ' ; ZLEN[ZCSP ] := 2 ; ZINSTR[ZIND ] := 'IND ' ; ZLEN[ZIND ] := 2 ; ZINSTR[ZINDS ] := 'INDS ' ; ZLEN[ZINDS ] := 2 ; ZINSTR[ZIXA ] := 'IXA ' ; ZLEN[ZIXA ] := 3 ; ZINSTR[ZSPWRP] := 'SPWRP' ; ZLEN[ZSPWRP] := 1 ; ZINSTR[ZSTRLG] := 'STRLG' ; ZLEN[ZSTRLG] := 2 ; ZINSTR[ZSTR ] := 'STR ' ; ZLEN[ZSTR ] := 3 ; ZINSTR[ZMVP ] := 'MVP ' ; ZLEN[ZMVP ] := 2 ; ZINSTR[ZSTRS ] := 'STRS ' ; ZLEN[ZSTRS ] := 3 ; ZINSTR[ZLDALG] := 'LDALG' ; ZLEN[ZLDALG] := 2 ; (* ZINSTR[ZLDAL ] := 'LDAL ' ; ZLEN[ZLDAL ] := 2 ; *) ZINSTR[ZLDA ] := 'LDA ' ; ZLEN[ZLDA ] := 3 ; ZINSTR[ZLCA ] := 'LCA ' ; ZLEN[ZLCA ] := 10; ZINSTR[ZXJP ] := 'XJP ' ; ZLEN[ZXJP ] := 6 ; ZINSTR[ZCMPM ] := 'CMPM ' ; ZLEN[ZCMPM ] := 3 ; ZINSTR[ZEQU ] := 'EQU ' ; ZLEN[ZEQU ] := 1 ; ZINSTR[ZNEQ ] := 'NEQ ' ; ZLEN[ZNEQ ] := 1 ; ZINSTR[ZLEQ ] := 'LEQ ' ; ZLEN[ZLEQ ] := 1 ; ZINSTR[ZLES ] := 'LES ' ; ZLEN[ZLES ] := 1 ; ZINSTR[ZGEQ ] := 'GEQ ' ; ZLEN[ZGEQ ] := 1 ; ZINSTR[ZGRT ] := 'GRT ' ; ZLEN[ZGRT ] := 1 ; ZINSTR[ZCMPRS] := 'CMPRS' ; ZLEN[ZCMPRS] := 2 ; ZINSTR[ZMOV ] := 'MOV ' ; ZLEN[ZMOV ] := 2 ; ZINSTR[ZMST ] := 'MST ' ; ZLEN[ZMST ] := 1 ; ZINSTR[ZRET ] := 'RET ' ; ZLEN[ZRET ] := 1 ; ZINSTR[ZSTO ] := 'STO ' ; ZLEN[ZSTO ] := 1 ; ZINSTR[ZSTOS ] := 'STOS ' ; ZLEN[ZSTOS ] := 1 ; ZINSTR[ZRETF8] := 'RETF8' ; ZLEN[ZRETF8] := 1 ; ZINSTR[ZORD ] := 'ORD ' ; ZLEN[ZORD ] := 0 ; ZINSTR[ZCHR ] := 'CHR ' ; ZLEN[ZCHR ] := 0 ; ZINSTR[ZADI ] := 'ADI ' ; ZLEN[ZADI ] := 1 ; ZINSTR[ZADIC ] := 'ADIC ' ; ZLEN[ZADIC ] := 2 ; ZINSTR[ZSBI ] := 'SBI ' ; ZLEN[ZSBI ] := 1 ; ZINSTR[ZDVI ] := 'DVI ' ; ZLEN[ZDVI ] := 1 ; ZINSTR[ZMOD ] := 'MOD ' ; ZLEN[ZMOD ] := 1 ; ZINSTR[ZMPI ] := 'MPI ' ; ZLEN[ZMPI ] := 1 ; ZINSTR[ZNGI ] := 'NGI ' ; ZLEN[ZNGI ] := 1 ; ZINSTR[ZRST ] := 'RST ' ; ZLEN[ZRST ] := 1 ; ZINSTR[ZDEC1 ] := 'DEC1 ' ; ZLEN[ZDEC1 ] := 1 ; ZINSTR[ZODD ] := 'ODD ' ; ZLEN[ZODD ] := 1 ; ZINSTR[ZFLT ] := 'FLT ' ; ZLEN[ZFLT ] := 1 ; ZINSTR[ZFLO ] := 'FLO ' ; ZLEN[ZFLO ] := 1 ; ZINSTR[ZABI ] := 'ABI ' ; ZLEN[ZABI ] := 1 ; ZINSTR[ZSGS ] := 'SGS ' ; ZLEN[ZSGS ] := 1 ; ZINSTR[ZINN ] := 'INN ' ; ZLEN[ZINN ] := 1 ; ZINSTR[ZUNI ] := 'UNI ' ; ZLEN[ZUNI ] := 1 ; ZINSTR[ZINT ] := 'INT ' ; ZLEN[ZINT ] := 1 ; ZINSTR[ZDIF ] := 'DIF ' ; ZLEN[ZDIF ] := 1 ; ZINSTR[ZNEW ] := 'NEW ' ; ZLEN[ZNEW ] := 2 ; ZINSTR[ZAND ] := 'AND ' ; ZLEN[ZAND ] := 1 ; ZINSTR[ZIOR ] := 'IOR ' ; ZLEN[ZIOR ] := 1 ; ZINSTR[ZNOT ] := 'NOT ' ; ZLEN[ZNOT ] := 1 ; ZINSTR[ZMSTF ] := 'MSTF ' ; ZLEN[ZMSTF ] := 1 ; ZINSTR[ZRETF ] := 'RETF ' ; ZLEN[ZRETF ] := 1 ; ZINSTR[ZCUP1 ] := 'CUP1 ' ; ZLEN[ZCUP1 ] := 1 ; ZINSTR[ZCSP1 ] := 'CSP1 ' ; ZLEN[ZCSP1 ] := 1 ; ZINSTR[ZFJP ] := 'FJP ' ; ZLEN[ZFJP ] := 2 ; ZINSTR[ZUJP ] := 'UJP ' ; ZLEN[ZUJP ] := 2 ; ZINSTR[ZIND1 ] := 'IND1 ' ; ZLEN[ZIND1 ] := 1 ; ZINSTR[ZIXA1 ] := 'IXA1 ' ; ZLEN[ZIXA1 ] := 1 ; ZINSTR[ZLODG ] := 'LODG ' ; ZLEN[ZLODG ] := 1 ; ZINSTR[ZLODL ] := 'LODL ' ; ZLEN[ZLODL ] := 1 ; ZINSTR[ZENT ] := 'ENT ' ; ZLEN[ZENT ] := 11; (* OUTPUT PROCEDURE CALL TABLE *) WRITELN(OUTPUT,'1 PROCEDURE CALL TABLE ', 'CALL_CNT, CUM_CNT, DATA_SIZE, ADDR. ') ; WRITELN(OUTPUT) ; K := 0 ; (* REWRITE(SYMFILE) ; (* WRITE SYMBOL FILE FOR THE SIMULATOR *) FOR I := MINPROC TO PROC_CNT DO BEGIN J := PROC_INX[I] ; K := K+CALL_CNT[J] ; WRITELN(OUTPUT, I, J:4, PROC_ID[J]:12, CALL_CNT[J]:8, K:8, PROC_DATA[J]:9, PROC_ADR[J]:8 ) ; (* WRITELN(SYMFILE,I+1:6,PROC_ID[J]:12, PROC_ADR[J]+CODE_ORG+FIX_AREA:8);*) END ; (* SORT OPCODES BY FREQUENCY *) TZCNT := 0 ; ZINX[0] := ZOPCNT ; (* NOTE ZCNT[ZOPCNT] = 0 *) ## ## FOR I := 0 TO ZOPCNT-1 DO ## BEGIN (* INSERT THE NEXT ENTRY IN ITS PROPER PLACE *) ## J := ZCNT[I] ; TZCNT := TZCNT+J ; ## K := -1 ; REPEAT K := K+1 UNTIL ZCNT[ ZINX[K] ] <= J ; ## ## FOR J := I DOWNTO K DO ZINX[J+1] := ZINX[J] ; ## ## ZINX[K] := I ; ## END (* SORT LOOP *) ; WRITELN(OUTPUT, ' I_INTERPRETIVE CODE FREQUENCIES, ', 'TOTAL (P_CODES, I_CODES, BYTES) :', GPC-1:7, TZCNT:7, GIC:8) ; WRITELN(OUTPUT) ; WRITELN(OUTPUT) ; WRITELN('(ABS) (I.LEN) (T.LEN) (C.LEN)':55 ); WRITELN(OUTPUT) ; L := 0 ; N := 0 ; IF ZCNT[ZLCA] > 0 THEN ZLEN[ZLCA] := LCALEN DIV ZCNT[ZLCA] ; (* CALC. AVERG 'LCA' LEN. *) FOR J := 0 TO ZOPCNT DO BEGIN I := (* ZINX[J] *) J ; K := ZCNT[I] ; L := L+K ; IF K > 0 THEN BEGIN M := ZLEN[I]*K ; N := N+M ; WRITELN(OUTPUT, J, I:4, ZINSTR[I]:7, K:6, (* K*1000 DIV TZCNT:6, L*1000 DIV TZCNT:6, *) ZLEN[I]:10, M:7, (*M *1000 DIV GIC:7,*) N:9 ) ; END ; END ; WRITELN(OUTPUT) ; WRITELN(OUTPUT, '**** TOTAL ', '(P_CODES, BYTES, ACCOUNTED) :', GPC-1:7, GIC:7, N:8) ; END (* PRINTCOUNTS*) ; """ (*----------------------------------------------------------------------------*) BEGIN (* GENERATE *) (* RESET(INPUT) ; *) REPEAT (* READ UNTIL LAST INSTRUCTION, 'STP' *) READ(INPUT,CH) ; (* FIRST CHARACTER OF LINE *) IF CH = ' ' THEN BEGIN (* NO LABEL FIELD *) ASSEMBLE END (* CH = ' ' *) ELSE BEGIN (*PLABEL*) IF (CH = 'L') THEN BEGIN (* LABEL DEFINITION *) READ(INPUT, X, CH) ; (*READ NEXT NON BLANK CHAR*) IF INPUT@ = 'L' THEN (* LAB *) BEGIN LABELVALUE := IC ; UPDATELBL(X) ; END ELSE BEGIN (*PDEF*) READ(INPUT, CH (*SKIP OVER OPCODE*), LABELVALUE) ; UPDATELBL(X) ; IF OP = PRET (* THIS IS OLD OPCODE *) THEN BEGIN PROC_DATA[CURPROC] := LABELVALUE ; """ OUTPUT_CODE ; """ (* OUTPUT CODE FOR THIS PROC. *) OUTPUT_CODE1 ; (* OUTPUT BINARY OBJECT FORM *) GPC := GPC+PC ; PC := 0 ; IC := 0 ; END ; END (*PDEF*) ; READLN(INPUT) ; END (* STANDARD LABEL *) ELSE BEGIN (* PROCEDURE OR FUNCTION ENTRY POINT *) READ(INPUT, CURPROC) ; PROC_ADR[CURPROC] := GIC ; (* RECORD ENTRY POINT ADR *) REPEAT READ(INPUT,CH) UNTIL INPUT@ <> ' ' ; (*ADVANCE TO OPCODE FIELD*) ASSEMBLE END (* PROCEDURE OR FUNCTION *) END (* LABEL *) ; UNTIL OP = PSTP ; """ PRINTCOUNTS ; """ END (* GENERATE *) ; (*----------------------------------------------------------------------------*) PROCEDURE ASSEMBLE; (*TRANSLATE SYMBOLIC CODE INTO MACHINE CODE AND STORE*) VAR TCH :CHAR; S1, DY, DX, I, J : INTEGER; NEGATE: BOOLEAN ; STRING : ARRAY[1..MAXSLEN] OF CHAR ; "B :BOOLEAN; R :REAL; S :SET OF 0..63;" (*----------------------------------------------------------------------------*) " PROCEDURE GET_OPCDE; BEGIN READ(INPUT,NAME) ; OP := IVECTOR[NAME[1]]-1 ; INSTR[PNOP] := NAME ; REPEAT OP := OP+1 UNTIL (INSTR[OP] = NAME) ; IF OP >= PNOP THEN BEGIN WRITELN(OUTPUT,' **** ILLEGAL OPCODE: ' ,NAME) ; OP := PTOF (* NOP *) END ; IF OP <= 63 THEN IF (OP IN NEEDOPNDS) THEN REPEAT READ(INPUT,CH) ; UNTIL INPUT@ <> ' ' ; END; (*GET_OPCDE*) " (*----------------------------------------------------------------------------*) (*++PROCEDURE ASSEM2 ; " FOR DEBUGGING HAVE TO DEVIDE ASSEMBLE INTO TWO " BEGIN CASE OP OF +++*) (*+++++ END " CASE OP " ; END " ASSEM2 " ; +++*) BEGIN (* ASSEMBLE *) P := 0; Q := 0; "OP := 0; T := UNDEF ; " ### #"GET_OPCDE;" ### # READ(INPUT, CH) ; OP := ORD(CH) ; ### #"WRITELN(OUTPUT,OP:3 , INSTR[OP]:5, IC:8);" IF (OP IN NEEDOPNDS) THEN READ(INPUT, CH) ; """ REPEAT READ(INPUT,CH) ; UNTIL INPUT@ <> ' ' ; """ ### # IF OP >= PNOP THEN BEGIN WRITELN(OUTPUT, OP); ERROR(160) END ; CASE OP OF (* GET PARAMETERS T,P,Q *) PLOC : BEGIN WRITE(OUTPUT, '+') ; PC := PC-1 END ; PLCA, PLSA : BEGIN PACKSTRNG := OP = PLSA ; Q := IC ; CODE[IC] := ZLCA ; IC := IC+2 ; READ(INPUT, CH) ; REPEAT READ(INPUT, CH) ; (* CH = FIRST CHAR IN STRING *) REPEAT IF OP = PLCA THEN BEGIN CODE[IC] := 0 ; IC := IC+1 ; END ; CODE[IC] := "ASCII[CH]-32" ORD(CH) ; IC := IC+1 ; READ(INPUT,CH) UNTIL CH = '''' ; UNTIL INPUT@ <> '''' ; CODE[Q+1] := IC-(Q+2) ; ZCNT[ZLCA] := ZCNT[ZLCA]+1 ; LCALEN := LCALEN+ IC-Q ; (* ACCUMULATE LENGTH *) END; PLDC : BEGIN READ(INPUT, CH) ; CASE CH OF (*GET Q*) 'I', 'B' :BEGIN P := 1; READ(INPUT, CH, Q) ; END; 'C' :BEGIN P := 1 ; READ(INPUT,CH, CH, CH (* SKIP OVER ,'*) ) ; Q := "ASCII[CH]-32" ORD(CH) ; END (* C *) ; 'R' :BEGIN READ(INPUT, CH(*,*),CH) ; J := 0 ; DY := 0 ; NEGATE := CH = '-' ; IF (CH = '+') OR (CH = '-') THEN READ(CH) ; WHILE CH = '0' DO READ(CH) ; (* SKIP LAEDING ZEROS *) IF CH ='.' THEN BEGIN READ(CH) ; WHILE CH ='0' DO BEGIN J := J-1 ; READ(CH) END ; DX := 0 ; (*POWER INCREMENT *) END ELSE DX := +1 ; WHILE CH IN ['0'..'9'] DO BEGIN DY := DY+1 ; STRING[DY] := CH ; J := J+DX ; READ(CH) ; IF CH = '.' THEN BEGIN DX := 0 ; READ(CH) END ; END ; IF CH = 'E' THEN BEGIN READ(P) ; J := J+P ; IF (J < -63) OR (J > 63) THEN BEGIN ERROR(191); J := 0; END; END; J := J+64 ; IF NEGATE THEN J := J+128 ; FOR I := DY+1 TO 14 DO STRING[I] := '0' ; CODE[IC] := ZLDC8 ; IC := IC+1 ; ZCNT[ZLDC8] := ZCNT[ZLDC8]+1 ; IF STRING[1] = '0' THEN J := 0 ; FOR I := 1 TO 7 DO BEGIN CODE[IC] := (ORD(STRING[I*2-1])-ORD('0') ) * 16 + (ORD(STRING[I*2] )-ORD('0')) ; IC := IC+1 ; END ; CODE[IC] := J ; IC := IC+1 ; P := 4 ; " REPEAT READ(INPUT,CH) ; UNTIL CH = ',' ; READ(INPUT,R); " "ERROR(140 (* LODC R *) ) ;" END; 'N' :; (*P,Q = 0*) 'S' :BEGIN P := 4; "S := [ ];" REPEAT READ(INPUT,CH) ; UNTIL CH = '(' ; CODE[IC] := ZLDC8 ; IC := IC+1 ; ZCNT[ZLDC8] := ZCNT[ZLDC8]+1 ; FOR I := 0 TO 7 DO BEGIN "J := I*16 ;" READ(INPUT, S1, CH(*,*)) ; CODE[IC] := S1 ; IC := IC+1 ; END (* FOR I :=..*) ; END END (*CASE*) ; IF P <> 4 THEN BEGIN NEGATE := Q < 0 ; IF NEGATE THEN Q := -Q ; IF Q < 32 THEN (*LOAD SHORT CONST *) BEGIN CODE[IC] := ZLDC1+Q ; IC := IC+1 ; ZCNT[ZLDC1] := ZCNT[ZLDC1]+1 ; END ELSE IF Q <= 255 THEN BEGIN CODE[IC] := ZLDC2 ; CODE[IC+1] := Q ; IC := IC+2 ; ZCNT[ZLDC2] := ZCNT[ZLDC2]+1 ; END ELSE (* LOAD LARGE CONSTANT *) BEGIN CODE[IC] := ZLDC ; CODE[IC+1] := Q DIV 256 ; CODE[IC+2] := Q MOD 256 ; IC := IC+3 ; ZCNT[ZLDC] := ZCNT[ZLDC]+1 ; END (* LARGE CONST *) ; IF NEGATE THEN BEGIN CODE[IC] := ZNGI ; ZCNT[ZNGI] := ZCNT[ZNGI]+1 ; IC := IC+1 ; END ; END (* LOAD CONST INT, CHAR, BOOL, NIL *) ; END; PLOD : BEGIN "READ(INPUT, CH) ; CASE CH OF 'I','C','B','A': T := INT ; 'R': T := REEL ; 'S': T := SETT ; END (* CASE *) ; " READ(INPUT, TCH(*TYPE*), CH (*,*), P, CH (*,*), Q) ; IF TCH = 'R' THEN TCH := 'S' ; P := P-1 ; IF P > 7 THEN ERROR(162 (* LEVEL TOO HIGH *) ); " IF T = REEL THEN ERROR(101 (* 'LOD' REAL OPERAND *) ) ELSE " IF (TCH = 'S') OR ((P > 0) AND (P < LEVEL)) OR (Q > 63) THEN IF (TCH <> 'S') AND (P = GLOBAL) AND (Q <= 511) THEN BEGIN CODE[IC] := ZLODG2 ; CODE[IC+1] := Q DIV 2 ; ZCNT[ZLODG2]:= ZCNT[ZLODG2]+1 ; IC := IC+2 ; END ELSE BEGIN (* LOAD SET, NON LOCAL/NON GLOBAL OR LARGE ADR *) IF TCH = 'S' THEN BEGIN CODE[IC] := ZLOD8; ZCNT[ZLOD8] := ZCNT[ZLOD8]+1 END ELSE BEGIN CODE[IC] := ZLOD ; ZCNT[ZLOD] := ZCNT[ZLOD]+1 END ; IF Q > 16383 THEN ERROR(102 (*'LOD' OFFSET TOO LARGE*)) ; CODE[IC+1] := P*32 + Q DIV 512 ; CODE[IC+2] := (Q MOD 512) DIV 2 ; IC := IC+3 ; END ELSE (* LOAD LOCAL/GLOBAL SMALL OFFSET *) BEGIN IF P = LEVEL THEN I := ZLODL ELSE I := ZLODG ; ZCNT[I] := ZCNT[I]+1 ; IF I = ZLODL THEN I := ZLODG+1 ; (* DISTRIBUTE OPCODE *) CODE[IC] := I + Q ; IC := IC+1 ; END ; IF ODD(Q) THEN ERROR(125) ; END (* LOD *) ; PSTR : BEGIN "READ(INPUT, CH) ; CASE CH OF 'I','C','B','A': T := INT ; 'R': T := REEL ; 'S': T := SETT ; END (* CASE *) ; " READ(INPUT, TCH(*TYPE*), CH(*,*), P, CH(*,*), Q) ; P := P-1 ; IF P > 7 THEN ERROR(162 (* LEVEL TOO HIGH *) ) ; IF TCH = 'R' THEN TCH := 'S' ; " IF T = REEL THEN ERROR(108 (* 'STR' REAL OPERAND *) ) ELSE " IF (TCH = 'S') OR ((P > GLOBAL) AND (P < LEVEL)) OR "(Q > 127)" (Q > 255) THEN BEGIN (* LOAD SET, NON LOCAL/NON GLOBAL OR LARGE ADR *) IF TCH = 'S' THEN BEGIN CODE[IC] := ZSTRS ; ZCNT[ZSTRS] := ZCNT[ZSTRS]+1 ; END ELSE BEGIN CODE[IC] := ZSTR ; ZCNT[ZSTR] := ZCNT[ZSTR]+1 ; END ; CODE[IC+1] := P*32 + Q DIV 512 ; CODE[IC+2] := (Q MOD 512) DIV 2 ; IC := IC+3 ; ZCNT[ZSTR] := ZCNT[ZSTR+1] ; IF Q > 16383 THEN ERROR(104 (* 'STR' OFFSET TOO LARGE *) ) ; END ELSE (* STORE LOCAL/GLOBAL SMALL OFFSET *) BEGIN CODE[IC] := ZSTRLG ; I := Q DIV 2 ; IF P = LEVEL THEN CODE[IC+1] := I ELSE CODE [IC+1] := I+128 ; (* STORE GLOBAL VAR *) ZCNT[ZSTRLG] := ZCNT[ZSTRLG]+1 ; IC := IC+2 ; END ; END (* LOD,STR *) ; PLDA : BEGIN READ(INPUT, P, CH(*,*), Q) ; P := P-1 ; IF P > 7 THEN ERROR(162 (* LEVEL TOO HIGH *) ); (* IF NEEDED, WE CAN ASSUME ALL OFFSETS ARE WORD OFFSETS AND EXTEND THE OFFSET RANGE BY ONE BIT *) IF ((P = GLOBAL) OR (P = LEVEL)) AND ("Q < 128" Q < 256) THEN BEGIN CODE[IC] := ZLDALG ; Q := Q DIV 2 ; IF P <> LEVEL THEN Q := Q+128 ; (* LOAD GLOBAL ADDRESS *) ZCNT[ZLDALG] := ZCNT[ZLDALG]+1 ; CODE[IC+1] := Q ; IC := IC+2 ; END ELSE BEGIN CODE[IC] := ZLDA ; CODE[IC+1] := P*32 + Q DIV 512 ; CODE[IC+2] := (Q MOD 512) DIV 2 ; IF Q > 16383 THEN ERROR(106 (* LDA OFFSET TOO LARGE*) ) ; ZCNT[ZLDA] := ZCNT[ZLDA]+1 ; IC := IC+3 ; END ; END (* LDA *) ; PCUP: BEGIN READ(INPUT, CH(*TYP*),CH(*,*), P (*PRM CNT*), CH, CH(*,$*), Q) ; I := -1 ; REPEAT I := I+1 UNTIL (PROC_INX[I] = Q) OR (I = PROC_CNT) ; (* I CONTAINS PROC INDEX *) IF I < 16 THEN BEGIN CODE[IC] := ZCUP1+I ; IC := IC+1 ; ZCNT[ZCUP1] := ZCNT[ZCUP1]+1 ; END ELSE BEGIN IF I >= PROC_CNT THEN ERROR(112 (* UNDEF PROC *) ) ; CODE[IC] := ZCUP ; CODE[IC+1] := I ; IC := IC+2 ; ZCNT[ZCUP] := ZCNT[ZCUP]+1 ; END ; END (* CUP *) ; PRET, PMST : BEGIN READ(INPUT, TCH) ; IF TCH = 'R' THEN TCH := 'S' ; "CASE CH OF 'P': P:=0; 'I': P:=1; 'A': P:=2; 'B': P:=3; 'C': P:=4; 'R': P:= 5 ; 'S': P:= 6 END; " IF OP = PRET THEN BEGIN IF LEVEL > 0 THEN CODE[IC] := ZRET ELSE BEGIN CODE[IC] := ZLDC1 ; IC := IC+1 ; CODE[IC] := ZCSP1+13 (*ZXIT*) ; END ; IF TCH = 'S' THEN CODE[IC] := ZRETF8 ELSE IF TCH <> 'P' THEN CODE[IC] := ZRETF ; IF TCH = 'P' THEN ZCNT[ZRET] := ZCNT[ZRET]+1 ELSE ZCNT[ZRETF] := ZCNT[ZRETF]+1 ; END ELSE (* OP = PMST *) BEGIN CODE[IC] := ZMST ; IF TCH <> 'P' THEN BEGIN IF TCH = 'S' THEN CODE[IC] := ZMSTF8 ELSE CODE[IC] := ZMSTF8 ; (* IN FACT 'ZMSTF' *) ZCNT[ZMSTF] := ZCNT[ZMSTF]+1 ; END ELSE ZCNT[ZMST] := ZCNT[ZMST] + 1 ; END ; IC := IC+1 ; END ; PDEC,PINC : BEGIN READ(INPUT, TCH(*TYPE*), CH(*,*), Q) ; IF Q > 255 THEN ERROR(168 (* INC/DEC OPERAND TOO LARGE *)) ; IF (OP = PDEC) AND (Q = 1) THEN BEGIN CODE[IC] := ZDEC1 ; ZCNT[ZDEC1] := ZCNT[ZDEC1]+1 ; END ELSE IF OP = PINC THEN BEGIN CODE[IC] := ZADIC ; CODE[IC+1] := Q ; IC := IC+1 ; ZCNT[ZADIC] := ZCNT[ZADIC]+1 ; END ELSE BEGIN IF Q < 32 THEN BEGIN # CODE[IC] := ZLDC1 + Q ; ZCNT[ZLDC1] := ZCNT[ZLDC1]+1 ; IC := IC+1 ; END ELSE BEGIN CODE[IC] := ZLDC2 ; CODE[IC+1] := Q ; IC := IC+2 ; ZCNT[ZLDC2] := ZCNT[ZLDC2]+1 ; END ; IF OP = PDEC THEN BEGIN CODE[IC] := ZSBI ; ZCNT[ZSBI] := ZCNT[ZSBI]+1 END ELSE BEGIN CODE[IC] := ZADI ; ZCNT[ZADI] := ZCNT[ZADI]+1 END ; END (* ~ (OP = PDEC) AND (Q = 1) *) ; IC := IC+1 ; END (* INC,DEC *) ; PIND : BEGIN READ(INPUT, TCH(*TYPE*), CH (*,*), Q) ; IF TCH = 'R' THEN TCH := 'S' ; "IF TCH = 'R' THEN ERROR(107 (* 'IND R' ENCOUNTERED *) ) ELSE" IF (Q < 16) AND (TCH <> 'S') THEN BEGIN CODE[IC] := ZIND1 + Q ; IC := IC+1 ; ZCNT[ZIND1] := ZCNT[ZIND1]+1 END ELSE (* LARGE DISPLACEMENT *) BEGIN CODE[IC] := ZIND ; IF TCH = 'S' THEN BEGIN CODE[IC] := ZINDS ; ZCNT[ZINDS] := ZCNT[ZINDS]+1 END ELSE BEGIN CODE[IC] := ZIND ; ZCNT[ZIND] := ZCNT[ZIND]+1 END ; CODE[IC+1] := Q ; IC := IC+2 ; IF Q > 255 THEN ERROR(110 (* LARGE OFFSET FOR ' IND ' *) ) ; END ; END (* IND *) ; PSTO : BEGIN READ(INPUT, TCH) ; IF (TCH ='R') OR (TCH ='S') THEN I := ZSTOS ELSE I := ZSTO ; CODE[IC] := I ; IC := IC+1 ; ZCNT[I] := ZCNT[I]+1 ; END (* PSTO *) ; PIXA : BEGIN READ(INPUT, Q) ; IF Q < 16 THEN (* SHORT OPERAND *) BEGIN CODE[IC] := ZIXA1+ Q ; IC := IC+ 1 ; ZCNT[ZIXA1] := ZCNT[ZIXA1]+1 ; END ELSE BEGIN CODE[IC] := ZIXA ; CODE[IC+1] := Q DIV 256 ; CODE[IC+2] := Q MOD 256 ; ZCNT[ZIXA] := ZCNT[ZIXA]+1 ; IC := IC+3 ; END ; END (* IXA *) ; PFJP,PUJP: BEGIN READ(INPUT, CH (*L*), I(*INT LABEL*)) ; J := ZFJP ; IF OP = PUJP THEN J := ZUJP ; IF LABELTAB[I].ST = DEFINED THEN (* BACKWARD BRANCH *) BEGIN CODE[IC] := J+LABELTAB[I].VAL DIV 256 ; CODE[IC+1] := LABELTAB[I].VAL MOD 256 ; END ELSE (* FORWARD BRANCH *) BEGIN CODE[IC] := J ; CODE[IC+1] := LABELTAB[I].VAL ; LABELTAB[I].VAL := IC+1 ; END ; IC := IC+2 ; ZCNT[J] := ZCNT[J]+1 ; END ; (*++++++ PABI, PADI, PSBI, PMPI, PNGI, PDVI, PMOD, PAND, PIOR, PNOT, PODD, PCHK, PINN, PINT, PUNI, PDIF, PSGS, PRST, PSQI, PABR, PADR, PSBR, PMPR, PDVR, PNGR, PFLT, PFLO, PSQR, PENT, PCSP, PEQU, PNEQ, PLEQ, PLES, PGEQ, PGRT, PNEW, PSAV, PXJP, PMOV : ASSEM2 ; ++++*) (*+++ ASSEM2 COPIED TO HERE +++*) PENT : (* THIS SHOULD BE FIXED TO READ PARM LENGTH *) BEGIN (* RESET INSTR COUNTER *) FOR I := MINLBL TO MAXLBL DO BEGIN LABELTAB[I].VAL := 0 ; LABELTAB[I].ST := ENTERED END; READ(INPUT, TCH) ; IF TCH = 'P' THEN P := 0 ELSE IF (TCH = 'S') OR (TCH = 'R') THEN P := 8 " ELSE IF TCH = 'R' THEN ERROR(124 (* REAL PROC *) ) " ELSE P := 2 ; " WHILE TCH <> ',' DO READ(INPUT,TCH) ;" (* GET LEVEL *) READ(INPUT, CH (*,*), LEVEL) ; LEVEL := LEVEL-1 ; IF LEVEL > 7 THEN ERROR(127 (* PROCEDURE NESTING TOO DEEP *) ) ; CODE[0 "IC"] := "P*8+"LEVEL*2 ; READ(INPUT,CH,CH(*,$*),I) ; (*READ PROC_SIZE LABEL*) CODE[3"IC+2"] := LABELTAB[I].VAL ; CODE[2"IC+1"] := 0 ; LABELTAB[I].VAL := 3"IC+2" ; (* SET CODE[1] TO -(PARM AREA LENGTH) *) READ(INPUT, CH, P) ; CODE[1] := 256-(P+LNKAREA) ; IF P = 0 THEN CODE[1] := 0 ; WHILE INPUT@ = ' ' DO GET(INPUT) ; FOR J := 1 TO 6 DO BEGIN (* INCLUDE THE PROC NAME IN THE PROC HEADER *) READ(INPUT,CH) ; CODE[J+3"IC+3+J"] :="ASCII[CH]"ORD(CH)+ABS ; PROC_ID[CURPROC,J] := CH ; END ; READ(INPUT, PROC_ID[CURPROC,7] ) ; IC := 10 ; OLDIC := 0 ; ZCNT[ZENT] := ZCNT[ZENT]+1 ; " WRITELN(OUTPUT) ; " WRITE(OUTPUT, PROC_ID[CURPROC]:8,' ') ; END ; (* PENT *) PCSP : BEGIN ### # READ(INPUT,"NAME"CH) ; Q := SPCODE[ ORD(CH) ] ; " WHILE (NAME<>SPTABLE[Q]) AND (Q < SPCNT) DO Q := Q+1 ; IF NAME <> SPTABLE[Q] THEN BEGIN WRITE(NAME:5) ;ERROR(113 (* UNDEF CSP *) ) END ### # ELSE ### # WRITE('CSP', Q) ; ### # WRITELN( SPTABLE[Q]:5, Q ) ; " ### # IF Q >= QNOP THEN ERROR(113) ### # ELSE IF Q < 16 THEN BEGIN IF (Q = 7 (*WRS*)) AND PACKSTRNG THEN BEGIN CODE[IC] := ZSPWRP ; ZCNT[ZSPWRP] := ZCNT[ZSPWRP]+1 ; PACKSTRNG := FALSE ; END ELSE BEGIN CODE[IC] := ZCSP1+Q ; ZCNT[ZCSP1] := ZCNT[ZCSP1]+1 ; END ; IC := IC+1 ; END ELSE BEGIN CODE[IC] := ZCSP ; CODE[IC+1] := Q ; IC := IC+2 ; ZCNT[ZCSP] := ZCNT[ZCSP]+1 ; END ; END (* CSP *) ; PEQU,PNEQ,PLEQ,PLES,PGEQ,PGRT : BEGIN READ(INPUT, TCH) ; " CASE CH OF 'A': P := 0; 'I': P := 1; 'C': P := 2; 'B': P := 3; 'S': P := 4; 'R': P := 5; 'M' :BEGIN P := 6; READ(INPUT,CH,Q) ; END END ; " (* CMPOP[1..6] = 0, 1, 2, 3, 4, 5 *) (* IF ENOUGH UNUSED OPCODES ARE LEFT , (* THIS MAY BE CHANGED TO A TWO BYTE INST *) (*M*) IF TCH = 'M' THEN (* STRING COMARISON *) BEGIN READ(CH, Q) ; CODE[IC] := ZCMPM ; CODE[IC+1] := CMPOP[OP] "+ P DIV 252" ; CODE[IC+2] := Q DIV 2 ; IF Q >= 512 THEN ERROR(105 (*STRING TOO LONG*) ) ; IC := IC+3 ; ZCNT[ZCMPM] := ZCNT[ZCMPM]+1 ; END ELSE (*S*) IF TCH = 'S' THEN BEGIN CODE[IC] := ZCMPM ; IF OP = PGEQ THEN OP := PLES ; CODE[IC+1] := CMPOP[OP] + 6 ; IC := IC+2 ; ZCNT[ZCMPRS] := ZCNT[ZCMPRS]+1 ; END ELSE (*R*) IF TCH = 'R' THEN BEGIN "ERROR(130 (*REAL COMPARE*) ) ;" CODE[IC] := ZCMPM ; CODE[IC+1] := CMPOP[OP] + 10 ; IC := IC+2 ; ZCNT[ZCMPRS] := ZCNT[ZCMPRS]+1 ; END ELSE (*A, I, C, B*) BEGIN I := ZCMPM+CMPOP[OP]+1 ; CODE[IC] := I ; IC := IC+1 ; ZCNT[I] := ZCNT[I]+1 ; END ; END; (* EQU, NEQ, GEQ .... *) PCHK : BEGIN READ(INPUT,DX,DY); ERROR(141 (* CHK INSTR *) ) ; " CASE CH OF 'I','C': T := INT ; 'S': T := SETT ; 'A': T := ADR ; 'J': T := INDEX END ; " END; PNEW, PSAV : BEGIN Q := 0 ; IF OP = PNEW THEN READ(INPUT, Q) ; CODE[IC] := ZNEW ; CODE[IC+1] := Q ; IC := IC+2 ; ZCNT[ZNEW] := ZCNT[ZNEW]+1 ; IF Q > 255 THEN ERROR(146 (* LARGE OPERAND FOR 'NEW' *) ) ; END (* NEW *) ; PXJP : BEGIN READ(INPUT, CH, I); (* LABEL OF THE LOWER BOUND *) CODE[IC] := ZLDC ; CODE[IC+2] := LABELTAB[I].VAL ; LABELTAB[I].VAL := IC+2 ; CODE[IC+1] := 0 ; CODE[IC+3] := ZSBI ; (* SUBTRACT LOWER BOUND *) CODE[IC+4] := ZXJP ; CODE[IC+5] := LABELTAB[I+1].VAL ; LABELTAB[I+1].VAL := IC+5 ; CODE[IC+7] := LABELTAB[I+2].VAL ; LABELTAB[I+2].VAL := IC+7 ; CODE[IC+6] := 0 ; (* CASE EXIT LABEL *) ; CODE[IC+9] := LABELTAB[I+3].VAL ; LABELTAB[I+3].VAL := IC+9 ; CODE[IC+8] := 0 ; IC := IC+10 ; ZCNT[ZXJP] := ZCNT[ZXJP]+1 ; ZCNT[ZSBI] := ZCNT[ZSBI]+1 ; ZCNT[ZLDC] := ZCNT[ZLDC]+1 END (*PXJP*) ; PMOV : BEGIN READ(INPUT, Q) ; IF PACKSTRNG THEN BEGIN CODE[IC] := ZMVP ;ZCNT[ZMVP] := ZCNT[ZMVP]+1 ; PACKSTRNG := FALSE END ELSE BEGIN CODE[IC] := ZMOV ; ZCNT[ZMOV] := ZCNT[ZMOV]+1 END ; CODE[IC+1] := Q DIV 2 ; IC := IC+2 ; IF Q >= 512 THEN ERROR(114 (* MOVE OPERAND TOO LARGE *) ) ; END (* MOV *) ; PABI, PADI, PSBI, PMPI, PNGI, PDVI, PMOD, PAND, PIOR, PNOT, PODD, PCHR, PORD, PINN, PINT, PUNI, PDIF, PSGS, PRST : BEGIN Q := ZCNV[OP] ; CODE[IC] := Q ; IC := IC+1 ; ZCNT[Q] := ZCNT[Q]+1 ; END (* NO OPERAND OPCODES *) ; PSQI, PSQR : ERROR(152 (* INSTRUCTIONS NOT YET IMPLEMENTED *) ) ; PABR, PADR, PSBR, PMPR, PDVR, PNGR, PFLT, PFLO, PTRC ",PRND" : BEGIN "ERROR(154 (* REAL ARITHMETIC INSTRUCTIONS *) ) ;" CODE[IC] := ZREAL ; CODE[IC+1] := ZCNV[OP] ; IC := IC+2 ; ZCNT[ZREAL] := ZCNT[ZREAL+1] ; END (* REAL ARITHMETIC *) ; (*+++ END ASSEM2 +++*) PTON: TRACE:= TRUE ; PTOF: TRACE:= FALSE ; END; (*CASE*) READLN(INPUT); (* STORE INSTRUCTION *) " IF OP <> PLOC THEN BEGIN IF TRACE THEN (* LIST THE OBJECT CODE *) BEGIN WRITE(OUTPUT, PC:8, LEVEL:5, NAME:5, T:4, P:4, Q:8, ' ### ', OLDIC:6, ' --', IC:5, ' '); FOR I := OLDIC TO IC-1 DO WRITE(CODE[I]:4) ; WRITELN(OUTPUT) ; END ; OLDIC := IC ; PC := PC+1 ; END ; " PC := PC+1 ; END; (* ASSEMBLE *) (*------------------------------------------------------------------------*) BEGIN (*LOAD*) " TIMER := CLOCK(1) ; " WRITELN(OUTPUT, ' < STANFORD P_CODE ASSEMBLER/COMPRESSOR,', ' VERSION OF MARCH 78 >') ; WRITELN(OUTPUT) ; INIT ; (* INITIALIZE FOR LOADING THE P_PROGRAM *) GENERATE; (* GENERATE THE P_PROGRAM SEGMENT *) " IF TRACE THEN DUMP ; " " Q := (CLOCK(1)-TIMER) DIV 100 ; " WRITELN(OUTPUT) ; WRITELN(OUTPUT, ' ') ; WRITELN(OUTPUT,'****', GPC-1:6, GIC:6, ' INSTR./BYTES LOADED.' ", Q DIV 10: 4, '.', Q:1, ' SECONDS IN LOADING.'") ; " TIMER := CLOCK(1) ; " END; (*LOAD*) (*------------------------------------------------------------------------*) BEGIN (* MAIN *) RESET(INPUT) ; REWRITE(OUTPUT) ; RESET(PRD) ; REWRITE(PRR) ; LOAD; (* ASSEMBLES AND STORES CODE *) EXIT(ERRCNT) ; END (*PCODE_ASSEMBLER*).