jack@vu44.UUCP (Jack Jansen) (02/19/85)
: 'This is a shell archive. Run with the real shell,'
: 'not the seashell. It should extract the following:'
: ' Read_Me Makefile a6809 mkmnem.p mneminput '
echo x - Read_Me
sed 's/^X//' <<'EndOfFile' >Read_Me
XThis directory contains the source to the htsa 6809 assembler.
XIt is written in ISO standard pascal, and has been tested on a
XPDP 11/34 running unix v7m, using the VU pascal compiler.
X
XIt can also be used on a PRIME, if you have the Sheffield compiler,
Xthat is, PASCAL-S. The Prime standard pascal compiler won't compile it.
XIf a version for the prime is to be made, a "#define PRIME" statement
Xshould be added near the beginning of a6809.p.
X
XIf your pascal compiler does not call the C preprocessor, you
Xshould feed the 'a6809.p' source through cpp yourself.
XIf you don't have cpp, you should either obtain one (there was
Xa public domain cpp in net.sources and mod.sources recently),
Xor massage the files by hand. The only thing that #defined identifiers
Xare used for is for conditional compilation using #ifdef, so this
Xshouldn't be too hard.
XIf you are baffled by this, I can send you a tiny tiny cpp I wrote
Xin pascal for the prime if you send me a mail. I didn't include it
Xhere, however, since I'm not very proud of the code (this was an
Xunderstatement).
X
XThe assembler accepts standard Motorola 6809 assembly language, with
Xone known exception, nl. that the words PC and PCR can be used
Xinterchangeably, where Motorola only accepts PCR for PC Relative, and
XPC on PSH and PUL instructions.
XThe object file is in 'S1 format', as accepted by the ExorMacs systems,
Xand most other 680? based systems.
X
XThe assembler does not have any of the nifty features like
Xmacros, conditional assembly, relocatable binaries, etc.
XIf anyone feels like hacking it in, I would be *very* happy
Xif you sent us a copy. Especially relocatable output is something
Xthat would be very handy, and the only reason it isn't implemented
Xyet is lack of time.
X
XI'm planning to setup a mailing list for bugs, extensions, etc.
Xso I would be very happy if everyone who is planning to use the
Xassembler would mail his electronic address to mcvax!vu44!htsa!a6809-list.
XIf you find any bugs, also mail them there, and I'll try to fix them,
Xor distribute any fixes that I have received.
X
XOne more apology is probably in place here: Most of the comment
Xis in Dutch( :-) for me, :-( for you). Sorry, but I'm short on
Xtime these days, so I didn't have time to wade through the
Xsources (I already had to write a manual, so.....).
X
XThe following files are in this directory :
X
XMakefile make input file, if you have the VU pascal compiler.
Xa6809 shell file to run the assembler.
Xa6809.1 Manual page in -man format.
Xa6809.man Manual page, ready for displaying.
Xa6809.p Main program. Includes all the '.inc' files.
Xaserr Shell file to get erronuous lines from a listing.
Xexec.inc Code generator source file.
Xinpt.inc Input routines source file.
Xmkmnem.p Separate program to make a mnemonics file.
Xmneminput Input file for mkmnem.p
Xoutp.inc Output routines source file.
Xpars.inc Parser source file.
Xsymb.inc Symbol table handling source file.
X
X Jack Jansen Hans Pronk
X Hogere Technische School "Amsterdam"
X Europaboulevard 23
X Amsterdam
X Holland
X Tel: +31 20 429333
X uucp: {decvax|seismo|philabs}!mcvax!vu44!htsa!jack
X ..!htsa!haper
X arpa: "decvax!mcvax!vu44!htsa!jack"@Berkeley.ARPA
X "decvax!mcvax!vu44!htsa!haper"@Berkeley.ARPA
X
XPS: Since Hans is still working full time at the HTS, and I'm only
Xhere one day in the week, it is probably wiser to mail problems,
Xetc to htsa!haper.
EndOfFile
echo x - Makefile
sed 's/^X//' <<'EndOfFile' >Makefile
X#
X# Makefile for a6809 assembler.
X#
XASSRC = a6809.p symb.inc inpt.inc outp.inc pars.inc exec.inc
XASOTHER = Read_Me Makefile a6809 mkmnem.p mneminput
Xall: mnemtab a6809prg
X
Xinstall: all a6809 aserr
X cp a6809 /usr/bin/a6809
X cp a6809prg /usr/lib/a6809prg
X cp mnemtab /usr/etc/a6809:mnemtab
X cp aserr /usr/bin/aserr
X
Xmnemtab: mneminput mkmnem
X mkmnem mneminput mnemtab
X
Xmkmnem: mkmnem.p
X pc -C mkmnem.p -o mkmnem
X
Xa6809prg: $(ASSRC)
X pc -C -I a6809.p -o a6809prg
X
Xa6809int: $(ASSRC)
X pc -I a6809.p -o a6809int
X
Xa6809lst: $(ASSRC)
X pc -C -E -I a6809.p -o a6809prg >a6809lst
X
XDistr: Distr.1 Distr.2
X
XDistr.1: $(ASOTHER)
X shar $(ASOTHER) >Distr.1
X
XDistr.2: $(ASSRC)
X shar $(ASSRC) >Distr.2
EndOfFile
echo x - a6809
sed 's/^X//' <<'EndOfFile' >a6809
X: a6809 interlude.
Xcase $# in
X0) echo "Usage * $0 [-nl] [-nh] source "
X echo " Hex op 'source.hex', listing op 'source.list'."
X echo " -nl: geen listing; -nh: geen hexfile."
X exit
X ;;
Xesac
X
Xasm=/usr/lib/a6809prg
Xtable=/usr/etc/a6809:mnemtab
Xdodbg=0
Xdolst=1
Xdohex=1
Xdosmbl=0
X
Xwhile expr "X$1" : "X-" != 0 >/dev/null; do
X case $1 in
X -s) dosmbl=1 ; shift ;;
X -d) dodbg=1 ; shift ;;
X -nl) dolst=0 ; shift ;;
X -nh) dohex=0 ; shift ;;
X -*) echo Onbekende optie $1 ; exit ;;
X esac
Xdone
X
Xcase $# in
X0) echo Geen sourcefile gegeven.
X exit
Xesac
X
Xsource=$1.src
Xif test ! -r $source
Xthen
X source=$1
X if test ! -r $source
X then
X echo "Non-existent sourcefile"
X exit
X fi
Xfi
X
Xobj=`basename $source .src`.hex
Xlst=`basename $source .src`.list
X
Xcase $dolst in
X0) lst=/dev/tty ;;
Xesac
Xcase $dohex in
X0) obj=/tmp/ast$$ ;;
Xesac
Xecho $dohex $dolst $dodbg $dosmbl >$obj
X$asm $source $obj $table >$lst
X
Xcase $dolst in
X1) aserr $lst
Xesac
EndOfFile
echo x - mkmnem.p
sed 's/^X//' <<'EndOfFile' >mkmnem.p
X#
XPROGRAM MKMNEM(INPUT,OUTPUT,INFILE,OUTFILE);
X(* Make mnemonic file for A6809 *)
X
X(* #define PRIME (* For the PRIME, or *)
X#define UNIX (* For UNIX *)
X
XCONST
X MAXMNEM = 160;
X STRSIZE = 6;
X
XTYPE
X STRING = PACKED ARRAY [1..STRSIZE] OF CHAR;
X OPTYPE = ( OPNAM, OPFCB, OPFCC, OPRMB, OPEQU, OPSDP, OPEND,
X OPOPT, OP0, OP1B, OP1W, OPEMT, OPREL, OPREG, OPSTK );
X
X MNEMRECORD = RECORD
X NAME : STRING;
X OPT : OPTYPE;
X OPC : INTEGER;
X END;
X
XVAR
X CONV : ARRAY [ 0 .. 14 ] OF OPTYPE;
X INFILE : TEXT;
X OUTFILE : FILE OF MNEMRECORD;
X TABLE : ARRAY[1..MAXMNEM] OF MNEMRECORD;
X NROFELEM , I , J : INTEGER;
X#ifdef PRIME
X FNAME : PACKED ARRAY [1..32] OF CHAR;
X#endif
X
X#ifdef PRIME
XVALUE
X CONV = ( OPNAM,OPFCB,OPFCC,OPRMB,OPEQU,OPSDP,OPEND,
X OPOPT,OP0,OP1B,OP1W,OPEMT,OPREL,OPREG,OPSTK );
X
XPROCEDURE GETFNAM;
XVAR I : INTEGER;
XBEGIN
X WHILE INPUT^ = ' ' DO GET(INPUT);
X FOR I := 1 TO 32 DO
X IF EOLN(INPUT) THEN FNAME[I] := ' ' ELSE READ(FNAME[I]);
XEND(*GETFNAM*);
X#endif
X
XPROCEDURE INSTR( VAR S : STRING);
XVAR I : INTEGER;
XBEGIN
X WHILE INFILE^ = ' ' DO GET(INFILE);
X FOR I := 1 TO STRSIZE DO
X IF INFILE^ = ' ' THEN S[I] := ' ' ELSE READ(INFILE,S[I]);
XEND(* INSTR *);
X
XPROCEDURE INHEX(VAR N : INTEGER);
XVAR D : INTEGER;
XBEGIN
X N := 0;
X WHILE INFILE^ = ' ' DO GET(INFILE);
X WHILE INFILE^ IN ['A'..'F','0'..'9'] DO BEGIN
X IF INFILE^ IN ['A'..'F']
X THEN D := ORD(INFILE^)-ORD('A')+10
X ELSE D := ORD(INFILE^)-ORD('0');
X N := N*16+D;
X GET(INFILE);
X END;
XEND (* INHEX *);
X
XPROCEDURE SORT;
XVAR I,J : INTEGER;
X DUMMY : MNEMRECORD;
XBEGIN
X FOR I := 1 TO NROFELEM DO
X FOR J := 2 TO NROFELEM DO
X IF TABLE[J].NAME < TABLE[J-1].NAME THEN BEGIN
X DUMMY := TABLE[J];
X TABLE[J] := TABLE[J-1];
X TABLE[J-1] := DUMMY;
X END;
XEND (* SORT *);
X
XBEGIN
X#ifdef PRIME
X WRITE('Input filename - ');
X GETFNAM;
X RESET(INFILE,FNAME);
X WRITE('Output filename - ');
X GETFNAM;
X REWRITE(OUTFILE,FNAME);
X#else
X RESET(INFILE);
X REWRITE(OUTFILE);
X
X CONV[ 0] := OPNAM;
X CONV[ 1] := OPFCB;
X CONV[ 2] := OPFCC;
X CONV[ 3] := OPRMB;
X CONV[ 4] := OPEQU;
X CONV[ 5] := OPSDP;
X CONV[ 6] := OPEND;
X CONV[ 7] := OPOPT;
X CONV[ 8] := OP0 ;
X CONV[ 9] := OP1B ;
X CONV[10] := OP1W ;
X CONV[11] := OPEMT;
X CONV[12] := OPREL;
X CONV[13] := OPREG;
X CONV[14] := OPSTK;
X#endif
X WRITE('Reading...');
X I := 0;
X WHILE NOT EOF(INFILE) DO BEGIN
X I := I+1;
X REPEAT
X INSTR(TABLE[I].NAME);
X IF TABLE[I].NAME[1] = '*' THEN
X READLN(INFILE);
X UNTIL TABLE[I].NAME[1] <> '*';
X READ(INFILE,J);
X TABLE[I].OPT := CONV[J];
X INHEX(TABLE[I].OPC);
X WRITE(OUTPUT,'.');
X WHILE (INFILE^ = ' ') AND NOT EOF(INFILE) DO GET(INFILE);
X END;
X NROFELEM := I;
X WRITELN;
X WRITE('Sorting...');
X SORT;
X WRITELN;
X WRITELN('Writing...');
X FOR I := 1 TO NROFELEM DO BEGIN
X OUTFILE^ := TABLE[I];
X PUT(OUTFILE);
X END;
X WRITELN;
XEND .
EndOfFile
echo x - mneminput
sed 's/^X//' <<'EndOfFile' >mneminput
XABX 8 3A
XADCA 9 89
XADCB 9 C9
XADDA 9 8B
XADDB 9 CB
XADDD 10 C3
XANDA 9 84
XANDB 9 C4
XANDCC 9 1C
X* !! ANDC is identiek aan ANDCC om compatibel te blijven met RT-11 a6809
XANDC 9 1C
XASL 9 48
XASLA 8 48
XASLB 8 58
XASR 9 47
XASRA 8 47
XASRB 8 57
XBCC 12 24
XBCS 12 25
XBEQ 12 27
XBGE 12 2C
XBGT 12 2E
XBHI 12 22
XBHS 12 24
XBITA 9 85
XBITB 9 C5
XBLE 12 2F
XBLO 12 25
XBLS 12 23
XBLT 12 2D
XBMI 12 2B
XBNE 12 26
XBPL 12 2A
XBRA 12 20
XBRN 12 21
XBSR 12 8D
XBVC 12 28
XBVS 12 29
XCLR 9 4F
XCLRA 8 4F
XCLRB 8 5F
XCMPA 9 81
XCMPB 9 C1
XCMPD 10 1083
XCMPU 10 1183
XCMPX 10 8C
XCMPS 10 118C
XCMPY 10 108C
XCOM 9 43
XCOMA 8 43
XCOMB 8 53
XCWAI 9 3C
XDAA 8 19
XDEC 9 4A
XDECA 8 4A
XDECB 8 5A
XEMT 11 3F
XEORA 9 88
XEORB 9 C8
XEXG 13 1E
XFCB 1 01
XFCC 2 00
XFDB 1 02
XINC 9 4C
XINCA 8 4C
XINCB 8 5C
XJMP 10 4E
XJSR 10 8D
XLBCC 12 1024
XLBCS 12 1025
XLBEQ 12 1027
XLBGE 12 102C
XLBGT 12 102E
XLBHI 12 1022
XLBHS 12 1024
XLBLE 12 102F
XLBLO 12 1025
XLBLS 12 1023
XLBLT 12 102D
XLBMI 12 102B
XLBNE 12 1026
XLBPL 12 102A
XLBRA 12 16
XLBRN 12 1021
XLBSR 12 17
XLBVC 12 1028
XLBVS 12 1029
XLDA 9 86
XLDAA 9 86
XLDB 9 C6
XLDAB 9 C6
XLDD 10 CC
XLDS 10 10CE
XLDU 10 CE
XLDX 10 8E
XLDY 10 108E
XLEAS 10 12
XLEAU 10 13
XLEAX 10 10
XLEAY 10 11
XLSL 9 48
XLSLA 8 48
XLSLB 8 58
XLSR 9 44
XLSRA 8 44
XLSRB 8 54
XMUL 8 3D
XNAM 0 00
XNEG 9 40
XNEGA 8 40
XNEGB 8 50
XNOP 8 12
XOPT 7 00
XORA 9 8A
XORAA 9 8A
XORB 9 CA
XORAB 9 CA
XORCC 9 1A
XORG 3 02
XPSHS 14 34
XPSHU 14 36
XPULS 14 35
XPULU 14 37
XRMB 3 01
XROL 9 49
XROLA 8 49
XROLB 8 59
XROR 9 46
XRORA 8 46
XRORB 8 56
XRTI 8 3B
XRTS 8 39
XSBCA 9 82
XSBCB 9 C2
XSEX 8 1D
XSTA 9 87
XSTAA 9 87
XSTB 9 C7
XSTAB 9 C7
XSTD 10 CD
XSTS 10 10CF
XSTU 10 CF
XSTX 10 8F
XSTY 10 108F
XSUBA 9 80
XSUBB 9 C0
XSUBD 10 83
XSWI 8 3F
XSWI2 8 103F
XSWI3 8 113F
XSYNC 8 13
XTFR 13 1F
XTST 9 4D
XTSTA 8 4D
XTSTB 8 5D
XZZZZZZ 8 FE
XEND 6 00
XEQU 4 00
XSETDP 5 00
X* SETD == SETDP, FOR RT-11 COMPATABILITY
XSETD 5 00
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 ^^^^^jack@vu44.UUCP (Jack Jansen) (02/19/85)
: '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 ^^^^^