Motorola 6809 cross-assembler (part 2 of 2)
Jack Jansen
jack at vu44.UUCP
Tue Feb 19 20:49:46 AEST 1985
: '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, >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 ); (* #<EXPRESSION> *)
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 ^^^^^
More information about the Comp.sources.unix
mailing list