The PowerPC 604 RISC Microprocessor - eisber.net

14 Pascal Implementation: Compiler and Assembler/Interpreter697 powers morkstp(oloot)698 arroyos begin morketp(aoltypo); rorkstp(inxtype) end;699 records' begin marketp(fotfld); earketp(recvar) end;700 files: markstp(filtypo)1701 tegfld, markstp(fetvar);102 variant' begin mnrkotp(nxtvar); marketp(oubvar) end .103 end (Cease.)704 end ("with*)705 end ( 0markstph);106707 procedure morkctp;708 begin709 if fp nil then710 with fp" do711 begin marketp(llink); markctp(rlink);712 markstp(idtype)713 end714 end (*mackctp*);715716 begin ("marker*)717 for i s• top downto lim do718 marketp(displaylil.fneme)719 end ("marker");720721 procedure followctp(fPs ctp); forward;722723 procedure followstp(fpi stp);724 begin725 it fp 0 nil then726 with fp" do727 if marked then728 begin marked false; write(output,' 's4,ord(fp):6,eire110);729 case form of130 scalars begin write(output,'scalar's10)1131 if scalkind w standard then732 write(output,'standard's10)733 sloe write(output, s declared'110,":4,ord(fconst)16);734 writeln(output)735 end;736 aubranges begin731 write(output,'subrangs'110,' 's4,ord(rangetype)s6);738 if rangetype realptr then739 write(output,min.ival,max.ival)740 else741 it (min.valp nil) and (max.valp nil) then742 write(output,' ',min.valp".rvals9,74) ",max.valr.rvals9);744 writeln(output); followetp(rangetype);745 end;746 pointers writein(output, g pointer's10,"14,ord(altypo)16);747 powers begin writeln(output, s eet'110,' 't4,ord(eleet)16)1740 followstp(eleet)749 end;750 arrays; begin751 writeIn(outpuWarray'110,"14,ord(ealtype)s6,"t4,752 ord(inxtype)t6);753 followstp(aeltype); followstp(inxtype)754 end;755 recorder begin756 writeln(output,'record's10,' '14,ord(fetfld)16,"14,757 ord(rocvor)t6); followctp(fstfld);758 followatp(recvar)759 end;760 files: begin write(output, s file'110, 9 's4,ord(filtype)16);Compiler Listing 15161 followetp(filtype)762 . end;763 tagfidt begin writeln(output,'tagfld's10,' 't4,ord(tagfieldp):6,764 "14,ord(fatvar):6);765 followstp(fetver)766 end;767 variants begin writeln(output,'varlant'110,' '14,ord(nxtvar):6,768 "s4,ord(eubver)16,varval.ival);169 followstp(nxtvar); followstp(subvar)170 end771 end (*case")772 end (*if marked")773 end (Afollowstph);114715 procedure followctp;176 var is integer;771 begin778 if fp 0 nil then779 with fp" do700 begin write(output,' 's4,ord(tp)s6,' ',name:9,' '14,ord(Ilink)16,781 ' 's4,ord(rlink),6,' '14,ord(idtypo)s6);782 case kiss. of703 types: write(output,'type'110)1184 konst: begin write(output,'conatent'110, 1 '14,ord(next)16),785 if idtype nil then186 if idtype • realptr then787 begin788 if valueo.valp 0 nil then789 write(output,' ',values.volp".rval:9)790 end791 else792 if idtype".form - arrays then ("stringconat')793 begin794 if vsluee.valp nil then79) begin write(output,' ');796 with values.valp" do797 for i I to elgth do798 write(output,svallii)799 end800 end801 else write(output,voluce.ival)802 end;803 yore: begin write(output i 'variable't10)i804 if vkind actual then write(output,'actual':10)805 else write(output,'formal'110);806 write(output,' '14,ord(next)16,vlev,' '14,vaddri6 );807 end;808 fields write(output,'field's10,' I t4,ord(next)16,":4,11daddr:6),809 proc,810 tunes begin811 if klase - proc then write(output,'procedure'110)012 else write(outpuWfunction'110);813 if pfdecklnd standard then814 write(output,'stendard':10, key110)815 else816 begin write(output i 'declared'110,' ':4,ord(next)16);811 write(output,pflev,' 1 14,pfneme:6)1818 if pfkind • actual then 1819 begin write(outpuWactual'110);820' if forwdecl then write(output,'forwsrd':10)821 else write(output,'notforward':10)1822 if extern then write(output,'excern'110)823 else write(output,'not extern':10).824 end