Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Posting-Version: version B 2.10.1 6/24/83 (MC830713); site vu44.UUCP Path: utzoo!linus!philabs!cmcl2!seismo!mcvax!vu44!jack From: jack@vu44.UUCP (Jack Jansen) Newsgroups: net.sources Subject: Motorola 6809 cross-assembler (part 2 of 2) Message-ID: <599@vu44.UUCP> Date: Tue, 19-Feb-85 05:49:46 EST Article-I.D.: vu44.599 Posted: Tue Feb 19 05:49:46 1985 Date-Received: Thu, 21-Feb-85 05:34:33 EST Reply-To: a6809-list@htsa.UUCP Organization: VU Informatica, Amsterdam Lines: 1711 : 'This is a shell archive. Run with the real shell,' : 'not the seashell. It should extract the following:' : ' a6809.p symb.inc inpt.inc outp.inc pars.inc exec.inc ' echo x - a6809.p sed 's/^X//' <<'EndOfFile' >a6809.p X# XPROGRAM MAIN(INP,OUTPUT,HEX,MNEMFILE); X(* X * a6809 - mc6809 cross-assembler. X * X * Copyright : Jack Jansen en Hans Pronk, H.T.S."A", 1982. X * History : X * Jack Jansen, 10-10-83 , V1.0 PRIME : X * FCC verbeterd, string werd niet gelezen (a6809.pars) X * ORG aan begin pass 2 (a6809.main) X * R mode file gemaakt, programmanaam veranderd in MAIN. X * Errors detected op de terminal (a6809.main) X * Parity strippen in strings (a6809.exec) X * Octale getallen (a6809.inpt) X * ESC-L voor de hex file (a6809.main) X * Filenamen goed inlezen (a6809.main) X * Jack Jansen, 11-10-83, V1.0 UNIX : X * Versie UNIX gemaakt. X * Upper/Lower case mapping. X * Jack, 28-feb-84 : X * NEXTCH checkte niet of er >= 80 chars waren ingelezen. X * Hans Pronk, 16-11-84 , V1.1 Unix : X * fatal error ( eof ) verbeterd (a6809.main) X * direct page initialiseerd nu goed X * start adress voor auto start geimplementeerd. X * PC is gelijk aan PCR ( a6809.exec ) X * op0 geen error op commentaar ( a6809.pars ) X * MAKEOPER modulair gemaakt ( en gotoes weggewerkt ) ( a6809.pars ) X * X *) X X (* Define ONE of the following constants : *) X#define UNIX (* For a UNIX version *) X (* #define PRIME (* For a PRIME version *) X(* X A6809 CONSTANT DEFINITIONS. X ====== ======== ============ X*) XCONST X#ifdef PRIME X VERSION = 'A6809 V1.1 PR1ME'; X MNEMNAM = 'HTSAME>ETC>A6809.MNEMONICS'; X#else X VERSION = 'A6809 V1.1 UNIX '; X#endif X FILENAMELENGTH = 32; X NOFNAME = ' '; X MAXMNEM = 160; X STRLEN = 6; (* LENGTH OF IDENTIFIERS *) X MAXERR = 3; (* # ERRORS PER LINE *) X MAXCODE = 5; (* # CODES PER LINE *) X HBMAX = 30; (* SIZE OF HEX BUFFER *) X LINESPP = 55; (* LISTING LINES/PAGE *) X LINLEN = 80; (* CHARS/LINE *) X LEGEID = ' '; (* GEEN IDENTIFIER *) X(* X A6809 TYPE DEFINITIONS. X ====== ==== ============ X*) XTYPE X STRING = PACKED ARRAY[ 1 .. STRLEN ] OF CHAR; X#ifdef PRIME X FILENAME = PACKED ARRAY[ 1 .. FILENAMELENGTH ] OF CHAR; X#endif X X VARSTRING = ^VARSRECORD; X VARSRECORD = RECORD X INHOUD : CHAR; X NEXT : VARSTRING; X END; X X IDRECORD = ^IDENTRY; X IDENTRY = RECORD X WAARDE,DEFLIN : INTEGER; X END; X X ARGTYPE = ( ARGIND,ARGNUM,ARGREG,ARGSTR,ARGIMM,ARGOPT ); X X OPTYPE = ( OPNAM, OPFCB, OPFCC, OPRMB, OPEQU, OPSDP, OPEND, X OPOPT, OP0, OP1B, OP1W, OPEMT, OPREL, OPREG, OPSTK ); X OPCSET = SET OF OPTYPE; X X REGISTER = ( REGX,REGY,REGU,REGS,REGPC,REGD,PCREG, X REGA,REGB,REGCC,REGDP,NOREG ); X REGSET = SET OF REGISTER; X X SYMBOL = ( NAMSY,NUMSY,SPACESY,EOFSY,ADDSY,MINSY,MULSY,DIVSY, X MODSY,ANDSY,ORSY,LBRACKSY,RBRACKSY,LESSY,GREATERSY, X LPARSY,RPARSY,IMMSY,COMMASY,DOTSY,EOLNSY,ERRORSY); X X MNEMRECORD = RECORD X NAME : STRING; X OPT : OPTYPE; X OPC : INTEGER; X END; X X OPLIST = ^OPRECORD; X OPRECORD = RECORD X NEXT : OPLIST; X CASE ARGTP : ARGTYPE OF X ARGIND : ( AILIST : OPLIST ); (* [ ...... ] *) X ARGNUM : ( ANVAL : INTEGER; (* NUM, NUM *) X ANFORC , X ANLONG : BOOLEAN ); X ARGREG : ( ARREG : REGISTER; (* REGISTER NAME *) X ARINC : -2 .. 2 ); (* # OF INC/DEC *) X ARGSTR : ( ASTEXT : VARSTRING );(* OTHER STRINGS *) X ARGIMM : ( AIVAL : INTEGER ); (* # *) X ARGOPT : ( AOOPT : STRING ); (* STRING FOR OPT *) X END; X X STMT = ^STMTRECORD; X STMTRECORD = RECORD X LEBEL : STRING; X OPCODE : INTEGER; X OPT : OPTYPE; X OPERANDS : OPLIST; X END; X X TREE = ^TREELEAF; X TREELEAF = RECORD X LLINK,RLINK : TREE; (* LINKER/RECHTER ZOON *) X NAME : STRING; (* IDENTIFIER NODE *) X DATA : IDRECORD; (* DATA IN DEZE NODE *) X END; X(* X A6809 GLOBAL VAR DEFINITIONS. X ====== ====== === ============ X*) XVAR X I : INTEGER; X INP, X HEX : TEXT; (* HEX OUTPUT FILE *) X MNEMFILE : FILE OF MNEMRECORD; X#ifdef PRIME X INPNAME, (* INPUT FILE NAME *) X OUTNAME, (* OUTPUT FILE NAME *) X HEXNAME : FILENAME; (* AND HEXFILE NAME *) X#endif X C : CHAR; (* INGELEZEN CHARACTER *) X SY : SYMBOL; (* INGELEZEN TERMINAL *) X SYNAM : STRING; (* INGELEZEN IDENTIFIER *) X SYNUM : INTEGER; (* INGELEZEN GETAL *) X SYCHAR : ARRAY[CHAR] OF SYMBOL; (* MAP CHAR->SYMBOLTYPE *) X REGNAME: ARRAY[REGISTER] OF STRING; (*NAMES OF REGISTERS *) X MNEMTAB : ARRAY[1..MAXMNEM] OF MNEMRECORD; (* MNEMONIC TABLE*) X TITLE : VARSTRING; (* PAGE HEADER *) X ROOT : TREE; (* FIRST IDENTIFIER *) X ST : STMT; (* STATEMENT *) X COMMENT, (* TRUE IF COMMENTLINE *) X DEBUG, (* DEBUGGING ON *) X OPTLIST, (* TRUE IF LISTING WTD *) X OPTBIN, (* TRUE IF BINARY WANTED*) X OPTSYM, (* TRUE IF SYMTABLE WTD *) X PASS2, (* TRUE ALS IN PASS 2 *) X INITIALIZING, (* TRUE ALS IN INITIALISATIE*) X STOPPED: BOOLEAN; (* TRUE ALS 'END' *) X LOCCNTR, (* LOCATION COUNTER *) X OLOCCNTR, (* OLD LOC. COUNTER *) X CODELOC, (* HEXBUF LOCATION *) X CODELIN, (* INDEX IN 'CODES' *) X CODECNTR, (* INDEX IN 'HEXBUF' *) X LINCNTR, (* LINE COUNTER *) X PAGCNTR, (* PAGE COUNTER *) X CHRCNTR, (* CHARPOS COUNTER *) X ERRLIN , (* # ERRORS IN LINE *) X DIRPAG , (* SETDP VARIABLE *) X STARTADR , (* ADRESS FOR AUTOSTART *) X MNEMLEN, (* LENGTH OF MNEMTAB*) X ERRCNTR: INTEGER; (* ERROR COUNTER *) X ASSOPC, (* PSUEDO-OPERATIONS *) X PROOPC : OPCSET; (* REAL OPERATIONS *) X INXREG, (* INDEX REGISTERS *) X ACCREG : REGSET; (* ACCU OFFSET REGS. *) X LINE : PACKED ARRAY[1..LINLEN] OF CHAR; X (* LINE FOR LISTING *) X ERRORS : PACKED ARRAY[1..MAXERR] OF CHAR; X (* ERROR CHARACTERS *) X CODES : ARRAY[1..MAXCODE] OF INTEGER;(*LISTING BINARY CODES *) X HEXBUF : ARRAY[1..HBMAX] OF INTEGER; (* HEXFILE BUFFER *) X X(* X A6809 PROCEDURE/FUNCTION HEADERS. X ====== ========= ======== ======== XDE ROUTINES STAAN OP DE VOLGENDE FILES : X XA6809.SYMB X GETNAM X NEWNAM X XA6809.INPT X NEXTCH X INSYMBOL X INNAM X INNUM X ISINIT XA6809.OUTP X LISTLINE X PRINTHEX X OUTHEX X FLUSHEX XA6809.PARS X MAKEOPER X MAKEXPR X MAK1NUM X MAKESTMT X XA6809.EXEC X DOINIT X DOSTMT X REMTITLE X REGNYB X REGBIT X MKLEBEL X REMSTMT X REMOPLIST X DOOPER X X*) X{ *************************************** X XPROCEDURE NEXTCH; EXTERN; X(##* LEES VOLGENDE KARAKTER, EN STOP DAT IN 'C'. *##) X X XPROCEDURE INSYMBOL; EXTERN; X(##* LEES EEN SYMBOL EN ZET GOLBALE VAR'S SY,SYNUM,SYNAM. *##) X X XPROCEDURE ISINIT; EXTERN; X(##* ISINIT INITIALISEERT VOOR INSYMBOL. *##) X X XFUNCTION MAKEOPER : OPLIST; EXTERN; X(##* LEEST EEN LIJST MET OPERANDEN, EN RETURNT EEN POINTER NAAR *##) X(##* HET RESULTAAT *##) X X X XFUNCTION MAKESTMT : STMT; EXTERN; X(##* LEEST (MBV MAKEOPER) EEN REGEL, EN RETURNT EEN POINTER NAAR *##) X(##* HET RESULTAAT *##) X X XPROCEDURE DOSTMT(S : STMT); EXTERN; X(##* DOSTMT VOERT STATEMENTS UIT. *##) X X XFUNCTION NEWNAM(NAME : STRING; DATA : IDRECORD) : BOOLEAN; EXTERN; X(##* NEWNAM ZET NAAM 'NAME' MET DATA 'DATA' IN DE SYMBOLTABLE. *##) X(##* ER WORDT 'TRUE' GERETURNED ALS 'DATA' NIET GELIJK IS AAN *##) X(##* EEN EVENTUELE VORIGE 'DATA'. *##) X X XFUNCTION GETNAM(NAME : STRING) : IDRECORD; EXTERN; X(##* GETNAM RETURNT DE DATA BEHORENDE BIJ 'NAME', EN 'NIL' ALS *##) X(##* 'NAME' NIET GEVONDEN WORDT. *##) X X XPROCEDURE OUTHEX(VAL,LEN : INTEGER); EXTERN; X(##* OUTHEX OUTPUT 'LEN' BYTES VANUIT VAL NAAR DE LISTING EN NAAR *##) X(##* DE HEX FILE. *##) X X XPROCEDURE FLUSHEX; EXTERN; X(##* FLUSHEX SCHRIJFT DE BUFFER 'HEXBUF' NAAR DE 'HEX' FILE. *##) X X XPROCEDURE ERROR(C : CHAR); EXTERN; X(##* GEEFT ERRORMELDING 'C'. *##) X X XFUNCTION FIND(MNEM : STRING;VAR OPC : INTEGER; VAR TP : OPCTYP); X EXTERN; X(##* FIND ZOEKT MNEMONICS OP EN RETURNT 'OPC' EN 'TP'. *##) X X XPROCEDURE LISTLINE; EXTERN; X(##* LISTLINE LIST 1 REGEL, EN ZORGT VOOR PAGINERING,ETC. *##) X X********************************** } X(* FORWARD DEFINITIONS *) X XPROCEDURE ERROR( C : CHAR ) ; FORWARD; X XPROCEDURE FLUSHEX (LASTBLOK : BOOLEAN ); FORWARD; X XPROCEDURE PRINTHEX( VAR F : TEXT; NUM,SIZ : INTEGER);FORWARD; X X(* EXTERN DEFINITIONS *) X#ifdef PRIME XFUNCTION IAND(I,J : INTEGER) : INTEGER; EXTERN; (* BINARY AND *) X XFUNCTION IOR(I,J : INTEGER) : INTEGER; EXTERN; (* BINARY OR *) X X#else XFUNCTION IAND(I,J : INTEGER) : INTEGER; XBEGIN X ERROR('?'); X IAND := 0; XEND; X XFUNCTION IOR(I,J : INTEGER) : INTEGER; XBEGIN X ERROR('?'); X IOR := 0; XEND; X X#endif X X#include "symb.inc" X#include "inpt.inc" X#include "outp.inc" X#include "pars.inc" X#include "exec.inc" X X#ifdef PRIME XPROCEDURE INFNAM(VAR NM : FILENAME); X(* INFNAM LEEST EEN FILENAME VAN DE TERMINAL *) X(* VAR I : INTEGER; *) XBEGIN X WHILE (INPUT^ = ' ') AND NOT EOLN(INPUT) DO GET(INPUT); X(* FOR I := 1 TO FILENAMELENGTH DO *) X(* IF EOLN(INPUT) THEN NM[I] := ' ' ELSE READ(INPUT,NM[I]); *) X READ(INPUT,NM); XEND (* INFNAM *); X XPROCEDURE READOPT; X(* VAR I : INTEGER; *) XBEGIN X READLN; X WHILE ( INPUT^ = ' ') AND NOT EOLN DO X GET(INPUT); X(* FOR I := 1 TO STRLEN DO *) X(* IF INPUT^ IN ['A' .. 'Z'] THEN READ(SYNAM[I]) ELSE SYNAM[I] := ' '; *) XREAD(SYNAM); XFOR I := 1 TO STRLEN DO X IF SYNAM[I] IN ['a'..'z'] THEN X SYNAM[I] := CHR(ORD(SYNAM[I])+ORD('A')-ORD('a')); XEND (* READOPT *); X#endif X X XBEGIN (* OF MAIN PROGRAM *) X CHRCNTR := 0; X#ifdef PRIME X WRITELN(OUTPUT,'[',VERSION,']'); X WRITE(OUTPUT,'Input file - '); X INFNAM(INPNAME); X WRITE(OUTPUT,'Listing file - '); X READLN; X INFNAM(OUTNAME); X WRITE(OUTPUT,'Hex file - '); X READLN; X INFNAM(HEXNAME); X OPTBIN := HEXNAME <> NOFNAME; X OPTLIST:= OUTNAME <> NOFNAME; X DEBUG := FALSE; X INITIALIZING := TRUE; X REPEAT X WRITE('Option - '); X READOPT; X IF SYNAM <> LEGEID THEN OPTION(SYNAM); X UNTIL SYNAM = LEGEID; X IF INPNAME <> NOFNAME THEN RESET(INP,INPNAME); X IF HEXNAME <> NOFNAME THEN REWRITE(HEX,HEXNAME) X ELSE IF OPTBIN THEN REWRITE(HEX,'HEX.6809'); X IF OUTNAME <> NOFNAME THEN REWRITE(OUTPUT,OUTNAME); X%CHECKS OFF; X IF OUTNAME <> NOFNAME THEN WRITELN(CHR(1),CHR(1)); X%CHECKS ON; X#else X RESET(HEX); X READ(HEX,I); X OPTBIN := I <> 0; X READ(HEX,I); X OPTLIST := I <> 0; X READ(HEX,I); X DEBUG := I <> 0; X READ(HEX,I); X OPTSYM := I <> 0; X REWRITE(HEX); X#endif X IF OPTBIN THEN X WRITELN(HEX,CHR(27),'L'); (* ESC-L, labbus load sequence *) X INITIALIZING := FALSE; X ROOT := NIL; X PASS2 := FALSE; X TITLE := NIL; X#ifdef PRIME X IF INPNAME <> NOFNAME THEN RESET(INP,INPNAME) ELSE RESET(INP); X#else X RESET(INP); X#endif X NEXTCH; (* LEES EERSTE CHAR *) X MNEMINIT; (* INIT MNEMONICTABLE *) X ISINIT; (* INSYMBOL INIT. *) X DOINIT; (* DOSTMT INIT. *) X(************** PASS 1 *************) X LOCCNTR := 0; X OLOCCNTR := 0; X LINCNTR := 0; X PAGCNTR := 0; X ERRCNTR := 0; X CODELIN := 0; X DIRPAG := 0; X CODELOC := 0; X STARTADR := 0; X STOPPED := FALSE; X WHILE NOT STOPPED AND NOT EOF(INP) DO BEGIN X OLOCCNTR := LOCCNTR; X COMMENT := FALSE; X LINCNTR := LINCNTR+1; X ST := MAKESTMT; (* LEES STATEMENT *) X ERRORS := ' '; X ERRLIN := 0; X IF NOT COMMENT THEN X DOSTMT(ST); (* VOER STATEMENT UIT *) X IF DEBUG THEN LISTLINE; X CHRCNTR := 0; X CODELIN := 0; X IF NOT STOPPED AND NOT EOF(INP) THEN X BEGIN X READLN(INP); X NEXTCH; X END; X END; X OLOCCNTR := 0; X FLUSHEX(FALSE); X(************** PASS 2 *************) X PASS2 := TRUE; X STOPPED := FALSE; X LOCCNTR := 0; X OLOCCNTR := 0; X LINCNTR := 0; X CODELIN := 0; X PAGCNTR := 0; X ERRCNTR := 0; X CHRCNTR := 0; X CODELOC := 0; X STARTADR:=0; X DIRPAG := 0; X#ifdef PRIME X IF INPNAME <> NOFNAME THEN RESET(INP,INPNAME) ELSE RESET(INP); X#else X RESET(INP); X#endif X NEXTCH; X WHILE NOT STOPPED AND NOT EOF(INP) DO X BEGIN X COMMENT := FALSE; X LINCNTR := LINCNTR+1; X OLOCCNTR := LOCCNTR; X ERRLIN := 0; X ERRORS := ' '; X ERRLIN := 0; X ST := MAKESTMT; X IF NOT COMMENT THEN X DOSTMT(ST); X IF OPTLIST OR (ERRLIN > 0) THEN LISTLINE; X CHRCNTR := 0; X IF NOT STOPPED AND NOT EOF(INP) THEN X BEGIN X READLN(INP); X NEXTCH; X END; X END; X IF NOT STOPPED THEN (* EOF WITHOUT END PSEUDO OP *) X BEGIN X LINCNTR := LINCNTR +1; X ERRCNTR := ERRCNTR +1; X WRITELN('E ',LINCNTR:5,' **** NO END STATEMENT ***** '); X END; X IF OPTSYM THEN SYMTABLE; X WRITELN('Errors detected : ',ERRCNTR:1); X#ifdef PRIME X REWRITE(OUTPUT,'@TTY'); X WRITELN('Errors detected : ',ERRCNTR:1); X#endif X FLUSHEX(FALSE); X FLUSHEX(TRUE); XEND. EndOfFile echo x - symb.inc sed 's/^X//' <<'EndOfFile' >symb.inc X(* X A???? SYMBOLTABLE HANDLING. X ===== =========== ========= X*) X XPROCEDURE MNEMINIT; X(* MNEMINIT LEEST DE TABEL 'MNEMTAB' VAN DE FILE 'MNEMFILE'. *) X(* UITEINDELIJKE LENGTE KOMT IN MNEMLEN. MAX LEN IN 'MAXMNEM'. *) X(* DE FILE MOET GESORTEERD ZIJN, EN DE NAAM MOET IN 'MNEMNAM' *) X(* STAAN. *) XVAR X I : INTEGER; XBEGIN X#ifdef PRIME X RESET(MNEMFILE,MNEMNAM); X#else X RESET(MNEMFILE); X#endif X I := 0; X WHILE NOT EOF(MNEMFILE) DO BEGIN X I := I + 1; X IF I < MAXMNEM THEN MNEMTAB[I] := MNEMFILE^; X GET(MNEMFILE); X END; X(*DBG writeln(i,' Mnemonics gelezen.');*) X MNEMLEN := I; X IF I > MAXMNEM THEN BEGIN X WRITELN(OUTPUT,'**FATAL ERROR : MNEMONIC TABLE TOO LONG'); X MNEMLEN := 0; X END; XEND (* MNEMINIT *); X XPROCEDURE FIND(MNEM : STRING; VAR OPC : INTEGER; VAR TP : OPTYPE); X(* FIND ZOEKT EEN MNEMONIC OP EN RETURNT OPC EN TP *) XVAR X OLOW, OHIGH, LOW, MID, HIGH : INTEGER; XBEGIN X LOW := 1; X HIGH := MNEMLEN; X MID := (LOW+HIGH) DIV 2; X OLOW := LOW-1; X OHIGH := HIGH; X WHILE (MNEMTAB[MID].NAME<>MNEM)AND((OLOW<>LOW)OR(OHIGH<>HIGH)) DO BEGIN X OLOW := LOW; X OHIGH := HIGH; X IF MNEMTAB[MID].NAME < MNEM THEN LOW := MID X ELSE HIGH := MID; X MID := (LOW+HIGH) DIV 2; X END; X IF MNEMTAB[MID].NAME <> MNEM THEN BEGIN X ERROR('O'); X TP := OP0; X OPC := 254; X END ELSE BEGIN X TP := MNEMTAB[MID].OPT; X OPC:= MNEMTAB[MID].OPC; X END; XEND (* FIND *); X X XFUNCTION GETNAM(NAME : STRING) : IDRECORD; X(* GETNAM ZOEKT DE NODE MET NAAM 'NAME' OP, EN RETURN HET *) X(* IDRECORD DAT ERBIJ HOORT, OF NIL ALS 'NAME' NIET BESTAAT*) X XVAR X FOUND : BOOLEAN; X P : TREE; XBEGIN X P := ROOT; X FOUND := P=NIL; X IF NOT FOUND THEN FOUND := P^.NAME = NAME; X WHILE NOT FOUND DO BEGIN X IF P^.NAME < NAME THEN P := P^.LLINK X ELSE P := P^.RLINK; X FOUND := P = NIL; X IF NOT FOUND THEN FOUND := P^.NAME = NAME; X END; X IF P = NIL THEN GETNAM := NIL X ELSE GETNAM := P^.DATA; XEND (* FUNCTION GETNAM *); X XFUNCTION NEWNAM(NAME : STRING; DATA : IDRECORD):BOOLEAN; X(* NEWNAM ZET 'NAME' IN DE BOOM, ALS HIJ NOG NIET BESTAAT, *) X(* EN RETURNT 'TRUE' ALS ER GEEN VERSCHIL IS TUSSEN DE *) X(* NIEUWE EN (EVENTUELE) OUDE DATA. *) XVAR X P,OLDP : TREE; X SIGN,FOUND : BOOLEAN; XBEGIN X OLDP := NIL; X P := ROOT; X FOUND := P=NIL; X IF NOT FOUND THEN FOUND := P^.NAME=NAME; X WHILE NOT FOUND DO BEGIN X OLDP := P; X SIGN := P^.NAME < NAME; X IF SIGN THEN P := P^.LLINK X ELSE P := P^.RLINK; X FOUND := P = NIL; X IF NOT FOUND THEN FOUND := P^.NAME = NAME; X END; X IF P <> NIL THEN BEGIN X NEWNAM := (P^.DATA^.WAARDE=DATA^.WAARDE)AND X (P^.DATA^.DEFLIN=DATA^.DEFLIN); X P^.DATA := DATA; X END ELSE BEGIN X NEW(P); X P^.NAME := NAME; X P^.DATA := DATA; X P^.LLINK := NIL; X P^.RLINK := NIL; X IF OLDP = NIL THEN ROOT := P ELSE X IF SIGN THEN OLDP^.LLINK := P X ELSE OLDP^.RLINK := P; X NEWNAM := TRUE; X END; XEND (* FUNCTION NEWNAM *); X XPROCEDURE SYMTABLE; X(* SYMTABLE LIST DE SYMBOLTABLE, ALFABETISCH GESORTEERD. *) XVAR SYMDUN : INTEGER; XPROCEDURE L1SYM(P : TREE); X(* LIST EEN SYMBOOL EN DE BIJBEHORENDE BOOM *) XBEGIN X IF P^.RLINK <> NIL THEN L1SYM(P^.RLINK); X WRITE(' ',P^.NAME,P^.DATA^.DEFLIN : 5,' '); X PRINTHEX(OUTPUT,P^.DATA^.WAARDE,4); X WRITE(OUTPUT,' '); X SYMDUN := SYMDUN + 1; X IF SYMDUN > 4 THEN BEGIN X SYMDUN := 1; X WRITELN; X END; X IF P^.LLINK <> NIL THEN L1SYM(P^.LLINK); XEND (* L1SYM *); X XBEGIN (* OF SYMTABLE *) X SYMDUN := 1; X FOR SYMDUN := 1 TO 4 DO X WRITE(' NAME DEF VALUE '); X WRITELN; WRITELN; X SYMDUN := 1; X IF ROOT <> NIL THEN L1SYM(ROOT); X WRITELN; WRITELN; XEND (* SYMTABLE *); EndOfFile echo x - inpt.inc sed 's/^X//' <<'EndOfFile' >inpt.inc X(* X A6809 INPUT ROUTINES. X ===== ===== ========= X*) X XPROCEDURE NEXTCH; X(* NEXTCH LEEST HET VOLGENDE KARAKTER EN BEWAART HET VOOR LISTING *) XBEGIN X IF EOF(INP) THEN C := ' ' ELSE X IF EOLN(INP) THEN C := ' ' ELSE BEGIN X READ(INP,C); X IF CHRCNTR < LINLEN THEN X CHRCNTR := CHRCNTR+1; X LINE[CHRCNTR] := C; X(* X IF ('a' <= C) AND (C <= 'z') THEN X C := CHR(ORD(C)-ORD('a')+ORD('A')); X*) X END; XEND (* PROCEDURE NEXTCH *); X XPROCEDURE INNAM; X(* INNAM LEEST EEN NAAM ALS SY=NAMSY *) XVAR I : INTEGER; X S : SET OF CHAR; XBEGIN X S := ['A'..'Z', 'a'..'z', '0'..'9', '.']; X FOR I := 1 TO STRLEN DO X IF C IN S THEN BEGIN X IF C IN ['a'..'z'] THEN C:=CHR(ORD(C)-ORD('a')+ORD('A')); X SYNAM[I] := C; X NEXTCH; X END ELSE X SYNAM[I] := ' '; X WHILE C IN S DO NEXTCH; XEND (* PROCEDURE INNAM *); X XPROCEDURE INSYMBOL; X(* INSYMBOL LEEST HET VOLGENDE SYMBOOL VAN DE INPUTFILE EN *) X(* STOPT DAT IN 'SY'. ALS SY=NAMSY WORDT SYNAM INGEVULD, *) X(* ALS SY=NUMSY WORDT SYNUM INGEVULD. *) X XPROCEDURE INNUMB; X(* INNUMB LEEST EEN GETAL ALS SY=NUMSY *) XVAR X NUM,N,BASE : INTEGER; X ANY : BOOLEAN; XBEGIN X IF C = '''' THEN BEGIN X NEXTCH; X NUM := ORD(C) MOD 128; X NEXTCH; X END ELSE X IF C = '"' THEN BEGIN X NEXTCH; X NUM := ORD(C) MOD 128; X NEXTCH; X NUM := NUM*256 + ORD(C) MOD 128; X NEXTCH; X END ELSE BEGIN X ANY := FALSE; X NUM := 0; X IF C = '$' THEN BASE := 16 ELSE X IF C = '%' THEN BASE := 2 ELSE X IF C = '@' THEN BASE := 8 ELSE X BASE := 10; X IF BASE <> 10 THEN NEXTCH; X REPEAT X IF C IN ['0' .. '9'] THEN N := ORD(C) - ORD('0') ELSE X IF C IN ['A' .. 'F'] THEN N := ORD(C) - ORD('A') + 10 ELSE X IF C IN ['a' .. 'f'] THEN N := ORD(C) - ORD('a') + 10 ELSE X N := 999; X IF N < BASE THEN BEGIN X ANY := TRUE; X NEXTCH; X NUM := NUM*BASE + N; X END; X UNTIL N >= BASE; X IF NOT ANY THEN ERROR('N'); X END; X SYNUM := NUM; XEND (* PROCEDURE INNUM *); X XBEGIN (* OF PROCEDURE INSYMBOL *) X IF EOF(INP) THEN SY := EOFSY ELSE X IF EOLN(INP) AND (C = ' ') THEN BEGIN X SY := EOLNSY; X END ELSE BEGIN X SY := SYCHAR[C]; X IF SY = NUMSY THEN INNUMB ELSE X IF SY = NAMSY THEN INNAM ELSE X IF SY = SPACESY THEN BEGIN X WHILE NOT (EOLN(INP) OR EOF(INP)) AND X ((C = ' ') OR (C = CHR(9))) DO BEGIN X NEXTCH; X END X END ELSE NEXTCH; X END (* IF EOF(INP) .... *); XEND (* PROCEDURE INSYMBOL *); X XPROCEDURE ISINIT; X(* ISINIT INITIALISEERT HET ARRAY SYCHAR. *) XVAR C : CHAR; XBEGIN X FOR C := CHR(0) TO CHR(127) DO X SYCHAR[C] := ERRORSY; X SYCHAR[CHR(9)] := SPACESY; X SYCHAR[' '] := SPACESY; X SYCHAR['"'] := NUMSY; X SYCHAR['!'] := ORSY; X SYCHAR['#'] := IMMSY; X SYCHAR['$'] := NUMSY; X SYCHAR['%'] := NUMSY; X SYCHAR['&'] := ANDSY; X SYCHAR['''']:= NUMSY; X SYCHAR['('] := LPARSY; X SYCHAR[')'] := RPARSY; X SYCHAR['*'] := MULSY; X SYCHAR['+'] := ADDSY; X SYCHAR[','] := COMMASY; X SYCHAR['-'] := MINSY; X SYCHAR['.'] := NAMSY; X SYCHAR['/'] := DIVSY; X FOR C := '0' TO '9' DO SYCHAR[C] := NUMSY; X SYCHAR['<'] := LESSY; X SYCHAR['>'] := GREATERSY; X SYCHAR['@'] := NUMSY; X FOR C := 'A' TO 'Z' DO SYCHAR[C] := NAMSY; X FOR C := 'a' TO 'z' DO SYCHAR[C] := NAMSY; X SYCHAR['['] := LBRACKSY; X SYCHAR['\'] := MODSY; X SYCHAR[']'] := RBRACKSY; X REGNAME[REGD ] := 'D '; X REGNAME[REGX ] := 'X '; X REGNAME[REGY ] := 'Y '; X REGNAME[REGU ] := 'U '; X REGNAME[REGS ] := 'S '; X REGNAME[REGPC] := 'PCR '; X REGNAME[PCREG] := 'PC '; X REGNAME[REGA ] := 'A '; X REGNAME[REGB ] := 'B '; X REGNAME[REGCC] := 'CC '; X REGNAME[REGDP] := 'DP '; X REGNAME[NOREG] := ' '; XEND (* PROCEDURE ISINIT *); EndOfFile echo x - outp.inc sed 's/^X//' <<'EndOfFile' >outp.inc X(* X A???? LISTING CONTROL. X ===== ======= ======== X*) X XPROCEDURE PRINTHEX (*VAR F : TEXT ; NUM,SIZ : INTEGER*); X(* PRINTHEX PRINT 'NUM' IN 'SIZ' POSITIES OP FILE 'F' *) XVAR X RESULT : ARRAY[1 .. 4] OF CHAR; X N,I : INTEGER; XBEGIN X FOR I := 1 TO SIZ DO BEGIN X N := NUM MOD 16; X NUM := (NUM-N) DIV 16; X IF N < 0 THEN N := 16-N; X IF N < 10 THEN RESULT[I] := CHR(N+ORD('0')) X ELSE RESULT[I] := CHR(N+ORD('A')-10); X END; X FOR I := SIZ DOWNTO 1 DO X WRITE(F,RESULT[I]); XEND (* PROCEDURE PRINTHEX *); X XPROCEDURE LISTLINE; X(* LISTLINE SCHRIJFT 1 REGEL NAAR DE LISTINGFILE. *) XVAR X I : INTEGER; X P : VARSTRING; XBEGIN X IF OPTLIST AND (LINCNTR MOD LINESPP = 1 ) THEN BEGIN X WRITE(CHR(12),VERSION:30); X P := TITLE; X FOR I := 31 TO 75 DO X IF P=NIL THEN WRITE(' ') X ELSE BEGIN X WRITE(P^.INHOUD); X P:=P^.NEXT; X END; X PAGCNTR := PAGCNTR+1; X WRITELN('Page ',PAGCNTR:1); X END; X WRITE(ERRORS,LINCNTR:5,' '); X IF COMMENT THEN X WRITE(' ':MAXCODE*3+9) X ELSE BEGIN X PRINTHEX(OUTPUT,OLOCCNTR,4); X WRITE(OUTPUT,' '); X FOR I := 1 TO MAXCODE DO X IF I > CODELIN THEN X WRITE(' ':3) X ELSE BEGIN X WRITE(' '); X PRINTHEX(OUTPUT,CODES[I],2); X END; X WRITE(OUTPUT,' ':4); X CODELIN:=0; X END; X FOR I:=1 TO CHRCNTR DO WRITE(OUTPUT,LINE[I]); X CHRCNTR := 0; X WRITELN; XEND (* PROCEDURE LISTLINE *); X XPROCEDURE OUTHEX(VAL,LEN : INTEGER); X(* OUTHEX STUURT EEN BYTE NAAR DE LISTINGFILE EN NAAR DE HEXFILE *) XVAR X I : INTEGER; X TEMP : ARRAY[1..4] OF INTEGER; XBEGIN X#ifdef PRIME X IF LEN > 4 THEN BEGIN X#else X IF LEN > 2 THEN BEGIN X#endif X WRITELN('**** OUTHEX LENGTE TE GROOT (',LEN:1,').'); X END ELSE BEGIN X FOR I := LEN DOWNTO 1 DO BEGIN X TEMP[I] := VAL MOD 256; X VAL := (VAL - TEMP[I]) DIV 256; X END; X FOR I := 1 TO LEN DO BEGIN X IF CODELIN < MAXCODE THEN BEGIN X CODELIN := CODELIN+1; X CODES[CODELIN] := TEMP[I]; X END; X IF CODECNTR >= HBMAX THEN FLUSHEX(FALSE); X LOCCNTR := LOCCNTR + 1 ; X CODECNTR := CODECNTR+1; X HEXBUF[CODECNTR] := TEMP[I]; X END; X END; XEND (* PROCEDURE OUTHEX *); X XPROCEDURE FLUSHEX (*LASTBLOK:BOOLEAN*); X(* FLUSHEX STUURT VERZAMELDE HEX-OUTPUT NAAR DE HEX-FILE. *) XVAR X I,SUM : INTEGER; XBEGIN X IF (CODECNTR <> 0) AND PASS2 AND OPTBIN X OR PASS2 AND LASTBLOK THEN BEGIN X SUM := 0; X IF LASTBLOK THEN BEGIN X WRITE(HEX,'S9'); X CODECNTR := 0; X CODELOC := STARTADR; X END ELSE X WRITE(HEX,'S1'); X PRINTHEX(HEX,CODECNTR+3,2); X PRINTHEX(HEX,CODELOC,4); X SUM := CODELOC MOD 256; X SUM := (CODELOC-SUM) DIV 256 + SUM + CODECNTR+3; X FOR I := 1 TO CODECNTR DO BEGIN X SUM := SUM + HEXBUF[I]; X PRINTHEX(HEX,HEXBUF[I],2); X END; X PRINTHEX(HEX,-SUM-1,2); X WRITELN(HEX); X END; X CODELOC := LOCCNTR; X CODECNTR := 0; XEND (* PROCEDURE FLUSHEX *); X XPROCEDURE ERROR(*C : CHAR*); X(* GIVE AN ERROR. *) XBEGIN X IF ERRLIN < MAXERR THEN BEGIN X ERRLIN := ERRLIN+1; X ERRORS[ERRLIN] := C; X END; X ERRCNTR := ERRCNTR+1; XEND (* PROCEDURE ERROR *); EndOfFile echo x - pars.inc sed 's/^X//' <<'EndOfFile' >pars.inc X(* X A68K OPERAND DECODING. X ==== ======= ========= X*) X XFUNCTION MAKESTR(ENDC : CHAR) : OPLIST; X(* NAKESTRING LEEST TOT END-OF-LINE OF TOT 'ENDC' *) XVAR Q : OPLIST; X X FUNCTION MAKST( ENDC : CHAR) : VARSTRING; X VAR P : VARSTRING; X BEGIN X P := NIL; X IF C<>ENDC THEN BEGIN X NEW(P); X P^.INHOUD := C; X NEXTCH; X P^.NEXT := NIL; X END; X IF (C<>ENDC) AND NOT (EOLN(INP) AND (C = ' ')) THEN P^.NEXT := MAKST(ENDC); X MAKST := P; X END (* MAKST *); X XBEGIN (* OF MAKESTR *) X NEW(Q); X Q^.NEXT := NIL; X Q^.ARGTP := ARGSTR; X Q^.ASTEXT := MAKST(ENDC); X MAKESTR := Q; XEND (* FUNCTION MAKESTR *); X XFUNCTION MAKEOPER : OPLIST; X(* MAKEOPER LEEST EEN LIJST OPERANDEN EN RETURNT DIE. *) XVAR X RR : REGISTER; X P : OPLIST; X RINC : INTEGER; (* NUMBER OF MINUS SYMBOLS ON FRONT *) X NEGATIVE, (* TRUE IF A MINUS HAS BEEN SKPD*) X FLONG : BOOLEAN; (* FOR FORCING LONG DATA, IF *) X (* DEFLIN > CURLIN. *) X X FUNCTION MAKEXPR : INTEGER; X (* MAKEXPR LEEST EEN EXPRESSIE. *) X VAR X OLDSY : SYMBOL; X N,NUMBER : INTEGER; X X FUNCTION MAK1NUM : INTEGER; X (* MAK1NUM LEEST 1 GETAL ( NUMMER,NAAM OF * ) *) X VAR X N : INTEGER; X P : IDRECORD; X BEGIN X IF SY = MULSY THEN N := OLOCCNTR ELSE X IF SY = NUMSY THEN N := SYNUM ELSE X BEGIN X P := GETNAM(SYNAM); X IF P = NIL THEN BEGIN X IF PASS2 THEN ERROR('U'); X FLONG := TRUE; X N := -1; X END ELSE BEGIN X IF P^.DEFLIN > LINCNTR THEN FLONG := TRUE; X N := P^.WAARDE; X END; X END; X INSYMBOL; X MAK1NUM := N; X END (* FUNCTION MAK1NUM *); X X BEGIN (* OF FUNCTION MAKEXPR *) X IF SY IN [NAMSY,NUMSY,MULSY] THEN NUMBER := MAK1NUM X ELSE NUMBER := 0; X IF NEGATIVE THEN BEGIN X NUMBER := -NUMBER; X NEGATIVE := FALSE; X IF RINC > 1 THEN ERROR('+'); X RINC := 0; X END; X WHILE SY IN [ADDSY,MINSY,MULSY,DIVSY,MODSY,ANDSY,ORSY] DO BEGIN X OLDSY := SY; X INSYMBOL; X IF SY IN [NAMSY,NUMSY,MULSY] THEN N := MAK1NUM X ELSE BEGIN X SY := ERRORSY; X ERROR('N'); X N := 1; X END; X CASE OLDSY OF X ADDSY : NUMBER := NUMBER + N; X MINSY : NUMBER := NUMBER - N; X MULSY : NUMBER := NUMBER * N; X DIVSY : IF N = 0 THEN ERROR('/') ELSE NUMBER := NUMBER DIV N; X MODSY : IF N = 0 THEN ERROR('/') ELSE NUMBER := NUMBER MOD N; X ANDSY : NUMBER := IAND(NUMBER,N); X ORSY : NUMBER := IOR (NUMBER,N); X END; X END; X MAKEXPR := NUMBER; X END (* FUNCTION MAKEXPR *); X X FUNCTION ISREG( VAR RR:REGISTER ):BOOLEAN; X VAR R : REGISTER; X BEGIN X RR := NOREG; X FOR R := REGX TO REGDP DO X IF SYNAM = REGNAME[R] THEN RR:=R; X IF RR = PCREG THEN RR := REGPC; X ISREG := RR <> NOREG; X END; (* ISREG *) X XBEGIN (* OF FUNCTION MAKEOPER *) X FLONG := FALSE; X NEGATIVE := FALSE; X NEW(P); X RINC := 0; X WHILE SY = MINSY DO BEGIN X NEGATIVE := TRUE; X INSYMBOL; X RINC := RINC +1; X END; X WITH P^ DO X IF SY IN [ LBRACKSY ,IMMSY ,NAMSY ,NUMSY, ADDSY, MULSY, GREATERSY, X LESSY,COMMASY ] THEN X CASE SY OF X LBRACKSY : BEGIN X ARGTP := ARGIND; X INSYMBOL; X AILIST := MAKEOPER; X IF SY <> RBRACKSY THEN ERROR(']'); X INSYMBOL; X END; X X IMMSY : BEGIN X ARGTP := ARGIMM; X INSYMBOL; X IF SY IN [NUMSY,NAMSY,ADDSY,MINSY,MULSY] THEN X AIVAL := MAKEXPR X ELSE BEGIN X AIVAL := -1; X ERROR('N'); X END; X END; X X GREATERSY,LESSY,ADDSY, X NUMSY,MULSY : BEGIN X ARGTP := ARGNUM; X ANFORC := (SY=GREATERSY) OR (SY=LESSY); X ANLONG := (SY=GREATERSY); X IF ANFORC THEN INSYMBOL; X ANVAL := MAKEXPR; X IF FLONG AND NOT ANFORC THEN BEGIN X ANFORC := TRUE; X ANLONG := TRUE; X END; X END; X NAMSY : BEGIN X IF ISREG(RR) THEN BEGIN X ARGTP := ARGREG; X ARINC := 0; X ARREG := RR; X INSYMBOL; X IF NOT NEGATIVE THEN BEGIN X WHILE SY = ADDSY DO BEGIN X ARINC := ARINC+1; X INSYMBOL; X END; X END ELSE BEGIN X ARINC := -RINC; X NEGATIVE := FALSE; X END; X IF ABS(ARINC) > 2 THEN ERROR('+'); X END ELSE BEGIN X ARGTP := ARGNUM; X ANVAL := MAKEXPR; X ANFORC := FLONG; X ANLONG := FLONG; X END; X END; X COMMASY : BEGIN (* ONLY , SO MAKE 0 PARAMETER *) X ARGTP := ARGNUM; X ANVAL := 0; X ANFORC := FALSE; X ANLONG := FALSE; X END; X END (* CASE STAEMENT *) X ELSE BEGIN X DISPOSE (P); X P := NIL; X END; X IF NEGATIVE THEN (* ONLY A MINUS *) ERROR('+'); X IF ( SY = COMMASY ) AND ( P <> NIL ) THEN BEGIN X INSYMBOL; X P^.NEXT := MAKEOPER; X END X ELSE P^.NEXT := NIL; X MAKEOPER := P; XEND (* FUNCTION MAKEOPER *); X XFUNCTION MAKESTMT : STMT; X(* MAKESTMT LEEST EEN STATEMENT MBV INSYMBOL EN NEXTCH, EN *) X(* STUURT DAT TERUG ALS RETURNWAARDE. ALS HET EEN COMMENT *) X(* IS WORDT COMMENT OP TRUE GEZET. *) XCONST X MNNAM = 'NAM '; X MNOPT = 'OPT '; X MNFCC = 'FCC '; XVAR X P : STMT; X ENDC : CHAR; X MNEMON : STRING ; XBEGIN X INSYMBOL; X IF (SY = MULSY) OR (SY = EOLNSY) THEN BEGIN (* COMMENTAARREGEL *) X P := NIL; X COMMENT := TRUE; X END ELSE BEGIN X COMMENT := FALSE; X NEW(P); X IF SY = NAMSY THEN BEGIN X P^.LEBEL := SYNAM; X INSYMBOL; X END ELSE P^.LEBEL := LEGEID; X IF SY = SPACESY THEN INSYMBOL ELSE ERROR('L'); X IF SY = NAMSY THEN BEGIN X MNEMON := SYNAM; X END ELSE IF SY = EOFSY THEN MNEMON := 'END ' X ELSE MNEMON := LEGEID; X IF (MNEMON[4]=' ') AND (C = ' ') THEN BEGIN X NEXTCH; X IF (C<>' ') AND (C<>' ') THEN BEGIN X MNEMON[4] := C; X NEXTCH; X END; X END; X INSYMBOL; X FIND ( MNEMON,P^.OPCODE,P^.OPT); X IF (P^.OPT <> OP0) THEN BEGIN X(* PARAMETER DECODERING VOOR 'NAM','OPT' EN 'FCC' *) X IF( SY=SPACESY) AND (MNEMON<>MNFCC) AND (MNEMON<>MNNAM) THEN X INSYMBOL; X IF MNEMON = MNOPT THEN BEGIN X IF SY = SPACESY THEN INSYMBOL; X NEW(P^.OPERANDS); X P^.OPERANDS^.ARGTP := ARGOPT; X P^.OPERANDS^.AOOPT := SYNAM; X END ELSE IF MNEMON = MNNAM THEN BEGIN X P^.OPERANDS := MAKESTR(CHR(0)); (* LEES TOT EOLN *) X NEXTCH; X INSYMBOL; X END ELSE IF MNEMON = MNFCC THEN BEGIN X WHILE C = ' ' DO NEXTCH; X ENDC := C; X NEXTCH; X P^.OPERANDS := MAKESTR(ENDC); X IF C <> ENDC THEN ERROR('Q'); X NEXTCH; X INSYMBOL; X END X ELSE P^.OPERANDS := MAKEOPER; X END ELSE P^.OPERANDS := NIL ; X IF ( SY<>SPACESY) AND (SY<>EOLNSY) THEN ERROR('S'); X END; X WHILE NOT EOLN(INP) DO NEXTCH; X MAKESTMT := P; XEND (* FUNCTION MAKESTMT *); EndOfFile echo x - exec.inc sed 's/^X//' <<'EndOfFile' >exec.inc XPROCEDURE OPTION( S : STRING); X(* BEHANDEL ASSEMBLER OPTIONS *) XBEGIN X IF S = 'L ' THEN OPTLIST := TRUE ELSE X IF S = 'NOL ' THEN OPTLIST := FALSE ELSE X IF S = 'O ' THEN OPTBIN := TRUE ELSE X IF S = 'NOO ' THEN OPTBIN := FALSE ELSE X IF S = 'S ' THEN OPTSYM := TRUE ELSE X IF S = 'NOS ' THEN OPTSYM := FALSE ELSE X IF S = 'DEBUG ' THEN DEBUG := TRUE ELSE X IF INITIALIZING THEN WRITELN('UNKNOWN OPTION "',S,'"') X ELSE ERROR('U'); XEND (* OPTION *); X XPROCEDURE DOINIT; XBEGIN X INXREG:= [ REGX .. REGPC ]; X ACCREG:= [ REGD ,REGA ,REGB]; X ASSOPC:= [ OPNAM .. OPOPT]; X PROOPC:= [ OP0 .. OPSTK]; X DIRPAG:= 0; XEND; X XPROCEDURE DOSTMT(SPTR:STMT); XCONST X MNRMB = 1; X MNORG = 2; X MNFCB = 1; X MNFDB = 2; X XVAR X OPERAND,OPEXT, X POSTB,LEN, X OPCODE,VAL, X DIST,SECBYT : INTEGER; X OPT : OPTYPE; X OPRPTR : OPLIST ; X STRPTR : VARSTRING; X DOPOST : BOOLEAN; X X PROCEDURE REMTITLE; X (* REMTITLE VERWIJDERD DE TITLE STRING VAN HET *) X (* TYPE VARSTRING *) X VAR OP,P : VARSTRING; X BEGIN X P:= TITLE; X WHILE P <> NIL DO X BEGIN X OP := P; X P := P^.NEXT; X DISPOSE(OP); X END; X END; (* PROCEDURE REMTITLE *) X X PROCEDURE REMSTMT; X X PROCEDURE REMOPLIST(P :OPLIST); X VAR NP :OPLIST; X BEGIN X WHILE P<>NIL DO X BEGIN X IF P^.ARGTP = ARGIND X THEN REMOPLIST(P^.AILIST); X NP:= P^.NEXT; X DISPOSE(P); X P:= NP; X END; X END; X X BEGIN X OPRPTR := SPTR^.OPERANDS; X DISPOSE(SPTR); X REMOPLIST(OPRPTR); X END; X X FUNCTION REGNYB(REG:REGISTER):INTEGER; X BEGIN X CASE REG OF X REGX : REGNYB := 1; X REGY : REGNYB := 2; X REGU : REGNYB := 3; X REGS : REGNYB := 4; X REGPC : REGNYB := 5; X REGD : REGNYB := 0; X REGA : REGNYB := 8; X REGB : REGNYB := 9; X REGDP : REGNYB := 11; X REGCC : REGNYB := 10; X END; X END; (* FUNCTION REGNYB *) X X FUNCTION REGBIT(REG:REGISTER):INTEGER; X BEGIN X CASE REG OF X REGX : REGBIT := 16; X REGY : REGBIT := 32; X REGU, X REGS : REGBIT := 64; X REGPC : REGBIT := 128; X REGD : REGBIT := 6; (* REGISTER A + B *) X REGA : REGBIT := 2; X REGB : REGBIT := 4; X REGDP : REGBIT := 8; X REGCC : REGBIT := 1; X END; X END; (* FUNCTION REGBIT *) X X PROCEDURE MKLEBEL(NAME :STRING; WAARDE:INTEGER); X VAR IDPTR : IDRECORD; X BEGIN X NEW(IDPTR); X IDPTR^.DEFLIN := LINCNTR; X IDPTR^.WAARDE := WAARDE; X IF NOT NEWNAM(NAME,IDPTR) X THEN ERROR('M'); X END; X X PROCEDURE DOOPER(OPPTR : OPLIST); X VAR INC : INTEGER; X OPCLEN : INTEGER; X X PROCEDURE DOREGX; X BEGIN X IF OPPTR^.NEXT <> NIL THEN ERROR('S'); X CASE OPPTR^.ARREG OF X REGX : POSTB := POSTB + 0 ; X REGY : POSTB := POSTB + 32; X REGU : POSTB := POSTB + 64; X REGS : POSTB := POSTB + 96; X REGPC: POSTB := POSTB + 12; X END; X IF OPPTR^.ARREG <> REGPC THEN X BEGIN X (* INC / DEC OMREKENING: *) X (* ,--X ,-X ,X ,X+ ,X++ *) X (* 3 2 4 0 1 *) X INC:= OPPTR^.ARINC -1; X IF INC = -1 THEN INC := 4 X ELSE INC := ABS(INC); X POSTB := POSTB + INC; X END ELSE X IF OPPTR^.ARINC <> 0 X THEN ERROR('+'); X END; (* INDEX REGISTER HANDLING *) X X PROCEDURE DOREGA; X BEGIN X IF OPPTR^.NEXT = NIL THEN BEGIN X ERROR('A'); (* NEED INDEX REG AFTER ACCU*) X END ELSE BEGIN (* MORE OPERANDS *) X DOOPER(OPPTR^.NEXT); (* DO NEXT FIRST *) X IF (POSTB MOD 16 ) <> 4 THEN ERROR('A') X ELSE (* CAME BACK WITH ZERO OFFSET *) X CASE OPPTR^.ARREG OF X REGD : POSTB := POSTB +7; X REGA : POSTB := POSTB +2; X REGB : POSTB := POSTB +1; X END; X END; X END; (* DOREGA *) X X PROCEDURE DOINDIRECT; X BEGIN X IF OPPTR^.NEXT <> NIL THEN ERROR ('S') ELSE X IF OPPTR^.AILIST = NIL THEN ERROR('E') X ELSE BEGIN X DOOPER(OPPTR^.AILIST); X IF NOT DOPOST X THEN BEGIN X POSTB := 159; (* $9F *) X LEN := 2 ; (* EXTENDED INDIRECT *) X DOPOST := TRUE; X OPEXT := 32; X END ELSE BEGIN X IF POSTB < 128 THEN BEGIN X LEN := 1; X OPERAND := POSTB MOD 16; X IF POSTB > 15 THEN OPERAND := OPERAND -32; X POSTB := ((POSTB DIV 32)*32)+136; X (* CHANGE 5 BIT OFFSET IN 8 BIT *) X END ELSE X IF ((POSTB MOD 32)=0) OR ((POSTB MOD 32)=2) X THEN ERROR('+'); X POSTB := POSTB + 16; (* MAKE IT INDIRECT *) X END; (* DOPOST = TRUE *) X END; X END; X X PROCEDURE DONUM; X BEGIN X DOPOST := FALSE; X OPERAND := OPPTR^.ANVAL; X IF OPPTR^.ANFORC THEN X IF OPPTR^.ANLONG X THEN LEN := 2 X ELSE LEN := 1 X ELSE X#ifdef PRIME X IF (IAND(OPERAND,-256) DIV 256 = DIRPAG ) X#else X IF ((OPERAND>=0) AND (OPERAND DIV 256=DIRPAG)) X OR ((OPERAND<0) AND ((OPERAND-(OPERAND MOD 256)) X = (DIRPAG * 256))) X#endif X THEN LEN := 1 X ELSE LEN := 2; X IF LEN = 2 X THEN OPEXT := 48 X ELSE OPEXT := 16; X END; (* DIRECT & EXTENDED *) X X PROCEDURE DOPCR; X BEGIN X (* Altered 23-oct-84, Hans. *) X IF OPCODE > 256 THEN OPCLEN := 2 X ELSE OPCLEN := 1; X IF OPPTR^.ANLONG THEN LEN := 2 X ELSE LEN := 1; X OPERAND := OPERAND - OLOCCNTR - OPCLEN -1 -LEN; X IF((OPERAND > 127) OR (OPERAND < -128)) AND X (LEN <> 2) AND NOT OPPTR^.ANFORC THEN BEGIN X LEN := 2; X OPERAND := OPERAND -1; X END; X IF LEN = 2 THEN POSTB := POSTB +1 ; X END; (* OFFSET FROM PCR *) X X PROCEDURE DOOFFSET; X BEGIN X IF OPERAND <> 0 THEN X IF (POSTB MOD 16) = 4 (* OFFSET FROM REGISTER *) X THEN X IF (OPERAND>127) OR (OPERAND<-128) X (* Added 9-feb-84, Jack. *) X OR ( OPPTR^.ANFORC AND OPPTR^.ANLONG) X (* Added 23-oct-84, Hans. *) X AND NOT ( OPPTR^.ANFORC AND NOT OPPTR^.ANLONG ) X THEN BEGIN X POSTB := POSTB + 5; (* 16 BIT OFF- *) X LEN := 2; (* SET FORM R *) X END ELSE X IF (OPERAND>15) OR (OPERAND<-16) X THEN BEGIN X POSTB := POSTB +4; (* 8 BIT *) X LEN := 1; (* OFFSET *) X END ELSE BEGIN (* FROM R *) X IF OPERAND < 0 THEN X OPERAND:=32+OPERAND; X POSTB := POSTB - 132 + OPERAND; X LEN := 0; (* 5 BIT OFFSET FROM R *) X END X ELSE X ERROR('C') (* OFFSET NOT ALLOWED *) X ELSE X LEN := 0 X END; (* OFFSET FROM INDEX REG *) X X BEGIN X CASE OPPTR^.ARGTP OF X ARGREG : BEGIN X POSTB := 128; X LEN := 0; X DOPOST := TRUE; X OPEXT := 32; X IF OPPTR^.ARREG IN INXREG THEN X DOREGX X ELSE X IF NOT (OPPTR^.ARREG IN ACCREG) THEN ERROR('V') X ELSE (* ACCU OFSET *) X DOREGA; X END; (* REGISTER OPERANDS *) X ARGIMM : BEGIN X IF OPPTR^.NEXT <> NIL THEN ERROR('S') X ELSE X BEGIN X LEN := -1; X OPERAND := OPPTR^.AIVAL; X OPEXT := 0; X DOPOST := FALSE; X END; (* IMMIDIATE MODE *) X END; X ARGIND : BEGIN X DOINDIRECT; X END; (* INDIRECT MODE *) X ARGNUM : BEGIN X IF OPPTR^.NEXT = NIL THEN X DONUM X ELSE BEGIN (* INDEXED ? *) X DOOPER(OPPTR^.NEXT); X IF NOT DOPOST OR (LEN <> 0) THEN ERROR('C') X ELSE X OPERAND := OPPTR^.ANVAL; X IF POSTB = 140 (* OFFSET FROM PCR *) X THEN X DOPCR X ELSE X DOOFFSET; X END; X END; (* ARGNUM *) X END; (* CASE STATEMENT *) X END; (* DOOPER *) X XBEGIN X OPCODE := SPTR^.OPCODE; X OPT := SPTR^.OPT ; X OPRPTR:=SPTR^.OPERANDS; X IF (OPRPTR = NIL) AND NOT( (OPT = OP0) OR (OPT = OPEND)) X THEN ERROR('E') X ELSE X IF OPT IN ASSOPC THEN X CASE OPT OF X OPNAM : BEGIN X REMTITLE; X TITLE := OPRPTR^.ASTEXT; X END; X OPFCB : BEGIN X (* ZOWEL FCB ALS FDB *) X IF OPCODE = MNFCB THEN LEN := 1 X ELSE X IF OPCODE = MNFDB THEN LEN := 2 X ELSE ERROR('?'); X WHILE OPRPTR <> NIL DO X BEGIN X IF OPRPTR^.ARGTP <> ARGNUM THEN ERROR('G') X ELSE X OUTHEX(OPRPTR^.ANVAL,LEN); X OPRPTR := OPRPTR^.NEXT; X END; X END; X OPFCC : BEGIN X STRPTR := OPRPTR^.ASTEXT; X WHILE STRPTR <> NIL DO X BEGIN X VAL := ORD( STRPTR^.INHOUD) MOD 128; X STRPTR := STRPTR^.NEXT ; X OUTHEX( VAL , 1); X END; X END; X OPRMB : BEGIN (* ZOWEL RMB ALS ORG KOMEN HIER *) X IF OPRPTR^.ARGTP <> ARGNUM THEN ERROR('G') X ELSE BEGIN X IF OPCODE = MNORG THEN BEGIN X LOCCNTR := OPRPTR^.ANVAL; X FLUSHEX(FALSE); X END ELSE X IF OPRPTR^.ANVAL <> 0 THEN X IF OPCODE = MNRMB THEN BEGIN X LOCCNTR := OLOCCNTR + OPRPTR^.ANVAL; X FLUSHEX(FALSE); X END ELSE X ERROR('?'); (* NO ORG OR RMB *) X END; X END; X OPEQU : BEGIN X IF SPTR^.LEBEL = LEGEID THEN ERROR('L') X ELSE X IF OPRPTR^.ARGTP <> ARGNUM THEN ERROR('G') X ELSE X BEGIN X MKLEBEL(SPTR^.LEBEL,OPRPTR^.ANVAL); X SPTR^.LEBEL := LEGEID; X (* PREVENT DUBBEL DEFINING *) X END; X OLOCCNTR := OPRPTR^.ANVAL; X END; X OPSDP : BEGIN X IF OPRPTR^.ARGTP <> ARGNUM THEN ERROR('G') X ELSE X DIRPAG := OPRPTR^.ANVAL MOD 256 ; X OLOCCNTR := OPRPTR^.ANVAL; X END; X OPEND : BEGIN X IF OPRPTR <> NIL THEN X IF OPRPTR^.ARGTP = ARGNUM THEN X STARTADR := OPRPTR^.ANVAL; X STOPPED := TRUE; X END; X OPOPT : OPTION(OPRPTR^.AOOPT); X END (* CASE *) X ELSE X BEGIN X IF OPT IN PROOPC THEN X CASE OPT OF X OP0 : IF OPCODE > 255 X THEN OUTHEX(OPCODE ,2) X ELSE OUTHEX(OPCODE ,1); X OP1B, X OP1W : BEGIN X DOOPER(OPRPTR); X IF OPEXT = 0 (* IMMEDIATE MODE *) X THEN X IF OPT = OP1B X THEN LEN := 1 X ELSE LEN := 2; X (* EERST EENS KIJKEN OF ALLES MAG *) X IF (OPCODE >= 64) AND (OPCODE <= 79) X (* NEG .. CLR *) X THEN X IF OPEXT = 16 (* DIRECT *) X THEN OPEXT := -64 (* SPECIAL *) X ELSE X IF OPEXT = 0 THEN ERROR('I'); X (* AND IMM NOT ALLOWED *) X IF ((OPCODE = 26) OR (OPCODE = 28)) X (* ORCC AND ANDCC *) X AND (OPEXT <> 0) THEN ERROR('I'); X (* ONLY IMM MODE *) X IF ( (OPCODE = 135) (* STA *) X OR (OPCODE = 199) (* STB *) X OR (OPCODE = 205) (* STD *) X OR (OPCODE = 143) (* STX *) X OR (OPCODE = 207) (* STU *) X OR (OPCODE = 16*256+143) (* STY *) X OR (OPCODE = 16*256+207) (* STS *) X OR (OPCODE = 141)) (* JSR *) X AND (OPEXT = 0) X THEN ERROR('I'); (* HAVE NO IMM MODES *) X IF ((OPCODE>16) AND (OPCODE<19))AND X (* LEAX .. LEAU *) X (OPEXT <> 32) (* ONLY INDEXED MODE *) X THEN ERROR('I'); X OPCODE := OPCODE + OPEXT; X IF OPCODE > 255 X THEN OUTHEX(OPCODE,2) X ELSE OUTHEX(OPCODE,1); X IF DOPOST THEN OUTHEX(POSTB,1); X OUTHEX(OPERAND,LEN) X END; X X OPEMT : BEGIN X IF OPRPTR^.ARGTP <> ARGNUM X THEN ERROR('G') X ELSE X BEGIN X OUTHEX(OPCODE,1); X OUTHEX(OPRPTR^.ANVAL,1); X END; X END; X OPREL : BEGIN X IF OPRPTR^.ARGTP <> ARGNUM X THEN ERROR('G') X ELSE X BEGIN X DIST := OPRPTR^.ANVAL -OLOCCNTR - 4; X IF OPCODE > 255 X THEN X BEGIN X OUTHEX(OPCODE ,2); X OUTHEX(DIST ,2); X END X ELSE X BEGIN X OUTHEX(OPCODE ,1); X IF (OPCODE=22) OR (OPCODE=23) THEN X (* LBRA EN LBSR ZIJN 1 BYT INSTR. MET 2 BYT OFFS. *) X BEGIN X DIST := DIST +1; X OUTHEX(DIST,2); X END X ELSE X BEGIN X DIST := DIST + 2; X IF (DIST>127) OR (DIST<-128) THEN X BEGIN X ERROR('R'); X DIST := -4; X END; X OUTHEX(DIST ,1); X END; (* SHORT BRANCH *) X END; (* 1 BYTE OPCODE *) X END; (* NUMERIC OPERAND *) X END; (* OPREL*) X OPREG : BEGIN X IF OPRPTR^.ARGTP <> ARGREG X THEN ERROR('V') X ELSE X IF OPRPTR^.NEXT <> NIL THEN X BEGIN X OUTHEX(OPCODE,1); X SECBYT := REGNYB(OPRPTR^.ARREG); X OPRPTR := OPRPTR^.NEXT; X IF OPRPTR^.NEXT <> NIL X THEN ERROR('C'); X IF OPRPTR^.ARGTP <> ARGREG X THEN ERROR('V') X ELSE X BEGIN X SECBYT := SECBYT*16+REGNYB(OPRPTR^.ARREG); X OUTHEX (SECBYT , 1); X END; X END X ELSE ERROR('C'); (* NO SECOND REG *) X END; X OPSTK : BEGIN X IF OPCODE > 255 X THEN OUTHEX(OPCODE,2) X ELSE OUTHEX(OPCODE,1); X SECBYT :=0; X WHILE OPRPTR <> NIL DO X BEGIN X IF OPRPTR^.ARGTP <> ARGREG X THEN ERROR('V') X ELSE X SECBYT := SECBYT+REGBIT(OPRPTR^.ARREG); X OPRPTR := OPRPTR^.NEXT; X END; X OUTHEX(SECBYT,1); X END; X END (* CASE *) X ELSE (* NOT ( PROOPC OR ASSOPC ) *) X ERROR('?'); X END; X IF SPTR^.LEBEL <> LEGEID X THEN MKLEBEL(SPTR^.LEBEL,OLOCCNTR); X REMSTMT; XEND; (* OF ROUTINE DO STATEMENT *) EndOfFile exit -- Jack Jansen, {seismo|philabs|decvax}!mcvax!jack Notice new, improved, shorter and faster address ^^^^^ -- Jack Jansen, {seismo|philabs|decvax}!mcvax!jack Notice new, improved, shorter and faster address ^^^^^