IMD 1.17: 14/03/2012 8:50:55 ASSM: B3466A 3.5" DS      ASSM  M$!QLINKASSMYTK $6SiM68KDECLT_K 4$6V3M68KFORMT_KA$6WM68KFPCDGTKI$$7#M68KFPDECTKm$7M68KFPEXPTKs$7M68KPARSETKy`$7_M68KPAS1T_KQ$7P{M68KPAS1BTK*H$7GM68KPAS2ATKr$7"M68KPAS2BTK'$7)M68KPNCHT_K$71M68KREADT_K"$74!M68KSYMBT_K$76M68KUTILT_K5j$7Ai#MAINSCHT__K$7DOPINITFPT_K$7SbMAKE_ASSMTKl$7VLINKASSMNTKn$7YiM68KEXPT__Ko,$8+{M68KFPMVMTK$8wM68KPAS2CTK`$8_OPINITT___K $8!%CONVERTC__2$8Slh1 oscratch:assmbler p ldxCOPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY imainsch ttttts174 ttts372 lkq  { THIS FILE CONTAINS THE GLOBAL DECLARATIONS FOR THE 68000 ASSEMBLER } (* Note - when making the changes of 3/8/85 to partially support the mc68881 floating point coprocessor, several areas and/or items of special interest were flagged in the assembler source. The flag used was a series of three question marks (i.e. "???"). These should be inspected and removed as appropriate changes are made for full support of the MC68881 and MC68020 Brad Taylor  *) CONST VERSTRING='[3.25]'; MONTH=10; DAY =28; YEAR =91; var bump_value : integer; { JWH 11/21/89. } $include 'M68KFPDEC'$ $INCLUDE 'NOPCODES'$ MAXLINELEN=200; BLANK=' '; COMMA=','; PERIOD='.'; OPENPAREN='('; CLOSEPAREN=')';      DSCALE,ERRRELREFS); EVALWHEN=(NOK, OK1, OK2); LSTRING=STRING[MAXLINELEN]; SYMKIND=(ABSOLUT, RELATIVE, AREG, DREG, STREG, fpreg, fpstreg, PREG); STREF=^SYMTABENTRY; EXTREFPTR=^EXTREFBLOCK; FORCEMODE=(NOMODE, LMODE, SMODE, RMODE); SYMT* IS OFFSET A D-REGISTER ? *) OFFSET: 0..31; DWID: BOOLEAN; (* IS WIDTH A D-REGISTER ? *) WIDTH: 0..31; END; BIGREC=PACKED ARRAY [0..511] OF BYTE; IDXWORD=PACKED RECORD {ASSUMES ALLOCATION ORDER} DA: BOOLEAN; REGI: 0.ABENTRY=PACKED RECORD SLINK,SPLINK :STREF; DEFINED: SHORTINT; SKIND: SYMKIND; SVALUE: WORD32; SEXTPTR:EXTREFPTR; { USED FOR EQUATES TO EXTERNALS } EXT: BOOLEAN; { FLAG TO INDICATE AN EXTERNAL } SMODE: FORCEMODE; SNAME:STRING80; E.7; WL: BOOLEAN; SCALE: 0..3; FULL: BOOLEAN; CASE INTEGER OF 0: (DISP: 0..255); 1: ( { 7 } BASE_SUPPRESS: BOOLEAN; { 6 } INDEX_SUPPRESS: BOOLEAN; { 5, 4 } BD_SIZE: DISPSIZE; { 3 } FILL: NUMBERSIGN='#'; ATSIGN='@'; PLUS='+'; MINUS='-'; MAXNAMELEN=11; {LAF 870820} TYPE WORD32=PACKED RECORD CASE INTEGER OF {ASSUMES ALLOCATION ORDER} 1: (HIHALF,LOHALF: SHORTINT); 2: (BYTE1, BYTE2, BYTE3, BYTE4: BYTE); 3: (BITS: PACND; EXPRVALUE=RECORD BASE: SYMKIND; OFFSET: WORD32; EXPREFS: EXTREFPTR; EMODE: FORCEMODE END; EXTREFBLOCK=PACKED RECORD MINUS: BOOLEAN; SYMPT: STREF END; DEFPTR=^DEFREC; DEFREC=PACKED RECORD DEFNKED ARRAY[0..31] OF BOOLEAN); 4: (LONGINT: INTEGER); 5: (fltpt : longreal); 6: (fltptwd1, fltptwd2, fltptwd3, fltptwd4 : shortint ); END; OPNAME=PACKED ARRAY[1..MAXNAMELEN] OF CHAR; (* LAF 861120 *) {LAF 870820} OPREC=PACKED RECORD EXT: DEFPTR; DEFTYPE: RELOCTYPE; LOCATION: WORD32; IDNAME: STRING80; END; EXTPTR=^EXTREC; EXTREC=PACKED RECORD EXTNEXT: EXTPTR; EXTNAME: STRING80; END; REFPTR=^REFREC; REFREC=RECORD REFNEXT: REFPTR; INFO: GENERAL NAME: OPNAME; CODE: SHORTINT; CLASS: SHORTINT END; OPNUM=0..NOPCODES; OPTABLETYPE = ARRAY[OPNUM] OF OPREC; ERRCODE=(ERRBADOP, ERRUNDEFSYM, ERRBADMODE, ERRLABELREQD, ERRDUPDEFSYM, ERRBADSUFFIX, ERRBADSIZE, ERRBADCOVALUE; VALUE: WORD32; EXTSTUFF: REFERENCEPTR; EXTSTUFF2: REFERENCEPTR; END; OPSIZETYPE = 0..12; DISPSIZE = (S_RES, S_NULL, S_WORD, S_LONG); OPERAND=RECORD SIZE: OPSIZETYPE; MODE: 0.. 9; (* 8=fpreg, 9NST, ERRBADEXPR, ERRARITHOFLO, ERRFIELDOFLO, ERRBADSYNTAX, ERRBADBASE,ERREXTREFS,ERRMODEDECL, ERRPHASE, ERRINCOPEN, ERRBADINCLUDE,ERRBADCOM, ERRGOTSTART, ERRDIROVF,ERRCOMMAEXP, ERRSYMBEXP, ERREOLEXP, ERRREGEXP, ERRAREGEXP, ERRCLOSEPEXP,ERRM=fpstreg *) { REG: 0..16; } (* STACK REGISTERS RANGE THROUGH 14 *) { 12/26/89 JWH : } REG: 0..22; (* STACK REGISTERS RANGE THROUGH 14 *) { 15 } INDEXMODE: (ADDRS, DATA); { 14,13,12} INDEX: 0..7; ODNAME, erropen, readerror, errwrite, errcread,erroddorg,errTASwarn,errlinecnt, errfpregnotallowed, errfpsysregnotallowed, errfpopdnotallowed, errdifffpregneeded, errfpconstneeded, errfpregneeded, errfpsysregneeded, errfpmonadicneeded, errf { INDEX REG NUMBER } { 11 } INDEXSIZE: (WRD, LONG); { 10, 9 } INDEXSCALE: 0..3; { 8 } FULL_FORMAT: BOOLEAN; { 7 } BASE_SUPPRESS: BOOLEAN; { 6 } INDEX_SUPPRESS: BOOLEAN; { 5, 4 } BD_SIZE: DISPSIZE; { 3 pel, errfpregexp, errbadfpk, errfpromconst, errfpimmedparse, errfpimmedsize, errfpinternalerr, errfpbccsize, ERRCOLONEXP,ERRLBRACEEXP,ERRRBRACEEXP,ERRRBRACKEXP,ERRRBRACKUNEXP, ERR2INNER,ERR2DISP,ERR2INDEX,ERR2AN,ERR2ZPC,ERRMISZPC, ERRBA } FILL: BOOLEAN; { 2 } POST_INDEXED: BOOLEAN; { 1, 0 } OD_SIZE: DISPSIZE; VALUE: EXPRVALUE; OD_VALUE: EXPRVALUE;(* OUTER DISPLACEMENT *) END; BITFIELDTYPE= RECORD DOFF: BOOLEAN; (      BOOLEAN; { 2 } POST_INDEXED: BOOLEAN; { 1, 0 } OD_SIZE: DISPSIZE; ); END; TITLELINE= STRING[60]; ORGMODETYPE=(SHORTFWDS, LONGFWDS); PCMODETYPE=(ABS, REL); CHARKINDS=(SPECIAL, ALPHABETIC, NUMERIC); ADDRESS = ^CLUDELINENO: SHORTINT; MAINLINENO: SHORTINT; {KEEP TRACK OF LINE NUMBERS IN FILES} CURROP: OPREC; { CURRENT SOURCE LINE } CURCOL: SHORTINT; LAB: STRING255; LINE: LSTRING; LINECOPY:LSTRING; PRINTLINE:LSTRING; LOCCTR: WORD32INTEGER; { GENERIC POINTER } MDPTRTYPE = ^MODULEDIRECTORY; LDIRPTRTYPE = ^DIRECTRY; DIRECTRY = ARRAY[0..1] OF DIRENTRY; SOURCEPTR = ^SOURCEREC; SOURCEREC = RECORD NEXTSOURCE: SOURCEPTR; SOURCELINE: STRING[MAXLINELEN]; END; $if mc6; {CURRENT PC} LOCCTB: WORD32; LOWRORG:WORD32; { LOWEST RELOCATABLE ADDRESS } HIGHADDR:WORD32; { HIGHEST RELOCATABLE ADDRESS } GOTSTART: BOOLEAN; STARTLOC: WORD32; { START LOCATION FOR EXECUTION }8881$ fpsysflagtyp = 0..7; (* system register flag type *) fpformtyp = 0..7; (* src/dest format type type *) $end$ CONST OPTABLE = OPTABLETYPE[ $INCLUDE 'OPCODES'$ ]; VAR RDATE: DATEREC; { DATE OF CURR STARTMODE: RELOCTYPE; { MODE OF STARTLOC } $if false$ (* variable lastop is not used anywhere *) LASTOP: OPNUM; $end$ ZOPFILE: FILE OF OPREC; { OPCODE FILE } SIZESUFFIX:CHAR; { INDICATES IF .B, .W, .S OR .L SUFFIX FOUNENT REVISION } CDATE: DATEREC; { CURRENT DATE } ctime: timerec; { current time } ctimestr: string[8]; { string of current time } CHTYPE: ARRAY[CHAR] OF CHARKINDS; XLATE: ARRAY[CHAR] OF CHAR; {USED FOR UPCAD } SIZE: SHORTINT; { CURRENT SIZE OF OPERAND DETERMINED FROM SIZESUFFIX } BITFIELD: BITFIELDTYPE; { OFFSET AND WIDTH FOR BIT FIELD INSTRUCTIONS } OPERAND1, OPERAND2: OPERAND; { HOLD OPERAND INFORMATION FOR CURRENT INST } OPERAND4, OPERANDSE CONVERSION } CH: CHAR; {SCRATCH VAR} EVALOK: EVALWHEN; { SCRATCH VAR } EVALUE: EXPRVALUE; { SCRATCH VAR } PASS:1..2; { INDICATES PASS NUMBER } SUPERLIST: BOOLEAN; { LIST BOOLEAN SET IN 5, OPERAND6: OPERAND; { BFxxx & CAS2 } $if mc68881$ operand3 : operand; (* hold opd info for FSINCOS and FMOVE.P FPn,(k) *) fpreadmode : boolean; (* flt. pt. mode flag for GETSYMBOL() *) allowfpopds : boolean; INITIAL DIALOGUE } LISTING: BOOLEAN; { STATE VAR FOR LISTING SET BY PSEUDO OPS} didheader: boolean; { indicates if header line was output } listdone: boolean; { indicates assembly source list is done } decimal: boolean;  (* allow flt. pt. operands ? *) fpsysflag : fpsysflagtyp; (* 881 system reg flag for FMOVEM *) $end$ PCMODE: PCMODETYPE; { INDICATES ORG OR RORG IN EFFECT } ORGMODE:ORGMODETYPE; { INDICATES IF FORCE LONG FOR FWD REFS } ZERO32 { print addresses in decimal (ugh!)} OBJECT: BOOLEAN; { STATE VAR FOR OBJECT OUTPUT } DEBUG: BOOLEAN; { TURNS ON DEBUG MODE } LISTSYMS: BOOLEAN; { PRINT SYMBOL TABLE } ERRINLINE: BOOLEAN; { INDICATES AN ERRO: WORD32; { ALWAYS HAS 32 BIT ZERO } FWDREF: BOOLEAN; { FLAG TO INDICATE A FWD REF IN OPERAND } LP: TEXT; REPLY: CHAR; { HOLDS Y/N RESPONSE FOR LIST OPTION } LLEN: SHORTINT; { PRINTER WIDTH } R IN CURRENT LINE} LINEERRCODE: ERRCODE; { WHAT THE ERROR WAS } ERRCOUNT, LINENO: SHORTINT; { COUNT LINES AND ERRORS } PASS1ERRS: SHORTINT; { HOLDS NUMBER OF PASS 1 ERRORS } LASTERRLINE: SHORTINT; { NUMBER OF LAST ERROR LINE} IN SHORTMODE: BOOLEAN; { PRINT MODE FOR DC'S } CONTIGUOUS: BOOLEAN; ENDOFCODE: INTEGER; PUNCHLC: SHORTINT; PUNCHBLK: BIGREC; OBJCTR: SHORTINT; EXTFILE: EXTPTR; { LINKER OUTPUT FILES } DEFFILE: DEFPTR; REFFILE: REFPTR; EXTHEAD:     EAN; SIZE: 0..3; EA: 0..63; END); 4:(TYPE4: PACKED RECORD XFILL: 0..31; B10: BOOLEAN; B9: BOOLEAN; DMODE: 0..7; MODE: 0..7; FILL: 0..7; END); 5:(TYPE5: PACKED RECORD XXFILL: 0..511; B6: BOOLEAN; FILL5:0..3; VECTOR: 0..15; ok : evalwhen; var evalue : exprvalue; var col : shortint ) : boolean; $end$ PROCEDURE NEGEXPR(VAR VAL: EXPRVALUE); PROCEDURE GETCONST(VAR VAL:EXPRVALUE; VAR COLL: SHORTINT); PROCEDURE GETSYMBOL(VAR VAL:EXPRVALUE; VAR COLL: SHORTINT); PROCEDUEND); 6:(IDX: {PACKED} ARRAY[1..11] OF IDXWORD); $if mc68881$ 7:( fptype1: packed record f_line : 0..15; (* op word *) cp_id : 0..7; typ : 0..7; num : 0..63; opclass : 0..7; (* Command word *) rx : 0..7; ry : 0..7; RE PARSE_BITFIELD(VAR BF: BITFIELDTYPE); PROCEDURE PARSEOPERAND(VAR OP:OPERAND); FUNCTION PARSE_CACHES : INTEGER; $if mc68881$ procedure fpmovem( writetomem : boolean; report : boolean ); function setfpsysflag( opd : operand; report : boolean;  EXTPTR; EXTTAIL: EXTPTR; DEFHEAD: DEFPTR; DEFTAIL: DEFPTR; globalptr: defptr; REFHEAD: REFPTR; REFTAIL: REFPTR; SOURCEHEAD: SOURCEPTR; SOURCETAIL: SOURCEPTR; SOURCEFILENAME: STRING255; LISTNAME:STRING255; OBJNAME: STRING255; MODNA extension : 0..127; (* also used for CPRED *) end ); $end$ 8:(BITS: PACKED RECORD B15,B14,B13,B12,B11,B10,B9,B8,B7,B6,B5,B4,B3,B2,B1,B0: BOOLEAN; END); 9:(BITS2: PACKED RECORD FILL: SHORTINT; (* first word *) BME: STRING80; GOTMODNAME: BOOLEAN; iomsg: string80; { used for error messages } EXTCTR: SHORTINT; { COUNTS NUMBER OF EXTERNAL SYMBOLS FROM REFA, REFR'S } DEFCTR: SHORTINT; { COUNTS NUMBER OF DEFFILE RECORDS } FIRSTREF: BOOLEAN; REFCTR: SHORTI15,B14,B13,B12,B11,B10,B9,B8,B7,B6,B5,B4,B3,B2,B1,B0: BOOLEAN; END); 10:(OITS: PACKED RECORD B15: BOOLEAN; O4,O3,O2,O1,O0: 0..7; END); 11:(OITS2: PACKED RECORD FILL: SHORTINT; (* first word *) B15: BOOLEAN; O4,O3,O2,ONT; { COUNTS NUMBER OF REFFILE RECORDS } REFLOC: INTEGER; LASTREFLOC: INTEGER; REFOFF: INTEGER; { THESE ARE USED IN CALCULATING REF OFFSETS } ORIGIN: INTEGER; { START LOCATION OF CURRENT TEXTREC } TEXTSTART: INTEGER; TEXTSIZE: INTEGER; 1,O0: 0..7; END); 12:(OITS3: PACKED RECORD FILL1: SHORTINT; (* first word *) FILL2: SHORTINT; (* second word *) B15: BOOLEAN; O4,O3,O2,O1,O0: 0..7; END); 13:(BF: PACKED RECORD FILL: SHORTINT;  REFSTART: INTEGER; REFSIZE: INTEGER; DEFSTART: INTEGER; DEFSIZE: INTEGER; EXTSTART: INTEGER; EXTSIZE: INTEGER; GLOBALSIZE: INTEGER; GLOBALBASE: INTEGER; SOURCESTART: INTEGER; SOURCESIZE: INTEGER; TEXTRECORDS: INTEGER; TEXTINFO: SH (* first word *) B15: BOOLEAN; REG: 0..7; (* bits 15-12 *) DOFF: BOOLEAN; OFFSET: 0..31; (* bits 11- 6 *) DWID: BOOLEAN; WIDTH : 0..31; (* bits 5- 0 *) END); END; CODELENGTH: SHORTINT; PAGENUMBER: SHORTINT; TOPMARGORTINT; { OFFSET OF INFO FOR TEXT RECORDS } GV: GENERALVALUE; { SCRATCH GVR } GOTCOM: BOOLEAN; {SAYS WE HAVE SEEN A VALID COM STATEMENT} CODE: RECORD {ASSUMES ALLOCATION ORDER} CASE INTEGER OF 0:(INT: PACKED ARRAY[1..11] OF SHORTINT);IN, BOTMARGIN, LINESPERPAGE: SHORTINT; CURRENTLINE: SHORTINT; TITLE: TITLELINE; CHECKREGNO: SHORTINT; CHECKREGMODE: SYMKIND; { TWO GLOBALS FOR CHECKREG FUNCTION } LDIRP: LDIRPTRTYPE; MDPTR: MDPTRTYPE; IMPLEMENT END; FORWARD MODULE MAIN 1:(BYT: PACKED ARRAY[1..22] OF BYTE); 2:(TYPE2: PACKED RECORD FILL1: 0..3; MSIZE: 0..3; REGX: 0..7; OPM1: 0..7; B5: BOOLEAN; B4: BOOLEAN; B3: BOOLEAN; REGY: 0..7; END); 3:(TYPE3: PACKED RECORD OPCODE: 0..15; DATA1: 0..7; B8: BOOL; IMPORT MAINDECL,SYSGLOBALS; EXPORT {**** DECLARE UTILITY PROCEDURES } PROCEDURE EXPRESS(GIVERRORS:BOOLEAN;VAR EVALOK:EVALWHEN; VAR EVALUE:EXPRVALUE; VAR COL: SHORTINT); $if mc68881$ function fpimmedexp( giveerrors : boolean; var eval     var flag : fpsysflagtyp ) : boolean; $end$ FUNCTION CHECKREGS:BOOLEAN; FUNCTION CHECKSPREGS: BOOLEAN; PROCEDURE PASS2;  of function "fpform" *)  (* * Name: fpform - flt. pt. operand format selection routine * * Abstract: * This function returns the format code (range 0..7) for * the floating point instruction operand passed in, * as per the MC68881 instruction requirements. * * H $if mc68881$ procedure fpcodegen; $include 'M68KFORM'$ begin if (currop.class >= fpbase) and (currop.class <= fpgentop) then begin (* "general" class *) codelength := 4; code.fptype1.cp_id := defaulistory: * 02/26/85 - bct, original *) function fpform( opd : operand; report : boolean; srcform : boolean ) : fpformtyp; const badops = 101; opsok = 100; begin TRY if sizesuffix = 'L' then begin fpform := 0; if not datamodet_cpid; code.int[ 2 ] := 0; (* clear cmd word *) if (currop.class = (fpbase+0)) and (currop.name[ 6 ] = 'M') and (operand1.mode <> 9) and (operand2.mode <> 9) then begin (* FMOVEM for FPn's *) ( opd ) then escape( badops ); end else if sizesuffix = 'S' then begin fpform := 1; if not datamode( opd ) then escape( badops ); end else if sizesuffix = 'X' then begin fpform := 2; if not memmode( opd ) then eswith code.fptype1 do if (operand1.mode = 7) and (operand1.reg = 4) then begin (* *) opclass := 7; if operand2.mode = 4 then rx := 0 else rx := 4; code.byt[ 4 ] := opcape( badops ); end else if sizesuffix = 'P' then begin fpform := 3; if not memmode( opd ) then escape( badops ); end else if (sizesuffix = 'W') or (sizesuffix = ' ') then begin fpform := 4; if not datamode( opd erand1.value.offset.byte4; buildea( operand2, 3, code.idx[ 3 ] ); end else if operand1.mode = 0 then begin (* Dn, *) opclass := 7; if operand2.mode = 4 then rx := 2 else r) then escape( badops ); end else if sizesuffix = 'D' then begin fpform := 5; if not memmode( opd ) then escape( badops ); end else if sizesuffix = 'B' then begin fpform := 6; if not datamode( opd ) then escape( x := 6; extension := operand1.reg * 16; buildea( operand2, 3, code.idx[ 3 ] ); end else if (operand2.mode = 7) and (operand2.reg = 4) then begin (* , *) opclass := 6; rx badops ); end else begin error( errfpinternalerr ); escape( badops ); end; escape( opsok ); RECOVER if escapecode = badops then begin if report then error( errbadmode ); fpform := 4; end else := 4; code.byt[ 4 ] := operand2.value.offset.byte4; buildea( operand1, 3, code.idx[ 3 ] ); end else if operand2.mode = 0 then begin (* ,Dn *) opclass := 6; rx := 6; extension := ope if escapecode <> opsok then escape( escapecode ) else if not srcform then if not alterable( opd ) then begin if report then error( errbadmode ); fpform := 4; end; end; (* endrand2.reg * 16; buildea( operand1, 3, code.idx[ 3 ] ); end else error( errfpinternalerr ); end (* FMOVEM for FPn's *) else (* more general "general" class *)      begin (* movecr *) code.fptype1.rx := 7; code.fptype1.extension := operand1.value.offset.longint; end else begin code.fptype1.rx := fpform( operand1, true, true ); code.fptype1.extension := (currop.cla6 else if currop.name[3] = 'D' then { really FDDIV } code.fptype1.extension := 100; end; 260 : begin { FSQRT } if currop.name[2] = 'D' then { really FDSQRT } code.fptype1.extension := 69 else if currop.name[3] = 'S' then { really ss - fpbase); if currop.class = (fpbase+48) then begin (* FSINCOS *) if operand3.mode <> 8 then error( errfpinternalerr ); code.fptype1.extension := code.fptype1.extension + operand3.reg; end;FSSQRT } code.fptype1.extension := 65; end; 296 : begin { FSUB } if currop.name[2] = 'D' then { really FDSUB } code.fptype1.extension := 108 else if currop.name[3] = 'S' then { really FSSUB } code.fptype1.extension := 104; endif (operand1.mode = 8) and (operand2.mode = 8) then begin (* FPn, FPm *) code.fptype1.opclass := 0; code.fptype1.rx := operand1.reg; code.fptype1.ry := operand2.reg; code.fptype1.extension := (currop.class - fpbas buildea( operand1, 3, code.idx[ 3 ] ); end; end else if operand1.mode = 9 then (* CONTROL/STATUS/IADDR, *) begin code.fptype1.opclass := 5; if fpsysflag = 0 then error( errfpinternalerr ); code.fptype1.rx := fpsye); if currop.class = (fpbase+48) then begin (* FSINCOS *) if operand3.mode <> 8 then error( errfpinternalerr ); code.fptype1.extension := code.fptype1.extension + operand3.reg; end; esflag; buildea( operand2, 3, code.idx[ 3 ] ); end else if operand2.mode = 9 then (* ,CONTROL/STATUS/IADDR *) begin code.fptype1.opclass := 4; if fpsysflag = 0 then error( errfpinternalerr ); code.fptype1.rx := fpsysflnd else if operand1.mode = 8 then begin (* FPn, *) code.fptype1.opclass := 3; code.fptype1.rx := fpform( operand2, true, false ); code.fptype1.ry := operand1.reg; if operand3.mode = 0 then (* Bag; buildea( operand1, 3, code.idx[ 3 ] ); end else error( errfpinternalerr ); {------------------------------------------------------------------} { 11/20/89 JWH } { Fix the extension word if we had an explicitly forced { single orCD, in Dn *) begin code.fptype1.rx := 7; if operand3.mode <> 0 then error( errfpinternalerr ); code.fptype1.extension := 16 * operand3.reg; end else if (operand3.mode = 7) and (operand3.reg = 4) then begin  double precision rounding instruction. 68040 only. } { Also for the fmove instruction, we require that the dest. { be an FPn. Otherwise just use the standard version of fmove, { i.e. don't alter the extension word. } case currop.class of  (* BCD, static *) code.fptype1.extension := operand3.value.offset.longint; end else code.fptype1.extension := 0; buildea( operand2, 3, code.idx[ 3 ] ); end (* FPn, *) else 256,280,282,290,291 : {FMOVE,FABS,FNEG,FADD,FMUL} begin { FMOVE, etc. } if ((currop.class <> 256 ) or (operand2.mode = 8)) then begin if currop.name[2] = 'S' then { really FSMOVE, etc. } code.fptype1.extension := code.fptype1.extensio if operand2.mode = 8 then begin (* , FPn *) code.fptype1.opclass := 2; code.fptype1.ry := operand2.reg; if (currop.class = (fpbase+0)) and (currop.name[ 6 ] = 'C') and (currop.name[ 7 ] = 'R') then n + 64 else if currop.name[2] = 'D' then { really FDMOVE, etc. } code.fptype1.extension := code.fptype1.extension + 68; end; end; 288 : begin { FDIV } if currop.name[2] = 'S' then { really FSDIV, etc. } code.fptype1.extension := 9     ; otherwise ; end; { CASE } {----------------------------------------------------------------} end (* "general" class *) else if (currop.class >= (fpbase+fpbrbase)) and (currop.class <= (fpbase+fpbrbaset.hihalf; code.int[ 3 ] := operand1.value.offset.lohalf; codelength := codelength + 2; end; if ( operand1.value.exprefs <> NIL ) or ( ( operand1.value.base = absolut ) and ( pcmode = rel) ) or ( ( operand1.value.base = relative ) and ( pcmode+31)) then begin (* FDBcc, FScc, FTcc, and FTPcc *) codelength := 4; code.fptype1.cp_id := default_cpid; code.int[ 2 ] := 0; code.fptype1.extension := currop.class - (fpbase+fpbrbase); if currop.ce= abs ) ) then begin operand1.mode := 7; operand1.reg := 2; (* what about 32 bit displ ??? *) linkpatch := true; dolinkxtref( operand1, 2, linkpatch, exwordaddr ); end; end (* FBcc ode = -4024 then (* FDBcc *) begin code.type2.regy := operand1.reg; code.int[ 3 ] := operand2.value.offset.lohalf; codelength := codelength + 2; operand2.size:=2; (* kludges for branches *) operand2.mode:=7; (* kludges for*) else if (currop.class = (fpbase+fpbrbase+33)) or (currop.class = (fpbase+fpbrbase+34)) then begin (* FSAVE and FRESTORE *) codelength := 2; code.fptype1.cp_id := default_cpid; buildea( oper branches *) operand2.reg :=2; (* kludges for branches *) dolinkxtref(operand2,4,true,exwordaddr); end else if currop.code = -4032 then (* FScc *) begin buildea( operand1, 3, code.idx[ 3 ] ); end else if currop.cand1, 2, code.idx[ 2 ] ); end (* FSAVE and FRESTORE *) else if currop.class = (fpbase+fpbrbase+35) then begin (* FNOP *) codelength := 4; code.fptype1ode = -3974 then (* FTPcc *) begin if operand1.size <= 2 then begin code.int[ 3 ] := operand1.value.offset.lohalf; codelength := codelength + 2; end else begin code.int[ 1 ] := code.int[ 1 ] + 1; code.int[ 3.cp_id := default_cpid; code.int[ 2 ] := 0; end (* FNOP *) else begin error( errfpinternalerr ); end; end; (* fpcodegen *) $end$  ] := operand1.value.offset.hihalf; code.int[ 4 ] := operand1.value.offset.lohalf; codelength := codelength + 4; end; dolinkxtref(operand1,4,false,exwordaddr); end; end (* FDBcc, FScc, FTcc, and const mc68881 = true; (* support MC68881 flt. pt. coprocessor ? *) fpimmed = true; (* support flt. pt. immed. operands ? *) (* The initial flt. pt. opd support of 3/8/85 is limited according to the following notes: 1) FTPcc *) else if currop.class = (fpbase+fpbrbase+32) then begin (* FBcc *) codelength := 4; code.fptype1.cp_id := default_cpid; if operand1.size = 2 then (* 16 bit displacement *) begsyntax (src and obj) is that of the host Pascal compiler, without the 'L' exponent flag (i.e. only the 'E' exponent flag), and a period is required. 2) use of flt. pt. opds in expressions is not fully supported 3) DS directive is supportin code.int[ 2 ] := operand1.value.offset.lohalf; end else (* 32 bit displacement *) begin if operand1.size <> 4 then error( errfpinternalerr ); code.int[ 1 ] := code.int[ 1 ] + 64; code.int[ 2 ] := operand1.value.offsed for all flt. pt. type sizes 4) flt. pt. constants are only supported on the DC directive and as immediate operands, and then the explicit ".D" size must be specified *) { $if mc68881$ numfpops = 655; (* number of flt. pt. o     ovflcheck off$ escape( opsok ); RECOVER if escapecode = opsok then begin (* parsed OK *) for i := col to (nxtcol - 1) do begin if line[ i ] = '.' then (* require '.' in opd *) fltnum := 1 ELSE GOTO 2; CURCOL := CURCOL + 2; IF LINE[CURCOL] <> '/' THEN GOTO 1 ELSE BEGIN CURCOL := CURCOL + 1; IF LINE[CURCOL] = 'I' THEN BEGIN IF LINE[CURCOL+1] = 'C' THEN BEGIN PARSE_CACHES := 3; CURCOL := CURCOL + 2; GOTO 1true; if line[ i ] = 'L' then (* disallow 'L' exponent flag *) el := true; end; if fltnum then begin if el and giveerrors then error( errfpel ); evalok := OK1; col := nxtcol; evalue.offset.fltpt := tfp;; END ELSE GOTO 2; END ELSE GOTO 2; END; END; { IF LINE[CURCOL] = 'D' WAS TRUE, CONTROL SHOULDN'T BE HERE. } IF LINE[CURCOL] = 'I' THEN BEGIN IF LINE[CURCOL+1] = 'C' THEN PARSE_CACHES := 2 ELSE GOTO 2; CURCOL := CURCOps $end$ $if fpimmed$ NOPCODES = 294 + numfpops; (* total number of ops $end$ $if not fpimmed$ NOPCODES = 289 + numfpops; (* total number of ops $end$ } $if mc68881$ fpbase = 256; (* first class number for flt. pt. ops *) fpge fpimmedexp := true; end; end (* parsed OK *) else if giveerrors then error( errfpimmedparse ); end; (* fpimmedexp *) $end$ ntop = fpbase+58; (* last class # for "general class" ops *) fpbrbase = fpgentop+1-fpbase; (* 1st class # for branch and misc. ops *) fptop = fpbase+fpbrbase+35; (* last class number for flt. pt. ops *) default_cpid = 1; (* def{ THESE PROCEDURES DO OPERAND DECODING AND EVALUATION IF NECESSARY. } FUNCTION PARSE_CACHES : integer; {-----------------------------------------------------------} { The following routine is included for the CPUSH and CINV } { instructiault coprocessor id number, note that multi-coprocessor support will require mods where this is used *) fpromconstmax = 63; (* max address allowable for MOVECR *) $end$ ons added with the 68040 support. The parsing of } { the first operand with these instructions is so elementary} { that it didn't seem worth it to mess with PARSEOPERAND. } { Returns : 1 if DATA cache only } { 2 if I$if fpimmed$ function fpimmedexp (* FWD -> ( giveerrors : boolean; var evalok : evalwhen; var evalue : exprvalue; var col : shortint ) : boolean *); const opsok = 100; var fltnum : boolean; (* Pascal floating pt. num ? *) el NSTRUCTION CACHE only } { 3 if BOTH CACHES } { 0 if an ERROR } { Expects the syntax to be EXACTLY as follows : } { DC - specifies: boolean; (* flt. num contains L .vs. E ? *) i : shortint; (* index temp *) tfp : longreal; (* temp flt. pt. opd *) nxtcol : integer; (* next col after flt. pt. opd *) begin fpimmed DATA cache } { IC - specifies INSTRUCTION cache } { DC/IC or IC/DC - specifies BOTH caches } { except that lowercase letters are permitted (they're } { converted to uppercase by the liexp := false; evalok := nok; with evalue do begin base := absolut; offset.fltpt := 0.0E0; exprefs := NIL; emode := nomode; end; fltnum := false; el := false; TRY $ovflcheck on$ strread( line, col, nxtcol, tfp ); $ne scanner ). } LABEL 1,2; { LABEL 1 : clean exit point. } { LABEL 2 : error exit point. } BEGIN IF LINE[CURCOL] = 'D' THEN BEGIN IF LINE[CURCOL+1] = 'C' THEN PARSE_CACHES :=      L + 2; IF LINE[CURCOL] <> '/' THEN GOTO 1 ELSE BEGIN CURCOL := CURCOL + 1; IF LINE[CURCOL] = 'D' THEN BEGIN IF LINE[CURCOL+1] = 'C' THEN BEGIN PARSE_CACHES := 3; CURCOL := CURCOL + 2; GOTO 1; END ELSE GOTO 2; END  BF.WIDTH :=TEMPOP.REG; END ELSE BEGIN (* constant *) BF.DWID:=FALSE; BF.WIDTH :=TEMPOP.VALUE.OFFSET.LONGINT; END; IF LINE[CURCOL]<>'}' THEN BEGIN IF PASS=2 THEN ERROR(ERRRBRACEEXP); ESCAPE(BADOPS); END; CURCOL:=CURCOL+1; END; FUNCTION CHE ELSE GOTO 2; END; END; 2: PARSE_CACHES := 0; 1: END; PROCEDURE PARSE_BITFIELD{(VAR BF: BITFIELDTYPE)}; {FWD} VAR TEMPOP: OPERAND; BEGIN IF LINE[CURCOL]<>'{' THEN BEGIN IF PASS=2 THEN ERROR(ERRLBRACEEXP); ESCAPE(BADOPS); END; CURCOL:=CURCOCKREGS; { FWD DECLARED } VAR HOLDCOL: SHORTINT; RVALUE: EXPRVALUE; TPASS: 1..2; BEGIN HOLDCOL:=CURCOL; TPASS:=PASS; PASS:=1; { KLUGE TO AVOID UNDEFINED SYMBOL ERRORS } GETSYMBOL(RVALUE, HOLDCOL); PASS:=TPASS; IF (RVALUE.BASE=AREG) OR (RVALUE.BASE=DRL+1; TEMPOP.VALUE.EXPREFS:=NIL; PARSEOPERAND(TEMPOP); IF (TEMPOP.MODE<>0) AND ((TEMPOP.MODE<>7) OR (TEMPOP.REG<>0)) THEN BEGIN IF PASS=2 THEN ERROR(ERRBADMODE); ESCAPE(BADOPS); END; IF (TEMPOP.VALUE.EXPREFS<>NIL) THEN BEGIN TEMPOP.VALUE.EXPREFS:=NIL;EG) OR (RVALUE.BASE=FPREG) THEN BEGIN CHECKREGNO:=RVALUE.OFFSET.LOHALF; CHECKREGMODE:=RVALUE.BASE; CHECKREGS:=TRUE; CURCOL:=HOLDCOL; END ELSE CHECKREGS:=FALSE; END; FUNCTION CHECKSPREGS; { CHECKS FOR CCR, SR, USP } { FWD DECLARED } VAR  TEMPOP.VALUE.OFFSET :=ZERO32; IF PASS=2 THEN ERROR(ERREXTREFS); ESCAPE(BADOPS); END; IF (TEMPOP.MODE<>0) AND ((0>TEMPOP.VALUE.OFFSET.LONGINT) OR (TEMPOP.VALUE.OFFSET.LONGINT>=32)) THEN BEGIN IF PASS=2 THEN ERROR(ERRFIELDOFLO); ESCAPE(BADOPS); { ALSO DFC, SFC, VBR } { AND MSP,ISP,CACR,CAAR } HOLDCOL: SHORTINT; RVALUE: EXPRVALUE; TPASS: 1..2; BEGIN HOLDCOL:=CURCOL; TPASS:=PASS; PASS:=1; { KLUGE TO AVOID UNDEF SYMBOL ERRORS } GETSYMBOL(RVALUE, HOLDCOL); PASS:=TPASS; IF (RVALUE END; IF TEMPOP.MODE=0 THEN BEGIN (* D-register *) BF.DOFF:=TRUE; BF.OFFSET:=TEMPOP.REG; END ELSE BEGIN (* constant *) BF.DOFF:=FALSE; BF.OFFSET:=TEMPOP.VALUE.OFFSET.LONGINT; END; IF LINE[CURCOL]<>':' THEN BEGIN IF PASS=2 THEN ERROR(E.BASE=STREG) OR (RVALUE.BASE=FPSTREG) THEN BEGIN CHECKREGNO:=RVALUE.OFFSET.LOHALF; CHECKREGMODE:=RVALUE.BASE; CHECKSPREGS:=TRUE; CURCOL:=HOLDCOL; END ELSE CHECKSPREGS:=FALSE END; PROCEDURE PARSEOPERAND{(VAR OP:OPERAND)}; {FWD} VAR HOLDCOL:RRCOLONEXP); ESCAPE(BADOPS); END; CURCOL:=CURCOL+1; TEMPOP.VALUE.EXPREFS:=NIL; PARSEOPERAND(TEMPOP); IF (TEMPOP.MODE<>0) AND ((TEMPOP.MODE<>7) OR (TEMPOP.REG<>0)) THEN BEGIN IF PASS=2 THEN ERROR(ERRBADMODE); ESCAPE(BADOPS); END; IF (TEMPOP.VALUE.EXPREFS< SHORTINT; REGSUFFIX: CHAR; PROCEDURE GETINDEX; BEGIN IF CHECKREGS THEN BEGIN IF LINE[CURCOL]='.' THEN BEGIN REGSUFFIX:=LINE[CURCOL+1]; IF LINE[CURCOL+1]<>BLANK THEN CURCOL:=CURCOL+2; END (* LINE[CURCOL]='.' *) ELSE REGSUFFI>NIL) THEN BEGIN TEMPOP.VALUE.EXPREFS:=NIL; TEMPOP.VALUE.OFFSET :=ZERO32; IF PASS=2 THEN ERROR(ERREXTREFS); ESCAPE(BADOPS); END; IF (TEMPOP.MODE<>0) AND (* different from offset field *) ((0>=TEMPOP.VALUE.OFFSET.LONGINT) OR (TEMPOP.VALUE.OX:=' '; OP.INDEX:=CHECKREGNO; IF CHECKREGMODE=AREG THEN OP.INDEXMODE:=ADDRS ELSE OP.INDEXMODE:=DATA; $if mc68881$ if (pass=2) and (checkregmode=fpreg) then error(errfpregnotallowed); $end$ IF REGSUFFIX='L' THEN OP.INDEXSIZE:=FFSET.LONGINT>32)) THEN BEGIN IF PASS=2 THEN ERROR(ERRFIELDOFLO); ESCAPE(BADOPS); END; IF (TEMPOP.MODE<>0) AND (TEMPOP.VALUE.OFFSET.LONGINT=32) THEN TEMPOP.VALUE.OFFSET.LONGINT:=0; IF TEMPOP.MODE=0 THEN BEGIN (* D-register *) BF.DWID:=TRUE; LONG ELSE IF REGSUFFIX='W' THEN OP.INDEXSIZE:=WRD ELSE IF REGSUFFIX=' ' THEN OP.INDEXSIZE:=WRD ELSE IF PASS=2 THEN ERROR(ERRBADSUFFIX); IF LINE[CURCOL]<>'*' THEN OP.INDEXSCALE:=0 ELSE BEGIN { MUST BE A SCALE FACTOR } CURC     VALUE.EMODE=LMODE THEN SIZE:=S_LONG ELSE (* VALUE.EMODE=SMODE *) BEGIN SIZE:=S_WORD; IF (PASS=2) AND NOT(FITSIN16(VALUE.OFFSET)) THEN ERROR(ERRFIELDOFLO); END; (* VALUE.EMODE=SMODE *) IF SIZE=S_LONG THEN INCRSIZE:=INCRSIZE+4 ELSE IF SIZEode := nomode; end; end; (* full flt. pt. support will require mods here, note too that sizesuffix = ' ' will likely need to allow implicit flt. pt. minimum req'rd size selection else if sizesuffix = 'S' then op.size := 4 else i=S_WORD THEN INCRSIZE:=INCRSIZE+2; END; PROCEDURE IMMEDOP; $if fpimmed$ var specialcaseit : boolean; (* handling FMOVE.P FPn,(#k) or FMOVECR.X #ccc,FPn ? *) $end$ BEGIN CURCOL := CURCOL + 1; $if fpimmed$ if (currop.class = (fpbasf sizesuffix = 'D' then op.size := 8 else if sizesuffix = 'X' then op.size := 12 else if sizesuffix = 'P' then op.size := 12; ---------------------- ??? *) $end$ END; PROCEDURE INDIRECT; (* NOW INCLUDES: (* 2n (An) An IND. (* 3nOL:=CURCOL+1; IF LINE[CURCOL]='1' THEN OP.INDEXSCALE:=0 ELSE IF LINE[CURCOL]='2' THEN OP.INDEXSCALE:=1 ELSE IF LINE[CURCOL]='4' THEN OP.INDEXSCALE:=2 ELSE IF LINE[CURCOL]='8' THEN OP.INDEXSCALE:=3 ELSE e+0)) (* FMOVE instructions *) and ( ((currop.name[6] = 'C') and (currop.name[7] = 'R')) (* FMOVECR *) or ((line[curcol-2] = '{') and (operand1.mode = 8) and (sizesuffix = 'P')) ) (* FMOVE FPn,(#k) *) then specialcaseit := true els IF PASS=2 THEN ERROR(ERRBADSCALE); IF LINE[CURCOL]<>BLANK THEN CURCOL:=CURCOL+1; END; END (* CHECKREGS *) ELSE (* NOT CHECKREGS *) IF PASS=2 THEN ERROR(ERRREGEXP) END; (* GETINDEX *) PROCEDURE GETDISPSIZE(VALUE: EXPRVALUE; VAR SIZE: DISe specialcaseit := false; if (sizesuffix = 'D') and not specialcaseit then begin if fpimmedexp( pass=2, evalok, evalue, curcol ) then begin if (not allowfpopds) and (pass = 2) then error( errfpopdnotallowed ); end else beginPSIZE; VAR INCRSIZE: OPSIZETYPE); (* Based on VALUE.OFFSET, set SIZE to S_NULL, S_WORD, or S_LONG, (* and increment INCRSIZE by 0, 2, or 4 bytes (**) (* mostly swiped from ABSORINDEXED *) BEGIN IF VALUE.EMODE=NOMODE THEN BEGIN IF VALUE.BASE=RELATIV if pass = 2 then error( errfpconstneeded ); end; end else $end$ EXPRESS(PASS=2,EVALOK,EVALUE,CURCOL); OP.MODE:=7; OP.REG:=4; OP.VALUE:=EVALUE; $if fpimmed$ if specialcaseit then op.size := 0 else $end$ if sizesuffix = 'B' then BEGIN E THEN BEGIN IF ORGMODE=LONGFWDS THEN SIZE:=S_LONG ELSE SIZE:=S_WORD; END (* VALUE.BASE=RELATIVE *) ELSE BEGIN IF (EVALOK<>OK1) OR (VALUE.EXPREFS<>NIL) THEN { FWD OR EXT REF } BEGIN IF ORGMODE=LONGFWDS THEN SIOP.SIZE:=2; IF PASS=2 THEN IF NOT(FITSIN8(EVALUE.OFFSET)) AND ( (EVALUE.OFFSET.HIHALF<>0) OR (EVALUE.OFFSET.LOHALF< 0) OR (EVALUE.OFFSET.LOHALF>255)) AND (EVALUE.EXPREFS=NIL) THEN ERROR(ERRFIELDOFLO); END else if (sizesuffixZE:=S_LONG ELSE BEGIN SIZE:=S_WORD; IF (PASS=2) AND NOT(FITSIN16(VALUE.OFFSET)) THEN ERROR(ERRFIELDOFLO); END END (* (EVALOK<>OK1) OR (VALUE.EXPREFS<>NIL) *) ELSE { NOT FWD REF } IF 0 = (VALUE.OFFSET.LONGINT) THEN (*  = 'W') or (sizesuffix = ' ') then BEGIN OP.SIZE:=2; IF PASS=2 THEN IF NOT(FITSIN16(EVALUE.OFFSET)) AND (EVALUE.OFFSET.HIHALF<>0) AND (EVALUE.EXPREFS=NIL) THEN ERROR(ERRFIELDOFLO); END else if sizesuffix = 'L' then $if not fFITSIN0 *) SIZE:=S_NULL ELSE IF FITSIN16(VALUE.OFFSET) THEN SIZE:=S_WORD ELSE (* FITSIN32(VALUE.OFFSET) *) SIZE:=S_LONG; END (* VALUE.BASE<>RELATIVE *) END (* VALUE.EMODE=NOMODE *) ELSE IF VALUE.EMODE=RMODE THEN SIZE:=S_WORD ELSE IF pimmed$ OP.SIZE:=4; $end$ $if fpimmed$ op.size := 4 else if sizesuffix = 'D' then op.size := 8 else begin error( errfpimmedsize ); op.size := 8; with op.value do begin base := absolut; offset.fltpt := 0.0; exprefs := nil; em      (An)+ An IND. WITH POSTINCREMENT (* 5n (d16,An) An IND. WITH DISP. (* 6n (d8,An,Xn.SIZE*SCALE) An IND. WITH INDEX (8-BIT DISP.) (* 6n (bd,An,Xn.SIZE*SCALE) An IND. WITH INDEX (BASE DISP.) (* 6n ([bd,An],Xn.SIZEENZPC :=FALSE; SEENINDEX :=FALSE; VALUEOK:=OK1; (* 870814 *) EVALOK :=OK1; (* 870814 *) OP.FILL:= FALSE; OP.POST_INDEXED:= FALSE; OP.VALUE.OFFSET:= ZERO32; OP.VALUE.EXPREFS:= NIL; OP.VALUE.BASE:= ABSOLUT; OP.VALUE.EMODE:= NOMO*SCALE,od) MEMORY IND. POST-INDEXED (* 6n ([bd,An,Xn.SIZE*SCALE],od) MEMORY IND. PRE-INDEXED (* 73 (rd8,Xn.SIZE*SCALE) PC IND. WITH INDEX (8-BIT DISP.) (* 73 (rbd,Xn.SIZE*SCALE) PC IND. WITH INDEX (BASE DISP.) (* 73 ([rbd],Xn.SIZE*SCALE,od)DE; (* 870814 *) OP.OD_VALUE.OFFSET:= ZERO32; OP.OD_VALUE.EXPREFS:= NIL; OP.OD_VALUE.BASE:= ABSOLUT; OP.OD_VALUE.EMODE:= NOMODE; (* 870814 *) CURCOL:=CURCOL+1; TRY WHILE TRUE DO (* exits with ESCAPE(OPSOK) *) BEGIN IF LINE[CURCOL]='[' T PC MEMORY IND. POST-INDEXED (* 73 ([rbd,Xn.SIZE*SCALE],od) PC MEMORY IND. PRE-INDEXED (* (* OPERAND RECORD: (* SIZE: total size of operand (* MODE: mode, goes in EA (* REG: An, goes in EA (* INDEXMODE:HEN BEGIN IF SEENINNER THEN BEGIN IF PASS=2 THEN ERROR(ERR2INNER); ESCAPE(BADOPS); END; IF SEENZPC THEN BEGIN IF PASS=2 THEN ERROR(ERRMISZPC); ESCAPE(BADOPS); END; CHANGE_An_TO_INDEX(TRUE); ININNER:=TRUE; SEENINNER:=TR index is An/Dn (ADDRS,DATA) (* INDEX: Xn (* INDEXSIZE: SIZE (WRD,LONG) (* INDEXSCALE: SCALE (0..3) (* FULL_FORMAT: (* BASE_SUPPRESS: didn't see base (* INDEX_SUPPRESS: didn't see index (* BD_SIZE:UE; OP.OD_VALUE:=OP.VALUE; IF SEENINDEX THEN OP.POST_INDEXED:=TRUE; CURCOL:=CURCOL+1; END; IF ('A'<=LINE[CURCOL]) AND (LINE[CURCOL]<='Z') OR (LINE[CURCOL]='_') THEN BEGIN COLL:=CURCOL; GETSYMBOL(VAL,COLL);  size of bd (S_RES,S_NULL,S_WORD,S_LONG) (* FILL: zero bit (* POST_INDEXED: index was seen outside ']' (* OD_SIZE: size of od (S_RES,S_NULL,S_WORD,S_LONG) (* VALUE: inner (also called base) or only di INDISPLACEMENT:=(VAL.BASE<>AREG) AND (VAL.BASE<>DREG) AND (VAL.BASE<>PREG); (* THIS WILL CATCH SPREG, AND FP REGS IN EXPRESS BELOW *) END ELSE INDISPLACEMENT:=TRUE; IF INDISPLACEMENT THEN BEGIN (* INDISPLACEMENT *) Esplacement (* OD_VALUE: outer displacement (**) VAR ININNER,SEENINNER,SEENID,SEENOD,SEENAN,SEENZPC,SEENINDEX: BOOLEAN; COLL: SHORTINT; VAL: EXPRVALUE; VALUEOK: EVALWHEN; INDISPLACEMENT,ININDEX: BOOLEAN; PROCEDURE CHANGE_An_TO_INDEXXPRESS(PASS=2,EVALOK,EVALUE,CURCOL); (* ININNER T T T T F F F F (* SEENID T T F F T T F F (* SEENOD T F T F T F T F (* e e m v e o e v (* (* e: error; m: move VALUE to OD_VALUE, store in VALUE (* v: stor(NEW_POST_INDEXED: BOOLEAN); BEGIN IF SEENAN AND NOT SEENZPC THEN BEGIN (* NEED TO CHANGE OLD An TO INDEX *) IF SEENINDEX THEN BEGIN IF PASS=2 THEN ERROR(ERR2INDEX); ESCAPE(BADOPS); END; SEENINDEX:=TRUE; SEENAN :=FALSE; OP.Pe in VALUE; o: store in OD_VALUE (**) IF ININNER THEN BEGIN IF SEENID THEN BEGIN IF PASS=2 THEN ERROR(ERR2DISP); ESCAPE(BADOPS); END; SEENID:=TRUE; IF SEENOD THEN BEGIN OP.OD_VALUE:=OP.VALUE; IF OP.OD_VALUE.BASE=RELATIVE THEN OST_INDEXED:=NEW_POST_INDEXED; OP.INDEXMODE :=ADDRS; OP.INDEX :=OP.REG; OP.INDEXSIZE :=WRD; OP.INDEXSCALE:=0; END; END; BEGIN ININNER :=FALSE; SEENINNER :=FALSE; SEENID :=FALSE; SEENOD :=FALSE; SEENAN :=FALSE; SE BEGIN IF PASS=2 THEN ERROR(ERRRELREFS); ESCAPE(BADOPS); END; END; OP.VALUE:=EVALUE; VALUEOK:=EVALOK; IF OP.VALUE.BASE=RELATIVE THEN CHANGE_An_TO_INDEX(FALSE); END ELSE BEGIN IF SEENOD THEN BEGIN IF PASS=2 THEN ERROR(ERR2DISP); ESCA     D; ININNER:=FALSE; CURCOL:=CURCOL+1; END; IF LINE[CURCOL]=')' THEN BEGIN IF ININNER THEN BEGIN IF PASS=2 THEN ERROR(ERRRBRACKEXP); ESCAPE(BADOPS); END; ESCAPE(OPSOK); END; IF LINE[CURCOL]=',' THEN CUSEENINDEX AND NOT SEENZPC AND FITSIN16(VAL.OFFSET) THEN BEGIN (* EA=2n, 3n, or 5n *) IF SEENOD THEN BEGIN (* EA=5n *) OP.SIZE:=OP.SIZE+2; OP.MODE:=5; END (* EA=5n *) ELSE BEGIN (* EA=2n or 3n *) IF LINE[CURCOL]='+' THEN RCOL:=CURCOL+1 ELSE BEGIN IF PASS=2 THEN ERROR(ERRCOMMAEXP); ESCAPE(BADOPS); END; END; (* infinite WHILE *) RECOVER IF ESCAPECODE=BADOPS THEN BEGIN (* BADOPS *) OP.REG:= 0; OP.INDEXMODE:= DATA; OP.INDEX:=  BEGIN (* EA=3n *) OP.MODE:=3; CURCOL:=CURCOL+1; END (* EA=3n *) ELSE BEGIN (* EA=2n *) OP.MODE:=2; END; (* EA=2n *) END (* EA=2n or 3n *) END (* EA=2n, 3n, or 5n *) ELSE BEGIN (* EA=6n or 73 *) OP.SIZE:=OPE(BADOPS); END; SEENOD:=TRUE; IF SEENINNER THEN BEGIN OP.OD_VALUE:=EVALUE; IF OP.OD_VALUE.BASE=RELATIVE THEN BEGIN IF PASS=2 THEN ERROR(ERRRELREFS); ESCAPE(BADOPS); END; END ELSE BEGIN OP. VALUE:=EVALUE; VALUEOK:=EVALOK;  0; OP.INDEXSIZE:= WRD; OP.INDEXSCALE:= 0; OP.POST_INDEXED:= FALSE; OP.VALUE.OFFSET:= ZERO32; OP.VALUE.EXPREFS:= NIL; OP.VALUE.BASE:= ABSOLUT; OP.OD_VALUE.OFFSET:= ZERO32; OP.OD_VALUE.EXPREFS:= NIL; IF OP.VALUE.BASE=RELATIVE THEN CHANGE_An_TO_INDEX(FALSE); END; END; END (* INDISPLACEMENT *) ELSE BEGIN (* NOT INDISPLACEMENT *) (* THIS CAN ONLY HAPPEN IF GETSYMBOL(VAL,COLL) WAS CALLED *) IF VAL.BASE=AREG THEN I OP.OD_VALUE.BASE:= ABSOLUT; END; (* BADOPS *) (* (* SEENINNER T T T T T T T T T T T T T T T T F F F F F F F F F F F F F F F F (* SEENID T T T T T T T T F F F F F F F F T T T T T T T T F F F F F F F F (* SEENOD T T T T F F F F T T T T F F FNINDEX:=(LINE[COLL]='*') OR (LINE[COLL]='.') OR SEENAN OR (SEENINNER AND NOT ININNER) OR (OP.VALUE.BASE=RELATIVE) ELSE IF VAL.BASE=DREG THEN ININDEX:=TRUE ELSE (* VAL.BASE=PREG *) BEGIN ININDEX:=FALSE; IF SEENZPC THEN BEGIN IF PASS=2  F T T T T F F F F T T T T F F F F (* SEENAN T T F F T T F F T T F F T T F F T T F F T T F F T T F F T T F F (* SEENINDEX T F T F T F T F T F T F T F T F T F T F T F T F T F T F T F T F (* 6 6 ? ? 6 6 ? ? 6 6 . . 6 6 . . . . . . . . . . 6 5 ? THEN ERROR(ERR2ZPC); ESCAPE(BADOPS); END; IF SEENINNER AND NOT ININNER THEN BEGIN IF PASS=2 THEN ERROR(ERRMISZPC); ESCAPE(BADOPS); END; CHANGE_An_TO_INDEX(FALSE); SEENZPC:=TRUE; END; IF ININDEX THEN BEGIN (* ININDEX *) IF SEENINDEX THEN B? 6 2 6 . (* ?: MODE=IF VALUE IS REL THEN 7 ELSE 6 (* .: IMPOSSIBLE (**) CURCOL:=CURCOL+1; OP.SIZE:=0; (* LET'S START WITH THIS *) (* The following code is needed to reduce the address to an offset, (* if possible, so that GETDISPSIZE and FITSIN16 will proEGIN IF PASS=2 THEN ERROR(ERR2INDEX); ESCAPE(BADOPS); END; SEENINDEX:=TRUE; GETINDEX; OP.POST_INDEXED:=NOT ININNER AND SEENINNER; END (* ININDEX *) ELSE BEGIN (* ADDRESS REGISTER OR ZPC *) CURCOL:=COLL; (* ALREADY PARSED BY GETSYMBOL *) SEENANduce the (* correct size. (**) VAL:=OP.VALUE; IF OP.VALUE.BASE=RELATIVE THEN BEGIN IF VALUEOK=OK1 THEN BEGIN VAL.BASE:=ABSOLUT; (* A guess is made here that the distance between the operator (* start (LOCCTR) and the operand start is 2 :=TRUE; OP.REG:=VAL.OFFSET.LONGINT; (* 16 FOR ZPC *) END; (* ADDRESS REGISTER OR ZPC *) END; (* NOT INDISPLACEMENT *) IF LINE[CURCOL]=']' THEN BEGIN IF NOT ININNER THEN BEGIN IF PASS=2 THEN ERROR(ERRRBRACKUNEXP); ESCAPE(BADOPS); ENbytes. The operand (* start is where PC is at runtime when the operand is evaluated (* (at runtime). (**) VAL.OFFSET.LONGINT:=VAL.OFFSET.LONGINT-(LOCCTR.LONGINT+2); END; END; IF SEENAN AND NOT SEENINNER AND NOT SEENID AND NOT      P.SIZE+2; (* ROOM FOR EXTENSION WORD *) IF ({NOT SEENAN AND} (OP.VALUE.BASE=RELATIVE)) OR SEENZPC THEN BEGIN OP.MODE:=7; OP.REG:=3; END ELSE OP.MODE:=6; OP.FULL_FORMAT:= SEENINNER OR NOT SEENINDEX OR NOT SEENOD OR NOT FITSIN8( OP.REG:=CHECKREGNO; END ELSE BEGIN IF PASS=2 THEN ERROR(ERRCLOSEPEXP) END ELSE BEGIN IF PASS=2 THEN ERROR(ERRAREGEXP) END ELSE IF PASS=2 THEN ERROR(ERRAREGEXP); END; PROCEDURE ABSORINDEXED; BEGIN EXPRESS(PASS=2, EVALOK, EVALUE, CUVAL.OFFSET) OR (VALUEOK<>OK1) OR (VAL.EXPREFS<>NIL) OR { LAF 870323 SR46894 & others } (NOT SEENAN AND (OP.VALUE.BASE=ABSOLUT)) OR SEENZPC; IF OP.FULL_FORMAT THEN BEGIN OP.BASE_SUPPRESS:=(NOT SEENAN AND (OP.MODE=6)) OR SEENZPC; RCOL); OP.VALUE:=EVALUE; IF LINE[CURCOL]='(' THEN { INDEXED } BEGIN OP.FULL_FORMAT:=FALSE; CURCOL:=CURCOL+1; IF EVALUE.BASE=RELATIVE THEN BEGIN OP.MODE:=7; OP.REG :=3; OP.SIZE:=2; GETINDEX; IF LINE[CURCOL]<>')' THEN BEGIN IF  IF OP.BASE_SUPPRESS AND NOT SEENZPC THEN OP.REG:=0; (* MAKE IT A LITTLE CLEANER *) IF SEENINNER THEN BEGIN GETDISPSIZE( VAL ,OP.BD_SIZE,OP.SIZE); GETDISPSIZE(OP.OD_VALUE,OP.OD_SIZE,OP.SIZE); END ELSE BEGPASS=2 THEN ERROR(ERRCLOSEPEXP) END ELSE CURCOL:=CURCOL+1; END (* EVALUE.BASE=RELATIVE *) ELSE BEGIN { ABSOLUTE INDEXED } { ASSUMPTION FOR NOW } OP.MODE:=5; OP.REG :=0; OP.SIZE:=2; OP.INDEXMODE:=ADDRS; OP.INDEXSIZE:=WRD;IN GETDISPSIZE( VAL ,OP.BD_SIZE,OP.SIZE); OP.OD_SIZE:=S_RES; END; OP.INDEX_SUPPRESS:=NOT SEENINDEX; IF OP.INDEX_SUPPRESS THEN BEGIN (* MAKE IT A LITTLE CLEANER *) OP.INDEXMODE:= DATA; OP.INDEX:=  IF CHECKREGS THEN BEGIN IF (CHECKREGMODE=AREG) OR (PASS=1) THEN BEGIN OP.REG:=CHECKREGNO; IF LINE[CURCOL]=',' THEN { LOOK FOR ANOTHER REG } BEGIN CURCOL:=CURCOL+1; OP.MODE:=6; GETINDEX; IF LINE[CURCOL]<>')' THEN BEGI 0; OP.INDEXSIZE:= WRD; OP.INDEXSCALE:= 0; END; IF NOT SEENINNER THEN OP.POST_INDEXED:=FALSE; END; (* OP.FULL_FORMAT *) END; (* EA=6n or 73 *) END; $IF FALSE$ PROCEDURE INDORAUTOINC; (* REPLACED BY 'INDIRN IF PASS=2 THEN ERROR(ERRCLOSEPEXP) END ELSE CURCOL:=CURCOL+1; IF (PASS=2) AND NOT(FITSIN8(EVALUE.OFFSET)) THEN ERROR(ERRFIELDOFLO); END (* LINE[CURCOL]=',' *) ELSE { ADDR REG PLUS DISPLACEMENT } BEGIN IF PASS=1 THEN IF LINEECT' *) BEGIN CURCOL:=CURCOL+1; OP.MODE:=2; OP.SIZE:=0; IF CHECKREGS THEN IF CHECKREGMODE=AREG THEN BEGIN OP.REG:=CHECKREGNO; IF (LINE[CURCOL]=')') AND (LINE[CURCOL+1]='+') THEN BEGIN OP.MODE:=3; CURCOL:=CURCOL+2; END [CURCOL]='.' THEN BEGIN CURCOL:=CURCOL+1; IF (LINE[CURCOL]<>')') AND (LINE[CURCOL]<>' ') THEN CURCOL:=CURCOL+1; END; (* LINE[CURCOL]='.' *) (* PASS=1 *) IF LINE[CURCOL]<>')' THEN BEGIN IF PASS=2 THEN ERROR(ERRCLOSEPEXP ELSE (* <>')+' *) BEGIN IF LINE[CURCOL]=')' THEN CURCOL:=CURCOL+1 ELSE IF PASS=2 THEN ERROR(ERRCLOSEPEXP); END; (* <>')+' *) END (* CHECKREGMODE=AREG *) ELSE (* CHECKREGMODE<>AREG *) IF PASS=2 THEN ERROR(ERRAREGEXP) ELSE E) END ELSE (* LINE[CURCOL]=')' *) BEGIN CURCOL:=CURCOL+1; IF (PASS=2) AND NOT(FITSIN16(EVALUE.OFFSET)) THEN ERROR(ERRFIELDOFLO); END (* LINE[CURCOL]=')' *) END (* LINE[CURCOL]<>',' *) END (* (CHECKREGMODE=AREG) OR (PASS=1)LSE (* NOT CHECKREGS *) IF PASS=2 THEN ERROR(ERRAREGEXP); END; $END$ PROCEDURE AUTODEC; BEGIN CURCOL:=CURCOL+2; OP.MODE:=4; OP.SIZE:=0; IF CHECKREGS THEN IF CHECKREGMODE=AREG THEN IF LINE[CURCOL]=')' THEN BEGIN CURCOL:=CURCOL+1;  *) ELSE BEGIN IF PASS=2 THEN ERROR(ERRAREGEXP) END; END (* CHECKREGS *) ELSE BEGIN IF PASS=2 THEN ERROR(ERRAREGEXP) END END (* EVALUE.BASE<>RELATIVE *) END (* LINE[CURCOL]='(' *) ELSE BEGIN { ABS OR REL WITH NO INDEX REGS }       begin if allowfpopds then op.mode:=8 else begin if pass=2 then error(errfpregnotallowed); op.mode:=0; end; end else op.mode:=0; (* dreg *) $end$ $if not mc68881$ IF CHECKREGMODE=AREG THEN OP; END; EXTFILE^.EXTNAME:=LAB; IF EXTHEAD = NIL THEN EXTHEAD:=EXTFILE ELSE EXTTAIL^.EXTNEXT:=EXTFILE; EXTTAIL:=EXTFILE; EXTFILE^.EXTNEXT:=NIL; EXTSIZE:=EXTSIZE+LENGTH(LAB)+4-(LENGTH(LAB) MOD 4); EXTCTR:=EXTCTR+1; END EL.MODE:=1 ELSE OP.MODE:=0; $end$ OP.REG:=CHECKREGNO; END ELSE IF CHECKSPREGS THEN BEGIN OP.SIZE:=0; $if mc68881$ if checkregmode=fpstreg then begin if allowfpopds then op.mode:=9 else begin if pass=2 then error(errfprSE ERROR(ERRDUPDEFSYM); IF LINE[CURCOL]=BLANK THEN ESCAPE(OPSOK); IF LINE[CURCOL]<>COMMA THEN ESCAPE(BADOPS); CURCOL:=CURCOL+1; UNTIL FALSE; RECOVER IF ESCAPECODE=BADOPS THEN ERROR(ERRBADSYNTAX) ELSE IF ESCAPECODE<>OPSOK THEN ESCAPE(ESCAPECODE) OP.MODE:=7; IF EVALUE.EMODE=NOMODE THEN BEGIN IF EVALUE.BASE=RELATIVE THEN BEGIN if orgmode=longfwds then begin op.reg :=1; op.size:=4; end else begin OP.REG :=2; OP.SIZE:=2; end END (* EVALUE.BASE=RELATIVE *) ELSEegnotallowed); op.mode:=7; end; end else $end$ OP.MODE:=7; OP.REG:=CHECKREGNO; END ELSE ABSORINDEXED; END; (* PARSEOPERAND *) $include 'M68KFPMVM'$  BEGIN IF (EVALOK<>OK1) OR (EVALUE.EXPREFS<>NIL) THEN { FWD OR EXT REF } BEGIN IF ORGMODE=LONGFWDS THEN BEGIN OP.REG :=1; OP.SIZE:=4; END ELSE BEGIN OP.REG :=0; OP.SIZE:=2; IF (PASS=2) AND NOT(FITSIN16(OP.VALUE.OFFSET)) THE{modifications made by jch on 08/26/86 } { allow '_' and '@' at the beginning of a word (label)} { # register mask for movem} IMPLEMENT PROCEDURE PASS1; { THIS PROCEDURE DOES ALL THE PASS 1 PROCESSING } VAR SP: STREF; LABKIND: SYMKIND; N ERROR(ERRFIELDOFLO); END END (* (EVALOK<>OK1) OR (EVALUE.EXPREFS<>NIL) *) ELSE { NOT FWD REF } IF FITSIN16(EVALUE.OFFSET) THEN BEGIN OP.REG :=0; OP.SIZE:=2; END ELSE BEGIN OP.REG :=1; OP.SIZE:=4; END END (* EVALUE.BASE<>RELATIVE * REFTYPE: SYMKIND; STARTCOL: SHORTINT; LEN: SHORTINT; STRTEMP: STRING80; PROCEDURE REFLIST; CONST OPSOK=100; BADOPS=101; VAR VAL: WORD32; COL:SHORTINT; TEMPIO: INTEGER; BEGIN TRY VAL.HIHALF:=0; REPEAT IF NOT(LINE[CURCOL] IN ['A) END (* EVALUE.EMODE=NOMODE *) ELSE IF EVALUE.EMODE=RMODE THEN BEGIN OP.REG :=2; OP.SIZE:=2; END ELSE IF EVALUE.EMODE=LMODE THEN BEGIN OP.REG :=1; OP.SIZE:=4; END ELSE (* EVALUE.EMODE=SMODE *) BEGIN OP.REG :=0; OP.SIZE:=2; IF'..'Z','_','@']) THEN ESCAPE(BADOPS); {jch 08/26/86} STARTCOL:=CURCOL; REPEAT CURCOL:=CURCOL+1 UNTIL CHTYPE[LINE[CURCOL]]=SPECIAL; LAB:=COPY(LINE, STARTCOL, CURCOL-STARTCOL); VAL.LOHALF:=0; LOOKUPSYMBOL(SP); IF SP=NIL THEN ENTERSYMBOL(SP, (PASS=2) AND NOT(FITSIN16(EVALUE.OFFSET)) THEN ERROR(ERRFIELDOFLO); END (* EVALUE.EMODE=SMODE *) END (* LINE[CURCOL]<>'(' *) END; { OF PROCEDURE ABSORINDEXED -- I HOPE } BEGIN (* PARSEOPERAND *) IF LINE[CURCOL]='#' THEN IMMEDOP ELSE IF TRUE, REFTYPE, VAL); IF NOT(SP^.EXT) AND ((SP^.DEFINED=-1) OR (SP^.DEFINED=LINENO)) THEN BEGIN WITH SP^ DO BEGIN SKIND:=REFTYPE; SVALUE.LONGINT:=EXTSIZE DIV 4; EXT:=TRUE; DEFINED:=LINENO; END; TRY NEWBY LINE[CURCOL]='(' THEN INDIRECT (* WAS INDORAUTOINC *) ELSE IF (LINE[CURCOL]='-') AND (LINE[CURCOL+1]='(') THEN AUTODEC ELSE IF CHECKREGS THEN BEGIN OP.SIZE:=0; $if mc68881$ if checkregmode=areg then op.mode:=1 else if checkregmode=fpreg thenTES(EXTFILE,SIZEOF(EXTREC)-80+LENGTH(LAB)) RECOVER BEGIN if escapecode=-2 then begin WRITELN(LP,'MEMORY OVERFLOW!'); LPCHECK; { 3/2/84 } IF LISTNAME<>'CONSOLE:' THEN WRITELN('MEMORY OVERFLOW!'); ESCAPE(-1); end else escape(escapecode)     ; END; PROCEDURE MODELIST(MFLAG:FORCEMODE); CONST OPSOK=100; BADOPS=101; VAR STARTCOL: SHORTINT; SP: STREF; BEGIN TRY REPEAT STARTCOL:=CURCOL; IF NOT(LINE[CURCOL] IN ['A'..'Z','@','_']) THEN ESCAPE(BADOPS);{jch 08/26/86} REPEAT nd else $end$ EXPRESS(FALSE, EVALOK, EVALUE, CURCOL); COUNT:=1; END; WHILE LINE[CURCOL]=',' DO BEGIN CURCOL:=CURCOL+1; IF LINE[CURCOL]=CHR(39) THEN CHARSTRING1 ELSE BEGIN COUNT:=COUNT+1; $if fpimmed$ if sizesuffix = 'D' the CURCOL:=CURCOL+1; UNTIL CHTYPE[LINE[CURCOL]]=SPECIAL; LAB:=COPY(LINE, STARTCOL, CURCOL-STARTCOL); LOOKUPSYMBOL(SP); IF SP<>NIL THEN IF NOT SP^.EXT THEN BEGIN ERROR(ERRMODEDECL); ESCAPE(BADOPS); END; ENTERSYMBOL(SP, FALSE,n begin if not fpimmedexp(false,evalok,evalue,curcol) then begin (* pass 2 will flag error *) end; end else $end$ EXPRESS(FALSE, EVALOK, EVALUE, CURCOL); END; END; LOCCTR.LONGINT := LOCCTR.LONGINT + SIZE*C ABSOLUT, ZERO32); SP^.SMODE:=MFLAG; IF LINE[CURCOL]=BLANK THEN ESCAPE(OPSOK); IF LINE[CURCOL]<>COMMA THEN ESCAPE(BADOPS); CURCOL:=CURCOL+1; UNTIL FALSE; RECOVER IF ESCAPECODE=BADOPS THEN ERROR(ERRBADSYNTAX) ELSE IF ESCAPECODE<>OPSOOUNT; END; 2: { DS } BEGIN EXPRESS(false, EVALOK, EVALUE, CURCOL); IF (EVALOK=OK1) AND (EVALUE.EXPREFS=NIL) and (evalue.base=absolut) THEN LOCCTR.LONGINT:=SIZE*EVALUE.OFFSET.LONGINT +LOCCTR.LONGINT END; 3: {ENK THEN ESCAPE(ESCAPECODE); END; PROCEDURE PASS1PSEUDOS; { PSEUDO-OP PROCESSING FOR PASS 1 } VAR COUNT: SHORTINT; SYM: STREF; COL:SHORTINT; TEMPSOURCE: SOURCEPTR; PROCEDURE CHARSTRING1; VAR BYTECOUNT:SHORTINT; DONE: BOOLEAN; BEGIN DONE:=D}; { NO ACTION } 4: {MNAME} BEGIN IF GOTMODNAME THEN ERROR(ERRMODNAME) ELSE BEGIN IF CHTYPE[LINE[CURCOL]]=ALPHABETIC THEN BEGIN COL:=CURCOL; REPEAT COL:=COL+1; UNTIL CHTYPE[LINE[COL]]=SPECIAL; MODNAME:=COPY(LINE,FALSE; BYTECOUNT:=0; REPEAT CURCOL:=CURCOL+1; IF CURCOL<>LENGTH(LINE) THEN BEGIN IF LINE[CURCOL]=CHR(39) THEN BEGIN IF LINE[CURCOL+1]<>CHR(39) THEN DONE:=TRUE ELSE BEGIN BYTECOUNT:=BYTECOUNT+1; CURCOL:=CURCOL+1; END END CURCOL,COL-CURCOL); if strlen(modname) > 15 then setstrlen(modname,15); GOTMODNAME:=TRUE; IF LINE[COL]<>' ' THEN ERROR(ERREOLEXP); END ELSE ERROR(ERRSYMBEXP) END END; 5: { EQU } BEGIN IF LAB='' THEN ERROR ELSE BYTECOUNT:=BYTECOUNT+1 END ELSE BEGIN ERROR(ERRBADSYNTAX); DONE:=TRUE; END; UNTIL DONE; IF CURCOL<>LENGTH(LINE) THEN CURCOL:=CURCOL+1; LOCCTR.LONGINT := LOCCTR.LONGINT + BYTECOUNT; IF {LOCCTR.BITS[0]} ODD(LOCCTR.LOHALF) AND (SIZE=2) THE(ERRLABELREQD) ELSE BEGIN LOOKUPSYMBOL(SYM); IF CHECKREGS THEN WITH SYM^ DO BEGIN SKIND:=CHECKREGMODE; SVALUE.HIHALF:=0; SVALUE.LOHALF:=CHECKREGNO; SEXTPTR:=NIL; EXT:=FALSE; END ELSE IF CHECKSPREGSN LOCCTR.LONGINT := LOCCTR.LONGINT + 1; IF (SIZE=4) THEN WHILE BYTECOUNT MOD 4 <> 0 DO BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 1; BYTECOUNT:=BYTECOUNT+1; END; END; BEGIN CASE CURROP.CODE OF 0: { COMMENT }; 1: { DC }  THEN WITH SYM^ DO BEGIN SKIND:=CHECKREGMODE; SVALUE.HIHALF:=0; SVALUE.LOHALF:=CHECKREGNO; SEXTPTR:=NIL; EXT:=FALSE; END ELSE BEGIN EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); IF EVALOK=OK1 THEN WITH BEGIN COUNT:=0; IF LINE[CURCOL]=CHR(39) THEN CHARSTRING1 ELSE BEGIN $if fpimmed$ if sizesuffix = 'D' then begin if not fpimmedexp(false,evalok,evalue,curcol) then begin (* pass 2 will flag error *) end; e SYM^ DO BEGIN SVALUE:=EVALUE.OFFSET; SEXTPTR:=EVALUE.EXPREFS; SKIND:=EVALUE.BASE; if smode=nomode then SMODE:=EVALUE.EMODE; EXT:=FALSE END ELSE WITH SYM^ DO BEGIN ERROR(ERRB     VALUE.OFFSET; IF PCMODE=ABS THEN SP^.SKIND:=ABSOLUT ELSE SP^.SKIND:=RELATIVE; END; IF SIZE=4 THEN ORGMODE:=LONGFWDS ELSE ORGMODE:=SHORTFWDS; END END; 19: { COM } BEGIN IF GOTCOM THEN ERROR(ERRBADCOM) ELSE BEPROCEDURE IS IN READER MODULE } 31, 32: { SPRINT, LPRINT }; 33: { START } BEGIN IF GOTSTART THEN ERROR(ERRGOTSTART) ELSE BEGIN EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); IF (EVALUE.EXPREFS<>NIL) OR (EVALOK<>OK1) THEN ERROR(ERRGIN GOTCOM:=TRUE; IF LINE[CURCOL] IN ['A'..'Z','_','@'] THEN BEGIN {jch 08/26/86} STARTCOL:=CURCOL; REPEAT CURCOL:=CURCOL+1; UNTIL CHTYPE[LINE[CURCOL]]=SPECIAL; LAB:=COPY(LINE, STARTCOL, CURCOL-STARTCOL); ENTERSYMBOL(SP,BADEXPR) ELSE BEGIN STARTLOC:=EVALUE.OFFSET; if evalue.base=absolut then startmode:=absolute else startmode:=relocatable; GOTSTART:=TRUE; END END END; 34: { DECIMAL } decimal:=true; END; { OF CASE } END; { OF PROCEDURE PADEXPR); SVALUE:=ZERO32; SEXTPTR:=NIL; SKIND:=ABSOLUT; EXT:=FALSE; END END END END; 6: BEGIN { SRC } IF CURCOL < LENGTH(PRINTLINE) THEN BEGIN COUNT:=LENGTH(PRINTLINE) - CURCOL + 1; TRY N TRUE, ABSOLUT, ZERO32); SP^.EXT:=TRUE; IF LINE[CURCOL]=COMMA THEN BEGIN CURCOL:=CURCOL+1; EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); IF (EVALOK=OK1) AND (EVALUE.EXPREFS=NIL) THEN BEGIN if evalue.base<>absolut then errEWBYTES(TEMPSOURCE, COUNT+5) RECOVER BEGIN if escapecode=-2 then begin WRITELN(LP,'MEMORY OVERFLOW!'); LPCHECK; { 3/2/84 } IF LISTNAME<>'CONSOLE:' THEN WRITELN('MEMORY OVERFLOW!'); ESCAPE(-1); end else escape(escaor(errbadbase); SP^.SVALUE.LONGINT:=1; TRY NEWBYTES(DEFFILE,SIZEOF(DEFREC)-80+LENGTH(LAB)) RECOVER BEGIN if escapecode=-2 then begin WRITELN(LP,'MEMORY OVERFLOW!'); LPCHECK; { 3/2/84 } IF LISTNAME<>'CONSOLE:' pecode); END; TEMPSOURCE^.SOURCELINE[0]:=CHR(COUNT); FOR COL:=CURCOL TO LENGTH(PRINTLINE) DO TEMPSOURCE^.SOURCELINE[COL-CURCOL+1]:=PRINTLINE[COL]; IF SOURCEHEAD=NIL THEN SOURCEHEAD:=TEMPSOURCE ELSE SOURCETAIL^.NEXTSOURCE:=TEMPSOURCE; THEN WRITELN('MEMORY OVERFLOW!'); ESCAPE(-1); end else escape(escapecode); END; DEFFILE^.IDNAME:=LAB; DEFFILE^.DEFTYPE:=GLOBAL; IF EVALUE.OFFSET.LONGINT<0 THEN BEGIN GLOBALSIZE:=-EVALUE.OFFSET.LONGINT;  SOURCETAIL:=TEMPSOURCE; TEMPSOURCE^.NEXTSOURCE:=NIL; END END; 8,10,12,14,16,17,18, 20, 29: ; { NO PASS 1 ACTION } 9: { LLEN } BEGIN EXPRESS(false, EVALOK, EVALUE, CURCOL); IF (EVALUE.EXPREFS<>NIL) OR (EVALOK<>OK1) OR NOT(DEFFILE^.LOCATION.LONGINT:=0; END ELSE BEGIN GLOBALSIZE:=EVALUE.OFFSET.LONGINT; DEFFILE^.LOCATION.LONGINT:=-GLOBALSIZE; END; IF DEFHEAD=NIL THEN DEFHEAD:=DEFFILE ELSE DEFTAIL^.DEFNEXT:=DEFFILE; DEFTAIL:=DEFF(EVALUE.OFFSET.HIHALF=0) AND (EVALUE.OFFSET.LOHALF>=32) AND (EVALUE.OFFSET.LOHALF<=132)) THEN else LLEN:=EVALUE.OFFSET.LOHALF; END; 11: { NOOBJ } object:=false; 13,15: { ORG, RORG } BEGIN STRTEMP:=LAB; EXPRESS(ILE; globalptr:=deffile; DEFFILE^.DEFNEXT:=NIL; DEFCTR:=DEFCTR+1; END ELSE ERROR(ERRBADCONST) END ELSE ERROR(ERRCOMMAEXP) END ELSE ERROR(ERRSYMBEXP); END END; 21: {REFA} BEGIN REFTYPE:=false, EVALOK, EVALUE, CURCOL); IF (EVALOK=OK1) AND (EVALUE.EXPREFS=NIL) THEN BEGIN LOCCTR:=EVALUE.OFFSET; IF CURROP.CODE=13 THEN PCMODE:=ABS ELSE PCMODE:=REL; IF STRTEMP<>'' THEN BEGIN LAB:=STRTEMP; LOOKUPSYMBOL(SP); SP^.SVALUE:=EABSOLUT; REFLIST; END; 22: {REFR} BEGIN REFTYPE:=RELATIVE; REFLIST; END; 25: { LMODE } MODELIST(LMODE); 26: { SMODE } MODELIST(SMODE); 27: { RMODE } MODELIST(RMODE); 30: { INCLUDE } INCLUDEINSTR; {      ASS1PSEUDOS } PROCEDURE PASS1STUFF; VAR CMPI_PCREL: BOOLEAN; $include 'M68KPAS1B'$ {THIS ROUTINE HANDLES ALL PASS1 PROCESSING FOR INSTRUCTIONS} BEGIN if currop.class = 99 then pass1pseudos else $if mc68881$ if (currop.class >= fpbase) and (currop.S=NIL) THEN BEGIN EVALUE.OFFSET.LONGINT := EVALUE.OFFSET.LONGINT - 2 - LOCCTR.LONGINT; IF FITSIN8(EVALUE.OFFSET) AND (EVALUE.EXPREFS=NIL) AND not ((evalue.base=absolut ) and (pcmode=rel)) and not ((evalue.base=relative) and (pclass <= fptop) then pass1fpops else $end$ CASE CURROP.CLASS OF 0: BEGIN { ILLEGAL OP} LOCCTR.LONGINT := LOCCTR.LONGINT + 2; END; 1,4,15,16,24,26,28,30,31,34,35: {ABCD, SBCD, ADDX, SUBX, EXG, EXT, MOVEQ, RTM} LOCCTR.LONGINT := Lcmode=abs)) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2 ELSE LOCCTR.LONGINT := LOCCTR.LONGINT + 4; END (* EVALOK=OK1 *) ELSE LOCCTR.LONGINT := LOCCTR.LONGINT + 4; END; (* SIZESUFFIX <> 'S' *) END; (* Bcc *) 8: { Bx BIT OCCTR.LONGINT + 2; 2,5: {ADD,ADDA, SUB, SUBA, AND, OR} BEGIN PARSEOPERAND(OPERAND1); LOCCTR.LONGINT := LOCCTR.LONGINT + 2+OPERAND1.SIZE; IF LINE[CURCOL]=',' THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF CURROP.NAME[4]=OPERATIONS } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; PARSEOPERAND(OPERAND1); IF (OPERAND1.MODE=7) AND (OPERAND1.REG=4) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; IF (OPERAND1.MODE=0) OR ((OPERAND1.MODE=7) AND (OPERAND1.REG=' ' THEN BEGIN IF ((OPERAND1.MODE<>0) AND (OPERAND2.MODE<>0)) OR (NOT(MEMALT(OPERAND2)) AND (OPERAND2.MODE<>0)) THEN OPERAND2.SIZE:=0; END ELSE IF OPERAND2.MODE<>1 THEN OPERAND2.SIZE:=0; LOCCTR.LONGINT := LOCCTR.LONGINT + OPERA4)) THEN BEGIN IF LINE[CURCOL]=',' THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF CURROP.NAME='BTST ' THEN BEGIN IF (OPERAND2.MODE=1) OR ((OPERAND2.MODE=7) AND (OPERAND2.REG=4) AND (OPERAND1.MODE<>0)) OR ((OPND2.SIZE; END; END; 3: { ADDQ, SUBQ } BEGIN IF LINE[CURCOL] <> '#' THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2 ELSE BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; PARSEOPERAND(OPERAND1); IF LINE[CURCOL]=',' THEN BEGIN ERAND2.MODE=7) AND (OPERAND2.REG>4)) THEN OPERAND2.SIZE:=0 END ELSE IF NOT DATALTERABLE(OPERAND2) THEN OPERAND2.SIZE:=0; LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END END END; 9,10,11,25: {CHK, DIVS, DIVU, CLR, NBCD, NEGCURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF ALTERABLE(OPERAND2) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END END END; 6: { ASL, ASR, LSL, LSR, ROL, ROR, ROXL, ROXR } BEGIN PARSEOPERAND(OPERAND1); I, NEGX, CMP, CMPA} BEGIN PARSEOPERAND(OPERAND1); LOCCTR.LONGINT := LOCCTR.LONGINT + 2+OPERAND1.SIZE; IF (CURROP.NAME = 'TAS ') AND (OPERAND1.MODE <> 0 {Dreg}) THEN ERROR(errTASwarn); END; 12,13,23,32,41: { STOP, DBCC,F MEMALT(OPERAND1) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2+OPERAND1.SIZE ELSE LOCCTR.LONGINT := LOCCTR.LONGINT + 2; END; 7: { Bcc, BSR } BEGIN IF (SIZESUFFIX='S') OR (SIZESUFFIX='B') THEN LOCCTR.LONGINT := LOCCTR.LONGINT + MOVEP, MOVEC, PACK } LOCCTR.LONGINT := LOCCTR.LONGINT + 4; 14: {EOR} BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; PARSEOPERAND(OPERAND1); IF OPERAND1.MODE=0 THEN IF LINE[CURCOL]=',' THEN BEGIN CURCOL:=CURCOL+1; PARSEO 2 ELSE IF (SIZESUFFIX='W') THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 4 ELSE IF (SIZESUFFIX='L') THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 6 ELSE BEGIN EXPRESS(FALSE, EVALOK, EVALUE, CURCOL); IF (EVALOK=OK1) AND (EVALUE.EXPREFPERAND(OPERAND2); LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END; END; 17,19: { (JMP, JSR, PEA), LEA } BEGIN PARSEOPERAND(OPERAND1); LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND1.SIZE+2; END; 18,27: { ADDI, SUB      CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF CONTROLMODE(OPERAND2) AND ALTERABLE(OPERAND2) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END; END ELSE BEGIN PARSEOPERAND(OPERAND1); IF CONTROLMODE(OPERAND1) THE 40: { CHK2, CMP2 } IF NOT CONTROLMODE(OPERAND1) THEN OPERAND1.SIZE:=0; 42: { BFTST, BFCHG, BFCLR, BFSET } IF NOT ((OPERAND1.MODE=0) OR ((CURROP.NAME<>'BFTST ') AND CONTROLALTERABLE(OPERAND1)) OR ((CURROP.NAME ='BFTSTN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND1.SIZE; END END; 29: { TRAP } BEGIN PARSEOPERAND(OPERAND1); IF LINE[CURCOL]=',' THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 4 ELSE LOCCTR.LONGINT := LOCCTR.LONGINT + 2; END; 33: { MOVES ') AND CONTROLMODE(OPERAND1))) THEN OPERAND1.SIZE:=0; 43: { BFEXTU, BFEXTS, BFFFO } IF (OPERAND1.MODE<>0) AND NOT CONTROLMODE(OPERAND1) THEN OPERAND1.SIZE:=0; 45: { DIVS.L, DIVSL.L, DIVU.L, DIVUL.L, MULS.L, MULU.L } II, CMPI, ANDI, ORI, EORI } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; PARSEOPERAND(OPERAND1); IF (OPERAND1.MODE=7) AND (OPERAND1.REG=4) THEN BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND1.SIZE; IF LINE[CURCOL]=',' THEN BEGIN  } BEGIN LOCCTR.LONGINT:=LOCCTR.LONGINT+4; PARSEOPERAND(OPERAND1); IF LINE[CURCOL]=',' THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF ((OPERAND1.MODE<=1) OR (OPERAND2.MODE<=1)) AND (MEMALT(OPERAND1) OR MEMALT(OPERACURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); CMPI_PCREL:=(CURROP.NAME='CMPI ') AND (OPERAND2.MODE=7) AND ((OPERAND2.REG=2) OR (OPERAND2.REG=3)); IF ((CURROP.CLASS=18) AND (DATALTERABLE(OPERAND2) OR CMPI_PCREL)) OR ((CURROP.CLASND2)) THEN LOCCTR.LONGINT:=LOCCTR.LONGINT+OPERAND1.SIZE+ OPERAND2.SIZE; END; END; 36: { TRAPcc } IF SIZESUFFIX='L' THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 6 ELSE IF SIZESUFFIX='W' THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 4 ELSE S=27) AND (DATALTERABLE(OPERAND2) OR ((OPERAND2.MODE=7) AND (OPERAND2.REG>4) and (operand2.reg<7)))) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END END ELSE IF SIZE=1 THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2 E LOCCTR.LONGINT := LOCCTR.LONGINT + 2; 37: { CALLM } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 4; PARSEOPERAND(OPERAND1); IF (LINE[CURCOL]=',') AND (OPERAND1.MODE=7) AND (OPERAND1.REG=4) THEN BEGIN CURCOL:=CURCOL+1; PLSE LOCCTR.LONGINT := LOCCTR.LONGINT + SIZE END; 20: { LINK } LOCCTR.LONGINT := LOCCTR.LONGINT + 2 + SIZE; 21: { MOVE } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; PARSEOPERAND(OPERAND1); LOCCTR.LONGINT := LOCCTR.LONGINT + OPEARSEOPERAND(OPERAND2); IF NOT CONTROLMODE(OPERAND2) THEN (* BAD MODE *) OPERAND2.SIZE:=0; LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END; END; 38: { CAS } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 4; PARSEOPERAND(OPERAND1); IFRAND1.SIZE; IF LINE[CURCOL]=',' THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; END END; 22: { MOVEM } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 4; IF (CHECKREGS OR (LI (LINE[CURCOL]=',') AND (OPERAND1.MODE=0) THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF (LINE[CURCOL]=',') AND (OPERAND1.MODE=0) THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND3); IF MEMALT(OPERAND3) THEN NE[CURCOL] = '#')) THEN BEGIN {jch 08/26/86} $if mc68881$ if checkregmode = fpreg then error( errfpregnotallowed ); $end$ WHILE (LINE[CURCOL]<>' ') AND (LINE[CURCOL]<>',') DO CURCOL:=CURCOL+1; IF LINE[CURCOL]=',' THEN BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND3.SIZE; END; END; END; 39: { CAS2 } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 6; END; 40,42,43,45: { (CHK2, CMP2), BFCHG, BFEXTS, DIVS.L } BEGIN PARSEOPERAND(OPERAND1); CASE CURROP.CLASS OF       F NOT DATAMODE(OPERAND1) THEN OPERAND1.SIZE:=0; END; LOCCTR.LONGINT := LOCCTR.LONGINT + 4 + OPERAND1.SIZE; END; 44: { BFINS } BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 4; PARSEOPERAND(OPERAND1); IF (LINE[CURCOL]=',') AND (OPERAND1.MODE=2.VALUE.EXPREFS<>NIL THEN DISPOSE(OPERAND2.VALUE.EXPREFS); IF OPERAND3.VALUE.EXPREFS<>NIL THEN DISPOSE(OPERAND3.VALUE.EXPREFS); IF OPERAND4.VALUE.EXPREFS<>NIL THEN DISPOSE(OPERAND4.VALUE.EXPREFS); IF OPERAND5.VALUE.EXPREFS<>NIL THEN DISPOSE(OPE0) THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAND2); IF (OPERAND2.MODE=0) OR CONTROLALTERABLE(OPERAND2) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + OPERAND2.SIZE; (* ELSE BAD MODE *) END; END; 46: { MOVE16 - ADDED 6/30/89 JWH } RAND5.VALUE.EXPREFS); IF OPERAND6.VALUE.EXPREFS<>NIL THEN DISPOSE(OPERAND6.VALUE.EXPREFS); GETLINE; END; END; BEGIN { 4 Bytes or 6 Bytes ????? } LOCCTR.LONGINT := LOCCTR.LONGINT + 4; PARSEOPERAND(OPERAND1); IF OPERAND1.MODE = 7 THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2 ELSE IF (LINE[CURCOL]=',') THEN BEGIN CURCOL:=CURCOL+1; PARSEOPERAND(OPERAN$if mc68881$ procedure pass1fpops; const opsok = 100; badops = 101; function getsysflags1( var opd : operand ) : boolean; begin getsysflags1 := false; if setfpsysflag( opd, false, fpsysflag ) then begin getsysflags1 := true; D2); IF (OPERAND2.MODE = 7) THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; (* ELSE BAD MODE - PASS2 WILL CATCH IT ????? *) END; END; { CASE 46 } 47,48,49,50,51,52 : BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 2; END; { CASES 47,48,49,50, if line[ curcol ] = '/' then begin curcol := curcol + 1; parseoperand( opd ); if not setfpsysflag( opd, false, fpsysflag ) then getsysflags1 := false else if line[ curcol ] = '/' then begin curcol := curcol + 151,52 } END; { OF CASE } END; { OF PROCEDURE PASS1STUFF } BEGIN GETLINE; WHILE (LINE<>' END') AND (CURROP.NAME<>'END ') DO BEGIN IF ODD(LOCCTR.LOHALF) AND NOT(((CURROP.NAME='DS ') OR (CURROP.NAME='DC ')) AND (SIZE=1)) and (; parseoperand( opd ); if not setfpsysflag( opd, false, fpsysflag ) then getsysflags1 := false; end; end; end; end; (* getsysflags1 *) procedure fpmoves1; begin (* currop.class = (fpbase+0) currop.name<>' ') THEN LOCCTR.LONGINT := LOCCTR.LONGINT + 1; IF LAB<>'' THEN BEGIN IF PCMODE=ABS THEN LABKIND:=ABSOLUT ELSE LABKIND:=RELATIVE; if ((ord(lab[1])>=ord('A')) and (ord(lab[1])<=ord('Z')) OR (ORD(LAB[1]) = ORD('_'assumed *) if currop.name[ 6 ] = 'M' then begin (* FMOVEM *) TRY if operand1.mode = 9 then begin (* source system regs *) if not getsysflags1( operand1 ) th)) OR (ORD(LAB[1]) = ORD('@'))) then {jch 08/26/86} begin ENTERSYMBOL(SP,TRUE, LABKIND, LOCCTR); SP^.EXT:=FALSE; { OVERRIDE ANY REFS FOR THIS SYMBOL } end else error(errbadsyntax); END; OPERAND1.VALUE.EXPREFS:=NIL; OPERAND2en escape( badops ); if line[ curcol ] <> ',' then begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if not memalt( operand2 ) then escape( badops ); end .VALUE.EXPREFS:=NIL; OPERAND3.VALUE.EXPREFS:=NIL; OPERAND4.VALUE.EXPREFS:=NIL; OPERAND5.VALUE.EXPREFS:=NIL; OPERAND6.VALUE.EXPREFS:=NIL; PASS1STUFF; IF OPERAND1.VALUE.EXPREFS<>NIL THEN DISPOSE(OPERAND1.VALUE.EXPREFS); IF OPERAND (* source system regs *) else if operand1.mode = 8 then begin fpmovem( true, false ); end else if operand1.mode = 0 then begin (* Dn, *) if line[ curcol ] <> ',' then       ; operand2.reg := 0; operand2.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctb.longint := locctb.longint + operand1.size + operand2.size; end (*  *) if not datamode( operand1 ) then begin escape( badops ); end; end; if (operand1.mode = 7) and (operand1.reg = 4) then operand1.size := 4; end; end (* system reg(s) *) else FMOVEM *) else if (currop.name[ 6 ] = 'C') and (currop.name[ 7 ] = 'R') then begin (* FMOVECR *) TRY if not ((operand1.mode = 7) and (operand1.reg = 4)) then begin escape( badops ) begin (* not system reg(s) *) if operand1.mode = 8 then begin (* source FPn *) if (line[ curcol ] = '{') or (sizesuffix = 'P') then begin (* FPn,(#k) or FPn, begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if not ( (controlmode( operand2 ) and alterable( operand2 ) ) or (operand2.mode = 4) ) then begin escape( badops ); end; en; end; if line[ curcol ] <> ',' then begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if operand2.mode <> 8 then begin escape( badops ); end; escape( opsok ); Rd (* Dn, *) else begin (* source *) if line[ curcol ] <> ',' then begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if operand2.mode = ECOVER if escapecode = badops then begin operand1.mode := 7; operand1.reg := 4; operand1.size := 2; operand1.value.offset.longint := 0; operand2.mode := 8; operand2.reg := 0; operand2.size :9 then begin (* destination system regs *) if not getsysflags1( operand2 ) then escape( badops ); if not memmode( operand1 ) then begin escape( badops ); end; if (operand1.mode = 7) a= 0; end else if escapecode <> opsok then escape( escapecode ); end (* FMOVECR *) else begin (* FMOVE *) TRY if line[ curcol ] <>nd (operand1.reg = 4) then operand1.size := 4; end (* destination system regs *) else if operand2.mode = 0 then begin (* ,Dn *) if not (controlmode( operand1 ) or (operand1.mode ',' then begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if (operand1.mode = 9) or (operand2.mode = 9) then begin (* system reg(s) *) if operand1.mode = 3)) then begin escape( badops ); end; end (* ,Dn *) else begin if not ( controlmode( operand1 ) or (operand1.mode = 3) ) then begin escape( badops ); end; fpmovem( = 9 then begin (* source system reg *) if operand1.reg <= 2 then begin (* CONTROL or STATUS *) if not datalterable( operand2 ) then begin escape( badops ); end; end else begi false, false ); end; end; (* source *) escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 0; operand1.reg := 0; operand1.size := 0; operand2.mode := 2n (* IADDR *) if not alterable( operand2 ) then begin escape( badops ); end; end; end else begin (* destination system reg *) if operand2.reg <= 2 then begin (* CONTROL or STATUS      (Dn) *) if not memalt( operand2 ) then begin escape( badops ); end; if not ((sizesuffix = ' ') or (sizesuffix = 'P')) then begin escape( badops ); end; if line[ curcol ] = '{' then begin d; (* not system reg(s) *) escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 2; operand1.reg := 0; operand1.size := 0; operand2.mode := 8; operand2.reg (* explicit k *) curcol := curcol + 1; parseoperand( operand3 ); if (operand3.mode = 7) and (operand3.reg = 4) then begin (* static k *) end else if operand3.mode <> 0 the := 0; operand2.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctb.longint := locctb.longint + operand1.size + operand2.size; end; (* FMOVE *) end; (* fpmn begin (* dynamic k *) escape( badops ); end; if line[ curcol ] <> '}' then begin escape( badops ); end; curcol := curcol + 1; end (* explicit k *) eloves1 *) begin (* pass1fpops *) allowfpopds := true; if (currop.class >= fpbase) and (currop.class <= fpgentop) then begin (* "general class" instructions *) fpsysflag := 0; with operand3 do begin mode := 1;se begin (* default (#k) *) end; end (* FPn,(#k) or FPn,(Dn) *) else begin if operand2.mode = 8 then begin (* FPn,FPm *) if operand1.reg = operand2.re (* acts as no-op flag for fpcodegen() *) reg := 0; size := 0; end; locctb.longint := locctr.longint + 4; TRY parseoperand( operand1 ); if currop.class = ( fpbase + 0 ) then fpmoves1 else if currop.class = fpbase + 48 g then begin escape( badops ); end; end else begin (* FPn, *) if (sizesuffix = 'D') or (sizesuffix = 'X') then begin if not memalt( operand2 ) then begin then begin (* FSINCOS *) TRY if line[ curcol ] <> ',' then begin escape( badops ); end; curcol := curcol + 1; fpreadmode := true; parseoperand( operand2 ); fpreadmod escape( badops ); end; end else begin if not datalterable( operand2 ) then begin escape( badops ); end; end; end; end; end (* source FPn *) else e := false; if line[ curcol ] <> ':' then begin escape( badops ); end; curcol := curcol + 1; parseoperand( operand3 ); if (operand2.mode <> 8) or (operand3.mode <> 8) then begin escape( badops ); end; if oif operand2.mode = 8 then begin (* destination FPn *) if (sizesuffix = 'D') or (sizesuffix = 'X') or (sizesuffix = 'P') then begin if not memmode( operand1 ) then begin escape( badops ); perand2.reg = operand3.reg then begin escape( badops ); end; if operand1.mode = 8 then begin end else if sizesuffix in [ 'D', 'X', 'P' ] then begin if not memmode( operand1 ) then begin escape( badops ); end; end else begin if not datamode( operand1 ) then begin escape( badops ); end; end; end (* destination FPn *) else begin escape( badops ); end; en end; end else if not datamode( operand1 ) then begin escape( badops ); end; escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 8; operand1.reg := 0; operand1.size       *) (* LAF 861120 FSDlg00784 if (sizesuffix = 'D') or (sizesuffix = 'X') then begin sizesuffix := 'S'; size := 4; end; *) end; if (sizesuffix = 'D') or (sizesuffix = 'X') or (sizesuffix = 'P') then R if escapecode = badops then begin if currop.class = (fpbase+58) then begin (* ftest *) operand1.mode := 2; operand1.reg := 0; end else begin operand1.mode := 8; operand1.reg := 0; end; op begin if not memmode( operand1 ) then begin escape( badops ); end; end else if not datamode( operand1 ) then begin escape( badops ); end; end (* ,FPn *) else erand1.size := 0; operand2.mode := 8; operand2.reg := 1; operand2.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctr.longint := locctb.longint; end (* "general class" instructions:= 0; operand2.mode := 8; operand2.reg := 1; operand2.size := 0; operand3.mode := 8; operand3.reg := 2; operand3.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctb.longint := locctb.lo begin escape( badops ); end; end (* two operands *) else begin (* one operand *) if currop.class = (fpbase+58) then begin (* FTngint + operand1.size; end (* FSINCOS *) else begin (* Fs, Fs *) if line[ curcol ] = ',' then begin (* two operands *) EST *) if operand1.mode = 9 then begin escape( badops ); end else if operand1.mode = 8 then begin operand2 := operand1; (* makes fpcodegen() work *) end else begin operand2.mode := 8;  if currop.class = (fpbase + 58) then begin (* FTEST *) escape( badops ); end; curcol := curcol + 1; parseoperand( operand2 ); if operand1.mode = 8 then begin (* source FPn *)  operand2.reg := 6; (* FPn makes fpcodegen work *) operand2.size := 0; if sizesuffix in [ 'D', 'X', 'P' ] then begin if not memmode( operand1 ) then begin escape( badops ); end; end else if not da if operand2.mode = 8 then begin (* FPn, FPm *) if not ((currop.class > (fpbase+0)) and (currop.class < (fpbase+32))) then begin (* not monadic op *) if operand1.reg = operand2.reg then tamode( operand1 ) then begin escape( badops ); end; end; end (* FTEST *) else begin (* not FTEST *) if operand1.mode <> 8 then begin escape( badops );  begin escape( badops ); end; end; end (* FPn,FPm *) else begin escape( badops ); end; end (* source FPn *) else if operand2.mode = 8 then begin  end; if not ( (currop.class > (fpbase + 0)) and (currop.class < (fpbase + 32)) ) then begin (* not monadic op *) escape( badops ); end; operand2 := operand1; end;  (* , FPn *) if (currop.class = (fpbase+36)) or (currop.class = (fpbase+39)) then begin (* fsglmul or flgldiv *) (* ??? see pgs 62, 248, and 253 of prelim. 881 manual, may be only 'S' is allowed  (* not FTEST *) end; (* one operand *) locctb.longint := locctb.longint + operand1.size + operand2.size; end; (* Fs, Fs *) escape( opsok ); RECOVE       *) else if (currop.class >= (fpbase+fpbrbase)) and (currop.class <= (fpbase+fpbrbase+31)) then begin (* FDBcc, FScc, FTcc, and FTPcc *) if currop.code = -4024 then (* FDBcc *) begin TRY papsok then escape( escapecode ); locctr.longint := locctr.longint + 4 + operand1.size; end; end (* FDBcc, FScc, FTcc, and FTPcc *) else if currop.class = (fpbase+fpbrbase+32) then begin rseoperand( operand1 ); if operand1.mode <> 0 then begin escape(badops ); end; if line[ curcol ] <> ',' then begin escape( badops ); end; curcol := curcol + 1; express( false, evalok, evalue, curcol ); (* ??? must be  (* FBcc *) TRY express( false, evalok, evalue, curcol ); (* ??? must be relative, as opposed to absolute ? *) evalue.offset.longint := evalue.offset.longint - ( 2 + locctr.longint ); if (sizesuffix = 'W'relative, as opposed to absolute ? *) evalue.offset.longint := evalue.offset.longint - ( 4 + locctr.longint ); operand2.value := evalue; escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 0; ope) or (sizesuffix = ' ') then begin if (evalue.exprefs = NIL) and not ( (evalue.base=absolut) and (pcmode = rel) ) and not ( (evalue.base=relative) and (pcmode=abs) ) and not fitsin16( evalue.offset ) then begin size := 4; end rand1.reg := 0; operand1.size := 0; operand2.value.offset := zero32; operand2.value.exprefs := NIL; end else if escapecode <> opsok then escape( escapecode ); locctr.longint := locctr.longint + 6; end else if curro else size := 2; end else size := 4; escape( opsok ); RECOVER if ( escapecode <> badops ) and ( escapecode <> opsok ) then escape( escapecode ) else if escapecode = opsok then operand1.value := evalue; lop.code = -4032 then (* FScc *) begin TRY parseoperand( operand1 ); if not datalterable( operand1 ) then begin escape( badops ); end; escape( opsok ); RECOVER if escapecode = badops then begin occtr.longint := locctr.longint + 2 + size; end (* FBcc *) else if (currop.class = (fpbase+fpbrbase+33)) or (currop.class = (fpbase+fpbrbase+34)) then begin (* perand1.mode := 2; operand1.reg := 0; operand1.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctr.longint := locctr.longint + 4 + operand1.size; end else if currop.code = -3972 then (*FSAVE or FRESTORE *) TRY parseoperand( operand1 ); if ( (currop.class = (fpbase+fpbrbase+33)) and (* save *) not ( (controlmode( operand1 ) and alterable( operand1)) or (operand1.mode = 4) ) ) (* restore *) or ( (curro FTcc *) begin locctr.longint := locctr.longint + 4; end else if currop.code = -3974 then (* FTPcc *) begin TRY parseoperand( operand1 ); if not ( (operand1.mode = 7) and (operand1.reg = 4) ) then begin p.class = (fpbase+fpbrbase+34)) and not (controlmode( operand1 ) or (operand1.mode = 3)) ) then begin escape( badops ); end; escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 2; operand1. escape( badops ); end; escape( opsok ); RECOVER if escapecode = badops then begin operand1.mode := 7; operand1.reg := 4; operand1.size := 2; operand1.value.offset := zero32; end else if escapecode <> oreg := 0; operand1.size := 0; end else if escapecode <> opsok then escape( escapecode ); locctr.longint := locctr.longint + 2 + operand1.size; end (* FSAVE or FRESTORE *) else if curro      ************** Not needed!!! (BAR) if object then begin I:=BLOCKREAD(OBJFILE,PUNCHBLK,1,OBJCTR); IF I<>1 THEN ERROR(errcread); end; ***************************************} TEXTRECORDS:=TEXTRECORDS+1; END; PROCEDURE NEWCODESEG; BEGIN TEXTSIZE:=ENFULL_FORMAT)) then begin if not(fitsin8(oper.value.offset)) then begin reffile^.info.valueextend:=true; exwordaddr:=zero32; code.byt[bdisp+1]:=0; end end $if fpimmed$ (* ??? may need larger immed. opd handliDOFCODE-ORIGIN; NEWTEXTREC; ORIGIN:=LOCCTR.LONGINT; if odd(origin) then error(erroddorg); CONTIGUOUS:=TRUE; END; PROCEDURE REFOFFSET; {CALCULATES OFFSETS FOR REF RECORDS} BEGIN IF FIRSTREF THEN BEGIN LASTREFLOC:=REFLOC; REFOFF:=REFLOC-ng *) $end$ else if not((oper.mode=7) and (oper.reg=4) and (size=4)) then if not(fitsin16(oper.value.offset)) AND (OPER.SIZE=2) then begin reffile^.info.valueextend:=true; exwordaddr:=zero32; code.int[bdisp div 2 + 1]:=0p.class = (fpbase+fpbrbase+35) then begin (* FNOP *) size := 4; locctr.longint := locctr.longint + 4; end; (* FNOP *) allowfpopds := false; eORIGIN; FIRSTREF:=FALSE; END ELSE BEGIN REFOFF:=REFLOC-LASTREFLOC; LASTREFLOC:=REFLOC; END; IF REFOFF<256 THEN BEGIN REFFILE^.INFO.LONGOFFSET:=FALSE; REFFILE^.INFO.SHORT:=REFOFF; END ELSE BEGIN REFFILE^.INFO.LONGOFFSET:=nd; (* pass1fpops *) $end$ TRUE; REFFILE^.INFO.LONG:=REFOFF; END; END; PROCEDURE DOLINKXTREF(OPER:OPERAND;BDISP:SHORTINT; LINKPATCH:BOOLEAN; VAR EXWORDADDR: WORD32); VAR OD_DISP: INTEGER; PROCEDURE NEWREFFILE; BEGIN TRY NEW(REFFILE) RECOVER BEGIN CONST BADOPS=101; OPSOK=100; PROCEDURE PASS2; { THIS PROCEDURE DOES ALL THE PASS 2 PROCESSING. } VAR SP:STREF; { SCRATCH VAR FOR SYMTABLE ACCESS } PROCEDURE PASS2STUFF; { THIS DOES PASS 2 INSTRUCTION PROCESSING } VAR TOP: OPERAND; { SCRATCH VAR FOR OPEif escapecode=-2 then begin WRITELN(LP,'MEMORY OVERFLOW!'); LPCHECK; { 3/2/84 } IF LISTNAME<>'CONSOLE:' THEN WRITELN('MEMORY OVERFLOW!'); ESCAPE(-1); end else escape(escapecode); END; END; PROCEDURRANDS } PROCEDURE NEWTEXTREC; { DOES NECESSARY STUFF WHEN GET NEW ORG } VAR I, SAVEBLOCK: SHORTINT; BEGIN REFCOPY; SAVEBLOCK:=OBJCTR; if object then begin I:=BLOCKREAD(OBJFILE,PUNCHBLK,1,1); IF I<>1 THEN ERROR(errcread); end; PUNCHLC:=TEXTINFO; IF E PUTREFFILE; BEGIN REFLOC:=LOCCTR.LONGINT+BDISP; REFOFFSET; IF REFHEAD=NIL THEN REFHEAD:=REFFILE ELSE REFTAIL^.REFNEXT:=REFFILE; REFTAIL:=REFFILE; REFFILE^.REFNEXT:=NIL; REFCTR:=REFCTR+1; END; BEGIN IF ((OPER.MODE=6) OR ((OPER.MODPUNCHLC+22>511 THEN ERROR(ERRDIROVF); PUNCHDWORD(TEXTSTART); PUNCHDWORD(TEXTSIZE); PUNCHDWORD(REFSTART); PUNCHDWORD(REFSIZE); IF PCMODE=REL THEN GV.PRIMARYTYPE:=RELOCATABLE ELSE GV.PRIMARYTYPE:=ABSOLUTE; GV.DATASIZE:=SINT; GV.PATCHABLE:=FALSE; GV.VALUEEXE=7) AND (OPER.REG=3))) AND OPER.FULL_FORMAT THEN BDISP:=BDISP+2-1; (* SPACE FOR EXTENSION WORD *) IF OPER.VALUE.EXPREFS <> NIL THEN (******************** THERE IS AN EXTERNAL REFERENCE *) BEGIN NEWREFFILE; REFFILE^.EXTSTUFF2.LAST:=FALSE; RETEND:=TRUE; GV.LONGOFFSET:=FALSE; GV.SHORT:=6; PUNCHGVR(GV); PUNCHDWORD(ORIGIN); if object then begin I:=BLOCKWRITE(OBJFILE, PUNCHBLK,1,1); IF I<>1 THEN ERROR(errwrite); end; TEXTINFO:=PUNCHLC; OBJCTR:=SAVEBLOCK; TEXTSTART:=OBJCTR-1; PUNCHLC:=0; {****FFILE^.EXTSTUFF.ADR:=OPER.VALUE.EXPREFS^.SYMPT^.SVALUE.LOHALF; REFFILE^.INFO.VALUEEXTEND:=FALSE; if ((oper.mode=6) AND (NOT OPER.FULL_FORMAT)) or ((oper.mode=7) and (oper.reg=4) and (size=1)) or ((oper.mode=7) and (oper.reg=3) AND (NOT OPER.      ; end ELSE IF ((OPER.MODE=6) OR ((OPER.MODE=7) AND (OPER.REG=3))) AND OPER.FULL_FORMAT AND (OPER.BD_SIZE=S_WORD) AND NOT(FITSIN16(OPER.VALUE.OFFSET)) THEN BEGIN REFFILE^.INFO.VALUEEXTEND:=TRUE; EXWORDADDR: REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=LINKPATCH; IF OPER.SIZE=2 THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT; (* MUST BE SIZE=4 *) IF OPER.VALUE.EXPREFS^.MINUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT =ZERO32; CODE.INT[BDISP DIV 2 + 1]:=0; END; CASE OPER.MODE OF 0,1,2,3,4: BEGIN END; 5: BEGIN REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.DATASIZE:=SWORD; REFFILE^.INFO.PATCHABLE:=FALSE; IF OPER.VALUE.EXPREFS^.MELSE REFFILE^.EXTSTUFF.OP:=ADDIT; IF (OPER.VALUE.BASE=RELATIVE) THEN IF (OPER.VALUE.EXPREFS^.SYMPT^.SKIND=RELATIVE) AND (PCMODE=REL) THEN BEGIN REFFILE^.EXTSTUFF2.OP:=SUBIT; REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=INUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; END; 6: BEGIN (* SAME AS MODE=7, REG=3 *) REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=FALSE; IF OPER.FULL_FORMAT THEN BEGIN TRUE; END ELSE ELSE IF PCMODE=REL THEN BEGIN { ABSOLUTE TARGET -- KLUGE FOR BRANCH } REFFILE^.EXTSTUFF2.OP:=SUBIT; REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE; END; END; 3: BEGIN (* SAME AS MODE=6 *) {PC + 8 BIF OPER.BD_SIZE=S_WORD (* CAN'T HAVE S_NULL OR S_RES WITH AN EXT. REF. *) THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT END ELSE REFFILE^.INFO.DATASIZE:=SBYTE; IF OPER.VALUE.EXPREFS^.MINUS THEN REFFILE^.EXIT} REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=false; IF OPER.FULL_FORMAT THEN BEGIN IF OPER.BD_SIZE=S_WORD (* CAN'T HAVE S_NULL OR S_RES WITH AN EXT. REF. *) THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASITSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; IF OPER.VALUE.EXPREFS^.SYMPT^.SKIND=RELATIVE THEN BEGIN REFFILE^.EXTSTUFF2.OP:=SUBIT; REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE; END; END; 7: ZE:=SINT END ELSE REFFILE^.INFO.DATASIZE:=SBYTE; IF OPER.VALUE.EXPREFS^.MINUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; IF OPER.VALUE.EXPREFS^.SYMPT^.SKIND=RELATIVE THEN BEGIN REFFILE^.EXTSTUFF2.OP:=SUBIT; R CASE OPER.REG OF 0,1: BEGIN REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=FALSE; IF OPER.REG=0 THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT; IF ((OPER.VALUE.BASE=RELATIVE) AND (OPER.VALUE.EXPREEFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE; END; END; 4: BEGIN $if mc68881$ (* need to handle larger immed. opds ??? *) $end$ REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=FALSE; CASE SIZE OF 1: REFFILEFS^.SYMPT^.SKIND=ABSOLUT)) OR ((OPER.VALUE.BASE=ABSOLUT) AND (OPER.VALUE.EXPREFS^.SYMPT^.SKIND=RELATIVE)) THEN BEGIN IF (OPER.VALUE.BASE=ABSOLUT) AND NOT(OPER.VALUE.EXPREFS^.MINUS) THEN REFFILE^.EXTSTUFF2.OP:=SUBIT ELSE RE^.INFO.DATASIZE:=SBYTE; 2: REFFILE^.INFO.DATASIZE:=SWORD; 4: REFFILE^.INFO.DATASIZE:=SINT; END; IF ((OPER.VALUE.BASE=RELATIVE) AND (OPER.VALUE.EXPREFS^.SYMPT^.SKIND=ABSOLUT)) OR ((OPER.VALUE.BASE=ABSOLUT) AND (OPER.VALUE.EXPREFS^.SYFFILE^.EXTSTUFF2.OP:=ADDIT; REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE; END; IF OPER.VALUE.EXPREFS^.MINUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; END; 2: BEGIN {PC + 16 BIT} MPT^.SKIND=RELATIVE)) THEN BEGIN IF (OPER.VALUE.BASE=ABSOLUT) AND NOT(OPER.VALUE.EXPREFS^.MINUS) THEN REFFILE^.EXTSTUFF2.OP:=SUBIT ELSE REFFILE^.EXTSTUFF2.OP:=ADDIT; REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE;       MARYTYPE:=GENERAL; if not fitsin16(oper.value.offset) AND (SIZE=2) then begin reffile^.info.valueextend:=true; reffile^.value:=oper.value.offset; code.int[2]:=0; end else reffile^.info.valueextend:=false; IF SIZE=2 THEN REFFILS_LONG THEN BDISP:=BDISP+4 ELSE IF OPER.BD_SIZE=S_WORD THEN BDISP:=BDISP+2; IF OPER.OD_VALUE.EXPREFS <> NIL THEN (******************** THERE IS AN EXTERNAL REFERENCE *) BEGIN NEWREFFILE; REFFILE^.EXTSTUFF2.LAST:=FALSE; REFFE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT; REFFILE^.EXTSTUFF.ADR:=0; if oper.value.base=absolut then reffile^.extstuff.op:=subit else REFFILE^.EXTSTUFF.OP:=addit; REFFILE^.EXTSTUFF.LAST:=TRUE; PUTREFFILE; END else if (ILE^.EXTSTUFF.ADR:=OPER.OD_VALUE.EXPREFS^.SYMPT^.SVALUE.LOHALF; REFFILE^.INFO.VALUEEXTEND:=FALSE; IF (OPER.OD_SIZE=S_WORD) AND NOT(FITSIN16(OPER.OD_VALUE.OFFSET)) THEN BEGIN REFFILE^.INFO.VALUEEXTEND:=TRUE; EXWORDADDR:=ZER END; IF OPER.VALUE.EXPREFS^.MINUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; END; 5,6,7: BEGIN END; END; {CASE} END; {CASE} REFFILE^.EXTSTUFF.LAST:=NOT REFFILE^.EXTSTUFF2.LAST; IF REFFILE^.INFO.VALUEpcmode=abs) and (((oper.mode=7) and ((oper.reg=2) or (oper.reg=3))) OR ( OPER.MODE=6)) and (oper.value.base=relative) then begin (******************** THERE IS A RELATIVE BUT NO EXTERNAL IN INDIRECT *) NEWREFFILE; reffile^.info.patchable:=linkpEXTEND THEN REFFILE^.VALUE:=OPER.VALUE.OFFSET ELSE REFFILE^.VALUE:=ZERO32; PUTREFFILE; END (* OPER.VALUE.EXPREFS <> NIL *) ELSE $if mc68881$ (* need to handle larger immed. opds ??? *) $end$ IF (OPER.VALUE.BASE=RELATIVE) AND (OPER.MODEatch and (OPER.MODE=7) AND (oper.reg=2); reffile^.info.primarytype:=relocatable; if (OPER.MODE=7) AND (oper.reg=2) then reffile^.info.datasize:=sword else IF OPER.FULL_FORMAT THEN BEGIN IF OPER.BD_SIZE=S_WORD (* CAN'T HAVE S_NULL =7) AND ((OPER.REG=4) or (oper.reg=0) or (oper.reg=1)) THEN (******************** THERE IS A RELATIVE IN ABSOLUTE OR IMMEDIATE *) BEGIN NEWREFFILE; REFFILE^.INFO.PATCHABLE:=FALSE; REFFILE^.INFO.PRIMARYTYPE:=RELOCATABLE; REFFILE^.INFO.VALUEEXOR S_RES WITH A REF. *) THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT END ELSE REFFILE^.INFO.DATASIZE:=SBYTE; if (not(fitsin16(oper.value.offset)) and (REFFILE^.INFO.DATASIZE=SWORD)) or (not(fitsin8 (oper.valTEND:=FALSE; if (oper.reg=4) then CASE SIZE OF 1: REFFILE^.INFO.DATASIZE:=SBYTE; 2: REFFILE^.INFO.DATASIZE:=SWORD; 4: REFFILE^.INFO.DATASIZE:=SINT; $if fpimmed AND FALSE$ 8: begin reffile^.info.datasize:= sint; (* this is wue.offset)) and (REFFILE^.INFO.DATASIZE=SBYTE)) then begin reffile^.info.valueextend:=true; if REFFILE^.INFO.DATASIZE=SBYTE then code.byt[bdisp+1]:=0 else code.int[bdisp div 2 + 1]:=0; reffile^.value:=oper.value.offset; rong ??? *) reffile^.info.valueextend := true; reffile^.value := oper.value.offset; end; $end$ END (* CASE *) (* if (oper.reg=4) *) else if oper.reg=0 then reffile^.info.datasize:=sword else reffile^.info.datasize:=sint; PUTREFFILE; exwordaddr:=zero32; end else begin reffile^.info.valueextend:=false; reffile^.value:=zero32; end; PUTREFFILE; end; (*************************************************************************) (* THE PRECEDING CHUNKS ARE ALL EXCLUSI END ELSE IF (CURROP.CLASS=7) $if mc68881$ or (currop.class=(fpbase+fpbrbase+32)) (* FBcc *) $end$ THEN BEGIN (******************** THIS IS A BRANCH AND NOT EXTERNAL *) NEWREFFILE; REFFILE^.INFO.PATCHABLE:=LINKPATCH; REFFILE^.INFO.PRIVE; IF ONE IS INVOKED, NONE OF (* THE OTHERS ARE. THE FOLLOWING CHUNK IS INDEPENDENT OF THE PRECEDING. (**) IF ((OPER.MODE=6) OR ((OPER.MODE=7) AND (OPER.REG=3))) AND (OPER.FULL_FORMAT) AND (OPER.OD_SIZE>=S_WORD) THEN BEGIN IF OPER.BD_SIZE=      O32; CODE.INT[BDISP DIV 2 + 1]:=0; END; REFFILE^.INFO.PRIMARYTYPE:=GENERAL; REFFILE^.INFO.PATCHABLE:=FALSE; IF OPER.OD_SIZE=S_WORD (* CAN'T HAVE S_NULL OR S_RES WITH AN EXT. REF. *) THEN REFFILE^.INFO.DATASIZE:=SWORD EL ELSE IF NOT SHORTMODE THEN LISTINST(1); if not contiguous then newcodeseg; PUNCHBYTE(ORD(LINECOPY[CURCOL])); LOCCTR.LONGINT := LOCCTR.LONGINT + 1; BYTECOUNT:=BYTECOUNT+1; END; BEGIN DONE:=FALSE; BYTECOUNT:=0; REPEAT CURCOL:=CURCOL+1; SE REFFILE^.INFO.DATASIZE:=SINT; IF OPER.OD_VALUE.EXPREFS^.MINUS THEN REFFILE^.EXTSTUFF.OP:=SUBIT ELSE REFFILE^.EXTSTUFF.OP:=ADDIT; IF OPER.OD_VALUE.EXPREFS^.SYMPT^.SKIND=RELATIVE THEN BEGIN REFFILE^.EXTSTUFF2.OP:=SUBIT;  IF CURCOL<>LENGTH(LINECOPY) THEN IF LINECOPY[CURCOL]=CHR(39) THEN IF LINECOPY[CURCOL+1]=CHR(39) THEN BEGIN CURCOL:=CURCOL+1; CODE.BYT[1]:=39; OUTPUTCHAR; END ELSE DONE:=TRUE ELSE BEGIN CODE.BYT[1]:=ORD(LINECOPY[CURCOL]); OUTPUT REFFILE^.EXTSTUFF2.ADR:=0; REFFILE^.EXTSTUFF2.LAST:=TRUE; END; REFFILE^.EXTSTUFF.LAST:=NOT REFFILE^.EXTSTUFF2.LAST; IF REFFILE^.INFO.VALUEEXTEND THEN REFFILE^.VALUE:=OPER.OD_VALUE.OFFSET ELSE REFFILE^.VALUE:=ZERO32; CHAR; END ELSE BEGIN ERROR(ERRBADSYNTAX); DONE:=TRUE; END; UNTIL DONE; IF (SIZE=2) AND ODD(LOCCTR.LOHALF) THEN BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 1; BYTECOUNT:=BYTECOUNT+1; if not contiguous then newcodesegPUTREFFILE; END (* OPER.OD_VALUE.EXPREFS <> NIL *) $IF FALSE$ ELSE if (pcmode=abs) and (oper.OD_value.base=relative (* THIS CAN'T HAPPEN ANYMORE *)) then begin (******************** THERE IS A RELATIVE BUT NO EXTERNAL IN INDIRECT *) NE; PUNCHBYTE(0); END ELSE IF SIZE=4 THEN WHILE BYTECOUNT MOD 4 <> 0 DO BEGIN LOCCTR.LONGINT := LOCCTR.LONGINT + 1; if not contiguous then newcodeseg; PUNCHBYTE(0); BYTECOUNT:=BYTECOUNT+1; END; $if mc68881$ (* may need larger sizWREFFILE; reffile^.info.patchable:=FALSE; reffile^.info.primarytype:=relocatable; IF OPER.OD_SIZE=S_WORD (* CAN'T HAVE S_NULL OR S_RES WITH A REF. *) THEN REFFILE^.INFO.DATASIZE:=SWORD ELSE REFFILE^.INFO.DATASIZE:=SINT; if (not(e handling here ??? *) $end$ IF CURCOL<>LENGTH(LINECOPY) THEN CURCOL:=CURCOL+1; COUNT := COUNT + BYTECOUNT DIV SIZE; END; BEGIN CASE CURROP.CODE OF 0: { COMMENT } LISTINST(4); 1: { DC } BEGIN COUNT:=0; CURCOL:=CURCOL-1; fitsin16(oper.OD_value.offset)) and (REFFILE^.INFO.DATASIZE=SWORD)) then begin reffile^.info.valueextend:=true; code.int[bdisp div 2 + 1]:=0; reffile^.value:=oper.OD_value.offset; exwordaddr:=zero32; end else bOPERAND1.MODE:=7; OPERAND1.REG:=4; LINECOPY:=PRINTLINE; LINECOPY[0]:=SUCC(LINECOPY[0]); LINECOPY[LENGTH(LINECOPY)]:=BLANK; REPEAT CURCOL:=CURCOL+1; IF LINE[CURCOL]=CHR(39) THEN CHARSTRING2 ELSE BEGIN COUNT:=COUNT+1; $iegin reffile^.info.valueextend:=false; reffile^.value:=zero32; end; PUTREFFILE; end; $END$ END; END; {PROCEDURE DOLINKXTREF} PROCEDURE PASS2PSEUDOS; { THIS DOES PSEUDO-OPS FOR PASS 2 } VAR COUNT: SHORTINT; SYM, SP: STREF;f fpimmed$ if sizesuffix = 'D' then begin if not fpimmedexp( true, evalok, evalue, curcol ) then error( errfpconstneeded ); end else $end$ EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); OPERAND1.VALUE:=EVALUE; CODELENGTH: I,COL, LEN, STARTCOL: SHORTINT; tlab: lstring; PROCEDURE CHARSTRING2; VAR DONE: BOOLEAN; BYTECOUNT: SHORTINT; PROCEDURE OUTPUTCHAR; BEGIN CODELENGTH:=1; IF (BYTECOUNT=0) AND (COUNT=0) THEN BEGIN LISTINST(1); PRINTLINE:=''; END =SIZE; CASE SIZE OF 1: BEGIN IF NOT(FITSIN8(EVALUE.OFFSET)) AND ((EVALUE.OFFSET.HIHALF<>0) OR (EVALUE.OFFSET.LOHALF<0) OR (EVALUE.OFFSET.LOHALF>255)) and (evalue.exprefs=nil) THEN ERROR(ERRFIELDOFLO); IF NOT CONTIGUOUS THEN NEWC      OK1) AND (EVALUE.EXPREFS=NIL) THEN if evalue.base=absolut then begin IF CONTIGUOUS THEN ENDOFCODE:=LOCCTR.LONGINT; LOCCTR.LONGINT:=SIZE*EVALUE.OFFSET.LONGINT +LOCCTR.LONGINT; CONTIGUOUS:=FALSE; end else error(errbadbase) ELSE bDOFCODE-ORIGIN; NEWTEXTREC; END; if pcmode=rel then if locctr.longint > highaddr.longint then highaddr:=locctr; LOCCTR:=EVALUE.OFFSET; ORIGIN:=EVALUE.OFFSET.LONGINT; if odd(origin) then error(erroddorg); CONTIGUOUS:=TRegin if (evalue.exprefs <> NIL) then error(errextrefs); if evalok = ok2 then ERROR(ERRBADEXPR); end; END; 3: {END} LISTINST(4); 4: {MNAME} LISTINST(4); 5: {EQU} BEGIN tlab:=lab; LOOKUPSYMBOL(SYM); IF CHEUE; IF SIZE=4 THEN ORGMODE:=LONGFWDS ELSE ORGMODE:=SHORTFWDS; IF CURROP.CODE=13 THEN PCMODE:=ABS ELSE BEGIN PCMODE:=REL; IF LOCCTR.LONGINT < LOWRORG.LONGINT THEN LOWRORG:=LOCCTR; END; IF LINE[CURCOL]<>' ' THEN ERROR(ERREOLEXP); END ODESEG; CODE.BYT[1]:=EVALUE.OFFSET.BYTE4; DOLINKXTREF(OPERAND1, 0, FALSE, LOCCTB); punchbyte(code.byt[1]); END; 2: BEGIN IF NOT(FITSIN16(EVALUE.OFFSET)) AND (EVALUE.OFFSET.HIHALF<>0) and (evalue.exprefs=nil) THEN ERROR(ERRFIELDCKREGS THEN BEGIN CODE.INT[1]:=0; CODE.INT[2]:=CHECKREGNO; END ELSE IF CHECKSPREGS THEN BEGIN CODE.INT[1]:=0; CODE.INT[2]:=CHECKREGNO; END ELSE BEGIN EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); CODE.OFLO); CODE.INT[1]:=EVALUE.OFFSET.LOHALF; IF NOT CONTIGUOUS THEN NEWCODESEG; DOLINKXTREF(OPERAND1, 0, FALSE, LOCCTB); PUNCHCODE; END; 4: BEGIN CODE.INT[1]:=EVALUE.OFFSET.HIHALF; CODE.INT[2]:=EVALUE.OFFSET.LOHALF; IF NOTINT[1]:=EVALUE.OFFSET.HIHALF; CODE.INT[2]:=EVALUE.OFFSET.LOHALF; END; if (tlab<>'') and (sym<>nil) then IF (CODE.INT[1]<>SYM^.SVALUE.HIHALF) OR (CODE.INT[2]<>SYM^.SVALUE.LOHALF) THEN ERROR(ERRPHASE); CODELENGTH:=4; IF L CONTIGUOUS THEN NEWCODESEG; DOLINKXTREF(OPERAND1, 0, FALSE, LOCCTB); PUNCHCODE; END; $if fpimmed$ 8: begin with evalue.offset do begin code.int[ 1 ] := fltptwd1; code.int[ 2 ] := fltptwd2; code.int[ 3 ] :=INE[CURCOL]<>' ' THEN ERROR(ERREOLEXP); LISTINST(2); END; 6: { SRC } LISTINST(4); 8: {LIST} BEGIN LISTINST(4); LISTING:=TRUE; END; 9: { LLEN } BEGIN EXPRESS(true, EVALOK, EVALUE, CURCOL); IF (EVALUE.EXPR fltptwd3; code.int[ 4 ] := fltptwd4; if not contiguous then newcodeseg; dolinkxtref( operand1, 0, false, locctb); punchcode; end; end; 12: begin (* ??? error( errfpinternalerr ); *) end; $end$ ENDEFS<>NIL) OR (EVALOK<>OK1) OR NOT((EVALUE.OFFSET.HIHALF=0) AND (EVALUE.OFFSET.LOHALF>=32) AND (EVALUE.OFFSET.LOHALF<=132)) THEN ERROR(ERRBADEXPR) else LLEN:=EVALUE.OFFSET.LOHALF; listinst(4); END; 10: { NOLIST, NOL } BE; IF (LENGTH(PRINTLINE)>0) OR NOT(SHORTMODE) THEN LISTINST(1); IF COUNT>0 THEN PRINTLINE:=''; LOCCTR.LONGINT := LOCCTR.LONGINT + SIZE; END UNTIL LINE[CURCOL]<>','; IF LINE[CURCOL]<>' ' THEN ERROR(ERREOLEXP); END; {OF DC PROGIN LISTINST(4); LISTING:=FALSE; END; 11: { NOOBJ} LISTINST(4); 12: { NOPAGE } BEGIN LISTINST(4); LINESPERPAGE:=32767; END; 13,15: { ORG, RORG } BEGIN EXPRESS(true, EVALOK, EVALUE, CURCOL); IF (EVCESSING} 2: { DS } BEGIN EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); IF LINE[CURCOL]<>BLANK THEN ERROR(ERREOLEXP); CODELENGTH:=2; CODE.INT[1]:=EVALUE.OFFSET.LOHALF; LISTINST(1); { NORMAL LINE LIST } IF (EVALOK=ALOK=OK1) AND (EVALUE.EXPREFS=NIL) THEN BEGIN IF CONTIGUOUS THEN BEGIN IF LOCCTR.LONGINT>ORIGIN THEN BEGIN TEXTSIZE:=LOCCTR.LONGINT-ORIGIN; NEWTEXTREC; END END ELSE IF ENDOFCODE > ORIGIN THEN BEGIN TEXTSIZE:=EN     else error(errbadexpr); LISTINST(3); END; 14: { PAGE } if superlist and listing then CURRENTLINE:=LINESPERPAGE+10; 17: { SPC } BEGIN EXPRESS(TRUE,EVALOK,EVALUE,CURCOL); IF (EVALOK<>NOK) and (evalue.exprefs=nil) and (evalue.base=ab=DEFFILE ELSE DEFTAIL^.DEFNEXT:=DEFFILE; DEFTAIL:=DEFFILE; DEFFILE^.DEFNEXT:=NIL; DEFCTR:=DEFCTR+1; IF LINE[CURCOL]=BLANK THEN ESCAPE(OPSOK); IF LINE[CURCOL]<>COMMA THEN ESCAPE(BADOPS); CURCOL:=CURCOL+1; UNTIL FALSE; RECOVER solut) THEN BEGIN if line[curcol]<>' ' then begin error(erreolexp); listinst(4); end else begin PRINTLINE:=' '; FOR COUNT:=1 TO EVALUE.OFFSET.LOHALF DO LISTINST(4); end; END ELSE BEGIN error(errIF ESCAPECODE=BADOPS THEN ERROR(ERRBADSYNTAX) ELSE IF ESCAPECODE<>OPSOK THEN ESCAPE(ESCAPECODE); LISTINST(4); END; 21,22: { REFA, REFR } LISTINST(4); { NO PASS 2 ACTION } 25,26,27,28: { LMODE, SMODE, RMODE, MLOAD } LISTINST(4); 29: { badexpr); listinst(4); end; END; 18: { TTL } BEGIN CODELENGTH:=LENGTH(LINE)-CURCOL; IF CODELENGTH>60 THEN CODELENGTH:=60; TITLE[0]:=CHR(CODELENGTH); FOR I:=1 TO CODELENGTH DO TITLE[I]:=LINE[CURCOL+I-1]; END; 19: { COM } NOSYMS } BEGIN LISTSYMS:=FALSE; LISTINST(4); END; 30: { INCLUDE } BEGIN LISTINST(4); INCLUDEINSTR; END; 31: { SPRINT } BEGIN SHORTMODE:=TRUE; LISTINST(4); END; 32: { LPRINT } BEGIN SHORTMODE:=FALSE; LISTINST(4); 20: { DEF } BEGIN TRY REPEAT IF NOT(LINE[CURCOL] IN ['A'..'Z','_','@']) THEN {leading '_','@'} ESCAPE(BADOPS); {jch 08/26/86} STARTCOL:=CURCOL; REPEAT CURCOL:=CURCOL+1; UN LISTINST(4); END; 33: { START } BEGIN EXPRESS(TRUE, EVALOK, EVALUE, CURCOL); IF (EVALUE.EXPREFS<>NIL) OR (EVALOK<>OK1) THEN BEGIN CODE.INT[1]:=0; CODE.INT[2]:=0; END ELSE BEGIN CODE.INT[1]:=EVALUE.OFFSET.HIHALF; CODE.INT[2]TIL CHTYPE[LINE[CURCOL]]=SPECIAL; LAB:=COPY(LINE, STARTCOL, CURCOL-STARTCOL); LOOKUPSYMBOL(SP); IF SP=NIL THEN BEGIN ERROR(ERRUNDEFSYM); ESCAPE(OPSOK); END; IF SP^.DEFINED<=0 THEN BEGIN ERROR(ERRUNDEFSYM); ESCAPE(OPSOK) END; :=EVALUE.OFFSET.LOHALF; IF LINE[CURCOL]<>' ' THEN ERROR(ERREOLEXP); END; CODELENGTH:=4; LISTINST(2); END; 34: { DECIMAL } listinst(4); END; { OF CASE } END; { OF PROCEDURE } PROCEDURE CODEGEN; VAR I :SHORTINT; LINKPATCH  IF (SP^.EXT) OR (SP^.SEXTPTR<>NIL) THEN BEGIN ERROR(ERREXTREFS); ESCAPE(OPSOK); END; TRY NEWBYTES(DEFFILE,SIZEOF(DEFREC)-80+LENGTH(LAB)) RECOVER BEGIN if escapecode=-2 then begin WRITELN(LP,'MEMORY OVERFLOW!'); :BOOLEAN; EXWORDADDR:WORD32; DUMMY: SHORTINT; { KLUDGE FOR COMPILER BUG} SAVEREGY, SAVEMODE: 0..7; PROCEDURE BUILDEA(OPER:OPERAND;CDISP:SHORTINT;VAR EAWORD1:IDXWORD); VAR EADISP: SHORTINT; BEGIN {BUILDEA} CODE.TYPE4.MODE:=OPER.MODE; CODE. LPCHECK; { 3/2/84 } IF LISTNAME<>'CONSOLE:' THEN WRITELN('MEMORY OVERFLOW!'); ESCAPE(-1); end else escape(escapecode); END; DEFFILE^.LOCATION:=SP^.SVALUE; IF SP^.EXT AND (SP^.SVALUE.LOHALF=0) AND (SP^.SVALUE.HIHALF=0)TYPE2.REGY:=OPER.REG; CASE CODE.TYPE4.MODE OF 0,1,2,3,4: BEGIN {NO ACTION} END; {DN, AN, (AN), (AN)+, -(AN)} 5:BEGIN {D(AN)} CODE.INT[CDISP]:=OPER.VALUE.OFFSET.LOHALF; CODELENGTH:=CODELENGTH+2; DOLINKXTREF(OPER,CDIS THEN DEFFILE^.DEFTYPE:=GLOBAL ELSE IF SP^.SKIND=ABSOLUT THEN DEFFILE^.DEFTYPE:=ABSOLUTE ELSE IF SP^.SKIND=RELATIVE THEN DEFFILE^.DEFTYPE:=RELOCATABLE ELSE ESCAPE(BADOPS); DEFFILE^.IDNAME:=SP^.SNAME; IF DEFHEAD=NIL THEN DEFHEAD:P*2-2,LINKPATCH, EXWORDADDR); END; 6:BEGIN {D(AN,RI)} CODELENGTH:=CODELENGTH+2; EAWORD1.DA :=OPER.INDEXMODE=ADDRS; EAWORD1.REGI :=OPER.INDEX; EAWORD1.WL :=OPER.INDEXSIZE=LONG; EAWORD1.SCALE:=OPER.INDE     FFSET.LOHALF; CODELENGTH:=CODELENGTH+2; DOLINKXTREF(OPER,CDISP*2-2,LINKPATCH, EXWORDADDR); END; 2:BEGIN {PC + 16 BIT DISP} EXWORDADDR.LONGINT := OPER.VALUE.OFFSET.LONGINT + 2 - LOCCTR.LONGINT - CDISPEXWORDADDR); IF (NOT OPER.FULL_FORMAT AND NOT FITSIN8(EXWORDADDR)) OR ( OPER.FULL_FORMAT AND NOT FITSIN16(EXWORDADDR) AND (OPER.BD_SIZE=S_WORD)) THEN ERROR(ERRFIELDOFLO); END; 4:{IMMEDIATE DATA} BEGIN $if mc68881$ (* need*2; OPER.VALUE.OFFSET:=EXWORDADDR; CODE.INT[CDISP]:=EXWORDADDR.LOHALF; DOLINKXTREF(OPER,CDISP*2-2,LINKPATCH, EXWORDADDR); IF NOT FITSIN16(EXWORDADDR) THEN ERROR(ERRFIELDOFLO); END; 3:BEGIN {PC + INDEX REG + 8 BIT DISP} to handle larger immed. opds ??? *) $end$ IF SIZE = 1 THEN CODE.INT[CDISP]:=OPER.VALUE.OFFSET.BYTE4 ELSE IF SIZE = 2 THEN CODE.INT[CDISP]:=OPER.VALUE.OFFSET.LOHALF $if fpimmed$ ELSE if size = 4 then $end$ BEGIN CODE.INT[CDISP]:=OPER.XSCALE; EAWORD1.FULL :=OPER.FULL_FORMAT; IF EAWORD1.FULL THEN BEGIN EAWORD1.BASE_SUPPRESS :=OPER.BASE_SUPPRESS ; EAWORD1.INDEX_SUPPRESS:=OPER.INDEX_SUPPRESS; EAWORD1.BD_SIZE :=OPER.BD_SIZE ; EAWORD1.FILL  IF OPER.FULL_FORMAT AND OPER.BASE_SUPPRESS THEN EXWORDADDR.LONGINT := OPER.VALUE.OFFSET.LONGINT ELSE BEGIN EXWORDADDR.LONGINT := OPER.VALUE.OFFSET.LONGINT + 2 - LOCCTR.LONGINT - CDISP*2; END; OPER.VALUE.OFFSET:=EXWORDADDR; EAWORD1.DA  :=OPER.FILL ; EAWORD1.POST_INDEXED :=OPER.POST_INDEXED ; EAWORD1.OD_SIZE :=OPER.OD_SIZE ; EADISP:=CDISP; IF OPER.BD_SIZE=S_LONG THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER. VALUE.OFFSET :=OPER.INDEXMODE=ADDRS; EAWORD1.REGI :=OPER.INDEX; EAWORD1.WL :=OPER.INDEXSIZE=LONG; EAWORD1.SCALE:=OPER.INDEXSCALE; EAWORD1.FULL :=OPER.FULL_FORMAT; IF EAWORD1.FULL THEN BEGIN EAWORD1.BASE_SUPPRESS :=OPER.BASE_SUPPRESS ; EAWORD1.INDEX_SU.HIHALF; EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER. VALUE.OFFSET.LOHALF; END ELSE IF OPER.BD_SIZE=S_WORD THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER. VALUE.OFFSET.LOHALF; END; IF OPER.OD_SIZE=S_LONG THEN BEGIN EADISP:=EADPPRESS:=OPER.INDEX_SUPPRESS; EAWORD1.BD_SIZE :=OPER.BD_SIZE ; EAWORD1.FILL :=OPER.FILL ; EAWORD1.POST_INDEXED :=OPER.POST_INDEXED ; EAWORD1.OD_SIZE :=OPER.OD_SIZE ; EADISP:=CDISP; IF OPER.BISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.HIHALF; EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.LOHALF; END ELSE IF OPER.OD_SIZE=S_WORD THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.LOHALF; END; CODELEND_SIZE=S_LONG THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER. VALUE.OFFSET.HIHALF; EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER. VALUE.OFFSET.LOHALF; END ELSE IF OPER.BD_SIZE=S_WORD THEN BEGIN EADISP:=EADISP+1; CODE.INGTH:=CODELENGTH+(EADISP-CDISP)*2; END ELSE EAWORD1.DISP:=OPER.VALUE.OFFSET.BYTE4; DOLINKXTREF(OPER,CDISP*2-1,LINKPATCH, EXWORDADDR); END; 7:BEGIN CODELENGTH:=CODELENGTH+2; CASE CODE.TYPE2.REGY OF 0:BEGIN CODE.INT[CT[EADISP]:=OPER. VALUE.OFFSET.LOHALF; END; IF OPER.OD_SIZE=S_LONG THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.HIHALF; EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.LOHALF; END ELSE IFDISP]:=OPER.VALUE.OFFSET.LOHALF; {ABS 16 BIT ADDR.} DOLINKXTREF(OPER,CDISP*2-2,LINKPATCH, EXWORDADDR); END; 1:BEGIN {ABS 32 BIT ADDR.} CODE.INT[CDISP]:=OPER.VALUE.OFFSET.HIHALF; CODE.INT[CDISP+1]:=OPER.VALUE.O OPER.OD_SIZE=S_WORD THEN BEGIN EADISP:=EADISP+1; CODE.INT[EADISP]:=OPER.OD_VALUE.OFFSET.LOHALF; END; CODELENGTH:=CODELENGTH+(EADISP-CDISP)*2; END ELSE EAWORD1.DISP:=OPER.VALUE.OFFSET.BYTE4; DOLINKXTREF(OPER,CDISP*2-1,LINKPATCH,      VALUE.OFFSET.HIHALF; CODE.INT[CDISP+1]:=OPER.VALUE.OFFSET.LOHALF; CODELENGTH:=CODELENGTH+2; $if fpimmed$ end else if size = 8 then with oper.value.offset do begin code.int[cdisp] := fltptwd1; code.int[cdisp+1] := fltptwd2;  {DY,DX} CODE.TYPE2.REGX:=OPERAND2.REG; {-(AY),-(AX)} CODE.TYPE2.REGY:=OPERAND1.REG; CODE.TYPE3.SIZE:=SIZE DIV 2; CODE.TYPE2.B3:=OPERAND1.MODE = 4; END; 6: {ASL,ASR,LSL,LSR,ROL,ROR,ROXL,ROXR}{ASSUME MEM FORMAT IS SUPcode.int[cdisp+2] := fltptwd3; code.int[cdisp+3] := fltptwd4; codelength := codelength + 6; end else begin (* ??? error( errfpinternalerr ); *) $end$ END; DOLINKXTREF(OPER,CDISP*2-2+ORD(SIZE=1), LINKPATCH, EXWORDADDR) END; PLIED} BEGIN IF OPERAND1.MODE = 0 THEN BEGIN {DX,DY} CODE.TYPE2.REGX:=OPERAND1.REG; CODE.TYPE3.SIZE:=SIZE DIV 2; CODE.TYPE2.REGY:=OPERAND2.REG; CODE.TYPE2.B5:=TRUE; END ELSE IF NOT MEMALT(OPERAND1) THEN BEG 5,6,7: {CCR, SR, USP} BEGIN CODE.TYPE2.REGY:=4; CODELENGTH:=CODELENGTH-2; END; END; (* CASE CODE.TYPE2.REGY *) END; (* CASE = 7 *) $if mc68881$ 8: (* flt. pt. register FPn operand *) begin error( errfpregnotallIN {#,DY} CODE.TYPE2.REGX:=OPERAND1.VALUE.OFFSET.BYTE4 MOD 8; CODE.TYPE3.SIZE:=SIZE DIV 2; CODE.TYPE2.REGY:=OPERAND2.REG; CODE.TYPE2.B5:=FALSE; END ELSE BEGIN {} BUILDEA(OPERAND1,2,CODE.IDX[2]); END; owed ); end; 9: (* flt. pt. system register operand *) begin error( errfpsysregnotallowed ); end; $end$ END; (* CASE *) END; {BUILDEA} $include 'M68KFPCDG'$ BEGIN {CODEGEN} IF NOT CONTIGUOUS THEN NEWCODESEG; C END; 7: {Bcc (BRANCH ON CONDITION) ,BRA,BSR} {