diff --git a/compiler/cutils.pas b/compiler/cutils.pas index c79c3a494d..4b5fd9f7e3 100644 --- a/compiler/cutils.pas +++ b/compiler/cutils.pas @@ -37,6 +37,8 @@ interface function min(a,b : longint) : longint; function max(a,b : longint) : longint; + function SwapLong(x : longint): longint; + function SwapWord(x : word): word; function align(i,a:longint):longint; function used_align(varalign,minalign,maxalign:longint):longint; function size_2_align(len : longint) : longint; @@ -136,6 +138,30 @@ uses end; + Function SwapLong(x : longint): longint; + var + y : word; + z : word; + Begin + y := (x shr 16) and $FFFF; + y := ((y shl 8) and $FFFF) or ((y shr 8) and $ff); + z := x and $FFFF; + z := ((z shl 8) and $FFFF) or ((z shr 8) and $ff); + SwapLong := (longint(z) shl 16) or longint(y); + End; + + + Function SwapWord(x : word): word; + var + z : byte; + Begin + z := (x shr 8) and $ff; + x := x and $ff; + x := (x shl 8); + SwapWord := x or z; + End; + + function align(i,a:longint):longint; { return value aligned boundary @@ -708,7 +734,10 @@ initialization end. { $Log$ - Revision 1.8 2001-07-01 20:16:15 peter + Revision 1.9 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.8 2001/07/01 20:16:15 peter * alignmentinfo record added * -Oa argument supports more alignment settings that can be specified per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN diff --git a/compiler/globtype.pas b/compiler/globtype.pas index a2696b9f83..c8097181f0 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -42,7 +42,7 @@ interface ts32real = single; ts64real = double; ts80real = extended; - ts64comp = comp; + ts64comp = extended; {$endif} {$ifdef alpha} bestreal = extended; @@ -208,7 +208,10 @@ implementation end. { $Log$ - Revision 1.13 2001-07-01 20:16:15 peter + Revision 1.14 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.13 2001/07/01 20:16:15 peter * alignmentinfo record added * -Oa argument supports more alignment settings that can be specified per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN diff --git a/compiler/i386/cgai386.pas b/compiler/i386/cgai386.pas index c3eeaca47a..2cead4230d 100644 --- a/compiler/i386/cgai386.pas +++ b/compiler/i386/cgai386.pas @@ -1431,17 +1431,19 @@ implementation LOC_REGISTER,LOC_CREGISTER: begin case orddef.typ of - u8bit: + u8bit,uchar,bool8bit: tai:=Taicpu.Op_reg_reg(A_MOVZX,S_BL,location.register,destreg); s8bit: tai:=Taicpu.Op_reg_reg(A_MOVSX,S_BL,location.register,destreg); - u16bit: + u16bit,uwidechar,bool16bit: tai:=Taicpu.Op_reg_reg(A_MOVZX,S_WL,location.register,destreg); s16bit: tai:=Taicpu.Op_reg_reg(A_MOVSX,S_WL,location.register,destreg); - u32bit,s32bit: + u32bit,bool32bit,s32bit: if location.register <> destreg then tai:=Taicpu.Op_reg_reg(A_MOV,S_L,location.register,destreg); + else + internalerror(330); end; if delloc then ungetregister(location.register); @@ -1455,18 +1457,20 @@ implementation begin r:=newreference(location.reference); case orddef.typ of - u8bit: + u8bit,uchar,bool8bit: tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,r,destreg); s8bit: tai:=Taicpu.Op_ref_reg(A_MOVSX,S_BL,r,destreg); - u16bit: + u16bit,uwidechar,bool16bit: tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,r,destreg); s16bit: tai:=Taicpu.Op_ref_reg(A_MOVSX,S_WL,r,destreg); - u32bit: + u32bit,bool32bit: tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg); s32bit: tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg); + else + internalerror(330); end; end; if delloc then @@ -2996,7 +3000,10 @@ implementation end. { $Log$ - Revision 1.25 2001-07-01 20:16:18 peter + Revision 1.26 2001-07-30 20:59:28 peter + * m68k updates from v10 merged + + Revision 1.25 2001/07/01 20:16:18 peter * alignmentinfo record added * -Oa argument supports more alignment settings that can be specified per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN diff --git a/compiler/i386/n386cnv.pas b/compiler/i386/n386cnv.pas index 48cfd93717..75e0c8e3c1 100644 --- a/compiler/i386/n386cnv.pas +++ b/compiler/i386/n386cnv.pas @@ -372,6 +372,7 @@ implementation new(hr); reset_reference(hr^); hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR'); + location.register:=getregister32; emit_ref_reg(A_LEA,S_L,hr,location.register); end else @@ -1423,7 +1424,10 @@ begin end. { $Log$ - Revision 1.17 2001-07-16 13:19:08 jonas + Revision 1.18 2001-07-30 20:59:29 peter + * m68k updates from v10 merged + + Revision 1.17 2001/07/16 13:19:08 jonas * fixed allocation of register before release in second_cstring_to_pchar Revision 1.16 2001/07/08 21:00:17 peter diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 6d0a9d01b2..0cca7cae88 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -190,12 +190,13 @@ implementation constsethi:=pos; if pos0 then + if (pconst32bitset(constset)^[l] and mask)<>0 then Message(parser_e_illegal_set_expr); - constset^[l]:=constset^[l] or mask; + pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask; end; var @@ -1044,8 +1045,20 @@ implementation function ttypeconvnode.first_int_to_real : tnode; begin first_int_to_real:=nil; - if registersfpu<1 then - registersfpu:=1; +{$ifdef m68k} + if (cs_fp_emulation in aktmoduleswitches) or + (tfloatdef(resulttype.def).typ=s32real) then + begin + if registers32<1 then + registers32:=1; + end + else + if registersfpu<1 then + registersfpu:=1; +{$else not m68k} + if registersfpu<1 then + registersfpu:=1; +{$endif not m68k} location.loc:=LOC_FPU; end; @@ -1415,7 +1428,10 @@ begin end. { $Log$ - Revision 1.29 2001-07-08 21:00:15 peter + Revision 1.30 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.29 2001/07/08 21:00:15 peter * various widestring updates, it works now mostly without charset mapping supported diff --git a/compiler/node.pas b/compiler/node.pas index dccff0c251..91b1b99f99 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -36,6 +36,8 @@ interface type pconstset = ^tconstset; tconstset = array[0..31] of byte; + pconst32bitset = ^tconst32bitset; + tconst32bitset = array[0..7] of longint; tnodetype = ( addn, {Represents the + operator.} @@ -795,7 +797,10 @@ implementation end. { $Log$ - Revision 1.17 2001-06-04 18:14:16 peter + Revision 1.18 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.17 2001/06/04 18:14:16 peter * store blocktype info in tnode Revision 1.16 2001/06/04 11:53:13 peter diff --git a/compiler/parser.pas b/compiler/parser.pas index f91a22ad16..ebf60fc3a5 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -98,7 +98,7 @@ implementation stacksize:=target_info.stacksize; { open assembler response } - AsmRes:=TAsmScript.Create(outputexedir+'ppas'); + GenerateAsmRes(outputexedir+'ppas'); { open deffile } DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext); @@ -617,7 +617,10 @@ implementation end. { $Log$ - Revision 1.20 2001-07-01 20:16:16 peter + Revision 1.21 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.20 2001/07/01 20:16:16 peter * alignmentinfo record added * -Oa argument supports more alignment settings that can be specified per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index e91986ac94..5ec44307b3 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -297,7 +297,7 @@ implementation {$ifdef m68k} if target_info.target<>target_m68k_PalmOS then begin - dataSegment.concat(Tai_symbol.Createdataname_global('HEAP_SIZE',0)); + dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4)); dataSegment.concat(Tai_const.Create_32bit(heapsize)); end; {$else m68k} @@ -1335,7 +1335,10 @@ implementation end. { $Log$ - Revision 1.37 2001-06-18 20:36:25 peter + Revision 1.38 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.37 2001/06/18 20:36:25 peter * -Ur switch (merged) * masm fixes (merged) * quoted filenames for go32v2 and win32 diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 0a468cd3d6..b32f67bc5f 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -247,11 +247,16 @@ begin {$endif} {$ifdef m68k} s32floattype.setdef(tfloatdef.create(s32real)); - s64floattype.setdef(tfloatdef.create(s32real)); if (cs_fp_emulation in aktmoduleswitches) then - s80floattype.setdef(tfloatdef.create(s32real))) + begin + s64floattype.setdef(tfloatdef.create(s32real)); + s80floattype.setdef(tfloatdef.create(s32real))) + end else - s80floattype.setdef(tfloatdef.create(s80real)); + begin + s64floattype.setdef(tfloatdef.create(s64real)); + s80floattype.setdef(tfloatdef.create(s80real)); + end; {$endif} { some other definitions } voidpointertype.setdef(tpointerdef.create(voidtype)); @@ -266,7 +271,10 @@ end; end. { $Log$ - Revision 1.17 2001-07-09 21:15:41 peter + Revision 1.18 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.17 2001/07/09 21:15:41 peter * Length made internal * Add array support for Length diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 608c64fd0d..374f414489 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -70,6 +70,7 @@ implementation curconstsegment : TAAsmoutput; ll : tasmlabel; s : string; + c : char; ca : pchar; tmpguid : tguid; aktpos : longint; @@ -370,15 +371,14 @@ implementation { untrue - because they are considered } { arrays of 32-bit values CEC } - { store as longint values in little-endian format } - if target_info.endian = endian_little then + if source_info.endian = target_info.endian then begin for l:= 0 to p.resulttype.def.size-1 do curconstsegment.concat(tai_const.create_8bit(tsetconstnode(p).value_set^[l])); end else begin - { store as longint values in big-endian format } + { store as longint values in swaped format } j:=0; for l:=0 to ((p.resulttype.def.size-1) div 4) do begin @@ -430,7 +430,10 @@ implementation end else if is_constcharnode(p) then begin - strval:=pchar(@tordconstnode(p).value); + { strval:=pchar(@tordconstnode(p).value); + THIS FAIL on BIG_ENDIAN MACHINES PM } + c:=chr(tordconstnode(p).value and $ff); + strval:=@c; strlength:=1 end else if is_constresourcestringnode(p) then @@ -560,7 +563,8 @@ implementation else if is_constcharnode(p) then begin - ca:=pchar(@tordconstnode(p).value); + c:=chr(tordconstnode(p).value and $ff); + ca:=@c; len:=1; end else @@ -885,7 +889,10 @@ implementation end. { $Log$ - Revision 1.27 2001-07-08 21:00:15 peter + Revision 1.28 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.27 2001/07/08 21:00:15 peter * various widestring updates, it works now mostly without charset mapping supported diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 7a02249eb9..12e3f04b96 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -1356,7 +1356,10 @@ implementation if t.is_conditional then handleconditional(t) else - t.proc{$ifdef FPCPROCVAR}(){$endif}; + begin + Message1(scan_d_handling_switch,'$'+hs); + t.proc{$ifdef FPCPROCVAR}(){$endif}; + end; end else begin @@ -2599,7 +2602,10 @@ exit_label: end. { $Log$ - Revision 1.20 2001-07-15 11:56:21 peter + Revision 1.21 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.20 2001/07/15 11:56:21 peter * merged fixed relative path fix Revision 1.19 2001/07/08 21:00:16 peter diff --git a/compiler/script.pas b/compiler/script.pas index 899193f8a3..6d56b982a3 100644 --- a/compiler/script.pas +++ b/compiler/script.pas @@ -44,10 +44,37 @@ type end; TAsmScript = class (TScript) - Constructor Create(Const ScriptName : String); - Procedure AddAsmCommand (Const Command, Options,FileName : String); - Procedure AddLinkCommand (Const Command, Options, FileName : String); - Procedure AddDeleteCommand (Const FileName : String); + Constructor Create(Const ScriptName : String); virtual; + Procedure AddAsmCommand (Const Command, Options,FileName : String);virtual;abstract; + Procedure AddLinkCommand (Const Command, Options, FileName : String);virtual;abstract; + Procedure AddDeleteCommand (Const FileName : String);virtual;abstract; + Procedure AddDeleteDirCommand (Const FileName : String);virtual;abstract; + end; + + TAsmScriptDos = class (TAsmScript) + Constructor Create (Const ScriptName : String); override; + Procedure AddAsmCommand (Const Command, Options,FileName : String);override; + Procedure AddLinkCommand (Const Command, Options, FileName : String);override; + Procedure AddDeleteCommand (Const FileName : String);override; + Procedure AddDeleteDirCommand (Const FileName : String);override; + Procedure WriteToDisk;override; + end; + + TAsmScriptAmiga = class (TAsmScript) + Constructor Create (Const ScriptName : String); override; + Procedure AddAsmCommand (Const Command, Options,FileName : String);override; + Procedure AddLinkCommand (Const Command, Options, FileName : String);override; + Procedure AddDeleteCommand (Const FileName : String);override; + Procedure AddDeleteDirCommand (Const FileName : String);override; + Procedure WriteToDisk;override; + end; + + TAsmScriptUnix = class (TAsmScript) + Constructor Create (Const ScriptName : String);override; + Procedure AddAsmCommand (Const Command, Options,FileName : String);override; + Procedure AddLinkCommand (Const Command, Options, FileName : String);override; + Procedure AddDeleteCommand (Const FileName : String);override; + Procedure AddDeleteDirCommand (Const FileName : String);override; Procedure WriteToDisk;override; end; @@ -59,6 +86,8 @@ type var AsmRes : TAsmScript; +Procedure GenerateAsmRes(const st : string); + implementation @@ -87,7 +116,7 @@ end; constructor TScript.CreateExec(const s:string); begin - fn:=FixFileName(s)+source_info.scriptext; + fn:=FixFileName(s)+target_info.scriptext; executable:=true; data:=TStringList.Create; end; @@ -143,14 +172,18 @@ begin end; -Procedure TAsmScript.AddAsmCommand (Const Command, Options,FileName : String); +{**************************************************************************** + Asm Response +****************************************************************************} + +Constructor TAsmScriptDos.Create (Const ScriptName : String); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptDos.AddAsmCommand (Const Command, Options,FileName : String); begin -{$ifdef Unix} - if FileName<>'' then - Add('echo Assembling '+FileName); - Add (Command+' '+Options); - Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi'); -{$else} if FileName<>'' then begin Add('SET THEFILE='+FileName); @@ -158,18 +191,11 @@ begin end; Add(command+' '+Options); Add('if errorlevel 1 goto asmend'); -{$endif} end; -Procedure TasmScript.AddLinkCommand (Const Command, Options, FileName : String); +Procedure TAsmScriptDos.AddLinkCommand (Const Command, Options, FileName : String); begin -{$ifdef Unix} - if FileName<>'' then - Add('echo Linking '+FileName); - Add (Command+' '+Options); - Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi'); -{$else} if FileName<>'' then begin Add('SET THEFILE='+FileName); @@ -177,29 +203,23 @@ begin end; Add (Command+' '+Options); Add('if errorlevel 1 goto linkend'); -{$endif} end; -Procedure TAsmScript.AddDeleteCommand (Const FileName : String); +Procedure TAsmScriptDos.AddDeleteCommand (Const FileName : String); begin -{$ifdef Unix} - Add('rm '+FileName); -{$else} - Add('Del '+FileName); -{$endif} + Add('Del '+FileName); end; -Procedure TAsmScript.WriteToDisk; +Procedure TAsmScriptDos.AddDeleteDirCommand (Const FileName : String); +begin + Add('Rmdir '+FileName); +end; + + +Procedure TAsmScriptDos.WriteToDisk; Begin -{$ifdef Unix} - AddStart('{ echo "An error occurred while linking $1"; exit 1; }'); - AddStart('DoExitLink ()'); - AddStart('{ echo "An error occurred while assembling $1"; exit 1; }'); - AddStart('DoExitAsm ()'); - AddStart('#!/bin/sh'); -{$else} AddStart('@echo off'); Add('goto end'); Add(':asmend'); @@ -208,10 +228,151 @@ Begin Add(':linkend'); Add('echo An error occured while linking %THEFILE%'); Add(':end'); -{$endif} inherited WriteToDisk; end; +{**************************************************************************** + Amiga Asm Response +****************************************************************************} + +Constructor TAsmScriptAmiga.Create (Const ScriptName : String); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptAmiga.AddAsmCommand (Const Command, Options,FileName : String); +begin + if FileName<>'' then + begin + Add('SET THEFILE '+FileName); + Add('echo Assembling $THEFILE'); + end; + Add(command+' '+Options); + Add('if error'); + Add('skip asmend'); + Add('endif'); +end; + + +Procedure TAsmScriptAmiga.AddLinkCommand (Const Command, Options, FileName : String); +begin + if FileName<>'' then + begin + Add('SET THEFILE '+FileName); + Add('echo Linking $THEFILE'); + end; + Add (Command+' '+Options); + Add('if error'); + Add('skip linkend'); + Add('endif'); +end; + + +Procedure TAsmScriptAmiga.AddDeleteCommand (Const FileName : String); +begin + Add('Delete '+FileName); +end; + + +Procedure TAsmScriptAmiga.AddDeleteDirCommand (Const FileName : String); +begin + Add('Delete '+FileName); +end; + + +Procedure TAsmScriptAmiga.WriteToDisk; +Begin + Add('skip end'); + Add('lab asmend'); + Add('echo An error occured while assembling $THEFILE'); + Add('skip end'); + Add('lab linkend'); + Add('echo An error occured while linking $THEFILE'); + Add('lab end'); + inherited WriteToDisk; +end; + + +{**************************************************************************** + Unix Asm Response +****************************************************************************} + +Constructor TAsmScriptUnix.Create (Const ScriptName : String); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptUnix.AddAsmCommand (Const Command, Options,FileName : String); +begin + if FileName<>'' then + Add('echo Assembling '+FileName); + Add (Command+' '+Options); + Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi'); +end; + + +Procedure TAsmScriptUnix.AddLinkCommand (Const Command, Options, FileName : String); +begin + if FileName<>'' then + Add('echo Linking '+FileName); + Add (Command+' '+Options); + Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi'); +end; + + +Procedure TAsmScriptUnix.AddDeleteCommand (Const FileName : String); +begin + Add('rm '+FileName); +end; + + +Procedure TAsmScriptUnix.AddDeleteDirCommand (Const FileName : String); +begin + Add('rmdir '+FileName); +end; + + +Procedure TAsmScriptUnix.WriteToDisk; +Begin + AddStart('{ echo "An error occurred while linking $1"; exit 1; }'); + AddStart('DoExitLink ()'); + AddStart('{ echo "An error occurred while assembling $1"; exit 1; }'); + AddStart('DoExitAsm ()'); + AddStart('#!/bin/sh'); + inherited WriteToDisk; +end; + + +Procedure GenerateAsmRes(const st : string); +begin +{$ifdef i386} + case target_info.target of + target_i386_linux, + target_i386_freebsd, + target_i386_sunos, + target_i386_beos : + AsmRes:=TAsmScriptUnix.Create(st); + else + AsmRes:=TAsmScriptDos.Create(st); + end; +{$else not i386} +{$ifdef m68k} + case target_info.target of + target_m68k_amiga : + AsmRes:=TAsmScriptAmiga.Create(st); + target_m68k_linux : + AsmRes:=TAsmScriptUnix.Create(st); + else + AsmRes:=TAsmScriptDos.Create(st); + end; +{$else not m68k} + AsmRes:=TAsmScriptUnix.Create(st); +{$endif not m68k} +{$endif not i386} +end; + {**************************************************************************** Link Response @@ -237,7 +398,10 @@ end; end. { $Log$ - Revision 1.10 2001-07-10 21:01:35 peter + Revision 1.11 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.10 2001/07/10 21:01:35 peter * fixed crash with writing of the linker script Revision 1.9 2001/04/18 22:01:58 peter diff --git a/compiler/symdef.pas b/compiler/symdef.pas index e0d8321e10..5eeabf65c6 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -684,7 +684,7 @@ interface pbestrealtype : ^ttype = @s80floattype; {$endif} {$ifdef m68k} - pbestrealtype : ^ttype = @s32floattype; + pbestrealtype : ^ttype = @s64floattype; {$endif} {$ifdef alpha} pbestrealtype : ^ttype = @s64floattype; @@ -1930,11 +1930,9 @@ implementation { found this solution in stabsread.c from GDB v4.16 } s64comp : stabstring := strpnew('r'+ tstoreddef(s32bittype.def).numberstring+';-'+tostr(savesize)+';0;'); -{$ifdef i386} { under dos at least you must give a size of twelve instead of 10 !! } { this is probably do to the fact that in gcc all is pushed in 4 bytes size } s80real : stabstring := strpnew('r'+tstoreddef(s32bittype.def).numberstring+';12;0;'); -{$endif i386} else internalerror(10005); end; @@ -5525,7 +5523,10 @@ Const local_symtable_index : longint = $8001; end. { $Log$ - Revision 1.37 2001-07-30 11:52:57 jonas + Revision 1.38 2001-07-30 20:59:27 peter + * m68k updates from v10 merged + + Revision 1.37 2001/07/30 11:52:57 jonas * fixed web bugs 1563/1564: procvars of object can't be regvars (merged) Revision 1.36 2001/07/01 20:16:16 peter diff --git a/compiler/tokens.pas b/compiler/tokens.pas index 5d2dc4ba27..057dce0a3b 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -460,19 +460,24 @@ procedure create_tokenidx; length, so a search only will be done in that small part } var t : ttoken; + i : longint; + c : char; begin fillchar(tokenidx^,sizeof(tokenidx^),0); for t:=low(ttoken) to high(ttoken) do begin if not arraytokeninfo[t].special then begin - if ord(tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first)=0 then - tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].first:=t; - tokenidx^[length(arraytokeninfo[t].str),arraytokeninfo[t].str[1]].last:=t; + i:=length(arraytokeninfo[t].str); + c:=arraytokeninfo[t].str[1]; + if ord(tokenidx^[i,c].first)=0 then + tokenidx^[i,c].first:=t; + tokenidx^[i,c].last:=t; end; end; end; + procedure inittokens; begin tokeninfo:=@arraytokeninfo; @@ -490,7 +495,10 @@ end; end. { $Log$ - Revision 1.11 2001-06-03 21:57:38 peter + Revision 1.12 2001-07-30 20:59:28 peter + * m68k updates from v10 merged + + Revision 1.11 2001/06/03 21:57:38 peter + hint directive parsing support Revision 1.10 2001/05/06 17:12:43 jonas