⟦0dcd4a9bc⟧

TextFileVerbose

job jaba 600 time 6 0
(
newpass2txt = edit p2rcpas
if ok.no
finis
end)

; corrections to p2rcpas
; 80.07.30 correct load in connection with finding a register to use
; 80.08.15 correct  outconstblock of set- and string-constants
; 80.09.18 let the stack size (survey.yes) be listed half words and not as
;          as ( half words - 2048 )
; 80.09.23 correct value initialization of record .. f:packed array .. end
; 80.09.24 correct for-statement in case of step-var in register 0 
; 80.11.05 correct inoperation  var in ( set1 + set2 )
; 80.11.13 correct loadaddress of ' var ^ [ index ]  '
; 80.11.17 correct standardprocedure ( new )
; 80.11.17 correct use of temporary sets
; 80.12.04 correct registerstore, call of reservecode before am
; 81.01.30 correct outconst block, if last instruction is 'am' then move
;          the instruction down after the constant block
; 81.01.30 correct read(ln) with more than one argument
; 81.02.11 correct searchregisters( double word variable ) where only
;          half of the variable still is in the registers
; 81.03.05 prevent double use of registers, e.g. if i + c[i] 
;          and  i  was found in a register
; 81.05.27 prevent temporary storing of nonsense after makeregister and
;          operation and load(real or string !! )







l./version = 'pascal pass2/, d, i/
version = 'pascal pass2 version   1981.05.27';
/


l./maxident/, r/3333/4333/,


