PASCAL2.KSyyPASCAL2.KS -- LANCASTER NOVA PASCAL RELEASE 2.1 -- KEY SHEET THE DISTRIBUTION TAPE IS 9-TRACK, 800 BPI IN RDOS DUMP FORMAT. FORMAT: MT0:0 PASCAL RELEASE 2 PROGRAMS MT0:1 DUPLICATE OF MT0:0 MT0:2 PASCAL SOURCES (IF ORDERED) MT0:3 DUPLICATE OF lMT0:2 THIS IS AN EXAMPLE OF CLI COMMANDS FOR LOADING AND RUNNING THE LANCASTER PASCAL COMPILER OUT OF SUB-DIRECTORY 'PASCAL'. WARNING! OMIT THE COMMAND '@MAKESPACE.CM@' TO RETAIN ALL FILES. INIT ALGOL CDIR PASCAL DIR PASCAL LINK (ASM,MAC,XREF,LFE,EDIT,^zRLDR).SV/2 LINK MAC.PS/2 LINK RLDR.OL/2 LINK MATH.LB/2 LINK RFPI.RB/2 LINK SYS.LB/2 LINK LIBRARY.CM ALGOL:LIBRARY.CM LINK ALGOL0.LB ALGOL:ALGOL0.LB LINK ALGOL1.LB ALGOL:ALGOL1.LB LINK ALGOL2.LB ALGOL:ALGOL2.LB LINK ALGOL3.LB ALGOL:ALGOL3.LB LINK SMPYD.LB ATdLGOL:SMPYD.LB LINK NMPYD.LB ALGOL:NMPYD.LB INIT MT0 LOAD MT0:0 RELEASE MT0 @MAKENEWPASCAL.CM@ @MAKESPACE.CM@ PASCAL /Z DEMO.PS $LPT/L DEMO $TTO PASCAL2.KS -- LANCASTER NOVA PASCAL RELEASE 2.1 -- KEY SHEET PREREQUISITES: The following Data General CCorporation RDOS utilities are needed in order to create the NOVA PASCAL system: MATH.LB RFPI.RB RLDR.SV and RLDR.OL ASM.SV MAC.SV and MAC.PS and XREF.SV LIBRARY.CM ALGOL1.LB ALGOL2.LB ALGOL3.LB SMPYD.LB or NMPYD.LB or HMPYD.LB or EMPYD.LB Load'ing If the system was supplied on disc, then you should be able to use that disc to compile and run NOVA PASCAL programs without any changes. Loading from Disc If you need to move the NOVA PASCAL system to another disc using a different revisikon of RDOS the following procedures should be used: 1. Move the NOVA PASCAL system binaries by a command of the form: MOVE/A/V directory @P4BINARIES.CM@ 2. If you require hardware multiply/divide: DELETE/V R2SMPYD.RB LFE X library title REN"AME title.RB R2SMPYD.LB where library is one of NMPYD.LB HMPYD.LB EMPYD.LB and title is one of NMPYD HMPYD EMPYD as appropriate for the multiple/divide unit 3. Create a new systemqO PASCAL system by the command: @MAKENEWPASCAL.CM@ (over) Loading from Cassette If the system was supplied on cassettes then: 1. Load all cassettes supplied using commands of the form: LOAD/A/V CTn:1 where n is the cassette drive number. 2. If the PASCAL system is to have provision for a hardware multiply/divide unit, then issue the following command sequence: DELETE/V R2SMPYD.RB LFE X library title RENAME title.RB R2SMPYD.RB where library is one of NMPYD.LB L HMPYD.LB EMPYD.LB and title is one of NMPYD HMPYD EMPYD as appropriate for the multiple/divide unit. 3. Create the new NOVA PASCAL system using the command: @MAKENEWPASCAL.CM@ In either case the total time tak%fen to reload the system is about 20 minutes. During the initial creation of the NOVA PASCAL system the following messages will be produced: FILE DOES NOT EXIST: P4LIB.LB $BIND.RB DELETED: $BIND.RB FILE DOES NOT EXIST: P4LIB.LB $BIND.RB XDELETED: $BIND.RB FILE DOES NOT EXIST: PASCOVMAP.LD FILE DOES NOT EXIST: P4ASM.LD FILE DOES NOT EXIST: P4MAC.LD FILE DOES NOT EXIST: P4ERRSUM.LD FILE DOES NOT EXIST: PASCAL.LD FILE DOES NOT EXIST: PCODE.LD When the NOVA PASCAL system has been created to the required specifications, the following command may be issued to remove files which are no longer required: @MAKESPACE.CM@ Having issued this command, however, it is then not possible to reMAKE the system without reloading.  Ref: CSD AF024 R2SDBIN.RBYU.&GH|`z|b CCnCCD8$4Y2Q9!  -Y+Q2A*A*A D$$))')! #)#1D$$ ) I)RD$$r*1PPP+D Q8-09S _DEMO.PS '5[PROGRAM DEMO(OUTPUT); BEGIN WRITELN('HELLO'); END. PASCAL.RBYY %b                 &                      AFNF   * DĒ(ZL   H($: KZf@     TE98}h  ]   D'9vr   b "GED g   G' r  a bG$$   a# #D$$׮ #C#C'PD%$굼 C#GC#8+XG%8f  P8+KG$$Mb8#3B#C D$b   + D861    H%$<*>  D("G  &@  nH8 8#8C*8#8C Kb'', A   ,E$ȁ:1 %  1 %   H(%H&   1@  DȔ$V K 1|G"'$d@    1#D+$3r z   D$D    R E$$;)  #  D$'Ĝ    D$G  R GY +  D$81   G89ƛ    R D88 -   GĜgx    D%"  R /  Dď E  D$$^D     RD($ C 1   D''>A(   G"'$6    R 3 G''>D   X$P{R  " d8# XB%n `8C8X  " t8#X۔$`Dn 8C8X 5 " Plǒ(|8# 8C8X  " BEǢK8# 8C8X 6 "Db;Fg 8# 8C8X H*8!% " 8# 8C814XY$GZM [ 1@  5 DP" 8# 8C "G$8_  *   G'+~%  z  DPǫ~" 8# 8C "G$8  R -  9G'+=%  z 6 DP[~" =8# 8C "G$8$  *   G'+%2  z 7 DX@" a  R DĒN)  # XX$:\ z  "  DD(!j  R 3  D$$ڹx  z EB%읆% " 8# 8C DD("  *   &D$$  z EB%q " z8# 8C8G$$k+8K  R H$$43    G"'$   1 #DĒĕ   bE"'$1n  R 8 G''<l   X9$   1 # D$$ /  "K$$ϟ.n  1# K9$<Y  *  Y8DlJ e   K9$Xn d  *  X8$f   a  H$Eڕt a e:  "GGEۂ e=     Gb8#8X   K"G  1?  D$+rǬ1B ӊ#+  rD( uD r X9$a r r DD$w 5  HĒę 5  rY$$ح r  DD9r \r ? GĢ$\   1G Y($(3 1I #+ X9$k:* r uL r`P+Ǟ8h# 6hC 8#8XX8qFX ^  r"G$X T ro &G"'$Db r rHb9|p=` phC G GbǗ~   8#8X DD$f 1P # HD+s1R #  8bGb%$;#8X  r uEb%$3T r r uE89aW r  5G'"'  r DĒNr & rY$$ܬ r  DD8=r r 98#["+DE 8X  P  Hb8*R    8#["+%n&8X 6 1Y #dE$$ 4> 1[ # X9$njB r u] r &D$D,P r G"''8^r  5 D$$l r rX9$z r  r D$Df, r G;"+3r 8#8X  HbǤY  [   A"G%D 1_  1a D9(-#+C 1c #+DX9   r u] D$$ Ar & r H'"'Ar  5DℜXcv`h# hC D  r D$X r `  hC DZ" # 58# `G$pj0 - hC # DD%4I> r r3 `G$L I hC r E89 Z a r r c D$$@h r  r H';0v r 8#8X lE$,Ԅ    8#P[($Q% 8X  C   D%v  e  H'"'/B zj r DǬ6 r 8'C8X  Y8b'Oc  _     &DD8  h 8# 8CD' PKO `hC 8S8G$?v #8CCCCC8#8CCCCl[Ȓ(Y  8X    - @ # DȒ$A P   )*+,D9$ -. D & E$"' ,,  j   + H%(:  m +o *o )H(DH      #DȔ$PV _  # v P(Kd 8#8C  [ I 8#XȔ$Vr 8C  #  YD$   l #+ DD$[   #   H$"+ #   Dl%D #     )*D$G +,-. $  D(%0 & 8   , -E(d%  .q #   Ed%(  s    u Y((:     K    X%e* Ed%]  >7L%$ 24DLE,e( TX\`dh Ddd-6 lp  L,$2D   L,eOR  B E$,` & 06LE,$}n TV b p APCSLAM NOD$$| TIRO... : E TNREDE D$$2 REOR(R)SI N-POCEDA SSMELBRED$$2 .D EO SON TXESITOC.MMCD$$t OC.MMCVSSLCPDLCQ%D$$V, BRBLONS UOCR EIFELS EPICD$$a IFDEOC.MMCI NREORR4POCPMD$$ LIRES.V4POCPMLIREO.L4POCPMD$$: LIRE4PRESRMUS.V4PREORSRD$$A 4PRESRMU4PAM.CVS4PSA.MVSD$$ 4PAMC4PSAMAM.CVSSA.MVSD$$A LRRDS.V4PUC.EBR4PIL.BD$$ BLT$OTONAVP SAAC LERIVISD$$$ NO O N/ IFINHSDEW D$$2 TI HREORSRS CUECSSUFLLY@? $I]FH~P!OT ?U:YN $Itf!ot zAO _x 2N,D If  _R2RFT.RBU!9PSH+&K\vRD'$PEA8;) !4!D$$!4!!B!B D$$RUT!4!)D$S*!$!@! X3!DA ? ,) (  X)!$) DӒ$_?  0 !1)Q D$$א$!S1*J!@ `D$dwOCb.MMC |@9@7RkGN   *s DĒ(L   H($ IZf@     TE98h  ]   D'9Cvr   b "GED gb   G' r  a bG$$    a #D$$׮ #C#C'PD%$굼 C#GC#8+XG%8f  P8+KG$$Mb8#3B#C D$b   + D861    H%$n>*s  D("G^  &@  nH8 8#8C*8#8C Kb''', A   ,E$Ȓ:1b  1b  b H(%H  b 1@  DȔ$V Kb 1G'8 d@    "G$8r R   #G'h"   XĒȃ    R DĒ8   X$$9  LX  DD(  R  D$'D   D$$˯   1# bEĜP    D%#  R  DĈ #  D$$YD      RD($D   D'$q(  d " BEǢد6@8# 8C8X  "Db;gD P8# 8C8X H*8#R " `8# 8ӫC8XX$8'`  " p8# 8Cb[DPn8X  " 8# XȔ$ z|8C8X [b 1G$o@   " 8# 8G9$.oC  * s X88H    K$  "   H%$BR   # D   d " D$$  R H$$z7    D(*  " '8# G$$S8C  * H$$h7s  &  D(*$  " 8# G8"'U28C8+8K  RDG'@    D89TN     DD$$G\1# p  D+9իj   R D88jx   GĒC|     1Db%$ #   DY$w 1#DXLj   * DĞn  e  s DX%  * D{s   DDd%$a   a eE985   e   E8$ Rb  8#8X  bGX8gv   8#8XDȔDR  . 1 #6Y(b%@. 1 #  X$$<8#8X R r H$$5Ju r^ r H'"'9Xu r  5D$$Af  r D88tr & r"G$$ r  D'or r 8bGd%(0#8X   Y8'I  4 C  8bGd%$ #8X  1 DD$-# 1 # K"'DB r u r DĒ & r D$$nr  5 D$D- rr= G"'Dr r s r DĒ  r Dbd% 2*r 8#8X = EY8L8 B  e D$(F  1  1H"'%'dT #+C V1 #D+"'b+ d r uHĒp r & rY$$+~ r  5D0++`h# hCX89>  r DD+^r` hhCX90.5 # 58#DX$` hC # DȢ$r rDX$` hC r H'"'9 r r HĒ{ r  r&aY$b)  r 8#8X DĒ8Wl_  8#bG%'&P8X ^C  X9$u4  es Y$$+B z r D8;pPr 8'C8X "[G-^      DQl& 8# 8DD87zCK`hC 8SP$88#8CCCCC8#8CCClGE5C8X  g - @ #Dْ$ϊ   )*+@D"'D ,-. Df & HD$f  }  E$%f  + * )EE0j  f   #DYDL;    #D$D+   E#Dl$   # ` "[$$˰   )*+,-D(_" . f & f HD$T0 g ,l -l . DY(]D> # L  , f  S Y((cL  D f   M f j Yb;$~Z  f   De%Kh  Dd,v >7D,,s L%%   (8Dde@G BLRX`hE,,۠ jr| Ldd    CPDOD$$ EOMINOT.R.. : E TNRED$$ DE REOR(R)SI N-POCEDA SSD$$t MELBRE.D EO SON TXESITOCD$$ .MMCOC.MMCVSDLCPCQD$$Qq BRBLONS UOCR EIFELS EPD$$( ICIFDEOC.MMCI NREORR4PAMD$$ .CVS4PSA.MVS4PAMC4PSAMD$$j7, AM.CVSSA.MVSLRRDS.V4PD$$8E: UC.EBR4PIL.BBLT$OTONAVD$$2H P OCEDR VESIOI N O N/D$$^V IFINHSDE.TW TI HREORSRS D$d CUECSSUFLLY@j $IFH~P!OT[ ?U:YN $Itf!ot zAO:_x% DCInT ~ _MAKESPACE.CMj ܫDELETE PCODE.LD,PASCAL.LD,P4ASM.LD,P4MAC.LD,PASCOVMAP.LD,P4ERRSUM.LD,^ MAKENEWPASCAL.CM,MAKEP4LIB.CM,MAKEP4LIBN.CM,MAKEP4COMP.CM,^ MAKEP4ASM.CM,MAKEP4MAC.CM,MAKEP4ERRSUM.CM,MAKEPASCAL.CM,MAKEPCODE.CM,^ R2ROUTL.RB,R2IOUTL.RB,R2SCONSTS.RB,R2SECHKH.RB,R2SITAB.RB,^ R2SADMIN.RB,R2SINTEGER.RB,R2SBOOLEAN.RB,R2SSET.RB,^ R2STESTS.RB,R2SMISC.RB,R2SSPTAB.RB,R2SHEAP.RB,R2SOPN.RB,R2SIOIN.RB,^ R2SRD.RB,R2STI.RB,R2STP.RB,R2SREWR.RB,R2SRANDOM.RB,R2CRCODE.RB,^ R2IREAL.RB,R2RREAL.RB,R2IFNS.RB,R2RFNWS.RB,R2IFT.RB,R2RFT.RB,^ R2IFW.RB,R2RFW.RB,R2CSPTAB.RB,R2CITAB.RB,R2SDBIN.RB,R2SDECODER.RB,^ R2SDIV.RB,R2SMEMACC.RB,R2SMPD.RB,R2SMPY.RB,R2SMYP.RB,R2SOVL.RB,^ SWOP.RB,^ P4ASM.RB,P4MAC.RB,P4PASCAL.RB,P4BLOCK.RB,P4BODY.RB,P4INIT.RB,^ P4CODjEGEN.RB,P4DECLARE.RB,P4ENTERERR.RB,P4ERRSUM.RB,^ PASCAL.RB,PCODE.RB,^ P4BINARIES.CM,MAKESPACE.CM^ R2SOVL.RBY!9Sϕ@pynD$$j *"( Q! ?( !$ 1 ? D$,! )( 24POCPMDhLIREO.L _R2SIOIN.RBY!7"34b R#Tz@ClA_T[B8wD$$CP A !4!!.RB,^ R2SMYP.RB,R2SDIV.RB,R2SMPD.RB,R2SDBIN.RB,^ $BIND.RB,^ RFPI.RB;^ DELETE/V $BIND.RB^ COM.CM6XNSPEEDPASCAL2.KSR2SDIV.RBYU.tH@}6D$$r#Y!QIABpPKD$$/CY1C 9D$B!)@_c\ _P4DECLARE.RBY $6Yto$I It2 u q(0 Q-LP(O-!-%!2ll۳2Չ#!׉։!ى--D$$Wb,b (!e D$$a 'a(eDD$e9;9 eH($*099d#  D$$8 G%$"FaesD$$UIT D'$ b a a)X'$jpdw a^HDD$~'(!e a ^HDĒD>'a eE D%f9 e ad G$$Vlade ^D'$a ae D_K$$ D8'5 a e aD$$ EŒ8Ne ad a  D$$a   e  DD$e kad e DD$9 dl   D$}&^' a a E8$u4e< a  D$$?PB eT G$$lPadX a  aD$D^   el kaDD$Nl e eDD(ze,e ^G$(xade faX$D (!e aD($J ad  b4bD$$l ^@'(!E8$e@ a ^@'G%$Mae eD$$o D$'   a aX'$d a^(D'$!e a ^ @D$$u'a) PH!e$ G((_"aHee2 aE8$R0d6 a ^@'D$$>a ec  \D$$ La  HD$$ adB G$$@a   D$$;N ^D%$\ ' a  E$$Yje e ,e D%%%)xma d -e G$Da  d qaD$%S  PH!e aXDD4~HeD e adHDo a*e adHĒ( a( a D$% e DĒ(a +edH8$@ a D$%  edDD$eh a99eH$$D'99;9 4D%8[I d+ a D$$ .^%^' E$$<a ;9 D$$U9J 9DDDX'eb adf aE%fde ap*eH(Ģ tz ad~ a  E%$ca e e D%%%sa d ,e rG$$Ğa D%%ܬd0e aX($stPdP9GeD$8" a*e ad D$$Mae  aE8'd ya 'a D$$a D$$H (!eHĒ( a ad <D(( e' d, D$%}* bbe;9D$$8 !"eH%%FZeRdXD(DpT ad?!e{D$$ob  a  'D$$Up    aE8$*~d aK^ DD$m'(!e a K^ D8$xh'a PH!EĔ$Z#e aHe1 eDD$uT ad a bbD0D$e a K^D8('aeKD$$ Y    D8$< a "eH( ad a K^D$$, 'a aD$%#  eE aX$$ʃ&K^'(!eCD$$a4 a K^'aX'$]BdI ad bbDD$oPed a K^D8(^'aeD$$~lk    G$(za "e aE8$d a K^DD$Ã' a a /D((2eeD$$i/edH$(/d EĒ$e aK^'D$$2(!e a K^DŢ87<'ad add/D$$e/  ua\ +T PYD$$ -EDI \ /D$$} \ r\ ///eHD$^"  !e/ ^ \ D$(80 bbeb D$$m>     D$$KL   8 aX8'iZ  adf  aKD$$_h ^N''(!e  D$$v a K^ ''G$%„ a PH!e  aXDD]r He6 e  adHĒ$  a K^'D(%: ' ae ^D$(M e  ^ad eH((# ~e ^ d D$8 eC    a D$$ e2  6PPHD$$l H"e He DD% Pd HPd HD$(k e H d2 \ D$$L H  H D$$, HP   D$$Y:  d  ei D$$H  aK^'(!E8$cV eg  a K^DD$d 'adm  a(~DDDCr (!"e6 /e  uaD$$' \ +T PY-EDI D$$x \ /\ \ /D%(d //e !e ^ D$$ \ b*b D$D- ^'(!e  aD$$k  K'^'aD$' e H e  wa aX$(Ӛ ^(!e  aX$'xi  K^@'a^D%%; (ep en  ^D8( a aeG UrD$$k   D$$g( 8D'l6  a  . a  aX'$ D dK  aK^LD(R '(!eg  a K^D'%+M` L'a e dJ DD ҡn eE  ^a  aX($w| e D$$   8D$$F  aD'Ĕ   . a  a^D$$i K'(!e  a D$& K^L'a eH($f z e?  ae D$$)  ^aD$$@Z e ^(!e D$$k  xa e D$DЕ    d  DŒ8X 9  ad!  aKD$D$ ^D'(!e=  aD$8x2  K^D'adC  DDD<@ adJ eQ  aX$$عN dS  e D$$!eE a^(D$$CL\)#H "#eD$Z8 9  _R2SECHK.RBY!5L$II'i`iijQ>1@UA D$$ke*;1.RB,^ R2SMYP.RB,R2SDIV.RB,R2SMPD.RB,R2SDBIN.RB,^ $BIND.RB;^ DELETE/V $BIND.RB^ R2SREWR.RBU!82#s•H.Kll1N:ÞcCD8U8[BTxyZD8'9!4!PZ 8Z? 0 ?D$8 (  ?( !4!ҐZ 8ZD$$, 0 ?(  (  (  ?D8zp&*( 41  CDD YPl[ػ8H@0 0 0(D8$sFYQ! 0 ?,( )1! !b[$$ѤT 0)!  !1.I$bh@n@p@{ _R2SCONSTS.RBY!5tc3 4DH[Bܱ@{\@{ܱ\   hcF _R2STI.RBY!8ח󷕯t$IDR"MLMpKM JNl{NztVvRn@CvA_ `}ܱ:ÞܱC{z*D$$2I!I1PB)L!4D$Ą!!$!@!,! 2(292)D$$N) (y &1&Q@ F$$*'X(J 'H'`  D$$}81 'Hł' 1 Dm$&!F'0 B D$$CT D$$5b D$$'p n D$$~ DZ Hb 3y  _R2STESTS.RBYL s$I@=D7O \В$IH$S:Q'QXQ @ qD$$ @ 6  Ap D($Ͽ!D 1 !D8$pO*!!$!D0*)  !D$$8!L!$!!,@H$,D$$fF0%5?!$!!,D8$oUT 7!0 'P!$!','D$$b!  % ''$' !PD$$p!$!','! !PD$$~ !$!','!  :I!P!Ds!!0@b& _P4ERRSUM.RB\\d+T'EH'NE PXD$$.LCEET \^D\D($LZ \d+U'TNLI 'XEEPTCD$$Ch \+DE D$$bv \\d+D$$⇄D''OE PXCE6ET D \DD$V\d+T''O'/ODNWOT ' D$$ \+E PXCEET D D$%Z \\d+I'D$$['FE PXCEET D \\D$$d+F'LI'EE PXCEET D$$2v\^D \ \E$$9d+REOR RNIF CAOT RD$$> \\d+REOR RNIV D$$=RAAILB\^E\D($ \dq;@gdHE(Ň d.dQdtddddHE( ,dddd#Id7dKdHE(:_dsdddddAD$$HAAAAAAAD$$VAAAAAAAD$$dAAAAAAAD$$rAAAAAAdHE(qyd2dFd`ddHddHD$ngdd bb>d3 +UFCNITH,NOR SELUD$$@ T\+YTEPM SU TEBD$$_{S AC\+AL,RS BUARD$$0_GN ERO\+P IOTNRED$$L \\dH$$H,n +IFELV LAEUP RAMA\D$$*+TEREN TOA LLWODELD$$'8\\dn +OFWRRA DEDD$$xFLCRADE\+F NUTCOID$$jT;NR PETE\+TIOI ND$$AbFOR SELU T\+YTEPD$$pN TOA LLWODE\\D$$~dn +IMSSNI GERUSTLT D$$\+PY ENIF NUTCOI ND$$b\+EDLCRATAOI N D$( \\dn +-FOFD$$MRTAF ROR AE\+ LD$$0NOYL \\D$$dn +REOR RNIT PY EFOOHD$$\+S ATDNRA DUFCNITD$$7\+NOP RAMATERE D$%& \\dn +UND$$T[ BMREO FAPAREM\+D$$"ETSRD EO SON TGA\D$$ &+ER EIWHTD CEALAR\D$"$4+ITNO \D%$B\dn +LIELAG LAPARD$$PEMET\+ RUSSBITUTD$$^ITNO \\dn D$$zl+ERUSTLT PY EFOP \D$$:4z+RAMATEREF NUTCOI\D$$er҈+ NODSEN TOA RGEED$$Q\+W TI HEDLCRATAOID$$r\^N\ \dH$$ϲn +YTEPC NOLFCI TFO\D$$+O EPARDN S D$$Z\\dn +XERPSEISNOD$$xI  SON\+ TFOS TED$$RT PY E \\dH$$n +ETTS SNOE UQLATI\D$$@a + YLAOLEW DNOYL D$$+ \\dn +TSIRTCI CND$$w" ULISNO\+N TOA LLD$$0 WODE 0% \\dH$$K> n +IFELC MOAPIRISNO\D$$L +N TOA LLWODE D$$Z \\dn +LIELLGT PYD$$th EFOO \+EPARDNS(D$$2Av ) \\dH$$' n +YTEPO P[ FPORENA D\D$$s +UMTSB EOBLOAE ND$$ؠ \\dn +ES TLEMENED$$= TYTEP\+M SU TEBD$${ S ACAL R\+ROS BUD$$r ARGN E \\E$$g dn +ES TLEMEYFNE TYTEPD$$I \+ SON TOCPMTABIELD$$f \\dn +YTEPO FD$$]J AVIRBAEL\+I SOND$$ TRAAR Y \\E$$" dn +NIED XYTEPI SOND$$, \+ TOCPMTABIELW TID$$: \+ HEDLCRATAOI N D$D}H \\dn +YTEPO D$$8RV FAVIRBAEL\+I SD$$Xfd ON TEROCDR \\D$$4r dn +YTEPO FAVIRBAELD$$ \+M SU TEBF LIK/ EROD$$Î \+P OITNRE D$( \\dn +LIELD$$ AG LAPAREMET\+ RD$$v USSBITUTITNO \\D$$ dn +LIELAG LYTEPO FD$$0 \+OLPOC NORTLOV ~!RAD$$ \+AILB E D$%( \\dn +LID$$wV ELAG LYTEPO F\+D$$4 XERPSEISNO \DD$U \dn +YTEPC NOLFCI T D$(*C( \\dn xqWD(En6 xg: ddd@ddE(EJD dddIdldddE(E0CR d d? db d d d d E(Ep;` d dR du d d d d D$$=n bb̒qyd +D$$}=| SAISMGNE TFOF LI\DO%$$kM +SEN TOA LLWODE \D($յ \d+ALEB LYTEPI CND$$ MO\+APITLB EIWHTD$$mz S LE\+CEITGNE PXD$$u ERSSOI\^N\D($T \d+USRBNAEGB UODND$$anR S\+UMTSB ECSLAD$$- RA \\d+D$$ NIED XYTEPM SU T\D$$ % +ON TEBI TNGERE \D($0 \d+SAISNGEMTNT OD$$[$ TS\+NAADDRF NUTCD$$2 DOI N\+SIN TOA LLD$$@ WODE \\dD$$N +SAISNGEMTNT OOF\D$$\ +MRLAF NUTCOI NSI\D$$j +N TOA LLWODE D$$^x \\d+ONS CU HIFD$$^ LE DNI\+T IH SERD$$ OCDR \\dH$$Y +YTEPE RRROI NER\D$$qy +DA D$$ \\d+CAUTLAP RAD$$dg MATERE\+M SU TEBD$$ A V RAAI+:\+LB E D$$ \\E$$ d+OCTNOR LAVIRBAELD$$1 \+M SU TENTIEH REBD$$O \+F ROAM LON RON ND$$ \+OLAC L D$(S. \\d+UMTLD$${< DIFENIDEC SA\+ ED$$ɲJ ALEB L \\D$$X d+OT OAMYNC SASEI D$$f \+ NACESS ATETEMTND$(t \\d+IMSSD$$4 NI GOCRRSEOP\+DND$$+ NI GAVIRNA TED\+D$$׫ LCRATAOI N \DD$_N \d+ERLAO RTSIRGNT D$$\ \+GAIFLESDN TOA D$$ LL\+WODE D$$t \\^dqD(E _g d{ d d d E(E* d dN d d d d d9 E($d\ d d bb̠qDD$ud+RPVEOISUD CEALARD$$\+ITNOW SAN TOF D$$*RO\+AWDR k D$$I8 \\d+D$$5FGAIA NOFWRRA DED\D$$lT+LCRADE \D($>Zb\d+APAREMET RISEZD$$npM \+SU TEBC NOTSD$$7~NA T\\d+D$$IMSSNI GAVIRNA T\D$$+NID CEALARITNO \D($\d+USSBITUTITNOO D$$Y F\+TSNAADDRP ORD$$n/CUF\+CNN TOA LLD$$WODE \\dLJD$$+UMTLDIFENIDEL BA\D$$2+LE \D%$ \d+UMTLDICEALERD$$  DAL\+EB L D$$S \\dD$$&+NUEDLCRADEL BALE\D(tВ$_4\d+NUEDIFEN DALEBD$%B L\\d+RED$$!"POR RNIB SA EES\^D$D8 ^T\ \d+AVUL ED$$lAPAREMET R\+XEEPD$$zTCDE \\D$$d+TSNAADDRF LI EAWD$$&\+ SEREDLCRADE D$D \\d+NUEDLCD$$]RADEE TXRE\+AN LD$$aIFEL \\D$$Ld+OFTRAR NRPCODERUD$$;\+ EROF NUTCOI NXED$$\+EPTCDE D$(\\d+APCSD$$ LAP ORECUDER\+O D$$09 RUFCNITNOE PX\+D$$"CEET D \DD$Q60\d+IMSSNI GIFEL' ID$$m>\+PNTU 'NIP ORRGD$$sL A\+ MEHDANI G D$$GZ \\d+D$$3hIMSSNI GIFEL' O\D$$v+TUUP'TI NRPGO R\D$$+MAH AEHIDGN \D%$ڒ\d+LIELAG LATFGD$$MEIDL\+I NAVIRNAD$$+ T \\dD%(ļqvgddEdhdHE(!dddd&d:dNdHE(0hdddEdd5dgAD$$)d b b(̑eD%%C)e ad ao dD$$b> a bb̴qE$$d+REOR RNIR AE LOCD$$\+SNATTN :IDIG TXED$$,\+EPTCDE  D$DEr:\\d+TSIRGND$$AHC NOTSNA T\+UMTSD$$uVN TOE CXEE D\+OSD$$BdQr^gMddH$$P0 bb +UOPTTU D$$^ +4PREORSR D$$jlC GGeCD$$z C dt^D$$.ˆ  +REOR RUSMMRA Y D$$ ^  +****D$$R******** * D$D GGe;;HDD$nHe6 (eH$$ 1<^  D$$0YX^: ^  dH((r ad1 ad1 aEEEz>d1 ad1 ad1 aH((w`d1 akd1 ad1dH%(U1 6 gddddHE(Y"ddd ddddH((0!ddCDD> aR*@D _MAKEP4COMP.CMdU GDELETE PASCOVMAP.LD;^ RLDR R2IOUTL,R2SCONSTS,R2SECHK,R2SDECODER,^ R2CITAB,R2SMEMACC,R2SADMIN,R2SINTEGER,R2SBOOLEAN,^ R2SSET,R2STESTS,R2SMISC,R2CSPTAB,R2SHEAP,^ R2SOPN,R2SIOIN,R2SRD,R2STI,R2STP,R2IREAL,^ R2IFNS,R2IFT,R2IFW,R2SOVL,^ R2SMYP,R2SDIV,R2SMPD,R2SDbBIN,MATH.LB,^ P4PASCAL,P4BLOCK[P4INIT,^ P4DECLARE,P4BODY P4CODEGEN] P4COMPILER/S PASCOVMAP.LD/L^ R2ROUTL.RBU!4wtϔHF y Z1N:lܱ\D8U8c[BTx$ID AIAEG$'Y(:ZY(D88"  Y("ŏP8@D„$' !( H , ) ([$:p*H,1 (0P0"P$ 8 03( @F@JMcJ$4@m@)@@^D$$YN $@#H"H!H!$8#\ D$$a4z\Q! ?( 12P)TQ & D$fcj N1 PN1 *O!PPH!HA 0 Z$xgx0  ? X4!DA ? -) (  X*!%) DӒ$[?  0 "1)Q D$$;%!S1*J!@ L$lcIbx?OC.MMC ~D-ؾ@8@6@QnGN ]%+EGRTD$$ VLNAOD ]&+D$$ ZAPEG  ]'D$$h+OE R ]D$$O/vO(+ORNU D D$$])+AHTL D$$Ғ bbl--D$$9,,D$$R+D$$;6+D$$+ƚ* *D$$))D$$@..D$$( D$$"(+D$$p bb D$$4 +NIET,EG R  D$Ķ,-  aD$$: +ERLA  D$86H ,  aD$$V +HCRA D$'bd +  aD$$L[r +OBLOAE N D$$ a *  aD$D  eD$$Ϝ ] * D$$]Ǫ   G$$)+ad*D$$5 +IN L*{ D$$  )  D$$  a$%  D$$=e ]D$$   D$$<    aD$$5'd a]&D$$(   D$'AP6   aD$$D ]) D$$R    D8$` a ]D$$ln'  a D$$&|    aD$$׊ ]( D$$aŘ    D$$  a  D$$ e ]D$$9   4D$$;   aD$$%d ]#D$$     D$'y[   aD%$$d  e: ]D$$F   cOD$$̏$   D$$Un2ad   D$$ @en ]D$$N   D$$];\   aD$$jd> + D$.$x  , D$$xچ    D$%ʆ  e D$$Ң ] ,D$$    D$$,Ӿ    D$$3%   aDD$4%d bb 55D$$Y+ D$$ 44+D$$=  D$$3D$$ 83+ D$$. D$$<2D$$J2+ D$$X D$$f1 1+ D$$C7t 2 D$$p G$$EaD$$I]0 0+ D$$=  D$$@ D$$~aD$$) bb/"$D$$#' eD$$B^ dH$$s&%ޤT6D$$E  !^ D$$=7^ TD$$.*T b b>^WD$$8^O'^|D$$MF'^\^>D$$^T^#^^D$$Wb b bZ]GD$$np+FI J ]GD$$~+OD D$$R]G+FO  D$$vc]G+OT D$$hn ]G+NI D$$Uh ]G+RO D$$x ]G+D$$NE D ]GD$$+OF R ]GD$$2M +AV R D$$]G +ID V D$$E ]G +OM D D$$/ ]G +ES T L D$$Q& ]G +NA DD$$4  ]G+D$$BON T ]GD$$^P+HTNE ]GD$$\^+LEES D$$9l]G+IWHT #D$$Y;z]G+OGOT D$$b@ ]G+ACES D$$;2 ]G+YTEPD$$ ]G+D$$ IFEL ]GD$$+EBIG N ]GDO($$+NUIT L D$$]G+HWLI E D$$ ]G+RAAR Y D$$ ]G+OCSN T D$$G ]G+ALEBD$$j L ]G+D$$!N" EREPTA ]GD$$\0 +EROCDR ]GD$$b$> +ODNWOT D$$,L ]G+APKCDE D$$WZ ]G +ARDNMO D$$"h ]G!+OFWRRA DD$$R6v  ]G"+RPGOD$${6 AR M ]G#+D$$ UFCNITNO ]G$D$$r +XEETNRLA ]GD$$ %+RPCODERU D$$ڌ ]]D$$ ]d]D$$ ]]D$$b ]!]#D$$G ] & b b]D$$9  ]+]D$$ *],]D$$S E]]D$$, ']$]D$$": ] ]D$$ H ] ]D$$V ]]D$$d .](]D$$r %],&]D$$ !]]D$$ ]]D$$r )]#]D$$~ ]]D$$f ]"]D$$? ]B=-]D$$, ] 0]D$$/ !]"]D$$ #]$1]D$$ %] ^+.]D$$* ^-.] ^*.D$$$m ] ^/.]5: ^(.D$$ ( ] ^). ] ^D$$6 $./] ^=.]D$$D ^ ./] ^,. D$$nR ] ^..] ^'.D$$` /] ^[. ] ^D$$n ]. ] ^:.6I]D$$| ^^.] ^<.D$$J ] ^>.] ^;.D$$e   bb%D$$}3 e ]IdH$$G ]I]I D$$ ]I ]I"D$$U ]I 0?0.D%$jF .e ]n.DD$ d ]n^+.]D$$w n^-.]n^*.D$$pV ]n^/.]n^=.D$$L  ]n^<.]n^MFD$${8$ >.  b b]D$$2 +G TE ]D$${@ +P TU D$$ N ]+R ID D$$k\ ]+R RD D$$kj ]+R CD D$Ga$]x ]+W IRD$$3 ]+D$$' W OR ]D$$v +W RR ]D$$=~ +W CR D$$P ] +W SR D$$_ ] +O NP D$$uj ] +N WE D$$e\ ] +R TSD$$ ]+D$$- E NL ]D$$ +S NI ]D$$ʀ ;+C SO D$$. ]+E PX D$$ ^< ]+S TQ D$$`J ]+L GO D$$[X ]+A NTD$$Ef ]+D$$,t R NL ( ]D$$ +W NL ]D$$@ +S VA D$$v ]+C SL D$$j ]+W RD D$$\ ]+R RR D$$m ҩ]+P GAD$$Ύ ]+D$$,) E RO ]D$$8 +R ES ]D$$w+R RW D$$]+R DN  D$$ b b]R+A IBD$$Z* ]R+A D$$88RB ]R+D$$lAFA ID ]RD$$XT+A RD ]RD$$Xb+A DN ]RD$$p+D FI  ]D$$.a~R+D IV D$$]R+D RV D$$ ]R+E FO D$$.]R +F OL D$$. ]R +F TL D$$+ ]R +I NN_ D$$+ ]R +I TN D$$* ]R +I RO D$$* ]R+M DOD$$Y ]R+M D$$) IP ]R+D$$w4M RP ]R+D$$t&+N IG ]RD$$k4+N RG ]RD$$ B+N TO ]D$$HrPR+O DD D$$2^]R+S IB D$$l]R+S RB "D$$(2z]R+S SG D$$#( ]R+S IQ D$$ ( ]R+S RQ D$$$ ]R+S OT D$$& ]R+T CR D$$* ]R+U INDI'$$Y ]R+S D$$$PT ]R+D$$0C PS ]RD$$+D CE ]R D$$+E TN  ]RD$$!+F PJ ]D$$og"R"+I CN D$$a0]R#+I DN D$$S>]R$+I AX D$$S7L]R%+L OA D$$R5Z ]R&+L AC D$$54h ]R'+L OD D$$)v[ ]R(+M VO D$$% ]R)+M TS D$$2 ]R*+R TED$$!X ]R++S D$$&OR  ]R,+D$$8X PJ ]R-D$$+C LKH ]R.D$$+C PU ]RD$$ /+E UQ ]D$$oR0+G QE D$$s]R1+G TR D$$p]R2+L AD D$$3]R3+L CD D$$b2, ]R4+L QE D$$Q2: ]R5+L SE D$$Q(H ]R6+L DO D$$32V  ]R7+N QE D$$#d ]R8+S RTD$$?Wr ]R9+U D$$5-PJ ]R:+D$$/O DR ]R;D$$+C RH ]R<D$$+U CJ ]RD$$ =+C PX ]D$$gR>+H TL % D$$" bbF?eD$$i]0.d]D$$U^A.]^B.D$$I8]^C.]^D.D$$9 ]^E.]^D$$2F.]^G.0]D$$(^H.]^I.D$$*6]^J.]^K.D$$D]^L.]^D$$RM.]^N.]D$$`^O.]^P.D$$n]^Q.]^/hR.D$$|]^S.]^D$$·T.]^U.]D$$^V.]^W.D$$ ]^X.]^Y.D$$մ]^Z.]^D$$0.]^1.]D$$s^2.]^3.D$$hU]^4.]^5.D$$W]^6.]^D$$P7.]^8.]D$$:^9.]^+.D$$/g]^-.]^*.OSD$$$]^/.]^D$$2(.]^).]D$$@^$.]^=.D$$qN]^ .]^,.D$$\]^..]^D$$j'.]^[.]D$e$x^].]^:.D$$$]^^.]^;.D$$]^<.]^D$$C>.]l^0.]D$$l^1.]l^2.D$$O]l^3.]l^4.D$$]l^5.]l^D$$6.]l^7.]D$$l^8.]l^9. D$$ b bx]]D$$,h]]D$$6]]D$$6 1]]D$$f.]] D$$g<] ] D$$5J] ] D$$5X]]D$$=f]]D$$t] ]]D$$ug]]D$$qf]]D$$dg]]D$$O5]]D$$B]]]D$$sUG] ]!D$$f]"]#D$$g]$]%D$$]&]']D$$@(])]D$$f*]+],D$$e]-,].D$$f*]/]0D$$48]1]2D$$~]<]=D$$*X]>]MD$$]M]MD$$&]M]MD$$>]MD$$s]M]MBD$$]M ]M D$$%]M ]MD$$ ]M D$${]M]MD$${ ]M]MD$$z{]M]M9D$$gs&]M]MD$$UI4]M]MD$$E&B]M]MD$$=P]M]D$$ ^M]MD$$Il]M]M%D$$]z]M b bD%DP ah a a a ED$a* a a bb| ED$껤a a- a89;D$$|Ʋ  ED(?a a a a9DF$$(8; D  _R2SADMIN.RBY!6$8$I$I@TwlA[VlNJDQF;$ 5D$$xx!8S" C% C!!X !8D$$})"X CP 2" 9D$$$") bҕ  D$$)*"  !!L! G%@$(#D$$8 ) "0!H!"@"%@""@ D$$F!!,! P !,! D$T !,!P) HIn8I+ _R2SSPTAB.RBU!75T@n8D$$erD$$WrD?;$I$I$ISpHKU xFO#x$I$I$Iyz[ UVxx7x _ A _A @:nx _R2CRCODE.RBU!8…@RڸA^Fe v D$$SX &X ' &8+3B&XDD$WW &8+3 'P&& &AIQD$!)1@C+ _R2SITAB.RBU!5핯bm{{@<@{{ <$ $$W2$$I2$HH*12356HHH2&8789:;<=>?7%ȐHFHIJLMNPQRH0$vTTUVXY$b@ikmHHNpotvwxyz{|l~}~HHHYxA4G/G.aG-aH,0f&*BnKAl7+1`Ф Ф_HHH"22_vF1Fx(p_'&äP%#PF"Y!DD_##_HHHQQ_LA}$_FF_P)isiraiqjpHHHlAADfngeldGFDE7DOCB7_c bHHua5 BjAh&~ GZF[_A^&} }]7\$}W&S^`}O FK _P4BODY.RBY`EN$I$I$I# P ։ - ։  ։ ։`M Չ2Չ .bՉ --Չ#Չ@fӉ #,Ӊ@#Ӊ`#lllێ-Ċ-#222Ċllwʊ!Ȋ#Ŋ#׉Ŋ!( D$Db&b(!e :aD8$  'a(eE$8vod ^t a aD(8* eG  aD$DC8eEeE"dH%$Fo eZ D(8|Tdo  aE$DbeoeodH$8p - ad ,D$(~ ad E($|Pe+d +!D$$PD$(  ad  aD$D~ ^@'af eH(# ad ad  aXD'u a a a D$'^e*e aJEĒ$Bd  a^ D$$;D%$  e aE$%)d ^'afD$$&ee7 aD$(6E4d aeE$S@(Be[?#eT ^0G$(xPadY $' dz aD$^ -a!ek :a D(żla ex a dz D$'zd a D$8PH!e aHeH(( 3 e ad aX$$ e ^e D$$   HPAeHŒ$; adHPPP\D$$,HP  3HPa D%$za d   D%(t t d  $gddHE$qd}ddAAAdHD(mAd(!e aX'${ 'ad b bD$D~" ^'aeH$''0+ a  a D$8[>^ 'a a D($L"e'd --D$DBZ"ed a d -eHĔ$yhq a , d|-e|D$$_v a , ,,"eHŒ$ a d  GD(Gaa"eB a d aXDDd%-e a D%8 , -e a , D$'ȼ,,"e a dD$$y ad% --D'$"e a d aD$%d% -I-"e G$%'a d ad% *D%8ou*"e a d D%(ad%%gdUdHE$dddd)d, D$$,b"b<^DD':("eF a D$(6H^'aer aDD(V-ea a dr,E8'^>del a dr aDD$ree a  G$%܀a ^'a aX$D_ "ea_<dR D$'=Ŝ--"e a dDD$3 -e a , dD$$-e a , ,DD(y,"e a d D8$' a"e a dHĒ$\0 ad_ -^-D$D{"e a d9 -eHĔ$r a , d-eD$$  a , ,,"eHŒ$<! a d9  GD(\(a"e3 a d9 aXD$4b6d_ **"eJ D(ĶD a dP ad_D%(Rqr&gYddd;dHD$P!`cdr b$b ^D((n'a,eE$8|ee ad G$%a e D1(8F-a!e :a aD$$, a,eeH($ɴ ad a D$$"eeeH'$n ae a dH$:3 ad aD$$_% d e  -e D%%8 a , d -e  G$(a , ae D$$y d ,e$^Rd;DDDGX$ *e.^Bd; +eH((y28^Cd;^Id^D(@>(eJ a^AdH$D>N^(e\ aDD$\^Sd a!^D(j("et a^MdH$D >x^(e aDD$>^Md a^FdD(EDݔV'gdAd=dOdaE%$L]dydd 5.aE$(ذd 4.ad 1D($9.ad 0.adH$D 7.ad /.DD%[\adq 'gdE(E dddddd G$$va* bb@ KD$$Tf^@'aeDD$mue$#eH$ $ a a KaH(%.feBe? aX8$<dB a"eH8%!9J ,a-"e\ G$(Xa , aedH$'>f'en a adD$8t'e -^)a aX'$Kd ad (aX'$aI d ady(gdHE(YgdgdtdddddHŒ8; ad 3a bD%$>!b e(9; DDDed ; D((^ e  d; D$D,K!"eG D$(e  e 9 DDŭ.a d  ^ad D$$>d   #eD',!e# a ad, G$$1*a b bF K^D$Dxh8'aP (!e1 &7PD($FH!eO aHe1D'$ T'e] ada a D$$Yibbbx K^'aHĔ$+pf a  a.eDD$q~ ad 4a K^D((k'aP (e aX8  9a  a a D$D KaP  ad aD$$9 b(bX K^ 'E%%af aeD$'(g,#e aE'D9d -a!e :aWMXĒĥ a  9a *eH( ad a  G$$0 a  a ^D$$i{(!e K^'D$$̳& ae{ aeH$D4w eY D$.  D$$1   e D$Dа^e:  -D$$-a 3a a  D$'H a  ,a  a D(Đ e#  <a dH'$"   9a   D$D 0 e  ad>  aDDD> 'eH  adL  aD$$ L bb~ a  a D$D^Z K^@'aP (eHĒ(lh m  a(!eY  EĒ$cv e  a K^@'E%8ͤ aP (e  a(DDDy !e{ ds )e  a D$Dީ Kaf ad  5aD$$ bb\ a  a D$Dɼ K^'af a D$':  a+e  ad D$$nE  6a KaP  9a D$$6  a b"b D$%+ 8 eD  ^D$$ \ aH D$$  e"  D$$I d(  aeH$Q, ?  ,a#e?  D$D@3: a adS  aD$8*H  K^@'aEĒ$V e  a K^'E%$d afe ew  DDfr ad  ae  aXŢ8>!  ad  ad  D$$ 3a K^5 'aD$$" ^ (e7   aD$(At  K^'afE$'C e5 e  ad5 DŒĝF  ae1  a -aX$$ !e  :a - aD'8%  8 -a a  /EaX''7  a -a!eH8$   :a 6 -a D$$Z  HXe PX ,D$8zg e'  4^I.ad/  D'$8S( 0^I.ad5  adHĒ$l6 F  7a K^'&G88D a a  !a +EŒ8R eY  ad]  6a KE$$` aP  a ,eu  D$jn "ad{  a D$'A| a 9 a  a D$$&- bb e DH$'G  ^0a ad D$$.ʦ  a3 K^D$$ 'ae% eH($~ ! 9e 99;9D$$  eH$$ ;9   DD$[ d  a ) a D8$* 8 )a;9 D$$H    HXe DD(ӭ PXd  ad%  aX$( $  PH!e2  aD$'!2 He +e@  adD D$$@ 'I 6a KaP 99D$(N bbe ;9 D%$7\  e eHD$j es  a aD($,x d d d^  D8( a ae  aE8$o d g a^'D$' (!e  a aD$%p ^'(e d  ^D'\ < a a E'$ e  ad adH%'>$ m  a a-dm  a aH8(3 dm  a abdm  aDD( adm  a a dm  GEu a aM dm  a a dH%$  m  a a dm &,g dH$${ AAAAAAAD$$). AAAAAAAD$$< AAAHGAAAAD$$ J AAAAAAAD%(X AAd d d d dHE$f d d d ^(D'8t !e  a a bD$$ bH e H Rd D%$  Ra #e \H e D$$_ +. NE T ? \D$$Zb H \\d +D$$= . NE T L \D$$ R\^;\ H D$% e H \d +AMD$$E NI 5 \\D$$ \H e^?\D$$ H \^:\ D$$\PP U T RG8t)a Qa  Va QG$$q*a VaH eD$D 8 WH YH eN \M?aX$$F HaYeYD%$mT[[e[e[D$(b ["e 2D$8z`p[ a 6W)aHD$$\~P ([a WWdD($[ eW[WH&D$'S[P )\a )DD$`WadWWHP D8'e[\a [WaYDD$YdNdE 6PHD$$Ke>H[[ ^ D$D a e7 JD$$e7\ ^ \ +NUD$$EDLCRADE \ +D$$q XEETNRLA \ D$$+IFEL \ D$$6&\ \ ^ D$D{4\ HPd  D$t$B6a Ha X ^D(%P'aP (!eL D$8:^PH!ei aHeH((DlL'ew ad{ aX$(Țz;9 ZZeZ[[D$$i݈!e a\ +L BAD$$V±LE \ [D$$= \ \ ^ \ DD@[Zd Ha H E$$'eH e *^P.G$8ߋa d *H ad D$(X6a *^P.a  .XaX$$Yj#e,^L\ ^ \D$$g Q\^=\ XD$$ \\^L\ ^D$$j \ V\^=\D$$b$" T \\H #"E$$0eS^L\ ^ \ D$$>Hm\^=\ HD$$L \\H e#E$$Zen+CPDO:E D$$ h\\ )a D v.Ra a  _R2IFNS.RBY!:]S$IHSF # x UVxD(E  @pH  _R2SHEAP.RBY!7s[IxQOD$$J!$!$$\$(!4!PD$$(J%  ) !,!$H $(!4D 5!PJ  _R2IFW.RBY!:l`=4TPb|D6@pH _SWOP.RB ~gÁHڅtf gKvX$$! # D;$?֐8S  3 D _P4ASM.RBY 2S   @G) D$$b bv+SR T D$$" D$$mT+CC P D$$* ^<"5D$$8+NA DD$$)F ^D$$BT"+D$$bRW I D$$p D$$t~+ID F  .D$$t^% D$$xh+HC R D$$c^0D$$r+NIID D$$1^XD$$͖F+RSSO aLD$$ ^TD$$d+ELAQ D$$y ^D$$t +CL A D$$d ^+D$$w&+OED$Qv$4 F D$$B^)D$$pP+DL A D$$q^^\D$$ml+TA N D$$TzD$$l+DL C D$$^^D$$Q`+JF P D$$-Ѳ^eD$$+EDCC D$$R ^nD$$"R<n+DA R D$$$ ^D$$z +LF OD$$N  ^D$$H !+D$$˵"LE N !D$$0q!"D$$a>+AL O "D$$AL^]"F#D$$hZ+SC P  D$$h#^c#D$$Tvv$+EDIC D$$I$;^l$D$$ n%+NE T D$$ %^b%D$$#&+VD I D$$g &^D$$&'+UC P D$$ 0'^aD$$h'2(+NJD$$8 C (D$$^4()D$$h+DO D )D$$^)*D$$c,+AP G ? D$$n:**D$$_H++LF T D$$k5V+^+D$$|$d b b-+LH T D$$ r -^D$$-.R+HCD$$wAK .D$$^ ./D$$4q+NI N /D$$0^(/D$$/b0+GN I D$$=0^0<D$$e1+HCBK D$$1^q1D$$S2+HCCK D$$rN  2^p2D$$O3+XC P D$$Y( 3^u'D$$6324+DR CD$$D 4 D$$R45+OID$$ ` R 5D$$D n^#56D$$Xp|+XI A 6D_)$$ъ^_6n7D$$sh+OM D D$$7^7D$$l8+HCIK D$$8^q8D$$9+GN R D$$4 9^9D$$H:+BS I D$$l :^D$$$:;+NI T D$$C ;^&D$$=$;<+EDD$$2bAC <D$$@^l<n=D$$[N+PJ T =D$$\^}=>D$$bj+PM I D$$5 x>^>D$$Gj?+PJ F D$$̔?^~?D$$@+TSCR D$$Ѡ @^P@D$$#A+HCRK D$$  A^pD$$mAB+HCSK D$$j B^pD$$ BC+BSD$$  R CD$$^CED$$O +AS V ED$$I.E:GD$$f<+PM R GD$$J^GD$$|SXI+OM V D$$fI^`IxD$$ZVtJ+DR I D$$ȂJ JD$$RK+ON T D$$Ξ K^!KD$$nL+JU C D$$8 L^AD$$LM+IS N D$$c MQD$$M b bND$$!Q+GS S D$$N^$ND$$WO+SM T D$$[<O^ OD$$`*<P+EGAQ |$ D$$$8 P^PD$$FQ+EGBQ D$$uT Q^D$$bQR+EGCQ D$$p R^D$$~RS+MJ/D$$u  P SD$$^2STD$$`+SR E TD$$TUD$$_+JT P UD$$Z^fU`JD$$aV+OL G D$$lVVD$$NW+DW R D$$C WWD$$~WX+EGIQ D$$B+&X^XD$g$4Y+JU P D$$UB Y^dYD$$(OPZ+DLCC D$$^ Z^^D$$lZ[+VO LD$$|z [D$$k[\+EGD$$5 MQ \D$$$^\ ]D$$V+SR N ]D$$^1]^D$$:^+RT C D$$^1^^D$$g_+DLBC D$$__^^_D$$ `+DLIC D$$- `^^`D$$" a+QS R D$$1Z0 a^D$$v> ab+EGSQ D$$L b^D$$Z bc+QSD$$h T cD$$|v cd+D$$ RW C ^  dD$$  deD$$M +JX P eD$$ Į ^gefD$$)R +TSAO D$$ f^fD$$] g+EGRQB D$$_A g^gD$$ h+NIAC D$$/ h^hhD$$S ni+DLRC D$$; i^^D$$, ij{+NICC D$$: j^jD$$>H jnk+TSD$$V P kD$$Zd ^*k b bD$$ydr l+NICD D$$Ԁ l^X=lD$$Ž Po+WR R D$$JK ooD$$ p+NIIC D$$ p^hD$$t pnq+DLBO D$$O  q^=,LD$$ qFr+DLD$$ CO rD$$ ^LrFsD$$J +RW R sD$$   stD$$mV( +RW S t$D$$6 tvD$$WD +DLAO D$$R v^LvFD$$Q` w+TSRO D$$:n w^ wD$$| x+DLIO D`($$ x^LxD$$ Fy+QEBU D$$r y^D$$Ԃ yz+QECU D$$W z^D$$  z{+NID$$F RD {D$$ ^X{Z|D$$S +ELAS |D$$" ^|}D$$R +ELBS D$$$ }^}D$$:Y2 ~+QEAU D$$@@ ~^~D$$HN +ELBQ D$$\ ^D$$X j ݀+ELIQ D$$mx ݀^D$$ `݁+DLRO D$$̔ ݁^LD$$ ݁Z݂+DLD$$ SO ݂D$$׾ ^L݂d݃D$$L +LW N ݃D$$1 ݄݃D$$qd +QEMU ݄D$$ ^݄ D$$q` +DLNC D$$) ݅^^݅D$$

ݥݥD$$Lݨ+OLCD D$$WZ ݨ^HݨD$$$hݩ+ENBQ D$$lv ݩ^D$$|ݪ+RGAT D$$S ݪ^D$$ݪݫ+ROD$$ BD ݫD$$ ^/ݫݬD$$wZ+ROCD ݬD$$^.ݬE-ݮD$$M+ELSS D$$ ^ݮD$$DHݯ+ERBT D$$0ݯ^ ݯD$$?ݰ+NIAD D$$u, ݰ^XݰD$$:Fݲ+ROID D$$BH ݲ^,D$$pVݴ+ERAT D$${d ݴ^ D$$]Rrݴ b bD$$D+ERIT ? D$$2ݶ^ ݶD$$Oݸ+MC S D$$ݸ^3ݸD$$ĸݹ+EG T D$$C ݹݹD$$ ݼ+OC S ^ D$$Y ݼݼD$$.ݽ+ERPT D$$  ݽ^ D$$ ݽݿ+ERRTD$$ ݿ^D$$tD( ݿ+!D$$6ELCQ D$$XD^D$$kR+NISD D$$`^XdD$$Rn+OE R D$$|D]%$$M+ELCS D$$4^D$$+ROAD D$$ ^-D$$ +VD R D$$%M ^ D$$v+ELMS D$$  ^D$$7 +ELD$$KRQ D$$f^D$$E$+ERCT D$$B2*e^ D$$U@+XE P D$$ND$$K\+ELMQ D$$6j^ D$$>x+EN W D$$ۺ.D$$+ELSQ D$$ۢ ^D$$+LC S D$$0  D$$0+RSAO D$$ ^TD$$F+RSBOD$$ ^D$$TF+D$$RSCO D$$ ^TFD$$`.+NR D 8 D$$<D$$GJ+RSIO D$$X^TFD$$Mf+PO N D$$tD$$y@+TSCOG D$$^ D$$+LR N D$$X@ D$$+TSAR D$$  ^PD$$m+TSBR D$$ ^PD$$P b bxD$$D+TSIO D$$)3^D$$?+RSRO D$$ *^TED$$8Z+BA I D$$F ^D$$AGT+DA I D$$\b ^D$$Qp+NU ID$$~ ^+D$$&'+D$$QTSBO D$$ ^D$$$S+TSSO D$$Y^ D$$]S+BA R bED$$A^D$$;+TSIR D$$%^PD$$+ +RR R D$$> D$$&+TSRR D$2ܒ$4 ^PD$$) B^+TSSRD$$$P ^D$$a^^P^( b DD( lb a af a ao D($y z a a{ a b bD$$t}^+ \\]\ DD$\e]\ +T.TX' D$$tNIUP'T \\D$$^" \\^ D$$b\\^" \\D$$I^^ \\^ D$$8\K\^ \\D$$H^" \\^!D$$  \\^ \\D$$s^+ \\+T.TXD$$' UOPTTU ' \\D$$%"^" \\^D$$P0 \@\^" \D$$%>\^^ \\^D$$kL \\^ \D$$rZ\^+ \\+T.D$$whTX' RP'D \\D$$v^" \\^D$$# \\^" \D$$’\^^ \\^D$$s[ \\^ \D$$Ю\^" \\^D$$`,! \\^ \D$$N(\^+ \\+D$$T.TX' RP'R M \D$$I\^" \\^D$$U \\^" \D$$ \^^ \\D$$p^ \\^ \D$$\\ b btLD$$,&T&+******W**** D$$Y: \ +I SNRT .ON . D$$H \ L%\ +D$$]V' \ D$$d\\ + 'AH SON TEYD$$kr TEB\ +NEC TAREDED$$3F RO \ \ /"\D$$ b bPL&TD$$=&P+NITS.RN .O= D$$ \ L%\ + D$$A \ \D$$'4\ ]\ L\D%$ɼ \e]\ \@ D$$](+** \D$$O \\ +* *LIELD$$AG LOCED\ \  D$$ bb$\.D$$\.\D$$(.\.(D$$6eE\.D$$ϨD^L$D$$dRT$L#T#\+ D$(` ep aED$Mnde \ E$$|e P d DR,$$+ e ED$ae^D$$jƦ^L#DD$UT#dp bbZ^D%$"!e \\D$(c) \\d^D$$1![ \\]\D$$թ bbf^"D$$!e \\D$$ \\d ^D$$Z \\]\D$$$ bbl^"D%$&02Z"!eM \D$$o@\\\dZ^D$$nN \\]D$$Ax\\ bbx^D$$BNj""!e D$$x \\ \\D$$[d^  \D$$Ô\]\ bbDD$e^"eH$$R^ \\E$%;d^"eD$Dq \\d^D$$% \\ \\D$(#" \\d E$$Ge \\d D$$ \\L% \D$$¾\ bb4\H D$$ ^ \H ^D$(.,#H H "eAH DD$ӗ<P d\H .KDD$gJ<(!e+**A SSMELBREC DOD$$X\ + EREOR R : D$$f \ \ P HD$$t H e\H D$%\ H P dv\ D$$#+**L SA TEROCDRDE\D$$) +P OCEDC UOTNRE= D$$\ L% \ \ L&D$$/KT&\H .L(D$$UH P H H \D$$]H .K<("m"eD$$" \H .L(D$$\{H P d bD$$bJH e!H D$$ e!\\ DD$zd  bbX+R.XD D$$`c* 8 \\6D$$ 8+E.TX DC.TS. LC D\D$$F+CPTR N \D$$T\ ^0T^9.D$$#b@L.@ex<L.$'D$$p<LTdc^AT^ZD$$]~.@L.@e8L.$D$$'8LTd8^D$D}y'<'8\)e+**A SSD$$aMELB YOCED\ +S CED$$QYITNON TOP OR\ +EPD$$DLR YNEED.D \ \D$$P~ +**L SA TEROCDRDETMD$$A\ +P OCEDC UOTNRE= D$$-\ L% \ \ ^D%%o7\e\d]D$D \ L^;e\LD($.8(eL D$$& P@ @e: ^ D('$4  d)  \ D$%>BP#L^;#!ep]D$DLP\ L^;en  D$$>^ L L^:enD$%b(l d>\ e D$%{z  ^ ex D$(c稈 @ @e D$$|    E$$cd+PJ C ED$⡲e a +SJ R@ CPTR ND$$z \\ddD$$(w+OP P e E$$a  +SD Z4 1 D$$! \\+DL A D$$0 \ aD$$ \+@ 14 D$D \\dd+UPHSD$D" eo a D$$0 H+SI Z4 1 D$$>\\+TS A D$(RL \ a\D$$Z+@ 14  \D%$h\dd+OLDA D%D v e a  D%(ф a a a+SJD$$X R@ C.DL \\D$$^J \\ \D$$n\+DL A D$$Ӽ\\+@ 74 D$$x \\E$$#dd+TSRO  D$$ ^E"eJ E$$a  +TS A D$Dr \ a\D$$#+4 7 \D$$zg\+SJ R@ C.TS D$(R, \\ Ca \D%$CL:\ a \\E$( Hdd @ @ea D$(w6V\  dN\D$$d e+R.XD 01 D$$fr\\ b$bD$$L \Tr D$Dߎ\ \eDD$^ d\ aH(DB  d#ed \D$%X\\d% a'd%D$%\  ^@ad%DD$ a'd%\ \ 1 D%% a&d% a'd%D$$\ \  D((^a`d% a'd%\D$$ \  ^DDDa a`d% a'd%\ D$%( ]\ L^Le; ]6*DD$6 \ d- \ D$$D \\L\ D$$)R \\]\ d%DD$/` a'd%\  \D$%n \]\ d% aH$$-| 'd%\  aE+E$g d% a'd%\  D((o ^ad% a'd%D$% \  ^ad%DD$w a'd%\  D((D ^ad% a'd%D$Dh \  ad% a'dH$$5 %\  aEE$ d% a'd%\ ]\D$$J  L^Le !]\ E$$!d \  \\D$$!L\ \\D$%95$!]\ d% a'd%D$$2!k \\ \\D$%5@!]\ d% a'd%D$%N!]\ L^Lea!]DD$Hl\!\ dS!\ \D$$j!\L\ \D$Dx!\]\ d% a'dH$$Vӆ!%]\ L^ e!]D($ȭ!\ d!  D$$^!L \ D$$h!\ ^ a D$$X! ^ \\D%E!]\ d% a'd%\D$$N! \ \ aH($[!d% a'd%  \D$$!\]\ \e!D$$6"]\ e$"D$$_"] \\D((9 "d "d% a'd%\D%%."  aam&d% a'd%D$%g<"]\ L.eO"]DD$J"\ dA" L D$$X"\ \ D$$bf"\\ 0E$$Jt"e"+T.TX D$$"\0\& 0\D$$K8" '\0\ 0D$$R "\ \d5# DD$T%" 0e"+T.TX D$$M"\0\ 0D$$"\ ,\0\D$%" 0\ \]d5# D$$"0e#+T.TX D$$۫" \0\D$$7# 0\ <\0D$$ d#\ 0\ \dH$$#5#+T.TX \D$$ۘ*# \\]HG\D%$=8# d% a'd% aH($wF#&d% a'd%  \D$$T#^.\ \]!\D$$b# \^0\ M!\D%$ap# \d% \\D%$r4~#\ a"d% \D$$r#\\ \ \D(%虚#\d%rg#dE(ET#dddddddE(E#dddddddE(E#dddddddE(E#dddddddPE(Et#ddd d d d d E(E#d d d d d d d E(En#d d d d d d d E(EՊ $d$ d` d` d` d` d` d` E(E8$d` d` d` de dz dz dz E(E‰&$dz dz dz dz dz dz d E(E;4$d d d d d d d E(E؈B$d d d d d d d E(EzP$d d d d d d d E(E^$d d d d d d d E(Exl$d d d d d d d E(Ez$d d d d d d d E(Eņ[$d d d d d d d E(E:$d d d d d d d E(E[$d d d d d-!d-!d-!E(EQ$d-!d-!d-!d-!d-!d-!d2!E(E$dI!dI!dI!dI!dI!dI!dI!E(E$dI!dI!dN!d!d!d!d!E(E$dX!d!d!d!d!d!d!E(E$d!d!d!d!d!d!d!E(E $d!d!d!d!d!d!d!E(EU~%d!d!d!d!d!d&"d&"E(E%}%d&"d&"d&"d&"d&"d&"d&"E(E|"%d+"d7"d7"d7"d7"d7"d7"E(E~y0%d7"du7"d7"d<"d<#d<#d<#E(E\u>%d<#d<#d<#d<#d<#d<#dA#E(EtL%dI#dI#dI#dI#dI#dI#dI#E($Z%dI#dI#dN#AAAAD$%>h%AAAAAdw#AD$$v%AAAAAAAD$$Bb%Ad# b^b+UOPTTU D$$V% +RP R D$$֠% +NIUP T D$$ˮ% + ;D$$;ռ%====P A4MSB GE +NID$$O% SON W   D$$ؕ%T+^0.T (T%T*D$(:%^P-L*H-e &L*D$$%P.L.+ D$Dz1& L*T*d% aj]D$$& ] ] D$$̹&] ] D$$,&L^.]+ITt T D%$|:& "er&+********** D$$8H& +N OITLT EOFD$$pV&NU D +********** D$$7d&   ^7D$$^Er&L ]]D$D& L e}&CF]D$$ & ] L^Ie&D$(̦&T,d&L^Le&T,E$$.I&d&L^PL^?#eH($_&&T,d&] L^.D$$HJ&e&T,d&T,L,,E$$&dY)]) L%L)L)5D$$&"e''L'T'^I D$$& L) ^  + ;??D$$& ?CPDO E +C UOD$$ 'TNO TUO FTS +PE? D$$1'??   LD$$T(')T%] di)L (D$$r6']* L*] LD$$RD' e?'di)D$$R'] ] D$$#`'] ]+IF L D$( n' e{' ad2)]D$$s|'+WS 1  ]D+$$|'+WS 2 #]D$$n'+WS 3 #]D$$Oe'+WS 4 #e&(D$$Di'] L^0L^1D$$'#e']L L^D$Dx'1e'T)d'T)D$%/'T*P-L*H-e (]D$$ʆ' ]L*L L)D$$e'L.L(T)L*TD$$(*d'].L(TD$$~Q(*]L*L)] E$$2$(d2)]+XT T D$$*2(^M"e(^. ]D$$@(] L D%$6N(L^ eE(T*P-LD($\(*H-e(] L0D$$߅j(e}(0 "0DD%x( d(L0e(0D$$(1 <0 d(D%$(L0e(0 >D$$e(0 d(L D%$5(L*T*d[(] LD$$|( d2)]+NE T D$$Ü(  e(L+e(D$$(T+^.զ ]dH$$d/((+ ; . D$$(]d)]+NE DD$(u) !e)^.D$$) ]!e,)]D$% ) L e)]D($.) di) azL%TD$$ Z<)%di)L ] LD%$J) eD)] dH%(X)i)g_)d&d1'dR'dH%$&f)4)d?)eu)] dHD(t)i))e&L'e)+-;--D$$) -ON .FOW RAʼ +INGND$$) S = L'D$D0.)  L&e)+*;** *D$$H)ON .FOF TA +LAE RRD$$L)RO S= L& D$$`) +E.DN D$( )L&eb/)^7D$$)  Ew)a%*@ ) _R2SMEMACC.RBY!6.sەt$I$IJ1g7^_\AR7M}K&}:&+$}) F}F+ \ܱxD$$"('X"8;'"CD$$L !,!#( *D$$!!L)ŧ "!!D #(D$$* )ħ!,!J !0!PD$$Ro8)ħ!,!!xl`Zc[ByZCTxܱ\D$$ *"( P! ^'\ \d^(D$$*L\ ^ \ +1WW 2D$$#Z3WW 4 \^)D$$Kh\ \dqagvE(Evddd d"dJd-dD%$v -q8k-gdAddHE(dddddddH$D Vd a bbD(%%e3d-D$(y@e^I\ d*E$De^B\ d+-EeH$$^^C\ deH$$]S^I\ d^R\D$D d3 ad3^A\D$%9D d3^S\ d3^MD(8\ d3 ^ad3DE(bg!dddddd)HE$,ddd bb@#eH$$4:N a]R\ D$$9Ha\ a D%DVbbL#eu a]RD$$Vd\ a \D$Dqr\ a bbDsG%$X#e a]R\D($h a\\D$%\ a bD$(}7 bebdVD%%V,"e*e 3D((%ad+e 3DD(6Sad 3adD$E^)e 3adHPD$DbAe adHPPD$$%P\HP,eD%$  3HPad 3HPE%%had`dHe. 'D($v(=aVd7 68aH$(>6}dR #aVdR ^G$E DadRgLd!d9dAE$ERd`d`gZdddTD$$k` bbeHD(nde +DE$|aVd 88DE$Na}de D(%^ad a4dDŢ(R ^adgdsdH$$5Ed b beBE8$d2 a eHPAeD($؏ a.dHPPP\HD$(jP &HPaZd D($^ad<deDE$3  %aZd  28aH$$gd)e ")aVE'$d) ^ad)Pg#dHE'$d dd.< ^ad<D(D22\g6ddd+D$DE@ bb| aeH(*NX*eX a#e{ E$$j\a]R!\^LD$$j\ ^ \ \D$DTix\ !)a bbD%$\#e a]R\D$$q'^L\ ^ \ D$$4\\ aH$%8 bbh#e a]RD$$L;\\^LD$$4\ ^ \ <\D$(\ a bD%%r^bne -e ,D$$ "e e  aX$$  -a} bbH#E$$_e.^L\ ^ \ D$$ \^:\ \FD$D.. bbe#eH$$<} a]R&\\D$$8J+. XT T D$$X\^"\ \D$$f^ \ ^"\ \D$$Vt &ae-H$$V 3a D$$28  a  aZDD$ёd3 bbeH$$e 2D$$l8  a aZD$$lud b,b& CD(% de eD$$Ұ  d 68 DD( )a}dt;: D%$eD((} d/8e" 'D($Z)aVd* 6)a}D%ܢ$* dt e? D%$8adc eK DD$S5Fad[ 8H D'$tT#e[ a D$EMbdtqglddD$%dpAd1'(!e ;G$$3~a 'a(e D$%6͌ eU  e D$$Te a  a G$'ڨa ^'a aH(%fee qG$%ad -a!e :D$$fa4 e@  G$D~aee D($|a 'e --a}D$Ee -aVdD$EC e "-aVd G$$)aE$ŝ&e@p2 +ae6E'%&4d; a $aZ D$8Be eO adS DDDPP adeeH%8 eN eN  tG$$~L aH e\  H aZE$D]Z dd  H aZ bbD($$h Be  a K^HD($_v 'a P:' E$$ e e +E%'q e e  ^aD$$v d  ^a e D(HP H e  taPdH(L  e  ta K^D'%4U H'a e  .EaX$%  K^H'a d DD$R Pd \ ]D$'  ^ \ a D%$d H e H d  D$$u a\ H!e D$(  a 28a%E$$, ei ee  -aeH($R: B  aZdc  ,aeH($fRH P  aZdc  +aeH($ÌV ^  aZdc  ^adHĒ$Ţd i  ta PH!eH$$r  a K^H'aHU*DDv He  e  adHŢ$[  ad H e  DD$/y tad \ ]D$'  ^ \ a D%$B H e H d  D$$A a\ H eH$$]uw  28a aZD$$9P bbH e  G$$Wy a K^H'aD$$j Pe eH$$_ k  +e% e DĒ(  ^a d*  ^G%%( a e=  e8  tG%%L]6 aPdQ  eQ  tG$$D a K^H'aD'$qR ef  a K^HD((` 'adi Pd \ D$$7n ] ^ D$$A| \ Ea  H e HDD$ d  a \ D($+) H!e e DDDۦ e  ad  aD'$p e  a K^HD$$߲ 'ae -e D%(  ta ad D'$w e  a K^HD$$a 'ae -e D$$  ta,e  |a E'$ a ^ad -e. D$$7 e  3 a 28 D$D$ a aZd ,eH$Du2 K e<  3a 28 D$(@  a aZd +ED(N eh eY  3a 28DDE\  a  aZd D$$ 3j e ez  ^aE8$Mx d  a e z2 e D(%d  3 a 3 a 2D(( 8  a  aZd  D$$A ta PH!e  G$$u a K^H'aHD$8ؾ e  e  ad  DD( ad H e>  taX$$] d \ ]D$4  ^ \ a  H DD(ti e H d  aX$%0  \  e  2D((7 8  a aZ bD'$} b< ^a K^H/D$$. 'a eO D%$^< eK dHDlXJ O  ta eY  adHĒ$.X ]  a K^H'G%$ f ae ey  DDRt tad  a!e  D$8 ta e  ad  D$$ߐ a K^@'a DD$= e e  D' a! a!#E8'c e  tad  ta bD$$ b< ^a K^H_DD$6 'a e D$$R e E8(8 d  ta e aE8$^d a K^HD$$'a e9E$$%e5 a! aXD(k*!#e3 tad9 taX((B8 eC adG aX$'XeF K^@'aD$$eDTeoec tadH8$TNbo a!eo ta D$$`pb b K^H'aH$$~  a eH$$QڌeeH$% eD$$Шd ta e+ G$$ a K^H' aX$DC  e aE$'9dx)e ad)D(e) a ,#E8$ne ad) aX$(e%eDD$u e d)dH($d d) DD(,&tad 3 a  E$$z4aZ b bJ K^@D$$B'a e_eH$(wP[ a aZd_ }aX$$O^ b bJ K^@D$$l'a eeD$Dlz a G aZd }aD$$մ bb K^'E%'.\a e ^aD$(xee taX$%d!e tG%8?a e tad G$$`a K^@e'a E%%ae-e tG$D%a 28a H D$$_ aZ b b< K^@D8(.'ae#-ED(Le a >a<d# taX$(" b bPweI-E($m 0e8 a<dI,eC DD$2>a<dI }a- b D%%LbPeo-e^ E$$Za<do,ei a<dHĒ$Dho }a- b bXD$'Ave,e }aeH D$( e aZd aH$$<- b b<eD$%"-e }a a<*D$DŮ b bJeE8(le }a :a4- D$$gb b<e-eD$$EX }a ;a<+ b bD(%IRnee }G$$TfaH e aVE$$Ad  "aV bbD$8eY a KD$$wC^@'a  e0 #G$$K,ad4 aeSDD(`:eE }adSHD%8H !"eS taD$$dVd\ H elD$$d]ds]D%8FrH e} ta ^ DM'$*\ a H eD(ńqH e ad G$$˜aH   \ D$$Te 28E$$iѸaH e aZdH%%B H e aZdD(E(H e a<d D$$paZH e* bD$$݌b H  D$%~ !e  )8 aZD$% eA e.D'$e# ~ad,^ D(8C(( d3 ^a aD$$#6 e ^aeT D$$SDa K^H'aE$$YRdee ^DD$`a d| ^a D'D6n a!e| aD$$ | a\K^H'(!E8$Jӊe a K^HDD$c'ad  K^H'G%%ae  e D$( Ѵee D$%/Gee a'eHDp a ,a-"E($e a<,   D($D. ad a   D((N@. ade aD(čr  d a aX$D_!e ad  DD$g$"e,R e D((M/2  e= adA aX((@ ereO ~aX$$fNH e_ = aH%$u\dr ek  aZdH$$m*jr . aH  bD$$ xb eu D$$◆e ^(!eDDDɔe ad aD((. d a- d ae d E%%Ma d a d a dDDDZV apd a`d a7dH(( ad a d% aE$Ecdq"gdddE(EodddddddE(EdddddddD$D ^(!e eH(źR ad ad D%%~  #eBe1%M aX'$O.d5 a ^@D(%p*<'a a dm a$dDDDwPJ aJd apd adH((X ad ad aEE$?nfd a dq #gsdHE(tEdJdOdTdYd^dcdHE$.cdhdhdhdO  D$'9#e e adD(  ad a  _PASCAL.AL{Y BEGIN COMMENT - PROGRAM TO MONITOR THE PASCAL COMPILER ASSEMBLER ETC. BY ARTHUR FOSTER ON THE 20TH. MAY 1977... END; LITERAL NIL (0); POINTER LIBLIST; INTEGER REVISION,UPDATE; INTEGER (2) SWITCHES; BOOLEAN LOAD,LOADMAP,LIBRARY; BOOLEAN BINARY,LISTING,PCODE,MONITOR,EXTN,FAILED; STRING PROGFILE,PCODEFILE,LISTFILE,LOADFILE,QCODEFILE,BINARYFILE; STRING LIBFILE,SAVEFILE,MONITORFILE; EXTERNAL PROCEDURE FERROR; EXTERNAL PROCEDURE GTIME; EXTERNAL PROCEDURE SWOP; STRIoCNG PROCEDURE CAT(B,C); STRING B,C; BEGIN STRING A; A := B; SUBSTR(A,LENGTH(A)+1,LENGTH(A)+LENGTH(C)) := C; CAT := A END; PROCEDURE ERRORMESSAGE(TEXT); VALUE TEXT; STRING TEXT; BEGIN FAILED := TRUE; OPEN(3,MONITORFILE); WRIT&E(3,"PASCAL MONITOR...",TEXT,"<15>"); CLOSE(3) END; PROCEDURE SWOPPROG(PROGNAME); VALUE PROGNAME; STRING PROGNAME; BEGIN INTEGER ERRORNUMBER; IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; h GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PASCAL MONITOR...",HOUR,":",MINUTE,":",SECOND, " ",PROGNAME," ENTERED ","<15>"); CLOSE(3) END; CLOSE(0); PROGNAME := C(AT(PROGNAME,"<0>"); SWOP(PROGNAME,ERRORNUMBER); IF ERRORNUMBER <> -1 THEN BEGIN COMMENT - OTHER ERROR TRAPS ARE POSSIBLE HERE!; IF ERRORNUMBER < 255 THEN FERROR(ERRORNUMBER) m ELSE IF ERRORNUMBER = 318 THEN BEGIN EXTN := TRUE; LOAD := FALSE END ELSE IF ERRORNUMBER = 311 THEN ERRORMESSAGE("ERROR(S) IN P-CODE ASSEMBLER") ELSE FAILED := TRUE END END; STRING PROCEDURE EXTENSION(PROGNAME,EXTENT); VALUE PROGNAME,EXTENT; STRING PROGNAME,EXTENT; BEGIN INTEGER I; I := INDEX(PROGNAME,"."); IF I <> 0 THEN SETCURRENT(PROGNAME,I-1); PROGNAME := CAT(PROGNAME,"."); PROGNAME := CAT(PROGNAM{E,EXTENT); EXTENSION := CAT(PROGNAME,"<0>") END; PROCEDURE APPENDCOM(PARAMNAME,SWITCHES); VALUE PARAMNAME,SWITCHES; STRING PARAMNAME; INTEGER (2) SWITCHES; BEGIN WRITE(0,PARAMNAME); BYTEWRITE(0,ADDRESS(SWITCHES),4); END; BOOLEAN APROCEDURE EXISTS(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); EXISTS := TRUE; GOTO QUIT; NOFILE: ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST")); EXIST S := FALSE; QUIT: END; PROCEDURE CREATEFILE(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); DELETE(FILENAME); NOFILE: OPEN(4,FILENAME); CLOSE(4) END;3 PROCEDURE CREATECOM(PROGNAME,SWITCHES); VALUE PROGNAME,SWITCHES; STRING PROGNAME; INTEGER (2) SWITCHES; BEGIN DELETE("COM.CM<0>"); OPEN(0,"COM.CM<0>"); APPENDCOM(PROGNAME,SWITCHES) END; PROCEDURE GENERATELIST(PT,FILENAME); VALtUE FILENAME; POINTER PT; STRING FILENAME; BEGIN POINTER PT1,PT2; BASED STRING BSTRING; BASED POINTER BPT; INTEGER I; ALLOCATE(PT1,20); IF PT = NIL THEN PT := PT1 ELSE BEGIN PT2 := PT;  LOOP : IF PT2 -> BPT <> NIL THEN BEGIN PT2 := PT2 -> BPT; GOTO LOOP END; PT2 -> BPT := PT1 END; FOR I := 0 STEP 1 UNTIL 19 DO (PT1 + I)->BPT := NIL; (PT1+1)->BSTRING := FILENAME END; BOOLEAN PROCEDURE TESTFILE(TESTNAME); VALUE TESTNAME; STRING TESTNAME; BEGIN TESTNAME := CAT(TESTNAME,"<0>"); OPEN(4,TESTNAME,NOFILE); CLOSE(4); TESTFILE ʗ:= TRUE; GOTO FINIS; NOFILE : TESTFILE := FALSE; FINIS: END; PROCEDURE READCOM(ERROR); LABEL ERROR; BEGIN STRING FILENAME; BOOLEAN ARRAY PSWITCH,PROGSWITCH [25]; OPEN(0,"COM.CM"); COMARG(0,FILENAME,PROGSWITCH,ERR2); ; COMARG(0,PROGFILE,PSWITCH,ERR1); IF NOT EXISTS(PROGFILE) THEN GOTO ERROR; COMMENT - SET THE INITIAL NAMES FOR EACH OF THE FILES; SAVEFILE := EXTENSION(PROGFILE,"SV"); LISTFILE := EXTENSION(PROGFILE,"LS"); PCODEFILE :=]# EXTENSION(PROGFILE,"PC"); LOADFILE := EXTENSION(PROGFILE,"LD"); QCODEFILE := EXTENSION(PROGFILE,"QC"); BINARYFILE := EXTENSION(PROGFILE,"RB"); COMMENT - AND NOW THE SWITCHES; IF NOT PROGSWITCH[1] THEN LOAD := TRUE;  IF PROGSWITCH[4] THEN EXTN := TRUE; IF PROGSWITCH[11] THEN LISTING := TRUE; IF PROGSWITCH[15] THEN PCODE := TRUE; IF PROGSWITCH[12] THEN LOADMAP := TRUE; IF PROGSWITCH[25] THEN MONITOR := TRUE; COMMENT - AND THE LOCA L SWITCHES,WHICH DEFINE THE FILES; LOOP: BEGIN COMARG(0,FILENAME,PROGSWITCH,QUIT); IF PROGSWITCH[11] THEN BEGIN LISTING := TRUE; LISTFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[15] THEN 9} BEGIN PCODE := TRUE; PCODEFILE := EXTENSION(FILENAME,"PC") END ELSE IF PROGSWITCH[12] THEN BEGIN LOADMAP := TRUE; LOADFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[18] THEN  SAVEFILE := EXTENSION(FILENAME,"SV") ELSE IF PROGSWITCH[1] THEN BINARYFILE := EXTENSION(FILENAME,"RB") ELSE IF PROGSWITCH[25] THEN BEGIN MONITOR := TRUE; MONITORFILE := CAT(FILENAME,"<0>") h END ELSE IF PROGSWITCH[4] THEN BEGIN LIBRARY := TRUE; EXTN := TRUE; LIBFILE := EXTENSION(FILENAME,"RB"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE B+OEGIN LIBFILE := EXTENSION(FILENAME,"LB"); IF TESTFILE(LIBFILE) THEN  FILENAME := LIBFILE ELSE IF NOT TESTFILE(FILENAME) THEN BEGIN ERRORMESSSAGE(CAT(FILENAME," DOES NOT EXIST")); FILENAME := "<0>" END ELSE FILENAME := CAT(FILENAME,"<0>") END; GENERATELIST(LIBLIST,FILENAME) END O END; GOTO LOOP; ERR1: ERRORMESSAGE("NO SOURCE FILE SPECIFIED");  GOTO ERROR; ERR2: ERRORMESSAGE("COM.CM IN ERROR"); GOTO ERROR; QUIT: CLOSE(0); IF FAILED THEN GOTO ERROR END; PROCEDURE GENCOMPCALL; IF EXISTS("P4COMPILER.ShV") AND EXISTS("P4COMPILER.OL") THEN BEGIN CREATECOM("P4COMPILER",SWITCHES); APPENDCOM(PROGFILE,SWITCHES); CREATEFILE(LISTFILE); CREATEFILE(PCODEFILE); APPENDCOM(LISTFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); SWOPPROG("P4COMPILER.SV") END; PROCEDURE GENERRCALL; IF EXISTS("P4ERRSUM.SV") AND EXISTS("P4ERRORS") THEN BEGIN CREATECOM("P4ERRSUM",SWITCHES); SWITCHES := -17777777777R8; IF LISTING THEN APPENDCOM(LISTFILE,SWITCHES) ELSE APPENDCOM(MONITORFILE,SWITCHES); SWITCHES := 0; SWOPPROG("P4ERRSUM.SV") END; PROCEDURE GENPASMCALL; IF (IF EXTN THEN EXISTS("P4MAC.SV") ELSE EXISTS("P4ASM.SV")) THEN BEGIN IF EXTN THEN CREATECOM("P4MAC",SWITCHES) ELSE CREATECOM("P4ASM",SWITCHES);  CREATEFILE(QCODEFILE); APPENDCOM(QCODEFILE,SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("P4MAC.SV") ELSE SWOPPROG("P4ASM.SV") END; PROCEDURE GENASMCALL; IF (IF EXTN THEN EXISTS("MAC.SV") ELSE EXISTS("ASM.SV")) THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(BINARYFILE); APPENDCOM(BINARYFILE,SWITCHES); APPENDCOM("<0>",SWITCHES); APPENDCOM(QCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("MAC.SV") ELSE SWOPPROG("ASM.SV") END; PROCEDURE GENRLDRCALL; IF EXISTS("RLDR.SV") AND EXISTS("P4CUE.RB") AND EXISTS("P4LIB.LB") THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(LOADFsILE); SWITCHES := 4000000R8; APPENDCOM(LOADFILE,SWITCHES); SWITCHES := 0; CREATEFILE(SAVEFILE); SWITCHES := 20000R8; APPENDCOM(SAVEFILE,SWITCHES); SWITCHES := 0; APPENDCOM("P4CUE.RB",SWITCHES); APPENDCOM("P4LIB.LB",SWITMLCHES); APPENDCOM(BINARYFILE,SWITCHES); IF LIBRARY THEN BEGIN BASED STRING BSTRING; BASED POINTER BPT; STRING FILENAME; LOOP : IF LIBLIST <> NIL THEN BEGIN FILENAME := (LIBLIST+1)->BSTR̺ING; SETCURRENT(FILENAME,INDEX(FILENAME,"<0>")); APPENDCOM(FILENAME,SWITCHES); LIBLIST := LIBLIST->BPT; GOTO LOOP END END; SWOPPROG("RLDR.SV") END; PROCEDURE INIT; BEGIN INTEGER I; MONITORFILE := "$TTO<0>"; REVISION := 2; UPDATE := 1; SWITCHES := 0; LIBLIST := NIL; LIBRARY := BINARY := LISTING := PCODE := MONITOR := FALSE; FAILED := LOAD := LOADMAP := EXTN := FALSE END; BEGIN INIT; READCOM(ABSEND); IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"NOVA PASCAL REVISION ",REV϶ISION,".",UPDATE); WRITE(3," ON ",DAY,"/",MONTH,"/",YEAR,"<15>"); CLOSE(3) END; GENCOMPCALL; IF NOT LISTING THEN DELETE(LISTFILE); IF FAILED THEN BEGIN MONITOR := FALSE; GENERRCALL; Q DELETE("P4ERRORS"); MONITOR := TRUE END ELSE BEGIN GENPASMCALL; IF NOT FAILED THEN BEGIN GENASMCALL; DELETE(QCODEFILE); IF LOAD AND N.OT FAILED THEN BEGIN GENRLDRCALL; IF NOT LOADMAP THEN DELETE(LOADFILE) END END END; IF NOT PCODE THEN DELETE(PCODEFILE); ABSEND: IF MONITORPa THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PASCAL MONITOR...",HOUR,":",MINUTE,":",SECOND," FINISHED"); IF FAILED THEN WRITE(3e K," WITH ERRORS") ELSE WRITE(3," SUCCESSFULLY"); WRITE(3,"<15>"); CLOSE(3) END; END; MAKEP4MAC.CMY 0A:&DELETE/V P4MAC.LD;^ RLDR P4CUE P4LIB.LB P4MAC P4MAC/S P4MAC.LD/LPCODE.AL -BEGIN COMMENT - PROGRAM TO MONITOR THE PCODE ASSEMBLER ETC. BY ARTHUR FOSTER ON THE 20TH. MAY 1977... END; LITERAL NIL (0); POINTER LIBLIST; INTEGER REVISION,UPDATE; INTEGER (2) SWITCHES; BOOLEAN LOAD,LOADMAP,LIBRARY; G4BOOLEAN BINARY,LISTING,PCODE,MONITOR,EXTN,FAILED; STRING PROGFILE,PCODEFILE,LISTFILE,LOADFILE,QCODEFILE,BINARYFILE; STRING LIBFILE,SAVEFILE,MONITORFILE; EXTERNAL PROCEDURE FERROR; EXTERNAL PROCEDURE GTIME; EXTERNAL PROCEDURE SWOP; STRING PROCEDUHRE CAT(B,C); STRING B,C; BEGIN STRING A; A := B; SUBSTR(A,LENGTH(A)+1,LENGTH(A)+LENGTH(C)) := C; CAT := A END; PROCEDURE ERRORMESSAGE(TEXT); VALUE TEXT; STRING TEXT; BEGIN FAILED := TRUE; OPEN(3,MONITORFILE); WRITE(3,"PCODE: MONITOR...",TEXT,"<15>"); CLOSE(3) END; PROCEDURE SWOPPROG(PROGNAME); VALUE PROGNAME; STRING PROGNAME; BEGIN INTEGER ERRORNUMBER; IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEA=R,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PCODE MONITOR...",HOUR,":",MINUTE,":",SECOND, " ",PROGNAME," ENTERED ","<15>"); CLOSE(3) END; CLOSE(0); PROGNAME := CAT(PROGNAME,f"<0>"); SWOP(PROGNAME,ERRORNUMBER); IF ERRORNUMBER <> -1 THEN BEGIN COMMENT - OTHER ERROR TRAPS ARE POSSIBLE HERE!; IF ERRORNUMBER < 255 THEN FERROR(ERRORNUMBER) ELSE IF ERRORNUMBER = 318 THEN BEGIN EXTN := TRUE; LOAD := FALSE END ELSE IF ERRORNUMBER = 311 THEN ERRORMESSAGE("ERROR(S) IN P-CODE ASSEMBLER") ELSE FAILED := TRUE END  END; STRING PROCE\DURE EXTENSION(PROGNAME,EXTENT); VALUE PROGNAME,EXTENT; STRING PROGNAME,EXTENT; BEGIN INTEGER I; I := INDEX(PROGNAME,"."); IF I <> 0 THEN SETCURRENT(PROGNAME,I-1); PROGNAME := CAT(PROGNAME,"."); PROGNAME := CAT(PROGNAME,EXTENT); * EXTENSION := CAT(PROGNAME,"<0>") END; PROCEDURE APPENDCOM(PARAMNAME,SWITCHES); VALUE PARAMNAME,SWITCHES; STRING PARAMNAME; INTEGER (2) SWITCHES; BEGIN WRITE(0,PARAMNAME); BYTEWRITE(0,ADDRESS(SWITCHES),4); END; BOOLEAN PROCEDURE EXmISTS(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); EXISTS := TRUE; GOTO QUIT; NOFILE: ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST")); EXISTS := FALSE; $ QUIT: END; PROCEDURE CREATEFILE(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); DELETE(FILENAME); NOFILE: OPEN(4,FILENAME); CLOSE(4) END; PROCEDURE CREATECOM(PROGNAME,SWITCHES); VALUE PROGNAME,SWITCHES; STRING PROGNAME; INTEGER (2) SWITCHES; BEGIN DELETE("COM.CM<0>"); OPEN(0,"COM.CM<0>"); APPENDCOM(PROGNAME,SWITCHES) END; PROCEDURE GENERATELIST(PT,FILENAME); VALUE FILENAME; POINTER PT; STRING FILENAME; BEGIN POINTER PT1,PT2; BASED STRING BSTRING; BASED POINTER BPT; INTEGER I; ALLOCATE(PT1,20); IF PT = NIL THEN PT := PT1 ELSE BEGIN PT2 := PT; LOd@OP : IF PT2 -> BPT <> NIL THEN BEGIN PT2 := PT2 -> BPT; GOTO LOOP END; PT2 -> BPT := PT1 END; FOR I := 0 STEP 1 UNTIL 19 DO (PT1 + I)->BPTȫ := NIL; (PT1+1)->BSTRING := FILENAME END; BOOLEAN PROCEDURE TESTFILE(TESTNAME); VALUE TESTNAME; STRING TESTNAME; BEGIN TESTNAME := CAT(TESTNAME,"<0>");  OPEN(4,TESTNAME,NOFILE); CLOSE(4); TESTFILE := TRUE;  GOTO FINIS; NOFILE : TESTFILE := FALSE; FINIS: END; PROCEDURE READCOM(ERROR); LABEL ERROR; BEGIN STRING FILENAME; BOOLEAN ARRAY PSWITCH,PROGSWITCH [25]; OPEN(0,"COM.CM"); COMARG(0,FILENAME,PROGSWITCH,ERR2); COMARG(0,:sPROGFILE,PSWITCH,ERR1); COMMENT - SET THE INITIAL NAMES FOR EACH OF THE FILES; SAVEFILE := EXTENSION(PROGFILE,"SV"); LOADFILE := EXTENSION(PROGFILE,"LD"); PCODEFILE := EXTENSION(PROGFILE,"PC"); COMMENT - z1ENSURE THAT THE FILE EXISTS; IF NOT EXISTS(PCODEFILE) THEN GOTO ERROR; QCODEFILE := EXTENSION(PROGFILE,"QC"); BINARYFILE := EXTENSION(PROGFILE,"RB"); COMMENT - AND NOW THE SWITCHES; IF NOT PROGSWITCH[1] THEN LOAD := TR5UE; IF PROGSWITCH[4] THEN EXTN := TRUE; IF PROGSWITCH[15] THEN PCODE := TRUE; IF PROGSWITCH[12] THEN LOADMAP := TRUE; IF PROGSWITCH[25] THEN MONITOR := TRUE; COMMENT - AND THE LOCAL SWITCHES,WHICH DEFINE THE FILES; LOndOP: BEGIN COMARG(0,FILENAME,PROGSWITCH,QUIT); IF PROGSWITCH[12] THEN BEGIN LOADMAP := TRUE; LOADFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[18] THEN SAVEFILE := EXTENSION(FILENAMER,"SV") ELSE IF PROGSWITCH[1] THEN BINARYFILE := EXTENSION(FILENAME,"RB") ELSE IF PROGSWITCH[25] THEN BEGIN  MONITOR := TRUE; MONITORFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[4] THEN y BEGIN LIBRARY := TRUE; EXTN := TRUE; LIBFILE := EXTENSION(FILENAME,"RB"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE BEGIN LIBFILE := EXTENSION(FILENAME,"LBA"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE IF NOT TESTFILE(FILENAME) THEN BEGIN ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST"));  FILENAME := "<0>" END ELSE FILENAME := CAT(FILENAME,"<0>") END; GENERATELIST(LIBLIST,FILENAME) END END; GOTO LOOP; ERR1: ERRORMESSAGE("NO SOURCE FILE SPECIFIED"); GOTO ERROR; ERR2: ERRORMESSAGE("COM.CM IN ERROR"); GOTO ERROR; QUIT: CLOSE(0); IF FAILED THEN GOTO ERROR END; PROCEDURE GENPASMCALL; IF (IF EXTN THEN EXISTS("P4MAC.SV") ELSE EXISTS("P4ASM.SV")) THEN BEGIN IF EXTN THEN CREATECOM("P4MAC",SWITCHES) ELSE CREATECOM("P4ASM",SWITCHES); CREATEFILE(QCODEFILE); APPENDCOM(QCODEFILE,SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("P4MAC.SV") ELSE SWOPPROG("P4ASM.SV") END; PROCEDURE GENASMCALL; IF (IF EXTN THEN EXISTS("MAC.SV") ELSE EXISTS("ASM.SV")) THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(BINARYFILE); APPENDCOM(BINARYFILE,SWITCHES); APPENDCOM("<0>",SWITCHES); APPENDCOM(QCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("MAC.SV") ELSE SWOPPROG("ASM.SV") END; PROCEDURE GENRLDRCALL; IF EXISTS("RLDR.SV") AND EXISTS("P4CUE.RB") AND EXISTS("P4LIB.LB")M THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(LOADFILE); SWITCHES := 4000000R8; APPENDCOM(LOADFILE,SWITCHES); SWITCHES := 0; CREATEFILE(SAVEFILE); SWITCHES := 20000R8; APPENDCOM(SAVEFefILE,SWITCHES); SWITCHES := 0; APPENDCOM("P4CUE.RB",SWITCHES); APPENDCOM("P4LIB.LB",SWITCHES); APPENDCOM(BINARYFILE,SWITCHES); IF LIBRARY THEN BEGIN BASED STRING BSTRING; BASED POINTER BPT; STRING FILENAME; LOOP : IF LIBLIST <> NIL THEN BEGIN FILENAME := (LIBLIST+1)->BSTRING; SETCURRENT(FILENAME,INDEX(FILENAME,"<0>")); APPENDCOM(FILENAME,SWITCHES); LIBLIST := LIBLIST->BPT; GOTO LOOP END END; SWOPPROG("RLDR.SV") END; PROCEDURE INIT; BEGIN INTEGER I; MONITORFILE := "$TTO<0>"; REVISION := 2; UPDATE := 0; SWITCHES := 0; LIBLIST := NIL; LIBRWARY := BINARY := LISTING := PCODE := MONITOR := FALSE; FAILED := LOAD := LOADMAP := EXTN := FALSE END; BEGIN INIT; READCOM(ABSEND); IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"NOVA PCODE REVISION ",REVISION,".",UPDATE); WRITE(3," ON ",DAY,"/",MONTH,"/",YEAR,"<15>"); CLOSE(3) END; BEGIN GENPASMCALL; IF NOCT FAILED THEN BEGIN GENASMCALL;  DELETE(QCODEFILE); IF LOAD AND NOT FAILED THEN BEGIN GENRLDRCALL; IF NOT LOADMAP THEN DELETE(LOADFILE) END END END; ABSEND: IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PCODE JMONITOR...",HOUR,":",MINUTE,":",SECOND," FINISHED");  IF FAILED THEN WRITE(3," WITH ERRORS") ELSE WRITE(3," SUCCESSFULLY"); WRITE(3,"<15>"); CLOSE(3) END; END; R2CSPTAB.RBYU-p%#T@n8D$$erD$$-$IR$I$I$IZpHnUxFO#x UVx$I$IH}Vx7x _ A  _A x _R2SINTEGER.RBY!67Sb$I$IILBBA Ф_12_)vF$1FD_#_Q__ F_AD$$!4!!,!L !4!!,D$$!L !,!L !4!,Z!L !4D$$!!,J !D !,p!L !4D$$ג*!!,  NL!L !4!!,J D8!L H :0 _R2CITAB.RBYY 7텯bm{{@<@{{ <$$ $$W2$$I2$HC*123456HHH2&8789:;<=>k?ȐHFHIJLMNPQRH0$vTTUVXY$b@ikmHHNpotvwxyz{|l~}~HHHjYxG/G.aG-aH,0f&_*BnAl7+1`Ф Ф_2HHH2_vF1Fx(p_'&äP%#PF"Y!DD_##_QHHH?Q_LA}$_FF_P)isiraiqjplAAHHÛH?DfgeldGFDE7DOCB7_c buHȐH% a5 BjAh&~ GZF[_A^&} }]7\$}W&S}O FK _R2IFT.RBY!:\OSHQD6@pH _PASCFLS.m ~4PASCFLS,^ P4COMPILER.,^ P4ASM.SV,^ P4MAC.SV,^ P4LIB.LB,^ PCMESSAGE.ER,^ P4CUE.RB,^ P4ERRSUM.SV,^ PASCAL.SV,^ PCODE.SV^ R2RFNS.RBU!9TS$I$I@0F$#!x UVxM @O N b*D$$)Y0Z!!,!D!0:D$$X )   0  D$$ P  !DiHLA)pf _R2SSET.RBY!6s$@ Вx>p_/"äPu{P$$<0!,!!!D D$$!!D4 !8 'X!4!',D$$'L' !8 'X!4!',D&$*'L' !8 'X!4!',VJD$&}8'L' !8 !X#(D$ F@#P!L  _R2RFW.RB  44T-x@d _MAKEPASCAL.CMR /?DELETE/V PASCAL.LD;^ RLDR PASCAL SWOP @LIBRARY.CM@ PASCAL.LD/LP4BLOCK.RBYN7mNC$I@`-!x-R#$2llt2!#Q-׉Oى-q(P(D$D٢bb"\)!e#(!D%;\)!"e ad D'$(!e# a b$ȯb D$(* O(!e@ 2aX$$8 O'aO(eNDDD|FeqeT+ diD$$`ZT  +D$$Ob  adH$$jp@^30("E%((~eed G%$uae ^@ G$$a  E%%ZPe -ee D((E d ,eE$$e ^-e.D%$^+ d^- D%$e D$(6 d D'Łd ia ad@D$$y ee- D% ad@e8PD$$&e.^- ,  G$%4ad@ ja aD$%ǭB(!eN a a D$$uP bb`#eHD8^cdw  a  D$$Bla  " bD%x(CQzbedD($Ȉ"eekD%$ndWdi axD$$Cdi 7 7 eD$$TͲ  "eH$%m  d !e D$$,}~A   D$(_7 7 ax D$(DŽ 7di axdiD%$ ax axD$Dj"  aR"diD$$  D$(9""e7  ax" D%$D0 d "D$$>"""dH$( Li axdigHE()~Z[dddddddH$$nFhMdez aH$D7vxdVe ED$axdd bD$$ibLeeH%$  +axe b,D$(adbD&e eD8$A a ad ^^a D$$x^  %aeD8( a a e aD$(L ae e aDDĔ a d ^_a ^D($'%a^(eH8d a ad eH(ċ+,e, ({a aD$$,(\)# "#eH($:e e&D'$[HeQ adU a D$$RV^@'a  D%8)d"!"es a aH$$r (#\Z61)# D('y"#eUd a E bd;  _MAKEP4ERRS.CMY 0M DELETE/V P4ERRSUM.LD;^ RLDR P4CUE P4LIB.LB P4ERRSUM P4ERRSUM/S P4ERRSUM.LD/LR2SMISC.RBYU-ڕtu$I$IHPېG&~ `HAG;+GB`G7F6YxHf%&7FܱC{\C{DĒ$<!,!* !!D !,!!4G$$K! :Z !,!!$D$$d!L  (  !4! xD8$@* !$!)(!!D  !$D$$I8!D !$@!L  !$!)X@F(H74pHI _R2SMPY.RB  &ڕTvHJ`7 wD$$X0YDr _MAKEPCODE.CMDELETE/V PCODE.LD;^ RLDR PCODE SWOP @LIBRARY.CM@ PCODE.LD/LPCMESSAGE.ERY 0ILLEGAL INSTRUCTION ENCOUNTERED BY THE INTERPRETER STACK SPACE EXHAUSTED EOF SET FOR 'GET' INSTRUCTION EOF SET FOR 'READ' INSTRUCTION HEOF NOT SET FOR 'PUT' INSTRUCTION 'WRITE' BUFFER EMPTY UNDER/OVERFLOW FLAG SET ON RETURN FROM RFPI OVERFLOW ON TRUNCATE INSTRUCTION dZMISSING LABEL IN CASE STATEMENT - UJC ENCOUNTERED TOO MANY TEXT FILES REQUESTED AT ONE TIME ILLEGAL EXTERNAL PROCEDURE CALL VALUE OUT OF RANGE...AT RANGE CHECK INSTRUCTION HEAP SPACE EXHAUSTED...PROCEDURE NEW FIELD WIDTH IS NEGATIVE OR EXCEEDS 120 INPUT ERROR...FLOATING POINT INTERPRETER OUTPUT ERROR...FLOATING POINT INTERPRETER R2IREAL.RBY!:~}‹$I$IGФ2D#QLA}FD6@pH _R2SMYP.RBYU-rؕtw)|D$$ YJJY9@, _P4MAC.RBY 1#_8   @G) D$$b bv+SR T D$$" D$$mT+CC P D$$* ^<"5D$$8+NA DD$$)F ^D$$BT"+D$$bRW I D$$p D$$t~+ID F  .D$$t^% D$$xh+HC R D$$c^0D$$r+NIID D$$1^XD$$͖F+RSSO aLD$$ ^TD$$d+ELAQ D$$y ^D$$t +CL A D$$d ^+D$$w&+OED$Qv$4 F  D$$B^)D$$pP+DL A D$$q^^\D$$ml+TA N D$$TzD$$l+DL C D$$^^D$$Q`+JF P D$$-Ѳ^eD$$+EDCC D$$R ^nD$$"R<n+DA R D$$$ ^D$$z +LF OD$$N  ^D$$H !+D$$˵"LE N !D$$0q!"D$$a>+AL O "D$$AL^]"F#D$$hZ+SC P D$$h#^c#D$$Tvv$+EDIC D$$I$;^l$D$$ n%+NE T D$$ %^b%D$$#&+VD I D$$g &^D$$&'+UC P D$$ 0'^aD$$h'2(+NJD$$8 C (D$$^4()D$$h+DO D )D$$^)*D$$c,+AP G ? D$$n:**D$$_H++LF T D$$k5V+^+D$$|$d b b-+LH T D$$ r -^D$$-.R+HCD$$wAK .D$$^ ./D$$4q+NI N /D$$0^(/D$$/b0+GN I D$$=0^0<D$$e1+HCBK D$$1^q1D$$S2+HCCK D$$rN  2^p2D$$O3+XC P D$$Y( 3^u'D$$6324+DR CD$$D 4 D$$R45+OID$$ ` R 5D$$D n^#56D$$Xp|+XI A 6D_)$$ъ^_6n7D$$sh+OM D D$$7^7D$$l8+HCIK D$$8^q8D$$9+GN R D$$4 9^9D$$H:+BS I D$$l :^D$$$:;+NI T D$$C ;^&D$$=$;<+EDD$$2bAC <D$$@^l<n=D$$[N+PJ T =D$$\^}=>D$$bj+PM I D$$5 x>^>D$$Gj?+PJ F D$$̔?^~?D$$@+TSCR D$$Ѡ @^P@D$$#A+HCRK D$$  A^pD$$mAB+HCSK D$$j B^pD$$ BC+BSD$$  R CD$$^CED$$O +AS V ED$$I.E:GD$$f<+PM R GD$$J^GD$$|SXI+OM V D$$fI^`IxD$$ZVtJ+DR I D$$ȂJ JD$$RK+ON T D$$Ξ K^!KD$$nL+JU C D$$8 L^AD$$LM+IS N D$$c MQD$$M b bND$$!Q+GS S D$$N^$ND$$WO+SM T  D$$[<O^ OD$$`*<P+EGAQ |$ D$$$8 P^PD$$FQ+EGBQ D$$uT Q^D$$bQR+EGCQ D$$p R^D$$~RS+MJ/D$$u  P SD$$^2STD$$`+SR E TD$$TUD$$_+JT P UD$$Z^fU`JD$$aV+OL G D$$lVVD$$NW+DW R D$$C WWD$$~WX+EGIQ D$$B+&X^XD$g$4Y+JU P D$$UB Y^dYD$$(OPZ+DLCC D$$^ Z^^D$$lZ[+VO LD$$|z [D$$k[\+EGD$$5 MQ \D$$$^\ ]D$$V+SR N ]D$$^1]^D$$:^+RT C D$$^1^^D$$g_+DLBC D$$__^^_D$$ `+DLIC D$$- `^^`D$$" a+QS R D$$1Z0 a^D$$v> ab+EGSQ D$$L b^D$$Z bc+QSD$$h T cD$$|v cd+D$$ RW C ^ dD$$  deD$$M +JX P eD$$ Į ^gefD$$)R +TSAO D$$ f^fD$$] g+EGRQB D$$_A g^gD$$ h+NIAC D$$/ h^hhD$$S ni+DLRC D$$; i^^D$$, ij{+NICC D$$: j^jD$$>H jnk+TSD$$V P  kD$$Zd ^*k b bD$$ydr l+NICD D$$Ԁ l^X=lD$$Ž Po+WR R D$$JK ooD$$ p+NIIC D$$ p^hD$$t pnq+DLBO D$$O q^=,LD$$ qFr+DLD$$ CO rD$$ ^LrFsD$$J +RW R sD$$   stD$$mV( +RW S t$D$$6 tvD$$WD +DLAO D$$R v^LvFD$$Q` w+TSRO D$$:n w^ wD$$| x+DLIO D`($$ x^LxD$$ Fy+QEBU D$$r y^D$$Ԃ yz+QECU D$$W z^D$$  z{+NID$$F RD {D$$ ^X{Z|D$$S +ELAS |D$$" ^|}D$$R +ELBS D$$$ }^}D$$:Y2 ~+QEAU D$$@@ ~^~D$$HN +ELBQ D$$\ ^D$$X j ݀+ELIQ D$$mx ݀^D$$ `݁+DLRO D$$̔ ݁^LD$$ ݁Z݂+DLD$$ SO ݂D$$׾ ^L݂d݃D$$L +LW N ݃D$$1 ݄݃D$$qd +QEMU ݄D$$ ^݄ D$$q` +DLNC D$$) ݅^^݅D$$

ݥݥD$$Lݨ+OLCD D$$WZ ݨ^HݨD$$$hݩ+ENBQ D$$lv ݩ^D$$|ݪ+RGAT D$$S ݪ^D$$ݪݫ+ROD$$ BD ݫD$$ ^/ݫݬD$$wZ+ROCD ݬD$$^.ݬE-ݮD$$M+ELSS D$$ ^ݮD$$DHݯ+ERBT D$$0ݯ^ ݯD$$?ݰ+NIAD D$$u, ݰ^XݰD$$:Fݲ+ROID D$$BH ݲ^,D$$pVݴ+ERAT D$${d ݴ^ D$$]Rrݴ b bD$$D+ERIT ? D$$2ݶ^ ݶD$$Oݸ+MC S D$$ݸ^3ݸD$$ĸݹ+EG T D$$C ݹݹD$$ ݼ+OC S ^ D$$Y ݼݼD$$.ݽ+ERPT D$$ ݽ^ D$$ ݽݿ+ERRTD$$ ݿ^D$$tD( ݿ+!D$$6ELCQ D$$XD^D$$kR+NISD D$$`^XdD$$Rn+OE R D$$|D]%$$M+ELCS D$$4^D$$+ROAD D$$ ^-D$$ +VD R D$$%M ^ D$$v+ELMS D$$  ^D$$7 +ELD$$KRQ D$$f^D$$E$+ERCT D$$B2*e^ D$$U@+XE P D$$ND$$K\+ELMQ D$$6j^ D$$>x+EN W D$$ۺ.D$$+ELSQ D$$ۢ ^D$$+LC S D$$0  D$$0+RSAO D$$ ^TD$$F+RSBOD$$ ^D$$TF+D$$RSCO D$$ ^TFD$$`.+NR D 8 D$$<D$$GJ+RSIO D$$X^TFD$$Mf+PO N D$$tD$$y@+TSCOG D$$^ D$$+LR N D$$X@ D$$+TSAR D$$  ^PD$$m+TSBR D$$ ^PD$$P b bxD$$D+TSIO D$$)3^D$$?+RSRO D$$ *^TED$$8Z+BA I D$$F ^D$$AGT+DA I D$$\b ^D$$Qp+NU ID$$~ ^+D$$&'+D$$QTSBO D$$ ^D$$$S+TSSO D$$Y^ D$$]S+BA R bED$$A^D$$;+TSIR D$$%^PD$$+ +RR R D$$> D$$&+TSRR D$2ܒ$4 ^PD$$) B^+TSSRD$$$P ^D$$a^^P^( b DD( lb a af a ao D($y z a a{ a b bD$$t}^+ \\]\ DD$\e]\ +T.TX' D$$tNIUP'T \\D$$^" \\^ D$$b\\^" \\D$$I^^ \\^ D$$8\K\^ \\D$$H^" \\^!D$$  \\^ \\D$$s^+ \\+T.TXD$$' UOPTTU ' \\D$$%"^" \\^D$$P0 \@\^" \D$$%>\^^ \\^D$$kL \\^ \D$$rZ\^+ \\+T.D$$whTX' RP'D \\D$$v^" \\^D$$# \\^" \D$$’\^^ \\^D$$s[ \\^ \D$$Ю\^" \\^D$$`,! \\^ \D$$N(\^+ \\+D$$T.TX' RP'R M \D$$I\^" \\^D$$U \\^" \D$$ \^^ \\D$$p^ \\^ \D$$\\ b btLD$$,&T&+******W**** D$$Y: \ +I SNRT .ON . D$$H \ L%\ +D$$]V' \ D$$d\\ + 'AH SON TEYD$$kr TEB\ +NEC TAREDED$$3F RO \ \ /"\D$$ b bPL&TD$$=&P+NITS.RN .O= D$$ \ L%\ + D$$A \ \D$$'4\ ]\ L\D%$ɼ \e]\ \@ D$$](+** \D$$O \\ +* *LIELD$$AG LOCED\ \  D$$ bb$\.D$$\.\D$$(.\.(D$$6eE\.D$$ϨD^L$D$$dRT$L#T#\+ D$(` ep aED$Mnde \ E$$|e P d DR,$$+ e ED$ae^D$$jƦ^L#DD$UT#dp bbZ^D%$"!e \\D$(c) \\d^D$$1![ \\]\D$$թ bbf^"D$$!e \\D$$ \\d ^D$$Z \\]\D$$$ bbl^"D%$&02Z"!eM \D$$o@\\\dZ^D$$nN \\]D$$Ax\\ bbx^D$$BNj""!e D$$x \\ \\D$$[d^  \D$$Ô\]\ bbDD$e^"eH$$R^ \\E$%;d^"eD$Dq \\d^D$$% \\ \\D$(#" \\d E$$Ge \\d D$$ \\L% \D$$¾\ bb4\H D$$ ^ \H ^D$(.,#H H "eAH DD$ӗ<P d\H .KDD$gJ<(!e+**A SSMELBREC DOD$$X\ + EREOR R : D$$f \ \ P HD$$t H e\H D$%\ H P dv\ D$$#+**L SA TEROCDRDE\D$$) +P OCEDC UOTNRE= D$$\ L% \ \ L&D$$/KT&\H .L(D$$UH P H H \D$$]H .K<("m"eD$$" \H .L(D$$\{H P d bD$$bJH e!H D$$ e!\\ DD$zd  bbX+R.XD D$$`c* 8 \\6D$$ 8+E.TX DC.TS. LC D\D$$F+CPTR N \D$$T\ ^0T^9.D$$#b@L.@ex<L.$'D$$p<LTdc^AT^ZD$$]~.@L.@e8L.$D$$'8LTd8^D$D}y'<'8\)e+**A SSD$$aMELB YOCED\ +S CED$$QYITNON TOP OR\ +EPD$$DLR YNEED.D \ \D$$P~ +**L SA TEROCDRDETMD$$A\ +P OCEDC UOTNRE= D$$-\ L% \ \ ^D%%o7\e\d]D$D \ L^;e\LD($.8(eL D$$& P@ @e: ^ D('$4  d)  \ D$%>BP#L^;#!ep]D$DLP\ L^;en  D$$>^ L L^:enD$%b(l d>\ e D$%{z  ^ ex D$(c稈 @ @e D$$|    E$$cd+PJ C ED$⡲e a +SJ R@ CPTR ND$$z \\ddD$$(w+OP P e E$$a  +SD Z4 1 D$$! \\+DL A D$$0 \ aD$$ \+@ 14 D$D \\dd+UPHSD$D" eo a D$$0 H+SI Z4 1 D$$>\\+TS A D$(RL \ a\D$$Z+@ 14 \D%$h\dd+OLDA D%D v e a  D%(ф a a a+SJD$$X R@ C.DL \\D$$^J \\ \D$$n\+DL A D$$Ӽ\\+@ 74 D$$x \\E$$#dd+TSRO  D$$ ^E"eJ E$$a  +TS A D$Dr \ a\D$$#+4 7 \D$$zg\+SJ R@ C.TS D$(R, \\ Ca \D%$CL:\ a \\E$( Hdd @ @ea D$(w6V\  dN\D$$d e+R.XD 01 D$$fr\\ b$bD$$L \Tr D$Dߎ\ \eDD$^ d\ aH(DB  d#ed \D$%X\\d% a'd%D$%\  ^@ad%DD$ a'd%\ \ 1 D%% a&d% a'd%D$$\ \  D((^a`d% a'd%\D$$ \  ^DDDa a`d% a'd%\ D$%( ]\ L^Le; ]6*DD$6 \ d- \ D$$D \\L\ D$$)R \\]\ d%DD$/` a'd%\  \D$%n \]\ d% aH$$-| 'd%\  aE+E$g d% a'd%\  D((o ^ad% a'd%D$% \  ^ad%DD$w a'd%\  D((D ^ad% a'd%D$Dh \  ad% a'dH$$5 %\  aEE$ d% a'd%\ ]\D$$J  L^Le !]\ E$$!d \  \\D$$!L\ \\D$%95$!]\ d% a'd%D$$2!k \\ \\D$%5@!]\ d% a'd%D$%N!]\ L^Lea!]DD$Hl\!\ dS!\ \D$$j!\L\ \D$Dx!\]\ d% a'dH$$Vӆ!%]\ L^ e!]D($ȭ!\ d!  D$$^!L \ D$$h!\ ^ a D$$X! ^ \\D%E!]\ d% a'd%\D$$N! \ \ aH($[!d% a'd%  \D$$!\]\ \e!D$$6"]\ e$"D$$_"] \\D((9 "d "d% a'd%\D%%."  aam&d% a'd%D$%g<"]\ L.eO"]DD$J"\ dA" L D$$X"\ \ D$$bf"\\ 0E$$Jt"e"+T.TX D$$"\0\& 0\D$$K8" '\0\ 0D$$R "\ \d5# DD$T%" 0e"+T.TX D$$M"\0\ 0D$$"\ ,\0\D$%" 0\ \]d5# D$$"0e#+T.TX D$$۫" \0\D$$7# 0\ <\0D$$ d#\ 0\ \dH$$#5#+T.TX \D$$ۘ*# \\]HG\D%$=8# d% a'd% aH($wF#&d% a'd%  \D$$T#^.\ \]!\D$$b# \^0\ M!\D%$ap# \d% \\D%$r4~#\ a"d% \D$$r#\\ \ \D(%虚#\d%rg#dE(ET#dddddddE(E#dddddddE(E#dddddddE(E#dddddddPE(Et#ddd d d d d E(E#d d d d d d d E(En#d d d d d d d E(EՊ $d$ d` d` d` d` d` d` E(E8$d` d` d` de dz dz dz E(E‰&$dz dz dz dz dz dz d E(E;4$d d d d d d d E(E؈B$d d d d d d d E(EzP$d d d d d d d E(E^$d d d d d d d E(Exl$d d d d d d d E(Ez$d d d d d d d E(Eņ[$d d d d d d d E(E:$d d d d d d d E(E[$d d d d d-!d-!d-!E(EQ$d-!d-!d-!d-!d-!d-!d2!E(E$dI!dI!dI!dI!dI!dI!dI!E(E$dI!dI!dN!d!d!d!d!E(E$dX!d!d!d!d!d!d!E(E$d!d!d!d!d!d!d!E(E $d!d!d!d!d!d!d!E(EU~%d!d!d!d!d!d&"d&"E(E%}%d&"d&"d&"d&"d&"d&"d&"E(E|"%d+"d7"d7"d7"d7"d7"d7"E(E~y0%d7"d7"d7"d<"d<#d<#d<#E(E\u>%d<#d<#d<#d<#d<#d<#dA#E(EtL%dI#dI#dI#dI#dI#dI#dI#E($Z%dI#dI#dN#AAAAD$%>h%AAAAAdw#AD$$v%AAAAAAAD$$fb%Ad# b^bj+UOPTTU D$$V% +RP R D$$֠% +NIUP T D$$ˮ% + ;D$$9%====P M4CAB GE +NID$$O% SON W   D$$ؕ%T+^0.T (T%T*D$(:%^P-L*H-e &L*D$$%P.L.+ D$Dz1& L*T*d% aj]D$$& ] ] D$$̹&] ] D$$,&L^.]+ITt T D%$|:& "er&+********** D$$8H& +N OITLT EOFD$$pV&NU D +********** D$$7d&   ^7D$$^Er&L ]]D$D& L e}&CG]D$$ & ] L^Ie&D$(̦&T,d&L^Le&T,E$$.I&d&L^PL^?#eH($_&&T,d&] L^.D$$HJ&e&T,d&T,L,,E$$ &d<)]) L%L)L)5D$$&"e''L'T'^I D$$& L) ^  + ;??D$$& ?CPDO E +C UOD$$ 'TNO TUO FTS +PE? D$$1'??   LD$$9T(')T%] dL)L )D$$r6']* L*] LD$$SD' e?'dL)D$$R'] ] D$$#`'] ]+IF L D$(2 n' e{' ad)]D$$s|'+WS 1 ]D+$$|'+WS 2 #]D$$n'+WS 3 #]D$$Oe'+WS 4 #e&(D$$Di'] L^0L^1D$$'#e']L L^D$Dx'1e'T)d'T)D$%/'T*P-L*H-e (]D$$ʆ' ]L*L L)D$$e'L.L(T)L*TD$$(*d'].L(TD$$~Q(*]L*L)] E$$O$(d)]+XT T D$$*2(^M"e(^. ]D$$@(] L D%$6N(L^ eE(T*P-LD($\(*H-e(] L0D$$߅j(e}(0 "0DD%x( d(L0e(0D$$( <0 d(D%$(L0e(0 >D$$e(0 d(L D%$5(L*T*d[(] LD$$( d)]+NE T D$$/( e(^. D$$(]\d(]+NE D D$D( !e(^.D$%r( ]!e)]D$() L e)]DD$ ) dL) azL%T%E$$ )dL)L ] LD($O.) e')L] dL)D(E3m<)gB)d&d1'dR'd)E($rJ)d")eX)] dL)D$D8X))e&L'e)+-;-- -D$$f)ON .FOW RA +INGN SD$$"t) = L' D$$#܂) L&e)+*;** *OND$$a) .FOF TA +LAE RRROD$$,) S= L& D$$>e) +E.DN D$DU)L&e)^7D$$0)  aH">)%*@') _R2SBOOLEAN.RBY!6z34?I^PFYD$$\!,!L !4!!,@!D D$ sC!4!!,π@!D  _P4PASCAL.RBYN7b3UtB$I$I$IJ؉() ׉-ykRډ(ى-׉։Չ!Kx%( @ʡGz ˾-؉c(D$$bbde}+* ** * D$$ \   D$$~:Ф  ex D$(.*  e=^,DDDQ8\ dU eM^ \D%$ F  d=^^\ D(DFT  e^dideHD$-bgdi\  D$$ p d \ ޤ$D%$)~\)!"e!!!\ D$$J+ \DD%TD &e \ dD$$Uv\ ^ \  bD$$4b<й<$D$$K,~L' Ԥ eD$$  ޤԹ߹D$$+^' dD$$FԥݤݤD$$x bb<+4PREORSR D$$[   e%D$$ ?  dD$%w& b bVe8$e5\ D$D4 a\)!eS\D%$B\ $eN\ D$$Pdw+ * **E FO D$$ ^ \ +NEOCNUETER D D$$l \ \P P b DD(@zb a(^*e^TD($8e a(^+"dDD$vؖ^Le a(^+$$D$$2m!e\ d^DeD$DA a(^+'d^CED$e a(^+p&# a(DD$9^,e| b8b ^ DDD!"e a(deH$$/ a(!e].D$$e / ^a E$$a(d.deH$$  a(]D$$".^0(eD$$%D0e8dG^ D$$> e8]D$$L]E$(-Zez]Geu]D$$+h]Id~D$DvdWdD$$N.LeD$$ a(].eD$(^.^E#eDD$(S^.eLeD$$( a(^.e$H($Ġ^:d].E($նe adLD$%e a(]D$$כ.e^Ee]D$$V-LeD$$ a(^+^-#e]NH$D 1Le.DD$, a(].eHE$:A ad]LE$($HeP a(]D%$JV.eAD$%Rde}D$^(Or^ dkLD$$ eeD$$ dH%$9d a^0 D$%w^. ^0 dLD$%e adD$$ceLeH$$ ]l.D$$Ad adHD$xd a(D$$e  D$(> ^'#ee aH(%^^d  a(^'eD(%(e4.dgD$$M6eF ^aD$$.DD$$OhRee DD$?`dPd a(D((i,n^=e{ a(d}D$$L|d a(^.eDE(6 a(dd a(D$$~d^=e  a(dH%%+^>e  a(dD%$ cd a(^=eH(%qN  a¥(d d aH%D(^*e a(^$ED(iAe ax^*e a(ED(Dd a(^)e a(E$$(dd] .D$(]n. a(d/D%$d>gdAAAD$(J$dAAddddHE(zh2dddddddHE(v@dddddddHE(NddiddddADE(#\AddddddHE(yjddddmdddHE(yxdddddddHE(ydddddddHE$EAdd bbD$(伢;9 e;9 D$(Wzd e eaH$$A  d He D($[ d   ED(:He e d D$$f  bbLDDEtqeeddDDDeddH$$ bb9: t:D$$  e];: eXDD(. eI (e=ddH$$;<G%eD ga  dV D$$JeS  dV  d)DD%'X::d%e haD%%f(em5 d(ev3 $E%(td(e2 d(E(($e4 d(e1 dH$$0  bbD$$e E$%e  d+D$(e?d D.$$e   bbD(%!JeQd;-D%%43ed*eE$%eded+D%%2ed,eE((4ddQ adQD$%NJdQdQdQ D(D*adQdQ ^aH%(8dQg?ddddHE(eF d(d0d$d4d4 bD($DTbP a  D$$b   bb(LD$$epXTL b$bD%(%~e adD%$e#e+. ITLT D$$!W \\D%$ \!e+. NE TCPDO ED$$K  \\ aD$$ . L ^(!eD$% aek aD$$eV  ]D$$r$]#]D$$#!#]"#E$$ e= (D$$D$$ڈ&   DD$r4  a 6 D$$UFB6 a^H(!eTD(D 0P adZ a eH(D^ eh a aD$D3l ev ady aD($z e  D%(e  d{ 6d#eD$$*+. ITLTE TXES G \D%$Ѹ\#e+. XTMT1 D$$Q \\+. DRD$$ X01 x\\D$$ +. RNLE \D$$ \ !aDD$be a\D%$?)#e#e +. NE D D$$ͯ \\\ D$$> \ !"e ^>D($" e(  a b^ b.+NIUPD$$Q0 T +UOPTTUD$$> +RP R D$$>L  aD$$+Z  a '^@%ED$&;h ayes a^?0+ D%=v  a) * _R2SDECODER.RBY!5sG@pH{{C<{{#<( D$$?$9)KKGp4)  _PASCAL2.KSyyPASCAL2.KS -- LANCASTER NOVA PASCAL RELEASE 2.1 -- KEY SHEET THE DISTRIBUTION TAPE IS 9-TRACK, 800 BPI IN RDOS DUMP FORMAT. FORMAT: MT0:0 PASCAL RELEASE 2 PROGRAMS MT0:1 DUPLICATE OF MT0:0 MT0:2 PASCAL SOURCES (IF ORDERED) MT0:3 DUPLICATE OF lMT0:2 THIS IS AN EXAMPLE OF CLI COMMANDS FOR LOADING AND RUNNING THE LANCASTER PASCAL COMPILER OUT OF SUB-DIRECTORY 'PASCAL'. WARNING! OMIT THE COMMAND '@MAKESPACE.CM@' TO RETAIN ALL FILES. INIT ALGOL CDIR PASCAL DIR PASCAL LINK (ASM,MAC,XREF,LFE,EDIT,^zRLDR).SV/2 LINK MAC.PS/2 LINK RLDR.OL/2 LINK MATH.LB/2 LINK RFPI.RB/2 LINK SYS.LB/2 LINK LIBRARY.CM ALGOL:LIBRARY.CM LINK ALGOL0.LB ALGOL:ALGOL0.LB LINK ALGOL1.LB ALGOL:ALGOL1.LB LINK ALGOL2.LB ALGOL:ALGOL2.LB LINK ALGOL3.LB ALGOL:ALGOL3.LB LINK SMPYD.LB ATdLGOL:SMPYD.LB LINK NMPYD.LB ALGOL:NMPYD.LB INIT MT0 LOAD MT0:0 RELEASE MT0 @MAKENEWPASCAL.CM@ @MAKESPACE.CM@ PASCAL /Z DEMO.PS $LPT/L DEMO $TTO PASCAL2.KS -- LANCASTER NOVA PASCAL RELEASE 2.1 -- KEY SHEET PREREQUISITES: The following Data General CCorporation RDOS utilities are needed in order to create the NOVA PASCAL system: MATH.LB RFPI.RB RLDR.SV and RLDR.OL ASM.SV MAC.SV and MAC.PS and XREF.SV LIBRARY.CM ALGOL1.LB ALGOL2.LB ALGOL3.LB SMPYD.LB or NMPYD.LB or HMPYD.LB or EMPYD.LB Load'ing If the system was supplied on disc, then you should be able to use that disc to compile and run NOVA PASCAL programs without any changes. Loading from Disc If you need to move the NOVA PASCAL system to another disc using a different revisikon of RDOS the following procedures should be used: 1. Move the NOVA PASCAL system binaries by a command of the form: MOVE/A/V directory @P4BINARIES.CM@ 2. If you require hardware multiply/divide: DELETE/V R2SMPYD.RB LFE X library title REN"AME title.RB R2SMPYD.LB where library is one of NMPYD.LB HMPYD.LB EMPYD.LB and title is one of NMPYD HMPYD EMPYD as appropriate for the multiple/divide unit 3. Create a new systemqO PASCAL system by the command: @MAKENEWPASCAL.CM@ (over) Loading from Cassette If the system was supplied on cassettes then: 1. Load all cassettes supplied using commands of the form: LOAD/A/V CTn:1 where n is the cassette drive number. 2. If the PASCAL system is to have provision for a hardware multiply/divide unit, then issue the following command sequence: DELETE/V R2SMPYD.RB LFE X library title RENAME title.RB R2SMPYD.RB where library is one of NMPYD.LB L HMPYD.LB EMPYD.LB and title is one of NMPYD HMPYD EMPYD as appropriate for the multiple/divide unit. 3. Create the new NOVA PASCAL system using the command: @MAKENEWPASCAL.CM@ In either case the total time tak%fen to reload the system is about 20 minutes. During the initial creation of the NOVA PASCAL system the following messages will be produced: FILE DOES NOT EXIST: P4LIB.LB $BIND.RB DELETED: $BIND.RB FILE DOES NOT EXIST: P4LIB.LB $BIND.RB XDELETED: $BIND.RB FILE DOES NOT EXIST: PASCOVMAP.LD FILE DOES NOT EXIST: P4ASM.LD FILE DOES NOT EXIST: P4MAC.LD FILE DOES NOT EXIST: P4ERRSUM.LD FILE DOES NOT EXIST: PASCAL.LD FILE DOES NOT EXIST: PCODE.LD When the NOVA PASCAL system has been created to the required specifications, the following command may be issued to remove files which are no longer required: @MAKESPACE.CM@ Having issued this command, however, it is then not possible to reMAKE the system without reloading.  Ref: CSD AF024 R2SDBIN.RBYU.&GH|`z|b CCnCCD8$4Y2Q9!  -Y+Q2A*A*A D$$))')! #)#1D$$ ) I)RD$$r*1PPP+D Q8-09S _DEMO.PS '5[PROGRAM DEMO(OUTPUT); BEGIN WRITELN('HELLO'); END. PASCAL.RBYY %b                 &                      AFNF   * DĒ(ZL   H($: KZf@     TE98}h  ]   D'9vr   b "GED g   G' r  a bG$$   a# #D$$׮ #C#C'PD%$굼 C#GC#8+XG%8f  P8+KG$$Mb8#3B#C D$b   + D861    H%$<*>  D("G  &@  nH8 8#8C*8#8C Kb'', A   ,E$ȁ:1 %  1 %   H(%H&   1@  DȔ$V K 1|G"'$d@    1#D+$3r z   D$D    R E$$;)  #  D$'Ĝ    D$G  R GY +  D$81   G89ƛ    R D88 -   GĜgx    D%"  R /  Dď E  D$$^D     RD($ C 1   D''>A(   G"'$6    R 3 G''>D   X$P{R  " d8# XB%n `8C8X  " t8#X۔$`Dn 8C8X 5 " Plǒ(|8# 8C8X  " BEǢK8# 8C8X 6 "Db;Fg 8# 8C8X H*8!% " 8# 8C814XY$GZM [ 1@  5 DP" 8# 8C "G$8_  *   G'+~%  z  DPǫ~" 8# 8C "G$8  R -  9G'+=%  z 6 DP[~" =8# 8C "G$8$  *   G'+%2  z 7 DX@" a  R DĒN)  # XX$:\ z  "  DD(!j  R 3  D$$ڹx  z EB%읆% " 8# 8C DD("  *   &D$$  z EB%q " z8# 8C8G$$k+8K  R H$$43    G"'$   1 #DĒĕ   bE"'$1n  R 8 G''<l   X9$   1 # D$$ /  "K$$ϟ.n  1# K9$<Y  *  Y8DlJ e   K9$Xn d  *  X8$f   a  H$Eڕt a e:  "GGEۂ e=     Gb8#8X   K"G  1?  D$+rǬ1B ӊ#+  rD( uD r X9$a r r DD$w 5  HĒę 5  rY$$ح r  DD9r \r ? GĢ$\   1G Y($(3 1I #+ X9$k:* r uL r`P+Ǟ8h# 6hC 8#8XX8qFX ^  r"G$X T ro &G"'$Db r rHb9|p=` phC G GbǗ~   8#8X DD$f 1P # HD+s1R #  8bGb%$;#8X  r uEb%$3T r r uE89aW r  5G'"'  r DĒNr & rY$$ܬ r  DD8=r r 98#["+DE 8X  P  Hb8*R    8#["+%n&8X 6 1Y #dE$$ 4> 1[ # X9$njB r u] r &D$D,P r G"''8^r  5 D$$l r rX9$z r  r D$Df, r G;"+3r 8#8X  HbǤY  [   A"G%D 1_  1a D9(-#+C 1c #+DX9   r u] D$$ Ar & r H'"'Ar  5DℜXcv`h# hC D  r D$X r `  hC DZ" # 58# `G$pj0 - hC # DD%4I> r r3 `G$L I hC r E89 Z a r r c D$$@h r  r H';0v r 8#8X lE$,Ԅ    8#P[($Q% 8X  C   D%v  e  H'"'/B zj r DǬ6 r 8'C8X  Y8b'Oc  _     &DD8  h 8# 8CD' PKO `hC 8S8G$?v #8CCCCC8#8CCCCl[Ȓ(Y  8X    - @ # DȒ$A P   )*+,D9$ -. D & E$"' ,,  j   + H%(:  m +o *o )H(DH      #DȔ$PV _  # v P(Kd 8#8C  [ I 8#XȔ$Vr 8C  #  YD$   l #+ DD$[   #   H$"+ #   Dl%D #     )*D$G +,-. $  D(%0 & 8   , -E(d%  .q #   Ed%(  s    u Y((:     K    X%e* Ed%]  >7L%$ 24DLE,e( TX\`dh Ddd-6 lp  L,$2D   L,eOR  B E$,` & 06LE,$}n TV b p APCSLAM NOD$$| TIRO... : E TNREDE D$$2 REOR(R)SI N-POCEDA SSMELBRED$$2 .D EO SON TXESITOC.MMCD$$t OC.MMCVSSLCPDLCQ%D$$V, BRBLONS UOCR EIFELS EPICD$$a IFDEOC.MMCI NREORR4POCPMD$$ LIRES.V4POCPMLIREO.L4POCPMD$$: LIRE4PRESRMUS.V4PREORSRD$$A 4PRESRMU4PAM.CVS4PSA.MVSD$$ 4PAMC4PSAMAM.CVSSA.MVSD$$A LRRDS.V4PUC.EBR4PIL.BD$$ BLT$OTONAVP SAAC LERIVISD$$$ NO O N/ IFINHSDEW D$$2 TI HREORSRS CUECSSUFLLY@? $I]FH~P!OT ?U:YN $Itf!ot zAO _x 2N,D If  _R2RFT.RBU!9PSH+&K\vRD'$PEA8;) !4!D$$!4!!B!B D$$RUT!4!)D$S*!$!@! X3!DA ? ,) (  X)!$) DӒ$_?  0 !1)Q D$$א$!S1*J!@ `D$dwOCb.MMC |@9@7RkGN   *s DĒ(L   H($ IZf@     TE98h  ]   D'9Cvr   b "GED gb   G' r  a bG$$    a #D$$׮ #C#C'PD%$굼 C#GC#8+XG%8f  P8+KG$$Mb8#3B#C D$b   + D861    H%$n>*s  D("G^  &@  nH8 8#8C*8#8C Kb''', A   ,E$Ȓ:1b  1b  b H(%H  b 1@  DȔ$V Kb 1G'8 d@    "G$8r R   #G'h"   XĒȃ    R DĒ8   X$$9  LX  DD(  R  D$'D   D$$˯   1# bEĜP    D%#  R  DĈ #  D$$YD      RD($D   D'$q(  d " BEǢد6@8# 8C8X  "Db;gD P8# 8C8X H*8#R " `8# 8ӫC8XX$8'`  " p8# 8Cb[DPn8X  " 8# XȔ$ z|8C8X [b 1G$o@   " 8# 8G9$.oC  * s X88H    K$  "   H%$BR   # D   d " D$$  R H$$z7    D(*  " '8# G$$S8C  * H$$h7s  &  D(*$  " 8# G8"'U28C8+8K  RDG'@    D89TN     DD$$G\1# p  D+9իj   R D88jx   GĒC|     1Db%$ #   DY$w 1#DXLj   * DĞn  e  s DX%  * D{s   DDd%$a   a eE985   e   E8$ Rb  8#8X  bGX8gv   8#8XDȔDR  . 1 #6Y(b%@. 1 #  X$$<8#8X R r H$$5Ju r^ r H'"'9Xu r  5D$$Af  r D88tr & r"G$$ r  D'or r 8bGd%(0#8X   Y8'I  4 C  8bGd%$ #8X  1 DD$-# 1 # K"'DB r u r DĒ & r D$$nr  5 D$D- rr= G"'Dr r s r DĒ  r Dbd% 2*r 8#8X = EY8L8 B  e D$(F  1  1H"'%'dT #+C V1 #D+"'b+ d r uHĒp r & rY$$+~ r  5D0++`h# hCX89>  r DD+^r` hhCX90.5 # 58#DX$` hC # DȢ$r rDX$` hC r H'"'9 r r HĒ{ r  r&aY$b)  r 8#8X DĒ8Wl_  8#bG%'&P8X ^C  X9$u4  es Y$$+B z r D8;pPr 8'C8X "[G-^      DQl& 8# 8DD87zCK`hC 8SP$88#8CCCCC8#8CCClGE5C8X  g - @ #Dْ$ϊ   )*+@D"'D ,-. Df & HD$f  }  E$%f  + * )EE0j  f   #DYDL;    #D$D+   E#Dl$   # ` "[$$˰   )*+,-D(_" . f & f HD$T0 g ,l -l . DY(]D> # L  , f  S Y((cL  D f   M f j Yb;$~Z  f   De%Kh  Dd,v >7D,,s L%%   (8Dde@G BLRX`hE,,۠ jr| Ldd    CPDOD$$ EOMINOT.R.. : E TNRED$$ DE REOR(R)SI N-POCEDA SSD$$t MELBRE.D EO SON TXESITOCD$$ .MMCOC.MMCVSDLCPCQD$$Qq BRBLONS UOCR EIFELS EPD$$( ICIFDEOC.MMCI NREORR4PAMD$$ .CVS4PSA.MVS4PAMC4PSAMD$$j7, AM.CVSSA.MVSLRRDS.V4PD$$8E: UC.EBR4PIL.BBLT$OTONAVD$$2H P OCEDR VESIOI N O N/D$$^V IFINHSDE.TW TI HREORSRS D$d CUECSSUFLLY@j $IFH~P!OT[ ?U:YN $Itf!ot zAO:_x% DCInT ~ _MAKESPACE.CMj ܫDELETE PCODE.LD,PASCAL.LD,P4ASM.LD,P4MAC.LD,PASCOVMAP.LD,P4ERRSUM.LD,^ MAKENEWPASCAL.CM,MAKEP4LIB.CM,MAKEP4LIBN.CM,MAKEP4COMP.CM,^ MAKEP4ASM.CM,MAKEP4MAC.CM,MAKEP4ERRSUM.CM,MAKEPASCAL.CM,MAKEPCODE.CM,^ R2ROUTL.RB,R2IOUTL.RB,R2SCONSTS.RB,R2SECHKH.RB,R2SITAB.RB,^ R2SADMIN.RB,R2SINTEGER.RB,R2SBOOLEAN.RB,R2SSET.RB,^ R2STESTS.RB,R2SMISC.RB,R2SSPTAB.RB,R2SHEAP.RB,R2SOPN.RB,R2SIOIN.RB,^ R2SRD.RB,R2STI.RB,R2STP.RB,R2SREWR.RB,R2SRANDOM.RB,R2CRCODE.RB,^ R2IREAL.RB,R2RREAL.RB,R2IFNS.RB,R2RFNWS.RB,R2IFT.RB,R2RFT.RB,^ R2IFW.RB,R2RFW.RB,R2CSPTAB.RB,R2CITAB.RB,R2SDBIN.RB,R2SDECODER.RB,^ R2SDIV.RB,R2SMEMACC.RB,R2SMPD.RB,R2SMPY.RB,R2SMYP.RB,R2SOVL.RB,^ SWOP.RB,^ P4ASM.RB,P4MAC.RB,P4PASCAL.RB,P4BLOCK.RB,P4BODY.RB,P4INIT.RB,^ P4CODjEGEN.RB,P4DECLARE.RB,P4ENTERERR.RB,P4ERRSUM.RB,^ PASCAL.RB,PCODE.RB,^ P4BINARIES.CM,MAKESPACE.CM^ R2SOVL.RBY!9Sϕ@pynD$$j *"( Q! ?( !$ 1 ? D$,! )( 24POCPMDhLIREO.L _R2SIOIN.RBY!7"34b R#Tz@ClA_T[B8wD$$CP A !4!!.RB,^ R2SMYP.RB,R2SDIV.RB,R2SMPD.RB,R2SDBIN.RB,^ $BIND.RB,^ RFPI.RB;^ DELETE/V $BIND.RB^ COM.CM6XNSPEEDPASCAL2.KSR2SDIV.RBYU.tH@}6D$$r#Y!QIABpPKD$$/CY1C 9D$B!)@_c\ _P4DECLARE.RBY $6Yto$I It2 u q(0 Q-LP(O-!-%!2ll۳2Չ#!׉։!ى--D$$Wb,b (!e D$$a 'a(eDD$e9;9 eH($*099d#  D$$8 G%$"FaesD$$UIT D'$ b a a)X'$jpdw a^HDD$~'(!e a ^HDĒD>'a eE D%f9 e ad G$$Vlade ^D'$a ae D_K$$ D8'5 a e aD$$ EŒ8Ne ad a  D$$a   e  DD$e kad e DD$9 dl   D$}&^' a a E8$u4e< a  D$$?PB eT G$$lPadX a  aD$D^   el kaDD$Nl e eDD(ze,e ^G$(xade faX$D (!e aD($J ad  b4bD$$l ^@'(!E8$e@ a ^@'G%$Mae eD$$o D$'   a aX'$d a^(D'$!e a ^ @D$$u'a) PH!e$ G((_"aHee2 aE8$R0d6 a ^@'D$$>a ec  \D$$ La  HD$$ adB G$$@a   D$$;N ^D%$\ ' a  E$$Yje e ,e D%%%)xma d -e G$Da  d qaD$%S  PH!e aXDD4~HeD e adHDo a*e adHĒ( a( a D$% e DĒ(a +edH8$@ a D$%  edDD$eh a99eH$$D'99;9 4D%8[I d+ a D$$ .^%^' E$$<a ;9 D$$U9J 9DDDX'eb adf aE%fde ap*eH(Ģ tz ad~ a  E%$ca e e D%%%sa d ,e rG$$Ğa D%%ܬd0e aX($stPdP9GeD$8" a*e ad D$$Mae  aE8'd ya 'a D$$a D$$H (!eHĒ( a ad <D(( e' d, D$%}* bbe;9D$$8 !"eH%%FZeRdXD(DpT ad?!e{D$$ob  a  'D$$Up    aE8$*~d aK^ DD$m'(!e a K^ D8$xh'a PH!EĔ$Z#e aHe1 eDD$uT ad a bbD0D$e a K^D8('aeKD$$ Y    D8$< a "eH( ad a K^D$$, 'a aD$%#  eE aX$$ʃ&K^'(!eCD$$a4 a K^'aX'$]BdI ad bbDD$oPed a K^D8(^'aeD$$~lk    G$(za "e aE8$d a K^DD$Ã' a a /D((2eeD$$i/edH$(/d EĒ$e aK^'D$$2(!e a K^DŢ87<'ad add/D$$e/  ua\ +T PYD$$ -EDI \ /D$$} \ r\ ///eHD$^"  !e/ ^ \ D$(80 bbeb D$$m>     D$$KL   8 aX8'iZ  adf  aKD$$_h ^N''(!e  D$$v a K^ ''G$%„ a PH!e  aXDD]r He6 e  adHĒ$  a K^'D(%: ' ae ^D$(M e  ^ad eH((# ~e ^ d D$8 eC    a D$$ e2  6PPHD$$l H"e He DD% Pd HPd HD$(k e H d2 \ D$$L H  H D$$, HP   D$$Y:  d  ei D$$H  aK^'(!E8$cV eg  a K^DD$d 'adm  a(~DDDCr (!"e6 /e  uaD$$' \ +T PY-EDI D$$x \ /\ \ /D%(d //e !e ^ D$$ \ b*b D$D- ^'(!e  aD$$k  K'^'aD$' e H e  wa aX$(Ӛ ^(!e  aX$'xi  K^@'a^D%%; (ep en  ^D8( a aeG UrD$$k   D$$g( 8D'l6  a  . a  aX'$ D dK  aK^LD(R '(!eg  a K^D'%+M` L'a e dJ DD ҡn eE  ^a  aX($w| e D$$   8D$$F  aD'Ĕ   . a  a^D$$i K'(!e  a D$& K^L'a eH($f z e?  ae D$$)  ^aD$$@Z e ^(!e D$$k  xa e D$DЕ    d  DŒ8X 9  ad!  aKD$D$ ^D'(!e=  aD$8x2  K^D'adC  DDD<@ adJ eQ  aX$$عN dS  e D$$!eE a^(D$$CL\)#H "#eD$Z8 9  _R2SECHK.RBY!5L$II'i`iijQ>1@UA D$$ke*;1.RB,^ R2SMYP.RB,R2SDIV.RB,R2SMPD.RB,R2SDBIN.RB,^ $BIND.RB;^ DELETE/V $BIND.RB^ R2SREWR.RBU!82#s•H.Kll1N:ÞcCD8U8[BTxyZD8'9!4!PZ 8Z? 0 ?D$8 (  ?( !4!ҐZ 8ZD$$, 0 ?(  (  (  ?D8zp&*( 41  CDD YPl[ػ8H@0 0 0(D8$sFYQ! 0 ?,( )1! !b[$$ѤT 0)!  !1.I$bh@n@p@{ _R2SCONSTS.RBY!5tc3 4DH[Bܱ@{\@{ܱ\   hcF _R2STI.RBY!8ח󷕯t$IDR"MLMpKM JNl{NztVvRn@CvA_ `}ܱ:ÞܱC{z*D$$2I!I1PB)L!4D$Ą!!$!@!,! 2(292)D$$N) (y &1&Q@ F$$*'X(J 'H'`  D$$}81 'Hł' 1 Dm$&!F'0 B D$$CT D$$5b D$$'p n D$$~ DZ Hb 3y  _R2STESTS.RBYL s$I@=D7O \В$IH$S:Q'QXQ @ qD$$ @ 6  Ap D($Ͽ!D 1 !D8$pO*!!$!D0*)  !D$$8!L!$!!,@H$,D$$fF0%5?!$!!,D8$oUT 7!0 'P!$!','D$$b!  % ''$' !PD$$p!$!','! !PD$$~ !$!','!  :I!P!Ds!!0@b& _P4ERRSUM.RB\\d+T'EH'NE PXD$$.LCEET \^D\D($LZ \d+U'TNLI 'XEEPTCD$$Ch \+DE D$$bv \\d+D$$⇄D''OE PXCE6ET D \DD$V\d+T''O'/ODNWOT ' D$$ \+E PXCEET D D$%Z \\d+I'D$$['FE PXCEET D \\D$$d+F'LI'EE PXCEET D$$2v\^D \ \E$$9d+REOR RNIF CAOT RD$$> \\d+REOR RNIV D$$=RAAILB\^E\D($ \dq;@gdHE(Ň d.dQdtddddHE( ,dddd#Id7dKdHE(:_dsdddddAD$$HAAAAAAAD$$VAAAAAAAD$$dAAAAAAAD$$rAAAAAAdHE(qyd2dFd`ddHddHD$ngdd bb>d3 +UFCNITH,NOR SELUD$$@ T\+YTEPM SU TEBD$$_{S AC\+AL,RS BUARD$$0_GN ERO\+P IOTNRED$$L \\dH$$H,n +IFELV LAEUP RAMA\D$$*+TEREN TOA LLWODELD$$'8\\dn +OFWRRA DEDD$$xFLCRADE\+F NUTCOID$$jT;NR PETE\+TIOI ND$$AbFOR SELU T\+YTEPD$$pN TOA LLWODE\\D$$~dn +IMSSNI GERUSTLT D$$\+PY ENIF NUTCOI ND$$b\+EDLCRATAOI N D$( \\dn +-FOFD$$MRTAF ROR AE\+ LD$$0NOYL \\D$$dn +REOR RNIT PY EFOOHD$$\+S ATDNRA DUFCNITD$$7\+NOP RAMATERE D$%& \\dn +UND$$T[ BMREO FAPAREM\+D$$"ETSRD EO SON TGA\D$$ &+ER EIWHTD CEALAR\D$"$4+ITNO \D%$B\dn +LIELAG LAPARD$$PEMET\+ RUSSBITUTD$$^ITNO \\dn D$$zl+ERUSTLT PY EFOP \D$$:4z+RAMATEREF NUTCOI\D$$er҈+ NODSEN TOA RGEED$$Q\+W TI HEDLCRATAOID$$r\^N\ \dH$$ϲn +YTEPC NOLFCI TFO\D$$+O EPARDN S D$$Z\\dn +XERPSEISNOD$$xI  SON\+ TFOS TED$$RT PY E \\dH$$n +ETTS SNOE UQLATI\D$$@a + YLAOLEW DNOYL D$$+ \\dn +TSIRTCI CND$$w" ULISNO\+N TOA LLD$$0 WODE 0% \\dH$$K> n +IFELC MOAPIRISNO\D$$L +N TOA LLWODE D$$Z \\dn +LIELLGT PYD$$th EFOO \+EPARDNS(D$$2Av ) \\dH$$' n +YTEPO P[ FPORENA D\D$$s +UMTSB EOBLOAE ND$$ؠ \\dn +ES TLEMENED$$= TYTEP\+M SU TEBD$${ S ACAL R\+ROS BUD$$r ARGN E \\E$$g dn +ES TLEMEYFNE TYTEPD$$I \+ SON TOCPMTABIELD$$f \\dn +YTEPO FD$$]J AVIRBAEL\+I SOND$$ TRAAR Y \\E$$" dn +NIED XYTEPI SOND$$, \+ TOCPMTABIELW TID$$: \+ HEDLCRATAOI N D$D}H \\dn +YTEPO D$$8RV FAVIRBAEL\+I SD$$Xfd ON TEROCDR \\D$$4r dn +YTEPO FAVIRBAELD$$ \+M SU TEBF LIK/ EROD$$Î \+P OITNRE D$( \\dn +LIELD$$ AG LAPAREMET\+ RD$$v USSBITUTITNO \\D$$ dn +LIELAG LYTEPO FD$$0 \+OLPOC NORTLOV ~!RAD$$ \+AILB E D$%( \\dn +LID$$wV ELAG LYTEPO F\+D$$4 XERPSEISNO \DD$U \dn +YTEPC NOLFCI T D$(*C( \\dn xqWD(En6 xg: ddd@ddE(EJD dddIdldddE(E0CR d d? db d d d d E(Ep;` d dR du d d d d D$$=n bb̒qyd +D$$}=| SAISMGNE TFOF LI\DO%$$kM +SEN TOA LLWODE \D($յ \d+ALEB LYTEPI CND$$ MO\+APITLB EIWHTD$$mz S LE\+CEITGNE PXD$$u ERSSOI\^N\D($T \d+USRBNAEGB UODND$$anR S\+UMTSB ECSLAD$$- RA \\d+D$$ NIED XYTEPM SU T\D$$ % +ON TEBI TNGERE \D($0 \d+SAISNGEMTNT OD$$[$ TS\+NAADDRF NUTCD$$2 DOI N\+SIN TOA LLD$$@ WODE \\dD$$N +SAISNGEMTNT OOF\D$$\ +MRLAF NUTCOI NSI\D$$j +N TOA LLWODE D$$^x \\d+ONS CU HIFD$$^ LE DNI\+T IH SERD$$ OCDR \\dH$$Y +YTEPE RRROI NER\D$$qy +DA D$$ \\d+CAUTLAP RAD$$dg MATERE\+M SU TEBD$$ A V RAAI+:\+LB E D$$ \\E$$ d+OCTNOR LAVIRBAELD$$1 \+M SU TENTIEH REBD$$O \+F ROAM LON RON ND$$ \+OLAC L D$(S. \\d+UMTLD$${< DIFENIDEC SA\+ ED$$ɲJ ALEB L \\D$$X d+OT OAMYNC SASEI D$$f \+ NACESS ATETEMTND$(t \\d+IMSSD$$4 NI GOCRRSEOP\+DND$$+ NI GAVIRNA TED\+D$$׫ LCRATAOI N \DD$_N \d+ERLAO RTSIRGNT D$$\ \+GAIFLESDN TOA D$$ LL\+WODE D$$t \\^dqD(E _g d{ d d d E(E* d dN d d d d d9 E($d\ d d bb̠qDD$ud+RPVEOISUD CEALARD$$\+ITNOW SAN TOF D$$*RO\+AWDR k D$$I8 \\d+D$$5FGAIA NOFWRRA DED\D$$lT+LCRADE \D($>Zb\d+APAREMET RISEZD$$npM \+SU TEBC NOTSD$$7~NA T\\d+D$$IMSSNI GAVIRNA T\D$$+NID CEALARITNO \D($\d+USSBITUTITNOO D$$Y F\+TSNAADDRP ORD$$n/CUF\+CNN TOA LLD$$WODE \\dLJD$$+UMTLDIFENIDEL BA\D$$2+LE \D%$ \d+UMTLDICEALERD$$  DAL\+EB L D$$S \\dD$$&+NUEDLCRADEL BALE\D(tВ$_4\d+NUEDIFEN DALEBD$%B L\\d+RED$$!"POR RNIB SA EES\^D$D8 ^T\ \d+AVUL ED$$lAPAREMET R\+XEEPD$$zTCDE \\D$$d+TSNAADDRF LI EAWD$$&\+ SEREDLCRADE D$D \\d+NUEDLCD$$]RADEE TXRE\+AN LD$$aIFEL \\D$$Ld+OFTRAR NRPCODERUD$$;\+ EROF NUTCOI NXED$$\+EPTCDE D$(\\d+APCSD$$ LAP ORECUDER\+O D$$09 RUFCNITNOE PX\+D$$"CEET D \DD$Q60\d+IMSSNI GIFEL' ID$$m>\+PNTU 'NIP ORRGD$$sL A\+ MEHDANI G D$$GZ \\d+D$$3hIMSSNI GIFEL' O\D$$v+TUUP'TI NRPGO R\D$$+MAH AEHIDGN \D%$ڒ\d+LIELAG LATFGD$$MEIDL\+I NAVIRNAD$$+ T \\dD%(ļqvgddEdhdHE(!dddd&d:dNdHE(0hdddEdd5dgAD$$)d b b(̑eD%%C)e ad ao dD$$b> a bb̴qE$$d+REOR RNIR AE LOCD$$\+SNATTN :IDIG TXED$$,\+EPTCDE  D$DEr:\\d+TSIRGND$$AHC NOTSNA T\+UMTSD$$uVN TOE CXEE D\+OSD$$BdQr^gMddH$$P0 bb +UOPTTU D$$^ +4PREORSR D$$jlC GGeCD$$z C dt^D$$.ˆ  +REOR RUSMMRA Y D$$ ^  +****D$$R******** * D$D GGe;;HDD$nHe6 (eH$$ 1<^  D$$0YX^: ^  dH((r ad1 ad1 aEEEz>d1 ad1 ad1 aH((w`d1 akd1 ad1dH%(U1 6 gddddHE(Y"ddd ddddH((0!ddCDD> aR*@D _MAKEP4COMP.CMdU GDELETE PASCOVMAP.LD;^ RLDR R2IOUTL,R2SCONSTS,R2SECHK,R2SDECODER,^ R2CITAB,R2SMEMACC,R2SADMIN,R2SINTEGER,R2SBOOLEAN,^ R2SSET,R2STESTS,R2SMISC,R2CSPTAB,R2SHEAP,^ R2SOPN,R2SIOIN,R2SRD,R2STI,R2STP,R2IREAL,^ R2IFNS,R2IFT,R2IFW,R2SOVL,^ R2SMYP,R2SDIV,R2SMPD,R2SDbBIN,MATH.LB,^ P4PASCAL,P4BLOCK[P4INIT,^ P4DECLARE,P4BODY P4CODEGEN] P4COMPILER/S PASCOVMAP.LD/L^ R2ROUTL.RBU!4wtϔHF y Z1N:lܱ\D8U8c[BTx$ID AIAEG$'Y(:ZY(D88"  Y("ŏP8@D„$' !( H , ) ([$:p*H,1 (0P0"P$ 8 03( @F@JMcJ$4@m@)@@^D$$YN $@#H"H!H!$8#\ D$$a4z\Q! ?( 12P)TQ & D$fcj N1 PN1 *O!PPH!HA 0 Z$xgx0  ? X4!DA ? -) (  X*!%) DӒ$[?  0 "1)Q D$$;%!S1*J!@ L$lcIbx?OC.MMC ~D-ؾ@8@6@QnGN ]%+EGRTD$$ VLNAOD ]&+D$$ ZAPEG  ]'D$$h+OE R ]D$$O/vO(+ORNU D D$$])+AHTL D$$Ғ bbl--D$$9,,D$$R+D$$;6+D$$+ƚ* *D$$))D$$@..D$$( D$$"(+D$$p bb D$$4 +NIET,EG R  D$Ķ,-  aD$$: +ERLA  D$86H ,  aD$$V +HCRA D$'bd +  aD$$L[r +OBLOAE N D$$ a *  aD$D  eD$$Ϝ ] * D$$]Ǫ   G$$)+ad*D$$5 +IN L*{ D$$  )  D$$  a$%  D$$=e ]D$$   D$$<    aD$$5'd a]&D$$(   D$'AP6   aD$$D ]) D$$R    D8$` a ]D$$ln'  a D$$&|    aD$$׊ ]( D$$aŘ    D$$  a  D$$ e ]D$$9   4D$$;   aD$$%d ]#D$$     D$'y[   aD%$$d  e: ]D$$F   cOD$$̏$   D$$Un2ad   D$$ @en ]D$$N   D$$];\   aD$$jd> + D$.$x  , D$$xچ    D$%ʆ  e D$$Ң ] ,D$$    D$$,Ӿ    D$$3%   aDD$4%d bb 55D$$Y+ D$$ 44+D$$=  D$$3D$$ 83+ D$$. D$$<2D$$J2+ D$$X D$$f1 1+ D$$C7t 2 D$$p G$$EaD$$I]0 0+ D$$=  D$$@ D$$~aD$$) bb/"$D$$#' eD$$B^ dH$$s&%ޤT6D$$E  !^ D$$=7^ TD$$.*T b b>^WD$$8^O'^|D$$MF'^\^>D$$^T^#^^D$$Wb b bZ]GD$$np+FI J ]GD$$~+OD D$$R]G+FO  D$$vc]G+OT D$$hn ]G+NI D$$Uh ]G+RO D$$x ]G+D$$NE D ]GD$$+OF R ]GD$$2M +AV R D$$]G +ID V D$$E ]G +OM D D$$/ ]G +ES T L D$$Q& ]G +NA DD$$4  ]G+D$$BON T ]GD$$^P+HTNE ]GD$$\^+LEES D$$9l]G+IWHT #D$$Y;z]G+OGOT D$$b@ ]G+ACES D$$;2 ]G+YTEPD$$ ]G+D$$ IFEL ]GD$$+EBIG N ]GDO($$+NUIT L D$$]G+HWLI E D$$ ]G+RAAR Y D$$ ]G+OCSN T D$$G ]G+ALEBD$$j L ]G+D$$!N" EREPTA ]GD$$\0 +EROCDR ]GD$$b$> +ODNWOT D$$,L ]G+APKCDE D$$WZ ]G +ARDNMO D$$"h ]G!+OFWRRA DD$$R6v  ]G"+RPGOD$${6 AR M ]G#+D$$ UFCNITNO ]G$D$$r +XEETNRLA ]GD$$ %+RPCODERU D$$ڌ ]]D$$ ]d]D$$ ]]D$$b ]!]#D$$G ] & b b]D$$9  ]+]D$$ *],]D$$S E]]D$$, ']$]D$$": ] ]D$$ H ] ]D$$V ]]D$$d .](]D$$r %],&]D$$ !]]D$$ ]]D$$r )]#]D$$~ ]]D$$f ]"]D$$? ]B=-]D$$, ] 0]D$$/ !]"]D$$ #]$1]D$$ %] ^+.]D$$* ^-.] ^*.D$$$m ] ^/.]5: ^(.D$$ ( ] ^). ] ^D$$6 $./] ^=.]D$$D ^ ./] ^,. D$$nR ] ^..] ^'.D$$` /] ^[. ] ^D$$n ]. ] ^:.6I]D$$| ^^.] ^<.D$$J ] ^>.] ^;.D$$e   bb%D$$}3 e ]IdH$$G ]I]I D$$ ]I ]I"D$$U ]I 0?0.D%$jF .e ]n.DD$ d ]n^+.]D$$w n^-.]n^*.D$$pV ]n^/.]n^=.D$$L  ]n^<.]n^MFD$${8$ >.  b b]D$$2 +G TE ]D$${@ +P TU D$$ N ]+R ID D$$k\ ]+R RD D$$kj ]+R CD D$Ga$]x ]+W IRD$$3 ]+D$$' W OR ]D$$v +W RR ]D$$=~ +W CR D$$P ] +W SR D$$_ ] +O NP D$$uj ] +N WE D$$e\ ] +R TSD$$ ]+D$$- E NL ]D$$ +S NI ]D$$ʀ ;+C SO D$$. ]+E PX D$$ ^< ]+S TQ D$$`J ]+L GO D$$[X ]+A NTD$$Ef ]+D$$,t R NL ( ]D$$ +W NL ]D$$@ +S VA D$$v ]+C SL D$$j ]+W RD D$$\ ]+R RR D$$m ҩ]+P GAD$$Ύ ]+D$$,) E RO ]D$$8 +R ES ]D$$w+R RW D$$]+R DN  D$$ b b]R+A IBD$$Z* ]R+A D$$88RB ]R+D$$lAFA ID ]RD$$XT+A RD ]RD$$Xb+A DN ]RD$$p+D FI  ]D$$.a~R+D IV D$$]R+D RV D$$ ]R+E FO D$$.]R +F OL D$$. ]R +F TL D$$+ ]R +I NN_ D$$+ ]R +I TN D$$* ]R +I RO D$$* ]R+M DOD$$Y ]R+M D$$) IP ]R+D$$w4M RP ]R+D$$t&+N IG ]RD$$k4+N RG ]RD$$ B+N TO ]D$$HrPR+O DD D$$2^]R+S IB D$$l]R+S RB "D$$(2z]R+S SG D$$#( ]R+S IQ D$$ ( ]R+S RQ D$$$ ]R+S OT D$$& ]R+T CR D$$* ]R+U INDI'$$Y ]R+S D$$$PT ]R+D$$0C PS ]RD$$+D CE ]R D$$+E TN  ]RD$$!+F PJ ]D$$og"R"+I CN D$$a0]R#+I DN D$$S>]R$+I AX D$$S7L]R%+L OA D$$R5Z ]R&+L AC D$$54h ]R'+L OD D$$)v[ ]R(+M VO D$$% ]R)+M TS D$$2 ]R*+R TED$$!X ]R++S D$$&OR  ]R,+D$$8X PJ ]R-D$$+C LKH ]R.D$$+C PU ]RD$$ /+E UQ ]D$$oR0+G QE D$$s]R1+G TR D$$p]R2+L AD D$$3]R3+L CD D$$b2, ]R4+L QE D$$Q2: ]R5+L SE D$$Q(H ]R6+L DO D$$32V  ]R7+N QE D$$#d ]R8+S RTD$$?Wr ]R9+U D$$5-PJ ]R:+D$$/O DR ]R;D$$+C RH ]R<D$$+U CJ ]RD$$ =+C PX ]D$$gR>+H TL % D$$" bbF?eD$$i]0.d]D$$U^A.]^B.D$$I8]^C.]^D.D$$9 ]^E.]^D$$2F.]^G.0]D$$(^H.]^I.D$$*6]^J.]^K.D$$D]^L.]^D$$RM.]^N.]D$$`^O.]^P.D$$n]^Q.]^/hR.D$$|]^S.]^D$$·T.]^U.]D$$^V.]^W.D$$ ]^X.]^Y.D$$մ]^Z.]^D$$0.]^1.]D$$s^2.]^3.D$$hU]^4.]^5.D$$W]^6.]^D$$P7.]^8.]D$$:^9.]^+.D$$/g]^-.]^*.OSD$$$]^/.]^D$$2(.]^).]D$$@^$.]^=.D$$qN]^ .]^,.D$$\]^..]^D$$j'.]^[.]D$e$x^].]^:.D$$$]^^.]^;.D$$]^<.]^D$$C>.]l^0.]D$$l^1.]l^2.D$$O]l^3.]l^4.D$$]l^5.]l^D$$6.]l^7.]D$$l^8.]l^9. D$$ b bx]]D$$,h]]D$$6]]D$$6 1]]D$$f.]] D$$g<] ] D$$5J] ] D$$5X]]D$$=f]]D$$t] ]]D$$ug]]D$$qf]]D$$dg]]D$$O5]]D$$B]]]D$$sUG] ]!D$$f]"]#D$$g]$]%D$$]&]']D$$@(])]D$$f*]+],D$$e]-,].D$$f*]/]0D$$48]1]2D$$~]<]=D$$*X]>]MD$$]M]MD$$&]M]MD$$>]MD$$s]M]MBD$$]M ]M D$$%]M ]MD$$ ]M D$${]M]MD$${ ]M]MD$$z{]M]M9D$$gs&]M]MD$$UI4]M]MD$$E&B]M]MD$$=P]M]D$$ ^M]MD$$Il]M]M%D$$]z]M b bD%DP ah a a a ED$a* a a bb| ED$껤a a- a89;D$$|Ʋ  ED(?a a a a9DF$$(8; D  _R2SADMIN.RBY!6$8$I$I@TwlA[VlNJDQF;$ 5D$$xx!8S" C% C!!X !8D$$})"X CP 2" 9D$$$") bҕ  D$$)*"  !!L! G%@$(#D$$8 ) "0!H!"@"%@""@ D$$F!!,! P !,! D$T !,!P) HIn8I+ _R2SSPTAB.RBU!75T@n8D$$erD$$WrD?;$I$I$ISpHKU xFO#x$I$I$Iyz[ UVxx7x _ A _A @:nx _R2CRCODE.RBU!8…@RڸA^Fe v D$$SX &X ' &8+3B&XDD$WW &8+3 'P&& &AIQD$!)1@C+ _R2SITAB.RBU!5핯bm{{@<@{{ <$ $$W2$$I2$HH*12356HHH2&8789:;<=>?7%ȐHFHIJLMNPQRH0$vTTUVXY$b@ikmHHNpotvwxyz{|l~}~HHHYxA4G/G.aG-aH,0f&*BnKAl7+1`Ф Ф_HHH"22_vF1Fx(p_'&äP%#PF"Y!DD_##_HHHQQ_LA}$_FF_P)isiraiqjpHHHlAADfngeldGFDE7DOCB7_c bHHua5 BjAh&~ GZF[_A^&} }]7\$}W&S^`}O FK _P4BODY.RBY`EN$I$I$I# P ։ - ։  ։ ։`M Չ2Չ .bՉ --Չ#Չ@fӉ #,Ӊ@#Ӊ`#lllێ-Ċ-#222Ċllwʊ!Ȋ#Ŋ#׉Ŋ!( D$Db&b(!e :aD8$  'a(eE$8vod ^t a aD(8* eG  aD$DC8eEeE"dH%$Fo eZ D(8|Tdo  aE$DbeoeodH$8p - ad ,D$(~ ad E($|Pe+d +!D$$PD$(  ad  aD$D~ ^@'af eH(# ad ad  aXD'u a a a D$'^e*e aJEĒ$Bd  a^ D$$;D%$  e aE$%)d ^'afD$$&ee7 aD$(6E4d aeE$S@(Be[?#eT ^0G$(xPadY $' dz aD$^ -a!ek :a D(żla ex a dz D$'zd a D$8PH!e aHeH(( 3 e ad aX$$ e ^e D$$   HPAeHŒ$; adHPPP\D$$,HP  3HPa D%$za d   D%(t t d  $gddHE$qd}ddAAAdHD(mAd(!e aX'${ 'ad b bD$D~" ^'aeH$''0+ a  a D$8[>^ 'a a D($L"e'd --D$DBZ"ed a d -eHĔ$yhq a , d|-e|D$$_v a , ,,"eHŒ$ a d  GD(Gaa"eB a d aXDDd%-e a D%8 , -e a , D$'ȼ,,"e a dD$$y ad% --D'$"e a d aD$%d% -I-"e G$%'a d ad% *D%8ou*"e a d D%(ad%%gdUdHE$dddd)d, D$$,b"b<^DD':("eF a D$(6H^'aer aDD(V-ea a dr,E8'^>del a dr aDD$ree a  G$%܀a ^'a aX$D_ "ea_<dR D$'=Ŝ--"e a dDD$3 -e a , dD$$-e a , ,DD(y,"e a d D8$' a"e a dHĒ$\0 ad_ -^-D$D{"e a d9 -eHĔ$r a , d-eD$$  a , ,,"eHŒ$<! a d9  GD(\(a"e3 a d9 aXD$4b6d_ **"eJ D(ĶD a dP ad_D%(Rqr&gYddd;dHD$P!`cdr b$b ^D((n'a,eE$8|ee ad G$%a e D1(8F-a!e :a aD$$, a,eeH($ɴ ad a D$$"eeeH'$n ae a dH$:3 ad aD$$_% d e  -e D%%8 a , d -e  G$(a , ae D$$y d ,e$^Rd;DDDGX$ *e.^Bd; +eH((y28^Cd;^Id^D(@>(eJ a^AdH$D>N^(e\ aDD$\^Sd a!^D(j("et a^MdH$D >x^(e aDD$>^Md a^FdD(EDݔV'gdAd=dOdaE%$L]dydd 5.aE$(ذd 4.ad 1D($9.ad 0.adH$D 7.ad /.DD%[\adq 'gdE(E dddddd G$$va* bb@ KD$$Tf^@'aeDD$mue$#eH$ $ a a KaH(%.feBe? aX8$<dB a"eH8%!9J ,a-"e\ G$(Xa , aedH$'>f'en a adD$8t'e -^)a aX'$Kd ad (aX'$aI d ady(gdHE(YgdgdtdddddHŒ8; ad 3a bD%$>!b e(9; DDDed ; D((^ e  d; D$D,K!"eG D$(e  e 9 DDŭ.a d  ^ad D$$>d   #eD',!e# a ad, G$$1*a b bF K^D$Dxh8'aP (!e1 &7PD($FH!eO aHe1D'$ T'e] ada a D$$Yibbbx K^'aHĔ$+pf a  a.eDD$q~ ad 4a K^D((k'aP (e aX8  9a  a a D$D KaP  ad aD$$9 b(bX K^ 'E%%af aeD$'(g,#e aE'D9d -a!e :aWMXĒĥ a  9a *eH( ad a  G$$0 a  a ^D$$i{(!e K^'D$$̳& ae{ aeH$D4w eY D$.  D$$1   e D$Dа^e:  -D$$-a 3a a  D$'H a  ,a  a D(Đ e#  <a dH'$"   9a   D$D 0 e  ad>  aDDD> 'eH  adL  aD$$ L bb~ a  a D$D^Z K^@'aP (eHĒ(lh m  a(!eY  EĒ$cv e  a K^@'E%8ͤ aP (e  a(DDDy !e{ ds )e  a D$Dީ Kaf ad  5aD$$ bb\ a  a D$Dɼ K^'af a D$':  a+e  ad D$$nE  6a KaP  9a D$$6  a b"b D$%+ 8 eD  ^D$$ \ aH D$$  e"  D$$I d(  aeH$Q, ?  ,a#e?  D$D@3: a adS  aD$8*H  K^@'aEĒ$V e  a K^'E%$d afe ew  DDfr ad  ae  aXŢ8>!  ad  ad  D$$ 3a K^5 'aD$$" ^ (e7   aD$(At  K^'afE$'C e5 e  ad5 DŒĝF  ae1  a -aX$$ !e  :a - aD'8%  8 -a a  /EaX''7  a -a!eH8$   :a 6 -a D$$Z  HXe PX ,D$8zg e'  4^I.ad/  D'$8S( 0^I.ad5  adHĒ$l6 F  7a K^'&G88D a a  !a +EŒ8R eY  ad]  6a KE$$` aP  a ,eu  D$jn "ad{  a D$'A| a 9 a  a D$$&- bb e DH$'G  ^0a ad D$$.ʦ  a3 K^D$$ 'ae% eH($~ ! 9e 99;9D$$  eH$$ ;9   DD$[ d  a ) a D8$* 8 )a;9 D$$H    HXe DD(ӭ PXd  ad%  aX$( $  PH!e2  aD$'!2 He +e@  adD D$$@ 'I 6a KaP 99D$(N bbe ;9 D%$7\  e eHD$j es  a aD($,x d d d^  D8( a ae  aE8$o d g a^'D$' (!e  a aD$%p ^'(e d  ^D'\ < a a E'$ e  ad adH%'>$ m  a a-dm  a aH8(3 dm  a abdm  aDD( adm  a a dm  GEu a aM dm  a a dH%$  m  a a dm &,g dH$${ AAAAAAAD$$). AAAAAAAD$$< AAAHGAAAAD$$ J AAAAAAAD%(X AAd d d d dHE$f d d d ^(D'8t !e  a a bD$$ bH e H Rd D%$  Ra #e \H e D$$_ +. NE T ? \D$$Zb H \\d +D$$= . NE T L \D$$ R\^;\ H D$% e H \d +AMD$$E NI 5 \\D$$ \H e^?\D$$ H \^:\ D$$\PP U T RG8t)a Qa  Va QG$$q*a VaH eD$D 8 WH YH eN \M?aX$$F HaYeYD%$mT[[e[e[D$(b ["e 2D$8z`p[ a 6W)aHD$$\~P ([a WWdD($[ eW[WH&D$'S[P )\a )DD$`WadWWHP D8'e[\a [WaYDD$YdNdE 6PHD$$Ke>H[[ ^ D$D a e7 JD$$e7\ ^ \ +NUD$$EDLCRADE \ +D$$q XEETNRLA \ D$$+IFEL \ D$$6&\ \ ^ D$D{4\ HPd  D$t$B6a Ha X ^D(%P'aP (!eL D$8:^PH!ei aHeH((DlL'ew ad{ aX$(Țz;9 ZZeZ[[D$$i݈!e a\ +L BAD$$V±LE \ [D$$= \ \ ^ \ DD@[Zd Ha H E$$'eH e *^P.G$8ߋa d *H ad D$(X6a *^P.a  .XaX$$Yj#e,^L\ ^ \D$$g Q\^=\ XD$$ \\^L\ ^D$$j \ V\^=\D$$b$" T \\H #"E$$0eS^L\ ^ \ D$$>Hm\^=\ HD$$L \\H e#E$$Zen+CPDO:E D$$ h\\ )a D v.Ra a  _R2IFNS.RBY!:]S$IHSF # x UVxD(E  @pH  _R2SHEAP.RBY!7s[IxQOD$$J!$!$$\$(!4!PD$$(J%  ) !,!$H $(!4D 5!PJ  _R2IFW.RBY!:l`=4TPb|D6@pH _SWOP.RB ~gÁHڅtf gKvX$$! # D;$?֐8S  3 D _P4ASM.RBY 2S   @G) D$$b bv+SR T D$$" D$$mT+CC P D$$* ^<"5D$$8+NA DD$$)F ^D$$BT"+D$$bRW I D$$p D$$t~+ID F  .D$$t^% D$$xh+HC R D$$c^0D$$r+NIID D$$1^XD$$͖F+RSSO aLD$$ ^TD$$d+ELAQ D$$y ^D$$t +CL A D$$d ^+D$$w&+OED$Qv$4 F D$$B^)D$$pP+DL A D$$q^^\D$$ml+TA N D$$TzD$$l+DL C D$$^^D$$Q`+JF P D$$-Ѳ^eD$$+EDCC D$$R ^nD$$"R<n+DA R D$$$ ^D$$z +LF OD$$N  ^D$$H !+D$$˵"LE N !D$$0q!"D$$a>+AL O "D$$AL^]"F#D$$hZ+SC P  D$$h#^c#D$$Tvv$+EDIC D$$I$;^l$D$$ n%+NE T D$$ %^b%D$$#&+VD I D$$g &^D$$&'+UC P D$$ 0'^aD$$h'2(+NJD$$8 C (D$$^4()D$$h+DO D )D$$^)*D$$c,+AP G ? D$$n:**D$$_H++LF T D$$k5V+^+D$$|$d b b-+LH T D$$ r -^D$$-.R+HCD$$wAK .D$$^ ./D$$4q+NI N /D$$0^(/D$$/b0+GN I D$$=0^0<D$$e1+HCBK D$$1^q1D$$S2+HCCK D$$rN  2^p2D$$O3+XC P D$$Y( 3^u'D$$6324+DR CD$$D 4 D$$R45+OID$$ ` R 5D$$D n^#56D$$Xp|+XI A 6D_)$$ъ^_6n7D$$sh+OM D D$$7^7D$$l8+HCIK D$$8^q8D$$9+GN R D$$4 9^9D$$H:+BS I D$$l :^D$$$:;+NI T D$$C ;^&D$$=$;<+EDD$$2bAC <D$$@^l<n=D$$[N+PJ T =D$$\^}=>D$$bj+PM I D$$5 x>^>D$$Gj?+PJ F D$$̔?^~?D$$@+TSCR D$$Ѡ @^P@D$$#A+HCRK D$$  A^pD$$mAB+HCSK D$$j B^pD$$ BC+BSD$$  R CD$$^CED$$O +AS V ED$$I.E:GD$$f<+PM R GD$$J^GD$$|SXI+OM V D$$fI^`IxD$$ZVtJ+DR I D$$ȂJ JD$$RK+ON T D$$Ξ K^!KD$$nL+JU C D$$8 L^AD$$LM+IS N D$$c MQD$$M b bND$$!Q+GS S D$$N^$ND$$WO+SM T D$$[<O^ OD$$`*<P+EGAQ |$ D$$$8 P^PD$$FQ+EGBQ D$$uT Q^D$$bQR+EGCQ D$$p R^D$$~RS+MJ/D$$u  P SD$$^2STD$$`+SR E TD$$TUD$$_+JT P UD$$Z^fU`JD$$aV+OL G D$$lVVD$$NW+DW R D$$C WWD$$~WX+EGIQ D$$B+&X^XD$g$4Y+JU P D$$UB Y^dYD$$(OPZ+DLCC D$$^ Z^^D$$lZ[+VO LD$$|z [D$$k[\+EGD$$5 MQ \D$$$^\ ]D$$V+SR N ]D$$^1]^D$$:^+RT C D$$^1^^D$$g_+DLBC D$$__^^_D$$ `+DLIC D$$- `^^`D$$" a+QS R D$$1Z0 a^D$$v> ab+EGSQ D$$L b^D$$Z bc+QSD$$h T cD$$|v cd+D$$ RW C ^  dD$$  deD$$M +JX P eD$$ Į ^gefD$$)R +TSAO D$$ f^fD$$] g+EGRQB D$$_A g^gD$$ h+NIAC D$$/ h^hhD$$S ni+DLRC D$$; i^^D$$, ij{+NICC D$$: j^jD$$>H jnk+TSD$$V P kD$$Zd ^*k b bD$$ydr l+NICD D$$Ԁ l^X=lD$$Ž Po+WR R D$$JK ooD$$ p+NIIC D$$ p^hD$$t pnq+DLBO D$$O  q^=,LD$$ qFr+DLD$$ CO rD$$ ^LrFsD$$J +RW R sD$$   stD$$mV( +RW S t$D$$6 tvD$$WD +DLAO D$$R v^LvFD$$Q` w+TSRO D$$:n w^ wD$$| x+DLIO D`($$ x^LxD$$ Fy+QEBU D$$r y^D$$Ԃ yz+QECU D$$W z^D$$  z{+NID$$F RD {D$$ ^X{Z|D$$S +ELAS |D$$" ^|}D$$R +ELBS D$$$ }^}D$$:Y2 ~+QEAU D$$@@ ~^~D$$HN +ELBQ D$$\ ^D$$X j ݀+ELIQ D$$mx ݀^D$$ `݁+DLRO D$$̔ ݁^LD$$ ݁Z݂+DLD$$ SO ݂D$$׾ ^L݂d݃D$$L +LW N ݃D$$1 ݄݃D$$qd +QEMU ݄D$$ ^݄ D$$q` +DLNC D$$) ݅^^݅D$$

ݥݥD$$Lݨ+OLCD D$$WZ ݨ^HݨD$$$hݩ+ENBQ D$$lv ݩ^D$$|ݪ+RGAT D$$S ݪ^D$$ݪݫ+ROD$$ BD ݫD$$ ^/ݫݬD$$wZ+ROCD ݬD$$^.ݬE-ݮD$$M+ELSS D$$ ^ݮD$$DHݯ+ERBT D$$0ݯ^ ݯD$$?ݰ+NIAD D$$u, ݰ^XݰD$$:Fݲ+ROID D$$BH ݲ^,D$$pVݴ+ERAT D$${d ݴ^ D$$]Rrݴ b bD$$D+ERIT ? D$$2ݶ^ ݶD$$Oݸ+MC S D$$ݸ^3ݸD$$ĸݹ+EG T D$$C ݹݹD$$ ݼ+OC S ^ D$$Y ݼݼD$$.ݽ+ERPT D$$  ݽ^ D$$ ݽݿ+ERRTD$$ ݿ^D$$tD( ݿ+!D$$6ELCQ D$$XD^D$$kR+NISD D$$`^XdD$$Rn+OE R D$$|D]%$$M+ELCS D$$4^D$$+ROAD D$$ ^-D$$ +VD R D$$%M ^ D$$v+ELMS D$$  ^D$$7 +ELD$$KRQ D$$f^D$$E$+ERCT D$$B2*e^ D$$U@+XE P D$$ND$$K\+ELMQ D$$6j^ D$$>x+EN W D$$ۺ.D$$+ELSQ D$$ۢ ^D$$+LC S D$$0  D$$0+RSAO D$$ ^TD$$F+RSBOD$$ ^D$$TF+D$$RSCO D$$ ^TFD$$`.+NR D 8 D$$<D$$GJ+RSIO D$$X^TFD$$Mf+PO N D$$tD$$y@+TSCOG D$$^ D$$+LR N D$$X@ D$$+TSAR D$$  ^PD$$m+TSBR D$$ ^PD$$P b bxD$$D+TSIO D$$)3^D$$?+RSRO D$$ *^TED$$8Z+BA I D$$F ^D$$AGT+DA I D$$\b ^D$$Qp+NU ID$$~ ^+D$$&'+D$$QTSBO D$$ ^D$$$S+TSSO D$$Y^ D$$]S+BA R bED$$A^D$$;+TSIR D$$%^PD$$+ +RR R D$$> D$$&+TSRR D$2ܒ$4 ^PD$$) B^+TSSRD$$$P ^D$$a^^P^( b DD( lb a af a ao D($y z a a{ a b bD$$t}^+ \\]\ DD$\e]\ +T.TX' D$$tNIUP'T \\D$$^" \\^ D$$b\\^" \\D$$I^^ \\^ D$$8\K\^ \\D$$H^" \\^!D$$  \\^ \\D$$s^+ \\+T.TXD$$' UOPTTU ' \\D$$%"^" \\^D$$P0 \@\^" \D$$%>\^^ \\^D$$kL \\^ \D$$rZ\^+ \\+T.D$$whTX' RP'D \\D$$v^" \\^D$$# \\^" \D$$’\^^ \\^D$$s[ \\^ \D$$Ю\^" \\^D$$`,! \\^ \D$$N(\^+ \\+D$$T.TX' RP'R M \D$$I\^" \\^D$$U \\^" \D$$ \^^ \\D$$p^ \\^ \D$$\\ b btLD$$,&T&+******W**** D$$Y: \ +I SNRT .ON . D$$H \ L%\ +D$$]V' \ D$$d\\ + 'AH SON TEYD$$kr TEB\ +NEC TAREDED$$3F RO \ \ /"\D$$ b bPL&TD$$=&P+NITS.RN .O= D$$ \ L%\ + D$$A \ \D$$'4\ ]\ L\D%$ɼ \e]\ \@ D$$](+** \D$$O \\ +* *LIELD$$AG LOCED\ \  D$$ bb$\.D$$\.\D$$(.\.(D$$6eE\.D$$ϨD^L$D$$dRT$L#T#\+ D$(` ep aED$Mnde \ E$$|e P d DR,$$+ e ED$ae^D$$jƦ^L#DD$UT#dp bbZ^D%$"!e \\D$(c) \\d^D$$1![ \\]\D$$թ bbf^"D$$!e \\D$$ \\d ^D$$Z \\]\D$$$ bbl^"D%$&02Z"!eM \D$$o@\\\dZ^D$$nN \\]D$$Ax\\ bbx^D$$BNj""!e D$$x \\ \\D$$[d^  \D$$Ô\]\ bbDD$e^"eH$$R^ \\E$%;d^"eD$Dq \\d^D$$% \\ \\D$(#" \\d E$$Ge \\d D$$ \\L% \D$$¾\ bb4\H D$$ ^ \H ^D$(.,#H H "eAH DD$ӗ<P d\H .KDD$gJ<(!e+**A SSMELBREC DOD$$X\ + EREOR R : D$$f \ \ P HD$$t H e\H D$%\ H P dv\ D$$#+**L SA TEROCDRDE\D$$) +P OCEDC UOTNRE= D$$\ L% \ \ L&D$$/KT&\H .L(D$$UH P H H \D$$]H .K<("m"eD$$" \H .L(D$$\{H P d bD$$bJH e!H D$$ e!\\ DD$zd  bbX+R.XD D$$`c* 8 \\6D$$ 8+E.TX DC.TS. LC D\D$$F+CPTR N \D$$T\ ^0T^9.D$$#b@L.@ex<L.$'D$$p<LTdc^AT^ZD$$]~.@L.@e8L.$D$$'8LTd8^D$D}y'<'8\)e+**A SSD$$aMELB YOCED\ +S CED$$QYITNON TOP OR\ +EPD$$DLR YNEED.D \ \D$$P~ +**L SA TEROCDRDETMD$$A\ +P OCEDC UOTNRE= D$$-\ L% \ \ ^D%%o7\e\d]D$D \ L^;e\LD($.8(eL D$$& P@ @e: ^ D('$4  d)  \ D$%>BP#L^;#!ep]D$DLP\ L^;en  D$$>^ L L^:enD$%b(l d>\ e D$%{z  ^ ex D$(c稈 @ @e D$$|    E$$cd+PJ C ED$⡲e a +SJ R@ CPTR ND$$z \\ddD$$(w+OP P e E$$a  +SD Z4 1 D$$! \\+DL A D$$0 \ aD$$ \+@ 14 D$D \\dd+UPHSD$D" eo a D$$0 H+SI Z4 1 D$$>\\+TS A D$(RL \ a\D$$Z+@ 14  \D%$h\dd+OLDA D%D v e a  D%(ф a a a+SJD$$X R@ C.DL \\D$$^J \\ \D$$n\+DL A D$$Ӽ\\+@ 74 D$$x \\E$$#dd+TSRO  D$$ ^E"eJ E$$a  +TS A D$Dr \ a\D$$#+4 7 \D$$zg\+SJ R@ C.TS D$(R, \\ Ca \D%$CL:\ a \\E$( Hdd @ @ea D$(w6V\  dN\D$$d e+R.XD 01 D$$fr\\ b$bD$$L \Tr D$Dߎ\ \eDD$^ d\ aH(DB  d#ed \D$%X\\d% a'd%D$%\  ^@ad%DD$ a'd%\ \ 1 D%% a&d% a'd%D$$\ \  D((^a`d% a'd%\D$$ \  ^DDDa a`d% a'd%\ D$%( ]\ L^Le; ]6*DD$6 \ d- \ D$$D \\L\ D$$)R \\]\ d%DD$/` a'd%\  \D$%n \]\ d% aH$$-| 'd%\  aE+E$g d% a'd%\  D((o ^ad% a'd%D$% \  ^ad%DD$w a'd%\  D((D ^ad% a'd%D$Dh \  ad% a'dH$$5 %\  aEE$ d% a'd%\ ]\D$$J  L^Le !]\ E$$!d \  \\D$$!L\ \\D$%95$!]\ d% a'd%D$$2!k \\ \\D$%5@!]\ d% a'd%D$%N!]\ L^Lea!]DD$Hl\!\ dS!\ \D$$j!\L\ \D$Dx!\]\ d% a'dH$$Vӆ!%]\ L^ e!]D($ȭ!\ d!  D$$^!L \ D$$h!\ ^ a D$$X! ^ \\D%E!]\ d% a'd%\D$$N! \ \ aH($[!d% a'd%  \D$$!\]\ \e!D$$6"]\ e$"D$$_"] \\D((9 "d "d% a'd%\D%%."  aam&d% a'd%D$%g<"]\ L.eO"]DD$J"\ dA" L D$$X"\ \ D$$bf"\\ 0E$$Jt"e"+T.TX D$$"\0\& 0\D$$K8" '\0\ 0D$$R "\ \d5# DD$T%" 0e"+T.TX D$$M"\0\ 0D$$"\ ,\0\D$%" 0\ \]d5# D$$"0e#+T.TX D$$۫" \0\D$$7# 0\ <\0D$$ d#\ 0\ \dH$$#5#+T.TX \D$$ۘ*# \\]HG\D%$=8# d% a'd% aH($wF#&d% a'd%  \D$$T#^.\ \]!\D$$b# \^0\ M!\D%$ap# \d% \\D%$r4~#\ a"d% \D$$r#\\ \ \D(%虚#\d%rg#dE(ET#dddddddE(E#dddddddE(E#dddddddE(E#dddddddPE(Et#ddd d d d d E(E#d d d d d d d E(En#d d d d d d d E(EՊ $d$ d` d` d` d` d` d` E(E8$d` d` d` de dz dz dz E(E‰&$dz dz dz dz dz dz d E(E;4$d d d d d d d E(E؈B$d d d d d d d E(EzP$d d d d d d d E(E^$d d d d d d d E(Exl$d d d d d d d E(Ez$d d d d d d d E(Eņ[$d d d d d d d E(E:$d d d d d d d E(E[$d d d d d-!d-!d-!E(EQ$d-!d-!d-!d-!d-!d-!d2!E(E$dI!dI!dI!dI!dI!dI!dI!E(E$dI!dI!dN!d!d!d!d!E(E$dX!d!d!d!d!d!d!E(E$d!d!d!d!d!d!d!E(E $d!d!d!d!d!d!d!E(EU~%d!d!d!d!d!d&"d&"E(E%}%d&"d&"d&"d&"d&"d&"d&"E(E|"%d+"d7"d7"d7"d7"d7"d7"E(E~y0%d7"du7"d7"d<"d<#d<#d<#E(E\u>%d<#d<#d<#d<#d<#d<#dA#E(EtL%dI#dI#dI#dI#dI#dI#dI#E($Z%dI#dI#dN#AAAAD$%>h%AAAAAdw#AD$$v%AAAAAAAD$$Bb%Ad# b^b+UOPTTU D$$V% +RP R D$$֠% +NIUP T D$$ˮ% + ;D$$;ռ%====P A4MSB GE +NID$$O% SON W   D$$ؕ%T+^0.T (T%T*D$(:%^P-L*H-e &L*D$$%P.L.+ D$Dz1& L*T*d% aj]D$$& ] ] D$$̹&] ] D$$,&L^.]+ITt T D%$|:& "er&+********** D$$8H& +N OITLT EOFD$$pV&NU D +********** D$$7d&   ^7D$$^Er&L ]]D$D& L e}&CF]D$$ & ] L^Ie&D$(̦&T,d&L^Le&T,E$$.I&d&L^PL^?#eH($_&&T,d&] L^.D$$HJ&e&T,d&T,L,,E$$&dY)]) L%L)L)5D$$&"e''L'T'^I D$$& L) ^  + ;??D$$& ?CPDO E +C UOD$$ 'TNO TUO FTS +PE? D$$1'??   LD$$T(')T%] di)L (D$$r6']* L*] LD$$RD' e?'di)D$$R'] ] D$$#`'] ]+IF L D$( n' e{' ad2)]D$$s|'+WS 1  ]D+$$|'+WS 2 #]D$$n'+WS 3 #]D$$Oe'+WS 4 #e&(D$$Di'] L^0L^1D$$'#e']L L^D$Dx'1e'T)d'T)D$%/'T*P-L*H-e (]D$$ʆ' ]L*L L)D$$e'L.L(T)L*TD$$(*d'].L(TD$$~Q(*]L*L)] E$$2$(d2)]+XT T D$$*2(^M"e(^. ]D$$@(] L D%$6N(L^ eE(T*P-LD($\(*H-e(] L0D$$߅j(e}(0 "0DD%x( d(L0e(0D$$(1 <0 d(D%$(L0e(0 >D$$e(0 d(L D%$5(L*T*d[(] LD$$|( d2)]+NE T D$$Ü(  e(L+e(D$$(T+^.զ ]dH$$d/((+ ; . D$$(]d)]+NE DD$(u) !e)^.D$$) ]!e,)]D$% ) L e)]D($.) di) azL%TD$$ Z<)%di)L ] LD%$J) eD)] dH%(X)i)g_)d&d1'dR'dH%$&f)4)d?)eu)] dHD(t)i))e&L'e)+-;--D$$) -ON .FOW RAʼ +INGND$$) S = L'D$D0.)  L&e)+*;** *D$$H)ON .FOF TA +LAE RRD$$L)RO S= L& D$$`) +E.DN D$( )L&eb/)^7D$$)  Ew)a%*@ ) _R2SMEMACC.RBY!6.sەt$I$IJ1g7^_\AR7M}K&}:&+$}) F}F+ \ܱxD$$"('X"8;'"CD$$L !,!#( *D$$!!L)ŧ "!!D #(D$$* )ħ!,!J !0!PD$$Ro8)ħ!,!!xl`Zc[ByZCTxܱ\D$$ *"( P! ^'\ \d^(D$$*L\ ^ \ +1WW 2D$$#Z3WW 4 \^)D$$Kh\ \dqagvE(Evddd d"dJd-dD%$v -q8k-gdAddHE(dddddddH$D Vd a bbD(%%e3d-D$(y@e^I\ d*E$De^B\ d+-EeH$$^^C\ deH$$]S^I\ d^R\D$D d3 ad3^A\D$%9D d3^S\ d3^MD(8\ d3 ^ad3DE(bg!dddddd)HE$,ddd bb@#eH$$4:N a]R\ D$$9Ha\ a D%DVbbL#eu a]RD$$Vd\ a \D$Dqr\ a bbDsG%$X#e a]R\D($h a\\D$%\ a bD$(}7 bebdVD%%V,"e*e 3D((%ad+e 3DD(6Sad 3adD$E^)e 3adHPD$DbAe adHPPD$$%P\HP,eD%$  3HPad 3HPE%%had`dHe. 'D($v(=aVd7 68aH$(>6}dR #aVdR ^G$E DadRgLd!d9dAE$ERd`d`gZdddTD$$k` bbeHD(nde +DE$|aVd 88DE$Na}de D(%^ad a4dDŢ(R ^adgdsdH$$5Ed b beBE8$d2 a eHPAeD($؏ a.dHPPP\HD$(jP &HPaZd D($^ad<deDE$3  %aZd  28aH$$gd)e ")aVE'$d) ^ad)Pg#dHE'$d dd.< ^ad<D(D22\g6ddd+D$DE@ bb| aeH(*NX*eX a#e{ E$$j\a]R!\^LD$$j\ ^ \ \D$DTix\ !)a bbD%$\#e a]R\D$$q'^L\ ^ \ D$$4\\ aH$%8 bbh#e a]RD$$L;\\^LD$$4\ ^ \ <\D$(\ a bD%%r^bne -e ,D$$ "e e  aX$$  -a} bbH#E$$_e.^L\ ^ \ D$$ \^:\ \FD$D.. bbe#eH$$<} a]R&\\D$$8J+. XT T D$$X\^"\ \D$$f^ \ ^"\ \D$$Vt &ae-H$$V 3a D$$28  a  aZDD$ёd3 bbeH$$e 2D$$l8  a aZD$$lud b,b& CD(% de eD$$Ұ  d 68 DD( )a}dt;: D%$eD((} d/8e" 'D($Z)aVd* 6)a}D%ܢ$* dt e? D%$8adc eK DD$S5Fad[ 8H D'$tT#e[ a D$EMbdtqglddD$%dpAd1'(!e ;G$$3~a 'a(e D$%6͌ eU  e D$$Te a  a G$'ڨa ^'a aH(%fee qG$%ad -a!e :D$$fa4 e@  G$D~aee D($|a 'e --a}D$Ee -aVdD$EC e "-aVd G$$)aE$ŝ&e@p2 +ae6E'%&4d; a $aZ D$8Be eO adS DDDPP adeeH%8 eN eN  tG$$~L aH e\  H aZE$D]Z dd  H aZ bbD($$h Be  a K^HD($_v 'a P:' E$$ e e +E%'q e e  ^aD$$v d  ^a e D(HP H e  taPdH(L  e  ta K^D'%4U H'a e  .EaX$%  K^H'a d DD$R Pd \ ]D$'  ^ \ a D%$d H e H d  D$$u a\ H!e D$(  a 28a%E$$, ei ee  -aeH($R: B  aZdc  ,aeH($fRH P  aZdc  +aeH($ÌV ^  aZdc  ^adHĒ$Ţd i  ta PH!eH$$r  a K^H'aHU*DDv He  e  adHŢ$[  ad H e  DD$/y tad \ ]D$'  ^ \ a D%$B H e H d  D$$A a\ H eH$$]uw  28a aZD$$9P bbH e  G$$Wy a K^H'aD$$j Pe eH$$_ k  +e% e DĒ(  ^a d*  ^G%%( a e=  e8  tG%%L]6 aPdQ  eQ  tG$$D a K^H'aD'$qR ef  a K^HD((` 'adi Pd \ D$$7n ] ^ D$$A| \ Ea  H e HDD$ d  a \ D($+) H!e e DDDۦ e  ad  aD'$p e  a K^HD$$߲ 'ae -e D%(  ta ad D'$w e  a K^HD$$a 'ae -e D$$  ta,e  |a E'$ a ^ad -e. D$$7 e  3 a 28 D$D$ a aZd ,eH$Du2 K e<  3a 28 D$(@  a aZd +ED(N eh eY  3a 28DDE\  a  aZd D$$ 3j e ez  ^aE8$Mx d  a e z2 e D(%d  3 a 3 a 2D(( 8  a  aZd  D$$A ta PH!e  G$$u a K^H'aHD$8ؾ e  e  ad  DD( ad H e>  taX$$] d \ ]D$4  ^ \ a  H DD(ti e H d  aX$%0  \  e  2D((7 8  a aZ bD'$} b< ^a K^H/D$$. 'a eO D%$^< eK dHDlXJ O  ta eY  adHĒ$.X ]  a K^H'G%$ f ae ey  DDRt tad  a!e  D$8 ta e  ad  D$$ߐ a K^@'a DD$= e e  D' a! a!#E8'c e  tad  ta bD$$ b< ^a K^H_DD$6 'a e D$$R e E8(8 d  ta e aE8$^d a K^HD$$'a e9E$$%e5 a! aXD(k*!#e3 tad9 taX((B8 eC adG aX$'XeF K^@'aD$$eDTeoec tadH8$TNbo a!eo ta D$$`pb b K^H'aH$$~  a eH$$QڌeeH$% eD$$Шd ta e+ G$$ a K^H' aX$DC  e aE$'9dx)e ad)D(e) a ,#E8$ne ad) aX$(e%eDD$u e d)dH($d d) DD(,&tad 3 a  E$$z4aZ b bJ K^@D$$B'a e_eH$(wP[ a aZd_ }aX$$O^ b bJ K^@D$$l'a eeD$Dlz a G aZd }aD$$մ bb K^'E%'.\a e ^aD$(xee taX$%d!e tG%8?a e tad G$$`a K^@e'a E%%ae-e tG$D%a 28a H D$$_ aZ b b< K^@D8(.'ae#-ED(Le a >a<d# taX$(" b bPweI-E($m 0e8 a<dI,eC DD$2>a<dI }a- b D%%LbPeo-e^ E$$Za<do,ei a<dHĒ$Dho }a- b bXD$'Ave,e }aeH D$( e aZd aH$$<- b b<eD$%"-e }a a<*D$DŮ b bJeE8(le }a :a4- D$$gb b<e-eD$$EX }a ;a<+ b bD(%IRnee }G$$TfaH e aVE$$Ad  "aV bbD$8eY a KD$$wC^@'a  e0 #G$$K,ad4 aeSDD(`:eE }adSHD%8H !"eS taD$$dVd\ H elD$$d]ds]D%8FrH e} ta ^ DM'$*\ a H eD(ńqH e ad G$$˜aH   \ D$$Te 28E$$iѸaH e aZdH%%B H e aZdD(E(H e a<d D$$paZH e* bD$$݌b H  D$%~ !e  )8 aZD$% eA e.D'$e# ~ad,^ D(8C(( d3 ^a aD$$#6 e ^aeT D$$SDa K^H'aE$$YRdee ^DD$`a d| ^a D'D6n a!e| aD$$ | a\K^H'(!E8$Jӊe a K^HDD$c'ad  K^H'G%%ae  e D$( Ѵee D$%/Gee a'eHDp a ,a-"E($e a<,   D($D. ad a   D((N@. ade aD(čr  d a aX$D_!e ad  DD$g$"e,R e D((M/2  e= adA aX((@ ereO ~aX$$fNH e_ = aH%$u\dr ek  aZdH$$m*jr . aH  bD$$ xb eu D$$◆e ^(!eDDDɔe ad aD((. d a- d ae d E%%Ma d a d a dDDDZV apd a`d a7dH(( ad a d% aE$Ecdq"gdddE(EodddddddE(EdddddddD$D ^(!e eH(źR ad ad D%%~  #eBe1%M aX'$O.d5 a ^@D(%p*<'a a dm a$dDDDwPJ aJd apd adH((X ad ad aEE$?nfd a dq #gsdHE(tEdJdOdTdYd^dcdHE$.cdhdhdhdO  D$'9#e e adD(  ad a  _PASCAL.AL{Y BEGIN COMMENT - PROGRAM TO MONITOR THE PASCAL COMPILER ASSEMBLER ETC. BY ARTHUR FOSTER ON THE 20TH. MAY 1977... END; LITERAL NIL (0); POINTER LIBLIST; INTEGER REVISION,UPDATE; INTEGER (2) SWITCHES; BOOLEAN LOAD,LOADMAP,LIBRARY; BOOLEAN BINARY,LISTING,PCODE,MONITOR,EXTN,FAILED; STRING PROGFILE,PCODEFILE,LISTFILE,LOADFILE,QCODEFILE,BINARYFILE; STRING LIBFILE,SAVEFILE,MONITORFILE; EXTERNAL PROCEDURE FERROR; EXTERNAL PROCEDURE GTIME; EXTERNAL PROCEDURE SWOP; STRIoCNG PROCEDURE CAT(B,C); STRING B,C; BEGIN STRING A; A := B; SUBSTR(A,LENGTH(A)+1,LENGTH(A)+LENGTH(C)) := C; CAT := A END; PROCEDURE ERRORMESSAGE(TEXT); VALUE TEXT; STRING TEXT; BEGIN FAILED := TRUE; OPEN(3,MONITORFILE); WRIT&E(3,"PASCAL MONITOR...",TEXT,"<15>"); CLOSE(3) END; PROCEDURE SWOPPROG(PROGNAME); VALUE PROGNAME; STRING PROGNAME; BEGIN INTEGER ERRORNUMBER; IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; h GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PASCAL MONITOR...",HOUR,":",MINUTE,":",SECOND, " ",PROGNAME," ENTERED ","<15>"); CLOSE(3) END; CLOSE(0); PROGNAME := C(AT(PROGNAME,"<0>"); SWOP(PROGNAME,ERRORNUMBER); IF ERRORNUMBER <> -1 THEN BEGIN COMMENT - OTHER ERROR TRAPS ARE POSSIBLE HERE!; IF ERRORNUMBER < 255 THEN FERROR(ERRORNUMBER) m ELSE IF ERRORNUMBER = 318 THEN BEGIN EXTN := TRUE; LOAD := FALSE END ELSE IF ERRORNUMBER = 311 THEN ERRORMESSAGE("ERROR(S) IN P-CODE ASSEMBLER") ELSE FAILED := TRUE END END; STRING PROCEDURE EXTENSION(PROGNAME,EXTENT); VALUE PROGNAME,EXTENT; STRING PROGNAME,EXTENT; BEGIN INTEGER I; I := INDEX(PROGNAME,"."); IF I <> 0 THEN SETCURRENT(PROGNAME,I-1); PROGNAME := CAT(PROGNAME,"."); PROGNAME := CAT(PROGNAM{E,EXTENT); EXTENSION := CAT(PROGNAME,"<0>") END; PROCEDURE APPENDCOM(PARAMNAME,SWITCHES); VALUE PARAMNAME,SWITCHES; STRING PARAMNAME; INTEGER (2) SWITCHES; BEGIN WRITE(0,PARAMNAME); BYTEWRITE(0,ADDRESS(SWITCHES),4); END; BOOLEAN APROCEDURE EXISTS(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); EXISTS := TRUE; GOTO QUIT; NOFILE: ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST")); EXIST S := FALSE; QUIT: END; PROCEDURE CREATEFILE(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); DELETE(FILENAME); NOFILE: OPEN(4,FILENAME); CLOSE(4) END;3 PROCEDURE CREATECOM(PROGNAME,SWITCHES); VALUE PROGNAME,SWITCHES; STRING PROGNAME; INTEGER (2) SWITCHES; BEGIN DELETE("COM.CM<0>"); OPEN(0,"COM.CM<0>"); APPENDCOM(PROGNAME,SWITCHES) END; PROCEDURE GENERATELIST(PT,FILENAME); VALtUE FILENAME; POINTER PT; STRING FILENAME; BEGIN POINTER PT1,PT2; BASED STRING BSTRING; BASED POINTER BPT; INTEGER I; ALLOCATE(PT1,20); IF PT = NIL THEN PT := PT1 ELSE BEGIN PT2 := PT;  LOOP : IF PT2 -> BPT <> NIL THEN BEGIN PT2 := PT2 -> BPT; GOTO LOOP END; PT2 -> BPT := PT1 END; FOR I := 0 STEP 1 UNTIL 19 DO (PT1 + I)->BPT := NIL; (PT1+1)->BSTRING := FILENAME END; BOOLEAN PROCEDURE TESTFILE(TESTNAME); VALUE TESTNAME; STRING TESTNAME; BEGIN TESTNAME := CAT(TESTNAME,"<0>"); OPEN(4,TESTNAME,NOFILE); CLOSE(4); TESTFILE ʗ:= TRUE; GOTO FINIS; NOFILE : TESTFILE := FALSE; FINIS: END; PROCEDURE READCOM(ERROR); LABEL ERROR; BEGIN STRING FILENAME; BOOLEAN ARRAY PSWITCH,PROGSWITCH [25]; OPEN(0,"COM.CM"); COMARG(0,FILENAME,PROGSWITCH,ERR2); ; COMARG(0,PROGFILE,PSWITCH,ERR1); IF NOT EXISTS(PROGFILE) THEN GOTO ERROR; COMMENT - SET THE INITIAL NAMES FOR EACH OF THE FILES; SAVEFILE := EXTENSION(PROGFILE,"SV"); LISTFILE := EXTENSION(PROGFILE,"LS"); PCODEFILE :=]# EXTENSION(PROGFILE,"PC"); LOADFILE := EXTENSION(PROGFILE,"LD"); QCODEFILE := EXTENSION(PROGFILE,"QC"); BINARYFILE := EXTENSION(PROGFILE,"RB"); COMMENT - AND NOW THE SWITCHES; IF NOT PROGSWITCH[1] THEN LOAD := TRUE;  IF PROGSWITCH[4] THEN EXTN := TRUE; IF PROGSWITCH[11] THEN LISTING := TRUE; IF PROGSWITCH[15] THEN PCODE := TRUE; IF PROGSWITCH[12] THEN LOADMAP := TRUE; IF PROGSWITCH[25] THEN MONITOR := TRUE; COMMENT - AND THE LOCA L SWITCHES,WHICH DEFINE THE FILES; LOOP: BEGIN COMARG(0,FILENAME,PROGSWITCH,QUIT); IF PROGSWITCH[11] THEN BEGIN LISTING := TRUE; LISTFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[15] THEN 9} BEGIN PCODE := TRUE; PCODEFILE := EXTENSION(FILENAME,"PC") END ELSE IF PROGSWITCH[12] THEN BEGIN LOADMAP := TRUE; LOADFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[18] THEN  SAVEFILE := EXTENSION(FILENAME,"SV") ELSE IF PROGSWITCH[1] THEN BINARYFILE := EXTENSION(FILENAME,"RB") ELSE IF PROGSWITCH[25] THEN BEGIN MONITOR := TRUE; MONITORFILE := CAT(FILENAME,"<0>") h END ELSE IF PROGSWITCH[4] THEN BEGIN LIBRARY := TRUE; EXTN := TRUE; LIBFILE := EXTENSION(FILENAME,"RB"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE B+OEGIN LIBFILE := EXTENSION(FILENAME,"LB"); IF TESTFILE(LIBFILE) THEN  FILENAME := LIBFILE ELSE IF NOT TESTFILE(FILENAME) THEN BEGIN ERRORMESSSAGE(CAT(FILENAME," DOES NOT EXIST")); FILENAME := "<0>" END ELSE FILENAME := CAT(FILENAME,"<0>") END; GENERATELIST(LIBLIST,FILENAME) END O END; GOTO LOOP; ERR1: ERRORMESSAGE("NO SOURCE FILE SPECIFIED");  GOTO ERROR; ERR2: ERRORMESSAGE("COM.CM IN ERROR"); GOTO ERROR; QUIT: CLOSE(0); IF FAILED THEN GOTO ERROR END; PROCEDURE GENCOMPCALL; IF EXISTS("P4COMPILER.ShV") AND EXISTS("P4COMPILER.OL") THEN BEGIN CREATECOM("P4COMPILER",SWITCHES); APPENDCOM(PROGFILE,SWITCHES); CREATEFILE(LISTFILE); CREATEFILE(PCODEFILE); APPENDCOM(LISTFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); SWOPPROG("P4COMPILER.SV") END; PROCEDURE GENERRCALL; IF EXISTS("P4ERRSUM.SV") AND EXISTS("P4ERRORS") THEN BEGIN CREATECOM("P4ERRSUM",SWITCHES); SWITCHES := -17777777777R8; IF LISTING THEN APPENDCOM(LISTFILE,SWITCHES) ELSE APPENDCOM(MONITORFILE,SWITCHES); SWITCHES := 0; SWOPPROG("P4ERRSUM.SV") END; PROCEDURE GENPASMCALL; IF (IF EXTN THEN EXISTS("P4MAC.SV") ELSE EXISTS("P4ASM.SV")) THEN BEGIN IF EXTN THEN CREATECOM("P4MAC",SWITCHES) ELSE CREATECOM("P4ASM",SWITCHES);  CREATEFILE(QCODEFILE); APPENDCOM(QCODEFILE,SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("P4MAC.SV") ELSE SWOPPROG("P4ASM.SV") END; PROCEDURE GENASMCALL; IF (IF EXTN THEN EXISTS("MAC.SV") ELSE EXISTS("ASM.SV")) THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(BINARYFILE); APPENDCOM(BINARYFILE,SWITCHES); APPENDCOM("<0>",SWITCHES); APPENDCOM(QCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("MAC.SV") ELSE SWOPPROG("ASM.SV") END; PROCEDURE GENRLDRCALL; IF EXISTS("RLDR.SV") AND EXISTS("P4CUE.RB") AND EXISTS("P4LIB.LB") THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(LOADFsILE); SWITCHES := 4000000R8; APPENDCOM(LOADFILE,SWITCHES); SWITCHES := 0; CREATEFILE(SAVEFILE); SWITCHES := 20000R8; APPENDCOM(SAVEFILE,SWITCHES); SWITCHES := 0; APPENDCOM("P4CUE.RB",SWITCHES); APPENDCOM("P4LIB.LB",SWITMLCHES); APPENDCOM(BINARYFILE,SWITCHES); IF LIBRARY THEN BEGIN BASED STRING BSTRING; BASED POINTER BPT; STRING FILENAME; LOOP : IF LIBLIST <> NIL THEN BEGIN FILENAME := (LIBLIST+1)->BSTR̺ING; SETCURRENT(FILENAME,INDEX(FILENAME,"<0>")); APPENDCOM(FILENAME,SWITCHES); LIBLIST := LIBLIST->BPT; GOTO LOOP END END; SWOPPROG("RLDR.SV") END; PROCEDURE INIT; BEGIN INTEGER I; MONITORFILE := "$TTO<0>"; REVISION := 2; UPDATE := 1; SWITCHES := 0; LIBLIST := NIL; LIBRARY := BINARY := LISTING := PCODE := MONITOR := FALSE; FAILED := LOAD := LOADMAP := EXTN := FALSE END; BEGIN INIT; READCOM(ABSEND); IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"NOVA PASCAL REVISION ",REV϶ISION,".",UPDATE); WRITE(3," ON ",DAY,"/",MONTH,"/",YEAR,"<15>"); CLOSE(3) END; GENCOMPCALL; IF NOT LISTING THEN DELETE(LISTFILE); IF FAILED THEN BEGIN MONITOR := FALSE; GENERRCALL; Q DELETE("P4ERRORS"); MONITOR := TRUE END ELSE BEGIN GENPASMCALL; IF NOT FAILED THEN BEGIN GENASMCALL; DELETE(QCODEFILE); IF LOAD AND N.OT FAILED THEN BEGIN GENRLDRCALL; IF NOT LOADMAP THEN DELETE(LOADFILE) END END END; IF NOT PCODE THEN DELETE(PCODEFILE); ABSEND: IF MONITORPa THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PASCAL MONITOR...",HOUR,":",MINUTE,":",SECOND," FINISHED"); IF FAILED THEN WRITE(3e K," WITH ERRORS") ELSE WRITE(3," SUCCESSFULLY"); WRITE(3,"<15>"); CLOSE(3) END; END; MAKEP4MAC.CMY 0A:&DELETE/V P4MAC.LD;^ RLDR P4CUE P4LIB.LB P4MAC P4MAC/S P4MAC.LD/LPCODE.AL -BEGIN COMMENT - PROGRAM TO MONITOR THE PCODE ASSEMBLER ETC. BY ARTHUR FOSTER ON THE 20TH. MAY 1977... END; LITERAL NIL (0); POINTER LIBLIST; INTEGER REVISION,UPDATE; INTEGER (2) SWITCHES; BOOLEAN LOAD,LOADMAP,LIBRARY; G4BOOLEAN BINARY,LISTING,PCODE,MONITOR,EXTN,FAILED; STRING PROGFILE,PCODEFILE,LISTFILE,LOADFILE,QCODEFILE,BINARYFILE; STRING LIBFILE,SAVEFILE,MONITORFILE; EXTERNAL PROCEDURE FERROR; EXTERNAL PROCEDURE GTIME; EXTERNAL PROCEDURE SWOP; STRING PROCEDUHRE CAT(B,C); STRING B,C; BEGIN STRING A; A := B; SUBSTR(A,LENGTH(A)+1,LENGTH(A)+LENGTH(C)) := C; CAT := A END; PROCEDURE ERRORMESSAGE(TEXT); VALUE TEXT; STRING TEXT; BEGIN FAILED := TRUE; OPEN(3,MONITORFILE); WRITE(3,"PCODE: MONITOR...",TEXT,"<15>"); CLOSE(3) END; PROCEDURE SWOPPROG(PROGNAME); VALUE PROGNAME; STRING PROGNAME; BEGIN INTEGER ERRORNUMBER; IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEA=R,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PCODE MONITOR...",HOUR,":",MINUTE,":",SECOND, " ",PROGNAME," ENTERED ","<15>"); CLOSE(3) END; CLOSE(0); PROGNAME := CAT(PROGNAME,f"<0>"); SWOP(PROGNAME,ERRORNUMBER); IF ERRORNUMBER <> -1 THEN BEGIN COMMENT - OTHER ERROR TRAPS ARE POSSIBLE HERE!; IF ERRORNUMBER < 255 THEN FERROR(ERRORNUMBER) ELSE IF ERRORNUMBER = 318 THEN BEGIN EXTN := TRUE; LOAD := FALSE END ELSE IF ERRORNUMBER = 311 THEN ERRORMESSAGE("ERROR(S) IN P-CODE ASSEMBLER") ELSE FAILED := TRUE END  END; STRING PROCE\DURE EXTENSION(PROGNAME,EXTENT); VALUE PROGNAME,EXTENT; STRING PROGNAME,EXTENT; BEGIN INTEGER I; I := INDEX(PROGNAME,"."); IF I <> 0 THEN SETCURRENT(PROGNAME,I-1); PROGNAME := CAT(PROGNAME,"."); PROGNAME := CAT(PROGNAME,EXTENT); * EXTENSION := CAT(PROGNAME,"<0>") END; PROCEDURE APPENDCOM(PARAMNAME,SWITCHES); VALUE PARAMNAME,SWITCHES; STRING PARAMNAME; INTEGER (2) SWITCHES; BEGIN WRITE(0,PARAMNAME); BYTEWRITE(0,ADDRESS(SWITCHES),4); END; BOOLEAN PROCEDURE EXmISTS(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); EXISTS := TRUE; GOTO QUIT; NOFILE: ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST")); EXISTS := FALSE; $ QUIT: END; PROCEDURE CREATEFILE(FILENAME); VALUE FILENAME; STRING FILENAME; BEGIN FILENAME := CAT(FILENAME,"<0>"); OPEN(4,FILENAME,NOFILE); CLOSE(4); DELETE(FILENAME); NOFILE: OPEN(4,FILENAME); CLOSE(4) END; PROCEDURE CREATECOM(PROGNAME,SWITCHES); VALUE PROGNAME,SWITCHES; STRING PROGNAME; INTEGER (2) SWITCHES; BEGIN DELETE("COM.CM<0>"); OPEN(0,"COM.CM<0>"); APPENDCOM(PROGNAME,SWITCHES) END; PROCEDURE GENERATELIST(PT,FILENAME); VALUE FILENAME; POINTER PT; STRING FILENAME; BEGIN POINTER PT1,PT2; BASED STRING BSTRING; BASED POINTER BPT; INTEGER I; ALLOCATE(PT1,20); IF PT = NIL THEN PT := PT1 ELSE BEGIN PT2 := PT; LOd@OP : IF PT2 -> BPT <> NIL THEN BEGIN PT2 := PT2 -> BPT; GOTO LOOP END; PT2 -> BPT := PT1 END; FOR I := 0 STEP 1 UNTIL 19 DO (PT1 + I)->BPTȫ := NIL; (PT1+1)->BSTRING := FILENAME END; BOOLEAN PROCEDURE TESTFILE(TESTNAME); VALUE TESTNAME; STRING TESTNAME; BEGIN TESTNAME := CAT(TESTNAME,"<0>");  OPEN(4,TESTNAME,NOFILE); CLOSE(4); TESTFILE := TRUE;  GOTO FINIS; NOFILE : TESTFILE := FALSE; FINIS: END; PROCEDURE READCOM(ERROR); LABEL ERROR; BEGIN STRING FILENAME; BOOLEAN ARRAY PSWITCH,PROGSWITCH [25]; OPEN(0,"COM.CM"); COMARG(0,FILENAME,PROGSWITCH,ERR2); COMARG(0,:sPROGFILE,PSWITCH,ERR1); COMMENT - SET THE INITIAL NAMES FOR EACH OF THE FILES; SAVEFILE := EXTENSION(PROGFILE,"SV"); LOADFILE := EXTENSION(PROGFILE,"LD"); PCODEFILE := EXTENSION(PROGFILE,"PC"); COMMENT - z1ENSURE THAT THE FILE EXISTS; IF NOT EXISTS(PCODEFILE) THEN GOTO ERROR; QCODEFILE := EXTENSION(PROGFILE,"QC"); BINARYFILE := EXTENSION(PROGFILE,"RB"); COMMENT - AND NOW THE SWITCHES; IF NOT PROGSWITCH[1] THEN LOAD := TR5UE; IF PROGSWITCH[4] THEN EXTN := TRUE; IF PROGSWITCH[15] THEN PCODE := TRUE; IF PROGSWITCH[12] THEN LOADMAP := TRUE; IF PROGSWITCH[25] THEN MONITOR := TRUE; COMMENT - AND THE LOCAL SWITCHES,WHICH DEFINE THE FILES; LOndOP: BEGIN COMARG(0,FILENAME,PROGSWITCH,QUIT); IF PROGSWITCH[12] THEN BEGIN LOADMAP := TRUE; LOADFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[18] THEN SAVEFILE := EXTENSION(FILENAMER,"SV") ELSE IF PROGSWITCH[1] THEN BINARYFILE := EXTENSION(FILENAME,"RB") ELSE IF PROGSWITCH[25] THEN BEGIN  MONITOR := TRUE; MONITORFILE := CAT(FILENAME,"<0>") END ELSE IF PROGSWITCH[4] THEN y BEGIN LIBRARY := TRUE; EXTN := TRUE; LIBFILE := EXTENSION(FILENAME,"RB"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE BEGIN LIBFILE := EXTENSION(FILENAME,"LBA"); IF TESTFILE(LIBFILE) THEN FILENAME := LIBFILE ELSE IF NOT TESTFILE(FILENAME) THEN BEGIN ERRORMESSAGE(CAT(FILENAME," DOES NOT EXIST"));  FILENAME := "<0>" END ELSE FILENAME := CAT(FILENAME,"<0>") END; GENERATELIST(LIBLIST,FILENAME) END END; GOTO LOOP; ERR1: ERRORMESSAGE("NO SOURCE FILE SPECIFIED"); GOTO ERROR; ERR2: ERRORMESSAGE("COM.CM IN ERROR"); GOTO ERROR; QUIT: CLOSE(0); IF FAILED THEN GOTO ERROR END; PROCEDURE GENPASMCALL; IF (IF EXTN THEN EXISTS("P4MAC.SV") ELSE EXISTS("P4ASM.SV")) THEN BEGIN IF EXTN THEN CREATECOM("P4MAC",SWITCHES) ELSE CREATECOM("P4ASM",SWITCHES); CREATEFILE(QCODEFILE); APPENDCOM(QCODEFILE,SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); APPENDCOM(PCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("P4MAC.SV") ELSE SWOPPROG("P4ASM.SV") END; PROCEDURE GENASMCALL; IF (IF EXTN THEN EXISTS("MAC.SV") ELSE EXISTS("ASM.SV")) THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(BINARYFILE); APPENDCOM(BINARYFILE,SWITCHES); APPENDCOM("<0>",SWITCHES); APPENDCOM(QCODEFILE,SWITCHES); IF EXTN THEN SWOPPROG("MAC.SV") ELSE SWOPPROG("ASM.SV") END; PROCEDURE GENRLDRCALL; IF EXISTS("RLDR.SV") AND EXISTS("P4CUE.RB") AND EXISTS("P4LIB.LB")M THEN BEGIN CREATECOM("",SWITCHES); APPENDCOM(MONITORFILE,SWITCHES); CREATEFILE(LOADFILE); SWITCHES := 4000000R8; APPENDCOM(LOADFILE,SWITCHES); SWITCHES := 0; CREATEFILE(SAVEFILE); SWITCHES := 20000R8; APPENDCOM(SAVEFefILE,SWITCHES); SWITCHES := 0; APPENDCOM("P4CUE.RB",SWITCHES); APPENDCOM("P4LIB.LB",SWITCHES); APPENDCOM(BINARYFILE,SWITCHES); IF LIBRARY THEN BEGIN BASED STRING BSTRING; BASED POINTER BPT; STRING FILENAME; LOOP : IF LIBLIST <> NIL THEN BEGIN FILENAME := (LIBLIST+1)->BSTRING; SETCURRENT(FILENAME,INDEX(FILENAME,"<0>")); APPENDCOM(FILENAME,SWITCHES); LIBLIST := LIBLIST->BPT; GOTO LOOP END END; SWOPPROG("RLDR.SV") END; PROCEDURE INIT; BEGIN INTEGER I; MONITORFILE := "$TTO<0>"; REVISION := 2; UPDATE := 0; SWITCHES := 0; LIBLIST := NIL; LIBRWARY := BINARY := LISTING := PCODE := MONITOR := FALSE; FAILED := LOAD := LOADMAP := EXTN := FALSE END; BEGIN INIT; READCOM(ABSEND); IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"NOVA PCODE REVISION ",REVISION,".",UPDATE); WRITE(3," ON ",DAY,"/",MONTH,"/",YEAR,"<15>"); CLOSE(3) END; BEGIN GENPASMCALL; IF NOCT FAILED THEN BEGIN GENASMCALL;  DELETE(QCODEFILE); IF LOAD AND NOT FAILED THEN BEGIN GENRLDRCALL; IF NOT LOADMAP THEN DELETE(LOADFILE) END END END; ABSEND: IF MONITOR THEN BEGIN INTEGER YEAR,MONTH,DAY,HOUR,MINUTE,SECOND; GTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND); OPEN(3,MONITORFILE); WRITE(3,"PCODE JMONITOR...",HOUR,":",MINUTE,":",SECOND," FINISHED");  IF FAILED THEN WRITE(3," WITH ERRORS") ELSE WRITE(3," SUCCESSFULLY"); WRITE(3,"<15>"); CLOSE(3) END; END; R2CSPTAB.RBYU-p%#T@n8D$$erD$$-$IR$I$I$IZpHnUxFO#x UVx$I$IH}Vx7x _ A  _A x _R2SINTEGER.RBY!67Sb$I$IILBBA Ф_12_)vF$1FD_#_Q__ F_AD$$!4!!,!L !4!!,D$$!L !,!L !4!,Z!L !4D$$!!,J !D !,p!L !4D$$ג*!!,  NL!L !4!!,J D8!L H :0 _R2CITAB.RBYY 7텯bm{{@<@{{ <$$ $$W2$$I2$HC*123456HHH2&8789:;<=>k?ȐHFHIJLMNPQRH0$vTTUVXY$b@ikmHHNpotvwxyz{|l~}~HHHjYxG/G.aG-aH,0f&_*BnAl7+1`Ф Ф_2HHH2_vF1Fx(p_'&äP%#PF"Y!DD_##_QHHH?Q_LA}$_FF_P)isiraiqjplAAHHÛH?DfgeldGFDE7DOCB7_c buHȐH% a5 BjAh&~ GZF[_A^&} }]7\$}W&S}O FK _R2IFT.RBY!:\OSHQD6@pH _PASCFLS.m ~4PASCFLS,^ P4COMPILER.,^ P4ASM.SV,^ P4MAC.SV,^ P4LIB.LB,^ PCMESSAGE.ER,^ P4CUE.RB,^ P4ERRSUM.SV,^ PASCAL.SV,^ PCODE.SV^ R2RFNS.RBU!9TS$I$I@0F$#!x UVxM @O N b*D$$)Y0Z!!,!D!0:D$$X )   0  D$$ P  !DiHLA)pf _R2SSET.RBY!6s$@ Вx>p_/"äPu{P$$<0!,!!!D D$$!!D4 !8 'X!4!',D$$'L' !8 'X!4!',D&$*'L' !8 'X!4!',VJD$&}8'L' !8 !X#(D$ F@#P!L  _R2RFW.RB  44T-x@d _MAKEPASCAL.CMR /?DELETE/V PASCAL.LD;^ RLDR PASCAL SWOP @LIBRARY.CM@ PASCAL.LD/LP4BLOCK.RBYN7mNC$I@`-!x-R#$2llt2!#Q-׉Oى-q(P(D$D٢bb"\)!e#(!D%;\)!"e ad D'$(!e# a b$ȯb D$(* O(!e@ 2aX$$8 O'aO(eNDDD|FeqeT+ diD$$`ZT  +D$$Ob  adH$$jp@^30("E%((~eed G%$uae ^@ G$$a  E%%ZPe -ee D((E d ,eE$$e ^-e.D%$^+ d^- D%$e D$(6 d D'Łd ia ad@D$$y ee- D% ad@e8PD$$&e.^- ,  G$%4ad@ ja aD$%ǭB(!eN a a D$$uP bb`#eHD8^cdw  a  D$$Bla  " bD%x(CQzbedD($Ȉ"eekD%$ndWdi axD$$Cdi 7 7 eD$$TͲ  "eH$%m  d !e D$$,}~A   D$(_7 7 ax D$(DŽ 7di axdiD%$ ax axD$Dj"  aR"diD$$  D$(9""e7  ax" D%$D0 d "D$$>"""dH$( Li axdigHE()~Z[dddddddH$$nFhMdez aH$D7vxdVe ED$axdd bD$$ibLeeH%$  +axe b,D$(adbD&e eD8$A a ad ^^a D$$x^  %aeD8( a a e aD$(L ae e aDDĔ a d ^_a ^D($'%a^(eH8d a ad eH(ċ+,e, ({a aD$$,(\)# "#eH($:e e&D'$[HeQ adU a D$$RV^@'a  D%8)d"!"es a aH$$r (#\Z61)# D('y"#eUd a E bd;  _MAKEP4ERRS.CMY 0M DELETE/V P4ERRSUM.LD;^ RLDR P4CUE P4LIB.LB P4ERRSUM P4ERRSUM/S P4ERRSUM.LD/LR2SMISC.RBYU-ڕtu$I$IHPېG&~ `HAG;+GB`G7F6YxHf%&7FܱC{\C{DĒ$<!,!* !!D !,!!4G$$K! :Z !,!!$D$$d!L  (  !4! xD8$@* !$!)(!!D  !$D$$I8!D !$@!L  !$!)X@F(H74pHI _R2SMPY.RB  &ڕTvHJ`7 wD$$X0YDr _MAKEPCODE.CMDELETE/V PCODE.LD;^ RLDR PCODE SWOP @LIBRARY.CM@ PCODE.LD/LPCMESSAGE.ERY 0ILLEGAL INSTRUCTION ENCOUNTERED BY THE INTERPRETER STACK SPACE EXHAUSTED EOF SET FOR 'GET' INSTRUCTION EOF SET FOR 'READ' INSTRUCTION HEOF NOT SET FOR 'PUT' INSTRUCTION 'WRITE' BUFFER EMPTY UNDER/OVERFLOW FLAG SET ON RETURN FROM RFPI OVERFLOW ON TRUNCATE INSTRUCTION dZMISSING LABEL IN CASE STATEMENT - UJC ENCOUNTERED TOO MANY TEXT FILES REQUESTED AT ONE TIME ILLEGAL EXTERNAL PROCEDURE CALL VALUE OUT OF RANGE...AT RANGE CHECK INSTRUCTION HEAP SPACE EXHAUSTED...PROCEDURE NEW FIELD WIDTH IS NEGATIVE OR EXCEEDS 120 INPUT ERROR...FLOATING POINT INTERPRETER OUTPUT ERROR...FLOATING POINT INTERPRETER R2IREAL.RBY!:~}‹$I$IGФ2D#QLA}FD6@pH _R2SMYP.RBYU-rؕtw)|D$$ YJJY9@, _P4MAC.RBY 1#_8   @G) D$$b bv+SR T D$$" D$$mT+CC P D$$* ^<"5D$$8+NA DD$$)F ^D$$BT"+D$$bRW I D$$p D$$t~+ID F  .D$$t^% D$$xh+HC R D$$c^0D$$r+NIID D$$1^XD$$͖F+RSSO aLD$$ ^TD$$d+ELAQ D$$y ^D$$t +CL A D$$d ^+D$$w&+OED$Qv$4 F  D$$B^)D$$pP+DL A D$$q^^\D$$ml+TA N D$$TzD$$l+DL C D$$^^D$$Q`+JF P D$$-Ѳ^eD$$+EDCC D$$R ^nD$$"R<n+DA R D$$$ ^D$$z +LF OD$$N  ^D$$H !+D$$˵"LE N !D$$0q!"D$$a>+AL O "D$$AL^]"F#D$$hZ+SC P D$$h#^c#D$$Tvv$+EDIC D$$I$;^l$D$$ n%+NE T D$$ %^b%D$$#&+VD I D$$g &^D$$&'+UC P D$$ 0'^aD$$h'2(+NJD$$8 C (D$$^4()D$$h+DO D )D$$^)*D$$c,+AP G ? D$$n:**D$$_H++LF T D$$k5V+^+D$$|$d b b-+LH T D$$ r -^D$$-.R+HCD$$wAK .D$$^ ./D$$4q+NI N /D$$0^(/D$$/b0+GN I D$$=0^0<D$$e1+HCBK D$$1^q1D$$S2+HCCK D$$rN  2^p2D$$O3+XC P D$$Y( 3^u'D$$6324+DR CD$$D 4 D$$R45+OID$$ ` R 5D$$D n^#56D$$Xp|+XI A 6D_)$$ъ^_6n7D$$sh+OM D D$$7^7D$$l8+HCIK D$$8^q8D$$9+GN R D$$4 9^9D$$H:+BS I D$$l :^D$$$:;+NI T D$$C ;^&D$$=$;<+EDD$$2bAC <D$$@^l<n=D$$[N+PJ T =D$$\^}=>D$$bj+PM I D$$5 x>^>D$$Gj?+PJ F D$$̔?^~?D$$@+TSCR D$$Ѡ @^P@D$$#A+HCRK D$$  A^pD$$mAB+HCSK D$$j B^pD$$ BC+BSD$$  R CD$$^CED$$O +AS V ED$$I.E:GD$$f<+PM R GD$$J^GD$$|SXI+OM V D$$fI^`IxD$$ZVtJ+DR I D$$ȂJ JD$$RK+ON T D$$Ξ K^!KD$$nL+JU C D$$8 L^AD$$LM+IS N D$$c MQD$$M b bND$$!Q+GS S D$$N^$ND$$WO+SM T  D$$[<O^ OD$$`*<P+EGAQ |$ D$$$8 P^PD$$FQ+EGBQ D$$uT Q^D$$bQR+EGCQ D$$p R^D$$~RS+MJ/D$$u  P SD$$^2STD$$`+SR E TD$$TUD$$_+JT P UD$$Z^fU`JD$$aV+OL G D$$lVVD$$NW+DW R D$$C WWD$$~WX+EGIQ D$$B+&X^XD$g$4Y+JU P D$$UB Y^dYD$$(OPZ+DLCC D$$^ Z^^D$$lZ[+VO LD$$|z [D$$k[\+EGD$$5 MQ \D$$$^\ ]D$$V+SR N ]D$$^1]^D$$:^+RT C D$$^1^^D$$g_+DLBC D$$__^^_D$$ `+DLIC D$$- `^^`D$$" a+QS R D$$1Z0 a^D$$v> ab+EGSQ D$$L b^D$$Z bc+QSD$$h T cD$$|v cd+D$$ RW C ^ dD$$  deD$$M +JX P eD$$ Į ^gefD$$)R +TSAO D$$ f^fD$$] g+EGRQB D$$_A g^gD$$ h+NIAC D$$/ h^hhD$$S ni+DLRC D$$; i^^D$$, ij{+NICC D$$: j^jD$$>H jnk+TSD$$V P  kD$$Zd ^*k b bD$$ydr l+NICD D$$Ԁ l^X=lD$$Ž Po+WR R D$$JK ooD$$ p+NIIC D$$ p^hD$$t pnq+DLBO D$$O q^=,LD$$ qFr+DLD$$ CO rD$$ ^LrFsD$$J +RW R sD$$   stD$$mV( +RW S t$D$$6 tvD$$WD +DLAO D$$R v^LvFD$$Q` w+TSRO D$$:n w^ wD$$| x+DLIO D`($$ x^LxD$$ Fy+QEBU D$$r y^D$$Ԃ yz+QECU D$$W z^D$$  z{+NID$$F RD {D$$ ^X{Z|D$$S +ELAS |D$$" ^|}D$$R +ELBS D$$$ }^}D$$:Y2 ~+QEAU D$$@@ ~^~D$$HN +ELBQ D$$\ ^D$$X j ݀+ELIQ D$$mx ݀^D$$ `݁+DLRO D$$̔ ݁^LD$$ ݁Z݂+DLD$$ SO ݂D$$׾ ^L݂d݃D$$L +LW N ݃D$$1 ݄݃D$$qd +QEMU ݄D$$ ^݄ D$$q` +DLNC D$$) ݅^^݅D$$

ݥݥD$$Lݨ+OLCD D$$WZ ݨ^HݨD$$$hݩ+ENBQ D$$lv ݩ^D$$|ݪ+RGAT D$$S ݪ^D$$ݪݫ+ROD$$ BD ݫD$$ ^/ݫݬD$$wZ+ROCD ݬD$$^.ݬE-ݮD$$M+ELSS D$$ ^ݮD$$DHݯ+ERBT D$$0ݯ^ ݯD$$?ݰ+NIAD D$$u, ݰ^XݰD$$:Fݲ+ROID D$$BH ݲ^,D$$pVݴ+ERAT D$${d ݴ^ D$$]Rrݴ b bD$$D+ERIT ? D$$2ݶ^ ݶD$$Oݸ+MC S D$$ݸ^3ݸD$$ĸݹ+EG T D$$C ݹݹD$$ ݼ+OC S ^ D$$Y ݼݼD$$.ݽ+ERPT D$$ ݽ^ D$$ ݽݿ+ERRTD$$ ݿ^D$$tD( ݿ+!D$$6ELCQ D$$XD^D$$kR+NISD D$$`^XdD$$Rn+OE R D$$|D]%$$M+ELCS D$$4^D$$+ROAD D$$ ^-D$$ +VD R D$$%M ^ D$$v+ELMS D$$  ^D$$7 +ELD$$KRQ D$$f^D$$E$+ERCT D$$B2*e^ D$$U@+XE P D$$ND$$K\+ELMQ D$$6j^ D$$>x+EN W D$$ۺ.D$$+ELSQ D$$ۢ ^D$$+LC S D$$0  D$$0+RSAO D$$ ^TD$$F+RSBOD$$ ^D$$TF+D$$RSCO D$$ ^TFD$$`.+NR D 8 D$$<D$$GJ+RSIO D$$X^TFD$$Mf+PO N D$$tD$$y@+TSCOG D$$^ D$$+LR N D$$X@ D$$+TSAR D$$  ^PD$$m+TSBR D$$ ^PD$$P b bxD$$D+TSIO D$$)3^D$$?+RSRO D$$ *^TED$$8Z+BA I D$$F ^D$$AGT+DA I D$$\b ^D$$Qp+NU ID$$~ ^+D$$&'+D$$QTSBO D$$ ^D$$$S+TSSO D$$Y^ D$$]S+BA R bED$$A^D$$;+TSIR D$$%^PD$$+ +RR R D$$> D$$&+TSRR D$2ܒ$4 ^PD$$) B^+TSSRD$$$P ^D$$a^^P^( b DD( lb a af a ao D($y z a a{ a b bD$$t}^+ \\]\ DD$\e]\ +T.TX' D$$tNIUP'T \\D$$^" \\^ D$$b\\^" \\D$$I^^ \\^ D$$8\K\^ \\D$$H^" \\^!D$$  \\^ \\D$$s^+ \\+T.TXD$$' UOPTTU ' \\D$$%"^" \\^D$$P0 \@\^" \D$$%>\^^ \\^D$$kL \\^ \D$$rZ\^+ \\+T.D$$whTX' RP'D \\D$$v^" \\^D$$# \\^" \D$$’\^^ \\^D$$s[ \\^ \D$$Ю\^" \\^D$$`,! \\^ \D$$N(\^+ \\+D$$T.TX' RP'R M \D$$I\^" \\^D$$U \\^" \D$$ \^^ \\D$$p^ \\^ \D$$\\ b btLD$$,&T&+******W**** D$$Y: \ +I SNRT .ON . D$$H \ L%\ +D$$]V' \ D$$d\\ + 'AH SON TEYD$$kr TEB\ +NEC TAREDED$$3F RO \ \ /"\D$$ b bPL&TD$$=&P+NITS.RN .O= D$$ \ L%\ + D$$A \ \D$$'4\ ]\ L\D%$ɼ \e]\ \@ D$$](+** \D$$O \\ +* *LIELD$$AG LOCED\ \  D$$ bb$\.D$$\.\D$$(.\.(D$$6eE\.D$$ϨD^L$D$$dRT$L#T#\+ D$(` ep aED$Mnde \ E$$|e P d DR,$$+ e ED$ae^D$$jƦ^L#DD$UT#dp bbZ^D%$"!e \\D$(c) \\d^D$$1![ \\]\D$$թ bbf^"D$$!e \\D$$ \\d ^D$$Z \\]\D$$$ bbl^"D%$&02Z"!eM \D$$o@\\\dZ^D$$nN \\]D$$Ax\\ bbx^D$$BNj""!e D$$x \\ \\D$$[d^  \D$$Ô\]\ bbDD$e^"eH$$R^ \\E$%;d^"eD$Dq \\d^D$$% \\ \\D$(#" \\d E$$Ge \\d D$$ \\L% \D$$¾\ bb4\H D$$ ^ \H ^D$(.,#H H "eAH DD$ӗ<P d\H .KDD$gJ<(!e+**A SSMELBREC DOD$$X\ + EREOR R : D$$f \ \ P HD$$t H e\H D$%\ H P dv\ D$$#+**L SA TEROCDRDE\D$$) +P OCEDC UOTNRE= D$$\ L% \ \ L&D$$/KT&\H .L(D$$UH P H H \D$$]H .K<("m"eD$$" \H .L(D$$\{H P d bD$$bJH e!H D$$ e!\\ DD$zd  bbX+R.XD D$$`c* 8 \\6D$$ 8+E.TX DC.TS. LC D\D$$F+CPTR N \D$$T\ ^0T^9.D$$#b@L.@ex<L.$'D$$p<LTdc^AT^ZD$$]~.@L.@e8L.$D$$'8LTd8^D$D}y'<'8\)e+**A SSD$$aMELB YOCED\ +S CED$$QYITNON TOP OR\ +EPD$$DLR YNEED.D \ \D$$P~ +**L SA TEROCDRDETMD$$A\ +P OCEDC UOTNRE= D$$-\ L% \ \ ^D%%o7\e\d]D$D \ L^;e\LD($.8(eL D$$& P@ @e: ^ D('$4  d)  \ D$%>BP#L^;#!ep]D$DLP\ L^;en  D$$>^ L L^:enD$%b(l d>\ e D$%{z  ^ ex D$(c稈 @ @e D$$|    E$$cd+PJ C ED$⡲e a +SJ R@ CPTR ND$$z \\ddD$$(w+OP P e E$$a  +SD Z4 1 D$$! \\+DL A D$$0 \ aD$$ \+@ 14 D$D \\dd+UPHSD$D" eo a D$$0 H+SI Z4 1 D$$>\\+TS A D$(RL \ a\D$$Z+@ 14 \D%$h\dd+OLDA D%D v e a  D%(ф a a a+SJD$$X R@ C.DL \\D$$^J \\ \D$$n\+DL A D$$Ӽ\\+@ 74 D$$x \\E$$#dd+TSRO  D$$ ^E"eJ E$$a  +TS A D$Dr \ a\D$$#+4 7 \D$$zg\+SJ R@ C.TS D$(R, \\ Ca \D%$CL:\ a \\E$( Hdd @ @ea D$(w6V\  dN\D$$d e+R.XD 01 D$$fr\\ b$bD$$L \Tr D$Dߎ\ \eDD$^ d\ aH(DB  d#ed \D$%X\\d% a'd%D$%\  ^@ad%DD$ a'd%\ \ 1 D%% a&d% a'd%D$$\ \  D((^a`d% a'd%\D$$ \  ^DDDa a`d% a'd%\ D$%( ]\ L^Le; ]6*DD$6 \ d- \ D$$D \\L\ D$$)R \\]\ d%DD$/` a'd%\  \D$%n \]\ d% aH$$-| 'd%\  aE+E$g d% a'd%\  D((o ^ad% a'd%D$% \  ^ad%DD$w a'd%\  D((D ^ad% a'd%D$Dh \  ad% a'dH$$5 %\  aEE$ d% a'd%\ ]\D$$J  L^Le !]\ E$$!d \  \\D$$!L\ \\D$%95$!]\ d% a'd%D$$2!k \\ \\D$%5@!]\ d% a'd%D$%N!]\ L^Lea!]DD$Hl\!\ dS!\ \D$$j!\L\ \D$Dx!\]\ d% a'dH$$Vӆ!%]\ L^ e!]D($ȭ!\ d!  D$$^!L \ D$$h!\ ^ a D$$X! ^ \\D%E!]\ d% a'd%\D$$N! \ \ aH($[!d% a'd%  \D$$!\]\ \e!D$$6"]\ e$"D$$_"] \\D((9 "d "d% a'd%\D%%."  aam&d% a'd%D$%g<"]\ L.eO"]DD$J"\ dA" L D$$X"\ \ D$$bf"\\ 0E$$Jt"e"+T.TX D$$"\0\& 0\D$$K8" '\0\ 0D$$R "\ \d5# DD$T%" 0e"+T.TX D$$M"\0\ 0D$$"\ ,\0\D$%" 0\ \]d5# D$$"0e#+T.TX D$$۫" \0\D$$7# 0\ <\0D$$ d#\ 0\ \dH$$#5#+T.TX \D$$ۘ*# \\]HG\D%$=8# d% a'd% aH($wF#&d% a'd%  \D$$T#^.\ \]!\D$$b# \^0\ M!\D%$ap# \d% \\D%$r4~#\ a"d% \D$$r#\\ \ \D(%虚#\d%rg#dE(ET#dddddddE(E#dddddddE(E#dddddddE(E#dddddddPE(Et#ddd d d d d E(E#d d d d d d d E(En#d d d d d d d E(EՊ $d$ d` d` d` d` d` d` E(E8$d` d` d` de dz dz dz E(E‰&$dz dz dz dz dz dz d E(E;4$d d d d d d d E(E؈B$d d d d d d d E(EzP$d d d d d d d E(E^$d d d d d d d E(Exl$d d d d d d d E(Ez$d d d d d d d E(Eņ[$d d d d d d d E(E:$d d d d d d d E(E[$d d d d d-!d-!d-!E(EQ$d-!d-!d-!d-!d-!d-!d2!E(E$dI!dI!dI!dI!dI!dI!dI!E(E$dI!dI!dN!d!d!d!d!E(E$dX!d!d!d!d!d!d!E(E$d!d!d!d!d!d!d!E(E $d!d!d!d!d!d!d!E(EU~%d!d!d!d!d!d&"d&"E(E%}%d&"d&"d&"d&"d&"d&"d&"E(E|"%d+"d7"d7"d7"d7"d7"d7"E(E~y0%d7"d7"d7"d<"d<#d<#d<#E(E\u>%d<#d<#d<#d<#d<#d<#dA#E(EtL%dI#dI#dI#dI#dI#dI#dI#E($Z%dI#dI#dN#AAAAD$%>h%AAAAAdw#AD$$v%AAAAAAAD$$fb%Ad# b^bj+UOPTTU D$$V% +RP R D$$֠% +NIUP T D$$ˮ% + ;D$$9%====P M4CAB GE +NID$$O% SON W   D$$ؕ%T+^0.T (T%T*D$(:%^P-L*H-e &L*D$$%P.L.+ D$Dz1& L*T*d% aj]D$$& ] ] D$$̹&] ] D$$,&L^.]+ITt T D%$|:& "er&+********** D$$8H& +N OITLT EOFD$$pV&NU D +********** D$$7d&   ^7D$$^Er&L ]]D$D& L e}&CG]D$$ & ] L^Ie&D$(̦&T,d&L^Le&T,E$$.I&d&L^PL^?#eH($_&&T,d&] L^.D$$HJ&e&T,d&T,L,,E$$ &d<)]) L%L)L)5D$$&"e''L'T'^I D$$& L) ^  + ;??D$$& ?CPDO E +C UOD$$ 'TNO TUO FTS +PE? D$$1'??   LD$$9T(')T%] dL)L )D$$r6']* L*] LD$$SD' e?'dL)D$$R'] ] D$$#`'] ]+IF L D$(2 n' e{' ad)]D$$s|'+WS 1 ]D+$$|'+WS 2 #]D$$n'+WS 3 #]D$$Oe'+WS 4 #e&(D$$Di'] L^0L^1D$$'#e']L L^D$Dx'1e'T)d'T)D$%/'T*P-L*H-e (]D$$ʆ' ]L*L L)D$$e'L.L(T)L*TD$$(*d'].L(TD$$~Q(*]L*L)] E$$O$(d)]+XT T D$$*2(^M"e(^. ]D$$@(] L D%$6N(L^ eE(T*P-LD($\(*H-e(] L0D$$߅j(e}(0 "0DD%x( d(L0e(0D$$( <0 d(D%$(L0e(0 >D$$e(0 d(L D%$5(L*T*d[(] LD$$( d)]+NE T D$$/( e(^. D$$(]\d(]+NE D D$D( !e(^.D$%r( ]!e)]D$() L e)]DD$ ) dL) azL%T%E$$ )dL)L ] LD($O.) e')L] dL)D(E3m<)gB)d&d1'dR'd)E($rJ)d")eX)] dL)D$D8X))e&L'e)+-;-- -D$$f)ON .FOW RA +INGN SD$$"t) = L' D$$#܂) L&e)+*;** *OND$$a) .FOF TA +LAE RRROD$$,) S= L& D$$>e) +E.DN D$DU)L&e)^7D$$0)  aH">)%*@') _R2SBOOLEAN.RBY!6z34?I^PFYD$$\!,!L !4!!,@!D D$ sC!4!!,π@!D  _P4PASCAL.RBYN7b3UtB$I$I$IJ؉() ׉-ykRډ(ى-׉։Չ!Kx%( @ʡGz ˾-؉c(D$$bbde}+* ** * D$$ \   D$$~:Ф  ex D$(.*  e=^,DDDQ8\ dU eM^ \D%$ F  d=^^\ D(DFT  e^dideHD$-bgdi\  D$$ p d \ ޤ$D%$)~\)!"e!!!\ D$$J+ \DD%TD &e \ dD$$Uv\ ^ \  bD$$4b<й<$D$$K,~L' Ԥ eD$$  ޤԹ߹D$$+^' dD$$FԥݤݤD$$x bb<+4PREORSR D$$[   e%D$$ ?  dD$%w& b bVe8$e5\ D$D4 a\)!eS\D%$B\ $eN\ D$$Pdw+ * **E FO D$$ ^ \ +NEOCNUETER D D$$l \ \P P b DD(@zb a(^*e^TD($8e a(^+"dDD$vؖ^Le a(^+$$D$$2m!e\ d^DeD$DA a(^+'d^CED$e a(^+p&# a(DD$9^,e| b8b ^ DDD!"e a(deH$$/ a(!e].D$$e / ^a E$$a(d.deH$$  a(]D$$".^0(eD$$%D0e8dG^ D$$> e8]D$$L]E$(-Zez]Geu]D$$+h]Id~D$DvdWdD$$N.LeD$$ a(].eD$(^.^E#eDD$(S^.eLeD$$( a(^.e$H($Ġ^:d].E($նe adLD$%e a(]D$$כ.e^Ee]D$$V-LeD$$ a(^+^-#e]NH$D 1Le.DD$, a(].eHE$:A ad]LE$($HeP a(]D%$JV.eAD$%Rde}D$^(Or^ dkLD$$ eeD$$ dH%$9d a^0 D$%w^. ^0 dLD$%e adD$$ceLeH$$ ]l.D$$Ad adHD$xd a(D$$e  D$(> ^'#ee aH(%^^d  a(^'eD(%(e4.dgD$$M6eF ^aD$$.DD$$OhRee DD$?`dPd a(D((i,n^=e{ a(d}D$$L|d a(^.eDE(6 a(dd a(D$$~d^=e  a(dH%%+^>e  a(dD%$ cd a(^=eH(%qN  a¥(d d aH%D(^*e a(^$ED(iAe ax^*e a(ED(Dd a(^)e a(E$$(dd] .D$(]n. a(d/D%$d>gdAAAD$(J$dAAddddHE(zh2dddddddHE(v@dddddddHE(NddiddddADE(#\AddddddHE(yjddddmdddHE(yxdddddddHE(ydddddddHE$EAdd bbD$(伢;9 e;9 D$(Wzd e eaH$$A  d He D($[ d   ED(:He e d D$$f  bbLDDEtqeeddDDDeddH$$ bb9: t:D$$  e];: eXDD(. eI (e=ddH$$;<G%eD ga  dV D$$JeS  dV  d)DD%'X::d%e haD%%f(em5 d(ev3 $E%(td(e2 d(E(($e4 d(e1 dH$$0  bbD$$e E$%e  d+D$(e?d D.$$e   bbD(%!JeQd;-D%%43ed*eE$%eded+D%%2ed,eE((4ddQ adQD$%NJdQdQdQ D(D*adQdQ ^aH%(8dQg?ddddHE(eF d(d0d$d4d4 bD($DTbP a  D$$b   bb(LD$$epXTL b$bD%(%~e adD%$e#e+. ITLT D$$!W \\D%$ \!e+. NE TCPDO ED$$K  \\ aD$$ . L ^(!eD$% aek aD$$eV  ]D$$r$]#]D$$#!#]"#E$$ e= (D$$D$$ڈ&   DD$r4  a 6 D$$UFB6 a^H(!eTD(D 0P adZ a eH(D^ eh a aD$D3l ev ady aD($z e  D%(e  d{ 6d#eD$$*+. ITLTE TXES G \D%$Ѹ\#e+. XTMT1 D$$Q \\+. DRD$$ X01 x\\D$$ +. RNLE \D$$ \ !aDD$be a\D%$?)#e#e +. NE D D$$ͯ \\\ D$$> \ !"e ^>D($" e(  a b^ b.+NIUPD$$Q0 T +UOPTTUD$$> +RP R D$$>L  aD$$+Z  a '^@%ED$&;h ayes a^?0+ D%=v  a) * _R2SDECODER.RBY!5sG@pH{{C<{{#<( D$$?$9)KKGp4)  _R2STP.SR 9 .TITL R2STP .ENT XPUT,XWLN,XWRC,XWRS,XPAG .ENT WRITE,WRLIN .EXTD CNTAD,TABAD,TEMP,TEMP1,TEMP2,CR,RHB .EXTD .FIND,.BGET,.BPUT,.GCH,CHAN .EXTN BFBP0 .NREL ; ROUTINE TO WRITE OUT A STRING TO THE BUFFER ; ; ENTRY - AC0 - BYTE POINTER TO FIRST BYTE ;< AC1 - NUMBER OF BYTES ; AC2 - CHANNEL NUMBER ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED WRITE: STA 3,USP STA 0,TEMP1 STA 1,TEMP2 JSR @.FIND ;PICK UP BUFFER INFO. LDA 1,@CNTAD ;NEXT +`BYTE ADD 0,1 STA 1,TEMP ;STORE ADDRESS TEMPORARILY NXTCH: LDA 2,TEMP1 ;CHARACTER ADDRESS JSR @.BGET ;GET NEXT BYTE LDA 2,TEMP JSR @.BPUT ;PUT THAT BYTE ISZ @CNTAD ISZ TEMP ;INCREMENT BUFFER ADDRESS ISZ TEMP1 ;INCREMENT CHARACTER ADDRESS DSZ TEMP2 ;DECREMENT AND TEST BYTE COUNT JMP NXTCH JMP @USP XPUT: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET STATUS MOVL# 0,0,SZC ;EOF? JMP PUTOK MOVL# 0,0,SNR ;JUST AWAY? JMP .+4 SUBZR 0,0 STA 0,FST,2 ;FIRST TIME THROUGH JMP PUTOK ERR.P ;bNO PERPE ;REPORT PUT ERROR PUTOK: JSR @.GCH ;PICK UP CHANNEL NO. ET AL JMP NCH MOVZL 2,0 ;BYTE POINTER TO FBA SUBZL 1,1 ;SET BIT 15 LDA 2,CHAN ;CHANNEL JSR WRITE NEXT NCH: MOVZL 2,0 LDA 2,CHAN ;WRITE IT STRAIGHT OUT .SYSTM .WRS 77 ERR.2  NEXT XPAG: LDA 0,FF JMP .+2 XWLN: LDA 0,CR ;CR IN BUFFER STA 0,TEMP1 POP1 2 MOVZR 2,2 ;B.PTR TO FBA,NOW WORD ADDRESS JSR WRLIN NEXT FF: 6000 .BFBP: BFBP0 XWRC: POP1 2 ;FBA MOVZR 2,2 JSR @.GCH JMP .+1 POP1 1 ;# OF CHARS SUBZL 0,0 ; SUB 0,1,SNR ;LEADING SPACES ? JMP CHAR ;NO LDA 0,@.BFBP ;B.PTR TO SPACES LDA 2,CHAN JSR WRITE CHAR: LDA 0,SP MOVZL 0,0 ;B.PTR TO STACK TOP SUBZL 1,1 ;ONE BYTE LDA 2,CHAN JSR WRITE POP1 1 ;REMOVE CHAR NEXT XWRS: POP1 2 ;FBA MOVZR 2,2 JSR @~.GCH ;GET CHANNEL JMP .+1 POP1 0 ;SL - STRIN LENGTH POP1 1 ;PL - PRINT LENGTH SUBZ# 1,0,SZC ;IF SL>=PL JMP NOSP ;NO LEADER LEEDR: STA 0,Z1 SUB 0,1 ;LDR LENGTH LDA 0,@.BFBP LDA 2,CHAN JSR WRITE LDA 1,Z1 NOSP: POP1 0 LDA 2,CHAN JSR WRITE N7EXT ; ROUTINE TO OUTPUT THE LINE STORED IN THE BUFFER. ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - UNDEFINED ; AC1 - COUNT OF BYTES WRITTEN(INCLUSIVE OF TERMINATOR). ; O AC2 - WORD ADDRESS OF FBA WRLIN: STA 3,USP ;RETURN ADDDRESS JSR @.GCH ;GET CHANNEL HALT ;IMPOSSIBLE LDA 2,CHAN ;CHANNEL JSR @.FIND LDA 2,@CNTAD ADD 0,2 ;FORM BYTE ADDRESS OF NEXT CHARACTER LDA 0,TEMP1 JSR @.BPUT ;STORE THE TERMIN?ATOR LDA 2,CHAN JSR @.FIND ;FIND THE BUFFER IN USE SUB 1,1 STA 1,@CNTAD ;RESET THE CHANNEL BUFFER STA 1,@TABAD LDA 2,CHAN ;RETREIVE CHANNEL NUMBER .SYSTM .WRL 77 ;WRITE THE LINE ERR.2 JMP @USP .END LIFE. YPROGRAM LIFE(INPUT,OUTPUT); (* GAME OF LIFE BY H.L.CONWAY - P7-70 *) CONST MAXBOARDSIZE = 50; TYPE STATE = (DEAD,STABLE,GROWING); NEIGHBOR = SET OF 0..8; BOARDS = PACKED ARRAY [1..MAXBOARDSIZE,1..MAXBOARDSIZE] OF CHAR; VAR SURVIVEPOPULATION : NEIGHBOR;ݟ BOARDSTATE : STATE; NEWBOARD,OLDBOARD : BOARDS; I,J : 0..MAXBOARDSIZE; NUMBEROFNEIGHBORS : 0..8; GENERATION,MAXGENERATION,BOARDSIZE : INTEGER; ALIVECOUNT,CHANGECOUNT : INTEGER; LEFT,RIGHT,UP,DOWN,HORIZOFFSET,VERTOFFSET : -1..+1; BEGIN SURVIVEPOPULQFATION:=[2,3]; WHILE NOT EOF DO BEGIN (* INITIALISE PARAMETERS AND CREATE BOARD *) GENERATION:=0; READLN(MAXGENERATION); READLN(BOARDSIZE); IF BOARDSIZE>MAXBOARDSIZE THEN BEGIN WRITE('!! ',' BOARDSIZE TOO ','BIG - WILL BE RE','SET TO M|AX'); WRITELN('BOARDSIZE'); BOARDSIZE:=MAXBOARDSIZE END; FOR I:=1 TO BOARDSIZE DO FOR J:=1 TO BOARDSIZE DO OLDBOARD[I,J]:=' '; READLN(I,J); (*READ LOCATION OF INITIAL ORGANISM *) WHILE I<>0 DO BEGIN IF (I<0) OR (I>BOARDSIZE) O@{R (J<0) OR (J>BOARDSIZE) THEN WRITELN('!! ','NON-EXISTENT ','CELL .. ELEMENT',' IGNORED ',I,J) ELSE OLDBOARD[I,J]:='*'; READLN(I,J) END; (*BOARD PROCESSING BEGINS NOW *) REPEAT ALIVECOUNT:=0; CHANGECOUNT:=0; FOR I:=1 TO BOARDSIZE DO Y FOR J:=1 TO BOARDSIZE DO BEGIN IF I>1 THEN LEFT:=-1 ELSE LEFT:=0; IF I1 THEN UP:=-1 ELSE UP:=0; IF J0) OR (VERTOFFSafET<>0)) THEN NUMBEROFNEIGHBORS:=NUMBEROFNEIGHBORS+1; (* NOW,SEE WHICH CELLS SHOULD BE ALIVE NEXT GENERATION *) NEWBOARD[I,J]:=' '; IF ((OLDBOARD[I,J]=' ') AND (NUMBEROFNEIGHBORS=3)) OR ((OLDBOARD[I,J]='*') AND (NUMBEROFNEIGHBORS IN SURVIVEgPOPULATION)) THEN BEGIN NEWBOARD[I,J]:='*'; ALIVECOUNT:=ALIVECOUNT+1 END END; (* NEW GENERATION COMPLETE. COPY IT TO OLDBOARD FOR NEXT CYCLE *) GENERATION:=GENERATION+1; WRITELN;WRITELN;WRITELN; WRITELN('GENERATION # ',GENERATION:3,  ' POPULATION = ',ALIVECOUNT:3); FOR I:=1 TO BOARDSIZE DO BEGIN WRITE(' ':14); FOR J:=1 TO BOARDSIZE DO BEGIN WRITE(NEWBOARD[I,J]:2); IF NEWBOARD[I,J]<>OLDBOARD[I,J] THEN BEGIN CHANGECOUNT:=CHANGECOUNT+1; OLDBOARD[I,J]:=NEWBOARD[/I,J] END END; WRITELN END; (* EVALUATE STATE OF BOARD AT END OF THIS GENERATION *) IF ALIVECOUNT=0 THEN BOARDSTATE:=DEAD ELSE IF CHANGECOUNT = 0 THEN BOARDSTATE:=STABLE ELSE BOARDSTATE:=GROWING UNTIL (BOARDSTATE=DEAD) OR (BOARDS$,TATE=STABLE) OR (GENERATION>=MAXGENERATION); CASE BOARDSTATE OF DEAD: WRITELN(' COLONY DIED'); STABLE: WRITELN(' COLONY IS ','STABLE'); GROWING:WRITELN(' MAX GENERATION ','# EXCEEDED') END END (*OF A SINGLE DATA SET *) END. NEW2P4ASMB.rX PROGRAM NEW2P4ASMB(OUTPUT, INPUT); BEGIN WRITELN(OUTPUT, 'TO START WITH, W', 'E ASSUME THAT TH', 'E FOLLOWING FILE', ' NAMES ARE NOT O', 'N YOUR DISK :'); WRITEELN(OUTPUT, ' ' : 20, '** SETUPA'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM'); WRITELN(OUTPUT, ' ' : 20, '** P4MAC'); WRITELN(OUTPUT); WRITELN(OUTPUT, 'PLEASE ENSURE TH', 'AT THE FOLLOWING', ' FILES OF- RELEAS', 'E 2 EXIST ON YOU', 'R DISK :'); WRITELN(OUTPUT, ' ' : 20, '< FASTHASH.SV'); WRITELN(OUTPUT, ' ' : 20, ' SETUP'); WRITELN(OUTPUT, ' ' : 20, ' SETUPAX'); WRITELN(OUTPUT, ' ' : 20, '  SETUPAZ'); WRITELN(OUTPUT, ' ' : 20, ' HEADA2'); WRITELN(OUTPUT, ' ' : 20, ' HEADM2'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM.SV'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM.PC'); WRITELN(OUTPUT, ' ' : 20, ' P4AMX2'); WRITELN(OUTPUT, ' ' : 20, ' P4ASMZ2'); WRITELN(OUTPUT, ' ' : 20, '> P4MACZ2'); WRITELN(OUTPUT); WRITELN(OUTPUT, 'IF YOU DON''T HAV', 'E THE ABOVE FILE', 'S, YOU SHOULD ST', 'OP BY PRESSING T',  'HE ''CNTRL A'' KEY'); WRITELN(OUTPUT, ', OTHERWISE TYPE', ' IN ''RETURN'' KEY', ' TWICE.'); READLN(INPUT); WRITELN(OUTPUT, '****************', ' GENERATION OFc_ N', 'EW PCODE ASSEMBL', 'ER BEGINS NOW ! ', '****************') END. P4ENTERERR. PROGRAM P4ENTEREROR(P4MESSAGE,INPUT,OUTPUT); CONST STRINGLENGTH = 60; TYPE STRING = PACKED ARRAY [1..STRINGLENGTH] OF CHAR; ERRORRECORD = RECORD FIRSTMESSAGE : STRING; FILLER1 : INTEGER; FNILLER2 : INTEGER; SECONDMESSAGE : STRING; FILLER3 : INTEGER END; VAR P4MESSAGE : RANDOM FILE OF ERRORRECORD; COUNT,ERRORNUMBER : INTEGER; TEST : BOOLEAN; PROCEDURE LOADMESSAGE(VAR MESSAGE : STRING); VAR COUNT : 1..STRINGLENGTH; BEGIN READLN(INPUT); FOR COUNT := 1 TO STRINGLENGTH DO IF NOT (EOLN(INPUT) OR EOF(INPUT)) THEN READ(MESSAGE[COUNT]) ELSE MESSAGE[COUNT] := ' ' END (*OF LOADMESSAGE*); BEGIN TEST := TRUE;-k WRITELN(OUTPUT,'ANSWER THE QUEST','IONS TO INSERT N','EW ENTRIES IN TH', 'E INTERPRETER ER','ROR TABLE'); WRITELN(OUTPUT,'VALID RESPONSES ','TO THE FOLLOWING',' QUESTIONS ARE ', 'TERMINATED BY ','A CARRIAGE RETUR','N'g); REPEAT WRITELN(OUTPUT,'TYPE THE ENTRY N','UMBER (0-1026)'); IF NOT TEST THEN READLN(INPUT); READ(INPUT,ERRORNUMBER); IF (ERRORNUMBER >= 0) AND (ERRORNUMBER <= 1026) THEN BEGIN WRITELN(OUTPUT,'NOW TYPE THE TAB','LE ENTRY (UP TO ','60 CHtARS)'); BEGIN GETRANDOM(P4MESSAGE,ERRORNUMBER DIV 2); IF NOT EOR(P4MESSAGE) THEN WITH P4MESSAGE^ DO BEGIN FOR COUNT := 1 TO STRINGLENGTH DO BEGIN FIRSTMESSAGE[COUNT] := ' '; SECONDMESSAGE[COUNT] := ' ' END; FILLER1 := 3338; FILLER3 := 3338 END; IF ODD(ERRORNUMBER) THEN LOADMESSAGE(P4MESSAGE^.SECONDMESSAGE) P ELSE LOADMESSAGE(P4MESSAGE^.FIRSTMESSAGE); PUTRANDOM(P4MESSAGE,ERRORNUMBER DIV 2); WRITELN(OUTPUT,'MESSAGE O.K.'); END END ELSE WRITELN(OUTPUT,'ILLEGAL ERROR NU','MBER ',ERRORNUMBER); WRITELN(OUTPUT,'DO YOU WISH TO ','INSERT MORE ENTR','IES(YES/NO)'); READLN(INPUT); WHILE INPUT^ = ' ' DO GET(INPUT); TEST := INPUT^ <> 'Y' UNTIL TEST END. R2CSPTAB.SRU- .TITL R2CSPTAB ;SPECIAL VERSION OF THE TABLE FOR THE COMPILER ;INCORPORATING THE CALL TO THE OVERLAY ROUTINES. .EXTN XWLN,XWRC,XWRI,XWRR,XWRS .EXTN XRDC,XRDI,XRDR,XRLN .EXTN XGET,XPUT .EXTN XELN .EXTN XATN,XCOS,XEXP,XLOG,XSIN,XSQT .EXTN XNEW,XSAV,XRST .EXTN XRND,XOPN .EXTN XCLS .EXTN XPAG,XOVL .EXTN PUNDF .ENT SPTAB .NREL SPTAB : XGET ;0 XPUT ;1 XRST ;2 XRLN ;3 XNEW ;4 XWLN ;5 XWRS ;6 XELN ;7 XWRI ;8 XWRR ;9 XWRC ;10 XRDI ;11 XRDR ;12 XRDC ;13 XSIN ;14 XCOS ;15 XEXP ;16 XLOG ;17 XSQT ;18 XATN ;19 XSAV ;20 XOPN ;21..OPEN ANY FILE (CREATE IMPLIED) XRND ;22 XOVL ;23 XCLS ;24 PUNDF ;25 PUNDF ;26 XPAG ;27 PUNDF ;28 PUNDF ;29 PUNDF ;30 PUNDF ;31 .END R2SINTEGER.SR 5w .TITL R2SINTEGER ; THE P-CODE INTERPRETER'S INTEGER OPERATIONS .ENT PINC,PADI,PSBI,PNGI,PSQI,PABI,PMOD,PODD,PMPI,PDVI,PDEC .ENT PINCC,PDECC .EXTN .MPY,.DIV .NREL PINCC: MOVS 2,2 ;NB CHAR IN LHB JMP PINC PADI: POP1 2 ;ADD INTEGER PINC: LTOP1 1 } ;INCREMENT (Q FIELD IN AC2) ADD 2,1 STOP1 1 NEXT PDECC: MOVS 2,2 ;NB CHAR IN LHB JMP PDEC PSBI: POP1 2 ;SUBTRACT INTEGER PDEC: LTOP1 1 ;DECREMENT (Q FIELD IN AC2) SUB 2,1 STOP1 1 NEXT PNGI: LTOP1 1 ;NEGATE INTEGER NEG 1,1 STOP1 1 NEXT PSQI: LTOP1 2 ;SQUARE INTEGER JMP MPI1 PABI: LTOP1 1 ;ABSOLUTE VALUE OF INTEGER MOVZL# 1,1,SZC ;NEGATE IF NECESSARY NEG 1,1 STOP1 1 NEXT PMOD: POP1 2 ;MODULUS LTOP1 1 MOVL# 1,1,SZC ;SET AC0 FOR HIGH-ORDER ADC 0,0,SKP ; WORD OF DOUBLE PRECISVION SUB 0,0 ; DIVIDEND FOR .DIV JSR @..DIV ;SIGNED DIVIDE STOP1 0 ;REMAINDER IN AC0 NEXT PODD: LTOP1 1 ;TEST ON ODD MOVR 1,1 ;SET AC1=TRUE IF B15=1 SUBCL 1,1 ; FALSE IF B15=0 STOP1 1 NEXT PMPI: POP1 2 ;MULTIPLY INTEGER MPI1: LTOP61 1 ;ENTRY FROM PSQI SUBO 0,0 ;CLEAR AC0 JSR @..MPY ;SIGNED MULTIPLY STOP1 1 ;LOW ORDER WORD OF DOUBLE NEXT ; PRECISION RESULT IN AC1 ..MPY: .MPY ;(MATH.LB) PDVI: POP1 2 ;DIVIDE INTEGER LTOP1 1 MOVL# 1,1,SZC ;SET AC0 FOR HIGH-ORDER ADC 05,0,SKP ; WORD OF DOUBLE PRECISION SUB 0,0 ; DIVIDEND FOR .DIV JSR @..DIV ;SIGNED DIVIDE STOP1 1 ;QUOTIENT IN AC1 NEXT ..DIV: .DIV ;(MATH.LB) .END R2CITAB.SRY _C .TITL R2CITAB .REV 2,1 ; THE INTERPRETER JUMP TABLE .ENT ITAB0,ITAB1 .EXTN PLOD,PLDO,PSTR,PSRO,PLDA,PLAO,PSTO,PLDC,PLCI,PIND .EXTN PINDC,PSTOC .EXTN PINC,PINCC .EXTN PMST,PCUP,PCXP,PENT,PRET,;]PCSP .EXTN PIXA .EXTN PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PUJP,PFJP,PXJP,PTJP,PUJC .EXTN PCHKC,PCHK2,PCHK3,PCHK4,PEOF .EXTN PADI,PADR,PSBI,PSBR .EXTN PSGS .EXTN PFLT,PFLO,PTRC .EAXTN PNGI,PNGR,PSQI,PSQR,PABI,PABR .EXTN PNOT,PAND,PIOR .EXTN PDIF,PINT,PUNI,PINN  .EXTN PMOD,PODD .EXTN PMPI,PMPR,PDVI,PDVR .EXTN PMOV,PLCA,PDEC,PDECC,PSTP,PHLT .EXTN PCHR,PORDI,PORDA,PORDC,PORDB5 .EXTN PNON .ZREL ITAB0: PNON ; 0 NOT USED PHLT ; 1 PEQU ; 2 PNEQ ; 3 PGEQ ; 4 PGRT q ; 5 PLEQ ; 6 PLES ; 7 PSTO ; 8 PSTO ; 9 PSTOC ; 10 PSTO ; 11 PMST "; 12 PRET ; 13 PADI ; 14 PSBI ; 15 PNGI ; 16 PSQI ; 17 PABI ; 18 PMOD  ; 19 PODD ; 20 PMPI ; 21  PDVI ; 22 PADR ; 23 PSBR ; 24 PFLT ; 25 PFLO K* ; 26 PTRC ; 27 PNGR ; 28 PSQR ; 29 PABR ; 30 PMPR ; 31 PDVR ; 32 PNOT 1# ; 33 PAND ; 34 PIOR  ; 35 PSGS ; 36 PDIF ; 37 PINT ; 38 PUNI ; 39 PINN, ; 40 PEOF ; 41 PSTP ; 42 PLCA ; 43 PORDI ; 44 SET ASIDE PORDA ; 45 4 LOCATIONS PORDC N ; 46 FOR THE PORDB ; 47 ORD FAMILY PCHR ; 48 ; THE GAPS IN THE REMAINDER OF TABLE 0 ARE FOR CORAL PNON ; 49 PNON ; 50 PHNON ; 51 PNON ; 52 PNON ; 53 PNON ; 54 PNON ; 55 PNON ; 56 PNON ; 57 R5 PNON ; 58 PNON  ; 59 PNON ; 60 PNON ; 61 PNON ; 62 PNON ; 63 ITAB1: PNON ; 64 NOT USED : PUJC ; 65 PEQU ; 66 PNEQ ; 67 PGEQ ; 68 PGRT ; 69 PLEQ ; 70 PLES ; !|71 N.B MULTIPLE COMPARES  PLOD ; 72 PLOD ; 73 PLOD ; 74 PLOD ; 75 PLDO ; 76 PLDO ; 77 d_ PLDO ; 78 PLDO ; 79 PSTR ; 80 PSTR ; 81 PSTR ; 82 PSTR ; 83 PSRO ; 84 OV PSRO  ; 85 PSRO ; 86 PSRO ; 87 PIND ; 88 PIND ; 89 PINDC ; 90 PIND ; 91 F PLDA ; 92 PLAO ; 93 PLDC ; 94 PIXA ; 95 PMOV ; 96 PCUP ; 97 PENT ; @]98  PCSP ; 99 PUJP ;100 PFJP ;101 PTJP ;102 PXJP ;103 PINC ;104 PNON v ;105 ALSO INC PINCC ;106 PNON ;107 ALSO INC PDEC ;108 ALSO NEEDS NEXT 3 PNON ;109 PDECC ;110 PNON 5 ;111 PCHKC ;112 NEEDS 3 MORE PCHK2 ;113 PCHK3 ;114 PCHK4 ;115 ; THE GAPS IN THE REMAINDER OF TABLE 1 ARE FOR CORAL PNON ; 116 PCXP ; 117 PNON ; 118 PNON ; 119 PNON ; 120 PNON ; 121 PNON ; 122  $ PNON ; 123 PNON ; 124 PNON ; 125 PNON ; 126 PNON ; 127 .END P4ERRSUM.! $8 PROGRAM ERRSUM(OUTPUT); CONST MAXBIT = 59; MAXSETMOD = 60; (*MAXBIT+1*) MAXSET = 10; VAR I : 0..MAXSET; N : 0..MAXBIT; M : INTEGER; ERROR : ARRAY [0..MAXSET] OF SET OF 0..MAXBIT; P4ERRORS : FILE OF SET OF 0..MAXBIT; PROCEDURE MESSAGE1; VAR PM : 0..59; BEGIN P := M; CASE P OF 1: WRITELN(OUTPUT,'ERROR IN SIMPLE ','TYPE'); 2: WRITELN(OUTPUT,'IDENTIFIER EXPEC','TED'); 3: WRITELN(OUTPUT,'''PROGRAM'' EXPE','CTED'); 4: WRITELN(OUTPUT,''')'' EXPECTED'); 5: WRITELNО(OUTPUT,''':'' EXPECTED'); 6: WRITELN(OUTPUT,'ILLEGAL SYMBOL'); 7: WRITELN(OUTPUT,'ERROR IN PARAMET','ER LIST'); 8: WRITELN(OUTPUT,'''OF'' EXPECTED'); 9: WRITELN(OUTPUT,'''('' EXPECTED'); 10: WRITELN(OUTPUT,'ERROR IN TYPE'); 1+1: WRITELN(OUTPUT,'''['' EXPECTED'); 12: WRITELN(OUTPUT,''']'' EXPECTED'); 13: WRITELN(OUTPUT,'''END'' EXPECTED'); 14: WRITELN(OUTPUT,''';'' EXPECTED'); 15: WRITELN(OUTPUT,'INTEGER EXPECTED'); 16: WRITELN(OUTPUT,'''='' EXPECTED');  17: WRITELN(OUTPUT,'''BEGIN'' EXPECT','ED'); 18: WRITELN(OUTPUT,'ERROR IN DECLARA','TION PART'); 19: WRITELN(OUTPUT,'ERROR IN FIELD L','IST'); 20: WRITELN(OUTPUT,''','' EXPECTED'); 21: WRITELN(OUTPUT,'''.'' EXPECTED'); 50: W=!RITELN(OUTPUT,'ERROR IN CONSTAN','T'); 51: WRITELN(OUTPUT,''':='' EXPECTED'); 52: WRITELN(OUTPUT,'''THEN'' EXPECTE','D'); 53: WRITELN(OUTPUT,'''UNTIL'' EXPECT','ED'); 54: WRITELN(OUTPUT,'''DO'' EXPECTED'); 55: WRITELN(OUTPUT,'''TO' '/''DOWNTO''',' EXPECTED'); 56: WRITELN(OUTPUT,'''IF'' EXPECTED'); 57: WRITELN(OUTPUT,'''FILE'' EXPECTE','D'); 58: WRITELN(OUTPUT,'ERROR IN FACTOR'); 59: WRITELN(OUTPUT,'ERROR IN VARIABL','E'); END (* OF CASE *) END (*MESSAGE1*); 3 PROCEDURE MESSAGE2; VAR P : 60..119; BEGIN P := M; CASE P OF 101: WRITELN(OUTPUT,'IDENTIFIER DECLA','RED TWICE'); 102: WRITELN(OUTPUT,'LOW BOUND EXCEED','S HIGHBOUND'); 103: WRITELN(OUTPUT,'IDENTIFIER IS NO','T OF APPRO2PRIATE',' CLASS'); 104: WRITELN(OUTPUT,'IDENTIFIER NOT D','ECLARED'); 105: WRITELN(OUTPUT,'SIGN NOT ALLOWED'); 106: WRITELN(OUTPUT,'NUMBER EXPECTED'); 107: WRITELN(OUTPUT,'INCOMPATABLE SUB','RANGE TYPES'); 108: WRITELN(OUTPUT,'FILED NOT ALLOWED',' HERE'); 109: WRITELN(OUTPUT,'TYPE MUST NOTBE ','REAL'); 110: WRITELN(OUTPUT,'TAGFIELD TYPE MU','ST BE SCALAR OR ','SUBRANGE'); 111: WRITELN(OUTPUT,'INCOMPATIBLE WIT','H TAGFIELD TYPE'); 112: WRITELN(OUTPUT,'INDEX TYPE MU?EST ','NOT BE REAL'); 113: WRITELN(OUTPUT,'INDEX TYPE MUST ','BE SCALAR OR SUB','RANGE'); 114: WRITELN(OUTPUT,'BASE TYPE MUST N','OT BE REAL'); 115: WRITELN(OUTPUT,'BASE TYPE MUST B','E SCALAR OR SUBR','ANGE');  116: WRITELN(OUTPUT,'ERRORC IN TYPE OF',' STANDARD PROCED','URE PARAMETER'); 117: WRITELN(OUTPUT,'UNSATISFIED FORW','ARD REFERENCE'); 118: WRITELN(OUTPUT,'FORWARD REFERENC','E TYPE IDENTIFIE', 'R IN VARIABLE DE','CLARATION'); 119: WRITELN(OUTP?UT,'FORWARD DECLARED','; REPETITION OF ', 'PARAMETER LIST N','OT ALLOWED'); END (* OF CASE *) END (*MESSAGE2*); PROCEDURE MESS3A; VAR P : 120..145; BEGIN P := M; CASE P OF 120: WRITELN(OUTPUT,'FUNCTION$ RESULT ','TYPE MUST BE SCA', 'LAR, SUBRANGE OR',' POINTER'); 121: WRITELN(OUTPUT,'FILE VALUE PARAM','ETER NOT ALLOWED'); 122: WRITELN(OUTPUT,'FORWARD DECLARED',' FUNCTION; REPET', 'ITION OF RESUL7)T ','TYPE NOT ALLOWED'); 123: WRITELN(OUTPUT,'MISSING RESULT T','YPE IN FUNCTION ','DECLARATION'); 124: WRITELN(OUTPUT,'F-FORMAT FOR REA','L ONLY'); 125: WRITELN(OUTPUT,'ERROR IN TYPE OF',' STANDARD FUNCTI','ON PARAMETER'); 126: WRITELN(OUTPUT,'NUMBER OF PARAME','TERS DOES NOT AG', 'REE WITH DECLARA','TION'); 127: WRITELN(OUTPUT,'ILLEGAL PARAMETE','R SUBSTITUTION'); 128: WRITELN(OUTPUT,'RESULT TYPE OF P','ARAMETER FUNCTIO', 'N DOES NOT AGREE',' WITH DECLARATIO','N'); 129: WRITELN(OUTPUT,'TYPE CONFLICT OF',' OPERANDS'); 130: WRITELN(OUTPUT,'EXPRESSION IS NO','T OF SET TYPE'); 131: WRITELN(OUTPUT,'TESTS ON EQUALIT','Y ALLOWED ONLY'); 132: WRITELN(OUTPUT,'STRICT |INCLUSION',' NOT ALLOWED'); 133: WRITELN(OUTPUT,'FILE COMPARISION',' NOT ALLOWED'); 134: WRITELN(OUTPUT,'ILLEGL TYPE OF O','PERAND(S)'); 135: WRITELN(OUTPUT,'TYPE OF OPERAND ','MUST BE BOOLEAN'); 136: WRITELN(OUTPUT,'SET ELEMENT TYPE','* MUST BE SCALAR ','OR SUBRANGE'); 137: WRITELN(OUTPUT,'SET ELEMENT TYPE','S NOT COMPATIBLE'); 138: WRITELN(OUTPUT,'TYPE OF VARIABLE',' IS NOT ARRAY'); 139: WRITELN(OUTPUT,'INDEX TYPE IS NO','T COMPATIBLE WIT','H DECLARATION'); 140: WRITELN(OUTPUT,'TYPE OF VARIABLE',' IS NOT RECORD'); 141: WRITELN(OUTPUT,'TYPE OF VARIABLE',' MUST BE FILE OR',' PIONTER'); 142: WRITELN(OUTPUT,'ILLEGAL PARAMETE','R SUBSTITUTION'); 143: WRITELN(OUTPUT,'ILLEGAL TYPE OF ','LOOP CONTROL VAR','IABLE'); 144: WRITELN(OUTPUT,'ILLEGAL TYPE OF ','EXPRESSION'); 145: WRITELN(OUTPUT,'TYPE CONFLICT'); END (* OF CASE *) END (* OF MESS3A *); PROCEDURE MESS3B; VAR P : 146..159; BEGIN P := M; CASE P OF 146: WRITELN(OUTPUT:,'ASSIGMENT OF FIL','ES NOT ALLOWED'); 147: WRITELN(OUTPUT,'LABEL TYPE INCOM','PATIBLE WITH SEL', 'ECTING EXPRESSIO','N'); 148: WRITELN(OUTPUT,'SUBRANGE BOUNDS ','MUST BE SCALAR'); 149: WRITELN(OUTPUT,'INDEX TYPE MUST ','NOT BE INTEGER'); 150: WRITELN(OUTPUT,'ASSIGNMENT TO ST','ANDARD FUNCTION ','IS NOT ALLOWED'); 151: WRITELN(OUTPUT,'ASSIGNMENT TO FO','RMAL FUNCTION IS',' NOT ALLOWED'); 152: WRITELN(OUTPUT,'NO SUCH FIELD IN',' THIS RECORD'); 153: (GWRITELN(OUTPUT,'TYPE ERROR IN RE','AD'); 154: WRITELN(OUTPUT,'ACTUAL PARAMETER',' MUST BE A VARIA','BLE'); 155: WRITELN(OUTPUT,'CONTROL VARIABLE',' MUST NEITHER BE', ' FORMAL NOR NON ','LOCAL'); 156: WRITELN(OUTPUT,';MULTIDEFINED CAS','E LABEL'); 157: WRITELN(OUTPUT,'TOO MANY CASES I','N CASE STATEMENT'); 158: WRITELN(OUTPUT,'MISSING CORRESPO','NDING VARIANT DE','CLARATION'); 159: WRITELN(OUTPUT,'REAL OR STRING T','AGFIELDS NOT ALL','OWED'); END (* O-5F CASE *) END (* MESS3B *); PROCEDURE MESS3C; VAR P : 160..179; BEGIN P := M; CASE P OF 160: WRITELN(OUTPUT,'PREVIOUS DECLARA','TION WAS NOT FOR','WARD'); 161: WRITELN(OUTPUT,'AGAIN FORWARD DE','CLARED'); 162: WRITELN(O2UTPUT,'PARAMETER SIZE M','UST BE CONSTANT'); 163: WRITELN(OUTPUT,'MISSING VARIANT ','IN DECLARATION'); 164: WRITELN(OUTPUT,'SUBSTITUTION OF ','STANDARD PROC/FU','NC NOT ALLOWED'); 165: WRITELN(OUTPUT,'MULTIDEFINED LAB','EL'); 166: WRITELN(OUTPUT,'MULTIDECLARED LA','BEL'); 167: WRITELN(OUTPUT,'UNDECLARED LABEL'); 168: WRITELN(OUTPUT,'UNDEFINED LABEL'); 169: WRITELN(OUTPUT,'ERROR IN BASE SE','T'); 170: WRITELN(OUTPUT,'VALUE PARAMETER ','EXPECTED'); 171: WRITELN(OUTtPUT,'STANDARD FILE WA','S REDECLARED'); 172: WRITELN(OUTPUT,'UNDECLARED EXTER','NAL FILE'); 173: WRITELN(OUTPUT,'FORTRAN PROCEDUR','E OR FUNCTION EX','PECTED'); 174: WRITELN(OUTPUT,'PASCAL PROCEDURE',' OR FUNCTION EXP','ECTED'); 175: WRITELN(OUTPUT,'MISSING FILE ''I','NPUT'' IN PROGRA','M HEADING'); 176: WRITELN(OUTPUT,'MISSING FILE ''O','UTPUT'' IN PROGR','AM HEADING'); 178: WRITELN(OUTPUT,'ILLEGAL TAGFIELD',' IN VARIANT'); END (*OF CASE*) END (*MESS3C*); PROCEDURE MESSAGE3; BEGIN IF M > 145 THEN BEGIN IF M > 159 THEN MESS3C ELSE MESS3B END ELSE MESS3A END (*MESAGE3*); PROCEDURE MESSAGE4; VAR P : 180..239; BEGIN P := M; CASE P OF W5 201: WRITELN(OUTPUT,'ERROR IN REAL CO','NSTANT: DIGIT EX','PECTED'); 202: WRITELN(OUTPUT,'STRING CONSTANT ','MUST NOT EXCEED ','SOURCE LINE'); 203: WRITELN(OUTPUT,'INTEGER CONSTANT',' EXCEEDS RANGE'); 204: WRITELN(OUTPUT,'8 OR 9 IN OCTA,L ','NUMBER'); END (* OF CASE *) END (*MESSAGE4*); PROCEDURE MESSAGE5; VAR P : 240..299; BEGIN P := M; CASE P OF 250: WRITELN(OUTPUT,'TOO MANY NESTED ','SCOPES OF IDENTI','FIERS'); 251: WRITELN(OUTPUT,'TOO MANY NESTED ','PROCEDURES AND/O','R FUNCTIONS'); 252: WRITELN(OUTPUT,'TOO MANY FORWARD',' REFERENCES OF P','ROCEDURE ENTRIES'); 253: WRITELN(OUTPUT,'PROCEDURE TOO LO','NG'); 254: WRITELN(OUTPUT,'TOO MANY LONG CO','NSTANTS IN THIS ','PROCEDURE'); 255: WRITELN(OUTPUT,'TOO MANY ERRORS ','ON THIS SOURCE L','INE'); 256: WRITELN(OUTPUT,'TOO MANY EXTERNA','L REFERENCES'); 257: WRITELN(OUTPUT,'TOO MANY EXTERNA','LS'); 258: WRITELN(OUTPUT,'TOO MANY LOCAL F','ILES'); 259: WRITELN(OUTPUT,'EXPRfESSION TOO C','OMPLICATED'); END (* OF CASE *) END (*MESSAGE5*); PROCEDURE MESSAGE6; VAR P : 300..359; BEGIN P := M; CASE P OF 300: WRITELN(OUTPUT,'DIVISION BY ZERO'); 301: WRITELN(OUTPUT,'NO CASE PROVIDED',' FOR THIS VALOxUE'); 302: WRITELN(OUTPUT,'INDEX EXPRESSION',' OUT OF BOUNDS');  303: WRITELN(OUTPUT,'VALUE TO BE ASSI','GNED IS OUT OF B','OUNDS'); 304: WRITELN(OUTPUT,'ELEMENT EXPRESSI','ON OUT OF RANGE'); 350: WRITELN(OUTPUT,'GLOBAL LABEL ','NOT AL3LOWED WHEN',' DECLARING ', 'EXTERNAL PROC/','FUNC'); 351: WRITELN(OUTPUT,'GLOBAL VAR ','NOT ALLOWED ','WHEN DECLARING', ' EXTERNAL ','PROC/FUNC'); END (* OF CASE *) END (* MESSAGE6 *); PROCEDΔURE MESSAGE7; VAR P : 360..419; BEGIN P := M; CASE P OF 399: WRITELN(OUTPUT,'IMPLEMENTATION R','ESTRICTION'); 398: WRITELN(OUTPUT,'VARIABLE DIMENSI','ON ARRAYS NOT IM','PLEMENTED'); 400: WRITELN(OUTPUT,'ATTEMPT TO ACCES','S A־N INDEXED VAR','IABLE DIRECTLY'); END (* OF CASE *) END(* MESSAGE7*); PROCEDURE MESSAGE9; VAR P : 480..539; BEGIN P := M; CASE P OF 500: WRITELN(OUTPUT,'LOAD ERROR'); 501: WRITELN(OUTPUT,'LOAD ERROR'); END (* OF CASE *) END (*MESSAGE9*); BEGIN (* MAIN*) FOR I := 0 TO MAXSET DO BEGIN GET(P4ERRORS); ERROR[I] := P4ERRORS^ END; WRITELN(OUTPUT,' ':10,'ERROR SUMMARY'); WRITELN(OUTPUT,' ':10,'*************'); WRITELN(OUTPUT); FOR I := 0 TO MAXSET DO FOR N := 0 TwO MAXBIT DO IF N IN ERROR[I] THEN BEGIN M := I * MAXSETMOD + N; WRITE(OUTPUT,' ':3,M:6,':',' ':4); CASE I OF 0 : MESSAGE1; 1 : MESSAGE2; 2 : MESSAGE3; 3 : MESSAGE4; 4 : MESSAGE5; 5 : MESSAGE6; 6 : MESSAGE7; S 8 : MESSAGE9; 7,9,10 : ;  END (*OF CASE*); END END (*OF PROGRAM*). R2IFT.SR ?s .TITL R2IFT ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO READ REAL AND WRITE REAL .ENT XRDR,XWRR .EXTN PUNDF .NREL XRDR: XWRR: .PUND .END NEW2P4ASME.kk LPROGRAM NEW2P4ASME(OUTPUT); BEGIN WRITELN(OUTPUT, '****************', ' GENERATION OF N', 'EW PCODE ASSEMBL', 'ER COMPLETED. **', '***************'); WRITELN(OUTB8PUT, 'YOU MAY DELETE A', 'LL OTHER FILES O', 'F RELEASE II MEN', 'TIONED AT THE '); WRITELN(OUTPUT, ' BEGINNING PLUS ', 'SETUP.SV, SETU' : 14, 'zxPA.SV, P4AMY2 AN', 'D P4MAC.SV EXCEP', 'T P4ASM.SV'); WRITELN(OUTPUT) END. MAKE2P4AM.CMrX 9NEW2P4ASMB $TTO $TTI;^ PASCAL/Z SETUP $LPT/L;^ DELETE/V SETUP.RB;^ SETUP SETUP.TB $TTO;^ FASTHASH P4ASM.PC SETUPAY SETUP.TB $LPT;^ APPEND SETUPA SETUPAX SETUPAY SETUPAZ;^ PASCAL/Z SETUPA $LPT/L;^ DELETE/V SETUPA SETUPA.RB;^ SETUPA P4AMY2 $TTO;^ APPEND P4MA+C HEADM2 P4AMX2 P4AMY2 P4MACZ2;^ PASCAL/Z P4MAC $LPT/L;^ DELETE/V P4MAC;^ APPEND P4ASM HEADA2 P4AMX2 P4AMY2 P4ASMZ2;^ PASCAL/Z/P P4ASM $LPT/L;^ DELETE/V P4ASM;^ NEW2P4ASME $TTO R2RFNS.SR < .TITL R2RFNS .ENT PFPIN,PFPES,PFPEX,PFPEF .ENT XATN,XCOS,XEXP,XLOG,XSIN,XSQT .ENT XRND .EXTD WSA .EXTN FENT, PTRC .NREL PFPFN: PFPIN: STA 3,TAC3 ;ENTRY USED BY UNARY OPERATORS SUB 3,3 ;AND EVERYTHING ELSE LDA 2,WSA ;RFPI WRITE AREA STA 3,0,2  ;OVFL UNFL FLAGS DSZ SP FENT FLDA 1,@SP FJMP @TAC3 TAC3: 0 PFPES: FSTA 0,@SP ;EXIT ROUTINE 3 ENTRIES PFPEX: FEXT ISZ SP PFPEF: LDA 2,WSA LDA 3,0,2 MOV 3,3,SNR ;ANY FP FLAGS SET ? NEXT ;NO ERR.P PERFP ;YES ERROR406 ;THE FOLLOWING STANDA&RD FUNCTION CALLS ;HAVE A COMMON FORMAT. THE JSR TO PFPFN ;LOADS THE FP OPERANDS INTO FP ACCUMULATOR ;1. THE FJMP TO PFPES ENSURES THAT THE ;RESULT IS STORED. IN THE EVENT OF OVFL OR ;UNDFL ERROR 406 IS REPORTED TO RDOS XATN: JSR PFPFN FATN 1,0 FJMP PFP^[ES XCOS: JSR PFPFN FCOS 1,0 FJMP PFPES XEXP: JSR PFPFN FEXP 1,0 FJMP PFPES XLOG: JSR PFPFN FALG 1,0 FJMP PFPES XSIN: JSR PFPFN FSIN 1,0 FJMP PFPES XSQT: JSR PFPFN FSQR 1,0 FJMP PFPES XRND: JSR PFPFN FRND 1,0 FSTA 0,@SP FLD3 .PTRC FJMP 1)t,3 .PTRC: PTRC .END COM.CM 3TYPER2SHEAP.SRR2RFW.SR =,5 .TITLE R2RFW .ENT WSA ;RELOCATABLE FLOATING POINT INTERPRETER (RFPI) ;NEEDS A WRITE AREA OF 100 DECIMAL LOCATIONS, THE ;ADDRESS OF THIS AREA TO BE GIVEN AT LOCATION ;WSA IN PAGE ZERO. THE AREA IS INITIALISED ONCE ;ONLY BY SEGMENT PR. .ZREL WSA: FPPAD Q .NREL FPPAD: .BLK 100. .END SETUP.mm P(* UNIVERSITY OF LANCASTER DEPARTMENT OF CCOPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE I/II DATE : MARCH, 1977 *) (*******K'*************************************************** THIS PROGRAM IS TO PRODUCE A HASH TABLE FOR ALL THE PCODE MNEMONICS. NO OPTIMAL STRATEGY IS INCORPORATED TO SPEED UP THE ACCESSING MECHANISM. # TO ACTIVATE THIS PROGRAM, DO THE FOLLOWING COMMAND : SETUP SETUP.TB ======================= WHERE 'SETUP.TB' IS THE OUTPUT FILE USED TO CONTAIN THE HASH TABLE  AND WILL BE USED AS INPUT FILE TO THE PROGRAM "FASTHASH" IS THE PRR FILE USED TO CONTAIN SOME USEFUL INFORMATION FOR USER REFERENCE. ***********J**********************************************) PROGRAM SETUP(OUTPUT, PRR); CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) TYPE STRING4 = ARRAY[1..4] OF CHAR; STRING6 = ARRAY[1..6] OF CHARx; TEMPLATE = RECORD PCODE : STRING4; SEMICODE : STRING6; ACTION : INTEGER END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; ; I, J, K : 1..TABLESIZE; ZERO, ENTRIES, PETTY : INTEGER; PROCEDURE HASH(HPCODE : STRING4; HSEMICODE : STRING6; HACTION : INTEGER); VAR TEMP, RNDM, PI : INTEGER; BEGIN TEMP := ORD(HPCODE[1]) * 4 + ORD(HPCODE[2]) * 2 + ORD(HPCODE[3]) ; IF ORD(HPCODE[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(HPCODE[4]); TEMP := TEMP MOD TABLESIZE; RNDM := 1; PI := 0; WHILE PCODETABLE[ (TEMP + PI) MOD TABLESIZE].PCODE <> ' ' DO BEGIN (* OF THE REHASHING ALGORITHM MENTIONED BY DAVID GRIES IN HIS 'COMPILER CONSTRUCTION' *) RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); END;  (* AN EMPTY ENTRY IN THE PCODE TABLE IS FOUND *) WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN PCODE := HPCODE; SEMICODE := HSEMICODE; ACTION := HACTION; END; ENTRIES := ENTRIES + 1 G0 END (* OF HASH *); PROCEDURE COMPLETETASK; PROCEDURE TASK1; BEGIN (********** GROUP 1 WITH NO OPERANDS **********) (* TYPES OF THE FOLLOWING FORMAT IN A 16-BIT WORD ................... < : : : :00XXXXTT:XX000000: : : : :........:........: WHERE TT = 00 IF INTEGER, ADDRESS OR BOOLEAN = 01 IF REAL a6 = 10 IF CHAR = 11 IF SET OR RECORD. X = 0 OR 1. NB THE ABOVE FORMAT APPLIES TO INSTRUCTIONS HAVING A 'C' FIELD *)  HASH('STOA', '004000', 0); HASH('STOB', '004000', 0); HASH('STOC', '005000', 0); HASH('STOI', '004000', 0); HASH('STOR', '004400', 0); HASH('STOS', '005400', 0); HASH('EOF ', '024400', 0); HASH('ADI ', '007000', 0); HASH('ADR ', '013400', 0); HASH('SBI ', '007400', 0); HASH('SBR ', '014000', 0); HASH('SGS ', '022000', 0); HASH('FLT ', '014400', 0); HASH('FLO ', '015000', 0); HASH('TRC ', '015400', 0); HASH('NGI ', '010000', 0); HASH('NGR ', '016000', 0); HASH('SQI ', '010400', 0); HASH('SQR ', '016400', 0); HASH('ABI ', '011000', 0); H{ASH('ABR ', '017000', 0); HASH('NOT ', '020400', 0); HASH('AND ', '021000', 0); HASH('IOR ', '021400', 0); HASH('DIF ', '022400', 0); HASH('INT ', '023000', 0); HASH('UNI ', '023400', 0);  HASH('INN ', '024000', 0); HASH('MOD ', '011400', 0); HASH('ODD ', '012000', 0); HASH('LCA ', '025400', 0); END (* TO BE CONTINUED IN TASK2 *); PROCEDURE TASK2; BEGIN (* CONTINUED FROMu TASK1 *) HASH('MPI ', '012400', 0); HASH('MPR ', '017400', 0); HASH('DVI ', '013000', 0); HASH('DVR ', '020000', 0); HASH('STP ', '025000', 0); HASH('CHR ', '030000', 0); HASH('QORDA', '026400', 0); HASH('ORDB', '027400', 0); HASH('ORDC', '027000', 0); HASH('ORDI', '026000', 0); (* COMPARISON TYPES WITH THE FOLLOWING FORMAT ................... : : G : :00XXXXXX:XXXXXTTT: : : : :........:........: WHERE TTT = 001 IF INTEGER OR CHAR = 010 IF REAL = 011 IF BOOLEAN  = 100 IF SET OR RECORD = 101 IF ADDRESS. X = 0 OR 1. *) HASH('EQUA', '001005', 0); HASH('EQUB', '001003', 0); HASH('EQUC', '001001', 0); HASH('EQUI',G '001001', 0); HASH('EQUR', '001002', 0); HASH('EQUS', '001004', 0); HASH('NEQA', '001405', 0); HASH('NEQB', '001403', 0); HASH('NEQC', '001401', 0); HASH('NEQI', '001401', 0); HASH('NEQR', '001402', 0); HASH('NEQS', '001404', 0); HASH('GEQA', '002005', 0); HASH('GEQB', '002003', 0); HASH('GEQC', '002001', 0); HASH('GEQI', '002001', 0); HASH('GEQR', '002002', 0); tR HASH('GEQS', '002004', 0); END (* TO BE CONTINUED IN TASK3 *); PROCEDURE TASK3; BEGIN (* CONTINUED FROM TASK3 *) HASH('GRTA', '002405', 0); HASH('GRTB', '002403', 0); HASH('GRTC', '002401', 0); HASH('GRTI', '002401', 0); HASH('GRTR', '002402', 0); HASH('GRTS', '002404', 0); HASH('LEQA', '003005', 0); HASH('LEQB', '003003', 0); HASH('LEQC', '003001', 0); HASH(I'LEQI', '003001', 0); HASH('LEQR', '003002', 0);  HASH('LEQS', '003004', 0); HASH('LESA', '003405', 0); HASH('LESB', '003403', 0); HASH('LESC', '003401', 0); HASH('LESI', '003401', 0);  HASH('LESR', '003402', 0); HASH('LESS', '003404', 0); HASH('RETA', '006401', 0); HASH('RETB', '006401', 0); HASH('RETC', '006401', 0); HASH('RETI', '006401', 0); HASH('RETP', '006400'k, 0); HASH('RETR', '006402', 0); END (* OF TASK1 *); PROCEDURE TASK4; BEGIN (********** GROUP 2 WITH OPERANDS **********) (* TYPES WITH THE FOLLOWING FORMAT ...................  : : : :W1XXXXXX:XX000000: : : : :........:........: WHERE W = 0 IF ONE-WORD INSTRUCTION = 1 IF TWO-WORD INSTRUCTION X = 0 OR d1. *) (* COMPARISON TYPES *) (********************) HASH('EQUM', '001000', 10); HASH('NEQM', '001400', 10); HASH('GEQM', '002000', 10); HASH('GRTM', '002400', 10); HASH('LEQf#M', '003000', 10); HASH('LESM', '003400', 10); (* OTHER TYPES *) (***************) HASH('LODA', '044000', 20); HASH('LODB', '044000', 20); HASH('LODC', '044000', 20); HASH('LODI', '044000', 20); HASH('LODR', '044000', 30); HASH('LODS', '044000', 40); HASH('STRA', '050000', 20); HASH('STRB', '050000', 20); HASH('STRC', '050000', 20); HASH('STRI', '050000', 20); HASH('MSTRR', '050000', 30); HASH('STRS', '050000', 40); HASH('LDA ', '056000', 20); HASH('CXP ', '072400', 50); HASH('HLT ', '000400', 0); HASH('CUP ', '060400', 50); HASH('MST ', '006000', 60); > HASH('LDOA', '046000', 70); HASH('LDOB', '046000', 70); HASH('LDOC', '046000', 70); HASH('LDOI', '046000', 70); HASH('LDOR', '046000', 90); HASH('LDOS', '046000', 100); END (* TO BE CONTINUED I8.N TASK5 *); PROCEDURE TASK5; BEGIN (*CONTINUED FROM TASK4 *) HASH('SROA', '052000', 70); HASH('SROB', '052000', 70); HASH('SROC', '052000', 70); HASH('SROI', '052000', 70); HASH('SROR', '052000', 90); HASH('SROS', '052000', 100); HASH('LAO ', '056400', 70); HASH('INDA', '054000', 70); HASH('INDB', '054000', 70); HASH('INDC', '054000', 80); HASH('INDI', '054000', 70);  HASH('INDR', '054000', 90); HASH('INDS', '054000', 100); HASH('INCA', '064000', 110); HASH('INCI', '064000', 110); HASH('INCC', '065000', 110); HASH('IXA ', '057400', 110); HASH('MOV ', '0600%00', 120); END (* TO BE CONTINUED IN TASK6 *); PROCEDURE TASK6; BEGIN (* CONTINUED FROM TASK5 *) HASH('DECA', '066000', 110); HASH('DECI', '066000', 110); HASH('DECC', '067000', 110); H"ASH('ENT ', '061000', 130); HASH('UJC ', '040400', 140); HASH('UJP ', '062000', 150); HASH('FJP ', '062400', 150); HASH('XJP ', '063400', 150); HASH('TJP ', '063000', 150); HASH('CSP ', '061400', 160); HASH('CHKA', '171400', 170); HASH('CHKB', '070400', 170); HASH('CHKC', '070000', 170); HASH('CHKI', '070400', 170); HASH('CHKR', '070000', 170); HASH('CHKS', '070000', 170); HAj+SH('LDC ', '057000', 180); HASH('LDCB', '057000', 190); HASH('LDCC', '057000', 200); HASH('LDCI', '057000', 190); HASH('LDCN', '057000', 210); HASH('LDCR', '057000', 220);  HASH('JNC ', '032000', 2Jd30); END (* OF TASK 4 *); PROCEDURE TASK7; BEGIN (* STANDARD PROCEDURES *) HASH('ATN ', '000023', 0); HASH('COS ', '000017', 0); HASH('ELN ', '000007', 0); HASH('EXP ', '000020', 0); HASH('GET ', '000000', 0); HASH('LOG ', '000021', 0); HASH('NEW ', '000004', 0); HASH('PUT ', '000001', 0); HASH('RDC ', '000015', 0); HASH('RDI ', '000013', 0); HASH('RDR ', '000)014', 0); HASH('RLN ', '000003', 0); HASH('RST ', '000002', 0); HASH('SAV ', '000024', 0); HASH('SIN ', '000016', 0); HASH('SQT ', '000022', 0); HASH('WLN ', '000005', 0); HASH('WRRC ', '000012', 0); HASH('WRI ', '000010', 0); HASH('WRR ', '000011', 0); HASH('WRS ', '000006', 0); HASH('OPN ', '000025', 0); HASH('RND ', '000026', 0); HASH('OVL ', '000027', 0);  HASH('CLS ', '000030', 0); HASH('RRR ', '000031', 0); HASH('WDR ', '000032', 0); HASH('PAG ', '000033', 0); HASH('EOR ', '000034', 0); HASH('RWR ', '000035', 0); HASH('RSE ', '000036', 09); END (* OF TASK7 *); BEGIN (* OF COMPLETETASK *) TASK1; TASK2; TASK3; TASK4; TASK5; TASK6; TASK7; END (* OF COMPLETE TASK *); BEGIN (* OF MAIN PROGRAM *) WRITELN(PRR, 'SETUP STARTS'); WRITELN; WRITELN; WRITELN; FOR I := 0 TO TABSIZE0 DO BEGIN PCODETABLE[I].PCODE := ' '; PCODETABLE[I].SEMICODE := ' '; PCODETABLE[I].ACTION := 0 END; ZERO := ORD('0'); COMPLETETASK; ; WRITE('*'); (* WRITE '*' AS THE HEADER TO INDICATE THAT HASH TABLE IS TO FOLLOW *) FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO BEGIN WRITE(PCODE); IF SEMICODE[1] = ' ' THEN  WRITE(0 : 6, 0 : 4) ELSE BEGIN PETTY := 0; IF SEMICODE[1] = '1' THEN PETTY := -8; WRITE( ((((PETTY + ORD(SEMICODE[2]) - ZERO ) * 8 +  ORD(SEMICODE[3]) - ZERO ) * 8 + ORD(SEMICODE[4]) - ZERO ) * 8 + ORD(SEMICODE[5]) - ZERO ) * 8 +  ORD(SEMICODE[6]) -ZERO : 6, ACTION : 4); END; v WRITELN END; WRITELN(PRR, '; HASH TABLE SIZ', 'E = ' : 8, TABLESIZE : 1); WRITELN(PRR, '; TOTAL PCODE EN', 'TRIES = ' : 8, ENTRIES : 1); WRITELN(PRR, '; LOADING FACTOR', ' = ' : 8, ENTRIES/TABLESIZE : 1) END. R2RFILES.CMDR2SECHK,^ R2ROUTL,^ R2SMPD,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2RFT,^ R2SITAB,^ R2SDIV,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2SDECODER,^ R2SMYP,^ R2RR7&EAL,^ R2SREWR,^ R2RFNS,^ R2SSPTAB,^ R2SCONSTS,^ R2RFW^ R2SSET.SR 6 .TITL R2SSET ; THE P-CODE INTERPRETER'S SET OPERATIONS .ENT PSGS,PDIF,PINT,PUNI,PINN,MIN4 .ZREL N16: 20 ;USEFUL CONSTANTS MIN4: -4 ASP=Z1 ;AUXILLIARY SET PTR .MACRO SASP ;MACRO TO SET UP ASP IN ACCUMULATOR LDA ^1,SP ;SPECIFIED BY ^1. ASP{ IS DEFINED AS LDA 0,MIN4 ;SIMPLY "STACK PTR - 4". IT IS ADD 0,^1 ;USEFUL WHEN DEALING WITH 2 SETS ON T'STACK STA ^1,ASP % .NREL PSGS: LDA 2,MIN4 ;FORM SINGLETON SET FROM INTEGER POP1 1 ;GET INTO MORE CONVENIENT FORM INC 1,1 NEG 1,1 SUBZ 0,0 =; ; NOW SHIFT CIRCULAR (CARRY-WITH-AC0) WHILST COUNTING UP THRU ZERO ; EVERY 16 SHIFTS, WE PUSH "ALL ZEROES", BUT ALSO, WHEN COUNT=ZERO ; WE PUSH A WORD WITH JUST THE RIGHT BIT SET. STOP WHEN 4 WORDS PUSHED. ; SGS1: MOVR 0,0,SZR JMP SGS2 PUSH1 0 ;PUSH A ZERO WORD MOVR 0,0 INC 2,2,SNR ;ASSUMES NEXT EXPANDS TO EXACTLY NEXT ;ONE WORD SGS2: INC 1,1,SZR JMP SGS1 PUSH1 0 ;PUSH THE WORD HOLDING THE BIT INCC 2,2,SZR JMP SGS1 NEXT PDIF: SASP 3 ;FIND SET DIFFERENCE DIF1: POP1 2 ;SIMPLY DO "A & NOT B" FOR EACH LDA 1,@ASP ;OF THE 4 CORRESPONDING PAIRS OF WORDS COM 2,2 AND 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP DIF1 NEXT PINT: SASP 3 ;FIND SET INTERSECTION INT1: POP1 2 ;SIMPLY "A & B" FOR EACH OF 4 PAIRS AGAIN LDA 1,@ASP AND 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP INT1 NEXT PUNI: SASP 3 ;FIND SET UNION UNI1: POP1 2 ;"A OR B" THIS TIME LDA 1,@ASP COM 2,2 ;ON THIS SILLY M/C "OR" HAS TO BE AND 2,1 ;"COM - AND - ADC" ADC 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP UNI1 NEXT ֆPINN: LDA 3,SP ;FORM BOOLEAN = "TRUE IFF NTH ELEMENT LDA 0,MIN4 ;OF SET PRESENT". SORRY, BUT SASP ADD 0,3 ;NOT QUITE SUITABLE HERE STA 3,SP LDA 0,0,3 LDA 1,N16 INN1: INC 3,3 ;THIS LOOP FINDS WHICH WORD SUBZ 1,0,SZC ;OF SET WE WANT JMP INN1 SUBZ 1,1 INN3: MOVL 1,1 ;THIS LOOP FINDS WHICH BIT OF THE WORD INC 0,0,SZR JMP INN3 LDA 0,0,3 AND 0,1,SZR SUBZL 1,1 ;TRUE IFF BIT IS THERE STOP1 1 NEXT .END P4MACZ2.mm . PROCEDURE DOTFILE; (* REDUNDANT IN RELEASE II *) BEGIN WRITELN(OUTPUT, 11008 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* READ OFF EOLN *) WRITELN(OUTPUT, '.TXT ''INPUT'''); WRITELN(OUTPU=T, -8954); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8954);  WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8952); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''OUTPUT'''); WRITELN(OUTPUT, -8951); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8949); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRIT&ELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRD'''); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); , WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8946); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRR'''); WRITELN(OUTPUT, -8945); WRITELN(OUTPUT, -7403); V WRITELN(OUTPUT, -8943); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRITELN(OUTPUT, 2048 ); WRITELN END (*** OF DOTFILE ***); PROCEDURE PACKCODE; VAR SMCODE, I, P, Q : INTEGER; LITERALS c: STRING3; OP, TEMPOP : STRING4; ERROR : BOOLEAN; PROCEDURE DUMMYLABELS; BEGIN ECOUNT := ECOUNT + 1; WRITELN(PRR, '**********', ' INSTR. NO. ' : 12, ICOUNT : 5, ' ''' : 2, OP, / ''' HAS NOT YET BE', 'EN CATERED FOR '); WRITELN END (*** OF DUMMYLABELS ***); FUNCTION PKACTION : INTEGER; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; PROCEDURE ERRORP;  BEGIN ERROR := TRUE; ECOUNT := ECOUNT + 1; MORETRY := FALSE; WRITE(PRR, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(INPUT, CH); 1 WRITE(PRR, CH)  UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN(PRR); WRITE(PRR, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(PRR) END (*** ERRORP ***); BEGI;N (* OF PKACTION *) PKACTION := 0; TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLES>IZE; MORETRY := TRUE; SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN IF OP = PCODE THEN BEGIN MORETRY := FALSE; SMCODE := SEMICODE; PKACTION:= ACTION; END ELSE IF PCODE = ' ' THEN ERRORP;   IF MORETRY THEN BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4 ); SMAX := SMAX + 1 END END END (*** OF PKACTION ***); PROCEDURE NILP(P1, P2 : INTEGERca); (* PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1= 0)) THEN BEGIN WRITELN(OUTPUT, P2); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 ); RE`AD(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILP ***); PROCEDURE NILPS(P1, P2, P3 : INTEGER); (* SPECIAL PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1 < HALFWORD) AND (P1 >= 0)) THEN BEGIN WRITELN(OUTPUT, P2 + P3 ); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 + P3 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILPS ***); PROCEDURE QTOP(P1, P2, P3 : INTEGER); (* PCODE WITH P AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND (P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN WRITELN(OUTPUT, P3 + P1 ); WRITELN(OUTPUT, P2 : 7) END ELSE WRITELN(OUTPUT, BIT16 + P3 + P2 ); 0 READ(INPUT, CH) (* READ OFF EOLN *) END (*** QTOP ***); PROCEDURE QTOPS(P1, P2, P3, P4 : INTEGER); (* SPECIAL PCODE WITH P AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND ( P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN 2 WRITELN(OUTPUT, P3 + P4 + P1 ); WRITELN(OUTPUT, P2) END ELSE WRITELN(OUTPUT, BIT16 + P2 + P3 + P4 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF QTOPS ***); PROCEDURE BOUNDS(SEMICODE,Qi LOWERBOUND, UPPERBOUND : INTEGER); (* GENERATE OFFENDING PCODE LOCATION IN CASE CHECK RANGE BEING INVALID *) BEGIN IF SEMICODE > 0 THEN BEGIN IF (LOWERBOUND = 0) AND (UPPERBOUND < HALFWORD) THEN DS WRITELN(OUTPUT, SEMICODE + BIT16 + UPPERBOUND) ELSE BEGIN IF (LOWERBOUND >= 0) AND (LOWERBOUND < HALFWORD) THEN WRITELN(OUTPUT, SEMICODE + LOWERBOUND) ELSE , BEGIN WRITELN(OUTPUT, SEMICODE + HALFWORD); WRITELN(OUTPUT, LOWERBOUND) END; WRITELN(OUTPUT, UPPERBOUND) END END ELSE IF +LOWERBOUND > 0 THEN WRITELN(OUTPUT, SEMICODE + 1) ELSE WRITELN(OUTPUT, SEMICODE); WRITELN(OUTPUT, ICOUNT + 1) END (* OF BOUNDS *); PROCEDURE LOWCODE; (* TO PROVIDE FACILITIES FOR THOSE POOR SOULS WHO MUST LIVE W9ITH MACHINE CODES *) VAR I, J, K, L, ACC, LEVEL, DISPL : INTEGER; CODEND : BOOLEAN; DIRECTIVE : STRING4; LINE : ARRAY[1..80] OF CHAR; GOODCHAR : SET OF CHAR; GOODIGIT : SET OF '0'b..'9'; FUNCTION GETNUM : INTEGER; VAR NUMBER : INTEGER; BEGIN WHILE ((LINE[J] = ' ') OR (LINE[J] = ',')) AND (J < I) DO J := J + 1; IF NOT (LINE[J] IN GOODIGIT) THEN  BEGIN WRITELN(PRR, '** ASSEMBLER COD', 'E ERROR :'); FOR J := 1 TO I DO WRITE(PRR, LINE[J]); WRITELN(PRR); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); ECOUNT := ECOUNT + 1 END; NUMBER := ORD(LINE[J]) - ZERO; J := J + 1; WHILE (J <= I) AND (LINE[J] IN GOODIGIT) DO BEGIN NUMBER := N3UMBER * 10 + ORD(LINE[J]) - ZERO; J := J + 1 END; GETNUM := NUMBER END (* OF GETNUM *); PROCEDURE GETLABEL; VAR N : INTEGER; BEGIN IF J > 1 THEN  BEGIN FOR N := 1 TO J DO WRITE(OUTPUT, LINE[N]); END END (* OF GET LABEL *); BEGIN (* OF LOWCODE *); WRITELN(OUTPUT, '.RDX 8'); WRITELN(OUTPUT, '.EXTD .CST .CLD ', 'PCRTN'); CODEND := FALSE; FOR CH := '0' TO '9' DO GOODIGIT := GOODIGIT + [CH]; FOR CH := 'A' TO 'Z' DO GOODCHAR := GOODCHAR + [CH]; GOODCHAR := GOODCHAR + ['.', '$'] + GOODIGIT; REPEAT A IF EOF(INPUT) THEN BEGIN WRITELN(PRR, '** ASSEMBLY CODE', ' SECTION NOT PRO', 'PERLY ENDED.'); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); HALT(311); s END; REPEAT WHILE EOLN(INPUT) DO READLN(INPUT); READ(INPUT, CH);  IF CH = ';' THEN READLN(INPUT) UNTIL CH IN GOODCHAR; LINE[1] := CH; ] FOR I := 2 TO 80 DO LINE[I] := ' '; I := 1; J := 1; WHILE NOT( EOLN(INPUT) OR ( I = 80) OR (CH = ';')) DO BEGIN READ(INPUT, CH); IF CH <> ';' THEN H+ BEGIN I := I + 1; LINE[I] := CH; IF CH = ':' THEN J := I END END; READLN(INPUT); IF J > 1 THEN n< REPEAT J := J + 1; UNTIL LINE[J] <> ' '; L := 1; FOR K := J TO J + 3 DO BEGIN DIRECTIVE[L] := LINE[K]; L := L + 1 E END; IF DIRECTIVE = 'JPC ' THEN BEGIN GETLABEL;  CODEND := TRUE; WRITELN(OUTPUT, 'JSR @PCRTN') END ELSE IF DIRECTIVE = 'POxP ' THEN BEGIN GETLABEL; J := J + 4; WRITELN(OUTPUT, 'DSZ 41'); WRITE(OUTPUT, 'LDA ' : 5, GETNUM : 1, ' @41'); WRITELN(OUTPUT) Y END ELSE IF DIRECTIVE = 'PUSH' THEN BEGIN GETLABEL;  J := J + 4; WRITELN(OUTPUT, 'ISZ 41'); WRITE(OUTPUT, 'STA ': 5, GETNUM : 1, ' @41');(B WRITELN(OUTPUT) END ELSE IF DIRECTIVE = 'LOAD' THEN BEGIN GETLABEL; J := J + 4; ACC := GETNUM; LEVEL := GETNUM; DISPL := {GETNUM; WRITELN(OUTPUT, 'JSR @.CLD'); WRITELN(OUTPUT, LEVEL); WRITELN(OUTPUT, DISPL); WRITE(OUTPUT, 'LDA ' : 5, ACC : 1, ' @47'); WRITELN(OUTPUT); p END ELSE IF (DIRECTIVE = 'STOR') AND (LINE[J + 4] = 'E') THEN BEGIN GETLABEL; J := J + 5; WRITE(OUTPUT, 'STA ' : 5, GETNUM : 1, ' 47'); j) WRITELN(OUTPUT); WRITELN(OUTPUT, 'JSR @.CST');  WRITELN(OUTPUT, GETNUM); WRITELN(OUTPUT, GETNUM); END ELSE BEGIN FOR J := 1- TO I DO WRITE(OUTPUT, LINE[J]); WRITELN(OUTPUT) END; UNTIL CODEND; WRITELN(OUTPUT, '.RDX 10') END (* OF LOWCODE *); BEGIN (* OF PACKCODE *) OP[1] := CH; REAYD(INPUT, OP[2], OP[3]); IF EOLN(INPUT) THEN OP[4] := ' ' ELSE READ(INPUT, OP[4]); CASE PKACTION OF 0 : (* STOA STOA STOC STOI STOR STOS EOF ADI ADR SBI SBR SGS FLT FLO٪ TRC NGI NGR SQI SQR ABI ABR NOT AND IOR DIF INT UNI INN MOD ODD LCA MPI MPR DVI DVR STP CHR ORDA ORDB ORDC ORDI EQUA EQUB  EQUC EQUI EQUR EQUS NEQA NEQB NEQC NEQI NEQR NEQS GEQA GEQB GEQC GEQI GEQR GEQS GRTA GRTB GRTC GRTI GRTR GRTR GRTS LEQA LEQB LEQC LEQI LEQR LEQS LESA LESB LESC LESI LESR LESS RETA RETB RETC RETI RETP RETR ATN COS ELN EXP GET LOG NEW PUT RDC RDI RDR RLN RST SAV SIN SQwT WLN WRC WRI WRR WRS  OPS OPN OVL CMS RSN *) BEGIN IF ERROR THEN ERROR := FALSE ELSE BEGIN ; WRITELN(OUTPUT, SMCODE ); READLN(INPUT) (* RID EOLN *) END END; 1, 2, 3, 4, 5, 6, 7, 8, 9 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 10 : (* EQUM NEQM GEQ GRTM LEQM LESM  *) BEGIN READ(INPUT, Q); NILP(Q, SMCODE + BIT15) END; 11, 12, 13, 14, 15, 16, 17, 18, 19 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 20 : (* LODA LODB LODC LODI STRA STRB STRC STRI LDA *) BEGIN READ(INPUT, P, Q); QTOP(P, Q DIV 2, SMCODE) END;z 21, 22, 23, 24, 25, 26, 27, 28, 29 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 30 : (* LODR STRR *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q DIV 2, SMCODE, HALFWORDV) END; 31, 32, 33, 34, 35, 36, 37, 38, 39 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 40 : (* LODS STRS *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q D IV 2, SMCODE, 3 * HALFWORD) END; 41, 42, 43, 44, 45, 46, 47, 48, 49 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 50 : (* CUP CXP *) BEGIN READ(INPUT, P); Y READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P DIV 2 ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 51, 52, 53, 54, 55, 56, 57, 58, 59 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 60 : (* MST *) BEGIN READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + Q ); READ(INPUT, CH) (* READ OF EOLN *) END; 61, 62, 63, 64, 65, 66, 67, 68, 69 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 70 : (* LDOA LDOB LDOC LDOI  SROAy SROB SROC SROI INDA INDB INDI LAO *) BEGIN READ(INPUT, Q); NILP(Q DIV 2, SMCODE) END; 71, 72, 73, 74, 75, 76, 77,H 78, 79 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 80 : (* INDC *) BEGIN READ(INPUT, Q); NILPS(Q, SMCODE, 2 * HALFWORD) END; 81, 82, 83, 84, 85, 86, 8>7, 88, 89 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 90 : (* LDOR SROR INDR *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD) END; 91, 92|C, 93, 94, 95, 96, 97, 98, 99 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 100 : (*LDOS SROS INDS *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD * 3)  END; 101, 102, 103, 104, 105, 106, 107, 108, 109 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 110 : (* INCA INCI INCC IXA DECA DECI DECC *) BEGIN m READ(INPUT, Q); NILP(Q, SMCODE) END; 111, 112, 113, 114, 115, 116, 117, 118, 119 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 120 : (*MOV *) BEGIN ? READ(INPUT, Q); NILP((Q + 1) DIV 2, SMCODE) END; 121, 122, 123, 124, 125, 126, 127, 128, 129 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 130 : (* ENT *) BEGIN  READ(INPUT, P); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P ); WRITELN(OUTPUT, CH, Q : 1); ] READ(INPUT, CH) (* READ OFF EOLN *) END; 131, 132, 133, 134, 135, 136, 137, 138, 139 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 140 : (* UJC *) BEGIN  WRITELN(OUTPUT, SMCODE ); WRITELN(OUTPUT, 0 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 141, 142, 143, 144, 145, 146, 147, 148, 149 : DUMMYLABELS; (***** FOR FUTURE INSERTXIONS *****) 150 : (* UJP FJP XJP TJP JPF JPT SJP *) BEGIN READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODEfi ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 151, 152, 153, 154, 155, 156, 157, 158, 159 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****)  160 : (* CSP *) BEGIN READ(INPUT, CH); WHILE CH = ' ' DO READ(INPUT, CH); I := SMCODE; TEMPOP := OP; OP[1] := CH; READ(INPUT, OP[2], OP[3]); OP[4] := ' '; P := PKACTION; (* P IS DUMMY, CALLING PKACTION IS JUST TO  OBTAIN SEMI-CODE VALUE IN SMCODE *) WRITELN(OUTPUT, SMCO8^DE + I + BIT16 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 161, 162, 163, 164, 165, 166, 167, 168, 169 :DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 170 : (* CHKA CHKB CHKC CHKI *) 5 BEGIN READLN(INPUT, P, Q); BOUNDS(SMCODE, P, Q) END; 171, 172, 173, 174, 175, 176, 177, 178, 179 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 180 : (* LDC *) BEGIN WRITELN(OUTPUT, SMCODE + 3 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *)  FOR I := 1 TO 4 DO WRITELN(OUTPUT, SWITCHES[I]); END; 181, 182, 183, 184, 185, 186, 187, 188, 189 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 190 : (* LDCB LDCI *) BEGIN : READ(INPUT, Q); QTOP(0, Q, SMCODE) END; 191, 192, 193, 194, 195, 196, 197, 198, 199 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 200 : (* LDCC *) (* SORRY FOR THIS MESS,  BUT BLAME THE NOVA ASSEMBLER PLEASE. *) BEGIN READ(INPUT, CH); (* THE ORDINAL OF (') = 7 *) WHILE ORD(CH) <> 7 DO READ(INPUT, CH); LITERALS[1] := CH; V READ(INPUT, LITERALS[2], LITERALS[3]); WRITELN(OUTPUT, SMCODE ); IF LITERALS[2] = CHR(7) (* IF LITERALS[2] = '''' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 39 (* NOVA z CODE FOR (') *) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(12) (* IF LITERALS[2] = ',' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 44 (* NOVA CODE FOR (,) *) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(28) (* IF LITERALS[2] = '<' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHRH(30), CHR(7)) ELSE WRITELN(OUTPUT, '.TXT ', LITERALS); READ(INPUT, CH) (* READ OFF EOLN *) END; 201, 202, 203, 204, 205, 206, 207, 208, 209 : DUMMYLABELS; (***** FOR FUTURE INSXERTIONS *****) 210 : (* LDCN *) QTOP(0, 0, SMCODE); 211, 212, 213, 214, 215, 216, 217, 218, 219 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 220 : (* LDCR *) (* NOTICE THE NON-FLOATING POINT OUTPUT FORMAT OF 'R' *) BEGIN WRITELN(OUTPUT, SMCODE + 1, '.'); READLN(INPUT, R); WRITELN(OUTPUT,'0', R : 0) END; 230 : (* JNC *) (* FOR MACHINE TCODE ADDICTS ONLY *) BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT); LOWCODE; END; (* REDUNDANT 'CCP ' 240 : BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT, Q); WRITELN(OUTPUT, Q); END; *) END (* OF CASE PKACTION *) END (*** OF PACKCODE ***); BEGIN (* OF MAIN *) WRITELN; WRITELN; WRITELN; E WRITELN(PRR, '; ==== P4MAC BEG', 'INS NOW'); ENT := TRUE; ZERO := ORD('0'); ICOUNT := 3; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO PCODE := ' '; COMPLETABLE; (* START READING IN THE PCODE PROGRAM FROM PRD FILE *) READ(INPUT, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(PRR, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(PRR); HxALT(311) END; WRITE(OUTPUT, CH: 16, DOTNAME); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH); (* RID EOLN *) REPEAT READ(INPUT, CH); IF C2yH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF (CH = 'P') OR (CH = '?') THEN PCTYPE := PCODENTRY ELSE BEGIN READ(INPUT, CH); IF CH = '.' THEN PCTYPE := NONPCODE  ELSE PCTYPE := PCODES END; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(INPUT, J); IF (ICOUNT <> J) AND (J <> 0)z THEN BEGIN  WCOUNT := WCOUNT + 1; WRITELN(PRR, 'I', J : 5, ' ' : 14, '; ??? PCODE' , ' COUNT OUT OF ST', 'EP ???');  END; ICOUNT := J; READ(INPUT, CH) (* READ OFF EOLN *) END; LLABEL : (* LABELS *) BEGIN WRITE(OUTPUT, CH);  READ(INPUT, I); WRITE(OUTPUT, I : 1); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) OH UNTIL EOLN(INPUT); READLN(INPUT); WRITELN(OUTPUT) END; NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) BEGIN ζ READ(INPUT, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF DOTNAME = 'FIL' THEN DOTFILE ELSE BEGIN IF ((DOTNAME = 'SW1') OR (DOTNAME = 'SW2') < OR (DOTNAME = 'SW3') OR (DOTNAME = 'SW4')) THEN BEGIN REPEAT READ(INPUT, CH) ,  UNTIL (CH = '0') OR (CH = '1'); (* READ UNTIL BINARY IS FOUND *) BINARYSTR[1] := CH; IF CH = '1' THEN J := -1 ELSE J := 0; q FOR I := 2 TO 16 DO BEGIN READ(INPUT, CH); BINARYSTR[I] := CH;  J := J * 2 + ORD(CH) - ZERO END; I := ORD(DOTNAME[3]) - ZERO; SWITCHES[I] := J; READ(IINPUT, CH) (* READ OFF EOLN *) END ELSE IF (DOTNAME = 'TXT') AND (INPUT^ <> 'M') THEN BEGIN WRITE(OUTPUT, '.v', DOTNAME : 3); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL CH <> ' '; l FOR I := 1 TO 16 DO BEGIN READ(INPUT, CH); IF CH = CHR(2) (* IF CH = '"' *) THEN   WRITE(OUTPUT, CHR(28), 34 (*NOVA CODE FOR(") *) : 1, CHR(30)) ELSE IF CH = CHR(28) (* IF CH = '<' *) THEN  WRITE(OUTPUT, CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHR(30)) ELSE IF CH = CHR(30) (* IF CH = '>' *) THEN   WRITE(OUTPUT, CHR(28), 62 (* NOVA CODE FOR (>) *) : 1, CHR(30)) ELSE WRITE(OUTPUT, CH) END;  READLN(INPUT, CH); WRITELN(OUTPUT, CH) END ELSE BEGIN  IF DOTNAME = 'ENT' THEN  WRITE(OUTPUT, '.', DOTNAME) ELSE IF NOT (DOTNAME = 'END') THEN WRITE(OUTPUT, '.', DOTNAME); IF NOT EOLN(INPUT) THEN REPEAT READ(INPUT, CH);  WRITE(OUTPUT, CH)  UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN END END F END; PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN PACKCODE; ICOUNT := ICOUNT + 1  END; PCODENTRY : (* PACKED PCODE ޾ENTRY POINT *) BEGIN WRITE(OUTPUT, CH); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EUJOLN(INPUT); WRITELN; READ(INPUT, CH) (* READ OFF EOLN *) END; END (* OF CASE PCTYPE *); WHILE EOLN(INPUT) DO BEGIN WRITELN;  READ(INPUT, CH) (* READ OF EOLN *) END UNTIL EOF(INPUT); (* THE PCODE PROGRAM HAS BEEN PACKED FOR INTERPRETER *) (* WRITELN; WRITELN; WRITELN; WRITELN(PRR, '; IDEAL SEARCHES', ' = ', SMIN); WRITELڠN(PRR, '; ACTUAL SEARCHE', 'S = ', SMAX); *) IF WCOUNT > 0 THEN WRITELN(PRR, ';---- NO. OF WAR', 'NINGS = ', WCOUNT : 6); IF ECOUNT > 0 THEN WRITELN(PRR, ';**** NO. OF FAT', 'AL ERRORS = ', ECOUNT : 6); WRITELNkn(OUTPUT, '.END' : 16); IF ECOUNT > 0 THEN HALT(311); WRITELN; WRITELN; WRITELN END. P4COMPILE1.Nm(*$T-,D-*) (********************************************** * * * * * PORTABLE PASCAL COMPILER * * ************************ * Z_ *  * * PASCAL P4 * * * * * * AUTHORS: * * M URS AMMANN * * KESAV NORI * * CHRISTIAN JACOBI * * * * ADDRESS: * *   * * INSTITUT FUER INFORMATIK * * EIDG. TECHNISCHE HOCHSCHULE * * CH-8096 ZUERICH * * * * I * * LAST CHANGES COMPLETED IN MAY 76 * * * * LANCASTER AMENDMENTS BY * * * * A. FOSTER  W * * * * DEPARTMENT OF COMPUTER STUDIES * * UNIVERSITY OF LANCASTER * * BAILRIGG * * LANCASTER LA1 4YX * * m * * * * LAST LANCASTER CHANGES JUNE 77 * * * **********************************************) PROGRAM PASCALKpCOMPILER(INPUT,OUTPUT,PRR); CONST DISPLIMIT = 20; MAXLEVEL = 10; INTSIZE = 2; INTAL = 2; REALSIZE = 4; REALAL = 2; CHARSIZE = 1; CHARAL = 2; FILEMAX = 6; CHARMAX = 1; BOOLSIZE = 2; BOOLAPL = 2; PTRSIZE = 2; ADRAL = 2; SETSIZE = 8; SETAL = 2; STACKAL = 2; STACKELSIZE = 2; STRGLGTH = 16; SETHIGH = 63; SETLOW = 0; ORDMAXCHAR = 63; ORDMINCHAR = 0; MAXINT  = 32767; LCAFTERM2ARKSTACK = 12; FILEAL = CHARAL; (* STACKELSIZE = MINIMUM SIZE FOR 1 STACKELEMENT = K*STACKAL STACKAL = SCM(ALL OTHER AL-CONSTANTS) CHARMAX = SCM(CHARSIZE,CHARAL) SCM = SMALLEST COMMON MULTIPLE LCAFTERMARKSTACK >= 4*PTRSIZE+MAX(X-SIZE) = K1*STACKELSIZE *) MAXSTACK = 2; PARMAL = STACKAL; PARMSIZE = STACKELSIZE; RECAL = STACKAL; FILEBUFFER = 4; MAXADDR = MAXINT; (*EQRROR REPORTING CONSTANTS*) MAXERRBIT = 59; MAXERRMOD = 60; MAXERRSET = 10; TYPE (*DESCRIBING:*) (*************)  (*BASIC SYMBOLS*) (***************) SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP, LPARENT,RPAREJNT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW, COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROGSY, PROCSY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY, BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY;, GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY, THENSY,OTHERSY,RANDOMSY,EXTRNSY); OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP, NEOP,EQOP,INOP,NOOP); SETOFSYS = SET6 OF SYMBOL; CHTP = (LETTER,NUMBER,SPECIAL,ILLEGAL); (*CONSTANTS*) (***********) CSTCLASS = (REEL,PSET,STRG); CSP = ^ CO0NSTANT; CONSTANT = RECORD CASE CCLASS: CSTCLASS OF REEL: (RVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR); PSET: (PVAL: SET OF 0..58); STRG: (SLGTH: 0..STRGLGTH;  SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR) END; VALU = RECORD CASE INTVAL: BOOLEAN OF (*INTVAL NEVER SET NORE TESTED*) TRUE: (IVAL: INTEGER); FALSE: (VALP: CSP)  END; (*DATA STRUCTURES*) (*****************) LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR; STRUCTFORM = (SCALAR,SUBRAUNGE,POINTER,POWER,ARRAYS,RECORDS,FILES, TAGFLD,VARIANT); DECLKIND = (STANDARD,DECLARED); STP = ^ STRUCTURE; CTP = ^ IDENTIFIER; STRUCTURE = PACKED RECORD MARKED: BOOLEAN; (*FOR TEST PHASE ONLY*) G SIZE: ADDRRANGE; CASE FORM: STRUCTFORM OF SCALAR: (CASE SCALKIND: DECLKIND OF  DECLARED: (FCONST: CTP)); SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU)wo; POINTER: (ELTYPE: STP); POWER: (ELSET: STP); ARRAYS: (AELTYPE,INXTYPE: STP); RECORDS: (FSTFLD: CTP; RECVAR: STP); FILES: (FILTYPE: STP; RANDOMFILE :BOOLEAN); TAGFLD: (TAGFIELDP: CTP; FSTVAR: STP); VARIANT: (NXTVAR,SUBVAR: STP; VARVAL: VALU)  END; (*NAMES*) 4 (*******) IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC); SETOFIDS = SET OF IDCLASS; IDKIND = (ACTUAL,FORMAL); ALPHA = PACKED ARRAY [1..8] OF CHAR; IDENTIFIER = PACKED RECORD h NAME: ALPHA; LLINK, RLINK: CTP; IDTYPE: STP; NEXT: CTP; CASE KLASS: IDCLASS OF  KONST: (VALUES: VALU); VARS: (VKIND: IDKIND; VLEV: LEVRANGE; VADDR: ADDRRANGE); M FIELD: (FLDADDR: ADDRRANGE); PROC, FUNC: (CASE PFDECKIND: DECLKIND OF STANDARD: (KEY: 1..17); DECLARED: (PFLEV: LEVRANGE; PFNAME: INTEGER;  CASE PFKIND: IDKIND OF ACTUAL: (FORWDECL,EXTDEC, EXTERN: BOOLEAN))) END; DISPRANGE = 0..DISPLIMIT; WHERE = (BLCK,CREC,VREC,REC); (*EXPRESSIONS*) (*************) ATTRKIND = (CST,VARBL,EXPR); VACCESS = (DRCT,INDRCT,ҥINXD); ATTR = RECORD TYPTR: STP; CASE KIND: ATTRKIND OF CST: (CVAL: VALU); VARBL: (CASE ACCESS: VACCESS OF DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE); N' INDRCT: (IDPLMT: ADDRRANGE)) END; TESTP = ^ TESTPOINTER; TESTPOINTER = PACKED RECORD ELT1,ELT2 : STP; LASTTESTP : TESTP END;  (*LABELS*) (********) LBP = ^ LABL; LABL = RECORD NEXTLAB: LBP; DEFINED: BOOLEAN; LABVAL, LABNAME: INTEGER END; EXTFILEP =< ^FILEREC; FILEREC = RECORD FILENAME:ALPHA; NEXTFILE:EXTFILEP; FTYPE : CTP END; (*-------------------------------------------------------------------------*) VAR (*RETURNED BY SOURCE PROGRAM SCANNER A INSYMBOL: **********)  SY: SYMBOL; (*LAST SYMBOL*) OP: OPERATOR; (*CLASSIFICATION OF LAST SYMBOL*) VAL: VALU; (*VALUE OF LAS~T CONSTANT*) LGTH: INTEGER; (*LENGTH OF LAST STRING CONSTANT*) ID: ALPHA; (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*) KK: 1..8; (*NR OF CHARS IN LAST IDENTIFIER*) CH: CHAR;  (*LAST CHARACTER*) EOL: BOOLEAN; (*END OF LINE FLAG*) (*COUNTERS:*) (***********) CHCNT: INTEGER; (*CHARACTER COUNTER*) LC,zIC: ADDRRANGE; (*DATA LOCATION AND INSTRUCTION COUNTER*) LINECOUNT: INTEGER; (*SWITCHES:*) (***********) DP, (*DECLARATION PART*) e PRTERR, (*TO ALLOW FORWARD REFERENCES IN POINTER TYPE DECLARATION BY SUPPRESSING ERROR MESSAGE*) LIST,PRCODE,PRTABLES: BOOLEAN; (*OUTPUT OPTIONS FOR -- SOURCE PROGRAM LISTING -- PRINTING SYMBOLIC CODE -- DISPLAYING IDENT AND STRUCT TABLES --> PROCEDURE OPTION*) DEBUG: BOOLEAN;  (*POINTERS:*)  (***********) PARMPTR, INTPTR,REALPTR,CHARPTR, BOOLPTR,NILPTR,TEXTPTR: STP; (*POINTERS TO ENTRIES OF STANDARD IDS*) UTYPPTR,UCSTPTR,UVARPTR, UFLDPTR,UPRC?PTR,UFCTPTR, (*POINTERS TO ENTRIES FOR UNDECLARED IDS*) FWPTR: CTP; (*HEAD OF CHAIN OF FORW DECL TYPE IDS*) FEXTFILEP: EXTFILEP; (*HEAD OF CHAIN OF EXTERNAL FILES*) GLOBTESTP: TESTP; (*LAST T+aESTPOINTER*)  (*BOOKKEEPING OF DECLARATION LEVELS:*) (************************************) LEVEL: LEVRANGE; (*CURRENT STATIC LEVEL*) DISX,  (*LEVEL OF LAST ID SEARCHED BY SEARCHID*) TOP: DISPRANGE; (*TOP OF DISPLAY*) DISPLAY: (*WHERE: MEANS:*) ARRAY [DISPRANGE] OF PACKED RECORD (*=BLCK: ID IS VARIABLE ID*)  FNAME: CTP; FLABEL: LBP; (*=CREC: ID IS FIELD ID IN RECORD WITH*) CASE OCCUR: WHERE OF (* CONSTANT ADDRESS*) CREC: (CLEV: LEVRANGE; (*=VREC: ID IS FIELD ID IN RECORD WITH*) CDSPL: ADDRRANG!E);(* VARIABLE ADDRESS*) VREC: (VDSPL: ADDRRANGE) END; (* --> PROCEDURE WITHSTATEMENT*) (*ERROR MESSAGES:*) (*****************) * ERRINX: 0..10; (*NR OF ERRORS IN CURRENT SOURCE LINE*) ERRLIST: ARRAY [1..10] OF (*BIT MAP OF COMPILE-TIME ERRORS*) PACKED RECORD POS: INTEGER; NMR: 1..400 END; sc (*FILE USE TO PASS BIT MAP TO THE ERROR*) (*SUMMARY GENERATOR PROGRAM*) ERRORS : ARRAY [0..MAXERRSET] OF SET OF 0..MAXERRBIT; ERRFLAG : BOOLEAN;  (*EXPRESSION COMPILATION:*) (*************************) GATTR: ATTR; (*DESCRIBES THE EXPR CURRENTLY COMPILED*) (*STRUCTURED CONSTANTS:*) )~ (***********************) CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS, STATBEGSYS,TYPEDELS: SETOFSYS; CHARTP : ARRAY[CHAR] OF CHTP; RW: ARRAY [1..37(*NR. OF RES. WORDS*)] OF ALPHA; FRW: ARRAY "[1..9] OF 1..38(*NR. OF RES. WORDS + 1*); RSY: ARRAY [1..37(*NR. OF RES. WORDS*)] OF SYMBOL; SSY: ARRAY [CHAR] OF SYMBOL; ROP: ARRAY [1..37(*NR. OF RES. WORDS*)] OF OPERATOR; SOP: ARRAY [CHAR] OF OPERATOR; NA: ARRAY [1..41] OF ALPHA; ' MN: ARRAY[0..62] OF PACKED ARRAY[1..4] OF CHAR; SNA: ARRAY [1..31] OF PACKED ARRAY [1..4] OF CHAR; CDX: ARRAY[0..62] OF -4..+4; PDX: ARRAY[1..31] OF -7..+7; ORDINT: ARRAY[CHAR] OF INTEGER; INTLABEL,MXINT10,DIGMAX: INTEGER; (*-----a--------------------------------------------------------------------*) PROCEDURE ENDOFLINE; VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER; BEGIN IF ERRINX > 0 THEN (*OUTPUT ERROR MESSAGES*) BEGIN WRITE(OUTPUT,' **** ':15); LlASTPOS := 0; FREEPOS := 1; FOR K := 1 TO ERRINX DO BEGIN WITH ERRLIST[K] DO BEGIN CURRPOS := POS; CURRNMR := NMR END; IF CURRPOS = LASTPOS THEN WRITE(OUTPUT,',')  ELSE BEGIN V WHILE FREEPOS < CURRPOS DO BEGIN WRITE(OUTPUT,' '); FREEPOS := FREEPOS + 1 END; WRITE(OUTPUT,'^'); LASTPOS := CURRPOS END; IF CURRNMR < 10 THEN F := 1 EL@-SE IF CURRNMR < 100 THEN F := 2 ELSE F := 3; WRITE(OUTPUT,CURRNMR:F); FREEPOS := FREEPOS + F + 1 END; WRITELN(OUTPUT); ERRINX := 0 END; IF LIST AND (NOT EOF(INPUT)) THEN BEGIN LINECOUNPT := LINECOUNT + 1; WRITE(OUTPUT,LINECOUNT:6,' ':2); IF DP THEN WRITE(OUTPUT,LC:7) ELSE WRITE(OUTPUT,IC:7); WRITE(OUTPUT,' ') END; CHCNT := 0 END (*ENDOFLINE*) ; PROCEDURE ERROR(FERRNR: INTEGER); VAR I : 0..MAXERRSET;  BEGIN I := FERRNR DIV MAXERRMOD; ERRORS[I] := [FERRNR MOD MAXERRMOD] + ERRORS[I]; ERRFLAG := TRUE; IF ERRINX >= 9 THEN BEGIN ERRLIST[10].NMR := 255; ERRINX := 10; ERRORS[4] := ERRORS[4] + [15] END ELSE BEGI@N ERRINX := ERRINX + 1; ERRLIST[ERRINX].NMR := FERRNR END; ERRLIST[ERRINX].POS := CHCNT END (*ERROR*) ; PROCEDURE ERRORREPORT; VAR P4ERRORS : FILE OF SET OF 0..MAXERRBIT; I : 0..MAXERRSET; BEGIN FOR I := 0 TO MAXERRSET DO BEGIN P4ERRORS^ := ERRORS[I]; PUT(P4ERRORS) END END (*ERROR REPORT*); PROCEDURE INSYMBOL; (*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGъTH*) LABEL 1,2,3; VAR I,K: INTEGER; DIGIT: PACKED ARRAY [1..STRGLGTH] OF CHAR; STRING: PACKED ARRAY [1..STRGLGTH] OF CHAR; LVP: CSP;TEST: BOOLEAN; PROCEDURE NEXTCH; BEGIN IF EOL THEN BEGIN IF LIST THEN WRITELNhG(OUTPUT); ENDOFLINE END; IF NOT EOF(INPUT) THEN BEGIN EOL := EOLN(INPUT); READ(INPUT,CH); IF LIST THEN WRITE(OUTPUT,CH); CHCNT := CHCNT + 1  END ELSE BEGIN WRITELN(OUTPUT,' *** EOF ','ENCOUNTERED'); ) TEST := FALSE END END; PROCEDURE OPTIONS; BEGIN REPEAT NEXTCH; IF CH <> '*' THEN BEGIN IF CH = 'T' THEN BEGIN NEXTCH; PRTABLES := CH = '+' END ELSE IF CH = 'L' THEN BEGIN NEXTCH; LIST := CH = '+'; IF NOT LIST THEN WRITELN(OUTPUT) END ELSE IF CH = 'D' THEN BEGIN NEXTCH; DEBUG := CH = '+' END ELSE & IF CH = 'C' THEN BEGIN NEXTCH; PRCODE := CH = '+' END; NEXTCH END UNTIL CH <> ',' END (*OPTIONS*) ; BEGIN (*INSYMBOL*) 1: REPEAT WHILE (CH = ' ') AND NOT EOL DO NEXTCH; TEST := E OL; IF TEST THEN NEXTCH UNTIL NOT TEST; IF CHARTP[CH] = ILLEGAL THEN BEGIN SY := OTHERSY; OP := NOOP; ERROR(399); NEXTCH END ELSE CASE CH OF 'A','B','C','D','E','F','G','H','I', 'J','K','L','M','N','O','P','Q','R', 'S','T','U','V','W','X','Y','Z': BEGIN K := 0; REPEAT IF K < 8 THEN BEGIN K := K + 1; ID[K] := CH END ; NEXTCH UNTIL CHARTP[CH] IN [SPECIAL,ILLEGAL]; IF K >= KK FTHEN KK := K ELSE REPEAT ID[KK] := ' '; KK := KK - 1 UNTIL KK = K; FOR I := FRW[K] TO FRW[K+1] - 1 DO IF RW[I] = ID THEN BEGIN SY := RSY[I]; OP := ROP[I]; GOTO 2 END; SY := IDENT; OP := NOOP; 2: END; '0','1','2','3','4','5','6','7','8','9': BEGIN OP := NOOP; I := 0; REPEAT I := I+1; IF I<= DIGMAX THEN DIGIT[I] := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER; IF (CH = '.') OR (CH = 'E')[ THEN BEGIN K := I; IF CH = '.' THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH; IF CH = '.' THEN BEGIN CH := ':'; GOTO 3 END; I#F CHARTP[CH] <> NUMBER THEN ERROR(201) ELSE REPEAT K := K + 1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER END;  IF CH = 'E' THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;  NEXTCH; IF (CH = '+') OR (CH ='-') THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH END; IF CHARTP[CH] <> NUMBER THEN ERROR(201) ELSE REPEAT K := K+1; IF K <= DIGMAX THEN DIGIT[K]9 := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER END;  NEW(LVP,REEL); SY:= REALCONST; LVP^.CCLASS := REEL; WITH LVP^ DO BEGIN FOR I := 1 TO STRGLGTH DO RVAL[I] .:= ' '; IF K <= DIGMAX THEN FOR I := 2 TO K + 1 DO RVAL[I] := DIGIT[I-1] ELSE BEGIN ERROR(203); RVAL[2] := '0'; RVAL[3] := '.'; RVAL[4] := '0'  END END; VAL.VALP := LVP END ELSE 3: BEGIN IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END ELSE WITH VAL DO  BEGIN IVAL := 0; FOR K := 1 TO I DO BEGIN IF IVAL <= MXINT10 THEN IVAL := IVAL*10+ORDINT[DIGIT[K]] ELSE BEGIN ERROR(203); IVAL := 0 uEND END; SY := INTCONST END END END; '''': BEGIN LGTH := 0; SY := STRINGCONST; OP := NOOP; REPEAT REPEAT NEXTCH; LGTH := LGTH + 1;  IF LGTH <= STRGLGTH THEN STRING[LGTH] := CH UNTIL (EOL) OR (CH = ''''); IF EOL THEN ERROR(202) ELSE NEXTCH UNTIL CH <> ''''; LGTH := LGTH - 1; (*NOW LGTH = NR OF CHARS IN STRING*) IF LGTH = v1 THEN VAL.IVAL := ORD(STRING[1]) ELSE BEGIN NEW(LVP,STRG); LVP^.CCLASS:=STRG; IF LGTH > STRGLGTH THEN BEGIN ERROR(399); LGTH := STRGLGTH END; WITH LVP^ DO BEGIN SLGTH := LGTFH; FOR I := 1 TO LGTH DO SVAL[I] := STRING[I] END; VAL.VALP := LVP END END; ':': BEGIN OP := NOOP; NEXTCH; IF CH = '=' THEN BEGIN SY := BECOMES; NEXTCH ,END ELSE SY := COLON END; '.':  BEGIN OP := NOOP; NEXTCH; IF CH = '.' THEN BEGIN SY := COLON; NEXTCH END ELSE SY := PERIOD END; '<': BEGIN NEXTCH; SY := RELOP; IdF CH = '=' THEN BEGIN OP := LEOP; NEXTCH END ELSE IF CH = '>' THEN BEGIN OP := NEOP; NEXTCH END ELSE OP := LTOP END; '>': BEGIN NEXTCH; SY := RELOP; IF CH = '=' THEZ4N BEGIN OP := GEOP; NEXTCH END  ELSE OP := GTOP END; '(': BEGIN NEXTCH; IF CH = '*' THEN BEGIN NEXTCH; IF CH = '$' THEN OPTIONS; REPEAT WHILE CH <> '*' pDDO NEXTCH; NEXTCH UNTIL CH = ')'; NEXTCH; GOTO 1 END; SY := LPARENT; OP := NOOP END; '*','+','-', '=','/',')', '[',']',',',';','^','$': BEGIN SY := SSY[CH]; OP :=( SOP[CH]; NEXTCH END; ' ': SY := OTHERSY END (*CASE*) END (*INSYMBOL*) ; PROCEDURE ENTERID(FCP: CTP); (*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE, WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS AN UNBALANCED BINARY TREE*) VAR NAM: ALPHA; LCP, LCP1: CTP; LLEFT: BOOLEAN; BEGIN NAM := FCP^.NAME; LCP := DISPLAY[TOP].FNAME; IF LCP = NIL THEN DISPLAY[TOP].FNAME := FCP ELSE BEGIN REPEAT LCP1 := LCP; IF LCP^.NAME = UNAM THEN (*NAME CONFLICT, FOLLOW RIGHT LINK*) BEGIN ERROR(101); LCP := LCP^.RLINK; LLEFT := FALSE END ELSE IF LCP^.NAME < NAM THEN BEGIN LCP := LCP^.RLINK; LLEFT := FALSE END ELSE BEGIN LCP := LCP^.LLINK; LLEFT := TRUE END UNTIL LCP = NIL; IF LLEFT THEN LCP1^.LLINK := FCP ELSE LCP1^.RLINK := FCP END; FCP^.LLINK := NIL; FCP^.RLINK := NIL END (*ENTERID*) ; PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP); (*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S --> PROCEDURE PROCEDUREDECLARATION --> PROCEDURE SELECTOR*) LABEL 1; BEGIN WHILE FCP <> NIL DO IF FCP^.NAME = ID THEN GOTO 1 ELSE IF FCP^.NAME < ID THEN FCP := FCP^.RLINK C ELSE FCP := FCP^.LLINK; 1: FCP1 := FCP END (*SEARCHSECTION*) ; PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); LABEL 1; VAR LCP: CTP; BEGIN FOR DISX := TOP DOWNTO 0 DO BEGIN LCP := DISPLAY[DISX].FNAME; WHILE LCP <> NIL DO IF LCP^.NAME = ID THEN IF LCP^.KLASS IN FIDCLS THEN GOTO 1 ELSE BEGIN IF PRTERR THEN ERROR(103); LCP := LCP^.RLINK END ELSE IF LCP^.NAME < ID TH.EN LCP := LCP^.RLINK ELSE LCP := LCP^.LLINK END; (*SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION --> PROCEDURE SIMPLETYPE*) IF PRTERR THEN 06 BEGIN ERROR(104); (*TO AVOID RETURNING NIL, REFERENCE AN ENTRY FOR AN UNDECLARED ID OF APPROPRIATE CLASS --> PROCEDURE ENTERUNDECL*) IF TYPES IN FIDCLS THEN LCP := UTYPPTR ELSE IF VARS IN FIDCLS THEN6 LCP := UVARPTR ELSE IF FIELD IN FIDCLS THEN LCP := UFLDPTR ELSE IF KONST IN FIDCLS THEN LCP := UCSTPTR ELSE IF PROC IN FIDCLS THEN LCP := UPRCPTR  ELSE LCP := UFC6TPTR; END; 1: FCP := LCP END (*SEARCHID*) ; PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER); (*GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE*) (*ASSUME FSP<>INTPTR AND FSP<>REALPTR*) BEGIN FMIN := 0; FMAX := 0; IF FSP <>R NIL THEN WITH FSP^ DO IF FORM = SUBRANGE THEN BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END ELSE IF FSP = CHARPTR THEN BEGIN FMIN := ORDMINCHAR; FMAX := ORDMAXCHAR END ELSE IF FCONST <> NIL THEN FMAX := FCONST^.VALUES.IVAL END (*GETBOUNDS*) ; FUNCTION ALIGNQUOT(FSP: STP): INTEGER; BEGIN ALIGNQUOT := 1; IF FSP <> NIL THEN WITH FSP^ DO CASE FORM OF SCALAR: IF FSP=INTPTR THEN A;,LIGNQUOT := INTAL ELSE IF FSP=BOOLPTR THEN ALIGNQUOT := BOOLAL ELSE IF SCALKIND=DECLARED THEN ALIGNQUOT := INTAL ELSE IF FSP=CHARPTR THEN ALIGNQUOT := CHARAL ELSE IF FSP=REALPTYR THEN ALIGNQUOT := REALAL ELSE (*PARMPTR*) ALIGNQUOT := PARMAL; SUBRANGE: ALIGNQUOT := ALIGNQUOT(RANGETYPE); POINTER: ALIGNQUOT := ADRAL; POWER: ALIGNQUOT := SETAL; FILES: ALIGNQUOT := FIL|FEAL; ARRAYS: ALIGNQUOT := ALIGNQUOT(AELTYPE); RECORDS: ALIGNQUOT := RECAL; VARIANT,TAGFLD: ERROR(501) END END (*ALIGNQUOT*); PROCEDURE ALIGN(FSP: STP; VAR FLC: INTEGER); VAR K,L: INTEGER; BEGIN K := ALIGNQUOT(FSP); L := FLC-1; FLC := L + K - (K + L) MOD K (*CORRECTION TO ALIGN (K + L) AS MOD ONLY TRUE FOR +VE INTS*) END (*ALIGN*); PROCEDURE GENLABEL(VAR NXTLAB: INTEGER); BEGIN INTLABEL := INTLABEL + 1; NXTLAB := INTLABEL ENDV (*GENLABEL*); PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP; NOTEXTDEC,EXTN : BOOLEAN); VAR LSY: SYMBOL; TEST: BOOLEAN; PLOCFP,FLOCFP,LOCFP : EXTFILEP; RANDOMFLAG : BOOLEAN; PARMSUM,PARMNO : INTEGER; PROCEDURE SKIP(FSYS: SFlETOFSYS); (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*) BEGIN IF NOT EOF(INPUT) THEN BEGIN WHILE NOT(SY IN FSYS) AND (NOT EOF(INPUT)) DO INSYMBOL; IF NOT (SY IN FSYS) THEN INSYMBOL END END (*SKIP*) ; PBROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU); VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG); LVP: CSP; I: 2..STRGLGTH; BEGIN LSP := NIL; FVALU.IVAL := 0; IF NOT(SY IN CONSTBEGSYS) THEN BEGIN ERROR(50); SUKIP(FSYS+CONSTBEGSYS) END; IF SY IN CONSTBEGSYS THEN BEGIN IF SY = STRINGCONSTSY THEN BEGIN IF LGTH = 1 THEN LSP := CHARPTR ELSE BEGIN NEW(LSP,ARRAYS); E WITH LSP^ DO BEGIN AELTYPE := CHARPTR; INXTYPE := NIL; SIZE := LGTH*CHARSIZE; FORM := ARRAYS  END END; FVALU := VAL; INSYMBOL END ELSE BEGIN SIGN := NONE; IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG; INSYMBOL END; IF SY = IDENT7) THEN BEGIN SEARCHID([KONST],LCP); WITH LCP^ DO BEGIN LSP := IDTYPE; FVALU := VALUES END;  IF SIGN <> NONE THEN IF LSP = INTPTR THEN BEGIN IF SgGIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END ELSE IF LSP = REALPTR THEN BEGIN IF SIGN = NEG THEN BEGIN NEW(LVP,REEL); m IF FVALU.VALP^.RVAL[1] = ' ' THEN LVP^.RVAL[1] := '+' ELSE LVP^.RVAL[1] := '-'; FOR I := 2 TO STRGLGTH DO LVP^.RVAL[I] :k= FVALU.VALP^.RVAL[I]; FVALU.VALP := LVP; END END ELSE ERROR(105); INSYMBOL; END ELSE  IF SY = INTCONST THEN BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL; LSP := INTPTR; FVALU := VAL; INSYMBOL END ELSE IF SY = REALCONST THEN BEGI?N IF SIGN = NEG THEN VAL.VALP^.RVAL[1] := '-'; LSP := REALPTR; FVALU := VAL; INSYMBOL END ELSE BEGIN ERROR(106); SKIP(FSYS) END END; IF NOT (SY IN FSYS) TBHEN BEGIN ERROR(6); SKIP(FSYS) END END; FSP := LSP END (*CONSTANT*) ; FUNCTION EQUALBOUNDS(FSP1,FSP2: STP): BOOLEAN; VAR LMIN1,LMIN2,LMAX1,LMAX2: INTEGER; BEGIN IF (FSP1=NIL) OR (FSP2=NIL) THEN EQUALBOUN2DS := TRUE ELSE BEGIN GETBOUNDS(FSP1,LMIN1,LMAX1); GETBOUNDS(FSP1,LMIN2,LMAX2); EQUALBOUNDS := (LMIN1=LMIN2) AND (LMAX1=LMAX2) END END (*EQUALBOUNDS*) ; FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLErAN; (*DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE*) VAR NXT1,NXT2: CTP; COMP: BOOLEAN; LTESTP1,LTESTP2 : TESTP; BEGIN IF FSP1 = FSP2 THEN COMPTYPES := TRUE ELSE IF (FSP1 <> NIL) AND (FSP2K <> NIL) THEN IF FSP1^.FORM = FSP2^.FORM THEN CASE FSP1^.FORM OF SCALAR: COMPTYPES := FALSE; (* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE NOT RECOGNIZED TO BE COM^PATIBLE*) SUBRANGE: COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2^.RANGETYPE); POINTER: BEGIN COMP := FALSE; LTESTP1 := GLOBTESTP; LTESTP2 := GLOBTESTP;  WHILE LTESTP1 <> NIL DO WITH LTESTP1^ DO BEGIN IF (ELT1 = FSP1^.ELTYPE) AND (ELT2 = FSP2^.ELTYPE) THEN COMP := TRUE; Z LTESTP1 := LASTTESTP END; IF NOT COMP THEN BEGIN NEW(LTESTP1); WITH LTESTP1^ DO BEGIN ELT1 := FSP1^.ELTYPE; ELT2 := FSP2^.ELTYPE; LASTTESTP := GLOBTESTP END; GLOBTESTP := LTESTP1; COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE) END;  COMPTYPES := COMP; GLOBTESTP := LTESTP2 END; POWER: COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET); ARRAYS: BEGIN COMP := COMPTYPES(FSP1^.AELTYPE,FSP`2^.AELTYPE) AND COMPTYPES(FSP1^.INXTYPE,FSP2^.INXTYPE); COMPTYPES := COMP AND EQUALBOUNDS(FSP1^.INXTYPE,FSP2^.INXTYPE) END; RECORDS: BEGIN NXT1 := FS|=P1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP:=TRUE;  WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) DO BEGIN COMP:=COMP AND COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE); NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT  END; COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL) AND(FSP1^.RECVAR = NIL)AND(FSP2^.RECVAR = NIL) END; (*IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE  c IFF NO VARIANTS OCCUR*)  FILES: COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE) END (*CASE*) ELSE (*FSP1^.FORM <> FSP2^.FORM*) IF FSP1^.FORM = SUBRANGE THEN COMPTYPzES := COMPTYPES(FSP1^.RANGETYPE,FSP2) ELSE IF FSP2^.FORM = SUBRANGE THEN COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE) ELSE COMPTYPES := FALSE ELSE COMPTYPES := TRUE END (*COMPTYPES*) ; F FUNCTION STRING(FSP: STP) : BOOLEAN; BEGIN STRING := FALSE; IF FSP <> NIL THEN IF FSP^.FORM = ARRAYS THEN IF COMPTYPES(FSP^.AELTYPE,CHARPTR) THEN STRING := TRUE END (*STRING*) ; PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: gSTP; VAR FSIZE: ADDRRANGE); VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP; LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER; PROCEDURE SIMPLETYPE(FSYS:SETOFSYS; VAR FSP:STP; VAR FSIZE:ADDRRANGE); VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE; LCNT: INTEGER; LVALU: VALU; BEGIN FSIZE := 1; IF NOT (SY IN SIMPTYPEBEGSYS) THEN BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END; IF SY IN SIMPTYPEBEGSYS THEN BEGIN IF SY = LPARENT THEN BEGIN TTOP := TOP; (*DECL. CONSTS LOCAL TO INNERMOST BLOCK*) WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1; NEW(LSP,SCALAR,DECLARED); WITH LSP^ DO BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := DECLARED END; LCP1 := NIL; LCNT := 0; REPEAT INSYMBOL; IF SY = IDENT THEN BEGIN NEW(LCP,KONST); H WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1; VALUES.IVAL := LCNT; KLASS := KONST END; ENTERID(LCP); LCNT : = LCNT + 1; LCP1 := LCP; INSYMBOL END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END 0 UNTIL SY <> COMMA; LSP^.FCONST := LCP1; TOP := TTOP; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE BEGIN IF SY = IDENT THEN BEGIN SEARCHID([TYPES,KONST],LCP); INSYMBOL; IF LCP^.KLASS = KONST THEN BEGIN NEW(LSP,SUBRANGE); WITH LSP^, LCP^ DO BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE;!% IF STRING(RANGETYPE) THEN BEGIN ERROR(148); RANGETYPE := NIL END; MIN := VALUES; SIZE := INTSIZE END;  IF SY = COLON THEN INSYMBOL ELSE ERROR(5); CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107) END ELSE H BEGIN LSP := LCP^.IDTYPE; IF LSP <> NIL THEN FSIZE := LSP^.SIZE END END (*SY = IDENT*) ELSE BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE; m CONSTANT(FSYS + [COLON],LSP1,LVALU); IF STRING(LSP1) THEN BEGIN ERROR(148); LSP1 := NIL END; WITH LSP^ DO BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE END;  IF SY = COLON THEN INSYMBOL ELSE ERROR(5); CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)  END; IF LSP <> NIL THEN WITH LSP^ DO IF FORM = SUBRANGE THEN IF RANGETYPE <> NIL THEN IF RANGETYPE = REALPTR THEN ERROR(399) ELSE IF MIN.IVAL > MAX.IVAL THEN ERROR(102) END; FSP := LSP; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL  END (*SIMPLETYPE*) ; PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP); VAR LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP; MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU; BEGIN NXT1 := NIL; LSP := NIL; IF NOT (SY IN (FSYS+[IDENT,CASESY])) THEN BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END; WHILE SY = IDENT DO BEGIN NXT := NXT1; REPEAT IF SY = IDENT THEN BEGIN NEW(LCP,FIELD); WITH LCP^ DO BEGIN NAME :=d ID; IDTYPE := NIL; NEXT := NXT; KLASS := FIELD END; NXT := LCP; ENTERID(LCP); INSYMBOL END ELSE ERROR(2); IF NOT (SiY IN [COMMA,COLON]) THEN BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMGBOL ELSE ERROR(5); TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE); WHILE NXT <> NXT1 DO WITH NXT^ DO BEGIN ALIGN(LSP,DISPL); P4COMPILE2.NNm IDTYPE := LSP; FLDADDR := DISPL; NXT := NEXT; DISPL := DISPL + LSIZE END; NXT1 := LCP; IF SY = SEMICOLON THEN BEGIN INSYMBOL;  IF NOT (SY IN [IDENT,CAS#ESY]) THEN BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END END END (*WHILE*); NXT := NIL; WHILE NXT1 <> NIL DO WITH NXT1^ DO BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 п:= LCP END; IF SY = CASESY THEN BEGIN NEW(LSP,TAGFLD); WITH LSP^ DO BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM:=TAGFLD END; FRECVAR := LSP; INSYMBOL; IF SY = IDENT THEN  BEGIN NEW(LCP,FIELD); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS:=FIELD; NEXT := NIL; FLDADDR := DISPL END; ENTERID(LCP); INSYMBOL; A IF SY = COLON THEN INSYMBOL ELSE ERROR(5); IF SY = IDENT THEN BEGIN SEARCHID([TYPES],LCP1); LSP1 := LCP1^.IDTYPE;  IF LSP1 <> NIL THEN BEGIN ALIGN(LPCP^.IDTYPE,DISPL); LCP^.FLDADDR := DISPL; DISPL := DISPL+LSP1^.SIZE; IF (LSP1^.FORM <= SUBRANGE) OR STRING(LSP1) THEN BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ER ROR(109) ELSE IF STRING(LSP1) THEN ERROR(399); LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP; END  ELSE ERROR(110); END;  INSYMBOL; END ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END END ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END; LSP^.SIZE := DISPL; IF SY = OFSY THEN INDSYMBOL ELSE ERROR(8); LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL; REPEAT LSP2 := NIL; IF NOT (SY IN [SEMICOLON,ENDSY]) THEN  BEGIN REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALUq); IF LSP^.TAGFIELDP <> NIL THEN IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3)THEN ERROR(111); NEW(LSP3,VARIANT); WITH LSP3^ DO BEGIN NXTVAR := LSP1; SUBVAR := LSP2; VARVAL 9:= LVALU; FORM := VARIANT END; LSP4 := LSP1; WHILE LSP4 <> NIL DO WITH LSP4^ DO BEGIN IF VARVAL.IVAL = LVALU.IVAL THEN ERROR(178); LSP4 := NXTVAR END; LSP1 := LSP3; LSP2 := LSP3; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOKL ELSE ERROR(5); IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9); FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2); IF DISPL > MAXSIZE THEN MAXSIZE := DISPL; WHILE LSP3 <> NIL DO BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2; LSP3^.SIZE := DISPL; LSP3 := LSP4 END; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [SEMICOLON]) THEN  BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END END ELSE ERROR(4); END;  TEST := SY <> SEMICOLON; IF NOT TEST THEN BEGIN DISPL := MINSIZE;  INSYMBOL END UNTIL TEST; DISPL := MAXSIZE; LSP^.FSTVAR := LSP1; END ELSE FRECVAR := NIL END (*FIELDLIST*) ; BEGIN (*TYP*) IF NOT (SY IN TYPEBEGSYS) THEN BEGI#N ERROR(10); SKIP(FSYS + TYPEBEGSYS) END; IF SY IN TYPEBEGSYS THEN BEGIN IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE) ELSE (*^*) IF SY = ARROW THEN BEGIN NEW(LSP,POINTER); FSP := LSP; d WITH LSP^ DO BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM:=POINTER END; INSYMBOL; IF SY = IDENT THEN BEGIN PRTERR := FALSE; (*NO ERROR IF SEARCH NOT SUCCESSFUL*)   SEARCHID([TYPES],LCP); PRTERR := TRUE; IF LCP = NIL THEN (*FORWARD REFERENCED TYPE ID*)  BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP;  NEXT := FWPTR; KLASS := TYPES END; FWPTR := LCP END ELSE BEGIN IF LCP^.IDTYPE <> NIL THEN a IF LCP^.IDTYPE^.FORM = FILES THEN ERROR(108) ELSE LSP^.ELTYPE := LCP^.IDTYPE END; INSYMBOL; END ELSE ERROR(2); END E ELSE BEGIN IF SY = PACKEDSY THEN BEGIN INSYMBOL; IF NOT (SY IN TYPEDELS) THEN BEGIN ERROR(10); SKIP(FSYS + TYPEDELS) ׆ END END; (*ARRAY*) IF SY = ARRAYSY THEN BEGIN INSYMBOL; IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11); LSP1 := NIL; REPEAT NEW(LSP,ARRAYS); 2{ WITH LSP^ DO BEGIN AELTYPE := LSP1; INXTYPE := NIL; FORM:=ARRAYS END; LSP1 := LSP; SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2,LSIZE); LSP1^.SIZE := LSIbZE; IF LSP2 <> NIL THEN IF LSP2^.FORM <= SUBRANGE THEN BEGIN IF LSP2 = REALPTR THEN BEGIN ERROR(109); LSP2 := NIL END p ELSE IF LSP2 = INTPTR THEN BEGIN ERROR(149); LSP2 := NIL END; LSP^.INXTYPE := LSP2 END ELSE BEGI4N ERROR(113); LSP2 := NIL END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12); IF SY = OFSY THENf INSYMBOL ELSE ERROR(8); TYP(FSYS,LSP,LSIZE); REPEAT WITH LSP1^ DO BEGIN LSP2 := AELTYPE; AELTYPE := LSP; IF INXTYPE <> NIL THEN < BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);  IF AELTYPE = CHARPTR THEN LSIZE := CHARSIZE ELSE ALIGN(LSP,LSIZE); LSIZE := LSIZE*(LMAX - LMIN + 1); A SIZE := LSIZE END END; LSP := LSP1; LSP1 := LSP2 UNTIL LSP1 = NIL END ELSE (*RECORD*) IF SY = RECORDSY THEN BEGIN INSYMBOL;  OLDTOP := TOP; IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := REC END END ELSE ERROR(250); DISPL := 0;  FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1); NEW(LSP,RECORDS); WITH LSP^ DO BEGIN FSTFLD := DISPLAY[TOP].FNAME; RECVAR := LSP1; SIZE := DISPL; FORM := RECORDS 0( END; TOP := OLDTOP; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END ELSE (*SET*) IF SY = SETSY THEN BEGIN INSYMBOL; M  IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); SIMPLETYPE(FSYS,LSP1,LSIZE); IF LSP1 <> NIL THEN IF LSP1^.FORM > SUBRANGE THEN BEGIN ERROR(115); LSP1 := NIL END ELSE IF LSP1 = REALPTR THEN ERROR(114); NEW(LSP,POWER); WITH LSP^ DO BEGIN ELSET:=LSP1; SIZE:=SETSIZE; FORM:=POWER END; END ELSE BEGIN IF SY = RANDOMSY THEN BEGIN INSYMBOL; RANDOMFLAG := TRUE END ELSE RANDOMFLAG := FALSE; (*FILE*) IF SY = FILESY THEN BEGIN INSYMBOL; IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); IF SY<> FILESY THEN TYP(FSYS,LSP1,LSIZE) (t ELSE BEGIN ERROR(121); SKIP(FSYS+TYPEBEGSYS) END; NEW(LSP,FILES); WITH LSP^ DO BEGIN FILTYPE:=LSP1; FORM:=FILES; SIZE := LSIZE; RANDOMFILE := RANDOMFLAG END END; END; FSP := LSP END; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL; ; IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP^.SIZE END (*TYP*) ; PROCEDURE LABELDECLARATION; VAR LLP: LBP; REDEF: BOOLEAN; LBNAME: INTEGER; BEGIN REPEAT IF SY = INTCONST THEN WITH DISPLAY[TOP] DO BEGIN LLP := FLABEL; REDEF := FALSE; WHILE (LLP <> NIL) AND NOT REDEF DO IF LLP^.LABVAL <> VAL.IVAL THEN LLP := LLP^.NEXTLAB ELSE BEGIN REDEF := TRUE; ERROR(166) END;  IF NOT REDEF THEN BEGIN NEW(LLP); WITH LLP^ DO BEGIN LABVAL := VAL.IVAL; GENLABEL(LBNAME); DEFINED := FALSE; NEXTLAB := FLABEL; LABNAME := LBNAME END; FLABEL := LLP END; INSYMBOL END ELSE ERROR(15); IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END; TEST := SY <> COMMA; IF NOT TE,ST THEN INSYMBOL UNTIL TEST; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) END (* LABELDECLARATION *) ; PROCEDURE CONSTDECLARATION; VAR LCP: CTP; LSP: STP; LVALU: VALU; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2);N) SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,KONST); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS:=KONST END; INSYMBOL;  IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBO}L ELSE ERROR(16); CONSTANT(FSYS + [SEMICOLON],LSP,LVALU); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN 7 BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) END END (*CONSTDECLARATION*) ; PROCEDURE TYPEDECLARATION; VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END; INSYMBOL; IF (SY = RELOP) AND (OPͫ = EQOP) THEN INSYMBOL ELSE ERROR(16); TYP(FSYS + [SEMICOLON],LSP,LSIZE); ENTERID(LCP); LCP^.IDTYPE := LSP; (*HAS ANY FORWARD REFERENCE BEEN SATISFIED:*) LCP1 := FWPTR; WHILE LCP1 <> NIL DO } BEGIN IF LCP1^.NAME = LCP^.NAME THEN BEGIN LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE; IF LCP1 <> FWPTR THEN LCP2^.NEXT := LCP1^.NEXT ELSE FWPTR := LCP1^.NEXT; / END; LCP2 := LCP1; LCP1 := LCP1^.NEXT END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) END; IF FWPTR <> NIL THEN BEGIN ERROR(117); WRITELN(OUTPUT); REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME); FWPTR := FWPTR^.NEXT UNTIL FWPTR = NIL; IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16) END END (*TYPEDECLARATION*) ; PROCEDURE VARDECLARATION; VAR LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN NXT := NIL; REPEAT REPEAT IF SY = IDENT THEN BEGIN NEW(LCPA,VARS); WITH LCP^ DO BEGIN NAME := ID; NEXT := NXT; KLASS := VARS; IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL END; ENTERID(LCP); NXT := LCP; INSYMBOLAL; END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL N UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE); IF LSP^.FORM = FILES THEN (*MACHINE DEPENDENT*) IF LSIZE > 510 THEN ERROR(399) ELSE IF LSP^.RANDOMFILE THEN BEGIN IF LSIZE > 126 THEN LSIZE := 512 ELSE LSIZE := 128  END; WHILE NXT <> NIL DO WITH NXT^ DO BEGIN ALIGN(LSP,LC); IF LS?P^.FORM = FILES THEN BEGIN LC := LC+4; (*SPACE FOR FLAGS*) LOCFP := FEXTFILEP; TEST := TRUE; WHILE ((LOCFP <> NIL) AND TEST) DO IF LOCFP^.FILENAME = NXT^.NAME THEN TEST :=z FALSE ELSE LOCFP := LOCFP^.NEXTFILE; IF LOCFP <> NIL THEN (*DEAL WITH EXTERNAL FILES*) LOCFP^.FTYPE := NXT ELSE (* IT WAS AN INTERNAL FILE*) BEGIN NEW(PLOCFP); WITH PLOCFP^ DO BEGIN FILENAME := NXT^.NAME; NEXTFILE := FLOCFP; FTYPE := N XT; END; FLOCFP := PLOCFP END;  END; IDTYPE := LSP; VADDR := LC; LC := LC + LSIZE; NXT := NEXT END; IF SY = SEMICOLON4 THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS); IF FWPTR <> NIL THEN  BEGIN ERROR(117); WRITELN(OUTPUT); REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME);  FWPTR := FWPTR^.NEXT UNTIL FWPTR = NIL; IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16) END END (*VARDECLARATION*) ;  PROCEDURE PROCDECLARATION(FSY: SYMBOL); VAR OLDLEV: 0..MAXLEVEL; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP; FORW: BOOLEAN; OLDTOP: DISPRANGE; PARCNT: INTEGER; LLC,LCM: ADDRRANGE; LBNAME: INTEGER; MARKP: ^INTEGER; PROCEDURE PARAlMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP); VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND; LLC: ADDRRANGE; COUNT,LSIZE: INTEGER; BEGIN LCP1 := NIL; IF NOT (SY IN FSY + [LPARENT]) THEN BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END; IF SY = LPARENT THEN BEGIN IF FORW THEN ERROR(119); INSYMBOL; IF NOT (SY IN [IDENT,VARSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END; WHIL*TE SY IN [IDENT,VARSY,PROCSY,FUNCSY] DO BEGIN IF SY = PROCSY THEN BEGIN ERROR(399); REPEAT INSYMBOL; IF SY = IDENT THEN BEGIN NEW(LCP,PROC,DECLARrED,FORMAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP1; PFLEV := LEVEL (*BEWARE OF PARAMETER PROCEDURES*); KLASS:=PROC;PFDECKIND:=DECLARED;PFKIND:=FORMAL END;  ENTERID(LCP); LCP1 := LCP; ALIGN(PARMPTR,LC); (*LC := LC + SOME SIZE *) X INSYMBOL END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])END UpWNTIL SY <> COMMA END  ELSE BEGIN IF SY = FUNCSY THEN BEGIN ERROR(399); LCP2 := NIL; REPEAT INSYMBOL; IF SY = IDEN'wT THEN BEGIN NEW(LCP,FUNC,DECLARED,FORMAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2; PFLEV := LEVEL (*BEWARE PARAM FUNCS*);  KLASS:=FUNC;PFDECKIND:=DECLARED; PFKIND:=FORMAL END; ENTERID(LCP); LCP2 := LCP; . ALIGN(PARMPTR,LC); (*LC := LC + SOME SIZE*) INSYMBOL; END; IF NOT (SY IN [COMMA,COLON] + FSYS) THEN  BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT]) END UNTIL SY <> COMMA; IF SY = COLON THEN BEGIN INSYMBOL; IF SY = IjDENT THEN BEGIN SEARCHID([TYPES],LCP); LSP := LCP^.IDTYPE; IF LSP <> NIL THEN IF NOT(LSP^.FORM IN[SCALAR,SUBRANGE,POINTER]) H  THEN BEGIN ERROR(120); LSP := NIL END; LCP3 := LCP2; WHILE LCP2 <> NIL DO BEGIN LCP2^.IDTYPE := LSP; LCP := LCP2;  LCP2 := LCP2^.NEXT END; LCP^.NEXT := LCP1; LCP1 := LCP3; INSYMBOL END ELSE ER\ROR(2); IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END END ELSE ERROR(5) END IA ELSE BEGIN IF SY = VARSY THEN BEGIN LKIND := FORMAL; INSYMBOL END ELSE LKIND := ACTUAL; LCP2 := NIL;  N COUNT := 0; REPEAT IF SY = IDENT THEN BEGIN NEW(LCP,VARS); WITH LCP^ DO BEGIN NAME:=ID; IDTYPE:=NIL; KLASS:v=VARS; VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL; END; ENTERID(LCP); LCP2 := LCP; COUNT := COUNT+1;   > INSYMBOL; END; IF NOT (SY IN [COMMA,COLON] + FSYS) THEN BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN BEGIN INSYMBOL; IF SY = IDENT THEN  BEGIN SEARCHID([TYPES],LCP); LSP := LCP^.IDTYPE; LSIZE := PTRSIZE; IF LSP <> NIL THEN IF LKIND=ACTUAL THEN  IF LSP^.FORM<=POWER THEN LSIZE := LSP^.SIZE ELSE IF LSP^.FORM=FILES THEN ERROR(121); ALIGN(PARMPTR,LSIZE);  LCP3 := LCP2; 1 ALIGN(PARMPTR,LC); LC := LC+COUNT*LSIZE; LLC := LC; WHILE LCP2 <> NIL DO BEGIN LCP := LCP2;  WITH LCP2^ DO BEGIN IDTYPE := LSP; LLC := LLC-LSIZE; VADDR := LLC; END; A/ LCP2 := LCP2^.NEXT END; LCP^.NEXT := LCP1; LCP1 := LCP3; INSYMBOL END  ELSE ERROR(2); IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END  END ELSE ERROR(5);  END; END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT,VARSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT])END Q END END (*WHILE*) ; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSY + FSYS) THEN BEGIN ERROR(6); SKIP(FSY + FSYS) END END ELSE ERROR(4Y); LCP3 := NIL; (*REVERSE POINTERS AND RESERVE LOCAL CELLS FOR COPIES OF MULTIPLE VALUES*) WHILE LCP1 <> NIL DO WITH LCP1^ DO BEGIN LCP2 := NEXT; NEXT := LCP3;  ~ IF KLASS = VARS THEN IF IDTYPE <> NIL THEN IF (VKIND=ACTUAL)AND(IDTYPE^.FORM>POWER) THEN BEGIN ALIGN(IDTYPE,LC); VADDR := LC; LC := LC+IDETYPE^.SIZE; END; LCP3 := LCP1; LCP1 := LCP2 END; FPAR := LCP3 END ELSE FPAR := NIL END (*PARAMETERLIST*) ; BEGIN (*PROCDECLARATION*) LLC := LC; LC :=V LCAFTERMARKSTACK; FORW := FALSE; IF SY = IDENT THEN BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP); (*DECIDE WHETHER FORW.*) IF LCP <> NIL THEN BEGIN IF LCP^.KLASS = PROC THEN FORW := LCP^.FORWDECL AND(FSY = PROCSY)AND(LCP^.PFKIND = ACTUAL) ELSE IF LCP^.KLASS = FUNC THEN FORW:=LCP^.FORWDECL AND(FSY=FUNCSY)AND(LCP^.PFKIND=ACTUAL) ELSE FORW := FALSE; IF NOT FORW THEN ERROR(160) 3 END; IF NOT FORW THEN BEGIN IF FSY = PROCSY THEN NEW(LCP,PROC,DECLARED,ACTUAL) ELSE NEW(LCP,FUNC,DECLARED,ACTUAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; EXTDEC := FALSE; EXTERN := FALSE; PFLEV := LEVEL; GENLABEL(LBNAME); PFDECKIND := DECLARED; PFKIND := ACTUAL; PFNAME := LBNAME; IF FSY = PROCSY THEN KLASS := PROC ELSE KLASS := FUNC < END; ENTERID(LCP) END ELSE BEGIN LCP1 := LCP^.NEXT; WHILE LCP1 <> NIL DO BEGIN WITH LCP1^ DO IF KLASS = VARS THEN IF +IDTYPE <> NIL THEN BEGIN LCM := VADDR + IDTYPE^.SIZE; IF LCM > LC THEN LC := LCM END; LCP1 := LCP1^.NEXT END END; INSYMBOL A END ELSE BEGIN ERROR(2); LCP := UFCTPTR END; OLDLEV := LEVEL; OLDTOP := TOP; IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251); IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TO6P] DO BEGIN IF FORW THEN FNAME := LCP^.NEXT ELSE FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END END ELSE ERROR(250); IF FSY = PROCSY THEN BEGIN PARAMETERLIST([SEMICOLON],LCP1); IF NOT FORW THEN LCP^.NEXT := LCP1 END ELSE BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1); IF NOT FORW THEN LCP^.NEXT := LCP1; IF SY = COLON THEN BEGIN INSYMBOL; ۋ IF SY = IDENT THEN BEGIN IF FORW THEN ERROR(122); SEARCHID([TYPES],LCP1); LSP := LCP1^.IDTYPE; LCP^.IDTYPE := LSP; IF LSP <> NIL THEN IF haNOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN BEGIN ERROR(120); LCP^.IDTYPE := NIL END; INSYMBOL END ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END END ELSE [ IF NOT FORW THEN ERROR(123) END; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); IF SY = EXTRNSY THEN BEGIN WITH LCP^ DO BEGIN EXTDEC := TRUE; IF PRCODE THEN 7 BEGIN WRITELN(PRR); WRITELN(PRR,' .EXTN ?',NAME); WRITELN(PRR);  WRITELN(PRR,'L',' ',PFNAME:4,':','?':3,NAME); END; INSYMBOL; IF SY =SEMICOLON THEN INSYMBOL ELSE ERROR(14); END END ELSE IF SY = FORWARDSY THEN BEGIN IF FORW THEN ERROR(161) ELSE LCP^.FORWDECL := TRUE; INSYMBOL; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); IF NOT (SY IN FSYS) THEN  BEGIN ERROR(6); SKIP(FSYS) END END ELSE BEGIN LCP^.FORWDECL := FALSE; MARK(MARKP); REPEAT BLOCK(FSYS,SEMICOLON,LCP,TRUE,NOT(NOTEXTDEC)); IF SY = SEMICOLON THEN BEGIN INSYMBOL; I4F NOT (SY IN [BEGINSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE IF NOT ((SY =PERIOD) AND EXTN) THEN ERROR(14) UNTIL ((SY IN [BEGINSY,PROCSY,FUNCSY]) OR EOF(INPUT)) OR ((SY=PER1IOD) AND EXTN); RELEASE(MARKP); (* RETURN LOCAL ENTRIES ON RUNTIME HEAP *) END; LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC; END (*PROCDECLARATION*) ; PROCEDURE BODY(FSYS: SETOFSYS); CONST CSTOCCMAX=65; CIXMAX=1000;  TYPE OPRANGE = 0..63; VAR LLCP:CTP; SAVEID:ALPHA; CSTPTR: ARRAY [1..CSTOCCMAX] OF CSP; CSTPTRIX: 0..CSTOCCMAX; (*ALLOWS REFERENCING OF NONINTEGER CONSTANTS BY AN INDEX (INSTEAD OF A POINTER), WHICU}H CAN BE STORED IN THE P2-FIELD OF THE INSTRUCTION RECORD UNTIL WRITEOUT. --> PROCEDURE LOAD, PROCEDURE WRITEOUT*) I, ENTNAME, SEGSIZE: INTEGER; STACKTOP, TOPNEW, TOPMAX: INTEGER; LCMAX,LLC1: ADDRRANGE; LCP: CTP; LLP: LBP; PROCEDURE MES(I: INTEGER); BEGIN TOPNEW := TOPNEW + CDX[I]*MAXSTACK; IF TOPNEW > TOPMAX THEN TOPMAX := TOPNEW END; PROCEDURE PUTIC; BEGIN IF IC MOD 10 = 0 THEN WRITELN(PRR,'I',' ',IC:5) ExND; PROCEDURE GEN0(FOP: OPRANGE); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4) END; IC := IC + 1; MES(FOP) END (*GEN0*) ; PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER); VAR K: INTEGER; BEGIN; IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[FOP]:4); IF FOP = 30 THEN BEGIN WRITELN(PRR,SNA[FP2]:12); TOPNEW := TOPNEW + PDX[FP2]*MAXSTACK; IF TOPNEW > TOPMAX THEN TOPMAX := TOPNEW  END  ELSE BEGIN IF FOP = 38 THEN BEGIN WRITELN(PRR); WRITE(PRR,' .TXT ','"'); WITH CSTPTR[FP2]^ DO BEGIN FOR K := 1 TOC SLGTH DO WRITE(PRR,SVAL[K]:1); FOR K := SLGTH+1 TO STRGLGTH DO WRITE(PRR,' '); END; WRITELN(PRR,'"') END ELSE IF FOP = 42 THEN WRITELN(PRR,CHR(FP2)) =  ELSE WRITELN(PRR,FP2:12); MES(FOP) END END; IC := IC + 1 END (*GEN1*) ; PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER); VAR K,H,M : INTEGER; BEGIN IF PRCODE THEN BEGIN PUTIC; IF ((FOP=51) AND (FP1=5)) THEN BEGIN FOR K := 1 TO 4 DO BEGIN WRITE(PRR,' .SW',K:1,'=':2,' '); FOR H := 0 TO 15 DO   BEGIN M := (K-1)*16+H; WITH CSTPTR[FP2]^ DO IF M IN PVAL THEN WRITE(PRR,'1':1) ELSE WRITE(PRR,'0':1) / END; WRITELN(PRR) END END; WRITE(PRR,MN[FOP]:4); CASE FOP OF 45,50,54,56: WRITELN(PRR,' ',FP1:3,FP2:8);  47,48,49,52,53,55: BEGIN WRITE(PRR,CHR(FP1)); IF CHR(FP1) = 'M' THEN WRITE(PRR,FP2:11); WRITELN(PRR) END; 51: CASE FP1 OF 1: WRITELN(PRR,'I',' '>,FP2); 2: BEGIN WRITE(PRR,'R',' '); WITH CSTPTR[FP2]^ DO FOR K := 1 TO STRGLGTH DO WRITE(PRR,RVAL[K]); WRITELN(PRR) END;  3: WRITELN(PRR,'B',' ',FP2); 4: WRITELN(PRR,'N'); 6: WRITELN(PRR,'C','''':2,CHR(FP2),''''); 5: BEGIN WRITE(PRR,'(':2,' '); WRITE(PRR,'W1 W2 W3 W4'); WRITELN(PRR,')':2)  END END END; END; IC := IC + 1; MES(FOP) END (*GEN2*) ; PROCEDURE GENTYPINDICATOR(FSP: STP); BEGIN IF FSP<>NIL THEN WITH FSP^ DO CASE FORM OF -t SCALAR: IF FSP=INTPTR THEN WRITE(PRR,'I') ELSE IF FSP=BOOLPTR THEN WRITE(PRR,'B') ELSE IF FSP=CHARPTR THEN WRITE(PRR,'C') ELSE  IF SCALKIND = DECLARED THEN WRITE(PRR,'I') ELSE WRITE(PRR,'R'); SUBRANGE: GENTYPINDICATOR(RANGETYPE); POINTER: WRITE(PRR,'A');  POWER: WRITE(PRR,'S'); V] RECORDS,ARRAYS: WRITE(PRR,'M'); FILES,TAGFLD,VARIANT: ERROR(500) END END (*TYPINDICATOR*); PROCEDURE GEN0T(FOP: OPRANGE; FSP: STP); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[~;FOP]:4); GENTYPINDICATOR(FSP); WRITELN(PRR); END; IC := IC + 1; MES(FOP) END (*GEN0T*); PROCEDURE GEN1T(FOP: OPRANGE; FP2: INTEGER; FSP: STP);  BEGIN IF PRCODE THEN BEGIN PUTIC; [E WRITE(PRR,MN[FOP]:4); GENTYPINDICATOR(FSP); WRITELN(PRR,FP2:11) END; IC := IC + 1; MES(FOP) END (*GEN1T*); PROCEDURE GEN2T(FOP: OPRANGE; FP1,FP2: INTEGER; FSP: STP); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[FOP]: 4); GENTYPINDICATOR(FSP); WRITELN(PRR,FP1:3,FP2:8); END; IC := IC + 1; MES(FOP)  END (*GEN2T*); PROCEDURE LOAD; BEGIN WITHd GATTR DO IF TYPTR <> NIL THEN BEGIN CASE KIND OF CST: IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN IF TYPTR = BOOLPTR THEN GEN2(51(*LDC*),3,CVAL.IVAL) U ELSE IF TYPTR=CHARPTR THEN GEN2(51(*LDC*),6,CVAL.IVAL) ELSE GEN2(51(*LDC*),1,CVAL.IVAL) ELSE IF TYPTR = NILPTR THEN SGEN2(51(*LDC*),4,0) ELSE IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; CSTPTR[CSTPTRIEX] := CVAL.VALP; IF TYPTR = REALPTR THEN GEN2(51(*LDC*),2,CSTPTRIX) ELSE GEN2(51(*LDC*),5,CSTPTRIX) b END; VARBL: CASE ACCESS OF DRCT: IF VLEVEL<=1 THEN GEN1T(39(*LDO*),DPLMT,TYPTR) ELSE GEN2T(54(*LOD*),LEVEL-VLEVEL,DPLMT,TYPTR); G INDRCT: GEN1T(35(*IND*),IDPLMT,TYPTR); INXD: ERROR(400) END; EXPR:  END; KIND := EXPR END END (*LOAD*) ; PROCEDURE STORE(VAR FATR NIL THEN CASE ACCESS OF DRCT: IF VLEVEL <= 1 THEN GEN1T(43(*SRO*),DPLMT,TYPTR) ELSE GEN2T(56(*STR*),LEVEL-VLEVEL,DPLMT,TYPTR); ; INDRCT: IF IDPLMT <> 0 THEN ERROR(400) ELSE GEN0T(26(*STO*),TYPTR); INXD: ERROR(400) END  END (*STORE*) ; PROCEDURE LOADADDRESS; BEGIN WITH GATTR DO IF TYPTR <> NIL THEtN BEGIN CASE KIND OF CST: IF STRING(TYPTR) THEN IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; ' CSTPTR[CSTPTRIX] := CVAL.VALP; GEN1(38(*LCA*),CSTPTRIX)  END ELSE ERROR(400); VARBL: CASE ACCESS OF DRCT: IF VLEVELJ <= 1 THEN GEN1(37(*LAO*),DPLMT) ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT); INDRCT: IF IDPLMT <> 0 THEN GEN1T(34(*INC*),IDPLMT,NILPTR); INXDw: ERROR(400) END; EXPR: ERROR(400) END; KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0 END END (*LOADADDRESS*) ; PROCEDURE GENFJP(FADDR: INTEGER); BEGIN LOAD; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> BOOLPTR THEN ERROR(144); IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[33]:4,'L':7,' ',FADDR:4) END; IC := IC + 1; MES(33) END (*GENFJP*) ; PROCEDURE GENUJPXJP(FOP:v> OPRANGE; FP2: INTEGER); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR, MN[FOP]:4, 'L':7,' ',FP2:4) END; IC := IC + 1; MES(FOP) END (*GENUJPENT*); PROCEDURE GENCUPENT(FOP: OPRANGE; FP1,FP2: INTEGER); BEGIN rD IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4,FP1:4,'L':3,' ',FP2:4) END; IC := IC + 1; MES(FOP) END; PROCEDURE CHECKBNDS(FSP: STP); VAR LMIN,LMAX: INTEGER; BEGIN IF FS ?P <> NIL THEN IF FSP <> INTPTR THEN IF FSP <> REALPTR THEN  IF FSP^.FORM <= SUBRANGE THEN BEGIN GETBOUNDS(FSP,LMIN,LMAX); GEN2T(45(*CHK*),LMIN,LMAX,FSP) (END END (*CHECKBNDS*); PROCEDURE PUTLABEL(LABNAME: INTEGER); BEGIN IF PRCODE THEN WRITELN(PRR, 'L',' ', LABNAME:4,':') END (*PUTLABEL*); PROCEDURE OPENFILES(LOCFP : EXTFILEP); BEGIN WHILE LOCFP <> NIL DO ]0 WITH LOCFP^ DO BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[38]:4); WRITELN(PRR,' .TXT ','"',FILENAME,' ':8,'"'); IC := IC+1; MES(38) END; R2SMISC.SRU,P .TITL R2SMISC ; VARIOUS OTHER OPERATIONS FOR THE P-CODE INTERPRETER .ENT PIXA,PSTP,PHLT,PNON .ENT PORD,PORDA,PORDC,PCHR,PORDB,PORDI .ENT PSTOC,PINDC .EXTN MPY .EXTN PUNDF .EXTD LHBNP,RHBNP .NREL PINDC: POP1 1 ; B.AD FROM STACK ADDZR 1,2 ; UADD Q FIELD..SET CARRY LDA 1,0,2 ; GET HOLD OF BYTE PAIR LDA 0,RHBNP ; GET MASK MOV 0,0,SNC ; WHICH BYTE REQD ? MOVS 1,1 ; LEFT ANDS 1,0 ; MASK PUSH1 0 ; BYTE TO STACK NEXT PSTOC: POP1 1 ;CHAR FROM STACK LHB POP1 2 ; BYTE DESTINATION LDA 0,LHBNP ; GET MASK AND 0,1 MOVZR 2,2,SNC ; MAKE WD ADDRESS - WHICH HALF ? MOVS 0,0,SKP ; LH MOVS 1,1 ; RH LDA 3,0,2 ; GET EXISTING CONTENTS AND 0,3 ; REMOVE UNWANTED BYTE ADD 1,3 ; ADD IN NEW BYTE STA 3,0,2 NEXT PIXA: POP1 1 ;INDEXED ADDR"|ESS LTOP1 0 MPY STOP1 1 NEXT PSTP: .SYSTM ;SOFT HALT .RESET ; (RETURN TO CALLING PROGRAM) ERR.2 .SYSTM .RTN JMP . PHLT: POP1 2 ;HARD HALT .SYSTM .ERTN JMP . NEXT PCHR: POP1 0 LDA 1,RHB40 ADD 1,0 LDA 1,RHBNP ROT: ANDS 1,0 PUSH1 0 NEXT RHB40: 40 LHB40: 40B7 PORD: NEXT PORDA: LTOP1 0 MOVZR 0,0 STOP1 0 NEXT PORDB: LTOP1 0 SUB 1,1 ;CLEAR AC1 MOVR 0,0 ;B15 INTO CARRY MOVL 1,1 ;CARRY INTO AC1 STOP1 1 NEXT PORDI: NEXT PORDC: POP1 0 LDA 1,LHB40 SUB 1,0 LDA 1,LHBNP JM4-P ROT PNON: .PUND ;UNDEFINED INSTRUCTION .END R2SSYMBOLS.SR D~B .TITL R2SSYMBOLS .DUSR PC = 20 ;ADDRESS OF PCODE INSTRUCTION .DUSR IP = 40 .DUSR SP = 41 ;CURRENT TOP OF STACK .DUSR MP = 42 ;MARK POINTER .DUSR DSP = 43 ;DATA SEGMENT POINTER (STACK BASE) .DUSR HP = 44 ;HEAP POINTER .DUSR EP = 45 ;STuACK MAX .DUSR AI1 = 27 ;AUTO INC 1 .DUSR AI2 = 26 ;AUTO INC 2 .DUSR AD1 = 37 ;AUTO DEC 1 .DUSR AD2 = 36 ;AUTO DEC 2 .DUSR Z1 = 47 .DUSR Z2 = 46 .DUSR .ERR2 = 50 ;RETURN WITH RDOS ERROR  .DUSR .ERRP = 51 ;RETURN WITH PCODE ERROR .DUSR NEXT@ = JMP @IP ;OBEY NEXT PCODE INSTRUCTION .DUSR PUSH = ISZ SP .DUSR POP = DSZ SP .MACRO LTOP1 LDA ^1,@SP % .MACRO STOP1 STA ^1,@SP % .MACRO PUSH1 PUSH STOP1 ^1 % .MACRO POP1 LTOP1 ^1 POP % .MACRO .PUND JMP @.+1 PUNDF % .DUSR ERR.2 = JLSR @.ERR2 .DUSR ERR.P = JSR @.ERRP .DUSR ANS = 0 ;OFFSET FOR FUNCTION VALUE .DUSR SL = 2 ; STATIC LINK .DUSR DL = 3 ; DYNAMIC LINK .DUSR MTS = 4 ;MAX TOP OF STACK .DUSR RA = 5 ; RETURN ADDRESS .DUSR MSL = 6 ;MARK STACK LENGTH .DUSR FCH = -1 ;FILE CHANNEL OFFSET .DUSR FST = -2 ;FILE STATUS OFFSET ;INTERPRETER ERROR CODES .DUSR PEROP = 400 ; UNDEFINED OP. CODE OR S.P. CODE .DUSR PERSO = 401 ; STORE OVERFLOW .DUSR PERGE = 402 ; EOF SET FOR GET .DUSR PERRE = 403 ; REf AD ERROR .DUSR PERPE = 404 ; PUT ERROR .DUSR PERIW = 405 ;INTEGER FIELD WIDTH .DUSR PERFP = 406 ; OV UN FLAGS RFPI .DUSR PERTR = 407 ; TRUNCATE OV ERROR .DUSR PERCJ = 410 ;CASE ERROR .. UJC .DUSR PERRB = 411 ; ASCII BUFFERRING ERROR .DUSR PERX9hP = 412 ;ILLEGAL EXTERNAL PROCEDURE CALL .DUSR PERCK = 413 ; CHK ERROR .DUSR PERHO = 414 ; HEAP OVERFLOW .DUSR PERFW = 415 ; FIELD WIDTH ERROR .DUSR PERFI = 416 ;FPI ERROR .DUSR PERFO = 417 ;FPI I/O ERROR .END EXAMPLES.CMraROMAN,LIFE,GRAPH,PRIMES,RGCD^ P4COMPILE3.NN~s IF FTYPE <> NIL THEN WITH FTYPE^ DO BEGIN GEN2(51(*LDC*),1,IDTYPE^.SIZE-1); GEN2(50(*LDA*),LEVEL-VLEV,VADDR); GEN1(30(*CSP*),11(*OPN*)); ENDUT; LOCFP := NEXTFILE END; END; (* OF OPENFILES*) PROCEDURE CLOSEFILES(LOCFP: EXTFILEP); BEGIN WHILE LOCFP <> NIL DO WITH LOCFP^ DO BEGIN IF FTYPE <> NIL THEN  WITH FTYPE^ DO GEN2(50(*LDA*),LEVEL-VLEV,VADDR); GEN1(30(*CSP*),24(*CLS*));  LOCFP := NEXTFILE END END; (* OF CLOSEFILES*) PROCEDURE STATEMENT(FSYS: SETOFSYS); LABEL 1; VAR LCP: CTP; LLP: LBP; PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD; PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP); VAR LATTR: ATTR; LCP: CTP; LSIZE,LMIN,LMAX: INTEGER; BEGIN WITH FCP^, GATTR DO BEGIN TYPTR := IDTYPE; KIND := VARBL; CASE KLASS OF VARS:  IF VKIND = ACTUAL THEN BEGIN ACCESS := DRCT; VLEVEL := VLEV; DPLMT := VADDR END  ELSE BEGIN GEN2T(54(*LOD*),LEVEL-VLEV,VADDR,NILPTR); ACCESS := INDRCT; IDPLMT := 0 END; FIELD: WITH DISPLAY[DISX] DO IF OCCUR = CREC THEN mJ BEGIN ACCESS := DRCT; VLEVEL := CLEV;  DPLMT := CDSPL + FLDADDR END ELSE BEGIN IF LEVEL = 1 THEN GEN1T(39(*LOD*),VDSPL,NILPVTR) ELSE GEN2T(54(*LOD*),0,VDSPL,NILPTR); ACCESS := INDRCT; IDPLMT := FLDADDR END; FUNC: IF PFDECKIND = STANDARD THEN BEGIN ERROR(15D0); TYPTR := NIL END ELSE BEGIN  IF PFKIND = FORMAL THEN ERROR(151) ELSE IF (PFLEV+1<>LEVEL)OR(FPROCP<>FCP) THEN ERROR(177); BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1; DPLMT := 0 (*IMPL. RELAT. ADDR. OF FCT. RESULT*) END END END (*CASE*) END (*WITH*); IF NOT (SY IN SELECTSYSm + FSYS) THEN BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END; WHILE SY IN SELECTSYS DO BEGIN (*[*) IF SY = LBRACK THEN BEGIN REPEAT LATTR := GATTR; WITH LATTR DO IF TYPTR <> NIL THEN IF TYPTR^.FORM <> ARRAYS THEN BEGIN ERROR(138); TYPTR := NIL END; LOADADDRESS; INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK])M; LOAD;  IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM<>SCALAR THEN ERROR(113) ELSE IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),0GATTR.TYPTR); IF LATTR.TYPTR <> NIL THEN WITH LATTR.TYPTR^ DO BEGIN IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN BEGIN U IF INXTYPE <> NIL THEN  BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); IF DEBUG THEN GEN2T(45(*CHK*),LMIN,LMAX,INTPTR); IF LMIN>0 THEN GEN1T(31(*DEC*),LMIN,INTPTR) ELSE IF LMIN<0 THEN GEN1T(34(*INC*),-LMIN,INTPTR); (*OR SIMPLY GEN1(31,LMIN)*) END 3  END ELSE ERROR(139); WITH GATTR DO BEGIN TYPTR := AELTYPE; KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0  END; IF GATTR.TYPTR <> NIL THEN BEGIN LSIZE := GATTR.TYPTR^.SIZE; IF COMPTYPES(GATTR.TYPTR,CHARPTR) THEN LSIZE :=CHARSIZE   ELSE ALIGN(GATTR.TYPTR,LSIZE); GEN1(36(*IXA*),LSIZE) END END UNTIL SY <> COMMA; IF SY = RBRACK THEN INSYMBOL ELSE ERdROR(12) END (*IF SY = LBRACK*) ELSE (*.*) IF SY = PERIOD THEN BEGIN WITH GATTR DO BEGIN IF TYPTR <> NIL THEN  IF TYPTR^.FORM <> RECORDS THEN BEGIN ERROR(140); TYPTR := NIL END; INSYMBOL; IF SY = IDENT THEN BEGIN IF TYPTR <> NIL THE&N BEGIN SEARCHSECTION(TYPTR^.FSTFLD,LCP); IF LCP = NIL THEN BEGIN ERROR(152); TYPTR := NIL END ELSE   WITH LCP^ DO BEGIN TYPTR := IDTYPE; CASE ACCESS OF DRCT: DPLMT := DPLMT + FLDADDR; INDRCT: IDPLMT := IDPLMT + FLDADDR; INXD: ERROR(400) END END END; INSYMBOL o END (*SY = IDENT*) ELSE ERROR(2) END (*WITH GATTR*) END (*IF SY = PERIOD*) ELSE (*^*) BEGIN IF GATTR.TYPTR <> NIL THEN F WITH GATTR,TYPTR^ DO IF FORM = POINTER THEN BEGIN LOAD; TYPTR := ELTYPE; IF DEBUG THEN GEN2T(45(*CHK*),1,MAXADDR,NILPTR);  WITH GATTR DO  BEGIN KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0 END END ELSE IF FORM = FILES THEN TYPTR := FILTYPE ELSE ERROR(141); INSYMBOL END; IF NOT (SY IN FSYS + SELECTSYS) THEN BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END END (*WHILE*) END (*SELE'CTOR*) ; PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP); VAR LKEY: 1..15; PROCEDURE VARIABLE(FSYS: SETOFSYS); VAR LCP: CTP; BEGIN IF SY = IDENT THEN BEGIN SEARCHID([VARS,FIELD],LCP); IBNSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FSYS,LCP) END (*VARIABLE*) ; PROCEDURE GETPUTRESETREWRITE; BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS; IF GATTR.TYPTR <> NIL;~ THEN IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(116); IF LKEY <= 2 THEN GEN1(30(*CSP*),LKEY(*GET,PUT*)) ELSE GEN1(30(*CSP*),LKEY+26(*RESET,REWRITE*)) END (*GETPUTRESETREWRITE*) ; PROCEDURE FILEDEFAULTm(FNAME : ALPHA; ERRNO:INTEGER; VAR LLEV,LADDR:INTEGER); BEGIN SAVEID := ID; ID := FNAME; SEARCHID([VARS],LLCP); IF LLCP^.IDTYPE <> NIL THEN LADDR := LLCP^.VADDR ELSE BEGIN PERROR(ERRNO); LADDR := 0 END; LLEV := 1; ID := SAVEID END; PROCEDURE READ; VAR LCP:CTP; LLEV:LEVRANGE; LADDR:ADDRRANGE; LSP : STP; BEGIN IF SY = LPARENT THEN BEGDŽIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]); LSP := GATTR.TYPTR; TEST := FALSE; IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN WITH GATTR, LSP^ DO BEGIN c IF FILTYPE = CHARPTR THEN BEGIN LLEV := VLEVEL; LADDR := DPLMT; IF ACCESS = INDRCT THEN ERROR(399) END ELSE ERROR(399); IF DSY = RPARENT THEN BEGIN IF LKEY = 8 THEN ERROR(116); TEST := TRUE END ELSE  IF SY <> COMMA THEN BEGIN ERROR(116); SKIP(FSYSj + [COMMA,RPARENT]) END; IF SY = COMMA THEN BEGIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]) END ELSE TEST := TRUE END ELSE FILEDEFAULT(NA[3],175,LLEV,LADEDR); IF NOT TEST THEN REPEAT LOADADDRESS; GEN2(50(*LDA*),LEVEL-LLEV,LADDR); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= SUBRANGE THEN IF COMPTYPES(INTPTR,GATTR.TYPT0.R) THEN GEN1(30(*CSP*),3(*RDI*)) ELSE IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN GEN1(30(*CSP*),4(*RDR*)) ELSE IF COMPTYPES(CHARPTR,GATTR.WTYPTR) THEN GEN1(30(*CSP*),5(*RDC*)) ELSE ERROR(399) ELSE ERROR(116);  TEST := SY <> COMMA; IF NOT TEST THEN BEGIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]) END UNTIL TEST; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE IF LKEY = 5 THEN ERROR(116) ELSE FILEDEFAULT(NA[3],175,LLEV,LADDR); IF LKEY = 11 THEN BEGIN GEN2(50(*LDA*),LEVEL - LLEV, LADDR); GEN1(30(*CSP*),21(*RLN*)) END  END (*READ*) ; PROCEDURE WRITE; VAR LSP: STP; DEFAULT : BOOLEAN; LLKEY: 1..15; LCP:CTjP; LLEV:LEVRANGE; LADDR,LEN:ADDRRANGE; BEGIN LLKEY := LKEY; IF SY = LPARENT THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]); LSP := GATTR.TYPTR; TEST := FALSE; IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN WITH GATTR, LSP^ DO BEGIN  IF FILTYPE = CHARPTR THEN BEGIN LLEV := VLEVEL; LADDR := DPLMT;  IF ACCESS = INDRCT THEN ERROR(399) END ELSE ERROR(399); IF SY = RPARENT THEN BEGIN IF LLKEY = 10 THEN ERROR(116); TEST := TRUE h END ELSE IF SY <> COMMA THEN BEGIN ERROR(116); SKIP(FSYS+[COMMA,RPARENT]) END; IF SY = COMMA THEN BEGIN INSYMBOL; EXPRESSION(FSYS+[COMMA,COLON,RPARENT]) END ELSE TEST := TRUE END ELSE FILEDEFAULT(NA[4],176,LLEV,LADDR); IF NOT TEST THEN REPEAT LSP := GATTR.TYPTR; IF LSP <> NIL THEN &b IF LSP^.FORM <= SUBRANGE THEN LOAD ELSE LOADADDRESS; IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INHTPTR THEN ERROR(116); LOAD; DEFAULT := FALSE END ELSE DEFAULT := TRUE; IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> &NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(116);  IF LSP <> REALPTR THEN ERROR(124); LOAD; ERROR(399); END ELSE IF LSP = INTPTR THEN BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,10); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),6(*WRI*)) END ELSE IF LSP = REALPTR THEN BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,20); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),8(*WRR*)) END ELSE IF LSP = CHARPTR THEN BEGIN IF D#vEFAULT THEN GEN2(51(*LDC*),1,1); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),9(*WRC*)) END ELSE IF LSP <> NIL THEN KBEGIN IF LSP^.FORM = SCALAR THEN ERROR(399) ELSE IF STRING(LSP) THEN BEGIN LEN := LSP^.SIZE DIV CHARMAX; IF DEFAULT THEN GEN2(51(*LDC*),1,LEN); GEN2(51(*LDC*),1,LEN); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),10(*WRS*)) v END  ELSE ERROR(116) END; TEST := SY <> COMMA; IF NOT TEST THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]) END8 UNTIL TEST; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE IF LKEY = 6 THEN ERROR(116) ELSE FILEDEFAULT(NA[4],176,LLEV,LADDR); IF LLKEY = 12 THEN (*WRITELN*)  BEGIN GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),22(*WLN*)) END END (*WRITE*) ; PROCEDURE PACK; VAR LSP,LSP1: STP; BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT]); *R LSP := NIL; LSP1 := NIL; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN LSP := INXTYPE; LSP1 := AELTYPE END ELSE ERROR(116); IF SY e= COMMA THEN INSYMBOL ELSE ERROR(20); EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116) ELSE IF NOT COMPTYPES(LSP,GATTR.TYPTR) T˿HEN ERROR(116); IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); VARIABLE(FSYS + [RPARENT]); IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN V  IF NOT COMPTYPES(AELTYPE,LSP1) OR NOT COMPTYPES(INXTYPE,LSP) THEN ERROR(116) END ELSE ERROR(116) END (*PACK*) ; PROCEDURE UNPACK; VAR LSP,LSP1: STP; BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT]); LSP := NIL; LSP1 := NIL; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN LSP := INXTYPE; LSP1 := AELTYPE END ELSE ERROR(116); IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); VARIABLE(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN IF NOT COMPTYPES(AELTYPE,LSP1) OR NOT COMPTYPES(INXTYPE,LSP) THEN ERROR(116) END ELSE ERROR(116);  IFL SY = COMMA THEN INSYMBOL ELSE ERROR(20); EXPRESSION(FSYS + [RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116) ELSE IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEON ERROR(116); END (*UNPACK*) ; PROCEDURE NEW; LABEL 1; VAR LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER; LSIZE,LSZ: ADDRRANGE; LVAL: VALU; BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESSd; LSP := NIL; VARTS := 0; LSIZE := 0; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = POINTER THEN BEGIN IF ELTYPE <> NIL THEN BEGIN LSIZE := ELTYPE^.SIZE; IF ELTYPE^.FORM = RECORDS THEN LSP := ELTYPE^.RECVAR END END ELSE ERROR(116); WHILE SY = COMMA DO  BEGIN INSYMBOL;CONSTANT(FSYS + [COMMA,RPARENT],LSP1,LVAL); VARTS := VARTS + 1; (*CHECK TO INSERT HERE: IS CONSTANT IN TAGFIELDTYPE RANGE*) IF LSP = NIL THEN ERROR(158) ELSE IF LSP^.FORM <> TAGFLD THEN EۢRROR(162) ELSE IF LSP^.TAGFIELDP <> NIL THEN IF STRING(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159) ELSE IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1) THEN [ BEGIN LSP1 := LSP^.FSTVAR; WHILE LSP1 <> NIL DO WITH LSP1^ DO IF VARVAL.IVAL = LVAL.IVAL THEN KL BEGIN LSIZE := SIZE; LSP := SUBVAR; GOTO 1 END ELSE LSP1 := NXTVAR;  LSIZE := LSP^.SIZE; LSP := NIL; kO END ELSE ERROR(116); 1: END (*WHILE*) ; GEN2(51(*LDC*),1,LSIZE); GEN1(30(*CSP*),12(*NEW*)); END (*NEW*) ; PROCEDURE MARK; BEGIN VARIABLE(FSYS+[RPARENT]ǎ); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = POINTER THEN BEGIN LOADADDRESS; GEN1(30(*CSP*),23(*SAV*)) END ELSE ERROR(125) END(*MARK*); PROCEDURE RELEASE; BE$GIN VARIABLE(FSYS+[RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = POINTER THEN BEGIN LOAD; GEN1(30(*CSP*),13(*RST*)) END ELSE ERROR(125) END (*RELEASE*); $ PROCEDURE PUTGETRANDOM; VAR LLEV,LADDR : INTEGER; BEGIN VARIABLE(FSYS+[COMMA]); IF GATTR.TYPTR <> NIL THEN  WITH GATTR, GATTR.TYPTR^ DO IF FORM <> FILES THEN ERROR(1016) ELSE BEGIN LLEV := VLEVEL; LADDR := DPLMT; IF NOT RANDOMFILE THEN ERROR(116); IF ACCESS = INDRCT THEN ERROR(399); IF SY <> COMMA THEN ERROR(116) ELSE INSYMBOL; {e EXPRESSION(FSYS+[RPARENT]); LOAD; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(116);  GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),LKEY+11(*WDR,RRR*)q) END END (*OF PUTGETRANDOM*); PROCEDURE HALT; BEGIN EXPRESSION(FSYS+[RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN BEGIN LOAD; GEN0(62(*HLT*66)) END ELSE ERROR(116) END; (*OF HALT*) PROCEDURE ABS; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*)) ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END END (*ABS*) ; PROCEDURE SQR; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQIft*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*)) ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END END (*SQR*) ; PROCEDURE TRUNC; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> REALPTR THEN ERROR(125); IF LKEY=12 THEN GEN1(30(*CSP*),31(*RND*)) ELSE GEN0(27(*TRC*)); GATTR.TYPTR := INTPTR END (*TRUNC*) ; PROCEDURE ODD; BEGIN IF GATTR".TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(125); GEN0(20(*ODD*)); GATTR.TYPTR := BOOLPTR END (*ODD*) ; PROCEDURE ORD; BEGIN IF GATTR.TYPTR <> NIL THEN i: IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125); GEN0T(58(*ORD*),GATTR.TYPTR); GATTR.TYPTR := INTPTR END (*ORD*) ; PROCEDURE CHR; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(125); GEN0(59(*CHR*)); GATTR.TYPTR := CHARPTR END (*CHR*) ; PROCEDURE PREDSUCC; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN %ERROR(125); IF LKEY = 7 THEN GEN1T(31(*DEC*),1,GATTR.TYPTR) ELSE GEN1T(34(*INC*),1,GATTR.TYPTR) END (*PREDSUCC*) ; PROCEDURE EOF; VAR LLEV,LADDR : INTEGER; BEGIN IF SY = LPARENT THEN BEGIN INSYMBOL; VARIABLE(FSYS + [RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125) y ELSE IF (GATTR.TYPTR^.RANDOMFILE AND NOT (LKEY = 9)) THEN ERROR(116); LOADADDRESS END ELSE WITH GATTR DO BEGIN  IF LKEY = 9 THEN ERROR(116) ELSE FILEDEFAULT(NA[3],175,LLEV,LADDR); GEN2(50(*LDA*),LEVEL-LLEV,LADDR) END; IF LKEY = 9 THEN GEN1(30(*CSP*),28(*EOR*)) ELSE IF LKEY = 10 THEN GEN0(8(*EOF*)) ELSE GEN1(30(*CSP*),14(*ELN*)); GATTR.TYPTR := BOOLPTR END (*EOF*) ; PROCEDURE PAGE; VAR LLEV,LADDR : INTEGER; BEGIN IF SY = LPARENT THEN BEGIN  INSYMBOL; VARIABLE(FSYS+[RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = FILES THEN LOADADDRESS ELSE ERROR(116g) END ELSE BEGIN FILEDEFAULT(NA[4],176,LLEV,LADDR); GEN2(50(*LDA*),LEVEL-LLEV,LADDR) END; GEN1(30(*CSP*),27(*PAG*)) END (*PAGE*); PROCEDURE CALLNONSTA.VNDARD; VAR NXT,LCP: CTP; LSP: STP; LKIND: IDKIND; LB: BOOLEAN; LOCPAR, LLC: ADDRRANGE; BEGIN LOCPAR := 0; WITH FCP^ DO BEGIN NXT := NEXT; LKIND := PFKIND; IF NOT EXTERN THEN GEN1(41(*MST*),LEVEL-PFLEV) END; IF SY = LPARENT THEN BEGIN LLC := LC; REPEAT LB := FALSE; (*DECIDE WHETHER PROC/FUNC MUST BE PASSED*) IF LKIND = ACTUAL THEN BEGIN  IF NXT = NIL THEN ERROR(126)  ELSE LB := NXT^.KLASS IN [PROC,FUNC] END ELSE ERROR(399); (*FOR FORMAL PROC/FUNC LB IS FALSE AND EXPRESSION WILL BE CALLED, WHICH WILL ALLWAYS INTERPRET A PROC/FUNC ID AT ITS BEGINNING AS A CALL RATHER THAN A PARAMETER PASSING. IN THIS IMPLEMENTATION, PARAMETER PROCEDURES/FUNCTIONS ARE THEREFORE NOT ALLOWED TO HAVE PROCEDURE/F0UNCTION PARAMETERS*)  INSYMBOL; IF LB THEN (*PASS FUNCTION OR PROCEDURE*) BEGIN ERROR(399); IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FS=YS + [COMMA,RPARENT]) END ELSE BEGIN IF NXT^.KLASS = PROC THEN SEARCHID([PROC],LCP) ELSE BEGIN SEARCHID([FUNC],LCP);  IF NOT COMPTYPES(LCP^.IDTYPE,NXT^.IDTYPE) THEN ERROR(128) END; INSYMBOL; IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN xF BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END END END (*IF LB*) ELSE BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL; THEN  IF LKIND = ACTUAL THEN BEGIN IF NXT <> NIL THEN BEGIN LSP := NXT^.IDTYPE; IF LSP <> NIL THEN  BEGIN IF (NXT^.VKIND = ACTUAL) THEN IF LSP^.FORM <= POWER THEN BEGIN LOAD; IF DEBUG THEN CHECKBNDS(LSP); IF COMPTYPES(REALPTR,LSP) AND (GATTR.TYPTR = INTPTR) THEN BEGIN GEN0(10(*FLT*)); ̗ GATTR.TYPTR := REALPTR END; LOCPAR := LOCPAR+LSP^.SIZE; ALIGN(PARMPTR,LOCPAR); END 6E ELSE BEGIN LOADADDRESS; LOCPAR := LOCPAR+PTRSIZE; ALIGN(PARMP]#TR,LOCPAR) END ELSE IF GATTR.KIND = VARBL THEN BEGIN LOADADDRESS;  . LOCPAR := LOCPAR+PARMSIZE END ELSE ERROR(154); IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(142)  END END END ELSE (*LKIND = FORMAL*) BEGIN (*PASS FORMAL PARAM*) END  END;  IF (LKIND = ACTUAL) AND (NXT <> NIL) THEN NXT := NXT^.NEXT UNTIL SY <> COMMA; LC := LLC; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END (*IF LPARENT*); IF LKIND = ACTUAL THEN K BEGIN IF NXT <> NIL THEN ERROR(126); WITH FCP^ DO BEGIN IF EXTDEC THEN GENCUPENT(61(*CXP*),LOCPAR,PFNAME) ELSE IF EXTERN THEN GEN1(30(*CSP*),PFNAME) Ȗ ELSE GENCUPENT(46(*CUP*),LOCPAR,PFNAME); END END; GATTR.TYPTR := FCP^.IDTYPE END (*CALLNONSTANDARD*) ; BEGIN (*CALL*) IF FCP^.PFDECKIND = STANDARD THEN BEGIN LKEY := FCP^.KEY; IF FCP^.KLASS = PROC THEN BEGIN IF NOT(LKEY IN [5,6,11,12,16]) THEN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);  CASE LKEY OF 1,2, 2 3,4: GETPUTRESETREWRITE; 5,11: READ; 6,12: WRITE; 7: PACK; 8: UNPACK; 9: NEW; 10: RELEASE; 13: MARK; t 14,15: PUTGETRANDOM; 16: PAGE; 17: HALT END; IF NOT(LKEY IN [5,6,11,12,16]) THEN IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END { ELSE BEGIN IF (LKEY <= 8) OR (LKEY >= 12) THEN BEGIN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9); EXPRESSION(FSYS+[RPARENT]); LOAD  END; CASE LKEY OF 1: ABS; 2: SQR; 3,12: TRUNC; 4: ODD;  5: ORD; 6: CHR; 7,8i: PREDSUCC; 9,10,11 : EOF END; IF (LKEY <= 8) OR (LKEY >= 12) THEN IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END; END (*STANDARD PROCEDURES AND FUNCTIONS*) ELSE CALLNONSTANDARD END (*CALL*) ; PROCEDURE EXPRESSION; VAR LATTR: ATTR; LOP: OPERATOR; TYPIND: CHAR; LSIZE: ADDRRANGE; PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS); VAR LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN; PROCEDURE TERM(FSYS: SETOFSYS); VAR LATTR: ATTR; LOP: OPERATOR; PROCEDURE FACTOR(FSYS: SETOFSYS); VAR LCP: CTP; LVP: CSP; VARPART: BOOLEAN; CSTPARTR: SET OF 0..58; LSP: STP; BEGIN IF NOT (SY IN FACBEGSYS) THEN BEGIN ERROR(58); SKIP(FSYS + FACBEGSYS);  GATTR.TYPTR := NIL END; WHILE SY IN FACBEGSYS DO  BEGIN CASE SY OF (*ID*) IDENT: BEGIN SEARCHID([KONST,VARS,FIELD,FUNC],LCP); INSYMBOL; IF LCP^.KLASS = FUNC THEN d BEGIN CALL(FSYS,LCP); WITH GATTR DO BEGIN KIND := EXPR;  IF TYPTR <> NIL THEN IF TYPTR^.FORM=SUBRANGE THEN ; TYPTR := TYPTR^.RANGETYPE END END ELSE IF LCP^.KLASS = KONST THEN WITH GATTR, L CP^ DO BEGIN TYPTR := IDTYPE; KIND := CST; CVAL := VALUES  END ELSE BEGIN SELECTOR(FSYS,LCP); 27 IF GATTR.TYPTR<>NIL THEN(*ELIM.SUBR.TYPES TO*) WITH GATTR,TYPTR^ DO(*SIMPLIFY LATER TESTS*) IF FORM = SUBRANGE THEN TYPTR := RANGETYPE END END; (*CST*) INTCONST:  BEGIN WITH GATTR DO BEGIN TYPTR := INTPTR; KIND := CST;  CVAL := VAL END; INSYMBOL END; REALCONST: BEGIN WITH GATTR DO  BEGIN TYPTR := REALPTR; KIND := CST; CVAL := VAL END; INSYMBOL END; STRINGCONST: BEGIN  WITH GATTR DO BEGIN IF LGTH = 1 THEN TYPTR := CHARPTR ELSE BEGIN NEW(LSP,ARRAYS); WITH LSPd^ DO BEGIN AELTYPE := CHARPTR; FORM:=ARRAYS;  INXTYPE := NIL; SIZE := LGTH*CHARSIZE END; TYPTR := LSP Q END; KIND := CST; CVAL := VAL END; INSYMBOL END; (*(*) LPARENT: BEGIN INSYMBOL; EXPREkSSION(FSYS + [RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END; (*NOT*) NOTSY: BEGIN INSYMBOL; FACTOR(FSYS); LOAD; GEN0(19(*NOT*))a; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> BOOLPTR THEN BEGIN ERROR(135); GATTR.TYPTR := NIL END; END; (*[*) LBRACK:  BEGIN INSYMBOL; CSTPART := [ ]; VARPART := FALSE;  NEW(LSP,POWER); WITH LSP^ DO BEGIN ELSET:=NIL;SIZE:=SETSIZE;FORM:=POWER END; IF SY = εRBRACK THEN BEGIN WITH GATTR DO BEGIN TYPTR := LSP; KIND := CST END; INSYMBOL END ;ELSE BEGIN  REPEAT EXPRESSION(FSYS + [COMMA,RBRACK]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN  BEGIN ERROR(136); GATTR.TYPTR := NIL END ELSE IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN BEGIN  IF GATTR.KIND = CST THEN  IF (GATTR.CVAL.IVAL < SETLOW) OR (GATTR.CVAL.IVAL > SETHIGH) THEN ERROR(304) 8> ELSE CSTPART := CSTPART+[GATTR.CVAL.IVAL] ELSE BEGIN LOAD; IF cNOT COMPTYPES(GATTR.TYPTR,INTPTR)  THEN GEN0T(58(*ORD*),GATTR.TYPTR); GEN0(23(*SGS*)); IF VARPART THEN GEN0(28(*UNI*))  ELSE VARPART := TRUE END; LSP^.ELSET := GATTR.TYPTR; GATTR.TYPTR := LSP g END  ELSE ERROR(137); TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IFk SY = RBRACK THEN INSYMBOL ELSE ERROR(12) END; IF VARPART THEN BEGIN IF CSTPART <> [ ] THEN BEGIN NEW(LVP,PSET);: LVP^.PVAL := CSTPART; LVP^.CCLASS := PSET; IF CSTPTRIX = CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; CSTPTR[CSTPTRIX] := LVP; GEN2(51(*LDC*),5,CSTPTRIX); GEN0(28(*UNI*)); GATTR.KIND := EXPR END 9K  END END ELSE BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART; LVP^.CCLASS := PSET; GATTR.CVAL.VALP := LVP END END END (*CASE*) ; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END END (*WHILE*)  ˞ END (*FACTOR*) ; BEGIN (*TERM*) FACTOR(FSYS + [MULOP]); WHILE SY = MULOP DO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; FACTOR(FSYS + [MULOP]); LOAD;  IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (***) MUL: IF (LATTR.TYPTR=INTPTR)AND(GATTR.TYPTR=INTPTR) THEN GEN0(15(*MPI*))  ELSE  BEGIN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END 2 ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR  END; Z IF (LATTR.TYPTR = REALPTR) AND(GATTR.TYPTR=REALPTR)THEN GEN0(16(*MPR*)) ELSE IF(LATTR.TYPTR^.FORM=POWER) s AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)THEN GEN0(12(*INT*)) ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END END; (*/*) RDIV: BEGIN 8 IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF LATTR.TYPTR = INTP^TR THEN BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END; IF (LATTR.TYPTR = REALPTR) AND (GATTR.iTYPTR=REALPTR)THEN GEN0(7(*DVR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; (*DIV*) IDIV: IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END; (*MOD*) IMOD: IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) THEN GEN0(14(*MOD*)) pT ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END; (*AND*) ANDOP:IF (LATTR.TYPTR = BOOLPTR) AND (GATTR.TYPTR = BOOLPTR) THEN GEN0(4(*AND*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END.A END (*CASE*) ELSE GATTR.TYPTR := NIL END (*WHILE*) END (*TERM*) ; BEGIN (*SIMPLEEXPRESSION*)  SIGNED := FALSE; IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THErN BEGIN SIGNED := OP = MINUS; INSYMBOL END; TERM(FSYS + [ADDOP]); IF SIGNED THEN BEGIN LOAD; IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; WHILE SY = ADDOP DO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; TERM(FSYS + [ADDOP]); LOAD;i IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (*+*) PLUS: IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN GEN0(2(*ADI*))  T ELSE BEGIN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*));  LATTR.TYPTR := REALPTR END  ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN GEN0(3(*ADR*)) ELSE IF(LATTR.TYPTR^.FORM=POWER)  AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN GEN0t(28(*UNI*)) ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END END; (*-*) MINUS: IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN GEN0(21(*SAsBI*)) ELSE BEGIN IF LATTR.TYPTR = INTPTR THEN  BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR P4COMPILE4.NN END; IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN GEN0(22(*SBR*)) ELSE IF (LATTR.TYPTR^.FORM = POWER)  AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN GEN0(5(*DIF*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; (*OR*) OROP: S IF(LATTR.TYPTR=BOOLPTR)AND(GATTR.TYPTR=BOOLPTR)THEN GEN0(13(*IOR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END (*CASE*) ELSE GATTR.TYPTR := NIL R END (*WHILE*) END (*SIMPLEEXPRESSION*) ; BEGIN (*EXPRESSION*) SIMPLEEXPRESSION(FSYS + [RELOP]); IF SY = RELOP THEN BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= PiOWER THEN LOAD ELSE LOADADDRESS; LATTR := GATTR; LOP := OP; IF LOP = INOP THEN  IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),GATTR.TYPTR); INSYMBOL; SIMPLEEXPRESSION(FSYS); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= POWER THEN LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN IF LOP = INOP THEN Z IF GATTR.TYPTR^.FORM = POWER THEN IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET) THEN  GEN0(11(*INN*)) ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END ELSE BEGIN ERR OR(130); GATTR.TYPTR := NIL END ELSE BEGIN IF LATTR.TYPTR <> GATTR.TYPTR THEN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*)); LPATTR.TYPTR := REALPTR END ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR .END; IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LSIZE := LATTR.TYPTR^.SIZE; CASE LATTR.TYPTR^.FORM OF SCALAR: IF LATTR.TYPTR = REALPTR THEN TYPIND := 'R' ELSE IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 'B' ELSE IF LATTR.TYPTR = CHARPTR THEN TYPIND := 'C' 1 ELSE TYPIND := 'I'; POINTER: BEGIN IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 'A' Q END; POWER: BEGIN IF LOP IN [LTOP,GTOP] THEN ERROR(132); TYPIND := 'S' END; ARRAYS: BEGIN 8 IF NOT STRING(LATTR.TYPTR) AND(LOP IN[LTOP,LEOP,GTOP,GEOP])THEN ERROR(131); TYPIND := 'M' END; RECORDS:  BEGIN IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 'M' END; FILES: BEGIN ERROR(133); TYPIND := 'F' END END; CASE LOP OF LTOP: GEN2(53(*LES*),ORD(TYPIND),LSIZE); LEOP: GEN2(52(*LEQ*),ORD(TYPIND),LSIZE); GTOP: GE?wN2(49(*GRT*),ORD(TYPIND),LSIZE); GEOP: GEN2(48(*GEQ*),ORD(TYPIND),LSIZE); NEOP: GEN2(55(*NEQ*),ORD(TYPIND),LSIZE); EQOP: GEN2(47(*EQU*),ORD(TYPIND),LSIZE) e END END ELSE ERROR(129) END; GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR END (*SY = RELOP*) END (*EXPRESSION*) ; PROCEDURE ASSIGNMENT(FCP: CTP);  VAR LATTR: ATTR; BEGIN SELECTOR(FSYS + [BECOMES],FCP); IF SY = BECOMES THEN BEGIN IF GATTR.TYPTR <> NIL THEN IF (GATTR.ACCESS<>DRCT) OR (GATTR.TYPTR^.FORM>POWER) THEN LOADADDRE}SS; LATTR := GATTR; INSYMBOL; EXPRESSION(FSYS); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= POWER THEN LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.mTYPTR <> NIL) THEN BEGIN  IF COMPTYPES(REALPTR,LATTR.TYPTR)AND(GATTR.TYPTR=INTPTR)THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF CO3MPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN CASE LATTR.TYPTR^.FORM OF SCALAR, SUBRANGE: BEGIN IF DEBUG THEN CHECKBNDS(LATTR.TYPTR); ? STORE(LATTR)  END; POINTER: BEGIN IF DEBUG THEN GEN2T(45(*CHK*),0,MAXADDR,NILPTR); STORE(LATTR)  END; POWER: STORE(LATTR); ARRAYS, RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE); FILES: ERROR(146) END ELSE ERROR(129)  END END (*SY = BECOMES*) ELSE ERROR(51) END (*ASSIGNMENT*) ; PROCEDURE GOTOSTATEMENT; VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE; BEGIN IF SY = INTCOENST THEN BEGIN FOUND := FALSE; TTOP1 := TOP; WHILE DISPLAY[TTOP1].OCCUR <> BLCK DO TTOP1 := TTOP1 - 1; TTOP := TTOP1; REPEAT WHILE DISPLAY[TTOP].OCCUR <> BLCK DO KTTOP := TTOP - 1; LLP := DISPLAY[TTOP].FLABEL; WHILE (LLP <> NIL) AND NOT FOUND DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN FOUND := TRUE; w IF TTOP = TTOP1 THEN GENUJPXJP(57(*UJP*),LABNAME) ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(399) END ELSE LLP := NEXTLAB; TTOP := TTOP - 1   UNTIL FOUND OR (TTOP = 0); IF NOT FOUND THEN ERROR(167); INSYMBOL END ELSE ERROR(15) END (*GOTOSTATEMENT*) ; PROCEDURE COMPOUNDSTATEMENT; BEGIN REPEAT U REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)  END (*COMPOUNDSTATEMENET*) ; PROCEDURE IFSTATEMENT; VAR LCIX1,LCIX2: INTEGER; BEGIN EXPRESSION(FSYS + [THENSY]); GENLABEL(LCIX1); GENFJP(LCIX1); IF SY = THENSY THEN INSYMBOL ELSE ERROR(52); STATEMENT(FSYS + [ELSESY]); IF SY = ELSESY THEN BEGIN GENLABEL(LCIX2); GENUJPXJP(57(*UJP*),LCIX2); PUTLABEL(LCIX1); INSYMBOL; STATEMENT(FSYS); PUTLABEL(LCIX2) END ELSE PUTLABEL(LCIX1)  END (*IFSTATEMENT*) ; PROCEDURE CASESTATEMENT; LABEL 1; TYPE CIP = ^CASEINFO; CASEINFO = PACKED RECORD NEXT: CIP; CSSTART: INTEGER;  CSLAB: INTEGER END; VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU; LADDR, LCIX, LCIX1, LMIN, LMAX: INTEGER; BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]); LOAD; LSP o%:= GATTR.TYPTR; IF LSP <> NIL THEN IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN BEGIN ERROR(144); LSP := NIL END ELSE IF NOT COMPTYPES(LSP,INTPTR) THEN GEN0T(58(*ORD*),LSP); (*BUG CORRECTION fHBY A.F. ON 11/11/76*) GENLABEL(LCIX); GENUJPXJP(57(*UJP*),LCIX); IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); FSTPTR := NIL; GENLABEL(LADDR); REPEAT LPT3 := NIL; GENLABEL(LCIX1); IF NOT(SY IN [SEMICOLON,ENDSY]) THEN BEGIN REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL); IF LSP <> NIL THEN IF COMPTYPES(LSP,LSP1) THEN BEGIN LPT1 := FSTPTR; LPT2 := NIL; W 0HILE LPT1 <> NIL DO WITH LPT1^ DO BEGIN IF CSLAB <= LVAL.IVAL THEN BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156); GOTO 1 C END; LPT2 := LPT1; LPT1 := NEXT END; 1: NEW(LPT3); WITH LPT3^ DO BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL; 5 CSSTART := LCIX1 END; IF LPT2 = NIL THEN FSTPTR := LPT3 ELSE LPT2^.NEXT := LPT3 END ELSE ERROR(147); TEST := SY <> COMMA; IF NOT TREST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); PUTLABEL(LCIX1); REPEAT STATEMENT(FSYS + [SEMICOLON]) UNTIL NOT (SY IN STATBEGSYS); IF LPT3 <> NIL THEN .6 GENUJPXJP(57(*UJP*),LADDR); END; TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; PUTLABEL(LCIX); IF FSTPTR <> NIL THEN BEGIN LMAX := FSTPTR^.CSLAB;  (*REVERSE POINTERS*) LPT1 := FSTPTR; FSTPTR := NIL; REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR; FSTPTR := LPT1; LPT1 := LPT2 UNTIL LPT1 = NIL; LMIN := FSTPTR^.CSLAB; e} IF LMAX - LMIN < CIXMAX THEN BEGIN GEN2T(45(*CHK*),LMIN,LMAX,INTPTR); GEN2(51(*LDC*),1,LMIN); GEN0(21(*SBI*)); GENLABEL(LCIX); GENUJPXJP(44(*XJP*),LCIX); PUTLABEL(LCIX); n REPEAT WITH FSTPTR^ DO BEGIN WHILE CSLAB > LMIN DO BEGIN GEN0(60(*UJC ERROR*)); LMIN := LMIN+1 ENDG; GENUJPXJP(57(*UJP*),CSSTART); FSTPTR := NEXT; LMIN := LMIN + 1 END  UNTIL FSTPTR = NIL; PUTLABEL(LADDR) END ELSE ERROR(157) END; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END (*CASESTATEMENT*) ; PROCEDURE REPEATSTATEMENT; VAR LADDR: INTEGER; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR); REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]); IF SY IN STATBEGSYS THEN ERROR(14) UNTIL NOT(SY IN STATBEGSYS); WHILE SY = SEMICOLON DO BEGIN INSYMBOL; REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]); IF SY IN XSTATBEGSYS THEN ERROR(14) UNTIL NOT (SY IN STATBEGSYS); END; IF SY = UNTILSY THEN BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR) END ELSE ERROR(53) END (*REPEATSTATEMENT*) ; @e PROCEDURE WHILESTATEMENT; VAR LADDR, LCIX: INTEGER; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);  EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX); IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(^lFSYS); GENUJPXJP(57(*IJP*),LADDR); PUTLABEL(LCIX) END (*WHILESTATEMENT*) ; PROCEDURE FORSTATEMENT; VAR LATTR: ATTR; LSP: STP; LSY: SYMBOL; LCIX, LADDR: INTEGER; LLC: ADDRRANGE; BEGIN LLC := LC; WITH LATTR DO BEGIN TYPTR := NIL; KIND := VARBL; ACCESS := DRCT; VLEVEL := LEVEL; DPLMT := 0 END; IF SY = IDENT THEN BEGIN SEARCHID([VARS],LCP); WITH LCP^, LATTR DO v BEGIN TYPTR := IDTYPE; KIND := VARBL; IF VKIND = ACTUAL THEN BEGIN ACCESS := DRCT; VLEVEL := VLEV; DPLMT := VADDR END ELSE BEGIN ERROR(155); A TYPTR := NIL END END; IF LATTR.TYPTR <> NIL THEN IF (LATTR.TYPTR^.FORM > SUBRANGE) OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN BEGIN ERROR(143); LATTR.TYPTR := NIL END;  INSYMBOL END ELSE BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY]) END; IF SY = BECOMES THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [TOSY,DOWNTOSY,DOSY]); IF GATTR.TYPTR <> NIL \THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)  ELSE IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LOAD; STORE(LATTR) END ELSE ERROR(145) END ELSE BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END; IF SY IN [TOSY,DOWNTOSY] THEN BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]); IF GATTR.TYPTR <> NIL THEN IF GATTR.JmTYPTR^.FORM <> SCALAR THEN ERROR(144) ELSE  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LOAD; IF NOT COMPTYPES(LATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),[1GATTR.TYPTR); ALIGN(INTPTR,LC); GEN2T(56(*STR*),0,LC,INTPTR); GENLABEL(LADDR); PUTLABEL(LADDR); GATTR := LATTR; LOAD; IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),GATTR.TYPTR); GEN2T(54(*LOD*),0,LC,INTPTR); LC := LC + INTSIZE; IF LC > LCMAX THEN LCMAX := LC; IF LSY = TOSY THEN#' GEN2(52(*LEQ*),ORD('I'),1) ELSE GEN2(48(*GEQ*),ORD('I'),1); END ELSE ERROR(145) END ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END; GENLABEL(LCIX); GENUJPXJP(33(*FJP*),LCIX); IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(FSYS); GATTR := LATTR; LOAD; IF LSY=TOSY THEN GEN1T(34(*INC*),1,GATTR.TYPTR) ELSE GEN1T(31(*DEC*),1,GATTR.TYPTR); STORE(LATTR); GENUJPXJP(57(*UJP*),LADDR); PUTLABEL(LCIX); LC := LLC; END (*FORSTATEMENT*) ; PROCEDURE WITHSTATEMENT; VAR LCP: CTP; LCNT1: DISPRANGE; LLC: ADDRRANGE; BEGIN LCNT1 := 0; LLC := LC; REPEAT IF SY = IDENT THEN BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FSYS + [COMMA,DOSY],LCP); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = RECOűRDS THEN IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := GATTR.TYPTR^.FSTFLD; FLABEL := NIL S END;  IF GATTR.ACCESS = DRCT THEN WITH DISPLAY[TOP] DO BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL; CDSPL := GATTR.DPLMT END y~ ELSE BEGIN LOADADDRESS; ALIGN(NILPTR,LC); GEN2T(56(*STR*),0,LC,NILPTR); WITH DISPLAY[TOP] DO BEGIN OCCUR := VREC; VDSPL := LC END;  LC := LC+PTRSIZE; IF LC > LCMAX THEN LCMAX := LC END END ELSE ERROR(250) ELSE ERROR(140); TEST := SY <> COMMA;  IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(FSYS); TOP := TOP-LCNT1; LC := LLC; END (*WITHSTATEMENT*) ; BEGIN (*STATEMENT*) IF SY = INTCONST4 THEN (*LABEL*) BEGIN LLP := DISPLAY[TOP].FLABEL; WHILE LLP <> NIL DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN IF DEFINED THEN ERROR(165); PUTLABEL(LABNAME); DEFINED := TRUE; GOTO 1 END ELSE LLP := NEXTLAB; ERROR(167); 1: INSYMBOL; IF SY = COLON THEN INSYMBOL ELSE ERROR(5) END; IF NOT (SY IN FSYS + [IDENT]) THENi BEGIN ERROR(6); SKIP(FSYS) END; IF SY IN STATBEGSYS + [IDENT] THEN BEGIN CASE SY OF IDENT: BEGIN SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL; IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP) ELSE ASSIGNMENT(LCP) END; BEGINSY: BEGIN INSYMBOL; COMPOUNDSTATEMENT END; GOTOSY: BEGIN INSYMBOL; GOTOSTATEMENT END; IFSY: BEGIN INSYMBOL; IFSTATEMENT END; CASESY: BEGIN INSYMBOL; CASESTATEMENT END; WHILESY: BEGIN INSYMBOL; WHILESTATEMENT END; REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENT END; FORSY: BEGIN INSYMBOL; FORSTATEMENT END; C WITHSY: BEGIN INSYMBOL; WITHSTATEMENT END END; IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN BEGIN ERROR(6); SKIP(FSYS) END END END (*STATEMENT*) ; BEGIN (*BODY*) IF FPROCP e<> NIL THEN ENTNAME := FPROCP^.PFNAME ELSE GENLABEL(ENTNAME); IF PRCODE THEN BEGIN WRITELN(PRR); IF EXTN THEN WRITELN(PRR,' .ENT ?',FPROCP^.NAME) ELSE BEGIN WRITE(PRR,' .ENT L',ENTNAME:1,';':3); h IF FPROCP <> NIL THEN WRITE(PRR,FPROCP^.NAME:5) ELSE WRITE(PRR,'MAIN'); WRITELN(PRR) END; WRITELN(PRR) END; IF EXTN THEN WRITELN(PRR,'?',FPROCP^.NAME,':');  PARMSUM := 0; CSTPTRIX := 0; TOPNEW := LCAFTERMARKSTACK; TOPMAX := LCAFTERMARKSTACK; PUTLABEL(ENTNAME); GENLABEL(SEGSIZE); GENLABEL(STACKTOP); GENCUPENT(32(*ENT1*),1,SEGSIZE); GENCUPENT(32(*ENT2*),2,STACKTOP); IF FPROCP <> NIL ȡTHEN (*COPY MULTIPLE VALUES INTO LOACAL CELLS*) BEGIN LLC1 := LCAFTERMARKSTACK; LCP := FPROCP^.NEXT; IF EXTN THEN BEGIN GENLABEL(PARMNO); GENCUPENT(32(*ENT3*),3,PARMNO) END; WHILE LCP <> NIL DO WITH LCP^ DO BEGIN IF KLASS = VARS THEN IF IDTYPE <> NIL THEN IF (VKIND=ACTUAL) AND (IDTYPE^.FORM>POWER) THEN BEGIN GEN2(50(Q*LDA*),0,VADDR); GEN2T(54(*LOD*),0,LLC1,NILPTR); PARMSUM := PARMSUM + PTRSIZE; GEN1(40(*MOV*),IDTYPE^.SIZE);  LLC1 := LLC1 + PTRSIZE END  ELSE BEGIN IF VKIND = ACTUAL THEN BEGIN PARMSUM := PARMSUM + IDTYPE^.SIZE; LLC1 := LLC1 + IDTYPE^.SIZE END  ELSE BEGIN PARMSUM := PARMSUM + PTRSIZE; LLC1 := LLC1 + PTRSIZE END;  ALIGN(PARMPTR,LLC1); ALIGN(PARMPTR,PARMS\UM) END; LCP := LCP^.NEXT; END; END ELSE BEGIN SAVEID := ID; LOCFP := FEXTFILEP; WHILE LOCFP <> NIL DO BEGIN R WITH LOCFP^ DO BEGIN ID := FILENAME; SEARCHID([VARS],LLCP);  IF LLCP^.IDTYPE <> NIL THEN IF LLCP^.IDTYPEl^.FORM <> FILES THEN BEGIN WRITELN(OUTPUT); WRITELN(OUTPUT,' ':8,'UNDECLARED ', 'EXTERNAL ','FILE',ID:8); V WRITE (OUTPUT,' ':CHCNT+16); END END;  LOCFP := LOCFP^.NEXTFILE END; ID := SAVEID; [ OPENFILES(FEXTFILEP); END; OPENFILES(FLOCFP); LCMAX := LC; REPEAT REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13); LLP := DISPLAY[TOP].FLABEL; (*TEST FOR UNDEFINED LABELS*)  WHILE LLP <> NIL DO WITH LLP^ DO BEGIN IF NOT DEFINED THEN BEGIN ER<ROR(168); WRITELN(OUTPUT); WRITELN(OUTPUT,' LABEL ',LABVAL); WRITE(OUTPUT,' ':CHCNT+16) END; LLP := NEXTLAB END; CLOSEFILES(FLOCFP); IF FPROCP <> NIL THEN BEGIN m IF FPROCP^.IDTYPE = NIL THEN GEN1(42(*RET*),ORD('P')) ELSE GEN0T(42(*RET*),FPROCP^.IDTYPE); END ELSE BEGIN CLOSEFILES(FEXTFILEP); GEN1(42(*RET*),ORD('P')); END; ALIGN(PARMPTR,LCMAX); IF PRCODE THEN BEGIN WRITELN(PRR,'L',' ',SEGSIZE:4,'=',LCMAX:9); WRITELN(PRR,'L',' ',STACKTOP:4,'=',TOPMAX:9); END; IF (EXTN AND PRCODE) THEN WRITELN(PRR,'L',' ',PARMNO:4,'=',PARMSUM:9); IF F6PROCP = NIL THEN BEGIN IF PRCODE THEN WRITELN (PRR,'PCODE: '); IC := 0; (*GENERATE CALL OF MAIN PROGRAM; NOTE THAT THIS CALL MUST BE LOADED AT ABSOLUTE ADDRESS ZERO*) GEN1(41(*MST*),0); GENCUPENT(46(*CUPvT*),0,ENTNAME); GEN0(29(*STP*)); END; END (*BODY*) ; BEGIN (*BLOCK*) FLOCFP := NIL; DP := TRUE; REPEAT IF SY = LABELSY THEN IF NOTEXTDEC THEN BEGIN INSYMBOL; LABELDECLARATION END ELSE BEXGIN ERROR(350); SKIP(FSYS-[LABELSY]) END; IF SY = CONSTSY THEN BEGIN INSYMBOL; CONSTDECLARATION END; IF SY = TYPESY THEN BEGIN INSYMBOL; TYPEDECLARATION END; IF SY = VARSY THEN IF NOTEXTDEC THEN BEGI7N INSYMBOL; VARDECLARATION END ELSE BEGIN ERROR(351); SKIP(FSYS-[VARSY]) END; WHILE SY IN [PROCSY,FUNCSY] DO BEGIN LSY := SY; INSYMBOL; PROCDECLARATION(LSY) END; IF NOTEXTDEC THEN IF SY <> BEGINSY THEN | BEGIN ERROR(18); SKIP(FSYS) END UNTIL ((SY IN STATBEGSYS) OR EOF(INPUT)) OR (( SY = PERIOD ) AND EXTN); IF NOTEXTDEC AND (SY <> PERIOD) THEN BEGIN DP := FALSE; IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);  REPEAT BODY(FSYS + [CASESY]); IF (SY <> FSY) AND NOT(EXTN AND (SY = PERIOD)) THEN BEGIN ERROR(6); SKIP(FSYS) END UNTIL (((SY = FSY) OR (SY IN BLOCKBEGSYS)) OR EOF(INPUT)) OR (EXTN AND (SY = PERIOD)) ENDO ELSE BEGIN ERROR(174); NOTEXTDEC := TRUE END END (*BLOCK*) ; PROCEDURE PROGRAMME(FSYS:SETOFSYS); VAR LEXTFP,PEXTFP,EXTFP:EXTFILEP; FILECOUNT : INTEGER; LLCP : CTP; EXTN : BOOLEAN; BEGIN IF SY = PROGSY THEN BEGIN INSYMBOL; EXTN:=FALSE END ELSE EXTN := TRUE; IF SY = IDENT THEN BEGIN IF PRCODE THEN BEGIN (******** NOVA CONTROL STATEMENTS ******) (*****************************************) WRITELN(PRR,' .TITL ',ID:5); IF NOT(EXTN) THEN WRITELN(PRR,' .ENT PCODE'); END;  INSYMBOL; FILECOUNT := 0; EXTFP := NIL; IF NOT (SY IN [LPARENT,SEMICOLON]) THEN ERROR(14); IF SY = LPARENT THEN BEGIN REPEAT INSYMBOL; U IF SY = IDENT THEN BEGIN NEW(EXTFP); WITH EXTFP^ DO BEGIN FILENAME := ID; IF ((FILENAME = NA[3]) OR (FILENAME = NA[4]) OR (FILENAeME = NA[33]) OR (FILENAME = NA[34]))  THEN BEGIN NEW(LLCP,VARS); WITH LLCP^ DO BEGIN NAME := FILENAME; IDTYPE := TEXTPTR; L KLASS := VARS; VKIND := ACTUAL; NEXT := NIL; VADDR := LCAFTERMARKSTACK+FILEMAX*FILECOUNT+4; VLEV := 1; FILECOUNT := FILECOUNT + 1 END;  ENTERID(LLCP);  FTYPE := LLCP END; NEXTFILE := FEXTFILEP END; FEXTFILEP := EXTFP; INSYMBOL; IF NOT ( SY IN [COMMA,RPARENT] ) THEN ERROR(20) END ELSE ERROR(2) UNTIL SY <> COMMA; IF SY <> RPARENT THEN ERROR(4); INSYMBOL END; IF SY <> SEMICOLON THE EN ERROR(14) ELSE INSYMBOL; PEXTFP := NIL; WHILE EXTFP <> NIL DO BEGIN LEXTFP := EXTFP; WITH LEXTFP^ DO BEGIN EXTFP := NEXTFILE; NEXTFILE := PEXTFP END; PEXTFP := LEXTFP 5B END; FEXTFILEP := PEXTFP; (*POINTERS ARE REVERSED*) END ELSE IF PRCODE THEN WRITELN(PRR,' .TITL EXTSEG'); IF PRCODE THEN BEGIN WRITELN(PRR,' .TXTM 1'); WRITELN(PRR,' .RDX 10'); WRITELN(PRR,' .N6DREL'); END; REPEAT BLOCK(FSYS,PERIOD,NIL,NOT(EXTN),EXTN); IF SY <> PERIOD THEN ERROR(21) UNTIL (SY = PERIOD) OR EOF(INPUT); WRITELN(OUTPUT); WRITELN(OUTPUT); IF PRCODE THEN WRITELN(PRR,' .END'); IF EXTN AND NOT ERRFLAG THEN ;HALT(318); IF ERRINX <> 0 THEN INSYMBOL END (*PROGRAMME*) ; PROCEDURE STDNAMES; BEGIN NA[ 1] := 'FALSE '; NA[ 2] := 'TRUE '; NA[ 3] := 'INPUT '; NA[ 4] := 'OUTPUT '; NA[ 5] := 'GET '; NA[ 6] := 'PUT '; NA[ 7] := 'RES+"ET '; NA[ 8] := 'REWRITE '; NA[ 9] := 'READ '; NA[10] := 'WRITE '; NA[11] := 'PACK '; NA[12] := 'UNPACK '; NA[13] := 'NEW '; NA[14] := 'RELEASE '; NA[15] := 'READLN '; NA[16] := 'WRITELN '; NA[17] := 'ABS '; NA[18] := 'SҥQR '; NA[19] := 'TRUNC '; NA[20] := 'ODD '; NA[21] := 'ORD '; NA[22] := 'CHR '; NA[23] := 'PRED '; NA[24] := 'SUCC '; NA[25] := 'EOF '; NA[26] := 'EOLN '; NA[27] := 'SIN '; NA[28] := 'COS '; NA[29] := R'EXP '; NA[30] := 'SQRT '; NA[31] := 'LN '; NA[32] := 'ARCTAN '; NA[33] := 'PRD '; NA[34] := 'PRR '; NA[35] := 'MARK '; NA[36] := 'PUTRANDO'; NA[37] := 'GETRANDO'; NA[38] := 'PAGE '; NA[39] := 'EOR '; NA[40] :W= 'ROUND '; NA[41] := 'HALT '; END (*STDNAMES*) ; PROCEDURE ENTERSTDTYPES; VAR SP: STP; BEGIN (*TYPE UNDERLIEING:*) (*******************) NEW(INTPTR,SCALAR,STANDARD); (*INTEGER*) WITH INTPTR^ DO BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(REALPTR,SCALAR,STANDARD); (*REAL*) WITH REALPTR+^ DO BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(CHARPTR,SCALAR,STANDARD); (*CHAR*) WITH CHARPTR^ DO BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(BOOLPTR#,SCALAR,DECLARED); (*BOOLEAN*) WITH BOOLPTR^ DO BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END; NEW(NILPTR,POINTER); (*NIL*) WITH NILPTR^ DO BEGIN ELPTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END; NEW(PARMPTR,SCALAR,STANDARD); (*FOR ALIGNMENT OF PARAMETERS*) WITH PARMPTR^ DO BEGIN SIZE := PARMSIZE; FORM := SCALAR; SCALKIND := STANDARD END ; NEW(TEXTPTR,FILES); M (*TEXT*) WITH TEXTPTR^ DO BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE; FORM := FILES; RANDOMFILE := FALSE END END (*ENTERSTDTYPES*) ; PROCEDURE ENTSTDNAMES; VAR CP,CP1: CTP; I: INTEGER; BEGIN 0 (*NAME:*) (*******) NEW(CP,TYPES); (*INTEGER*) WITH CP^ DO BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); (*REAL*) WITH CP^ DO BEGIN NAME := 'REAL '; IDTYPE := REALPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES);  (*CHAR*) WITH CP^ DO BEGIN NAME := 'CHAR '; IDTYPE := CHARPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES);  (*BOOLEAN*) WITH CP^ DO BEGIN NAME := 'BOOLEAgN '; IDTYPE := BOOLPTR; KLASS := TYPES END; ENTERID(CP); CP1 := NIL; FOR I := 1 TO 2 DO BEGIN NEW(CP,KONST); (*FALSE,TRUE*) WITH CP^ DO BEGIN NAME := NA[I]; IDTYPE := BOOLPTR; [ NEXT := CP1; VALUES.IVAL := I - 1; KLASS := KONST END; ENTERID(CP); CP1 := CP END; BOOLPTR^.FCONST := CP; NEW(CP,KONST);  (*NIL*) WITH CP^ DO BEGIN NAME := 'NIL '; ?6IDTYPE := NILPTR; NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST END; ENTERID(CP); FOR I := 36 TO 37 DO (*GETRANDOM,PUTRANDOM*) BEGIN NEW(CP,PROC,STANDARD); WITH CP^ DO BEGIN NAME := KNA[I]; IDTYPE := NIL; NEXT := NIL; KEY := I-22; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,PROC,STANDARD); (*PAGE*) WITH CP^ DO %K BEGIN NAME := NA[38]; IDTYPE := NIL; NEXT := NIL; KEY := 16; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP); NEW(CP,PROC,STANDARD); (*HALT*) WITH CP^ DOi BEGIN NAME := NA[41]; IDTYPE := NIL; NEXT := NIL; KEY := 17; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP);  NEW(CP,FUNC,STANDARD); (*EOR*) WITH CP^ DOj BEGIN NAME := NA[39]; IDTYPE := NIL; NEXT := NIL; KEY := 9; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP); NEW(CP,FUNC,STANDARD); (*ROUND*) WITH CP^ ,pDO BEGIN NAME := NA[40]; IDTYPE := NIL; NEXT := NIL; KEY := 12; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP); FOR I := 5 TO 16 DO BEGIN NEW(CP,PROC,STANDARD); (*GET,PUT,RESET*) WITH CP^ DO (*REWRITE,READ*) BEGIN NAME := NA[I]; IDTYPE := NIL; (*WRITE,PACK*) NEXT := NIL; KEY := I - 4; (*UNPACK,PACK*)  KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,PROC,STANDARD); WITH CP^ DO BEGIN NAME:=NA[35]; IDTYPE:=NIL; NEXT:= NIL; KEY:=13; KLASS:=PROC; PFDECKIND:= STANDARD  END; ENTERID(CP); FOR I := 25 TO 26 DO BEGIN NEW(CP,FUNC,STANDARD); WITH CP^ DO BEGIN NAME := NA[I]; IDTYPE := NIL; NEXT := NIL; KEY := I - 15; KLASS := FUNC; PFDECKIND := STANDARD END,; ENTERID(CP) END; FOR I := 17 TO 24 DO BEGIN NEW(CP,FUNC,STANDARD); (*ABS,SQR,TRUNC*) WITH CP^ DO (*ODD,ORD,CHR*) BEGIN NAME := NA[I]; IDTYPE := NIL; (*PRED,SUCC*) NEXT := NIL; KEY := I - 16; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,VARS); (*PARAMETER OF PREDECLARED FUNCTIONS*) WITYH CP^ DO BEGIN NAME := ' '; IDTYPE := REALPTR; KLASS := VARS; VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0 END; FOR I := 27 TO 32 DO BEGIN NEW(CP1,FUNC,DECLARED,ACTUAL); (*SIN,COS,EXP*) =! WITH CP1^ DO (*SQRT,LN,ARCTAN*) BEGIN NAME := NA[I]; EXTDEC := FALSE; IDTYPE := REALPTR; NEXT := CP; FORWDECL := FALSE; EXTERN := TRUE; PFLEV := 0; PFNAME := I - 12; KLASS := FUNC; PFV]DECKIND := DECLARED; PFKIND := ACTUAL END; ENTERID(CP1) END END (*ENTSTDNAMES*) ; PROCEDURE ENTERUNDECL; BEGIN NEW(UTYPPTR,TYPES); WITH UTYPPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; KLASS := TYPES END;  NEW(UCSTPTR,KONST); WITH UCSTPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST END; NEW(UVARPTR,VARS); WITH UVARPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; VKIND := ACTUAL; NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS END; NEW(UFLDPTR,FIELD); WITH UFLDPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0; KLASS := FIELD END; NEW(UPRCPTR,PROC,DECLARopED,ACTUAL); WITH UPRCPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; FORWDECL := FALSE; EXTDEC := FALSE; NEXT := NIL; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME); KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL END{; NEW(UFCTPTR,FUNC,DECLARED,ACTUAL); WITH UFCTPTR^ DO BEGIN NAME := ' '; EXTDEC := FALSE; IDTYPE := NIL; NEXT := NIL; FORWDECL := FALSE; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME); KLASS := FUNC; PFDECKIND := DECLARE62D; PFKIND := ACTUAL END END (*ENTERUNDECL*) ; PROCEDURE INITSCALARS; BEGIN FWPTR := NIL; PRTABLES := FALSE; LIST := TRUE; PRCODE := TRUE; DEBUG := TRUE; ERRFLAG := FALSE; FOR IC := 1 TO MAXERRSET DO ERRORS[IC] := []; Zw DP := FALSE; PRTERR := TRUE; ERRINX := 0; INTLABEL := 0; KK := 8; FEXTFILEP := NIL; LC := LCAFTERMARKSTACK+FILEBUFFER*FILEMAX; (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR 2 TEXT FILES *) IC := 3; EOL := TRUE; LINECOUNT := 0; z CH := ' '; CHCNT := 0; GLOBTESTP := NIL; MXINT10 := MAXINT DIV 10; DIGMAX := STRGLGTH - 1; END (*INITSCALARS*) ; PROCEDURE INITSETS; BEGIN CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT]; SIMPTYPEBEGSYS := [LPARENT] + CDONSTBEGSYS; TYPEBEGSYS:=[ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY,RANDOMSY]+SIMPTYPEBEGSYS; TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY]; BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY, BEGINSY]; SELECTSYS_Q := [ARROW,PERIOD,LBRACK]; FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY]; STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY, CASESY]; END (*INITSETS*) ; PROCEDURE INITTABLES; PRO[CEDURE RESWORDS; BEGIN RW[ 1] := 'IF '; RW[ 2] := 'DO '; RW[ 3] := 'OF '; RW[ 4] := 'TO '; RW[ 5] := 'IN '; RW[ 6] := 'OR '; RW[ 7] := 'END '; RW[ 8] := 'FOR '; RW[ 9] := 'VAR '; RW[10] := 'DIV '; RW[11] := 'MOD '; RW[12] := 'SET '; RW[13] := 'AND '; RW[14] := 'NOT '; RW[15] := 'THEN '; RW[16] := 'ELSE '; RW[17] := 'WITH '; RW[18] := 'GOTO '; RW[19] := 'CASE '; RW[20] := 'TYPE '; )5 RW[21] := 'FILE '; RW[22] := 'BEGIN '; RW[23] := 'UNTIL '; RW[24] := 'WHILE '; RW[25] := 'ARRAY '; RW[26] := 'CONST '; RW[27] := 'LABEL '; RW[28] := 'REPEAT '; RW[29] := 'RECORD '; RW[30] := 'DOWNTO '; RW[31] := 'PACKED '; RW[32] := 'RANDOM '; RW[33] := 'FORWARD '; RW[34] := 'PROGRAM '; RW[35] := 'FUNCTION'; RW[36] := 'EXTERNAL'; RW[37] := 'PROCEDUR'; FRW[1] := 1; FRW[2] := 1; FRW[3] := 7; FRW[4] := 15; FRW[5] := 22; FRW[6] := 28; FRW[7] := 33; FRW[8] := 35; FRW[9] := 38; END (*RESWORDS*) ; PROCEDURE SYMBOLS; BEGIN RSY[1] := IFSY; RSY[2] := DOSY; RSY[3] := OFSY; RSY[4] := TOSY; RSY[5] := RELOP; RSY[6] := ADDOP; RSY[7] := ENDSY; RSY[8] := FORSY; RSY[9r] := VARSY; RSY[10] := MULOP; RSY[11] := MULOP; RSY[12] := SETSY; RSY[13] := MULOP; RSY[14] := NOTSY; RSY[15] := THENSY; RSY[16] := ELSESY; RSY[17] := WITHSY; RSY[18] := GOTOSY; RSY[19] := CASESY; RSY[20] := TYPESY; RSY[21] := FILES$Y; RSY[22] := BEGINSY; RSY[23] := UNTILSY; RSY[24] := WHILESY; RSY[25] := ARRAYSY; RSY[26] := CONSTSY; RSY[27] := LABELSY; RSY[28] := REPEATSY; RSY[29] := RECORDSY; RSY[30] := DOWNTOSY; RSY[31] := PACKEDSY; RSY[32] := RANDOMSY; RSY[j33] := FORWARDSY; RSY[34] := PROGSY; RSY[35] := FUNCSY; RSY[36] := EXTRNSY; RSY[37] := PROCSY; SSY['+'] := ADDOP; SSY['-'] := ADDOP; SSY['*'] := MULOP; SSY['/'] := MULOP; SSY['('] := LPARENT; SSY[')'] := RPARENT; SSY['$'] := OTHERSY; SSY['='] := RELOP; SSY[' '] := OTHERSY; SSY[','] := COMMA; SSY['.'] := PERIOD; SSY[''''] := OTHERSY; SSY['['] := LBRACK; SSY[']'] := RBRACK; SSY[':'] := COLON; SSY['^'] := ARROW; SSY['<'] := RELOP; SSY['>'] := RELOP; SSY[';'] := SEMICOLON; END (*SYMBOLS*) ; PROCEDURE RATORS; VAR I: INTEGER; CH: CHAR; BEGIN FOR I := 1 TO 37 (*NR OF RES WORDS*) DO ROP[I] := NOOP; ROP[5] := INOP; ROP[10] := IDIV; ROP[11] := IMOD; ROP[6] := OROP; ROP[13]># := ANDOP; FOR CH := CHR(ORDMINCHAR) TO CHR(ORDMAXCHAR) DO SOP[CH] := NOOP; SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL; SOP['/'] := RDIV; SOP['='] := EQOP; SOP['<'] := LTOP; SOP['>'] := GTOP; END (*RATORS*) ; PROC5EDURE PROCMNEMONICS; BEGIN SNA[ 1] :=' GET'; SNA[ 2] :=' PUT'; SNA[ 3] :=' RDI'; SNA[ 4] :=' RDR'; SNA[ 5] :=' RDC'; SNA[ 6] :=' WRI'; SNA[ 7] :=' WRO'; SNA[ 8] :=' WRR'; SNA[ 9] :=' WRC'; SNA[10] :=' WRS'; SNA[11] :=' OPN'; SNA[12] :S=' NEW'; SNA[13] :=' RST'; SNA[14] :=' ELN'; SNA[15] :=' SIN'; SNA[16] :=' COS'; SNA[17] :=' EXP'; SNA[18] :=' SQT'; SNA[19] :=' LOG'; SNA[20] :=' ATN'; SNA[21] :=' RLN'; SNA[22] :=' WLN'; SNA[23] :=' SAV'; SNA[24] :=' CLS'; SNA[25] :=' WDR'; SNA[26] :=' RRR'; SNA[27] :=' PAG'; SNA[28] :=' EOR'; SNA[29] :=' RSE'; SNA[30] :=' RWR'; SNA[31] :=' RND' END (*PROCMNEMONICS*) ; PROCEDURE INSTRMNEMONICS; BEGIN MN[0] :=' ABI'; MN[1] :=' ABR'; MN[2] :=' ADI'; MN[3] :='܈ ADR'; MN[4] :=' AND'; MN[5] :=' DIF'; MN[6] :=' DVI'; MN[7] :=' DVR'; MN[8] :=' EOF'; MN[9] :=' FLO'; MN[10] :=' FLT'; MN[11] :=' INN'; MN[12] :=' INT'; MN[13] :=' IOR'; MN[14] :=' MOD'; MN[15] :=' MPI'; MN[16] :=' MPR'; MN[17] :='< NGI'; MN[18] :=' NGR'; MN[19] :=' NOT'; MN[20] :=' ODD'; MN[21] :=' SBI'; MN[22] :=' SBR'; MN[23] :=' SGS'; MN[24] :=' SQI'; MN[25] :=' SQR'; MN[26] :=' STO'; MN[27] :=' TRC'; MN[28] :=' UNI'; MN[29] :=' STP'; MN[30] :=' CSP'; MN[31] :=' DEC'; MN[32] :=' ENT'; MN[33] :=' FJP'; MN[34] :=' INC'; MN[35] :=' IND'; MN[36] :=' IXA'; MN[37] :=' LAO'; MN[38] :=' LCA'; MN[39] :=' LDO'; MN[40] :=' MOV'; MN[41] :=' MST'; MN[42] :=' RET'; MN[43] :=' SRO'; MN[44] :=' XJP'; MN[455] :=' CHK'; MN[46] :=' CUP'; MN[47] :=' EQU'; MN[48] :=' GEQ'; MN[49] :=' GRT'; MN[50] :=' LDA'; MN[51] :=' LDC'; MN[52] :=' LEQ'; MN[53] :=' LES'; MN[54] :=' LOD'; MN[55] :=' NEQ';  MN[56] :=' STR'; MN[57] :=' UJP'; MN[58] :=' ORD'; MN[5q9] :=' CHR'; MN[60] :=' UJC'; MN[61] := ' CXP'; MN[62] :=' HLT'; END (*INSTRMNEMONICS*) ; PROCEDURE CHARTYPES; VAR I : INTEGER; BEGIN FOR I := ORDMINCHAR TO ORDMAXCHAR DO CHARTP[CHR(I)] := ILLEGAL; CHARTP['A'] := LE7TTER ; CHARTP['B'] := LETTER ; CHARTP['C'] := LETTER ; CHARTP['D'] := LETTER ; CHARTP['E'] := LETTER ; CHARTP['F'] := LETTER ; CHARTP['G'] := LETTER ; CHARTP['H'] := LETTER ; CHARTP['I'] := LETTER ; CHARTP['J'] := LETTER ; CHARTP['K'] := LETTER ; CHARTP['L'] := LETTER ; CHARTP['M'] := LETTER ; CHARTP['N'] := LETTER ; CHARTP['O'] := LETTER ; CHARTP['P'] := LETTER ; CHARTP['Q'] := LETTER ; CHARTP['R'] := LETTER ; CHARTP['S'] := LETTER ; CHARTP['T'] := LETTER ; CHARTP['U'] := LETTER ; CHARTP['V'] := LETTER ; CHARTP['W'] := LETTER ; CHARTP['X'] := LETTER ; CHARTP['Y'] := LETTER ; CHARTP['Z'] := LETTER ; CHARTP['0'] := NUMBER ; CHARTP['1'] := NUMBER ; CHARTP['2'] := zNUMBER ; CHARTP['3'] := NUMBER ; CHARTP['4'] := NUMBER ; CHARTP['5'] := NUMBER ; CHARTP['6'] := NUMBER ; CHARTP['7'] := NUMBER ; CHARTP['8'] := NUMBER ; CHARTP['9'] := NUMBER ; CHARTP['+'] := SPECIAL; CHARTP['-'] := SPECIAL; CHARTP['*'] := SPECIAL; CHARTP['/'] := SPECIAL; CHARTP['('] := SPECIAL; CHARTP[')'] := SPECIAL; CHARTP['$'] := SPECIAL; CHARTP['='] := SPECIAL; CHARTP[' '] := SPECIAL; CHARTP[','] := SPECIAL; CHARTP['.'] := SPECIAL; CHARTP[''''] := SPECIAL; CHARTP['['] := SPECIAL; CHARTP[']'] := SPECIAL; CHARTP[':'] := SPECIAL; CHARTP['^'] := SPECIAL; CHARTP[';'] := SPECIAL; CHARTP['<'] := SPECIAL; CHARTP['>'] := SPECIAL; ORDINT['0'] := 0; ORDINT['1'] := 1; zORDINT['2'] := 2; ORDINT['3'] := 3; ORDINT['4'] := 4; ORDINT['5'] := 5; ORDINT['6'] := 6; ORDINT['7'] := 7; ORDINT['8'] := 8; ORDINT['9'] := 9; END; PROCEDURE INITDX; BEGIN CDX[ 0] := 0; CDX[ 1] := 0; CDX[ 2] := -ҁ1; CDX[ 3] := -2; CDX[ 4] := -1; CDX[ 5] := -4; CDX[ 6] := -1; CDX[ 7] := -2; CDX[ 8] := 0; CDX[ 9] := 1; CDX[10] := 1; CDX[11] := -4; CDX[12] := -4; CDX[13] := -1; CDX[14] := -1; CDX[15] := -1; CDX[16] := -2; CDX[17] := 0; CDX[h18] := 0; CDX[19] := 0; CDX[20] := 0; CDX[21] := -1; CDX[22] := -2; CDX[23] := 3; CDX[24] := 0; CDX[25] := 0; CDX[26] := -2; CDX[27] := -1; CDX[28] := -4; CDX[29] := 0; CDX[30] := 0; CDX[31] := 0; CDX[32] := 0; CDX[33] := -1; CDX[34] := 0; CDX[35] := 0; CDX[36] := -1; CDX[37] := +1; CDX[38] := +1; CDX[39] := +4; CDX[40] := -2; CDX[41] := 0; CDX[42] := 0; CDX[43] := -1; CDX[44] := -1; CDX[45] := 0; CDX[46] := 0; CDX[47] := -1; CDX[48] := -1; CDX5[49] := -1; CDX[50] := +1; CDX[51] := +4; CDX[52] := -1; CDX[53] := -1; CDX[54] := +4; CDX[55] := -1; CDX[56] := -1; CDX[57] := 0; CDX[58] := 0; CDX[59] := 0; CDX[60] := 0; CDX[61] := 0; CDX[62] := -1; PDX[ 1] := -1; PDX[ 2] := -1; PDX[ 3] := -2; PDX[ 4] := -3; PDX[ 5] := -2; PDX[ 6] := -3; PDX[ 7] := -3; PDX[ 8] := -4; PDX[ 9] := -3; PDX[10] := -4; PDX[11] := -3; PDX[12] := -2; PDX[13] := -1; PDX[14] := 0; PDX[15] := 0; PDX[16] := 0; PDX[17] := 0; PDX[18] := 0; PDX[19] := 0; PDX[20] := 0; PDX[21] := -1; PDX[22] := -1; PDX[23] := -1; PDX[24] := -1;  PDX[25] := -2; PDX[26] := -2; PDX[27] := -1; PDX[28] := -1; PDX[29] := -2; PDX[30] := -2; PDX[31] := 0 END; BEGIN (*INITTABLES*5) RESWORDS; SYMBOLS; RATORS; INSTRMNEMONICS; PROCMNEMONICS; CHARTYPES; INITDX; END (*INITTABLES*) ; PROCEDURE FULLINITALISATION; BEGIN (*INITIALIZE*) (************) INITSCALARS; INITSETS; INITTABLES; (*ENTER STANDARD NAMES AND STANx-DARD TYPES:*) (******************************************) LEVEL := 0; TOP := 0; WITH DISPLAY[0] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END; ENTERSTDTYPES; STDNAMES; ENTSTDNAMES; ENTERUNDECL; TOP := 1; LEVEL := 1; WITH DISPLAY[1] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END; END; BEGIN FULLINITALISATION; (*COMPILE:*) (**********) INSYMBOL; PROGRAMME(BLOCKBEGSYS+STATBEGSYS-[CASESY]); IF ERRFLAG THEN BEGIN ERRORREPORT; HALT(31lc9) END; END. R2IREAL.SR > .TITL R2IREAL ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO REAL NUMBER OPERATIONS .ENT PADR,PSBR,PFLT,PFLO,PTRC,PNGR .ENT PSQR,PABR,PMPR,PDVR .EXTN PUNDF .NREL PADR: PSBR: PFLT: PFLO: PTRC: PNGR: PSQR: PABR: PMPR: PDVR: .PUND .END R2SMYP.SRU,ݽ .TITL R2SMYP .ENT .MPY,.SV0 .EXTN MPY .ZREL .SV0: 0 .NREL .MPY : N. : STA 3,N.1 SUB 3,3 MOVL# 1,1,SZC ADD 2,3 MOVL# 2,2,SZC ADD 1,3 STySA 3,N.2 MPY LDA 3,N.2 SUB 3,0 JMP @.+1 N.1: 0 N.2: 0 .END R2SBOOLEAN.SR vR .TITL R2SBOOLEAN ; THE P-CODE INTERPRETER'S BOOLEAN OPERATIONS .ENT PNOT,PAND,PIOR .NREL PNOT: LTOP1 1 ;"NOT" MOV 1,1,SZR ;SET AC1=1 (TRUE) IF CURRENTLY 0 SUB 1,1,SKP ; 0 IF 1 INC 1,1 STOP1 1 NEXT PAND: POP1 2 ;"AND" LTOP1 1 SUB 0,0 1i ANDR 2,1 ;KEEP B15 IN CARRY MOVL 0,0 ; RESULT OF "AND" IS A SINGLE BIT STOP1 0 NEXT PIOR: POP1 2 ;"INCLUSIVE OR"  LTOP1 1 SUB 0,0 COM 2,2 ;DELETE COMMON 1'S FROM AC1 AND 2,1 ADCR 2,1 ;OR MOVL 0,0 ;RESULT OF "IOR" IS A SINGLE BIT STOP1 0 JRNEXT .END MAKEDGSYMB.CMm (DELETE MAC.PS;^ MAC/N/S NBID FPID OSID^ R2SDECODER.SR 2 .TITL R2SDECODER .EXTD ITAB0,ITAB1 .ENT PUNDF ; THE INTERPRETER INSTRUCTION DECODER .LOC 40 ; SPECIAL PAGE ZERO LOCN. CONTAINING INTER ; ENTRY ADDRESS OF INTERPRETER .NREL OPMSK: 037400 ; MASK FOR OP-CODE PMSK: 000377 ; MASK FOR P-FIELD 7INTER: LDA 0,@PC ; AC0:= NEXT INSTR. LDA 3,OPMSK ANDS 0,3 ; AC3:= OP-CODE LDA 1,PMSK AND 0,1 ; AC1(P):= P-FIELD ADDL# 0,0,SNC ; TEST Q1-BIT:- JMP @ITAB0,3 ; Q1=0: ENTER INTERP. TABLE MOVL# 0,0,SNC ; Q1=1: TEST Q2-BIT:- JMP .+4 MOV 1,2 ; Q2=_1: AC2(Q):= P-FIELD SUB 1,1 ; AC1(P):= 0; JMP @ITAB1,3 ; ENTER INTERP. TABLE LDA 2,@PC ; Q2=0: AC2(Q):= Q-FIELD JMP @ITAB1,3 ; ENTER INTERP. TABLE PUNDF: ERR.P PEROP .END R2SDBIN.SR ; .TITL R2SDBIN .ENT .DBIN .ENT .DBNI .EXTD .PTCH .EXTD .GTCH .LOC 0 .ZREL Z. : .NREL .DBNI: N. : 54464 ; 0/ STA 3,N.9 50462 g ; 1/ STA 2,N.8 20471 ; 2/ LDA 0,N.16 JSR @.PTCH ; 3/ JSR @.PTCH 102400 ; 4/ SUB 0,0 JSR @.PTCH ; 5/ JSR @.PTCH 4ק03 ;  6/ JMP N.1 .DBIN: 54455 ; 7/ STA 3,N.9 50453 ; 10/ STA 2,N.8 N.1: 102400 ; 11/ SUB 0,0 40462 ; 12/ STA 0,N.1^ 7 40452 ; 13/ STA 0,N.10 40452 ; 14/ STA 0,N.11 JSR @.GTCH ; 15/ JSR @.GTCH 24451 ; 16/ LDA 1,N.12 106405 ; > 17/ SUB  0,1,SNR 405 ; 20/ JMP N.2 24447 ; 21/ LDA 1,N.13 106404 ; 22/ SUB 0,1,SZR 403 ; 23/ JMP N.3 10441 B ; 24/ ISZ N.10 N.2: JSR @.GTCH ; 25/ JSR @.GTCH N.3: 24443 ; 26/ LDA 1,N.14 30443 ; 27/ LDA 2,N.15 142033 ; 30/ ADCZ# 2,0,SNC ͉  106032 ; 31/ ADCZ# 0,1,SZC 406 ; 32/ JMP N.4 122400 ; 33/ SUB 1,0 24432 ; 34/ LDA 1,N.11 4420 ; 35/ JSGR N.7 44430 ; 36/ STA 1,N.11 766 ; 37/ JMP N.2 N.4: 24426 ; 40/ LDA 1,N.11 125122 ; 41/ MOVZL 1,1,SZC 10432   0 ; 42/ ISZ N.17 14422 ; 43/ DSZ N.10 406 ; 44/ JMP N.5 125005 ; 45/ MOV 1,1,SNR 14426 ; 46/ DSZ N.17 124641 M ; 47/ NEGOR 1,1,SKP 125240 ; 50/ MOVOR 1,1 402 ; 51/ JMP N.6 N.5: 125220 ; 52/ MOVZR 1,1 N.6: 30410 ; 53/ LDA 2,N.8 Xe 2410 ; 54/ JMP @N.9 N.7: 131120 ; 55/ MOVZL 1,2 151120 ; 56/ MOVZL 2,2 147000 ; 57/ ADD 2,1 125120 ; 60/ MOVZL 1,1 ! 107000 ; 61/ ADD 0,1 1400 ; 62/ JMP 0,3 N.8: 0 ; 63/ JMP 0 N.9: 0 ; 64/ JMP 0 N.10: 0  ; 65/ JMP 0 N.11dx: 0 ; 66/ JMP 0 N.12: 53 ; 67/ JMP 53 N.13: 55 ; 70/ JMP 55 N.14: 60 ; 71/ JMP 60 N.15: 71 ; 72/ JMP 71 N.16: o) 123 ; 73/ JMP 123 N.17: 0 ; 74/ JMP 0 .END SETUPAZ.kj (*========== SETUPAZ STARTS FROM HERE UP TO END OF THIS PROGRAM ==========*) BEGIN (* OF MAIN BODY *) WRITELN(PRR, '; SETUPA BEGINS'); WRITELN; WRITELN; WRITELN; FOR I := 0 TO TABSIZE0 DO BEGIN PCODETABLE[I].PCODEY := ' '; PCODETABLE[I].SEMICODE := ' '; PCODETABLE[I].ACTION := 0 END; ZERO := ORD('0'); COMPLETETASK; WRITELN('PROCEDURE COMPLE', 'TABLE;'); WRITELN; WRITELN; J := 1; K := 0; WRITELN('PROCEDURE TABLE', '0;'); WRITELN('BEGIN'); FOR I := 0 TO TABSIZE0 DO BEGIN WITH PCODETABLE[I] DO BEGIN IF SEMICODE[1] <> ' ' THEN BEGIN IF K MOD 30 = 29 THEN  BEGIN WRITELN('END;'); WRITELN; WRITELN; WRITELN('PROCEDURE TABLE', J : 1, '; '); WRITELN('BEGIN'); J := J + 1; X END; WRITE(' ' : 5, 'WITH PCODETABLE[', I : 1, '] ' : 2, 'DO BEGIN PCODE:=', '''', PCODE : 4, '''; ' : 3, 'SEMICODE:=' : 10); IF SEMICODE[1] = '1' THEN PETTY := J-8 ELSE PETTY := 0; WRITELN( (((( PETTY + ORD(SEMICODE[2]) - ZERO) * 8 + ORD(SEMICODE[3]) - ZERO) * 8 + ORD(SEM5ICODE[4]) - ZERO) * 8 +  ORD(SEMICODE[5]) - ZERO) * 8 + ORD(SEMICODE[6]) - ZERO : 6, '; ' : 2, 'ACTION:=' : 8, ACTION : 4, ' END;');  K := K + 1; END END END; WRITELN('END;'); WRITELN; WRITELN; WRITELN; WRITELN('BEGIN'); FOR I := 0 TO J - 1 DO WRITELN(' ' : 5, 'TABLE' : 5, I : 1, '; '); WRITELN('END;'); iWRITELN; WRITELN; WRITELN(PRR, '; HASH TABLE SIZ', 'E = ' : 8, TABLESIZE : 1); WRITELN(PRR, '; TOTAL PCODE EN', 'TRIES = ' : 8, ENTRIES : 1); WRITELN(PRR, '; LOADING FACTOR', ' = ' : 8, ENTRIES/TABLESIZE : 1) END. R2RFT.SR =T .TITLE R2RFT .ENT XRDR,XWRR .EXTD WSA,PUTFL,LHB .EXTN FENT .EXTN WRITE,BLANK,CHINF,BFHLF,BFPTR .EXTN PURGE .NREL ;THESE ROUTINES USE THE FP INTERPRETER BRKC=2 WDISP=121 ;# OF CHARS FOR NUMBER DDISP=122 ;# OF CHARS AFTER . XRDR: SUBZL 0,0 ;SE MT FLAG STA 0,@.CHF ;IN CHIN FENT ;ENTER DITTO FDFC 0 ;FP NUMBER INTO FP AC0 FSTA 0,TEMPR ;COPY IT FEXT ;EXIT LDA 3,WSA LDA 3,0,3 ;PICK UP FLAG MOV 3,3,SNR ;SKIP IF NON-ZERO JMP .+3 ERR.P PERFI ;REPORT ERROR POP1 2 MOVZR 2,2 DSZ F,ST,2 ;MARK BUFFER EMPTY JMP .+1 ;EOL MAY BE SHOWING POP1 2 ;GET DESTINATION MOVZR 2,2 LDA 0,TEMPR STA 0,0,2 ;STORE FIRST HALF LDA 0,TEMPR+1 STA 0,1,2 ;STORE LAST HALF NEXT TEMPR: 0 0 .CHF: CHINF .RITE: WRITE .BLNK: BLANK .BHLF: BFHLF .BPTR: BFPTR .PRGE: PURGE WIDTH: 31. CHADP: 4 BIGE: (24+64.)*256. HOLDR: 0 0 XWRR: POP1 2 ;FBA MOVZR 2,2 LDA 1,CHADP ;# CHARS AFTER . POP1 0 ;# CHARS IN TOTO STA 0,AD1 ;COMPATABILITY WITH WRI IN PURGE POP1 3 STA 3,HOLDR+1 ;FIRST HALF POP1 3 STA 3,HOLRDR ;LAST HALF LDA 3,WSA ;FP WRITE AREA STA 1,DDISP,3 ;PLACES AFTER DP LDA 1,WIDTH ;PLACES MAXIMUM STA 1,WDISP,3 SUB 1,1 ;CLEAR FLAGS STA 1,0,3 ;IN WSA LDA 1,AD1 ;FIELD WIDDTH FROM USER MOV 1,1,SNR ;SKIP IF WIDTH >0 JMP EFORM LDA 1,HOLDR ;FP NUMBER PART 1 LDA 3,LHB ;MASK ANDZL 3,1 ;KEEP EXPONENT ANDD .. MOVZR 1,1 ;LOSE MANTISSA SIGN LDA 3,BIGE ;LARGEST EXPONENT FOR F FORMAT ADCZ 3,1,SZC ;SKIP IF AC1(EXP)<=AC3(BIGE) JMP EFORM FFORM: FENT ;FP ENTER FLDA 0,HOLDR ;LOAD NUMBER FF_DCF 0 ;PUT IN BUFF FEXT ;FP EXIT ACS 0,2 OK JMP TESTF EFORM: FENT FLDA 0,HOLDR FFDC 0 FEXT TESTF: LDA 3,WSA LDA 3,0,3 ;PICK UP FLAG MOV 3,3,SNR ;ERROR IF NON ZERO JMP .+3 ERR.P PERFO ;REPORT ERROR JSR @.PRGE ;EMPTIES AND TIDIES BUFFER |.END R2IOUTL.SR b. .TITL R2IOUTL .ENT .BPUT,.BGET,.GCH,.FIND .ENT TEMP .EXTN ERR2,ERRP,PCODE .EXTD CHAN,SPACE,TEMP2,CNTAD,TABAD .EXTD LHB,RHB .TXTM 1 .ZREL ; DEFINE SOME CONSTANTS IN PAGE ZERO THAT ARE ASSUMED TO HAVE ; ADDRESSES 50 AND 51.... ERR2 ; .ERR2 = 50 ERRP ; .ERRP = 51 .BPUT: BPUT .BGET: BGET .GCH: GCHAN .CTAB: CTAB .BTAB: BTAB-1 .OTAB: OTAB-1 .TTAB: TTAB-1 .FIND: FIND TEMP: 0 .NREL ; ROUTINE TO WRITE A BYTE TO A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - BYTE TO BE WRITTEN(IN LHB) ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED BPUT: STA 3,BLNK ;LINK STORED LDA 1,LHB ;MASK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHCICH BYTE MOVS 0,0,SKP ;RIGHT OR LEFT? MOVS 1,1 LDA 3,0,2 ;LOAD FROM WORD ADDRESS AND 1,3 ;MASK OUT OTHER BYTE ADD 0,3 ;REPLACE WITH NEW BYTE STA 3,0,2 ;AND RESTORE JMP @BLNK ; ROUTINE TO READ A BYTE FROM A GIVEN BYTE ADDRESS ; ; CONDITIONS ..˻. ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - VALUE OF BYTE READ(IN LHB) ; AC1 - UNDEFINED ; AC2 - UNDEFINED BGET: STA 3,BLNK ;STORE LINK LDA 1,LHB ;BYTE MASK FOoR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHICH BYTE MOVS 1,1 ;RIGHT OR LEFT? LDA 0,0,2 ;LOAD FROM WORD ADDRESS. AND 1,0,SZC ;EXTRACT BYTE MOVS 0,0 ;SWOP INTO LHB  JMP @BLNK ; ROUTINE TO GET THE CHANNEL NO. AND RECORD LENGTH OF SPECIFIC FILE. ;̝ ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - CHANNEL NUMBER ; AC1 - RECORD LENGTH ; AC2 - WORD ADDRESS OF FBA ; ; NORMAL RETURN - NONE CHARACTER INPUT/OUTPUT ; RETURN + 1 - CHARACTER INPUT/OUTPUT GCHAN: STA 3,BLNK ;STORE LINK LDA 1,LHB ;MASK FOR LEFT HAND BYTE LDA 0,FCH,2 ;CHANNEL WORD OF FBA ANDS 0,1,SNR ;ISOLATE RECORD LENGTH ISZ BLNK ;AND TEST IF CHAR I/O. MOVZL 1,1 ;MAK)E IT A BYTE COUNT LDA 3,RHB ;MASK CHANNEL NUMBER AND 3,0 STA 0,CHAN JMP @BLNK BLNK: 0 ; ROUTINE TO SEARCH TABLES FOR BUFFER DETAILS. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - CHANNEL NUMBER OF FILE (OR ZERO) ; ; RETURN - AC0 - BYTE ADDRESS OF BUFFER AREA(BASE) ; AC1 - ADDRESS OF BYTE COUNT (DISPLACEMENT) ; AC2 - WORD ADDRESS OF ENTRY IN CHANNEL TABLE FIND: LDA 0,TSIZE ;SIZE OF TABLE LDA 1,.CTAB ;ADDRESS OF CHANNEL TABLE(TOP) STA 1,TEMP RETST: LDA 1,@TEMP ;SEARCH UNTIL A MATCH OR ERROR SUB 2,1,SNR JMP RETRN ;A MATCH IS FOUND DSZ TEMP INC 0,0,SZR ;TABLE EXHAUSTED? JMP RETST ;NO,FIND NEXT ERR.P ;YES, BLOW..... 411 RETRN: LDA 1,.OTAB SUBZ 0,1 ;ADDRESS OF BYTE COUNT(DISPLACEMENT) STA 1,CNTAD LDA 1,@CNTAD ;LOAD ACTUAL COUNT LDA 2,C200 SUBZ# 1,2,SZC ;TEST IF LINE TOO LONG JMP .+3 JSR .NERR ;LINE LIMIT FLAGGED TO CLI 22 LDA 1,CNTAD LDA 2,.TTAB SUB 0,2 ;ENTRY IN THE TABLE TAB COUNTS STA 2,TABAD LD<A 2,.BTAB SUB 0,2 LDA 0,0,2 ;SET BUFFER ADDRESS(BASE) LDA 2,TEMP ;CHANNEL TABLE ADDRESS JMP 0,3 .NERR: LDA 2,0,3 ;PICK UP ERROR CODE ERR.2 C200: 200 TSIZE: -4 ;TABLE SIZE 0 0 0 CTAB: 0 ;TOP OF CHANNEL TABLE OTAB: .BLK 4 ;COUNT TABLE TTAB: .BLK 4 ;TAB COUNTER FOR ASCII INPUT/OUTPUT BTAB: BUFF1*2 ;BUFFER TABLE BUFF2*2 BUFF3*2 BUFF4*2 BUFF1: .BLK 104 ;BUFFERS BUFF2: .BLK 104 BUFF3: .BLK 104 BUFF4: .BLK 104 .LOC .-420 ; P-CODE SYSTEM INITIALISATION PROCEDURES. .PCODE: PCODE PI: .SYSTM >; X1 := NMAX; X0 := HMA; .MEM JMP . STA 0,HP ; INITIALISE HEAP POINTER TO MAX ADR SUB 1,0 ; X0 := INCREMENT FOR .MEMI CALL STA 1,DSP ; STACK STARTS AT INITIAL NMAX STA 1,MP STA 1,SP DSZ SP LDA 3,HP ; GET THE TOP OF THE HEAP STA 3,@DSP ;STORE?* IT IN THE STACK BASE .SYSTM ; ALLOCATE ALL AVAILABLE STORE .MEMI JMP . SUB 2,2 ;CHANNEL ZERO FOR 'COM.CM' SUB 1,1 ;NORMAL CHARACTERISTICS LDA 0,.COMF ;'COM.CM' .SYSTM .OPEN 77 ERR.2 LDA 2,.PCODE LDA 2,2,2 ;PICK UP THE LABEL OF FIRST CUP  LDA 1,C5 ADD 1,2 ;FORM ADDRESS OF FIRST POSSIBLE FILENAME STA 2,STPC JSR COMA1 JSR COMA2 ;READS PROGRAM NAMEAND GLOBAL SWITCHES RENU: JSR COMA1 ;READS NAME OF SECOND ARGUEMENT LDA 2,.COMA STA 2,TEMP ;SET UP THE BUFFER ADDRESS LDA 2,STPC ;FIRS T POSSIBLE NAME LDA 1,13,2 ;FIRST POSSIBLE OPEN COMMAND LDA 0,COPN ; CSP OPN SUB 1,0,SZR  ;IS IT A MATCH JMP NOMAT ;NO - THEN BLOW UP.... MOVZL 2,2 ;YES - THEN REPLACE FILENAME STA 2,TEMP2 LDA 0,M20 ;INITIAL COUNT STA 0,COUNT NEXTB: LDA 2,TEMP JSR @.BGET ;GET THE NEXT BYTE LDA 2,TEMP2 JSR @.BPUT ;PUT IT INTO THE FILENAME MOV 0,0,SNR ;TEST IF NULL AFTER THE PUT.... JMP ENAME ISZ TEMP ;UPDATE POINTERS ISZ TEMP2 ISZ COUNT ;ERROR IF OVER.. JMP NEXTB JSR .NERR 317 NOMAT: JSR~ .NERR 313 ; ROUTINE TO READ THE FILENAME COMA1: STA 3,TEMP LDA 0,.COMA ;ARGUEMENT BUFFER SUB 2,2 ;CHANNEL ZERO .SYSTM .RDL 77 ;READ THAT NAME JMP TSTEF ;SEE IF EOF? JMP @TEMP TSTEF: LDA 1,C6 ;TEST IF EOF SUB# 1,2,SZR ERR.2 ;IF NOT THEN BLOW... JMP ENDAL ; ROUTINE TO READ THE SWITCHES COMA2: STA 3,TEMP LDA 0,.SWA ;SWITCH BUFFER LDA 1,C4 ;TWO WORDS SUB 2,2 ;CHANNEL ZERO .SYSTM .RDS 77 ;READ FOUR BYTES JMP TSTEF JMP @TEMP ENAME: LDA 0,SPACE ;FILL OUT WITH SPACES LDA 2,TEMP2 F JSR @.BPUT ISZ TEMP2 ISZ COUNT JMP ENAME LDA 2,STPC ;UPDATE THE POINTER TO THE PCODE LDA 1,C15 ;BY AN APPROPRIATE AMOUNT ADD 1,2 STA 2,STPC JSR COMA2 LDA 0,SWA ;PICK UP SWITCHES MOVZL 0,0,SNC ;AND TEST IF 'A' SET ON. JMP RENU ;NO...THEN GNET NEXT PARAMETER SUBZR 0,0 ;OTHERWISE SET BIT 0 OF NULLS LDA 2,STPC LDA 1,-5,2 ;COUNT ADD 0,1 STA 1,-5,2 ;RESTORE COUNT JMP RENU ENDAL: LDA 0,.PCODE ; INITIALISE PC STA 0,PC DSZ PC NEXT .COMF: COMF*2 COMF: .TXT 'COM.CM' C5: 5 C4: 4 C15: 15 Ck6: 6 .COMA: COMA*2 .SWA: SWA*2 STPC: 0 M20: -20 COUNT: 0 COPN: 161425 COMA: .BLK 10 SWA: .BLK 2 .END PI R2ALLFILES.CM8R2SECHK,^ R2ROUTL,^ R2IFT,^ R2SMPD,^ R2SOVL,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2IREAL,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2CITAB,^ R2IFNS,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2RFT,^ R2SITAB,^ R2SDIV,^ R2IFW,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2CSPTAB,^ R2IOUTL,^ R2SDECODER,^ R2SMYP,^ R2RREAL,^ R2SREWR,^ R2RFNS,^ R2SSPTAB,^ R2SCONSTS,^ R2RFW^ R2SOVL.SR A-3 .TITLE R2SOVL .TXTM 1 .NREL .ENT XOVL ; AT XOVL IT IS ASSUMED THAT THE OVERLAY NODE AND NUMBER ; ARE PASSED VIA STACK LOCATION ...... IF THE FILE IS ; FOUND NOT TO BE OPEN IT IS OPENED OVOPN: .SYSTM .GCHN ; ASK RDOS FOR A CHANNEL ERR.2 STA 2,OVCEHN LDA 0,PASOL .SYSTM .OVOPN 77 ; OPEN OVERLAY FILE PASCAL.OL ERR.2 XOVL: LTOP1 0 ; PICK UP NODE AND NUMBER ADC 1,1 ; UNCONDITIONAL LOAD LDA 2,OVCHN .SYSTM .OVLOD 77 JMP ERCHK POP NEXT ERCHK: MOV 2,2,SNR JMP OVOPN ; ILLEGAL CHANNEL # LDA L*1,FSHUT SUB 2,1,SNR ; FILE OPEN ? JMP OVOPN ; YES ERR.2 ; NO .. LEAVE IT TO RDOS OVCHN: -1 FSHUT: 15 PASOL: .+1*2 .TXT "P4COMPILER.OL" .END R2SIOIN.SR 9"Z .TITLE R2SIOIN .ENT XRDI .ENT GETC,.GTCH .ENT CHINF .EXTN .DBIN .EXTD .READ,SPACE .ZREL GETC:.GTCH:CHIN .NREL ;THE INTEGER READING ROUTINE FOLLOWS, IT MAKES USE OF ;THE ENTRY POINT .DBIN IN MATH.LB XRDI: SUBZL 0,0 ;MAKE ONE STA 0,CHINF ;SET FLAG IN CHIN JSR @DBIN ;READ INTEGER POP1 2 ;FBA MOVZR 2,2 POP1 3 ;INTEGER DESTINATION MOVZR 3,3 STA 1,0,3 ;STORE INTEGER DSZ FST,2 ;MARK BUFFER FULL NEXT ;EOL MAY BE SET NEXT ;IT MAY NOT DBIN: .DBIN CHINF: 1 CHIN: STA 3,Z1 ;KEEP RETURN1 LTOP1 2 ;USE STACK TOP MOVZR 2,2 ; .. ITS A BYTE ADDRESS DSZ CHINF JMP DIGS ; LEADR: JSR @.READ LDA 1,SPACE ;GET SPACE CHAR SUB 0,1,SZR ;SPACE ? JMP DIGS+1 ; - NO ISZ FST,2 ; - YES, SET FB EMPTY JMP LEADR DIGS: JSR @.READ MOVS 0,0 ISZ FS*cT,2 ; SET FB EMPTY JMP @Z1 ; .END R2SDIV.SRR*1 .TITL R2SDIV .ENT .DIV .EXTN DVD .NREL .DIV : N. : STA 3,N.6 STA 2,N.5 STA 1,N.4 STA 0,N.3 MOVL 2,3,SZC NEG 2,2 SUBCL 3,3 MOVZL /3,3 MOVL# 0,0,SNC JMP N.1 INC 3,3 NEG 1,1,SZR COM 0,0,SKP NEG  0,0 N.1: STA 3,N.7 SUB 0,0 DVD LDA 2,N.5 MOVL 1,1,SNC MOVR 1,1,SZC  JMP N.2 LDA 3,N.7 MOVR 3,3,SNC COM 3,3,SKP NEG 0,0 MOVR 3,3,SNC NEG 1,1 MOVZ 3,3 JMP @N.6 N.2: LDA 0,N.3 LDA 1,N.4 JMP @N.6 N.3=\: 0 N.4: 0 N.5: 0 N.6: 0 N.7: 0 .END R2SECHK.SR 24 .TITLE R2SECHK ; ERROR HANDLER AND CHECK ROUTINES .ENT HELP .ENT ERRP,ERR2,ERR .ENT PCHKC,PCHK4,PCHK2,PCHK3 .EXTD PUTFL .EXTN .BIND, BFPTR,BFBP0 .TXTM 1 .NREL ERR2: ERR: .SYSTM .ERTN JMP . ERRP: LDA 2,0,3 ;PICK UP E CODE LDA 3,INSTR ;GET LAST INSTR MARKER JMP RATS ; THIS ENTRY FOR CHECK ADDRESS PCHK4: LTOP1 0 LDA 3,@PC ; PICK UP INSTR # MOV 2,2,SZR ; POSSIBLE NULL ? JMP NONIL ; NO MOV 0,0,SNR ; YES TEST TOP OF STACK NEXT ; ITS A NULL NONIL: LDA 1,DSP ; STACK BASE LafDA 2,@DSP ; INITIAL VALUE OF HP MOVZR 0,0 ; MAKE WORD ADDR JMP TEST KEEP: STA 3,INSTR NEXT LHB40: 40 PCHKC: LDA 0,LHB40 ADDS 0,1 ADDS 0,2 JMP PCHK2 PCHK3: MOV 2,1 ;LOWER BOUND TO AC1 LDA 2,@PC ;GET UPPER BOUND PCHK2: LDA 3,@PC ;GET INSTR BCOUNT LTOP1 0 ;STACK TOP TO AC0 TEST: ADDOR 0,0 ;UNSIGN THESE NUMBERS ADDOR 1,1 ;SO THAT THE FOLLOWING ADDOR 2,2 ;TESTS WORK AS INTENDED ! ADCZ# 2,0,SZC ;SKP IF AC0<=AC2 (UPPER) JMP MICE ;TROUBLE SUBZ# 1,0,SZC ;SKP IF AC0<12> BUGS" .TXT "<15><12>LAST KNOWN PCODE INSTRUCTION " ASIN: .BLK 4 .TXT "<15><12>INTERPRETER ERRO<#R CODE " ASEC: .BLK 4 .TXT "<15><12>" MESSF: .-1*2 .END SETUPAX.kj"S (* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ------------------------------ AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE I/II DATE : MARCH, 1977 *) (*******\********************************************************** THE MIDDLE PART ( IE THE WHOLE COMPLETETASK PROCEDURE ) OF THIS PROGRAM IS PRODUCED BY THE PROGRAM "FASTHASH". THE ORDER OF THE HASHING IS SUCH THAT THE ACTIVATION OF THIS WILL EVENTUALLY PRODUCE A SET OF PROCEDURES ( IE THE WHOLE PROCEDURE COMPLETABLE IN EITHER "P4ASM" OR "P4MAC" ) THAT WILL OPTIMIZE ALL THE PCODE MNEMONICS' ACCESS MECHANISM.  IT OUTPUTS A SET OF PROCEDURES WHICH FORM THE MIDDLE PART OF EITHER "P4ASM" OR "P4MAC". THE OUTPUT FILE CONTAINING THIS SET OF PROCEDURES IS "P4AMY1" IN RELEASE I OR "P4AMY2" IN RELEASE II. THIS PR>aOGRAM IS THE AMALGAMATION OF THREE SMALLER FILES "SETUPAX", "SETUPAY" AND "SETUPAZ". THIS PROGRAM IS ACTIVATED BY THE FOLLOWING COMMAND : SETUPA P4AMY ===================== WHERE P4AMY IS A OUTPUT FILE USED TO CONTAIN  PROCEDURE COMPLETABLE IN BOTH PROGRAMS "P4ASM" AND "P4MAC". l = AN PRR FILE USED TO CONTAIN SOME USEFUL INFORATION FOR USER REFERENCE. **************************************************************) PROGRAM SETUPA(OUTPUT, PRR); CONST TABLESIZE = 256; TABSIZE0 = 255; (** IE TABLE SIZE WITH ZERO ORIGIN **) TYPE STRING4 = ARRAY[1..4] OF CHAR; STRING6 = ARRAY[1..6] OF CHAR; TEMPLATE = RECORD PCODE : STRING4; 9 SEMICODE : STRING6; ACTION : INTEGER END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; I, J : 1..TABLESIZE; ZERO, ENTRIES, PETTY, K : INTEGER; PROCEDURE HASH?(HPCODE : STRING4; HSEMICODE : STRING6; HACTION : INTEGER); VAR TEMP, PI, RNDM : INTEGER; BEGIN TEMP := ORD(HPCODE[1]) * 4 + ORD(HPCODE[2]) * 2 + ORD(HPCODE[3]) ; IF ORD(HPCODE[m4]) <> 0 THEN TEMP := TEMP * 2 + ORD(HPCODE[4]); TEMP := TEMP MOD TABLESIZE; RNDM := 1; PI := 0; WHILE PCODETABLE[ (TEMP + PI) MOD TABLESIZE ].PCODE <> ' ' DO BEGIN (* OF THE REHASHING ALGORITHM MENTIONED BY9 DAVID GRIES IN HIS 'COMPILER CONSTRUCTION' *)  RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); END; (* AN EMPTY ENTRY IN THE PCODE TABLE IS FOUND *) WITH PCODETABLE[ (TEMP + PI)~o MOD TABLESIZE ] DO BEGIN PCODE := HPCODE; SEMICODE := HSEMICODE; ACTION := HACTION; END; ENTRIES := ENTRIES + 1 END (* OF HASH *); (*<<<<<<<<<<<<<<<<<<<< SETUPAX ENDS HERE >>>>>>>>>>>>>>>>>>>>*) GRAPH. #okPROGRAM GRAPH1(OUTPUT); CONST D=0.0625; S=32 ; H=34 ; C=6.28318 ; LIM=32 ; VAR X,Y:REAL; I,N:INTEGER; BEGIN FOR I:=0 TO LIM DO BEGIN X:=D*I; Y:=EXP(-X)*SIN(C*X) ; N:=TRUNC(S*Y)+H; REPEAT WRITE(' '); N:=N-1 - UNTIL N=0; WRITELN('*') END END. R2RREAL.SR ;z| .TITL R2RREAL ; THE P-CODE INTERPRETER'S REAL NUMBER OPERATIONS .ENT PADR,PSBR,PFLT,PFLO,PTRC,PNGR,PSQR,PABR,PMPR,PDVR .EXTD WSA .EXTN PFPIN,PFPES,PFPEX,PFPEF .NREL .PFPN: PFPIN ;ENTRY USED BY UNARY OPERATORS .PFPS: PFPES ;STORE FP0 ON STACK AND LEAVE RFPI .PFPX: PFPEX ;LEAVE RFPI WITHOUT STORING FP0 .PFPF: PFPEF ;SIMPLY CHECK RFPI FLAGS PFPBN: STA 3,AC3 ;USED BY FP BINARY OPERATORS JSR @.PFPN FDSZ SP ;GET SECOND FDSZ SP ;FP OPERAND FLDA 0,@SP ;FROM STACK FJMP @AC3 AC3: 0 PADR:#| JSR PFPBN FADD 1,0 FJMP @.PFPS PSBR: JSR PFPBN FSUB 1,0 FJMP @.PFPS SAC3: 0 FLSUB: STA 3,SAC3 ;USED ONLY BY THE FLOATS SUB 2,2 ;SL TO DL INTEGER LTOP1 3 ;GET TOP OF STACK MOVL# 3,3,SZC ;-VE ? ADC 2,2 ;YES STOP1 2 PUSH1 3 ;LS HALF OF DL IլNT JMP @SAC3 PFLT: JSR FLSUB JSR @.PFPN ;LOAD INTO FAC1 REDUNDANT FFLO @SP FJMP @.PFPX PFLO: POP1 0 ;FLOATS ITEM BELOW TOP POP1 1 ;OF STACK.....ASSUMES JSR FLSUB ;REAL ON TOP OF STACK JSR @.PFPN FFLO @SP FEXT ISZ SP ;RESTORE SP PUSH1 1 PUSH1 0 JMP @.PFPF PTRC: JSR @.PFPN ;FIXES TOP OF STACK FFIX @SP ;THIS FIXES TO DL FEXT ISZ SP ;RESTORE SP POP1 1 ;GET LS HALF OF DL INT LTOP1 0 ;MS HALF OF DL INT MOVZL 1,2  ;FOLLOWING TESTS THAT INC 0,0,SNC ;SIGN OF BOTH HALVES = MOVZR 0,0,SZR ;AND MS HALF HAS NO VALUE JMP PTRCE ;CONDITIONS NOT MET STOP1 1 JMP @.PFPF PTRCE: ERR.P PERTR ;TRUNCATE ERROR PNGR: JSR @.PFPN ;NEGATE FP NUMBER FNEG 1,0 FJMP @.PFPS PSQR: JSR @.PFPN ;SQUARE FP NUMBER FMOV 1,0 FMPY 1,0 FJMP @.PFPSH> PABR: JSR @.PFPN ;ABS OF FP NUMBER FPOS 1,0 FJMP @.PFPS PMPR: JSR PFPBN ;MULTIPLY FP FMPY 1,0 FJMP @.PFPS PDVR: JSR PFPBN ;DIVIDE FP NUMBER FDIV 1,0 FJMP @.PFPS .END FASTHASH.i!(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ------------------------------ AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (***********j****************************************************** THIS PROGRAM IS TO READ IN THE HASH TABLE FROM THE INPUT FILE "SETUP.TB" PRODUCED BY THE PROGRAM "SETUP". IT THEN PROCESSES A  BIG PCODE PROGRAM (PREFERABLY "P4ASM.PC" OR "P4MAC.PC") TO OBTAIN THE FREQUENCIES OF THE PCODE INSTRUCTIONS. FINALLY IT PRODUCES A PROCEDURE (IE THE PROCEDURE COMPLETETASK IN THE PROGRAM "SETUPA"). THE ORDERING OF THE HASHING SEQUENCE IN THE OUTPUT PROCEDURE IS SUCH THAT ACCESSING THE PCODE INSTRUCTIONS IN THE TABLE WILL BE MUCH MORE IMPROVED. TO ACTIVATE THIS PROGRAM, DO THE FOLLOWING COMMAND :  FASTHASH PCODEPROGRAM SETUPAY SETUP.TהB DEVICE ============================================= WHERE SETUP.TB = INPUT FILE CONTANING THE HASH TABLE PRODUCED BY THE PROGRAM "SETUP". = PRD k$FILE CONTAINING ANY BIG PCODE PROGRAM ( IE "P4ASM.PC" OR "P4MAC.PC"). SETUPAY = OUTPUT FILE CONTAINING THE PROCEDURE WHICH  IS "PROCEDURE COMPLETETASK " IN THӫE PROGRAM "SETUPA". = PRR FILE CONTAINNG FREQUENCIES OF PCODE INSTRUCTIONS IN PCODEPROGRAM FOR USER REFERENCE. ***************************!*****************************************) PROGRAM FASTHASH(PRD, PRR, INPUT, OUTPUT); LABEL 0; CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) TYPE INSTRTYPE = (COMMENT, LLABEL, NONPCODE, PCODES, PCODENTRY); STRING3 = ARRAY[1..3] OF CHAR; STRING4 = ARRAY[1..4] OF CHAR; TEMPLATE = RECORD PCODE : STRING4; SEMICODE, ACTION, FREQUENCY : INTEGER  END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; SORT : RECORD SPCODE :STRING4;  SSEMICODE, SACTION, SFREQUENCY : INTEGER END;  CH : CHAR; DOTNAME : STRING3; I, J, ICOUNT, SMIN, SMAX : INTEGER; ENT : BOOLEAN; PCTYPE : INSTRTYPE; PROCEDURE OCTALIZER(SMCODE : INTEGER); VAR I, TEMP : INTEGER;  COMPLEMENT : BOOLEAN; OCTALDIGIT : ARRAY[1..6] OF INTEGER; BEGIN COMPLEMENT := SMCODE < 0; SMCODE := ABS(SMCODE); FOR I := 1 TO 6 DO BEGIN TEMP := SMCODE DIV 8; OCTALDIGIT[I]:= ABS(SMCODE - TEMP * 8); SMCODE := TEMP END; IF COMPLEMENT THEN BEGIN I := 1; WHILE OCTALDIGIT[I] = 0 DO I := I + 1; OCTALDIGIT[I] := 8 - OCTALDIGIT[I]; I := I + 1; WHILE I < 6 DO BEGIN OCTALDIGIT[I] := 7 - OCTALDIGIT[I]; I := I + 1 END; OCTALDIGIT[6] := 1 END; FOR I := 6 DOWNTO 1 DO WRITE(PRR, OCTALDIGIT[I] : 1) END (* OF OCTALIZER *); PROCEDURE CHECK; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; OP  : STRING4; PROCEDURE ERRORP; BEGIN MORETRY := FALSE; WRITE(OUTPUT, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(PRD, CH); WRITE(OUTPUT, CH) UNTIL EOLN(PRD); READ(PRD, CH); (* RID EOLN *) WRITE(OUTPUT, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(OUTPUT) END (*** ERRORP ***); BEGIN (* OF CHECK *) OP[1] :=XC CH; READ(PRD, OP[2], OP[3]); IF EOLN(PRD) THEN OP[4] := ' ' ELSE READ(PRD, OP[4]); READLN(PRD); TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THE}N TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLESIZE; MORETRY := TRUE; SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP F ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE] DO BEGIN IF OP = PCODE THEN BEGIN FREQUENCY := FREQUENCY + 1; MORETRY := FALSE; ENCD ELSE IF PCODE = ' ' THEN ERRORP; IF MORETRY THEN BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); SMAX := SMAX + 1 END{! END END (*** OF CHECK ***); BEGIN (* OF MAIN *) WRITELN(OUTPUT, '; FASTHASH START', 'S NOW'); ICOUNT := 3; REPEAT READ(INPUT, CH) UNTIL CH = '*'; (*READ OFF HASH TABLE HEADER *) FOR I := 0 TO TAUBSIZE0 DO WITH PCODETABLE[I] DO BEGIN FOR J := 1 TO 4 DO READ(INPUT, PCODE[J]); READLN(INPUT, SEMICODE, ACTION) END; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO IF PCODE[1] = ' ' TH0EN FREQUENCY := -1; (************ START READING IN THE PCODE PROGRAM FROM PRD ************) (* HASH TABLE HAS JUST BEEN READ IN FROM SETUP.TB *) READ(PRD, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(OUTPUT, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(OUTPUT); GOTO 0 END; READLN(PRD); REPEAT READ(PRD, CH); IF CH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF CH = 'P' THEN PCTYPE := PCODENTRY ELSE BEGIN READ(PRD, CH); IF CH = '.' THEN PCTYPE := NONPCODE ELSE PCTYPE := PCODES >JEND; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(PRD, J); IF (ICOUNT <> J) AND (J <> 0) THEN WRITELN(O3UTPUT, 'I', J : 5, ' ' : 14, '; ??? PCODE'  , ' COUNT OUT OF ST', 'EP ???'); ICOUNT := J; READ(PRD, CH) (* READ OFF EOLN *) END;  LLABEL : (* LABELS *) READLN(PRD); NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) READLN(PRD); PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN | CHECK;  ICOUNT := ICOUNT + 1 END; PCODENTRY : (* PACKED PCODE ENTRY POINT *) READLN(PRD) END (* OF CASE PCTYPE *); WHILE EOLN(PRD) DO READLN(PRD) UNTIL EOF(PRD); WRITELN(OUTPUT); WRITELN(OUTPUT, '; IDEAL SEARCHES', ' = ', SMIN); WRITELN(OUTPUT, '; ACTUAL SEARCHE', 'S = ', SMAX); J := 1; REPEAT ENT := FALSE; FOR I := 0 TO TABSs IZE0 - J DO BEGIN  IF PCODETABLE[I].FREQUENCY < PCODETABLE[I + 1].FREQUENCY THEN BEGIN ENT := TRUE; WITH PCODETABLE[I], SORT DO BEGIN  SPCODE := PCODE; SSEMICODE := SEMICODE; SACTION := ACTION; SFREQUENCY := FREQUENCY END; PCODETABLE[I].PCOtDE := PCODETABLE[I + 1].PCODE; PCODETABLE[I].SEMICODE := PCODETABLE[I + 1].SEMICODE; PCODETABLE[I].ACTION := PCODETABE[I + 1].ACTION; PCODETABLE[I].FREQUENCY := PCODETABLE[I + 1].FREQUENCY; WITH PCODETABLE[I + 1], SORT DO BEGIN PCODE := SPCODE; SEMICODE := SSEMICODE; ACTION := SACTION;  FREQUENCY := SFREQUENCY END END END; J := J + 1; UNTIL NOT ENT; WRITELN(OUTPUT); FOR I := 1 TO 4 DO WRITE(OUTPUT, ' PCODE' : 10, ' SMCODE' : 7, ' ACT' : 4, ' FREQ' : 5); WRITELN(OUTPUT); FOR I := 1 TO 4 DO WRITE(OUTPUT, '----------' : 10, '=======' : 7, '----' : 4, '*****' : 5); WRITELN(OUTPUT); I := 0; REPEAT WITH PCODETABLE[I] DO BEGIN WRITE(OUTPUT, PCODE : 10, SEMICODE : 7, ACTION : 4, FREQUENCY + 1 : 5); IF I MOD 4 = 3 THEN WRITELN(OUTPUT) END; I := I + 1 UNTIL PCODETABLE[I].FREQUENCY = -1; WRITELN(OUTPUT); WRITELN(PRR); WRITELN(PRR, 'PROCEDURE COMPLE', 'TETASK;'); WRITELN(PRR); WRITELN(PRR); I := 0; J := 1; WRITELN(PRR, 'PROCEDURE TASK0;'); WRITELN(PRR, 'BEGIN'); REPEAT WITH PCODETABLE[I] DO BEGIN IF I MOD 30 = 29 THEBN BEGIN WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR); WRITELN(PRR, 'PROCEDURE TASK' : 14, J : 1, '; '); WRITELN(PRR, 'BEGIN'); J := J +02 1 END; WRITE(PRR, ' ' : 5, 'HASH(''' : 6, PCODE : 4, ''', ''' : 4); OCTALIZER(SEMICODE); WRITELN(PRR, ''', ' : 3, ACTION : 4, ');') END; I := I + 1;  UNTIL PCODETABLE[IS].PCODE = ' '; WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR, 'BEGIN'); FOR I := 0 TO J - 1 DO WRITELN(PRR, ' ' : 5, 'TASK' : 4, I : 1, '; '); WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR); WRITELN(PRR)&`; 0 : WRITELN END. PRIMES.& E-PROGRAM PRIMES(OUTPUT); (* EXAMPLE P54 PASCAL USER MANUAL AND REPORT *) CONST WDLENGTH=16; MAXBIT=15; W=2; VAR SIEVE,PRIMES : ARRAY[0..W] OF SET OF 0..MAXBIT; NEXT : RECORD WORD,BIT : INTEGER END; J,K,T,C : INTEGER; EMPTY : BOOLCEAN; BEGIN FOR T:=0 TO W DO BEGIN SIEVE[T]:=[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]; PRIMES[T]:=[] END; SIEVE[0]:=SIEVE[0]-[0]; NEXT.WORD:=0; NEXT.BIT:=1; EMPTY:=FALSE; WITH NEXT DO REPEAT WHILE NOT(BIT IN SIEVE[WORD]) DO BIT:=SU:PCC(BIT); PRIMES[WORD]:=PRIMES[WORD]+[BIT]; C:=2*BIT+1; J:=BIT; K:=WORD; WHILE K<=W DO BEGIN SIEVE[K]:=SIEVE[K]-[J]; K:=K+WORD*2; J:=J+C; WHILE J>MAXBIT DO BEGIN K:=K+1; J:=J-WDLENGTH  END END; IF SIEVE[WORD]?=[] THEN BEGIN EMPTY:=TRUE; BIT:=0 END; WHILE EMPTY AND (WORDC 0,0,SZR JMP .-2 JMP 0,3 .RITE: WRITE BIND: .BIND XWRI: POP1 2 ;FBA MOVZR 2,2 POP1 0 ;$ OF CHARS STA 0,AD1 ;KEEP A COPY POP1 1 ;INTEGER JSR @BIND PURGE: LDA 2,FCH,2 ;CHANNEL # LDA 1,RHB AND 1,2 LDA 3,BFHLF ;BUFFER HALFWAY LDA 1,BFPTR ;PTR UPDATED BY PUT SUBZ 3,1,SEZ ;CHARS IN BUFF JMP OK ERR.P ;REPORT NOTHING PERIW ; TO PRINT OK: SUBZ 1,0,SBN ;LEADING SPACES ? JMP NOLDR ;NO SUB 0,3 ;YES LDA 1,AD1 ;GET # OF CHARS NOLDR: MOV 3,0 ;BYTE PTR JSR @.RITE ; ;NOW RESET BUFFER TO ALL SPACES ; LDA 2,BFHLF STA 2,BFPTR ;RESET PTR SUB 0,0 STA 0,PUTFL NEXT PUTCH: STA 3,Z1 LDA 1,PUTFL ;GET FLAGS MOVL# 1,1,SZC ;SIGN FLAG SET ? JMP SSET ;YES MOVZR 0,0,SNC ;NO - B15 0 FOR SPACE JMP @Z1 ;IGNORE SPACES MOVR 1,1 ;CARRY> IS #0 - USE IT STA 1,PUTFL ;SIGN ENCOUNTERED MOVZR# 0,0,SZC ;+ OR - ? JMP @Z1 ;+ MOVOL 0,0 ;REFORM - JMP SAND ;LETIT GO SSET: MOVR# 1,1,SZC ;DIGIT FLAG SET ? JMP SAND ;YES LDA 2,ZERO ;NO - LEADING ZERO ? SUB# 0,2,SNR JMP @Z1 ;IGNORE LEAD&ING ZEROES MOV 0,0,SZR ;NULL TERMINATING INTEGER ? JMP SETD MOV 2,0 ;PASS ZERO FOR NULL JMP SAND SETD: INC 1,1 ;SET DFLAG STA 1,PUTFL ;SET D FLAG SAND: MOVS 0,0,SNR ;LAST NULL ? JSR @Z1 ;YES - IGNORE IT LDA 2,BFPTR ;CURRENT POSN. JSR @.BPUT ISZ BFPTR JMP @Z1 ZERO: 60 SPWD: 1B2+1B10 ;SPACE IN EACH BYTE BFSIZ: 66. ;WORDS BFBP0: BUFFA*2 ;FIRST CHAR BFHLF: BUFFA*2+66. ;HALFWAY CHAR BFPTR: BUFFA*2+66. ;CURRENT PTR BUFFA: .DO 66. ;LINE BUFFER 1B2+1B10 .ENDC .END R2STESTS.SR 6Ɲ .TITL R2STESTS ; THE P-CODE INTERPRETER'S COMPARISON OPERATIONS ; THESE ARE RATHER TRICKY: "DOCUMENTATION" AVAILABLE FROM LW .ENT PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PFPIN .EXTD MIN4,WSA,LHB .NREL ASP=Z1 ;SEE PSSET ABOUT ASP & SASP .MACRm"O SASP LDA ^1,SP LDA 0,MIN4 ADD 0,^1 STA ^1,ASP % ; BRANCH TABLE FOR SUBROUTINE COMP COMTAB: CM ;MULTIPLE CI ;INTEGER CR ;REAL CI ;BOOLEAN CS ;SET CI ;ADDRESS ; HELPFUL HINT: SUBROUTINE COMP LEAVES ZERO IN AC0. THEREFORE, IN ; THE FEOLLOWING PEQU ET AL:- ; "INC 0,0" MEANS "AC0:= TRUE" ; "SUBCL 0,0" " "AC0:= VALUE OF CARRY" ; "SUBL 0,0" " "AC0:= VALUE OF NOT CARRY" ; NONE OF ABOVE " "AC0 REMAINS FALSE" PEQU: JSR COMP MOV# 1,1,SNR ;IFF AC1=0 & CARRY=0 SUBL 0,0 JMP COM2 PNEQ: JSR COMP MOV# 1,1,SNR ;IFF AC1 NON-ZERO OR (AC1=0 & CARRY=1) SUBCL 0,0,SKP INC 0,0 JMP COM2 PGEQ: JSR COMP SUBL 0,0 ;IFF CARRY=0 JMP COM2 PGRT: JSR COMP MOVC 1,1,SEZ ;IFF AC1 NON-ZERO & CARRY=0 INC 0,0 JMP COM2 PLEQ: JSR }COMP MOV# 1,1,SNR ;IFF (AC1=0 & CARRY=0)OR CARRY=1 SUBL 0,0,SKP SUBCL 0,0 JMP COM2 PLES: JSR COMP MOV# 1,1,SEZ ;IFF AC1 NON-ZERO & CARRY=1 INC 0,0 JMP COM2 COM2: STOP1 0 NEXT .COMT: COMTAB ; COMP IS A UNIVERSAL (IE CAN BE USED FOR ALL STANDARD TYPES) ; SUBROUTINE WHICH COMPARES THE TOP 2 ELEMENTS OF THE STACK. IT ; RETURNS CARRY & AC1 SET AS FOLLOWS:- ; CARRY=1 <=> LESS THAN ; AC1=0 <=> EQUAL ; PLUS THE SPECIAL CASE (FOR SETS ONLY) ; (CARRY=1 & AC1=0) <=> "NO RELATION" ; THISv IS SUFFICIENT INFO FOR ANY OF THE 6 COMPARISON OPS ; IF YOU REALLY INSIST ON STUDYING THIS CODE, HAVE 2 ASPRINS READY - ; & BLAME JJS, NOT ME ; OTHER POINTS TO NOTE ARE THAT S/R COMP CLEARS ALL RUBBISH OFF THE ; STACK & SETS AC0="FALSE" SO THAT (AFTER POSSIBLE RESETTING ; BY PEQU ET AL) IT IS ALL READY FOR A QUICK "STOP1" COMP: MOV 2,0 ;FIRST WE BRANCH ACCORDING TO TYPE LDA 2,.COMT ADD 1,2 JMP @0,2 .PFPN: PFPIN ; *** REAL - COMPARISON IS ARITH SUBTRACTION CR: MOV 3,0 ;TO PRESERVE LINK JSR @.PFPN& ;INIT'ISE FP & LOAD FAC1 FDSZ SP FDSZ SP FLDA 0,@SP FSUB 1,0 FSTA 0,@SP FEXT ;EXIT FLOAT.PT LDA 2,WSA ;CHECK REPLY WD OK LDA 1,0,2 MOV 1,1,SNR JMP CR1 ;IF NO PROBS ERR.P PERFP CR1: MOV 0,3 ;RESTORE LINK SUB 1,1 ;CRAFTY USE OF INTEGER PHATH! PUSH1 1 JMP CI ; *** MULTIPLE - ARITH SUBTR OF "N-WORDS-LENGTH" INTEGERS (UNSIGNED) CM: NEG 0,2 ;START AT MOST SIGNIFICANT END. WHILE POP1 0 ;WORD-PAIRS ARE EQUAL, CARRY ON. FIRST MOVZR 0,0 LTOP1 1 ;UNEQUAL PAIR GIVES REQD RELATION MOVZR 1,1 STA 0,AI1 DSZ AI1 STA 1,AI2 DSZ AI2 CM1: LDA 0,@AI1 LDA 1,@AI2 INC 2,2,SZR ; TO DEAL WITH ODD BYTE JMP CM2 ; - NO LDA 2,LHB ; YES AND 2,0 ; AND 2,1 SUB 2,2 COM 2,2 CM2: SUBO 0,1,SNR INCC 2,2,SNR JMP COM1 JMP CM1 ; *** INTEG,BOOLE,ADDR#} - ARITH SUBTR (UNSIGNED) CI: POP1 0 LTOP1 1 ADDOR 0,0 ;CONVERTS SIGNED INTEGERS TO UNSIGNED ADDOR 1,1 SUBO 0,1 JMP COM1 ; *** SET - LOOK AT CORRESPONDING WORD-PAIRS. WHENEVER "NO RELN", ; EXIT "NO RELN". WHILE "EQUAL", KEEP OPEN MIND. BUT AS SOON AS GEQ ; OR LEQ FOUND, ALL THE REST MUST BE GEQ OR LEQ RESPECTIVELY, ELSE ; "NO RELN" CS: SASP 2 CS1: POP1 0 LDA 1,@ASP DSZ ASP SUBZ# 0,1,SZR JMP CS2 ;IF NOT EQU LDA 0,SP SUBZ# 0,2,SNC JMP CS1 SUBO 1,1 JMP CS6 ;IF EQU (DONE) CS2: AND 0,1 SUB#V 0,1,SNR JMP CS4A ;IF GEQ SO FAR ISZ ASP LDA 0,@ASP DSZ ASP SUB# 0,1,SNR JMP CS5A ;IF LEQ SO FAR CS3: STA 2,SP SUBZ 1,1 JMP CS6 ;ELSE NEQ (DONE) CS4: POP1 0 LDA 1,@ASP DSZ ASP AND 0,1 SUBZ# 0,1,SNC JMP CS3 ;IF NEQ (DONE) CS4A: LDA 0,SP SUBZ# 0,2,SNC JMP CS4 MOVZ 0,1 ;SETS C=0 & AC1 NON-ZERO STA 2,SP JMP CS6 ;IF GEQ (DONE) CS5: POP1 0 LDA 1,@ASP DSZ ASP AND 1,0 SUBZ# 1,0,SNC JMP CS3 ;IF NEQ (DONE) CS5A: LDA 0,SP SUBZ# 0,2,SNC JMP CS5 MOVO 0,1 ;SETS C & AC1 NON-ZERO STA 2aLk,SP ;IF LEQ (DONE) CS6: POP ;GET RUBBISH OFF STACK POP POP COM1: SUBC 0,0 JMP 0,3 .END MAKER2SYMB.CMm 5߼DELETE MAC.PS;^ MAC/N/S NBID FPID OSID R2SSYMBOLS^ R2ROUTL.SR R .TITL R2ROUTL .ENT .BPUT,.BGET,.GCH,.FIND .ENT TEMP .EXTN ERR2,FINT,ERRP,PCODE .EXTD CHAN,SPACE,TEMP2,CNTAD,TABAD .EXTD LHB,RHB .TXTM 1 .ZREL ; DEFINE SOME CONSTANTS IN PAGE ZERO THAT ARE ASSUMED TO HAVE ; ADDRESSES 50 AND 51.... ERR2 ; .ERR2 = 50 ERRP ; .ERRP = 51 .BPUT: BPUT .BGET: BGET .GCH: GCHAN .CTAB: CTAB .BTAB: BTAB-1 .OTAB: OTAB-1 .TTAB: TTAB-1 .FIND: FIND TEMP: 0 .NREL ; ROUTINE TO WRITE A BYTE TO A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - BYTE TO BE WRITTEN(IN LHB) ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED BPUT: STA 3,BLNK ;LINK STORED LDA 1,LHB ;MASK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMI{NE WHICH BYTE MOVS 0,0,SKP ;RIGHT OR LEFT? MOVS 1,1 LDA 3,0,2 ;LOAD FROM WORD ADDRESS AND 1,3 ;MASK OUT OTHER BYTE ADD 0,3 ;REPLACE WITH NEW BYTE STA 3,0,2 ;AND RESTORE JMP @BLNK ; ROUTINE TO READ A BYTE FROM A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - VALUE OF BYTE READ(IN LHB) ; AC1 - UNDEFINED ; AC2 - UNDEFINED BGET: STA 3,BLNK ;STORE LINK LDA 1,LHB ;BYTE MA#SK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHICH BYTE MOVS 1,1 ;RIGHT OR LEFT? LDA 0,0,2 ;LOAD FROM WORD ADDRESS. AND 1,0,SZC ;EXTRACT BYTE MOVS 0,0 ;SWOP INTO LHB JMP @BLNK ; ROUTINE TO GET THE CHANNEL NO. AND RECORD LENGTH OF SPECIFIC FILE. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - CHANNEL NUMBER ; AC1 - RECORD LENGTH ; AC2 - WORD ADDRESS OF FBA ; ; NORMAL RETURN - NONYE CHARACTER INPUT/OUTPUT ; RETURN + 1 - CHARACTER INPUT/OUTPUT GCHAN: STA 3,BLNK ;STORE LINK LDA 1,LHB ;MASK FOR LEFT HAND BYTE LDA 0,FCH,2 ;CHANNEL WORD OF FBA ANDS 0,1,SNR ;ISOLATE RECORD LENGTH ISZ BLNK ;AND TEST IF CHAR I/O. MOVZL 1,1 " ;MAKE IT A BYTE COUNT LDA 3,RHB ;MASK CHANNEL NUMBER AND 3,0 STA 0,CHAN JMP @BLNK BLNK: 0 ; ROUTINE TO SEARCH TABLES FOR BUFFER DETAILS. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - CHANNEL NUMBER OF FILE (OR ZERO) ; ; RETURN - AC0 - BYTE ADDRESS OF BUFFER AREA(BASE) ; AC1 - ADDRESS OF BYTE COUNT (DISPLACEMENT) ; AC2 - WORD ADDRESS OF ENTRY IN CHANNEL TABLE FIND: LDA 0,TSIZE ;SIZE OF TABLE LDA 1,.CTAB ;ADDRESS OF CHANNExL TABLE(TOP) STA 1,TEMP RETST: LDA 1,@TEMP ;SEARCH UNTIL A MATCH OR ERROR SUB 2,1,SNR JMP RETRN ;A MATCH IS FOUND DSZ TEMP INC 0,0,SZR ;TABLE EXHAUSTED? JMP RETST ;NO,FIND NEXT ERR.P ;YES, BLOW..... 411 RETRN: LDA 1,.OTAB SUBZ 0,1 ;ADDRESST OF BYTE COUNT(DISPLACEMENT) STA 1,CNTAD LDA 1,@CNTAD ;LOAD ACTUAL COUNT LDA 2,C200 SUBZ# 1,2,SZC ;TEST IF LINE TOO LONG JMP .+3 JSR .NERR ;LINE LIMIT FLAGGED TO CLI 22 LDA 1,CNTAD LDA 2,.TTAB SUB 0,2 ;ENTRY IN THE TABLE TAB COUNTS STA 2,TABA)D LDA 2,.BTAB SUB 0,2 LDA 0,0,2 ;SET BUFFER ADDRESS(BASE) LDA 2,TEMP ;CHANNEL TABLE ADDRESS JMP 0,3 .NERR: LDA 2,0,3 ;PICK UP ERROR CODE ERR.2 C200: 200 TSIZE: -4 ;TABLE SIZE 0 0 0 CTAB: 0 ;TOP OF CHANNEL TABLE OTAB: .BLK 4 ;COUNT TABLE TTAŢB: .BLK 4 ;TAB COUNTER FOR ASCII INPUT/OUTPUT BTAB: BUFF1*2 ;BUFFER TABLE BUFF2*2 BUFF3*2 BUFF4*2 BUFF1: .BLK 104 ;BUFFERS BUFF2: .BLK 104 BUFF3: .BLK 104 BUFF4: .BLK 104 .LOC .-420 ; P-CODE SYSTEM INITIALISATION PROCEDURES. .PCODE: PCODE PI: .SYS5TM ; X1 := NMAX; X0 := HMA; .MEM JMP . STA 0,HP ; INITIALISE HEAP POINTER TO MAX ADR SUB 1,0 ; X0 := INCREMENT FOR .MEMI CALL STA 1,DSP ; STACK STARTS AT INITIAL NMAX STA 1,MP STA 1,SP DSZ SP LDA 3,HP ; GET THE TOP OF THE HEAP STA 3,@DSP ;4STORE IT IN THE STACK BASE .SYSTM ; ALLOCATE ALL AVAILABLE STORE .MEMI JMP . SUB 2,2 ;CHANNEL ZERO FOR 'COM.CM' SUB 1,1 ;NORMAL CHARACTERISTICS LDA 0,.COMF ;'COM.CM' .SYSTM .OPEN 77 ERR.2 LDA 2,.PCODE LDA 2,2,2 ;PICK UP THE LABEL OF FIRST CUP LDA 1,C5 ADD 1,2 ;FORM ADDRESS OF FIRST POSSIBLE FILENAME STA 2,STPC JSR COMA1 JSR COMA2 ;READS PROGRAM NAMEAND GLOBAL SWITCHES RENU: JSR COMA1 ;READS NAME OF SECOND ARGUEMENT LDA 2,.COMA STA 2,TEMP ;SET UP THE BUFFER ADDRESS LDA 2,STPC n;FIRST POSSIBLE NAME LDA 1,13,2 ;FIRST POSSIBLE OPEN COMMAND LDA 0,COPN ; CSP OPN SUB 1,0,SZR ;IS IT A MATCH JMP NOMAT ;NO - THEN BLOW UP.... MOVZL 2,2 ;YES - THEN REPLACE FILENAME STA 2,TEMP2 LDA 0,M20 ;INITIAL COUNT STA 0,COUNT NEXToB: LDA 2,TEMP JSR @.BGET ;GET THE NEXT BYTE LDA 2,TEMP2 JSR @.BPUT ;PUT IT INTO THE FILENAME MOV 0,0,SNR ;TEST IF NULL AFTER THE PUT.... JMP ENAME ISZ TEMP ;UPDATE POINTERS ISZ TEMP2 ISZ COUNT ;ERROR IF OVER.. JMP NEXTB JSR .NERR 317 NOMAT': JSR .NERR 313 ; ROUTINE TO READ THE FILENAME COMA1: STA 3,TEMP LDA 0,.COMA ;ARGUEMENT BUFFER SUB 2,2 ;CHANNEL ZERO .SYSTM .RDL 77 ;READ THAT NAME JMP TSTEF ;SEE IF EOF? JMP @TEMP TSTEF: LDA 1,C6 ;TEST IF EOF SUB# 1,2,SZR ERR.2 ;IF NOT THEN BLOW... JMP ENDAL ; ROUTINE TO READ THE SWITCHES COMA2: STA 3,TEMP LDA 0,.SWA ;SWITCH BUFFER LDA 1,C4 ;TWO WORDS SUB 2,2 ;CHANNEL ZERO .SYSTM .RDS 77 ;READ FOUR BYTES JMP TSTEF JMP @TEMP ENAME: LDA 0,SPACE ;FILL OUT WITH SPACES LDA 2,ZTEMP2 JSR @.BPUT ISZ TEMP2 ISZ COUNT JMP ENAME LDA 2,STPC ;UPDATE THE POINTER TO THE PCODE LDA 1,C15 ;BY AN APPROPRIATE AMOUNT ADD 1,2 STA 2,STPC JSR COMA2 LDA 0,SWA ;PICK UP SWITCHES MOVZL 0,0,SNC ;AND TEST IF 'A' SET ON. JMP RENU ;NO...THEN GET NEXT PARAMETER SUBZR 0,0 ;OTHERWISE SET BIT 0 OF NULLS LDA 2,STPC LDA 1,-5,2 ;COUNT ADD 0,1 STA 1,-5,2 ;RESTORE COUNT JMP RENU ENDAL: FINT ;START RFPI LDA 0,.PCODE ; INITIALISE PC STA 0,PC DSZ PC NEXT .COMF: COMF*2 COMF: .TXT 'COM. CM' C5: 5 C4: 4 C15: 15 C6: 6 .COMA: COMA*2 .SWA: SWA*2 STPC: 0 M20: -20 COUNT: 0 COPN: 161425 COMA: .BLK 10 SWA: .BLK 2 .END PI R2SMPD.SRU+2\ .TITL R2SMPD .ENT MPY,MPY0,DVD .EXTD .SV0 .ZREL MPYA: .MPYA MPYU: .MPYU DIVU: .DIVU .NREL MPY0 = JSR @MPYU MPY = JSR @MPYA DVD = JSR @DIVU ; SINGLE PRECISION FAST MULTIPLICATION ; ; ENTRY CONDITIONS - AC0 - ZERO OR VALUE TO BFE ADDEDTO RESULT ; AC1 - MULTIPICAND ; AC2 - MULTIPLIER ; AC3 - LINK ; ; EXIT CONDITIONS - AC0 - RESULT ; AC1-AC3 - UNDEFINED .MPYU: SUBC 0,0 ;CLEAR AC0, DON'T DISTURB CARRY .MPYA: STA 3,SAV3 ;SAVE AC3 ADCZ# 1,2,SZC ;SKIPS IF AC2/<=AC1 MOV 2,3,SKP ;LARGEST IN AC3 MOV 1,3,SKP MOV 1,2 ;SMALLEST (COUNT) AC2 SPFM: MOVZR 2,2,SZC ;BIT SET? ADD 3,0 ;YES MOV 2,2,SNR ;LAST BIT? JMP .+3 ;YES ADDZ 3,3 ;NO.. JMP .-5 ;..SO REPEAT MOV 0,1 SUB 0,0 JMP @SAV3 ; SINGLE PRECISION \UNSIGNED DIVIDE ; ; ENTRY CONDITIONS AC0 - DIVIDEND (HIGH ORDER) MOST SIG.BITS ; AC1 - DIVIDEND (LOW ORDER) LEAST SIG.BITS ;  AC2 - DIVISOR ; AC3 - UNUSED ; ; EXIT CONDITIONS AC0 - REMAINDER ; ] AC1 - QUOTIENT ; AC2 - UNCHANGED ; AC3 - DESTROYED ; .DIVI: SUB 0,0 ; INTEGER DIVIDE,CLEAR AC0 .DIVU: STA 3,SAV3 ; SAVE AC3 SUBZ# 2,0,SZC ; TEST FOR OVERFLOW JMP DIVE ;SET CARRY AND RETURN LDA '$3,M20 ; 16 ITERATIONS MOVZL 1,1 ; SHIFT LOW DIVIDEND DIVN: MOVL 0,0 ; SHIFT HIGH DIVIDEND SUB# 2,0,SZC ; DOES DIVISOR GO IN? SUB 2,0 ; YES MOVL 1,1 ; SHIFT LOW DIVIDEND INC 3,3,SZR ; CHECK COUNT JMP DIVN ; NOT DONE SUBO 3,3,SKP ; DONE ,CLEAR CARRY DIVE: SUBZ 3,3 ; SET CARRY JMP @SAV3 ; RETURN M20: -20 SAV3: 0 ;RETURN ADDRESS .END ;END OF UNSIGNED MULTIPLY R2SRANDOM.SR ; .TITL R2SRANDOM .ENT XRRR,XWDR,XEOR .EXTD TEMP2,.GCH,CHAN .NREL ; INPUT / OUTPUT ROUTINES FOR RANDOM FILES ; ; XRRR: SUBZL 2,2,SKP XWDR: SUBZ 2,2 STA 2,TEMP2 ;FLAG INDICATES WHETHER READING OR WRITING POP1 2 MOVZR 2,2 ;FBA ADDRESS JSR @.GCH ;vPICK UP CHANNEL NUMBER JMP .+1 MOV 2,0 LDA 2,CHAN LDA 3,C64 ;TEST IF LESS THAN 64 POP1 1 ;GET RECORD NUMBER ADCZ# 1,3,SNC ;RECORD LENGTH. JMP WRBLK ;IT'S A BLOCK TRANSFER DSZ TEMP2 JMP WRRI ;IT'S WRITE A RANDOM RECORD JMP RRRI ;IT'S READ A RANDOM RECORD WRBLK: DSZ TEMP2 JMP WRBI ;IT'S WRITE A RANDOM BLOCK JMP RRBI ;IT'S READ A RANDOM BLOCK C64: 100 ;CONSTANT 64 DECIMAL WRRI: MOV 0,3 STA 3,77,3 ;SET THE FLAG .SYSTM .WRR 77 ;WRITE A RECORD OUT IMMEDIATELY ERR.2 NEXT WRBI: MOVA 0,3 LDA 1,C255 ADD 1,3 ;FORM FLAG ADDRESS STA 1,0,3 ;SET FLAG .SYSTM .WRB 77 ;WRITE A RANDOM BLOCK IMMEDIATELY ERR.2 NEXT RRRI: .SYSTM .RDR 77 ;READ A RECORD IMMEDIATELY ERR.2 MOV 0,2 SUB 0,0 ;TEST IF EMPTY LDA 3,77,2 MOV 3,3,SNR SUBZL4 0,0 STA 0,FST,2 ;SET FLAG IN BUFFER NEXT RRBI: .SYSTM .RDB 77 ;READ A RANDOM BLOCK IMMEDIATELY ERR.2 MOV 0,2 SUB 0,0 LDA 3,C255 ;TEST IF EMPTY ADD 3,2 LDA 3,0,3 MOV 3,3,SNR ;IF EMPTY SET FLAG SUBZL 0,0 STA 0,FST,2 ;LOAD FLAG WORD NEXT ; PREDICATE FOR RANDOM FILES XEOR: POP1 2 ;FBA MOVZR 2,2 LDA 0,FST,2 ;LOAD FLAGS MOVZR 0,0 SUBL 0,0 PUSH1 0 ;RETURN BOOLEAN VALUE NEXT C255: 377 .END RGCD.%_PROGRAM RGCD(OUTPUT); (* EXAMPLE P82 PASCAL USER MANUAL AND REPORT *) VAR X, Y, N: INTEGER; FUNCTION GCD(M,N: INTEGER): INTEGER; BEGIN IF N=0 THEN GCD:=M ELSE GCD:=GCD(N,M MOD N) END; PROCEDURE TRY(A,B: INTEGER); BEGIN WRITELN(A,B,GCD(A,B)) ENDJp; BEGIN TRY(18,27); TRY(312,2142); TRY(61,53); TRY(98,868); END. HEADA2.j v(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (*$D-********"******************************************************* !!!! ONLY GOOD FOR PASCAL RELEASE II !!!! PROGRAM "P4ASM.SV" WILL READ IN A NOVA-PCODE PROGRAM AND TRANSLATE IT INTO THE CORRESPONDING PACKED PCODE PROGRAM WHICH WILL L/ATER BE PROCESSED BY THE NOVA ASSEMBLER TO PRODUCEAN INTERNAL CODE. SOURCE PROGRAM "P4ASM" IS THE AMALGAMATION OF FOUR SMALLER FILES : "HEADA2", "P4AMX2", "P4AMY2" AND "P4ASMZ2". TO ACTIVATE THIS PROGRAM, DO TH$E FOLLOWING COMMAND : P4ASM ANYPCODE.QC DEVICE ANYPCODE.PC ==================================== WHERE ANYPCODE.PC = INPUT FILE CONTAINING A PCODE PROGRAM ANYPCODE.QC = OuOUTPUT FILE CONTAINING THE CORRESPONDING PACKED PCODE PROGRAM. DEVICE = PRR FILE OR DEVICE FOR ERROR OR USEFUL MESSAGES. ******\******************************************************) PROGRAM P4ASM(OUTPUT, PRR, INPUT); ROMAN.  PROGRAM ROMAN(OUTPUT); VAR X,Y : INTEGER; BEGIN Y:=1; REPEAT X:=Y; WRITE(X,' '); WHILE X>=1000 DO BEGIN WRITE('M'); X:=X-1000 END; IF X>=500 THEN BEGIN WRITE('D'); X:=X-500 END; WHILE X>=100 DO BEGIN WRITE('C'); X:=X-100 END; IF X>=50 THEN BEGIN WRITE('L'); X:=X-50 END; WHILE X>=10 DO BEGIN WRITE(C'X'); X:=X-10 END;  IF X>=5 THEN BEGIN WRITE('V'); X:=X-5 END; WHILE X>=1 DO BEGIN WRITE('I'); X:=X-1 END; WRITELN; Y:=2*Y UNTIL Y>5000 END. HEADM2.jN(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (*$D-*a*************************************************************** !!!! ONLY GOOD FOR RELEASE II !!!! PROGRAM "P4MAC.SV" WILL READ IN A NOVA-PCODE PROGRAM AND TRANSLATE IT INTO THE CORRESPONDING PACKED PCODE PROGRAM WHICH WILL LATER BE PROCESSED BY THE NOVA MACRO-ASSEMBLER TO PRODUCE AN INTERNAL CODE. SOURCE PROGRAM "P4MAC" IS THE AMALGAMATION OF FOUR SMALLER FILES : "HEADM2", "P4AMX2", "P4AMY2" AND "P4MACZ2". TO ACTIVATE THIS PROGRAwM, DO THE FOLLOWING COMMAND : P4MAC ANYPCODE.QC DEVICE ANYPCODE.PC ==================================== WHERE ANYPCODE.PC = INPUT FILE USED TO CONTAIN A PCODE PROGRAM ANzYPCODE.QC = OUTPUT FILE USED TO CONTAIN THE CORRESPONDING INTERNAL CODE. DEVICE = PRR FILE OR DEVICE FOR ERROR OR USEFUL MESSAGES. ******************************D ******************************) PROGRAM P4MAC(OUTPUT, PRR, INPUT); P4ASMFILES.CMrr xP4ASMFILES.CM,NEW2P4ASMB,SETUP,FASTHASH,SETUPAX,SETUPAZ,^ HEADA2,HEADM2,P4AMX2,P4ASMZ2,P4MACZ2,NEW2P4ASME,MAKE2P4AM.CM^ R2SADMIN.SR 4F .TITL R2SADMIN ; THE P-CODE INTERPRETER'S "CONTROL" OPERATIONS, I.E.:- ; BLOCK, PROCEDURE, AND FUNCTION ENTRY/EXIT ; JUMPS .ENT PMST,PCUP,PCXP,PENT,PRET,PCSP .ENT PTJP,PFJP,PUJP,PXJP,PUJC .EXTN .BASE .EXTN SPTAB .NREL ;REMEMBER... ; SP=STACK PO%INTER ; MP=MARK POINTER ; SL=STATIC LINK ; DL=DYNAMIC LINK ; RA=RETURN ADDRESS ; PC=PCODE INSTRUCTION ADDRESS ; HP=HEAP POINTER ;REMEMBER...THAT THE CONTROL INSRUCTIONS WILL BE ENCOUNTERED ;IN THE ORDER MST CUP ENT . PMST: SUB 2,2 ;CREATE NEW STACK_ FRAME .BASE ;LEAVES SL IN AC2 LDA 3,SP ;SL:= BASE(P) STA 2,1+SL,3 LDA 0,MP ; DL:= MP STA 0,1+DL,3 LDA 0,EP ; GET STACK MAX STA 0,1+MTS,3 ; MTS:=SP LDA 0,.MSL ; SP:= SP+MSL ADD 0,3 STA 3,SP NEXT .MSL: MSL ;MSL IS 5 ; CUP PASSES IN THE P\ FIELD THE NUMBER OF PARAMETERS ; ASSOCIATED WITH THE PROCEDURE. ONE WORD IS SAVED ; FOR EACH (ADDRESS OF MULTI-WORD OBJECTS PASSED) PCUP: LDA 3,SP ; MP:= SP-MSL-P+1 SUB 1,3 ;THIS STRANGE VALUE USED LDA 1,.MSD ;..BY ENT SUBSEQUENTLY SUB 1,3 STA 3,3MP LDA 0,PC ; RA:=PC STA 0,RA,3 STA 2,PC ; PC:=Q-1 DSZ PC NEXT .MSD: MSL-1 ;CXP CALL EXTERNAL PROCEDURE - BY A.F. ON 11/02/77 ;ADDED CHECKS FOR PARAMETER LENGTHS PCXP: LDA 2,0,2 ;ACTUAL ADDRESS OF PROCEDURE LDA 0,4,2 ;LOAD THE COUNT OF PARAMETERS LDA 3,ENT3 ;TEST IF AN ENT3 IS HERE? SUB 0,3,SZR JMP XPER ;ERROR NO ENT3 LDA 0,5,2 ;O.K. NOW TEST NO. OF PARAMETERS MOVZR 0,0 ;DIVIDE BY 2 SUB 1,0,SNR ;BLOW OUT... IF NOT EQUAL JMP PCUP XPER: ERR.P 412 ENT3: 61003 ; ENT GIVES IN Q FIEg)LD STACK SPACE REQD BY PROC ; (ENT1 STATIC, ENT2 DYMAMIC) ; USING STRANGE MP WE SUBTRACT # OF PARAMETERS ; FROM THIS VALUE AND UPDATE SP PENT: MOVZR 2,2 ; HALVE Q FIELD MOVZR 1,1,SNR ; FIRST ENT OF PAIR ? JMP .+4 MOV 1,1,SZC ; NO, TEST IF OTHER QNEXT ; ENT3 JMP ENT2 ; NO LDA 0,MP ; SP:=MP+Q SUB 1,1 ; MAKE ZER0 NEG 2,2,SNR ; LOCAL SPACE COUNT JMP TEST CLR: PUSH1 1 ; SET TO ZERO INC 2,2,SZR ; ALL LOCAL SPACE JMP CLR JMP TEST ; CHECK STACK ENT2: LDA 0,SP ; SP+SEGMENT ADD 2,0 ; .}. WORKSPACE STA 0,EP ; .. = MAX STACK TEST: LDA 1,HP SUBO 0,1,SNC NEXT ERR.P PERSO ; REPORT NOT ENOUGH SPACE ;IN RETURNING LEAVE ONE OR TWO WORD FUNCTION ;VALUE (IF APPROPRIATE) ON TOP OF STACK PRET: LDA 2,MP ADD 2,1 ; SP:= MP-1+P STA 1,SP ef DSZ SP LDA 0,RA,2 ; PC:= RA STA 0,PC LDA 0,MTS,2 ; EP:= MTS STA 0,EP LDA 0,DL,2 ; MP:= DL STA 0,MP NEXT PCSP: LDA 0,.SPTAB ; JUMP INDIRECT SPTAB[Q] ADD 0,2 JMP @0,2 .SPTAB: SPTAB PFJP: POP1 1 ; IF Y=FALSE THEN:- MOV# 1,1,SZR NEXT PUJP: S/TA 2,PC ; PC:= Q-1 DSZ PC NEXT PTJP: POP1 1 ; IF Y=TRUE THEN:- MOV# 1,1,SNR NEXT JMP PUJP ; PC:=Q-1 PXJP: POP1 1 ; PC:= Y+Q-1 MOVZL 1,1 ;INDEX OVER 2WDS AT A TIME ADD 1,2 JMP PUJP PUJC: ERR.P PERCJ .END R2SSPTAB.SR- .TITL R2SSPTAB .EXTN XWLN,XWRC,XWRI,XWDR,XWRS .EXTN XRDC,XRDI,XRDR,XRLN .EXTN XGET,XPUT .EXTN XELN .EXTN XATN,XCOS,XEXP,XLOG,XSIN,XSQT .EXTN XNEW,XSAV,XRST .EXTN XRND,XOPN .EXTN XCLS,XRRR,XWRR .EXTN XPAG .EXTN XEOR,XRWR,XRSE .EXTN PUNDF .ENT^ SPTAB .NREL SPTAB : XGET ;0 XPUT ;1 XRST ;2 XRLN ;3 XNEW ;4 XWLN ;5 XWRS ;6 XELN ;7 XWRI ;8 XWRR ;9 XWRC ;10 XRDI ;11 XRDR ;12 XRDC ;13 XSIN ;14  XCOS ;15 XEXP ;16 XLOG ;17 XSQT ;18 XATN ;19 XSAV ;20 XOPN ;21..OPEN ANY FILE (CREATE IMPLIED) XRND ;22 PUNDF ;23 XCLS ;24 XRRR ;25 XWDR ;26 XPAG ;27 XEOR ;28 XRWR ;29 XRSE ;30 PUNDF ;31 .END P4SOURCES.CM_P4SOURCES.CM,^ R2RFW.SR,R2SECHK.SR,R2ROUTL.SR,R2IFT.SR,R2RFILES.CM,R2SMPD.SR,^ R2SOVL.SR,R2STP.SR,R2SINTEGER.SR,R2SBOOLEAN.SR,R2SRANDOM.SR,^ R2SOPN.SR,R2IREAL.SR,R2SADMIN.SR,R2SRD.SR,R2SIOIN.SR,R2CITAB.SR,^ R2IFNS.SR,R2CRCODE.SR,R2SSET.SR,R2STI.SR,R2RFT.SR,R2SITAB.SR,^ R2SDIV.SR,P4ERRSUM,R2IFW.SR,R2SMEMACC.SR,R2SMISC.SR,R2SDBIN.SR,^ R2STESTS.SR,R2SHEAP.SR,R2ALLFILES.CM,R2CSPTAB.SR,R2IOUTL.SR,^ R2SDECODER.SR,R2RREAL.SR,R2SMYP.SR,R2IFILES.CM,R2SSYMBOLS.SR,^ R2SREWR.SR,R2RFNS.SR{,R2SSPTAB.SR,R2SCONSTS.SR,P4ENTERERR,^ EXAMPLES.CM,ROMAN,LIFE,GRAPH,PRIMES,RGCD,^ P4COMPILE1,P4COMPILE2,P4COMPILE3,P4COMPILE4,^ MAKER2SYMBOLS.CM,MAKEDGSYMBOLS.CM,^ P4ASMFILES.CM,NEW2P4ASMB,SETUP,FASTHASH,SETUPAX,SETUPAZ,^ HEADA2,HEADM2,SP4AMX2,P4ASMZ2,P4MACZ2,NEW2P4ASME,MAKE2P4AM.CM^ P4ASMZ2.mm . PROCEDURE DOTFILE; (* REDUNDANT IN RELEASE II *) BEGIN WRITELN(OUTPUT, 11008 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* READ OFF EOLN *) WRITELN(OUTPUT, '.TXT ''INPUT'''); WRITELN(OUTPU=T, -8954); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8954); WRITELN(OUTPUT,  24064); WRITELN(OUTPUT, 8192); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8952); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''OUTPUT'''); WRITELN(OUTPUT, -8951); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8949); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRIT&ELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRD'''); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); , WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8946); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRR'''); WRITELN(OUTPUT, -8945); WRITELN(OUTPUT, -7403); V WRITELN(OUTPUT, -8943); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRITELN(OUTPUT, 2048 ); WRITELN END (*** OF DOTFILE ***); PROCEDURE PACKCODE; VAR SMCODE, I, P, Q : INTEGER; LITERALS c: STRING3; OP, TEMPOP : STRING4; ERROR : BOOLEAN; PROCEDURE DUMMYLABELS; BEGIN ECOUNT := ECOUNT + 1; WRITELN(PRR, '**********', ' INSTR. NO. ' : 12, ICOUNT : 5, ' ''' : 2, OP, / ''' HAS NOT YET BE', 'EN CATERED FOR ');  WRITELN END (*** OF DUMMYLABELS ***); FUNCTION PKACTION : INTEGER; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; PROCEDURE ERRORP;  BEGIN ERROR := TRUE; ECOUNT := ECOUNT + 1; MORETRY := FALSE; WRITE(PRR, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(INPUT, CH); 1 WRITE(PRR, CH) UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN(PRR); WRITE(PRR, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(PRR) END (*** ERRORP ***); BEGI;N (* OF PKACTION *) PKACTION := 0; TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLES>IZE; MORETRY := TRUE;  SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN IF OP = PCODE THEN BEGIN MORETRY := FALSE; SMCODE := SEMICODE; PKACTION:= ACTION; END ELSE IF PCODE = ' ' THEN ERRORP;  IF MORETRY THEN  BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); SMAX := SMAX + 1 END END END (*** OF PKACTION ***); PROCEDURE NILP(P1, P2 : INaTEGER); (* PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1= 0)) THEN BEGIN WRITELN(OUTPUT, P2); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 ); , READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILP ***); PROCEDURE NILPS(P1, P2, P3 : INTEGER); (* SPECIAL PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1 < HALFWORD) AND (P1 >= 0)) THEN BEGIN WRITELN(OUDTPUT, P2 + P3 ); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 + P3 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILPS ***); PROCEDURE QTOP(P1, P2, P3 : INTEGER); (* PCODE WITH P- AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND (P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN WRITELN(OUTPUT, P3 + P1 ); WRITELN(OUTPUT, P2 : 7) END ELSE WRITELN(OUTPUT, BIT16 + P3 + P2 );d READ(INPUT, CH) (* READ OFF EOLN *) END (*** QTOP ***); PROCEDURE QTOPS(P1, P2, P3, P4 : INTEGER); (* SPECIAL PCODE WITH P- AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND ( P2 < HALFWORD) AND (P2 >= 0)) THEN  BEGIN WRITELN(OUTPUT, P3 + P4 + P1 ); WRITELN(OUTPUT, P2) END ELSE WRITELN(OUTPUT, BIT16 + P2 + P3 + P4 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF QTOPS ***); PROCEDURE BOUNDS(SEMICODE, LOWERBOUND, UPPERBOUND : INTEGER); (* GENERATE POSSIBLE OFFENDING PCODE LOCATION IN CASE OF INVALID CHECK RANGE *) BEGIN IF SEMICODE > 0 THEN BEGIN IF (LOWERBOUND = 0) AND (UPPERBOUND < HALFWORD) THEN  WRITELN(OUTPUT, SEMICODE + BIT16 + UPPERBOUND) ELSE BEGIN IF (LOWERBOUND >= 0) AND (LOWERBOUND < HALFWORD) THEN WRITELN(OUTPUT, SEMICODE + LOWERBOUND) R ELSE BEGIN WRITELN(OUTPUT, SEMICODE + HALFWORD); WRITELN(OUTPUT, LOWERBOUND) END; WRITELN(OUTPUT, UPPERBOUND) END  END ELSE IF LOWERBOUND > 0 THEN WRITELN(OUTPUT, SEMICODE + 1) ELSE WRITELN(OUTPUT, SEMICODE); WRITELN(OUTPUT, ICOUNT + 1) END (* OF BOUNDS *); PROCEDURE LOWCODE; (* TO PROVIDE FACILITIES FOR THOSE POOR SOULS WmHO MUST LIVE WITH MACHINE CODES *) VAR I, J, K, L, ACC, LEVEL, DISPL : INTEGER; CODEND : BOOLEAN; DIRECTIVE : STRING4; LINE : ARRAY[1..80] OF CHAR; GOODCHAR : SET OF CHAR; GOODIGIT  : SET OF '0'..'9'; FUNCTION GETNUM : INTEGER; VAR NUMBER : INTEGER; BEGIN WHILE ((LINE[J] = ' ') OR (LINE[J] = ',')) AND (J < I) DO J := J + 1; IF NOT (LINE[J] IN GOODsZIGIT) THEN BEGIN WRITELN(PRR, '** ASSEMBLER COD', 'E ERROR :'); FOR J := 1 TO I DO WRITE(PRR, LINE[J]); WRITELN(PRR);  WRITELN(PRR, '** LAST RECORDED', ' PCO=DE COUNTER =', ICOUNT); ECOUNT := ECOUNT + 1 END; NUMBER := ORD(LINE[J]) - ZERO; J := J + 1; WHILE (J <= I) AND (LINE[J] IN GOODIGIT) DO BEGIN ۨ NUMBER := NUMBER * 10 + ORD(LINE[J]) - ZERO; J := J + 1 END; GETNUM := NUMBER END (* OF GETNUM *); PROCEDURE GETLABEL;  VAR N : INTEGER; BEGIN IF J B> 1 THEN BEGIN FOR N := 1 TO J DO WRITE(OUTPUT, LINE[N]); END END (* OF GET LABEL *); BEGIN (* OF LOWCODE *); WRITELN(OUTPUT, '.RDX 8'); WRITELz[N(OUTPUT, '.EXTD .CST .CLD ', 'PCRTN'); CODEND := FALSE; FOR CH := '0' TO '9' DO GOODIGIT := GOODIGIT + [CH]; FOR CH := 'A' TO 'Z' DO GOODCHAR := GOODCHAR + [CH]; GOODCHAR := GOODCHAR + ['.', '$'] + GOODIGIT; + REPEAT IF EOF(INPUT) THEN BEGIN WRITELN(PRR, '** ASSEMBLY CODE', ' SECTION NOT PRO', 'PERLY ENDED.'); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); 2 HALT(311); END; REPEAT WHILE EOLN(INPUT) DO READLN(INPUT); READ(INPUT, CH);  IF CH = ';' THEN READLN(INPUT) UNTIL CH IN GOODCHAR; LI@NE[1] := CH; FOR I := 2 TO 80 DO LINE[I] := ' '; I := 1; J := 1; WHILE NOT( EOLN(INPUT) OR ( I = 80) OR (CH = ';')) DO BEGIN READ(INPUT, CH); IF CH <> ';'H_ THEN BEGIN I := I + 1; LINE[I] := CH; IF CH = ':' THEN J := I END END; READLN(INPUT); IF J > 1 T_HEN REPEAT J := J + 1; UNTIL LINE[J] <> ' '; L := 1; FOR K := J TO J + 3 DO BEGIN DIRECTIVE[L] := LINE[K]; 5 L := L + 1 END; IF DIRECTIVE = 'JPC ' THEN BEGIN GETLABEL;  CODEND := TRUE; WRITELN(OUTPUT, 'JSR @PCRTN') END ELSE IF D IRECTIVE = 'POP ' THEN BEGIN GETLABEL; J := J + 4; WRITELN(OUTPUT, 'DSZ 41'); WRITE(OUTPUT, 'LDA ' : 5, GETNUM : 1, ' @41'); WRITELN(O)jUTPUT) END ELSE IF DIRECTIVE = 'PUSH' THEN BEGIN GETLABEL;  J := J + 4; WRITELN(OUTPUT, 'ISZ 41'); WRITE(OUTPUT, 'STA ': 5, GETNUM : 1, ' @41'); WRITELN(OUTPUT) END ELSE IF DIRECTIVE = 'LOAD' THEN BEGIN GETLABEL; J := J + 4; ACC := GETNUM; LEVEL := GETNUwM; DISPL := GETNUM; WRITELN(OUTPUT, 'JSR @.CLD'); WRITELN(OUTPUT, LEVEL);  WRITELN(OUTPUT, DISPL); WRITE(OUTPUT, 'LDA ' : 5, ACC : 1, ' @47'); WRITEYZLN(OUTPUT); END ELSE IF (DIRECTIVE = 'STOR') AND (LINE[J + 4] = 'E') THEN BEGIN GETLABEL; J := J + 5; WRITE(OUTPUT, 'STA ' : 5, GETNUM : 1, ' 47');  WRITELN(OUTPUT); WRITELN(OUTPUT, 'JSR @.CST');  WRITELN(OUTPUT, GETNUM); WRITELN(OUTPUT, GETNUM); END ELSE BEGIN "J FOR J := 1 TO I DO WRITE(OUTPUT, LINE[J]); WRITELN(OUTPUT) END; UNTIL CODEND; WRITELN(OUTPUT, '.RDX 10') END (* OF LOWCODE *); BEGIN (* OF PACKCODE *) OP[1] := CH; READ(INPUT, OP[2], OP[3]); IF EOLN(INPUT) THEN OP[4] := ' ' ELSE READ(INPUT, OP[4]); CASE PKACTION OF 0 : (* STOA STOA STOC STOI STOR STOS EOF ADI ADR SBI SBR SGS s FLT FLO TRC NGI NGR SQI SQR ABI ABR NOT AND IOR DIF INT UNI INN MOD ODD LCA MPI MPR DVI DVR STP CHR ORDA ORDC ORDI EQUA EQUB EQUB EQUC EQUI EQUR EQUS NEQA NEQB NEQC NEQI NEQR NEQS GEQA GEQB GEQC GEQI GEQR GEQS GRTA GRTB GRTC GRTI GRTR GRTR GRTS LEQA LEQB LEQC LEQI LEQR LEQS LESA LESB LESC LESI LESR LESS RETA RETB RETC RETI RETP RETR ATN COS ELN EXP GET LOG NEW PUT RDC RDI RDR RLN RST SAV SIN SQT WLN WRC WRI WRR WRS OPS  OPN OVL CMS RSN *) BEGIN IF ERROR THEN ERROR := FALSE ELSE BEGIN  WRITELN(OUTPUT, SMCODE ); READLN(INPUT) (* RID EOLN *) END END; 1, 2, 3, 4, 5, 6, 7, 8, 9 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****)  10 : (* EQUM NEQM GEQ GRTM LEQM LESM  *) BEGIN READ(INPUT, Q); NILP(Q, SMCODE + BIT15) END; 11, 12, 13, 14, 15, 16, 17, 18, 19 : DUMMYLABELS; λ (***** FOR FUTURE INSERTIONS *****) 20 : (* LODA LODB LODC LODI STRA STRB STRC STRI LDA *) BEGIN READ(INPUT, P, Q); QTOP(P, Q DIV 2, SMCODE) A END; 21, 22, 23, 24, 25, 26, 27, 28, 29 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 30 : (* LODR STRR *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q DIV 2, SMCiODE, HALFWORD) END; 31, 32, 33, 34, 35, 36, 37, 38, 39 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 40 : (* LODS STRS *) BEGIN READ(INPUT, P, Q);  QTOPS(P, Q DIV 2, SMCODE, 3 * HALFWORD) END; 41, 42, 43, 44, 45, 46, 47, 48, 49 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 50 : (* CUP CXP *) BEGIN READ(INPUT, Pt); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P DIV 2 ); WRITELN(OUTPUT, CH, Q : 1); READ()INPUT, CH) (* READ OFF EOLN *) END; 51, 52, 53, 54, 55, 56, 57, 58, 59 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 60 : (* MST *) BEGIN READ(INPUT, Q); qB WRITELN(OUTPUT, SMCODE + Q ); READ(INPUT, CH) (* READ OF EOLN *) END; 61, 62, 63, 64, 65, 66, 67, 68, 69 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 70 : (* LDOA LDOB LDOKC LDOI SROA SROB SROC SROI INDA INDB INDI LAO *) BEGIN READ(INPUT, Q); NILP(Q DIV 2, SMCODE) END; 71, 72, 73, 743, 75, 76, 77, 78, 79 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 80 : (* INDC *) BEGIN READ(INPUT, Q); NILPS(Q, SMCODE, 2 * HALFWORD) END; 81, 82, 83, &84, 85, 86, 87, 88, 89 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 90 : (* LDOR SROR INDR *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD) END;  91, 92, 93, 94, 95, 96, 97, 98, 99 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 100 : (*LDOS SROS INDS *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD * 3)  END; 101, 102, 103, 104, 105, 106, 107, 108, 109 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 110 : (* INCA INCI INCC IXA DECA DECI DECC *) BEGIN V READ(INPUT, Q); NILP(Q, SMCODE) END; 111, 112, 113, 114, 115, 116, 117, 118, 119 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 120 : (*MOV *)  BEGIN # READ(INPUT, Q); NILP((Q + 1) DIV 2, SMCODE) END; 121, 122, 123, 124, 125, 126, 127, 128, 129 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 130 : (* ENT *) ; BEGIN READ(INPUT, P); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P );  WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 131, 132, 133, 134, 135, 136, 137, 138, 139 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 140 : (* UJC *) BEGIN  WRITELN(OUTPUT, SMCODE ); WRITELN(OUTPUT, 0 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 141, 142, 143, 144, 145, 146, 147, 148, 149 : DUMMYLABELS; (***** FOR mFUTURE INSERTIONS *****) 150 : (* UJP FJP XJP TJP JPF JPT SJP *) BEGIN READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(O2UTPUT, SMCODE ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 151, 152, 153, 154, 155, 156, 157, 158, 159 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS 9*****) 160 : (* CSP *) BEGIN READ(INPUT, CH); WHILE CH = ' ' DO READ(INPUT, CH); I := SMCODE; TEMPOP := OP; OP[1] := CH;  READ(INPUT, OP[2], OP[3]); OP[4] := ' '; P := PKACTION; (* P IS DUMMY, CALLING PKACTION IS JUST TO  OBTAIN SEMI-CODE VALUE IN SMCODE *) WRITELN(OUTPUT, SMCODE + I + BIT16 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 161, 162, 163, 164, 165, 166, 167, 168, 169 :DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 170 : (* CHKA CHKB CHKC CHKI *) BEGIN READLN(INPUT, P, Q); BOUNDS(SMCODE, P, Q) END; 171, 172, 173, 174, 175, 176, 177, 178, 179 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) . 180 : (* LDC *) BEGIN WRITELN(OUTPUT, SMCODE + 3 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *)  FOR I := 1 TO 4 DO WRITELN(OUTPUT, SWITCHES[I]); END; 181, 182, 183, 184, 185, 186, 187, 188, 189 : DUMMYLABELS;  (***** FOR FUTURE INSERTIONS *****) 190 : (* LDCB LDCI *) BEGIN Z READ(INPUT, Q); QTOP(0, Q, SMCODE) END; 191, 192, 193, 194, 195, 196, 197, 198, 199 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 200 : (* LDCC *) (* SORRY FOR ]THIS MESS, BUT BLAME NOVA ASSEMBLER PLEASE *) BEGIN READ(INPUT, CH); (* THE ORDINAL OF (') = 7 *) WHILE ORD(CH) <> 7 DO READ(INPUT, CH); LITERALS[1] := CH; ' READ(INPUT, LITERALS[2], LITERALS[3]); WRITELN(OUTPUT, SMCODE ); IF LITERALS[2] = CHR(7) (* IF LITERALS[2] = ''' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), v 39 (*NOVA CODE FOR (')*) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] =CHR(12) (* IF CH = ',' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 44 : 1, (*NOVA CODE FOR (,) *) CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(28) (* IF LITERALS[2] = '<' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHR(30-), CHR(7)) ELSE WRITELN(OUTPUT, '.TXT ', LITERALS); READ(INPUT, CH) (* READ OFF EOLN *) END; 201, 202, 203, 204, 205, 206, 207, 208, 209 : DUMMYLABELS; (***** FOR FUTURE INSERTohIONS *****) 210 : (* LDCN *) QTOP(0, 0, SMCODE); 211, 212, 213, 214, 215, 216, 217, 218, 219 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 220 : (* LDCR *) (* NOTICE THE NON-FLOATING-PO'IINT OUTPUT FORMAT OF 'R' *) BEGIN WRITELN(OUTPUT, SMCODE + 1, '.');  READLN(INPUT, R); WRITELN(OUTPUT, '0', R : 0); END; 230 : (* JNC *) (* PARADISE FOR MACHINE CODE ADDICTS ONLY *) BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT); LOWCODE; END; (* REDUNDANT 'CCP ' 240 : BEGIN  WRITELN(OUTPUT, SMCODE); READLN(INPUT, Q); WRITELN(OUTPUT, Q) END; *) END (* OF CASE PKACTION *) END (*** OF PACKCODE ***); BEGIN (* OF MAIN *) WRITELN; WRITELN;  WRITELN; WRITELN(PRR, '; ==== P4ASM BEG', 'INS NOW'); ENT := TRUE; ZERO := ORD('0'); ICOUNT := 3; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO PCODE := ' '; COMPLETABLE; (* START READINGk IN THE PCODE PROGRAM FROM PRD FILE *) READ(INPUT, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(PRR, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(PRR)<; HALT(311) END; WRITE(OUTPUT, CH: 16, DOTNAME); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH); (* RID EOLN *) REPEAT READ(INPUT, CH); 0s IF CH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF (CH = 'P') OR (CH = '?') THEN PCTYPE := PCODENTRY ELSE BEGIN READ(INPUT, CH); IF CH = '.' THEN PCTYPE; := NONPCODE ELSE PCTYPE := PCODES END; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(INPUT, J); IF (ICOUNT <> J) AND (J <> 0) THEN BEGIN  WCOUNT := WCOUNT + 1; WRITELN(PRR, 'I', J : 5, ' ' : 14, '; ??? PCODE' , ' COUNT OUT OF ST', 'EP ???'); END; ICOUNT := J; READ(INPUT, CH) (* READ OFF EOLN *) END; LLABEL : (* LABELS *) BEGIN  M WRITE(OUTPUT, CH);  READ(INPUT, I); WRITE(OUTPUT, I : 1); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) `7 UNTIL EOLN(INPUT); READLN(INPUT); WRITELN(OUTPUT) END; NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) BEGIN 9: READ(INPUT, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF DOTNAME = 'FIL' THEN DOTFILE ELSE BEGIN IF ((DOTNAME = 'SW1') OR (DOTN.AME = 'SW2') OR (DOTNAME = 'SW3') OR (DOTNAME = 'SW4')) THEN BEGIN REPEAT READ(INPUT, CH)  UNTIL (CH = '0') OR (CH = '1'); (* READ UNTIL BINARY IS FOUND *) BINARYSTR[1] := CH; IF CH = '1' THEN J := -1 ELS E J := 0; FOR I := 2 TO 16 DO BEGIN READ(INPUT, CH); BINARYSTR[I] := CH; A  J := J * 2 + ORD(CH) - ZERO END; I := ORD(DOTNAME[3]) - ZERO; SWITCHES[I] := J; _ READ(INPUT, CH) (* READ OFF EOLN *) END ELSE IF (DOTNAME = 'TXT') AND (INPUT^ <> 'M') THEN BEGIN WRITE(OUTPUT, '.', DOTNAME : 3); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL CH <> ' ';' FOR I := 1 TO 16 DO BEGIN READ(INPUT, CH); IF CH = CHR(2) (* CH = '"'*) THEN   WRITE(OUTPUT, CHR(28), 34 : 1 (*NOVA CODE FOR '"'*), CHR(30)) ELSE IF CH = CHR(28 (*IF CH = '<'*)) THEN `t WRITE(OUTPUT, CHR(28), 60 : 1, (*NOVACODE FOR '<'*)CHR(30)) ELSE IF CH = CHR(30) (*IF CH = '>'*) THEN   WRITE(OUTPUT, CHR(28), 62 : 1, (*NOVA CODE FOR '>'*) CHR(30)) ELSE WRITE(OUTPUT, CH)  END; READLN(INPUT, CH); (* RID EOLN *) WRITELN(OUTPUT, CH) END ELSE BEGIN  I IF DOTNAME = 'ENT' THEN BEGIN IF ENT THEN BEGIN ENT := FALSE; ) WRITE(OUTPUT, '.', DOTNAME) END ELSE WRITE(OUTPUT, '; .', DOTNAME) END ELSE  IF NOT+> (DOTNAME = 'END') THEN WRITE(OUTPUT, '.', DOTNAME); IF NOT EOLN(INPUT) THEN REPEAT R24EAD(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN END END END; PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN PACKCODE; I$COUNT := ICOUNT + 1 END; PCODENTRY : (* PACKED PCODE ENTRY POINT *) BEGIN WRITE(OUTPUT, CH);  REPEAT READ(INPUT, ,CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH) (* READ OFF EOLN *) END; END (* OF CASE PCTYPE *); WHILE EOLN(INPUT) DO BEGIN WRITELN; READ(INPUT, CH) (* READ OF EOLN *) END UNTIL EOF(INPUT); (* THE PCODE PROGRAM HAS BEEN PACKED FOR INTERPRETER *) (* WRITELN(PRR); WRITELN(PRR, '; IDEAL SEARCHES', ' = ', SMIN); WRITELN(PRR, '; ACTUAL SEARCHE', 'S = ', SMAX); *) IF WCOUNT > 0 THEN WRITELN(PRR, ';---- NO. OF WAR', 'NINGS = ', WCOUNT : 6); IF ECOUNT > 0 THEN WRI0TELN(PRR, ';**** NO. OF FAT', 'AL ERRORS = ', ECOUNT : 6); WRITELN(OUTPUT, '.END' : 16); IF ECOUNT > 0 THEN HALT(311); WRITELN; WRITELN; WRITELN END. R2CRCODE.SR BWc .TITL R2CRCODE .TXTM 1 .ENT .CST,.CLD,PCRTN,PJNC .EXTN .BASE .ZREL .CST: CST .CLD: CLD PCRTN: .PCRT .NREL ;ENTRY POINT USED BY THE INTERPRETER TO INITIATE CODE PJNC: JMP @PC ;RETURN FROM CODE TO THE INTERPRETER .PCRT: STA 3,PC DSZ PC JMP @IP {e ;LOAD AND STORE FROM THE STACK ;STORE.... CST: STA 3,Z2 ;SAVE LINK JSR SAVER ;AND REGISTERS LDA 0,Z1 LDA 3,Z2 ;RESTORE LINK LDA 1,0,3 ;LEVEL DIFFERENCE LDA 2,1,3 ;OFFSET .BASE ;FORM ADDRESS  STA 0,0,2 ;STORE @ THE ADDRESS JMP HOME 7 ;RETURN ;LOAD...... CLD: STA 3,Z2 ;SAVE LINK JSR SAVER ;AND REGISTERS LDA 3,Z2 ;RESTORE LINK LDA 1,0,3 ;LEVEL DIFFERENCE LDA 2,1,3 ;OFFSET .BASE ;FORM ADDDRESS STA 2,Z1 HOME: ISZ Z2 ISZ Z2 JSR RESET JMP @Z2 ;RETURN SAVER: STA 0,jTEMP0 STA 1,TEMP1 STA 2,TEMP2 JMP 0,3 RESET: LDA 0,TEMP0 LDA 1,TEMP1 LDA 2,TEMP2 JMP 0,3 TEMP0: 0 TEMP1: 0 TEMP2: 0 .END R2SITAB.SRU GK .TITL R2SITAB ; THE INTERPRETER JUMP TABLE .ENT ITAB0,ITAB1 .EXTN PLOD,PLDO,PSTR,PSRO,PLDA,PLAO,PSTO,PLDC,PLCI,PIND .EXTN PINDC,PSTOC .EXTN PINC,PINCC .EXTN PMST,PCUP,PCXP,PENT,PRET,PCSP  .EXTN PIXA .EXTN PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PUJP,PFJP,PXJP,PTJP,PUJC .EXTN PCHKC,PCHK2,PCHK3,PCHK4,PEOF .EXTN PADI,PADR,PSBI,PSBR .EXTN PSGS .EXTN PFLT,PFLO,PTRC .EXTN PNGI,PNGR,PSQI,PSQR,PABI,PABR  .EXTN PNOT,PAND,PIOR .EXTN PDIF,PINT,PUNI,PINN .EXTN PMOD,PODD .EXTN PMPI,PMPR,PDVI,PDVR .EXTN PMOV,PLCA,PDEC,PDECC,PSTP,PHLT .EXTN PCHR,PORDI,PORDA,PORDC,PORDB .pEXTN PJNC .EXTN PNON .ZREL ITAB0: PNON ; 0 NOT USED PHLT ; 1 PEQU ; 2 PNEQ ; 3 PGEQ ; 4 PGRT ; 5  PLEQ ; 6 PLES ; 7 PSTO ; 8 PSTO ; 9 PSTOC ; 10 PSTO ; 11 PMST  ; 12 PRET ; 13 PADI ; 14 PSBI ; 15 PNGI ; 16 PSQI ; 17 PABI ; 18 PMOD  ; 19 PODD ; 20 PMPI ; 21 PDVI ; 22 PADR ; 23 PSBR ; 24 PFLT ; 25 41 PFLO ; 26 PTRC ; 27 PNGR ; 28 PSQR ; 29 PABR ; 30 PMPR ; 31 PDVR ; 32  ?! PNOT ; 33 PAND ; 34 PIOR ; 35 PSGS ; 36 PDIF ; 37 PINT ; 38 PUNI ; 39 S PINN ; 40 PEOF ; 41 PSTP ; 42 PLCA ; 43 PORDI ; 44 SET ASIDE PORDA ; 45 4 LOCATIONS  PORYDC ; 46 FOR THE PORDB ; 47 ORD FAMILY PCHR ; 48 ; THE GAPS IN THE REMAINDER OF TABLE 0 ARE FOR CORAL PNON ; 49 PNON ; 50 E3 PNON ; 51 PJNC ; 52 PNON ; 53 PNON ; 54 PNON ; 55 PNON ; 56  PNON ; 57 Ô PNON ; 58 PNON ; 59 PNON ; 60 PNON ; 61 PNON ; 62 PNON ; 63 ITAB1: PNON ; 64Ԙ NOT USED PUJC ; 65 PEQU ; 66 PNEQ ; 67 PGEQ ; 68 PGRT ; 69 PLEQ  ; 70 PLES z# ; 71 N.B MULTIPLE COMPARES PLOD ; 72 PLOD ; 73 PLOD ; 74 PLOD ; 75 PLDO ; 76 PLDO ;j@ 77 PLDO ; 78 PLDO ; 79 PSTR ; 80 PSTR ; 81 PSTR ; 82 PSTR ; 83 PSRO y. ; 84 PSRO ; 85 PSRO ; 86 PSRO ; 87 PIND ; 88 PIND ; 89 PINDC ; 90 PIND !9 ; 91 PLDA ; 92 PLAO ; 93 PLDC ; 94 PIXA ; 95 PMOV ; 96 PCUP ; 97 PENT qG ; 98 PCSP ; 99 PUJP ;100 PFJP ;101 PTJP ;102 PXJP ;103 PINC ;104 PNON2 ;105 ALSO INC PINCC ;106 PNON ;107 ALSO INC PDEC ;108 ALSO NEEDS NEXT 3 PNON ;109 PDECC ;110 PNWON ;111 PCHKC ;112 NEEDS 3 MORE PCHK2 ;113 PCHK3 ;114 PCHK4 ;115 ; THE GAPS IN THE REMAINDER OF TABLE 1 ARE FOR CORAL g PNON ; 116 PCXP ; 117 PNON ; 118 PNON ; 119 PNON  ; 120 PNON ; 121 PNON ; 122s} PNON ; 123 PNON ; 124 PNON ; 125 PNON ; 126 PNON ; 127 .END R2IFNS.SR! ?֖ .TITL R2IFNS ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO REAL STANDARD PROCEDURES .ENT XATN,XCOS,XEXP,XLOG,XSIN,XSQT,XRND .EXTN PUNDF .NREL XATN: .PUND XCOS: .PUND XEXP: .PUND XLOG: .PUND XSIN: .PUND XSQT: .PUND XRND: .PUND .END R2SHEAP.SR 8 .TITL R2SHEAP ; THE STANDARD PROCEDURES FOR OPERATING ON THE HEAP .ENT XNEW, XRST, XSAV .NREL XNEW: POP1 0 ;UNSTACK N (ELEMENT SIZE) MOVZR 0,0 SUB 3,3 ;AC3 AS SOURCE FOR ZEROES NEG 0,0 ;# OF WORDS TO CLEAR CLEAR: DSZ HP STA 3,@HP ;CLEAR EACH WORD OF NEW SPACE INC 0,0,SZR JMP CLEAR LDA 1,HP POP1 2 ;UNSTACK AD (POINTER VARIABLE ADDRESS) MOVZR 2,2 MOVZL 1,1 STA 1,0,2 ;[AD]:= HP MOVZR 1,1 ; BACK TO WD ADDR TO TEST EP LDA 0,EP ; ENOUGH ROOM ? ADCZ# 0,1,SZC ; SKP IF AC1<=AC0 .. HP<=EP NEXT ; YES ERR.P ; NO - ERROR RETURN PERHO ; WITH HEAP OVERFLOW XRST: POP1 1 ;RESET HEAP POINTER MOVZR 1,1 STA 1,HP NEXT XSAV: LDA 1,HP ;SAVE HEAP POINTER POP1 2 ;UNSTACK AD MOVZL 1,1 MOVZR 2,2 STA 1,0,2 ;[AD]:= HP NEXT .END R2IFW.SR! ?! .TITL R2IFW ; A DUMMY SEGMENT TO RESOLVE 2 CUES WHICH ARE ; REDUNDANT TO THE INTERPRETER WITHOUT FP .ENT WSA,PFPIN .EXTN PUNDF .ZREL WSA :0 .NREL PFPIN: .PUND .END R2IFILES.CMR2SECHK,^ R2IFT,^ R2SMPD,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2IREAL,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2IFNS,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2SITAB,^ R2SDIV,^ R2IFW,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2IOUTL,^-` R2SDECODER,^ R2SMYP,^ R2SREWR,^ R2SSPTAB,^ R2SCONSTS^ R2SMEMACC.SR! 4 .TITL R2SMEMACC ; THE P-CODE INTERPRETER'S "MEMORY ACCESS" OPERATIONS .ENT .BASE .ENT PIND,PLDO,PLOD .ENT PSRO,PSTR,PSTO .ENT PLAO,PLDA .ENT PLDC,PLCI,PLCA .ENT PMOV .EXTD RHB,LHB .EXTN PUNDF ; "BASE" BACKS DOWN THE NUMBER OF STACK FRAMES SP,ECIFIED BY ; AC1, AND ADDS THE BASE ADDRESS OF THIS STACK FRAME TO THE ; OFFSET IN AC2 .ZREL .BASE= JSR @. ;SET UP THE MNEMONIC .BASE AS BASE ; A JUMP TO ROUTINE "BASE" .NREL BASE: NEG 1,1,SZR ;CURRENT LEVEL ? JMP .+4 LDA 1,MP ;YES - GET MARK P܃OINTER ADD 1,2 ;ADD TO OFFSET JMP 0,3 ; AND RETURN STA 3,Z1 ;NO - SAVE RETURN ADDRESS LDA 3,MP ;PICK UP MARK POINTER LDA 3,SL,3 ;BACKTRACK ONE STACK LEVEL AT INC 1,1,SZR ; A TIME UNTIL AC1=0 JMP .-2 ADD 3,2 ;ADD STACK FRAME BASE TO OFFSET p JMP @Z1 ; AND RETURN ; "MOVE" MOVES THE NUMBER OF WORDS SPECIFIED BY AC1 FROM ; THE ADDRESS IN AC2 TO THE ADDRESS IN AC3 MOVE: LDA 0,0,2  STA 0,0,3 INC 1,1,SNR NEXT INC 2,2 INC 3,3 JMP MOVE TMSK: 001400 ;MASK FOR WORD COUNT ; LOAD INSTRUCTIONTS ; AC0 CONTAINS (NO. OF WORDS TO BE LOADED - 1) IN HIGH ; ORDER BYTE. VARIABLE ADDRESS GIVEN BY : ; IND - INDEX ON TOP OF STACK + OFFSET IN AC2 ; LDO - STACK BASE (DSP) + OFFSET IN AC2 (I.E. GLOBAL) ; LOD - OFFSET IN AC2 FROM STACK FRAME BASE N LEVELS ;  FURTHER DOWN, N IN AC1 PIND: POP1 1 ;INDEXED FETCH MOVZR 1,1 ; MAKE WD ADDRESS JMP .+2 PLDO: LDA 1,DSP ;LOAD CONTENTS OF BASE ADDRESS ADD 1,2,SKP PLOD: JSR BASE ;LOAD CONTENTS OF ADDRESS LDA 1,0,2 ;PICK UP VARIABLE PUSH1 1 ;PUT IT ON THE 5STACK LDA 1,TMSK ANDS 1,0,SNR ;ANY MORE WORDS ? NEXT ;NO NEG 0,1 ;YES - LOAD THEM ONE AT A TIME PLOD1: INC 2,2 LDA 0,0,2 PUSH1 0 INC 1,1,SZR JMP PLOD1 NEXT ; STORE INSTRUCTIONS ; AC0 CONTAINS (NO. OF WORDS TO BE STORED - 1) IN HIGH ; ORDER BYtTE. VARIABLE ADDRESS GIVEN BY : ; SRO - STACK BASE (DSP) + OFFSET IN AC2 (I.E. GLOBAL) ; STR - OFFSET IN AC2 FROM STACK FRAME BASE N LEVELS ; FURTHER DOWN, N IN AC1 ; STO - TOP OF STACK PSRO: LDA 1,DSP ;STORE ADD 1,2,SKP PSTR: JSR BASE ;STORE AT]d ADDRESS LDA 1,TMSK ANDS 1,0,SZR ;ONE WORD ONLY ? JMP PSTR1 POP1 1 ;YES - STORE IT STA 1,0,2 NEXT PSTR1: MOV 2,3 ;NO - USE "MOVE" LDA 2,SP ;DECREMENT STACK POINTER ADC 0,2 STA 2,SP PSTR2: INC 2,2 ;SET UP PARAMETERS FOR "MOVE" COM 0,1 JMP MOVE PSTO: LDA 1,TMSK ;STORE AT BASE LEVEL ADDRESS ANDS 1,0,SZR ;ONE WORD ONLY ? JMP PSTO1 POP1 1 ;YES - STORE IT POP1 3 MOVZR 3,3 ; MAKE WD ADDRESS STA 1,0,3 NEXT PSTO1: LDA 2,SP ;NO - DECREMENT STACK POINTER ADC 0,2 STA 2,SP POP1 3 ;USE "MNOVE" AGAIN MOVZR 3,3 ; MAKE WD ADDRESS JMP PSTR2 ; MORE LOAD INSTRUCTIONS (LOAD CONSTANT & LOAD ADDRESS) PLAO: LDA 1,DSP ;LOAD BASE LEVEL ADDRESS ADD 1,2,SKP PLDA: JSR BASE ;LOAD ADDRESS MOVZL 2,2 ; MAKE WD ADDRESS PUSH1 2 NEXT PLDC: PUSH1 2 f ;LOAD CONSTANT NEG 1,1,SNR ;MORE THAN ONE WORD ? NEXT ;NO PLDC1: LDA 2,@PC ;YES - PICK UP THE NEXT PUSH1 2 ; AND LOAD IT INC 1,1,SZR ;ANY MORE ? JMP PLDC1 ;YES NEXT ;NO PLCI: .PUND ;LOAD CONSTANT INDIRECT PLCA: LDA 2,PC ;LOAD ADDRESS XeOF CONSTANT INCZL 2,2 PUSH1 2 LDA 0,RHB ;RIGHT HAND BYTE MASK LDA 1,@PC ;SEARCH FOR END OF STRING (NULL) AND 0,1,SZR ; AND UPDATE PC JMP .-2 NEXT PMOV: NEG 2,1 ;STORE STRING AWAY POP1 2 MOVZR 2,2 ; MAKE WD ADDRESS POP1 3 MOVZR 3,3 ; DITT O JMP MOVE .END R2SRD.SRK *< .TITLE R2SRD .ENT PEOF,XELN,XRDC,XRLN,XGET .ENT .READ,READ .EXTD TEMP .ENT CR,TEMP1,TABAD .ENT CHAN,CNTAD,TEMP2 .EXTD .GCH,.FIND,.BPUT,.BGET .EXTD LHBNP,RHBNP,SPACE .ZREL .READ: READ CHAN: 0 CNTAD: 0 TABAD: 0 TEMP1: 0 TEMP2: 0 CR: 6400 .NREL ; READ - THIS ROUTINE LEAVES CHARACTER IN THE FILE BUFFER ; AND IN AC0. ; AC1 - UNDEFINED ; AC2 - FBA A BYTE ADDRESS ; ; FCH - FILE CHANNEL WORD (CONTAINS CHANNEL NO. + RECORD LENGTH). ; FST - FILE STATUS WORD (CURRENT STATE OF THE FILE). TAB: 4400 FF: 6000 CNTLZ: 15000 EOLFL: 1B1 EREOF: 6 C7: 7 READ: STA 3,USP ;USP RESTORED TO AC3 AFTER .SYSTM LDA 0,FST,2 ;GET FST MOVL# 0,0,SNC ;EOF SET ? JMP RD1 ; - NO ERR.P ; - YES PERRE ; REPORT READ ERROR RD1: MOVR 0,0,SZC ; FB EMPTY JMP lDRD2 ; - YES LDA 0,0,2 ; - NO, GET CHAR JMP 0,3 ; AND RETURN RD2: JSR @.GCH ;PICK UP CHANNEL AN' ALL JMP RNASC ;NONE CHARACTER INPUT ; ASCII TRANSFER FROM A SPECIFIED FILE RDASC: STA 2,TEMP2 ;STORE FOR A BIT LDA 2,CHAN JSR @.FIND ;ALL FILE DETAILS. LDA 2,@CNTAD ADD 0,2 ;FORM ADDDRESS OF NEXT CHARACTER. JSR @.BGET ;AS IN BIBLE BUT FOR CHARACTER LDA 2,TEMP2 ;THE RETURN OF FBA.... LDA 3,FST,2 ;TEST IF EOLN SET FROM LAST ADDZL# 3,3,SZC ;TIME THROUGH JMP RELN ;YES... MOV 0,0,SNR ;IS ŭIT NULL JMP RDNULL ;FORGET NULLS IF POSS. LDA 1,CR ;HOW ABOUT A CARRIAGE RETURN,THEN SUB# 1,0,SNR JMP RDEOL LDA 1,CNTLZ ;OR THE END OF THE FILE SUB# 1,0,SNR JMP RDERR+1 ;YES IT IS EOF SO END IT LDA 1,FF ;NO! THEN IT MUST BE A SUB# 1,0,SNR ;Ab FORM FEED OR I'LL GIVE UP. JMP RDEOL LDA 1,TAB ;PERHAPS EVEN A TERRIBLE TAB SUB# 1,0,SNR ;WHICH MAKES THE SYSTEM AWKWARD. JMP RDTAB STA 0,0,2 ;STORE THE CHARACTER IN THE BUFFER ISZ @CNTAD ;O.K. I GIVE UP IT WAS LDA 3,EREOF ;SOMETHING ELSE. RDEOF: STA 3,FST,2 ;YOU THINK YOU'RE NORMAL THEN... ISZ @TABAD ;KICK THE TAB COUNTER AND JMP @USP ;I'M OFF HOME ; NONE ASCII TRANSFER FROM A SPECIFIED FILE RNASC: MOVZL 2,0 ;BYTE POINTER TO FNA LDA 2,CHAN .SYSTM .RDS 77 ;READ A RECORD JMP .+2 JMP @USP JSR RDER1 ;TEST IF REAL ERROR MOVZR 0,2 ;RESET FBA SUBZR 3,3 STA 3,FST,2 ;SET EOF JMP @USP ;DEAL WITH THE END OF LINE RELN: SUB 3,3 ;RESET THE EOLN FLAG STA 3,FST,2 JSR RDRL ;GET A NEW LINE JMP RDASC ;AND RESTART ;DEAL WITH THE SPECISAL CASES... RDEOL: LDA 0,EOLFL ;FOUND END OF LINE OR STA 0,FST,2 ;EQUIVALENT, SO INDICATE LDA 0,SPACE ;IN THE STATUS AND BUFFER. STA 0,0,2 JMP @USP RDNUL: JSR RDRL ;READ THE NEXT LINE JMP RDASC ;AND RETURN FOR THE NEXT CHARACTER RDTAB: LDA 1,@TABAD ;TEST IF MULTIPLE OF 7 LDA 0,C7 COM 1,1 AND 1,0,SNR JMP NOTAB ;IT ISN'T NECESSARY LDA 0,SPACE STA 0,0,2 ;REPLACE WITH SPACES. JMP RDEOF-1 NOTAB: ISZ @CNTAD JMP RDASC ;GET NEXT CHARACTER. RDRL: STA 3,TEMP1 ;IF NO MORE IN BUFFER GET NEXT > SUB 1,1 STA 1,@CNTAD ;RESET THE BYTE COUNT. STA 1,@TABAD ;RESET THE TAB COUNTER. STA 2,TEMP2 ;STORE FBA TEMPORARILY LDA 2,CHAN ;GET THE CHANNEL AND ALL JSR @.FIND LDA 2,CHAN .SYSTM .RDL 77 JMP RDER2 LDA 2,TEMP2 LDA 0,SPACE ;LOAD A SPACE IN CASE ITS REQUIRED JMP @TEMP1 RDER2: ADD 1,0 JSR RDER1 ;TEST IF NOT EOF MOV 0,2 LDA 0,CNTLZ JSR @.BPUT ;MARK IT AS EOF LDA 2,TEMP2 JMP @TEMP1 RDERR: JSR RDER1 ;TEST IF NOT EOF LDA 0,EREOF SUBZR 3,3 ADD 0,3 LDA 2,TEMP2 ;RESTORE THE FBA JMP RDEOF ;MARK IT AS EOF RDER1: LDA 1,EREOF ;FINALLY THE ERROR CASE SUB# 1,2,SZR ERR.2 JMP 0,3 ;THE FOLLOWING ARE ENTRY POINTS USED BY PCODE PEOF: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET BUFFER STATUS MOVL 0,0 ;SET APPROPRIATE SUBCL 0,0 ;TRU|TH VALUE PUSH1 0 ;ON THE STACK NEXT XELN: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET BUFFER STATUS ADDL 0,0 ;EOL FLAG INTO CARRY SUBCL 0,0 ;SET TRUTH VALUE PUSH1 0 ;ON THE STACK NEXT XRDC: POP1 2 ;GET FBA MOVZR 2,2 JSR READ STA 2,TEMP ; STORE FBA TEMPORARILY POP1 2 ; ADDRESS OF DESTINATION BYTE JSR @.BPUT ; MOVE IT ... LDA 2,TEMP ; AND ON WE GO AS BEFORE. LDA 0,FST,2 ; GET STATUS MOVL# 0,0,SNC ; EOF ? JMP VALID ; - NO NEXT XRLN: POP1 2 ;ET FBA MOVZR 2,2 JSR @.GCH JMP .b+1 STA 2,TEMP2 LDA 2,CHAN JSR @.FIND LDA 2,TEMP2 JSR RDRL SUBZL 0,0 STA 0,FST,2 JSR @.READ NEXT XGET: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;CHECK BUFFER STATUS MOVL# 0,0,SNC ;FOR EOF JMP VALID ;OK - NO EOF ERR.P PERGE ;REPORT GET ERP]ROR VALID: MOVR 0,0,SNC ISZ FST,2 ; SET BUFFER EMPTY JSR @.READ NEXT .END P4AMX2. (********************* P4AMX2 BEGINS ********************) CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) BIT16 = -32768; BIT15 = 16384; HALFWORD = 256; TYPE  = INSTRTYPE = (COMMENT, LLABEL, NONPCODE, PCODES, PCODENTRY); STRING3 = ARRAY[1..3] OF CHAR; STRING4 = ARRAY[1..4] OF CHAR; STRING16 = ARRAY[1..16] OF CHAR; TEMPLATE = RECORD  PCODE : STRING4; SEMICODE, ACTION : INTEGER  END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; SWITCHES : ARRAY[1..4] OF INTEGER; CH : CHAR; DOTNAME \: STRING3; BINARYSTR : STRING16; R : REAL; I, J, ZERO, WCOUNT, ECOUNT, ICOUNT,SMIN, SMAX : INTEGER; ENT : BOOLEAN; PCTYPE : INSTRTYPE; (********************* P4AMX ENDS ***************}*****) R2SOPN.SRK   .TITLE R2SOPN .NREL .ENT XOPN,XCLS  .EXTN WRLIN .EXTD LHB,RHB,CHAN,TEMP,TEMP1 .EXTD .GCH,.FIND,SPACE,TEMP2 ; ; OPEN A FILE ; ; XOPN - STANDARD COMPILER PRODUCED ENTRY POINT. ; ; AT THE MOMENT ALL FILES ARE TREATED EQUALLY..... ; BUT SOME ARE MORE EQUAL THAN OTHERS. ; ; TWO FORMS - ASCII WHICH BUFFERS INPUT ; RECORD INPUT - INPUTS DIRECTLY INTO USER AREA. XOPN: .SYSTM ;ASK RDOS .GCHN ; FOR CHANNEL ERR.2 STA 2,TEMP2 ;CHANNEL NUMBER MOVS 2,1 ;CHAN # TO AC1 POP1 3 ;GET FBA MOVZR 3,3 ; MAKE WD ADDRESS STA 3,TEMP ;WORD ADDR OF FBA POP1 0 ;RECORD LENGTH INC 0,0 MOVZR 0,0 ;WORD COUNT OF BYTES ADDS 0,1 ;FORM FCH CONTENTS STA 1,FCH,3 ;STORE CHAN # ISZ FST,3 ;SET BUFFER EMPTY POP1 0 ;GET FNA LDA 3,PC ;PICK UP CURRENT ADDRESS LDA 1,-3,3 ;FIND THE END OF FILENAME MOV 1,1,SZR ;TEST IF APPEND MODE? ISZ APIND ;YES THEN SET FLAG SUB 1,1 STA 1,-3,3 ;RESET THE FILENAME. REOP: SUB 1,1 ;NORMAL CHARACTERISTICS LDA 3,APIND ;APPEND MODE? MOV 3,3,SZR JMP APP ;YES THEN OPEN APPEND .SYSTM .OPEN 77 JMP TEST REOP1: STA 1,APIND ;RESET APPEND MODE INDICATOR LDA 2,TEMP ;RESTORE WD ADDR OF FBA JSR @.GCH ;TEST IF ASCII FILE NEXT ;NO,CONTINUE LDA 0,SPACE ;SET SPACE IN BUFFER STA 0,0,2 SUB 2,2 ;YES|,THEN FIND A FREE BUFFER JSR @.FIND MOVZR 0,3 SUB 0,0 ;ENSURE THAT A NULL IS STA 0,0,3 ;PRESENT AT THE START OF BUFFER LDA 0,TEMP2 STA 0,0,2 ;STORE CHANNEL NUMBER IN TABLE NEXT APIND: 0 APP: .SYSTM .APPEND 77 JMP TEST JMP REOP1 ; IF THE FILE DOES NOT EXIST, CREATE IT! TEST: LDA 1,C12 SUB# 1,2,SZR ;IS IT REAL PROBLEM? ERR.2 .SYSTM .CRAND ERR.2 LDA 3,TEMP ;ASSUME THEN THAT IT IS SUBZR 2,2 ;AN OUTPUT FILE AND STA 2,FST,3 ;SET EOF IN FILE STATUS. LDA 2,TEMP2 JMP REOP C12: 12 ; CL>ZOSE A FILE ; ; TAKES ONE PARAMETER FROM THE STACK - FBA ; XCLS: POP1 2 ;FBA MOVZR 2,2 ;WORD ADDRESS OF FBA SUB 3,3 ;END WITH A NULL STA 3,TEMP1 JSR @.GCH ;GET CHANNEL NUMBER ET AL. JMP CLST ;NONE CHARACTER I/O LDA 0,FST,2 ;TEST IF A WRITE FILucE MOVZR 0,0,SNR JSR @.WRLN ;WRITE THE LAST LINE LDA 2,CHAN JSR @.FIND SUB 1,1 STA 1,@TEMP ;RELEASE THE BUFFER CLST: LDA 2,CHAN .SYSTM ;CLOSE THIS CHANNEL .CLOSE 77 ERR.2 NEXT .WRLN: WRLIN .END R2STP.SR 9 .TITL R2STP .ENT XPUT,XWLN,XWRC,XWRS,XPAG .ENT WRITE,WRLIN .EXTD CNTAD,TABAD,TEMP,TEMP1,TEMP2,CR,RHB .EXTD .FIND,.BGET,.BPUT,.GCH,CHAN .EXTN BFBP0 .NREL ; ROUTINE TO WRITE OUT A STRING TO THE BUFFER ; ; ENTRY - AC0 - BYTE POINTER TO FIRST BYTE ;< AC1 - NUMBER OF BYTES ; AC2 - CHANNEL NUMBER ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED WRITE: STA 3,USP STA 0,TEMP1 STA 1,TEMP2 JSR @.FIND ;PICK UP BUFFER INFO. LDA 1,@CNTAD ;NEXT +`BYTE ADD 0,1 STA 1,TEMP ;STORE ADDRESS TEMPORARILY NXTCH: LDA 2,TEMP1 ;CHARACTER ADDRESS JSR @.BGET ;GET NEXT BYTE LDA 2,TEMP JSR @.BPUT ;PUT THAT BYTE ISZ @CNTAD ISZ TEMP ;INCREMENT BUFFER ADDRESS ISZ TEMP1 ;INCREMENT CHARACTER ADDRESS DSZ TEMP2 ;DECREMENT AND TEST BYTE COUNT JMP NXTCH JMP @USP XPUT: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET STATUS MOVL# 0,0,SZC ;EOF? JMP PUTOK MOVL# 0,0,SNR ;JUST AWAY? JMP .+4 SUBZR 0,0 STA 0,FST,2 ;FIRST TIME THROUGH JMP PUTOK ERR.P ;bNO PERPE ;REPORT PUT ERROR PUTOK: JSR @.GCH ;PICK UP CHANNEL NO. ET AL JMP NCH MOVZL 2,0 ;BYTE POINTER TO FBA SUBZL 1,1 ;SET BIT 15 LDA 2,CHAN ;CHANNEL JSR WRITE NEXT NCH: MOVZL 2,0 LDA 2,CHAN ;WRITE IT STRAIGHT OUT .SYSTM .WRS 77 ERR.2  NEXT XPAG: LDA 0,FF JMP .+2 XWLN: LDA 0,CR ;CR IN BUFFER STA 0,TEMP1 POP1 2 MOVZR 2,2 ;B.PTR TO FBA,NOW WORD ADDRESS JSR WRLIN NEXT FF: 6000 .BFBP: BFBP0 XWRC: POP1 2 ;FBA MOVZR 2,2 JSR @.GCH JMP .+1 POP1 1 ;# OF CHARS SUBZL 0,0 ; SUB 0,1,SNR ;LEADING SPACES ? JMP CHAR ;NO LDA 0,@.BFBP ;B.PTR TO SPACES LDA 2,CHAN JSR WRITE CHAR: LDA 0,SP MOVZL 0,0 ;B.PTR TO STACK TOP SUBZL 1,1 ;ONE BYTE LDA 2,CHAN JSR WRITE POP1 1 ;REMOVE CHAR NEXT XWRS: POP1 2 ;FBA MOVZR 2,2 JSR @~.GCH ;GET CHANNEL JMP .+1 POP1 0 ;SL - STRIN LENGTH POP1 1 ;PL - PRINT LENGTH SUBZ# 1,0,SZC ;IF SL>=PL JMP NOSP ;NO LEADER LEEDR: STA 0,Z1 SUB 0,1 ;LDR LENGTH LDA 0,@.BFBP LDA 2,CHAN JSR WRITE LDA 1,Z1 NOSP: POP1 0 LDA 2,CHAN JSR WRITE N7EXT ; ROUTINE TO OUTPUT THE LINE STORED IN THE BUFFER. ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - UNDEFINED ; AC1 - COUNT OF BYTES WRITTEN(INCLUSIVE OF TERMINATOR). ; O AC2 - WORD ADDRESS OF FBA WRLIN: STA 3,USP ;RETURN ADDDRESS JSR @.GCH ;GET CHANNEL HALT ;IMPOSSIBLE LDA 2,CHAN ;CHANNEL JSR @.FIND LDA 2,@CNTAD ADD 0,2 ;FORM BYTE ADDRESS OF NEXT CHARACTER LDA 0,TEMP1 JSR @.BPUT ;STORE THE TERMIN?ATOR LDA 2,CHAN JSR @.FIND ;FIND THE BUFFER IN USE SUB 1,1 STA 1,@CNTAD ;RESET THE CHANNEL BUFFER STA 1,@TABAD LDA 2,CHAN ;RETREIVE CHANNEL NUMBER .SYSTM .WRL 77 ;WRITE THE LINE ERR.2 JMP @USP .END LIFE. YPROGRAM LIFE(INPUT,OUTPUT); (* GAME OF LIFE BY H.L.CONWAY - P7-70 *) CONST MAXBOARDSIZE = 50; TYPE STATE = (DEAD,STABLE,GROWING); NEIGHBOR = SET OF 0..8; BOARDS = PACKED ARRAY [1..MAXBOARDSIZE,1..MAXBOARDSIZE] OF CHAR; VAR SURVIVEPOPULATION : NEIGHBOR;ݟ BOARDSTATE : STATE; NEWBOARD,OLDBOARD : BOARDS; I,J : 0..MAXBOARDSIZE; NUMBEROFNEIGHBORS : 0..8; GENERATION,MAXGENERATION,BOARDSIZE : INTEGER; ALIVECOUNT,CHANGECOUNT : INTEGER; LEFT,RIGHT,UP,DOWN,HORIZOFFSET,VERTOFFSET : -1..+1; BEGIN SURVIVEPOPULQFATION:=[2,3]; WHILE NOT EOF DO BEGIN (* INITIALISE PARAMETERS AND CREATE BOARD *) GENERATION:=0; READLN(MAXGENERATION); READLN(BOARDSIZE); IF BOARDSIZE>MAXBOARDSIZE THEN BEGIN WRITE('!! ',' BOARDSIZE TOO ','BIG - WILL BE RE','SET TO M|AX'); WRITELN('BOARDSIZE'); BOARDSIZE:=MAXBOARDSIZE END; FOR I:=1 TO BOARDSIZE DO FOR J:=1 TO BOARDSIZE DO OLDBOARD[I,J]:=' '; READLN(I,J); (*READ LOCATION OF INITIAL ORGANISM *) WHILE I<>0 DO BEGIN IF (I<0) OR (I>BOARDSIZE) O@{R (J<0) OR (J>BOARDSIZE) THEN WRITELN('!! ','NON-EXISTENT ','CELL .. ELEMENT',' IGNORED ',I,J) ELSE OLDBOARD[I,J]:='*'; READLN(I,J) END; (*BOARD PROCESSING BEGINS NOW *) REPEAT ALIVECOUNT:=0; CHANGECOUNT:=0; FOR I:=1 TO BOARDSIZE DO Y FOR J:=1 TO BOARDSIZE DO BEGIN IF I>1 THEN LEFT:=-1 ELSE LEFT:=0; IF I1 THEN UP:=-1 ELSE UP:=0; IF J0) OR (VERTOFFSafET<>0)) THEN NUMBEROFNEIGHBORS:=NUMBEROFNEIGHBORS+1; (* NOW,SEE WHICH CELLS SHOULD BE ALIVE NEXT GENERATION *) NEWBOARD[I,J]:=' '; IF ((OLDBOARD[I,J]=' ') AND (NUMBEROFNEIGHBORS=3)) OR ((OLDBOARD[I,J]='*') AND (NUMBEROFNEIGHBORS IN SURVIVEgPOPULATION)) THEN BEGIN NEWBOARD[I,J]:='*'; ALIVECOUNT:=ALIVECOUNT+1 END END; (* NEW GENERATION COMPLETE. COPY IT TO OLDBOARD FOR NEXT CYCLE *) GENERATION:=GENERATION+1; WRITELN;WRITELN;WRITELN; WRITELN('GENERATION # ',GENERATION:3,  ' POPULATION = ',ALIVECOUNT:3); FOR I:=1 TO BOARDSIZE DO BEGIN WRITE(' ':14); FOR J:=1 TO BOARDSIZE DO BEGIN WRITE(NEWBOARD[I,J]:2); IF NEWBOARD[I,J]<>OLDBOARD[I,J] THEN BEGIN CHANGECOUNT:=CHANGECOUNT+1; OLDBOARD[I,J]:=NEWBOARD[/I,J] END END; WRITELN END; (* EVALUATE STATE OF BOARD AT END OF THIS GENERATION *) IF ALIVECOUNT=0 THEN BOARDSTATE:=DEAD ELSE IF CHANGECOUNT = 0 THEN BOARDSTATE:=STABLE ELSE BOARDSTATE:=GROWING UNTIL (BOARDSTATE=DEAD) OR (BOARDS$,TATE=STABLE) OR (GENERATION>=MAXGENERATION); CASE BOARDSTATE OF DEAD: WRITELN(' COLONY DIED'); STABLE: WRITELN(' COLONY IS ','STABLE'); GROWING:WRITELN(' MAX GENERATION ','# EXCEEDED') END END (*OF A SINGLE DATA SET *) END. NEW2P4ASMB.rX PROGRAM NEW2P4ASMB(OUTPUT, INPUT); BEGIN WRITELN(OUTPUT, 'TO START WITH, W', 'E ASSUME THAT TH', 'E FOLLOWING FILE', ' NAMES ARE NOT O', 'N YOUR DISK :'); WRITEELN(OUTPUT, ' ' : 20, '** SETUPA'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM'); WRITELN(OUTPUT, ' ' : 20, '** P4MAC'); WRITELN(OUTPUT); WRITELN(OUTPUT, 'PLEASE ENSURE TH', 'AT THE FOLLOWING', ' FILES OF- RELEAS', 'E 2 EXIST ON YOU', 'R DISK :'); WRITELN(OUTPUT, ' ' : 20, '< FASTHASH.SV'); WRITELN(OUTPUT, ' ' : 20, ' SETUP'); WRITELN(OUTPUT, ' ' : 20, ' SETUPAX'); WRITELN(OUTPUT, ' ' : 20, '  SETUPAZ'); WRITELN(OUTPUT, ' ' : 20, ' HEADA2'); WRITELN(OUTPUT, ' ' : 20, ' HEADM2'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM.SV'); WRITELN(OUTPUT, ' ' : 20, ' P4ASM.PC'); WRITELN(OUTPUT, ' ' : 20, ' P4AMX2'); WRITELN(OUTPUT, ' ' : 20, ' P4ASMZ2'); WRITELN(OUTPUT, ' ' : 20, '> P4MACZ2'); WRITELN(OUTPUT); WRITELN(OUTPUT, 'IF YOU DON''T HAV', 'E THE ABOVE FILE', 'S, YOU SHOULD ST', 'OP BY PRESSING T',  'HE ''CNTRL A'' KEY'); WRITELN(OUTPUT, ', OTHERWISE TYPE', ' IN ''RETURN'' KEY', ' TWICE.'); READLN(INPUT); WRITELN(OUTPUT, '****************', ' GENERATION OFc_ N', 'EW PCODE ASSEMBL', 'ER BEGINS NOW ! ', '****************') END. P4ENTERERR. PROGRAM P4ENTEREROR(P4MESSAGE,INPUT,OUTPUT); CONST STRINGLENGTH = 60; TYPE STRING = PACKED ARRAY [1..STRINGLENGTH] OF CHAR; ERRORRECORD = RECORD FIRSTMESSAGE : STRING; FILLER1 : INTEGER; FNILLER2 : INTEGER; SECONDMESSAGE : STRING; FILLER3 : INTEGER END; VAR P4MESSAGE : RANDOM FILE OF ERRORRECORD; COUNT,ERRORNUMBER : INTEGER; TEST : BOOLEAN; PROCEDURE LOADMESSAGE(VAR MESSAGE : STRING); VAR COUNT : 1..STRINGLENGTH; BEGIN READLN(INPUT); FOR COUNT := 1 TO STRINGLENGTH DO IF NOT (EOLN(INPUT) OR EOF(INPUT)) THEN READ(MESSAGE[COUNT]) ELSE MESSAGE[COUNT] := ' ' END (*OF LOADMESSAGE*); BEGIN TEST := TRUE;-k WRITELN(OUTPUT,'ANSWER THE QUEST','IONS TO INSERT N','EW ENTRIES IN TH', 'E INTERPRETER ER','ROR TABLE'); WRITELN(OUTPUT,'VALID RESPONSES ','TO THE FOLLOWING',' QUESTIONS ARE ', 'TERMINATED BY ','A CARRIAGE RETUR','N'g); REPEAT WRITELN(OUTPUT,'TYPE THE ENTRY N','UMBER (0-1026)'); IF NOT TEST THEN READLN(INPUT); READ(INPUT,ERRORNUMBER); IF (ERRORNUMBER >= 0) AND (ERRORNUMBER <= 1026) THEN BEGIN WRITELN(OUTPUT,'NOW TYPE THE TAB','LE ENTRY (UP TO ','60 CHtARS)'); BEGIN GETRANDOM(P4MESSAGE,ERRORNUMBER DIV 2); IF NOT EOR(P4MESSAGE) THEN WITH P4MESSAGE^ DO BEGIN FOR COUNT := 1 TO STRINGLENGTH DO BEGIN FIRSTMESSAGE[COUNT] := ' '; SECONDMESSAGE[COUNT] := ' ' END; FILLER1 := 3338; FILLER3 := 3338 END; IF ODD(ERRORNUMBER) THEN LOADMESSAGE(P4MESSAGE^.SECONDMESSAGE) P ELSE LOADMESSAGE(P4MESSAGE^.FIRSTMESSAGE); PUTRANDOM(P4MESSAGE,ERRORNUMBER DIV 2); WRITELN(OUTPUT,'MESSAGE O.K.'); END END ELSE WRITELN(OUTPUT,'ILLEGAL ERROR NU','MBER ',ERRORNUMBER); WRITELN(OUTPUT,'DO YOU WISH TO ','INSERT MORE ENTR','IES(YES/NO)'); READLN(INPUT); WHILE INPUT^ = ' ' DO GET(INPUT); TEST := INPUT^ <> 'Y' UNTIL TEST END. R2CSPTAB.SRU- .TITL R2CSPTAB ;SPECIAL VERSION OF THE TABLE FOR THE COMPILER ;INCORPORATING THE CALL TO THE OVERLAY ROUTINES. .EXTN XWLN,XWRC,XWRI,XWRR,XWRS .EXTN XRDC,XRDI,XRDR,XRLN .EXTN XGET,XPUT .EXTN XELN .EXTN XATN,XCOS,XEXP,XLOG,XSIN,XSQT .EXTN XNEW,XSAV,XRST .EXTN XRND,XOPN .EXTN XCLS .EXTN XPAG,XOVL .EXTN PUNDF .ENT SPTAB .NREL SPTAB : XGET ;0 XPUT ;1 XRST ;2 XRLN ;3 XNEW ;4 XWLN ;5 XWRS ;6 XELN ;7 XWRI ;8 XWRR ;9 XWRC ;10 XRDI ;11 XRDR ;12 XRDC ;13 XSIN ;14 XCOS ;15 XEXP ;16 XLOG ;17 XSQT ;18 XATN ;19 XSAV ;20 XOPN ;21..OPEN ANY FILE (CREATE IMPLIED) XRND ;22 XOVL ;23 XCLS ;24 PUNDF ;25 PUNDF ;26 XPAG ;27 PUNDF ;28 PUNDF ;29 PUNDF ;30 PUNDF ;31 .END R2SINTEGER.SR 5w .TITL R2SINTEGER ; THE P-CODE INTERPRETER'S INTEGER OPERATIONS .ENT PINC,PADI,PSBI,PNGI,PSQI,PABI,PMOD,PODD,PMPI,PDVI,PDEC .ENT PINCC,PDECC .EXTN .MPY,.DIV .NREL PINCC: MOVS 2,2 ;NB CHAR IN LHB JMP PINC PADI: POP1 2 ;ADD INTEGER PINC: LTOP1 1 } ;INCREMENT (Q FIELD IN AC2) ADD 2,1 STOP1 1 NEXT PDECC: MOVS 2,2 ;NB CHAR IN LHB JMP PDEC PSBI: POP1 2 ;SUBTRACT INTEGER PDEC: LTOP1 1 ;DECREMENT (Q FIELD IN AC2) SUB 2,1 STOP1 1 NEXT PNGI: LTOP1 1 ;NEGATE INTEGER NEG 1,1 STOP1 1 NEXT PSQI: LTOP1 2 ;SQUARE INTEGER JMP MPI1 PABI: LTOP1 1 ;ABSOLUTE VALUE OF INTEGER MOVZL# 1,1,SZC ;NEGATE IF NECESSARY NEG 1,1 STOP1 1 NEXT PMOD: POP1 2 ;MODULUS LTOP1 1 MOVL# 1,1,SZC ;SET AC0 FOR HIGH-ORDER ADC 0,0,SKP ; WORD OF DOUBLE PRECISVION SUB 0,0 ; DIVIDEND FOR .DIV JSR @..DIV ;SIGNED DIVIDE STOP1 0 ;REMAINDER IN AC0 NEXT PODD: LTOP1 1 ;TEST ON ODD MOVR 1,1 ;SET AC1=TRUE IF B15=1 SUBCL 1,1 ; FALSE IF B15=0 STOP1 1 NEXT PMPI: POP1 2 ;MULTIPLY INTEGER MPI1: LTOP61 1 ;ENTRY FROM PSQI SUBO 0,0 ;CLEAR AC0 JSR @..MPY ;SIGNED MULTIPLY STOP1 1 ;LOW ORDER WORD OF DOUBLE NEXT ; PRECISION RESULT IN AC1 ..MPY: .MPY ;(MATH.LB) PDVI: POP1 2 ;DIVIDE INTEGER LTOP1 1 MOVL# 1,1,SZC ;SET AC0 FOR HIGH-ORDER ADC 05,0,SKP ; WORD OF DOUBLE PRECISION SUB 0,0 ; DIVIDEND FOR .DIV JSR @..DIV ;SIGNED DIVIDE STOP1 1 ;QUOTIENT IN AC1 NEXT ..DIV: .DIV ;(MATH.LB) .END R2CITAB.SRY _C .TITL R2CITAB .REV 2,1 ; THE INTERPRETER JUMP TABLE .ENT ITAB0,ITAB1 .EXTN PLOD,PLDO,PSTR,PSRO,PLDA,PLAO,PSTO,PLDC,PLCI,PIND .EXTN PINDC,PSTOC .EXTN PINC,PINCC .EXTN PMST,PCUP,PCXP,PENT,PRET,;]PCSP .EXTN PIXA .EXTN PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PUJP,PFJP,PXJP,PTJP,PUJC .EXTN PCHKC,PCHK2,PCHK3,PCHK4,PEOF .EXTN PADI,PADR,PSBI,PSBR .EXTN PSGS .EXTN PFLT,PFLO,PTRC .EAXTN PNGI,PNGR,PSQI,PSQR,PABI,PABR .EXTN PNOT,PAND,PIOR .EXTN PDIF,PINT,PUNI,PINN  .EXTN PMOD,PODD .EXTN PMPI,PMPR,PDVI,PDVR .EXTN PMOV,PLCA,PDEC,PDECC,PSTP,PHLT .EXTN PCHR,PORDI,PORDA,PORDC,PORDB5 .EXTN PNON .ZREL ITAB0: PNON ; 0 NOT USED PHLT ; 1 PEQU ; 2 PNEQ ; 3 PGEQ ; 4 PGRT q ; 5 PLEQ ; 6 PLES ; 7 PSTO ; 8 PSTO ; 9 PSTOC ; 10 PSTO ; 11 PMST "; 12 PRET ; 13 PADI ; 14 PSBI ; 15 PNGI ; 16 PSQI ; 17 PABI ; 18 PMOD  ; 19 PODD ; 20 PMPI ; 21  PDVI ; 22 PADR ; 23 PSBR ; 24 PFLT ; 25 PFLO K* ; 26 PTRC ; 27 PNGR ; 28 PSQR ; 29 PABR ; 30 PMPR ; 31 PDVR ; 32 PNOT 1# ; 33 PAND ; 34 PIOR  ; 35 PSGS ; 36 PDIF ; 37 PINT ; 38 PUNI ; 39 PINN, ; 40 PEOF ; 41 PSTP ; 42 PLCA ; 43 PORDI ; 44 SET ASIDE PORDA ; 45 4 LOCATIONS PORDC N ; 46 FOR THE PORDB ; 47 ORD FAMILY PCHR ; 48 ; THE GAPS IN THE REMAINDER OF TABLE 0 ARE FOR CORAL PNON ; 49 PNON ; 50 PHNON ; 51 PNON ; 52 PNON ; 53 PNON ; 54 PNON ; 55 PNON ; 56 PNON ; 57 R5 PNON ; 58 PNON  ; 59 PNON ; 60 PNON ; 61 PNON ; 62 PNON ; 63 ITAB1: PNON ; 64 NOT USED : PUJC ; 65 PEQU ; 66 PNEQ ; 67 PGEQ ; 68 PGRT ; 69 PLEQ ; 70 PLES ; !|71 N.B MULTIPLE COMPARES  PLOD ; 72 PLOD ; 73 PLOD ; 74 PLOD ; 75 PLDO ; 76 PLDO ; 77 d_ PLDO ; 78 PLDO ; 79 PSTR ; 80 PSTR ; 81 PSTR ; 82 PSTR ; 83 PSRO ; 84 OV PSRO  ; 85 PSRO ; 86 PSRO ; 87 PIND ; 88 PIND ; 89 PINDC ; 90 PIND ; 91 F PLDA ; 92 PLAO ; 93 PLDC ; 94 PIXA ; 95 PMOV ; 96 PCUP ; 97 PENT ; @]98  PCSP ; 99 PUJP ;100 PFJP ;101 PTJP ;102 PXJP ;103 PINC ;104 PNON v ;105 ALSO INC PINCC ;106 PNON ;107 ALSO INC PDEC ;108 ALSO NEEDS NEXT 3 PNON ;109 PDECC ;110 PNON 5 ;111 PCHKC ;112 NEEDS 3 MORE PCHK2 ;113 PCHK3 ;114 PCHK4 ;115 ; THE GAPS IN THE REMAINDER OF TABLE 1 ARE FOR CORAL PNON ; 116 PCXP ; 117 PNON ; 118 PNON ; 119 PNON ; 120 PNON ; 121 PNON ; 122  $ PNON ; 123 PNON ; 124 PNON ; 125 PNON ; 126 PNON ; 127 .END P4ERRSUM.! $8 PROGRAM ERRSUM(OUTPUT); CONST MAXBIT = 59; MAXSETMOD = 60; (*MAXBIT+1*) MAXSET = 10; VAR I : 0..MAXSET; N : 0..MAXBIT; M : INTEGER; ERROR : ARRAY [0..MAXSET] OF SET OF 0..MAXBIT; P4ERRORS : FILE OF SET OF 0..MAXBIT; PROCEDURE MESSAGE1; VAR PM : 0..59; BEGIN P := M; CASE P OF 1: WRITELN(OUTPUT,'ERROR IN SIMPLE ','TYPE'); 2: WRITELN(OUTPUT,'IDENTIFIER EXPEC','TED'); 3: WRITELN(OUTPUT,'''PROGRAM'' EXPE','CTED'); 4: WRITELN(OUTPUT,''')'' EXPECTED'); 5: WRITELNО(OUTPUT,''':'' EXPECTED'); 6: WRITELN(OUTPUT,'ILLEGAL SYMBOL'); 7: WRITELN(OUTPUT,'ERROR IN PARAMET','ER LIST'); 8: WRITELN(OUTPUT,'''OF'' EXPECTED'); 9: WRITELN(OUTPUT,'''('' EXPECTED'); 10: WRITELN(OUTPUT,'ERROR IN TYPE'); 1+1: WRITELN(OUTPUT,'''['' EXPECTED'); 12: WRITELN(OUTPUT,''']'' EXPECTED'); 13: WRITELN(OUTPUT,'''END'' EXPECTED'); 14: WRITELN(OUTPUT,''';'' EXPECTED'); 15: WRITELN(OUTPUT,'INTEGER EXPECTED'); 16: WRITELN(OUTPUT,'''='' EXPECTED');  17: WRITELN(OUTPUT,'''BEGIN'' EXPECT','ED'); 18: WRITELN(OUTPUT,'ERROR IN DECLARA','TION PART'); 19: WRITELN(OUTPUT,'ERROR IN FIELD L','IST'); 20: WRITELN(OUTPUT,''','' EXPECTED'); 21: WRITELN(OUTPUT,'''.'' EXPECTED'); 50: W=!RITELN(OUTPUT,'ERROR IN CONSTAN','T'); 51: WRITELN(OUTPUT,''':='' EXPECTED'); 52: WRITELN(OUTPUT,'''THEN'' EXPECTE','D'); 53: WRITELN(OUTPUT,'''UNTIL'' EXPECT','ED'); 54: WRITELN(OUTPUT,'''DO'' EXPECTED'); 55: WRITELN(OUTPUT,'''TO' '/''DOWNTO''',' EXPECTED'); 56: WRITELN(OUTPUT,'''IF'' EXPECTED'); 57: WRITELN(OUTPUT,'''FILE'' EXPECTE','D'); 58: WRITELN(OUTPUT,'ERROR IN FACTOR'); 59: WRITELN(OUTPUT,'ERROR IN VARIABL','E'); END (* OF CASE *) END (*MESSAGE1*); 3 PROCEDURE MESSAGE2; VAR P : 60..119; BEGIN P := M; CASE P OF 101: WRITELN(OUTPUT,'IDENTIFIER DECLA','RED TWICE'); 102: WRITELN(OUTPUT,'LOW BOUND EXCEED','S HIGHBOUND'); 103: WRITELN(OUTPUT,'IDENTIFIER IS NO','T OF APPRO2PRIATE',' CLASS'); 104: WRITELN(OUTPUT,'IDENTIFIER NOT D','ECLARED'); 105: WRITELN(OUTPUT,'SIGN NOT ALLOWED'); 106: WRITELN(OUTPUT,'NUMBER EXPECTED'); 107: WRITELN(OUTPUT,'INCOMPATABLE SUB','RANGE TYPES'); 108: WRITELN(OUTPUT,'FILED NOT ALLOWED',' HERE'); 109: WRITELN(OUTPUT,'TYPE MUST NOTBE ','REAL'); 110: WRITELN(OUTPUT,'TAGFIELD TYPE MU','ST BE SCALAR OR ','SUBRANGE'); 111: WRITELN(OUTPUT,'INCOMPATIBLE WIT','H TAGFIELD TYPE'); 112: WRITELN(OUTPUT,'INDEX TYPE MU?EST ','NOT BE REAL'); 113: WRITELN(OUTPUT,'INDEX TYPE MUST ','BE SCALAR OR SUB','RANGE'); 114: WRITELN(OUTPUT,'BASE TYPE MUST N','OT BE REAL'); 115: WRITELN(OUTPUT,'BASE TYPE MUST B','E SCALAR OR SUBR','ANGE');  116: WRITELN(OUTPUT,'ERRORC IN TYPE OF',' STANDARD PROCED','URE PARAMETER'); 117: WRITELN(OUTPUT,'UNSATISFIED FORW','ARD REFERENCE'); 118: WRITELN(OUTPUT,'FORWARD REFERENC','E TYPE IDENTIFIE', 'R IN VARIABLE DE','CLARATION'); 119: WRITELN(OUTP?UT,'FORWARD DECLARED','; REPETITION OF ', 'PARAMETER LIST N','OT ALLOWED'); END (* OF CASE *) END (*MESSAGE2*); PROCEDURE MESS3A; VAR P : 120..145; BEGIN P := M; CASE P OF 120: WRITELN(OUTPUT,'FUNCTION$ RESULT ','TYPE MUST BE SCA', 'LAR, SUBRANGE OR',' POINTER'); 121: WRITELN(OUTPUT,'FILE VALUE PARAM','ETER NOT ALLOWED'); 122: WRITELN(OUTPUT,'FORWARD DECLARED',' FUNCTION; REPET', 'ITION OF RESUL7)T ','TYPE NOT ALLOWED'); 123: WRITELN(OUTPUT,'MISSING RESULT T','YPE IN FUNCTION ','DECLARATION'); 124: WRITELN(OUTPUT,'F-FORMAT FOR REA','L ONLY'); 125: WRITELN(OUTPUT,'ERROR IN TYPE OF',' STANDARD FUNCTI','ON PARAMETER'); 126: WRITELN(OUTPUT,'NUMBER OF PARAME','TERS DOES NOT AG', 'REE WITH DECLARA','TION'); 127: WRITELN(OUTPUT,'ILLEGAL PARAMETE','R SUBSTITUTION'); 128: WRITELN(OUTPUT,'RESULT TYPE OF P','ARAMETER FUNCTIO', 'N DOES NOT AGREE',' WITH DECLARATIO','N'); 129: WRITELN(OUTPUT,'TYPE CONFLICT OF',' OPERANDS'); 130: WRITELN(OUTPUT,'EXPRESSION IS NO','T OF SET TYPE'); 131: WRITELN(OUTPUT,'TESTS ON EQUALIT','Y ALLOWED ONLY'); 132: WRITELN(OUTPUT,'STRICT |INCLUSION',' NOT ALLOWED'); 133: WRITELN(OUTPUT,'FILE COMPARISION',' NOT ALLOWED'); 134: WRITELN(OUTPUT,'ILLEGL TYPE OF O','PERAND(S)'); 135: WRITELN(OUTPUT,'TYPE OF OPERAND ','MUST BE BOOLEAN'); 136: WRITELN(OUTPUT,'SET ELEMENT TYPE','* MUST BE SCALAR ','OR SUBRANGE'); 137: WRITELN(OUTPUT,'SET ELEMENT TYPE','S NOT COMPATIBLE'); 138: WRITELN(OUTPUT,'TYPE OF VARIABLE',' IS NOT ARRAY'); 139: WRITELN(OUTPUT,'INDEX TYPE IS NO','T COMPATIBLE WIT','H DECLARATION'); 140: WRITELN(OUTPUT,'TYPE OF VARIABLE',' IS NOT RECORD'); 141: WRITELN(OUTPUT,'TYPE OF VARIABLE',' MUST BE FILE OR',' PIONTER'); 142: WRITELN(OUTPUT,'ILLEGAL PARAMETE','R SUBSTITUTION'); 143: WRITELN(OUTPUT,'ILLEGAL TYPE OF ','LOOP CONTROL VAR','IABLE'); 144: WRITELN(OUTPUT,'ILLEGAL TYPE OF ','EXPRESSION'); 145: WRITELN(OUTPUT,'TYPE CONFLICT'); END (* OF CASE *) END (* OF MESS3A *); PROCEDURE MESS3B; VAR P : 146..159; BEGIN P := M; CASE P OF 146: WRITELN(OUTPUT:,'ASSIGMENT OF FIL','ES NOT ALLOWED'); 147: WRITELN(OUTPUT,'LABEL TYPE INCOM','PATIBLE WITH SEL', 'ECTING EXPRESSIO','N'); 148: WRITELN(OUTPUT,'SUBRANGE BOUNDS ','MUST BE SCALAR'); 149: WRITELN(OUTPUT,'INDEX TYPE MUST ','NOT BE INTEGER'); 150: WRITELN(OUTPUT,'ASSIGNMENT TO ST','ANDARD FUNCTION ','IS NOT ALLOWED'); 151: WRITELN(OUTPUT,'ASSIGNMENT TO FO','RMAL FUNCTION IS',' NOT ALLOWED'); 152: WRITELN(OUTPUT,'NO SUCH FIELD IN',' THIS RECORD'); 153: (GWRITELN(OUTPUT,'TYPE ERROR IN RE','AD'); 154: WRITELN(OUTPUT,'ACTUAL PARAMETER',' MUST BE A VARIA','BLE'); 155: WRITELN(OUTPUT,'CONTROL VARIABLE',' MUST NEITHER BE', ' FORMAL NOR NON ','LOCAL'); 156: WRITELN(OUTPUT,';MULTIDEFINED CAS','E LABEL'); 157: WRITELN(OUTPUT,'TOO MANY CASES I','N CASE STATEMENT'); 158: WRITELN(OUTPUT,'MISSING CORRESPO','NDING VARIANT DE','CLARATION'); 159: WRITELN(OUTPUT,'REAL OR STRING T','AGFIELDS NOT ALL','OWED'); END (* O-5F CASE *) END (* MESS3B *); PROCEDURE MESS3C; VAR P : 160..179; BEGIN P := M; CASE P OF 160: WRITELN(OUTPUT,'PREVIOUS DECLARA','TION WAS NOT FOR','WARD'); 161: WRITELN(OUTPUT,'AGAIN FORWARD DE','CLARED'); 162: WRITELN(O2UTPUT,'PARAMETER SIZE M','UST BE CONSTANT'); 163: WRITELN(OUTPUT,'MISSING VARIANT ','IN DECLARATION'); 164: WRITELN(OUTPUT,'SUBSTITUTION OF ','STANDARD PROC/FU','NC NOT ALLOWED'); 165: WRITELN(OUTPUT,'MULTIDEFINED LAB','EL'); 166: WRITELN(OUTPUT,'MULTIDECLARED LA','BEL'); 167: WRITELN(OUTPUT,'UNDECLARED LABEL'); 168: WRITELN(OUTPUT,'UNDEFINED LABEL'); 169: WRITELN(OUTPUT,'ERROR IN BASE SE','T'); 170: WRITELN(OUTPUT,'VALUE PARAMETER ','EXPECTED'); 171: WRITELN(OUTtPUT,'STANDARD FILE WA','S REDECLARED'); 172: WRITELN(OUTPUT,'UNDECLARED EXTER','NAL FILE'); 173: WRITELN(OUTPUT,'FORTRAN PROCEDUR','E OR FUNCTION EX','PECTED'); 174: WRITELN(OUTPUT,'PASCAL PROCEDURE',' OR FUNCTION EXP','ECTED'); 175: WRITELN(OUTPUT,'MISSING FILE ''I','NPUT'' IN PROGRA','M HEADING'); 176: WRITELN(OUTPUT,'MISSING FILE ''O','UTPUT'' IN PROGR','AM HEADING'); 178: WRITELN(OUTPUT,'ILLEGAL TAGFIELD',' IN VARIANT'); END (*OF CASE*) END (*MESS3C*); PROCEDURE MESSAGE3; BEGIN IF M > 145 THEN BEGIN IF M > 159 THEN MESS3C ELSE MESS3B END ELSE MESS3A END (*MESAGE3*); PROCEDURE MESSAGE4; VAR P : 180..239; BEGIN P := M; CASE P OF W5 201: WRITELN(OUTPUT,'ERROR IN REAL CO','NSTANT: DIGIT EX','PECTED'); 202: WRITELN(OUTPUT,'STRING CONSTANT ','MUST NOT EXCEED ','SOURCE LINE'); 203: WRITELN(OUTPUT,'INTEGER CONSTANT',' EXCEEDS RANGE'); 204: WRITELN(OUTPUT,'8 OR 9 IN OCTA,L ','NUMBER'); END (* OF CASE *) END (*MESSAGE4*); PROCEDURE MESSAGE5; VAR P : 240..299; BEGIN P := M; CASE P OF 250: WRITELN(OUTPUT,'TOO MANY NESTED ','SCOPES OF IDENTI','FIERS'); 251: WRITELN(OUTPUT,'TOO MANY NESTED ','PROCEDURES AND/O','R FUNCTIONS'); 252: WRITELN(OUTPUT,'TOO MANY FORWARD',' REFERENCES OF P','ROCEDURE ENTRIES'); 253: WRITELN(OUTPUT,'PROCEDURE TOO LO','NG'); 254: WRITELN(OUTPUT,'TOO MANY LONG CO','NSTANTS IN THIS ','PROCEDURE'); 255: WRITELN(OUTPUT,'TOO MANY ERRORS ','ON THIS SOURCE L','INE'); 256: WRITELN(OUTPUT,'TOO MANY EXTERNA','L REFERENCES'); 257: WRITELN(OUTPUT,'TOO MANY EXTERNA','LS'); 258: WRITELN(OUTPUT,'TOO MANY LOCAL F','ILES'); 259: WRITELN(OUTPUT,'EXPRfESSION TOO C','OMPLICATED'); END (* OF CASE *) END (*MESSAGE5*); PROCEDURE MESSAGE6; VAR P : 300..359; BEGIN P := M; CASE P OF 300: WRITELN(OUTPUT,'DIVISION BY ZERO'); 301: WRITELN(OUTPUT,'NO CASE PROVIDED',' FOR THIS VALOxUE'); 302: WRITELN(OUTPUT,'INDEX EXPRESSION',' OUT OF BOUNDS');  303: WRITELN(OUTPUT,'VALUE TO BE ASSI','GNED IS OUT OF B','OUNDS'); 304: WRITELN(OUTPUT,'ELEMENT EXPRESSI','ON OUT OF RANGE'); 350: WRITELN(OUTPUT,'GLOBAL LABEL ','NOT AL3LOWED WHEN',' DECLARING ', 'EXTERNAL PROC/','FUNC'); 351: WRITELN(OUTPUT,'GLOBAL VAR ','NOT ALLOWED ','WHEN DECLARING', ' EXTERNAL ','PROC/FUNC'); END (* OF CASE *) END (* MESSAGE6 *); PROCEDΔURE MESSAGE7; VAR P : 360..419; BEGIN P := M; CASE P OF 399: WRITELN(OUTPUT,'IMPLEMENTATION R','ESTRICTION'); 398: WRITELN(OUTPUT,'VARIABLE DIMENSI','ON ARRAYS NOT IM','PLEMENTED'); 400: WRITELN(OUTPUT,'ATTEMPT TO ACCES','S A־N INDEXED VAR','IABLE DIRECTLY'); END (* OF CASE *) END(* MESSAGE7*); PROCEDURE MESSAGE9; VAR P : 480..539; BEGIN P := M; CASE P OF 500: WRITELN(OUTPUT,'LOAD ERROR'); 501: WRITELN(OUTPUT,'LOAD ERROR'); END (* OF CASE *) END (*MESSAGE9*); BEGIN (* MAIN*) FOR I := 0 TO MAXSET DO BEGIN GET(P4ERRORS); ERROR[I] := P4ERRORS^ END; WRITELN(OUTPUT,' ':10,'ERROR SUMMARY'); WRITELN(OUTPUT,' ':10,'*************'); WRITELN(OUTPUT); FOR I := 0 TO MAXSET DO FOR N := 0 TwO MAXBIT DO IF N IN ERROR[I] THEN BEGIN M := I * MAXSETMOD + N; WRITE(OUTPUT,' ':3,M:6,':',' ':4); CASE I OF 0 : MESSAGE1; 1 : MESSAGE2; 2 : MESSAGE3; 3 : MESSAGE4; 4 : MESSAGE5; 5 : MESSAGE6; 6 : MESSAGE7; S 8 : MESSAGE9; 7,9,10 : ;  END (*OF CASE*); END END (*OF PROGRAM*). R2IFT.SR ?s .TITL R2IFT ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO READ REAL AND WRITE REAL .ENT XRDR,XWRR .EXTN PUNDF .NREL XRDR: XWRR: .PUND .END NEW2P4ASME.kk LPROGRAM NEW2P4ASME(OUTPUT); BEGIN WRITELN(OUTPUT, '****************', ' GENERATION OF N', 'EW PCODE ASSEMBL', 'ER COMPLETED. **', '***************'); WRITELN(OUTB8PUT, 'YOU MAY DELETE A', 'LL OTHER FILES O', 'F RELEASE II MEN', 'TIONED AT THE '); WRITELN(OUTPUT, ' BEGINNING PLUS ', 'SETUP.SV, SETU' : 14, 'zxPA.SV, P4AMY2 AN', 'D P4MAC.SV EXCEP', 'T P4ASM.SV'); WRITELN(OUTPUT) END. MAKE2P4AM.CMrX 9NEW2P4ASMB $TTO $TTI;^ PASCAL/Z SETUP $LPT/L;^ DELETE/V SETUP.RB;^ SETUP SETUP.TB $TTO;^ FASTHASH P4ASM.PC SETUPAY SETUP.TB $LPT;^ APPEND SETUPA SETUPAX SETUPAY SETUPAZ;^ PASCAL/Z SETUPA $LPT/L;^ DELETE/V SETUPA SETUPA.RB;^ SETUPA P4AMY2 $TTO;^ APPEND P4MA+C HEADM2 P4AMX2 P4AMY2 P4MACZ2;^ PASCAL/Z P4MAC $LPT/L;^ DELETE/V P4MAC;^ APPEND P4ASM HEADA2 P4AMX2 P4AMY2 P4ASMZ2;^ PASCAL/Z/P P4ASM $LPT/L;^ DELETE/V P4ASM;^ NEW2P4ASME $TTO R2RFNS.SR < .TITL R2RFNS .ENT PFPIN,PFPES,PFPEX,PFPEF .ENT XATN,XCOS,XEXP,XLOG,XSIN,XSQT .ENT XRND .EXTD WSA .EXTN FENT, PTRC .NREL PFPFN: PFPIN: STA 3,TAC3 ;ENTRY USED BY UNARY OPERATORS SUB 3,3 ;AND EVERYTHING ELSE LDA 2,WSA ;RFPI WRITE AREA STA 3,0,2  ;OVFL UNFL FLAGS DSZ SP FENT FLDA 1,@SP FJMP @TAC3 TAC3: 0 PFPES: FSTA 0,@SP ;EXIT ROUTINE 3 ENTRIES PFPEX: FEXT ISZ SP PFPEF: LDA 2,WSA LDA 3,0,2 MOV 3,3,SNR ;ANY FP FLAGS SET ? NEXT ;NO ERR.P PERFP ;YES ERROR406 ;THE FOLLOWING STANDA&RD FUNCTION CALLS ;HAVE A COMMON FORMAT. THE JSR TO PFPFN ;LOADS THE FP OPERANDS INTO FP ACCUMULATOR ;1. THE FJMP TO PFPES ENSURES THAT THE ;RESULT IS STORED. IN THE EVENT OF OVFL OR ;UNDFL ERROR 406 IS REPORTED TO RDOS XATN: JSR PFPFN FATN 1,0 FJMP PFP^[ES XCOS: JSR PFPFN FCOS 1,0 FJMP PFPES XEXP: JSR PFPFN FEXP 1,0 FJMP PFPES XLOG: JSR PFPFN FALG 1,0 FJMP PFPES XSIN: JSR PFPFN FSIN 1,0 FJMP PFPES XSQT: JSR PFPFN FSQR 1,0 FJMP PFPES XRND: JSR PFPFN FRND 1,0 FSTA 0,@SP FLD3 .PTRC FJMP 1)t,3 .PTRC: PTRC .END COM.CM 3TYPER2SHEAP.SRR2RFW.SR =,5 .TITLE R2RFW .ENT WSA ;RELOCATABLE FLOATING POINT INTERPRETER (RFPI) ;NEEDS A WRITE AREA OF 100 DECIMAL LOCATIONS, THE ;ADDRESS OF THIS AREA TO BE GIVEN AT LOCATION ;WSA IN PAGE ZERO. THE AREA IS INITIALISED ONCE ;ONLY BY SEGMENT PR. .ZREL WSA: FPPAD Q .NREL FPPAD: .BLK 100. .END SETUP.mm P(* UNIVERSITY OF LANCASTER DEPARTMENT OF CCOPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE I/II DATE : MARCH, 1977 *) (*******K'*************************************************** THIS PROGRAM IS TO PRODUCE A HASH TABLE FOR ALL THE PCODE MNEMONICS. NO OPTIMAL STRATEGY IS INCORPORATED TO SPEED UP THE ACCESSING MECHANISM. # TO ACTIVATE THIS PROGRAM, DO THE FOLLOWING COMMAND : SETUP SETUP.TB ======================= WHERE 'SETUP.TB' IS THE OUTPUT FILE USED TO CONTAIN THE HASH TABLE  AND WILL BE USED AS INPUT FILE TO THE PROGRAM "FASTHASH" IS THE PRR FILE USED TO CONTAIN SOME USEFUL INFORMATION FOR USER REFERENCE. ***********J**********************************************) PROGRAM SETUP(OUTPUT, PRR); CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) TYPE STRING4 = ARRAY[1..4] OF CHAR; STRING6 = ARRAY[1..6] OF CHARx; TEMPLATE = RECORD PCODE : STRING4; SEMICODE : STRING6; ACTION : INTEGER END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; ; I, J, K : 1..TABLESIZE; ZERO, ENTRIES, PETTY : INTEGER; PROCEDURE HASH(HPCODE : STRING4; HSEMICODE : STRING6; HACTION : INTEGER); VAR TEMP, RNDM, PI : INTEGER; BEGIN TEMP := ORD(HPCODE[1]) * 4 + ORD(HPCODE[2]) * 2 + ORD(HPCODE[3]) ; IF ORD(HPCODE[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(HPCODE[4]); TEMP := TEMP MOD TABLESIZE; RNDM := 1; PI := 0; WHILE PCODETABLE[ (TEMP + PI) MOD TABLESIZE].PCODE <> ' ' DO BEGIN (* OF THE REHASHING ALGORITHM MENTIONED BY DAVID GRIES IN HIS 'COMPILER CONSTRUCTION' *) RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); END;  (* AN EMPTY ENTRY IN THE PCODE TABLE IS FOUND *) WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN PCODE := HPCODE; SEMICODE := HSEMICODE; ACTION := HACTION; END; ENTRIES := ENTRIES + 1 G0 END (* OF HASH *); PROCEDURE COMPLETETASK; PROCEDURE TASK1; BEGIN (********** GROUP 1 WITH NO OPERANDS **********) (* TYPES OF THE FOLLOWING FORMAT IN A 16-BIT WORD ................... < : : : :00XXXXTT:XX000000: : : : :........:........: WHERE TT = 00 IF INTEGER, ADDRESS OR BOOLEAN = 01 IF REAL a6 = 10 IF CHAR = 11 IF SET OR RECORD. X = 0 OR 1. NB THE ABOVE FORMAT APPLIES TO INSTRUCTIONS HAVING A 'C' FIELD *)  HASH('STOA', '004000', 0); HASH('STOB', '004000', 0); HASH('STOC', '005000', 0); HASH('STOI', '004000', 0); HASH('STOR', '004400', 0); HASH('STOS', '005400', 0); HASH('EOF ', '024400', 0); HASH('ADI ', '007000', 0); HASH('ADR ', '013400', 0); HASH('SBI ', '007400', 0); HASH('SBR ', '014000', 0); HASH('SGS ', '022000', 0); HASH('FLT ', '014400', 0); HASH('FLO ', '015000', 0); HASH('TRC ', '015400', 0); HASH('NGI ', '010000', 0); HASH('NGR ', '016000', 0); HASH('SQI ', '010400', 0); HASH('SQR ', '016400', 0); HASH('ABI ', '011000', 0); H{ASH('ABR ', '017000', 0); HASH('NOT ', '020400', 0); HASH('AND ', '021000', 0); HASH('IOR ', '021400', 0); HASH('DIF ', '022400', 0); HASH('INT ', '023000', 0); HASH('UNI ', '023400', 0);  HASH('INN ', '024000', 0); HASH('MOD ', '011400', 0); HASH('ODD ', '012000', 0); HASH('LCA ', '025400', 0); END (* TO BE CONTINUED IN TASK2 *); PROCEDURE TASK2; BEGIN (* CONTINUED FROMu TASK1 *) HASH('MPI ', '012400', 0); HASH('MPR ', '017400', 0); HASH('DVI ', '013000', 0); HASH('DVR ', '020000', 0); HASH('STP ', '025000', 0); HASH('CHR ', '030000', 0); HASH('QORDA', '026400', 0); HASH('ORDB', '027400', 0); HASH('ORDC', '027000', 0); HASH('ORDI', '026000', 0); (* COMPARISON TYPES WITH THE FOLLOWING FORMAT ................... : : G : :00XXXXXX:XXXXXTTT: : : : :........:........: WHERE TTT = 001 IF INTEGER OR CHAR = 010 IF REAL = 011 IF BOOLEAN  = 100 IF SET OR RECORD = 101 IF ADDRESS. X = 0 OR 1. *) HASH('EQUA', '001005', 0); HASH('EQUB', '001003', 0); HASH('EQUC', '001001', 0); HASH('EQUI',G '001001', 0); HASH('EQUR', '001002', 0); HASH('EQUS', '001004', 0); HASH('NEQA', '001405', 0); HASH('NEQB', '001403', 0); HASH('NEQC', '001401', 0); HASH('NEQI', '001401', 0); HASH('NEQR', '001402', 0); HASH('NEQS', '001404', 0); HASH('GEQA', '002005', 0); HASH('GEQB', '002003', 0); HASH('GEQC', '002001', 0); HASH('GEQI', '002001', 0); HASH('GEQR', '002002', 0); tR HASH('GEQS', '002004', 0); END (* TO BE CONTINUED IN TASK3 *); PROCEDURE TASK3; BEGIN (* CONTINUED FROM TASK3 *) HASH('GRTA', '002405', 0); HASH('GRTB', '002403', 0); HASH('GRTC', '002401', 0); HASH('GRTI', '002401', 0); HASH('GRTR', '002402', 0); HASH('GRTS', '002404', 0); HASH('LEQA', '003005', 0); HASH('LEQB', '003003', 0); HASH('LEQC', '003001', 0); HASH(I'LEQI', '003001', 0); HASH('LEQR', '003002', 0);  HASH('LEQS', '003004', 0); HASH('LESA', '003405', 0); HASH('LESB', '003403', 0); HASH('LESC', '003401', 0); HASH('LESI', '003401', 0);  HASH('LESR', '003402', 0); HASH('LESS', '003404', 0); HASH('RETA', '006401', 0); HASH('RETB', '006401', 0); HASH('RETC', '006401', 0); HASH('RETI', '006401', 0); HASH('RETP', '006400'k, 0); HASH('RETR', '006402', 0); END (* OF TASK1 *); PROCEDURE TASK4; BEGIN (********** GROUP 2 WITH OPERANDS **********) (* TYPES WITH THE FOLLOWING FORMAT ...................  : : : :W1XXXXXX:XX000000: : : : :........:........: WHERE W = 0 IF ONE-WORD INSTRUCTION = 1 IF TWO-WORD INSTRUCTION X = 0 OR d1. *) (* COMPARISON TYPES *) (********************) HASH('EQUM', '001000', 10); HASH('NEQM', '001400', 10); HASH('GEQM', '002000', 10); HASH('GRTM', '002400', 10); HASH('LEQf#M', '003000', 10); HASH('LESM', '003400', 10); (* OTHER TYPES *) (***************) HASH('LODA', '044000', 20); HASH('LODB', '044000', 20); HASH('LODC', '044000', 20); HASH('LODI', '044000', 20); HASH('LODR', '044000', 30); HASH('LODS', '044000', 40); HASH('STRA', '050000', 20); HASH('STRB', '050000', 20); HASH('STRC', '050000', 20); HASH('STRI', '050000', 20); HASH('MSTRR', '050000', 30); HASH('STRS', '050000', 40); HASH('LDA ', '056000', 20); HASH('CXP ', '072400', 50); HASH('HLT ', '000400', 0); HASH('CUP ', '060400', 50); HASH('MST ', '006000', 60); > HASH('LDOA', '046000', 70); HASH('LDOB', '046000', 70); HASH('LDOC', '046000', 70); HASH('LDOI', '046000', 70); HASH('LDOR', '046000', 90); HASH('LDOS', '046000', 100); END (* TO BE CONTINUED I8.N TASK5 *); PROCEDURE TASK5; BEGIN (*CONTINUED FROM TASK4 *) HASH('SROA', '052000', 70); HASH('SROB', '052000', 70); HASH('SROC', '052000', 70); HASH('SROI', '052000', 70); HASH('SROR', '052000', 90); HASH('SROS', '052000', 100); HASH('LAO ', '056400', 70); HASH('INDA', '054000', 70); HASH('INDB', '054000', 70); HASH('INDC', '054000', 80); HASH('INDI', '054000', 70);  HASH('INDR', '054000', 90); HASH('INDS', '054000', 100); HASH('INCA', '064000', 110); HASH('INCI', '064000', 110); HASH('INCC', '065000', 110); HASH('IXA ', '057400', 110); HASH('MOV ', '0600%00', 120); END (* TO BE CONTINUED IN TASK6 *); PROCEDURE TASK6; BEGIN (* CONTINUED FROM TASK5 *) HASH('DECA', '066000', 110); HASH('DECI', '066000', 110); HASH('DECC', '067000', 110); H"ASH('ENT ', '061000', 130); HASH('UJC ', '040400', 140); HASH('UJP ', '062000', 150); HASH('FJP ', '062400', 150); HASH('XJP ', '063400', 150); HASH('TJP ', '063000', 150); HASH('CSP ', '061400', 160); HASH('CHKA', '171400', 170); HASH('CHKB', '070400', 170); HASH('CHKC', '070000', 170); HASH('CHKI', '070400', 170); HASH('CHKR', '070000', 170); HASH('CHKS', '070000', 170); HAj+SH('LDC ', '057000', 180); HASH('LDCB', '057000', 190); HASH('LDCC', '057000', 200); HASH('LDCI', '057000', 190); HASH('LDCN', '057000', 210); HASH('LDCR', '057000', 220);  HASH('JNC ', '032000', 2Jd30); END (* OF TASK 4 *); PROCEDURE TASK7; BEGIN (* STANDARD PROCEDURES *) HASH('ATN ', '000023', 0); HASH('COS ', '000017', 0); HASH('ELN ', '000007', 0); HASH('EXP ', '000020', 0); HASH('GET ', '000000', 0); HASH('LOG ', '000021', 0); HASH('NEW ', '000004', 0); HASH('PUT ', '000001', 0); HASH('RDC ', '000015', 0); HASH('RDI ', '000013', 0); HASH('RDR ', '000)014', 0); HASH('RLN ', '000003', 0); HASH('RST ', '000002', 0); HASH('SAV ', '000024', 0); HASH('SIN ', '000016', 0); HASH('SQT ', '000022', 0); HASH('WLN ', '000005', 0); HASH('WRRC ', '000012', 0); HASH('WRI ', '000010', 0); HASH('WRR ', '000011', 0); HASH('WRS ', '000006', 0); HASH('OPN ', '000025', 0); HASH('RND ', '000026', 0); HASH('OVL ', '000027', 0);  HASH('CLS ', '000030', 0); HASH('RRR ', '000031', 0); HASH('WDR ', '000032', 0); HASH('PAG ', '000033', 0); HASH('EOR ', '000034', 0); HASH('RWR ', '000035', 0); HASH('RSE ', '000036', 09); END (* OF TASK7 *); BEGIN (* OF COMPLETETASK *) TASK1; TASK2; TASK3; TASK4; TASK5; TASK6; TASK7; END (* OF COMPLETE TASK *); BEGIN (* OF MAIN PROGRAM *) WRITELN(PRR, 'SETUP STARTS'); WRITELN; WRITELN; WRITELN; FOR I := 0 TO TABSIZE0 DO BEGIN PCODETABLE[I].PCODE := ' '; PCODETABLE[I].SEMICODE := ' '; PCODETABLE[I].ACTION := 0 END; ZERO := ORD('0'); COMPLETETASK; ; WRITE('*'); (* WRITE '*' AS THE HEADER TO INDICATE THAT HASH TABLE IS TO FOLLOW *) FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO BEGIN WRITE(PCODE); IF SEMICODE[1] = ' ' THEN  WRITE(0 : 6, 0 : 4) ELSE BEGIN PETTY := 0; IF SEMICODE[1] = '1' THEN PETTY := -8; WRITE( ((((PETTY + ORD(SEMICODE[2]) - ZERO ) * 8 +  ORD(SEMICODE[3]) - ZERO ) * 8 + ORD(SEMICODE[4]) - ZERO ) * 8 + ORD(SEMICODE[5]) - ZERO ) * 8 +  ORD(SEMICODE[6]) -ZERO : 6, ACTION : 4); END; v WRITELN END; WRITELN(PRR, '; HASH TABLE SIZ', 'E = ' : 8, TABLESIZE : 1); WRITELN(PRR, '; TOTAL PCODE EN', 'TRIES = ' : 8, ENTRIES : 1); WRITELN(PRR, '; LOADING FACTOR', ' = ' : 8, ENTRIES/TABLESIZE : 1) END. R2RFILES.CMDR2SECHK,^ R2ROUTL,^ R2SMPD,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2RFT,^ R2SITAB,^ R2SDIV,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2SDECODER,^ R2SMYP,^ R2RR7&EAL,^ R2SREWR,^ R2RFNS,^ R2SSPTAB,^ R2SCONSTS,^ R2RFW^ R2SSET.SR 6 .TITL R2SSET ; THE P-CODE INTERPRETER'S SET OPERATIONS .ENT PSGS,PDIF,PINT,PUNI,PINN,MIN4 .ZREL N16: 20 ;USEFUL CONSTANTS MIN4: -4 ASP=Z1 ;AUXILLIARY SET PTR .MACRO SASP ;MACRO TO SET UP ASP IN ACCUMULATOR LDA ^1,SP ;SPECIFIED BY ^1. ASP{ IS DEFINED AS LDA 0,MIN4 ;SIMPLY "STACK PTR - 4". IT IS ADD 0,^1 ;USEFUL WHEN DEALING WITH 2 SETS ON T'STACK STA ^1,ASP % .NREL PSGS: LDA 2,MIN4 ;FORM SINGLETON SET FROM INTEGER POP1 1 ;GET INTO MORE CONVENIENT FORM INC 1,1 NEG 1,1 SUBZ 0,0 =; ; NOW SHIFT CIRCULAR (CARRY-WITH-AC0) WHILST COUNTING UP THRU ZERO ; EVERY 16 SHIFTS, WE PUSH "ALL ZEROES", BUT ALSO, WHEN COUNT=ZERO ; WE PUSH A WORD WITH JUST THE RIGHT BIT SET. STOP WHEN 4 WORDS PUSHED. ; SGS1: MOVR 0,0,SZR JMP SGS2 PUSH1 0 ;PUSH A ZERO WORD MOVR 0,0 INC 2,2,SNR ;ASSUMES NEXT EXPANDS TO EXACTLY NEXT ;ONE WORD SGS2: INC 1,1,SZR JMP SGS1 PUSH1 0 ;PUSH THE WORD HOLDING THE BIT INCC 2,2,SZR JMP SGS1 NEXT PDIF: SASP 3 ;FIND SET DIFFERENCE DIF1: POP1 2 ;SIMPLY DO "A & NOT B" FOR EACH LDA 1,@ASP ;OF THE 4 CORRESPONDING PAIRS OF WORDS COM 2,2 AND 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP DIF1 NEXT PINT: SASP 3 ;FIND SET INTERSECTION INT1: POP1 2 ;SIMPLY "A & B" FOR EACH OF 4 PAIRS AGAIN LDA 1,@ASP AND 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP INT1 NEXT PUNI: SASP 3 ;FIND SET UNION UNI1: POP1 2 ;"A OR B" THIS TIME LDA 1,@ASP COM 2,2 ;ON THIS SILLY M/C "OR" HAS TO BE AND 2,1 ;"COM - AND - ADC" ADC 2,1 STA 1,@ASP DSZ ASP INC 0,0,SZR JMP UNI1 NEXT ֆPINN: LDA 3,SP ;FORM BOOLEAN = "TRUE IFF NTH ELEMENT LDA 0,MIN4 ;OF SET PRESENT". SORRY, BUT SASP ADD 0,3 ;NOT QUITE SUITABLE HERE STA 3,SP LDA 0,0,3 LDA 1,N16 INN1: INC 3,3 ;THIS LOOP FINDS WHICH WORD SUBZ 1,0,SZC ;OF SET WE WANT JMP INN1 SUBZ 1,1 INN3: MOVL 1,1 ;THIS LOOP FINDS WHICH BIT OF THE WORD INC 0,0,SZR JMP INN3 LDA 0,0,3 AND 0,1,SZR SUBZL 1,1 ;TRUE IFF BIT IS THERE STOP1 1 NEXT .END P4MACZ2.mm . PROCEDURE DOTFILE; (* REDUNDANT IN RELEASE II *) BEGIN WRITELN(OUTPUT, 11008 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* READ OFF EOLN *) WRITELN(OUTPUT, '.TXT ''INPUT'''); WRITELN(OUTPU=T, -8954); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8954);  WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8952); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''OUTPUT'''); WRITELN(OUTPUT, -8951); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8949); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRIT&ELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRD'''); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); , WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8946); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRR'''); WRITELN(OUTPUT, -8945); WRITELN(OUTPUT, -7403); V WRITELN(OUTPUT, -8943); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRITELN(OUTPUT, 2048 ); WRITELN END (*** OF DOTFILE ***); PROCEDURE PACKCODE; VAR SMCODE, I, P, Q : INTEGER; LITERALS c: STRING3; OP, TEMPOP : STRING4; ERROR : BOOLEAN; PROCEDURE DUMMYLABELS; BEGIN ECOUNT := ECOUNT + 1; WRITELN(PRR, '**********', ' INSTR. NO. ' : 12, ICOUNT : 5, ' ''' : 2, OP, / ''' HAS NOT YET BE', 'EN CATERED FOR '); WRITELN END (*** OF DUMMYLABELS ***); FUNCTION PKACTION : INTEGER; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; PROCEDURE ERRORP;  BEGIN ERROR := TRUE; ECOUNT := ECOUNT + 1; MORETRY := FALSE; WRITE(PRR, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(INPUT, CH); 1 WRITE(PRR, CH)  UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN(PRR); WRITE(PRR, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(PRR) END (*** ERRORP ***); BEGI;N (* OF PKACTION *) PKACTION := 0; TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLES>IZE; MORETRY := TRUE; SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN IF OP = PCODE THEN BEGIN MORETRY := FALSE; SMCODE := SEMICODE; PKACTION:= ACTION; END ELSE IF PCODE = ' ' THEN ERRORP;   IF MORETRY THEN BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4 ); SMAX := SMAX + 1 END END END (*** OF PKACTION ***); PROCEDURE NILP(P1, P2 : INTEGERca); (* PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1= 0)) THEN BEGIN WRITELN(OUTPUT, P2); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 ); RE`AD(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILP ***); PROCEDURE NILPS(P1, P2, P3 : INTEGER); (* SPECIAL PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1 < HALFWORD) AND (P1 >= 0)) THEN BEGIN WRITELN(OUTPUT, P2 + P3 ); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 + P3 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILPS ***); PROCEDURE QTOP(P1, P2, P3 : INTEGER); (* PCODE WITH P AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND (P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN WRITELN(OUTPUT, P3 + P1 ); WRITELN(OUTPUT, P2 : 7) END ELSE WRITELN(OUTPUT, BIT16 + P3 + P2 ); 0 READ(INPUT, CH) (* READ OFF EOLN *) END (*** QTOP ***); PROCEDURE QTOPS(P1, P2, P3, P4 : INTEGER); (* SPECIAL PCODE WITH P AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND ( P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN 2 WRITELN(OUTPUT, P3 + P4 + P1 ); WRITELN(OUTPUT, P2) END ELSE WRITELN(OUTPUT, BIT16 + P2 + P3 + P4 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF QTOPS ***); PROCEDURE BOUNDS(SEMICODE,Qi LOWERBOUND, UPPERBOUND : INTEGER); (* GENERATE OFFENDING PCODE LOCATION IN CASE CHECK RANGE BEING INVALID *) BEGIN IF SEMICODE > 0 THEN BEGIN IF (LOWERBOUND = 0) AND (UPPERBOUND < HALFWORD) THEN DS WRITELN(OUTPUT, SEMICODE + BIT16 + UPPERBOUND) ELSE BEGIN IF (LOWERBOUND >= 0) AND (LOWERBOUND < HALFWORD) THEN WRITELN(OUTPUT, SEMICODE + LOWERBOUND) ELSE , BEGIN WRITELN(OUTPUT, SEMICODE + HALFWORD); WRITELN(OUTPUT, LOWERBOUND) END; WRITELN(OUTPUT, UPPERBOUND) END END ELSE IF +LOWERBOUND > 0 THEN WRITELN(OUTPUT, SEMICODE + 1) ELSE WRITELN(OUTPUT, SEMICODE); WRITELN(OUTPUT, ICOUNT + 1) END (* OF BOUNDS *); PROCEDURE LOWCODE; (* TO PROVIDE FACILITIES FOR THOSE POOR SOULS WHO MUST LIVE W9ITH MACHINE CODES *) VAR I, J, K, L, ACC, LEVEL, DISPL : INTEGER; CODEND : BOOLEAN; DIRECTIVE : STRING4; LINE : ARRAY[1..80] OF CHAR; GOODCHAR : SET OF CHAR; GOODIGIT : SET OF '0'b..'9'; FUNCTION GETNUM : INTEGER; VAR NUMBER : INTEGER; BEGIN WHILE ((LINE[J] = ' ') OR (LINE[J] = ',')) AND (J < I) DO J := J + 1; IF NOT (LINE[J] IN GOODIGIT) THEN  BEGIN WRITELN(PRR, '** ASSEMBLER COD', 'E ERROR :'); FOR J := 1 TO I DO WRITE(PRR, LINE[J]); WRITELN(PRR); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); ECOUNT := ECOUNT + 1 END; NUMBER := ORD(LINE[J]) - ZERO; J := J + 1; WHILE (J <= I) AND (LINE[J] IN GOODIGIT) DO BEGIN NUMBER := N3UMBER * 10 + ORD(LINE[J]) - ZERO; J := J + 1 END; GETNUM := NUMBER END (* OF GETNUM *); PROCEDURE GETLABEL; VAR N : INTEGER; BEGIN IF J > 1 THEN  BEGIN FOR N := 1 TO J DO WRITE(OUTPUT, LINE[N]); END END (* OF GET LABEL *); BEGIN (* OF LOWCODE *); WRITELN(OUTPUT, '.RDX 8'); WRITELN(OUTPUT, '.EXTD .CST .CLD ', 'PCRTN'); CODEND := FALSE; FOR CH := '0' TO '9' DO GOODIGIT := GOODIGIT + [CH]; FOR CH := 'A' TO 'Z' DO GOODCHAR := GOODCHAR + [CH]; GOODCHAR := GOODCHAR + ['.', '$'] + GOODIGIT; REPEAT A IF EOF(INPUT) THEN BEGIN WRITELN(PRR, '** ASSEMBLY CODE', ' SECTION NOT PRO', 'PERLY ENDED.'); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); HALT(311); s END; REPEAT WHILE EOLN(INPUT) DO READLN(INPUT); READ(INPUT, CH);  IF CH = ';' THEN READLN(INPUT) UNTIL CH IN GOODCHAR; LINE[1] := CH; ] FOR I := 2 TO 80 DO LINE[I] := ' '; I := 1; J := 1; WHILE NOT( EOLN(INPUT) OR ( I = 80) OR (CH = ';')) DO BEGIN READ(INPUT, CH); IF CH <> ';' THEN H+ BEGIN I := I + 1; LINE[I] := CH; IF CH = ':' THEN J := I END END; READLN(INPUT); IF J > 1 THEN n< REPEAT J := J + 1; UNTIL LINE[J] <> ' '; L := 1; FOR K := J TO J + 3 DO BEGIN DIRECTIVE[L] := LINE[K]; L := L + 1 E END; IF DIRECTIVE = 'JPC ' THEN BEGIN GETLABEL;  CODEND := TRUE; WRITELN(OUTPUT, 'JSR @PCRTN') END ELSE IF DIRECTIVE = 'POxP ' THEN BEGIN GETLABEL; J := J + 4; WRITELN(OUTPUT, 'DSZ 41'); WRITE(OUTPUT, 'LDA ' : 5, GETNUM : 1, ' @41'); WRITELN(OUTPUT) Y END ELSE IF DIRECTIVE = 'PUSH' THEN BEGIN GETLABEL;  J := J + 4; WRITELN(OUTPUT, 'ISZ 41'); WRITE(OUTPUT, 'STA ': 5, GETNUM : 1, ' @41');(B WRITELN(OUTPUT) END ELSE IF DIRECTIVE = 'LOAD' THEN BEGIN GETLABEL; J := J + 4; ACC := GETNUM; LEVEL := GETNUM; DISPL := {GETNUM; WRITELN(OUTPUT, 'JSR @.CLD'); WRITELN(OUTPUT, LEVEL); WRITELN(OUTPUT, DISPL); WRITE(OUTPUT, 'LDA ' : 5, ACC : 1, ' @47'); WRITELN(OUTPUT); p END ELSE IF (DIRECTIVE = 'STOR') AND (LINE[J + 4] = 'E') THEN BEGIN GETLABEL; J := J + 5; WRITE(OUTPUT, 'STA ' : 5, GETNUM : 1, ' 47'); j) WRITELN(OUTPUT); WRITELN(OUTPUT, 'JSR @.CST');  WRITELN(OUTPUT, GETNUM); WRITELN(OUTPUT, GETNUM); END ELSE BEGIN FOR J := 1- TO I DO WRITE(OUTPUT, LINE[J]); WRITELN(OUTPUT) END; UNTIL CODEND; WRITELN(OUTPUT, '.RDX 10') END (* OF LOWCODE *); BEGIN (* OF PACKCODE *) OP[1] := CH; REAYD(INPUT, OP[2], OP[3]); IF EOLN(INPUT) THEN OP[4] := ' ' ELSE READ(INPUT, OP[4]); CASE PKACTION OF 0 : (* STOA STOA STOC STOI STOR STOS EOF ADI ADR SBI SBR SGS FLT FLO٪ TRC NGI NGR SQI SQR ABI ABR NOT AND IOR DIF INT UNI INN MOD ODD LCA MPI MPR DVI DVR STP CHR ORDA ORDB ORDC ORDI EQUA EQUB  EQUC EQUI EQUR EQUS NEQA NEQB NEQC NEQI NEQR NEQS GEQA GEQB GEQC GEQI GEQR GEQS GRTA GRTB GRTC GRTI GRTR GRTR GRTS LEQA LEQB LEQC LEQI LEQR LEQS LESA LESB LESC LESI LESR LESS RETA RETB RETC RETI RETP RETR ATN COS ELN EXP GET LOG NEW PUT RDC RDI RDR RLN RST SAV SIN SQwT WLN WRC WRI WRR WRS  OPS OPN OVL CMS RSN *) BEGIN IF ERROR THEN ERROR := FALSE ELSE BEGIN ; WRITELN(OUTPUT, SMCODE ); READLN(INPUT) (* RID EOLN *) END END; 1, 2, 3, 4, 5, 6, 7, 8, 9 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 10 : (* EQUM NEQM GEQ GRTM LEQM LESM  *) BEGIN READ(INPUT, Q); NILP(Q, SMCODE + BIT15) END; 11, 12, 13, 14, 15, 16, 17, 18, 19 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 20 : (* LODA LODB LODC LODI STRA STRB STRC STRI LDA *) BEGIN READ(INPUT, P, Q); QTOP(P, Q DIV 2, SMCODE) END;z 21, 22, 23, 24, 25, 26, 27, 28, 29 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 30 : (* LODR STRR *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q DIV 2, SMCODE, HALFWORDV) END; 31, 32, 33, 34, 35, 36, 37, 38, 39 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 40 : (* LODS STRS *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q D IV 2, SMCODE, 3 * HALFWORD) END; 41, 42, 43, 44, 45, 46, 47, 48, 49 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 50 : (* CUP CXP *) BEGIN READ(INPUT, P); Y READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P DIV 2 ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 51, 52, 53, 54, 55, 56, 57, 58, 59 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 60 : (* MST *) BEGIN READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + Q ); READ(INPUT, CH) (* READ OF EOLN *) END; 61, 62, 63, 64, 65, 66, 67, 68, 69 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 70 : (* LDOA LDOB LDOC LDOI  SROAy SROB SROC SROI INDA INDB INDI LAO *) BEGIN READ(INPUT, Q); NILP(Q DIV 2, SMCODE) END; 71, 72, 73, 74, 75, 76, 77,H 78, 79 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 80 : (* INDC *) BEGIN READ(INPUT, Q); NILPS(Q, SMCODE, 2 * HALFWORD) END; 81, 82, 83, 84, 85, 86, 8>7, 88, 89 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 90 : (* LDOR SROR INDR *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD) END; 91, 92|C, 93, 94, 95, 96, 97, 98, 99 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 100 : (*LDOS SROS INDS *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD * 3)  END; 101, 102, 103, 104, 105, 106, 107, 108, 109 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 110 : (* INCA INCI INCC IXA DECA DECI DECC *) BEGIN m READ(INPUT, Q); NILP(Q, SMCODE) END; 111, 112, 113, 114, 115, 116, 117, 118, 119 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 120 : (*MOV *) BEGIN ? READ(INPUT, Q); NILP((Q + 1) DIV 2, SMCODE) END; 121, 122, 123, 124, 125, 126, 127, 128, 129 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 130 : (* ENT *) BEGIN  READ(INPUT, P); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P ); WRITELN(OUTPUT, CH, Q : 1); ] READ(INPUT, CH) (* READ OFF EOLN *) END; 131, 132, 133, 134, 135, 136, 137, 138, 139 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 140 : (* UJC *) BEGIN  WRITELN(OUTPUT, SMCODE ); WRITELN(OUTPUT, 0 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 141, 142, 143, 144, 145, 146, 147, 148, 149 : DUMMYLABELS; (***** FOR FUTURE INSERTXIONS *****) 150 : (* UJP FJP XJP TJP JPF JPT SJP *) BEGIN READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODEfi ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 151, 152, 153, 154, 155, 156, 157, 158, 159 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****)  160 : (* CSP *) BEGIN READ(INPUT, CH); WHILE CH = ' ' DO READ(INPUT, CH); I := SMCODE; TEMPOP := OP; OP[1] := CH; READ(INPUT, OP[2], OP[3]); OP[4] := ' '; P := PKACTION; (* P IS DUMMY, CALLING PKACTION IS JUST TO  OBTAIN SEMI-CODE VALUE IN SMCODE *) WRITELN(OUTPUT, SMCO8^DE + I + BIT16 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 161, 162, 163, 164, 165, 166, 167, 168, 169 :DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 170 : (* CHKA CHKB CHKC CHKI *) 5 BEGIN READLN(INPUT, P, Q); BOUNDS(SMCODE, P, Q) END; 171, 172, 173, 174, 175, 176, 177, 178, 179 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 180 : (* LDC *) BEGIN WRITELN(OUTPUT, SMCODE + 3 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *)  FOR I := 1 TO 4 DO WRITELN(OUTPUT, SWITCHES[I]); END; 181, 182, 183, 184, 185, 186, 187, 188, 189 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 190 : (* LDCB LDCI *) BEGIN : READ(INPUT, Q); QTOP(0, Q, SMCODE) END; 191, 192, 193, 194, 195, 196, 197, 198, 199 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 200 : (* LDCC *) (* SORRY FOR THIS MESS,  BUT BLAME THE NOVA ASSEMBLER PLEASE. *) BEGIN READ(INPUT, CH); (* THE ORDINAL OF (') = 7 *) WHILE ORD(CH) <> 7 DO READ(INPUT, CH); LITERALS[1] := CH; V READ(INPUT, LITERALS[2], LITERALS[3]); WRITELN(OUTPUT, SMCODE ); IF LITERALS[2] = CHR(7) (* IF LITERALS[2] = '''' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 39 (* NOVA z CODE FOR (') *) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(12) (* IF LITERALS[2] = ',' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 44 (* NOVA CODE FOR (,) *) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(28) (* IF LITERALS[2] = '<' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHRH(30), CHR(7)) ELSE WRITELN(OUTPUT, '.TXT ', LITERALS); READ(INPUT, CH) (* READ OFF EOLN *) END; 201, 202, 203, 204, 205, 206, 207, 208, 209 : DUMMYLABELS; (***** FOR FUTURE INSXERTIONS *****) 210 : (* LDCN *) QTOP(0, 0, SMCODE); 211, 212, 213, 214, 215, 216, 217, 218, 219 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 220 : (* LDCR *) (* NOTICE THE NON-FLOATING POINT OUTPUT FORMAT OF 'R' *) BEGIN WRITELN(OUTPUT, SMCODE + 1, '.'); READLN(INPUT, R); WRITELN(OUTPUT,'0', R : 0) END; 230 : (* JNC *) (* FOR MACHINE TCODE ADDICTS ONLY *) BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT); LOWCODE; END; (* REDUNDANT 'CCP ' 240 : BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT, Q); WRITELN(OUTPUT, Q); END; *) END (* OF CASE PKACTION *) END (*** OF PACKCODE ***); BEGIN (* OF MAIN *) WRITELN; WRITELN; WRITELN; E WRITELN(PRR, '; ==== P4MAC BEG', 'INS NOW'); ENT := TRUE; ZERO := ORD('0'); ICOUNT := 3; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO PCODE := ' '; COMPLETABLE; (* START READING IN THE PCODE PROGRAM FROM PRD FILE *) READ(INPUT, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(PRR, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(PRR); HxALT(311) END; WRITE(OUTPUT, CH: 16, DOTNAME); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH); (* RID EOLN *) REPEAT READ(INPUT, CH); IF C2yH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF (CH = 'P') OR (CH = '?') THEN PCTYPE := PCODENTRY ELSE BEGIN READ(INPUT, CH); IF CH = '.' THEN PCTYPE := NONPCODE  ELSE PCTYPE := PCODES END; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(INPUT, J); IF (ICOUNT <> J) AND (J <> 0)z THEN BEGIN  WCOUNT := WCOUNT + 1; WRITELN(PRR, 'I', J : 5, ' ' : 14, '; ??? PCODE' , ' COUNT OUT OF ST', 'EP ???');  END; ICOUNT := J; READ(INPUT, CH) (* READ OFF EOLN *) END; LLABEL : (* LABELS *) BEGIN WRITE(OUTPUT, CH);  READ(INPUT, I); WRITE(OUTPUT, I : 1); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) OH UNTIL EOLN(INPUT); READLN(INPUT); WRITELN(OUTPUT) END; NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) BEGIN ζ READ(INPUT, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF DOTNAME = 'FIL' THEN DOTFILE ELSE BEGIN IF ((DOTNAME = 'SW1') OR (DOTNAME = 'SW2') < OR (DOTNAME = 'SW3') OR (DOTNAME = 'SW4')) THEN BEGIN REPEAT READ(INPUT, CH) ,  UNTIL (CH = '0') OR (CH = '1'); (* READ UNTIL BINARY IS FOUND *) BINARYSTR[1] := CH; IF CH = '1' THEN J := -1 ELSE J := 0; q FOR I := 2 TO 16 DO BEGIN READ(INPUT, CH); BINARYSTR[I] := CH;  J := J * 2 + ORD(CH) - ZERO END; I := ORD(DOTNAME[3]) - ZERO; SWITCHES[I] := J; READ(IINPUT, CH) (* READ OFF EOLN *) END ELSE IF (DOTNAME = 'TXT') AND (INPUT^ <> 'M') THEN BEGIN WRITE(OUTPUT, '.v', DOTNAME : 3); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL CH <> ' '; l FOR I := 1 TO 16 DO BEGIN READ(INPUT, CH); IF CH = CHR(2) (* IF CH = '"' *) THEN   WRITE(OUTPUT, CHR(28), 34 (*NOVA CODE FOR(") *) : 1, CHR(30)) ELSE IF CH = CHR(28) (* IF CH = '<' *) THEN  WRITE(OUTPUT, CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHR(30)) ELSE IF CH = CHR(30) (* IF CH = '>' *) THEN   WRITE(OUTPUT, CHR(28), 62 (* NOVA CODE FOR (>) *) : 1, CHR(30)) ELSE WRITE(OUTPUT, CH) END;  READLN(INPUT, CH); WRITELN(OUTPUT, CH) END ELSE BEGIN  IF DOTNAME = 'ENT' THEN  WRITE(OUTPUT, '.', DOTNAME) ELSE IF NOT (DOTNAME = 'END') THEN WRITE(OUTPUT, '.', DOTNAME); IF NOT EOLN(INPUT) THEN REPEAT READ(INPUT, CH);  WRITE(OUTPUT, CH)  UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN END END F END; PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN PACKCODE; ICOUNT := ICOUNT + 1  END; PCODENTRY : (* PACKED PCODE ޾ENTRY POINT *) BEGIN WRITE(OUTPUT, CH); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EUJOLN(INPUT); WRITELN; READ(INPUT, CH) (* READ OFF EOLN *) END; END (* OF CASE PCTYPE *); WHILE EOLN(INPUT) DO BEGIN WRITELN;  READ(INPUT, CH) (* READ OF EOLN *) END UNTIL EOF(INPUT); (* THE PCODE PROGRAM HAS BEEN PACKED FOR INTERPRETER *) (* WRITELN; WRITELN; WRITELN; WRITELN(PRR, '; IDEAL SEARCHES', ' = ', SMIN); WRITELڠN(PRR, '; ACTUAL SEARCHE', 'S = ', SMAX); *) IF WCOUNT > 0 THEN WRITELN(PRR, ';---- NO. OF WAR', 'NINGS = ', WCOUNT : 6); IF ECOUNT > 0 THEN WRITELN(PRR, ';**** NO. OF FAT', 'AL ERRORS = ', ECOUNT : 6); WRITELNkn(OUTPUT, '.END' : 16); IF ECOUNT > 0 THEN HALT(311); WRITELN; WRITELN; WRITELN END. P4COMPILE1.Nm(*$T-,D-*) (********************************************** * * * * * PORTABLE PASCAL COMPILER * * ************************ * Z_ *  * * PASCAL P4 * * * * * * AUTHORS: * * M URS AMMANN * * KESAV NORI * * CHRISTIAN JACOBI * * * * ADDRESS: * *   * * INSTITUT FUER INFORMATIK * * EIDG. TECHNISCHE HOCHSCHULE * * CH-8096 ZUERICH * * * * I * * LAST CHANGES COMPLETED IN MAY 76 * * * * LANCASTER AMENDMENTS BY * * * * A. FOSTER  W * * * * DEPARTMENT OF COMPUTER STUDIES * * UNIVERSITY OF LANCASTER * * BAILRIGG * * LANCASTER LA1 4YX * * m * * * * LAST LANCASTER CHANGES JUNE 77 * * * **********************************************) PROGRAM PASCALKpCOMPILER(INPUT,OUTPUT,PRR); CONST DISPLIMIT = 20; MAXLEVEL = 10; INTSIZE = 2; INTAL = 2; REALSIZE = 4; REALAL = 2; CHARSIZE = 1; CHARAL = 2; FILEMAX = 6; CHARMAX = 1; BOOLSIZE = 2; BOOLAPL = 2; PTRSIZE = 2; ADRAL = 2; SETSIZE = 8; SETAL = 2; STACKAL = 2; STACKELSIZE = 2; STRGLGTH = 16; SETHIGH = 63; SETLOW = 0; ORDMAXCHAR = 63; ORDMINCHAR = 0; MAXINT  = 32767; LCAFTERM2ARKSTACK = 12; FILEAL = CHARAL; (* STACKELSIZE = MINIMUM SIZE FOR 1 STACKELEMENT = K*STACKAL STACKAL = SCM(ALL OTHER AL-CONSTANTS) CHARMAX = SCM(CHARSIZE,CHARAL) SCM = SMALLEST COMMON MULTIPLE LCAFTERMARKSTACK >= 4*PTRSIZE+MAX(X-SIZE) = K1*STACKELSIZE *) MAXSTACK = 2; PARMAL = STACKAL; PARMSIZE = STACKELSIZE; RECAL = STACKAL; FILEBUFFER = 4; MAXADDR = MAXINT; (*EQRROR REPORTING CONSTANTS*) MAXERRBIT = 59; MAXERRMOD = 60; MAXERRSET = 10; TYPE (*DESCRIBING:*) (*************)  (*BASIC SYMBOLS*) (***************) SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP, LPARENT,RPAREJNT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW, COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROGSY, PROCSY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY, BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY;, GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY, THENSY,OTHERSY,RANDOMSY,EXTRNSY); OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP, NEOP,EQOP,INOP,NOOP); SETOFSYS = SET6 OF SYMBOL; CHTP = (LETTER,NUMBER,SPECIAL,ILLEGAL); (*CONSTANTS*) (***********) CSTCLASS = (REEL,PSET,STRG); CSP = ^ CO0NSTANT; CONSTANT = RECORD CASE CCLASS: CSTCLASS OF REEL: (RVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR); PSET: (PVAL: SET OF 0..58); STRG: (SLGTH: 0..STRGLGTH;  SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR) END; VALU = RECORD CASE INTVAL: BOOLEAN OF (*INTVAL NEVER SET NORE TESTED*) TRUE: (IVAL: INTEGER); FALSE: (VALP: CSP)  END; (*DATA STRUCTURES*) (*****************) LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR; STRUCTFORM = (SCALAR,SUBRAUNGE,POINTER,POWER,ARRAYS,RECORDS,FILES, TAGFLD,VARIANT); DECLKIND = (STANDARD,DECLARED); STP = ^ STRUCTURE; CTP = ^ IDENTIFIER; STRUCTURE = PACKED RECORD MARKED: BOOLEAN; (*FOR TEST PHASE ONLY*) G SIZE: ADDRRANGE; CASE FORM: STRUCTFORM OF SCALAR: (CASE SCALKIND: DECLKIND OF  DECLARED: (FCONST: CTP)); SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU)wo; POINTER: (ELTYPE: STP); POWER: (ELSET: STP); ARRAYS: (AELTYPE,INXTYPE: STP); RECORDS: (FSTFLD: CTP; RECVAR: STP); FILES: (FILTYPE: STP; RANDOMFILE :BOOLEAN); TAGFLD: (TAGFIELDP: CTP; FSTVAR: STP); VARIANT: (NXTVAR,SUBVAR: STP; VARVAL: VALU)  END; (*NAMES*) 4 (*******) IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC); SETOFIDS = SET OF IDCLASS; IDKIND = (ACTUAL,FORMAL); ALPHA = PACKED ARRAY [1..8] OF CHAR; IDENTIFIER = PACKED RECORD h NAME: ALPHA; LLINK, RLINK: CTP; IDTYPE: STP; NEXT: CTP; CASE KLASS: IDCLASS OF  KONST: (VALUES: VALU); VARS: (VKIND: IDKIND; VLEV: LEVRANGE; VADDR: ADDRRANGE); M FIELD: (FLDADDR: ADDRRANGE); PROC, FUNC: (CASE PFDECKIND: DECLKIND OF STANDARD: (KEY: 1..17); DECLARED: (PFLEV: LEVRANGE; PFNAME: INTEGER;  CASE PFKIND: IDKIND OF ACTUAL: (FORWDECL,EXTDEC, EXTERN: BOOLEAN))) END; DISPRANGE = 0..DISPLIMIT; WHERE = (BLCK,CREC,VREC,REC); (*EXPRESSIONS*) (*************) ATTRKIND = (CST,VARBL,EXPR); VACCESS = (DRCT,INDRCT,ҥINXD); ATTR = RECORD TYPTR: STP; CASE KIND: ATTRKIND OF CST: (CVAL: VALU); VARBL: (CASE ACCESS: VACCESS OF DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE); N' INDRCT: (IDPLMT: ADDRRANGE)) END; TESTP = ^ TESTPOINTER; TESTPOINTER = PACKED RECORD ELT1,ELT2 : STP; LASTTESTP : TESTP END;  (*LABELS*) (********) LBP = ^ LABL; LABL = RECORD NEXTLAB: LBP; DEFINED: BOOLEAN; LABVAL, LABNAME: INTEGER END; EXTFILEP =< ^FILEREC; FILEREC = RECORD FILENAME:ALPHA; NEXTFILE:EXTFILEP; FTYPE : CTP END; (*-------------------------------------------------------------------------*) VAR (*RETURNED BY SOURCE PROGRAM SCANNER A INSYMBOL: **********)  SY: SYMBOL; (*LAST SYMBOL*) OP: OPERATOR; (*CLASSIFICATION OF LAST SYMBOL*) VAL: VALU; (*VALUE OF LAS~T CONSTANT*) LGTH: INTEGER; (*LENGTH OF LAST STRING CONSTANT*) ID: ALPHA; (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*) KK: 1..8; (*NR OF CHARS IN LAST IDENTIFIER*) CH: CHAR;  (*LAST CHARACTER*) EOL: BOOLEAN; (*END OF LINE FLAG*) (*COUNTERS:*) (***********) CHCNT: INTEGER; (*CHARACTER COUNTER*) LC,zIC: ADDRRANGE; (*DATA LOCATION AND INSTRUCTION COUNTER*) LINECOUNT: INTEGER; (*SWITCHES:*) (***********) DP, (*DECLARATION PART*) e PRTERR, (*TO ALLOW FORWARD REFERENCES IN POINTER TYPE DECLARATION BY SUPPRESSING ERROR MESSAGE*) LIST,PRCODE,PRTABLES: BOOLEAN; (*OUTPUT OPTIONS FOR -- SOURCE PROGRAM LISTING -- PRINTING SYMBOLIC CODE -- DISPLAYING IDENT AND STRUCT TABLES --> PROCEDURE OPTION*) DEBUG: BOOLEAN;  (*POINTERS:*)  (***********) PARMPTR, INTPTR,REALPTR,CHARPTR, BOOLPTR,NILPTR,TEXTPTR: STP; (*POINTERS TO ENTRIES OF STANDARD IDS*) UTYPPTR,UCSTPTR,UVARPTR, UFLDPTR,UPRC?PTR,UFCTPTR, (*POINTERS TO ENTRIES FOR UNDECLARED IDS*) FWPTR: CTP; (*HEAD OF CHAIN OF FORW DECL TYPE IDS*) FEXTFILEP: EXTFILEP; (*HEAD OF CHAIN OF EXTERNAL FILES*) GLOBTESTP: TESTP; (*LAST T+aESTPOINTER*)  (*BOOKKEEPING OF DECLARATION LEVELS:*) (************************************) LEVEL: LEVRANGE; (*CURRENT STATIC LEVEL*) DISX,  (*LEVEL OF LAST ID SEARCHED BY SEARCHID*) TOP: DISPRANGE; (*TOP OF DISPLAY*) DISPLAY: (*WHERE: MEANS:*) ARRAY [DISPRANGE] OF PACKED RECORD (*=BLCK: ID IS VARIABLE ID*)  FNAME: CTP; FLABEL: LBP; (*=CREC: ID IS FIELD ID IN RECORD WITH*) CASE OCCUR: WHERE OF (* CONSTANT ADDRESS*) CREC: (CLEV: LEVRANGE; (*=VREC: ID IS FIELD ID IN RECORD WITH*) CDSPL: ADDRRANG!E);(* VARIABLE ADDRESS*) VREC: (VDSPL: ADDRRANGE) END; (* --> PROCEDURE WITHSTATEMENT*) (*ERROR MESSAGES:*) (*****************) * ERRINX: 0..10; (*NR OF ERRORS IN CURRENT SOURCE LINE*) ERRLIST: ARRAY [1..10] OF (*BIT MAP OF COMPILE-TIME ERRORS*) PACKED RECORD POS: INTEGER; NMR: 1..400 END; sc (*FILE USE TO PASS BIT MAP TO THE ERROR*) (*SUMMARY GENERATOR PROGRAM*) ERRORS : ARRAY [0..MAXERRSET] OF SET OF 0..MAXERRBIT; ERRFLAG : BOOLEAN;  (*EXPRESSION COMPILATION:*) (*************************) GATTR: ATTR; (*DESCRIBES THE EXPR CURRENTLY COMPILED*) (*STRUCTURED CONSTANTS:*) )~ (***********************) CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS, STATBEGSYS,TYPEDELS: SETOFSYS; CHARTP : ARRAY[CHAR] OF CHTP; RW: ARRAY [1..37(*NR. OF RES. WORDS*)] OF ALPHA; FRW: ARRAY "[1..9] OF 1..38(*NR. OF RES. WORDS + 1*); RSY: ARRAY [1..37(*NR. OF RES. WORDS*)] OF SYMBOL; SSY: ARRAY [CHAR] OF SYMBOL; ROP: ARRAY [1..37(*NR. OF RES. WORDS*)] OF OPERATOR; SOP: ARRAY [CHAR] OF OPERATOR; NA: ARRAY [1..41] OF ALPHA; ' MN: ARRAY[0..62] OF PACKED ARRAY[1..4] OF CHAR; SNA: ARRAY [1..31] OF PACKED ARRAY [1..4] OF CHAR; CDX: ARRAY[0..62] OF -4..+4; PDX: ARRAY[1..31] OF -7..+7; ORDINT: ARRAY[CHAR] OF INTEGER; INTLABEL,MXINT10,DIGMAX: INTEGER; (*-----a--------------------------------------------------------------------*) PROCEDURE ENDOFLINE; VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER; BEGIN IF ERRINX > 0 THEN (*OUTPUT ERROR MESSAGES*) BEGIN WRITE(OUTPUT,' **** ':15); LlASTPOS := 0; FREEPOS := 1; FOR K := 1 TO ERRINX DO BEGIN WITH ERRLIST[K] DO BEGIN CURRPOS := POS; CURRNMR := NMR END; IF CURRPOS = LASTPOS THEN WRITE(OUTPUT,',')  ELSE BEGIN V WHILE FREEPOS < CURRPOS DO BEGIN WRITE(OUTPUT,' '); FREEPOS := FREEPOS + 1 END; WRITE(OUTPUT,'^'); LASTPOS := CURRPOS END; IF CURRNMR < 10 THEN F := 1 EL@-SE IF CURRNMR < 100 THEN F := 2 ELSE F := 3; WRITE(OUTPUT,CURRNMR:F); FREEPOS := FREEPOS + F + 1 END; WRITELN(OUTPUT); ERRINX := 0 END; IF LIST AND (NOT EOF(INPUT)) THEN BEGIN LINECOUNPT := LINECOUNT + 1; WRITE(OUTPUT,LINECOUNT:6,' ':2); IF DP THEN WRITE(OUTPUT,LC:7) ELSE WRITE(OUTPUT,IC:7); WRITE(OUTPUT,' ') END; CHCNT := 0 END (*ENDOFLINE*) ; PROCEDURE ERROR(FERRNR: INTEGER); VAR I : 0..MAXERRSET;  BEGIN I := FERRNR DIV MAXERRMOD; ERRORS[I] := [FERRNR MOD MAXERRMOD] + ERRORS[I]; ERRFLAG := TRUE; IF ERRINX >= 9 THEN BEGIN ERRLIST[10].NMR := 255; ERRINX := 10; ERRORS[4] := ERRORS[4] + [15] END ELSE BEGI@N ERRINX := ERRINX + 1; ERRLIST[ERRINX].NMR := FERRNR END; ERRLIST[ERRINX].POS := CHCNT END (*ERROR*) ; PROCEDURE ERRORREPORT; VAR P4ERRORS : FILE OF SET OF 0..MAXERRBIT; I : 0..MAXERRSET; BEGIN FOR I := 0 TO MAXERRSET DO BEGIN P4ERRORS^ := ERRORS[I]; PUT(P4ERRORS) END END (*ERROR REPORT*); PROCEDURE INSYMBOL; (*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGъTH*) LABEL 1,2,3; VAR I,K: INTEGER; DIGIT: PACKED ARRAY [1..STRGLGTH] OF CHAR; STRING: PACKED ARRAY [1..STRGLGTH] OF CHAR; LVP: CSP;TEST: BOOLEAN; PROCEDURE NEXTCH; BEGIN IF EOL THEN BEGIN IF LIST THEN WRITELNhG(OUTPUT); ENDOFLINE END; IF NOT EOF(INPUT) THEN BEGIN EOL := EOLN(INPUT); READ(INPUT,CH); IF LIST THEN WRITE(OUTPUT,CH); CHCNT := CHCNT + 1  END ELSE BEGIN WRITELN(OUTPUT,' *** EOF ','ENCOUNTERED'); ) TEST := FALSE END END; PROCEDURE OPTIONS; BEGIN REPEAT NEXTCH; IF CH <> '*' THEN BEGIN IF CH = 'T' THEN BEGIN NEXTCH; PRTABLES := CH = '+' END ELSE IF CH = 'L' THEN BEGIN NEXTCH; LIST := CH = '+'; IF NOT LIST THEN WRITELN(OUTPUT) END ELSE IF CH = 'D' THEN BEGIN NEXTCH; DEBUG := CH = '+' END ELSE & IF CH = 'C' THEN BEGIN NEXTCH; PRCODE := CH = '+' END; NEXTCH END UNTIL CH <> ',' END (*OPTIONS*) ; BEGIN (*INSYMBOL*) 1: REPEAT WHILE (CH = ' ') AND NOT EOL DO NEXTCH; TEST := E OL; IF TEST THEN NEXTCH UNTIL NOT TEST; IF CHARTP[CH] = ILLEGAL THEN BEGIN SY := OTHERSY; OP := NOOP; ERROR(399); NEXTCH END ELSE CASE CH OF 'A','B','C','D','E','F','G','H','I', 'J','K','L','M','N','O','P','Q','R', 'S','T','U','V','W','X','Y','Z': BEGIN K := 0; REPEAT IF K < 8 THEN BEGIN K := K + 1; ID[K] := CH END ; NEXTCH UNTIL CHARTP[CH] IN [SPECIAL,ILLEGAL]; IF K >= KK FTHEN KK := K ELSE REPEAT ID[KK] := ' '; KK := KK - 1 UNTIL KK = K; FOR I := FRW[K] TO FRW[K+1] - 1 DO IF RW[I] = ID THEN BEGIN SY := RSY[I]; OP := ROP[I]; GOTO 2 END; SY := IDENT; OP := NOOP; 2: END; '0','1','2','3','4','5','6','7','8','9': BEGIN OP := NOOP; I := 0; REPEAT I := I+1; IF I<= DIGMAX THEN DIGIT[I] := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER; IF (CH = '.') OR (CH = 'E')[ THEN BEGIN K := I; IF CH = '.' THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH; IF CH = '.' THEN BEGIN CH := ':'; GOTO 3 END; I#F CHARTP[CH] <> NUMBER THEN ERROR(201) ELSE REPEAT K := K + 1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER END;  IF CH = 'E' THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;  NEXTCH; IF (CH = '+') OR (CH ='-') THEN BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH END; IF CHARTP[CH] <> NUMBER THEN ERROR(201) ELSE REPEAT K := K+1; IF K <= DIGMAX THEN DIGIT[K]9 := CH; NEXTCH UNTIL CHARTP[CH] <> NUMBER END;  NEW(LVP,REEL); SY:= REALCONST; LVP^.CCLASS := REEL; WITH LVP^ DO BEGIN FOR I := 1 TO STRGLGTH DO RVAL[I] .:= ' '; IF K <= DIGMAX THEN FOR I := 2 TO K + 1 DO RVAL[I] := DIGIT[I-1] ELSE BEGIN ERROR(203); RVAL[2] := '0'; RVAL[3] := '.'; RVAL[4] := '0'  END END; VAL.VALP := LVP END ELSE 3: BEGIN IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END ELSE WITH VAL DO  BEGIN IVAL := 0; FOR K := 1 TO I DO BEGIN IF IVAL <= MXINT10 THEN IVAL := IVAL*10+ORDINT[DIGIT[K]] ELSE BEGIN ERROR(203); IVAL := 0 uEND END; SY := INTCONST END END END; '''': BEGIN LGTH := 0; SY := STRINGCONST; OP := NOOP; REPEAT REPEAT NEXTCH; LGTH := LGTH + 1;  IF LGTH <= STRGLGTH THEN STRING[LGTH] := CH UNTIL (EOL) OR (CH = ''''); IF EOL THEN ERROR(202) ELSE NEXTCH UNTIL CH <> ''''; LGTH := LGTH - 1; (*NOW LGTH = NR OF CHARS IN STRING*) IF LGTH = v1 THEN VAL.IVAL := ORD(STRING[1]) ELSE BEGIN NEW(LVP,STRG); LVP^.CCLASS:=STRG; IF LGTH > STRGLGTH THEN BEGIN ERROR(399); LGTH := STRGLGTH END; WITH LVP^ DO BEGIN SLGTH := LGTFH; FOR I := 1 TO LGTH DO SVAL[I] := STRING[I] END; VAL.VALP := LVP END END; ':': BEGIN OP := NOOP; NEXTCH; IF CH = '=' THEN BEGIN SY := BECOMES; NEXTCH ,END ELSE SY := COLON END; '.':  BEGIN OP := NOOP; NEXTCH; IF CH = '.' THEN BEGIN SY := COLON; NEXTCH END ELSE SY := PERIOD END; '<': BEGIN NEXTCH; SY := RELOP; IdF CH = '=' THEN BEGIN OP := LEOP; NEXTCH END ELSE IF CH = '>' THEN BEGIN OP := NEOP; NEXTCH END ELSE OP := LTOP END; '>': BEGIN NEXTCH; SY := RELOP; IF CH = '=' THEZ4N BEGIN OP := GEOP; NEXTCH END  ELSE OP := GTOP END; '(': BEGIN NEXTCH; IF CH = '*' THEN BEGIN NEXTCH; IF CH = '$' THEN OPTIONS; REPEAT WHILE CH <> '*' pDDO NEXTCH; NEXTCH UNTIL CH = ')'; NEXTCH; GOTO 1 END; SY := LPARENT; OP := NOOP END; '*','+','-', '=','/',')', '[',']',',',';','^','$': BEGIN SY := SSY[CH]; OP :=( SOP[CH]; NEXTCH END; ' ': SY := OTHERSY END (*CASE*) END (*INSYMBOL*) ; PROCEDURE ENTERID(FCP: CTP); (*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE, WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS AN UNBALANCED BINARY TREE*) VAR NAM: ALPHA; LCP, LCP1: CTP; LLEFT: BOOLEAN; BEGIN NAM := FCP^.NAME; LCP := DISPLAY[TOP].FNAME; IF LCP = NIL THEN DISPLAY[TOP].FNAME := FCP ELSE BEGIN REPEAT LCP1 := LCP; IF LCP^.NAME = UNAM THEN (*NAME CONFLICT, FOLLOW RIGHT LINK*) BEGIN ERROR(101); LCP := LCP^.RLINK; LLEFT := FALSE END ELSE IF LCP^.NAME < NAM THEN BEGIN LCP := LCP^.RLINK; LLEFT := FALSE END ELSE BEGIN LCP := LCP^.LLINK; LLEFT := TRUE END UNTIL LCP = NIL; IF LLEFT THEN LCP1^.LLINK := FCP ELSE LCP1^.RLINK := FCP END; FCP^.LLINK := NIL; FCP^.RLINK := NIL END (*ENTERID*) ; PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP); (*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S --> PROCEDURE PROCEDUREDECLARATION --> PROCEDURE SELECTOR*) LABEL 1; BEGIN WHILE FCP <> NIL DO IF FCP^.NAME = ID THEN GOTO 1 ELSE IF FCP^.NAME < ID THEN FCP := FCP^.RLINK C ELSE FCP := FCP^.LLINK; 1: FCP1 := FCP END (*SEARCHSECTION*) ; PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); LABEL 1; VAR LCP: CTP; BEGIN FOR DISX := TOP DOWNTO 0 DO BEGIN LCP := DISPLAY[DISX].FNAME; WHILE LCP <> NIL DO IF LCP^.NAME = ID THEN IF LCP^.KLASS IN FIDCLS THEN GOTO 1 ELSE BEGIN IF PRTERR THEN ERROR(103); LCP := LCP^.RLINK END ELSE IF LCP^.NAME < ID TH.EN LCP := LCP^.RLINK ELSE LCP := LCP^.LLINK END; (*SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION --> PROCEDURE SIMPLETYPE*) IF PRTERR THEN 06 BEGIN ERROR(104); (*TO AVOID RETURNING NIL, REFERENCE AN ENTRY FOR AN UNDECLARED ID OF APPROPRIATE CLASS --> PROCEDURE ENTERUNDECL*) IF TYPES IN FIDCLS THEN LCP := UTYPPTR ELSE IF VARS IN FIDCLS THEN6 LCP := UVARPTR ELSE IF FIELD IN FIDCLS THEN LCP := UFLDPTR ELSE IF KONST IN FIDCLS THEN LCP := UCSTPTR ELSE IF PROC IN FIDCLS THEN LCP := UPRCPTR  ELSE LCP := UFC6TPTR; END; 1: FCP := LCP END (*SEARCHID*) ; PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER); (*GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE*) (*ASSUME FSP<>INTPTR AND FSP<>REALPTR*) BEGIN FMIN := 0; FMAX := 0; IF FSP <>R NIL THEN WITH FSP^ DO IF FORM = SUBRANGE THEN BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END ELSE IF FSP = CHARPTR THEN BEGIN FMIN := ORDMINCHAR; FMAX := ORDMAXCHAR END ELSE IF FCONST <> NIL THEN FMAX := FCONST^.VALUES.IVAL END (*GETBOUNDS*) ; FUNCTION ALIGNQUOT(FSP: STP): INTEGER; BEGIN ALIGNQUOT := 1; IF FSP <> NIL THEN WITH FSP^ DO CASE FORM OF SCALAR: IF FSP=INTPTR THEN A;,LIGNQUOT := INTAL ELSE IF FSP=BOOLPTR THEN ALIGNQUOT := BOOLAL ELSE IF SCALKIND=DECLARED THEN ALIGNQUOT := INTAL ELSE IF FSP=CHARPTR THEN ALIGNQUOT := CHARAL ELSE IF FSP=REALPTYR THEN ALIGNQUOT := REALAL ELSE (*PARMPTR*) ALIGNQUOT := PARMAL; SUBRANGE: ALIGNQUOT := ALIGNQUOT(RANGETYPE); POINTER: ALIGNQUOT := ADRAL; POWER: ALIGNQUOT := SETAL; FILES: ALIGNQUOT := FIL|FEAL; ARRAYS: ALIGNQUOT := ALIGNQUOT(AELTYPE); RECORDS: ALIGNQUOT := RECAL; VARIANT,TAGFLD: ERROR(501) END END (*ALIGNQUOT*); PROCEDURE ALIGN(FSP: STP; VAR FLC: INTEGER); VAR K,L: INTEGER; BEGIN K := ALIGNQUOT(FSP); L := FLC-1; FLC := L + K - (K + L) MOD K (*CORRECTION TO ALIGN (K + L) AS MOD ONLY TRUE FOR +VE INTS*) END (*ALIGN*); PROCEDURE GENLABEL(VAR NXTLAB: INTEGER); BEGIN INTLABEL := INTLABEL + 1; NXTLAB := INTLABEL ENDV (*GENLABEL*); PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP; NOTEXTDEC,EXTN : BOOLEAN); VAR LSY: SYMBOL; TEST: BOOLEAN; PLOCFP,FLOCFP,LOCFP : EXTFILEP; RANDOMFLAG : BOOLEAN; PARMSUM,PARMNO : INTEGER; PROCEDURE SKIP(FSYS: SFlETOFSYS); (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*) BEGIN IF NOT EOF(INPUT) THEN BEGIN WHILE NOT(SY IN FSYS) AND (NOT EOF(INPUT)) DO INSYMBOL; IF NOT (SY IN FSYS) THEN INSYMBOL END END (*SKIP*) ; PBROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU); VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG); LVP: CSP; I: 2..STRGLGTH; BEGIN LSP := NIL; FVALU.IVAL := 0; IF NOT(SY IN CONSTBEGSYS) THEN BEGIN ERROR(50); SUKIP(FSYS+CONSTBEGSYS) END; IF SY IN CONSTBEGSYS THEN BEGIN IF SY = STRINGCONSTSY THEN BEGIN IF LGTH = 1 THEN LSP := CHARPTR ELSE BEGIN NEW(LSP,ARRAYS); E WITH LSP^ DO BEGIN AELTYPE := CHARPTR; INXTYPE := NIL; SIZE := LGTH*CHARSIZE; FORM := ARRAYS  END END; FVALU := VAL; INSYMBOL END ELSE BEGIN SIGN := NONE; IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG; INSYMBOL END; IF SY = IDENT7) THEN BEGIN SEARCHID([KONST],LCP); WITH LCP^ DO BEGIN LSP := IDTYPE; FVALU := VALUES END;  IF SIGN <> NONE THEN IF LSP = INTPTR THEN BEGIN IF SgGIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END ELSE IF LSP = REALPTR THEN BEGIN IF SIGN = NEG THEN BEGIN NEW(LVP,REEL); m IF FVALU.VALP^.RVAL[1] = ' ' THEN LVP^.RVAL[1] := '+' ELSE LVP^.RVAL[1] := '-'; FOR I := 2 TO STRGLGTH DO LVP^.RVAL[I] :k= FVALU.VALP^.RVAL[I]; FVALU.VALP := LVP; END END ELSE ERROR(105); INSYMBOL; END ELSE  IF SY = INTCONST THEN BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL; LSP := INTPTR; FVALU := VAL; INSYMBOL END ELSE IF SY = REALCONST THEN BEGI?N IF SIGN = NEG THEN VAL.VALP^.RVAL[1] := '-'; LSP := REALPTR; FVALU := VAL; INSYMBOL END ELSE BEGIN ERROR(106); SKIP(FSYS) END END; IF NOT (SY IN FSYS) TBHEN BEGIN ERROR(6); SKIP(FSYS) END END; FSP := LSP END (*CONSTANT*) ; FUNCTION EQUALBOUNDS(FSP1,FSP2: STP): BOOLEAN; VAR LMIN1,LMIN2,LMAX1,LMAX2: INTEGER; BEGIN IF (FSP1=NIL) OR (FSP2=NIL) THEN EQUALBOUN2DS := TRUE ELSE BEGIN GETBOUNDS(FSP1,LMIN1,LMAX1); GETBOUNDS(FSP1,LMIN2,LMAX2); EQUALBOUNDS := (LMIN1=LMIN2) AND (LMAX1=LMAX2) END END (*EQUALBOUNDS*) ; FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLErAN; (*DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE*) VAR NXT1,NXT2: CTP; COMP: BOOLEAN; LTESTP1,LTESTP2 : TESTP; BEGIN IF FSP1 = FSP2 THEN COMPTYPES := TRUE ELSE IF (FSP1 <> NIL) AND (FSP2K <> NIL) THEN IF FSP1^.FORM = FSP2^.FORM THEN CASE FSP1^.FORM OF SCALAR: COMPTYPES := FALSE; (* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE NOT RECOGNIZED TO BE COM^PATIBLE*) SUBRANGE: COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2^.RANGETYPE); POINTER: BEGIN COMP := FALSE; LTESTP1 := GLOBTESTP; LTESTP2 := GLOBTESTP;  WHILE LTESTP1 <> NIL DO WITH LTESTP1^ DO BEGIN IF (ELT1 = FSP1^.ELTYPE) AND (ELT2 = FSP2^.ELTYPE) THEN COMP := TRUE; Z LTESTP1 := LASTTESTP END; IF NOT COMP THEN BEGIN NEW(LTESTP1); WITH LTESTP1^ DO BEGIN ELT1 := FSP1^.ELTYPE; ELT2 := FSP2^.ELTYPE; LASTTESTP := GLOBTESTP END; GLOBTESTP := LTESTP1; COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE) END;  COMPTYPES := COMP; GLOBTESTP := LTESTP2 END; POWER: COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET); ARRAYS: BEGIN COMP := COMPTYPES(FSP1^.AELTYPE,FSP`2^.AELTYPE) AND COMPTYPES(FSP1^.INXTYPE,FSP2^.INXTYPE); COMPTYPES := COMP AND EQUALBOUNDS(FSP1^.INXTYPE,FSP2^.INXTYPE) END; RECORDS: BEGIN NXT1 := FS|=P1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP:=TRUE;  WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) DO BEGIN COMP:=COMP AND COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE); NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT  END; COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL) AND(FSP1^.RECVAR = NIL)AND(FSP2^.RECVAR = NIL) END; (*IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE  c IFF NO VARIANTS OCCUR*)  FILES: COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE) END (*CASE*) ELSE (*FSP1^.FORM <> FSP2^.FORM*) IF FSP1^.FORM = SUBRANGE THEN COMPTYPzES := COMPTYPES(FSP1^.RANGETYPE,FSP2) ELSE IF FSP2^.FORM = SUBRANGE THEN COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE) ELSE COMPTYPES := FALSE ELSE COMPTYPES := TRUE END (*COMPTYPES*) ; F FUNCTION STRING(FSP: STP) : BOOLEAN; BEGIN STRING := FALSE; IF FSP <> NIL THEN IF FSP^.FORM = ARRAYS THEN IF COMPTYPES(FSP^.AELTYPE,CHARPTR) THEN STRING := TRUE END (*STRING*) ; PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: gSTP; VAR FSIZE: ADDRRANGE); VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP; LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER; PROCEDURE SIMPLETYPE(FSYS:SETOFSYS; VAR FSP:STP; VAR FSIZE:ADDRRANGE); VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE; LCNT: INTEGER; LVALU: VALU; BEGIN FSIZE := 1; IF NOT (SY IN SIMPTYPEBEGSYS) THEN BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END; IF SY IN SIMPTYPEBEGSYS THEN BEGIN IF SY = LPARENT THEN BEGIN TTOP := TOP; (*DECL. CONSTS LOCAL TO INNERMOST BLOCK*) WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1; NEW(LSP,SCALAR,DECLARED); WITH LSP^ DO BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := DECLARED END; LCP1 := NIL; LCNT := 0; REPEAT INSYMBOL; IF SY = IDENT THEN BEGIN NEW(LCP,KONST); H WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1; VALUES.IVAL := LCNT; KLASS := KONST END; ENTERID(LCP); LCNT : = LCNT + 1; LCP1 := LCP; INSYMBOL END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END 0 UNTIL SY <> COMMA; LSP^.FCONST := LCP1; TOP := TTOP; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE BEGIN IF SY = IDENT THEN BEGIN SEARCHID([TYPES,KONST],LCP); INSYMBOL; IF LCP^.KLASS = KONST THEN BEGIN NEW(LSP,SUBRANGE); WITH LSP^, LCP^ DO BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE;!% IF STRING(RANGETYPE) THEN BEGIN ERROR(148); RANGETYPE := NIL END; MIN := VALUES; SIZE := INTSIZE END;  IF SY = COLON THEN INSYMBOL ELSE ERROR(5); CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107) END ELSE H BEGIN LSP := LCP^.IDTYPE; IF LSP <> NIL THEN FSIZE := LSP^.SIZE END END (*SY = IDENT*) ELSE BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE; m CONSTANT(FSYS + [COLON],LSP1,LVALU); IF STRING(LSP1) THEN BEGIN ERROR(148); LSP1 := NIL END; WITH LSP^ DO BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE END;  IF SY = COLON THEN INSYMBOL ELSE ERROR(5); CONSTANT(FSYS,LSP1,LVALU); LSP^.MAX := LVALU; IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)  END; IF LSP <> NIL THEN WITH LSP^ DO IF FORM = SUBRANGE THEN IF RANGETYPE <> NIL THEN IF RANGETYPE = REALPTR THEN ERROR(399) ELSE IF MIN.IVAL > MAX.IVAL THEN ERROR(102) END; FSP := LSP; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL  END (*SIMPLETYPE*) ; PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP); VAR LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP; MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU; BEGIN NXT1 := NIL; LSP := NIL; IF NOT (SY IN (FSYS+[IDENT,CASESY])) THEN BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END; WHILE SY = IDENT DO BEGIN NXT := NXT1; REPEAT IF SY = IDENT THEN BEGIN NEW(LCP,FIELD); WITH LCP^ DO BEGIN NAME :=d ID; IDTYPE := NIL; NEXT := NXT; KLASS := FIELD END; NXT := LCP; ENTERID(LCP); INSYMBOL END ELSE ERROR(2); IF NOT (SiY IN [COMMA,COLON]) THEN BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMGBOL ELSE ERROR(5); TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE); WHILE NXT <> NXT1 DO WITH NXT^ DO BEGIN ALIGN(LSP,DISPL); P4COMPILE2.NNm IDTYPE := LSP; FLDADDR := DISPL; NXT := NEXT; DISPL := DISPL + LSIZE END; NXT1 := LCP; IF SY = SEMICOLON THEN BEGIN INSYMBOL;  IF NOT (SY IN [IDENT,CAS#ESY]) THEN BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END END END (*WHILE*); NXT := NIL; WHILE NXT1 <> NIL DO WITH NXT1^ DO BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 п:= LCP END; IF SY = CASESY THEN BEGIN NEW(LSP,TAGFLD); WITH LSP^ DO BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM:=TAGFLD END; FRECVAR := LSP; INSYMBOL; IF SY = IDENT THEN  BEGIN NEW(LCP,FIELD); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS:=FIELD; NEXT := NIL; FLDADDR := DISPL END; ENTERID(LCP); INSYMBOL; A IF SY = COLON THEN INSYMBOL ELSE ERROR(5); IF SY = IDENT THEN BEGIN SEARCHID([TYPES],LCP1); LSP1 := LCP1^.IDTYPE;  IF LSP1 <> NIL THEN BEGIN ALIGN(LPCP^.IDTYPE,DISPL); LCP^.FLDADDR := DISPL; DISPL := DISPL+LSP1^.SIZE; IF (LSP1^.FORM <= SUBRANGE) OR STRING(LSP1) THEN BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ER ROR(109) ELSE IF STRING(LSP1) THEN ERROR(399); LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP; END  ELSE ERROR(110); END;  INSYMBOL; END ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END END ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END; LSP^.SIZE := DISPL; IF SY = OFSY THEN INDSYMBOL ELSE ERROR(8); LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL; REPEAT LSP2 := NIL; IF NOT (SY IN [SEMICOLON,ENDSY]) THEN  BEGIN REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALUq); IF LSP^.TAGFIELDP <> NIL THEN IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3)THEN ERROR(111); NEW(LSP3,VARIANT); WITH LSP3^ DO BEGIN NXTVAR := LSP1; SUBVAR := LSP2; VARVAL 9:= LVALU; FORM := VARIANT END; LSP4 := LSP1; WHILE LSP4 <> NIL DO WITH LSP4^ DO BEGIN IF VARVAL.IVAL = LVALU.IVAL THEN ERROR(178); LSP4 := NXTVAR END; LSP1 := LSP3; LSP2 := LSP3; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOKL ELSE ERROR(5); IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9); FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2); IF DISPL > MAXSIZE THEN MAXSIZE := DISPL; WHILE LSP3 <> NIL DO BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2; LSP3^.SIZE := DISPL; LSP3 := LSP4 END; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [SEMICOLON]) THEN  BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END END ELSE ERROR(4); END;  TEST := SY <> SEMICOLON; IF NOT TEST THEN BEGIN DISPL := MINSIZE;  INSYMBOL END UNTIL TEST; DISPL := MAXSIZE; LSP^.FSTVAR := LSP1; END ELSE FRECVAR := NIL END (*FIELDLIST*) ; BEGIN (*TYP*) IF NOT (SY IN TYPEBEGSYS) THEN BEGI#N ERROR(10); SKIP(FSYS + TYPEBEGSYS) END; IF SY IN TYPEBEGSYS THEN BEGIN IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE) ELSE (*^*) IF SY = ARROW THEN BEGIN NEW(LSP,POINTER); FSP := LSP; d WITH LSP^ DO BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM:=POINTER END; INSYMBOL; IF SY = IDENT THEN BEGIN PRTERR := FALSE; (*NO ERROR IF SEARCH NOT SUCCESSFUL*)   SEARCHID([TYPES],LCP); PRTERR := TRUE; IF LCP = NIL THEN (*FORWARD REFERENCED TYPE ID*)  BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := LSP;  NEXT := FWPTR; KLASS := TYPES END; FWPTR := LCP END ELSE BEGIN IF LCP^.IDTYPE <> NIL THEN a IF LCP^.IDTYPE^.FORM = FILES THEN ERROR(108) ELSE LSP^.ELTYPE := LCP^.IDTYPE END; INSYMBOL; END ELSE ERROR(2); END E ELSE BEGIN IF SY = PACKEDSY THEN BEGIN INSYMBOL; IF NOT (SY IN TYPEDELS) THEN BEGIN ERROR(10); SKIP(FSYS + TYPEDELS) ׆ END END; (*ARRAY*) IF SY = ARRAYSY THEN BEGIN INSYMBOL; IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11); LSP1 := NIL; REPEAT NEW(LSP,ARRAYS); 2{ WITH LSP^ DO BEGIN AELTYPE := LSP1; INXTYPE := NIL; FORM:=ARRAYS END; LSP1 := LSP; SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2,LSIZE); LSP1^.SIZE := LSIbZE; IF LSP2 <> NIL THEN IF LSP2^.FORM <= SUBRANGE THEN BEGIN IF LSP2 = REALPTR THEN BEGIN ERROR(109); LSP2 := NIL END p ELSE IF LSP2 = INTPTR THEN BEGIN ERROR(149); LSP2 := NIL END; LSP^.INXTYPE := LSP2 END ELSE BEGI4N ERROR(113); LSP2 := NIL END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12); IF SY = OFSY THENf INSYMBOL ELSE ERROR(8); TYP(FSYS,LSP,LSIZE); REPEAT WITH LSP1^ DO BEGIN LSP2 := AELTYPE; AELTYPE := LSP; IF INXTYPE <> NIL THEN < BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);  IF AELTYPE = CHARPTR THEN LSIZE := CHARSIZE ELSE ALIGN(LSP,LSIZE); LSIZE := LSIZE*(LMAX - LMIN + 1); A SIZE := LSIZE END END; LSP := LSP1; LSP1 := LSP2 UNTIL LSP1 = NIL END ELSE (*RECORD*) IF SY = RECORDSY THEN BEGIN INSYMBOL;  OLDTOP := TOP; IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := REC END END ELSE ERROR(250); DISPL := 0;  FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1); NEW(LSP,RECORDS); WITH LSP^ DO BEGIN FSTFLD := DISPLAY[TOP].FNAME; RECVAR := LSP1; SIZE := DISPL; FORM := RECORDS 0( END; TOP := OLDTOP; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END ELSE (*SET*) IF SY = SETSY THEN BEGIN INSYMBOL; M  IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); SIMPLETYPE(FSYS,LSP1,LSIZE); IF LSP1 <> NIL THEN IF LSP1^.FORM > SUBRANGE THEN BEGIN ERROR(115); LSP1 := NIL END ELSE IF LSP1 = REALPTR THEN ERROR(114); NEW(LSP,POWER); WITH LSP^ DO BEGIN ELSET:=LSP1; SIZE:=SETSIZE; FORM:=POWER END; END ELSE BEGIN IF SY = RANDOMSY THEN BEGIN INSYMBOL; RANDOMFLAG := TRUE END ELSE RANDOMFLAG := FALSE; (*FILE*) IF SY = FILESY THEN BEGIN INSYMBOL; IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); IF SY<> FILESY THEN TYP(FSYS,LSP1,LSIZE) (t ELSE BEGIN ERROR(121); SKIP(FSYS+TYPEBEGSYS) END; NEW(LSP,FILES); WITH LSP^ DO BEGIN FILTYPE:=LSP1; FORM:=FILES; SIZE := LSIZE; RANDOMFILE := RANDOMFLAG END END; END; FSP := LSP END; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE FSP := NIL; ; IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP^.SIZE END (*TYP*) ; PROCEDURE LABELDECLARATION; VAR LLP: LBP; REDEF: BOOLEAN; LBNAME: INTEGER; BEGIN REPEAT IF SY = INTCONST THEN WITH DISPLAY[TOP] DO BEGIN LLP := FLABEL; REDEF := FALSE; WHILE (LLP <> NIL) AND NOT REDEF DO IF LLP^.LABVAL <> VAL.IVAL THEN LLP := LLP^.NEXTLAB ELSE BEGIN REDEF := TRUE; ERROR(166) END;  IF NOT REDEF THEN BEGIN NEW(LLP); WITH LLP^ DO BEGIN LABVAL := VAL.IVAL; GENLABEL(LBNAME); DEFINED := FALSE; NEXTLAB := FLABEL; LABNAME := LBNAME END; FLABEL := LLP END; INSYMBOL END ELSE ERROR(15); IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END; TEST := SY <> COMMA; IF NOT TE,ST THEN INSYMBOL UNTIL TEST; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) END (* LABELDECLARATION *) ; PROCEDURE CONSTDECLARATION; VAR LCP: CTP; LSP: STP; LVALU: VALU; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2);N) SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,KONST); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS:=KONST END; INSYMBOL;  IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBO}L ELSE ERROR(16); CONSTANT(FSYS + [SEMICOLON],LSP,LVALU); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN 7 BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) END END (*CONSTDECLARATION*) ; PROCEDURE TYPEDECLARATION; VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END; INSYMBOL; IF (SY = RELOP) AND (OPͫ = EQOP) THEN INSYMBOL ELSE ERROR(16); TYP(FSYS + [SEMICOLON],LSP,LSIZE); ENTERID(LCP); LCP^.IDTYPE := LSP; (*HAS ANY FORWARD REFERENCE BEEN SATISFIED:*) LCP1 := FWPTR; WHILE LCP1 <> NIL DO } BEGIN IF LCP1^.NAME = LCP^.NAME THEN BEGIN LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE; IF LCP1 <> FWPTR THEN LCP2^.NEXT := LCP1^.NEXT ELSE FWPTR := LCP1^.NEXT; / END; LCP2 := LCP1; LCP1 := LCP1^.NEXT END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) END; IF FWPTR <> NIL THEN BEGIN ERROR(117); WRITELN(OUTPUT); REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME); FWPTR := FWPTR^.NEXT UNTIL FWPTR = NIL; IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16) END END (*TYPEDECLARATION*) ; PROCEDURE VARDECLARATION; VAR LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN NXT := NIL; REPEAT REPEAT IF SY = IDENT THEN BEGIN NEW(LCPA,VARS); WITH LCP^ DO BEGIN NAME := ID; NEXT := NXT; KLASS := VARS; IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL END; ENTERID(LCP); NXT := LCP; INSYMBOLAL; END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL N UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE); IF LSP^.FORM = FILES THEN (*MACHINE DEPENDENT*) IF LSIZE > 510 THEN ERROR(399) ELSE IF LSP^.RANDOMFILE THEN BEGIN IF LSIZE > 126 THEN LSIZE := 512 ELSE LSIZE := 128  END; WHILE NXT <> NIL DO WITH NXT^ DO BEGIN ALIGN(LSP,LC); IF LS?P^.FORM = FILES THEN BEGIN LC := LC+4; (*SPACE FOR FLAGS*) LOCFP := FEXTFILEP; TEST := TRUE; WHILE ((LOCFP <> NIL) AND TEST) DO IF LOCFP^.FILENAME = NXT^.NAME THEN TEST :=z FALSE ELSE LOCFP := LOCFP^.NEXTFILE; IF LOCFP <> NIL THEN (*DEAL WITH EXTERNAL FILES*) LOCFP^.FTYPE := NXT ELSE (* IT WAS AN INTERNAL FILE*) BEGIN NEW(PLOCFP); WITH PLOCFP^ DO BEGIN FILENAME := NXT^.NAME; NEXTFILE := FLOCFP; FTYPE := N XT; END; FLOCFP := PLOCFP END;  END; IDTYPE := LSP; VADDR := LC; LC := LC + LSIZE; NXT := NEXT END; IF SY = SEMICOLON4 THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE ERROR(14) UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS); IF FWPTR <> NIL THEN  BEGIN ERROR(117); WRITELN(OUTPUT); REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME);  FWPTR := FWPTR^.NEXT UNTIL FWPTR = NIL; IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16) END END (*VARDECLARATION*) ;  PROCEDURE PROCDECLARATION(FSY: SYMBOL); VAR OLDLEV: 0..MAXLEVEL; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP; FORW: BOOLEAN; OLDTOP: DISPRANGE; PARCNT: INTEGER; LLC,LCM: ADDRRANGE; LBNAME: INTEGER; MARKP: ^INTEGER; PROCEDURE PARAlMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP); VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND; LLC: ADDRRANGE; COUNT,LSIZE: INTEGER; BEGIN LCP1 := NIL; IF NOT (SY IN FSY + [LPARENT]) THEN BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END; IF SY = LPARENT THEN BEGIN IF FORW THEN ERROR(119); INSYMBOL; IF NOT (SY IN [IDENT,VARSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END; WHIL*TE SY IN [IDENT,VARSY,PROCSY,FUNCSY] DO BEGIN IF SY = PROCSY THEN BEGIN ERROR(399); REPEAT INSYMBOL; IF SY = IDENT THEN BEGIN NEW(LCP,PROC,DECLARrED,FORMAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP1; PFLEV := LEVEL (*BEWARE OF PARAMETER PROCEDURES*); KLASS:=PROC;PFDECKIND:=DECLARED;PFKIND:=FORMAL END;  ENTERID(LCP); LCP1 := LCP; ALIGN(PARMPTR,LC); (*LC := LC + SOME SIZE *) X INSYMBOL END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])END UpWNTIL SY <> COMMA END  ELSE BEGIN IF SY = FUNCSY THEN BEGIN ERROR(399); LCP2 := NIL; REPEAT INSYMBOL; IF SY = IDEN'wT THEN BEGIN NEW(LCP,FUNC,DECLARED,FORMAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2; PFLEV := LEVEL (*BEWARE PARAM FUNCS*);  KLASS:=FUNC;PFDECKIND:=DECLARED; PFKIND:=FORMAL END; ENTERID(LCP); LCP2 := LCP; . ALIGN(PARMPTR,LC); (*LC := LC + SOME SIZE*) INSYMBOL; END; IF NOT (SY IN [COMMA,COLON] + FSYS) THEN  BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT]) END UNTIL SY <> COMMA; IF SY = COLON THEN BEGIN INSYMBOL; IF SY = IjDENT THEN BEGIN SEARCHID([TYPES],LCP); LSP := LCP^.IDTYPE; IF LSP <> NIL THEN IF NOT(LSP^.FORM IN[SCALAR,SUBRANGE,POINTER]) H  THEN BEGIN ERROR(120); LSP := NIL END; LCP3 := LCP2; WHILE LCP2 <> NIL DO BEGIN LCP2^.IDTYPE := LSP; LCP := LCP2;  LCP2 := LCP2^.NEXT END; LCP^.NEXT := LCP1; LCP1 := LCP3; INSYMBOL END ELSE ER\ROR(2); IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END END ELSE ERROR(5) END IA ELSE BEGIN IF SY = VARSY THEN BEGIN LKIND := FORMAL; INSYMBOL END ELSE LKIND := ACTUAL; LCP2 := NIL;  N COUNT := 0; REPEAT IF SY = IDENT THEN BEGIN NEW(LCP,VARS); WITH LCP^ DO BEGIN NAME:=ID; IDTYPE:=NIL; KLASS:v=VARS; VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL; END; ENTERID(LCP); LCP2 := LCP; COUNT := COUNT+1;   > INSYMBOL; END; IF NOT (SY IN [COMMA,COLON] + FSYS) THEN BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN BEGIN INSYMBOL; IF SY = IDENT THEN  BEGIN SEARCHID([TYPES],LCP); LSP := LCP^.IDTYPE; LSIZE := PTRSIZE; IF LSP <> NIL THEN IF LKIND=ACTUAL THEN  IF LSP^.FORM<=POWER THEN LSIZE := LSP^.SIZE ELSE IF LSP^.FORM=FILES THEN ERROR(121); ALIGN(PARMPTR,LSIZE);  LCP3 := LCP2; 1 ALIGN(PARMPTR,LC); LC := LC+COUNT*LSIZE; LLC := LC; WHILE LCP2 <> NIL DO BEGIN LCP := LCP2;  WITH LCP2^ DO BEGIN IDTYPE := LSP; LLC := LLC-LSIZE; VADDR := LLC; END; A/ LCP2 := LCP2^.NEXT END; LCP^.NEXT := LCP1; LCP1 := LCP3; INSYMBOL END  ELSE ERROR(2); IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END  END ELSE ERROR(5);  END; END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT,VARSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT])END Q END END (*WHILE*) ; IF SY = RPARENT THEN BEGIN INSYMBOL; IF NOT (SY IN FSY + FSYS) THEN BEGIN ERROR(6); SKIP(FSY + FSYS) END END ELSE ERROR(4Y); LCP3 := NIL; (*REVERSE POINTERS AND RESERVE LOCAL CELLS FOR COPIES OF MULTIPLE VALUES*) WHILE LCP1 <> NIL DO WITH LCP1^ DO BEGIN LCP2 := NEXT; NEXT := LCP3;  ~ IF KLASS = VARS THEN IF IDTYPE <> NIL THEN IF (VKIND=ACTUAL)AND(IDTYPE^.FORM>POWER) THEN BEGIN ALIGN(IDTYPE,LC); VADDR := LC; LC := LC+IDETYPE^.SIZE; END; LCP3 := LCP1; LCP1 := LCP2 END; FPAR := LCP3 END ELSE FPAR := NIL END (*PARAMETERLIST*) ; BEGIN (*PROCDECLARATION*) LLC := LC; LC :=V LCAFTERMARKSTACK; FORW := FALSE; IF SY = IDENT THEN BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP); (*DECIDE WHETHER FORW.*) IF LCP <> NIL THEN BEGIN IF LCP^.KLASS = PROC THEN FORW := LCP^.FORWDECL AND(FSY = PROCSY)AND(LCP^.PFKIND = ACTUAL) ELSE IF LCP^.KLASS = FUNC THEN FORW:=LCP^.FORWDECL AND(FSY=FUNCSY)AND(LCP^.PFKIND=ACTUAL) ELSE FORW := FALSE; IF NOT FORW THEN ERROR(160) 3 END; IF NOT FORW THEN BEGIN IF FSY = PROCSY THEN NEW(LCP,PROC,DECLARED,ACTUAL) ELSE NEW(LCP,FUNC,DECLARED,ACTUAL); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; EXTDEC := FALSE; EXTERN := FALSE; PFLEV := LEVEL; GENLABEL(LBNAME); PFDECKIND := DECLARED; PFKIND := ACTUAL; PFNAME := LBNAME; IF FSY = PROCSY THEN KLASS := PROC ELSE KLASS := FUNC < END; ENTERID(LCP) END ELSE BEGIN LCP1 := LCP^.NEXT; WHILE LCP1 <> NIL DO BEGIN WITH LCP1^ DO IF KLASS = VARS THEN IF +IDTYPE <> NIL THEN BEGIN LCM := VADDR + IDTYPE^.SIZE; IF LCM > LC THEN LC := LCM END; LCP1 := LCP1^.NEXT END END; INSYMBOL A END ELSE BEGIN ERROR(2); LCP := UFCTPTR END; OLDLEV := LEVEL; OLDTOP := TOP; IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251); IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; WITH DISPLAY[TO6P] DO BEGIN IF FORW THEN FNAME := LCP^.NEXT ELSE FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END END ELSE ERROR(250); IF FSY = PROCSY THEN BEGIN PARAMETERLIST([SEMICOLON],LCP1); IF NOT FORW THEN LCP^.NEXT := LCP1 END ELSE BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1); IF NOT FORW THEN LCP^.NEXT := LCP1; IF SY = COLON THEN BEGIN INSYMBOL; ۋ IF SY = IDENT THEN BEGIN IF FORW THEN ERROR(122); SEARCHID([TYPES],LCP1); LSP := LCP1^.IDTYPE; LCP^.IDTYPE := LSP; IF LSP <> NIL THEN IF haNOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN BEGIN ERROR(120); LCP^.IDTYPE := NIL END; INSYMBOL END ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END END ELSE [ IF NOT FORW THEN ERROR(123) END; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); IF SY = EXTRNSY THEN BEGIN WITH LCP^ DO BEGIN EXTDEC := TRUE; IF PRCODE THEN 7 BEGIN WRITELN(PRR); WRITELN(PRR,' .EXTN ?',NAME); WRITELN(PRR);  WRITELN(PRR,'L',' ',PFNAME:4,':','?':3,NAME); END; INSYMBOL; IF SY =SEMICOLON THEN INSYMBOL ELSE ERROR(14); END END ELSE IF SY = FORWARDSY THEN BEGIN IF FORW THEN ERROR(161) ELSE LCP^.FORWDECL := TRUE; INSYMBOL; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); IF NOT (SY IN FSYS) THEN  BEGIN ERROR(6); SKIP(FSYS) END END ELSE BEGIN LCP^.FORWDECL := FALSE; MARK(MARKP); REPEAT BLOCK(FSYS,SEMICOLON,LCP,TRUE,NOT(NOTEXTDEC)); IF SY = SEMICOLON THEN BEGIN INSYMBOL; I4F NOT (SY IN [BEGINSY,PROCSY,FUNCSY]) THEN BEGIN ERROR(6); SKIP(FSYS) END END ELSE IF NOT ((SY =PERIOD) AND EXTN) THEN ERROR(14) UNTIL ((SY IN [BEGINSY,PROCSY,FUNCSY]) OR EOF(INPUT)) OR ((SY=PER1IOD) AND EXTN); RELEASE(MARKP); (* RETURN LOCAL ENTRIES ON RUNTIME HEAP *) END; LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC; END (*PROCDECLARATION*) ; PROCEDURE BODY(FSYS: SETOFSYS); CONST CSTOCCMAX=65; CIXMAX=1000;  TYPE OPRANGE = 0..63; VAR LLCP:CTP; SAVEID:ALPHA; CSTPTR: ARRAY [1..CSTOCCMAX] OF CSP; CSTPTRIX: 0..CSTOCCMAX; (*ALLOWS REFERENCING OF NONINTEGER CONSTANTS BY AN INDEX (INSTEAD OF A POINTER), WHICU}H CAN BE STORED IN THE P2-FIELD OF THE INSTRUCTION RECORD UNTIL WRITEOUT. --> PROCEDURE LOAD, PROCEDURE WRITEOUT*) I, ENTNAME, SEGSIZE: INTEGER; STACKTOP, TOPNEW, TOPMAX: INTEGER; LCMAX,LLC1: ADDRRANGE; LCP: CTP; LLP: LBP; PROCEDURE MES(I: INTEGER); BEGIN TOPNEW := TOPNEW + CDX[I]*MAXSTACK; IF TOPNEW > TOPMAX THEN TOPMAX := TOPNEW END; PROCEDURE PUTIC; BEGIN IF IC MOD 10 = 0 THEN WRITELN(PRR,'I',' ',IC:5) ExND; PROCEDURE GEN0(FOP: OPRANGE); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4) END; IC := IC + 1; MES(FOP) END (*GEN0*) ; PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER); VAR K: INTEGER; BEGIN; IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[FOP]:4); IF FOP = 30 THEN BEGIN WRITELN(PRR,SNA[FP2]:12); TOPNEW := TOPNEW + PDX[FP2]*MAXSTACK; IF TOPNEW > TOPMAX THEN TOPMAX := TOPNEW  END  ELSE BEGIN IF FOP = 38 THEN BEGIN WRITELN(PRR); WRITE(PRR,' .TXT ','"'); WITH CSTPTR[FP2]^ DO BEGIN FOR K := 1 TOC SLGTH DO WRITE(PRR,SVAL[K]:1); FOR K := SLGTH+1 TO STRGLGTH DO WRITE(PRR,' '); END; WRITELN(PRR,'"') END ELSE IF FOP = 42 THEN WRITELN(PRR,CHR(FP2)) =  ELSE WRITELN(PRR,FP2:12); MES(FOP) END END; IC := IC + 1 END (*GEN1*) ; PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER); VAR K,H,M : INTEGER; BEGIN IF PRCODE THEN BEGIN PUTIC; IF ((FOP=51) AND (FP1=5)) THEN BEGIN FOR K := 1 TO 4 DO BEGIN WRITE(PRR,' .SW',K:1,'=':2,' '); FOR H := 0 TO 15 DO   BEGIN M := (K-1)*16+H; WITH CSTPTR[FP2]^ DO IF M IN PVAL THEN WRITE(PRR,'1':1) ELSE WRITE(PRR,'0':1) / END; WRITELN(PRR) END END; WRITE(PRR,MN[FOP]:4); CASE FOP OF 45,50,54,56: WRITELN(PRR,' ',FP1:3,FP2:8);  47,48,49,52,53,55: BEGIN WRITE(PRR,CHR(FP1)); IF CHR(FP1) = 'M' THEN WRITE(PRR,FP2:11); WRITELN(PRR) END; 51: CASE FP1 OF 1: WRITELN(PRR,'I',' '>,FP2); 2: BEGIN WRITE(PRR,'R',' '); WITH CSTPTR[FP2]^ DO FOR K := 1 TO STRGLGTH DO WRITE(PRR,RVAL[K]); WRITELN(PRR) END;  3: WRITELN(PRR,'B',' ',FP2); 4: WRITELN(PRR,'N'); 6: WRITELN(PRR,'C','''':2,CHR(FP2),''''); 5: BEGIN WRITE(PRR,'(':2,' '); WRITE(PRR,'W1 W2 W3 W4'); WRITELN(PRR,')':2)  END END END; END; IC := IC + 1; MES(FOP) END (*GEN2*) ; PROCEDURE GENTYPINDICATOR(FSP: STP); BEGIN IF FSP<>NIL THEN WITH FSP^ DO CASE FORM OF -t SCALAR: IF FSP=INTPTR THEN WRITE(PRR,'I') ELSE IF FSP=BOOLPTR THEN WRITE(PRR,'B') ELSE IF FSP=CHARPTR THEN WRITE(PRR,'C') ELSE  IF SCALKIND = DECLARED THEN WRITE(PRR,'I') ELSE WRITE(PRR,'R'); SUBRANGE: GENTYPINDICATOR(RANGETYPE); POINTER: WRITE(PRR,'A');  POWER: WRITE(PRR,'S'); V] RECORDS,ARRAYS: WRITE(PRR,'M'); FILES,TAGFLD,VARIANT: ERROR(500) END END (*TYPINDICATOR*); PROCEDURE GEN0T(FOP: OPRANGE; FSP: STP); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[~;FOP]:4); GENTYPINDICATOR(FSP); WRITELN(PRR); END; IC := IC + 1; MES(FOP) END (*GEN0T*); PROCEDURE GEN1T(FOP: OPRANGE; FP2: INTEGER; FSP: STP);  BEGIN IF PRCODE THEN BEGIN PUTIC; [E WRITE(PRR,MN[FOP]:4); GENTYPINDICATOR(FSP); WRITELN(PRR,FP2:11) END; IC := IC + 1; MES(FOP) END (*GEN1T*); PROCEDURE GEN2T(FOP: OPRANGE; FP1,FP2: INTEGER; FSP: STP); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITE(PRR,MN[FOP]: 4); GENTYPINDICATOR(FSP); WRITELN(PRR,FP1:3,FP2:8); END; IC := IC + 1; MES(FOP)  END (*GEN2T*); PROCEDURE LOAD; BEGIN WITHd GATTR DO IF TYPTR <> NIL THEN BEGIN CASE KIND OF CST: IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN IF TYPTR = BOOLPTR THEN GEN2(51(*LDC*),3,CVAL.IVAL) U ELSE IF TYPTR=CHARPTR THEN GEN2(51(*LDC*),6,CVAL.IVAL) ELSE GEN2(51(*LDC*),1,CVAL.IVAL) ELSE IF TYPTR = NILPTR THEN SGEN2(51(*LDC*),4,0) ELSE IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; CSTPTR[CSTPTRIEX] := CVAL.VALP; IF TYPTR = REALPTR THEN GEN2(51(*LDC*),2,CSTPTRIX) ELSE GEN2(51(*LDC*),5,CSTPTRIX) b END; VARBL: CASE ACCESS OF DRCT: IF VLEVEL<=1 THEN GEN1T(39(*LDO*),DPLMT,TYPTR) ELSE GEN2T(54(*LOD*),LEVEL-VLEVEL,DPLMT,TYPTR); G INDRCT: GEN1T(35(*IND*),IDPLMT,TYPTR); INXD: ERROR(400) END; EXPR:  END; KIND := EXPR END END (*LOAD*) ; PROCEDURE STORE(VAR FATR NIL THEN CASE ACCESS OF DRCT: IF VLEVEL <= 1 THEN GEN1T(43(*SRO*),DPLMT,TYPTR) ELSE GEN2T(56(*STR*),LEVEL-VLEVEL,DPLMT,TYPTR); ; INDRCT: IF IDPLMT <> 0 THEN ERROR(400) ELSE GEN0T(26(*STO*),TYPTR); INXD: ERROR(400) END  END (*STORE*) ; PROCEDURE LOADADDRESS; BEGIN WITH GATTR DO IF TYPTR <> NIL THEtN BEGIN CASE KIND OF CST: IF STRING(TYPTR) THEN IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; ' CSTPTR[CSTPTRIX] := CVAL.VALP; GEN1(38(*LCA*),CSTPTRIX)  END ELSE ERROR(400); VARBL: CASE ACCESS OF DRCT: IF VLEVELJ <= 1 THEN GEN1(37(*LAO*),DPLMT) ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT); INDRCT: IF IDPLMT <> 0 THEN GEN1T(34(*INC*),IDPLMT,NILPTR); INXDw: ERROR(400) END; EXPR: ERROR(400) END; KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0 END END (*LOADADDRESS*) ; PROCEDURE GENFJP(FADDR: INTEGER); BEGIN LOAD; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> BOOLPTR THEN ERROR(144); IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[33]:4,'L':7,' ',FADDR:4) END; IC := IC + 1; MES(33) END (*GENFJP*) ; PROCEDURE GENUJPXJP(FOP:v> OPRANGE; FP2: INTEGER); BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR, MN[FOP]:4, 'L':7,' ',FP2:4) END; IC := IC + 1; MES(FOP) END (*GENUJPENT*); PROCEDURE GENCUPENT(FOP: OPRANGE; FP1,FP2: INTEGER); BEGIN rD IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4,FP1:4,'L':3,' ',FP2:4) END; IC := IC + 1; MES(FOP) END; PROCEDURE CHECKBNDS(FSP: STP); VAR LMIN,LMAX: INTEGER; BEGIN IF FS ?P <> NIL THEN IF FSP <> INTPTR THEN IF FSP <> REALPTR THEN  IF FSP^.FORM <= SUBRANGE THEN BEGIN GETBOUNDS(FSP,LMIN,LMAX); GEN2T(45(*CHK*),LMIN,LMAX,FSP) (END END (*CHECKBNDS*); PROCEDURE PUTLABEL(LABNAME: INTEGER); BEGIN IF PRCODE THEN WRITELN(PRR, 'L',' ', LABNAME:4,':') END (*PUTLABEL*); PROCEDURE OPENFILES(LOCFP : EXTFILEP); BEGIN WHILE LOCFP <> NIL DO ]0 WITH LOCFP^ DO BEGIN IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[38]:4); WRITELN(PRR,' .TXT ','"',FILENAME,' ':8,'"'); IC := IC+1; MES(38) END; R2SMISC.SRU,P .TITL R2SMISC ; VARIOUS OTHER OPERATIONS FOR THE P-CODE INTERPRETER .ENT PIXA,PSTP,PHLT,PNON .ENT PORD,PORDA,PORDC,PCHR,PORDB,PORDI .ENT PSTOC,PINDC .EXTN MPY .EXTN PUNDF .EXTD LHBNP,RHBNP .NREL PINDC: POP1 1 ; B.AD FROM STACK ADDZR 1,2 ; UADD Q FIELD..SET CARRY LDA 1,0,2 ; GET HOLD OF BYTE PAIR LDA 0,RHBNP ; GET MASK MOV 0,0,SNC ; WHICH BYTE REQD ? MOVS 1,1 ; LEFT ANDS 1,0 ; MASK PUSH1 0 ; BYTE TO STACK NEXT PSTOC: POP1 1 ;CHAR FROM STACK LHB POP1 2 ; BYTE DESTINATION LDA 0,LHBNP ; GET MASK AND 0,1 MOVZR 2,2,SNC ; MAKE WD ADDRESS - WHICH HALF ? MOVS 0,0,SKP ; LH MOVS 1,1 ; RH LDA 3,0,2 ; GET EXISTING CONTENTS AND 0,3 ; REMOVE UNWANTED BYTE ADD 1,3 ; ADD IN NEW BYTE STA 3,0,2 NEXT PIXA: POP1 1 ;INDEXED ADDR"|ESS LTOP1 0 MPY STOP1 1 NEXT PSTP: .SYSTM ;SOFT HALT .RESET ; (RETURN TO CALLING PROGRAM) ERR.2 .SYSTM .RTN JMP . PHLT: POP1 2 ;HARD HALT .SYSTM .ERTN JMP . NEXT PCHR: POP1 0 LDA 1,RHB40 ADD 1,0 LDA 1,RHBNP ROT: ANDS 1,0 PUSH1 0 NEXT RHB40: 40 LHB40: 40B7 PORD: NEXT PORDA: LTOP1 0 MOVZR 0,0 STOP1 0 NEXT PORDB: LTOP1 0 SUB 1,1 ;CLEAR AC1 MOVR 0,0 ;B15 INTO CARRY MOVL 1,1 ;CARRY INTO AC1 STOP1 1 NEXT PORDI: NEXT PORDC: POP1 0 LDA 1,LHB40 SUB 1,0 LDA 1,LHBNP JM4-P ROT PNON: .PUND ;UNDEFINED INSTRUCTION .END R2SSYMBOLS.SR D~B .TITL R2SSYMBOLS .DUSR PC = 20 ;ADDRESS OF PCODE INSTRUCTION .DUSR IP = 40 .DUSR SP = 41 ;CURRENT TOP OF STACK .DUSR MP = 42 ;MARK POINTER .DUSR DSP = 43 ;DATA SEGMENT POINTER (STACK BASE) .DUSR HP = 44 ;HEAP POINTER .DUSR EP = 45 ;STuACK MAX .DUSR AI1 = 27 ;AUTO INC 1 .DUSR AI2 = 26 ;AUTO INC 2 .DUSR AD1 = 37 ;AUTO DEC 1 .DUSR AD2 = 36 ;AUTO DEC 2 .DUSR Z1 = 47 .DUSR Z2 = 46 .DUSR .ERR2 = 50 ;RETURN WITH RDOS ERROR  .DUSR .ERRP = 51 ;RETURN WITH PCODE ERROR .DUSR NEXT@ = JMP @IP ;OBEY NEXT PCODE INSTRUCTION .DUSR PUSH = ISZ SP .DUSR POP = DSZ SP .MACRO LTOP1 LDA ^1,@SP % .MACRO STOP1 STA ^1,@SP % .MACRO PUSH1 PUSH STOP1 ^1 % .MACRO POP1 LTOP1 ^1 POP % .MACRO .PUND JMP @.+1 PUNDF % .DUSR ERR.2 = JLSR @.ERR2 .DUSR ERR.P = JSR @.ERRP .DUSR ANS = 0 ;OFFSET FOR FUNCTION VALUE .DUSR SL = 2 ; STATIC LINK .DUSR DL = 3 ; DYNAMIC LINK .DUSR MTS = 4 ;MAX TOP OF STACK .DUSR RA = 5 ; RETURN ADDRESS .DUSR MSL = 6 ;MARK STACK LENGTH .DUSR FCH = -1 ;FILE CHANNEL OFFSET .DUSR FST = -2 ;FILE STATUS OFFSET ;INTERPRETER ERROR CODES .DUSR PEROP = 400 ; UNDEFINED OP. CODE OR S.P. CODE .DUSR PERSO = 401 ; STORE OVERFLOW .DUSR PERGE = 402 ; EOF SET FOR GET .DUSR PERRE = 403 ; REf AD ERROR .DUSR PERPE = 404 ; PUT ERROR .DUSR PERIW = 405 ;INTEGER FIELD WIDTH .DUSR PERFP = 406 ; OV UN FLAGS RFPI .DUSR PERTR = 407 ; TRUNCATE OV ERROR .DUSR PERCJ = 410 ;CASE ERROR .. UJC .DUSR PERRB = 411 ; ASCII BUFFERRING ERROR .DUSR PERX9hP = 412 ;ILLEGAL EXTERNAL PROCEDURE CALL .DUSR PERCK = 413 ; CHK ERROR .DUSR PERHO = 414 ; HEAP OVERFLOW .DUSR PERFW = 415 ; FIELD WIDTH ERROR .DUSR PERFI = 416 ;FPI ERROR .DUSR PERFO = 417 ;FPI I/O ERROR .END EXAMPLES.CMraROMAN,LIFE,GRAPH,PRIMES,RGCD^ P4COMPILE3.NN~s IF FTYPE <> NIL THEN WITH FTYPE^ DO BEGIN GEN2(51(*LDC*),1,IDTYPE^.SIZE-1); GEN2(50(*LDA*),LEVEL-VLEV,VADDR); GEN1(30(*CSP*),11(*OPN*)); ENDUT; LOCFP := NEXTFILE END; END; (* OF OPENFILES*) PROCEDURE CLOSEFILES(LOCFP: EXTFILEP); BEGIN WHILE LOCFP <> NIL DO WITH LOCFP^ DO BEGIN IF FTYPE <> NIL THEN  WITH FTYPE^ DO GEN2(50(*LDA*),LEVEL-VLEV,VADDR); GEN1(30(*CSP*),24(*CLS*));  LOCFP := NEXTFILE END END; (* OF CLOSEFILES*) PROCEDURE STATEMENT(FSYS: SETOFSYS); LABEL 1; VAR LCP: CTP; LLP: LBP; PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD; PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP); VAR LATTR: ATTR; LCP: CTP; LSIZE,LMIN,LMAX: INTEGER; BEGIN WITH FCP^, GATTR DO BEGIN TYPTR := IDTYPE; KIND := VARBL; CASE KLASS OF VARS:  IF VKIND = ACTUAL THEN BEGIN ACCESS := DRCT; VLEVEL := VLEV; DPLMT := VADDR END  ELSE BEGIN GEN2T(54(*LOD*),LEVEL-VLEV,VADDR,NILPTR); ACCESS := INDRCT; IDPLMT := 0 END; FIELD: WITH DISPLAY[DISX] DO IF OCCUR = CREC THEN mJ BEGIN ACCESS := DRCT; VLEVEL := CLEV;  DPLMT := CDSPL + FLDADDR END ELSE BEGIN IF LEVEL = 1 THEN GEN1T(39(*LOD*),VDSPL,NILPVTR) ELSE GEN2T(54(*LOD*),0,VDSPL,NILPTR); ACCESS := INDRCT; IDPLMT := FLDADDR END; FUNC: IF PFDECKIND = STANDARD THEN BEGIN ERROR(15D0); TYPTR := NIL END ELSE BEGIN  IF PFKIND = FORMAL THEN ERROR(151) ELSE IF (PFLEV+1<>LEVEL)OR(FPROCP<>FCP) THEN ERROR(177); BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1; DPLMT := 0 (*IMPL. RELAT. ADDR. OF FCT. RESULT*) END END END (*CASE*) END (*WITH*); IF NOT (SY IN SELECTSYSm + FSYS) THEN BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END; WHILE SY IN SELECTSYS DO BEGIN (*[*) IF SY = LBRACK THEN BEGIN REPEAT LATTR := GATTR; WITH LATTR DO IF TYPTR <> NIL THEN IF TYPTR^.FORM <> ARRAYS THEN BEGIN ERROR(138); TYPTR := NIL END; LOADADDRESS; INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK])M; LOAD;  IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM<>SCALAR THEN ERROR(113) ELSE IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),0GATTR.TYPTR); IF LATTR.TYPTR <> NIL THEN WITH LATTR.TYPTR^ DO BEGIN IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN BEGIN U IF INXTYPE <> NIL THEN  BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); IF DEBUG THEN GEN2T(45(*CHK*),LMIN,LMAX,INTPTR); IF LMIN>0 THEN GEN1T(31(*DEC*),LMIN,INTPTR) ELSE IF LMIN<0 THEN GEN1T(34(*INC*),-LMIN,INTPTR); (*OR SIMPLY GEN1(31,LMIN)*) END 3  END ELSE ERROR(139); WITH GATTR DO BEGIN TYPTR := AELTYPE; KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0  END; IF GATTR.TYPTR <> NIL THEN BEGIN LSIZE := GATTR.TYPTR^.SIZE; IF COMPTYPES(GATTR.TYPTR,CHARPTR) THEN LSIZE :=CHARSIZE   ELSE ALIGN(GATTR.TYPTR,LSIZE); GEN1(36(*IXA*),LSIZE) END END UNTIL SY <> COMMA; IF SY = RBRACK THEN INSYMBOL ELSE ERdROR(12) END (*IF SY = LBRACK*) ELSE (*.*) IF SY = PERIOD THEN BEGIN WITH GATTR DO BEGIN IF TYPTR <> NIL THEN  IF TYPTR^.FORM <> RECORDS THEN BEGIN ERROR(140); TYPTR := NIL END; INSYMBOL; IF SY = IDENT THEN BEGIN IF TYPTR <> NIL THE&N BEGIN SEARCHSECTION(TYPTR^.FSTFLD,LCP); IF LCP = NIL THEN BEGIN ERROR(152); TYPTR := NIL END ELSE   WITH LCP^ DO BEGIN TYPTR := IDTYPE; CASE ACCESS OF DRCT: DPLMT := DPLMT + FLDADDR; INDRCT: IDPLMT := IDPLMT + FLDADDR; INXD: ERROR(400) END END END; INSYMBOL o END (*SY = IDENT*) ELSE ERROR(2) END (*WITH GATTR*) END (*IF SY = PERIOD*) ELSE (*^*) BEGIN IF GATTR.TYPTR <> NIL THEN F WITH GATTR,TYPTR^ DO IF FORM = POINTER THEN BEGIN LOAD; TYPTR := ELTYPE; IF DEBUG THEN GEN2T(45(*CHK*),1,MAXADDR,NILPTR);  WITH GATTR DO  BEGIN KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0 END END ELSE IF FORM = FILES THEN TYPTR := FILTYPE ELSE ERROR(141); INSYMBOL END; IF NOT (SY IN FSYS + SELECTSYS) THEN BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END END (*WHILE*) END (*SELE'CTOR*) ; PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP); VAR LKEY: 1..15; PROCEDURE VARIABLE(FSYS: SETOFSYS); VAR LCP: CTP; BEGIN IF SY = IDENT THEN BEGIN SEARCHID([VARS,FIELD],LCP); IBNSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FSYS,LCP) END (*VARIABLE*) ; PROCEDURE GETPUTRESETREWRITE; BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS; IF GATTR.TYPTR <> NIL;~ THEN IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(116); IF LKEY <= 2 THEN GEN1(30(*CSP*),LKEY(*GET,PUT*)) ELSE GEN1(30(*CSP*),LKEY+26(*RESET,REWRITE*)) END (*GETPUTRESETREWRITE*) ; PROCEDURE FILEDEFAULTm(FNAME : ALPHA; ERRNO:INTEGER; VAR LLEV,LADDR:INTEGER); BEGIN SAVEID := ID; ID := FNAME; SEARCHID([VARS],LLCP); IF LLCP^.IDTYPE <> NIL THEN LADDR := LLCP^.VADDR ELSE BEGIN PERROR(ERRNO); LADDR := 0 END; LLEV := 1; ID := SAVEID END; PROCEDURE READ; VAR LCP:CTP; LLEV:LEVRANGE; LADDR:ADDRRANGE; LSP : STP; BEGIN IF SY = LPARENT THEN BEGDŽIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]); LSP := GATTR.TYPTR; TEST := FALSE; IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN WITH GATTR, LSP^ DO BEGIN c IF FILTYPE = CHARPTR THEN BEGIN LLEV := VLEVEL; LADDR := DPLMT; IF ACCESS = INDRCT THEN ERROR(399) END ELSE ERROR(399); IF DSY = RPARENT THEN BEGIN IF LKEY = 8 THEN ERROR(116); TEST := TRUE END ELSE  IF SY <> COMMA THEN BEGIN ERROR(116); SKIP(FSYSj + [COMMA,RPARENT]) END; IF SY = COMMA THEN BEGIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]) END ELSE TEST := TRUE END ELSE FILEDEFAULT(NA[3],175,LLEV,LADEDR); IF NOT TEST THEN REPEAT LOADADDRESS; GEN2(50(*LDA*),LEVEL-LLEV,LADDR); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= SUBRANGE THEN IF COMPTYPES(INTPTR,GATTR.TYPT0.R) THEN GEN1(30(*CSP*),3(*RDI*)) ELSE IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN GEN1(30(*CSP*),4(*RDR*)) ELSE IF COMPTYPES(CHARPTR,GATTR.WTYPTR) THEN GEN1(30(*CSP*),5(*RDC*)) ELSE ERROR(399) ELSE ERROR(116);  TEST := SY <> COMMA; IF NOT TEST THEN BEGIN INSYMBOL; VARIABLE(FSYS + [COMMA,RPARENT]) END UNTIL TEST; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE IF LKEY = 5 THEN ERROR(116) ELSE FILEDEFAULT(NA[3],175,LLEV,LADDR); IF LKEY = 11 THEN BEGIN GEN2(50(*LDA*),LEVEL - LLEV, LADDR); GEN1(30(*CSP*),21(*RLN*)) END  END (*READ*) ; PROCEDURE WRITE; VAR LSP: STP; DEFAULT : BOOLEAN; LLKEY: 1..15; LCP:CTjP; LLEV:LEVRANGE; LADDR,LEN:ADDRRANGE; BEGIN LLKEY := LKEY; IF SY = LPARENT THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]); LSP := GATTR.TYPTR; TEST := FALSE; IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN WITH GATTR, LSP^ DO BEGIN  IF FILTYPE = CHARPTR THEN BEGIN LLEV := VLEVEL; LADDR := DPLMT;  IF ACCESS = INDRCT THEN ERROR(399) END ELSE ERROR(399); IF SY = RPARENT THEN BEGIN IF LLKEY = 10 THEN ERROR(116); TEST := TRUE h END ELSE IF SY <> COMMA THEN BEGIN ERROR(116); SKIP(FSYS+[COMMA,RPARENT]) END; IF SY = COMMA THEN BEGIN INSYMBOL; EXPRESSION(FSYS+[COMMA,COLON,RPARENT]) END ELSE TEST := TRUE END ELSE FILEDEFAULT(NA[4],176,LLEV,LADDR); IF NOT TEST THEN REPEAT LSP := GATTR.TYPTR; IF LSP <> NIL THEN &b IF LSP^.FORM <= SUBRANGE THEN LOAD ELSE LOADADDRESS; IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INHTPTR THEN ERROR(116); LOAD; DEFAULT := FALSE END ELSE DEFAULT := TRUE; IF SY = COLON THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> &NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(116);  IF LSP <> REALPTR THEN ERROR(124); LOAD; ERROR(399); END ELSE IF LSP = INTPTR THEN BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,10); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),6(*WRI*)) END ELSE IF LSP = REALPTR THEN BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,20); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),8(*WRR*)) END ELSE IF LSP = CHARPTR THEN BEGIN IF D#vEFAULT THEN GEN2(51(*LDC*),1,1); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),9(*WRC*)) END ELSE IF LSP <> NIL THEN KBEGIN IF LSP^.FORM = SCALAR THEN ERROR(399) ELSE IF STRING(LSP) THEN BEGIN LEN := LSP^.SIZE DIV CHARMAX; IF DEFAULT THEN GEN2(51(*LDC*),1,LEN); GEN2(51(*LDC*),1,LEN); GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),10(*WRS*)) v END  ELSE ERROR(116) END; TEST := SY <> COMMA; IF NOT TEST THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]) END8 UNTIL TEST; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END ELSE IF LKEY = 6 THEN ERROR(116) ELSE FILEDEFAULT(NA[4],176,LLEV,LADDR); IF LLKEY = 12 THEN (*WRITELN*)  BEGIN GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),22(*WLN*)) END END (*WRITE*) ; PROCEDURE PACK; VAR LSP,LSP1: STP; BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT]); *R LSP := NIL; LSP1 := NIL; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN LSP := INXTYPE; LSP1 := AELTYPE END ELSE ERROR(116); IF SY e= COMMA THEN INSYMBOL ELSE ERROR(20); EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116) ELSE IF NOT COMPTYPES(LSP,GATTR.TYPTR) T˿HEN ERROR(116); IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); VARIABLE(FSYS + [RPARENT]); IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN V  IF NOT COMPTYPES(AELTYPE,LSP1) OR NOT COMPTYPES(INXTYPE,LSP) THEN ERROR(116) END ELSE ERROR(116) END (*PACK*) ; PROCEDURE UNPACK; VAR LSP,LSP1: STP; BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT]); LSP := NIL; LSP1 := NIL; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN LSP := INXTYPE; LSP1 := AELTYPE END ELSE ERROR(116); IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); VARIABLE(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = ARRAYS THEN BEGIN IF NOT COMPTYPES(AELTYPE,LSP1) OR NOT COMPTYPES(INXTYPE,LSP) THEN ERROR(116) END ELSE ERROR(116);  IFL SY = COMMA THEN INSYMBOL ELSE ERROR(20); EXPRESSION(FSYS + [RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116) ELSE IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEON ERROR(116); END (*UNPACK*) ; PROCEDURE NEW; LABEL 1; VAR LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER; LSIZE,LSZ: ADDRRANGE; LVAL: VALU; BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESSd; LSP := NIL; VARTS := 0; LSIZE := 0; IF GATTR.TYPTR <> NIL THEN WITH GATTR.TYPTR^ DO IF FORM = POINTER THEN BEGIN IF ELTYPE <> NIL THEN BEGIN LSIZE := ELTYPE^.SIZE; IF ELTYPE^.FORM = RECORDS THEN LSP := ELTYPE^.RECVAR END END ELSE ERROR(116); WHILE SY = COMMA DO  BEGIN INSYMBOL;CONSTANT(FSYS + [COMMA,RPARENT],LSP1,LVAL); VARTS := VARTS + 1; (*CHECK TO INSERT HERE: IS CONSTANT IN TAGFIELDTYPE RANGE*) IF LSP = NIL THEN ERROR(158) ELSE IF LSP^.FORM <> TAGFLD THEN EۢRROR(162) ELSE IF LSP^.TAGFIELDP <> NIL THEN IF STRING(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159) ELSE IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1) THEN [ BEGIN LSP1 := LSP^.FSTVAR; WHILE LSP1 <> NIL DO WITH LSP1^ DO IF VARVAL.IVAL = LVAL.IVAL THEN KL BEGIN LSIZE := SIZE; LSP := SUBVAR; GOTO 1 END ELSE LSP1 := NXTVAR;  LSIZE := LSP^.SIZE; LSP := NIL; kO END ELSE ERROR(116); 1: END (*WHILE*) ; GEN2(51(*LDC*),1,LSIZE); GEN1(30(*CSP*),12(*NEW*)); END (*NEW*) ; PROCEDURE MARK; BEGIN VARIABLE(FSYS+[RPARENT]ǎ); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = POINTER THEN BEGIN LOADADDRESS; GEN1(30(*CSP*),23(*SAV*)) END ELSE ERROR(125) END(*MARK*); PROCEDURE RELEASE; BE$GIN VARIABLE(FSYS+[RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = POINTER THEN BEGIN LOAD; GEN1(30(*CSP*),13(*RST*)) END ELSE ERROR(125) END (*RELEASE*); $ PROCEDURE PUTGETRANDOM; VAR LLEV,LADDR : INTEGER; BEGIN VARIABLE(FSYS+[COMMA]); IF GATTR.TYPTR <> NIL THEN  WITH GATTR, GATTR.TYPTR^ DO IF FORM <> FILES THEN ERROR(1016) ELSE BEGIN LLEV := VLEVEL; LADDR := DPLMT; IF NOT RANDOMFILE THEN ERROR(116); IF ACCESS = INDRCT THEN ERROR(399); IF SY <> COMMA THEN ERROR(116) ELSE INSYMBOL; {e EXPRESSION(FSYS+[RPARENT]); LOAD; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(116);  GEN2(50(*LDA*),LEVEL-LLEV,LADDR); GEN1(30(*CSP*),LKEY+11(*WDR,RRR*)q) END END (*OF PUTGETRANDOM*); PROCEDURE HALT; BEGIN EXPRESSION(FSYS+[RPARENT]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN BEGIN LOAD; GEN0(62(*HLT*66)) END ELSE ERROR(116) END; (*OF HALT*) PROCEDURE ABS; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*)) ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END END (*ABS*) ; PROCEDURE SQR; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQIft*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*)) ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END END (*SQR*) ; PROCEDURE TRUNC; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> REALPTR THEN ERROR(125); IF LKEY=12 THEN GEN1(30(*CSP*),31(*RND*)) ELSE GEN0(27(*TRC*)); GATTR.TYPTR := INTPTR END (*TRUNC*) ; PROCEDURE ODD; BEGIN IF GATTR".TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(125); GEN0(20(*ODD*)); GATTR.TYPTR := BOOLPTR END (*ODD*) ; PROCEDURE ORD; BEGIN IF GATTR.TYPTR <> NIL THEN i: IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125); GEN0T(58(*ORD*),GATTR.TYPTR); GATTR.TYPTR := INTPTR END (*ORD*) ; PROCEDURE CHR; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> INTPTR THEN ERROR(125); GEN0(59(*CHR*)); GATTR.TYPTR := CHARPTR END (*CHR*) ; PROCEDURE PREDSUCC; BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN %ERROR(125); IF LKEY = 7 THEN GEN1T(31(*DEC*),1,GATTR.TYPTR) ELSE GEN1T(34(*INC*),1,GATTR.TYPTR) END (*PREDSUCC*) ; PROCEDURE EOF; VAR LLEV,LADDR : INTEGER; BEGIN IF SY = LPARENT THEN BEGIN INSYMBOL; VARIABLE(FSYS + [RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125) y ELSE IF (GATTR.TYPTR^.RANDOMFILE AND NOT (LKEY = 9)) THEN ERROR(116); LOADADDRESS END ELSE WITH GATTR DO BEGIN  IF LKEY = 9 THEN ERROR(116) ELSE FILEDEFAULT(NA[3],175,LLEV,LADDR); GEN2(50(*LDA*),LEVEL-LLEV,LADDR) END; IF LKEY = 9 THEN GEN1(30(*CSP*),28(*EOR*)) ELSE IF LKEY = 10 THEN GEN0(8(*EOF*)) ELSE GEN1(30(*CSP*),14(*ELN*)); GATTR.TYPTR := BOOLPTR END (*EOF*) ; PROCEDURE PAGE; VAR LLEV,LADDR : INTEGER; BEGIN IF SY = LPARENT THEN BEGIN  INSYMBOL; VARIABLE(FSYS+[RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = FILES THEN LOADADDRESS ELSE ERROR(116g) END ELSE BEGIN FILEDEFAULT(NA[4],176,LLEV,LADDR); GEN2(50(*LDA*),LEVEL-LLEV,LADDR) END; GEN1(30(*CSP*),27(*PAG*)) END (*PAGE*); PROCEDURE CALLNONSTA.VNDARD; VAR NXT,LCP: CTP; LSP: STP; LKIND: IDKIND; LB: BOOLEAN; LOCPAR, LLC: ADDRRANGE; BEGIN LOCPAR := 0; WITH FCP^ DO BEGIN NXT := NEXT; LKIND := PFKIND; IF NOT EXTERN THEN GEN1(41(*MST*),LEVEL-PFLEV) END; IF SY = LPARENT THEN BEGIN LLC := LC; REPEAT LB := FALSE; (*DECIDE WHETHER PROC/FUNC MUST BE PASSED*) IF LKIND = ACTUAL THEN BEGIN  IF NXT = NIL THEN ERROR(126)  ELSE LB := NXT^.KLASS IN [PROC,FUNC] END ELSE ERROR(399); (*FOR FORMAL PROC/FUNC LB IS FALSE AND EXPRESSION WILL BE CALLED, WHICH WILL ALLWAYS INTERPRET A PROC/FUNC ID AT ITS BEGINNING AS A CALL RATHER THAN A PARAMETER PASSING. IN THIS IMPLEMENTATION, PARAMETER PROCEDURES/FUNCTIONS ARE THEREFORE NOT ALLOWED TO HAVE PROCEDURE/F0UNCTION PARAMETERS*)  INSYMBOL; IF LB THEN (*PASS FUNCTION OR PROCEDURE*) BEGIN ERROR(399); IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FS=YS + [COMMA,RPARENT]) END ELSE BEGIN IF NXT^.KLASS = PROC THEN SEARCHID([PROC],LCP) ELSE BEGIN SEARCHID([FUNC],LCP);  IF NOT COMPTYPES(LCP^.IDTYPE,NXT^.IDTYPE) THEN ERROR(128) END; INSYMBOL; IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN xF BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END END END (*IF LB*) ELSE BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]); IF GATTR.TYPTR <> NIL; THEN  IF LKIND = ACTUAL THEN BEGIN IF NXT <> NIL THEN BEGIN LSP := NXT^.IDTYPE; IF LSP <> NIL THEN  BEGIN IF (NXT^.VKIND = ACTUAL) THEN IF LSP^.FORM <= POWER THEN BEGIN LOAD; IF DEBUG THEN CHECKBNDS(LSP); IF COMPTYPES(REALPTR,LSP) AND (GATTR.TYPTR = INTPTR) THEN BEGIN GEN0(10(*FLT*)); ̗ GATTR.TYPTR := REALPTR END; LOCPAR := LOCPAR+LSP^.SIZE; ALIGN(PARMPTR,LOCPAR); END 6E ELSE BEGIN LOADADDRESS; LOCPAR := LOCPAR+PTRSIZE; ALIGN(PARMP]#TR,LOCPAR) END ELSE IF GATTR.KIND = VARBL THEN BEGIN LOADADDRESS;  . LOCPAR := LOCPAR+PARMSIZE END ELSE ERROR(154); IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(142)  END END END ELSE (*LKIND = FORMAL*) BEGIN (*PASS FORMAL PARAM*) END  END;  IF (LKIND = ACTUAL) AND (NXT <> NIL) THEN NXT := NXT^.NEXT UNTIL SY <> COMMA; LC := LLC; IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END (*IF LPARENT*); IF LKIND = ACTUAL THEN K BEGIN IF NXT <> NIL THEN ERROR(126); WITH FCP^ DO BEGIN IF EXTDEC THEN GENCUPENT(61(*CXP*),LOCPAR,PFNAME) ELSE IF EXTERN THEN GEN1(30(*CSP*),PFNAME) Ȗ ELSE GENCUPENT(46(*CUP*),LOCPAR,PFNAME); END END; GATTR.TYPTR := FCP^.IDTYPE END (*CALLNONSTANDARD*) ; BEGIN (*CALL*) IF FCP^.PFDECKIND = STANDARD THEN BEGIN LKEY := FCP^.KEY; IF FCP^.KLASS = PROC THEN BEGIN IF NOT(LKEY IN [5,6,11,12,16]) THEN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);  CASE LKEY OF 1,2, 2 3,4: GETPUTRESETREWRITE; 5,11: READ; 6,12: WRITE; 7: PACK; 8: UNPACK; 9: NEW; 10: RELEASE; 13: MARK; t 14,15: PUTGETRANDOM; 16: PAGE; 17: HALT END; IF NOT(LKEY IN [5,6,11,12,16]) THEN IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END { ELSE BEGIN IF (LKEY <= 8) OR (LKEY >= 12) THEN BEGIN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9); EXPRESSION(FSYS+[RPARENT]); LOAD  END; CASE LKEY OF 1: ABS; 2: SQR; 3,12: TRUNC; 4: ODD;  5: ORD; 6: CHR; 7,8i: PREDSUCC; 9,10,11 : EOF END; IF (LKEY <= 8) OR (LKEY >= 12) THEN IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END; END (*STANDARD PROCEDURES AND FUNCTIONS*) ELSE CALLNONSTANDARD END (*CALL*) ; PROCEDURE EXPRESSION; VAR LATTR: ATTR; LOP: OPERATOR; TYPIND: CHAR; LSIZE: ADDRRANGE; PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS); VAR LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN; PROCEDURE TERM(FSYS: SETOFSYS); VAR LATTR: ATTR; LOP: OPERATOR; PROCEDURE FACTOR(FSYS: SETOFSYS); VAR LCP: CTP; LVP: CSP; VARPART: BOOLEAN; CSTPARTR: SET OF 0..58; LSP: STP; BEGIN IF NOT (SY IN FACBEGSYS) THEN BEGIN ERROR(58); SKIP(FSYS + FACBEGSYS);  GATTR.TYPTR := NIL END; WHILE SY IN FACBEGSYS DO  BEGIN CASE SY OF (*ID*) IDENT: BEGIN SEARCHID([KONST,VARS,FIELD,FUNC],LCP); INSYMBOL; IF LCP^.KLASS = FUNC THEN d BEGIN CALL(FSYS,LCP); WITH GATTR DO BEGIN KIND := EXPR;  IF TYPTR <> NIL THEN IF TYPTR^.FORM=SUBRANGE THEN ; TYPTR := TYPTR^.RANGETYPE END END ELSE IF LCP^.KLASS = KONST THEN WITH GATTR, L CP^ DO BEGIN TYPTR := IDTYPE; KIND := CST; CVAL := VALUES  END ELSE BEGIN SELECTOR(FSYS,LCP); 27 IF GATTR.TYPTR<>NIL THEN(*ELIM.SUBR.TYPES TO*) WITH GATTR,TYPTR^ DO(*SIMPLIFY LATER TESTS*) IF FORM = SUBRANGE THEN TYPTR := RANGETYPE END END; (*CST*) INTCONST:  BEGIN WITH GATTR DO BEGIN TYPTR := INTPTR; KIND := CST;  CVAL := VAL END; INSYMBOL END; REALCONST: BEGIN WITH GATTR DO  BEGIN TYPTR := REALPTR; KIND := CST; CVAL := VAL END; INSYMBOL END; STRINGCONST: BEGIN  WITH GATTR DO BEGIN IF LGTH = 1 THEN TYPTR := CHARPTR ELSE BEGIN NEW(LSP,ARRAYS); WITH LSPd^ DO BEGIN AELTYPE := CHARPTR; FORM:=ARRAYS;  INXTYPE := NIL; SIZE := LGTH*CHARSIZE END; TYPTR := LSP Q END; KIND := CST; CVAL := VAL END; INSYMBOL END; (*(*) LPARENT: BEGIN INSYMBOL; EXPREkSSION(FSYS + [RPARENT]); IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4) END; (*NOT*) NOTSY: BEGIN INSYMBOL; FACTOR(FSYS); LOAD; GEN0(19(*NOT*))a; IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR <> BOOLPTR THEN BEGIN ERROR(135); GATTR.TYPTR := NIL END; END; (*[*) LBRACK:  BEGIN INSYMBOL; CSTPART := [ ]; VARPART := FALSE;  NEW(LSP,POWER); WITH LSP^ DO BEGIN ELSET:=NIL;SIZE:=SETSIZE;FORM:=POWER END; IF SY = εRBRACK THEN BEGIN WITH GATTR DO BEGIN TYPTR := LSP; KIND := CST END; INSYMBOL END ;ELSE BEGIN  REPEAT EXPRESSION(FSYS + [COMMA,RBRACK]); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN  BEGIN ERROR(136); GATTR.TYPTR := NIL END ELSE IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN BEGIN  IF GATTR.KIND = CST THEN  IF (GATTR.CVAL.IVAL < SETLOW) OR (GATTR.CVAL.IVAL > SETHIGH) THEN ERROR(304) 8> ELSE CSTPART := CSTPART+[GATTR.CVAL.IVAL] ELSE BEGIN LOAD; IF cNOT COMPTYPES(GATTR.TYPTR,INTPTR)  THEN GEN0T(58(*ORD*),GATTR.TYPTR); GEN0(23(*SGS*)); IF VARPART THEN GEN0(28(*UNI*))  ELSE VARPART := TRUE END; LSP^.ELSET := GATTR.TYPTR; GATTR.TYPTR := LSP g END  ELSE ERROR(137); TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IFk SY = RBRACK THEN INSYMBOL ELSE ERROR(12) END; IF VARPART THEN BEGIN IF CSTPART <> [ ] THEN BEGIN NEW(LVP,PSET);: LVP^.PVAL := CSTPART; LVP^.CCLASS := PSET; IF CSTPTRIX = CSTOCCMAX THEN ERROR(254) ELSE BEGIN CSTPTRIX := CSTPTRIX + 1; CSTPTR[CSTPTRIX] := LVP; GEN2(51(*LDC*),5,CSTPTRIX); GEN0(28(*UNI*)); GATTR.KIND := EXPR END 9K  END END ELSE BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART; LVP^.CCLASS := PSET; GATTR.CVAL.VALP := LVP END END END (*CASE*) ; IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END END (*WHILE*)  ˞ END (*FACTOR*) ; BEGIN (*TERM*) FACTOR(FSYS + [MULOP]); WHILE SY = MULOP DO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; FACTOR(FSYS + [MULOP]); LOAD;  IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (***) MUL: IF (LATTR.TYPTR=INTPTR)AND(GATTR.TYPTR=INTPTR) THEN GEN0(15(*MPI*))  ELSE  BEGIN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END 2 ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR  END; Z IF (LATTR.TYPTR = REALPTR) AND(GATTR.TYPTR=REALPTR)THEN GEN0(16(*MPR*)) ELSE IF(LATTR.TYPTR^.FORM=POWER) s AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)THEN GEN0(12(*INT*)) ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END END; (*/*) RDIV: BEGIN 8 IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF LATTR.TYPTR = INTP^TR THEN BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END; IF (LATTR.TYPTR = REALPTR) AND (GATTR.iTYPTR=REALPTR)THEN GEN0(7(*DVR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; (*DIV*) IDIV: IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END; (*MOD*) IMOD: IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) THEN GEN0(14(*MOD*)) pT ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END; (*AND*) ANDOP:IF (LATTR.TYPTR = BOOLPTR) AND (GATTR.TYPTR = BOOLPTR) THEN GEN0(4(*AND*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END.A END (*CASE*) ELSE GATTR.TYPTR := NIL END (*WHILE*) END (*TERM*) ; BEGIN (*SIMPLEEXPRESSION*)  SIGNED := FALSE; IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THErN BEGIN SIGNED := OP = MINUS; INSYMBOL END; TERM(FSYS + [ADDOP]); IF SIGNED THEN BEGIN LOAD; IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*)) ELSE IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; WHILE SY = ADDOP DO BEGIN LOAD; LATTR := GATTR; LOP := OP; INSYMBOL; TERM(FSYS + [ADDOP]); LOAD;i IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN CASE LOP OF (*+*) PLUS: IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN GEN0(2(*ADI*))  T ELSE BEGIN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*));  LATTR.TYPTR := REALPTR END  ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN GEN0(3(*ADR*)) ELSE IF(LATTR.TYPTR^.FORM=POWER)  AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN GEN0t(28(*UNI*)) ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END END; (*-*) MINUS: IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN GEN0(21(*SAsBI*)) ELSE BEGIN IF LATTR.TYPTR = INTPTR THEN  BEGIN GEN0(9(*FLO*)); LATTR.TYPTR := REALPTR END ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR P4COMPILE4.NN END; IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN GEN0(22(*SBR*)) ELSE IF (LATTR.TYPTR^.FORM = POWER)  AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN GEN0(5(*DIF*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END; (*OR*) OROP: S IF(LATTR.TYPTR=BOOLPTR)AND(GATTR.TYPTR=BOOLPTR)THEN GEN0(13(*IOR*)) ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END END (*CASE*) ELSE GATTR.TYPTR := NIL R END (*WHILE*) END (*SIMPLEEXPRESSION*) ; BEGIN (*EXPRESSION*) SIMPLEEXPRESSION(FSYS + [RELOP]); IF SY = RELOP THEN BEGIN IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= PiOWER THEN LOAD ELSE LOADADDRESS; LATTR := GATTR; LOP := OP; IF LOP = INOP THEN  IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),GATTR.TYPTR); INSYMBOL; SIMPLEEXPRESSION(FSYS); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= POWER THEN LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN IF LOP = INOP THEN Z IF GATTR.TYPTR^.FORM = POWER THEN IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET) THEN  GEN0(11(*INN*)) ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END ELSE BEGIN ERR OR(130); GATTR.TYPTR := NIL END ELSE BEGIN IF LATTR.TYPTR <> GATTR.TYPTR THEN IF LATTR.TYPTR = INTPTR THEN BEGIN GEN0(9(*FLO*)); LPATTR.TYPTR := REALPTR END ELSE IF GATTR.TYPTR = INTPTR THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR .END; IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LSIZE := LATTR.TYPTR^.SIZE; CASE LATTR.TYPTR^.FORM OF SCALAR: IF LATTR.TYPTR = REALPTR THEN TYPIND := 'R' ELSE IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 'B' ELSE IF LATTR.TYPTR = CHARPTR THEN TYPIND := 'C' 1 ELSE TYPIND := 'I'; POINTER: BEGIN IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 'A' Q END; POWER: BEGIN IF LOP IN [LTOP,GTOP] THEN ERROR(132); TYPIND := 'S' END; ARRAYS: BEGIN 8 IF NOT STRING(LATTR.TYPTR) AND(LOP IN[LTOP,LEOP,GTOP,GEOP])THEN ERROR(131); TYPIND := 'M' END; RECORDS:  BEGIN IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131); TYPIND := 'M' END; FILES: BEGIN ERROR(133); TYPIND := 'F' END END; CASE LOP OF LTOP: GEN2(53(*LES*),ORD(TYPIND),LSIZE); LEOP: GEN2(52(*LEQ*),ORD(TYPIND),LSIZE); GTOP: GE?wN2(49(*GRT*),ORD(TYPIND),LSIZE); GEOP: GEN2(48(*GEQ*),ORD(TYPIND),LSIZE); NEOP: GEN2(55(*NEQ*),ORD(TYPIND),LSIZE); EQOP: GEN2(47(*EQU*),ORD(TYPIND),LSIZE) e END END ELSE ERROR(129) END; GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR END (*SY = RELOP*) END (*EXPRESSION*) ; PROCEDURE ASSIGNMENT(FCP: CTP);  VAR LATTR: ATTR; BEGIN SELECTOR(FSYS + [BECOMES],FCP); IF SY = BECOMES THEN BEGIN IF GATTR.TYPTR <> NIL THEN IF (GATTR.ACCESS<>DRCT) OR (GATTR.TYPTR^.FORM>POWER) THEN LOADADDRE}SS; LATTR := GATTR; INSYMBOL; EXPRESSION(FSYS); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM <= POWER THEN LOAD ELSE LOADADDRESS; IF (LATTR.TYPTR <> NIL) AND (GATTR.mTYPTR <> NIL) THEN BEGIN  IF COMPTYPES(REALPTR,LATTR.TYPTR)AND(GATTR.TYPTR=INTPTR)THEN BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END; IF CO3MPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN CASE LATTR.TYPTR^.FORM OF SCALAR, SUBRANGE: BEGIN IF DEBUG THEN CHECKBNDS(LATTR.TYPTR); ? STORE(LATTR)  END; POINTER: BEGIN IF DEBUG THEN GEN2T(45(*CHK*),0,MAXADDR,NILPTR); STORE(LATTR)  END; POWER: STORE(LATTR); ARRAYS, RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE); FILES: ERROR(146) END ELSE ERROR(129)  END END (*SY = BECOMES*) ELSE ERROR(51) END (*ASSIGNMENT*) ; PROCEDURE GOTOSTATEMENT; VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE; BEGIN IF SY = INTCOENST THEN BEGIN FOUND := FALSE; TTOP1 := TOP; WHILE DISPLAY[TTOP1].OCCUR <> BLCK DO TTOP1 := TTOP1 - 1; TTOP := TTOP1; REPEAT WHILE DISPLAY[TTOP].OCCUR <> BLCK DO KTTOP := TTOP - 1; LLP := DISPLAY[TTOP].FLABEL; WHILE (LLP <> NIL) AND NOT FOUND DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN FOUND := TRUE; w IF TTOP = TTOP1 THEN GENUJPXJP(57(*UJP*),LABNAME) ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(399) END ELSE LLP := NEXTLAB; TTOP := TTOP - 1   UNTIL FOUND OR (TTOP = 0); IF NOT FOUND THEN ERROR(167); INSYMBOL END ELSE ERROR(15) END (*GOTOSTATEMENT*) ; PROCEDURE COMPOUNDSTATEMENT; BEGIN REPEAT U REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)  END (*COMPOUNDSTATEMENET*) ; PROCEDURE IFSTATEMENT; VAR LCIX1,LCIX2: INTEGER; BEGIN EXPRESSION(FSYS + [THENSY]); GENLABEL(LCIX1); GENFJP(LCIX1); IF SY = THENSY THEN INSYMBOL ELSE ERROR(52); STATEMENT(FSYS + [ELSESY]); IF SY = ELSESY THEN BEGIN GENLABEL(LCIX2); GENUJPXJP(57(*UJP*),LCIX2); PUTLABEL(LCIX1); INSYMBOL; STATEMENT(FSYS); PUTLABEL(LCIX2) END ELSE PUTLABEL(LCIX1)  END (*IFSTATEMENT*) ; PROCEDURE CASESTATEMENT; LABEL 1; TYPE CIP = ^CASEINFO; CASEINFO = PACKED RECORD NEXT: CIP; CSSTART: INTEGER;  CSLAB: INTEGER END; VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU; LADDR, LCIX, LCIX1, LMIN, LMAX: INTEGER; BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]); LOAD; LSP o%:= GATTR.TYPTR; IF LSP <> NIL THEN IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN BEGIN ERROR(144); LSP := NIL END ELSE IF NOT COMPTYPES(LSP,INTPTR) THEN GEN0T(58(*ORD*),LSP); (*BUG CORRECTION fHBY A.F. ON 11/11/76*) GENLABEL(LCIX); GENUJPXJP(57(*UJP*),LCIX); IF SY = OFSY THEN INSYMBOL ELSE ERROR(8); FSTPTR := NIL; GENLABEL(LADDR); REPEAT LPT3 := NIL; GENLABEL(LCIX1); IF NOT(SY IN [SEMICOLON,ENDSY]) THEN BEGIN REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL); IF LSP <> NIL THEN IF COMPTYPES(LSP,LSP1) THEN BEGIN LPT1 := FSTPTR; LPT2 := NIL; W 0HILE LPT1 <> NIL DO WITH LPT1^ DO BEGIN IF CSLAB <= LVAL.IVAL THEN BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156); GOTO 1 C END; LPT2 := LPT1; LPT1 := NEXT END; 1: NEW(LPT3); WITH LPT3^ DO BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL; 5 CSSTART := LCIX1 END; IF LPT2 = NIL THEN FSTPTR := LPT3 ELSE LPT2^.NEXT := LPT3 END ELSE ERROR(147); TEST := SY <> COMMA; IF NOT TREST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); PUTLABEL(LCIX1); REPEAT STATEMENT(FSYS + [SEMICOLON]) UNTIL NOT (SY IN STATBEGSYS); IF LPT3 <> NIL THEN .6 GENUJPXJP(57(*UJP*),LADDR); END; TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; PUTLABEL(LCIX); IF FSTPTR <> NIL THEN BEGIN LMAX := FSTPTR^.CSLAB;  (*REVERSE POINTERS*) LPT1 := FSTPTR; FSTPTR := NIL; REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR; FSTPTR := LPT1; LPT1 := LPT2 UNTIL LPT1 = NIL; LMIN := FSTPTR^.CSLAB; e} IF LMAX - LMIN < CIXMAX THEN BEGIN GEN2T(45(*CHK*),LMIN,LMAX,INTPTR); GEN2(51(*LDC*),1,LMIN); GEN0(21(*SBI*)); GENLABEL(LCIX); GENUJPXJP(44(*XJP*),LCIX); PUTLABEL(LCIX); n REPEAT WITH FSTPTR^ DO BEGIN WHILE CSLAB > LMIN DO BEGIN GEN0(60(*UJC ERROR*)); LMIN := LMIN+1 ENDG; GENUJPXJP(57(*UJP*),CSSTART); FSTPTR := NEXT; LMIN := LMIN + 1 END  UNTIL FSTPTR = NIL; PUTLABEL(LADDR) END ELSE ERROR(157) END; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13) END (*CASESTATEMENT*) ; PROCEDURE REPEATSTATEMENT; VAR LADDR: INTEGER; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR); REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]); IF SY IN STATBEGSYS THEN ERROR(14) UNTIL NOT(SY IN STATBEGSYS); WHILE SY = SEMICOLON DO BEGIN INSYMBOL; REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]); IF SY IN XSTATBEGSYS THEN ERROR(14) UNTIL NOT (SY IN STATBEGSYS); END; IF SY = UNTILSY THEN BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR) END ELSE ERROR(53) END (*REPEATSTATEMENT*) ; @e PROCEDURE WHILESTATEMENT; VAR LADDR, LCIX: INTEGER; BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);  EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX); IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(^lFSYS); GENUJPXJP(57(*IJP*),LADDR); PUTLABEL(LCIX) END (*WHILESTATEMENT*) ; PROCEDURE FORSTATEMENT; VAR LATTR: ATTR; LSP: STP; LSY: SYMBOL; LCIX, LADDR: INTEGER; LLC: ADDRRANGE; BEGIN LLC := LC; WITH LATTR DO BEGIN TYPTR := NIL; KIND := VARBL; ACCESS := DRCT; VLEVEL := LEVEL; DPLMT := 0 END; IF SY = IDENT THEN BEGIN SEARCHID([VARS],LCP); WITH LCP^, LATTR DO v BEGIN TYPTR := IDTYPE; KIND := VARBL; IF VKIND = ACTUAL THEN BEGIN ACCESS := DRCT; VLEVEL := VLEV; DPLMT := VADDR END ELSE BEGIN ERROR(155); A TYPTR := NIL END END; IF LATTR.TYPTR <> NIL THEN IF (LATTR.TYPTR^.FORM > SUBRANGE) OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN BEGIN ERROR(143); LATTR.TYPTR := NIL END;  INSYMBOL END ELSE BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY]) END; IF SY = BECOMES THEN BEGIN INSYMBOL; EXPRESSION(FSYS + [TOSY,DOWNTOSY,DOSY]); IF GATTR.TYPTR <> NIL \THEN IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)  ELSE IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LOAD; STORE(LATTR) END ELSE ERROR(145) END ELSE BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END; IF SY IN [TOSY,DOWNTOSY] THEN BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]); IF GATTR.TYPTR <> NIL THEN IF GATTR.JmTYPTR^.FORM <> SCALAR THEN ERROR(144) ELSE  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN BEGIN LOAD; IF NOT COMPTYPES(LATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),[1GATTR.TYPTR); ALIGN(INTPTR,LC); GEN2T(56(*STR*),0,LC,INTPTR); GENLABEL(LADDR); PUTLABEL(LADDR); GATTR := LATTR; LOAD; IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN GEN0T(58(*ORD*),GATTR.TYPTR); GEN2T(54(*LOD*),0,LC,INTPTR); LC := LC + INTSIZE; IF LC > LCMAX THEN LCMAX := LC; IF LSY = TOSY THEN#' GEN2(52(*LEQ*),ORD('I'),1) ELSE GEN2(48(*GEQ*),ORD('I'),1); END ELSE ERROR(145) END ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END; GENLABEL(LCIX); GENUJPXJP(33(*FJP*),LCIX); IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(FSYS); GATTR := LATTR; LOAD; IF LSY=TOSY THEN GEN1T(34(*INC*),1,GATTR.TYPTR) ELSE GEN1T(31(*DEC*),1,GATTR.TYPTR); STORE(LATTR); GENUJPXJP(57(*UJP*),LADDR); PUTLABEL(LCIX); LC := LLC; END (*FORSTATEMENT*) ; PROCEDURE WITHSTATEMENT; VAR LCP: CTP; LCNT1: DISPRANGE; LLC: ADDRRANGE; BEGIN LCNT1 := 0; LLC := LC; REPEAT IF SY = IDENT THEN BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END ELSE BEGIN ERROR(2); LCP := UVARPTR END; SELECTOR(FSYS + [COMMA,DOSY],LCP); IF GATTR.TYPTR <> NIL THEN IF GATTR.TYPTR^.FORM = RECOűRDS THEN IF TOP < DISPLIMIT THEN BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1; WITH DISPLAY[TOP] DO BEGIN FNAME := GATTR.TYPTR^.FSTFLD; FLABEL := NIL S END;  IF GATTR.ACCESS = DRCT THEN WITH DISPLAY[TOP] DO BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL; CDSPL := GATTR.DPLMT END y~ ELSE BEGIN LOADADDRESS; ALIGN(NILPTR,LC); GEN2T(56(*STR*),0,LC,NILPTR); WITH DISPLAY[TOP] DO BEGIN OCCUR := VREC; VDSPL := LC END;  LC := LC+PTRSIZE; IF LC > LCMAX THEN LCMAX := LC END END ELSE ERROR(250) ELSE ERROR(140); TEST := SY <> COMMA;  IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = DOSY THEN INSYMBOL ELSE ERROR(54); STATEMENT(FSYS); TOP := TOP-LCNT1; LC := LLC; END (*WITHSTATEMENT*) ; BEGIN (*STATEMENT*) IF SY = INTCONST4 THEN (*LABEL*) BEGIN LLP := DISPLAY[TOP].FLABEL; WHILE LLP <> NIL DO WITH LLP^ DO IF LABVAL = VAL.IVAL THEN BEGIN IF DEFINED THEN ERROR(165); PUTLABEL(LABNAME); DEFINED := TRUE; GOTO 1 END ELSE LLP := NEXTLAB; ERROR(167); 1: INSYMBOL; IF SY = COLON THEN INSYMBOL ELSE ERROR(5) END; IF NOT (SY IN FSYS + [IDENT]) THENi BEGIN ERROR(6); SKIP(FSYS) END; IF SY IN STATBEGSYS + [IDENT] THEN BEGIN CASE SY OF IDENT: BEGIN SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL; IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP) ELSE ASSIGNMENT(LCP) END; BEGINSY: BEGIN INSYMBOL; COMPOUNDSTATEMENT END; GOTOSY: BEGIN INSYMBOL; GOTOSTATEMENT END; IFSY: BEGIN INSYMBOL; IFSTATEMENT END; CASESY: BEGIN INSYMBOL; CASESTATEMENT END; WHILESY: BEGIN INSYMBOL; WHILESTATEMENT END; REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENT END; FORSY: BEGIN INSYMBOL; FORSTATEMENT END; C WITHSY: BEGIN INSYMBOL; WITHSTATEMENT END END; IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN BEGIN ERROR(6); SKIP(FSYS) END END END (*STATEMENT*) ; BEGIN (*BODY*) IF FPROCP e<> NIL THEN ENTNAME := FPROCP^.PFNAME ELSE GENLABEL(ENTNAME); IF PRCODE THEN BEGIN WRITELN(PRR); IF EXTN THEN WRITELN(PRR,' .ENT ?',FPROCP^.NAME) ELSE BEGIN WRITE(PRR,' .ENT L',ENTNAME:1,';':3); h IF FPROCP <> NIL THEN WRITE(PRR,FPROCP^.NAME:5) ELSE WRITE(PRR,'MAIN'); WRITELN(PRR) END; WRITELN(PRR) END; IF EXTN THEN WRITELN(PRR,'?',FPROCP^.NAME,':');  PARMSUM := 0; CSTPTRIX := 0; TOPNEW := LCAFTERMARKSTACK; TOPMAX := LCAFTERMARKSTACK; PUTLABEL(ENTNAME); GENLABEL(SEGSIZE); GENLABEL(STACKTOP); GENCUPENT(32(*ENT1*),1,SEGSIZE); GENCUPENT(32(*ENT2*),2,STACKTOP); IF FPROCP <> NIL ȡTHEN (*COPY MULTIPLE VALUES INTO LOACAL CELLS*) BEGIN LLC1 := LCAFTERMARKSTACK; LCP := FPROCP^.NEXT; IF EXTN THEN BEGIN GENLABEL(PARMNO); GENCUPENT(32(*ENT3*),3,PARMNO) END; WHILE LCP <> NIL DO WITH LCP^ DO BEGIN IF KLASS = VARS THEN IF IDTYPE <> NIL THEN IF (VKIND=ACTUAL) AND (IDTYPE^.FORM>POWER) THEN BEGIN GEN2(50(Q*LDA*),0,VADDR); GEN2T(54(*LOD*),0,LLC1,NILPTR); PARMSUM := PARMSUM + PTRSIZE; GEN1(40(*MOV*),IDTYPE^.SIZE);  LLC1 := LLC1 + PTRSIZE END  ELSE BEGIN IF VKIND = ACTUAL THEN BEGIN PARMSUM := PARMSUM + IDTYPE^.SIZE; LLC1 := LLC1 + IDTYPE^.SIZE END  ELSE BEGIN PARMSUM := PARMSUM + PTRSIZE; LLC1 := LLC1 + PTRSIZE END;  ALIGN(PARMPTR,LLC1); ALIGN(PARMPTR,PARMS\UM) END; LCP := LCP^.NEXT; END; END ELSE BEGIN SAVEID := ID; LOCFP := FEXTFILEP; WHILE LOCFP <> NIL DO BEGIN R WITH LOCFP^ DO BEGIN ID := FILENAME; SEARCHID([VARS],LLCP);  IF LLCP^.IDTYPE <> NIL THEN IF LLCP^.IDTYPEl^.FORM <> FILES THEN BEGIN WRITELN(OUTPUT); WRITELN(OUTPUT,' ':8,'UNDECLARED ', 'EXTERNAL ','FILE',ID:8); V WRITE (OUTPUT,' ':CHCNT+16); END END;  LOCFP := LOCFP^.NEXTFILE END; ID := SAVEID; [ OPENFILES(FEXTFILEP); END; OPENFILES(FLOCFP); LCMAX := LC; REPEAT REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY]) UNTIL NOT (SY IN STATBEGSYS); TEST := SY <> SEMICOLON; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13); LLP := DISPLAY[TOP].FLABEL; (*TEST FOR UNDEFINED LABELS*)  WHILE LLP <> NIL DO WITH LLP^ DO BEGIN IF NOT DEFINED THEN BEGIN ER<ROR(168); WRITELN(OUTPUT); WRITELN(OUTPUT,' LABEL ',LABVAL); WRITE(OUTPUT,' ':CHCNT+16) END; LLP := NEXTLAB END; CLOSEFILES(FLOCFP); IF FPROCP <> NIL THEN BEGIN m IF FPROCP^.IDTYPE = NIL THEN GEN1(42(*RET*),ORD('P')) ELSE GEN0T(42(*RET*),FPROCP^.IDTYPE); END ELSE BEGIN CLOSEFILES(FEXTFILEP); GEN1(42(*RET*),ORD('P')); END; ALIGN(PARMPTR,LCMAX); IF PRCODE THEN BEGIN WRITELN(PRR,'L',' ',SEGSIZE:4,'=',LCMAX:9); WRITELN(PRR,'L',' ',STACKTOP:4,'=',TOPMAX:9); END; IF (EXTN AND PRCODE) THEN WRITELN(PRR,'L',' ',PARMNO:4,'=',PARMSUM:9); IF F6PROCP = NIL THEN BEGIN IF PRCODE THEN WRITELN (PRR,'PCODE: '); IC := 0; (*GENERATE CALL OF MAIN PROGRAM; NOTE THAT THIS CALL MUST BE LOADED AT ABSOLUTE ADDRESS ZERO*) GEN1(41(*MST*),0); GENCUPENT(46(*CUPvT*),0,ENTNAME); GEN0(29(*STP*)); END; END (*BODY*) ; BEGIN (*BLOCK*) FLOCFP := NIL; DP := TRUE; REPEAT IF SY = LABELSY THEN IF NOTEXTDEC THEN BEGIN INSYMBOL; LABELDECLARATION END ELSE BEXGIN ERROR(350); SKIP(FSYS-[LABELSY]) END; IF SY = CONSTSY THEN BEGIN INSYMBOL; CONSTDECLARATION END; IF SY = TYPESY THEN BEGIN INSYMBOL; TYPEDECLARATION END; IF SY = VARSY THEN IF NOTEXTDEC THEN BEGI7N INSYMBOL; VARDECLARATION END ELSE BEGIN ERROR(351); SKIP(FSYS-[VARSY]) END; WHILE SY IN [PROCSY,FUNCSY] DO BEGIN LSY := SY; INSYMBOL; PROCDECLARATION(LSY) END; IF NOTEXTDEC THEN IF SY <> BEGINSY THEN | BEGIN ERROR(18); SKIP(FSYS) END UNTIL ((SY IN STATBEGSYS) OR EOF(INPUT)) OR (( SY = PERIOD ) AND EXTN); IF NOTEXTDEC AND (SY <> PERIOD) THEN BEGIN DP := FALSE; IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);  REPEAT BODY(FSYS + [CASESY]); IF (SY <> FSY) AND NOT(EXTN AND (SY = PERIOD)) THEN BEGIN ERROR(6); SKIP(FSYS) END UNTIL (((SY = FSY) OR (SY IN BLOCKBEGSYS)) OR EOF(INPUT)) OR (EXTN AND (SY = PERIOD)) ENDO ELSE BEGIN ERROR(174); NOTEXTDEC := TRUE END END (*BLOCK*) ; PROCEDURE PROGRAMME(FSYS:SETOFSYS); VAR LEXTFP,PEXTFP,EXTFP:EXTFILEP; FILECOUNT : INTEGER; LLCP : CTP; EXTN : BOOLEAN; BEGIN IF SY = PROGSY THEN BEGIN INSYMBOL; EXTN:=FALSE END ELSE EXTN := TRUE; IF SY = IDENT THEN BEGIN IF PRCODE THEN BEGIN (******** NOVA CONTROL STATEMENTS ******) (*****************************************) WRITELN(PRR,' .TITL ',ID:5); IF NOT(EXTN) THEN WRITELN(PRR,' .ENT PCODE'); END;  INSYMBOL; FILECOUNT := 0; EXTFP := NIL; IF NOT (SY IN [LPARENT,SEMICOLON]) THEN ERROR(14); IF SY = LPARENT THEN BEGIN REPEAT INSYMBOL; U IF SY = IDENT THEN BEGIN NEW(EXTFP); WITH EXTFP^ DO BEGIN FILENAME := ID; IF ((FILENAME = NA[3]) OR (FILENAME = NA[4]) OR (FILENAeME = NA[33]) OR (FILENAME = NA[34]))  THEN BEGIN NEW(LLCP,VARS); WITH LLCP^ DO BEGIN NAME := FILENAME; IDTYPE := TEXTPTR; L KLASS := VARS; VKIND := ACTUAL; NEXT := NIL; VADDR := LCAFTERMARKSTACK+FILEMAX*FILECOUNT+4; VLEV := 1; FILECOUNT := FILECOUNT + 1 END;  ENTERID(LLCP);  FTYPE := LLCP END; NEXTFILE := FEXTFILEP END; FEXTFILEP := EXTFP; INSYMBOL; IF NOT ( SY IN [COMMA,RPARENT] ) THEN ERROR(20) END ELSE ERROR(2) UNTIL SY <> COMMA; IF SY <> RPARENT THEN ERROR(4); INSYMBOL END; IF SY <> SEMICOLON THE EN ERROR(14) ELSE INSYMBOL; PEXTFP := NIL; WHILE EXTFP <> NIL DO BEGIN LEXTFP := EXTFP; WITH LEXTFP^ DO BEGIN EXTFP := NEXTFILE; NEXTFILE := PEXTFP END; PEXTFP := LEXTFP 5B END; FEXTFILEP := PEXTFP; (*POINTERS ARE REVERSED*) END ELSE IF PRCODE THEN WRITELN(PRR,' .TITL EXTSEG'); IF PRCODE THEN BEGIN WRITELN(PRR,' .TXTM 1'); WRITELN(PRR,' .RDX 10'); WRITELN(PRR,' .N6DREL'); END; REPEAT BLOCK(FSYS,PERIOD,NIL,NOT(EXTN),EXTN); IF SY <> PERIOD THEN ERROR(21) UNTIL (SY = PERIOD) OR EOF(INPUT); WRITELN(OUTPUT); WRITELN(OUTPUT); IF PRCODE THEN WRITELN(PRR,' .END'); IF EXTN AND NOT ERRFLAG THEN ;HALT(318); IF ERRINX <> 0 THEN INSYMBOL END (*PROGRAMME*) ; PROCEDURE STDNAMES; BEGIN NA[ 1] := 'FALSE '; NA[ 2] := 'TRUE '; NA[ 3] := 'INPUT '; NA[ 4] := 'OUTPUT '; NA[ 5] := 'GET '; NA[ 6] := 'PUT '; NA[ 7] := 'RES+"ET '; NA[ 8] := 'REWRITE '; NA[ 9] := 'READ '; NA[10] := 'WRITE '; NA[11] := 'PACK '; NA[12] := 'UNPACK '; NA[13] := 'NEW '; NA[14] := 'RELEASE '; NA[15] := 'READLN '; NA[16] := 'WRITELN '; NA[17] := 'ABS '; NA[18] := 'SҥQR '; NA[19] := 'TRUNC '; NA[20] := 'ODD '; NA[21] := 'ORD '; NA[22] := 'CHR '; NA[23] := 'PRED '; NA[24] := 'SUCC '; NA[25] := 'EOF '; NA[26] := 'EOLN '; NA[27] := 'SIN '; NA[28] := 'COS '; NA[29] := R'EXP '; NA[30] := 'SQRT '; NA[31] := 'LN '; NA[32] := 'ARCTAN '; NA[33] := 'PRD '; NA[34] := 'PRR '; NA[35] := 'MARK '; NA[36] := 'PUTRANDO'; NA[37] := 'GETRANDO'; NA[38] := 'PAGE '; NA[39] := 'EOR '; NA[40] :W= 'ROUND '; NA[41] := 'HALT '; END (*STDNAMES*) ; PROCEDURE ENTERSTDTYPES; VAR SP: STP; BEGIN (*TYPE UNDERLIEING:*) (*******************) NEW(INTPTR,SCALAR,STANDARD); (*INTEGER*) WITH INTPTR^ DO BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(REALPTR,SCALAR,STANDARD); (*REAL*) WITH REALPTR+^ DO BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(CHARPTR,SCALAR,STANDARD); (*CHAR*) WITH CHARPTR^ DO BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END; NEW(BOOLPTR#,SCALAR,DECLARED); (*BOOLEAN*) WITH BOOLPTR^ DO BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END; NEW(NILPTR,POINTER); (*NIL*) WITH NILPTR^ DO BEGIN ELPTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END; NEW(PARMPTR,SCALAR,STANDARD); (*FOR ALIGNMENT OF PARAMETERS*) WITH PARMPTR^ DO BEGIN SIZE := PARMSIZE; FORM := SCALAR; SCALKIND := STANDARD END ; NEW(TEXTPTR,FILES); M (*TEXT*) WITH TEXTPTR^ DO BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE; FORM := FILES; RANDOMFILE := FALSE END END (*ENTERSTDTYPES*) ; PROCEDURE ENTSTDNAMES; VAR CP,CP1: CTP; I: INTEGER; BEGIN 0 (*NAME:*) (*******) NEW(CP,TYPES); (*INTEGER*) WITH CP^ DO BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES); (*REAL*) WITH CP^ DO BEGIN NAME := 'REAL '; IDTYPE := REALPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES);  (*CHAR*) WITH CP^ DO BEGIN NAME := 'CHAR '; IDTYPE := CHARPTR; KLASS := TYPES END; ENTERID(CP); NEW(CP,TYPES);  (*BOOLEAN*) WITH CP^ DO BEGIN NAME := 'BOOLEAgN '; IDTYPE := BOOLPTR; KLASS := TYPES END; ENTERID(CP); CP1 := NIL; FOR I := 1 TO 2 DO BEGIN NEW(CP,KONST); (*FALSE,TRUE*) WITH CP^ DO BEGIN NAME := NA[I]; IDTYPE := BOOLPTR; [ NEXT := CP1; VALUES.IVAL := I - 1; KLASS := KONST END; ENTERID(CP); CP1 := CP END; BOOLPTR^.FCONST := CP; NEW(CP,KONST);  (*NIL*) WITH CP^ DO BEGIN NAME := 'NIL '; ?6IDTYPE := NILPTR; NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST END; ENTERID(CP); FOR I := 36 TO 37 DO (*GETRANDOM,PUTRANDOM*) BEGIN NEW(CP,PROC,STANDARD); WITH CP^ DO BEGIN NAME := KNA[I]; IDTYPE := NIL; NEXT := NIL; KEY := I-22; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,PROC,STANDARD); (*PAGE*) WITH CP^ DO %K BEGIN NAME := NA[38]; IDTYPE := NIL; NEXT := NIL; KEY := 16; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP); NEW(CP,PROC,STANDARD); (*HALT*) WITH CP^ DOi BEGIN NAME := NA[41]; IDTYPE := NIL; NEXT := NIL; KEY := 17; KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP);  NEW(CP,FUNC,STANDARD); (*EOR*) WITH CP^ DOj BEGIN NAME := NA[39]; IDTYPE := NIL; NEXT := NIL; KEY := 9; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP); NEW(CP,FUNC,STANDARD); (*ROUND*) WITH CP^ ,pDO BEGIN NAME := NA[40]; IDTYPE := NIL; NEXT := NIL; KEY := 12; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP); FOR I := 5 TO 16 DO BEGIN NEW(CP,PROC,STANDARD); (*GET,PUT,RESET*) WITH CP^ DO (*REWRITE,READ*) BEGIN NAME := NA[I]; IDTYPE := NIL; (*WRITE,PACK*) NEXT := NIL; KEY := I - 4; (*UNPACK,PACK*)  KLASS := PROC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,PROC,STANDARD); WITH CP^ DO BEGIN NAME:=NA[35]; IDTYPE:=NIL; NEXT:= NIL; KEY:=13; KLASS:=PROC; PFDECKIND:= STANDARD  END; ENTERID(CP); FOR I := 25 TO 26 DO BEGIN NEW(CP,FUNC,STANDARD); WITH CP^ DO BEGIN NAME := NA[I]; IDTYPE := NIL; NEXT := NIL; KEY := I - 15; KLASS := FUNC; PFDECKIND := STANDARD END,; ENTERID(CP) END; FOR I := 17 TO 24 DO BEGIN NEW(CP,FUNC,STANDARD); (*ABS,SQR,TRUNC*) WITH CP^ DO (*ODD,ORD,CHR*) BEGIN NAME := NA[I]; IDTYPE := NIL; (*PRED,SUCC*) NEXT := NIL; KEY := I - 16; KLASS := FUNC; PFDECKIND := STANDARD END; ENTERID(CP) END; NEW(CP,VARS); (*PARAMETER OF PREDECLARED FUNCTIONS*) WITYH CP^ DO BEGIN NAME := ' '; IDTYPE := REALPTR; KLASS := VARS; VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0 END; FOR I := 27 TO 32 DO BEGIN NEW(CP1,FUNC,DECLARED,ACTUAL); (*SIN,COS,EXP*) =! WITH CP1^ DO (*SQRT,LN,ARCTAN*) BEGIN NAME := NA[I]; EXTDEC := FALSE; IDTYPE := REALPTR; NEXT := CP; FORWDECL := FALSE; EXTERN := TRUE; PFLEV := 0; PFNAME := I - 12; KLASS := FUNC; PFV]DECKIND := DECLARED; PFKIND := ACTUAL END; ENTERID(CP1) END END (*ENTSTDNAMES*) ; PROCEDURE ENTERUNDECL; BEGIN NEW(UTYPPTR,TYPES); WITH UTYPPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; KLASS := TYPES END;  NEW(UCSTPTR,KONST); WITH UCSTPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST END; NEW(UVARPTR,VARS); WITH UVARPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; VKIND := ACTUAL; NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS END; NEW(UFLDPTR,FIELD); WITH UFLDPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0; KLASS := FIELD END; NEW(UPRCPTR,PROC,DECLARopED,ACTUAL); WITH UPRCPTR^ DO BEGIN NAME := ' '; IDTYPE := NIL; FORWDECL := FALSE; EXTDEC := FALSE; NEXT := NIL; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME); KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL END{; NEW(UFCTPTR,FUNC,DECLARED,ACTUAL); WITH UFCTPTR^ DO BEGIN NAME := ' '; EXTDEC := FALSE; IDTYPE := NIL; NEXT := NIL; FORWDECL := FALSE; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME); KLASS := FUNC; PFDECKIND := DECLARE62D; PFKIND := ACTUAL END END (*ENTERUNDECL*) ; PROCEDURE INITSCALARS; BEGIN FWPTR := NIL; PRTABLES := FALSE; LIST := TRUE; PRCODE := TRUE; DEBUG := TRUE; ERRFLAG := FALSE; FOR IC := 1 TO MAXERRSET DO ERRORS[IC] := []; Zw DP := FALSE; PRTERR := TRUE; ERRINX := 0; INTLABEL := 0; KK := 8; FEXTFILEP := NIL; LC := LCAFTERMARKSTACK+FILEBUFFER*FILEMAX; (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR 2 TEXT FILES *) IC := 3; EOL := TRUE; LINECOUNT := 0; z CH := ' '; CHCNT := 0; GLOBTESTP := NIL; MXINT10 := MAXINT DIV 10; DIGMAX := STRGLGTH - 1; END (*INITSCALARS*) ; PROCEDURE INITSETS; BEGIN CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT]; SIMPTYPEBEGSYS := [LPARENT] + CDONSTBEGSYS; TYPEBEGSYS:=[ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY,RANDOMSY]+SIMPTYPEBEGSYS; TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY]; BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY, BEGINSY]; SELECTSYS_Q := [ARROW,PERIOD,LBRACK]; FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY]; STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY, CASESY]; END (*INITSETS*) ; PROCEDURE INITTABLES; PRO[CEDURE RESWORDS; BEGIN RW[ 1] := 'IF '; RW[ 2] := 'DO '; RW[ 3] := 'OF '; RW[ 4] := 'TO '; RW[ 5] := 'IN '; RW[ 6] := 'OR '; RW[ 7] := 'END '; RW[ 8] := 'FOR '; RW[ 9] := 'VAR '; RW[10] := 'DIV '; RW[11] := 'MOD '; RW[12] := 'SET '; RW[13] := 'AND '; RW[14] := 'NOT '; RW[15] := 'THEN '; RW[16] := 'ELSE '; RW[17] := 'WITH '; RW[18] := 'GOTO '; RW[19] := 'CASE '; RW[20] := 'TYPE '; )5 RW[21] := 'FILE '; RW[22] := 'BEGIN '; RW[23] := 'UNTIL '; RW[24] := 'WHILE '; RW[25] := 'ARRAY '; RW[26] := 'CONST '; RW[27] := 'LABEL '; RW[28] := 'REPEAT '; RW[29] := 'RECORD '; RW[30] := 'DOWNTO '; RW[31] := 'PACKED '; RW[32] := 'RANDOM '; RW[33] := 'FORWARD '; RW[34] := 'PROGRAM '; RW[35] := 'FUNCTION'; RW[36] := 'EXTERNAL'; RW[37] := 'PROCEDUR'; FRW[1] := 1; FRW[2] := 1; FRW[3] := 7; FRW[4] := 15; FRW[5] := 22; FRW[6] := 28; FRW[7] := 33; FRW[8] := 35; FRW[9] := 38; END (*RESWORDS*) ; PROCEDURE SYMBOLS; BEGIN RSY[1] := IFSY; RSY[2] := DOSY; RSY[3] := OFSY; RSY[4] := TOSY; RSY[5] := RELOP; RSY[6] := ADDOP; RSY[7] := ENDSY; RSY[8] := FORSY; RSY[9r] := VARSY; RSY[10] := MULOP; RSY[11] := MULOP; RSY[12] := SETSY; RSY[13] := MULOP; RSY[14] := NOTSY; RSY[15] := THENSY; RSY[16] := ELSESY; RSY[17] := WITHSY; RSY[18] := GOTOSY; RSY[19] := CASESY; RSY[20] := TYPESY; RSY[21] := FILES$Y; RSY[22] := BEGINSY; RSY[23] := UNTILSY; RSY[24] := WHILESY; RSY[25] := ARRAYSY; RSY[26] := CONSTSY; RSY[27] := LABELSY; RSY[28] := REPEATSY; RSY[29] := RECORDSY; RSY[30] := DOWNTOSY; RSY[31] := PACKEDSY; RSY[32] := RANDOMSY; RSY[j33] := FORWARDSY; RSY[34] := PROGSY; RSY[35] := FUNCSY; RSY[36] := EXTRNSY; RSY[37] := PROCSY; SSY['+'] := ADDOP; SSY['-'] := ADDOP; SSY['*'] := MULOP; SSY['/'] := MULOP; SSY['('] := LPARENT; SSY[')'] := RPARENT; SSY['$'] := OTHERSY; SSY['='] := RELOP; SSY[' '] := OTHERSY; SSY[','] := COMMA; SSY['.'] := PERIOD; SSY[''''] := OTHERSY; SSY['['] := LBRACK; SSY[']'] := RBRACK; SSY[':'] := COLON; SSY['^'] := ARROW; SSY['<'] := RELOP; SSY['>'] := RELOP; SSY[';'] := SEMICOLON; END (*SYMBOLS*) ; PROCEDURE RATORS; VAR I: INTEGER; CH: CHAR; BEGIN FOR I := 1 TO 37 (*NR OF RES WORDS*) DO ROP[I] := NOOP; ROP[5] := INOP; ROP[10] := IDIV; ROP[11] := IMOD; ROP[6] := OROP; ROP[13]># := ANDOP; FOR CH := CHR(ORDMINCHAR) TO CHR(ORDMAXCHAR) DO SOP[CH] := NOOP; SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL; SOP['/'] := RDIV; SOP['='] := EQOP; SOP['<'] := LTOP; SOP['>'] := GTOP; END (*RATORS*) ; PROC5EDURE PROCMNEMONICS; BEGIN SNA[ 1] :=' GET'; SNA[ 2] :=' PUT'; SNA[ 3] :=' RDI'; SNA[ 4] :=' RDR'; SNA[ 5] :=' RDC'; SNA[ 6] :=' WRI'; SNA[ 7] :=' WRO'; SNA[ 8] :=' WRR'; SNA[ 9] :=' WRC'; SNA[10] :=' WRS'; SNA[11] :=' OPN'; SNA[12] :S=' NEW'; SNA[13] :=' RST'; SNA[14] :=' ELN'; SNA[15] :=' SIN'; SNA[16] :=' COS'; SNA[17] :=' EXP'; SNA[18] :=' SQT'; SNA[19] :=' LOG'; SNA[20] :=' ATN'; SNA[21] :=' RLN'; SNA[22] :=' WLN'; SNA[23] :=' SAV'; SNA[24] :=' CLS'; SNA[25] :=' WDR'; SNA[26] :=' RRR'; SNA[27] :=' PAG'; SNA[28] :=' EOR'; SNA[29] :=' RSE'; SNA[30] :=' RWR'; SNA[31] :=' RND' END (*PROCMNEMONICS*) ; PROCEDURE INSTRMNEMONICS; BEGIN MN[0] :=' ABI'; MN[1] :=' ABR'; MN[2] :=' ADI'; MN[3] :='܈ ADR'; MN[4] :=' AND'; MN[5] :=' DIF'; MN[6] :=' DVI'; MN[7] :=' DVR'; MN[8] :=' EOF'; MN[9] :=' FLO'; MN[10] :=' FLT'; MN[11] :=' INN'; MN[12] :=' INT'; MN[13] :=' IOR'; MN[14] :=' MOD'; MN[15] :=' MPI'; MN[16] :=' MPR'; MN[17] :='< NGI'; MN[18] :=' NGR'; MN[19] :=' NOT'; MN[20] :=' ODD'; MN[21] :=' SBI'; MN[22] :=' SBR'; MN[23] :=' SGS'; MN[24] :=' SQI'; MN[25] :=' SQR'; MN[26] :=' STO'; MN[27] :=' TRC'; MN[28] :=' UNI'; MN[29] :=' STP'; MN[30] :=' CSP'; MN[31] :=' DEC'; MN[32] :=' ENT'; MN[33] :=' FJP'; MN[34] :=' INC'; MN[35] :=' IND'; MN[36] :=' IXA'; MN[37] :=' LAO'; MN[38] :=' LCA'; MN[39] :=' LDO'; MN[40] :=' MOV'; MN[41] :=' MST'; MN[42] :=' RET'; MN[43] :=' SRO'; MN[44] :=' XJP'; MN[455] :=' CHK'; MN[46] :=' CUP'; MN[47] :=' EQU'; MN[48] :=' GEQ'; MN[49] :=' GRT'; MN[50] :=' LDA'; MN[51] :=' LDC'; MN[52] :=' LEQ'; MN[53] :=' LES'; MN[54] :=' LOD'; MN[55] :=' NEQ';  MN[56] :=' STR'; MN[57] :=' UJP'; MN[58] :=' ORD'; MN[5q9] :=' CHR'; MN[60] :=' UJC'; MN[61] := ' CXP'; MN[62] :=' HLT'; END (*INSTRMNEMONICS*) ; PROCEDURE CHARTYPES; VAR I : INTEGER; BEGIN FOR I := ORDMINCHAR TO ORDMAXCHAR DO CHARTP[CHR(I)] := ILLEGAL; CHARTP['A'] := LE7TTER ; CHARTP['B'] := LETTER ; CHARTP['C'] := LETTER ; CHARTP['D'] := LETTER ; CHARTP['E'] := LETTER ; CHARTP['F'] := LETTER ; CHARTP['G'] := LETTER ; CHARTP['H'] := LETTER ; CHARTP['I'] := LETTER ; CHARTP['J'] := LETTER ; CHARTP['K'] := LETTER ; CHARTP['L'] := LETTER ; CHARTP['M'] := LETTER ; CHARTP['N'] := LETTER ; CHARTP['O'] := LETTER ; CHARTP['P'] := LETTER ; CHARTP['Q'] := LETTER ; CHARTP['R'] := LETTER ; CHARTP['S'] := LETTER ; CHARTP['T'] := LETTER ; CHARTP['U'] := LETTER ; CHARTP['V'] := LETTER ; CHARTP['W'] := LETTER ; CHARTP['X'] := LETTER ; CHARTP['Y'] := LETTER ; CHARTP['Z'] := LETTER ; CHARTP['0'] := NUMBER ; CHARTP['1'] := NUMBER ; CHARTP['2'] := zNUMBER ; CHARTP['3'] := NUMBER ; CHARTP['4'] := NUMBER ; CHARTP['5'] := NUMBER ; CHARTP['6'] := NUMBER ; CHARTP['7'] := NUMBER ; CHARTP['8'] := NUMBER ; CHARTP['9'] := NUMBER ; CHARTP['+'] := SPECIAL; CHARTP['-'] := SPECIAL; CHARTP['*'] := SPECIAL; CHARTP['/'] := SPECIAL; CHARTP['('] := SPECIAL; CHARTP[')'] := SPECIAL; CHARTP['$'] := SPECIAL; CHARTP['='] := SPECIAL; CHARTP[' '] := SPECIAL; CHARTP[','] := SPECIAL; CHARTP['.'] := SPECIAL; CHARTP[''''] := SPECIAL; CHARTP['['] := SPECIAL; CHARTP[']'] := SPECIAL; CHARTP[':'] := SPECIAL; CHARTP['^'] := SPECIAL; CHARTP[';'] := SPECIAL; CHARTP['<'] := SPECIAL; CHARTP['>'] := SPECIAL; ORDINT['0'] := 0; ORDINT['1'] := 1; zORDINT['2'] := 2; ORDINT['3'] := 3; ORDINT['4'] := 4; ORDINT['5'] := 5; ORDINT['6'] := 6; ORDINT['7'] := 7; ORDINT['8'] := 8; ORDINT['9'] := 9; END; PROCEDURE INITDX; BEGIN CDX[ 0] := 0; CDX[ 1] := 0; CDX[ 2] := -ҁ1; CDX[ 3] := -2; CDX[ 4] := -1; CDX[ 5] := -4; CDX[ 6] := -1; CDX[ 7] := -2; CDX[ 8] := 0; CDX[ 9] := 1; CDX[10] := 1; CDX[11] := -4; CDX[12] := -4; CDX[13] := -1; CDX[14] := -1; CDX[15] := -1; CDX[16] := -2; CDX[17] := 0; CDX[h18] := 0; CDX[19] := 0; CDX[20] := 0; CDX[21] := -1; CDX[22] := -2; CDX[23] := 3; CDX[24] := 0; CDX[25] := 0; CDX[26] := -2; CDX[27] := -1; CDX[28] := -4; CDX[29] := 0; CDX[30] := 0; CDX[31] := 0; CDX[32] := 0; CDX[33] := -1; CDX[34] := 0; CDX[35] := 0; CDX[36] := -1; CDX[37] := +1; CDX[38] := +1; CDX[39] := +4; CDX[40] := -2; CDX[41] := 0; CDX[42] := 0; CDX[43] := -1; CDX[44] := -1; CDX[45] := 0; CDX[46] := 0; CDX[47] := -1; CDX[48] := -1; CDX5[49] := -1; CDX[50] := +1; CDX[51] := +4; CDX[52] := -1; CDX[53] := -1; CDX[54] := +4; CDX[55] := -1; CDX[56] := -1; CDX[57] := 0; CDX[58] := 0; CDX[59] := 0; CDX[60] := 0; CDX[61] := 0; CDX[62] := -1; PDX[ 1] := -1; PDX[ 2] := -1; PDX[ 3] := -2; PDX[ 4] := -3; PDX[ 5] := -2; PDX[ 6] := -3; PDX[ 7] := -3; PDX[ 8] := -4; PDX[ 9] := -3; PDX[10] := -4; PDX[11] := -3; PDX[12] := -2; PDX[13] := -1; PDX[14] := 0; PDX[15] := 0; PDX[16] := 0; PDX[17] := 0; PDX[18] := 0; PDX[19] := 0; PDX[20] := 0; PDX[21] := -1; PDX[22] := -1; PDX[23] := -1; PDX[24] := -1;  PDX[25] := -2; PDX[26] := -2; PDX[27] := -1; PDX[28] := -1; PDX[29] := -2; PDX[30] := -2; PDX[31] := 0 END; BEGIN (*INITTABLES*5) RESWORDS; SYMBOLS; RATORS; INSTRMNEMONICS; PROCMNEMONICS; CHARTYPES; INITDX; END (*INITTABLES*) ; PROCEDURE FULLINITALISATION; BEGIN (*INITIALIZE*) (************) INITSCALARS; INITSETS; INITTABLES; (*ENTER STANDARD NAMES AND STANx-DARD TYPES:*) (******************************************) LEVEL := 0; TOP := 0; WITH DISPLAY[0] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END; ENTERSTDTYPES; STDNAMES; ENTSTDNAMES; ENTERUNDECL; TOP := 1; LEVEL := 1; WITH DISPLAY[1] DO BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END; END; BEGIN FULLINITALISATION; (*COMPILE:*) (**********) INSYMBOL; PROGRAMME(BLOCKBEGSYS+STATBEGSYS-[CASESY]); IF ERRFLAG THEN BEGIN ERRORREPORT; HALT(31lc9) END; END. R2IREAL.SR > .TITL R2IREAL ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO REAL NUMBER OPERATIONS .ENT PADR,PSBR,PFLT,PFLO,PTRC,PNGR .ENT PSQR,PABR,PMPR,PDVR .EXTN PUNDF .NREL PADR: PSBR: PFLT: PFLO: PTRC: PNGR: PSQR: PABR: PMPR: PDVR: .PUND .END R2SMYP.SRU,ݽ .TITL R2SMYP .ENT .MPY,.SV0 .EXTN MPY .ZREL .SV0: 0 .NREL .MPY : N. : STA 3,N.1 SUB 3,3 MOVL# 1,1,SZC ADD 2,3 MOVL# 2,2,SZC ADD 1,3 STySA 3,N.2 MPY LDA 3,N.2 SUB 3,0 JMP @.+1 N.1: 0 N.2: 0 .END R2SBOOLEAN.SR vR .TITL R2SBOOLEAN ; THE P-CODE INTERPRETER'S BOOLEAN OPERATIONS .ENT PNOT,PAND,PIOR .NREL PNOT: LTOP1 1 ;"NOT" MOV 1,1,SZR ;SET AC1=1 (TRUE) IF CURRENTLY 0 SUB 1,1,SKP ; 0 IF 1 INC 1,1 STOP1 1 NEXT PAND: POP1 2 ;"AND" LTOP1 1 SUB 0,0 1i ANDR 2,1 ;KEEP B15 IN CARRY MOVL 0,0 ; RESULT OF "AND" IS A SINGLE BIT STOP1 0 NEXT PIOR: POP1 2 ;"INCLUSIVE OR"  LTOP1 1 SUB 0,0 COM 2,2 ;DELETE COMMON 1'S FROM AC1 AND 2,1 ADCR 2,1 ;OR MOVL 0,0 ;RESULT OF "IOR" IS A SINGLE BIT STOP1 0 JRNEXT .END MAKEDGSYMB.CMm (DELETE MAC.PS;^ MAC/N/S NBID FPID OSID^ R2SDECODER.SR 2 .TITL R2SDECODER .EXTD ITAB0,ITAB1 .ENT PUNDF ; THE INTERPRETER INSTRUCTION DECODER .LOC 40 ; SPECIAL PAGE ZERO LOCN. CONTAINING INTER ; ENTRY ADDRESS OF INTERPRETER .NREL OPMSK: 037400 ; MASK FOR OP-CODE PMSK: 000377 ; MASK FOR P-FIELD 7INTER: LDA 0,@PC ; AC0:= NEXT INSTR. LDA 3,OPMSK ANDS 0,3 ; AC3:= OP-CODE LDA 1,PMSK AND 0,1 ; AC1(P):= P-FIELD ADDL# 0,0,SNC ; TEST Q1-BIT:- JMP @ITAB0,3 ; Q1=0: ENTER INTERP. TABLE MOVL# 0,0,SNC ; Q1=1: TEST Q2-BIT:- JMP .+4 MOV 1,2 ; Q2=_1: AC2(Q):= P-FIELD SUB 1,1 ; AC1(P):= 0; JMP @ITAB1,3 ; ENTER INTERP. TABLE LDA 2,@PC ; Q2=0: AC2(Q):= Q-FIELD JMP @ITAB1,3 ; ENTER INTERP. TABLE PUNDF: ERR.P PEROP .END R2SDBIN.SR ; .TITL R2SDBIN .ENT .DBIN .ENT .DBNI .EXTD .PTCH .EXTD .GTCH .LOC 0 .ZREL Z. : .NREL .DBNI: N. : 54464 ; 0/ STA 3,N.9 50462 g ; 1/ STA 2,N.8 20471 ; 2/ LDA 0,N.16 JSR @.PTCH ; 3/ JSR @.PTCH 102400 ; 4/ SUB 0,0 JSR @.PTCH ; 5/ JSR @.PTCH 4ק03 ;  6/ JMP N.1 .DBIN: 54455 ; 7/ STA 3,N.9 50453 ; 10/ STA 2,N.8 N.1: 102400 ; 11/ SUB 0,0 40462 ; 12/ STA 0,N.1^ 7 40452 ; 13/ STA 0,N.10 40452 ; 14/ STA 0,N.11 JSR @.GTCH ; 15/ JSR @.GTCH 24451 ; 16/ LDA 1,N.12 106405 ; > 17/ SUB  0,1,SNR 405 ; 20/ JMP N.2 24447 ; 21/ LDA 1,N.13 106404 ; 22/ SUB 0,1,SZR 403 ; 23/ JMP N.3 10441 B ; 24/ ISZ N.10 N.2: JSR @.GTCH ; 25/ JSR @.GTCH N.3: 24443 ; 26/ LDA 1,N.14 30443 ; 27/ LDA 2,N.15 142033 ; 30/ ADCZ# 2,0,SNC ͉  106032 ; 31/ ADCZ# 0,1,SZC 406 ; 32/ JMP N.4 122400 ; 33/ SUB 1,0 24432 ; 34/ LDA 1,N.11 4420 ; 35/ JSGR N.7 44430 ; 36/ STA 1,N.11 766 ; 37/ JMP N.2 N.4: 24426 ; 40/ LDA 1,N.11 125122 ; 41/ MOVZL 1,1,SZC 10432   0 ; 42/ ISZ N.17 14422 ; 43/ DSZ N.10 406 ; 44/ JMP N.5 125005 ; 45/ MOV 1,1,SNR 14426 ; 46/ DSZ N.17 124641 M ; 47/ NEGOR 1,1,SKP 125240 ; 50/ MOVOR 1,1 402 ; 51/ JMP N.6 N.5: 125220 ; 52/ MOVZR 1,1 N.6: 30410 ; 53/ LDA 2,N.8 Xe 2410 ; 54/ JMP @N.9 N.7: 131120 ; 55/ MOVZL 1,2 151120 ; 56/ MOVZL 2,2 147000 ; 57/ ADD 2,1 125120 ; 60/ MOVZL 1,1 ! 107000 ; 61/ ADD 0,1 1400 ; 62/ JMP 0,3 N.8: 0 ; 63/ JMP 0 N.9: 0 ; 64/ JMP 0 N.10: 0  ; 65/ JMP 0 N.11dx: 0 ; 66/ JMP 0 N.12: 53 ; 67/ JMP 53 N.13: 55 ; 70/ JMP 55 N.14: 60 ; 71/ JMP 60 N.15: 71 ; 72/ JMP 71 N.16: o) 123 ; 73/ JMP 123 N.17: 0 ; 74/ JMP 0 .END SETUPAZ.kj (*========== SETUPAZ STARTS FROM HERE UP TO END OF THIS PROGRAM ==========*) BEGIN (* OF MAIN BODY *) WRITELN(PRR, '; SETUPA BEGINS'); WRITELN; WRITELN; WRITELN; FOR I := 0 TO TABSIZE0 DO BEGIN PCODETABLE[I].PCODEY := ' '; PCODETABLE[I].SEMICODE := ' '; PCODETABLE[I].ACTION := 0 END; ZERO := ORD('0'); COMPLETETASK; WRITELN('PROCEDURE COMPLE', 'TABLE;'); WRITELN; WRITELN; J := 1; K := 0; WRITELN('PROCEDURE TABLE', '0;'); WRITELN('BEGIN'); FOR I := 0 TO TABSIZE0 DO BEGIN WITH PCODETABLE[I] DO BEGIN IF SEMICODE[1] <> ' ' THEN BEGIN IF K MOD 30 = 29 THEN  BEGIN WRITELN('END;'); WRITELN; WRITELN; WRITELN('PROCEDURE TABLE', J : 1, '; '); WRITELN('BEGIN'); J := J + 1; X END; WRITE(' ' : 5, 'WITH PCODETABLE[', I : 1, '] ' : 2, 'DO BEGIN PCODE:=', '''', PCODE : 4, '''; ' : 3, 'SEMICODE:=' : 10); IF SEMICODE[1] = '1' THEN PETTY := J-8 ELSE PETTY := 0; WRITELN( (((( PETTY + ORD(SEMICODE[2]) - ZERO) * 8 + ORD(SEMICODE[3]) - ZERO) * 8 + ORD(SEM5ICODE[4]) - ZERO) * 8 +  ORD(SEMICODE[5]) - ZERO) * 8 + ORD(SEMICODE[6]) - ZERO : 6, '; ' : 2, 'ACTION:=' : 8, ACTION : 4, ' END;');  K := K + 1; END END END; WRITELN('END;'); WRITELN; WRITELN; WRITELN; WRITELN('BEGIN'); FOR I := 0 TO J - 1 DO WRITELN(' ' : 5, 'TABLE' : 5, I : 1, '; '); WRITELN('END;'); iWRITELN; WRITELN; WRITELN(PRR, '; HASH TABLE SIZ', 'E = ' : 8, TABLESIZE : 1); WRITELN(PRR, '; TOTAL PCODE EN', 'TRIES = ' : 8, ENTRIES : 1); WRITELN(PRR, '; LOADING FACTOR', ' = ' : 8, ENTRIES/TABLESIZE : 1) END. R2RFT.SR =T .TITLE R2RFT .ENT XRDR,XWRR .EXTD WSA,PUTFL,LHB .EXTN FENT .EXTN WRITE,BLANK,CHINF,BFHLF,BFPTR .EXTN PURGE .NREL ;THESE ROUTINES USE THE FP INTERPRETER BRKC=2 WDISP=121 ;# OF CHARS FOR NUMBER DDISP=122 ;# OF CHARS AFTER . XRDR: SUBZL 0,0 ;SE MT FLAG STA 0,@.CHF ;IN CHIN FENT ;ENTER DITTO FDFC 0 ;FP NUMBER INTO FP AC0 FSTA 0,TEMPR ;COPY IT FEXT ;EXIT LDA 3,WSA LDA 3,0,3 ;PICK UP FLAG MOV 3,3,SNR ;SKIP IF NON-ZERO JMP .+3 ERR.P PERFI ;REPORT ERROR POP1 2 MOVZR 2,2 DSZ F,ST,2 ;MARK BUFFER EMPTY JMP .+1 ;EOL MAY BE SHOWING POP1 2 ;GET DESTINATION MOVZR 2,2 LDA 0,TEMPR STA 0,0,2 ;STORE FIRST HALF LDA 0,TEMPR+1 STA 0,1,2 ;STORE LAST HALF NEXT TEMPR: 0 0 .CHF: CHINF .RITE: WRITE .BLNK: BLANK .BHLF: BFHLF .BPTR: BFPTR .PRGE: PURGE WIDTH: 31. CHADP: 4 BIGE: (24+64.)*256. HOLDR: 0 0 XWRR: POP1 2 ;FBA MOVZR 2,2 LDA 1,CHADP ;# CHARS AFTER . POP1 0 ;# CHARS IN TOTO STA 0,AD1 ;COMPATABILITY WITH WRI IN PURGE POP1 3 STA 3,HOLDR+1 ;FIRST HALF POP1 3 STA 3,HOLRDR ;LAST HALF LDA 3,WSA ;FP WRITE AREA STA 1,DDISP,3 ;PLACES AFTER DP LDA 1,WIDTH ;PLACES MAXIMUM STA 1,WDISP,3 SUB 1,1 ;CLEAR FLAGS STA 1,0,3 ;IN WSA LDA 1,AD1 ;FIELD WIDDTH FROM USER MOV 1,1,SNR ;SKIP IF WIDTH >0 JMP EFORM LDA 1,HOLDR ;FP NUMBER PART 1 LDA 3,LHB ;MASK ANDZL 3,1 ;KEEP EXPONENT ANDD .. MOVZR 1,1 ;LOSE MANTISSA SIGN LDA 3,BIGE ;LARGEST EXPONENT FOR F FORMAT ADCZ 3,1,SZC ;SKIP IF AC1(EXP)<=AC3(BIGE) JMP EFORM FFORM: FENT ;FP ENTER FLDA 0,HOLDR ;LOAD NUMBER FF_DCF 0 ;PUT IN BUFF FEXT ;FP EXIT ACS 0,2 OK JMP TESTF EFORM: FENT FLDA 0,HOLDR FFDC 0 FEXT TESTF: LDA 3,WSA LDA 3,0,3 ;PICK UP FLAG MOV 3,3,SNR ;ERROR IF NON ZERO JMP .+3 ERR.P PERFO ;REPORT ERROR JSR @.PRGE ;EMPTIES AND TIDIES BUFFER |.END R2IOUTL.SR b. .TITL R2IOUTL .ENT .BPUT,.BGET,.GCH,.FIND .ENT TEMP .EXTN ERR2,ERRP,PCODE .EXTD CHAN,SPACE,TEMP2,CNTAD,TABAD .EXTD LHB,RHB .TXTM 1 .ZREL ; DEFINE SOME CONSTANTS IN PAGE ZERO THAT ARE ASSUMED TO HAVE ; ADDRESSES 50 AND 51.... ERR2 ; .ERR2 = 50 ERRP ; .ERRP = 51 .BPUT: BPUT .BGET: BGET .GCH: GCHAN .CTAB: CTAB .BTAB: BTAB-1 .OTAB: OTAB-1 .TTAB: TTAB-1 .FIND: FIND TEMP: 0 .NREL ; ROUTINE TO WRITE A BYTE TO A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - BYTE TO BE WRITTEN(IN LHB) ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED BPUT: STA 3,BLNK ;LINK STORED LDA 1,LHB ;MASK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHCICH BYTE MOVS 0,0,SKP ;RIGHT OR LEFT? MOVS 1,1 LDA 3,0,2 ;LOAD FROM WORD ADDRESS AND 1,3 ;MASK OUT OTHER BYTE ADD 0,3 ;REPLACE WITH NEW BYTE STA 3,0,2 ;AND RESTORE JMP @BLNK ; ROUTINE TO READ A BYTE FROM A GIVEN BYTE ADDRESS ; ; CONDITIONS ..˻. ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - VALUE OF BYTE READ(IN LHB) ; AC1 - UNDEFINED ; AC2 - UNDEFINED BGET: STA 3,BLNK ;STORE LINK LDA 1,LHB ;BYTE MASK FOoR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHICH BYTE MOVS 1,1 ;RIGHT OR LEFT? LDA 0,0,2 ;LOAD FROM WORD ADDRESS. AND 1,0,SZC ;EXTRACT BYTE MOVS 0,0 ;SWOP INTO LHB  JMP @BLNK ; ROUTINE TO GET THE CHANNEL NO. AND RECORD LENGTH OF SPECIFIC FILE. ;̝ ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - CHANNEL NUMBER ; AC1 - RECORD LENGTH ; AC2 - WORD ADDRESS OF FBA ; ; NORMAL RETURN - NONE CHARACTER INPUT/OUTPUT ; RETURN + 1 - CHARACTER INPUT/OUTPUT GCHAN: STA 3,BLNK ;STORE LINK LDA 1,LHB ;MASK FOR LEFT HAND BYTE LDA 0,FCH,2 ;CHANNEL WORD OF FBA ANDS 0,1,SNR ;ISOLATE RECORD LENGTH ISZ BLNK ;AND TEST IF CHAR I/O. MOVZL 1,1 ;MAK)E IT A BYTE COUNT LDA 3,RHB ;MASK CHANNEL NUMBER AND 3,0 STA 0,CHAN JMP @BLNK BLNK: 0 ; ROUTINE TO SEARCH TABLES FOR BUFFER DETAILS. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - CHANNEL NUMBER OF FILE (OR ZERO) ; ; RETURN - AC0 - BYTE ADDRESS OF BUFFER AREA(BASE) ; AC1 - ADDRESS OF BYTE COUNT (DISPLACEMENT) ; AC2 - WORD ADDRESS OF ENTRY IN CHANNEL TABLE FIND: LDA 0,TSIZE ;SIZE OF TABLE LDA 1,.CTAB ;ADDRESS OF CHANNEL TABLE(TOP) STA 1,TEMP RETST: LDA 1,@TEMP ;SEARCH UNTIL A MATCH OR ERROR SUB 2,1,SNR JMP RETRN ;A MATCH IS FOUND DSZ TEMP INC 0,0,SZR ;TABLE EXHAUSTED? JMP RETST ;NO,FIND NEXT ERR.P ;YES, BLOW..... 411 RETRN: LDA 1,.OTAB SUBZ 0,1 ;ADDRESS OF BYTE COUNT(DISPLACEMENT) STA 1,CNTAD LDA 1,@CNTAD ;LOAD ACTUAL COUNT LDA 2,C200 SUBZ# 1,2,SZC ;TEST IF LINE TOO LONG JMP .+3 JSR .NERR ;LINE LIMIT FLAGGED TO CLI 22 LDA 1,CNTAD LDA 2,.TTAB SUB 0,2 ;ENTRY IN THE TABLE TAB COUNTS STA 2,TABAD LD<A 2,.BTAB SUB 0,2 LDA 0,0,2 ;SET BUFFER ADDRESS(BASE) LDA 2,TEMP ;CHANNEL TABLE ADDRESS JMP 0,3 .NERR: LDA 2,0,3 ;PICK UP ERROR CODE ERR.2 C200: 200 TSIZE: -4 ;TABLE SIZE 0 0 0 CTAB: 0 ;TOP OF CHANNEL TABLE OTAB: .BLK 4 ;COUNT TABLE TTAB: .BLK 4 ;TAB COUNTER FOR ASCII INPUT/OUTPUT BTAB: BUFF1*2 ;BUFFER TABLE BUFF2*2 BUFF3*2 BUFF4*2 BUFF1: .BLK 104 ;BUFFERS BUFF2: .BLK 104 BUFF3: .BLK 104 BUFF4: .BLK 104 .LOC .-420 ; P-CODE SYSTEM INITIALISATION PROCEDURES. .PCODE: PCODE PI: .SYSTM >; X1 := NMAX; X0 := HMA; .MEM JMP . STA 0,HP ; INITIALISE HEAP POINTER TO MAX ADR SUB 1,0 ; X0 := INCREMENT FOR .MEMI CALL STA 1,DSP ; STACK STARTS AT INITIAL NMAX STA 1,MP STA 1,SP DSZ SP LDA 3,HP ; GET THE TOP OF THE HEAP STA 3,@DSP ;STORE?* IT IN THE STACK BASE .SYSTM ; ALLOCATE ALL AVAILABLE STORE .MEMI JMP . SUB 2,2 ;CHANNEL ZERO FOR 'COM.CM' SUB 1,1 ;NORMAL CHARACTERISTICS LDA 0,.COMF ;'COM.CM' .SYSTM .OPEN 77 ERR.2 LDA 2,.PCODE LDA 2,2,2 ;PICK UP THE LABEL OF FIRST CUP  LDA 1,C5 ADD 1,2 ;FORM ADDRESS OF FIRST POSSIBLE FILENAME STA 2,STPC JSR COMA1 JSR COMA2 ;READS PROGRAM NAMEAND GLOBAL SWITCHES RENU: JSR COMA1 ;READS NAME OF SECOND ARGUEMENT LDA 2,.COMA STA 2,TEMP ;SET UP THE BUFFER ADDRESS LDA 2,STPC ;FIRS T POSSIBLE NAME LDA 1,13,2 ;FIRST POSSIBLE OPEN COMMAND LDA 0,COPN ; CSP OPN SUB 1,0,SZR  ;IS IT A MATCH JMP NOMAT ;NO - THEN BLOW UP.... MOVZL 2,2 ;YES - THEN REPLACE FILENAME STA 2,TEMP2 LDA 0,M20 ;INITIAL COUNT STA 0,COUNT NEXTB: LDA 2,TEMP JSR @.BGET ;GET THE NEXT BYTE LDA 2,TEMP2 JSR @.BPUT ;PUT IT INTO THE FILENAME MOV 0,0,SNR ;TEST IF NULL AFTER THE PUT.... JMP ENAME ISZ TEMP ;UPDATE POINTERS ISZ TEMP2 ISZ COUNT ;ERROR IF OVER.. JMP NEXTB JSR .NERR 317 NOMAT: JSR~ .NERR 313 ; ROUTINE TO READ THE FILENAME COMA1: STA 3,TEMP LDA 0,.COMA ;ARGUEMENT BUFFER SUB 2,2 ;CHANNEL ZERO .SYSTM .RDL 77 ;READ THAT NAME JMP TSTEF ;SEE IF EOF? JMP @TEMP TSTEF: LDA 1,C6 ;TEST IF EOF SUB# 1,2,SZR ERR.2 ;IF NOT THEN BLOW... JMP ENDAL ; ROUTINE TO READ THE SWITCHES COMA2: STA 3,TEMP LDA 0,.SWA ;SWITCH BUFFER LDA 1,C4 ;TWO WORDS SUB 2,2 ;CHANNEL ZERO .SYSTM .RDS 77 ;READ FOUR BYTES JMP TSTEF JMP @TEMP ENAME: LDA 0,SPACE ;FILL OUT WITH SPACES LDA 2,TEMP2 F JSR @.BPUT ISZ TEMP2 ISZ COUNT JMP ENAME LDA 2,STPC ;UPDATE THE POINTER TO THE PCODE LDA 1,C15 ;BY AN APPROPRIATE AMOUNT ADD 1,2 STA 2,STPC JSR COMA2 LDA 0,SWA ;PICK UP SWITCHES MOVZL 0,0,SNC ;AND TEST IF 'A' SET ON. JMP RENU ;NO...THEN GNET NEXT PARAMETER SUBZR 0,0 ;OTHERWISE SET BIT 0 OF NULLS LDA 2,STPC LDA 1,-5,2 ;COUNT ADD 0,1 STA 1,-5,2 ;RESTORE COUNT JMP RENU ENDAL: LDA 0,.PCODE ; INITIALISE PC STA 0,PC DSZ PC NEXT .COMF: COMF*2 COMF: .TXT 'COM.CM' C5: 5 C4: 4 C15: 15 Ck6: 6 .COMA: COMA*2 .SWA: SWA*2 STPC: 0 M20: -20 COUNT: 0 COPN: 161425 COMA: .BLK 10 SWA: .BLK 2 .END PI R2ALLFILES.CM8R2SECHK,^ R2ROUTL,^ R2IFT,^ R2SMPD,^ R2SOVL,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2IREAL,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2CITAB,^ R2IFNS,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2RFT,^ R2SITAB,^ R2SDIV,^ R2IFW,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2CSPTAB,^ R2IOUTL,^ R2SDECODER,^ R2SMYP,^ R2RREAL,^ R2SREWR,^ R2RFNS,^ R2SSPTAB,^ R2SCONSTS,^ R2RFW^ R2SOVL.SR A-3 .TITLE R2SOVL .TXTM 1 .NREL .ENT XOVL ; AT XOVL IT IS ASSUMED THAT THE OVERLAY NODE AND NUMBER ; ARE PASSED VIA STACK LOCATION ...... IF THE FILE IS ; FOUND NOT TO BE OPEN IT IS OPENED OVOPN: .SYSTM .GCHN ; ASK RDOS FOR A CHANNEL ERR.2 STA 2,OVCEHN LDA 0,PASOL .SYSTM .OVOPN 77 ; OPEN OVERLAY FILE PASCAL.OL ERR.2 XOVL: LTOP1 0 ; PICK UP NODE AND NUMBER ADC 1,1 ; UNCONDITIONAL LOAD LDA 2,OVCHN .SYSTM .OVLOD 77 JMP ERCHK POP NEXT ERCHK: MOV 2,2,SNR JMP OVOPN ; ILLEGAL CHANNEL # LDA L*1,FSHUT SUB 2,1,SNR ; FILE OPEN ? JMP OVOPN ; YES ERR.2 ; NO .. LEAVE IT TO RDOS OVCHN: -1 FSHUT: 15 PASOL: .+1*2 .TXT "P4COMPILER.OL" .END R2SIOIN.SR 9"Z .TITLE R2SIOIN .ENT XRDI .ENT GETC,.GTCH .ENT CHINF .EXTN .DBIN .EXTD .READ,SPACE .ZREL GETC:.GTCH:CHIN .NREL ;THE INTEGER READING ROUTINE FOLLOWS, IT MAKES USE OF ;THE ENTRY POINT .DBIN IN MATH.LB XRDI: SUBZL 0,0 ;MAKE ONE STA 0,CHINF ;SET FLAG IN CHIN JSR @DBIN ;READ INTEGER POP1 2 ;FBA MOVZR 2,2 POP1 3 ;INTEGER DESTINATION MOVZR 3,3 STA 1,0,3 ;STORE INTEGER DSZ FST,2 ;MARK BUFFER FULL NEXT ;EOL MAY BE SET NEXT ;IT MAY NOT DBIN: .DBIN CHINF: 1 CHIN: STA 3,Z1 ;KEEP RETURN1 LTOP1 2 ;USE STACK TOP MOVZR 2,2 ; .. ITS A BYTE ADDRESS DSZ CHINF JMP DIGS ; LEADR: JSR @.READ LDA 1,SPACE ;GET SPACE CHAR SUB 0,1,SZR ;SPACE ? JMP DIGS+1 ; - NO ISZ FST,2 ; - YES, SET FB EMPTY JMP LEADR DIGS: JSR @.READ MOVS 0,0 ISZ FS*cT,2 ; SET FB EMPTY JMP @Z1 ; .END R2SDIV.SRR*1 .TITL R2SDIV .ENT .DIV .EXTN DVD .NREL .DIV : N. : STA 3,N.6 STA 2,N.5 STA 1,N.4 STA 0,N.3 MOVL 2,3,SZC NEG 2,2 SUBCL 3,3 MOVZL /3,3 MOVL# 0,0,SNC JMP N.1 INC 3,3 NEG 1,1,SZR COM 0,0,SKP NEG  0,0 N.1: STA 3,N.7 SUB 0,0 DVD LDA 2,N.5 MOVL 1,1,SNC MOVR 1,1,SZC  JMP N.2 LDA 3,N.7 MOVR 3,3,SNC COM 3,3,SKP NEG 0,0 MOVR 3,3,SNC NEG 1,1 MOVZ 3,3 JMP @N.6 N.2: LDA 0,N.3 LDA 1,N.4 JMP @N.6 N.3=\: 0 N.4: 0 N.5: 0 N.6: 0 N.7: 0 .END R2SECHK.SR 24 .TITLE R2SECHK ; ERROR HANDLER AND CHECK ROUTINES .ENT HELP .ENT ERRP,ERR2,ERR .ENT PCHKC,PCHK4,PCHK2,PCHK3 .EXTD PUTFL .EXTN .BIND, BFPTR,BFBP0 .TXTM 1 .NREL ERR2: ERR: .SYSTM .ERTN JMP . ERRP: LDA 2,0,3 ;PICK UP E CODE LDA 3,INSTR ;GET LAST INSTR MARKER JMP RATS ; THIS ENTRY FOR CHECK ADDRESS PCHK4: LTOP1 0 LDA 3,@PC ; PICK UP INSTR # MOV 2,2,SZR ; POSSIBLE NULL ? JMP NONIL ; NO MOV 0,0,SNR ; YES TEST TOP OF STACK NEXT ; ITS A NULL NONIL: LDA 1,DSP ; STACK BASE LafDA 2,@DSP ; INITIAL VALUE OF HP MOVZR 0,0 ; MAKE WORD ADDR JMP TEST KEEP: STA 3,INSTR NEXT LHB40: 40 PCHKC: LDA 0,LHB40 ADDS 0,1 ADDS 0,2 JMP PCHK2 PCHK3: MOV 2,1 ;LOWER BOUND TO AC1 LDA 2,@PC ;GET UPPER BOUND PCHK2: LDA 3,@PC ;GET INSTR BCOUNT LTOP1 0 ;STACK TOP TO AC0 TEST: ADDOR 0,0 ;UNSIGN THESE NUMBERS ADDOR 1,1 ;SO THAT THE FOLLOWING ADDOR 2,2 ;TESTS WORK AS INTENDED ! ADCZ# 2,0,SZC ;SKP IF AC0<=AC2 (UPPER) JMP MICE ;TROUBLE SUBZ# 1,0,SZC ;SKP IF AC0<12> BUGS" .TXT "<15><12>LAST KNOWN PCODE INSTRUCTION " ASIN: .BLK 4 .TXT "<15><12>INTERPRETER ERRO<#R CODE " ASEC: .BLK 4 .TXT "<15><12>" MESSF: .-1*2 .END SETUPAX.kj"S (* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ------------------------------ AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE I/II DATE : MARCH, 1977 *) (*******\********************************************************** THE MIDDLE PART ( IE THE WHOLE COMPLETETASK PROCEDURE ) OF THIS PROGRAM IS PRODUCED BY THE PROGRAM "FASTHASH". THE ORDER OF THE HASHING IS SUCH THAT THE ACTIVATION OF THIS WILL EVENTUALLY PRODUCE A SET OF PROCEDURES ( IE THE WHOLE PROCEDURE COMPLETABLE IN EITHER "P4ASM" OR "P4MAC" ) THAT WILL OPTIMIZE ALL THE PCODE MNEMONICS' ACCESS MECHANISM.  IT OUTPUTS A SET OF PROCEDURES WHICH FORM THE MIDDLE PART OF EITHER "P4ASM" OR "P4MAC". THE OUTPUT FILE CONTAINING THIS SET OF PROCEDURES IS "P4AMY1" IN RELEASE I OR "P4AMY2" IN RELEASE II. THIS PR>aOGRAM IS THE AMALGAMATION OF THREE SMALLER FILES "SETUPAX", "SETUPAY" AND "SETUPAZ". THIS PROGRAM IS ACTIVATED BY THE FOLLOWING COMMAND : SETUPA P4AMY ===================== WHERE P4AMY IS A OUTPUT FILE USED TO CONTAIN  PROCEDURE COMPLETABLE IN BOTH PROGRAMS "P4ASM" AND "P4MAC". l = AN PRR FILE USED TO CONTAIN SOME USEFUL INFORATION FOR USER REFERENCE. **************************************************************) PROGRAM SETUPA(OUTPUT, PRR); CONST TABLESIZE = 256; TABSIZE0 = 255; (** IE TABLE SIZE WITH ZERO ORIGIN **) TYPE STRING4 = ARRAY[1..4] OF CHAR; STRING6 = ARRAY[1..6] OF CHAR; TEMPLATE = RECORD PCODE : STRING4; 9 SEMICODE : STRING6; ACTION : INTEGER END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; I, J : 1..TABLESIZE; ZERO, ENTRIES, PETTY, K : INTEGER; PROCEDURE HASH?(HPCODE : STRING4; HSEMICODE : STRING6; HACTION : INTEGER); VAR TEMP, PI, RNDM : INTEGER; BEGIN TEMP := ORD(HPCODE[1]) * 4 + ORD(HPCODE[2]) * 2 + ORD(HPCODE[3]) ; IF ORD(HPCODE[m4]) <> 0 THEN TEMP := TEMP * 2 + ORD(HPCODE[4]); TEMP := TEMP MOD TABLESIZE; RNDM := 1; PI := 0; WHILE PCODETABLE[ (TEMP + PI) MOD TABLESIZE ].PCODE <> ' ' DO BEGIN (* OF THE REHASHING ALGORITHM MENTIONED BY9 DAVID GRIES IN HIS 'COMPILER CONSTRUCTION' *)  RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); END; (* AN EMPTY ENTRY IN THE PCODE TABLE IS FOUND *) WITH PCODETABLE[ (TEMP + PI)~o MOD TABLESIZE ] DO BEGIN PCODE := HPCODE; SEMICODE := HSEMICODE; ACTION := HACTION; END; ENTRIES := ENTRIES + 1 END (* OF HASH *); (*<<<<<<<<<<<<<<<<<<<< SETUPAX ENDS HERE >>>>>>>>>>>>>>>>>>>>*) GRAPH. #okPROGRAM GRAPH1(OUTPUT); CONST D=0.0625; S=32 ; H=34 ; C=6.28318 ; LIM=32 ; VAR X,Y:REAL; I,N:INTEGER; BEGIN FOR I:=0 TO LIM DO BEGIN X:=D*I; Y:=EXP(-X)*SIN(C*X) ; N:=TRUNC(S*Y)+H; REPEAT WRITE(' '); N:=N-1 - UNTIL N=0; WRITELN('*') END END. R2RREAL.SR ;z| .TITL R2RREAL ; THE P-CODE INTERPRETER'S REAL NUMBER OPERATIONS .ENT PADR,PSBR,PFLT,PFLO,PTRC,PNGR,PSQR,PABR,PMPR,PDVR .EXTD WSA .EXTN PFPIN,PFPES,PFPEX,PFPEF .NREL .PFPN: PFPIN ;ENTRY USED BY UNARY OPERATORS .PFPS: PFPES ;STORE FP0 ON STACK AND LEAVE RFPI .PFPX: PFPEX ;LEAVE RFPI WITHOUT STORING FP0 .PFPF: PFPEF ;SIMPLY CHECK RFPI FLAGS PFPBN: STA 3,AC3 ;USED BY FP BINARY OPERATORS JSR @.PFPN FDSZ SP ;GET SECOND FDSZ SP ;FP OPERAND FLDA 0,@SP ;FROM STACK FJMP @AC3 AC3: 0 PADR:#| JSR PFPBN FADD 1,0 FJMP @.PFPS PSBR: JSR PFPBN FSUB 1,0 FJMP @.PFPS SAC3: 0 FLSUB: STA 3,SAC3 ;USED ONLY BY THE FLOATS SUB 2,2 ;SL TO DL INTEGER LTOP1 3 ;GET TOP OF STACK MOVL# 3,3,SZC ;-VE ? ADC 2,2 ;YES STOP1 2 PUSH1 3 ;LS HALF OF DL IլNT JMP @SAC3 PFLT: JSR FLSUB JSR @.PFPN ;LOAD INTO FAC1 REDUNDANT FFLO @SP FJMP @.PFPX PFLO: POP1 0 ;FLOATS ITEM BELOW TOP POP1 1 ;OF STACK.....ASSUMES JSR FLSUB ;REAL ON TOP OF STACK JSR @.PFPN FFLO @SP FEXT ISZ SP ;RESTORE SP PUSH1 1 PUSH1 0 JMP @.PFPF PTRC: JSR @.PFPN ;FIXES TOP OF STACK FFIX @SP ;THIS FIXES TO DL FEXT ISZ SP ;RESTORE SP POP1 1 ;GET LS HALF OF DL INT LTOP1 0 ;MS HALF OF DL INT MOVZL 1,2  ;FOLLOWING TESTS THAT INC 0,0,SNC ;SIGN OF BOTH HALVES = MOVZR 0,0,SZR ;AND MS HALF HAS NO VALUE JMP PTRCE ;CONDITIONS NOT MET STOP1 1 JMP @.PFPF PTRCE: ERR.P PERTR ;TRUNCATE ERROR PNGR: JSR @.PFPN ;NEGATE FP NUMBER FNEG 1,0 FJMP @.PFPS PSQR: JSR @.PFPN ;SQUARE FP NUMBER FMOV 1,0 FMPY 1,0 FJMP @.PFPSH> PABR: JSR @.PFPN ;ABS OF FP NUMBER FPOS 1,0 FJMP @.PFPS PMPR: JSR PFPBN ;MULTIPLY FP FMPY 1,0 FJMP @.PFPS PDVR: JSR PFPBN ;DIVIDE FP NUMBER FDIV 1,0 FJMP @.PFPS .END FASTHASH.i!(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ------------------------------ AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (***********j****************************************************** THIS PROGRAM IS TO READ IN THE HASH TABLE FROM THE INPUT FILE "SETUP.TB" PRODUCED BY THE PROGRAM "SETUP". IT THEN PROCESSES A  BIG PCODE PROGRAM (PREFERABLY "P4ASM.PC" OR "P4MAC.PC") TO OBTAIN THE FREQUENCIES OF THE PCODE INSTRUCTIONS. FINALLY IT PRODUCES A PROCEDURE (IE THE PROCEDURE COMPLETETASK IN THE PROGRAM "SETUPA"). THE ORDERING OF THE HASHING SEQUENCE IN THE OUTPUT PROCEDURE IS SUCH THAT ACCESSING THE PCODE INSTRUCTIONS IN THE TABLE WILL BE MUCH MORE IMPROVED. TO ACTIVATE THIS PROGRAM, DO THE FOLLOWING COMMAND :  FASTHASH PCODEPROGRAM SETUPAY SETUP.TהB DEVICE ============================================= WHERE SETUP.TB = INPUT FILE CONTANING THE HASH TABLE PRODUCED BY THE PROGRAM "SETUP". = PRD k$FILE CONTAINING ANY BIG PCODE PROGRAM ( IE "P4ASM.PC" OR "P4MAC.PC"). SETUPAY = OUTPUT FILE CONTAINING THE PROCEDURE WHICH  IS "PROCEDURE COMPLETETASK " IN THӫE PROGRAM "SETUPA". = PRR FILE CONTAINNG FREQUENCIES OF PCODE INSTRUCTIONS IN PCODEPROGRAM FOR USER REFERENCE. ***************************!*****************************************) PROGRAM FASTHASH(PRD, PRR, INPUT, OUTPUT); LABEL 0; CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) TYPE INSTRTYPE = (COMMENT, LLABEL, NONPCODE, PCODES, PCODENTRY); STRING3 = ARRAY[1..3] OF CHAR; STRING4 = ARRAY[1..4] OF CHAR; TEMPLATE = RECORD PCODE : STRING4; SEMICODE, ACTION, FREQUENCY : INTEGER  END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; SORT : RECORD SPCODE :STRING4;  SSEMICODE, SACTION, SFREQUENCY : INTEGER END;  CH : CHAR; DOTNAME : STRING3; I, J, ICOUNT, SMIN, SMAX : INTEGER; ENT : BOOLEAN; PCTYPE : INSTRTYPE; PROCEDURE OCTALIZER(SMCODE : INTEGER); VAR I, TEMP : INTEGER;  COMPLEMENT : BOOLEAN; OCTALDIGIT : ARRAY[1..6] OF INTEGER; BEGIN COMPLEMENT := SMCODE < 0; SMCODE := ABS(SMCODE); FOR I := 1 TO 6 DO BEGIN TEMP := SMCODE DIV 8; OCTALDIGIT[I]:= ABS(SMCODE - TEMP * 8); SMCODE := TEMP END; IF COMPLEMENT THEN BEGIN I := 1; WHILE OCTALDIGIT[I] = 0 DO I := I + 1; OCTALDIGIT[I] := 8 - OCTALDIGIT[I]; I := I + 1; WHILE I < 6 DO BEGIN OCTALDIGIT[I] := 7 - OCTALDIGIT[I]; I := I + 1 END; OCTALDIGIT[6] := 1 END; FOR I := 6 DOWNTO 1 DO WRITE(PRR, OCTALDIGIT[I] : 1) END (* OF OCTALIZER *); PROCEDURE CHECK; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; OP  : STRING4; PROCEDURE ERRORP; BEGIN MORETRY := FALSE; WRITE(OUTPUT, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(PRD, CH); WRITE(OUTPUT, CH) UNTIL EOLN(PRD); READ(PRD, CH); (* RID EOLN *) WRITE(OUTPUT, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(OUTPUT) END (*** ERRORP ***); BEGIN (* OF CHECK *) OP[1] :=XC CH; READ(PRD, OP[2], OP[3]); IF EOLN(PRD) THEN OP[4] := ' ' ELSE READ(PRD, OP[4]); READLN(PRD); TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THE}N TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLESIZE; MORETRY := TRUE; SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP F ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE] DO BEGIN IF OP = PCODE THEN BEGIN FREQUENCY := FREQUENCY + 1; MORETRY := FALSE; ENCD ELSE IF PCODE = ' ' THEN ERRORP; IF MORETRY THEN BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); SMAX := SMAX + 1 END{! END END (*** OF CHECK ***); BEGIN (* OF MAIN *) WRITELN(OUTPUT, '; FASTHASH START', 'S NOW'); ICOUNT := 3; REPEAT READ(INPUT, CH) UNTIL CH = '*'; (*READ OFF HASH TABLE HEADER *) FOR I := 0 TO TAUBSIZE0 DO WITH PCODETABLE[I] DO BEGIN FOR J := 1 TO 4 DO READ(INPUT, PCODE[J]); READLN(INPUT, SEMICODE, ACTION) END; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO IF PCODE[1] = ' ' TH0EN FREQUENCY := -1; (************ START READING IN THE PCODE PROGRAM FROM PRD ************) (* HASH TABLE HAS JUST BEEN READ IN FROM SETUP.TB *) READ(PRD, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(OUTPUT, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(OUTPUT); GOTO 0 END; READLN(PRD); REPEAT READ(PRD, CH); IF CH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF CH = 'P' THEN PCTYPE := PCODENTRY ELSE BEGIN READ(PRD, CH); IF CH = '.' THEN PCTYPE := NONPCODE ELSE PCTYPE := PCODES >JEND; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(PRD, J); IF (ICOUNT <> J) AND (J <> 0) THEN WRITELN(O3UTPUT, 'I', J : 5, ' ' : 14, '; ??? PCODE'  , ' COUNT OUT OF ST', 'EP ???'); ICOUNT := J; READ(PRD, CH) (* READ OFF EOLN *) END;  LLABEL : (* LABELS *) READLN(PRD); NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) READLN(PRD); PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN | CHECK;  ICOUNT := ICOUNT + 1 END; PCODENTRY : (* PACKED PCODE ENTRY POINT *) READLN(PRD) END (* OF CASE PCTYPE *); WHILE EOLN(PRD) DO READLN(PRD) UNTIL EOF(PRD); WRITELN(OUTPUT); WRITELN(OUTPUT, '; IDEAL SEARCHES', ' = ', SMIN); WRITELN(OUTPUT, '; ACTUAL SEARCHE', 'S = ', SMAX); J := 1; REPEAT ENT := FALSE; FOR I := 0 TO TABSs IZE0 - J DO BEGIN  IF PCODETABLE[I].FREQUENCY < PCODETABLE[I + 1].FREQUENCY THEN BEGIN ENT := TRUE; WITH PCODETABLE[I], SORT DO BEGIN  SPCODE := PCODE; SSEMICODE := SEMICODE; SACTION := ACTION; SFREQUENCY := FREQUENCY END; PCODETABLE[I].PCOtDE := PCODETABLE[I + 1].PCODE; PCODETABLE[I].SEMICODE := PCODETABLE[I + 1].SEMICODE; PCODETABLE[I].ACTION := PCODETABE[I + 1].ACTION; PCODETABLE[I].FREQUENCY := PCODETABLE[I + 1].FREQUENCY; WITH PCODETABLE[I + 1], SORT DO BEGIN PCODE := SPCODE; SEMICODE := SSEMICODE; ACTION := SACTION;  FREQUENCY := SFREQUENCY END END END; J := J + 1; UNTIL NOT ENT; WRITELN(OUTPUT); FOR I := 1 TO 4 DO WRITE(OUTPUT, ' PCODE' : 10, ' SMCODE' : 7, ' ACT' : 4, ' FREQ' : 5); WRITELN(OUTPUT); FOR I := 1 TO 4 DO WRITE(OUTPUT, '----------' : 10, '=======' : 7, '----' : 4, '*****' : 5); WRITELN(OUTPUT); I := 0; REPEAT WITH PCODETABLE[I] DO BEGIN WRITE(OUTPUT, PCODE : 10, SEMICODE : 7, ACTION : 4, FREQUENCY + 1 : 5); IF I MOD 4 = 3 THEN WRITELN(OUTPUT) END; I := I + 1 UNTIL PCODETABLE[I].FREQUENCY = -1; WRITELN(OUTPUT); WRITELN(PRR); WRITELN(PRR, 'PROCEDURE COMPLE', 'TETASK;'); WRITELN(PRR); WRITELN(PRR); I := 0; J := 1; WRITELN(PRR, 'PROCEDURE TASK0;'); WRITELN(PRR, 'BEGIN'); REPEAT WITH PCODETABLE[I] DO BEGIN IF I MOD 30 = 29 THEBN BEGIN WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR); WRITELN(PRR, 'PROCEDURE TASK' : 14, J : 1, '; '); WRITELN(PRR, 'BEGIN'); J := J +02 1 END; WRITE(PRR, ' ' : 5, 'HASH(''' : 6, PCODE : 4, ''', ''' : 4); OCTALIZER(SEMICODE); WRITELN(PRR, ''', ' : 3, ACTION : 4, ');') END; I := I + 1;  UNTIL PCODETABLE[IS].PCODE = ' '; WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR, 'BEGIN'); FOR I := 0 TO J - 1 DO WRITELN(PRR, ' ' : 5, 'TASK' : 4, I : 1, '; '); WRITELN(PRR, 'END;'); WRITELN(PRR); WRITELN(PRR); WRITELN(PRR)&`; 0 : WRITELN END. PRIMES.& E-PROGRAM PRIMES(OUTPUT); (* EXAMPLE P54 PASCAL USER MANUAL AND REPORT *) CONST WDLENGTH=16; MAXBIT=15; W=2; VAR SIEVE,PRIMES : ARRAY[0..W] OF SET OF 0..MAXBIT; NEXT : RECORD WORD,BIT : INTEGER END; J,K,T,C : INTEGER; EMPTY : BOOLCEAN; BEGIN FOR T:=0 TO W DO BEGIN SIEVE[T]:=[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]; PRIMES[T]:=[] END; SIEVE[0]:=SIEVE[0]-[0]; NEXT.WORD:=0; NEXT.BIT:=1; EMPTY:=FALSE; WITH NEXT DO REPEAT WHILE NOT(BIT IN SIEVE[WORD]) DO BIT:=SU:PCC(BIT); PRIMES[WORD]:=PRIMES[WORD]+[BIT]; C:=2*BIT+1; J:=BIT; K:=WORD; WHILE K<=W DO BEGIN SIEVE[K]:=SIEVE[K]-[J]; K:=K+WORD*2; J:=J+C; WHILE J>MAXBIT DO BEGIN K:=K+1; J:=J-WDLENGTH  END END; IF SIEVE[WORD]?=[] THEN BEGIN EMPTY:=TRUE; BIT:=0 END; WHILE EMPTY AND (WORDC 0,0,SZR JMP .-2 JMP 0,3 .RITE: WRITE BIND: .BIND XWRI: POP1 2 ;FBA MOVZR 2,2 POP1 0 ;$ OF CHARS STA 0,AD1 ;KEEP A COPY POP1 1 ;INTEGER JSR @BIND PURGE: LDA 2,FCH,2 ;CHANNEL # LDA 1,RHB AND 1,2 LDA 3,BFHLF ;BUFFER HALFWAY LDA 1,BFPTR ;PTR UPDATED BY PUT SUBZ 3,1,SEZ ;CHARS IN BUFF JMP OK ERR.P ;REPORT NOTHING PERIW ; TO PRINT OK: SUBZ 1,0,SBN ;LEADING SPACES ? JMP NOLDR ;NO SUB 0,3 ;YES LDA 1,AD1 ;GET # OF CHARS NOLDR: MOV 3,0 ;BYTE PTR JSR @.RITE ; ;NOW RESET BUFFER TO ALL SPACES ; LDA 2,BFHLF STA 2,BFPTR ;RESET PTR SUB 0,0 STA 0,PUTFL NEXT PUTCH: STA 3,Z1 LDA 1,PUTFL ;GET FLAGS MOVL# 1,1,SZC ;SIGN FLAG SET ? JMP SSET ;YES MOVZR 0,0,SNC ;NO - B15 0 FOR SPACE JMP @Z1 ;IGNORE SPACES MOVR 1,1 ;CARRY> IS #0 - USE IT STA 1,PUTFL ;SIGN ENCOUNTERED MOVZR# 0,0,SZC ;+ OR - ? JMP @Z1 ;+ MOVOL 0,0 ;REFORM - JMP SAND ;LETIT GO SSET: MOVR# 1,1,SZC ;DIGIT FLAG SET ? JMP SAND ;YES LDA 2,ZERO ;NO - LEADING ZERO ? SUB# 0,2,SNR JMP @Z1 ;IGNORE LEAD&ING ZEROES MOV 0,0,SZR ;NULL TERMINATING INTEGER ? JMP SETD MOV 2,0 ;PASS ZERO FOR NULL JMP SAND SETD: INC 1,1 ;SET DFLAG STA 1,PUTFL ;SET D FLAG SAND: MOVS 0,0,SNR ;LAST NULL ? JSR @Z1 ;YES - IGNORE IT LDA 2,BFPTR ;CURRENT POSN. JSR @.BPUT ISZ BFPTR JMP @Z1 ZERO: 60 SPWD: 1B2+1B10 ;SPACE IN EACH BYTE BFSIZ: 66. ;WORDS BFBP0: BUFFA*2 ;FIRST CHAR BFHLF: BUFFA*2+66. ;HALFWAY CHAR BFPTR: BUFFA*2+66. ;CURRENT PTR BUFFA: .DO 66. ;LINE BUFFER 1B2+1B10 .ENDC .END R2STESTS.SR 6Ɲ .TITL R2STESTS ; THE P-CODE INTERPRETER'S COMPARISON OPERATIONS ; THESE ARE RATHER TRICKY: "DOCUMENTATION" AVAILABLE FROM LW .ENT PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PFPIN .EXTD MIN4,WSA,LHB .NREL ASP=Z1 ;SEE PSSET ABOUT ASP & SASP .MACRm"O SASP LDA ^1,SP LDA 0,MIN4 ADD 0,^1 STA ^1,ASP % ; BRANCH TABLE FOR SUBROUTINE COMP COMTAB: CM ;MULTIPLE CI ;INTEGER CR ;REAL CI ;BOOLEAN CS ;SET CI ;ADDRESS ; HELPFUL HINT: SUBROUTINE COMP LEAVES ZERO IN AC0. THEREFORE, IN ; THE FEOLLOWING PEQU ET AL:- ; "INC 0,0" MEANS "AC0:= TRUE" ; "SUBCL 0,0" " "AC0:= VALUE OF CARRY" ; "SUBL 0,0" " "AC0:= VALUE OF NOT CARRY" ; NONE OF ABOVE " "AC0 REMAINS FALSE" PEQU: JSR COMP MOV# 1,1,SNR ;IFF AC1=0 & CARRY=0 SUBL 0,0 JMP COM2 PNEQ: JSR COMP MOV# 1,1,SNR ;IFF AC1 NON-ZERO OR (AC1=0 & CARRY=1) SUBCL 0,0,SKP INC 0,0 JMP COM2 PGEQ: JSR COMP SUBL 0,0 ;IFF CARRY=0 JMP COM2 PGRT: JSR COMP MOVC 1,1,SEZ ;IFF AC1 NON-ZERO & CARRY=0 INC 0,0 JMP COM2 PLEQ: JSR }COMP MOV# 1,1,SNR ;IFF (AC1=0 & CARRY=0)OR CARRY=1 SUBL 0,0,SKP SUBCL 0,0 JMP COM2 PLES: JSR COMP MOV# 1,1,SEZ ;IFF AC1 NON-ZERO & CARRY=1 INC 0,0 JMP COM2 COM2: STOP1 0 NEXT .COMT: COMTAB ; COMP IS A UNIVERSAL (IE CAN BE USED FOR ALL STANDARD TYPES) ; SUBROUTINE WHICH COMPARES THE TOP 2 ELEMENTS OF THE STACK. IT ; RETURNS CARRY & AC1 SET AS FOLLOWS:- ; CARRY=1 <=> LESS THAN ; AC1=0 <=> EQUAL ; PLUS THE SPECIAL CASE (FOR SETS ONLY) ; (CARRY=1 & AC1=0) <=> "NO RELATION" ; THISv IS SUFFICIENT INFO FOR ANY OF THE 6 COMPARISON OPS ; IF YOU REALLY INSIST ON STUDYING THIS CODE, HAVE 2 ASPRINS READY - ; & BLAME JJS, NOT ME ; OTHER POINTS TO NOTE ARE THAT S/R COMP CLEARS ALL RUBBISH OFF THE ; STACK & SETS AC0="FALSE" SO THAT (AFTER POSSIBLE RESETTING ; BY PEQU ET AL) IT IS ALL READY FOR A QUICK "STOP1" COMP: MOV 2,0 ;FIRST WE BRANCH ACCORDING TO TYPE LDA 2,.COMT ADD 1,2 JMP @0,2 .PFPN: PFPIN ; *** REAL - COMPARISON IS ARITH SUBTRACTION CR: MOV 3,0 ;TO PRESERVE LINK JSR @.PFPN& ;INIT'ISE FP & LOAD FAC1 FDSZ SP FDSZ SP FLDA 0,@SP FSUB 1,0 FSTA 0,@SP FEXT ;EXIT FLOAT.PT LDA 2,WSA ;CHECK REPLY WD OK LDA 1,0,2 MOV 1,1,SNR JMP CR1 ;IF NO PROBS ERR.P PERFP CR1: MOV 0,3 ;RESTORE LINK SUB 1,1 ;CRAFTY USE OF INTEGER PHATH! PUSH1 1 JMP CI ; *** MULTIPLE - ARITH SUBTR OF "N-WORDS-LENGTH" INTEGERS (UNSIGNED) CM: NEG 0,2 ;START AT MOST SIGNIFICANT END. WHILE POP1 0 ;WORD-PAIRS ARE EQUAL, CARRY ON. FIRST MOVZR 0,0 LTOP1 1 ;UNEQUAL PAIR GIVES REQD RELATION MOVZR 1,1 STA 0,AI1 DSZ AI1 STA 1,AI2 DSZ AI2 CM1: LDA 0,@AI1 LDA 1,@AI2 INC 2,2,SZR ; TO DEAL WITH ODD BYTE JMP CM2 ; - NO LDA 2,LHB ; YES AND 2,0 ; AND 2,1 SUB 2,2 COM 2,2 CM2: SUBO 0,1,SNR INCC 2,2,SNR JMP COM1 JMP CM1 ; *** INTEG,BOOLE,ADDR#} - ARITH SUBTR (UNSIGNED) CI: POP1 0 LTOP1 1 ADDOR 0,0 ;CONVERTS SIGNED INTEGERS TO UNSIGNED ADDOR 1,1 SUBO 0,1 JMP COM1 ; *** SET - LOOK AT CORRESPONDING WORD-PAIRS. WHENEVER "NO RELN", ; EXIT "NO RELN". WHILE "EQUAL", KEEP OPEN MIND. BUT AS SOON AS GEQ ; OR LEQ FOUND, ALL THE REST MUST BE GEQ OR LEQ RESPECTIVELY, ELSE ; "NO RELN" CS: SASP 2 CS1: POP1 0 LDA 1,@ASP DSZ ASP SUBZ# 0,1,SZR JMP CS2 ;IF NOT EQU LDA 0,SP SUBZ# 0,2,SNC JMP CS1 SUBO 1,1 JMP CS6 ;IF EQU (DONE) CS2: AND 0,1 SUB#V 0,1,SNR JMP CS4A ;IF GEQ SO FAR ISZ ASP LDA 0,@ASP DSZ ASP SUB# 0,1,SNR JMP CS5A ;IF LEQ SO FAR CS3: STA 2,SP SUBZ 1,1 JMP CS6 ;ELSE NEQ (DONE) CS4: POP1 0 LDA 1,@ASP DSZ ASP AND 0,1 SUBZ# 0,1,SNC JMP CS3 ;IF NEQ (DONE) CS4A: LDA 0,SP SUBZ# 0,2,SNC JMP CS4 MOVZ 0,1 ;SETS C=0 & AC1 NON-ZERO STA 2,SP JMP CS6 ;IF GEQ (DONE) CS5: POP1 0 LDA 1,@ASP DSZ ASP AND 1,0 SUBZ# 1,0,SNC JMP CS3 ;IF NEQ (DONE) CS5A: LDA 0,SP SUBZ# 0,2,SNC JMP CS5 MOVO 0,1 ;SETS C & AC1 NON-ZERO STA 2aLk,SP ;IF LEQ (DONE) CS6: POP ;GET RUBBISH OFF STACK POP POP COM1: SUBC 0,0 JMP 0,3 .END MAKER2SYMB.CMm 5߼DELETE MAC.PS;^ MAC/N/S NBID FPID OSID R2SSYMBOLS^ R2ROUTL.SR R .TITL R2ROUTL .ENT .BPUT,.BGET,.GCH,.FIND .ENT TEMP .EXTN ERR2,FINT,ERRP,PCODE .EXTD CHAN,SPACE,TEMP2,CNTAD,TABAD .EXTD LHB,RHB .TXTM 1 .ZREL ; DEFINE SOME CONSTANTS IN PAGE ZERO THAT ARE ASSUMED TO HAVE ; ADDRESSES 50 AND 51.... ERR2 ; .ERR2 = 50 ERRP ; .ERRP = 51 .BPUT: BPUT .BGET: BGET .GCH: GCHAN .CTAB: CTAB .BTAB: BTAB-1 .OTAB: OTAB-1 .TTAB: TTAB-1 .FIND: FIND TEMP: 0 .NREL ; ROUTINE TO WRITE A BYTE TO A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - BYTE TO BE WRITTEN(IN LHB) ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - UNDEFINED BPUT: STA 3,BLNK ;LINK STORED LDA 1,LHB ;MASK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMI{NE WHICH BYTE MOVS 0,0,SKP ;RIGHT OR LEFT? MOVS 1,1 LDA 3,0,2 ;LOAD FROM WORD ADDRESS AND 1,3 ;MASK OUT OTHER BYTE ADD 0,3 ;REPLACE WITH NEW BYTE STA 3,0,2 ;AND RESTORE JMP @BLNK ; ROUTINE TO READ A BYTE FROM A GIVEN BYTE ADDRESS ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - BYTE ADDRESS ; ; RETURN - AC0 - VALUE OF BYTE READ(IN LHB) ; AC1 - UNDEFINED ; AC2 - UNDEFINED BGET: STA 3,BLNK ;STORE LINK LDA 1,LHB ;BYTE MA#SK FOR LEFT HAND BYTE MOVZR 2,2,SZC ;DETERMINE WHICH BYTE MOVS 1,1 ;RIGHT OR LEFT? LDA 0,0,2 ;LOAD FROM WORD ADDRESS. AND 1,0,SZC ;EXTRACT BYTE MOVS 0,0 ;SWOP INTO LHB JMP @BLNK ; ROUTINE TO GET THE CHANNEL NO. AND RECORD LENGTH OF SPECIFIC FILE. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - WORD ADDRESS OF FBA ; ; RETURN - AC0 - CHANNEL NUMBER ; AC1 - RECORD LENGTH ; AC2 - WORD ADDRESS OF FBA ; ; NORMAL RETURN - NONYE CHARACTER INPUT/OUTPUT ; RETURN + 1 - CHARACTER INPUT/OUTPUT GCHAN: STA 3,BLNK ;STORE LINK LDA 1,LHB ;MASK FOR LEFT HAND BYTE LDA 0,FCH,2 ;CHANNEL WORD OF FBA ANDS 0,1,SNR ;ISOLATE RECORD LENGTH ISZ BLNK ;AND TEST IF CHAR I/O. MOVZL 1,1 " ;MAKE IT A BYTE COUNT LDA 3,RHB ;MASK CHANNEL NUMBER AND 3,0 STA 0,CHAN JMP @BLNK BLNK: 0 ; ROUTINE TO SEARCH TABLES FOR BUFFER DETAILS. ; ; CONDITIONS ... ; ; ENTRY - AC0 - UNDEFINED ; AC1 - UNDEFINED ; AC2 - CHANNEL NUMBER OF FILE (OR ZERO) ; ; RETURN - AC0 - BYTE ADDRESS OF BUFFER AREA(BASE) ; AC1 - ADDRESS OF BYTE COUNT (DISPLACEMENT) ; AC2 - WORD ADDRESS OF ENTRY IN CHANNEL TABLE FIND: LDA 0,TSIZE ;SIZE OF TABLE LDA 1,.CTAB ;ADDRESS OF CHANNExL TABLE(TOP) STA 1,TEMP RETST: LDA 1,@TEMP ;SEARCH UNTIL A MATCH OR ERROR SUB 2,1,SNR JMP RETRN ;A MATCH IS FOUND DSZ TEMP INC 0,0,SZR ;TABLE EXHAUSTED? JMP RETST ;NO,FIND NEXT ERR.P ;YES, BLOW..... 411 RETRN: LDA 1,.OTAB SUBZ 0,1 ;ADDRESST OF BYTE COUNT(DISPLACEMENT) STA 1,CNTAD LDA 1,@CNTAD ;LOAD ACTUAL COUNT LDA 2,C200 SUBZ# 1,2,SZC ;TEST IF LINE TOO LONG JMP .+3 JSR .NERR ;LINE LIMIT FLAGGED TO CLI 22 LDA 1,CNTAD LDA 2,.TTAB SUB 0,2 ;ENTRY IN THE TABLE TAB COUNTS STA 2,TABA)D LDA 2,.BTAB SUB 0,2 LDA 0,0,2 ;SET BUFFER ADDRESS(BASE) LDA 2,TEMP ;CHANNEL TABLE ADDRESS JMP 0,3 .NERR: LDA 2,0,3 ;PICK UP ERROR CODE ERR.2 C200: 200 TSIZE: -4 ;TABLE SIZE 0 0 0 CTAB: 0 ;TOP OF CHANNEL TABLE OTAB: .BLK 4 ;COUNT TABLE TTAŢB: .BLK 4 ;TAB COUNTER FOR ASCII INPUT/OUTPUT BTAB: BUFF1*2 ;BUFFER TABLE BUFF2*2 BUFF3*2 BUFF4*2 BUFF1: .BLK 104 ;BUFFERS BUFF2: .BLK 104 BUFF3: .BLK 104 BUFF4: .BLK 104 .LOC .-420 ; P-CODE SYSTEM INITIALISATION PROCEDURES. .PCODE: PCODE PI: .SYS5TM ; X1 := NMAX; X0 := HMA; .MEM JMP . STA 0,HP ; INITIALISE HEAP POINTER TO MAX ADR SUB 1,0 ; X0 := INCREMENT FOR .MEMI CALL STA 1,DSP ; STACK STARTS AT INITIAL NMAX STA 1,MP STA 1,SP DSZ SP LDA 3,HP ; GET THE TOP OF THE HEAP STA 3,@DSP ;4STORE IT IN THE STACK BASE .SYSTM ; ALLOCATE ALL AVAILABLE STORE .MEMI JMP . SUB 2,2 ;CHANNEL ZERO FOR 'COM.CM' SUB 1,1 ;NORMAL CHARACTERISTICS LDA 0,.COMF ;'COM.CM' .SYSTM .OPEN 77 ERR.2 LDA 2,.PCODE LDA 2,2,2 ;PICK UP THE LABEL OF FIRST CUP LDA 1,C5 ADD 1,2 ;FORM ADDRESS OF FIRST POSSIBLE FILENAME STA 2,STPC JSR COMA1 JSR COMA2 ;READS PROGRAM NAMEAND GLOBAL SWITCHES RENU: JSR COMA1 ;READS NAME OF SECOND ARGUEMENT LDA 2,.COMA STA 2,TEMP ;SET UP THE BUFFER ADDRESS LDA 2,STPC n;FIRST POSSIBLE NAME LDA 1,13,2 ;FIRST POSSIBLE OPEN COMMAND LDA 0,COPN ; CSP OPN SUB 1,0,SZR ;IS IT A MATCH JMP NOMAT ;NO - THEN BLOW UP.... MOVZL 2,2 ;YES - THEN REPLACE FILENAME STA 2,TEMP2 LDA 0,M20 ;INITIAL COUNT STA 0,COUNT NEXToB: LDA 2,TEMP JSR @.BGET ;GET THE NEXT BYTE LDA 2,TEMP2 JSR @.BPUT ;PUT IT INTO THE FILENAME MOV 0,0,SNR ;TEST IF NULL AFTER THE PUT.... JMP ENAME ISZ TEMP ;UPDATE POINTERS ISZ TEMP2 ISZ COUNT ;ERROR IF OVER.. JMP NEXTB JSR .NERR 317 NOMAT': JSR .NERR 313 ; ROUTINE TO READ THE FILENAME COMA1: STA 3,TEMP LDA 0,.COMA ;ARGUEMENT BUFFER SUB 2,2 ;CHANNEL ZERO .SYSTM .RDL 77 ;READ THAT NAME JMP TSTEF ;SEE IF EOF? JMP @TEMP TSTEF: LDA 1,C6 ;TEST IF EOF SUB# 1,2,SZR ERR.2 ;IF NOT THEN BLOW... JMP ENDAL ; ROUTINE TO READ THE SWITCHES COMA2: STA 3,TEMP LDA 0,.SWA ;SWITCH BUFFER LDA 1,C4 ;TWO WORDS SUB 2,2 ;CHANNEL ZERO .SYSTM .RDS 77 ;READ FOUR BYTES JMP TSTEF JMP @TEMP ENAME: LDA 0,SPACE ;FILL OUT WITH SPACES LDA 2,ZTEMP2 JSR @.BPUT ISZ TEMP2 ISZ COUNT JMP ENAME LDA 2,STPC ;UPDATE THE POINTER TO THE PCODE LDA 1,C15 ;BY AN APPROPRIATE AMOUNT ADD 1,2 STA 2,STPC JSR COMA2 LDA 0,SWA ;PICK UP SWITCHES MOVZL 0,0,SNC ;AND TEST IF 'A' SET ON. JMP RENU ;NO...THEN GET NEXT PARAMETER SUBZR 0,0 ;OTHERWISE SET BIT 0 OF NULLS LDA 2,STPC LDA 1,-5,2 ;COUNT ADD 0,1 STA 1,-5,2 ;RESTORE COUNT JMP RENU ENDAL: FINT ;START RFPI LDA 0,.PCODE ; INITIALISE PC STA 0,PC DSZ PC NEXT .COMF: COMF*2 COMF: .TXT 'COM. CM' C5: 5 C4: 4 C15: 15 C6: 6 .COMA: COMA*2 .SWA: SWA*2 STPC: 0 M20: -20 COUNT: 0 COPN: 161425 COMA: .BLK 10 SWA: .BLK 2 .END PI R2SMPD.SRU+2\ .TITL R2SMPD .ENT MPY,MPY0,DVD .EXTD .SV0 .ZREL MPYA: .MPYA MPYU: .MPYU DIVU: .DIVU .NREL MPY0 = JSR @MPYU MPY = JSR @MPYA DVD = JSR @DIVU ; SINGLE PRECISION FAST MULTIPLICATION ; ; ENTRY CONDITIONS - AC0 - ZERO OR VALUE TO BFE ADDEDTO RESULT ; AC1 - MULTIPICAND ; AC2 - MULTIPLIER ; AC3 - LINK ; ; EXIT CONDITIONS - AC0 - RESULT ; AC1-AC3 - UNDEFINED .MPYU: SUBC 0,0 ;CLEAR AC0, DON'T DISTURB CARRY .MPYA: STA 3,SAV3 ;SAVE AC3 ADCZ# 1,2,SZC ;SKIPS IF AC2/<=AC1 MOV 2,3,SKP ;LARGEST IN AC3 MOV 1,3,SKP MOV 1,2 ;SMALLEST (COUNT) AC2 SPFM: MOVZR 2,2,SZC ;BIT SET? ADD 3,0 ;YES MOV 2,2,SNR ;LAST BIT? JMP .+3 ;YES ADDZ 3,3 ;NO.. JMP .-5 ;..SO REPEAT MOV 0,1 SUB 0,0 JMP @SAV3 ; SINGLE PRECISION \UNSIGNED DIVIDE ; ; ENTRY CONDITIONS AC0 - DIVIDEND (HIGH ORDER) MOST SIG.BITS ; AC1 - DIVIDEND (LOW ORDER) LEAST SIG.BITS ;  AC2 - DIVISOR ; AC3 - UNUSED ; ; EXIT CONDITIONS AC0 - REMAINDER ; ] AC1 - QUOTIENT ; AC2 - UNCHANGED ; AC3 - DESTROYED ; .DIVI: SUB 0,0 ; INTEGER DIVIDE,CLEAR AC0 .DIVU: STA 3,SAV3 ; SAVE AC3 SUBZ# 2,0,SZC ; TEST FOR OVERFLOW JMP DIVE ;SET CARRY AND RETURN LDA '$3,M20 ; 16 ITERATIONS MOVZL 1,1 ; SHIFT LOW DIVIDEND DIVN: MOVL 0,0 ; SHIFT HIGH DIVIDEND SUB# 2,0,SZC ; DOES DIVISOR GO IN? SUB 2,0 ; YES MOVL 1,1 ; SHIFT LOW DIVIDEND INC 3,3,SZR ; CHECK COUNT JMP DIVN ; NOT DONE SUBO 3,3,SKP ; DONE ,CLEAR CARRY DIVE: SUBZ 3,3 ; SET CARRY JMP @SAV3 ; RETURN M20: -20 SAV3: 0 ;RETURN ADDRESS .END ;END OF UNSIGNED MULTIPLY R2SRANDOM.SR ; .TITL R2SRANDOM .ENT XRRR,XWDR,XEOR .EXTD TEMP2,.GCH,CHAN .NREL ; INPUT / OUTPUT ROUTINES FOR RANDOM FILES ; ; XRRR: SUBZL 2,2,SKP XWDR: SUBZ 2,2 STA 2,TEMP2 ;FLAG INDICATES WHETHER READING OR WRITING POP1 2 MOVZR 2,2 ;FBA ADDRESS JSR @.GCH ;vPICK UP CHANNEL NUMBER JMP .+1 MOV 2,0 LDA 2,CHAN LDA 3,C64 ;TEST IF LESS THAN 64 POP1 1 ;GET RECORD NUMBER ADCZ# 1,3,SNC ;RECORD LENGTH. JMP WRBLK ;IT'S A BLOCK TRANSFER DSZ TEMP2 JMP WRRI ;IT'S WRITE A RANDOM RECORD JMP RRRI ;IT'S READ A RANDOM RECORD WRBLK: DSZ TEMP2 JMP WRBI ;IT'S WRITE A RANDOM BLOCK JMP RRBI ;IT'S READ A RANDOM BLOCK C64: 100 ;CONSTANT 64 DECIMAL WRRI: MOV 0,3 STA 3,77,3 ;SET THE FLAG .SYSTM .WRR 77 ;WRITE A RECORD OUT IMMEDIATELY ERR.2 NEXT WRBI: MOVA 0,3 LDA 1,C255 ADD 1,3 ;FORM FLAG ADDRESS STA 1,0,3 ;SET FLAG .SYSTM .WRB 77 ;WRITE A RANDOM BLOCK IMMEDIATELY ERR.2 NEXT RRRI: .SYSTM .RDR 77 ;READ A RECORD IMMEDIATELY ERR.2 MOV 0,2 SUB 0,0 ;TEST IF EMPTY LDA 3,77,2 MOV 3,3,SNR SUBZL4 0,0 STA 0,FST,2 ;SET FLAG IN BUFFER NEXT RRBI: .SYSTM .RDB 77 ;READ A RANDOM BLOCK IMMEDIATELY ERR.2 MOV 0,2 SUB 0,0 LDA 3,C255 ;TEST IF EMPTY ADD 3,2 LDA 3,0,3 MOV 3,3,SNR ;IF EMPTY SET FLAG SUBZL 0,0 STA 0,FST,2 ;LOAD FLAG WORD NEXT ; PREDICATE FOR RANDOM FILES XEOR: POP1 2 ;FBA MOVZR 2,2 LDA 0,FST,2 ;LOAD FLAGS MOVZR 0,0 SUBL 0,0 PUSH1 0 ;RETURN BOOLEAN VALUE NEXT C255: 377 .END RGCD.%_PROGRAM RGCD(OUTPUT); (* EXAMPLE P82 PASCAL USER MANUAL AND REPORT *) VAR X, Y, N: INTEGER; FUNCTION GCD(M,N: INTEGER): INTEGER; BEGIN IF N=0 THEN GCD:=M ELSE GCD:=GCD(N,M MOD N) END; PROCEDURE TRY(A,B: INTEGER); BEGIN WRITELN(A,B,GCD(A,B)) ENDJp; BEGIN TRY(18,27); TRY(312,2142); TRY(61,53); TRY(98,868); END. HEADA2.j v(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (*$D-********"******************************************************* !!!! ONLY GOOD FOR PASCAL RELEASE II !!!! PROGRAM "P4ASM.SV" WILL READ IN A NOVA-PCODE PROGRAM AND TRANSLATE IT INTO THE CORRESPONDING PACKED PCODE PROGRAM WHICH WILL L/ATER BE PROCESSED BY THE NOVA ASSEMBLER TO PRODUCEAN INTERNAL CODE. SOURCE PROGRAM "P4ASM" IS THE AMALGAMATION OF FOUR SMALLER FILES : "HEADA2", "P4AMX2", "P4AMY2" AND "P4ASMZ2". TO ACTIVATE THIS PROGRAM, DO TH$E FOLLOWING COMMAND : P4ASM ANYPCODE.QC DEVICE ANYPCODE.PC ==================================== WHERE ANYPCODE.PC = INPUT FILE CONTAINING A PCODE PROGRAM ANYPCODE.QC = OuOUTPUT FILE CONTAINING THE CORRESPONDING PACKED PCODE PROGRAM. DEVICE = PRR FILE OR DEVICE FOR ERROR OR USEFUL MESSAGES. ******\******************************************************) PROGRAM P4ASM(OUTPUT, PRR, INPUT); ROMAN.  PROGRAM ROMAN(OUTPUT); VAR X,Y : INTEGER; BEGIN Y:=1; REPEAT X:=Y; WRITE(X,' '); WHILE X>=1000 DO BEGIN WRITE('M'); X:=X-1000 END; IF X>=500 THEN BEGIN WRITE('D'); X:=X-500 END; WHILE X>=100 DO BEGIN WRITE('C'); X:=X-100 END; IF X>=50 THEN BEGIN WRITE('L'); X:=X-50 END; WHILE X>=10 DO BEGIN WRITE(C'X'); X:=X-10 END;  IF X>=5 THEN BEGIN WRITE('V'); X:=X-5 END; WHILE X>=1 DO BEGIN WRITE('I'); X:=X-1 END; WRITELN; Y:=2*Y UNTIL Y>5000 END. HEADM2.jN(* UNIVERSITY OF LANCASTER DEPARTMENT OF COMPUTER STUDIES ============================== AUTHOR : CHI-KEUNG YIP LANGUAGE : NOVA PASCAL RELEASE II DATE : MARCH, 1977 *) (*$D-*a*************************************************************** !!!! ONLY GOOD FOR RELEASE II !!!! PROGRAM "P4MAC.SV" WILL READ IN A NOVA-PCODE PROGRAM AND TRANSLATE IT INTO THE CORRESPONDING PACKED PCODE PROGRAM WHICH WILL LATER BE PROCESSED BY THE NOVA MACRO-ASSEMBLER TO PRODUCE AN INTERNAL CODE. SOURCE PROGRAM "P4MAC" IS THE AMALGAMATION OF FOUR SMALLER FILES : "HEADM2", "P4AMX2", "P4AMY2" AND "P4MACZ2". TO ACTIVATE THIS PROGRAwM, DO THE FOLLOWING COMMAND : P4MAC ANYPCODE.QC DEVICE ANYPCODE.PC ==================================== WHERE ANYPCODE.PC = INPUT FILE USED TO CONTAIN A PCODE PROGRAM ANzYPCODE.QC = OUTPUT FILE USED TO CONTAIN THE CORRESPONDING INTERNAL CODE. DEVICE = PRR FILE OR DEVICE FOR ERROR OR USEFUL MESSAGES. ******************************D ******************************) PROGRAM P4MAC(OUTPUT, PRR, INPUT); P4ASMFILES.CMrr xP4ASMFILES.CM,NEW2P4ASMB,SETUP,FASTHASH,SETUPAX,SETUPAZ,^ HEADA2,HEADM2,P4AMX2,P4ASMZ2,P4MACZ2,NEW2P4ASME,MAKE2P4AM.CM^ R2SADMIN.SR 4F .TITL R2SADMIN ; THE P-CODE INTERPRETER'S "CONTROL" OPERATIONS, I.E.:- ; BLOCK, PROCEDURE, AND FUNCTION ENTRY/EXIT ; JUMPS .ENT PMST,PCUP,PCXP,PENT,PRET,PCSP .ENT PTJP,PFJP,PUJP,PXJP,PUJC .EXTN .BASE .EXTN SPTAB .NREL ;REMEMBER... ; SP=STACK PO%INTER ; MP=MARK POINTER ; SL=STATIC LINK ; DL=DYNAMIC LINK ; RA=RETURN ADDRESS ; PC=PCODE INSTRUCTION ADDRESS ; HP=HEAP POINTER ;REMEMBER...THAT THE CONTROL INSRUCTIONS WILL BE ENCOUNTERED ;IN THE ORDER MST CUP ENT . PMST: SUB 2,2 ;CREATE NEW STACK_ FRAME .BASE ;LEAVES SL IN AC2 LDA 3,SP ;SL:= BASE(P) STA 2,1+SL,3 LDA 0,MP ; DL:= MP STA 0,1+DL,3 LDA 0,EP ; GET STACK MAX STA 0,1+MTS,3 ; MTS:=SP LDA 0,.MSL ; SP:= SP+MSL ADD 0,3 STA 3,SP NEXT .MSL: MSL ;MSL IS 5 ; CUP PASSES IN THE P\ FIELD THE NUMBER OF PARAMETERS ; ASSOCIATED WITH THE PROCEDURE. ONE WORD IS SAVED ; FOR EACH (ADDRESS OF MULTI-WORD OBJECTS PASSED) PCUP: LDA 3,SP ; MP:= SP-MSL-P+1 SUB 1,3 ;THIS STRANGE VALUE USED LDA 1,.MSD ;..BY ENT SUBSEQUENTLY SUB 1,3 STA 3,3MP LDA 0,PC ; RA:=PC STA 0,RA,3 STA 2,PC ; PC:=Q-1 DSZ PC NEXT .MSD: MSL-1 ;CXP CALL EXTERNAL PROCEDURE - BY A.F. ON 11/02/77 ;ADDED CHECKS FOR PARAMETER LENGTHS PCXP: LDA 2,0,2 ;ACTUAL ADDRESS OF PROCEDURE LDA 0,4,2 ;LOAD THE COUNT OF PARAMETERS LDA 3,ENT3 ;TEST IF AN ENT3 IS HERE? SUB 0,3,SZR JMP XPER ;ERROR NO ENT3 LDA 0,5,2 ;O.K. NOW TEST NO. OF PARAMETERS MOVZR 0,0 ;DIVIDE BY 2 SUB 1,0,SNR ;BLOW OUT... IF NOT EQUAL JMP PCUP XPER: ERR.P 412 ENT3: 61003 ; ENT GIVES IN Q FIEg)LD STACK SPACE REQD BY PROC ; (ENT1 STATIC, ENT2 DYMAMIC) ; USING STRANGE MP WE SUBTRACT # OF PARAMETERS ; FROM THIS VALUE AND UPDATE SP PENT: MOVZR 2,2 ; HALVE Q FIELD MOVZR 1,1,SNR ; FIRST ENT OF PAIR ? JMP .+4 MOV 1,1,SZC ; NO, TEST IF OTHER QNEXT ; ENT3 JMP ENT2 ; NO LDA 0,MP ; SP:=MP+Q SUB 1,1 ; MAKE ZER0 NEG 2,2,SNR ; LOCAL SPACE COUNT JMP TEST CLR: PUSH1 1 ; SET TO ZERO INC 2,2,SZR ; ALL LOCAL SPACE JMP CLR JMP TEST ; CHECK STACK ENT2: LDA 0,SP ; SP+SEGMENT ADD 2,0 ; .}. WORKSPACE STA 0,EP ; .. = MAX STACK TEST: LDA 1,HP SUBO 0,1,SNC NEXT ERR.P PERSO ; REPORT NOT ENOUGH SPACE ;IN RETURNING LEAVE ONE OR TWO WORD FUNCTION ;VALUE (IF APPROPRIATE) ON TOP OF STACK PRET: LDA 2,MP ADD 2,1 ; SP:= MP-1+P STA 1,SP ef DSZ SP LDA 0,RA,2 ; PC:= RA STA 0,PC LDA 0,MTS,2 ; EP:= MTS STA 0,EP LDA 0,DL,2 ; MP:= DL STA 0,MP NEXT PCSP: LDA 0,.SPTAB ; JUMP INDIRECT SPTAB[Q] ADD 0,2 JMP @0,2 .SPTAB: SPTAB PFJP: POP1 1 ; IF Y=FALSE THEN:- MOV# 1,1,SZR NEXT PUJP: S/TA 2,PC ; PC:= Q-1 DSZ PC NEXT PTJP: POP1 1 ; IF Y=TRUE THEN:- MOV# 1,1,SNR NEXT JMP PUJP ; PC:=Q-1 PXJP: POP1 1 ; PC:= Y+Q-1 MOVZL 1,1 ;INDEX OVER 2WDS AT A TIME ADD 1,2 JMP PUJP PUJC: ERR.P PERCJ .END R2SSPTAB.SR- .TITL R2SSPTAB .EXTN XWLN,XWRC,XWRI,XWDR,XWRS .EXTN XRDC,XRDI,XRDR,XRLN .EXTN XGET,XPUT .EXTN XELN .EXTN XATN,XCOS,XEXP,XLOG,XSIN,XSQT .EXTN XNEW,XSAV,XRST .EXTN XRND,XOPN .EXTN XCLS,XRRR,XWRR .EXTN XPAG .EXTN XEOR,XRWR,XRSE .EXTN PUNDF .ENT^ SPTAB .NREL SPTAB : XGET ;0 XPUT ;1 XRST ;2 XRLN ;3 XNEW ;4 XWLN ;5 XWRS ;6 XELN ;7 XWRI ;8 XWRR ;9 XWRC ;10 XRDI ;11 XRDR ;12 XRDC ;13 XSIN ;14  XCOS ;15 XEXP ;16 XLOG ;17 XSQT ;18 XATN ;19 XSAV ;20 XOPN ;21..OPEN ANY FILE (CREATE IMPLIED) XRND ;22 PUNDF ;23 XCLS ;24 XRRR ;25 XWDR ;26 XPAG ;27 XEOR ;28 XRWR ;29 XRSE ;30 PUNDF ;31 .END P4SOURCES.CM_P4SOURCES.CM,^ R2RFW.SR,R2SECHK.SR,R2ROUTL.SR,R2IFT.SR,R2RFILES.CM,R2SMPD.SR,^ R2SOVL.SR,R2STP.SR,R2SINTEGER.SR,R2SBOOLEAN.SR,R2SRANDOM.SR,^ R2SOPN.SR,R2IREAL.SR,R2SADMIN.SR,R2SRD.SR,R2SIOIN.SR,R2CITAB.SR,^ R2IFNS.SR,R2CRCODE.SR,R2SSET.SR,R2STI.SR,R2RFT.SR,R2SITAB.SR,^ R2SDIV.SR,P4ERRSUM,R2IFW.SR,R2SMEMACC.SR,R2SMISC.SR,R2SDBIN.SR,^ R2STESTS.SR,R2SHEAP.SR,R2ALLFILES.CM,R2CSPTAB.SR,R2IOUTL.SR,^ R2SDECODER.SR,R2RREAL.SR,R2SMYP.SR,R2IFILES.CM,R2SSYMBOLS.SR,^ R2SREWR.SR,R2RFNS.SR{,R2SSPTAB.SR,R2SCONSTS.SR,P4ENTERERR,^ EXAMPLES.CM,ROMAN,LIFE,GRAPH,PRIMES,RGCD,^ P4COMPILE1,P4COMPILE2,P4COMPILE3,P4COMPILE4,^ MAKER2SYMBOLS.CM,MAKEDGSYMBOLS.CM,^ P4ASMFILES.CM,NEW2P4ASMB,SETUP,FASTHASH,SETUPAX,SETUPAZ,^ HEADA2,HEADM2,SP4AMX2,P4ASMZ2,P4MACZ2,NEW2P4ASME,MAKE2P4AM.CM^ P4ASMZ2.mm . PROCEDURE DOTFILE; (* REDUNDANT IN RELEASE II *) BEGIN WRITELN(OUTPUT, 11008 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* READ OFF EOLN *) WRITELN(OUTPUT, '.TXT ''INPUT'''); WRITELN(OUTPU=T, -8954); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8954); WRITELN(OUTPUT,  24064); WRITELN(OUTPUT, 8192); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8952); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''OUTPUT'''); WRITELN(OUTPUT, -8951); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8949); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRIT&ELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRD'''); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, -7403); WRITELN(OUTPUT, -8948); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, 8192); , WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, -8946); WRITELN(OUTPUT, -8703); WRITELN(OUTPUT, 2048); WRITELN(OUTPUT, 11008); WRITELN(OUTPUT, '.TXT ''PRR'''); WRITELN(OUTPUT, -8945); WRITELN(OUTPUT, -7403); V WRITELN(OUTPUT, -8943); WRITELN(OUTPUT, 24064); WRITELN(OUTPUT, -32768); WRITELN(OUTPUT, 2048 ); WRITELN END (*** OF DOTFILE ***); PROCEDURE PACKCODE; VAR SMCODE, I, P, Q : INTEGER; LITERALS c: STRING3; OP, TEMPOP : STRING4; ERROR : BOOLEAN; PROCEDURE DUMMYLABELS; BEGIN ECOUNT := ECOUNT + 1; WRITELN(PRR, '**********', ' INSTR. NO. ' : 12, ICOUNT : 5, ' ''' : 2, OP, / ''' HAS NOT YET BE', 'EN CATERED FOR ');  WRITELN END (*** OF DUMMYLABELS ***); FUNCTION PKACTION : INTEGER; VAR TEMP, RNDM, PI : INTEGER; MORETRY : BOOLEAN; PROCEDURE ERRORP;  BEGIN ERROR := TRUE; ECOUNT := ECOUNT + 1; MORETRY := FALSE; WRITE(PRR, 'INSTR. NO. = ' : 13, ICOUNT : 1, ' ', OP); REPEAT READ(INPUT, CH); 1 WRITE(PRR, CH) UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN(PRR); WRITE(PRR, '** ', OP, ' ** ILLEGAL CODE'); WRITELN(PRR) END (*** ERRORP ***); BEGI;N (* OF PKACTION *) PKACTION := 0; TEMP := ORD(OP[1]) * 4 + ORD(OP[2]) * 2 + ORD(OP[3]); IF ORD(OP[4]) <> 0 THEN TEMP := TEMP * 2 + ORD(OP[4]); TEMP := TEMP MOD TABLES>IZE; MORETRY := TRUE;  SMIN := SMIN + 1; SMAX := SMAX + 1; RNDM := 1; PI := 0; IF OP = ' ' THEN ERRORP ELSE WHILE MORETRY DO WITH PCODETABLE[ (TEMP + PI) MOD TABLESIZE ] DO BEGIN IF OP = PCODE THEN BEGIN MORETRY := FALSE; SMCODE := SEMICODE; PKACTION:= ACTION; END ELSE IF PCODE = ' ' THEN ERRORP;  IF MORETRY THEN  BEGIN RNDM := (RNDM * 5) MOD (TABLESIZE * 4); PI := TRUNC(RNDM / 4); SMAX := SMAX + 1 END END END (*** OF PKACTION ***); PROCEDURE NILP(P1, P2 : INaTEGER); (* PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1= 0)) THEN BEGIN WRITELN(OUTPUT, P2); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 ); , READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILP ***); PROCEDURE NILPS(P1, P2, P3 : INTEGER); (* SPECIAL PCODE WITH NO P-FIELD *) BEGIN IF NOT ((P1 < HALFWORD) AND (P1 >= 0)) THEN BEGIN WRITELN(OUDTPUT, P2 + P3 ); WRITELN(OUTPUT, P1) END ELSE WRITELN(OUTPUT, BIT16 + P1 + P2 + P3 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF NILPS ***); PROCEDURE QTOP(P1, P2, P3 : INTEGER); (* PCODE WITH P- AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND (P2 < HALFWORD) AND (P2 >= 0)) THEN BEGIN WRITELN(OUTPUT, P3 + P1 ); WRITELN(OUTPUT, P2 : 7) END ELSE WRITELN(OUTPUT, BIT16 + P3 + P2 );d READ(INPUT, CH) (* READ OFF EOLN *) END (*** QTOP ***); PROCEDURE QTOPS(P1, P2, P3, P4 : INTEGER); (* SPECIAL PCODE WITH P- AND Q-FIELDS *) BEGIN IF NOT ((P1 = 0) AND ( P2 < HALFWORD) AND (P2 >= 0)) THEN  BEGIN WRITELN(OUTPUT, P3 + P4 + P1 ); WRITELN(OUTPUT, P2) END ELSE WRITELN(OUTPUT, BIT16 + P2 + P3 + P4 ); READ(INPUT, CH) (* READ OFF EOLN *) END (*** OF QTOPS ***); PROCEDURE BOUNDS(SEMICODE, LOWERBOUND, UPPERBOUND : INTEGER); (* GENERATE POSSIBLE OFFENDING PCODE LOCATION IN CASE OF INVALID CHECK RANGE *) BEGIN IF SEMICODE > 0 THEN BEGIN IF (LOWERBOUND = 0) AND (UPPERBOUND < HALFWORD) THEN  WRITELN(OUTPUT, SEMICODE + BIT16 + UPPERBOUND) ELSE BEGIN IF (LOWERBOUND >= 0) AND (LOWERBOUND < HALFWORD) THEN WRITELN(OUTPUT, SEMICODE + LOWERBOUND) R ELSE BEGIN WRITELN(OUTPUT, SEMICODE + HALFWORD); WRITELN(OUTPUT, LOWERBOUND) END; WRITELN(OUTPUT, UPPERBOUND) END  END ELSE IF LOWERBOUND > 0 THEN WRITELN(OUTPUT, SEMICODE + 1) ELSE WRITELN(OUTPUT, SEMICODE); WRITELN(OUTPUT, ICOUNT + 1) END (* OF BOUNDS *); PROCEDURE LOWCODE; (* TO PROVIDE FACILITIES FOR THOSE POOR SOULS WmHO MUST LIVE WITH MACHINE CODES *) VAR I, J, K, L, ACC, LEVEL, DISPL : INTEGER; CODEND : BOOLEAN; DIRECTIVE : STRING4; LINE : ARRAY[1..80] OF CHAR; GOODCHAR : SET OF CHAR; GOODIGIT  : SET OF '0'..'9'; FUNCTION GETNUM : INTEGER; VAR NUMBER : INTEGER; BEGIN WHILE ((LINE[J] = ' ') OR (LINE[J] = ',')) AND (J < I) DO J := J + 1; IF NOT (LINE[J] IN GOODsZIGIT) THEN BEGIN WRITELN(PRR, '** ASSEMBLER COD', 'E ERROR :'); FOR J := 1 TO I DO WRITE(PRR, LINE[J]); WRITELN(PRR);  WRITELN(PRR, '** LAST RECORDED', ' PCO=DE COUNTER =', ICOUNT); ECOUNT := ECOUNT + 1 END; NUMBER := ORD(LINE[J]) - ZERO; J := J + 1; WHILE (J <= I) AND (LINE[J] IN GOODIGIT) DO BEGIN ۨ NUMBER := NUMBER * 10 + ORD(LINE[J]) - ZERO; J := J + 1 END; GETNUM := NUMBER END (* OF GETNUM *); PROCEDURE GETLABEL;  VAR N : INTEGER; BEGIN IF J B> 1 THEN BEGIN FOR N := 1 TO J DO WRITE(OUTPUT, LINE[N]); END END (* OF GET LABEL *); BEGIN (* OF LOWCODE *); WRITELN(OUTPUT, '.RDX 8'); WRITELz[N(OUTPUT, '.EXTD .CST .CLD ', 'PCRTN'); CODEND := FALSE; FOR CH := '0' TO '9' DO GOODIGIT := GOODIGIT + [CH]; FOR CH := 'A' TO 'Z' DO GOODCHAR := GOODCHAR + [CH]; GOODCHAR := GOODCHAR + ['.', '$'] + GOODIGIT; + REPEAT IF EOF(INPUT) THEN BEGIN WRITELN(PRR, '** ASSEMBLY CODE', ' SECTION NOT PRO', 'PERLY ENDED.'); WRITELN(PRR, '** LAST RECORDED', ' PCODE COUNTER =', ICOUNT); 2 HALT(311); END; REPEAT WHILE EOLN(INPUT) DO READLN(INPUT); READ(INPUT, CH);  IF CH = ';' THEN READLN(INPUT) UNTIL CH IN GOODCHAR; LI@NE[1] := CH; FOR I := 2 TO 80 DO LINE[I] := ' '; I := 1; J := 1; WHILE NOT( EOLN(INPUT) OR ( I = 80) OR (CH = ';')) DO BEGIN READ(INPUT, CH); IF CH <> ';'H_ THEN BEGIN I := I + 1; LINE[I] := CH; IF CH = ':' THEN J := I END END; READLN(INPUT); IF J > 1 T_HEN REPEAT J := J + 1; UNTIL LINE[J] <> ' '; L := 1; FOR K := J TO J + 3 DO BEGIN DIRECTIVE[L] := LINE[K]; 5 L := L + 1 END; IF DIRECTIVE = 'JPC ' THEN BEGIN GETLABEL;  CODEND := TRUE; WRITELN(OUTPUT, 'JSR @PCRTN') END ELSE IF D IRECTIVE = 'POP ' THEN BEGIN GETLABEL; J := J + 4; WRITELN(OUTPUT, 'DSZ 41'); WRITE(OUTPUT, 'LDA ' : 5, GETNUM : 1, ' @41'); WRITELN(O)jUTPUT) END ELSE IF DIRECTIVE = 'PUSH' THEN BEGIN GETLABEL;  J := J + 4; WRITELN(OUTPUT, 'ISZ 41'); WRITE(OUTPUT, 'STA ': 5, GETNUM : 1, ' @41'); WRITELN(OUTPUT) END ELSE IF DIRECTIVE = 'LOAD' THEN BEGIN GETLABEL; J := J + 4; ACC := GETNUM; LEVEL := GETNUwM; DISPL := GETNUM; WRITELN(OUTPUT, 'JSR @.CLD'); WRITELN(OUTPUT, LEVEL);  WRITELN(OUTPUT, DISPL); WRITE(OUTPUT, 'LDA ' : 5, ACC : 1, ' @47'); WRITEYZLN(OUTPUT); END ELSE IF (DIRECTIVE = 'STOR') AND (LINE[J + 4] = 'E') THEN BEGIN GETLABEL; J := J + 5; WRITE(OUTPUT, 'STA ' : 5, GETNUM : 1, ' 47');  WRITELN(OUTPUT); WRITELN(OUTPUT, 'JSR @.CST');  WRITELN(OUTPUT, GETNUM); WRITELN(OUTPUT, GETNUM); END ELSE BEGIN "J FOR J := 1 TO I DO WRITE(OUTPUT, LINE[J]); WRITELN(OUTPUT) END; UNTIL CODEND; WRITELN(OUTPUT, '.RDX 10') END (* OF LOWCODE *); BEGIN (* OF PACKCODE *) OP[1] := CH; READ(INPUT, OP[2], OP[3]); IF EOLN(INPUT) THEN OP[4] := ' ' ELSE READ(INPUT, OP[4]); CASE PKACTION OF 0 : (* STOA STOA STOC STOI STOR STOS EOF ADI ADR SBI SBR SGS s FLT FLO TRC NGI NGR SQI SQR ABI ABR NOT AND IOR DIF INT UNI INN MOD ODD LCA MPI MPR DVI DVR STP CHR ORDA ORDC ORDI EQUA EQUB EQUB EQUC EQUI EQUR EQUS NEQA NEQB NEQC NEQI NEQR NEQS GEQA GEQB GEQC GEQI GEQR GEQS GRTA GRTB GRTC GRTI GRTR GRTR GRTS LEQA LEQB LEQC LEQI LEQR LEQS LESA LESB LESC LESI LESR LESS RETA RETB RETC RETI RETP RETR ATN COS ELN EXP GET LOG NEW PUT RDC RDI RDR RLN RST SAV SIN SQT WLN WRC WRI WRR WRS OPS  OPN OVL CMS RSN *) BEGIN IF ERROR THEN ERROR := FALSE ELSE BEGIN  WRITELN(OUTPUT, SMCODE ); READLN(INPUT) (* RID EOLN *) END END; 1, 2, 3, 4, 5, 6, 7, 8, 9 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****)  10 : (* EQUM NEQM GEQ GRTM LEQM LESM  *) BEGIN READ(INPUT, Q); NILP(Q, SMCODE + BIT15) END; 11, 12, 13, 14, 15, 16, 17, 18, 19 : DUMMYLABELS; λ (***** FOR FUTURE INSERTIONS *****) 20 : (* LODA LODB LODC LODI STRA STRB STRC STRI LDA *) BEGIN READ(INPUT, P, Q); QTOP(P, Q DIV 2, SMCODE) A END; 21, 22, 23, 24, 25, 26, 27, 28, 29 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 30 : (* LODR STRR *) BEGIN READ(INPUT, P, Q); QTOPS(P, Q DIV 2, SMCiODE, HALFWORD) END; 31, 32, 33, 34, 35, 36, 37, 38, 39 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 40 : (* LODS STRS *) BEGIN READ(INPUT, P, Q);  QTOPS(P, Q DIV 2, SMCODE, 3 * HALFWORD) END; 41, 42, 43, 44, 45, 46, 47, 48, 49 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 50 : (* CUP CXP *) BEGIN READ(INPUT, Pt); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P DIV 2 ); WRITELN(OUTPUT, CH, Q : 1); READ()INPUT, CH) (* READ OFF EOLN *) END; 51, 52, 53, 54, 55, 56, 57, 58, 59 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 60 : (* MST *) BEGIN READ(INPUT, Q); qB WRITELN(OUTPUT, SMCODE + Q ); READ(INPUT, CH) (* READ OF EOLN *) END; 61, 62, 63, 64, 65, 66, 67, 68, 69 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 70 : (* LDOA LDOB LDOKC LDOI SROA SROB SROC SROI INDA INDB INDI LAO *) BEGIN READ(INPUT, Q); NILP(Q DIV 2, SMCODE) END; 71, 72, 73, 743, 75, 76, 77, 78, 79 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 80 : (* INDC *) BEGIN READ(INPUT, Q); NILPS(Q, SMCODE, 2 * HALFWORD) END; 81, 82, 83, &84, 85, 86, 87, 88, 89 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 90 : (* LDOR SROR INDR *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD) END;  91, 92, 93, 94, 95, 96, 97, 98, 99 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 100 : (*LDOS SROS INDS *) BEGIN READ(INPUT, Q); NILPS(Q DIV 2, SMCODE, HALFWORD * 3)  END; 101, 102, 103, 104, 105, 106, 107, 108, 109 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 110 : (* INCA INCI INCC IXA DECA DECI DECC *) BEGIN V READ(INPUT, Q); NILP(Q, SMCODE) END; 111, 112, 113, 114, 115, 116, 117, 118, 119 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 120 : (*MOV *)  BEGIN # READ(INPUT, Q); NILP((Q + 1) DIV 2, SMCODE) END; 121, 122, 123, 124, 125, 126, 127, 128, 129 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 130 : (* ENT *) ; BEGIN READ(INPUT, P); READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(OUTPUT, SMCODE + P );  WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 131, 132, 133, 134, 135, 136, 137, 138, 139 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 140 : (* UJC *) BEGIN  WRITELN(OUTPUT, SMCODE ); WRITELN(OUTPUT, 0 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 141, 142, 143, 144, 145, 146, 147, 148, 149 : DUMMYLABELS; (***** FOR mFUTURE INSERTIONS *****) 150 : (* UJP FJP XJP TJP JPF JPT SJP *) BEGIN READ(INPUT, CH); WHILE CH <> 'L' DO READ(INPUT, CH); READ(INPUT, Q); WRITELN(O2UTPUT, SMCODE ); WRITELN(OUTPUT, CH, Q : 1); READ(INPUT, CH) (* READ OFF EOLN *) END; 151, 152, 153, 154, 155, 156, 157, 158, 159 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS 9*****) 160 : (* CSP *) BEGIN READ(INPUT, CH); WHILE CH = ' ' DO READ(INPUT, CH); I := SMCODE; TEMPOP := OP; OP[1] := CH;  READ(INPUT, OP[2], OP[3]); OP[4] := ' '; P := PKACTION; (* P IS DUMMY, CALLING PKACTION IS JUST TO  OBTAIN SEMI-CODE VALUE IN SMCODE *) WRITELN(OUTPUT, SMCODE + I + BIT16 ); READ(INPUT, CH) (* READ OFF EOLN *) END; 161, 162, 163, 164, 165, 166, 167, 168, 169 :DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 170 : (* CHKA CHKB CHKC CHKI *) BEGIN READLN(INPUT, P, Q); BOUNDS(SMCODE, P, Q) END; 171, 172, 173, 174, 175, 176, 177, 178, 179 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) . 180 : (* LDC *) BEGIN WRITELN(OUTPUT, SMCODE + 3 ); REPEAT READ(INPUT, CH); UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *)  FOR I := 1 TO 4 DO WRITELN(OUTPUT, SWITCHES[I]); END; 181, 182, 183, 184, 185, 186, 187, 188, 189 : DUMMYLABELS;  (***** FOR FUTURE INSERTIONS *****) 190 : (* LDCB LDCI *) BEGIN Z READ(INPUT, Q); QTOP(0, Q, SMCODE) END; 191, 192, 193, 194, 195, 196, 197, 198, 199 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 200 : (* LDCC *) (* SORRY FOR ]THIS MESS, BUT BLAME NOVA ASSEMBLER PLEASE *) BEGIN READ(INPUT, CH); (* THE ORDINAL OF (') = 7 *) WHILE ORD(CH) <> 7 DO READ(INPUT, CH); LITERALS[1] := CH; ' READ(INPUT, LITERALS[2], LITERALS[3]); WRITELN(OUTPUT, SMCODE ); IF LITERALS[2] = CHR(7) (* IF LITERALS[2] = ''' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), v 39 (*NOVA CODE FOR (')*) : 1, CHR(30), CHR(7)) ELSE IF LITERALS[2] =CHR(12) (* IF CH = ',' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 44 : 1, (*NOVA CODE FOR (,) *) CHR(30), CHR(7)) ELSE IF LITERALS[2] = CHR(28) (* IF LITERALS[2] = '<' *) THEN WRITELN(OUTPUT, '.TXT ', CHR(7), CHR(28), 60 (* NOVA CODE FOR (<) *) : 1, CHR(30-), CHR(7)) ELSE WRITELN(OUTPUT, '.TXT ', LITERALS); READ(INPUT, CH) (* READ OFF EOLN *) END; 201, 202, 203, 204, 205, 206, 207, 208, 209 : DUMMYLABELS; (***** FOR FUTURE INSERTohIONS *****) 210 : (* LDCN *) QTOP(0, 0, SMCODE); 211, 212, 213, 214, 215, 216, 217, 218, 219 : DUMMYLABELS; (***** FOR FUTURE INSERTIONS *****) 220 : (* LDCR *) (* NOTICE THE NON-FLOATING-PO'IINT OUTPUT FORMAT OF 'R' *) BEGIN WRITELN(OUTPUT, SMCODE + 1, '.');  READLN(INPUT, R); WRITELN(OUTPUT, '0', R : 0); END; 230 : (* JNC *) (* PARADISE FOR MACHINE CODE ADDICTS ONLY *) BEGIN WRITELN(OUTPUT, SMCODE); READLN(INPUT); LOWCODE; END; (* REDUNDANT 'CCP ' 240 : BEGIN  WRITELN(OUTPUT, SMCODE); READLN(INPUT, Q); WRITELN(OUTPUT, Q) END; *) END (* OF CASE PKACTION *) END (*** OF PACKCODE ***); BEGIN (* OF MAIN *) WRITELN; WRITELN;  WRITELN; WRITELN(PRR, '; ==== P4ASM BEG', 'INS NOW'); ENT := TRUE; ZERO := ORD('0'); ICOUNT := 3; FOR I := 0 TO TABSIZE0 DO WITH PCODETABLE[I] DO PCODE := ' '; COMPLETABLE; (* START READINGk IN THE PCODE PROGRAM FROM PRD FILE *) READ(INPUT, CH, CH, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF (CH <> '.') AND (DOTNAME <> 'TIT') THEN BEGIN WRITELN(PRR, '**********', ' NO TITLE FOUND ', '**********'); WRITELN(PRR)<; HALT(311) END; WRITE(OUTPUT, CH: 16, DOTNAME); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH); (* RID EOLN *) REPEAT READ(INPUT, CH); 0s IF CH = 'I' THEN PCTYPE := COMMENT ELSE IF CH = 'L' THEN PCTYPE := LLABEL ELSE IF (CH = 'P') OR (CH = '?') THEN PCTYPE := PCODENTRY ELSE BEGIN READ(INPUT, CH); IF CH = '.' THEN PCTYPE; := NONPCODE ELSE PCTYPE := PCODES END; CASE PCTYPE OF COMMENT : (* INSTRUCTION CHECK COUNT *) BEGIN READ(INPUT, J); IF (ICOUNT <> J) AND (J <> 0) THEN BEGIN  WCOUNT := WCOUNT + 1; WRITELN(PRR, 'I', J : 5, ' ' : 14, '; ??? PCODE' , ' COUNT OUT OF ST', 'EP ???'); END; ICOUNT := J; READ(INPUT, CH) (* READ OFF EOLN *) END; LLABEL : (* LABELS *) BEGIN  M WRITE(OUTPUT, CH);  READ(INPUT, I); WRITE(OUTPUT, I : 1); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) `7 UNTIL EOLN(INPUT); READLN(INPUT); WRITELN(OUTPUT) END; NONPCODE : (* NON STANDARD PCODE INSTRUCTIONS *) BEGIN 9: READ(INPUT, DOTNAME[1], DOTNAME[2], DOTNAME[3]); IF DOTNAME = 'FIL' THEN DOTFILE ELSE BEGIN IF ((DOTNAME = 'SW1') OR (DOTN.AME = 'SW2') OR (DOTNAME = 'SW3') OR (DOTNAME = 'SW4')) THEN BEGIN REPEAT READ(INPUT, CH)  UNTIL (CH = '0') OR (CH = '1'); (* READ UNTIL BINARY IS FOUND *) BINARYSTR[1] := CH; IF CH = '1' THEN J := -1 ELS E J := 0; FOR I := 2 TO 16 DO BEGIN READ(INPUT, CH); BINARYSTR[I] := CH; A  J := J * 2 + ORD(CH) - ZERO END; I := ORD(DOTNAME[3]) - ZERO; SWITCHES[I] := J; _ READ(INPUT, CH) (* READ OFF EOLN *) END ELSE IF (DOTNAME = 'TXT') AND (INPUT^ <> 'M') THEN BEGIN WRITE(OUTPUT, '.', DOTNAME : 3); REPEAT READ(INPUT, CH); WRITE(OUTPUT, CH) UNTIL CH <> ' ';' FOR I := 1 TO 16 DO BEGIN READ(INPUT, CH); IF CH = CHR(2) (* CH = '"'*) THEN   WRITE(OUTPUT, CHR(28), 34 : 1 (*NOVA CODE FOR '"'*), CHR(30)) ELSE IF CH = CHR(28 (*IF CH = '<'*)) THEN `t WRITE(OUTPUT, CHR(28), 60 : 1, (*NOVACODE FOR '<'*)CHR(30)) ELSE IF CH = CHR(30) (*IF CH = '>'*) THEN   WRITE(OUTPUT, CHR(28), 62 : 1, (*NOVA CODE FOR '>'*) CHR(30)) ELSE WRITE(OUTPUT, CH)  END; READLN(INPUT, CH); (* RID EOLN *) WRITELN(OUTPUT, CH) END ELSE BEGIN  I IF DOTNAME = 'ENT' THEN BEGIN IF ENT THEN BEGIN ENT := FALSE; ) WRITE(OUTPUT, '.', DOTNAME) END ELSE WRITE(OUTPUT, '; .', DOTNAME) END ELSE  IF NOT+> (DOTNAME = 'END') THEN WRITE(OUTPUT, '.', DOTNAME); IF NOT EOLN(INPUT) THEN REPEAT R24EAD(INPUT, CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); READ(INPUT, CH); (* RID EOLN *) WRITELN END END END; PCODES : (* STANDARD PCODE INSTRUCTIONS *) BEGIN PACKCODE; I$COUNT := ICOUNT + 1 END; PCODENTRY : (* PACKED PCODE ENTRY POINT *) BEGIN WRITE(OUTPUT, CH);  REPEAT READ(INPUT, ,CH); WRITE(OUTPUT, CH) UNTIL EOLN(INPUT); WRITELN; READ(INPUT, CH) (* READ OFF EOLN *) END; END (* OF CASE PCTYPE *); WHILE EOLN(INPUT) DO BEGIN WRITELN; READ(INPUT, CH) (* READ OF EOLN *) END UNTIL EOF(INPUT); (* THE PCODE PROGRAM HAS BEEN PACKED FOR INTERPRETER *) (* WRITELN(PRR); WRITELN(PRR, '; IDEAL SEARCHES', ' = ', SMIN); WRITELN(PRR, '; ACTUAL SEARCHE', 'S = ', SMAX); *) IF WCOUNT > 0 THEN WRITELN(PRR, ';---- NO. OF WAR', 'NINGS = ', WCOUNT : 6); IF ECOUNT > 0 THEN WRI0TELN(PRR, ';**** NO. OF FAT', 'AL ERRORS = ', ECOUNT : 6); WRITELN(OUTPUT, '.END' : 16); IF ECOUNT > 0 THEN HALT(311); WRITELN; WRITELN; WRITELN END. R2CRCODE.SR BWc .TITL R2CRCODE .TXTM 1 .ENT .CST,.CLD,PCRTN,PJNC .EXTN .BASE .ZREL .CST: CST .CLD: CLD PCRTN: .PCRT .NREL ;ENTRY POINT USED BY THE INTERPRETER TO INITIATE CODE PJNC: JMP @PC ;RETURN FROM CODE TO THE INTERPRETER .PCRT: STA 3,PC DSZ PC JMP @IP {e ;LOAD AND STORE FROM THE STACK ;STORE.... CST: STA 3,Z2 ;SAVE LINK JSR SAVER ;AND REGISTERS LDA 0,Z1 LDA 3,Z2 ;RESTORE LINK LDA 1,0,3 ;LEVEL DIFFERENCE LDA 2,1,3 ;OFFSET .BASE ;FORM ADDRESS  STA 0,0,2 ;STORE @ THE ADDRESS JMP HOME 7 ;RETURN ;LOAD...... CLD: STA 3,Z2 ;SAVE LINK JSR SAVER ;AND REGISTERS LDA 3,Z2 ;RESTORE LINK LDA 1,0,3 ;LEVEL DIFFERENCE LDA 2,1,3 ;OFFSET .BASE ;FORM ADDDRESS STA 2,Z1 HOME: ISZ Z2 ISZ Z2 JSR RESET JMP @Z2 ;RETURN SAVER: STA 0,jTEMP0 STA 1,TEMP1 STA 2,TEMP2 JMP 0,3 RESET: LDA 0,TEMP0 LDA 1,TEMP1 LDA 2,TEMP2 JMP 0,3 TEMP0: 0 TEMP1: 0 TEMP2: 0 .END R2SITAB.SRU GK .TITL R2SITAB ; THE INTERPRETER JUMP TABLE .ENT ITAB0,ITAB1 .EXTN PLOD,PLDO,PSTR,PSRO,PLDA,PLAO,PSTO,PLDC,PLCI,PIND .EXTN PINDC,PSTOC .EXTN PINC,PINCC .EXTN PMST,PCUP,PCXP,PENT,PRET,PCSP  .EXTN PIXA .EXTN PEQU,PNEQ,PGEQ,PGRT,PLEQ,PLES .EXTN PUJP,PFJP,PXJP,PTJP,PUJC .EXTN PCHKC,PCHK2,PCHK3,PCHK4,PEOF .EXTN PADI,PADR,PSBI,PSBR .EXTN PSGS .EXTN PFLT,PFLO,PTRC .EXTN PNGI,PNGR,PSQI,PSQR,PABI,PABR  .EXTN PNOT,PAND,PIOR .EXTN PDIF,PINT,PUNI,PINN .EXTN PMOD,PODD .EXTN PMPI,PMPR,PDVI,PDVR .EXTN PMOV,PLCA,PDEC,PDECC,PSTP,PHLT .EXTN PCHR,PORDI,PORDA,PORDC,PORDB .pEXTN PJNC .EXTN PNON .ZREL ITAB0: PNON ; 0 NOT USED PHLT ; 1 PEQU ; 2 PNEQ ; 3 PGEQ ; 4 PGRT ; 5  PLEQ ; 6 PLES ; 7 PSTO ; 8 PSTO ; 9 PSTOC ; 10 PSTO ; 11 PMST  ; 12 PRET ; 13 PADI ; 14 PSBI ; 15 PNGI ; 16 PSQI ; 17 PABI ; 18 PMOD  ; 19 PODD ; 20 PMPI ; 21 PDVI ; 22 PADR ; 23 PSBR ; 24 PFLT ; 25 41 PFLO ; 26 PTRC ; 27 PNGR ; 28 PSQR ; 29 PABR ; 30 PMPR ; 31 PDVR ; 32  ?! PNOT ; 33 PAND ; 34 PIOR ; 35 PSGS ; 36 PDIF ; 37 PINT ; 38 PUNI ; 39 S PINN ; 40 PEOF ; 41 PSTP ; 42 PLCA ; 43 PORDI ; 44 SET ASIDE PORDA ; 45 4 LOCATIONS  PORYDC ; 46 FOR THE PORDB ; 47 ORD FAMILY PCHR ; 48 ; THE GAPS IN THE REMAINDER OF TABLE 0 ARE FOR CORAL PNON ; 49 PNON ; 50 E3 PNON ; 51 PJNC ; 52 PNON ; 53 PNON ; 54 PNON ; 55 PNON ; 56  PNON ; 57 Ô PNON ; 58 PNON ; 59 PNON ; 60 PNON ; 61 PNON ; 62 PNON ; 63 ITAB1: PNON ; 64Ԙ NOT USED PUJC ; 65 PEQU ; 66 PNEQ ; 67 PGEQ ; 68 PGRT ; 69 PLEQ  ; 70 PLES z# ; 71 N.B MULTIPLE COMPARES PLOD ; 72 PLOD ; 73 PLOD ; 74 PLOD ; 75 PLDO ; 76 PLDO ;j@ 77 PLDO ; 78 PLDO ; 79 PSTR ; 80 PSTR ; 81 PSTR ; 82 PSTR ; 83 PSRO y. ; 84 PSRO ; 85 PSRO ; 86 PSRO ; 87 PIND ; 88 PIND ; 89 PINDC ; 90 PIND !9 ; 91 PLDA ; 92 PLAO ; 93 PLDC ; 94 PIXA ; 95 PMOV ; 96 PCUP ; 97 PENT qG ; 98 PCSP ; 99 PUJP ;100 PFJP ;101 PTJP ;102 PXJP ;103 PINC ;104 PNON2 ;105 ALSO INC PINCC ;106 PNON ;107 ALSO INC PDEC ;108 ALSO NEEDS NEXT 3 PNON ;109 PDECC ;110 PNWON ;111 PCHKC ;112 NEEDS 3 MORE PCHK2 ;113 PCHK3 ;114 PCHK4 ;115 ; THE GAPS IN THE REMAINDER OF TABLE 1 ARE FOR CORAL g PNON ; 116 PCXP ; 117 PNON ; 118 PNON ; 119 PNON  ; 120 PNON ; 121 PNON ; 122s} PNON ; 123 PNON ; 124 PNON ; 125 PNON ; 126 PNON ; 127 .END R2IFNS.SR! ?֖ .TITL R2IFNS ; A DUMMY SEGMENT TO SATISFY ALL UNDEFINED CUES ; TO REAL STANDARD PROCEDURES .ENT XATN,XCOS,XEXP,XLOG,XSIN,XSQT,XRND .EXTN PUNDF .NREL XATN: .PUND XCOS: .PUND XEXP: .PUND XLOG: .PUND XSIN: .PUND XSQT: .PUND XRND: .PUND .END R2SHEAP.SR 8 .TITL R2SHEAP ; THE STANDARD PROCEDURES FOR OPERATING ON THE HEAP .ENT XNEW, XRST, XSAV .NREL XNEW: POP1 0 ;UNSTACK N (ELEMENT SIZE) MOVZR 0,0 SUB 3,3 ;AC3 AS SOURCE FOR ZEROES NEG 0,0 ;# OF WORDS TO CLEAR CLEAR: DSZ HP STA 3,@HP ;CLEAR EACH WORD OF NEW SPACE INC 0,0,SZR JMP CLEAR LDA 1,HP POP1 2 ;UNSTACK AD (POINTER VARIABLE ADDRESS) MOVZR 2,2 MOVZL 1,1 STA 1,0,2 ;[AD]:= HP MOVZR 1,1 ; BACK TO WD ADDR TO TEST EP LDA 0,EP ; ENOUGH ROOM ? ADCZ# 0,1,SZC ; SKP IF AC1<=AC0 .. HP<=EP NEXT ; YES ERR.P ; NO - ERROR RETURN PERHO ; WITH HEAP OVERFLOW XRST: POP1 1 ;RESET HEAP POINTER MOVZR 1,1 STA 1,HP NEXT XSAV: LDA 1,HP ;SAVE HEAP POINTER POP1 2 ;UNSTACK AD MOVZL 1,1 MOVZR 2,2 STA 1,0,2 ;[AD]:= HP NEXT .END R2IFW.SR! ?! .TITL R2IFW ; A DUMMY SEGMENT TO RESOLVE 2 CUES WHICH ARE ; REDUNDANT TO THE INTERPRETER WITHOUT FP .ENT WSA,PFPIN .EXTN PUNDF .ZREL WSA :0 .NREL PFPIN: .PUND .END R2IFILES.CMR2SECHK,^ R2IFT,^ R2SMPD,^ R2STP,^ R2SINTEGER,^ R2SBOOLEAN,^ R2SRANDOM,^ R2SOPN,^ R2IREAL,^ R2SADMIN,^ R2SRD,^ R2SIOIN,^ R2IFNS,^ R2CRCODE,^ R2SSET,^ R2SMPY,^ R2STI,^ R2SITAB,^ R2SDIV,^ R2IFW,^ R2SMEMACC,^ R2SMISC,^ R2SDBIN,^ R2STESTS,^ R2SHEAP,^ R2IOUTL,^-` R2SDECODER,^ R2SMYP,^ R2SREWR,^ R2SSPTAB,^ R2SCONSTS^ R2SMEMACC.SR! 4 .TITL R2SMEMACC ; THE P-CODE INTERPRETER'S "MEMORY ACCESS" OPERATIONS .ENT .BASE .ENT PIND,PLDO,PLOD .ENT PSRO,PSTR,PSTO .ENT PLAO,PLDA .ENT PLDC,PLCI,PLCA .ENT PMOV .EXTD RHB,LHB .EXTN PUNDF ; "BASE" BACKS DOWN THE NUMBER OF STACK FRAMES SP,ECIFIED BY ; AC1, AND ADDS THE BASE ADDRESS OF THIS STACK FRAME TO THE ; OFFSET IN AC2 .ZREL .BASE= JSR @. ;SET UP THE MNEMONIC .BASE AS BASE ; A JUMP TO ROUTINE "BASE" .NREL BASE: NEG 1,1,SZR ;CURRENT LEVEL ? JMP .+4 LDA 1,MP ;YES - GET MARK P܃OINTER ADD 1,2 ;ADD TO OFFSET JMP 0,3 ; AND RETURN STA 3,Z1 ;NO - SAVE RETURN ADDRESS LDA 3,MP ;PICK UP MARK POINTER LDA 3,SL,3 ;BACKTRACK ONE STACK LEVEL AT INC 1,1,SZR ; A TIME UNTIL AC1=0 JMP .-2 ADD 3,2 ;ADD STACK FRAME BASE TO OFFSET p JMP @Z1 ; AND RETURN ; "MOVE" MOVES THE NUMBER OF WORDS SPECIFIED BY AC1 FROM ; THE ADDRESS IN AC2 TO THE ADDRESS IN AC3 MOVE: LDA 0,0,2  STA 0,0,3 INC 1,1,SNR NEXT INC 2,2 INC 3,3 JMP MOVE TMSK: 001400 ;MASK FOR WORD COUNT ; LOAD INSTRUCTIONTS ; AC0 CONTAINS (NO. OF WORDS TO BE LOADED - 1) IN HIGH ; ORDER BYTE. VARIABLE ADDRESS GIVEN BY : ; IND - INDEX ON TOP OF STACK + OFFSET IN AC2 ; LDO - STACK BASE (DSP) + OFFSET IN AC2 (I.E. GLOBAL) ; LOD - OFFSET IN AC2 FROM STACK FRAME BASE N LEVELS ;  FURTHER DOWN, N IN AC1 PIND: POP1 1 ;INDEXED FETCH MOVZR 1,1 ; MAKE WD ADDRESS JMP .+2 PLDO: LDA 1,DSP ;LOAD CONTENTS OF BASE ADDRESS ADD 1,2,SKP PLOD: JSR BASE ;LOAD CONTENTS OF ADDRESS LDA 1,0,2 ;PICK UP VARIABLE PUSH1 1 ;PUT IT ON THE 5STACK LDA 1,TMSK ANDS 1,0,SNR ;ANY MORE WORDS ? NEXT ;NO NEG 0,1 ;YES - LOAD THEM ONE AT A TIME PLOD1: INC 2,2 LDA 0,0,2 PUSH1 0 INC 1,1,SZR JMP PLOD1 NEXT ; STORE INSTRUCTIONS ; AC0 CONTAINS (NO. OF WORDS TO BE STORED - 1) IN HIGH ; ORDER BYtTE. VARIABLE ADDRESS GIVEN BY : ; SRO - STACK BASE (DSP) + OFFSET IN AC2 (I.E. GLOBAL) ; STR - OFFSET IN AC2 FROM STACK FRAME BASE N LEVELS ; FURTHER DOWN, N IN AC1 ; STO - TOP OF STACK PSRO: LDA 1,DSP ;STORE ADD 1,2,SKP PSTR: JSR BASE ;STORE AT]d ADDRESS LDA 1,TMSK ANDS 1,0,SZR ;ONE WORD ONLY ? JMP PSTR1 POP1 1 ;YES - STORE IT STA 1,0,2 NEXT PSTR1: MOV 2,3 ;NO - USE "MOVE" LDA 2,SP ;DECREMENT STACK POINTER ADC 0,2 STA 2,SP PSTR2: INC 2,2 ;SET UP PARAMETERS FOR "MOVE" COM 0,1 JMP MOVE PSTO: LDA 1,TMSK ;STORE AT BASE LEVEL ADDRESS ANDS 1,0,SZR ;ONE WORD ONLY ? JMP PSTO1 POP1 1 ;YES - STORE IT POP1 3 MOVZR 3,3 ; MAKE WD ADDRESS STA 1,0,3 NEXT PSTO1: LDA 2,SP ;NO - DECREMENT STACK POINTER ADC 0,2 STA 2,SP POP1 3 ;USE "MNOVE" AGAIN MOVZR 3,3 ; MAKE WD ADDRESS JMP PSTR2 ; MORE LOAD INSTRUCTIONS (LOAD CONSTANT & LOAD ADDRESS) PLAO: LDA 1,DSP ;LOAD BASE LEVEL ADDRESS ADD 1,2,SKP PLDA: JSR BASE ;LOAD ADDRESS MOVZL 2,2 ; MAKE WD ADDRESS PUSH1 2 NEXT PLDC: PUSH1 2 f ;LOAD CONSTANT NEG 1,1,SNR ;MORE THAN ONE WORD ? NEXT ;NO PLDC1: LDA 2,@PC ;YES - PICK UP THE NEXT PUSH1 2 ; AND LOAD IT INC 1,1,SZR ;ANY MORE ? JMP PLDC1 ;YES NEXT ;NO PLCI: .PUND ;LOAD CONSTANT INDIRECT PLCA: LDA 2,PC ;LOAD ADDRESS XeOF CONSTANT INCZL 2,2 PUSH1 2 LDA 0,RHB ;RIGHT HAND BYTE MASK LDA 1,@PC ;SEARCH FOR END OF STRING (NULL) AND 0,1,SZR ; AND UPDATE PC JMP .-2 NEXT PMOV: NEG 2,1 ;STORE STRING AWAY POP1 2 MOVZR 2,2 ; MAKE WD ADDRESS POP1 3 MOVZR 3,3 ; DITT O JMP MOVE .END R2SRD.SRK *< .TITLE R2SRD .ENT PEOF,XELN,XRDC,XRLN,XGET .ENT .READ,READ .EXTD TEMP .ENT CR,TEMP1,TABAD .ENT CHAN,CNTAD,TEMP2 .EXTD .GCH,.FIND,.BPUT,.BGET .EXTD LHBNP,RHBNP,SPACE .ZREL .READ: READ CHAN: 0 CNTAD: 0 TABAD: 0 TEMP1: 0 TEMP2: 0 CR: 6400 .NREL ; READ - THIS ROUTINE LEAVES CHARACTER IN THE FILE BUFFER ; AND IN AC0. ; AC1 - UNDEFINED ; AC2 - FBA A BYTE ADDRESS ; ; FCH - FILE CHANNEL WORD (CONTAINS CHANNEL NO. + RECORD LENGTH). ; FST - FILE STATUS WORD (CURRENT STATE OF THE FILE). TAB: 4400 FF: 6000 CNTLZ: 15000 EOLFL: 1B1 EREOF: 6 C7: 7 READ: STA 3,USP ;USP RESTORED TO AC3 AFTER .SYSTM LDA 0,FST,2 ;GET FST MOVL# 0,0,SNC ;EOF SET ? JMP RD1 ; - NO ERR.P ; - YES PERRE ; REPORT READ ERROR RD1: MOVR 0,0,SZC ; FB EMPTY JMP lDRD2 ; - YES LDA 0,0,2 ; - NO, GET CHAR JMP 0,3 ; AND RETURN RD2: JSR @.GCH ;PICK UP CHANNEL AN' ALL JMP RNASC ;NONE CHARACTER INPUT ; ASCII TRANSFER FROM A SPECIFIED FILE RDASC: STA 2,TEMP2 ;STORE FOR A BIT LDA 2,CHAN JSR @.FIND ;ALL FILE DETAILS. LDA 2,@CNTAD ADD 0,2 ;FORM ADDDRESS OF NEXT CHARACTER. JSR @.BGET ;AS IN BIBLE BUT FOR CHARACTER LDA 2,TEMP2 ;THE RETURN OF FBA.... LDA 3,FST,2 ;TEST IF EOLN SET FROM LAST ADDZL# 3,3,SZC ;TIME THROUGH JMP RELN ;YES... MOV 0,0,SNR ;IS ŭIT NULL JMP RDNULL ;FORGET NULLS IF POSS. LDA 1,CR ;HOW ABOUT A CARRIAGE RETURN,THEN SUB# 1,0,SNR JMP RDEOL LDA 1,CNTLZ ;OR THE END OF THE FILE SUB# 1,0,SNR JMP RDERR+1 ;YES IT IS EOF SO END IT LDA 1,FF ;NO! THEN IT MUST BE A SUB# 1,0,SNR ;Ab FORM FEED OR I'LL GIVE UP. JMP RDEOL LDA 1,TAB ;PERHAPS EVEN A TERRIBLE TAB SUB# 1,0,SNR ;WHICH MAKES THE SYSTEM AWKWARD. JMP RDTAB STA 0,0,2 ;STORE THE CHARACTER IN THE BUFFER ISZ @CNTAD ;O.K. I GIVE UP IT WAS LDA 3,EREOF ;SOMETHING ELSE. RDEOF: STA 3,FST,2 ;YOU THINK YOU'RE NORMAL THEN... ISZ @TABAD ;KICK THE TAB COUNTER AND JMP @USP ;I'M OFF HOME ; NONE ASCII TRANSFER FROM A SPECIFIED FILE RNASC: MOVZL 2,0 ;BYTE POINTER TO FNA LDA 2,CHAN .SYSTM .RDS 77 ;READ A RECORD JMP .+2 JMP @USP JSR RDER1 ;TEST IF REAL ERROR MOVZR 0,2 ;RESET FBA SUBZR 3,3 STA 3,FST,2 ;SET EOF JMP @USP ;DEAL WITH THE END OF LINE RELN: SUB 3,3 ;RESET THE EOLN FLAG STA 3,FST,2 JSR RDRL ;GET A NEW LINE JMP RDASC ;AND RESTART ;DEAL WITH THE SPECISAL CASES... RDEOL: LDA 0,EOLFL ;FOUND END OF LINE OR STA 0,FST,2 ;EQUIVALENT, SO INDICATE LDA 0,SPACE ;IN THE STATUS AND BUFFER. STA 0,0,2 JMP @USP RDNUL: JSR RDRL ;READ THE NEXT LINE JMP RDASC ;AND RETURN FOR THE NEXT CHARACTER RDTAB: LDA 1,@TABAD ;TEST IF MULTIPLE OF 7 LDA 0,C7 COM 1,1 AND 1,0,SNR JMP NOTAB ;IT ISN'T NECESSARY LDA 0,SPACE STA 0,0,2 ;REPLACE WITH SPACES. JMP RDEOF-1 NOTAB: ISZ @CNTAD JMP RDASC ;GET NEXT CHARACTER. RDRL: STA 3,TEMP1 ;IF NO MORE IN BUFFER GET NEXT > SUB 1,1 STA 1,@CNTAD ;RESET THE BYTE COUNT. STA 1,@TABAD ;RESET THE TAB COUNTER. STA 2,TEMP2 ;STORE FBA TEMPORARILY LDA 2,CHAN ;GET THE CHANNEL AND ALL JSR @.FIND LDA 2,CHAN .SYSTM .RDL 77 JMP RDER2 LDA 2,TEMP2 LDA 0,SPACE ;LOAD A SPACE IN CASE ITS REQUIRED JMP @TEMP1 RDER2: ADD 1,0 JSR RDER1 ;TEST IF NOT EOF MOV 0,2 LDA 0,CNTLZ JSR @.BPUT ;MARK IT AS EOF LDA 2,TEMP2 JMP @TEMP1 RDERR: JSR RDER1 ;TEST IF NOT EOF LDA 0,EREOF SUBZR 3,3 ADD 0,3 LDA 2,TEMP2 ;RESTORE THE FBA JMP RDEOF ;MARK IT AS EOF RDER1: LDA 1,EREOF ;FINALLY THE ERROR CASE SUB# 1,2,SZR ERR.2 JMP 0,3 ;THE FOLLOWING ARE ENTRY POINTS USED BY PCODE PEOF: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET BUFFER STATUS MOVL 0,0 ;SET APPROPRIATE SUBCL 0,0 ;TRU|TH VALUE PUSH1 0 ;ON THE STACK NEXT XELN: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;GET BUFFER STATUS ADDL 0,0 ;EOL FLAG INTO CARRY SUBCL 0,0 ;SET TRUTH VALUE PUSH1 0 ;ON THE STACK NEXT XRDC: POP1 2 ;GET FBA MOVZR 2,2 JSR READ STA 2,TEMP ; STORE FBA TEMPORARILY POP1 2 ; ADDRESS OF DESTINATION BYTE JSR @.BPUT ; MOVE IT ... LDA 2,TEMP ; AND ON WE GO AS BEFORE. LDA 0,FST,2 ; GET STATUS MOVL# 0,0,SNC ; EOF ? JMP VALID ; - NO NEXT XRLN: POP1 2 ;ET FBA MOVZR 2,2 JSR @.GCH JMP .b+1 STA 2,TEMP2 LDA 2,CHAN JSR @.FIND LDA 2,TEMP2 JSR RDRL SUBZL 0,0 STA 0,FST,2 JSR @.READ NEXT XGET: POP1 2 ;GET FBA MOVZR 2,2 LDA 0,FST,2 ;CHECK BUFFER STATUS MOVL# 0,0,SNC ;FOR EOF JMP VALID ;OK - NO EOF ERR.P PERGE ;REPORT GET ERP]ROR VALID: MOVR 0,0,SNC ISZ FST,2 ; SET BUFFER EMPTY JSR @.READ NEXT .END P4AMX2. (********************* P4AMX2 BEGINS ********************) CONST TABLESIZE = 256; TABSIZE0 = 255; (*** IE TABLE SIZE WITH ZERO ORIGIN ***) BIT16 = -32768; BIT15 = 16384; HALFWORD = 256; TYPE  = INSTRTYPE = (COMMENT, LLABEL, NONPCODE, PCODES, PCODENTRY); STRING3 = ARRAY[1..3] OF CHAR; STRING4 = ARRAY[1..4] OF CHAR; STRING16 = ARRAY[1..16] OF CHAR; TEMPLATE = RECORD  PCODE : STRING4; SEMICODE, ACTION : INTEGER  END; VAR PCODETABLE : ARRAY[0..TABSIZE0] OF TEMPLATE; SWITCHES : ARRAY[1..4] OF INTEGER; CH : CHAR; DOTNAME \: STRING3; BINARYSTR : STRING16; R : REAL; I, J, ZERO, WCOUNT, ECOUNT, ICOUNT,SMIN, SMAX : INTEGER; ENT : BOOLEAN; PCTYPE : INSTRTYPE; (********************* P4AMX ENDS ***************}*****) R2SOPN.SRK   .TITLE R2SOPN .NREL .ENT XOPN,XCLS  .EXTN WRLIN .EXTD LHB,RHB,CHAN,TEMP,TEMP1 .EXTD .GCH,.FIND,SPACE,TEMP2 ; ; OPEN A FILE ; ; XOPN - STANDARD COMPILER PRODUCED ENTRY POINT. ; ; AT THE MOMENT ALL FILES ARE TREATED EQUALLY..... ; BUT SOME ARE MORE EQUAL THAN OTHERS. ; ; TWO FORMS - ASCII WHICH BUFFERS INPUT ; RECORD INPUT - INPUTS DIRECTLY INTO USER AREA. XOPN: .SYSTM ;ASK RDOS .GCHN ; FOR CHANNEL ERR.2 STA 2,TEMP2 ;CHANNEL NUMBER MOVS 2,1 ;CHAN # TO AC1 POP1 3 ;GET FBA MOVZR 3,3 ; MAKE WD ADDRESS STA 3,TEMP ;WORD ADDR OF FBA POP1 0 ;RECORD LENGTH INC 0,0 MOVZR 0,0 ;WORD COUNT OF BYTES ADDS 0,1 ;FORM FCH CONTENTS STA 1,FCH,3 ;STORE CHAN # ISZ FST,3 ;SET BUFFER EMPTY POP1 0 ;GET FNA LDA 3,PC ;PICK UP CURRENT ADDRESS LDA 1,-3,3 ;FIND THE END OF FILENAME MOV 1,1,SZR ;TEST IF APPEND MODE? ISZ APIND ;YES THEN SET FLAG SUB 1,1 STA 1,-3,3 ;RESET THE FILENAME. REOP: SUB 1,1 ;NORMAL CHARACTERISTICS LDA 3,APIND ;APPEND MODE? MOV 3,3,SZR JMP APP ;YES THEN OPEN APPEND .SYSTM .OPEN 77 JMP TEST REOP1: STA 1,APIND ;RESET APPEND MODE INDICATOR LDA 2,TEMP ;RESTORE WD ADDR OF FBA JSR @.GCH ;TEST IF ASCII FILE NEXT ;NO,CONTINUE LDA 0,SPACE ;SET SPACE IN BUFFER STA 0,0,2 SUB 2,2 ;YES|,THEN FIND A FREE BUFFER JSR @.FIND MOVZR 0,3 SUB 0,0 ;ENSURE THAT A NULL IS STA 0,0,3 ;PRESENT AT THE START OF BUFFER LDA 0,TEMP2 STA 0,0,2 ;STORE CHANNEL NUMBER IN TABLE NEXT APIND: 0 APP: .SYSTM .APPEND 77 JMP TEST JMP REOP1 ; IF THE FILE DOES NOT EXIST, CREATE IT! TEST: LDA 1,C12 SUB# 1,2,SZR ;IS IT REAL PROBLEM? ERR.2 .SYSTM .CRAND ERR.2 LDA 3,TEMP ;ASSUME THEN THAT IT IS SUBZR 2,2 ;AN OUTPUT FILE AND STA 2,FST,3 ;SET EOF IN FILE STATUS. LDA 2,TEMP2 JMP REOP C12: 12 ; CL>ZOSE A FILE ; ; TAKES ONE PARAMETER FROM THE STACK - FBA ; XCLS: POP1 2 ;FBA MOVZR 2,2 ;WORD ADDRESS OF FBA SUB 3,3 ;END WITH A NULL STA 3,TEMP1 JSR @.GCH ;GET CHANNEL NUMBER ET AL. JMP CLST ;NONE CHARACTER I/O LDA 0,FST,2 ;TEST IF A WRITE FILucE MOVZR 0,0,SNR JSR @.WRLN ;WRITE THE LAST LINE LDA 2,CHAN JSR @.FIND SUB 1,1 STA 1,@TEMP ;RELEASE THE BUFFER CLST: LDA 2,CHAN .SYSTM ;CLOSE THIS CHANNEL .CLOSE 77 ERR.2 NEXT .WRLN: WRLIN .END