; page 20
l./procedure returnpseudo(var ps:/,
l./if user = pseudo then user:=pseudo^.sameregister/,
r/user:=pseudo^.sameregister/
begin
user := pseudo^ . sameregister;
/, i/
if (kind = variable) and not locassociated then
kind := expression;
end
/,




; page 24
l./procedure routinedescriptorwords/,

; page 25
l./,maxstackoffset/, r/offset/offset + 2048 (* actual number of halfwords used *)/,



; page 35
l./procedure outconstblock;(*jump:boolean/, 
l./i,j,jumpindex/, r/ :/, remember_am :/,
;81 01 30
l./outconstlimit:=outconstlimit+1/, i/
with code ^ . c [ lastindex ] do
if opcode = am then
begin
remember_am := constval;
lastindex := lastindex - 1;
end
else
remember_am := 0;

/,
; page 36
; 80.08.30
l./setconst:begin/,
l./lastindex := lastindex-1;(*/, i/
s^.constindex := lastindex;
/, l1, l./s^.constindex:=lastindex;/, d,

; page 37
l./stringconst:begin/,
l./lastindex:= lastindex-1/, i/
s^.constindex := lastindex;
/, l1, l./s^.constindex:=lastindex/, d,


;page 38  81 01 30
l./code^.c[jumpindex].displacement:=(lastindex-/, l1, i/
if remember_am <> 0 then
begin
lastindex := lastindex + 1;
code ^ . c [ lastindex ] . constval := remember_am;
end;

/,




; page 65-70
l./procedure registerstore;(*reg/,
l./(*not simple address or packk <> unpack*)/,
l./reservecode(6);/, d,
l./makeindirectcode(am,0,0,oneword*((/, i/
reservecode(2);
/,
l./makeindexcode(ac,w,w,1);(*complement the mask*)/,
l1, i/
reservecode( 2 );
/,
l./makecode(lo,regnumber,oneword*w);/, l1, i/
reservecode( 2 );
/,





; page 86-88
l./procedure loadaddress;(*/,
l./indexcode(addr,pckptr,v,/,
l./if(postordinal<>0/, r/)or(/) or (code^.c[lastindex].opcode = am) (* assure generation of 'al' *) 
or (/,



; page 89  81.02.11
l./procedure searchregisters(ps:pseudoptr/,
l./if(user<>nil)or valid/, r/<>/=/, r/or/and/,

l./if ps^.typ^.size>oneword then/, l1, i/
if count = 0 then
(* if count <> 0 only half of the variable or constant is in the
registers, and the function result becomes false *)
/,
l./if(count=0)and/, r/(count = 0) and //,
l./found:=false;end;/, 
r/end;/end
else
found := false;/,




; page 95
l./procedure load(ps:pseudoptr);/,
l./use the oldest register, after/,
l./result:=count;end;end;/, i/
with register [ 0 ] do
(* check if register 0 might have been used, i.e.
see if register 0 contains a temporary result from
a surrounding expression *)
if ( result <> 0 ) and ( user <> nil ) and
( register [ result ] . user <> nil ) and ( lastused < oldused ) then
storetmp( register [ 0 ] . user );
/,



; page 101  81 03 05
l./*** operation **/,
l./if rsize>oneword then/, i/
with register [ regno ] do
begin
kind := variable;
locassociated := false;
end;
/,
l./w:=(regno+1)mod/, i/
begin
/,
l./mod noofreg/, r/noofreg/noofreg;
with register [ w ] do
begin
kind := variable;
locassociated := false;
end;
end/,





; page 114  80.09.24
l./procedure forstatement(skip,skip1/,
l./expression:begin/,
l./if w=0 then/, d./end;/,

; page 115
l./makeindexcode(al,w,w,increment);/,
i/
if w = 0 then 
begin
if increment = 1 then (* for .. to *)
makewrelcode( ba, w, 1 )   (* ba. w0 1 *)
else (* for ... downto *)
makewrelcode( bs, w, 1 ); (* bs. w0 1 *)
end (* if w = 0 .. *)
else
/,



; 80.11.17 correct standardprocedure ( new )
; page 132
l./ps_new:begin/,
l./if tagvalue=s2^.reclabvalue then found:=true/,
r/found:=true;/
begin
found := true;
node := s1^.varlst; (* pick up next varlist before 's1:=next' *)
end;/,


l./node:=node^.varlst/, d,



; page 133  , 81.01.30
l./ps_readln,ps_read:begin/,
l./elserepeat/, i/
begin
if param ^ . next <> nil then
(* more than one call of read, save the zone address *)
storetmp( filparam );
 
/,
l./if filparam^.kind<>reg/, r/if/if second or (/,
r/ then/ ) then/,
l./loadregister(1,filparam)/, d, i/
second := true;
/,
l./nil;end/, i/
end;
/,





; 80.11.05 
; page 139
l./procedure evaltoresult;(*/,
l./procedure inoperator;/,
; page 140
l./(*not correct if oneword<>2/,
l./variable:begin/, r/:/,
tmp: /,
l./end;/, l./tmp:begin/, d./end;/,



; 80.11.17
;page 142
l./procedure fastsetoperation(op:/,
l./(*reserve a work set*)/, d./else/,

l./(* let temp be the address of the result/, l1, i/

if (right ^ . kind <> tmp) and (left ^ . kind <> tmp) then
begin (* reserve a work set, but only if both left and right are non-temporary !!! *)
fstfreetmp := fstfreetmp + siz;
nooffreetmp := nooffreetmp - siz;
if nooffreetmp < 0 then
begin
error( 311 ); (* no more temporary room *)
temp := 0; (* avoid index error !!! *)
end;
end;

/,
l./(*reserve a work set/, d./else/,




; 80.09.23 
; page    176
l./procedure fieldbegin;/,
l./packedvalue:=field^./, l1, i/
(* 80.09.23 special action for arrays *)
with field^.vartypedescr^ do
if typkind = earray then
packedvalue := packedval; (* pack kind of the array elements !! *)
/,





;*****************************************************
;*************  main program *************************
l./begin(*pass2*)/,




f
«eof»
DataMuseum.dk

RC3500

⟦0dcd4a9bc⟧ TextFileVerbose

Derivation

TextFileVerbose
