܀"PW"_ Eߕ ߋ '_ _  7I/O ERROR7BAD DISK FORMATߋtv7|TRAP TO 47nTRAP TO 10_ PPr2 _$(,8<DHLPTX\`dhlptx|"f&f&TRAP TO 4/10f&f&-  BPT EXECUTIONf&f&EUNKNOWN INTERRUPT b b@Y |Y b X b SYSTEM FAILURE R0 R1 R2 R3 R4 R5 PC PSWXXXXXX ߋtvx @ D DU@ff&f&_f&f&_f&f&   , W  ߋ_ @ Se~ &%"ߋtvȋvߋt KERNEL LOAD ERROR LOAD ABORTEDJ* r t@P W ߋ   SYSTEM LOAD ERROR J* v Wt _ ߋ  z J*gJ*@ BEv_E  zee B~e %Pe@fSPACE LIMIT .^ \N Z``Z\Dt_pqIMPH : 8       z g,' '0 0 eFT^T\ ^e'TX X T|T 8X H J\ ` zCORE LIMITj e?D s@! aVIRTUAL LIMIT: <  : e@ r 6  (  < Se~6 Wp _8     e r 6 ` (   eSe~6  eg eLB~6  egeLB~ @tEE vC`B C~PARAMETER LIMIT F beU0@BDFHJF& LN p tN ebPPPPPPPPPPPPPPPPPP@BDFHJFF LN8  Fe  Fgn_nW  r_ n@j  n t pr   b  r F R ~ \^ b` ` (  g* A g, A eA (  0  b 8 j 8n     &fU00 gd( Ber f ~J* H. F& @_BDNL z fg  \^ b` ` b   g B Hg B g" B eB (  _$ _: > j 8n     U0&$ J" & H eFNLg @TERMINATEDOVERFLOW ERRORPOINTER ERRORRANGE ERRORVARIANT ERRORHEAP LIMITSTACK LIMITh p"0<JU  L| ( * , . : 8   2 : |A`A _ be11    G~  #          r  t%r   : 8   z      p r|   : 8  |     pr z : 8 . |    ~H & _  pr z p r  ^ b` `    PA`AaAbAcAdAeAfAg (P  "*qJ*B\,& ." V$ & .tg,T p  B\TR : 8 & v   P R 5@55 5 5 595@ &  U0   P $ $ECJP DeH N qp25_>PH R" $ & Rt`PN r LPt@P W P : 8 B& dN_B  5@  5L5 ߋ&B U0  B  F Rl% ~v v~vU@trzEz%zn %l% z zxz~  p%l$ v v vt l x xt zU0 0 JP _L& qd : 8 t LHrl ~ n ߋtlvߋt v xn App | t | (P  L    P U@L ~_N ~ߋLU@L ~_N ~ߋL : 8    & L U0 T  L  0P 50 & .42UA0 : 8   055 55 &U0  %(ĜÜQ ~  U0U0&ABCDEFGH.<(+!I 12345678:#@'="90/STUVWXY,%_>?Z-JKLMNOPQ$*);^R0 ,  pr| p@ !)1 |2_HJ_N F)_HJ L_T * $_&(_0 _ _ , _.0_2*_f&f&_f&f&_f&f&_f&f&_f&f&_f&f&_z :<<<_ 012345\d r e0b : >SYSTEM LINE 6: >: >\ f: >: >6: >SYSTEM READY6: >: >6: >  R   R   & T   N & "(.2:BHP`x|(LRZhlxFR^jv2Lbt ",6Bbrbb&^bp(.26<HRdzw f d&dfdd&@d&e&&&&e&&&&&&&&dwS wzSpN` wbd t0wb#wN#wF    ~R~S wdS w7` ! ~ @ @N E~UU~ wteewd wT E~Npw4N  rw   rwN wEWtat wEWtaB tEe %  %  %  %  %  %  B  & 4  & &  &   &  &  & Q,~ e QL~ eQ,~ e qD~ e  ~  $~   ~   ~ $~   ~ d&   &bm w0 b  w `b ~d@dS wf& d  f& dXS w \wwD8S wrf& dS wJf& dw7w7 S wf& dw77nS wf& dE7 `  Ld  `A ~dd7 d e`&   wE   N   7Dw7pzwxv7x $VXRL7P :44.72 7w<w2w(www w7 b7 D 7 e&f&f&   v v v !N v v v 6 6 6 6  w8v Da   B A @  A @  @ 4% A% % Be % fDvwBwC    mB A @ mA @ m@ m;0         C B A D 6veH ew         B A @  A @  @ 0 B A @      @&f&f f & 6 6 v %w   a6 6 bC RaA CaB A  <aA CaB A  &aA CaB A B  aA CaB A  aA CaB A  aA CaB A  a@ BaA @  a@ BaA @  aAa@  B A @  B A @ 7%)B    C B A @ 6veH ewD    &    aam6qe  &f&f    & N & QR  v  6 66 6 6 6 "v     1w8 %6 6 6 6 ?     6  6  r6  b e%v 6 6 6  D v v v 6 eH w| B A @ - ---       &fee CR$$$ "  C 6e N A f C%v   H wp 6 6 &  f 6A  v  6NHvwtr7t`w^\7^ <>8276 : 7 7w<w2w(www w7  7 D 7 N"!8P \$ < " P>" >"$ C " P>" B"$ J X"$ M X"" O"""4 ] " 4 cF" . h"&4v " @ b ~B"b *B4 ~t" . "b >, " " B "" >" "   X PX6  ^ JD 0""  X:^U " X@ Z.  B" Xf `" Z< >"  X( >"   X PX6  ^,  P>  T      R  >  @ 4 t* P" | *Bz"n"f  z |  " >"  "z  X"d n >"    X PX6 |  ". - . /? t " t "  t^4 r$ r*v O VR 46 T & k  `2 `2" q T""" x""~ h(   &(  B  ""$ BL>" ^  "   BP> *   6 LH""* "" >"  "  ^. HP>"  X  X6 "Z& D :" T" " " 0 Z2  x  * "F X B" P>"` ,   |   < "   ". """& & v "0 & > bN 9 ""V  |  0 " ^ "  (`\"  `(  ' " " P (N l   J  0 " ^ " P h `\"  `(  l " "  N  $  V"$  Z"$  VB >"  *  "$ " " ^   B"$  Z  *" ""  0 *""   *"" ""  z0v |*Bz"x"  zx| *Bz"v" !z""/ 0 * """6  * """ <"2 K X B" >"  " X* 0 "" ["2 ^ >"  X X6F " X t" i" kR  " < X 2 H$jJ$R"  . ( X "  "   @@ Z V@ R    :   2   2   $    ""  "  < b t b r b 2   (2  H  0  X    0  X   l   X@ X$    $  " "   L bZ jR XZR*" l`2     BR   `r  l" l6*BrpnNZ@ 0  "  X 2 .nT6pT.vR.   . ( X "  " ^  @ CZ @ FZ \J: : M:r2P: ~2S: " V :"" Y " \ < _b lt bb Xr eb 2 h 2 k 0 n $0 q D0 t  p0 w  l{   6@ X$ h   $  " "   J tbZ H:   r    XZZ.ftrpdr~. n"tnnBl"Bl"2l" l t " nzn^:pnX$  "  "  `D`Dj \~PHZHLH>`~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TERMINATED IO IOPROCESS: TERMINATED CARDS: ERROR PRINTER: INSPECT ~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TE      , XZxZftrpr~v n"tnnvl"nl"Rl" lD tX( " nn^Z߲nXd$  "  " ٲ 2ڲbtHdڲ"bHtTH HHbdfbbTbH"TH" bH" H" zbH"H \@H@( UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TERMINATED IO IOPROCESS: TERMINATED CARDS: ERROR PRINTER: INSPECT bTbH"TH" bH" H" zbH"H \@H@( UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO >;w::fe&efef&&$ f rNeNpN rN&e&e&&$ f \ wXfef$& h w0fefe rNwfef$&e&&&&e& &e&8e<&9 fef$e&<Ce Ce |Ce$ fCe. PCe8 :CeB $CeL CeV Ce` Cej Cet Ce~ Ce Ce tCe ^Ce HCe 2Ce feC3Csf&0P1P2P3P4P5P6P7P8P9PVRfeC3Csf&APBPCPDPEPFPGPHPIPJPKPLPMPNPOPPPQPRPSPTPUPVPWPXPYPZP_PVRfe5uf&5uf&HVRfe5uf&C3Csf& PP P P+P-P*P/P(P)P$P=P,P.P'P%P:P#P"P&P@P<P>P?P;P PHVRfeCe8&e& &&l w$fe&$& &e weCe Ce Ce Ce Ce Ce Ce ! |Ce fCe" PCe(# :Ce2$ $Ce<% CeF& CeP' CeZ( Ced) Cen* Cex+ Ce, tCe- ^Ce. HCe/ 2Ce0 Ce1 Ce2 Ce3 Ce4 Ce5 Ce6 Ce7 Ce8 l xfe8 w"fw\&eAw&e w&e_w&eBw&e w&e(w&eCw&ew&e)wx&eDwd&e wT&e,wD&eEw0&e w &e;w&eFw&e"w&e@w&eGw&e.w&e*w&eHw&e:w&e/wt&eIw`&e<wP&e+w@&eJw,&e=w&e-w &eKw&e>w&e&w&eLw&e'w&e$w&eMw&e0w&e%wp&eNw\&e1wL&e?w<&eOw(&e2w&e#w&ePw&e3w&eQw&e4w&eRw&e5w&eSw&e6wx&eTwd&e7wT &eUw@&e8w0 &eVw&e9w  &eWw &eXw &eYw&eZw UxB~bJ4f2*LT.`(Z"T>` .@ w&efDfefef\ wfe&   && X w<- &e  &ew$ &e !&e"#&e $%&e&e&&e&$&& rN  0e'&e&(& r&& \ w`)&e&& &&d w(&e&$f &e we*&e&&&&l w + &e we,-..N/01f w2fe 34Af& XAf`U w fe?5Af5uf&T w fe?6Af 78wN9:;<f w=Af> h? w@fefefefe f$f@w@ABfe CDfefeEfe FGAf& XAf`U w fe?HAf5uf&T w fe?IAf Jfe f$KAfAf \Af\U wLfe& fefe & $MfNOwPQfe RSAf& XAf`U w fe?TAf5uf&T wfeU?VWXYZZ<[ \& ]f w &^ |_`aa<b& cf w &d 8efgg>h& & if w& & jklmm@n& & & of w& & & pqrss>t&u zvwxxFyf wfzf w fe {Af9X wfeAfew|fe0}Af9X wfeAfew~fe0Af9X wfeAfew6fe0feAfeAf Af Af Af   &  4F&e& "V^&e "V^&e:&etfV^&e& tfCs f wD&etftfVNNAfVfVNN0VfN@NV^w &e Af5uf&T w^Af.\ w^ VAf)\ wfew,Af.\ wfew&e<&e& Af5uf&T w  wtfCsf w`&etftfVNNAfVfVNN0VfN@NV^&e& &Af5uf&T wNAfE\ w&:\ w&e<&e&  &e& &e& Af+\ w vw*Af-\ w&e HAf5uf&T w  rw& l w>&e& NpN0Afew &e Af5uf&T wl& w&e&&w &e&&e&:\ w^tfVfx w @&etfV^:tfVf Xw& w tf&e w&& h w&  &` w  tf&e w&etfV^&& X w,&e&e&  w &e& &e&&&l w(&etftfVNNV^&e wetftft wtf&e w& w"tftfvVN&e wrtfCsftfvVN w$tftfVNN&e w tf&e wtf&e <&e& $&e$ ,&e$&e$ @ ~fef$&e&efe& $ f& ` w& s&e&e& ` f  "& h sj&e&& f ` "  A F@&e$e & ` ue "e " e  6 zf `f  bed  ` b  ` r fd `     " 9& ed & `f   " ed ` "   8  e&&fe$ 8 &ef&&l wn&e@ D&e &&fe&$ 8&e&&e w~ee<&e& fef$&& h wf&eh w4fefe rNw& ( wD&efe& fe!&e"w0fefe# rNwD$% &fe9'fef(&e)*e+& w,-./011X2&e& 345Afw 678f w9fe :Af \ wAf fe w;<Af& XAf`U w fe?=Af5uf&T w fe?>Af? @wA Af h ww BC Pw DE&ew FGH IJAf"hAf hA N@AfhA N@ w JwKAf \ wL Af"\Af\U wnMAf\ w  8wN w OPQ Rf w"S TfeU& wXAf.\ wV |w2Af)\ wW Vw  X w YZ[ \Af=\ w  w  ] Lw^_` aAf=\ w  w2bAf>\ w  w c wlde wXfgh XiAf=\ w  Jw j wklmn&e& opq r&e&es&eZ&$O& Aft Af'\Af \U wuAf \ w  wv ^Afw'h w@&\ w  wx&e&y&\ w";&eZ$O vw,z& rN\ w,{ |&e&}e~=& &e&&X w&eZ&e$O&eZ&$O &eZ&e$O .&e&ewTw w~fe fe fe& fefe& f \ wJfe& fefefef$ fe8wfefefefefef$ f$ AffefAf rNeNpN rNf wfe Af& XAf`U w fe?Af5uf&T wAf w\feAf5uf&T w fe?Af w: feAf5uf&T f w 2f9\ w9f Pwf f\ wdAf.\ wN bAf \ wf w &ew Af.\ w  w  2wf w" fe& w w| wh |wT hw@ Tw, @w ,w w1 w  ,w U~hp0Vf:2tj & w(  Ffe Af& XAf`U wfe? Af5uf&T wfe? Af Af h wPAf \ w  zwAf h w R&eC3Csf&+P-P;P PPVRAf4tf&T  wfe Af& XAf`U wfe? <Af5uf&T wfe? Af w<Af \ w  wAf4tf&T wAf+\ w&wjAf-\ w && wDAf\ w  4w &|  &e& fe@f&e &e  &C3Csf&& PPP PPVR &e&  Af \ w wAf \ w &Af"\ w` Af"\Af\U wAf\ w  w NAf \Af \UAf"\U wAfO\ w&e&e & w AfC3Csf&OPRPPPVPLPTPSPIPT w r&ewAf I\ wv!&eC3Csf&;PP5uf&HVR" Af4tf&T w#Af$5uf&T w%&eAf0& Z'Af(5uf&T wB&e&e NpNAfe0)*wB+ ,&e-Af;\ w. /0wR12Afw&ew3&ew4&ewp5&ew\6&e& wJ7&ew68&e9wL h v:& wD&&Rf&C3Csf&&P;HVRw@&&Rf&C3Csf&&P<LVR=>?@& wDA&Rf&T wBfeCDfe Efe& Ffe & $AfGAf hAfhA N@ w\HfefeIfe Af Jfe f$KAfwzLfefe & $ffeM& w.& &Rf&T wfeN& OePQRSTUU6<  ~VWXfe& fe& Yfe& fefeZfe0fe0fe0fe0[\]^_` a bfef fA N@c dfef FALSE TRUE EOL EOM CR FF INTEGER BOOLEAN REAL CHAR ABS SUCC PRED ORD CHR TRUNC NEW NIL END IF THEN BEGIN ELSE DO WITH IN OF WHILE CASE REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT DIV CONST TYPE FUNCTION FORWARD PROGRAM 5x38<ʑv\W,^^k v:@UE EOL EOM CR FF INTEGER BOOLEAN REAL CHAR ABS SUCC PRED ORD CHR TRUNC NEW NIL END IF THEN BEGIN ELSE DO WITH IN OF WHILE CASE REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT DIV CONST TYPE FUNCTION FORWARD PROGRAM 5x38MMw K feC3Csf&PVRfeC3Csf&PPVRfeC3Csf&"PVRfeC3Csf&PVRfeC3Csf& PVRfeBC3Csf& PPVRfe2C3Csf& PPVRfe"C3Csf& PP"PVRfeC3Csf& P PVRfeC3Csf&9PVRferC3Csf&9PPVRfeC3Csf& PVRfeC3Csf& P"PVRfeC3Csf&P PVRfeC3Csf&PVRfeC3Csf&PVRfeC3Csf&PVRfebC3Csf& PVRfeRC3Csf&PVRfeBC3Csf&-P.PVRfe2C3Csf& P PVRfe"C3Csf& PP$PVRfeC3Csf& P PVRfe5uf&C3Csf&9P:P<P;PHVRfeC3Csf&9P:P<P;P=PP2PPVRfeC3Csf&PP3P/P1PVRfeRC3Csf&PP0PVRfebC3Csf&PPPPPPPVRfer5uf&5uf&HVRfeC3Csf&P P PVRfeC3Csf&9PPP$P#P%P)P!P PVRfe5uf&C3Csf&P P*P,P+PHVRfeC3Csf&6P'P8PVRfeC3Csf&4P5P(P5uf&HVRfe5uf&C3Csf&PHVRfe5uf&C3Csf&PHVRfe5uf&C3Csf&;PLVRfe5uf&C3Csf&PHVRfeC3Csf&9P:P;PVRfevfe|& fep& fer frfe&Rf&Tef w  &ex&&l w2 &e we  fe  D fefe f\ w fe&    && X w<- &e  &ew$&e &e&e &e&e&e&$&& rN  0e&e&& r&& \ w`&e&& &&d w(&e&$f &e we&e&&&&l w &e we !""J#fefe$f\ w%fe& & ' (Af9X wfeAfew)fe0*Af9X wfeAfew+fe0,Af9X wfeAfew6-fe0.feAfe/012* Af Af Af 3Af *  45677<8& 9f w &: ;<==>>& & ?f w& & @ABCC@D& & & Ef w& 8& 0& (FGHIJJHKfet LftXM wft& \ w4Nf w O& fetP QwB<~p, 4 ""* ;"  @: N > R" G" ^@ : >" G"F _  "" >"   P0>   L" X " \, \8 k d* mr$ {" }"$  " P>" >"$  " P>" B"$  X"$  X"" """4 "  4 F"  . " &"  "    &" `$  *( " " V@  x " >" ""  *:  J x"8  "$  *0 (  $( $0 <@$4h4D$( D$P 1 "  BH `  " `,     d> $N"  $JD$N" JD" : : n  K f    x @&i" `"L  "8p D$,hLb"Th"*xL   "  $(~L    $" L  "b " `L     f   0    @$ 4h  4D$L0    l ,N r   \ h    "F   ^X  X (Z  " T0 x T 2b 0B"  B LZ   H >" Z  * T0 T^" 8T  V20 >"   |l ::r Z ;Z6 ;Z6 . $ J J@ @$(,.) f   z*    (@,*|) f   *   8r (R)x `   ,$ F : (J)  F*% " ".TvARBRCRDRERFRGRHRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR_R&0R1R2R3R4R5R6R7R8R9R&  J L"  .x f:x NFx L6Rx ^x    6T TNxD(Nx j B NxDv v @ NxDvj  b> NxDv&dDzV NxD< pCaF(HH@TRY AGAIN START(TASK, HOUR:MIN:SEC) PERIOD(TASK, HOUR:MIN:SEC) STOP(TASK) TIME(HOUR:MIN:SEC) SOLO TASK UNKNOWN TASK UNKNOWN TASK UNKNOWN TYPE COMMAND START PERIOD STOP TIME SOLO SCAN FLOW LOG v&dDzV NxD< pCaF(HH@TRY AGAIN START(TASK, HOUR:MIN:SEC) PERIOD(TASK, HOUR:MIN:SEC) STOP(TASK) TIME(HOUR:MIN:SEC) SOLO TASK UNKNOWN TASK UNKNOWN < b t b r b 2   (2  H  0  X    0  X   l   X@ X$    $  " "   L bZ jR XZR*" l`2     BR   `r  l" l6*BrpnNZ@ 0  "  X 2 .nT6pT.vR.   . ( X "  " ^  @ CZ @ FZ \J: : M:r2P: ~2S: " V :"" Y " \ < _b lt bb Xr eb 2 h 2 k 0 n $0 q D0 t  p0 w  l{   6@ X$ h   $  " "   J tbZ H:   r    XZZ.ftrpdr~. n"tnnBl"Bl"2l" l t " nzn^:pnX$  "  "  `D`Dj \~PHZHLH>`~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TERMINATED IO IOPROCESS: TERMINATED CARDS: ERROR PRINTER: INSPECT ~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TE   "   "  N  BP> *    BP> * "    "  * * "   "H $  ~ "    P>"" Z 02 h * x"L  X B"   P>"bH $ z ~ "    P>"" Z 02r h * x"2 B"   P>"|T +  x"T 1  x ~2"t 8  z  *t B d < * dt M   * *  "   >"  t ] f >*" \  B"   l "8 0" h"  x  "} " "   " ""`H" *  " " "" `&  " "" `&  "   " " "    b " 0 " V Z6 "h x0 "H  " " z "  0 "R   ""  "  06 "P  " 0 v " 0 "4  " " " (0 "< D " " " T < X$    " J< RH "  `4     " "  v   "" 0 ` 2 X>    >"| X X6"T"   " B ^ " " "$Gt  ^ " * "$Pt  ^ " " "$Yt  ^ " " "$ bt  ^ " ""h "  x "f x "H "x "* .x " ""r " :x "* Fx " "$ z R R*R ^*B j*2 v*" *$  " * * $  " * * r" `B B H >G    X,  H>G ˒T D B"   0 " H`0 `6 "XP >BL" R ^ "J " H"lܒN  0"  `:J 0" (  0"   z   0""     0" X  j ~00h x2" ".،:$(֌"  `2   ~   4   `F0D<<"   `&  nӰӰ0+  r B N0 "  `"  @ " L<    $ " bGL    " P"גpUH"\""~" `. H"  &" `Pf$ Ҍ< >" H" >HB `B T P҄ :B >"J >" Z \6fВpyt*Ò"zV x "tx  "Vx "8x "x "x "x "x "x  "x  "fx "Hx "*(x  " " 06   "("4,<6"LV X "($ 6N&ARBRCRDRERFRGRHRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR&0R1R2R3R4R5R6R7R8R9R&" `Ht  " F* ""H `", G  " R* """"""" " "v8+R-R_R"R'R#R&R(R)R*R=R<R>R,R.R/R?R@R:R;R8& " "" `Z   ^*  " " "" j*  " " "" `8 " ""vɌXfv|tdldh\TLfD<X4n,$ x T SYNTAX ERROR #TRUE FALSE DISK FAILURE, PROCEED?# ERROR IN FILE INPUT# ERROR IN FILE OUTPUT# INSPECT TAPE# TRANSMISSION ERROR# TAPE FAILURE# SEARCH ERROR# PRINTER FAILURE, CONTINUE?# NOT IMPLEMENTED# A~j"@b؉=V6B:L:D>(BNAME ERROR# CATALOG FULL# DISK FULL#FILE LIMIT# FILE PROTECTED# CATADDRESS IS WRONG # ARGUMENT ERROR# CATALOG ** PAGE NO SCRATCH ASCII SEQCODE CONCODE ALPHA INT EMPTY SCRATCH ASCII SEQCODE CONCODE PROTECTED UNPROTECTED TRUE FALSE LONG CATALOG LIST# NAME KIND # ADDRESS PROTECTION # FILELENGTH PAGESET BYE, IT WAS A NICE SESSION# * CYLINDER * #WHAT?#ACTION?# NEWCAT OLDCAT CREATE DELETE RENAME PUTATTR GETATTR LIST DUMP DUMPFILE LOAD DUMPFREE FINISH OLDCAT OR NEWCAT # SYSTEM INITIALIZER PROGRAM# **************************# FALSE LONG CATALOG LIST# NAME KIND # ADDRESS PROTECTION # FILELENGTH PAGESET BYE, IT WAS A NICE SESSION# * CYLINDER * #WHAT?#ACTION?# NEWCAT OLDCAT CREATE DELETE RENAME PUTATTR GETATTR LIST DUMP DUMPFILE LOAD DUMPFREE FINISH OLDCAT OR NEWCAT # $Ȳ rDz "   `    ~\Dz hȲ HȲ Ȳ ,Ȳ |߲ RȲ RƲ0Dz<Dz"   `&   !Ų""#$Ų%%L%&0*+, ,- -. n./ j01˲2 " 2  `&  3x344"45 6dܒL;<= => r>?  @l@"@A BےFGdH HI  JJ"JK L&ےOPQɒpTUHLVW"[\""]~^"^ `_` Dza"bbc  &d"d `ef8²gf IJh²i >"j H" >HBj `bkl T mÄm :~òmn o>"pppq r>" Z \s6Tstupxytz~"zʹX 2x " x  "x "x "x "dx ":x "x "x  "x  "x "hx ">(x  "" 06  "("4L*"> X"d( B 6N&ARBRCRDRERFRGRHRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR&0R1R2R3R4R5R6R7R8R9R&" ``t  " F* ""H `", G  " R* """"""" " "v8+R-R_R"R'R#R&R(R)R*R=R<R>R,R.R/R?R@R:R;R8& " "" `v    ^*  " " "|" j*  " " "" `H " ""v2&ⷲ.`    8      |l0\L<( 4BP^lx N  SYNTAX ERROR #TRUE FALSE DISK FAILURE, PROCEED?# ERROR IN FILE INPUT# ERROR IN FILE OUTPUT# INSPECT TAPE# TRANSMISSION ERROR# TAPE FAILURE# SEARCH ERROR# PRINTER FAILURE, CONTINUE?# NOT IMPLEMENTED# A~j"@b؉=V6B:L:D>(BNAME ERROR# CATALOG FULL# DISK FULL#FILE LIMIT# FILE PROTECTED# CATADDRESS IS WRONG # ARGUMENT ERROR# CATALOG ** PAGE NO SCRATCH ASCII SEQCODE CONCODE ALPHA INT EMPTY SCRATCH ASCII SEQCODE CONCODE PROTECTED UNPROTECTED TRUE FALSE LONG CATALOG LIST# NAME KIND # ADDRESS PROTECTION # FILELENGTH PAGESET BYE, IT WAS A NICE SESSION# * CYLINDER * #WHAT?#ACTION?# NEWCAT OLDCAT CREATE DELETE RENAME PUTATTR GETATTR LIST DUMP DUMPFILE LOAD DUMPFREE FINISH OLDCAT OR NEWCAT # SYSTEM INITIALIZER PROGRAM# **************************# FALSE LONG CATALOG LIST# NAME K&,e& \ w &e&,ew^&e&,e &,eewHXe@ ~ &@ D&&e4&, e &, e &e&, ee&, ee\ wx&, e,ef&\ w&ew&&e&, ewX&, ef&\ w&ew"&e&, e&& &, e &NpN& rN\ w0 (&&ee@ ~fe6f$&@ B&&&e&e4&& h wf4&$&e& \ w6&,ef4&$w. &,ef4ewh&e \&&f,&e& 4e&,e&e eX ~&@^&&C3Csf&VR&e&&e&e&e 6& w& &\ w|& &l&dA N@ wD&&Rf&C3Csf&&PHVRw  w  w  fe\ we v: ~&e&&& &&e4&,@e &&,@e & &,@e&&,@ef&,@ef&,@e  & e  Z feh w& &e& & fe\ w > ~&e &&& &&& & H&e &e&&&&eU&&&&,@e& &&&e!&e"&,@e #e&& \ wt$f\ w&e% f&h w '(( V ~)&& *f\ w&& +& && :,f\ w-&e .&/& \ w&0&w& ,@e &1& &2&3&e44&,@e & 5&,@e& 6&,@ef7&,@ef8&,@e&9 :& &e b;&e&<&&=&>&e` w$? @&eAf,w8&e\B w&e&,eC&&D&eEeeF&e&G H&e&I&eC3Csf&VRJ&e&Kfuh wdL&&e& M&N4tf&&Rf&DC3Csf& w :O&e&,@eP&e4tf&Q&Rf&HVReR&e&S&e& &T&e& U&&`V w &&W&,@e &X&eY& wZ&,@e &[&\]  ^__D ~` a&e& b&@ Fc&d&& e&e& f&e4g h&,@e&e& &&e ij kelmm<nfwPp& 2ws& w& ww& Zwy& w|ne~|zxvtrpnljhfdb`^\ZXVTRPNLJHFDB@><:86420.,*(&$"  }~< ~fe6f $ &ef.&e&fe. 8f.&e4&,ef &,e& &,e f.&,e & e &ef.fe\ w, &e ^&e&&e&e&eU&e&,e &&&&e&e&&,e&ee&f.\ wXfk\ w je @ ~fe6f $&f2,e & fl\ w &ef.ft\ w &ew &e&e&fe. N bf.&e4&,e&&,ef &,e f.&,e & &ef.efe\ w. & &e  &e&&&e`&\U w&ew&e&e&e&,e &&&&e&e&&,e&ee&f.\ wXfm\ w F&,0e& &e&ef2,e && h w|&&,e&,e&,0ee&e&,e ewn&e& e>fe6f$&e& &ef \ w& f4&$& &e&\ wN&,0e \ w& &&ew  @e& w<& & f& e&4 fd\ wZ& w & ,0e 4&&  nw& &f,&,0e& &,0e& fe0& f0 wr&,0e 4fe"f"e&, ,0e f"&w&,0e 4&, ,0ef &&, ,0e& \ wPf4$f4& $&     ee @ ~&e&e&e :&& ` w fef fe.f2& & &e | &&&\ w&& w4&,0ef2,e  vfef  !"#%@ ~&&e&e&e '&& ` w( Z)fef *fe.f2& ,&\ w&& w4-&,0ef2,e . p/fe0f 1238 ~45ff\ w 6fh\ w 7fj\ w >8f0,0ef2,e 9fwh w:f\ w .wf;f\ w < wB=fe0& >fef"e?@ AwbBC fDv\ wmssHxs@U{oyx" po^yJOBINPUTTEXTi po^yUJOBBUFFER1  po^yZ  po^y po^y po^ySPASS1  po^yg Bpo^y  po^yDISK po^yj  po^y `po^yCARDSMAN po^ymLIST po^ym po^yMOVE po^yp  po^yMAKETEMP po^ySPASCALTEXT po^ySPASS4TEXT po^y  po^yWRITETEXT  po^y po^yAUTOLOAD po^y po^yCONSOLE po^y REALTIME gpo^yJOBSTREAM po^y po^y po^y po^y Hpo^yKERNELTEXT3 Epo^yp po^yMOVEMAN po^ym po^ySPASCAL po^yu po^y po^y po^y po^y z { | } ~  po^y po^ySUPERMAC apo^yBACKUPMAN po^yCPASS3 Ppo^yEDITMAN po^yMAKETEMPMAN po^ySPASS3 po^y po^y po^yJOBINPUT po^yJOBOUTPUT p po^y      po^yJOBBUFFER2 po^y START  po^y CPASS3TEXT rpo^yCPASS6 Ipo^yLISTTEXT po^yREADTEXT po^ySPASS3TEXT (po^yCPASCALMAN po^yLISTMAN po^yPRINTERMAN *po^yREADMAN po^ySPASCALMAN po^ySPASS6  po^y po^y " # $BACKUPTEXT po^y%CARDSTEXT po^y%CPASS2TEXT  po^y%CPASS7TEXT @po^y%DISKTEXT +po^y%MAKETEMPTEXTpo^y%SPASS2TEXT po^y%SPASS7TEXT x po^y%BUILDTEXT xpo^y%FILETEXT  po^y%CDISKTEXT po^y%CPTEXT po^y%RKBOOTTEXT !po^ySTARTMAN po^y po^yWRITE y po^y po^y  po^y  po^y  po^yREALTIMETEXTpo^y po^y po^y po^yJOB Ypo^y po^y po^yCOMMANDS po^yFILEMAN po^y1TAPEMAN po^y1TEMP1  po^y2TEMP2 q po^y3PRINTER po^y5KERNELTEXT4 po^y5MTOPTEXT po^y%WRITEMAN | po^y1CPASS4 po^y9 po^y po^y po^ySPASS2 po^y= po^yJOBOUTPUTTXTpo^y%JOBSERVICE  po^y:BACKUP  po^y po^y Ipo^y po^y ?po^y po^yFILE po^y po^yCONSOLEMAN po^yCOPYMAN po^yCPASS7 po^yDO hpo^yKERNELTEXT2 po^yDISKMAN !po^y t po^y Epo^y  po^y po^y po^y po^y cpo^yTAPE po^yF po^y Hpo^y po^y po^y K po^y M N po^y PSPASS5 po^yPIPELINE po^y po^ySOLOCOPY po^yCPASS1TEXT  po^y CPASS6TEXT po^yCPASS1 po^yPRINTERTEXT po^yCATALOG SOLOTEXT po^ySPASS1TEXT po^ySPASS6TEXT 0 po^ySTARTTEXT 8 po^y  po^yJOBSTREAMTXTpo^yJOBSERVICETXxpo^y Q R S TCONSOLETEXT po^yU COPYTEXT po^yUIO ?po^yWCPASS5TEXT Apo^yUTOTAPETEXT po^yUCOPY po^yZSOLOBATTEXT po^yUSPASS5TEXT po^yUSPASS7 H po^y[TAPETEXT po^yUCPASS5 )po^y_BUILDBATTEXTpo^yUPREFIX po^yJOBPREFIX  po^y po^y po^yCPASCAL po^yXMAC po^y 9po^y po^y rpo^y po^y  po^y po^y cpo^y  po^y po^yPIPELINETEXTpo^y        !#%'"$& =?)+-/13579;>(*,.02468:<ACEGIKMOQSUWBDFHJLNPRTV@]_acegikmoY[^`bdfhjlnXZ\y{}qsuwz|~prtvx        !#%'"$& =?)+-/13579;>(*,.02468:<ACEGIKMOQSUWBDFHJLNPRTV@]_acegikmoY[^`bdfhjlnXZ\y{}qsuwz|~prtvx################### # BACKUP MANUAL # ################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES THE ENTIRE DISK TO OR FROM MAGNETIC TAPE. A DISK BACKUP IS STORED AS A SINGLE FILE ON TAPE TERMINATED BY AN END_OF_FILE MARK. THE TAPE MUST BE MOUNTED AND POSITIONED CORRECTLY BEFORE CALLING THE BACKUP PROGRAM. CALL: BACKUP(HOW: OPERATION) USING OPERATION = (READ, WRITE, CHECK) READ COMMAND: DISPLAYS THE MESSAGE PUSH RETURN TO OVERWRITE DISK ON THE CONSOLE. WHEN THE OPERATOR PUSHES TH#################### # CPASCAL MANUAL # #################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COMPILES A CONCURRENT PASCAL PROGRAM INPUT FROM A SOURCE MEDIUM, OUTPUTS A LISTING OF IT ON A DESTINATION MEDIUM, AND STORES THE CODE AS AN OBJECT FILE ON DISK. CALL: CPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) THE SOURCE CAN EITHER BE AN ASCII DISK FILE OR A SEQUENTIAL PROGRAM THAT INPUTS AN ASCII FILE. THE DESTINATION MUST BE A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE. THE OBJEC po^y po^y po^y CARDS po^yEDIT  po^ySPASS4 qpo^ySOLOFILES  po^y po^yCPASS2 |po^y po^y  po^y E RETURN KEY ON THE CONSOLE, THE ENTIRE DISK IS OVERWRITTEN WITH PAGES READ FROM A SINGLE TAPE FILE. THE INITIAL PAUSE ENABLES THE OPERATOR TO CALL THE BACKUP PROGRAM STORED ON ONE DISK PACK AND THEN MOUNT ANOTHER DISK PACK BEFORE OVERWRITING IT. WRITE COMMAND: COPIES THE ENTIRE DISK TO TAPE AS A SINGLE FILE. CHECK COMMAND: READS THE ENTIRE DISK AND A SINGLE TAPE FILE AND COMPARES THEM, PAGE BY PAGE, TO DETERMINE, WHETHER THEY ARE IDENTICAL. THIS COMMAND CAN BE USED TO VERIFY THE READABILITY OF A DISK SOLO po^yNEXT po^y READ 8po^yCPASCALTEXT po^yCPASS4TEXT Xpo^yKERNELTEXT1 po^yDOMAN po^yDOTEXT po^y po^yEDITTEXT po^yIOTEXT po^y po^yMOVETEXT po^y BACKUP AFTER IT HAS BEEN WRITTEN. ERROR MESSAGES: FILE LENGTH INCORRECT THE DISK AND THE TAPE FILE DO NOT CONTAIN THE SAME NUMBER OF PAGES. CHECK ERROR THE DISK AND THE TAPE FILE ARE NOT IDENTICAL. T CAN EITHER BE AN EXISTING (UNPROTECTED) DISK FILE OR A NON-EXISTING FILE. IN THE FIRST CASE, THE EXISTING FILE IS REPLACED BY A NEW ONE OF THE SAME NAME. IN THE SECOND CASE, A NEW FILE IS CREATED AND STORED ON DISK. IN BOTH CASES, THE OBJECT FILE WILL BE AN UNPROTECTED CONCURRENT CODE FILE. ERROR MESSAGES: TEMPORARY FILE MISSING ONE OR MORE OF THE SCRATCH FILES (TEMP1, TEMP2, AND NEXT) USED BY THE COMPILER ARE MISSING ON THE DISK. COMPILATION ERRORS THE PASCAL PROGRAM CONTAINS ERRORS OR THE COMPILE        !#%'"$& =?)+-/13579;>(*,.02468:<ACEGIKMOQSUWBDFHJLNPRTV@]_acegikmoY[^`bdfhjlnXZ\y{}qsuwz|~prtvxR HAS EXCEEDED ITS TABLE LIMITS. SEE THE PROGRAM LISTING FOR FURTHER DETAILS. OBJECT FILE LOST THE FILE PROGRAM CALLED BY THE COMPILER FAILED TO CREATE OR REPLACE THE OBJECT FILE DUE TO A RUN-TIME ERROR. ################## # CARDS MANUAL # ################## PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: INPUTS AN ASCII FILE FROM PUNCHED CARDS. ELIMINATES TRAILING BLANKS FROM EACH CARD AND TERMINATES IT BY A NL CHARACTER. THE LAST CARD MUST CONTAIN THE CHARACTER # FOLLOWED BY BLANKS ONLY. IT IS CONVERTED INTO AN EM CHARACTER. CALL: CAN ONLY BE USED TO PRODUCE INPUT FOR OTHER PROGRAMS. ERROR MESSAGES: ERROR TRANSMISSION ERROR DURING CARD INPUT. ERRONEOUS CHARACTERS ARE CONVERTED TO SUB CHARACTERS AND !#%' "$&/13579;=?)+-02468:<>(*,.LNPRTV@BDFHJACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J THE INPUT CONTINUES.  R F """ X  ( " " ^<  >" "0 " " >"   P0>   L" X" BB `  V-| j " \( 2        !#%' "$&9;=?)+-/1357:<>(*,.02468UWACEGIKMOQSV@BDFHJLNPRTY[]_acegikmoZ\^`bdfhjlnXuwy{}qsvxz|~prt     !#%' "$&13579;=?)+-/2468:<>(*,.0NPRTV@BDFHJLACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvs   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M ############### # DO MANUAL # ############### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: TO EXECUTE JOB CONTROL COMMANDS INPUT FROM AN ASCII FILE. CALL: DO(SOURCE: IDENTIFIER) THE SOURCE CAN EITHER BE AN ASCII DISK FILE OR A SEQUENTIAL PROGRAM THAT INPUTS AN ASCII FILE. CREATES A DISK FILE CALLED 'COMMANDS', COPIES THE SOURCE FILE INTO IT, AND INTERPRETS THE FILE AS JOB CONTROL COMMANDS. JOB CONTROL COMMANDS: EACH SOURCE LINE MUST CONTAIN EITHER A COMMENT OR A SINGLE COMMAND. A COMMENT IS L*"$   ( "$ ^ & #^4  "  X "*X @*XbCONSOLE: EITHER A BLANK LINE OR A TEXT STRING ENCLOSED IN QUOTES "THIS IS A COMMENT" A COMMAND CONSISTS OF A NAME OF A SEQUENTIAL PROGRAM POSSIBLY FOLLOWED BY ONE OR MORE ARGUMENTS: PROGRAMNAME PROGRAMNAME(ARG, ... , ARG) USING ARG: BOOLEAN, INTEGER, OR IDENTIFIER; A COMMAND INVOKES THE EXECUTION OF A PROGRAM WITH THE GIVEN ARGUMENTS. A COMMAND IS DISPLAYED ON THE CONSOLE BEFORE BEING EXECUTED. THE COMMAND INTERPRETATION TERMINATES AT THE END OF THE SOURCE FILE OR AS SOON AS ANY ONE OF THE COMMANDS ARE IN ~h>@B?\^`bdfPRTVXZ]_acegQSUWY[xz|~hjlnprtvy{}ikmoqsuw     $& "%'!#CORRECT OR FAILS DURING ITS EXECUTION. ERROR MESSAGES: NOT EXECUTABLE, TRY LIST(CATALOG, SEQCODE, CONSOLE) THE GIVEN PROGRAM NAME IS NOT DESCRIBED AS A SEQUENTIAL PROGRAM ON DISK. THE SUGGESTED COMMAND WILL LIST THE NAMES OF ALL SEQUENTIAL PROGRAMS ON THE CONSOLE. SOURCE COPY LOST THE FILE PROGRAM CALLED BY DO FAILED TO CREATE OR REPLACE THE COMMAND FILE DUE TO A RUN-TIME ERROR. (NUMBER) "THE REALTIME SYSTEM PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECTHNOLOGY PASADENA, CALIFORNIA 91125 20 OCTOBER 1975" "############# # IO TYPES # #############" TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; 2oqw y { &-3579<>):WACEGIKMOQSU@BDFHJLNPRTV\^begikmoZ     !#%')+-/ "$&(*,.9;=?ACEG1357:<>@BDF02468UWY[]_IKMOQSVXZ\^HJLNPRTqsuwacegikmortv`bdfhjlnpy{     0246 "$&(*,.1357!#%')+-/LN8:<>@BDFHJMO9;=?ACEGIKPRTVXZ\^`bdfQSUWY[]_aceglnprtvxz|~hjmoqsuwy{}ik "$&!#%',.02468:<>(LENGTH + 1; DIGITS(.LENGTH.):= CHR(REM MOD 10 + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR LENGTH:= LENGTH DOWNTO 1 DO DEVICE.WRITE(DIGITS(.LENGTH.)); END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN DEVICE.READ(C) END; BEGIN INIT DEVICE END; "############ # BELLKEY # ############" TYPE BELLKEY = CLASS VAR PARAM: IOPARAM; PROCEDURE ENTRY AWAIT; BEGIN IO(PARAM, PARAM, TYPEDEVICE) END; BEGIN PARAM.OPERATION:= CONTROL END; "######### # FIFO # #########" TYPE FIFO = CLASS(LIMIJ"v"$   ( "$  xx x B"$ "x *x xB"  h$ (6x*x x(B" (T (<&|z O" O# xP" P xO Xx x"$| x (NUMBER) " PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY THE JOB STREAM SYSTEM 31 DECEMBER 1975 " "############# # IO TYPES # #############" TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD V " O O O O O O O  O  O xV  "  O  O  O O O O O O ARG: INTEGER END; CONST NUL = '(:0:)'; BEL = '(:7:)'; NL = '(:10:)'; CONST LINELENGTH = 72; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; "############### # TYPEWRITER # ###############" TYPE TYPEWRITER = CLASS PROCEDURE ENTRY WRITE(C: CHAR); VAR PARAM: IOPARAM; X: CHAR; BEGIN X:= C; PARAM.OPERATION:= OUTPUT; IO(X, PARAM, TYPEDEVICE); END; PROCEDURE ENTRY READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TYPEDEVICE); END; BEGIN  O O xV "X O O O O O O O O O O x(V "$ O  O !O "OEND; "############# # TERMINAL # #############" TYPE TERMINAL = CLASS VAR DEVICE: TYPEWRITER; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN DEVICE.WRITE(C) END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> NUL DO BEGIN DEVICE.WRITE(C); I:= I + 1; C:= TEXT(.I.); END; END; PROCEDURE ENTRY WRITEINT(INT: UNIV INTEGER); VAR DIGITS: ARRAY (.1..6.) OF CHAR; REM, LENGTH: INTEGER; BEGIN REM:= INT; LENGTH:= 0; REPEAT LENGTH:=  #O $O %O &O 'O (O )"( xZt| z" x `( O h z X H z#Xv" z  *X<| vBCARD      /1357!#%')+-0246 "$&(*,.KMO9;=?ACEGILN8:<>@BDFHJgQSUWY[]_acePRTVXZ\^`bdfkmoqsuwy{}ilnprtvxz|~hj "$&!#%',.02468:<>(*-/13579S:  &O 'O (O )"( xZt| z" x `( O h z X H z#Xv" z  *X<| vBCARD(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, UNIV TWICE10); BEGIN IF TEXT(.2.) = ' ' THEN LIMIT:= LIMIT - 10; END; PROCEDURE ELIMINATE20(VAR TEXT: UNIV TWICE20); BEGIN IF TEXT(.2.) = ' ' THEN BEGIN LIMIT:= LIMIT - 20; ELIMINATE10(TEXT(.1.)); END ELSE ELIMINATE10(TEXT(.2.)); END; PROCEDURE ELIMINATE40(VAR TEXT: UNIV TWICE40); BEGIN IF TEXT(.2.) = ' ' THEN BEGIN LIMIT:= LIMIT - 40; ELIMINATE20(TEXT(.1.)); SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDI END ELSE ELIMINATE20(TEXT(.2.)); END; PROCEDURE ELIMINATEBLANKS; BEGIN WITH CARD DO BEGIN FIRST:= TEXT(.1.); TEXT(.1.):= '#'; LIMIT:= 80; ELIMINATE40(TEXT); WHILE TEXT(.LIMIT.) = ' ' DO LIMIT:= PRED(LIMIT); END; END; FUNCTION START: INTEGER; BEGIN WITH CARD DO IF LIMIT < 10 THEN START:= 2 ELSE BEGIN WRITE(TEXT(.2.)); WRITE(TEXT(.3.)); WRITE(TEXT(.4.)); WRITE(TEXT(.5.)); WRITE(TEXT(.6.)); WRITE(TEXT(.7.)); WRITE(TEXT(.8.)); WRITE(TEXT(.9.)); WRIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); TE(TEXT(.10.)); IF LIMIT < 20 THEN START:= 11 ELSE BEGIN WRITE(TEXT(.11.)); WRITE(TEXT(.12.)); WRITE(TEXT(.13.)); WRITE(TEXT(.14.)); WRITE(TEXT(.15.)); WRITE(TEXT(.16.)); WRITE(TEXT(.17.)); WRITE(TEXT(.18.)); WRITE(TEXT(.19.)); WRITE(TEXT(.20.)); IF LIMIT < 30 THEN START:= 21 ELSE BEGIN WRITE(TEXT(.21.)); WRITE(TEXT(.22.)); WRITE(TEXT(.23.)); WRITE(TEXT(.24.)); WRITE(TEXT(.25.)); WRITE(TEXT(.26.)); WRITE(TEXT(.27.)); WRITE(TEX PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PT(.28.)); WRITE(TEXT(.29.)); WRITE(TEXT(.30.)); IF LIMIT < 40 THEN START:= 31 ELSE BEGIN WRITE(TEXT(.31.)); WRITE(TEXT(.32.)); WRITE(TEXT(.33.)); WRITE(TEXT(.34.)); WRITE(TEXT(.35.)); WRITE(TEXT(.36.)); WRITE(TEXT(.37.)); WRITE(TEXT(.38.)); WRITE(TEXT(.39.)); WRITE(TEXT(.40.)); START:= 41; END; END; END; END; END; PROCEDURE WRITECARD; VAR I: INTEGER; BEGIN ELIMINATEBLANKS; IF LIMIT > 1 THEN WITH CUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEARD DO BEGIN WRITE(FIRST); FOR I:= START TO LIMIT DO WRITE(TEXT(.I.)); WRITE(NL); END ELSE IF FIRST = ' ' THEN WRITE(NL) ELSE IF FIRST = '#' THEN BEGIN WRITE(EM); EOF:= TRUE END ELSE BEGIN WRITE(FIRST); WRITE(NL) END; END; BEGIN IF TASK = INPUTTASK THEN BEGIN INITIALIZE; REPEAT READLINE(CARD); WRITECARD; UNTIL EOF; TERMINATE; END; END. Q; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "########################### # CARDS(VAR OK: BOOLEAN) # ###########################" "INSERT PREFIX HE     !#%' "$&13579;=?)+-/2468:<>(*,.0NPRTV@BDFHJLACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvs   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M RE" TYPE TWICE10 = ARRAY (.1..2, 1..10.) OF CHAR; TWICE20 = ARRAY (.1..2, 1..20.) OF CHAR; TWICE40 = ARRAY (.1..2, 1..40.) OF CHAR; SEQ80 = ARRAY (.1..80.) OF CHAR; SEQ52 = ARRAY (.1..52.) OF CHAR; IMAGE = RECORD TEXT: SEQ80; TAIL: SEQ52 END; VAR CARD: IMAGE; FIRST: CHAR; LIMIT: 1..80; EOF: BOOLEAN; PROCEDURE INITIALIZE; BEGIN IDENTIFY('CARDS: (:10:)'); EOF:= FALSE; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; END; PROCEDURE ELIMINATE10(VAR TEXT:     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnprtvxz|~ikmoqsuwy{} "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@B  j" ( " >" "     X& " `(   $ >B|6(p*4d@X" L( X0 " " >"   P0>   L" X" B `#################### # CONSOLE MANUAL # #################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES AN ASCII FILE TO OR FROM THE CONSOLE. THE LAST LINE OF AN INPUT FILE MUST CONSIST OF THE CHARACTER # FOLLOWED BY A NL CHARACTER. IT IS CONVERTED INTO THE EM CHARACTER. AN OUTPUT FILE MUST BE TERMINATED BY AN EM CHARACTER. CALL: CAN ONLY BE USED TO PRODUCE INPUT/OUTPUT FOR OTHER PROGRAMS.  ERROR TRANSMISSION ERROR DURING CARD INPUT. THE ERRONEOUS CARD IS SKIPPED AND THE INPUT CONTINUES.      +-/1357!#%'),.0246 "$&(*GIKMO9;=?ACEHJLN8:<>@BDFcegQSUWY[]_adfPRTVXZ\^`bikmoqsuwy{}hjlnprtvxz|~ "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@BDF     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnprtvxz|~ikmoqsuwy{} "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@BDFIKMOQSUWA(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, B( " >" "   X" "" ph"Hp  n( n"p  n( X nF* nR*p  n( n*p  n( n "p  n( n^*pSCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDI  n( n"jp,v ^p 06 |:  * ^ Z $ 0z*d  * ^ 8v $ 0"DX"& "2" XUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); "> ( *"2 0 " ^* " 0 " ^ 2&  $*X"$   (  " B" B|TRY AGAIN COPY(SO PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PURCE, DESTINATION: IDENTIFIER) CREATE REPLACE ASCII FILE COPY: DESTINATION FILE LOST SOURCE FILE UNKNOWN SOURCE KIND MUST BE ASCII OR SEQCODE DESTINATION FILE PROTECTED NEXT COPY: 0 " ^ 2&  $*X"$   (  " B" B|TRY AGAIN COPY(SOUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSE     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnprtvxz|~ikmoqsuwy{} "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@BDFIKMOQSUWACEGdfQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################# # CONSOLE(VAR OK: BOOLEAN) # #############################" "INSERT P################# # COPY MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES AN ASCII FILE FROM AN INPUT SOURCE TO AN OUTPUT DESTINATION. CALL: COPY(SOURCE, DESTINATION: IDENTIFIER) THE SOURCE CAN EITHER BE AN ASCII DISK FILE OR A SEQUENTIAL PROGRAM THAT INPUTS AN ASCII FILE. THE DESTINATION CAN BE AN ASCII DISK FILE, A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE, OR A NON-EXISTING FILE. IN THE FIRST CASE, THE EXISTING DISK FILE (WHICH MUST BE UNPROTECTED) IS REPLACEDREFIX HERE" PROCEDURE INITIALIZE; BEGIN IDENTIFY('CONSOLE: (:10:)'); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; END; PROCEDURE DISPLAYFILE; VAR C: CHAR; BEGIN READ(C); WHILE C <> EM DO BEGIN DISPLAY(C); READ(C) END; END; PROCEDURE ACCEPTFILE; VAR PRED, C: CHAR; BEGIN ACCEPT(C); WHILE C <> '#' DO BEGIN REPEAT WRITE(C); PRED:= C; ACCEPT(C); UNTIL PRED = NL; END; WRITE(EM); END; BEGIN INITIALIZE; IF TASK = OUTPUTTASK THEN DISPLAYFILE ELSE BY A NEW ONE OF THE SAME NAME. IN THE LAST CASE, A NEW FILE IS CREATED AND STORED ON DISK. IN BOTH CASES, THE RESULTING DISK FILE WILL BE AN UNPROTECTED ASCII FILE. ERROR MESSAGES: DESTINATION FILE LOST THE FILE PROGRAM CALLED BY COPY FAILED TO CREATE OR REPLACE THE DESTINATION FILE DUE TO A RUN-TIME ERROR. THE DESTINATION CAN BE AN ASCII DISK FILE, A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE, OR A NON-EXISTING FILE. IN THE FIRST CASE, THE EXISTING DISK FILE (WHICH MUST BE UNPROTECTED) IS REPLACEDIF TASK = INPUTTASK THEN ACCEPTFILE; END.       ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnprtvxz|~ikmoqsuwy{} "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@BDFIKMOQSUWACEGdfhjlRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER);  &!#%' "$)+-/13579;=?*,.02468:<>(FHJLNPRTV@BDACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J  " \(  " "" 4"d\nTLD<( H""(  BL>" ^" "   BP> *"f B " "   * V v'$(/$&  " `"  ""$  """"""& Z0 Ђ Z X Ў   (  "   (  "   (  "   (  X"& XF (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTӂ Z R ӎ "" "  "&  "  " XF Ђ Z  Ў  """  *$  " :"  "  "0 (  "" >"   P0>   L" X "(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; \"  >" ` "4 ""7 "$ : XC  >"$ A X V-   X >"$ I 2V( >" 1 "&R"" `" 1$ "" ] z @ ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "#################################################### # COPY(VAR OK: BOOLEAN; SOURCE, DEST: IDENTIFIER) #" c V  " j " " p  "x    x p&  t? h" L `" '& @ :, l"" `X   ^2l l  P>HP" l^ ####################################################" "INSERT PREFIX HERE" VAR SOURCE, DEST: ARGTYPE; OK: BOOLEAN; WHERE: (NOWHERE, ONDISK, ELSEWHERE); LENGTH: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT(' COPY(SOURCE,l l>P" l "  *  "*l"" `<l l   P>HP"" `X   ^2l l  P>HP" l^l l>P" l "  *  ,6   *  "$"5:\ DESTINATION: IDENTIFIER) (:10:)'); OK:= FALSE; END; END; PROCEDURE SAVEFILE; VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF WHERE = NOWHERE THEN ID:= 'CREATE ' ELSE ID:= 'REPLACE '; END; WITH LIST(.3.) DO BEGIN TAG:= IDTYPE; ID:= DEST.ID END; WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; WITH LIST(.5.) DO BEGIN TAG:= ,:N69:@@:2J::$T;:^:h':r1:|:::<:+:*:::|:n:`=:R>:D:6 :(:: :&(:0)::,:D-:N:X:b6:l :v::r7:dIDTYPE; ID:= 'ASCII ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('COPY:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('DESTINATION FILE LOST(:10:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN(:10:)') ELSEXL@4(       *4>HRt\hf\pPzD& R r r>"A r t9Vt t>"t0" v9Vv v>"dv0" x9Vx x>"8x0" z9Vz z>" CASE ATTR.KIND OF SCRATCH, CONCODE: ERROR('SOURCE KIND MUST BE ASCII OR SEQCODE (:10:)'); ASCII, SEQCODE: END; END; DEST:= PARAM(.3.); WITH DEST DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN WHERE:= NOWHERE ELSE IF ATTR.KIND = SEQCODE THEN WHERE:= ELSEWHERE ELSE IF ATTR.PROTECTED THEN ERROR('DESTINATION FILE PROTECTED (:10:)') ELSE WHERE:= ONDISK; END; END; PROCEDURE INITIO; VAR ARG: ARGTYT: INTEGER); VAR HEAD, TAIL, LENGTH: INTEGER; FUNCTION ENTRY ARRIVAL: INTEGER; BEGIN ARRIVAL:= TAIL; TAIL:= TAIL MOD LIMIT + 1; LENGTH:= LENGTH + 1; END; FUNCTION ENTRY DEPARTURE: INTEGER; BEGIN DEPARTURE:= HEAD; HEAD:= HEAD MOD LIMIT + 1; LENGTH:= LENGTH - 1; END; FUNCTION ENTRY EMPTY: BOOLEAN; BEGIN EMPTY:= (LENGTH = 0) END; FUNCTION ENTRY FULL: BOOLEAN; BEGIN FULL:= (LENGTH = LIMIT) END; BEGIN HEAD:= 1; TAIL:= 1; LENGTH:= 0 END; "############# # RESOURCE # #############" CONST PROPE; BEGIN WRITEARG(INP, SOURCE); IF WHERE = ELSEWHERE THEN WRITEARG(OUT, DEST) ELSE BEGIN WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'NEXT ' END; WRITEARG(OUT, ARG); END; END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; BEGIN READARG(INP, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF WHERE <> ELSEWHERE THEN BEGIN READARG(OUT, ARG); LENGTH:= ARG.INT END; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF (WHERE <> ELSEWHERE) & OK THEN SAVEFILE; END; PROCEDURE COPYT SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDEXT; VAR BLOCK: PAGE; EOF: BOOLEAN; BEGIN REPEAT READPAGE(BLOCK, EOF); WRITEPAGE(BLOCK, EOF); UNTIL EOF; END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('COPY:(:10:)'); OK:= (TASK = JOBTASK); CHECKARG; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN INITIALIZE; IF OK THEN BEGIN INITIO; COPYTEXT; CHECKIO; END; TERMINATE; END.      ')+-/1357!#%(*,.0246 "$&CEGIKMO9;=?ADFHJLN8:<>@B_acegQSUWY[]`bdfPRTVXZ\^{}ikmoqsuwy|~hjlnprtvxz "$&!#%',.02468:<>(*-/13579;=?)+HJLNPRTV@BDFIKMOQSUWACEGdfhjlnXZ\^`begikmoY[]_acprRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC         $`X     +-/!#%'),.IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN (:10:)(:0:)') ELSE CASE ATTR.KIND OF SCRATCH, CONCODE: ERROR('SOURCE KIND MUST BE ASCII OR SEQCODE(:10:)(:0:)'); ASCII, SEQCODE: END; END; DEST:= PARAM(.3.); WITH DEST DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('DESTINATION FILE UNKNOWN(:10:)(:0:)') ELSE IF ATTR.KIND <> SEQCODE THEN ERRORMOVE(1) LIST(FILES, ALL, TAPE) MOVE(1) COPY(TAPE, PRINTER) MOVE(183) COPY(TAPE, PRINTER) MOVE(1)  255 PAGES TOTAPETEXT ASCII UNPROTECTED 4 PAGES WRITE SEQCODE PROTECTED 2 PAGES WRITEMAN ASCII PROTECTED 1 PAGES WRITETEXT ASCII PROTECTED 9 PAGES XMAC ASCII UNPROTECTED 1 PAGES 125 ENTRIES 3391 PAGES  3 PAGES TAPEMAN ASCII PROTECTED 2 PAGES TAPETEXT ASCII PROTECTED , STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); ('DESTINATION KIND MUST BE SEQCODE(:10:)(:0:)'); END; OBJECT:= PARAM(.4.); WITH OBJECT DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN WHERE:= NOWHERE ELSE IF ATTR.PROTECTED THEN ERROR('OBJECT FILE PROTECTED (:10:)(:0:)') ELSE WHERE:= ONDISK; END; END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; C: CHAR; BEGIN "COMPLETE SOURCE TEXT INPUT/OUTPUT:" REPEAT READ(C) UNTIL C = EM; WRITE(EM); READARG(INP, ARG); IF NOT ARG.BOOL THEN O PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTK:= FALSE; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; END; PROCEDURE INITIALIZE; BEGIN WRITEARG(INP, SOURCE); WRITEARG(OUT, DEST); WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= NIL END; WITH LIST(.3.) DO BEGIN TAG:= INTTYPE; INT:= 0 END; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; PROCEDURE CALLPASS(ID: IDENTIFIER); VAR LINE: INTEGER; RESULT: PROGRESULT; BEGIN LIST((F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;.1.).BOOL:= FALSE; RUN(ID, LIST, LINE, RESULT); IF RESULT <> TERMINATED THEN BEGIN REPORT:= OUTP; WRITERESULT(ID, LINE, RESULT); END ELSE BEGIN OK:= LIST(.1.).BOOL; CODELENGTH:= LIST(.3.).INT; IF NOT OK THEN ERROR('COMPILATION ERRORS(:10:)(:0:)'); END; END; BEGIN CHECKARG; IF OK THEN BEGIN OPENFILE(1, 'TEMP1 '); OPENFILE(2, 'TEMP2 '); IF OK THEN BEGIN INITIALIZE; CALLPASS('CPASS1 '); IF OK THEN CALLPASS('CPASS2 ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################################### # CPASCAL(VAR OK: BOOLEAN; SOURCE, DEST, '); IF OK THEN CALLPASS('CPASS3 '); IF OK THEN CALLPASS('CPASS4 '); IF OK THEN CALLPASS('CPASS5 '); IF OK THEN CALLPASS('CPASS6 '); IF OK THEN OPENFILE(2, 'NEXT '); IF OK THEN CALLPASS('CPASS7 '); CHECKIO; IF OK & (CODELENGTH > 0) THEN SAVEFILE; TERMINATE; END; CLOSE(1); CLOSE(2); END; END.  OBJECT: IDENTIFIER) # ###############################################################" "INSERT PREFIX HERE" "THE PARAMETERS OF THE COMPILER PASSES HAVE THE FOLLOWING MEANING: LIST(.1.) : BOOLEAN (COMPILATION OK) LIST(.2.) : POINTER (HEAP POINTER) LIST(.3.) : INTEGER (CODE LENGTH) " VAR OK: BOOLEAN; SOURCE, DEST, OBJECT: ARGTYPE; CODELENGTH: INTEGER; WHERE: (NOWHERE, ONDISK); REPORT: (MAIN, OUTP); LIST: ARGLIST; PROCEDURE INITWRITE; BEGIN IDENTIFY('PASCAL:(:10:)'); REPORT:=         $`X     +-/!#%'),.MAIN; END; PROCEDURE WRITECHAR(C: CHAR); BEGIN IF REPORT = MAIN THEN DISPLAY(C) ELSE WRITE(C); END; PROCEDURE WRITETEXT(TEXT: LINE); CONST NUL = '(:0:)'; VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> NUL DO BEGIN WRITECHAR(C); I:= I + 1; C:= TEXT(.I.); END; END; PROCEDURE WRITEINT(INT, LENGTH: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(7%)+-/135 "$'%*,.02468:<>(+-/13579;=?)FHJLNPRTV@BDACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO LENGTH - DIGIT - 1 DO WRITECHAR(' '); IF INT < 0 THEN WRITECHAR('-') ELSE WRITECHAR(' '); FOR I:= DIGIT DOWNTO 1 DO WRITECHAR(NUMBER(.I.)); END; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; C: CHAR; BEGIN FOR I:= 1 TO IDLENGTH DO BEGIN C:= ID(.I.); IF C <> ' ' THEN WRITECHAR(C); END; END; PROCEDURE CONVRESULT(RESULT: PROGRESULT; VAR ID: IDENTIFIER); BEGIN CASE RESULT OF TERMINA5X5 n0& * " `(  "1r"$ 7  "r"p"n"l"j"& ? jZ< l Z L ln   (  r"   (  "   (  l"& L nXRTED: ID:= 'TERMINATED '; OVERFLOW: ID:= 'OVERFLOW '; POINTERERROR: ID:= 'POINTERERROR'; RANGEERROR: ID:= 'RANGEERROR '; VARIANTERROR: ID:= 'VARIANTERROR'; HEAPLIMIT: ID:= 'HEAPLIMIT '; STACKLIMIT: ID:= 'STACKLIMIT '; CODELIMIT: ID:= 'CODELIMIT '; TIMELIMIT: ID:= 'TIMELIMIT '; CALLERROR: ID:= 'CALLERROR ' END; END; PROCEDURE WRITERESULT (ID: IDENTIFIER; LINE: INTEGER; RESULT: PROGRESULT); VAR ARG: IDENTIFIER; BEGIN WRITE p Z \$ prp p"n"n n" r n"& Zj j"n j " jXR l Z $ ln l l"j"0 i  "" >"   P0>   L" X " \(  >" ` CHAR(NL); WRITEID(ID); WRITETEXT(': LINE (:0:)'); WRITEINT(LINE, 4); WRITECHAR(' '); CONVRESULT(RESULT, ARG); WRITEID(ARG); WRITECHAR(NL); OK:= (RESULT = TERMINATED); END; PROCEDURE ERROR(TEXT: LINE); BEGIN INITWRITE; WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN (:10:)(:0:)'); WRITETEXT (' CPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) (:10:)(:0:)'); OK:= FALSE; END; END; PROCEDURE OPENFILE(F: FILE; ID: I#'!$+-/!$4  -JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUW   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w DENTIFIER); VAR FOUND: BOOLEAN; BEGIN OPEN(F, ID, FOUND); IF NOT FOUND THEN ERROR('TEMPORARY FILE MISSING(:10:)(:0:)'); END; PROCEDURE SAVEFILE; VAR LENGTH, LINE: INTEGER; RESULT: PROGRESULT; BEGIN LENGTH:= (CODELENGTH + 511) DIV 512; WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF WHERE = NOWHERE THEN ID:= 'CREATE ' ELSE ID:= 'REPLACE '; END; WITH LIST(.3.) DO BEGIN TAG:= IDTYPE; ID:= OBJECT.ID E .MCALL .READW,.WRITW FUNCTION .READ ; ; R1 IS CHANNEL ; R2 IS BUFFER ; R3 IS BYTE COUNT ; R4 IS BLOCK NUMBER ; LET R3 := R3 R.SHIFT 1 .READW #AREA,R1,R2,R3,R4 IF RESULT IS CS RETURN #-1 END LET R3 := R3 L.SHIFT 1 ;MULT BY 2 RETURN R3 FUNCTION .WRITE LET R3 := R3 R.SHIFT 1 .WRITW #AREA,R1,R2,R3,R4 IF RESULT IS CS RETURN #-1 END LET R3 := R3 L.SHIFT 1 RETURN R3 AREA: .BLKW 10 .END ND; WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; WITH LIST(.5.) DO BEGIN TAG:= IDTYPE; ID:= 'CONCODE ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('PASCAL:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('OBJECT FILE LOST(:10:)(:0:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN OK:= (TASK = JOBTASK); SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> H"&(*,.0246;=?ACEGIKMO9<>@BDFHJLN8:WY[]_acegQSUXZ\^`bdfK M O 9 ; = I f P R T V X Z \ ^ ` b d g Q S U W Y [ ] _ a c e j l n h k m z | ~ n p r t v x       %'!#'$+-/!$4  -JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUW   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w y { "AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 2: SYNTAX ANALYSIS OCTOBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPT.TITLE RK05 BOOTSTRAP FOR CONCURRENT PASCAL SYSTEM .SBTTL INTRODUCTION ; ; ; THIS PROGRAM IS DESIGNED TO RESIDE ON BLOCK 0 OF AN RK05 PACK ; CONTAINING A SOLO SYSTEM. THE PROGRAM IS INITIATED BY THE ; STANDARD HARDWARE LOAD SEQUENCE, AND MOVES A PART OF ITSELF TO ; 156000 (8). THIS SECTION THEN READS IN THE KERNEL PORTION OF ; THE SOLO SYSTEM, WHICH WILL READ IN THE SOLO SYSTEM ITSELF. ; ; ; DEFINITIONS: ; RKCS = 177404 ;RK-11 CONTROL/STATUS REGISTER RKWC = 177406 ;RK-11 WORD COUNT (2'S COMPLEMENT) RK EXPECT THIS BR 10$ ;SKIP TRAP VECTORS TRAP4,0 ;TRAP TO 4 TRAP10,0 ;TRAP TO 10 10$: MOV #$LOC,SP ;SET SO TRAP TO 4/10 IS OK ;(WILL NOT CAUSE DOUBLE BUS ERROR) MOV SP,R0 ;R0 -> AREA FOR CODE MOV #20$,R1 ;R1 -> CODE 15$: MOV (R1)+,(R0)+ ;MOVE A WORD OF CODE CMP @R1,#-1 ;DONE? BNE 15$ ;NO, MOVE MORE CODE JMP @#$LOC ;DONE, START RELOCATED PORTION .PAGE .SBTTL RELOCATED CODE ; ; ; THE FOLLOWING CODE IS MOVED AND THEREFORE MUST BE POSITION- ; INDEPENDENT!!!! ; 20$: MOV @#RKDA, " `  " < 4 ,  X P H(    L (    $ \ T$  ""   "&,4h  "  "  " " "  "  "  "& ,4h  ION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTBA = 177410 ;RK-11 BUS ADDRESS REGISTER RKDA = 177412 ;RK-11 DISK ADDRESS REGISTER ; RKRD = 5 ;READ COMMAND (RKCS) ; ; ; TPS = 177564 ;TERMINAL PRINTER STATUS TPB = 177566 ;TERMINAL PRINTER BUFFER ; ; ; $LOC = 156000 ;HIGH MEMORY ADDRESS ; ; UNITNO = 40 ;PLACE TO PUT BOOTED UNIT ; ; .ASECT ;ABSOLUTE SECTION . = 0 ;START AT ABSOLUTE 0 .PAGE .SBTTL NON-RELOCATABLE CODE ; ; ; THE FOLLOWING CODE IS USED TO MOVE THE RELOCATABLE CODE TO A HIGH ; MEMORY ADDRESS. ; START: NOP ;SOME BOOT ROMSTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTE"  "  " "  "& ,4h  "  "  "  " " "&,4h  "  "  "  "  "  "F  T" r"8".:"":"0""GER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=0; BEGIN1=1; IF1=2; CASE1=3; WHILE1=4; REPEAT1=5; FOR1=6; CYCLE1=7; WITH1=8; INIT1=9; ID1=10; REAL1=11; STRING1=12; INTEGER1=13"4"RRRRRRRR R&RRRRR&vRRRRR R&6",T  " " " "  "RRRR&RR&RRR R&R&"R&R&R&; CHAR1=14; OPEN1=15; NOT1=16; SUB1=17; SET1=18; ARRAY1=19; RECORD1=20; CLASS1=21; MONITOR1=22; PROCESS1=23; PERIOD1=24; STAR1=25; SLASH1=26; DIV1=27; MOD1=28; AND1=29; PLUS1=30; MINUS1=31; OR1=32; EQ1=33; NE1=34; LE1=35; GE1=36; LT1=37; GT1=38; IN1=39; CONST1=40; TYPE1=41; VAR1=42; RRRRRR R& R RR&RRRRR&RRRRR&,T "h ":  hB  PROCEDURE1=43; FUNCTION1=44; PROGRAM1=45; SEMICOLON1=46; CLOSE1=47; UP_TO1=48; OF1=49; COMMA1=50; BUS1=51; COLON1=52; END1=53; ENTRY1=54; UNIV1=55; BECOMES1=56; THEN1=57; ELSE1=58; DO1=59; UNTIL1=60; TO1=61; DOWNTO1=62; LCONST1=63; MESSAGE1=64; NEW_LINE1=65; "OUTPUT OPERATORS" EOM2=1; CONST_ID2=2; CONST_DEF2=3; TYPE_ID2=4; TYPE_DEF2=5; VAR_ID2=  t  vdR  @ .  & X5 $]    6" 4r"&6; VAR_LIST2=7; VARE_LIST2=8; INITS_DEF2=9; INITS_END2=10; PROC_ID2=11; PROC_DEF2=12; PROCE_DEF2=13; PROC_END2=14; PROCE_END2=15; FUNC_ID2=16; FUNC_DEF2=17; FUNCE_DEF2=18; FUNC_END2=19; FUNCE_END2=20; PROG_ID2=21; PROG_DEF2=22; INTF_ID2=23; TYPE2=24; ENUM2=25; ENUM_ID2=26; ENUM_DEF2=27; SUBR_DEF2=28; SET_DEF2=29; ARRAY_DEF2=30; REC2=31; FIELD_ID2=32; FIELDLIST2=33; REC_DEF2=34; g50r  " > `p *|F4 " L ` 6&  P*  X$  ,2 ^h  " .d\ j. .>" .d "$  h " .d\  CLASS2=35; MONITOR2=36; PROCESS2=37; STACK2=38; PSTART2=39; PARM_ID2=40; PARM_TYPE2=41; UNIV_TYPE2=42; CPARMLIST2=43; VPARMLIST2=44; BODY2=45; BODY_END2=46; ANAME2=47; STORE2=48; CALL_NAME2=49; CALL2=50; ARG_LIST2=51; ARG2=52; FALSEJUMP2=53; DEF_LABEL2=54; JUMP_DEF2=55; INTF2=56; DEF_CASE2=57; CASE2=58; JUMP2=59; END_CASE2=60; ADDRESS2=61; FOR_STORE2=62; FOR_LIM. .>" .d "4  \  >"<  0" D  8"8" 0vT"  ^0" 0"0"0"0" 0,0"*0"0"B0"4&0 "Xdp|x&< 0 "  8 " B"$ 2=63; FOR_UP2=64; FOR_DOWN2=65; WITH_VAR2=66; WITH_TEMP2=67; WITH2=68; INIT_NAME2=69; INIT2=70; VALUE2=71; LT2=72; EQ2=73; GT2=74; LE2=75; NE2=76; GE2=77; IN2=78; UPLUS2=79; UMINUS2=80; PLUS2=81; MINUS2=82; OR2=83; STAR2=84; SLASH2=85; DIV2=86; MOD2=87; AND2=88; FNAME2=89; NOT2=90; EMPTY_SET2=91; INCLUDE2=92; FUNC B \ >"l "$   L` H" "(  \ \2 B"H V V2 B" :"$ X .d "&  "  " " " "  "    ZTION2=93; CALL_FUNC2=94; NAME2=95; COMP2=96; SUB2=97; ARROW2=98; CONSTANT2=99; REAL2=100; FREAL2=101; INTEGER2=102; FINTEGER2=103; CHAR2=104; FCHAR2=105; STRING2=106; FSTRING2=107; NEW_LINE2=108; LCONST2=109; MESSAGE2=110; PROCE_ID2=111; FUNCE_ID2=112; PEND2=113; CASE_JUMP2=114; "OTHER CONSTANTS" TEXT_LENGTH = 18; INFILE = 2; OUTFILE = 1; THIS_PASS = 2; SPELLING_MAX = 700; COMP_BLOCK=TRUE"u t"&y" `4$ ~ tXvC dt t>"$  tX2 V-  t t>""  P |"  , "    $"    "   xR OR QSEXPR_OP; QFACTOR_LIST:=QFACTOR OR QTERM_OP; QSET_EXPR:=QARGUMENT OR (.BUS1.); QSELECT:=(.PERIOD1,SUB1.); QSUB_END:=QARGUMENT OR (.BUS1.); QWITH_LIST:=QDO_TAIL OR QCOMMA; QTO_TAIL:=QDO_TAIL OR QEXPR; GET END; PROCEDURE ERROR(NUMBER:INTEGER; KEYS:SETS); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); WHILE NOT (SY IN KEYS) DO GET END; PROCEDURE CHECK(NUMBER:INTEGER; KEYS:SETS); BEGIN IF NOT (SY IN KEYS) THEN ERROR(NUMBER,KEYS) END; PROCEDURE NEW_LABEL(V; PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; "#############" "PASS ROUTINES" "#############" "PARSING ROUTINES" PROCEDURE PROGRAM_; FORWARD; PROCEDURE BLOCK(KEYS:SETS; IN_COMPONENT:BOOLEAN); FORWARD; PROCEDURE DECLARAR L:LABEL); BEGIN CURRENT_LABEL:=CURRENT_LABEL+1; L:=CURRENT_LABEL END; "#######" "PROGRAM" "#######" PROCEDURE PROGRAM_; BEGIN PUT1(PSTART2,PROCESS_MODE); PUT0(PROCESS2); BLOCK(QEOM, COMP_BLOCK); IF SY=PERIOD1 THEN GET ELSE ERROR(MPROG_ERROR,QEOM); IF SY<>EOM1 THEN ERROR(MPROG_ERROR,QEOM); PUT0(EOM2) END; "#####" "BLOCK" "#####" PROCEDURE BLOCK; BEGIN DECLARATIONS(KEYS OR QBODY); IF IN_COMPONENT THEN PUT0(INITS_DEF2); BODY(KEYS); IF IN_COMPONE; ROUTINE_BLOCK=FALSE; "MODES" CLASS_MODE=1; MONITOR_MODE=2; PROCESS_MODE=3; PROC_MODE=4; PROCE_MODE=5; FUNC_MODE=6; FUNCE_MODE=7; PROGRAM_MODE=8; "ERRORS" PROG_ERROR=1; DEC_ERROR=2; CONSTDEF_ERROR=3; TYPEDEF_ERROR=4; TYPE_ERROR=5; ENUM_ERROR=6; SUBR_ERROR=7; SET_ERROR=8; ARRAY_ERROR=9; RECORD_ERROR=10; STACK_ERROR=11; VAR_ERROR=12; ROUTINE_ERROR=13; PROC_ERROR=14; FUNC_ERROR=15; WITH_ERROR=16; PARM_ERROR=17; BODY_ATIONS(KEYS:SETS); FORWARD; PROCEDURE CONST_DEC(KEYS:SETS); FORWARD; PROCEDURE TYPE_DEC(KEYS:SETS); FORWARD; PROCEDURE TYPE_(KEYS:SETS); FORWARD; PROCEDURE ENUM_TYPE(KEYS:SETS); FORWARD; PROCEDURE SUBR_TYPE(KEYS:SETS); FORWARD; PROCEDURE SET_TYPE(KEYS:SETS); FORWARD; PROCEDURE ARRAY_TYPE(KEYS:SETS); FORWARD; PROCEDURE RECORD_TYPE(KEYS:SETS); FORWARD; PROCEDURE COMP_TYPE(KEYS:SETS); FORWARD; PROCEDURE VAR_DEC(KEYS:SETS); FORWARD; PROCEDURE ID_LIST(KEYS:SETS; OP,ERROR_NUM:INTEGER; VAERROR=18; STATS_ERROR=19; STAT_ERROR=20; IDSTAT_ERROR=21; ARG_ERROR=22; COMP_ERROR=23; IF_ERROR=24; CASE_ERROR=25; LABEL_ERROR=26; WHILE_ERROR=27; REPEAT_ERROR=28; FOR_ERROR=29; CYCLE_ERROR=30; EXPR_ERROR=31; VARIABLE_ERROR=32; CONSTANT_ERROR=33; INIT_ERROR=34; MPROG_ERROR=35; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUR ID_COUNT:INTEGER); FORWARD; PROCEDURE IDENTIFIER(KEYS:SETS; OP,ERROR_NUM:INTEGER); FORWARD; PROCEDURE ROUTINE_DEC(KEYS:SETS); FORWARD; PROCEDURE PROC_DEC(KEYS:SETS); FORWARD; PROCEDURE FUNC_DEC(KEYS:SETS); FORWARD; PROCEDURE PROG_DEC(KEYS:SETS); FORWARD; PROCEDURE PARM_LIST(KEYS:SETS; MODE:INTEGER); FORWARD; PROCEDURE BODY(KEYS:SETS); FORWARD; PROCEDURE STAT_LIST (KEYS:SETS); FORWARD; PROCEDURE STAT(KEYS:SETS); FORWARD; PROCEDURE ID_STAT(KEYS:SETS); FORWARD; PROCETE=8; XCHR=9; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=16; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; XWAIT=23; XREAL=24; TYPE SPELLING_INDEX=0..SPELLING_MAX; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; LABEL=INTEGER; SYMBOL=EOM1..NEW_LINE1; SETS=SET OF SYMBOL; VAR INTER_PASS_PTR:PASSPTR; SY:SYMBOL; ARG:INTEGER; CURRENT_LDURE ARG_LIST(KEYS:SETS); FORWARD; PROCEDURE COMPOUND_STAT(KEYS:SETS); FORWARD; PROCEDURE IF_STAT(KEYS:SETS); FORWARD; PROCEDURE CASE_STAT(KEYS:SETS); FORWARD; PROCEDURE LABEL_LIST(KEYS:SETS); FORWARD; PROCEDURE WHILE_STAT(KEYS:SETS); FORWARD; PROCEDURE REPEAT_STAT(KEYS:SETS); FORWARD; PROCEDURE FOR_STAT(KEYS:SETS); FORWARD; PROCEDURE CYCLE_STAT(KEYS:SETS); FORWARD; PROCEDURE WITH_STAT(KEYS:SETS); FORWARD; PROCEDURE INIT_STAT(KEYS:SETS); FORWARD; PROCEDURE EXPR(KEYS:SETS); FABEL:LABEL; TEST:BOOLEAN; "KEY SETS" QIGNORE, QOPEN, QCLOSE, QEOM, QEND, QSEMICOLON, QBODY, QID, QDEFINITIONS, QROUTINES, QDECLARATIONS, QDEF, QDEC, QCONSTANT, QCONST_DEF, QTYPE, QTYPE_DEF, QSUBR_LIMIT, QDIMENSION, QOF_TYPE, QVAR_DEF, QBLOCK, QPARM_END, QID_LIST, QPROC_END, QPROC_PARMS, QFUNC_END, QFUNC_TYPE, QORWARD; PROCEDURE SEXPR(KEYS:SETS); FORWARD; PROCEDURE TERM(KEYS:SETS); FORWARD; PROCEDURE FACTOR(KEYS:SETS); FORWARD; PROCEDURE FACTOR_ID(KEYS:SETS); FORWARD; PROCEDURE VARIABLE(KEYS:SETS); FORWARD; PROCEDURE CONSTANT(KEYS:SETS); FORWARD; "##########" "INITIALIZE" "##########" PROCEDURE GET; VAR LENGTH,I,VAL,PASS_NO,MESSAGE_NO,LINE_NO:INTEGER; DONE:BOOLEAN; BEGIN DONE:=FALSE; REPEAT READ_IFL(SY); IF SY IN QIGNORE THEN CASE SY OF LCONST1: BEGPROG_END, QINTERFACE, QPARM_LIST, QSTAT, QBODY_END, QENTRY, QSTAT_LIST, QID_END, QARGUMENT, QARG_END, QIF_END, QTHEN_END, QCASES, QCASE_END, QLABEL_LIST, QDO_TAIL, QUNARY, QFACTOR, QEXPR, QUNTIL_TAIL, QFOR_END, QFORB_END, QEXPR_OP, QSEXPR_OP, QTERM_OP, QTERM_LIST, QFACTOR_LIST, QSET_EXPR, QSELECT, QSUB_END,IN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); FOR I:=1 TO LENGTH DIV 2 DO BEGIN READ_IFL(VAL); PUT_ARG(VAL) END END; MESSAGE1: BEGIN READ_IFL(PASS_NO); READ_IFL(MESSAGE_NO); PUT2(MESSAGE2,PASS_NO,MESSAGE_NO) END; NEW_LINE1: BEGIN READ_IFL(LINE_NO); PUT1(NEW_LINE2,LINE_NO) END END ELSE DONE:=TRUE UNTIL DONE; IF SY IN QARG THEN READ_IFL(ARG) END; PROCEDU QARG, QCOMMA, QVARE_DEF, QTYPE_LIST, QWITH_LIST, QINIT_LIST, QTO_TAIL, QSTACK: SETS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE)RE INITIALIZE; BEGIN INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN TEST:=TESTOPTION IN OPTIONS END; IF TEST THEN PRINTFF; CURRENT_LABEL:=1; "LABEL 1 DENOTES THE BLOCK OF THE INITIAL PROCESS; IT IS ONLY REFERENCED BY THE FIRST JUMP INSTRUCTION IN THE PROGRAM" QIGNORE:=(.LCONST1,MESSAGE1,NEW_LINE1.); QCOMMA:=(.COMMA1.); QOPEN:=(.OPEN1.); QCLOSE:=(.CLOSE1.); QEOM:=(.EOM1.); QEND:=(.END1.); QSEMICOLON:=(.SEMICOLON1.); QBODY:=(.BEGIN1.); QID:=(; VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 2: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_.ID1.); QDEFINITIONS:=(.CONST1,TYPE1.); QROUTINES:=(.PROCEDURE1,FUNCTION1,PROGRAM1.); QSTACK:=(.PLUS1.); QENTRY:=(.ENTRY1.); QDECLARATIONS:=QDEFINITIONS OR (.VAR1.) OR QROUTINES; QDEF:=(.ID1,SEMICOLON1,EQ1.); QDEC:=(.ID1,SEMICOLON1,COLON1.); QCONSTANT:=(.ID1,INTEGER1,REAL1,CHAR1,STRING1.); QCONST_DEF:=QDEF OR QCONSTANT; QTYPE:=(.OPEN1,SET1,ARRAY1,RECORD1,CLASS1,MONITOR1,PROCESS1.) OR QCONSTANT; QTYPE_DEF:=QDEF OR QTYPE; QTYPE_LIST:=QTYPE OR QCOMMA; QOUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) SUBR_LIMIT:=(.UP_TO1.) OR QCONSTANT; QDIMENSION:=QTYPE OR (.COMMA1,BUS1,OF1.); QOF_TYPE:=QTYPE OR (.OF1.); QVAR_DEF:=QDEC OR QTYPE; QVARE_DEF:=QVAR_DEF OR (.ENTRY1.); QBLOCK:=QDECLARATIONS OR QBODY; QPARM_END:=QSEMICOLON OR QBLOCK; QID_LIST:=(.ID1,COMMA1.); QPROC_END:=(.ENTRY1,ID1,OPEN1.) OR QPARM_END; QARG:=(.ID1,INTEGER1,CHAR1,STRING1.); QPROC_PARMS:=QPROC_END-QID; QFUNC_END:=QPROC_END OR (.COLON1.); QFUNC_TYPE:=QPARM_END OR QID; QPROG_END:=QPROC_END-QBLOCK;END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS( QINTERFACE:=(.ENTRY1,ID1,COMMA1,SEMICOLON1.); QPARM_LIST:=QDEC OR (.UNIV1,VAR1.); QSTAT:=(.ID1,BEGIN1,IF1,CASE1,WHILE1,REPEAT1,FOR1, CYCLE1,WITH1,INIT1.); QBODY_END:=QSTAT OR QEND; QSTAT_LIST :=QSTAT OR QSEMICOLON; QID_END:=(.BECOMES1,OPEN1.); QINIT_LIST:=(.ID1,OPEN1,COMMA1.); QIF_END:=(.THEN1,ELSE1.) OR QSTAT; QTHEN_END:=QIF_END-(.THEN1.); QCASES:=QCONSTANT OR QSTAT OR (.COLON1,COMMA1,SEMICOLON1.); QCASE_END:=QCASES OR (.OF1,END1.); QLABEL_LIST:=QCONSTREM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('2'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTANT OR QCOMMA; QDO_TAIL:=QSTAT OR (.DO1.); QUNARY:=(.PLUS1,MINUS1.); QFACTOR:=QCONSTANT OR (.OPEN1,NOT1,SUB1.); QEXPR:=QUNARY OR QFACTOR; QARGUMENT:=QEXPR OR QCOMMA; QARG_END:=QARGUMENT OR QCLOSE; QUNTIL_TAIL:=QEXPR OR (.UNTIL1.); QFOR_END:=QEXPR OR QSTAT OR (.BECOMES1,TO1,DOWNTO1,DO1.); QFORB_END:=QFOR_END-(.BECOMES1.); QEXPR_OP:=(.EQ1,NE1,LE1,GE1,LT1,GT1,IN1.); QSEXPR_OP:=(.PLUS1,MINUS1,OR1.); QTERM_OP:=(.STAR1,SLASH1,DIV1,MOD1,AND1.); QTERM_LIST:=QFACTOLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP)#RTVsuwy{}ikmoqtvxz|~hjlnp579;=?)+-/138:<>(*,JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 LKEYS1:=KEYS OR QVARE_DEF; GET; REPEAT CHECK(VAR_ERROR,LKEYS1); IF SY=ENTRY1 THEN BEGIN OP:=VARE_LIST2; GET END ELSE OP:=VAR_LIST2; ID_LIST(LKEYS1,VAR_ID2,VAR_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); "VAR"TYPE_(LKEYS1); PUT1(OP,NUMBER); IF SY=SEMICOLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); CHECK(VAR_ERROR,LKEYS1) UNTIL NOT(SY IN QVARE_DEF); END; PROCEDURE ID_LIST; VAR LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYSDC =& M " `(  "T"$ Z  """"""& b Z<  Z L    (  "   (  "   (  "& o XR1:=KEYS OR QID_LIST; ID_COUNT:=0; DONE:=FALSE; REPEAT IDENTIFIER(LKEYS1,OP,ERROR_NUM); ID_COUNT:=ID_COUNT+1; CHECK(ERROR_NUM,LKEYS1); IF SY IN QID_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE IDENTIFIER; BEGIN IF SY=ID1 THEN BEGIN PUT1(OP,ARG); GET END ELSE BEGIN ERROR(ERROR_NUM,KEYS); PUT1(OP,XUNDEF) END END; "########" "ROUTINES" "########" PROCEDURE ROUTINE_DE  Z \$  "" "  "& } "  " XR  Z $   ""0   "" >"   P0>   L" X " \(  >" ` C; VAR LKEYS1:SETS; SEMI_EXPECTED:BOOLEAN; BEGIN LKEYS1:=KEYS OR QROUTINES; REPEAT SEMI_EXPECTED:=TRUE; CASE SY OF PROCEDURE1: PROC_DEC(LKEYS1); FUNCTION1: FUNC_DEC(LKEYS1); PROGRAM1: BEGIN SEMI_EXPECTED:=FALSE; PROG_DEC(LKEYS1) END END; IF SEMI_EXPECTED THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(ROUTINE_ERROR,LKEYS1); CHECK(ROUTINE_ERROR,LKEYS1); UNTIL NOT(SY IN QROUTINES) END; PROCEDURE PROC_DEC; VAR MODE,ID_OP,DEF_OP,END" "&" `3$  XvC d >"$  X2 V-   >""  P |"  , "    $"    &   (NT THEN PUT0(INITS_END2) END; "############" "DECLARATIONS" "############" PROCEDURE DECLARATIONS; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QDECLARATIONS; LKEYS2:=KEYS OR QROUTINES; CHECK(DEC_ERROR,LKEYS1); WHILE SY IN QDEFINITIONS DO BEGIN IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1); CHECK(DEC_ERROR,LKEYS1) END; IF SY=VAR1 THEN VAR_DEC(LKEYS2); CHECK(DEC_ERROR,LKEYS2); IF SY IN QROUTINES THEN ROUTINE_DEC(KEYS) END; PROCEDURE CO_OP:INTEGER; BEGIN GET; CHECK(PROC_ERROR,KEYS OR QPROC_END); IF SY=ENTRY1 THEN BEGIN GET; MODE:=PROCE_MODE; ID_OP:=PROCE_ID2; DEF_OP:=PROCE_DEF2; END_OP:=PROCE_END2 END ELSE BEGIN MODE:=PROC_MODE; ID_OP:=PROC_ID2; DEF_OP:=PROC_DEF2; END_OP:=PROC_END2 END; IDENTIFIER(KEYS OR QPROC_PARMS,ID_OP,PROC_ERROR); PARM_LIST(KEYS OR QPARM_END,MODE); PUT0(DEF_OP); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROC_ERROR,KEYS OR QBLOCK); BLOCK(KENST_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QCONST_DEF; LKEYS2:=KEYS-QCONST_DEF; GET; REPEAT IDENTIFIER(LKEYS1,CONST_ID2,CONSTDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1); CONSTANT(LKEYS1); PUT0(CONST_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1); CHECK(CONSTDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; PROCEDURE TYPE_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QTYPE_DEF; LKEYYS,ROUTINE_BLOCK); PUT0(END_OP) END; PROCEDURE FUNC_DEC; VAR MODE,ID_OP,DEF_OP,END_OP:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QFUNC_END; GET; CHECK(FUNC_ERROR,LKEYS1); IF SY=ENTRY1 THEN BEGIN GET; MODE:=FUNCE_MODE; ID_OP:=FUNCE_ID2; DEF_OP:=FUNCE_DEF2; END_OP:=FUNCE_END2 END ELSE BEGIN MODE:=FUNC_MODE; ID_OP:=FUNC_ID2; DEF_OP:=FUNC_DEF2; END_OP:=FUNC_END2 END; IDENTIFIER(LKEYS1,ID_OP,FUNC_ERROR); PARM_LIST(LKEYS1-QOPEN,MODE); S2:=KEYS-QTYPE_DEF; GET; REPEAT IDENTIFIER(LKEYS1,TYPE_ID2,TYPEDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); TYPE_(LKEYS1); PUT0(TYPE_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); CHECK(TYPEDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; "####" "TYPE" "####" PROCEDURE TYPE_; BEGIN CHECK(TYPE_ERROR,KEYS OR QTYPE); IF SY IN QTYPE THEN CASE SY OF OPEN1: ENUM_TYPE(KEYS); ID1,INTEGER1,REAL1,CH IF SY=COLON1 THEN GET ELSE ERROR(FUNC_ERROR,KEYS OR QFUNC_TYPE); IDENTIFIER(KEYS OR QPARM_END,DEF_OP,FUNC_ERROR); IF SY=SEMICOLON1 THEN GET ELSE ERROR(FUNC_ERROR,KEYS OR QBLOCK); BLOCK(KEYS,ROUTINE_BLOCK); PUT0(END_OP) END; PROCEDURE PROG_DEC; VAR DUMMY:INTEGER; BEGIN GET; IDENTIFIER(KEYS OR QPROG_END,PROG_ID2,PROG_ERROR); PARM_LIST(KEYS OR QINTERFACE,PROGRAM_MODE); PUT0(INTF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROG_ERROR,KEYS OR QINTERFACE); CHECK(PROAR1,STRING1: SUBR_TYPE(KEYS); SET1: SET_TYPE(KEYS); ARRAY1: ARRAY_TYPE(KEYS); RECORD1: RECORD_TYPE(KEYS); CLASS1,MONITOR1,PROCESS1: COMP_TYPE(KEYS) END ELSE BEGIN ERROR(TYPE_ERROR,KEYS); PUT1(TYPE2,XUNDEF) END END; PROCEDURE ENUM_TYPE; VAR NUMBER:INTEGER; BEGIN PUT0(ENUM2); GET; ID_LIST(KEYS OR QCLOSE,ENUM_ID2,ENUM_ERROR,NUMBER); PUT0(ENUM_DEF2); IF SY=CLOSE1 THEN GET ELSE ERROR(ENUM_ERROR,KEYS); END; PROCEDURE SUBR_TYG_ERROR,KEYS OR QENTRY); IF SY=ENTRY1 THEN BEGIN GET; ID_LIST(KEYS OR QSEMICOLON,INTF_ID2,PROG_ERROR,DUMMY); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROG_ERROR,KEYS) END; PUT0(PROG_DEF2) END; PROCEDURE PARM_LIST; VAR LIST_OP,TYPE_OP,NUMBER:INTEGER; DONE:BOOLEAN; LKEYS1:SETS; BEGIN PUT1(PSTART2,MODE); CHECK(PARM_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN LKEYS1:=KEYS OR QPARM_LIST OR QCLOSE; GET; DONE:=FALSE; REPEAT CHECK(PARM_ERRORPE; VAR SPIX:SPELLING_INDEX; BEGIN IF SY=ID1 THEN BEGIN SPIX:=ARG; GET; CHECK(SUBR_ERROR,KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THEN BEGIN PUT1(CONSTANT2,SPIX); GET; CONSTANT(KEYS); PUT0(SUBR_DEF2) END ELSE PUT1(TYPE2,SPIX) END ELSE BEGIN CONSTANT(KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THEN GET ELSE ERROR(SUBR_ERROR,KEYS OR QCONSTANT); CONSTANT(KEYS); PUT0(SUBR_DEF2) END END; PROCEDURE SET_TYPE; BEGIN GET; ,LKEYS1); IF SY=VAR1 THEN BEGIN GET; LIST_OP:=VPARMLIST2 END ELSE LIST_OP:=CPARMLIST2; ID_LIST(LKEYS1,PARM_ID2,PARM_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1); CHECK(PARM_ERROR,LKEYS1); IF SY=UNIV1 THEN BEGIN GET; TYPE_OP:=UNIV_TYPE2 END ELSE TYPE_OP:=PARM_TYPE2; "TYPE"IDENTIFIER(LKEYS1,TYPE_OP,PARM_ERROR); PUT1(LIST_OP,NUMBER); CHECK(PARM_ERROR,LKEYS1); IF SY IN QPARM_LIST THE IF SY=OF1 THEN GET ELSE ERROR(SET_ERROR,KEYS OR QTYPE); TYPE_(KEYS); PUT0(SET_DEF2) END; PROCEDURE ARRAY_TYPE; VAR LKEYS1:SETS; I,DIMENSIONS:INTEGER; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QDIMENSION; GET; IF SY=SUB1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1); DIMENSIONS:=0; DONE:=FALSE; REPEAT "INDEX"TYPE_(LKEYS1); DIMENSIONS:=DIMENSIONS+1; CHECK(ARRAY_ERROR,LKEYS1); IF SY IN QTYPE_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1) N IF SY=SEMICOLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(PARM_ERROR,KEYS); PUT0(PEND2) END END; "####" "BODY" "####" PROCEDURE BODY; BEGIN PUT0(BODY2); IF SY=BEGIN1 THEN GET ELSE ERROR(BODY_ERROR,KEYS OR QBODY_END); STAT_LIST (KEYS OR QEND); PUT0(BODY_END2); IF SY=END1 THEN GET ELSE ERROR(BODY_ERROR,KEYS) END; PROCEDURE STAT_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN ELSE DONE:=TRUE UNTIL DONE; IF SY=BUS1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QOF_TYPE); IF SY=OF1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QTYPE); "ELEMENT"TYPE_(KEYS); FOR I:=1 TO DIMENSIONS DO PUT0(ARRAY_DEF2) END; PROCEDURE RECORD_TYPE; VAR NUMBER:INTEGER; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QVAR_DEF OR QEND; PUT0(REC2); GET; DONE:= FALSE; REPEAT ID_LIST(LKEYS1,FIELD_ID2,RECORD_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ER LKEYS1:=KEYS OR QSTAT_LIST; DONE:=FALSE; REPEAT STAT(LKEYS1); CHECK(STATS_ERROR,LKEYS1); IF SY IN QSTAT_LIST THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(STATS_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE STAT; BEGIN CHECK(STAT_ERROR,KEYS OR QSTAT); IF SY IN QSTAT THEN CASE SY OF ID1: ID_STAT(KEYS); BEGIN1: COMPOUND_STAT(KEYS); IF1: IF_STAT(KEYS); CASE1: CASE_STAT(KEYS); WHILE1: WHILE_STAT(KEROR,LKEYS1); "FIELD"TYPE_(LKEYS1); PUT1(FIELDLIST2,NUMBER); CHECK(RECORD_ERROR,LKEYS1); IF SY IN QVAR_DEF THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; PUT0(REC_DEF2); IF SY=END1 THEN GET ELSE ERROR(RECORD_ERROR,KEYS); END; PROCEDURE COMP_TYPE; VAR MODE,OP:INTEGER; BEGIN CASE SY OF CLASS1: BEGIN MODE:=CLASS_MODE; OP:=CLASS2 END; MONITOR1: BEGIN MODE:=MONITOR_MODE; OP:=MONITOR2 END; YS); REPEAT1: REPEAT_STAT(KEYS); FOR1: FOR_STAT(KEYS); CYCLE1: CYCLE_STAT(KEYS); WITH1: WITH_STAT(KEYS); INIT1: INIT_STAT(KEYS) END END; PROCEDURE ID_STAT; VAR LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QID_END; VARIABLE(LKEYS1); CHECK(IDSTAT_ERROR,LKEYS1); IF SY=BECOMES1 THEN BEGIN PUT0(ANAME2); GET; EXPR(KEYS); PUT0(STORE2) END ELSE BEGIN PUT0(CALL_NAME2); ARG_LIST(KEYS); PUT0(CALL2) END END; PROCEDURPROCESS1: BEGIN MODE:=PROCESS_MODE; OP:=PROCESS2 END END; GET; PARM_LIST(KEYS OR QPARM_END OR QSTACK,MODE); PUT0(OP); IF SY=SEMICOLON1 THEN GET; "NO CHECK SINCE AD HOC EXTENSION" IF SY=PLUS1 THEN BEGIN GET; IF SY=INTEGER1 THEN BEGIN PUT1(STACK2,ARG); GET END ELSE ERROR(STACK_ERROR,KEYS OR QBLOCK) END; BLOCK(KEYS,COMP_BLOCK) END; "#########" "VARIABLES" "#########" PROCEDURE VAR_DEC; VAR OP,NUMBER:INTEGER; LKEYS1:SETS; BEGIN X0 ^ $ۄ ڰ K^ B"2  Tx (, B""  XZ " X"$  "t XZ " X"$  " " ^, X ,&ل,  T (8 (   "   "&  " " ^N   X "" " X "& .,  "  "  " "$ #  " B"* * " ^D     &  nٰ$( ْ(  XY  "  (  " \ `2  " " B" ٰ2 " `"  "  X2 " """  X"$4  ^"$9   "&Bv B"6H B Xr    T  (  "  " (  "b (  "  "   X4  "   Z "2  V " B" B",  " `"  Ւ8"  X  T 2  ( @ p  B"  $ B"*fr  ^  X2"X   X (" (   "(v B XX   " " " B"^0 @" N  X  j R " "  2 B",7"  X  Xt P < (  "  " " "  t (*R  X  8T0" ( 2  &jh B"x (  " >"  " B"&:"  ( @ " "4"""  X2 " " X" "J  ^ KҰ  X ԰" b t ((i"  XV  Xp " FJ Ғ$ v  B"$ |  B". 0    (R  B XJ " Z  ^6   B"  ( @ "  & B"4  ( 2,"  " B"" " B"   (  "  " Z "$&!#%',.02468:<>(*-/135Y [ ] _ a c e g Q S U W d j l n h k m z | ~ n p r t v x       %'!    &  *  (. jbZ 4*2U  >"" L ` & V d""$  .,  "  " " "&   (  " Z$ 0."  " B"" ` Z   (   "      0 B"0 (  (   " &*  "R ( "$# .,  " (  " "$ . .,  " (&8 ~  (  "  "$ B   ( @ "\O(  T" """""RR&R>  "  h  (  " " B""  ". " 4N"  " B"" `    (  " X,    h   B""RR&RR&R R&RRR&RR R R RR&RRRR&RRR&RR&RR&:":""" `& "4^ & +~ (  " " "Z   * ;&Lf" " B". (  "  " ""* *  $ Ld6    B"((    p Z D .   "   "   "        R     (  "  "     B" "6c ^  ^  X2< T   XtX     >"4u TH\      p T 8     tX&  \  >"  >"  "  "  ""* TL@     "  " ". h"  "  " \ B X   (  " X  "$   "  " "  " " " "  \> d  * B" B"$ \ n >"$  \ < >" .,  " ($ `   (   "  "& ^b d\ j >" d "  BB"" "ݒ&   X! ܄  ܰ,"  Xpp " ^4 % J "T X: ^" "  ($   X0 ^ & BۄH  *  "  "  ", ^  ^  X2j  X2: "  "" B""&  hj  X& ( N (   "   "  6 TRY_PTR); FUNCVALUE_CLASS:(FUNC_TYPE:NOUN_INDEX); ICONST_CLASS:(ICONST_TYPE:NOUN_INDEX; ICONST_VAL:INTEGER); RCONST_CLASS:(RCONST_DISP:INTEGER); SCONST_CLASS:(SCONST_LENGTH,SCONST_DISP:INTEGER); CASE_LABEL:(LABEL,INDEX:INTEGER); DEF_CLASS:(DEF_ENTRY:ENTRY_PTR; DEF_SPIX:SPELLING_INDEX) END; NAME_ACCESS=(GENERAL,EXTERNAL,INTERNAL,INCOMPLETE, UNRESOLVED,QUALIFIED,FUNCTIONAL,UNDEFINED); LEVEL_INDEX=0..MAX_LEVEL; SPELLING_ENTRY= RECORD EN1=71; LT1=72; EQ1=73; GT1=74; LE1=75; NE1=76; GE1=77; IN1=78; UPLUS1=79; UMINUS1=80; PLUS1=81; MINUS1=82; OR1=83; STAR1=84; SLASH1=85; DIV1=86; MOD1=87; AND1=88; FNAME1=89; NOT1=90; EMPTY_SET1=91; INCLUDE1=92; FUNCTION1=93; CALL_FUNC1=94; NAME1=95; COMP1=96; SUB1=97; ARROW1=98; CONSTANT1=99; REAL1=100; FRETRY:ENTRY_PTR; LEVEL:LEVEL_INDEX; ACCESS:NAME_ACCESS END; DISPLAY_REC= RECORD BASE:0..UPDATE_MAX1; LEVEL_ENTRY:ENTRY_PTR; PREV_SYSCOMP:LEVEL_INDEX; PREV_LIST: NAME_PTR END; UPDATE_REC= RECORD UPDATE_SPIX:SPELLING_INDEX; OLD_ENTRY:SPELLING_ENTRY END; PACKED_SET=INTEGER; VARIANT_REC= RECORD TAG_DISP:INTEGER; LABEL_SET:PACKED_SET; NEXT_VARIANT:VARIANT_PTR END; NAME_REC= RECORD NAME_SPIX:SPELLIAL1=101; INTEGER1=102; FINTEGER1=103; CHAR1=104; FCHAR1=105; STRING1=106; FSTRING1=107; NEW_LINE1=108; LCONST1=109; MESSAGE1=110; PROCE_ID1=111; FUNCE_ID1=112; PEND1=113; CASE_JUMP1=114; "OUTPUT OPERATORS" EOM2=1; TYPE_DEF2=2; NEW_NOUN2=3; VAR_LIST2=4; EVAR_LIST2=5; INITS_DEF2=6; PROC_DEF2=7; PROCE_DEF2=8; FUNC_DEF2=9; FUNCE_DEF2=10; PROG_DEF2=11; TYPE2=12; ENUM_DEF2=13; SUBR_DEFNG_INDEX; NAME_ENTRY:ENTRY_PTR; NEXT_NAME:NAME_PTR END; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; VAR INTER_PASS_PTR: PASSPTR; PARAMETERIZED,CONSTANTS: SET OF OPERAND_CLASS; QUALIFIABLE,TYPES,CONST_KINDS: SET OF ENTRY_KIND; NAME_LIST, OLD_NAMES: NAME_PTR; HALT,TEST,RESOLUTION: BOOLEAN; OPS:ARRAY (.STACK_INDEX.) OF OPERAND; UENTRY,FIRST_PARM,THIS_PARM: ENTRY_PTR; COMP_MODES,ENTRY_MODES: SET OF CLASS_MODE..PROGRAM_MODE; INACCESSIBLE,ENTRY_ACCESS,OP_ACCESS: SE2=14; SET_DEF2=15; INTF2=16; ARRAY_DEF2=17; REC2=18; FIELDLIST2=19; REC_DEF2=20; CLASS2=21; MONITOR2=22; PROCESS2=23; STACK2=24; PSTART2=25; PARM_TYPE2=26; UNIV_TYPE2=27; CPARMLIST2=28; VPARMLIST2=29; BODY2=30; BODY_END2=31; ADDRESS2=32; RESULT2=33; STORE2=34; CALL_PROC2=35; CALL_PROG2=36; INTF_ID2=37; PARM2=38; FALSEJUMP2=39; DEF_LABEL2=40; JUMP_DEF2=41; FUNCF_DEF2=42; T OF NAME_ACCESS; LABELS: ARRAY (.MIN_CASE..MAX_CASE.) OF INTEGER; THIS_UPDATE: UPDATE_INDEX; T:STACK_INDEX; ENUM_VAL,THIS_LABEL,SY,CONST_DISP, UNRES_COUNT: INTEGER; ENUM_TYPE,THIS_NOUN: NOUN_INDEX; UPDATES:ARRAY (.UPDATE_INDEX.) OF UPDATE_REC; DISPLAY:ARRAY (.LEVEL_INDEX.) OF DISPLAY_REC; SYSCOMP_LEVEL,THIS_LEVEL,BODY_LEVEL: LEVEL_INDEX; SPELLING_TABLE:ARRAY (.SPELLING_INDEX.) OF SPELLING_ENTRY; "############################" "COMMON TEST OUTPUT MECHANISM" "##################### JUMP2=43; CASE_LIST2=44; FOR_STORE2=45; FOR_LIM2=46; FOR_UP2=47; FOR_DOWN2=48; WITH_VAR2=49; WITH_TEMP2=50; WITH2=51; INIT2=52; VALUE2=53; LT2=54; EQ2=55; GT2=56; LE2=57; NE2=58; GE2=59; IN2=60; UPLUS2=61; UMINUS2=62; PLUS2=63; MINUS2=64; OR2=65; STAR2=66; SLASH2=67; DIV2=68; MOD2=69; AND2=70; NOT2=71; #######" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 3: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LIN EMPTY_SET2=72; INCLUDE2=73; FUNCTION2=74; CALL_FUNC2=75; ROUTINE2=76; VAR2=77; ARROW2=78; VCOMP2=79; RCOMP2=80; SUB2=81; INDEX2=82; REAL2=83; STRING2=84; LCONST2=85; MESSAGE2=86; NEW_LINE2=87; FWD_DEF2=88; CHK_TYPE2=89; PROCF_DEF2=90; UNDEF2=91; PEND2=92; CASE_JUMP2=93; "OTHER CONSTANTS" NOUN_MAX=700; MIN_CASE=0; MAX_CASE=127; THIS_PASS=3; SPELLING_MAX=700; OPERAND_MAX=150;K:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); UPDATE_MAX=100; UPDATE_MAX1=101; MAX_LEVEL=15; "MODES" CLASS_MODE=1; MONITOR_MODE=2; PROCESS_MODE=3; PROC_MODE=4; PROCE_MODE=5; FUNC_MODE=6; FUNCE_MODE=7; PROGRAM_MODE=8; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9 ; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91109 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 3: SCOPE ANALYSIS SEPTEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPT XORD=15; XPRED=16; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; XWAIT=23; XREAL=24; "STANDARD NOUN INDICES" ZARITHMETIC=25; ZINDEX=26; ZPASSIVE=27; ZVPARM=28; ZCPARM=29; ZSPARM=30; ZWITH=31; "ERRORS" UNRES_ERROR=1; AMBIGUITY_ERROR=2; ABORT_ERROR=3; CONSTID_ERROR=4; SUBR_ERROR=5; FEW_ARGS_ERROR=6; ARG_LIST_ERROR=7; MANY_ARGS_ERROR=8; CASERANGE_ERROR=9; CASETYPE_ERROR=10; ION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTAMBICASE_ERROR=11; WITH_ERROR=12; INIT_ERROR=13; PROC_USE_ERROR=14; NAME_ERROR=15; COMP_ERROR=16; SUB_ERROR=17; INTERFACE_ERROR=18; CALL_NAME_ERROR=19; "MISCELANEOUS" NOT_POSSIBLY_FORWARD=FALSE; POSSIBLY_FORWARD=TRUE; OUTPUT=TRUE; RETAIN=FALSE; PROC_TYPE= 1; STD_LEVEL=0; GLOBAL_LEVEL=1; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; TYPE ENTRY_KIND=(INDEX_CONST,REAL_CONST,STRING_CONST,VARIABLE, PARAMETER,FIELD,SCALAR_KIND,SYSCOMP_KIND,ROUTINE_KIND,SETYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTET_KIND, PROGRAM_KIND,POINTER_KIND,ARRAY_KIND,RECORD_KIND,WITH_KIND,UNDEF_KIND); OPERAND_CLASS=(VAR_CLASS,ROUTINE_CLASS,ICONST_CLASS,RCONST_CLASS,SCONST_CLASS, DEF_CLASS,UNDEF_CLASS,FCONST_CLASS,PROGRAM_CLASS,CASE_LABEL, FUNCVALUE_CLASS); ERROR_NOTE=(YES,NO,SUPPRESS); SPELLING_INDEX=0..SPELLING_MAX; NOUN_INDEX = 0..NOUN_MAX; STACK_INDEX=0..OPERAND_MAX; UNIV_SET = ARRAY (.1..8.) OF INTEGER; UPDATE_INDEX=0..UPDATE_MAX; NAME_PTR=@NAME_REC; VARIANT_PTR=@VARIANT_REC; ENTRGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; CONST_ID1=2; CONST_DEF1=3; TYPE_ID1=4; TYPE_DEF1=5; VAR_ID1=6; VAR_LIST1=7; EVAR_LIST1=8; INITS_DEF1=9; INITS_END1=10; PROC_ID1=11; PROC_DEF1=12; PROCE_DEF1=13; Y_PTR=@ENTRY_REC; ENTRY_REC= RECORD NOUN:NOUN_INDEX; CASE KIND:ENTRY_KIND OF INDEX_CONST:(CONST_TYPE:NOUN_INDEX; CONST_VAL:INTEGER); REAL_CONST:(REAL_DISP:INTEGER); STRING_CONST:(STRING_LENGTH,STRING_DISP:INTEGER); VARIABLE:(VAR_TYPE:ENTRY_PTR); PARAMETER:(PARM_TYPE,NEXT_PARM:ENTRY_PTR); FIELD:(FIELD_TYPE:ENTRY_PTR; VARIANT:VARIANT_PTR); SCALAR_KIND:(RANGE_TYPE:NOUN_INDEX); SYSCOMP_KIND:(INIT_STAT:ENTRY_PTR; ENTRY_NAME:NAME_PPROC_END1=14; PROCE_END1=15; FUNC_ID1=16; FUNC_DEF1=17; FUNCE_DEF1=18; FUNC_END1=19; FUNCE_END1=20; PROG_ID1=21; PROG_DEF1=22; INTF_ID1=23; TYPE1=24; ENUM1=25; ENUM_ID1=26; ENUM_DEF1=27; SUBR_DEF1=28; SET_DEF1=29; ARRAY_DEF1=30; REC1=31; FIELD_ID1=32; FIELDLIST1=33; REC_DEF1=34; CLASS1=35; MONITOR1=36; PROCESS1=37; STACK1=38; PSTART1=39; PARM_ID1=40; PARM_TYPE1=41; UNIV_TYTR); ROUTINE_KIND:(ROUT_PARM:ENTRY_PTR; ROUT_TYPE:NOUN_INDEX); PROGRAM_KIND:(PROG_PARM:ENTRY_PTR; INTERFACE:NAME_PTR); POINTER_KIND:(OBJECT_TYPE:ENTRY_PTR); ARRAY_KIND:(INDEX_TYPE:NOUN_INDEX; EL_TYPE:ENTRY_PTR); WITH_KIND:(WITH_TYPE:NOUN_INDEX); RECORD_KIND:(FIELD_NAME:NAME_PTR) END; OPERAND= RECORD CASE CLASS:OPERAND_CLASS OF VAR_CLASS:(VTYPE:ENTRY_PTR); PROGRAM_CLASS:(PROG,PPARM:ENTRY_PTR); ROUTINE_CLASS:(ROUT,PARM:ENPE1=42; CPARMLIST1=43; VPARMLIST1=44; BODY1=45; BODY_END1=46; ANAME1=47; STORE1=48; CALL_NAME1=49; CALL1=50; ARG_LIST1=51; ARG1=52; FALSEJUMP1=53; DEF_LABEL1=54; JUMP_DEF1=55; INTF1=56; DEF_CASE1=57; CASE1=58; JUMP1=59; END_CASE1=60; ADDRESS1=61; FOR_STORE1=62; FOR_LIM1=63; FOR_UP1=64; FOR_DOWN1=65; WITH_VAR1=66; WITH_TEMP1=67; WITH1=68; INIT_NAME1=69; INIT1=70; VALUEEL:=THIS_LEVEL-1 END; "#############" "NAME HANDLING" "#############" PROCEDURE PUSH; BEGIN IF T>= OPERAND_MAX THEN ABORT ELSE T:=T+1 END; PROCEDURE NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN IF THIS_NOUN>=NOUN_MAX THEN ABORT ELSE THIS_NOUN:=THIS_NOUN+1; NEW(E); WITH E@ DO BEGIN NOUN:=THIS_NOUN; KIND:=UNDEF_KIND END END; PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN PUSH; NEW_ENTRY(E); WITH OPS(.T.) DO BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=ER); VAR ARG1,ARG2,ARG3:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); PUT3(OP,ARG1,ARG2,ARG3) END; PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); CONST_DISP:=CONST_DISP+LENGTH; FOR I:=1 TO LENGTH DIV 2 DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE ERROR(NUMBER:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); END; PROCEDURE ABORT; BEGIN ERROR(ABORT_ERROR); HALT:=TRUE END; "; DEF_SPIX:=XUNDEF END END; PROCEDURE UPDATE(SPIX:SPELLING_INDEX; E:ENTRY_PTR; A:NAME_ACCESS); BEGIN IF THIS_LEVEL<>GLOBAL_LEVEL THEN BEGIN "SAVE OLD ENTRY" IF THIS_UPDATE>=UPDATE_MAX THEN ABORT ELSE THIS_UPDATE:=THIS_UPDATE+1; WITH UPDATES(.THIS_UPDATE.) DO BEGIN UPDATE_SPIX:=SPIX; OLD_ENTRY:=SPELLING_TABLE(.SPIX.) END END; WITH SPELLING_TABLE(.SPIX.) DO BEGIN ENTRY:=E; LEVEL:=THIS_LEVEL; ACCESS:=A END END; PROCEDURE PUSH_N##############" "INITIALIZATION" "##############" PROCEDURE STD_ID(VAR STD_ENTRY:ENTRY_PTR; INDEX:SPELLING_INDEX); BEGIN NEW(STD_ENTRY); STD_ENTRY@.NOUN:=INDEX; WITH SPELLING_TABLE(.INDEX.) DO BEGIN ENTRY:=STD_ENTRY; LEVEL:=STD_LEVEL; ACCESS:=GENERAL END END; PROCEDURE STD_CONST(CONST_INDEX,TYPE_INDEX:SPELLING_INDEX; CONST_VALUE:INTEGER); VAR CONST_ENTRY:ENTRY_PTR; BEGIN STD_ID(CONST_ENTRY,CONST_INDEX); WITH CONST_ENTRY@ DO BEGIN KIND:=INDEX_CONS ACEGIKMO9;=?B>@]_acegQSUWY[^`bdfPRTVXZ\y{}ikmoqsuwz|~hjlnprtvx     %'!#& "$)+-/13579;=?T; CONST_TYPE:=TYPE_INDEX; CONST_VAL:=CONST_VALUE END END; PROCEDURE STD_PARM(VAR PARM_ENTRY:ENTRY_PTR; PARMTYPE:ENTRY_PTR; PARM_INDEX:NOUN_INDEX); BEGIN NEW(PARM_ENTRY); WITH PARM_ENTRY@ DO BEGIN NOUN:=PARM_INDEX; KIND:=PARAMETER; PARM_TYPE:=PARMTYPE; NEXT_PARM:=NIL END END; PROCEDURE STD_ENTRY(VAR E:ENTRY_PTR; INDEX:NOUN_INDEX); BEGIN NEW(E); WITH E@ DO BEGIN NOUN:=INDEX; KIND:=UNDEF_KIND END END; PROCEDURE (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, STD_ROUT(ROUT_INDEX,ROUTTYPE:NOUN_INDEX; FIRST_PARM:ENTRY_PTR); VAR ROUT_ENTRY:ENTRY_PTR; BEGIN STD_ID(ROUT_ENTRY,ROUT_INDEX); WITH ROUT_ENTRY@ DO BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=FIRST_PARM; ROUT_TYPE:=ROUTTYPE END END; PROCEDURE STD_SCALAR(VAR SCALAR_ENTRY:ENTRY_PTR; SCALAR_INDEX:SPELLING_INDEX); BEGIN STD_ID(SCALAR_ENTRY,SCALAR_INDEX); WITH SCALAR_ENTRY@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=SCALAR_INDEX END END; PROCEDURE INITIASCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDILIZE; VAR I:INTEGER; INT_TYPE,REAL_TYPE,BOOL_TYPE,CHAR_TYPE,QUEUE_TYPE, INDEX_TYPE,ARITH_TYPE,PASSIVE_TYPE,ARITH_SPARM,INT_CPARM,QUEUE_VPARM, PAS2_VPARM,PAS1_VPARM,CHAR_CPARM,INDEX_CPARM,INDEX1_CPARM,REAL_CPARM, INDEX_SPARM,QUEUE_CPARM: ENTRY_PTR; BEGIN INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN TEST:=TESTOPTION IN OPTIONS END; IF TEST THEN PRINTFF; THIS_NOUN:=ZWITH; CONST_DISP:=0; HALT:=FALSE; RESOLUTION:=FALSE; UNRES_COUNT:= 0; PARAMEIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); TERIZED:=(.ROUTINE_CLASS,PROGRAM_CLASS.); COMP_MODES:=(.CLASS_MODE,MONITOR_MODE,PROCESS_MODE.); ENTRY_MODES:=(.PROCE_MODE,FUNCE_MODE.); QUALIFIABLE:=(.SYSCOMP_KIND,RECORD_KIND.); CONSTANTS:=(.ICONST_CLASS,RCONST_CLASS,SCONST_CLASS.); TYPES:=(.SCALAR_KIND,SYSCOMP_KIND,ARRAY_KIND,RECORD_KIND,SET_KIND, UNDEF_KIND.); OP_ACCESS:=(.GENERAL,INTERNAL,QUALIFIED,FUNCTIONAL.); CONST_KINDS:=(.INDEX_CONST,REAL_CONST,STRING_CONST.); INACCESSIBLE:=(.UNDEFINED,INCOMPLETE.); ENTRY_A PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE CCESS:=(.EXTERNAL,UNRESOLVED.); THIS_UPDATE:=-1; T:=-1; THIS_LEVEL:=STD_LEVEL; FOR I:=0 TO SPELLING_MAX DO SPELLING_TABLE(.I.).ACCESS:=UNDEFINED; "STANDARD ENTRYS" STD_CONST(XFALSE,XBOOLEAN,0); STD_CONST(XTRUE,XBOOLEAN,1); STD_ENTRY(UENTRY,XUNDEF); STD_ENTRY(INDEX_TYPE,ZINDEX); STD_ENTRY(ARITH_TYPE,ZARITHMETIC); STD_ENTRY(PASSIVE_TYPE,ZPASSIVE); STD_ID(QUEUE_TYPE,XQUEUE); QUEUE_TYPE@.KIND:=UNDEF_KIND; STD_SCALAR(INT_TYPE,XINTEGER); STD_SCALAR(REAL_TYPE,XPUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSREAL); STD_SCALAR(BOOL_TYPE,XBOOLEAN); STD_SCALAR(CHAR_TYPE,XCHAR); STD_PARM(ARITH_SPARM,ARITH_TYPE,ZSPARM); STD_PARM(INT_CPARM,INT_TYPE,ZCPARM); STD_PARM(QUEUE_CPARM,QUEUE_TYPE,ZCPARM); STD_PARM(QUEUE_VPARM,QUEUE_TYPE,ZVPARM); STD_PARM(CHAR_CPARM,CHAR_TYPE,ZCPARM); STD_PARM(INDEX_CPARM,INDEX_TYPE,ZCPARM); STD_PARM(INDEX_SPARM,INDEX_TYPE,ZSPARM); STD_PARM(PAS2_VPARM,PASSIVE_TYPE,ZVPARM); PAS2_VPARM@.NEXT_PARM:=INDEX_CPARM; STD_PARM(PAS1_VPARM,PASSIVE_TYPE,ZVPAEW_NAME(RESOLVE,OUTPUT:BOOLEAN; A:NAME_ACCESS); VAR SPIX:SPELLING_INDEX; E:ENTRY_PTR; BEGIN READ_IFL(SPIX); IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO IF (ACCESS<>UNDEFINED) AND (LEVEL=THIS_LEVEL) THEN IF RESOLVE AND (ACCESS=UNRESOLVED) THEN BEGIN E:=ENTRY; ACCESS:= A; RESOLUTION:= TRUE; UNRES_COUNT:= UNRES_COUNT - 1 END ELSE BEGIN ERROR(AMBIGUITY_ERROR); SPIX:=XUNDEF; END ELSE BEGIN NEW_EN_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR RM); PAS1_VPARM@.NEXT_PARM:=PAS2_VPARM; STD_PARM(INDEX1_CPARM,INDEX_TYPE,ZCPARM); INDEX1_CPARM@.NEXT_PARM:= INDEX_CPARM; STD_PARM(REAL_CPARM,REAL_TYPE,ZCPARM); STD_ROUT(XABS,ZARITHMETIC,ARITH_SPARM); STD_ROUT(XATTRIBUTE,XINTEGER,INDEX_CPARM); STD_ROUT(XCHR,XCHAR,INT_CPARM); STD_ROUT(XCONTINUE,PROC_TYPE,QUEUE_VPARM); STD_ROUT(XCONV,XREAL,INT_CPARM); STD_ROUT(XDELAY,PROC_TYPE,QUEUE_VPARM); STD_ROUT(XEMPTY,XBOOLEAN,QUEUE_CPARM); STD_ROUT(XIO,PROC_TYPE,PAS1_VPARM)I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('3'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" "#############" "PASS ROUTINES" "######; STD_ROUT(XORD,XINTEGER,CHAR_CPARM); STD_ROUT(XPRED,ZINDEX,INDEX_SPARM); STD_ROUT(XSTOP,PROC_TYPE,INDEX1_CPARM); STD_ROUT(XREALTIME,XINTEGER,NIL); STD_ROUT(XSETHEAP,PROC_TYPE,INT_CPARM); STD_ROUT(XSUCC,ZINDEX,INDEX_SPARM); STD_ROUT(XTRUNC,XINTEGER,REAL_CPARM); STD_ROUT(XSTART,PROC_TYPE,NIL); STD_ROUT(XWAIT,PROC_TYPE,NIL); END; "#######" "NESTING" "#######" PROCEDURE PUSH_LEVEL(E:ENTRY_PTR); BEGIN IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL#######" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(+1; WITH DISPLAY(.THIS_LEVEL.) DO BEGIN BASE:=THIS_UPDATE+1; LEVEL_ENTRY:=E; PREV_SYSCOMP:=SYSCOMP_LEVEL; PREV_LIST:=NAME_LIST; NAME_LIST:=NIL END END; PROCEDURE POP_LEVEL; VAR U:UPDATE_INDEX; BEGIN WITH DISPLAY (.THIS_LEVEL.) DO BEGIN SYSCOMP_LEVEL:=PREV_SYSCOMP; NAME_LIST:=PREV_LIST; FOR U:=THIS_UPDATE DOWNTO BASE DO WITH UPDATES(.U.) DO SPELLING_TABLE(.UPDATE_SPIX.):=OLD_ENTRY; THIS_UPDATE:=BASE-1 END; THIS_LEVARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4) END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; PROCEDURE IGNORE3(OP:INTEGEbdfhjlnprtv`ce46 "%')2#(EGIKMO9;=?ACFHJLN8:<>@BDacegQSUWY[]_bdfPRTVXZ\^`}ikmoqsuwy{p xzMO9;=@BEG>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq      "$&!#%'8:<>(*,.02469;=?)+-/1357TV@BDFHJLNPRUWACEGIKMOQSXZ\^`bdfhjlnY[]_acegikmotvxz|~MOVE(1) WRITE(AUTOLOAD) BACKUP(WRITE) MOVE(2) BACKUP(CHECK) MOVE(1) (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCzxBEGMO9;=@>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq     "$& #%'!>(*,.02468:<?)+-/RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM MO9;=@BEG>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq     "$& #%'!>(*,.02468:<?)+-/13, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTD F H J L N 8 : < > @ B G I K M O 9 ; = ? A ^ ` b d f P R T V X Z \ _ a c e g Q S U W Y [ ] z | ~ h j l n p r t v x { }  i k m o q s u w y           &         " $ '         ! # % * , . 0 2 4 6 8 : < > ( + - (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;################## # START MANUAL # ################## PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: STARTS EXECUTION OF A CONCURRENT PASCAL PROGRAM STORED ON THE DISK. THE CONCURRENT PROGRAM REPLACES THE SOLO OPERATING SYSTEM IN CORE. CALL: START(SYSTEM: IDENTIFIER) START(SYSTEM: IDENTIFIER; INITIAL: BOOLEAN) THE CALL: START(S) IS EQUIVALENT TO: START(S, FALSE). THE SELECTED OPERATING SYSTEM IS COPIED FROM A DISK FILE TO ONE OF TWO CONSECUTIVE DISK SEGMENTS BEFORE BEING EXECUTED. THE SELECTION        !#%' "$&/13579;=?)+-02468:<>(*,.KMOQSUWACEGILNPRTV@BDFHJgikmoY[]_acehjlnXZ\^`bdfqsuwy{} OF ONE OF THE DISK SEGMENTS IS DETERMINED BY THE BOOLEAN INITIAL. THE COMMAND START(S) OR START(S, FALSE) TEMPORARILY REPLACES THE SOLO OPERATING SYSTEM IN CORE BY ANOTHER OPERATING SYSTEM S. THE SOLO OPERATING SYSTEM CAN BE RESTARTED BY MEANS OF THE OPERATOR'S CONTROL PANEL. THE COMMAND START(S, TRUE) PERMANENTLY REPLACES THE SOLO OPERATING SYSTEM IN CORE AND ON DISK BY ANOTHER OPERATING SYSTEM S. SUBSEQUENT RESTARTS BY MEANS OF THE OPERATOR'S CONTROL PANEL WILL NOW START THE OPERATING SYSTEM S. THE (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SOLO OPERATING SYSTEM CAN BE MODIFIED AS FOLLOWS: EDIT(SOLOTEXT) CPASCAL(SOLOTEXT, PRINTER, SOLO) START(SOLO, TRUE) PLACES THE SOLO OPERATING SYSTEM IN CORE BY ANOTHER OPERATING SYSTEM S. THE SOLO OPERATING SYSTEM CAN BE RESTARTED BY MEANS OF THE OPERATOR'S CONTROL PANEL. THE COMMAND START(S, TRUE) PERMANENTLY REPLACES THE SOLO OPERATING SYSTEM IN CORE AND ON DISK BY ANOTHER OPERATING SYSTEM S. SUBSEQUENT RESTARTS BY MEANS OF THE OPERATOR'S CONTROL PANEL WILL NOW START THE OPERATING SYSTEM S. THE SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: CHAR); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "TOWERS OF HANOI PER BRINCH HANSEN 12 SEPTEMBER 1975" CONST DISKLIMIT = 6; TYPE DISKTYPE = 0..DISKLIMIT; CUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################ # DO(VAR OK: BOOLEAN; SOURCE: IDENTIFIER) # ############### PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE P#############################" "INSERT PREFIX HERE" TYPE CHARKIND = (LETTER, DIGIT, SPECIAL, OTHERCHAR); TOKENKIND = (OPERAND, LEFTPAR, COMMA, RIGHTPAR, SEMICOLON, NEWLINE, ENDMEDIUM, OTHERTOKEN); VAR OK, ONLINE: BOOLEAN; SOURCE: ARGTYPE; COPY: IDENTIFIER; BUFFER: RECORD TEXT: PAGE; PAGENO, CHARNO: INTEGER END; SYMB: RECORD KIND: CHARKIND; CH: CHAR END; TOKEN: RECORD KIND: TOKENKIND; ARG: ARGTYPE END; COMMAND: RECORD CODE: IDENTIFIER; ATTRp r t v x z | ~ u w y { }         !#%' "$&/13579;=?)+-02468:<>(*,.KMOQSUWACEGILNPRTV@BDFHJgikmoY[]_acehjlnXZ\^`bdfqsuwy{}" VAR OK: BOOLEAN; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE TAPEERROR(RESULT: IORESULT); BEGIN CASE RESULT OF INTERVENTION: WRITETEXT('INSPECT(:10:)'); TRANSMISSION: WRITETEXT('ERROR(:10:)'); FAILURE: WRITETEXT('FAILURE(:10:)'); ENDMEDIUM: WRITETEXT('ENDMEDIUM(:10:)') END; OK:= FALSE; END; PROCEDURE MOVETAPE(WHERE: IOARG; VAR RESULT: I$( " >" "   X$ 26*v&j",  "  "( ". " & "*" " >"0 0@  "$ " X Z2ORESULT); VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= MOVE; ARG:= WHERE; IOMOVE(TAPEDEVICE, PARAM); RESULT:= STATUS; END; END; PROCEDURE TRANSFERTAPE (HOW: IOOPERATION; VAR BLOCK: PAGE; VAR RESULT: IORESULT); VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= HOW; IOTRANSFER(TAPEDEVICE, PARAM, BLOCK); RESULT:= STATUS; END; END; PROCEDURE RECOVER; VAR STEP, MAXSTEP: INTEGER; RESULT: IORESULT; BEGIN STEP:= 0; MAXSTEP:= 10; REPEAT STEP:= STX B" & *, " >"  p ""j ""R V z x " 0" L, " >"  D"H V   0" x* " >" EP + 1; MOVETAPE(BACKSPACE, RESULT); CASE RESULT OF COMPLETE, ENDFILE: ; INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM: BEGIN TAPEERROR(RESULT); MAXSTEP:= STEP END; STARTMEDIUM: MAXSTEP:= STEP END UNTIL STEP = MAXSTEP; WHILE OK & (STEP > 1) DO BEGIN STEP:= STEP - 1; MOVETAPE(UPSPACE, RESULT); CASE RESULT OF COMPLETE, ENDFILE: ; INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM: TAPEERROR(RESULT) END; END; END; PROCED        $& "%'!#(*,.02468:<>)+-/13579;=?DFHJLNPRTV@BEGIKMOQSUWAC`bdfhjlnXZ\^acegikmoY[]_|~prtvxz}qsuwy{URE READTAPE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN); CONST MAXTIMES = 3; VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN; BEGIN TIMES:= 0; REPEAT TIMES:= TIMES + 1; TRANSFERTAPE(INPUT, BLOCK, RESULT); CASE RESULT OF COMPLETE: BEGIN EOF:= FALSE; DONE:= TRUE END; ENDFILE: BEGIN EOF:= TRUE; DONE:= TRUE END; INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM: BEGIN IF TIMES < MAXTIMES THEN RECOVER ELSE TAPEERROR(RESULT); '0%$( " E" #^ FV2<  >" E" n H " `0 E    >E# 8  ""0" >"    P >   L" X >" V  -     " EOF:= FALSE; DONE:= NOT OK; END END UNTIL DONE; END; PROCEDURE WRITETAPE(VAR BLOCK: PAGE); CONST MAXTIMES = 3; VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN; BEGIN TIMES:= 0; REPEAT TIMES:= TIMES + 1; TRANSFERTAPE(OUTPUT, BLOCK, RESULT); CASE RESULT OF COMPLETE: DONE:= TRUE; INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM: BEGIN IF TIMES < MAXTIMES THEN RECOVER ELSE TAPEERROR(RESULT); DONE:= \(   >" ` "!&xVplh`XPH@8N0$6   ^ "" * "$C   ^ "" " "$P   ^ "" " "" NOT OK; END END UNTIL DONE; END; PROCEDURE WRITEMARK; CONST MAXTIMES = 3; VAR TIMES: INTEGER; RESULT: IORESULT; DONE: BOOLEAN; BEGIN TIMES:= 0; REPEAT TIMES:= TIMES + 1; MOVETAPE(WRITEEOF, RESULT); CASE RESULT OF COMPLETE, ENDFILE: DONE:= TRUE; INTERVENTION, TRANSMISSION, FAILURE, ENDMEDIUM: BEGIN IF TIMES < MAXTIMES THEN RECOVER ELSE TAPEERROR(RESULT); DONE:= NOT OK; END END UNTIL DONE; EN] " hx "f tx "H x "* x " "0n "  " & ^($  X X*  ^ 4 * >  >  " "  *2  xL" D; PROCEDURE INITIALIZE; BEGIN IDENTIFY('TAPE:(:10:)'); OK:= TRUE; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; PROCEDURE TAPEINPUT; VAR BLOCK: PAGE; EOF: BOOLEAN; BEGIN INITIALIZE; REPEAT READTAPE(BLOCK, EOF); WRITEPAGE(BLOCK, EOF); UNTIL NOT OK OR EOF; IF NOT EOF THEN WRITEPAGE(BLOCK, TRUE); TERMINATE; END; PROCEDURE TAPEOUTPUT; VAR BLOCK: PAGE; EOF: BOOLEAN; BEGIN INITIALIZE; READPAGE(BLOCK, EOF); WHILE OK & NOT EOF DO L" H" P" xH"z >"x xP"  "  &BRRRRRRRRR R R R R RRRRRRRRRRR&RRRRRRRR R!R"R#R$R%R&R'R(R)R*R+R,R-R.R/R&BEGIN WRITETAPE(BLOCK); READPAGE(BLOCK, EOF); END; WHILE NOT EOF DO READPAGE(BLOCK, EOF); IF OK THEN WRITEMARK; TERMINATE; END; BEGIN IF TASK = INPUTTASK THEN TAPEINPUT ELSE IF TASK = OUTPUTTASK THEN TAPEOUTPUT; END. 0R1R2R3R4R5R6R7R8R9R:R;R<R=R>R?R@RARBRCRDRERFRGR&HRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR[R\R]R^R_R&`RaRbRcRdReRfRgRhRiRjRkRlRmRnRoRpRqRrRsRtRuRvRwR& ~ xL"| D"H V 4 2 0" |"0"$%   (  "&,  0 6 0f&88 02 0 B E$*X *XZINSPECT ERROR FAILURE ENDMEDIUM TAPE: ~H"v "t"r" xRF& ~4& "b  X " $ ,VF<J@J@J@" J@" B"2" T0 >" z>"B x x r>P |>"r"r v tZ2 xT0"x x>P |>"o q s u w y { }  i p r t v x z | ~        !#%' "$&/13579;=?)+-02468:<>(*,.KMOQSUWACEGILNPRTV@BDFHJgikmoY[]_acehjlnXZ\^`bdfqsuwy{} xRF& xRF&t t>"  t x z>"x x>P |>". v tXr2 " "@ ~ ~ >" ~`B| ~H" ~4&r r>"0  Z & >" `P xH" &z >"~"$ >" H" 0"################# # TAPE MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES A FILE TO OR FROM MAGNETIC TAPE. THE FILE CONSISTS OF BLOCKS OF 512 BYTES EACH. IT IS TERMINATED BY AN END_OF_FILE MARK. THE TAPE MUST BE POSITIONED CORRECTLY BEFORE USING THE TAPE PROGRAM. CALL: CAN ONLY BE USED TO PRODUCE INPUT/OUTPUT FOR OTHER PROGRAMS. ERROR MESSAGES: INSPECT INSPECTION OF THE DEVICE REQUIRED. ERROR TRANSMISSION ERROR DURING A BLOCK TRANSFER. FAILURE DEVICE FAILURE DURIN2    BB"  & "@  r  0  ~Z 6 0 J Z 6 0 F &  ^ v "t" xR8&   >>" V "L4    >vQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "########################## # TAPE(VAR OK: BOOLEAN) # ##########################" "INSERT PREFIX HERE|u `X     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegjlnprtv`bdfhGTH, KIND, PROTECTED)#USING# ID, OLDID, NEWID: IDENTIFIER; # LENGTH: 1..255; # KIND: (SCRATCH, ASCII, SEQCODE, CONCODE); # PROTECTED: BOOLEAN; #SCRATCH ASCII SEQCODE CONCODE DISK ERROR #PUSH RETURN#A~j"@b؉=V6B:L:D>(BNAME ERROR# CATALOG FULL# DISK FULL#FILE LIMIT# FILE PROTECTED# CATALOG NEXT NEXT NEXT NEXT NEXT REPLACE CREATE DELETE RENAME PROTECT FILE: ID)# FILE(REPLACE, ID, LEN! 4$ < " P>" >"$ C " P>" B"$ J X"$ M X"" O"""4 ] " 4 cF" . h"&4v " @ ` ~B"` *B4 ~ "t >" xR8&   B>" xL>H z>" >"  " V " >" \ Z6 "FK" v tX" 02  t>"  zB" w`0 R8&t t>" " v tX"b &* ^  0 ONST LEVELLIMIT = DISKLIMIT; TYPE LEVELTYPE = 0..LEVELLIMIT; TYPE PEGTYPE = RECORD HEIGHT: LEVELTYPE; CONTENTS: ARRAY (.LEVELTYPE.) OF DISKTYPE END; TYPE PEGNO = 1..3; VAR BOARD: ARRAY (.PEGNO.) OF PEGTYPE; DISKS: DISKTYPE; PROCEDURE WRITE(C: CHAR); VAR X: CHAR; PARAM: IOPARAM; BEGIN PARAM.OPERATION:= OUTPUT; X:= C; IOTRANSFER(TYPEDEVICE, PARAM, X); END; PROCEDURE WRITEFF; CONST MSEC = 3000; ESC = '(:27:)'; VAR I, J, K: INTEGER; BEGIN F (ib "  " " "  *&wf  "  " *d&  " "  $  F&  V0  $  VOR I:= 1 TO MSEC DO FOR J:= 1 TO 9 DO K:= 10 DIV 10; WRITE(ESC); WRITE(FF); END; PROCEDURE PRINTDISK(DISK: DISKTYPE); VAR CHARNO, BLANKS: INTEGER; BEGIN BLANKS:= 2 + DISKLIMIT - DISK; FOR CHARNO:= 1 TO BLANKS DO WRITE(' '); FOR CHARNO:= 1 TO 2*DISK + 1 DO WRITE('X'); FOR CHARNO:= 1 TO BLANKS DO WRITE(' '); END; PROCEDURE INITPEG(VAR PEG: PEGTYPE); VAR LEVEL: LEVELTYPE; BEGIN WITH PEG DO BEGIN HEIGHT:= 0; FOR LEVEL:= 0 TO LEVELLIMIT DO CONTENTS(.LEVEL.):= 0; END; END; P"$  ^l FNB6*X"* n BL>"  ^( "    BP> ** "" >"  "  ^$ H lP>"  X  X6 "* n BL>"  ^` ROCEDURE PUSHPEG(VAR PEG: PEGTYPE; DISK: DISKTYPE); BEGIN WITH PEG DO BEGIN HEIGHT:= HEIGHT + 1; CONTENTS(.LEVELLIMIT - HEIGHT + 1.):= DISK; END; END; PROCEDURE POPPEG(VAR PEG: PEGTYPE; VAR DISK: DISKTYPE); BEGIN WITH PEG DO BEGIN DISK:= CONTENTS(.LEVELLIMIT - HEIGHT + 1.); CONTENTS(.LEVELLIMIT - HEIGHT + 1.):= 0; HEIGHT:= HEIGHT - 1; END; END; PROCEDURE PRINTBOARD; VAR ROW: LEVELTYPE; COLUMN: PEGNO; BEGIN FOR ROW:= 0 TO LEVELLIMIT DO BEGIN FOR COLUMN:= 1 TO 3 DO    "   "( n N  BP> *& n   BP> * "H  Z  "  * * "   "J $ Z ~ "    lP>"" Z 02 h * PRINTDISK(BOARD(.COLUMN.).CONTENTS(.ROW.)); WRITE(NL); END; FOR ROW:= 1 TO 5 DO WRITE(NL); END; PROCEDURE INITBOARD; VAR COLUMN: PEGNO; DISK: DISKTYPE; BEGIN FOR COLUMN:= 1 TO 3 DO INITPEG(BOARD(.COLUMN.)); FOR DISK:= DISKS DOWNTO 1 DO PUSHPEG(BOARD(.1.), DISK); END; PROCEDURE INITIALIZE; VAR C: CHAR; BEGIN IDENTIFY('HANOI: (:10:)'); REPEAT ACCEPT(C); DISKS:= ORD(C) - ORD('0'); UNTIL (1 <= DISKS) & (DISKS <= DISKLIMIT); INITBOARD; WRITEFF; PRINTBOARD; END; PROCEDURE MO x"L  X B"   lP>"bJ $ zZ ~ l"    lP>"" Z 02r h * x"2 B"   lP>"|(6 n " "(@n    $ I | ZVE(NUMBER: LEVELTYPE; VAR SOURCE, DEST, TEMP: PEGTYPE); VAR DISK: DISKTYPE; BEGIN IF NUMBER > 1 THEN MOVE(NUMBER-1, SOURCE, TEMP, DEST); POPPEG(SOURCE, DISK); PUSHPEG(DEST, DISK); PRINTBOARD; WRITEFF; PRINTBOARD; IF NUMBER > 1 THEN MOVE(NUMBER-1, TEMP, DEST, SOURCE); END; BEGIN INITIALIZE; MOVE(DISKS, BOARD(.1.), BOARD(.2.), BOARD(.3.)); END. 4 x"( O PZ x ~2"F V Z   *F a Z  * F m Z ^ * *  " f   >"  (F ~ Z *"   rB"CESSCOUNT = 10; TYPE PROCESSINDEX = 1..PROCESSCOUNT; PROCESSQUEUE = ARRAY (.PROCESSINDEX.) OF QUEUE; TYPE RESOURCE = MONITOR VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q(.NEXT.ARRIVAL.)); END; PROCEDURE ENTRY RELEASE; BEGIN IF NEXT.EMPTY THEN FREE:= TRUE ELSE CONTINUE(Q(.NEXT.DEPARTURE.)); END; BEGIN FREE:= TRUE; INIT NEXT(PROCESSCOUNT) END; "############## # TASKQUEUE # ##############" CONST CALLER = 0;  6,  X "  " l  " "86DP  R\(  " 0 "t V Z6 "L t0 ", "    l: D0 " V Z6 "TYPE TASKQUEUE = MONITOR VAR WAITING: PROCESSQUEUE; PROCEDURE ENTRY PREEMPT; BEGIN DELAY(WAITING(.ATTRIBUTE(CALLER).)) END; PROCEDURE ENTRY RESUME(TASK: PROCESSINDEX); BEGIN CONTINUE(WAITING(.TASK.)) END; BEGIN END; "############ # TASKSET # ############" CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE TASKSET = MONITOR VAR TABLE: ARRAY (.PROCESSINDEX.) OF IDENTIFIER; PROCEDURE INITIALIZE; VAR TASK: PROCESSINDEX; BEGIN FOR TASK:= 1 TO PROCESSCOUNT DO TABLE(.TAS 4  " J BB0 "D      j "4 40 "2 P " t "6  0 "V   "&   "6 X L06 "P b " K.):= ' '; END; FUNCTION INDEX(ID: IDENTIFIER): PROCESSINDEX; VAR I, J: PROCESSINDEX; BEGIN I:= 1; J:= PROCESSCOUNT; WHILE I < J DO IF TABLE(.I.) = ID THEN J:= I ELSE I:= I + 1; INDEX:= I; END; PROCEDURE ENTRY INCLUDE(ID: IDENTIFIER; TASK: PROCESSINDEX); BEGIN TABLE(.TASK.):= ID END; FUNCTION ENTRY MEMBER(ID: IDENTIFIER): BOOLEAN; BEGIN MEMBER:= (TABLE(.INDEX(ID).) = ID) END; FUNCTION ENTRY TASK(ID: IDENTIFIER): PROCESSINDEX; BEGIN TASK:= INDEX(ID) END; PROCE z  "&$l H"L"r  B D  *   " L&"  ~   *  6 " *86 t" . "` >, " " B "" >" "   X IX6  ^ JB 0""   X, ?"f X2 Z ? B"( >"    " B@| 0" nNJ(.  0"  S$ X   (  ""a X0"gvX"6n"" hx "tx "   X IX6>  ^, < I>  R     FR     * P t " t "  t^4 r> rv   V  46  fx "Hx "*x " " 06  "4X"&v *X\2v<24\,$p6 TRY AGAIN# FILE(CREATE, ID, LENGTH, KIND, PROTECTED) # FILE(DELETE, ID)# FILE(PROTECT, ID, PROTECTED)# FILE(RENAME, OLDID, NEWID)# FILE(REPLACE, ID, LENo q s u w y { }  i p r t v x z | ~        !#%' "$&/13579;=?)+-02468:<>(*,.KMOQSUWACEGILNPRTV@BDFHJgikmoY[]_acehjlnXZ\^`bdfqsuwy{}5     $ & C E                          r t v x z | ~ l n p        !#%'?ACEGIKNBDFHJLQSUWY[]_acegRTVXZ\^`bdfPmoqsuwy{}iknprtvxz|~hjl     !#%' "$&579;=?)+-/1368:<>(*,.& &  `2 `2" , T""" 3""9 h(  ? &(  B D """z BL>" ^  "   BP> *  6 LG A BLOCK TRANSFER. ENDMEDIUM END OF MEDIUM REACHED DURING A BLOCK TRANSFER. H""* "" >"  "  ^. HP>"  X  X6 "X&  :" T" " " 0 Z2  x  * "F X B" P>"` j*   $  "  D88@~_8@5x  w A e@W w r   w rw |j r tPPw A4 W!e  w 6e !w &?w A w z_~P 5w " `5w `52~5@5 ߋRVA``ȋ5w *Aߋ H```ȋ w A@vߋt SYSTEM BUILD COMPLETE.  MAGTAPE ERROR.  DISK ERROR.  "  z   T < p" ~ ". ""  &  |    &  N  ""4 ( 6  | 4 3DURE ENTRY ME(VAR ID: IDENTIFIER); BEGIN ID:= TABLE(.ATTRIBUTE(CALLER).) END; BEGIN INITIALIZE END; "########## # CLOCK # ##########" CONST ONEMIN = 60.0 "SECONDS"; ONEHOUR = 3600.0 "SECONDS"; HALFDAY = 43200.0 "SECONDS"; ONEDAY = 86400.0 "SECONDS"; TYPE CLOCK = MONITOR VAR SECONDS: REAL; FUNCTION ENTRY VALUE: REAL; BEGIN VALUE:= SECONDS END; PROCEDURE ENTRY CORRECT(TIME: REAL); BEGIN SECONDS:= TIME END; PROCEDURE ENTRY TICK; BEGIN SECONDS:= SECONDS + 1.0; IF SECONDS"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 1: LEXICAL ANALYSIS MARCH 1975" (CHECK, NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; SPLITLENGTH = 4 "WORDS PER SPLIT REAL"; MAX_STRING_LENGTH = 80 "CHARS"; WORDS_PER_STRING = 40 "MAX$&RTePsvm t v x z | ~ n p r ?ACEGLNPRTVXxz|~y{}     !#%')+-/1357"$&(*,._STRING_LENGTH DIV WORDLENGTH"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPTION = 5; "***************************** CAUTION ************************************" "THE 'LARGEST_REAL' PROCEDURE IS MACHINE DEPENDANT. IT MAY HAVE TO BE CHANG&D " "IF THE COMPILER IS MOVED TO ANOTHER MACHINE . " TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTIt`, !" "#"$%F * +" ",,- >". /  P0> 0  L"1 X2 V-23 "3 \,4 45 6: ; < $=$> "?? Zf@ PX J$@AON = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; C >= ONEDAY THEN SECONDS:= SECONDS - ONEDAY; END; BEGIN SECONDS:= 0.0 END; "################ # TASKPROCESS # ################" TYPE TASKPROCESS = PROCESS (TYPEUSE: RESOURCE; WAITING: TASKQUEUE; TASKLIST: TASKSET; WATCH: CLOCK); VAR OPERATOR: TERMINAL; ID: IDENTIFIER; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; BEGIN WITH TASKLIST, OPERATOR DO BEGIN FOR I:= 1 TO (TASK(ID) - 2)*24 DO WRITE(' '); FOR I:= 1 TO IDLENGTH DO WRITE(ID(.I.)); WRITE(' '); WRITE(BEL)ONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "#######################AX_ORD=127; MAX_INTEGER=32767; INTEGER_LIMIT="(MAX_INTEGER-9) DIV 10" 3275; MAX_EXPONENT=38; TYPE SPLITREAL = ARRAY (.1..SPLITLENGTH.) OF INTEGER; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; PACKED_STRING = ARRAY (.1..WORDS_PER_STRING.) OF INTEGER; ALFA=ARRAY (.1..10.) OF CHAR; SPELLING_INDEX=INTEGER; PIECE=ARRAY(.0..ID_PIECE_LENGTH.) OF CHAR; PIECE_PTR=@ID_PIECE; ID_PIECE= RECORD PART:PIECE; NEXT:PIECE_PTR END; VAR REAL0, REAL1, REAL10, MAX_REAL, RE###################### # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "OUTPUT OPERATORS" EOM2=0; BEGIN2=1; IF2=2; CASE2=3; WHILE2=4; REPEAT2=5; FOR2=6; WITH2=7; ID2=8; REAL2=9; STRING2=10; INTEGER2=11; CHAR2=12; OPEN2=13; NOT2=14; SUB2=15; SET2=16; ARRAY2=17; RECORD2=18; ARROW2=19; PERIOD2=20; STAL_LIMIT: REAL; INTER_PASS_PTR:PASSPTR; CH:CHAR; LETTERS, DIGITS, ALFAMERICS, NON_ALFAS, STRING_SPECIAL: SET OF CHAR; TEST, UPTO_SW, BUS_SW, END_SCAN: BOOLEAN; CL1,CL2,CL3,CL4 "LINE NUMBER": CHAR; LINE_NO:INTEGER; PIECES: INTEGER; "ID LENGTH IN PIECES" TEST_BUF: ARRAY (.1..TEST_MAX.) OF INTEGER; TEST_INDEX: INTEGER; ID_TEXT: ARRAY(.0..MAX_PIECES.) OF PIECE; BLANK: PIECE "BLANK PADDING"; CHAR_INDEX:0..ID_PIECE_LENGTH "CURRENT CHAR INDEX"; SYMB: INTEGER "ID SYMBOLAR2=21; SLASH2=22; DIV2=23; MOD2=24; AND2=25; PLUS2=26; MINUS2=27; OR2=28; EQ2=29; NE2=30; LE2=31; GE2=32; LT2=33; GT2=34; IN2=35; CONST2=36; TYPE2=37; VAR2=38; PROCEDURE2=39; FUNCTION2=40; PROGRAM2=41; SEMICOLON2=42; CLOSE2=43; UP_TO2=44; OF2=45; COMMA2=46; BUS2=47; COLON2=48; END2=49; FORWARD2=5"; STRING_LENGTH:INTEGER; HASH_KEY: 0..HASH_MAX; "INDEX TO HASH_TABLE" CURRENT_INDEX "LAST ASSIGNED INDEX", INDEX "LAST SCANNED INDEX" : SPELLING_INDEX; STRING_TEXT: ARRAY (.1..MAX_STRING_LENGTH.) OF CHAR; HASH_TABLE: ARRAY (.0..HASH_MAX.) OF RECORD SPIX:SPELLING_INDEX; NAME:ID_PIECE END; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW P0; UNIV2=51; BECOMES2=52; THEN2=53; ELSE2=54; DO2=55; UNTIL2=56; TO2=57; DOWNTO2=58; LCONST2=59; MESSAGE2=60; NEW_LINE2=61; "OTHER CONSTANTS" "ERRORS" COMMENT_ERROR=1; NUMBER_ERROR=2; INSERT_ERROR=3; STRING_ERROR=4; CHAR_ERROR=5; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHR=9; ASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 1: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; ID_PIECE_LENGTH=9; "TEN CHARS PER PIECE" MAX_PIECES = 13; "FOURTEEN PIECES => 140 CHARS" TEST_MAX = 50; NULL=32767; "SYMBOL" SPAN=26; "NUMBER OF DISTINCT ID CHARS" THIS_PASS=1; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; HASH_MAX=750; "HASH TABLE UPPER BOUND" HASH_MAX1=751; "PRIME LENGTH OF HASH TABLE" MAX_INDEX=700; "MAX_LOADING=0.98 * HASH_MAX1-NO. OF RES.WDS." MIN_ORD=0; M357!#%')+-/146 &(*,.02O9;=?ACEGIKM8:<>@BDFHJLNSUWY[]_acegQTVXZ\^`bdfPRoqsuwy{}ikmprtvxz|~hjln     !#%' ; END; END; PROCEDURE WRITETIME(TIME: REAL); VAR HOUR, MIN, SEC: INTEGER; REM: REAL; BEGIN HOUR:= TRUNC(TIME/ONEHOUR); REM:= TIME - CONV(HOUR) * ONEHOUR; MIN:= TRUNC(REM/ONEMIN); SEC:= TRUNC(REM - CONV(MIN) * ONEMIN); WITH OPERATOR DO BEGIN WRITEINT(HOUR); WRITE(':'); WRITEINT(MIN); WRITE(':'); WRITEINT(SEC); WRITE(NL); END; END; BEGIN INIT OPERATOR; TASKLIST.ME(ID); CYCLE WAITING.PREEMPT; TYPEUSE.REQUEST; WRITEID(ID); WRITETIME(WATCH.VALUE); TYPEUSE.REL################# # MOVE MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: MOVES A MAGNETIC TAPE TO A GIVEN FILE. THE FILES ARE NUMBERED 1, 2, 3, ... EACH FILE IS TERMINATED BY AN END_OF_FILE MARK. CALL: MOVE(FILENO: INTEGER) ERROR MEESSAGES: INSPECT INSPECTION OF THE DEVICE REQUIRED. ERROR TRANSMISSION ERROR DURING TAPE MOVE. FAILURE DEVICE FAILURE DURING TAPE MOVE. ENDMEDIUM END OF MEDIUM REACHED DURING TAPE MOVE.  (SCRATCH, ASCII, SEQCODE, CONCODE, ALL); THE DETAEASE; END; END; "############## # TIMETABLE # ##############" TYPE TASKSCHEDULE = RECORD ACTIVE: BOOLEAN; START, PERIOD: REAL END; TYPE TIMETABLE = MONITOR(WAITING: TASKQUEUE); VAR TABLE: ARRAY (.PROCESSINDEX.) OF TASKSCHEDULE; PROCEDURE INITIALIZE; VAR TASK: PROCESSINDEX; BEGIN FOR TASK:= 1 TO PROCESSCOUNT DO TABLE(.TASK.).ACTIVE:= FALSE; END; FUNCTION REACHED(TIME, START: REAL): BOOLEAN; VAR DIFF: REAL; BEGIN DIFF:= TIME 1357!#%')+-/246 &(*,.0MO9;=?ACEGIKN8:<>@BDFHJLQSUWY[]_acegRTVXZ\^`bdfPmoqsuwy{}iknprtvxz|~hjl     !#%' "################# # READ MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES A FILE FROM MAGNETIC TAPE TO DISK AND STORES IT WITH GIVEN IDENTIFIER, KIND, AND PROTECTION ATTRIBUTES. THE TAPE MUST BE POSITIONED CORRECTLY BEFORE USING THE READ PROGRAM. CALL: READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOLEAN) USING FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE) THE FILE CAN EITHER BE AN EXISTING (UNPROTECTED) DISK FILE TO BE REPLACED BY THE TAPE FILE, OR A NON-EXISTING- START; IF ABS(DIFF) >= HALFDAY THEN REACHED:= (DIFF < 0.0) ELSE REACHED:= (DIFF >= 0.0); END; PROCEDURE ENTRY START(TASK: PROCESSINDEX; TIME: REAL); BEGIN WITH TABLE(.TASK.) DO BEGIN ACTIVE:= TRUE; START:= TIME END; END; PROCEDURE ENTRY PERIOD(TASK: PROCESSINDEX; TIME: REAL); BEGIN TABLE(.TASK.).PERIOD:= TIME END; PROCEDURE ENTRY STOP(TASK: PROCESSINDEX); BEGIN TABLE(.TASK.).ACTIVE:= FALSE END; PROCEDURE ENTRY EXAMINE(TIME: REAL); VAR TASK: PROCESSINDEX; LATE: REAL; BEGIN FOR TASK:= 1 DISK FILE TO BE CREATED AND COPIED FROM TAPE. ERROR MESSAGES: DISK FILE LOST THE FILE PROGRAM CALLED BY READ FAILED TO CREATE OR REPLACE THE DISK FILE DUE TO RUN-TIME ERRORS. D, AND PROTECTION ATTRIBUTES. THE TAPE MUST BE POSITIONED CORRECTLY BEFORE USING THE READ PROGRAM. CALL: READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOLEAN) USING FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE) THE FILE CAN EITHER BE AN EXISTING (UNPROTECTED) DISK FILE TO BE REPLACED BY THE TAPE FILE, OR A NON-EXISTINGTO PROCESSCOUNT DO WITH TABLE(.TASK.) DO IF ACTIVE THEN IF REACHED(TIME, START) THEN BEGIN WAITING.RESUME(TASK); START:= START + PERIOD; IF START >= ONEDAY THEN START:= START - ONEDAY; END; END; BEGIN INITIALIZE END; "################# # CLOCKPROCESS # #################" TYPE CLOCKPROCESS = PROCESS(WATCH: CLOCK; SCHEDULE: TIMETABLE); BEGIN WITH WATCH, SCHEDULE DO CYCLE WAIT; TICK; EXAMINE(VALUE) END; END; "#################### # OPERATORPROCESS # ### ?ACEGIKNBDFHJLQSUWY[]_acegRTVXZ\^`bdfPmoqsuwy{}iknprtvxz|~hjl     !#%' "$&579;=?)+-/1368:<>(*,.024TRY(E); UPDATE(SPIX,E,A) END; PUSH; WITH OPS(.T.) DO IF SPIX=XUNDEF THEN BEGIN CLASS:=UNDEF_CLASS; IF OUTPUT THEN PUT1(NEW_NOUN2,XUNDEF) END ELSE BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=E; DEF_SPIX:=SPIX; IF OUTPUT THEN PUT1(NEW_NOUN2,E@.NOUN) END END; PROCEDURE PUSH_OLD_NAME; VAR SPIX:SPELLING_INDEX; BEGIN PUSH; READ_IFL(SPIX); WITH OPS(.T.),SPELLING_TABLE(.SPIX.) DO IF ACCESS IN INACCESSIBLE THEN BEGIN ER(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCROR(NAME_ERROR); CLASS:=UNDEF_CLASS END ELSE BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=ENTRY; DEF_SPIX:=SPIX END END; PROCEDURE FIND_NAME(LIST:NAME_PTR; SPIX:SPELLING_INDEX; VAR E:ENTRY_PTR); VAR NAME:NAME_PTR; BEGIN E:=NIL; NAME:=LIST; WHILE NAME<>NIL DO WITH NAME@ DO IF NAME_SPIX=SPIX THEN BEGIN E:=NAME_ENTRY; NAME:=NIL END ELSE NAME:=NEXT_NAME; IF E=NIL THEN BEGIN ERROR(NAME_ERROR); E:=UENTRY END END; PSH_OLD_NAME; IF DEFINED THEN IF NOT(TOP@.KIND IN TYPES) THEN BEGIN ERROR(NAME_ERROR); OPS(.T.).CLASS:=UNDEF_CLASS END; IF OUTPUT THEN IF DEFINED THEN PUT1(OP,TOP@.NOUN) ELSE PUT1(OP,XUNDEF) END; PROCEDURE ENUM_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,GENERAL); IF DEFINED THEN BEGIN THIS_NOUN:=THIS_NOUN-1; "CONST IDS DON'T HAVE NOUNS" WITH TOP@ DO BEGIN KIND:=INDEX_CONST; CONST_TYPE:=ENUM_TYPE; ENUM_ROCEDURE CHAIN_NAME(E:ENTRY_PTR; SPIX:SPELLING_INDEX); VAR N:NAME_PTR; BEGIN NEW(N); WITH N@ DO BEGIN NAME_SPIX:=SPIX; NAME_ENTRY:=E; NEXT_NAME:=NAME_LIST; NAME_LIST:=N END END; PROCEDURE SET_ACCESS(SPIX:SPELLING_INDEX; A:NAME_ACCESS); BEGIN SPELLING_TABLE(.SPIX.).ACCESS:=A; T:=T-1 END; PROCEDURE ENTER_NAMES(LIST:NAME_PTR); VAR THIS_NAME:NAME_PTR; BEGIN THIS_NAME:=LIST; WHILE THIS_NAME<>NIL DO WITH THIS_NAME@ DO BEGIN UPDATE(NAMVAL:=ENUM_VAL+1; CONST_VAL:=ENUM_VAL END END; T:=T-1 END; PROCEDURE ENUM; VAR E:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(E); ENUM_VAL:=-1; WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=NOUN; ENUM_TYPE:=NOUN END END; PROCEDURE SUBR_DEF; VAR MIN,MAX:INTEGER; TYPE1:NOUN_INDEX; E:ENTRY_PTR; BEGIN MIN:=0; MAX:=1; TYPE1:=XUNDEF; WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN MAX:=ICONST_VAL; TYPE1:=ICONST_TYPE END ELSE ERROR(SUBR_E_SPIX,NAME_ENTRY,QUALIFIED); THIS_NAME:=NEXT_NAME END END; FUNCTION DEFINED:BOOLEAN; BEGIN DEFINED:=OPS(.T.).CLASS<>UNDEF_CLASS END; FUNCTION TOP:ENTRY_PTR; BEGIN TOP:=OPS(.T.).DEF_ENTRY END; "#####################" "CONSTANT DECLARATIONS" "#####################" PROCEDURE CONST_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,INCOMPLETE); IF DEFINED THEN THIS_NOUN:=THIS_NOUN-1 "CONST IDS DON'T POSSESS NOUNS" END; PROCEDURE CONST_DEF; BEGIN ERROR); WITH OPS(.T-1.) DO IF CLASS=ICONST_CLASS THEN BEGIN MIN:=ICONST_VAL; IF (MIN>MAX) OR (ICONST_TYPE<>TYPE1) THEN ERROR(SUBR_ERROR) END ELSE ERROR(SUBR_ERROR); T:=T-2; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=TYPE1; PUT4(SUBR_DEF2,NOUN,TYPE1,MIN,MAX) END END; PROCEDURE SET_DEF; VAR E:ENTRY_PTR; BEGIN T:=T-1; PUSH_NEW_ENTRY(E); E@.KIND:=SET_KIND; PUT1(SET_DEF2,E@.NOUN) END; PROCEDURE ARRWITH OPS(.T-1.) DO IF CLASS=DEF_CLASS THEN BEGIN WITH DEF_ENTRY@, OPS(.T.) DO IF CLASS IN CONSTANTS THEN CASE CLASS OF ICONST_CLASS: BEGIN KIND:=INDEX_CONST; CONST_TYPE:=ICONST_TYPE; CONST_VAL:=ICONST_VAL END; RCONST_CLASS: BEGIN KIND:=REAL_CONST; REAL_DISP:=RCONST_DISP END; SCONST_CLASS: BEGIN KIND:=STRING_CONST; STRING_LENAY_DEF; VAR INDEX:NOUN_INDEX; E,EL:ENTRY_PTR; BEGIN IF DEFINED THEN EL:=TOP ELSE EL:=UENTRY; T:=T-1; IF DEFINED THEN INDEX:=TOP@.NOUN ELSE INDEX:=XUNDEF; T:=T-1; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=ARRAY_KIND; INDEX_TYPE:=INDEX; EL_TYPE:=EL; PUT1(ARRAY_DEF2,NOUN) END END; PROCEDURE REC; VAR E:ENTRY_PTR; BEGIN PUT0(REC2); PUSH_NEW_ENTRY(E); PUSH_LEVEL(E) END; PROCEDURE FIELD_LIST; VAR I,NUMBER:INTEGER; TYP:ENTRY_PTR; GTH:=SCONST_LENGTH; STRING_DISP:=SCONST_DISP END END ELSE ERROR(CONSTID_ERROR); T:=T-1; SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-2 END; "#################" "TYPE DECLARATIONS" "#################" PROCEDURE TYPE_ID; VAR SPIX:SPELLING_INDEX; BEGIN READ_IFL(SPIX); WITH SPELLING_TABLE(.SPIX.) DO BEGIN IF (ACCESS<>UNDEFINED) AND (LEVEL=THIS_LEVEL) THEN BEGIN SPIX:=XUNDEF; ERROR(AMBIGUITY_ERROR) END EBEGIN READ_IFL(NUMBER); IF DEFINED THEN TYP:=TOP ELSE TYP:=UENTRY; T:=T-1; FOR I:=1 TO NUMBER DO WITH OPS(.T.) DO IF DEFINED THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=FIELD; FIELD_TYPE:=TYP END; CHAIN_NAME(DEF_ENTRY,DEF_SPIX); SET_ACCESS(DEF_SPIX,INTERNAL) END ELSE T:=T-1; PUT1(FIELDLIST2,NUMBER) END; PROCEDURE REC_DEF; VAR E:ENTRY_PTR; BEGIN WITH TOP@ DO BEGIN KIND:=RECORD_KIND; FIELD_NAME:=NLSE UPDATE(SPIX,NIL,INCOMPLETE) END; PUSH; WITH OPS(.T.) DO IF SPIX=XUNDEF THEN CLASS:=UNDEF_CLASS ELSE BEGIN CLASS:=DEF_CLASS; DEF_SPIX:=SPIX END END; PROCEDURE TYPE_DEF; BEGIN WITH OPS(.T-1.) DO IF CLASS=DEF_CLASS THEN WITH SPELLING_TABLE(.DEF_SPIX.) DO BEGIN IF DEFINED THEN ENTRY:=TOP ELSE ENTRY:=UENTRY; ACCESS:=GENERAL END; T:=T-2; PUT0(TYPE_DEF2) END; PROCEDURE TYPE_(OUTPUT:BOOLEAN; OP:INTEGER); BEGIN PUAME_LIST; PUT1(REC_DEF2,NOUN) END; POP_LEVEL END; PROCEDURE COMP_DEF(OP:INTEGER); VAR E:ENTRY_PTR; BEGIN SYSCOMP_LEVEL:=THIS_LEVEL; WITH TOP@ DO BEGIN KIND:=SYSCOMP_KIND; PUSH_NEW_ENTRY(E) "INITIAL STATEMENT"; INIT_STAT:=E; PUT2(OP,NOUN,E@.NOUN) END; WITH E@ DO BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=FIRST_PARM; ROUT_TYPE:=PROC_TYPE END; T:=T-1 END; PROCEDURE INITS_DEF; BEGIN PUT0(INITS_DEF2); TOP@.ENTRY_NAME:=NAM IF THIS_PARM=NIL THEN ERR:= YES ELSE PARM:=THIS_PARM@.NEXT_PARM END ELSE IF CLASS=PROGRAM_CLASS THEN BEGIN THIS_PARM:=PPARM; IF THIS_PARM=NIL THEN ERR:= YES ELSE PPARM:=THIS_PARM@.NEXT_PARM END ELSE ERR:=SUPPRESS; IF ERR<>NO THEN BEGIN IF ERR=YES THEN ERROR(MANY_ARGS_ERROR); PUT2(PARM2,XUNDEF,XUNDEF) END ELSE WITH THIS_PARM@ DO PUT2(PARM2,NOUN,PARM_TYPE@.NOUN); END; PROCEDURE DEF_CASE; BEGIN READ_IFL(THIS_LABEL); PUT1(DEF_LABEL2,T+79;=?DFHJLNPRTV@BEGIKMOQSU%'.02468:<>(*,/13579;=?)+-JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 HIS_LABEL) END; PROCEDURE CASE_; VAR VAL:INTEGER; BEGIN WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN PUT1(CHK_TYPE2,ICONST_TYPE); VAL:=ICONST_VAL; CLASS:=CASE_LABEL; LABEL:=THIS_LABEL; IF (VAL>=MIN_CASE) AND (VAL<=MAX_CASE) THEN INDEX:=VAL ELSE BEGIN ERROR(CASERANGE_ERROR); VAL:=0 END END ELSE BEGIN T:=T-1; ERROR(CASETYPE_ERROR) END END; PROCEDURE END_CASE; VAR L0,LN'b'nh$&  " `(  ""$  """"""&  Z<  Z L    (  "   (  "   (  "&  XRE_LIST; END; "#####################" "VARIABLE DECLARATIONS" "#####################" PROCEDURE VAR_LIST(OP:INTEGER); VAR I,NUMBER:INTEGER; TYP:ENTRY_PTR; BEGIN READ_IFL(NUMBER); PUT1(OP,NUMBER); IF DEFINED THEN TYP:=TOP ELSE TYP:=UENTRY; T:=T-1; FOR I:=1 TO NUMBER DO WITH OPS(.T.) DO IF DEFINED THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=VARIABLE; VAR_TYPE:=TYP END; IF OP=EVAR_LIST2 THEN CHAIN_NAME(DEF_ENTRY,DEF_SPIX); ,MIN,MAX,I:INTEGER; BEGIN READ_IFL(L0); READ_IFL(LN); FOR I:=MIN_CASE TO MAX_CASE DO LABELS(.I.):=LN; IF OPS(.T.).CLASS=CASE_LABEL THEN BEGIN MIN:=OPS(.T.).INDEX; MAX:=MIN; END ELSE BEGIN MIN:=0; MAX:=0 END; WHILE OPS(.T.).CLASS=CASE_LABEL DO BEGIN WITH OPS(.T.) DO BEGIN IF LABELS(.INDEX.)=LN THEN LABELS(.INDEX.):=LABEL ELSE ERROR(AMBICASE_ERROR); IF INDEX>MAX THEN MAX:=INDEX ELSE IF INDEXXUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO IF (ACCESS<>UNDEFINED) AND (LEVEL=SYSCOMP_LEVEL) THEN IF ACCESS IN ENTRY_ACCESS THEN CHAIN_NAME(ENTRY,SPIX) ELSE ERROR(INTERFACE_ERROR) ELSE BEGIN "FORWARD REFERENCE" NEW_ENTRY(INTF_ENTRY); PUT1(FWD_DEF2, INTF_ENTRY@.NOUN); CHAIN_NAME(INTF_ENTRY, SPIX); UPDATE(SPIX, INTF_ENTRY, UNRESOLVED); UNRES_COUNT:=IN IF ROUT_TYPE=PROC_TYPE THEN BEGIN ERROR(PROC_USE_ERROR); TYP:=XUNDEF END ELSE TYP:=ROUT_TYPE; PUT1(FUNCTION2, TYP); IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR); PUT0(CALL_FUNC2) END ELSE IF CLASS=FUNCVALUE_CLASS THEN ERROR(NAME_ERROR) END; PROCEDURE FUNCTION_ERROR(ERROR_NUM:INTEGER); BEGIN ERROR(ERROR_NUM); OPS(.T.).CLASS:=UNDEF_CLASS END; PROCEDURE FUNCTION_; VAR TYP: NOUN_INDEX; BEGIN TYP:= X UNRES_COUNT + 1 END END; PROCEDURE PSTART; VAR M:INTEGER; E:ENTRY_PTR; BEGIN READ_IFL(M); PUT1(PSTART2,M); IF M IN COMP_MODES THEN PUSH_NEW_ENTRY(E) ELSE IF M IN ENTRY_MODES THEN IF DEFINED THEN WITH OPS(.T.) DO CHAIN_NAME(DEF_ENTRY,DEF_SPIX); IF DEFINED THEN E:=TOP ELSE E:=UENTRY; PUSH_LEVEL(E); FIRST_PARM:=NIL END; PROCEDURE PARMLIST(OP:INTEGER); VAR I,NUMBER:INTEGER; PTYPE:ENTRY_PTR; BEGIN IF DEFINED THEN PTYPE:=TOP ELSE PTYPE:=UENTRY;  Z \$  "" "  "& " "  " XR  Z $   ""0 1  "" >"   P0>   L" X " \(  >" `  READ_IFL(NUMBER); PUT1(OP,NUMBER); FOR I:=NUMBER DOWNTO 1 DO WITH OPS(.T-I.) DO IF CLASS=DEF_CLASS THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=PARAMETER; PARM_TYPE:=PTYPE; IF FIRST_PARM=NIL THEN FIRST_PARM:=DEF_ENTRY ELSE THIS_PARM@.NEXT_PARM:=DEF_ENTRY; THIS_PARM:=DEF_ENTRY; NEXT_PARM:=NIL END; SPELLING_TABLE(.DEF_SPIX.).ACCESS:=INTERNAL END; T:=T-NUMBER-1 END; "####" "BODY" "####" PROC"= "&A" `5$ F XvC d >"$ M X2 V-   >"" U P t |" [ , t " a  t $"i  t  &q   "EDURE BODY; BEGIN BODY_LEVEL:=THIS_LEVEL; PUT0(BODY2) END; PROCEDURE ANAME; BEGIN WITH OPS(.T.) DO IF CLASS=FUNCVALUE_CLASS THEN PUT1(RESULT2,FUNC_TYPE) ELSE PUT0(ADDRESS2) END; PROCEDURE CALL_NAME; VAR INTF:NAME_PTR; ERR:BOOLEAN; BEGIN ERR:=FALSE; WITH OPS(.T.) DO BEGIN IF CLASS=PROGRAM_CLASS THEN BEGIN PUT0(INTF2); INTF:=PROG@.INTERFACE; WHILE INTF<>NIL DO WITH INTF@ DO BEGIN PUT1(INTF_ID2,NAME_ENTRY@.NOUw l d \ T L t* 4 p h ` X"     t2     " "z z" z z vX" z"$ "x.* x ,6 "  z" z x"Br" t T" tD2RR&RN); INTF:=NEXT_NAME END END ELSE IF CLASS=ROUTINE_CLASS THEN IF ROUT@.ROUT_TYPE<>PROC_TYPE THEN ERR:=TRUE ELSE "OK" ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(CALL_NAME_ERROR); CLASS:=UNDEF_CLASS END END END; PROCEDURE CALL(OP:INTEGER); BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN BEGIN IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR); PUT0(OP) END ELSE IF CLASS=PROGRAM_CLASS THEN BEGIN IF PPARRRRR&RRR RR8&bRRRRRR8&BRRR R&"B&|RRR&RRRR&RR&RRRRR&RR&RR&8&""v.Hz v" v " "  " " " M<>NIL THEN ERROR(FEW_ARGS_ERROR); PUT0(CALL_PROG2) END ELSE PUT0(OP); IF OP<>CALL_FUNC2 THEN T:=T-1 END; PROCEDURE ARG_LIST; BEGIN WITH OPS(.T.) DO IF CLASS IN PARAMETERIZED THEN "OK" ELSE BEGIN ERROR(ARG_LIST_ERROR); CLASS:=UNDEF_CLASS END END; PROCEDURE ARG; VAR THIS_PARM:ENTRY_PTR; ERR:ERROR_NOTE; BEGIN T:=T-1 "POP ARGUMENT"; ERR:=NO; WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN BEGIN THIS_PARM:=PARM; "  "    "  "*  " " "*  " "*  " " "*   " "J(    X) H * &   X  X6) * "  &  0 b "(  ^ $ ~( *   "~   X  ^2 \*   X`  X  h."     |  * `(     "  * $ ` * h(8CW`bdfhjlnprtvxz|~hsu     "$& #%'!>(*,.02468:<?)+-/13579;=BDFHJLNPRTV@CEGIKMOQSUWA^`bdf   "    "   X   "   "  X 4   X:   T" " " |T 0 .,Hph` : * X2 @   X l&"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 5: BODY SEMANTIC ANALYSIS DECEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; Nr"&)p&   " " X "  "X "J "<f "&|xtljf8  ^  ^6"   T8 bT  X2"  X "  X"  X  :  XH   "   "  "  HnJ^ H~P&Dzrj$X>PDz<4( +B *$@4f)|p8d& T6"  X X6 X6"4"&.,*(4T. $  Xp P 2T"B RT"( bT" " 0 . "*8( " L `b & A8 * G $QD XLBDh8,$~^D,D.f;>b@PFT6$bP~zLBlN,jNl xN r& ٖPASS 5: FILE_LIMIT4f)|p8d&    "      .[~ #          "$d$ r$nN,t   X    X     X @   l  "KMOQSU%'.02468:<>(*,/13579;=?)+-JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 $   (   "      "  "Z2  T    X L&  \  x(\ X "  "( "T ,f f<h&  " `(  ""$  """"""& Z<  Z L    (  "   (  "   (  "& XR   "6 " r    TD" X  r $   "     6(    T   T BT26  "  "*   XX  X, z."    Z \$  "" "  "&  "  " XR  Z $   ""0   "" >"   P0>   L" X " \(  >" `    " .   X  "jL   * J0|lH*   T0 & ^  H& & &v  " * V0.j  " "&!" `6$ & XvC d >"$ - X2 V-   >""9"<"?"Bnf^V"HB:2*"$ T V " `  $$% "+V  ".1"4  "(    ^" = "f,E   XB-       x-\,&N.. &T/X% p( _>""$ \  0 l ( V >"N"$e    V >""$p " H  | t 0 (  V >"F"$} *       | r B dN H2 &P * ( mDr B bN 2l& * ( {zr B (N  2&  * 2 X RT2 V  >""$  d V >"N""  $  B"(  02"p "$ V >" Z  "$ B"$ V >" Z  "$ B"$  X2f ( * 0^ 2T 0 2T ^&   X X$ ` * X$ , * v X X22F "@ *  "  $ X X2V >" Z  "$ B"$   BV >"4 Z  "$  B"$  V " >"*  n p " Z >" 0  p*  ~ ^ Fr " X N * $  X X2  ` * & (  X X$  * j X2F \ " *  " n b"Z ^  *  ( * 0 RTf X UMBEROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); GZ\^acegikmoY[]_jlnsuwy{}qtvxz|~prm z | ~ n p r t v x       %'!RY_VAR=2; VARIABLE=3; VAR_PARM=4; UNIV_VAR=5; CONST_PARM=6; UNIV_CONST=7; FIELD=8; EXPR=10; CONSTANT=11; SAVE_PARM=12; WITH_CONST = 13; WITH_VAR = 14; "TYPE KIND" INT_KIND=0; REAL_KIND=1; BOOL_KIND=2; CHAR_KIND=3; ENUM_KIND=4; SET_KIND=5; STRING_KIND=6; PASSIVE_KIND=7; POINTER_KIND=8; QUEUE_KIND=9; GENERIC_KIND=10; UNDEF_KIND=11; SYSCOMP_KIND=12; ROUTINE_KIND=13; ACTIVE_KIND=14; "INPUT_MODES""AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91109 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 4: DECLARATION ANALYSIS NOVEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; TWOWORDS = 4 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CLASS1_MODE=1; MONITOR1_MODE=2; PROCESS1_MODE=3; PROC1_MODE=4; PROCE1_MODE=5; FUNC1_MODE=6; FUNCE1_MODE=7; PROGRAM1_MODE=8; RECORD_MODE=9; "OUTPUT_MODES" SCONST2_MODE=11; LCONST2_MODE=0; PROC2_MODE=1; PROGRAM2_MODE=2; PE2_MODE=3; CE2_MODE=4; ME2_MODE=5; PROCESS2_MODE=6; CLASS2_MODE=7; MONITOR2_MODE=8; STD2_MODE=9; UNDEF2_MODE=10; "MISCELANEOUS" INITIAL_LEVEL=0; RESOLVE=TRUE; DONT_RESOLVE=FALSE; MAX_INT=32667; SET_MINCODEOPTION = 4; NUMBEROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOL=0; SET_MAX=127; THIS_PASS=4; STACK_MAX=100; NOUN_MAX=700; MAX_LEVEL=15; INITIALBLOCK=1; BYTELENGTH = 1; TEXT_LENGTH = 18; INFILE = 2; OUTFILE = 1; TYPE INPUT_MODE=CLASS1_MODE..RECORD_MODE; OUTPUT_MODE= LCONST2_MODE..SCONST2_MODE; DISPLACEMENT=INTEGER; STACK_INDEX=0..STACK_MAX; NOUN_INDEX=0..NOUN_MAX; LEGACY_TYPE=(CLASS_LEGACY,MONITOR_LEGACY,PROCESS_LEGACY,QUEUE_LEGACY); LEGACYS=SET OF LEGACY_TYPE; TYPE_KIND=INT_KIND..ACTIVE_KIND; TYPE_KINDS=SEEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTIT OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; PACKED_SET=0..15; ENTRY_CLASS=(UNDEFINED,VALUE,ROUTINE,TEMPLATE); ENTRY_PTR=@ENTRY; ENTRY= RECORD CASE CLASS:ENTRY_CLASS OF VALUE:( VMODE:OUTPUT_MODE; VDISP:DISPLACEMENT; CONTEXT:CONTEXT_KIND); ROUTINE:( RMODE:OUTPUT_MODE; RDISP:DISPLACEMENT; PARM_SIZE,VAR_SIZE,STACK_SIZE:DISPLACEMENT); T INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILON FILE_LENGTH(F:FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; TYPE_DEF1=2; NEW_NOUN1=3; VAR_LIST1=4; EVAR_LIST1=5; INITS_DEF1=6; PROC_DEF1=7; PROCE_DEF1=8; FUNC_DEF1=9; FUNCE_DEF1=10; PROG_DEF1=11; TYPEE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; BODY1=2; BODY_END1=3; ADDRESS1=4; RESULT1=5; STORE1=6; CALL_PROC1=7; CONSTPARM1=8; VARPARM1=9; FALSEJUMP1=10; DEF_LABEL1=11; JUMP_DEF1=12; CASE_JUMP1=1=12; ENUM_DEF1=13; SUBR_DEF1=14; SET_DEF1=15; INTF1=16; ARRAY_DEF1=17; REC1=18; FIELDLIST1=19; REC_DEF1=20; CLASS1=21; MONITOR1=22; PROCESS1=23; STACK1=24; PSTART1=25; PARM_TYPE1=26; UNIV_TYPE1=27; CPARMLIST1=28; VPARMLIST1=29; BODY1=30; BODY_END1=31; ADDRESS1=32; RESULT1=33; STORE1=34; CALL_PROC1=35; CALL_PROG1=36; INTF_ID1=37; PARM1=38; FALSEJUMP1=39; DEF_LABEL1=40; J13; JUMP1=14; CASE_LIST1=15; FOR_STORE1=16; FOR_LIM1=17; FOR_UP1=18; FOR_DOWN1=19; WITH1=20; INIT1=21; PROG_CALL1=22; INTF_LBL1=23; VALUE1=24; LT1=25; EQ1=26; GT1=27; LE1=28; NE1=29; GE1=30; IN1=31; UPLUS1=32; UMINUS1=33; PLUS1=34; MINUS1=35; OR1=36; STAR1=37; SLASH1=38; DIV1=39; MOD1=40; AND1=41; EMPTY_SET1=42; UMP_DEF1=41; FUNCF_DEF1=42; JUMP1=43; CASE_LIST1=44; FOR_STORE1=45; FOR_LIM1=46; FOR_UP1=47; FOR_DOWN1=48; WITH_VAR1=49; WITH_TEMP1=50; WITH1=51; INIT1=52; VALUE1=53; LT1=54; EQ1=55; GT1=56; LE1=57; NE1=58; GE1=59; IN1=60; UPLUS1=61; UMINUS1=62; PLUS1=63; MINUS1=64; OR1=65; STAR1=66; SLASH1=67; DIV1=68; MOD1=69; AND1=7 INCLUDE1=43; FUNCTION1=44; CALL_FUNC1=45; ROUTINE1=46; VAR1=47; ARROW1=48; VCOMP1=49; RCOMP1=50; SUB1=51; LCONST1=52; MESSAGE1=53; NEW_LINE1=54; CHK_TYPE1=55; SAVEPARM1=56; CALL_GEN1=57; NOT1=58; UNDEF1=59; RANGE1=60; "OUTPUT OPERATORS" PUSHCONST2=0; PUSHVAR2=1; PUSHIND2=2; PUSHADDR2=3; FIELD2=4; INDEX2=5; POINTER2=6; VARIANT2=7; RANGE2=8; ASSIGN2=9;0; NOT1=71; EMPTY_SET1=72; INCLUDE1=73; FUNCTION1=74; CALL_FUNC1=75; ROUTINE1=76; VAR1=77; ARROW1=78; VCOMP1=79; RCOMP1=80; SUB1=81; INDEX1=82; REAL1=83; STRING1=84; LCONST1=85; MESSAGE1=86; NEW_LINE1=87; FWD_DEF1=88; CHK_TYPE1=89; PROCF_DEF1=90; UNDEF1=91; PEND1=92; CASE_JUMP1=93; "OUTPUT OPERATORS" EOM2=1; BODY2=2; BODY_END2=3; ADDRESS2=4; RE ASSIGNTAG2=10; COPY2=11; NEW2=12; NOT2=13; AND2=14; OR2=15; NEG2=16; ADD2=17; SUB2=18; MUL2=19; DIV2=20; MOD2=21; "NOT USED" "NOT USED" FUNCTION2=24; BUILDSET2=25; COMPARE2=26; COMPSTRCT2=27; FUNCVALUE2=28; DEFLABEL2=29; JUMP2=30; FALSEJUMP2=31; CASEJUMP2=32; INITVAR2=33; CALL2=34; ENTER2=35; RETURN2=36; POP2=37; NEWLINE2=3SULT2=5; STORE2=6; CALL_PROC2=7; CONSTPARM2=8; VARPARM2=9; FALSEJUMP2=10; DEF_LABEL2=11; JUMP_DEF2=12; CASE_JUMP2=13; JUMP2=14; CASE_LIST2=15; FOR_STORE2=16; FOR_LIM2=17; FOR_UP2=18; FOR_DOWN2=19; WITH2=20; INIT2=21; CALL_PROG2=22; INTF_LBL2=23; VALUE2=24; LT2=25; EQ2=26; GT2=27; LE2=28; NE2=29; GE2=30; IN2=31; UPLUS2=32; UMINUS2=33; EMPLATE:( NOUN:NOUN_INDEX; SIZE:DISPLACEMENT; INHERITANCE:PACKED_SET; CASE KIND:TYPE_KIND OF INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND:( MIN,MAX:INTEGER); SYSCOMP_KIND:(SMODE:OUTPUT_MODE; OFFSET:DISPLACEMENT)) END; DISPLAY_INDEX=0..MAX_LEVEL; DISPLAY_REC= RECORD LAST_MODE: OUTPUT_MODE; LAST_ADDRESS:DISPLACEMENT; LAST_INHERITANCE:PACKED_SET END; UNIV_SET = ARRAY (.1..8.) OF INTEGER; VAR SY,PARM_NUM PLUS2=34; MINUS2=35; OR2=36; STAR2=37; SLASH2=38; DIV2=39; MOD2=40; AND2=41; EMPTY_SET2=42; INCLUDE2=43; FUNCTION2=44; CALL_FUNC2=45; ROUTINE2=46; VAR2=47; ARROW2=48; VCOMP2=49; RCOMP2=50; SUB2=51; LCONST2=52; MESSAGE2=53; NEW_LINE2=54; CHK_TYPE2=55; SAVEPARM2=56; CALL_GEN2=57; NOT2=58; UNDEF2=59; RANGE2=60; "STANDARD SPELLING/NOUN INDICES" XUNBER:INTEGER; INTER_PASS_PTR: PASSPTR; WITH_CONTEXT:CONTEXT_KIND; PACKED_CLASS,PACKED_MONITOR,PACKED_PROCESS,PACKED_QUEUE: PACKED_SET; N:NOUN_INDEX; DEBUG,DONE,UNIVERSAL,SAVE_CONTEXT,GENERIC_FUNCTION,INITIAL_ENTRY: BOOLEAN; NOUN_TABLE:ARRAY (.NOUN_INDEX.) OF ENTRY_PTR; STACK:ARRAY (.STACK_INDEX.) OF ENTRY_PTR; THIS_LEVEL: INTEGER; DISPLAY: ARRAY (.DISPLAY_INDEX.) OF DISPLAY_REC; INTF_LENGTH,CURRENT_DISP,CURRENT_LABEL, COMPVAR_LENGTH: DISPLACEMENT; CHK_MODE:INPUT_MODE; MODEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9 ; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=16; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; XWAIT=23; XREAL=24; "STANDARD NOUN INDICES" ZARITHMETIC=25; ZINDEX=26; ZPASSIVE=27; ZVPADE: OUTPUT_MODE; T: INTEGER; PASS_BY_REFERENCE, ASSIGNABLE: CONTEXTS; RECORD_INHERITANCE: LEGACYS; UENTRY,NEW_ENTRY,OLD_ENTRY,UTYPE: ENTRY_PTR; SMALLS,ACTIVES,PASSIVES,FUNC_TYPES,INDEXS,LARGES: TYPE_KINDS; NONVARPARMS: SET OF INPUT_MODE; NONCOMPS: SET OF OUTPUT_MODE; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT"RM=28; ZCPARM=29; ZSPARM=30; ZWITH=31; "ERRORS" NESTING_ERROR=1; ADDRESS_ERROR=2; ACTIVE_ERROR=3; QUEUE_ERROR=4; PROCESS_ERROR=5; ENTRY_ERROR=6; FUNCTYPE_ERROR=7; TYPEID_ERROR=8; ENUM1_ERROR=9; ENUM2_ERROR=10; INDEX_ERROR=11; MEMBER_ERROR=12; STACK_ERROR=13; PARM1_ERROR=14; PARM2_ERROR=15; PARM3_ERROR=16; PARM4_ERROR=17; PARM5_ERROR=18; PARM6_ERROR=19; PARM7_ERROR=20; COMPILER_ERROR=21; STRING_ERROR=22; "CONTEXT" FUNC_RESULT=1; ENTRY); WITH ENUM_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=WORDLENGTH; INHERITANCE:=0; KIND:=ENUM_KIND; MIN:=0; READ_IFL(MAX); IF MAX>SET_MAX THEN ERROR(ENUM2_ERROR) END; IF MODE=UNDEF2_MODE THEN ERROR(ENUM1_ERROR) END; PROCEDURE SUBR_DEF; VAR SUBR_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(SUBR_ENTRY); WITH SUBR_ENTRY@ DO BEGIN CLASS:=TEMPLATE; READ_IFL(NOUN); SIZE:=WORDLENGTH; INHERITANCE:=0; IF NOUN=XUNDEF THEN KIND:=ENUM_KIND UTYPE); WITH UTYPE@ DO BEGIN CLASS:=TEMPLATE; NOUN:=XUNDEF; SIZE:=1; INHERITANCE:=0; KIND:=UNDEF_KIND END; INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); PASS_BY_REFERENCE:=(.VAR_PARM,UNIV_VAR.); LARGES:=(.STRING_KIND,PASSIVE_KIND,ACTIVE_KIND,SYSCOMP_KIND.); TEMP_LEGACY:= (.CLASS_LEGACY.); PACK(PACKED_CLASS, TEMP_LEGACY); TEMP_LEGACY:= (.MONITOR_LEGACY.); PACK(PACKED_MONITOR, TEMP_LEGACY); TEMP_LEGACY:= (.PROCESS_LEGACY.); PACK(PACKED_PROCES ELSE KIND:=NOUN_TABLE(.NOUN.)@.KIND; READ_IFL(MIN); READ_IFL(MAX) END END; PROCEDURE MEMBER_CHECK; BEGIN WITH STACK(.T.)@ DO IF KIND IN INDEXS THEN IF (MINSET_MAX) THEN ERROR(MEMBER_ERROR) ELSE "OK" ELSE ERROR(MEMBER_ERROR) END; PROCEDURE SET_DEF; VAR SET_NOUN:NOUN_INDEX; SET_ENTRY:ENTRY_PTR; BEGIN MEMBER_CHECK; SET_NOUN:=STACK(.T.)@.NOUN; T:=T-1 "POP MEMBER TYPE"; PUSH_NEW_ENTRY(SET_ENTRY); WITH SET_ENTRY@ PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 4: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PAS, TEMP_LEGACY); TEMP_LEGACY:= (.QUEUE_LEGACY.); PACK(PACKED_QUEUE, TEMP_LEGACY); SMALLS:=(.INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND, QUEUE_KIND.); ACTIVES:=(.QUEUE_KIND,SYSCOMP_KIND,ACTIVE_KIND.); FUNC_TYPES:= (.INT_KIND, CHAR_KIND, BOOL_KIND, ENUM_KIND, REAL_KIND.); NONVARPARMS:=(.CLASS1_MODE,MONITOR1_MODE,PROCESS1_MODE,FUNC1_MODE, FUNCE1_MODE.); NEW(UENTRY); UENTRY@.CLASS:=UNDEFINED; NOUN_TABLE(.XUNDEF.):=UENTRY; STD_INDEX(XINTEGER,INT_KISSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_ND,-32767,32767); STD_NONINDEX(XREAL,REAL_KIND,REALLENGTH,0); STD_INDEX(XBOOLEAN,BOOL_KIND,0,1); STD_INDEX(XCHAR,CHAR_KIND,0,127); STD_NONINDEX(XQUEUE,QUEUE_KIND,WORDLENGTH,PACKED_QUEUE); STD_NONINDEX(ZWITH,POINTER_KIND,WORDLENGTH,0); STD_NONINDEX(ZARITHMETIC,GENERIC_KIND,0,0); STD_NONINDEX(ZPASSIVE,GENERIC_KIND,0,0); STD_NONINDEX(ZINDEX,GENERIC_KIND,0,0); STD_PARM(ZVPARM,VAR_PARM); STD_PARM(ZCPARM,CONST_PARM); STD_PARM(ZSPARM,SAVE_PARM); STD_ROUTINE( XTRUNC,0IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG:INTEGER); VAR T:ARRAY (.1); STD_ROUTINE( XABS,1); STD_ROUTINE( XSUCC,2); STD_ROUTINE( XPRED,3); STD_ROUTINE( XCONV,4); STD_ROUTINE( XEMPTY,5); STD_ROUTINE( XATTRIBUTE,6); STD_ROUTINE( XREALTIME,7); STD_ROUTINE( XORD,8); STD_ROUTINE( XCHR,9); STD_ROUTINE( XDELAY,0); STD_ROUTINE( XCONTINUE,1); STD_ROUTINE( XIO,2); STD_ROUTINE( XSTART,3); STD_ROUTINE( XSTOP,4); STD_ROUTINE( XSETHEAP,5); STD_ROUTINE( XWAIT,6); END; "######" "ERRORS" "######" PROCEDURE ERROR(NUMBER:IN..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER; BEGIN REM:=ARG; DIGIT:=0; REPEAT DIGIT:=DIGIT+1; T(.DIGIT.):=CHR(ABS(REM MOD 10) + ORD('0')); REM:=REM DIV 10; UNTIL REM=0; FOR I:=DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:=DIGIT+1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:=0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('4'); PRINTEOL END; PROCEDURE PRINTOP(OP:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; WRITEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER) END; PROCEDURE EOM; BEGIN WITH INTER_PASS_PTR@ DO BEGIN RELEASE(RESETPOINT); BLOCKS:=CURRENT_LABEL; END; PUT1(EOM2,COMPVAR_LENGTH "INITIAL PROCESS VAR SIZE"); DONE:=TRUE END; PROCEDURE ABORT; BEGIN PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR); EOM END; "######" "IGNORE" "######" PROCEDURE CASE_LIST; VAR I,ARG,MIN,MAX:INTEGER; BEGIN READ_IFL(ARG); READ_IFL(MIN); READ_IFL(MAX); PUT3(CASE_LIST2,ARTE('C'); PRINTABS(OP); PRINTED:=PRINTED+1; END; PROCEDURE PRINTARG(ARG:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; IF ARG<0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:=PRINTED+1; END; PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF DEBUG THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF DEBUG THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG1:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); IF DEBUG THEN G,MIN,MAX); FOR I:=MIN TO MAX+1 DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG1:INTEGER; BEGIN READ_IFL(ARG1); PUT1(OP,ARG1) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARGBEGIN PRINTOP(OP); PRINTARG(ARG1) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3) END END; PROCEDURE PUT3_ARG(ARG1,ARG2,ARG3:1,ARG2) END; "#############" "NOUN HANDLING" "#############" PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN READ_IFL(N); NEW(E); IF N<>XUNDEF THEN NOUN_TABLE(.N.):=E; IF T>=STACK_MAX THEN ABORT ELSE T:=T+1; STACK(.T.):=E END; PROCEDURE PUSH_OLD_ENTRY(VAR E:ENTRY_PTR); BEGIN READ_IFL(N); E:=NOUN_TABLE(.N.); IF T>=STACK_MAX THEN ABORT ELSE T:=T+1; STACK(.T.):=E END; "#######" "NESTING" "#######" PROCEDURE PUSH_LEVEL(M:INPUT_MODE); BEGIN IF THIS_LEVEL>=MINTEGER); BEGIN WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF DEBUG THEN BEGIN PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3) END END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4) END; PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4); PUT_ARG(ARG5) END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF" "#######" "PACKING" "#######" PROCAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1; WITH DISPLAY(.THIS_LEVEL.) DO BEGIN LAST_MODE:=MODE; PACK(LAST_INHERITANCE,RECORD_INHERITANCE); LAST_ADDRESS:=CURRENT_DISP; CURRENT_DISP:=0; IF MODE IN NONCOMPS THEN IF M<>RECORD_MODE THEN BEGIN ERROR(NESTING_ERROR); MODE:=CLASS2_MODE END; CASE M OF CLASS1_MODE: MODE:=CLASS2_MODE; MONITOR1_MODE: MODE:=MONITOR2_MODE; PROCESS1_MODE: MODE:=PROCESS2_MODE; PROC1_MODE,FUNCEDURE PACK (VAR PACKED_SET: INTEGER; UNPACKED_SET: UNIV UNIV_SET); BEGIN PACKED_SET:= UNPACKED_SET(.1.) END; PROCEDURE UNPACK (PACKED_SET: INTEGER; VAR UNPACKED_SET: UNIV UNIV_SET); BEGIN UNPACKED_SET(.1.):= PACKED_SET END; "##########" "INITIALIZE" "##########" PROCEDURE STD_INDEX(N:NOUN_INDEX; K:TYPE_KIND; L,U:INTEGER); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=WORDLENGTH; INHERITANCE:=0; KIN1_MODE: MODE:=PROC2_MODE; PROCE1_MODE,FUNCE1_MODE: CASE MODE OF CLASS2_MODE: MODE:=CE2_MODE; MONITOR2_MODE: MODE:=ME2_MODE; PROCESS2_MODE: MODE:=PE2_MODE END; PROGRAM1_MODE: MODE:=PROGRAM2_MODE; RECORD_MODE: BEGIN RECORD_INHERITANCE:=(..); MODE:=UNDEF2_MODE END END END END; PROCEDURE POP_LEVEL; BEGIN WITH DISPLAY(.THIS_LEVEL.) DO BEGIN MODE:=LAST_MODE; UNPACK(LAST_INHED:=K; MIN:=L; MAX:=U END END; PROCEDURE STD_PARM(N:NOUN_INDEX; C:CONTEXT_KIND); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=VALUE; VMODE:=UNDEF2_MODE; VDISP:= 0; CONTEXT:=C END END; PROCEDURE STD_ROUTINE(N:NOUN_INDEX; NO:INTEGER); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:= ROUTINE; RMODE:= STD2_MODE; RDISP:= NO; PARM_SIZE:= 0; VAR_SIZE:= 0; END END; PROCEDURE STD_NRITANCE,RECORD_INHERITANCE); CURRENT_DISP:=LAST_ADDRESS END; THIS_LEVEL:=THIS_LEVEL-1 END; "###################" "ADDRESS COMPUTATION" "###################" FUNCTION ADD(A,B:INTEGER):INTEGER; BEGIN "ASSERT (A>=0) AND (B>=0);" IF MAX_INT-A>=B THEN ADD:=A+B ELSE BEGIN ERROR(ADDRESS_ERROR); ADD:=A END END; FUNCTION MULTIPLY(A,B:INTEGER):INTEGER; BEGIN "ASSERT (A>=0) AND (B>=0);" IF A<=MAX_INT DIV B THEN MULTIPLY:=A*B ELSE BEGIN MULTIPLY:=ONINDEX(N:NOUN_INDEX; K:TYPE_KIND; S:DISPLACEMENT; I:PACKED_SET); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=S; INHERITANCE:=I; KIND:=K END END; PROCEDURE INITIALIZE; VAR I:INTEGER; TEMP_LEGACY: LEGACYS; BEGIN INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; GENERIC_FUNCTION:=FALSE; CURRENT_DISP:=0; T:=-1A; ERROR(ADDRESS_ERROR) END END; FUNCTION SUBTRACT(A,B:INTEGER):INTEGER; BEGIN "ASSERT A>=B;" IF (A>=0) AND (B>=0) THEN SUBTRACT:=A-B ELSE IF (A<0) AND (B<0) THEN SUBTRACT:=A-B ELSE SUBTRACT:=ADD(A,-B) END; "#################" "TYPE DECLARATIONS" "#################" PROCEDURE TYPE_; VAR TYP:ENTRY_PTR; BEGIN PUSH_OLD_ENTRY(TYP); IF TYP=UENTRY THEN STACK(.T.):=UTYPE; END; PROCEDURE ENUM_DEF; VAR ENUM_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(ENUM_ENT; DONE:=FALSE; THIS_LEVEL:=-1; MODE:=PROCESS2_MODE; INITIAL_ENTRY:=FALSE; SAVE_CONTEXT:=FALSE; COMPVAR_LENGTH:=0; PASSIVES:=(.INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND,SET_KIND, STRING_KIND,PASSIVE_KIND,UNDEF_KIND.); ASSIGNABLE:= (.FUNC_RESULT, VARIABLE, VAR_PARM, UNIV_VAR, WITH_VAR.); NONCOMPS:= (.PROC2_MODE, CE2_MODE, ME2_MODE, PE2_MODE, PROGRAM2_MODE, UNDEF2_MODE.); CURRENT_LABEL:=0;"THIS AUTOMATICALLY ASSIGNS LABEL 1 TO THE INITIAL PROCESS" NEW(H_CONTEXT IN ASSIGNABLE THEN CONTEXT:= WITH_VAR ELSE CONTEXT:= WITH_CONST END; T:=T-1; PUT0(ADDRESS2) END; PROCEDURE WITH_; BEGIN CURRENT_DISP:=CURRENT_DISP-WORDLENGTH; PUT0(WITH2) END; "################" "VALUE OR ROUTINE" "################" PROCEDURE FUNCTION_; BEGIN PUT0(FUNCTION2); PUT_TYPE END; PROCEDURE CALL_FUNC; BEGIN IF GENERIC_FUNCTION THEN BEGIN PUT0(CALL_GEN2); GENERIC_FUNCTION:= FALSE END ELSE PUT0(CALL_FUNC2) EODE=PROCESS2_MODE THEN BEGIN SIZE:=WORDLENGTH "CENTER"; OFFSET:=0 END ELSE BEGIN SIZE:=CURRENT_DISP "VAR SIZE" + STACK(.T.)@.PARM_SIZE + WORDLENGTH "CENTER"; OFFSET:=CURRENT_DISP "VAR SIZE" END; END; PROCEDURE PROG_DEF; BEGIN ROUTINE_DEF(DONT_RESOLVE); POP_LEVEL; T:=T-1 END; PROCEDURE FWD_DEF; VAR ROUTINE_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(ROUTINE_ENTRY); WITH ROUTINE_ENTRY@ DO BEGIN CLASS:=ROUTINE; CURRENT_LABEND; PROCEDURE INDEX; VAR VALUE:INTEGER; BEGIN READ_IFL(VALUE); PUT3(VAR2,SCONST2_MODE,VALUE,CONSTANT); PUT_TYPE END; PROCEDURE REAL_; VAR DISP:DISPLACEMENT; BEGIN READ_IFL(DISP); PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT); PUT3_ARG(REAL_KIND,XREAL,REALLENGTH) END; PROCEDURE STRING; VAR LENGTH:INTEGER; DISP:DISPLACEMENT; BEGIN READ_IFL(LENGTH); READ_IFL(DISP); PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT); PUT3_ARG(STRING_KIND,LENGTH,LENGTH) END; PROCEL:=CURRENT_LABEL+1; RDISP:=CURRENT_LABEL END; T:=T-1 END; PROCEDURE PSTART; BEGIN READ_IFL(CHK_MODE); PUSH_LEVEL(CHK_MODE); PARM_NUMBER:=0 END; PROCEDURE PEND; VAR VSIZE:DISPLACEMENT; I:INTEGER; BEGIN CURRENT_DISP:=WORDLENGTH; "LEAVE A WORD FOR LINE NUMBER" FOR I:=0 TO PARM_NUMBER-1 DO "ASSIGN ADDRESSES IN REVERSE ORDER" WITH STACK(.T-I.)@ DO BEGIN VSIZE:=VDISP; VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,VSIZE); VMODE:=MODE DURE RCOMP(OP:INTEGER); VAR N:NOUN_INDEX; BEGIN READ_IFL(N); WITH NOUN_TABLE(.N.)@ DO IF CLASS=ROUTINE THEN PUT5(OP,RMODE,RDISP,PARM_SIZE,VAR_SIZE,STACK_SIZE) ELSE PUT0(UNDEF2) END; PROCEDURE VCOMP(OP:INTEGER); VAR N:NOUN_INDEX; BEGIN READ_IFL(N); WITH NOUN_TABLE(.N.)@ DO BEGIN PUT3(OP,VMODE,VDISP,CONTEXT); PUT_TYPE; IF SAVE_CONTEXT THEN BEGIN WITH_CONTEXT:=CONTEXT; SAVE_CONTEXT:=FALSE END END END; PROCEDURE ARROW; BEGIN END; CURRENT_DISP:=CURRENT_DISP-WORDLENGTH "CENTER"; T:=T-PARM_NUMBER "POP PARMS"; END; PROCEDURE PARM_CHECK; VAR INHERIT:LEGACYS; BEGIN WITH STACK(.T.)@ DO "APPLY CHECKS" CASE CHK_MODE OF MONITOR1_MODE,PROCESS1_MODE,CLASS1_MODE: IF NOT(KIND IN SMALLS) THEN IF KIND=SYSCOMP_KIND THEN IF SMODE=MONITOR2_MODE THEN "OK" ELSE IF (SMODE=CLASS2_MODE) AND (CHK_MODE=CLASS1_MODE) THEN "OK" ELSE ERROR( PUT0(ARROW2); PUT_TYPE END; PROCEDURE SUB; VAR N:NOUN_INDEX; INDEX,ELEMENT:ENTRY_PTR; LENGTH:DISPLACEMENT; BEGIN "INDEX" TYPE_; INDEX:=STACK(.T.); T:=T-1; "ELEMENT" TYPE_; ELEMENT:=STACK(.T.); T:=T-1; WITH ELEMENT@ DO IF KIND=CHAR_KIND THEN LENGTH:=BYTELENGTH ELSE LENGTH:=SIZE; WITH INDEX@ DO BEGIN IF KIND IN INDEXS THEN PUT3(SUB2,MIN,MAX,LENGTH) ELSE PUT3(SUB2,0,0,1); PUT3_ARG(KIND,NOUN,SIZE) END; WITH ELEMENT@ DO BEGIN IF KIND=SYSCOMP_KIND TH DO BEGIN CLASS:=TEMPLATE; NOUN:=SET_NOUN; SIZE:=SETLENGTH; INHERITANCE:=0; KIND:=SET_KIND END END; PROCEDURE ARRAY_DEF; VAR SPAN,ARRAY_SIZE:DISPLACEMENT; ARRAY_KIND:TYPE_KIND; ARRAY_INHERITANCE:PACKED_SET; ARRAY_ENTRY:ENTRY_PTR; BEGIN WITH STACK(.T-1.)@ DO IF KIND IN INDEXS THEN SPAN:=ADD(SUBTRACT(MAX,MIN),1) ELSE BEGIN SPAN:=1; ERROR(INDEX_ERROR) END; WITH STACK(.T.)@ DO BEGIN IF KIND=CHAR_KIND THEN BEGIN IF SPAN MOD PARM1_ERROR) ELSE ERROR(PARM2_ERROR); PROC1_MODE,FUNC1_MODE: ; PROCE1_MODE,FUNCE1_MODE: BEGIN UNPACK(INHERITANCE,INHERIT); IF QUEUE_LEGACY IN INHERIT THEN ERROR(PARM4_ERROR) END; PROGRAM1_MODE: IF KIND IN ACTIVES THEN ERROR(PARM5_ERROR) END END; PROCEDURE PARM_TYPE; BEGIN TYPE_; PARM_CHECK END; PROCEDURE UNIV_TYPE; BEGIN TYPE_; IF STACK(.T.)@.KIND IN ACTIVES THEN ERROR(PARM6_ERROR); UNIVERSAL:=TWORDLENGTH <>0 THEN BEGIN ERROR(STRING_ERROR); SPAN:=WORDLENGTH END; ARRAY_KIND:=STRING_KIND; ARRAY_SIZE:=SPAN END ELSE BEGIN IF KIND IN PASSIVES THEN ARRAY_KIND:=PASSIVE_KIND ELSE ARRAY_KIND:=ACTIVE_KIND; ARRAY_SIZE:=MULTIPLY(SPAN,SIZE) END; ARRAY_INHERITANCE:=INHERITANCE END; T:=T-2 "POP INDEX AND ELEMENT TYPES"; PUSH_NEW_ENTRY(ARRAY_ENTRY); WITH ARRAY_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N;RUE; PARM_CHECK END; PROCEDURE PARMLIST(C:CONTEXT_KIND); VAR I,NUMBER:INTEGER; THIS_SIZE:DISPLACEMENT; BEGIN READ_IFL(NUMBER); PARM_NUMBER:=PARM_NUMBER+NUMBER; WITH STACK(.T.)@ DO IF (C IN PASS_BY_REFERENCE) OR (KIND IN LARGES) THEN THIS_SIZE:=WORDLENGTH ELSE THIS_SIZE:=SIZE; FOR I:=1 TO NUMBER DO WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VDISP:=THIS_SIZE; CONTEXT:=C END; T:=T-1 "POP TYPE" END; PROCEDURE CPARM_LIST; VAR C:CONTEXT_ SIZE:=ARRAY_SIZE; INHERITANCE:=ARRAY_INHERITANCE; KIND:=ARRAY_KIND END END; PROCEDURE FIELDLIST; VAR THIS_SIZE:DISPLACEMENT; INHERITED:LEGACYS; NUMBER,I:INTEGER; BEGIN WITH STACK(.T.)@ DO BEGIN UNPACK(INHERITANCE,INHERITED); RECORD_INHERITANCE:=RECORD_INHERITANCE OR INHERITED; THIS_SIZE:=SIZE END; READ_IFL(NUMBER); FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION" WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VMODE:=MODE; KIND; BEGIN IF UNIVERSAL THEN BEGIN C:=UNIV_CONST; UNIVERSAL:=FALSE END ELSE C:=CONST_PARM; PARMLIST(C) END; PROCEDURE VPARMLIST; VAR C:CONTEXT_KIND; BEGIN IF CHK_MODE IN NONVARPARMS THEN ERROR(PARM7_ERROR); IF UNIVERSAL THEN BEGIN C:=UNIV_VAR; UNIVERSAL:=FALSE END ELSE C:=VAR_PARM; PARMLIST(C) END; "####" "BODY" "####" PROCEDURE BODY; BEGIN WITH STACK(.T.)@ DO BEGIN VAR_SIZE:=CURRENT_DISP; IF INITIAL_ENTRY THEN BEGIN INITIACONTEXT:=FIELD; VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE) END; T:=T-NUMBER-1 "POP DECLARATION LIST" END; PROCEDURE REC_DEF; VAR REC_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(REC_ENTRY); WITH REC_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=CURRENT_DISP; PACK(INHERITANCE,RECORD_INHERITANCE); IF INHERITANCE=0 THEN KIND:=PASSIVE_KIND ELSE KIND:=ACTIVE_KIND; END; POP_LEVEL END; PROCEDURE ROUTINE_DEF (RESOLVE: BOOLEL_ENTRY:=FALSE; COMPVAR_LENGTH:=CURRENT_DISP "SAVE LENGTH OF COMPONENT VARIABLES"; CURRENT_DISP:=0 "INITIAL STATEMENT IS VARIABLE-LESS"; PUT5(BODY2,RMODE,RDISP,0,0,STACK_SIZE) END ELSE PUT5(BODY2,RMODE,RDISP,PARM_SIZE,VAR_SIZE,STACK_SIZE) END END; PROCEDURE BODY_END; BEGIN PUT0(BODY_END2); T:=T-1; POP_LEVEL END; "##########" "STATEMENTS" "##########" PROCEDURE PUT_TYPE; VAR N:NOUN_INDEX; LENGTH:DISPLACEMENT; BEGIN READ_IFL(N); WIAN); FORWARD; PROCEDURE COMP_DEF(LEGACY:PACKED_SET); VAR COMP_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(COMP_ENTRY); WITH COMP_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; INHERITANCE:=LEGACY; KIND:=SYSCOMP_KIND; SMODE:=MODE; END; ROUTINE_DEF(DONT_RESOLVE) "INITIAL STATEMENT" END; PROCEDURE STACK_; BEGIN IF STACK(.T-1.)@.SMODE<>PROCESS2_MODE THEN ERROR(STACK_ERROR); READ_IFL(STACK(.T.)@.STACK_SIZE) END; "#####################" "VARIABLE DECLARATIONSTH NOUN_TABLE(.N.)@ DO IF CLASS=TEMPLATE THEN BEGIN IF KIND=SYSCOMP_KIND THEN LENGTH:=OFFSET ELSE LENGTH:=SIZE; PUT3_ARG(KIND,NOUN,LENGTH) END ELSE PUT3_ARG(UNDEF_KIND,XUNDEF,1) END; PROCEDURE RESULT; VAR SHIFT: DISPLACEMENT; BEGIN WITH STACK(.T.)@ DO BEGIN IF (RMODE = PROC2_MODE) OR (RMODE = PE2_MODE) THEN SHIFT:= WORDLENGTH "CENTER LOCATION" ELSE SHIFT:= TWOWORDS "CENTER LOCATION AND COMPONENT ADDRESS"; PUT1(RESULT2, PARM_SIZE + SHIFT) " "#####################" PROCEDURE VAR_LIST; VAR NUMBER,I:INTEGER; THIS_SIZE:DISPLACEMENT; INHERITED:LEGACYS; BEGIN WITH STACK(.T.)@ DO BEGIN IF KIND IN ACTIVES THEN BEGIN "CHECK RULES" IF MODE IN NONCOMPS THEN ERROR(ACTIVE_ERROR); UNPACK(INHERITANCE,INHERITED); IF QUEUE_LEGACY IN INHERITED THEN IF MODE<>MONITOR2_MODE THEN ERROR(QUEUE_ERROR); IF KIND=SYSCOMP_KIND THEN IF SMODE=PROCESS2_MODE THEN IF THIS_LEVEL<>INITIAL_LEVEL THEND; PUT_TYPE END; PROCEDURE INTF_ID; VAR N:NOUN_INDEX; BEGIN READ_IFL(N); INTF_LENGTH:=INTF_LENGTH+WORDLENGTH; PUT1(INTF_LBL2,NOUN_TABLE(.N.)@.RDISP) END; PROCEDURE PARM; VAR PARM_NOUN:NOUN_INDEX; OP:INTEGER; PARM_CONTEXT:CONTEXT_KIND; BEGIN READ_IFL(PARM_NOUN); IF PARM_NOUN<>XUNDEF THEN WITH NOUN_TABLE(.PARM_NOUN.)@ DO BEGIN PARM_CONTEXT:= CONTEXT; CASE PARM_CONTEXT OF VAR_PARM,UNIV_VAR: OP:=VARPARM2; CONST_PARM,UNIV_CONST: OP:=CONEN ERROR(PROCESS_ERROR) END; THIS_SIZE:=SIZE END; READ_IFL(NUMBER); FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION" WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VMODE:=MODE; CONTEXT:=VARIABLE; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE); VDISP:=-CURRENT_DISP END; T:=T-NUMBER-1 "POP DECLARATION LIST" END; PROCEDURE EVAR_LIST; BEGIN WITH STACK(.T.)@ DO IF (KIND IN ACTIVES) OR (MODE<>CLASS2_MODE) THEN ERROR(ENTRY_ERROR); STPARM2; SAVE_PARM: BEGIN GENERIC_FUNCTION:=TRUE; OP:=SAVEPARM2 END END; PUT3(OP,VMODE,VDISP,CONTEXT) END ELSE PUT3(CONSTPARM2,UNDEF2_MODE,0,CONST_PARM); TYPE_; WITH STACK(.T.)@ DO BEGIN PUT3_ARG(KIND,NOUN,SIZE); IF PARM_CONTEXT = CONST_PARM THEN IF KIND IN INDEXS THEN IF N "TYPE NOUN" <> XINTEGER THEN PUT2(RANGE2,MIN,MAX) END; T:=T-1 END; PROCEDURE FOR_LIM; VAR ARG1,ARG2,ARG4:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2);VAR_LIST END; "####################" "ROUTINE DECLARATIONS" "####################" PROCEDURE ROUTINE_DEF; VAR ROUTINE_ENTRY:ENTRY_PTR; BEGIN IF RESOLVE THEN BEGIN PUSH_OLD_ENTRY(ROUTINE_ENTRY); WITH ROUTINE_ENTRY@ DO BEGIN PARM_SIZE:=CURRENT_DISP; VAR_SIZE:= 0; STACK_SIZE:=0; RMODE:=MODE END END ELSE BEGIN PUSH_NEW_ENTRY(ROUTINE_ENTRY); WITH ROUTINE_ENTRY@ DO BEGIN CLASS:=ROUTINE; PARM_SIZE:=CURRENT_DISP; STACK_S READ_IFL(ARG4); CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH); PUT4(FOR_LIM2,ARG1,-CURRENT_DISP,ARG2,ARG4) END; PROCEDURE FOR_LOOP(OP:INTEGER); BEGIN CURRENT_DISP:=CURRENT_DISP-WORDLENGTH; IGNORE2(OP) END; PROCEDURE WITH_TEMP; VAR WITH_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(WITH_ENTRY); WITH WITH_ENTRY@ DO BEGIN CLASS:=VALUE; VMODE:=PROC2_MODE "ALL TEMPS HAVE PROCEDURE MODE"; CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH); VDISP:=-CURRENT_DISP; IF WITIZE:=0; RMODE:=MODE; CURRENT_LABEL:=CURRENT_LABEL+1; RDISP:=CURRENT_LABEL END END; CURRENT_DISP:=0 END; PROCEDURE FUNC_DEF(RESOLVE:BOOLEAN); VAR FUNC_TYPE:ENTRY_PTR; BEGIN TYPE_; IF NOT(STACK(.T.)@.KIND IN FUNC_TYPES) THEN ERROR(FUNCTYPE_ERROR); T:=T-1 "POP FUNC TYPE"; ROUTINE_DEF(RESOLVE) END; PROCEDURE INITS_DEF; BEGIN INITIAL_ENTRY:=TRUE; "TOP OF STACK IS INITIAL STATEMENT ENTRY; SECOND IS COMPONENT ENTRY" WITH STACK(.T-1.)@ DO IF SM*,%'.02468:<>(*,/13579;=?)+-JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 " .^<  >" ": "* 2*b  $ % >:BJ6Z*jvzj8$ = & * *:JZtjhzv\"~LX&  " `(  ""$  """"""& Z<  Z L    (  "   (   " "   (  jP^DR8F,: ."  *:JZjzxlz`nT%2" 2 " ~$  BVDJ8>$ *L$  J*P+D,8-,. />$ ) J0P1vD2j83^,4R 5F:6r$ 6 >6D788,9 )"   (  "& XR  Z $  "" "  "&  "  " XR  Z X$   ""0   "" >"   P0>   L" X " \(  : ^ ($ D J:P;D<t8=h,>\ ?P L* W . " dB" Z6  . " dB"(d " " dZ$ " dB"  c "( p " " dZ$ " dB"  c" >" ` " "&" `7$  XvC d >"$ % X2 V-   >"" 2  H ," 8   @$?b   $  "" 2X """& " " " " >""" X R >"&  B BV" > > >" "4  T" T" T" T""    $ G*    & Q  X P H"  , h `( ^zr & * " ( r X"d " " dZ$ " dB"  c"*  tl B B0  l L"" D   R8& .T  > >"  "  "  "  "  "  "  "." P  X   f j V n B F ^ < T EN LENGTH:=OFFSET; PUT3_ARG(KIND,NOUN,LENGTH) END END; "#########" "MAIN LOOP" "#########" BEGIN INITIALIZE; REPEAT READ_IFL(SY); CASE SY OF ADDRESS1: PUT0(ADDRESS2); AND1: PUT0(AND2); ARRAY_DEF1: ARRAY_DEF; ARROW1: ARROW; BODY_END1: BODY_END; BODY1: BODY; CALL_FUNC1: CALL_FUNC; CALL_PROC1: PUT0(CALL_PROC2); CALL_PROG1: PUT1(CALL_PROG2,INTF_LENGTH); CASE_JUMP1: IGNORE1(CASE_JUMP2); CASE_LIST1: CASE_LIST; CHK_TYPE1: BEGIN PUT0(CHK_TYPE2); PUT_TYPE END; CLASS1: COMP_DEF(PACKED_CL B Z   N  . BN@>0.8 D H X L,lh  L JF X 2 B . V X8(d h Xn2 6 X ASS); CPARMLIST1: CPARM_LIST; DEF_LABEL1: IGNORE1(DEF_LABEL2); DIV1: PUT0(DIV2); EMPTY_SET1: PUT0(EMPTY_SET2); EOM1: EOM; ENUM_DEF1: ENUM_DEF; EQ1: PUT0(EQ2); EVAR_LIST1: EVAR_LIST; FALSEJUMP1: IGNORE1(FALSEJUMP2); FIELDLIST1: FIELDLIST; FOR_DOWN1: FOR_LOOP(FOR_DOWN2); FOR_LIM1: FOR_LIM; FOR_STORE1: PUT0(FOR_STORE2); FOR_UP1: FOR_LOOP(FOR_UP2); FUNC_DEF1,FUNCE_DEF1: FUNC_DEF(DONT_RESOLVE); FUNCF_DEF1: FUNC_DEF(RESOLVE); FUNCTION1: FUNCTION_; FWD_DEF1: FWD_DEF; GE1: PUT0(GE2); GT1: PUT0(G XF 2 ~.!nx"^ X#,$&X\ X%&&*'r* \ `2 ` Xa~ brlcf`dZTeN@f:4g.(h"ll~D(4L & & 6T2); INCLUDE1: PUT0(INCLUDE2); INDEX1: INDEX; INITS_DEF1: INITS_DEF; INIT1: PUT0(INIT2); INTF_ID1: INTF_ID; INTF1: INTF_LENGTH:=0; IN1: PUT0(IN2); JUMP_DEF1: IGNORE2(JUMP_DEF2); JUMP1: IGNORE1(JUMP2); LCONST1: LCONST; LE1: PUT0(LE2); LT1: PUT0(LT2); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: PUT0(MINUS2); MOD1: PUT0(MOD2); MONITOR1: COMP_DEF(PACKED_MONITOR); NEW_LINE1: IGNORE1(NEW_LINE2); NEW_NOUN1: PUSH_NEW_ENTRY(NEW_ENTRY); NE1: PUT0(NE2); NOT1: PUT0(NOT2); OR1: PUT0(OR2); PARM_TYPE1: PARM   r X@@V X@@   FJ B X 6A *Br > B"C >:" ` x| D LrV X(F BHD"`E _TYPE; PARM1: PARM; PEND1: PEND; PLUS1: PUT0(PLUS2); PROC_DEF1,PROCE_DEF1: ROUTINE_DEF(DONT_RESOLVE); PROCF_DEF1: ROUTINE_DEF(RESOLVE); PROCESS1: COMP_DEF(PACKED_PROCESS); PROG_DEF1: PROG_DEF; PSTART1: PSTART; RCOMP1: RCOMP(RCOMP2); REAL1: REAL_; REC_DEF1: REC_DEF; REC1: PUSH_LEVEL(RECORD_MODE); RESULT1: RESULT; ROUTINE1: RCOMP(ROUTINE2); SET_DEF1: SET_DEF; SLASH1: PUT0(SLASH2); STACK1: STACK_; STAR1: PUT0(STAR2); STORE1: PUT0(STORE2); STRING1: STRING; SUBR_DEF1: SUBR_DEF; SUB1: SUB; 2 ^ >" P" " >V* G I > U M > Q > xhS XK  L<O  0  *Jd~ fH&tJhV\NPRDT8L,P TYPE_DEF1: T:=T-1; TYPE1: TYPE_; UMINUS1: PUT0(UMINUS2); UNDEF1: PUT0(UNDEF2); UNIV_TYPE1: UNIV_TYPE; UPLUS1: PUT0(UPLUS2); VALUE1: PUT0(VALUE2); VAR_LIST1: VAR_LIST; VAR1: VCOMP(VAR2); VCOMP1: VCOMP(VCOMP2); VPARMLIST1: VPARMLIST; WITH_TEMP1: WITH_TEMP; WITH_VAR1: SAVE_CONTEXT:=TRUE; WITH1: WITH_ END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END.  W  "" L `0 >" xVn BY2Z"& \ `2 riLvj<fkxRl|FmpX2n\"oLt X0] N  >` X[ 2\ 2 "" `> BB >"*   x B&  ld > (: >" t"  0"  "  TPtH*  0 h B*  PH " v" 8 >V ^v: _Z" "q*j0:^p Ff:j64":L(Fx.HVbB`n 4 OhF#l* PASS 6: FILE_LIMIT2n\"oLt X0] N  >` X[ 2\  B" 0P(#  B : 2 **" L ` t , #)( " " .^<  >" "( " " .^<  >" "( " BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4=4; SET_KIND=5; STRING_KIND=6; PASSIVE_KIND=7; POINTER_KIND=8; QUEUE_KIND= 9; GENERIC_KIND=10; UNDEF_KIND=11; SYSCOMP_KIND=12; ROUTINE_KIND=13; ACTIVE_KIND=14; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9 ; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=1SUBSCRIPTING. INVALID INTERFACE. INVALID CALL. INVALID POINTING. INVALID RESOLUTION. INVALID NESTING. ADDRESS OVERFLOW. ACTIVE VARIABLE. QUEUE VARIABLE. NESTED PROCESS. INVALID ENTRY VARIABLE. INVALID FUNCTION TYPE. RECORD ENUMERATION. LONG ENUMERATION. INVALID INDEX TYPE. INVALID MEMBER TYPE. PROCESS STACK USAGE. INVALID PARAMETER. COMPILER ABORT. ODD LENGTH STRING TYPE. INVALID RESOLUTION. INVALID TAG TYPE6; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; XWAIT=23; XREAL=24; "STANDARD NOUN INDICES" ZARITHMETIC=25; ZINDEX=26; ZPASSIVE=27; ZVPARM=28; ZCPARM=29; ZSPARM=30; ZWITH=31; "DATA TYPS" BYTE_TYP=0; WORD_TYP=1; REAL_TYP=2; SET_TYP=3; STRUCT_TYP=4; "ADDRESS MODES" SCONST_MODE=11; LCONST_MODE=0; PROC_MODE=1; PROG_MODE=2; PE_MODE=3; CE_MODE=4; . RECORD POINTER TYPE. COMPILER ABORT. OPERAND TYPE. NOT A VARIABLE. NOT ASSIGNABLE. INVALID INITIALIZATION. TOO MUCH STACK. TOO MUCH CODE. PROCEDURE PRINTSUMMARY .CALLED. QUEUE VARIABLE. NESTED PROCESS. INVALID ENTRY VARIABLE. INVALID FUNCTION TYPE. RECORD ENUMERATION. LONG ENUMERATION. INVALID INDEX TYPE. INVALID MEMBER TYPE. PROCESS STACK USAGE. INVALID PARAMETER. COMPILER ABORT. ODD LENGTH STRING TYPE. INVALID RESOLUTION. INVALID TAG TYPE ME_MODE=5; PROCESS_MODE=6; CLASS_MODE=7; MONITOR_MODE=8; STD_MODE=9; UNDEF_MODE=10; TEMP_MODE=PROC_MODE; "COMPARISONS" LESS=0; EQUAL=1; GREATER=2; NOTLESS=3; NOTEQUAL=4; NOTGREATER=5; INSET=6; "ERRORS" COMPILER_ERROR=1; TYPE_ERROR=2; ADDRESS_ERROR=3; ASSIGN_ERROR=4; INIT_ERROR = 5; THIS_PASS=5; BYTELENGTH = 1; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; TYPE ADDR_STATE=(DIRECT,INDIRECT,ADDR,EXPRESSION);&(*,. "HJLO9;=Z\^`bdfPRTVX[]_aceQSUW   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w y { } h j n p r t v x z | ~ ADDR_MODE=LCONST_MODE..SCONST_MODE; ADDR_MODES=SET OF ADDR_MODE; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; DISPLACEMENT=INTEGER; TYPE_KIND=INT_KIND..ROUTINE_KIND; TYPE_KINDS=SET OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; OPERAND_CLASS=(UNDEFINED,VALUE,ROUTINE); OPERAND= RECORD KIND:TYPE_KIND; NOUN:INTEGER; MODE:ADDR_MODE; DISP:DISPLACEMENT; LENGTH:DISPLACEMENT; CASE CLASS:OPERAND_CLASS OF VALUE:(CONTEXT:CON*BzZnrbVJv>j2&0:DNXblv$   2Jbz vv"jj:^^RRRjFF::(2\BP6D*8$   , "xp b d .T dD 4 $ ," z*4  T" T" T" 02" 6"" STACK,THIS_STACK,EMPTY_STACK:STACK_LINK; DEBUG,DONE: BOOLEAN; PASSIVES,INDEXS,LARGES,ARITHMETIC,INDIRECTS,SMALLS: TYPE_KINDS; UNIVERSAL,ASSIGNS,VAR_PARMS,CNST_PARMS, PARMS: CONTEXTS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; P" " >" " "  "  " " "N"  j &". X6*  l "v$j&t^(ROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 5: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT R*F,:..08"2,4 68:<>@BDFHJLzNnPxbRlVT`JVT>XH2Z<&\0^$`b dfhjlnprtv,~x rzf|Z ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(~NB6*z pXpv@jX^R@F:(." $NznxblWORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG:INTEGER); VAR T:ARRAY (.1..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER; BEGIN REM:=ARG; DIGIT:=0; REPEAT DIGIT:=DIGITV`JT>H2<&0$H"q&0:DNXblv  *4>HR\fpz$.8BLV`jt~ (2[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq     "$& #%'!>(*,.02468:<?)+-/13579;=BDFHJEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################### # COPYLINES(VAR OK: BOOLEAN; ID: IDENTIFIER) # ####### 0 " " >"   P0>   L" X" B `  " \(  B (   *" ( *"@   t" . "b >, " " B "" >" "   X PX6  ^ JD 0""  X:^U " X@ Z.   `2" q T""" x""~ h(   &(  B  ""$ BL>" ^  "   BP> *   6 LH""* "B" Xf `" Z< >"  X( >"   X PX6  ^,  P>  T      R  >  @ 4 t* P" | *Bz"n"f  z |  " >"  "  ^. HP>"  X  X6 "Z& D :" T" " " 0 Z2  x  * "F X B" P>"` ,   |   < " >"  "z  X"d n >"    X PX6 |  ". - . /? t " t "  t^4 r$ r*v O VR 46 T & k  `2########################################" PROCEDURE WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(REM MOD 10 + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO 4 - DIGIT DO WRITE(' '); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(' '); END; PROCEDURE STARTIO; VAR SOURCE, DEST: ARGTYPE; BEGIN WITH SOURCE DO BEGIN TAG:= IDTYPE; ID:= PAN"!8P \$ < " P>" >"$ C " P>" B"$ J X"$ M X"" O"""4 ] " 4 cF" . h"&4v " @ b ~B"b *B4 ~RAM(.2.).ID END; WRITEARG(INP, SOURCE); WITH DEST DO BEGIN TAG:= IDTYPE; ID:= 'PRINTER ' END; WRITEARG(OUT, DEST); END; PROCEDURE STOPIO; VAR SOURCE, DEST: ARGTYPE; BEGIN READARG(INP, SOURCE); READARG(OUT, DEST); PARAM(.1.).BOOL:= SOURCE.BOOL & DEST.BOOL; END; PROCEDURE COPYTEXT; VAR C: CHAR; LINENO: INTEGER; BEGIN WRITE(FF); LINENO:= 0; READ(C); WHILE C <> EM DO BEGIN LINENO:= LINENO + 1; WRITEINT(LINENO); WHILE C <> NL DO BEGIN WRITE(C); READ(C) END; W2"( " ^\ >"  ^   BNPRINTER  B (   *" ( *"@   RITE(NL); READ(C); END; WRITE(EM); END; BEGIN STARTIO; COPYTEXT; STOPIO; END. MOVE(1) LIST(FILES, ALL, TAPE) MOVE(1) COPY(TAPE, PRINTER) MOVE(183) COPY(TAPE, PRINTER) MOVE(1) CTED 233 PAGES USER_PROGRAM SEQCODE UNPROTECTED 3 PAGES WRITE SEQCODE PROTECTED 2 PAGES WRITEMAN ASCII PROTECTED 1 PAGES WRITETEXT ASCII PROTECTED 9 PAGES 193 ENTRIES 4062 PAGES  3 PAGES TAPEMAN ASCII PROTECTED 2 PAGES TAPETEXT ASCII PROTECTED 14 PAGES TEMP1 SCRATCH PROTECTED R   `r  l" l6*BrpnNZ@"  "  X 2 .nT6pT.vR.   . ( X "  " ^  @ 5Z @ 8Z \< PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT: : ?:r0B: ~0E: " H :"" K " N < Qb lr Tb Xr Wb 2 Z 2 ] 0 ` $0 c D0 f  p0 i  jm   6@q X$   SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMED   $ | " "   H tbZ H:   r    XZZ.ftrpdr~. n"tnnBl"Bl"2l" l t IUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); " nzn^:pnX$  "  " ( R`\D|`Dj \~PHZHLH>`~dr`b`D PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE ~PH" `D H" `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TERMINATED IO IOPROCESS: TERMINATED CARDS: ERROR PRINTER: INSPECT ~dr`b`D5     #%')F02579;=?ACEG1368:<>@BDIKMOQSUWY[]_JLNPRTVXZ\^Hgikmoqsuwam z | ~ n p r t v x       %'!X HERE" CONST FIRSTCHAR = 1; LASTCHAR = 131; FIRSTLINE = 2; LASTLINE = 61; FIRSTPAGE = 2; LASTPAGE = 101; AFTERFILE = 0; VAR CONTROLCHAR: SET OF CHAR; C: CHAR; TEXT: LINE; PROCEDURE INITIALIZE; BEGIN IDENTIFY('PRINTER: (:10:)'); END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; END; PROCEDURE SETMARGIN; VAR I: INTEGER; BEGIN FOR I:= 1 TO FIRSTCHAR - 1 DO TEXT(.I.):= ' '; TEXT(.LASTCHAR + 1.):= NL; CONTROLCHAR:= (.CR, NL, FF, EM.); END; PROCEDUR"PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT/SEQUENTIAL PASCAL COMPILER PASS 6: CODE SELECTION 9 SEPTEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTIE PRINTLINE; VAR ENDLINE: BOOLEAN; CHARNO: INTEGER; BEGIN ENDLINE:= FALSE; CHARNO:= FIRSTCHAR; REPEAT READ(C); TEXT(.CHARNO.):= C; IF C IN CONTROLCHAR THEN BEGIN IF C = EM THEN TEXT(.CHARNO.):= NL; TEXT(.CHARNO + 1.):= ' '; ENDLINE:= TRUE; END ELSE IF CHARNO = LASTCHAR THEN BEGIN C:= NL; ENDLINE:= TRUE END ELSE CHARNO:= SUCC(CHARNO); UNTIL ENDLINE; WRITELINE(TEXT); END; PROCEDURE PRINTNL; BEGIN TEXT(.FIRSTCHAR.):= NL; TEXT(.FIRSTCHAR + 1.):=ON = 4; NUMBEROPTION = 5; MAXWORD = 100; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; TABLEPTR = @TABLE; TABLE = RECORD NEXTPORTION: TABLEPTR; CONTENTS: ARRAY (.1..MAXWORD.) OF INTEGER END; TABLEPART = RECORD PROGLENGTH, CODELENGTH, STACKLENGTH, VARLENGTH: INTEGER; JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR END; TABLESPT ' '; WRITELINE(TEXT); END; PROCEDURE PRINTFF; BEGIN TEXT(.FIRSTCHAR.):= FF; TEXT(.FIRSTCHAR + 1.):= ' '; WRITELINE(TEXT); END; PROCEDURE PRINTPAGE; VAR ENDPAGE: BOOLEAN; LINENO: INTEGER; BEGIN ENDPAGE:= FALSE; FOR LINENO:= 1 TO FIRSTLINE - 1 DO PRINTNL; LINENO:= FIRSTLINE; REPEAT PRINTLINE; CASE C OF CR: ; NL: IF LINENO = LASTLINE THEN BEGIN PRINTFF; ENDPAGE:= TRUE; END ELSE LINENO:= LINENO + 1; FF, EM: ENDPAGE:= R = @TABLEPART; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: TABLESPTR END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) TRUE END UNTIL ENDPAGE; END; PROCEDURE PRINTFILE; VAR ENDFILE: BOOLEAN; PAGENO: INTEGER; BEGIN SETMARGIN; ENDFILE:= FALSE; FOR PAGENO:= 1 TO FIRSTPAGE - 1 DO PRINTFF; PAGENO:= FIRSTPAGE; REPEAT PRINTPAGE; IF (C = EM) OR (PAGENO = LASTPAGE) THEN ENDFILE:= TRUE ELSE PAGENO:= PAGENO + 1; UNTIL ENDFILE; FOR PAGENO:= PAGENO TO PAGENO + AFTERFILE - 1 DO PRINTFF; END; BEGIN IF TASK = OUTPUTTASK THEN BEGIN INITIALIZE; PRINTFILE; TERMINATE; END;MO9;=@BEG>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq     "$& #%'!>(*,.02468:<?)+-/13579;=BDFHJLNPRTV@CEGIKM END. LINE; ); EGER; VAR BLOCK: UNIV PAGE); J("$   ( "4"B `"j  j>  R R RR&4""j  TP Xj  j > "4 X "" " Lj$j j>MO9;=@BEG>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoq     "$& #%'!>(*,.02468:<?)+-/13579;=BDFHJLNPRTV@CEGIKMOQSU j$j j> j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `"CEMENT; BEGIN READ_IFL(L); PUT1(PUSHLABEL2,L) END; PROCEDURE PROG_CALL; VAR INTF_LENGTH:INTEGER; BEGIN READ_IFL(INTF_LENGTH); PUT0(CALLPROG2); PUT1(POP2,INTF_LENGTH); POP END; "##########" "EXPRESSION" "##########" PROCEDURE EQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF CHAR_KIND,INT_KIND,BOOL_KIND, ENUM_KIND,POINTER_KIND, REAL_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND,PASSIVE_KIND: P *XPRINTER:  j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `"UT2(COMPSTRCT2,OP,T@.LENGTH); ACTIVE_KIND,QUEUE_KIND,GENERIC_KIND,UNDEF_KIND, SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); PASSIVE_KIND,ACTIVE_KIND,POINTER_KIND,QUEUE_KIND,GENNTF_LBL; IN1: INCLUSION; JUMP_DEF1: JUMP_DEF; JUMP1: JUMP; LCONST1: LCONST; LE1: INEQUALITY(NOTGREATER); LT1: STRICT_INEQUALITY(LESS); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: PLUS_MINUS_STAR(SUB2); MOD1: DIV_MOD(MOD2); NEW_LINE1: IGNORE1(NEWLINE2); NE1: EQUALITY(NOTEQUAL); NOT1: NOT_; OR1: OR_AND(OR2); PLUS1: PLUS_MINUS_STAR(ADD2); PROG_CALL1: PROG_CALL; RANGE1: IGNORE2(RANGE2); RCOMP1: RCOMP; RESULT1: RESULT; ROUTINE1: ROUTINE_; SAVEPARM1: CONSTPARM(TRUE); SLASH1: SLASH; STAR1: PLUS_MINUERIC_KIND, UNDEF_KIND,SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE STRICT_INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); SET_KIND,POINTER_KIND,PASSIVE_KIND,ACTIVE_KIND,QUEUE_KIND, SYSCOMP_KIND,ROUTINE_KIND,UNDEF_KIND: ERROR2(TYPE_ES_STAR(MUL2); STORE1: STORE(TRUE); SUB1: SUB; UMINUS1: UMINUS; UNDEF1: UNDEF; UPLUS1: UPLUS; VALUE1: VALUE_; VARPARM1: VARPARM; VAR1: VAR_; VCOMP1: VCOMP; WITH1: POP_TEMP END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END. RROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INCLUSION; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=SET_KIND) AND (S@.KIND IN INDEXS) AND (S@.NOUN=T@.NOUN) THEN PUT2(COMPARE2,INSET,SET_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=BOOL_EXPR END; PROCEDURE UMINUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN PUT1(NEG2,TTYP) ELSE ERROR1(TYPE_ERROR) END; PROCEDURE UPLUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN "OK" ELSE ERROR1(T END; CONST MAXARG = 10; TEXT_LENGTH = 18; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCE(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;DURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" PUSHCONST1 = 0; PUSHVAR1 = 1; PUSHIND1 = 2; PUSHADDR1 = 3; FIELD1 = 4; INDEX1 = 5; POINTER1 = 6; VARIANT1 = 7; RANGE1 = 8; ASSIGN1 = 9; ASSIGNTAG1 = 10; COPY1 = 11; NEW1 = 12; NOT1 = 13; AND1 = 14; OR1 ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################# # PRINTER(VAR OK: BOOLEAN) # #############################" "INSERT PREFIARG); IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH; WRITE2(GLOBADDR2, ADDR) END; MODE6, MODE7, MODE8: WRITE2(GLOBADDR2, ARG); MODE10: END; PUSHWORD; END; PROCEDURE PUSHINDIRECT(VARTYPE: INTEGER); BEGIN CASE VARTYPE OF BYTETYPE: WRITE1(PUSHBYTE2); WORDTYPE: WRITE1(PUSHIND2); REALTYPE: BEGIN WRITE1(PUSHREAL2); POPWORD; PUSHREAL; END; SETTYPE: BEGIN WRITE1(PUSHSET2); POPWORD; PUSHSET; END END; END; "S_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= #####################" "COMPARISON PROCEDURES" "#####################" PROCEDURE COMPAREWORD(ARG: INTEGER); BEGIN CASE ARG OF LESS: WRITE1(LSWORD2); EQUAL: WRITE1(EQWORD2); GREATER: WRITE1(GRWORD2); NOTLESS: WRITE1(NLWORD2); NOTEQUAL: WRITE1(NEWORD2); NOTGREATER: WRITE1(NGWORD2) END; POPWORD; END; PROCEDURE COMPAREREAL(ARG: INTEGER); BEGIN CASE ARG OF LESS: WRITE1(LSREAL2); EQUAL: WRITE1(EQREAL2); GREATER: WRITE1(GRREAL2 = 15; NEG1 = 16; ADD1 = 17; SUB1 = 18; MUL1 = 19; DIV1 = 20; MOD1 = 21; "NOT USED" "NOT USED" FUNCTION1 = 24; BUILDSET1 = 25; COMPARE1 = 26; COMPSTRUC1 = 27; FUNCVALUE1 = 28; DEFLABEL1 = 29; JUMP1 = 30; FALSEJUMP1 = 31; CASEJUMP1 = 32; INITVAR1 = 33; CALL1 = 34; ENTER1 = 35; RETURN1 = 36; POP1 = 37; NEWLINE1 = 38; ERROR1 = 39; CONSTANT1 = 40; MESSAGE1 = 41; INCREMENT1 = 42; DECREMENT1CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('6'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = 43; PROCEDURE1 = 44; INIT1 = 45; PUSHLABEL1 = 46; CALLPROG1 = 47; EOM1=48; "VIRTUAL DATA TYPES" BYTETYPE = 0; WORDTYPE = 1; REALTYPE = 2; SETTYPE = 3; "VIRTUAL ADDRESSING MODES" MODE0 = 0 "CONSTANT"; MODE1 = 1 "PROCEDURE"; MODE2 = 2 "PROGRAM"; MODE3 = 3 "PROCESS ENTRY"; MODE4 = 4 "CLASS ENTRY"; MODE5 = 5 "MONITOR ENTRY"; MODE6 = 6 "PROCESS"; MODE7 = 7 "CLASS"; MODE8 = 8 "MONITOR"; MODE9 = 9 "STANDARD"; MODE10=10 "UNDEFINED"; "COMPARISON OPERATORS" LESS = 0; EQ = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "################" "INPUT PROCEDURES" "################" PROCEDURE READ1ARG; BEGIN READ_IFL(ARG1) END; PROCEDURE READ2ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2) END; PROCEDURE READ3ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3) END; PROCEDURE READ4ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); READ_IFL(ARG4); END; PROCEDURE READ5ARG; BEGIN READ_IFL(ARG1)UAL = 1; GREATER = 2; NOTLESS = 3; NOTEQUAL = 4; NOTGREATER = 5; INSET = 6; "STANDARD FUNCTIONS" TRUNC1 = 0; ABS1 = 1; SUCC1 = 2; PRED1 = 3; CONV1 = 4; EMPTY1 = 5; ATTRIBUTE1 = 6; REALTIME1 = 7; MIN_FUNC = 0; MAX_FUNC = 7; "STANDARD PROCEDURES" DELAY1 = 0; CONTINUE1 = 1; IO1 = 2; START1 = 3; STOP1 = 4; SETHEAP1 = 5; WAIT1 = 6; MIN_PROC = 0; MAX_PROC = 6; "OUTPUT OPERATORS" CONSTADDR2 =; READ_IFL(ARG2); READ_IFL(ARG3); READ_IFL(ARG4); READ_IFL(ARG5) END; "#################" "OUTPUT PROCEDURES" "#################" PROCEDURE ERROR (PASS, NUMBER: INTEGER); FORWARD; PROCEDURE WRITE1(OP: INTEGER); BEGIN IF TEST THEN PRINTOP(OP); WRITE_IFL(OP); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE2(OP, ARG: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END; WRITE_IFL(OP 0; LOCALADDR2 = 1; GLOBADDR2 = 2; PUSHCONST2 = 3; PUSHLOCAL2 = 4; PUSHGLOB2 = 5; PUSHIND2 = 6; PUSHBYTE2 = 7; PUSHREAL2 = 8; PUSHSET2 = 9; FIELD2 = 10; INDEX2 = 11; POINTER2 = 12; VARIANT2 = 13; RANGE2 = 14; COPYBYTE2 = 15; COPYWORD2 = 16; COPYREAL2 = 17; COPYSET2 = 18; COPYTAG2 = 19; COPYSTRUC2 = 20; NEW2 = 21; NEWINIT2 = 22; NOT2 = 23; ANDWORD2 = 24; ANDSET2 = 25; ORWORD2 = 26; ORSET2 = 27; NEGWORD2 = 2); WRITE_IFL(ARG); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + TWOWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE3(OP, ARG1, ARG2: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); END; WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + THREEWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE4(OP, ARG1, ARG2, ARG3: INTEGER);8; NEGREAL2 = 29; ADDWORD2 = 30; ADDREAL2 = 31; SUBWORD2 = 32; SUBREAL2 = 33; SUBSET2 = 34; MULWORD2 = 35; MULREAL2 = 36; DIVWORD2 = 37; DIVREAL2 = 38; MODWORD2 = 39; BUILDSET2 = 40; INSET2 = 41; LSWORD2 = 42; EQWORD2 = 43; GRWORD2 = 44; NLWORD2 = 45; NEWORD2 = 46; NGWORD2 = 47; LSREAL2 = 48; EQREAL2 = 49; GRREAL2 = 50; NLREAL2 = 51; NEREAL2 = 52; NGREAL2 = 53; EQSET2 = 54; NLSET2 = 55; NESET2 = 56 BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); END; WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FOURWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE5(OP, ARG1, ARG2, ARG3, ARG4: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4); END; WRITE_IFL(OP); WRITE_IF; NGSET2 = 57; LSSTRUCT2 = 58; EQSTRUCT2 = 59; GRSTRUCT2 = 60; NLSTRUCT2 = 61; NESTRUCT2 = 62; NGSTRUCT2 = 63; FUNCVALUE2 = 64; JUMP2 = 65; FALSEJUMP2 = 66; CASEJUMP2 = 67; INITVAR2 = 68; CALL2 = 69; CALLSYS2 = 70; ENTER2 = 71; EXIT2 = 72; ENTERPROG2 = 73; EXITPROG2 = 74; BEGINCLAS2 = 75; ENDCLASS2 = 76; ENTERCLAS2 = 77; EXITCLASS2 = 78; BEGINMON2 = 79; ENDMON2 = 80; ENTERMON2 = 81; EXITMON2 = 82; BEGINPROC2 = 83;L(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FIVEWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITEARG(ARG: INTEGER); BEGIN IF TEST THEN PRINTARG(ARG); WRITE_IFL(ARG); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITELOCATION; BEGIN IF TEST THEN PRINTARG(LOCATION); WRITE_IFL(LOCATION); END; ENDPROC2 = 84; ENTERPROC2 = 85; EXITPROC2 = 86; POP2 = 87; NEWLINE2 = 88; INCRWORD2 = 89; DECRWORD2 = 90; INITCLASS2 = 91; INITMON2 = 92; INITPROC2 = 93; PUSHLABEL2 = 94; CALLPROG2 = 95; TRUNCREAL2 = 96; ABSWORD2 = 97; ABSREAL2 = 98; SUCCWORD2 = 99; PREDWORD2 = 100; CONVWORD2 = 101; EMPTY2 = 102; ATTRIBUTE2 = 103; REALTIME2 = 104; DELAY2 = 105; CONTINUE2 = 106; IO2 = 107; START2 = 108; STOP2 = 109; SETHEAP2 = 110; WAIT2 = 1PROCEDURE COMMENT(LENGTH: INTEGER); BEGIN LOCATION:= LOCATION - LENGTH END; PROCEDURE ERROR; BEGIN IF NOT AFTERERROR THEN BEGIN AFTERERROR:= TRUE; COMMENT(FOURWORDS); WRITE4(MESSAGE2, PASS, NUMBER, LINE); GENERATE:= FALSE END END; "################" "STACK PROCEDURES" "################" PROCEDURE PUSHWORD; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + WORDLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPWORD; BEGIN TEMP11; MESSAGE2 = 112; EOM2=113; "OTHER CONSTANTS" PDP11 = TRUE; CONCURRENT = TRUE; INITIALBLOCK = 1; SPLITLENGTH = 4 "WORDS PER REAL"; TWOWORDS = 4; THREEWORDS = 6; FOURWORDS = 8; FIVEWORDS = 10; STACK_LIMIT = 32667 "GREATEST INTEGER - 100"; CODE_LIMIT = 32667; THIS_PASS = 6; INFILE = 2; OUTFILE = 1; STACK_ERROR = 1; CODE_ERROR = 2; VAR LINK: PASSPTR; SUMMARY, TEST, CHECK, GENERATE, NUMBER, AFTERBEGIN, AFTERERROR, DONE: BOOLEAN; JUMPTABLE, BLOCKTABLE, STACKTABLE, C:= TEMP - WORDLENGTH END; PROCEDURE PUSHREAL; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + REALLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPREAL; BEGIN TEMP:= TEMP - REALLENGTH END; PROCEDURE PUSHSET; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + SETLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPSET; BEGIN TEMP:= TEMP - SETLENGTH END; PROCEDURE PUSH(LENGTH: INTEGER); BEGIN IFONSTTABLE: TABLEPTR; CONSTANTS, STACKLENGTH, VARLENGTH, PARAMLENGTH, POPLENGTH, TEMP, MAXTEMP, BLOCK, LOCATION, LINE, OP, ARG1, ARG2, ARG3, ARG4, ARG5: INTEGER; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEX TEMP < STACK_LIMIT - LENGTH THEN TEMP:= TEMP + LENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POP(LENGTH: INTEGER); BEGIN TEMP:= TEMP - LENGTH END; "###################" "VARIABLE PROCEDURES" "###################" FUNCTION DISPL(ARG: INTEGER): INTEGER; BEGIN IF ARG < 0 THEN DISPL:= ARG ELSE DISPL:= ARG + FOURWORDS; END; PROCEDURE PUSHVALUE(MODE, ARG: INTEGER); VAR ADDR: INTEGER; BEGIN CASE MODE OF MODE1, MODE3, MODE4, MODE5: T_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 6: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT WRITE2(PUSHLOCAL2, DISPL(ARG)); MODE2: BEGIN ADDR:= DISPL(ARG); IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH; WRITE2(PUSHGLOB2, ADDR) END; MODE6, MODE7, MODE8: WRITE2(PUSHGLOB2, ARG); MODE10: END; PUSHWORD; END; PROCEDURE PUSHADDRESS(MODE, ARG: INTEGER); VAR ADDR: INTEGER; BEGIN CASE MODE OF MODE0: WRITE2(CONSTADDR2, ARG); MODE1, MODE3, MODE4, MODE5: WRITE2(LOCALADDR2, DISPL(ARG)); MODE2: BEGIN ADDR:= DISPL(, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORD< b t b r b 2   (2  H  0  X    0  X   l   X@ X$    $  " "   L b!$4  -JLNPRTV@BDFHACHJLO9;=Z\^`bdfPRTVX[]_aceQSUW   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w y { } h j n p r t Z jR XZR*" l`2     BR   `r  l" l6*BrpnNZ@ 0  "  X 2 .nT6pT.vR.   . ( X .TITLE KERNEL FOR CONCURRENT PASCAL .SBTTL EDIT HISTORY ; ;<01> 10-APR-79 S. WILLIAMS ; ; THIS CODE MODIFIED TO RUN BAREFOOT ON PDP-11/34 WITHOUT I/D SPACE ; SEPARATION, TWO REGISTER SETS, OR FLOATING POINT HARDWARE. ; ; ALSO ADDED ABILITY TO BOOT FROM ANY RK05 UNIT ... ; ; ; ; ; SPL MACRO TO SIMULATE PDP-11/45 "SPL" INSTRUCTION ; .MACRO SPL PL .IF EQ,PL CLR @#PSW .IFF MOV #PL*40,@#PSW .ENDC .ENDM SPL ; ; ; MACRO TO PUSH STUFF ON STACK ; ; .MACRO PUSH LIST .IRP X, MOV X,-(SP) .ENDR .ENDM "  " ^  @ CZ @ FZ \J: : M:r2P: ~2S: " V :"" Y " \ < _b lt bb Xr eb 2 h 2 k 0 n $0 qPUSH ; ; MACRO TO UNDO A PUSH ; .MACRO POP LIST .IRP X, MOV (SP)+,X .ENDR .ENDM POP ; ; FAKE OUT THE MTPD AND MFPD INSTRUCTIONS FOR 11/40 AND 11/35 ; .MACRO MTPD X MTPI X .ENDM MTPD ; .MACRO MFPD X MFPI X .ENDM MFPD .IF NDF, F$PU ;USED BY SW FLOATING POINT ; ; GET PSW INTO REGISTER 0 ; .MACRO GETPSW X EMT 0 ;FETCH PSW INTO R0 MOV R0,X ;MOV TO DESTINATION .ENDM GETPSW .ENDC ;F$PU ; ; ; MACRO TO SET UP COMMON INTERRUPT ENTRY CODE ; ; .MACRO INTSRV R ;R -> SERVICE ROUTINE PUSH < D0 t  p0 w  l{   6@ X$ h   $  " "   J tbZ H:   r    XZZ.ftrpdr~. n"tnR5,R4,R3,R2,R1,R0> ;SAVE REGS .IF NB,R PUSH #KNEXIT ;FAKE JMP @#R ; JSR .ENDC .ENDM INTSRV .SBTTL FLOATING POINT SUPPORT ; ; ;<01> THIS SECTION ADDED BY EDIT <01> ; ; ; IF AN FPU-11 IS NOT AVAILABLE, LEAVE ASSEMBLY-TIME VARIABLE "F$PU" ; UNDEFINED, AND A SET OF SOFTWARE ROUTINES WILL BE INCLUDED AT ; ASSEMBLY TIME. ; ; ADDITIONAL SIZE: APP 1K(W). ; ;F$PU = 1 ;<01> DEFINE FOR FPU SUPPORT .IF NDF,F$PU ;<01> INCLUDE SW ROUTINES ONLY IF ;<01> NO FPU .GLOBL $ADD ;<01> DOUBLE FLOATING ADD .nBl"Bl"2l" l t " nzn^:pnX$  "  "  `D`Dj \~GLOBL $SBD ;<01> DOUBLE FLOATING SUBTRACT .GLOBL $MLD ;<01> DOUBLE FLOATING MULTIPLY .GLOBL $DVD ;<01> DOUBLE FLOATING DIVIDE .GLOBL $DCMP ;<01> DOUBLE FLOATING COMPARE .GLOBL $ID ;<01> CONVERT INTEGER -> DOUBLE .GLOBL $DI ;<01> CONVERT DOUBLE -> INTEGER .GLOBL OVERFL ;<01> OVERFLOW EXIT POINT .ENDC ;<01> ;**** ASSEMBLY OPTIONS **** ;* ;* ;* .SBTTL ASPHZHLH>`~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TE); NOTLESS: WRITE1(NLREAL2); NOTEQUAL: WRITE1(NEREAL2); NOTGREATER: WRITE1(NGREAL2) END; POPREAL; POPREAL; PUSHWORD; END; PROCEDURE COMPARESET(ARG: INTEGER); BEGIN CASE ARG OF EQUAL: WRITE1(EQSET2); NOTLESS: WRITE1(NLSET2); NOTEQUAL: WRITE1(NESET2); NOTGREATER: WRITE1(NGSET2); INSET: WRITE1(INSET2) END; POPSET; IF ARG <> INSET THEN BEGIN POPSET; PUSHWORD END; END; PROCEDURE COMPARESTRUCT(ARG1, ARG2: INTEGER); BEGIN CASE ARG1 OF SEMBLY OPTIONS ;* ;* ;* .NLIST TTM; NEGATE CONSOLE MODE ;* ;* ;* .DSABL GBL; NO GLOBALS ;* ;* ;* ;<01> .ENABL CDR; IGNORE CARD SERIALIZATION .ENABL AMA ;<01> USE ABSOLUTE ADDRESSING IN KERNEL ONLY! ;* ;* ;* ;* ;* THE RSX11M KERNEL BUILDER REQUIRES A RELOCATABLE ;* ASSEMBLY. THEREFORE, THE FOLLOWING ;* ASECT IS CONVERTED INTO A COMMENT. .AS LESS: WRITE1(LSSTRUCT2); EQUAL: WRITE1(EQSTRUCT2); GREATER: WRITE1(GRSTRUCT2); NOTLESS: WRITE1(NLSTRUCT2); NOTEQUAL: WRITE1(NESTRUCT2); NOTGREATER: WRITE1(NGSTRUCT2) END; WRITEARG(ARG2 DIV WORDLENGTH); POPWORD; END; "################" "TABLE PROCEDURES" "################" PROCEDURE ALLOCATE(VAR T: TABLEPTR; ENTRIES: INTEGER); VAR PORTION: TABLEPTR; I: INTEGER; BEGIN NEW(T); PORTION:= T; I:= ENTRIES - MAXWORD; WHILE I > 0 DO WITH PORTION@ DO BE"   ". """& & v "0 & > bN 9 ""V  |  0 " ^ "  (`\"  `(  ' " " P (GIN NEW(NEXTPORTION); PORTION:= NEXTPORTION; I:= I - MAXWORD; END; END; PROCEDURE ENTER(T: TABLEPTR; I, J: INTEGER); VAR PORTION: TABLEPTR; K: INTEGER; BEGIN PORTION:= T; K:= I; WHILE K > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; K:= K - MAXWORD; END; PORTION@.CONTENTS(.K.):= J; END; FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER; VAR PORTION: TABLEPTR; J: INTEGER; BEGIN PORTION:= T; J:= I; WHILE J > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; J:= J N l   J  0 " ^ " P h `\"  `(  l " "  N  $  V"$  Z"$  VB >"  *  "$ - MAXWORD; END; ENTRY:= PORTION@.CONTENTS(.J.); END; "###############" "LINE PROCEDURES" "###############" PROCEDURE NEWLINE(ARG: INTEGER); BEGIN LINE:= ARG; AFTERERROR:=FALSE; IF NUMBER AND AFTERBEGIN THEN WRITE2(NEWLINE2,LINE) END; PROCEDURE INITLINE; BEGIN LINE:=0; AFTERBEGIN:=FALSE END; "################" "BLOCK PROCEDURES" "################" PROCEDURE ENTERBLOCK(I, J, K, L: INTEGER); BEGIN BLOCK:= I; PARAMLENGTH:= J; VARLENGTH:= K; STACKLENGTH:=L; POPLENGTH:= PARAMLENGTH + FOURWORD" " ^   B"$  Z  *" ""  0 *""   *"" ""  z0v |*Bz"x"  zx| *Bz"v" !z""/ 0 * """6  *R5 ;R5 = DISK ADDR REG BIC #^C160000,R5 ;ISOLATE UNIT BITS MOVB #1,@#RKDA ;SET BLOCK NUMBER (DON'T CHANGE DRIVE ;NUMBER) MOV #-27000.,@#RKWC ;SET LARGE WORD COUNT MOV #0,@#RKBA ;SET BUFFER ADDRESS MOV #RKRD,@#RKCS ;READ IT 25$: TSTB @#RKCS ;DONE YET? BPL 25$ ;NO, LOOP TILL DONE BIT ON TST @#RKCS ;ERROR BIT SET? BMI IOERR ;YES, PRINT "DISK ERROR" CMP @#0,#137 ;TEST FOR JMP @#X INSTRUCTION @ 0 BNE BADFIL ;NOT THERE, BAD DISK MOV R5,@#UNITNO ;PASS UNIT NUMBER TO KERNEL NO """ <"2 K X B" >"  " X* 0 "" ["2 ^ >"  X X6F " X t" i" kR  " < X 2 H$P ;CONVENIENT PLACE TO PUT A HALT CLR PC ;ELSE, JUMP TO LOCATION 0 IOERR: JSR R0,PRINT ;CALL TTYOUT SUBROUTINE .ASCIZ \I/O ERROR\ ;BAD BLOCK ON DISK BADFIL: JSR R0,PRINT ;CALL TTYOUT SUBROUTINE .ASCIZ \BAD DISK FORMAT\ ;KERNEL NFG PRINT: TSTB @#TPS ;WAIT ON TERMINAL READY BPL PRINT ;NOT READY MOVB (R0)+,@#TPB ;PRINT NEXT CHARACTER BNE PRINT ;IF NE, MORE TO PRINT 40$: HALT ;HALT CPU BR 40$ ;DON'T ALLOW RE-TRY ENDCOD: .WORD -1 ;END OF MOVED CODE ; ; CHECK FOR CODE FIT INTO jJ$R"  . ( X "  "   @@ Z V@ R    :   2   2   $    ""  "  BOOT ; .IF GE, .ERROR ;;BOOT CODE EXTENDS INTO BITMAP .ENDC . = 400 ;MOVE PAST BITMAP ; ; THESE ROUTINES HANDLE TRAPS TO 4 AND 10 (WHILE BOOT STILL IN BLOCK ; ZERO OF MEMORY). ; ; TRAP4: JSR R0,PRINT ;TRAP TO 4 .ASCIZ \TRAP TO 4\ TRAP10: JSR R0,PRINT ;TRAP TO 10 .ASCIZ \TRAP TO 10\ .END  AFTERBEGIN:=FALSE END; "#########################################" "INITIALIZATION AND TERMINATION PROCEDURES" "#########################################" PROCEDURE BEGINPASS; BEGIN WITH LINK@ DO BEGIN SUMMARY:= SUMMARYOPTION IN OPTIONS; TEST:= TESTOPTION IN OPTIONS; CHECK:= CHECKOPTION IN OPTIONS; NUMBER:= NUMBEROPTION IN OPTIONS; GENERATE:= TRUE; MARK(RESETPOINT); ALLOCATE(JUMPTABLE, LABELS); ALLOCATE(BLOCKTABLE, BLOCKS); ALLOCATE(STACKTABLE, BLOCKS); ALLOCA(MODE, LABEL, PARAMLENGTH)": BEGIN READ3ARG; IF ARG1 = MODE3 THEN BEGIN WRITE2(CALLSYS2, (ARG2 - 2) * WORDLENGTH); ARG1:= WORDLENGTH; END ELSE BEGIN WRITE1(CALL2); WRITELOCATION; WRITEARG(ARG2); IF ARG1<>MODE1 THEN ARG3:=ARG3+WORDLENGTH; "INCLUDES COMPONENT ADDRESS IN PARAMLENGTH" IF CONCURRENT THEN ARG1:= ENTRY(STACKTABLE, ARG2) ELSE ARG1:= WORDLENGTH; END; PUSH(ARG1); POP(ARG1 + ARG3); END; ENTER1"(MODE, LABEL, PARAMLENGTH, VARLENGTE(CONSTTABLE, CONSTANTS DIV WORDLENGTH); END; LOCATION:= 0; CONSTANTS:= 0; INITLINE; IF TEST THEN PRINTFF; END; PROCEDURE ENDPASS; BEGIN WITH LINK@ DO BEGIN IF GENERATE THEN OPTIONS:= OPTIONS OR (.CODEOPTION.); NEW(TABLES); TABLES@.PROGLENGTH:= FOURWORDS + LOCATION + CONSTANTS; TABLES@.CODELENGTH:= LOCATION; TABLES@.STACKLENGTH:= STACKLENGTH; TABLES@.VARLENGTH:= VARLENGTH; TABLES@.JUMPTABLE:=JUMPTABLE; TABLES@.BLOCKTABLE:=BLOCKTABLE; TABLES@.STACKTABLE:=STACTH, TEMPLENGTH)": BEGIN READ5ARG; ENTERBLOCK(ARG2, ARG3, ARG4, ARG5); CASE ARG1 OF MODE1: WRITE5(ENTER2, BLOCK, POPLENGTH, LINE, VARLENGTH); MODE2: WRITE5(ENTERPROG2, POPLENGTH + WORDLENGTH, LINE, BLOCK, VARLENGTH); MODE3: WRITE5(ENTERPROC2, BLOCK, POPLENGTH, LINE, VARLENGTH); MODE4: WRITE5(ENTERCLAS2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH); MODE5: WRITE5(ENTERMON2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH); ECT ;<01> RE-CONVERT FOR RT-11 . = 0 ;<01> SET UP FOR 0 BASE ADDR. ;* ;* ;* .SBTTL PROGRAMMER IDENTIFICATION ;**** A DECLARATION OF RESPONSIBILITY ***** ;* ;* ;************** ;* ;* THE DESIGN OF THIS KERNEL FOR CONCURRENT PASCAL IS BY ;* ;* PER BRINCH HANSEN; ;* ;* THE HIGH LEVEL ENCODING IS BY ;* ;* PER BRINCH HANSEN, ;* ROBERT S. DEVERILL; ;* ;* THE ASSEMBLER LEVEL ENCODING IS BY ;* ;* ROBERT S. DEVERILL:_ ;* ;* BOTH OF WHOM KTABLE; TABLES@.CONSTTABLE:=CONSTTABLE; END; END; "#########" "OPERATORS" "#########" PROCEDURE SCAN; BEGIN DONE:=FALSE; REPEAT READ_IFL(OP); CASE OP OF PUSHCONST1"(VALUE)": BEGIN READ1ARG; WRITE2(PUSHCONST2, ARG1); PUSHWORD; END; PUSHVAR1"(TYPE, MODE, DISPL)": BEGIN READ3ARG; IF ARG1 = WORDTYPE THEN PUSHVALUE(ARG2, ARG3) ELSE BEGIN PUSHADDRESS(ARG2, ARG3); PUSHINDIRECT(ARG1); END; END; PUSHIND1"(TYPE)": BEGIN READ1ARG MODE6: WRITE2(BEGINPROC2, LINE); MODE7: WRITE5(BEGINCLAS2, BLOCK, FIVEWORDS, LINE, 0); MODE8: WRITE5(BEGINMON2, BLOCK, FIVEWORDS, LINE, 0); MODE10: END; END; RETURN1"(MODE)": BEGIN READ1ARG; CASE ARG1 OF MODE1: WRITE1(EXIT2); MODE2: WRITE1(EXITPROG2); MODE3: WRITE1(EXITPROC2); MODE4: WRITE1(EXITCLASS2); MODE5: WRITE1(EXITMON2); MODE6: WRITE1(ENDPROC2); MODE7: WRITE1(ENDCLASS2); MODE8: WRITE1(ENDMO; PUSHINDIRECT(ARG1) END; PUSHADDR1"(MODE, DISPL)": BEGIN READ2ARG; PUSHADDRESS(ARG1, ARG2) END; FIELD1"(DISPL)": BEGIN READ1ARG; IF ARG1<>0 THEN WRITE2(FIELD2,ARG1) END; INDEX1"(MIN, MAX, LENGTH)": BEGIN READ3ARG; WRITE4(INDEX2, ARG1, ARG2 - ARG1, ARG3); POPWORD; END; POINTER1: IF CHECK THEN WRITE1(POINTER2); VARIANT1"(TAGSET, DISPL)": BEGIN READ2ARG; IF CHECK THEN WRITE3(VARIANT2, ARG2, ARG1); END; RANGE1"(MIN, MAX)": BEGIN READ2ARG; IF CHECK THEN WRITE3(RANGE2, ARG1,N2); MODE10: END; EXITBLOCK; END; POP1"(LENGTH)": BEGIN READ1ARG; WRITE2(POP2, ARG1); POP(ARG1); END; NEWLINE1"(NUMBER)": BEGIN READ1ARG; NEWLINE(ARG1) END; ERROR1: GENERATE:= FALSE; CONSTANT1 "(LENGTH, VALUE)": BEGIN READ1ARG; FOR ARG3:= 1 TO ARG1 DIV WORDLENGTH DO BEGIN CONSTANTS:= CONSTANTS + 1; READ1ARG; ENTER(CONSTTABLE, CONSTANTS, ARG1); END; END; MESSAGE1"(PASS, ERROR)": BEGIN READ2ARG; ERROR(ARG1, ARG2) END; INCREMENT1: BEGIN WRITE1(I ARG2); END; ASSIGN1"(TYPE)": BEGIN READ1ARG; CASE ARG1 OF BYTETYPE: BEGIN WRITE1(COPYBYTE2); POPWORD END; WORDTYPE: BEGIN WRITE1(COPYWORD2); POPWORD END; REALTYPE: BEGIN WRITE1(COPYREAL2); POPREAL END; SETTYPE: BEGIN WRITE1(COPYSET2); POPSET END END; POPWORD; END; ASSIGNTAG1"(LENGTH)": BEGIN READ1ARG; IF ARG1 = 0 THEN WRITE1(COPYWORD2) ELSE WRITE2(COPYTAG2, ARG1 DIV WORDLENGTH); POPWORD; POPWORD; END; COPY1"(LENGTNCRWORD2); POPWORD END; DECREMENT1: BEGIN WRITE1(DECRWORD2); POPWORD END; PROCEDURE1"(STANDARDPROCEDURE)": BEGIN READ1ARG; IF (ARG1 >= MIN_PROC) AND (ARG1 <= MAX_PROC) THEN CASE ARG1 OF DELAY1: BEGIN WRITE1(DELAY2); POPWORD END; CONTINUE1: BEGIN WRITE1(CONTINUE2); POPWORD END; IO1: BEGIN WRITE1(IO2); POP(THREEWORDS) END; START1: WRITE1(START2); STOP1: BEGIN WRITE1(STOP2); POP(TWOWORDS) END; SETHEAP1: BEGIN WRITH)": BEGIN READ1ARG; WRITE2(COPYSTRUC2, ARG1 DIV WORDLENGTH); POPWORD; POPWORD; END; NEW1"(LENGTH, INITIALIZE)": BEGIN READ2ARG; IF (ARG2 = 1) & CHECK THEN WRITE3(NEWINIT2, BLOCK, ARG1) ELSE WRITE3(NEW2, BLOCK, ARG1); POPWORD; END; NOT1: WRITE1(NOT2); AND1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN BEGIN WRITE1(ANDWORD2); POPWORD END ELSE BEGIN WRITE1(ANDSET2); POPSET END; END; OR1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN BEE1(SETHEAP2); POPWORD END; WAIT1: WRITE1(WAIT2) END; END; INIT1"(MODE, LABEL, PARAMLENGTH, VARLENGTH)": BEGIN READ4ARG; IF ARG1 = MODE6 THEN BEGIN WRITE4(INITPROC2, ARG3, ARG4, ARG2); PUSH(FOURWORDS); POP(ARG3 + FIVEWORDS); END ELSE BEGIN IF ARG1 = MODE7 THEN WRITE2(INITCLASS2, ARG3) ELSE WRITE2(INITMON2, ARG3); ARG1:= ENTRY(STACKTABLE, ARG2); POP(ARG3); PUSH(ARG1); POP(ARG1 + WORDLENGTH); END; WRITELOCATION; WRITEARG(ARGGIN WRITE1(ORWORD2); POPWORD END ELSE BEGIN WRITE1(ORSET2); POPSET END; END; NEG1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN WRITE1(NEGWORD2) ELSE WRITE1(NEGREAL2); END; ADD1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN BEGIN WRITE1(ADDWORD2); POPWORD END ELSE BEGIN WRITE1(ADDREAL2); POPREAL END; END; SUB1"(TYPE)": BEGIN READ1ARG; CASE ARG1 OF WORDTYPE: BEGIN WRITE1(SUBWORD2); POPWORD END; REALTYPE: BEG2); END; PUSHLABEL1"(LABEL)": BEGIN READ1ARG; WRITE1(PUSHLABEL2); WRITELOCATION; WRITEARG(ARG1); PUSHWORD; END; CALLPROG1: BEGIN WRITE1(CALLPROG2); PUSHWORD END; EOM1"(VARLENGTH)": BEGIN DONE:=TRUE; READ1ARG; VARLENGTH:=ARG1; COMMENT(WORDLENGTH); WRITE1(EOM2) END END UNTIL DONE END; BEGIN INIT_PASS(LINK); BEGINPASS; SCAN; ENDPASS; NEXT_PASS(LINK); END. IN WRITE1(SUBREAL2); POPREAL END; SETTYPE: BEGIN WRITE1(SUBSET2); POPSET END END; END; MUL1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN BEGIN WRITE1(MULWORD2); POPWORD END ELSE BEGIN WRITE1(MULREAL2); POPREAL END; END; DIV1"(TYPE)": BEGIN READ1ARG; IF ARG1 = WORDTYPE THEN BEGIN WRITE1(DIVWORD2); POPWORD END ELSE BEGIN WRITE1(DIVREAL2); POPREAL END; END; MOD1"(TYPE)": BEGIN READ1ARG; WRITE1(MODWORD2); POPWORD END; "(NOT USED)" "(NOT USED8BDIKMOQSUWY[]_JLNPRTVXZ\^Hgikmoqsuwa~y{}xz|m z | ~ n p r t v x       %'!)" FUNCTION1"(STANDARDFUNC, TYPE)": BEGIN READ2ARG; IF (ARG1 >= MIN_FUNC) AND (ARG1 <= MAX_FUNC) THEN CASE ARG1 OF TRUNC1: BEGIN WRITE1(TRUNCREAL2); POPREAL; PUSHWORD END; ABS1: IF ARG2 = WORDTYPE THEN WRITE1(ABSWORD2) ELSE WRITE1(ABSREAL2); SUCC1: WRITE1(SUCCWORD2); PRED1: WRITE1(PREDWORD2); CONV1: BEGIN WRITE1(CONVWORD2); POPWORD; PUSHREAL END; EMPTY1: WRITE1(EMPTY2); ATTRIBUTE1:"PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP-11/45 CONCURRENT/SEQUENTIAL PASCAL COMPILER PASS 7: CODE ASSEMBLY 9 SEPTEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; LISTOPTION = 0; SUMMARYOPTION = WRITE1(ATTRIBUTE2); REALTIME1: BEGIN WRITE1(REALTIME2); PUSHWORD END END; END; BUILDSET1: BEGIN WRITE1(BUILDSET2); POPWORD END; COMPARE1"(COMPARISON, TYPE)": BEGIN READ2ARG; CASE ARG2 OF WORDTYPE: COMPAREWORD(ARG1); REALTYPE: COMPAREREAL(ARG1); SETTYPE: COMPARESET(ARG1) END; END; COMPSTRUC1"(COMPARISON, LENGTH)": BEGIN READ2ARG; COMPARESTRUCT(ARG1, ARG2) END; FUNCVALUE1"(MODE)": BEGIN READ2ARG; CASE ARG1 OF 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPTION = 5; MAXWORD = 100; TYPE FILE = 1..2; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; TABLEPTR = @TABLE; TABLE = RECORD NEXTPORTION: TABLEPTR; CONTENTS: ARRAY (.1..MAXWORD.) OF INTEGER END; TABLEPART = RECORD PROGLENGTH, CODELENGTH, STACKLENGTH, MODE1, MODE3: IF ARG2 = WORDTYPE THEN BEGIN WRITE2(FUNCVALUE2, 0); PUSHWORD END ELSE BEGIN WRITE2(FUNCVALUE2, 8); PUSHREAL END; MODE4, MODE5: IF ARG2 = WORDTYPE THEN BEGIN WRITE2(FUNCVALUE2, 16); PUSHWORD END ELSE BEGIN WRITE2(FUNCVALUE2, 24); PUSHREAL END; MODE9, MODE10: END; END; DEFLABEL1"(LABEL)": BEGIN READ1ARG; ENTER(JUMPTABLE, ARG1, LOCATION); IF NUMBER THEN WRITE2(NEWLINE2,LINE) END; JUMP1"(LABEL)S; TEMP:= 0; MAXTEMP:= 0; IF BLOCK=INITIALBLOCK THEN ENTER(JUMPTABLE,BLOCK,LOCATION) ELSE ENTER(BLOCKTABLE,BLOCK,LOCATION); "THE INITIAL BLOCK IS ONLY REFERENCED BY THE FIRST JUMP INSTRUCTION IN A PROGRAM, BUT NOT BY ANY CALL OR INIT INSTRUCTION" AFTERBEGIN:=TRUE END; PROCEDURE EXITBLOCK; BEGIN IF STACKLENGTH < STACK_LIMIT - MAXTEMP - VARLENGTH THEN STACKLENGTH:= STACKLENGTH + MAXTEMP + VARLENGTH + FIVEWORDS ELSE ERROR(THIS_PASS, STACK_ERROR); ENTER(STACKTABLE, BLOCK, STACKLENGTH); ": BEGIN READ1ARG; WRITE1(JUMP2); WRITELOCATION; WRITEARG(ARG1); END; FALSEJUMP1"(LABEL)": BEGIN READ1ARG; WRITE1(FALSEJUMP2); WRITELOCATION; WRITEARG(ARG1); POPWORD; END; CASEJUMP1"(MIN, MAX, LABELS)": BEGIN READ2ARG; ARG2:= ARG2 - ARG1; WRITE3(CASEJUMP2, ARG1, ARG2); WRITELOCATION; FOR ARG3:= 0 TO ARG2 DO BEGIN READ1ARG; WRITEARG(ARG1) END; POPWORD; END; INITVAR1"(LENGTH)": BEGIN READ1ARG; IF CHECK THEN WRITE2(INITVAR2, ARG1 DIV WORDLENGTH); END; CALL1"RITEOP(OP); COPYARG; READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; PROCEDURE WRITEPROC(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WRITEOP(OP); COPYARG; COPYARG; COPYBLOCK; READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; "########################" "HEAD AND TAIL PROCEDURES" "########################" PROCEDURE WRITEHEAD; BEGIN IF TEST THEN BEGIN PRINTFF; WRITE('('); WRITE('#'); WRITE(EOL); END; VARLENGTH: INTEGER; JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR END; TABLESPTR = @TABLEPART; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: TABLESPTR END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: IOVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 7: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PRNTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGER; PROCEDUROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.3.) DO BEGIN TAG:= INTTYPE; IF GENERATE THEN INT:= PROGLENGTH ELSE INT:= 0 END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGINE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" CONSTADDR1 = 0; LOCALADDR1 = 1; GLOBADDR1 = 2; PUSHCONST1 = 3; PUSHLOCAL1 = 4; PUSHGLOB1 = 5; PUSHIND1 = 6; PUSHBYTE1 = 7; PUSHREAL1 = 8; PUSHSET1 = 9; FIELD1 = 10; INDEX1 = 11; POINTER1 = 12; VARIANT1 IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, = 13; RANGE1 = 14; COPYBYTE1 = 15; COPYWORD1 = 16; COPYREAL1 = 17; COPYSET1 = 18; COPYTAG1 = 19; COPYSTRUC1 = 20; NEW1 = 21; NEWINIT1 = 22; NOT1 = 23; ANDWORD1 = 24; ANDSET1 = 25; ORWORD1 = 26; ORSET1 = 27; NEGWORD1 = 28; NEGREAL1 = 29; ADDWORD1 = 30; ADDREAL1 = 31; SUBWORD1 = 32; SUBREAL1 = 33; SUBSET1 = 34; MULWORD1 = 35; MULREAL1 = 36; DIVWORD1 = 37; DIVREAL1 = 38; MODWORD1 = 39; BUILDSET1 = 40; INSET1 PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INT= 41; LSWORD1 = 42; EQWORD1 = 43; GRWORD1 = 44; NLWORD1 = 45; NEWORD1 = 46; NGWORD1 = 47; LSREAL1 = 48; EQREAL1 = 49; GRREAL1 = 50; NLREAL1 = 51; NEREAL1 = 52; NGREAL1 = 53; EQSET1 = 54; NLSET1 = 55; NESET1 = 56; NGSET1 = 57; LSSTRUCT1 = 58; EQSTRUCT1 = 59; GRSTRUCT1 = 60; NLSTRUCT1 = 61; NESTRUCT1 = 62; NGSTRUCT1 = 63; FUNCVALUE1 = 64; JUMP1 = 65; FALSEJUMP1 = 66; CASEJUMP1 = 67; INITVAR1 = 68; CALEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('7'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "#######################" "INPUT/OUTPUT PROCEDURES" "#######################" PROCEDURE WRITEOP(OP: INTEGER); BEGIN IF GENERAL1 = 69; CALLSYS1 = 70; ENTER1 = 71; EXIT1 = 72; ENTERPROG1 = 73; EXITPROG1 = 74; BEGINCLAS1 = 75; ENDCLASS1 = 76; ENTERCLAS1 = 77; EXITCLASS1 = 78; BEGINMON1 = 79; ENDMON1 = 80; ENTERMON1 = 81; EXITMON1 = 82; BEGINPROC1 = 83; ENDPROC1 = 84; ENTERPROC1 = 85; EXITPROC1 = 86; POP1 = 87; NEWLINE1 = 88; INCRWORD1 = 89; DECRWORD1 = 90; INITCLASS1 = 91; INITMON1 = 92; INITPROC1 = 93; PUSHLABEL1 = 94; CALLPROG1 = 95; TRUNCREAL1 = 9TE THEN WRITE_IFL(OP) ELSE IF TEST THEN PRINTOP(OP); END; PROCEDURE WRITEARG(ARG: INTEGER); BEGIN IF GENERATE THEN WRITE_IFL(ARG) ELSE IF TEST THEN PRINTARG(ARG); END; PROCEDURE COPYARG; VAR ARG: INTEGER; BEGIN READ_IFL(ARG); IF GENERATE THEN WRITE_IFL(ARG) ELSE IF TEST THEN PRINTARG(ARG); END; PROCEDURE COPY1(OP: INTEGER); VAR ARG: INTEGER; BEGIN READ_IFL(ARG); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG) END ELSE IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END; END; PRO6; ABSWORD1 = 97; ABSREAL1 = 98; SUCCWORD1 = 99; PREDWORD1 = 100; CONVWORD1 = 101; EMPTY1 = 102; ATTRIBUTE1 = 103; REALTIME1 = 104; DELAY1 = 105; CONTINUE1 = 106; IO1 = 107; START1 = 108; STOP1 = 109; SETHEAP1 = 110; WAIT1 = 111; MESSAGE1=112; EOM1=113; "OUTPUT OPERATORS" CONSTADDR2 = 2; LOCALADDR2 = 4; GLOBADDR2 = 6; PUSHCONST2 = 8; PUSHLOCAL2 = 10; PUSHGLOB2 = 12; PUSHIND2 = 14; PUSHBYTE2 = 16; PUSHREAL2 = 18; PUSHSET2 = 20CEDURE COPY2(OP: INTEGER); VAR ARG1, ARG2: INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); END ELSE IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); END; END; PROCEDURE COPY3(OP: INTEGER); VAR ARG1, ARG2, ARG3: INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); END ELSE IF TEST THEN BEGI; FIELD2 = 22; INDEX2 = 24; POINTER2 = 26; VARIANT2 = 28; RANGE2 = 30; COPYBYTE2 = 32; COPYWORD2 = 34; COPYREAL2 = 36; COPYSET2 = 38; COPYTAG2 = 40; COPYSTRUC2 = 42; NEW2 = 44; NEWINIT2 = 46; NOT2 = 48; ANDWORD2 = 50; ANDSET2 = 52; ORWORD2 = 54; ORSET2 = 56; NEGWORD2 = 58; NEGREAL2 = 60; ADDWORD2 = 62; ADDREAL2 = 64; SUBWORD2 = 66; SUBREAL2 = 68; SUBSET2 = 70; MULWORD2 = 72; MULREAL2 = 74; DIVWORD2 = 7N PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); END; END; "################" "TABLE PROCEDURES" "################" FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER; VAR PORTION: TABLEPTR; J: INTEGER; BEGIN IF I=0 THEN ENTRY:=0 "REFERENCE TO UNDEFINED ROUTINE" ELSE BEGIN PORTION:= T; J:= I; WHILE J > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; J:= J - MAXWORD; END; ENTRY:= PORTION@.CONTENTS(.J.); END END; "########################" "JUMP AND CALL PROCEDURE6; DIVREAL2 = 78; MODWORD2 = 80; BUILDSET2 = 82; INSET2 = 84; LSWORD2 = 86; EQWORD2 = 88; GRWORD2 = 90; NLWORD2 = 92; NEWORD2 = 94; NGWORD2 = 96; LSREAL2 = 98; EQREAL2 = 100; GRREAL2 = 102; NLREAL2 = 104; NEREAL2 = 106; NGREAL2 = 108; EQSET2 = 110; NLSET2 = 112; NESET2 = 114; NGSET2 = 116; LSSTRUCT2 = 118; EQSTRUCT2 = 120; GRSTRUCT2 = 122; NLSTRUCT2 = 124; NESTRUCT2 = 126; NGSTRUCT2 = 128; FUNCVALUE2 = 130; JUMPS" "########################" PROCEDURE WRITEJUMP(OP: INTEGER); VAR LOCATION, JUMPLABEL: INTEGER; BEGIN WRITEOP(OP); READ_IFL(LOCATION); READ_IFL(JUMPLABEL); WRITEARG(ENTRY(JUMPTABLE, JUMPLABEL) - LOCATION); END; PROCEDURE WRITECASE(OP: INTEGER); VAR DIFF, LOCATION, CASELABEL, I: INTEGER; BEGIN WRITEOP(OP); COPYARG; READ_IFL(DIFF); WRITEARG(DIFF); READ_IFL(LOCATION); FOR I:= 0 TO DIFF DO BEGIN READ_IFL(CASELABEL); WRITEARG(ENTRY(JUMPTABLE, CASELABEL) - LOCATION); LOCATION:= L2 = 132; FALSEJUMP2 = 134; CASEJUMP2 = 136; INITVAR2 = 138; CALL2 = 140; CALLSYS2 = 142; ENTER2 = 144; EXIT2 = 146; ENTERPROG2 = 148; EXITPROG2 = 150; BEGINCLAS2 = 152; ENDCLASS2 = 154; ENTERCLAS2 = 156; EXITCLASS2 = 158; BEGINMON2 = 160; ENDMON2 = 162; ENTERMON2 = 164; EXITMON2 = 166; BEGINPROC2 = 168; ENDPROC2 = 170; ENTERPROC2 = 172; EXITPROC2 = 174; POP2 = 176; NEWLINE2 = 178; INCRWORD2 = 180; DECRWORD2 = 182; INITCLASS2 = 184; INITMONOCATION + WORDLENGTH; END; END; PROCEDURE WRITECALL(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WRITEOP(OP); READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; "###############################" "NEW, ENTER, AND EXIT PROCEDURES" "##############################" PROCEDURE WRITENEW(OP: INTEGER); VAR BLOCK, LENGTH: INTEGER; BEGIN WRITEOP(OP); READ_IFL(BLOCK); READ_IFL(LENGTH); WRITEARG(STACKLENGTH + LENGTH); WRITEARG(LENGTH); END; PROCEDURE COPYBLO2 = 186; INITPROC2 = 188; PUSHLABEL2 = 190; CALLPROG2 = 192; TRUNCREAL2 = 194; ABSWORD2 = 196; ABSREAL2 = 198; SUCCWORD2 = 200; PREDWORD2 = 202; CONVWORD2 = 204; EMPTY2 = 206; ATTRIBUTE2 = 208; REALTIME2 = 210; DELAY2 = 212; CONTINUE2 = 214; IO2 = 216; START2 = 218; STOP2 = 220; SETHEAP2 = 222; WAIT2 = 224; "OTHER CONSTANTS" STACKMARGIN = 20 "BYTES EXTRA PER PROCEDURE CALL"; PDP11 = TRUE; CONCURRENT = TRUE; INITIALBLOCK = 1; TYPE SHORTTEXT = ARRACK; BEGIN READ_IFL(BLOCK); STACKLENGTH:= ENTRY(STACKTABLE, BLOCK) + STACKMARGIN; WRITEARG(STACKLENGTH); END; PROCEDURE WRITEENTER(OP: INTEGER); BEGIN WRITEOP(OP); COPYBLOCK; COPYARG; COPYARG; COPYARG; END; PROCEDURE WRITEEXIT(OP: INTEGER); BEGIN WRITEOP(OP); END; PROCEDURE WRITEPROG(OP: INTEGER); BEGIN WRITEOP(OP); COPYARG; COPYARG; COPYBLOCK; COPYARG; END; "###############" "INIT PROCEDURES" "###############" PROCEDURE WRITEINIT(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WY (.1..8.) OF CHAR; MEDTEXT = ARRAY (.1..16.) OF CHAR; LONGTEXT = ARRAY (.1..24.) OF CHAR; VAR LINK: PASSPTR; SUMMARY, TEST, GENERATE: BOOLEAN; JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR; CONSTANTS: INTEGER; PROGLENGTH, CODELENGTH, STACKLENGTH, VARLENGTH: INTEGER; BLOCK: INTEGER; DONE: BOOLEAN; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK bdfhjlnprtvcem z | ~ n p r t v x       %'!MANY_ARGS_ERROR=8; CASERANGE_ERROR=9; CASETYPE_ERROR=10; AMBICASE_ERROR=11; WITH_ERROR=12; INIT_ERROR=13; PROC_USE_ERROR=14; NAME_ERROR=15; COMP_ERROR=16; SUB_ERROR=17; INTERFACE_ERROR=18; CALL_NAME_ERROR=19; ARROW_ERROR=20; RESOLVE_ERROR=21; BEGIN PRINTHEAD(3, LINE); CASE NO OF UNRES_ERROR: PRINTLONG ('UNRESOLVED ROUTINE. '); AMBIGUITY_ERROR: PRINTLONG ('AMBIGUOUS IDENTIFIER. '); ABORT_ERROR: PRINTLONG ('COMPILER ABORT. '); CONSTID_ERROR: "CONCURRENT PASCAL TEST OF LEXICAL ANALYSIS" (TEST,SUMMARY,CHECK,102) BEGIN IF CASE WHILE REPEAT FOR CYCLE WITH INIT ID 0.0 'AB' 0 'A' ( NOT (. SET ARRAY RECORD CLASS MONITOR PROCESS . * / DIV ejlnprtvm z | ~ n p r t v x       %'! MOD AND & + - OR = <> <= >= < > IN CONST TYPE VAR PROCEDURE FUNCTION PROGRAM ; ) .. OF , .) : END ENTRY UNIV := THEN ELSE DO UNT"CONCURRENT PASCAL TEST OF SYNTAX ANALYSIS" " NEW OPTIONS " (TEST, SUMMARY, CHECK, 10) TYPE ID2 = INTEGER; CONST ID17 = 20; CONST ID4=167; ID5=1.3E01; ID7 = 'A'; ID8 = 'PASCAL'; TYPE ID9 = ID10; ID = ARRAY (.ID, ID.) OF T; ID13 = RECORD ID14: ID15 END; ID16 = SET OF ID3; ID17 = CLASS BEGIN END; TYPE ID1 = ID2; ID3 = ID4..16; ID = (E1, E2); ID6 = 0..ID7; TYPE ID = RECORD FIELD: T; ID1,ID2: ID3 END; VAR ENTRY ID1, ID2: INTEGER; PROCEDURE ENTRY IL TO DOWNTO # $ @ % _  ? " " "" 3.. 3.) ALHARTMANNALHARTMANNALHARTMANN ALHARTMANNALHARTMANNALHARTMANN 32766 32767 32768 32769 1.0 1E0 1E1 1E-1 1E+1 1.0E1 10E37 10E38 0.1E-37 0.1E-38 1E50 1E9999999999999 999999999999999999999999999999999999999999999999999999999999999999999E0 0.999999999999999999999999999999999999999999999999999999999 '(:1:)' '(: 1 :)' '(:*:)' '(:500:)' 'ABC(:5:)DE' ' FALSE TRUE INTEGER BOOLEAN CHAR WRITEARG(PROGLENGTH); WRITEARG(CODELENGTH); WRITEARG(STACKLENGTH); WRITEARG(VARLENGTH); END; PROCEDURE WRITETAIL; VAR I: INTEGER; BEGIN FOR I:= 1 TO CONSTANTS DIV WORDLENGTH DO WRITEARG(ENTRY(CONSTTABLE, I)); IF TEST THEN BEGIN WRITE(EOL); WRITE('#'); WRITE(')'); END; END; "###################" "PRINTING PROCEDURES" "###################" PROCEDURE PRINTSHORT(T: SHORTTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= QUEUE ABS ATTRIBUTE CHR CONTINUE CONV DELAY EMPTY IO ORD PRED STOP REALTIME SETHEAP SUCC TRUNC START WAIT REAL " 999999999999999999999999999999999999999999999999999999 '(:1:)' '(: 1 :)' '(:*:)' '(:500:)' 'ABC(:5:)DE' ' FALSE TRUE INTEGER BOOLEAN CHAR T(.I.) END; END; PROCEDURE PRINTMED(T: MEDTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END; END; PROCEDURE PRINTLONG(T: LONGTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END; END; "################" "ERROR PROCEDURES" "################" PROCEDURE PRINTHEAD(PASS, LINE: INTEGER); VAR M: MEDTEXT; S: SHORTTEXT; BEGIN PRINTEOL; M:= '****** PASS . '; PRINTMEDID6; BEGIN END; PROCEDURE ID7; BEGIN END; FUNCTION ENTRY ID8: ID9; BEGIN END; FUNCTION ID10: ID11; BEGIN END; PROGRAM ID12; ENTRY ID13,ID14; PROGRAM ID16; PROCEDURE ID1; BEGIN END; PROCEDURE ID2(VAR ID3,ID4,ID5: UNIV ID6; ID3,ID4: ID6); BEGIN END; BEGIN "STATEMENTS TEST CASES" ID1:=0; ID2; ID3(.1, 2, 3.); BEGIN ;;; END; IF B THEN IF B THEN ELSE; CASE I OF 1, 3: ; 4: END; WHILE B DO; REPEAT UNTIL B; FOR I:= L TO U DO FOR J:= U DOWNTO L DO; CYCLE END; WITH R(M); PRINTABS(PASS); S:= ' LINE . '; PRINTSHORT(S); PRINTABS(LINE); WRITE(' '); END; PROCEDURE PASS1ERROR(NO, LINE: INTEGER); CONST COMMENT_ERROR=1; NUMBER_ERROR=2; INSERT_ERROR=3; STRING_ERROR=4; CHAR_ERROR=5; BEGIN PRINTHEAD(1, LINE); CASE NO OF COMMENT_ERROR: PRINTMED('ENDLESS COMMENT.'); NUMBER_ERROR: PRINTMED('INVALID NUMBER. '); INSERT_ERROR: PRINTMED('TABLE OVERFLOW. '); STRING_ERROR: PRINTMED('INVALID STRING. '); CHAR_ERROR: PRINTMED('BAD CHARACTER. ' DO; INIT COMPONENT; "EXPRESSION TEST CASES" ID:= (ID < ID) OR (ID > ID) OR (ID .FIELD <= ID) AND (ID(.1.) >= ID) AND NOT(-ID =+ID) AND (ID <> ID) OR (ID IN (.ID.)); ID:= 1 + 'A' - ID(ARG1, ARG2) * 'PASCAL' / 1.0 DIV 0 MOD 0; END "THAT'S ALL FOLKS" "********************" . "URRRRRP" .1, 2, 3.); BEGIN ;;; END; IF B THEN IF B THEN ELSE; CASE I OF 1, 3: ; 4: END; WHILE B DO; REPEAT UNTIL B; FOR I:= L TO U DO FOR J:= U DOWNTO L DO; CYCLE END; WITH R) END; PRINTEOL; END; PROCEDURE PASS2ERROR(NO, LINE: INTEGER); CONST PROG_ERROR=1; DEC_ERROR=2; CONSTDEF_ERROR=3; TYPEDEF_ERROR=4; TYPE_ERROR=5; ENUM_ERROR=6; SUBR_ERROR=7; SET_ERROR=8; ARRAY_ERROR=9; RECORD_ERROR=10; STACK_ERROR=11; VAR_ERROR=12; ROUTINE_ERROR=13; PROC_ERROR=14; FUNC_ERROR=15; WITH_ERROR=16; PARM_ERROR=17; BODY_ERROR=18; STATS_ERROR=19; STAT_ERROR=20; IDSTAT_ERROR=21; ARG_ERROR=22; COMP_ERROR=23; IF_ERROR=2prtv  m z | ~ n p r t v x       %'!4; CASE_ERROR=25; LABEL_ERROR=26; WHILE_ERROR=27; REPEAT_ERROR=28; FOR_ERROR=29; CYCLE_ERROR=30; EXPR_ERROR=31; VARIABLE_ERROR=32; CONSTANT_ERROR=33; INIT_ERROR=34; MPROG_ERROR=35; POINTER_ERROR=36; PREFIX_ERROR=37; INTERFACE_ERROR=38; BEGIN PRINTHEAD(2, LINE); CASE NO OF PROG_ERROR: PRINTMED('SEQL PROGRAM. '); DEC_ERROR: PRINTMED('DECLARATION. '); CONSTDEF_ERROR: PRINTMED('CONSTANT DFN. '); TYPEDEF_ERROR: PRINTMED('TYPE D"THIS IS A TEST OF CONCURRENT PASCAL SYNTAX ANALYSIS ERROR RECOVERY" (TEST) , CONST ID = - ; = ; , TYPE , = ; T = PROCESS + END; T = CLASS CLASS END END; ID = ( ; ID = ID .. ; ID = SET ; ID = ARRAY ; ID = RECORD ; VAR ID , ; , PROCEDURE BEGIN PROCEDURE ID BEGIN END / PROCEDURE / ENTRY / ID / ; / BEGIN / END / ; / FUNCTION BEGIN END PROGRAM ; BEGIN ID:= ID. + ID(. , .) - ID( , ) * , < (. , .) ; ID:= ID ID ID ID ID ID; WITH , ; FOR ID ; REPEAT ; CASE END; IF ; , REPEAT BEGIN UNTIL ; END, RFN. '); TYPE_ERROR: PRINTMED('TYPE. '); ENUM_ERROR: PRINTMED('ENUMERATION TYP.'); SUBR_ERROR: PRINTMED('SUBRANGE TYPE. '); SET_ERROR: PRINTMED('SET TYPE. '); ARRAY_ERROR: PRINTMED('ARRAY TYPE. '); RECORD_ERROR: PRINTMED('RECORD TYPE. '); STACK_ERROR: PRINTMED('STACK LENGTH. '); VAR_ERROR: PRINTMED('VAR DECLARATION.'); ROUTINE_ERROR: PRINTMED('ROUTINE. '); PROC_ERROR: tv    m z | ~ n p r t v x       %'! PRINTMED('PROCEDURE. '); FUNC_ERROR: PRINTMED('FUNCTION. '); WITH_ERROR: PRINTMED('WITH STMT. '); PARM_ERROR: PRINTMED('PARAMETER. '); BODY_ERROR: PRINTMED('BODY. '); STATS_ERROR: PRINTMED('STMT LIST. '); STAT_ERROR: PRINTMED('STATEMENT. '); IDSTAT_ERROR: PRINTMED('ID STMT. '); ARG_ERROR: PRINTMED('ARGUMENT. '); COMP_ERROR: PRINTMED('COMPOUND STMT. '); "CONCURRENT PASCAL SCOPE ANALYSIS TEST PROGRAM FOR CORRECT CASES" (TEST) CONST CONST1=0.0; CONST2='PASCAL'; CONST3=0; CONST4=CONST3; CONST5='A'; TYPE TYPE1=INTEGER; TYPE2=TYPE1; TYPE3=(ENUM1,ENUM2,ENUM3); TYPE4=0..10; TYPE5=SET OF TYPE4; TYPE6=ARRAY (.TYPE4.) OF TYPE1; TYPE7=RECORD FIELD1,FIELD2:TYPE2; FIELD3,FIELD4: TYPE5 END; TYPE8=CLASS VAR ENTRY EVAR1,EVAR2: INTEGER; PROCEDURE ENTRY PROC2; BEGIN END; FUNCTION ENTRY FUNC2:TYPE1; BEGIN FUNC2:=0 END; PROGRAM IF_ERROR: PRINTMED('IF STMT. '); CASE_ERROR: PRINTMED('CASE STMT. '); LABEL_ERROR: PRINTMED('LABEL LIST. '); WHILE_ERROR: PRINTMED('WHILE STMT. '); REPEAT_ERROR: PRINTMED('REPEAT STMT. '); FOR_ERROR: PRINTMED('FOR STMT. '); CYCLE_ERROR: PRINTMED('CYCLE STMT. '); EXPR_ERROR: PRINTMED('EXPRESSION. '); VARIABLE_ERROR: PRINTMED('VARIABLE. '); CONSTANT_ERROR: PRINTMED('CONSTPROG1(PARM1:TYPE5); ENTRY INTERFACE1,INTERFACE2; PROCEDURE ENTRY INTERFACE1; BEGIN END; PROCEDURE ENTRY INTERFACE2; BEGIN END; BEGIN END; CLASS1 = CLASS PROGRAM P; ENTRY E1, E2; PROCEDURE ENTRY E1; BEGIN END; FUNCTION ENTRY E2:INTEGER; BEGIN E2:= 0 END; BEGIN "CLASS1" END; CLASS2 = CLASS PROGRAM P; ENTRY E1, E2; PROCEDURE ENTRY E1; BEGIN END; FUNCTION ENTRY E2:INTEGER; BEGIN E2:= 0 END; BEGIN "CLASS2" END; TYPE9=PROCESS +100 BEGIN END; TYPE10=MONITOR (PARM1:TYPE1); BEGIN END; VAR VAR1,VAR2:TANT. '); INIT_ERROR: PRINTMED('INIT STMT. '); MPROG_ERROR: PRINTMED('TERMINATION. '); PREFIX_ERROR: PRINTMED('PREFIX. '); INTERFACE_ERROR: PRINTMED('INTERFACE. '); POINTER_ERROR: PRINTMED('POINTER TYPE. ') END; PRINTSHORT(' SYNTAX.'); PRINTEOL; END; PROCEDURE PASS3ERROR(NO, LINE: INTEGER); CONST UNRES_ERROR=1; AMBIGUITY_ERROR=2; ABORT_ERROR=3; CONSTID_ERROR=4; SUBR_ERROR=5; FEW_ARGS_ERROR=6; ARG_LIST_ERROR=7; : WRITECALL(PUSHLABEL2); CALLPROG1: WRITEOP(CALLPROG2); TRUNCREAL1: WRITEOP(TRUNCREAL2); ABSWORD1: WRITEOP(ABSWORD2); ABSREAL1: WRITEOP(ABSREAL2); SUCCWORD1: WRITEOP(SUCCWORD2); PREDWORD1: WRITEOP(PREDWORD2); CONVWORD1: WRITEOP(CONVWORD2); EMPTY1: WRITEOP(EMPTY2); ATTRIBUTE1: WRITEOP(ATTRIBUTE2); REALTIME1: WRITEOP(REALTIME2); DELAY1: WRITEOP(DELAY2); CONTINUE1: WRITEOP(CONTINUE2); IO1: WRITEOP(IO2); START1: WRITEOP(START2); STOP1: WRITEOP(STOP2); SETHEAP1: EST OR GENERATE; GENERATE:= FALSE; END; PROGLENGTH:= TABLES@.PROGLENGTH; CODELENGTH:= TABLES@.CODELENGTH; STACKLENGTH:= TABLES@.STACKLENGTH + STACKMARGIN; VARLENGTH:= TABLES@.VARLENGTH; JUMPTABLE:= TABLES@.JUMPTABLE; BLOCKTABLE:= TABLES@.BLOCKTABLE; STACKTABLE:= TABLES@.STACKTABLE; CONSTTABLE:= TABLES@.CONSTTABLE; END; CONSTANTS:= LINK@.CONSTANTS; WRITEHEAD; END; PROCEDURE ENDPASS; BEGIN WRITETAIL; IF SUMMARY THEN PRINTSUMMARY; RELEASE(LINWRITEOP(SETHEAP2); WAIT1: WRITEOP(WAIT2); MESSAGE1"(PASS, ERROR, LINE)": PRINTMESSAGE; EOM1: DONE:=TRUE END UNTIL DONE; END "OF SCAN"; BEGIN BEGINPASS; SCAN; ENDPASS; NEXT_PASS(LINK) END. K@.RESETPOINT); END; "#################" "OPERATOR SCANNING" "#################" PROCEDURE SCAN; VAR OP: INTEGER; BEGIN DONE:= FALSE; REPEAT READ_IFL(OP); CASE OP OF CONSTADDR1"(DISPL)": COPY1(CONSTADDR2); LOCALADDR1"(DISPL)": COPY1(LOCALADDR2); GLOBADDR1"(DISPL)": COPY1(GLOBADDR2); PUSHCONST1"(VALUE)": COPY1(PUSHCONST2); PUSHLOCAL1"(DISPL)": COPY1(PUSHLOCAL2); PUSHGLOB1"(DISPL)": COPY1(PUSHGLOB2); PUSHIND1: WRITEOP(PUSHIND2); PUSHBYTE1: WRITEOP(PUSHBYTE2); PUSHREAL1: WRITEOP(P!#%' "$)+-/13579;=?*,.02468:<>(FHJLNPRTV@BDACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J USHREAL2); PUSHSET1: WRITEOP(PUSHSET2); FIELD1"(DISPL)": COPY1(FIELD2); INDEX1"(MIN, MAX-MIN, LENGTH)": COPY3(INDEX2); POINTER1: WRITEOP(POINTER2); VARIANT1"(DISPL, TAGSET)": COPY2(VARIANT2); RANGE1"(MIN, MAX)": COPY2(RANGE2); COPYBYTE1: WRITEOP(COPYBYTE2); COPYWORD1: WRITEOP(COPYWORD2); COPYREAL1: WRITEOP(COPYREAL2); COPYSET1: WRITEOP(COPYSET2); COPYTAG1"(LENGTH DIV WORDLENGTH)": COPY1(COPYTAG2); COPYSTRUC1"(LENGTH DIV WORDLENGTH)": COPY1(COPYSTRUC2); NEW1"(BLOCK, LENGT PRINTLONG ('INVALID CONSTANT. '); SUBR_ERROR: PRINTLONG ('INVALID SUBRANGE. '); FEW_ARGS_ERROR: PRINTLONG ('MISSING ARGUMENT. '); ARG_LIST_ERROR: PRINTLONG ('NOT A ROUTINE. '); MANY_ARGS_ERROR: PRINTLONG ('TOO MANY ARGUMENTS. '); CASERANGE_ERROR: PRINTLONG ('LABEL VALUE TOO LARGE. '); CASETYPE_ERROR: PRINTLONG ('INVALID LABEL. '); AMBICASE_ERROR: PRINTLONG ('AMBIGUOUS LABEL. '); WITH_ERROR: PRINTLOH)": WRITENEW(NEW2); NEWINIT1"(BLOCK, LENGTH)": WRITENEW(NEWINIT2); NOT1: WRITEOP(NOT2); ANDWORD1: WRITEOP(ANDWORD2); ANDSET1: WRITEOP(ANDSET2); ORWORD1: WRITEOP(ORWORD2); ORSET1: WRITEOP(ORSET2); NEGWORD1: WRITEOP(NEGWORD2); NEGREAL1: WRITEOP(NEGREAL2); ADDWORD1: WRITEOP(ADDWORD2); ADDREAL1: WRITEOP(ADDREAL2); SUBWORD1: WRITEOP(SUBWORD2); SUBREAL1: WRITEOP(SUBREAL2); SUBSET1: WRITEOP(SUBSET2); MULWORD1: WRITEOP(MULWORD2); MULREAL1: WRITEOP(MULREAL2); DIVWORD1NG ('INVALID WITH VARIABLE. '); INIT_ERROR: PRINTLONG ('INVALID INITIALIZATION. '); PROC_USE_ERROR: PRINTLONG ('NOT A FUNCTION. '); NAME_ERROR: PRINTLONG ('INVALID NAME USAGE. '); COMP_ERROR: PRINTLONG ('INVALID SELECTION. '); SUB_ERROR: PRINTLONG ('INVALID SUBSCRIPTING. '); INTERFACE_ERROR: PRINTLONG ('INVALID INTERFACE. '); CALL_NAME_ERROR: PRINTLONG ('INVALID CALL. '); ARROW_ERROR: PRINTLONG ('INV: WRITEOP(DIVWORD2); DIVREAL1: WRITEOP(DIVREAL2); MODWORD1: WRITEOP(MODWORD2); BUILDSET1: WRITEOP(BUILDSET2); INSET1: WRITEOP(INSET2); LSWORD1: WRITEOP(LSWORD2); EQWORD1: WRITEOP(EQWORD2); GRWORD1: WRITEOP(GRWORD2); NLWORD1: WRITEOP(NLWORD2); NEWORD1: WRITEOP(NEWORD2); NGWORD1: WRITEOP(NGWORD2); LSREAL1: WRITEOP(LSREAL2); EQREAL1: WRITEOP(EQREAL2); GRREAL1: WRITEOP(GRREAL2); NLREAL1: WRITEOP(NLREAL2); NEREAL1: WRITEOP(NEREAL2); NGREAL1: WRITEOP(NGREAL2); EQYPE1; ENTRY VAR3,VAR4:TYPE2; VAR5:TYPE7; VAR6:TYPE8; VAR7:TYPE9; VAR8: TYPE10; VAR9:TYPE5; VAR10: TYPE6; PROCEDURE PROC1( PARM1,PARM2:TYPE1; VAR PARM3:TYPE2; PARM4:UNIV TYPE2; VAR PARM5: UNIV TYPE2); CONST LCONST1=1; TYPE LTYPE=1..2; VAR LVAR:LTYPE; BEGIN END; PROCEDURE PROC3; BEGIN END; FUNCTION FUNC1(PARM1:TYPE1):TYPE1; BEGIN END; FUNCTION FUNC3:TYPE1; BEGIN END; BEGIN P; VAR1:='A'; VAR1:='PASCAL'; VAR1:=0.0; PROC1(VAR1,VAR2,VAR3,VAR4,VAR5); ALID POINTING. '); RESOLVE_ERROR: PRINTLONG ('INVALID RESOLUTION. ') END; PRINTEOL; END; PROCEDURE PASS4ERROR(NO, LINE: INTEGER); CONST NESTING_ERROR=1; ADDRESS_ERROR=2; ACTIVE_ERROR=3; QUEUE_ERROR=4; PROCESS_ERROR=5; ENTRY_ERROR=6; FUNCTYPE_ERROR=7; TYPEID_ERROR=8; ENUM1_ERROR=9; ENUM2_ERROR=10; INDEX_ERROR=11; MEMBER_ERROR=12; STACK_ERROR=13; PARM1_ERROR=14; PARM2_ERROR=15; PARM3_ERROR=16; PARM4_ERROR=17; PARM5_ERROR=18; PARM6_ERROR=19 PROC3; IF VAR1 THEN PROC3 ELSE; CASE VAR1 OF 1,2,3:; 4,5:; 6: END; WHILE VAR1 DO; REPEAT UNTIL VAR1; FOR VAR1:=1 TO 2 DO; FOR VAR1:=2 DOWNTO 1 DO; CYCLE END; WITH VAR5 DO BEGIN FIELD1:=FIELD2; VAR1:=0 END; WITH VAR6 DO BEGIN PROC2; VAR1:=FUNC2; EVAR1:=EVAR2 END; INIT VAR6,VAR7,VAR8(VAR1); VAR1:= (CONST1 < CONST2) OR (CONST3 = VAR10(.0.)) OR NOT (CONST5 > 0) OR (0<=0) OR (0<>0) OR (0>=0) OR (0 IN (.0.)); VAR2:=+VAR1; VAR2:=-VAR1; VAR2:=0; PARM7_ERROR=20; COMPILER_ERROR=21; STRING_ERROR=22; RESOLVE_ERROR=23; TAG_ERROR=24; POINTER_ERROR=25; BEGIN PRINTHEAD(4, LINE); CASE NO OF NESTING_ERROR: PRINTLONG ('INVALID NESTING. '); ADDRESS_ERROR: PRINTLONG ('ADDRESS OVERFLOW. '); ACTIVE_ERROR: PRINTLONG ('ACTIVE VARIABLE. '); QUEUE_ERROR: PRINTLONG ('QUEUE VARIABLE. '); PROCESS_ERROR: PRINTLONG ('NESTED PROCESS. '); ENTRY_ERROR: PRINTLONG ('INVALID +0-0; VAR2:=(0*0/0 DIV 0 MOD 0) AND 0; VAR2:=VAR1; VAR2:=FUNC1(VAR1); VAR6.EVAR1:=VAR6.EVAR2; VAR2:=VAR5.FIELD1; VAR2:=VAR6.FUNC2; VAR6.PROC2; VAR2:=FUNC3 END. CYCLE END; WITH VAR5 DO BEGIN FIELD1:=FIELD2; VAR1:=0 END; WITH VAR6 DO BEGIN PROC2; VAR1:=FUNC2; EVAR1:=EVAR2 END; INIT VAR6,VAR7,VAR8(VAR1); VAR1:= (CONST1 < CONST2) OR (CONST3 = VAR10(.0.)) OR NOT (CONST5 > 0) OR (0<=0) OR (0<>0) OR (0>=0) OR (0 IN (.0.)); VAR2:=+VAR1; VAR2:=-VAR1; VAR2:=0ENTRY VARIABLE. '); FUNCTYPE_ERROR: PRINTLONG ('INVALID FUNCTION TYPE. '); TYPEID_ERROR: ; ENUM1_ERROR: PRINTLONG ('RECORD ENUMERATION. '); ENUM2_ERROR: PRINTLONG ('LONG ENUMERATION. '); INDEX_ERROR: PRINTLONG ('INVALID INDEX TYPE. '); MEMBER_ERROR: PRINTLONG ('INVALID MEMBER TYPE. '); STACK_ERROR: PRINTLONG ('PROCESS STACK USAGE. '); PARM1_ERROR,PARM2_ERROR,PARM3_ERROR,PARM4_ERROR, PARM5_ERROR,PARM6_ERROR, PARM7_ERSET1: WRITEOP(EQSET2); NLSET1: WRITEOP(NLSET2); NESET1: WRITEOP(NESET2); NGSET1: WRITEOP(NGSET2); LSSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(LSSTRUCT2); EQSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(EQSTRUCT2); GRSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(GRSTRUCT2); NLSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NLSTRUCT2); NESTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NESTRUCT2); NGSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NGSTRUCT2); FUNCVALUE1"(KIND)": COPY1(FUNCVALUE2); JUMP1"(LOCATION, LROR: PRINTLONG ('INVALID PARAMETER. '); COMPILER_ERROR: PRINTLONG ('COMPILER ABORT. '); STRING_ERROR: PRINTLONG ('ODD LENGTH STRING TYPE. '); RESOLVE_ERROR: PRINTLONG ('INVALID RESOLUTION. '); TAG_ERROR: PRINTLONG ('INVALID TAG TYPE. '); POINTER_ERROR: PRINTLONG ('RECORD POINTER TYPE. ') END; PRINTEOL; END; PROCEDURE PASS5ERROR(NO, LINE: INTEGER); CONST COMPILER_ERROR=1; TYPE_ERROR=2; ADDRESS_ERROR=3; ASSIGN_ERROR=4; ABEL)": WRITEJUMP(JUMP2); FALSEJUMP1"(LOCATION, LABEL)": WRITEJUMP(FALSEJUMP2); CASEJUMP1"(MIN, MAX-MIN, LOCATION, LABELS)": WRITECASE(CASEJUMP2); INITVAR1"(LENGTH DIV WORDLENGTH)": COPY1(INITVAR2); CALL1"(LOCATION, BLOCK)": WRITECALL(CALL2); CALLSYS1"(ENTRY * WORDLENGTH)": COPY1(CALLSYS2); ENTER1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTER2); EXIT1: WRITEEXIT(EXIT2); ENTERPROG1"(POPLENGTH, LINE, BLOCK, VARLENGTH)": WRITEPROG(ENTERPROG2); EXITPROG1: WRITEEXIT(EXITPROGINIT_ERROR = 5; BEGIN PRINTHEAD(5, LINE); CASE NO OF COMPILER_ERROR: PRINTMED('COMPILER ABORT. '); TYPE_ERROR: PRINTMED('OPERAND TYPE. '); ADDRESS_ERROR: PRINTMED('NOT A VARIABLE. '); ASSIGN_ERROR: PRINTMED('NOT ASSIGNABLE. '); INIT_ERROR: PRINTLONG ('INVALID INITIALIZATION. ') END; PRINTEOL; END; PROCEDURE PASS6ERROR(NO, LINE: INTEGER); CONST STACK_ERROR = 1; CODE_ERROR = 2; BEGIN PRINTHEAD(6, LINE); CASE NO OF STACK_ERROR: PRINTMED('TOO MUC2); BEGINCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(BEGINCLAS2); ENDCLASS1: WRITEEXIT(ENDCLASS2); ENTERCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERCLAS2); EXITCLASS1: WRITEEXIT(EXITCLASS2); BEGINMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(BEGINMON2); ENDMON1: WRITEEXIT(ENDMON2); ENTERMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERMON2); EXITMON1: WRITEEXIT(EXITMON2); BEGINPROC1"(LINE)": COPY1(BEGINPROC2); ENDPROC1: WRITEEXIT(ENDH STACK. '); CODE_ERROR: PRINTMED('TOO MUCH CODE. ') END; PRINTEOL; END; PROCEDURE PRINTMESSAGE; VAR PASS, ERROR, LINE: INTEGER; BEGIN OK:= TEST; READ_IFL(PASS); READ_IFL(ERROR); READ_IFL(LINE); CASE PASS OF 1: PASS1ERROR(ERROR, LINE); 2: PASS2ERROR(ERROR, LINE); 3: PASS3ERROR(ERROR, LINE); 4: PASS4ERROR(ERROR, LINE); 5: PASS5ERROR(ERROR, LINE); 6: PASS6ERROR(ERROR, LINE) END; END; "##################" "SUMMARY PROCEDURES" "##################" PROCEDURE PRPROC2); ENTERPROC1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERPROC2); EXITPROC1: WRITEEXIT(EXITPROC2); POP1"(LENGTH)": COPY1(POP2); NEWLINE1"(NUMBER)": COPY1(NEWLINE2); INCRWORD1: WRITEOP(INCRWORD2); DECRWORD1: WRITEOP(DECRWORD2); INITCLASS1"(PARAMLENGTH, LOCATION, BLOCK)": WRITEINIT(INITCLASS2); INITMON1"(PARAMLENGTH, LOCATION, BLOCK)": WRITEINIT(INITMON2); INITPROC1"(PARAMLENGTH, VARLENGTH, BLOCK, LOCATION, BLOCK)": WRITEPROC(INITPROC2); PUSHLABEL1"(LOCATION, BLOCK)"INTSUMMARY; BEGIN WRITE(EOL); PRINTLONG('PROCEDURE PRINTSUMMARY .'); PRINTSHORT('CALLED. ') END; "#########################################" "INITIALIZATION AND TERMINATION PROCEDURES" "#########################################" PROCEDURE BEGINPASS; BEGIN INIT_PASS(LINK); WITH LINK@ DO BEGIN SUMMARY:= SUMMARYOPTION IN OPTIONS; TEST:= TESTOPTION IN OPTIONS; GENERATE:= CODEOPTION IN OPTIONS; IF PDP11 THEN GENERATE:= GENERATE & NOT TEST ELSE BEGIN TEST:= T   0 X  t(   "  " " X "> h "   2 .d TP  V  Z6   (!Z .d". . 8~ T V j \ N @ :2 >$  @vl( 8B /X  :B  Xj " 82 0X(c   R 8h 0X 8 8z 2L@B"0  "  " " " "<1  .Bd TL    ""  .d X@ P^4"" "X T" " `" ". . 1X  8, V 8& X  ""N >"  T* 2X  b " 3X   8 1X   8 " `T 88&l("   4XB"2  "  "  "  "  "XR .d B8& "  " \ . Bd "  0" "  8"8 8 "p. . BB"(c  "  "  8"   @! 2 R T* .X   " Z" 5X \  D J"#">"$"&"%" 88 b .X X>  X& v  8 T &8&$  6X" X " "H& s  "  "  "  "  0"$ .Bd ^  p .d H .d T 0vT  6T 0^   X8 "21X1&  " `(  ""$  """"""& Z<  Z L    (  "   (  "   (  "& XR "  4X   .X    &T06Rv8& ""  n >"  vT* 2X   " 2  X ~  R  V8&" 64&"  Z \$  "" "  "&  "  " XR  Z $   ""0   "" >"   P0>   L" X " \(  >" ` + & .X   F VT0dH f8 6X2j"o" ""*" " "" V8 X 8   .X  8  X2 F8&r 6X2R"p"""*"""""% "&)" `2$ . XvC d >"$ 5 X2 V-   >"" A P |" G , " M   $"U    &^   > HF x 4X  68 8  .X ~ 8  BI8 &8z 88@ .X  80 8P 6XH 8: .X | XZ'  8 Xx 88&"" T m " L `~ J\Tn &8l ?f " , FT B  T" "?R@RAR&62R&R&/R&R&5R&.R&R&v R&f(R *X," +"(Z 4X  7Xj*" )"   T* .X N " /X  q@|- X  8 80. 5X D R 8&"\)R&V+R,R-R&R&6R&Ff*R8V8&6 R.R!R&& R.R4R& R R RR R&68&RRRRRRR8&68&68&0R8&2R3R1R8&1R8&&8&&6R8&F8&8&v T* .X  " @ 8 T    ,~ p b `T F 8 l*  |\P 8&x 8X$/t 01  2R 8 X3L" R2R&f6R RR8&F R RR R&VfvF&Ff4R8&6v8&&fF&6R R2R.R&&7R*R8& RRRRRRRRR R&8&8&8RR& RR2R&9R:R8&v9RF&f84R2R. 8&&4\ T* 2X  " /X n 2L  5X 0 zT v8& 8.5 8 9X  * :X8@7 n 6 6 X f8&$ V8Hr R8&Vf1R5R8&F68&6;R8&&RR&RRR8&&8&68&8&<R8&88R=R>R;R8&8RF&!R"R#R$R%R&R'R&RR R&RRRRR&8&8&v3R8&fZ" 1X $~9  4X ;  fT* .X @ " R< 5X  @R F8&" :, FT* 2X x " D6 ߌ$ 68X5 j ;XRR&V3R8&668&68&0n $  T0 v2  T0  $  >" "2'l%@L X #$ ^#>$ 8.     `1  F8& V8& fT: (X ߄ 86 .7 XߒBj6 ߌ 8\ <X x߄ 8 5 ޒX 8&$ 8_V=2 8X ބ* >@"@" =X ބ: >Xr"A" 68?  ;X ބ ^ d h *X v> VT  6 `@  8& F&Z !X 68 R .X Jr Tx`P  8& F& !X tN .X > Tx@c     m z | ~ n p r t v x       %'!     m z | ~ n p r t v x       %'!"CONCURRENT PASCAL TEST OF SCOPE ANALYSIS ERROR RECOVERY" (TEST) CONST CONST1=INTEGER; CONST2=3; CONST4=3.0; CONST5='PASCAL'; CONST5=0; TYPE CONST1=INTEGER; TYPE1=UNDEF_TYPE; TYPE2=INTEGER; TYPE3=CONST2; TYPE4=(ENUM1,ENUM2,CONST2,ENUM3); TYPE5=CONST2..CONST4; TYPE6=1..10; TYPE7=TYPE5..TYPE6; TYPE8=SET OF TYPE6; TYPE9=ARRAY (.TYPE6.) OF INTEGER; TYPE10=RECORD FIELD1,FIELD1,FIELD2:INTEGER; FIELD3,FIELD1:REAL END; TYPE11=CLASS(VAR PARM1,PARM2:TYPE1; PARM1,PARM2:TYP"CONCURRENT PASCAL TEST OF DECLARATION ANALYSIS" (TEST) TYPE T1=INTEGER; T2='A'..'Z'; T3A = SET OF 1..10; T7=ARRAY (.T2.) OF CHAR; T9=RECORD F1,F2:INTEGER; F3:REAL; F4: RECORD F5:INTEGER END END; T10=CLASS BEGIN END; T11=PROCESS +100 BEGIN END; VAR V1,V2,V3:T1; ENTRY V4,V5:T2; V6:T9; V7:T7; V8:CHAR; PROCEDURE PROC1; BEGIN END; FUNCTION FUNC1:T1; BEGIN END; PROCEDURE ENTRY EPROC1; BEGIN END; FUNCTION ENTRY EFUNC1:T1; BEGIN END; PROGRAM PROG1(PARM1,PARM2:T1; VAR PE1; PARM3,PARM1:UNIV TYPE2; VAR PARM1,PARM4:UNIV TYPE3); BEGIN END; TYPE12=MONITOR BEGIN END; TYPE13=PROCESS BEGIN END; VAR VAR1,VAR2,VAR3:INTEGER; VAR1,VAR2,VAR3,VAR4: REAL; ENTRY VAR1,VAR4:TYPE1; ENTRY VAR1,VAR4:REAL; VAR5:TYPE10; VAR6:RECORD F1:TYPE1 END; VAR7:TYPE9; VAR8:TYPE11; VAR9:TYPE12; VAR10:TYPE13; PROCEDURE VAR1; BEGIN END; PROCEDURE PROC1(PARM1,PARM2:INTEGER); BEGIN END; PROCEDURE ENTRY PROC2(PARM1,PARM2:INTEGER); PROCEDURE ENTRY PROC2; BEGIN END; BEGIN END; ARM3:UNIV T1); ENTRY EPROC1,EFUNC1,FWD1,FWD2; PROCEDURE ENTRY FWD1; BEGIN END; FUNCTION ENTRY FWD2:T1; BEGIN END; BEGIN FOR V1:=1 TO 10 DO FOR V2:=1 TO 10 DO WITH V6 DO F1:=1; V6.F1:=1; V6.F4.F5:=1; WITH V6,F4 DO F5:=1; V1:=V7(.V8.) END. EGIN END; VAR V1,V2,V3:T1; ENTRY V4,V5:T2; V6:T9; V7:T7; V8:CHAR; PROCEDURE PROC1; BEGIN END; FUNCTION FUNC1:T1; BEGIN END; PROCEDURE ENTRY EPROC1; BEGIN END; FUNCTION ENTRY EFUNC1:T1; BEGIN END; PROGRAM PROG1(PARM1,PARM2:T1; VAR P PROGRAM PROGX(PARM1:INTEGER); ENTRY EX1,EX2,EX3; FUNCTION FUNC1:INTEGER; BEGIN END; FUNCTION FUNC2(PARM1:INTEGER):INTEGER; BEGIN END; FUNCTION FUNC1:TYPE1; BEGIN END; FUNCTION ENTRY FUNC2:TYPE2; BEGIN END; FUNCTION ENTRY FUNC3:TYPE1; BEGIN END; PROGRAM PROG1; PROGRAM PROG1; PROGRAM PROG2; ENTRY PROC1,PROC2,FUNC1,FUNC2,FUNC3,FORD1,FORD2; PROCEDURE ENTRY FORD1; BEGIN END; BEGIN CASE VAR1 OF 182,INTEGER: ; 1: ; REAL: ; 8.0: ; 128: ; 5: END; PROGX(1); WITH VAR5,0"  X   X  "D X """ ۄ " ΄ &QF̒* B"  X   XPQ    ".VAR6,VAR1 DO FIELD1:=VAR7(.F1.); PROC1; PROC1(VAR1); PROC1(VAR1,VAR2); PROC1(VAR1,VAR2,VAR1); VAR1:=FUNC1; VAR1:=VAR2(VAR1); VAR1:=VAR2.VAR1; VAR1 := PROC1(VAR1, VAR2); VAR1 := VAR1(.1.); FUNC1; VAR1:=FUNC1(X); VAR1; VAR1:= VAR5.NOFIELD; VAR1:=FUNC3; VAR1:=FUNC2; VAR1:=FUNC2(VAR2); VAR1:=1+1.0-'A'/'PASCAL'; INIT VAR8(VAR1,VAR2,VAR3,VAR4,VAR5,VAR6,VAR7,VAR8), VAR8,VAR9,VAR10, VAR1; END. : ; REAL: ; 8.0: ; 128: ; 5: END; PROGX(1); WITH VAR5,"4  X.   T  (  "  " (  "^ (  "  "*x (˰$,  (  "$" (S xɒ$ (      m z | ~ n p r t v x       %'! X ^ l " " \ . Bd "  0" "8 8 *"  8:"n. . BB"2 .d T 0^6 >(  h@   8" "  "  0"~X  " "CONCURRENT PASCAL TEST OF STANDARD ROUTINES" (TEST) TYPE MONITOR_TYPE=MONITOR TYPE ENUM_TYPE=(ENUM1,ENUM2,ENUM3); PASSIVE_TYPE=ARRAY(.ENUM_TYPE.) OF INTEGER; VAR I,J,K:INTEGER; X,Y:REAL; E,F:ENUM_TYPE; P:PASSIVE_TYPE; C:CHAR; Q:QUEUE; B:BOOLEAN; BEGIN I:=ABS(J); X:=ABS(Y); I:=ATTRIBUTE(J); C:=CHR(K); CONTINUE(Q); X:=CONV(I); DELAY(Q); B:=EMPTY(Q); IO(P,P,E); I:=ORD('A'); E:=PRED(F); STOP(I,J); I:=REALTIME; SETHEAP(I); E:=SU 8"  "  0"6 6>"  6"8"2  .dT0 . .B" (" .Bd  X4 "  "X  8 .d>>"  8"$. .B"(P  "CC(F); I:=TRUNC(X); START; WAIT END; BEGIN END. ITOR_TYPE=MONITOR TYPE ENUM_TYPE=(ENUM1,ENUM2,ENUM3); PASSIVE_TYPE=ARRAY(.ENUM_TYPE.) OF INTEGER; VAR I,J,K:INTEGER; X,Y:REAL; E,F:ENUM_TYPE; P:PASSIVE_TYPE; C:CHAR; Q:QUEUE; B:BOOLEAN; BEGIN I:=ABS(J); X:=ABS(Y); I:=ATTRIBUTE(J); C:=CHR(K); CONTINUE(Q); X:=CONV(I); DELAY(Q); B:=EMPTY(Q); IO(P,P,E); I:=ORD('A'); E:=PRED(F); STOP(I,J); I:=REALTIME; SETHEAP(I); E:=SU (  " Ű( 3^ (|R ɒ$:  ( .  "(E (T Ȓ Nv@  DŽ^VFJBP:߄2DŽ&K #]xȄ&6؄~؄"     m z | ~ n p r t v x       %'!((ȄDDHDŽph JDŽT"܄L܄D"67*4' B"ӄZ߄T0BDŽ.b B"-\t/DŽhz`X PL8: 2.҄҄;8tIh"CONCURRENT PASCAL TEST OF SEMANTIC CHECKS" (TEST) CONST C=0; TYPE T1=RECORD F1:T1; F2:(E1,E2,E3); F3:CLASS BEGIN END END; XT3=SET OF 0..130; XT4=SET OF REAL; XT5=ARRAY (.INTEGER.) OF INTEGER; XT6=ARRAY (.1..3.) OF CHAR; XT8=ARRAY (.0..30000.) OF INTEGER; T2=C; T4=5..1; T5='A'..3; T6=SET OF REAL; T7=1..0; T8=ARRAY(.1..10,(ENUM1,ENUM2),'A'..'Z',REAL.) OF INTEGER; T9=ARRAY (.1..3.) OF CHAR; T10=CLASS +100 BEGIN END; T11=CLASS BEGIN END; T12=MONITOR BEGIN END; T13=MONITOR VAR ENTRY|τ4nf ""J<>)ń2+ń&(Ƅ96Vń@E߄WHń:zGHĄAb؄\Ą|?4pdЄ>2Є ,ބV݄H܄ۄC>ĄBp" V1:INTEGER; V2:QUEUE; V3:PROCESS BEGIN END; PROCEDURE ENTRY ME1; BEGIN END; BEGIN ME1 END; T14=CLASS VAR ENTRY V1:INTEGER; ENTRY V2:T11; BEGIN END; T15=PROCESS BEGIN END; T16=ARRAY (.1..4.) OF CHAR; T16=CLASS (PARM1:INTEGER; VAR PARM2:INTEGER; PARM3:T12; PARM4:T11; PARM5:T9); BEGIN PARM1:=0 END; T17=CLASS(PARM1:T11); BEGIN INIT PARM1 END; VAR V1:T10; V2:QUEUE; V3:PROCESS BEGIN END; V4:INTEGER; V5:T14; V6:REAL; PROCEDURE PROC1; TYPE T1=CLASS BEGIN END; VAR V1:T11; BEGI |ф (S  ф^ (T  ф& ( n  "V   "2  " O" M"  FЄP 4  (  "B (  "  " P" L" fτ N END; PROCEDURE PROC2; PROCEDURE PROC3; BEGIN END; BEGIN END; FUNCTION FUNC1:C; BEGIN END; FUNCTION ENTRY FUNC3:INTEGER; BEGIN END; FUNCTION FUNC2:REAL; BEGIN END; PROGRAM PROG1; ENTRY FUNC3,FWD1; PROCEDURE ENTRY PROC4(PARM1:C; PARM2:T1; VAR PARM3:T3; VAR PARM4:UNIV T3; VAR PARM5:UNIV T11; PARM6:QUEUE); BEGIN END; FUNCTION FUNC4(VAR PARM1:INTEGER):T3; BEGIN END; PROCEDURE PROC5; BEGIN PROC5 END; PROGRAM PROG2(PARM1:INTEGER; PARM2:T11); PROCEDURE PROC6(PARM1:UNIV INTEGER); BEGIN END; PROCEDURE PRO(  "  "L τR ( 0 [΄(dj< *"""  T " "  V "t"L M N @Ͱh v` " 2 "  |vل< ׄBքx ׄb>„Vׄ@=„45„(2ބ1„B3„q(`V:@n`nvZL@j`Jr>thZ,tz8>`<@\Rd&F 4 JnL~^T\"n0X.tB~ Z Zv    "      "$&(m z | ~ n p r t v x       %'!PASS 3: FILE_LIMIT ׄBքx ׄb>„Vׄ@=„45„(2ބ1„B3„q(`V:@n`nvZL@j`Jr>thZ,tz8>`<@\Rd&F 4 JnL~^T\"n0X.tB~ Z Zv    " C7(PARM1:T16); BEGIN END; PROCEDURE PROC8(VAR PARM1:INTEGER); BEGIN END; BEGIN "MAIN" V2:=V2; V4:=1.0; V5.V1:=0; PROG2; PROG2(A,B); PROG2(A,B,C); PROC6(TRUE); PROC6(REAL); PROC7('AB'); PROC8(1); IF 1 THEN; CASE 1 OF 1:; 1:; 128:; TRUE: END; WHILE 1 DO; REPEAT UNTIL 1; FOR FUNC1:='A' TO 'B' DO; FOR V6:=1.0 TO 2.0 DO; WITH 1 DO; INIT V1,V4; END. RE PROC5; BEGIN PROC5 END; PROGRAM PROG2(PARM1:INTEGER; PARM2:T11); PROCEDURE PROC6(PARM1:UNIV INTEGER); BEGIN END; PROCEDURE PRO"CONCURRENT PASCAL TEST OF BODY ANALYSIS - NORMAL AND ERROR CASES" (TEST) CONST CONSTANT=0; TYPE INDEX=1..10; STRING_TYPE=ARRAY (.INDEX.) OF CHAR; SPLIT_REAL = ARRAY (.1..4.) OF INTEGER; VAR INT_VAR:INTEGER; REAL_VAR:REAL; CHAR_VAR:CHAR; BOOLEAN_VAR:BOOLEAN; SPLIT_VAR: SPLIT_REAL; ACTIVE_VAR:CLASS BEGIN END; STRING_VAR: STRING_TYPE; SET_VAR: SET OF CHAR; PROCEDURE PROC1(ARG1:INTEGER; VAR ARG2:INTEGER; VAR ARG3:UNIV INTEGER; ARG4:UNIV INTEGER; ARG5:STRING_TYPE; ARG6: UNIV REAL;       "$&(#%')m z | ~ n p r t v x       %'! ARG7: UNIV SPLIT_REAL); BEGIN ARG1:=1; ARG4:=1 END; BEGIN "MAIN" INT_VAR:=1; ACTIVE_VAR:=ACTIVE_VAR; CONSTANT:=1; INT_VAR:=1.0; PROC1(1,INT_VAR,BOOLEAN_VAR,TRUE,'AB', SPLIT_VAR, REAL_VAR); "CORRECT" PROC1(1.0,1,REAL_VAR,1.0,FALSE, (..), +REAL_VAR); "ERROR" IF BOOLEAN_VAR THEN; IF 1 THEN ; CASE INT_VAR OF TRUE:; FALSE:; 1: END; WHILE TRUE DO; WHILE CONSTANT DO; REPEAT UNTIL TRUE; REPEAT UNTIL CONSTANT; FOR INT_VAR:=CONSTANT TO CONSTANT DO FOR INT_VAR:=CONSTAN"CONCURRENT PASCAL TEST OF CODE SELECTION AND CODE ASSEMBLY" (TEST) CONST STRING_CONST = 'PASCAL'; REAL_CONST=1.0; INT_CONST = 1; TYPE SUBRANGE_TYPE = 1..6; STRING_TYPE = ARRAY(.SUBRANGE_TYPE.) OF CHAR; SET_TYPE = SET OF SUBRANGE_TYPE; RECORD_TYPE = RECORD FIELD1, FIELD2: INTEGER END; CLASS_TYPE = CLASS PROCEDURE ENTRY CLASS_ENTRY; BEGIN END; FUNCTION ENTRY CLASS_FUNC:INTEGER; BEGIN CLASS_FUNC:=0 END; FUNCTION ENTRY REAL_FUNC (ARG: INTEGER): REAL; BEGIN REAL_FUNC:= CONV(ARG) END; BEGIN "CLASS INIT" END; MT DOWNTO CONSTANT DO; FOR REAL_VAR:=CONSTANT TO TRUE DO; BOOLEAN_VAR:=(ACTIVE_VAR=ACTIVE_VAR) AND (INT_VAR<>BOOLEAN_VAR) OR (INT_VAR=INT_VAR); BOOLEAN_VAR:=(STRING_VAR<=STRING_VAR) OR (INT_VAR>=INT_VAR) AND (SET_VAR<=SET_VAR); BOOLEAN_VAR:=(STRING_VARREAL_VAR); BOOLEAN_VAR:=CHAR_VAR IN SET_VAR; BOOLEAN_VAR:=CONSTANT IN SET_VAR; INT_VAR:=TRUE; BOOLEAN_VAR:=+TRUE; BOOLEAN_VAR:=-TRUE; INT_VAR:=+INT_VAR; INT_VAR:=-INT_VAR; INT_VAR:=-INT_VAR+INT_VARONITOR_TYPE = MONITOR VAR Q: QUEUE; PROCEDURE ENTRY MONITOR_ENTRY (S: SUBRANGE_TYPE); BEGIN END; FUNCTION ENTRY MONITOR_FUNC:INTEGER; BEGIN MONITOR_FUNC:=0 END; BEGIN DELAY(Q); CONTINUE(Q); IF EMPTY(Q) THEN END; PROCESS_TYPE = PROCESS PROCEDURE ENTRY INTERFACE; BEGIN END; PROGRAM SEQUENTIAL; ENTRY INTERFACE, PROCESS_FUNC; FUNCTION ENTRY PROCESS_FUNC: INTEGER; BEGIN PROCESS_FUNC:= 0 END; BEGIN SEQUENTIAL END; VAR CH: CHAR; INT: INTEGER; X: REAL; BOOL: BOOLEAN; BITS: SET_TYPE; STRING: STRING_TYPE; REC: -INT_VAR; INT_VAR:=INT_VAR-REAL_VAR; SET_VAR:=SET_VAR-SET_VAR OR SET_VAR AND SET_VAR; INT_VAR:=INT_VAR*INT_VAR; REAL_VAR:=REAL_VAR*REAL_VAR; INT_VAR:=INT_VAR/INT_VAR; REAL_VAR:=REAL_VAR/REAL_VAR; INT_VAR:=INT_VAR DIV INT_VAR MOD INT_VAR; BOOLEAN_VAR:=NOT BOOLEAN_VAR; SET_VAR:=NOT SET_VAR; SET_VAR:=(.CHAR_VAR,CHAR_VAR.); CHAR_VAR:=STRING_VAR(.INT_VAR.); CHAR_VAR:=STRING_VAR(.REAL_VAR.); END. UE; BOOLEAN_VAR:=-TRUE; INT_VAR:=+INT_VAR; INT_VAR:=-INT_VAR; INT_VAR:=-INT_VAR+INT_VARRECORD_TYPE; CLASS_VAR: CLASS_TYPE; MONITOR_VAR: MONITOR_TYPE; PROCESS_VAR: PROCESS_TYPE; PROCEDURE LOCALADDR(VAR ARG: INTEGER); VAR I: INTEGER; BEGIN I:= ARG END; FUNCTION LOCAL_FUNC:INTEGER; BEGIN LOCAL_FUNC:=0 END; FUNCTION REAL_FUNC (ARG: INTEGER): REAL; BEGIN REAL_FUNC:= CONV(ARG) END; BEGIN "MAIN" X:= CLASS_VAR.REAL_FUNC(1) + REAL_FUNC(1); CH:= STRING(.1.); STRING(.1.):= CH; STRING:= STRING_CONST; IO(CH,CH,TRUE); START; WAIT; STOP(INT,FALSE); SETHEAP(INT); LOCALADDR(INT); WITH MONITOR_VAR DO MONITOR_E  $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~   NTRY(MONITOR_FUNC); IF TRUE THEN; IF TRUE THEN ELSE; CASE LOCAL_FUNC OF 1,2: ; 3: END; WHILE TRUE DO; REPEAT UNTIL FALSE; FOR INT:=0 TO 1 DO; FOR INT:=1 DOWNTO 0 DO; CYCLE END; WITH REC DO FIELD1:=FIELD2+REC.FIELD1+REC.FIELD2; INIT CLASS_VAR, MONITOR_VAR, PROCESS_VAR; BOOL:=(0<0) OR (0<=0) AND (0=0) OR (0>=0) AND (0>0) OR (0<>0); BOOL:=(X=X) AND (X>X) OR (X<>X); BOOL:=(BITS<=BITS) OR (BITS=BITS) OR (BITS>=BITS) OR (BITS<>BITS) OR (0 IN BITS) ; BOOL:=(STRING=STRING) AND (STRING>STRING) OR (STRING<>STRING); INT:=-INT+INT-INT*INT DIV INT MOD INT; X:= -X+X-X*X/X; BOOL:=NOT BOOL OR BOOL AND BOOL; BITS:=BITS OR BITS AND BITS - (.1.); INT:=TRUNC(CONV(1))+ABS(INT)+TRUNC(ABS(X)) +SUCC(1)+PRED(0)+REALTIME; INT:= ATTRIBUTE(TRUE) END.   $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~     $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}    "################## # KERNEL TEST 2 # ##################" "TEST OUTPUT, BELL KEY IS CLOCK INTERRUPT. WILL TEST: TIME.ADD (FRACTION < 10000) TIMER.TICK CLOCK.INCREMENT (NOW.SEC < LASTTIME + WAITTIME) CLOCK INTERRUPT (BUT NOT IDLING) RUNNING.UPDATE (SLICE = MAXSLICE, NESTING = 0) READY.RESCHEDULE (PRIORITY > 0 AND OVERTIME) " VAR A: PROCESS BEGIN CYCLE END END; BEGIN "B" INIT A; CYCLE END END. F.(  $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}   D,." %& '" ''(" +, -" --." 0"6788 Z 9:=>?.@AA$BC,^    &  )*,+x,      "$&(#%')m z | ~ n p r t v x       %'!#& "$IPPLEPAGE; INDEX: INTEGER; EOF: BOOLEAN); BEGIN WRITEPAGE(P(.INDEX.),EOF) END; PROCEDURE CONCAT; VAR BASE1,BASE2,LIMIT,I: INTEGER; BEGIN FIRSTTIME:=TRUE; BASE1:=J-TWICEPAGELENGTH; BASE2:=BUFFERLENGTH-J; LIMIT:=BASE2+PAGELENGTH; GETPAGE(BUFFER); REPEAT FOR I:=BORDER3 TO LIMIT DO BUFFER(.BASE1+I.):=BUFFER(.I.); PUTPAGE(BUFFER); FOR I:=BORDER2 TO J DO BUFFER(.I.):=BUFFER(.BASE2+I.); GETPAGE(BUFFER) UNTIL EOF; J:=J-PAGELENGTH; REPEAT J:=J+1 UNTIL BUFFER(.J.)=EM; J:=J-1; (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY,IF J>=PAGELENGTH THEN PUTINDEXED(BUFFER,1,FALSE) ELSE BEGIN RESTOREPAGE(BUFFER); J:=J+PAGELENGTH END END; PROCEDURE SAVEFILE; VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:=BOOLTYPE; BOOL:=FALSE END; WITH LIST(.2.) DO BEGIN TAG:=IDTYPE; IF WHERE=NOWHERE THEN ID:='CREATE ' ELSE ID:='REPLACE ' END; WITH LIST(.3.) DO BEGIN TAG:=IDTYPE; ID:=DEST.ID END; WITH LIST(.4.) DO BEGIN TAG:=INTTYPE; INT:=LENGTH END; WITH LIST(.5.) DO BEGIN T  $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}    SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDZV, 67 "8"9:* >?"@ A< EF"GGH >" "I 6J  XKF P Q" "RRS >"T U  P0> V  L"W XX V-hXY "Y \,Z  ZIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); [ \: `a"bbc >"d  e  Xf hlmnop q"q `(r x& x|rs   :tppN$uvINPUT 5 LINES X V-hXY "Y \,Z  Z PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE AG:=IDTYPE; ID:='ASCII ' END; WITH LIST(.6.) DO BEGIN TAG:=BOOLTYPE; BOOL:=FALSE END; RUN('FILE ',LIST,LINE,RESULT); IF (RESULT<>TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('DESTINATION FILE LOST(:10:)') END; PROCEDURE INITDEST; VAR ARG: ARGTYPE; BEGIN IF WHERE=ELSEWHERE THEN WRITEARG(OUT,DEST) ELSE BEGIN WITH ARG DO BEGIN TAG:=IDTYPE; ID:='NEXT ' END; WRITEARG(OUT,ARG) END END; PROCEDURE TERMDEST; VAR ARG: ARGTYPE; BEGIN IF WHERE<>ELSEWHERE THEN BEGIN READARPUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSG(OUT,ARG); LENGTH:=ARG.INT END; READARG(OUT,ARG); IF NOT ARG.BOOL THEN OK:=FALSE; IF (WHERE<>ELSEWHERE) & OK THEN SAVEFILE END; PROCEDURE TERMSOURCE; VAR ARG: ARGTYPE; BEGIN READARG(INP,ARG); IF NOT ARG.BOOL THEN OK:=FALSE END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:=BOOLTYPE; BOOL:=OK END END; BEGIN INITIALIZE; IF OK THEN BEGIN K:=1; INITDEST; WHILE (K<=N) & OK DO BEGIN WRITEARG(INP,SOURCE(.K.)); CONCAT; TERMSOURCE; K:=K+1 EQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "*************************************************************** * CONCAT(SOURCE(.1.),...SOURCE(.N.),DEST END; PUTINDEXED(BUFFER,2,FALSE); PUTINDEXED(BUFFER,2,TRUE); TERMDEST; TERMINATE END END. INATION: IDENTIFIER) * ***************************************************************" CONST BUFFERLENGTH = 1536; TWICEPAGELENGTH = 1024; BORDER2 = 513; BORDER3 = 1025; TYPE TRIPPLEPAGE = ARRAY(.1..3.) OF PAGE; VAR BUFFER: ARRAY(.1..BUFFERLENGTH.) OF CHAR; SOURCE: ARRAY(.1..MAXARG.) OF ARGTYPE; DEST: ARGTYPE; WHERE: (NOWHERE,ONDISK,ELSEWHERE); OK,EOF,FIRSTTIME: BOOLEAN; LENGTH: INTEGER; J,K,N: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:=0; REPEAT I:=I+1;   $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     C:=TEXT(.I.); DISPLAY(C) UNTIL C=NL END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:=FALSE END; PROCEDURE IDERROR(ID: IDENTIFIER; TEXT: LINE); VAR I: INTEGER; BEGIN FOR I:=1 TO IDLENGTH DO IF ID(.I.)<>' ' THEN DISPLAY(ID(.I.)); DISPLAY(' '); ERROR(TEXT) END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT (' CONCAT(SOURCE(.1.),...,SOURCE(.N.),DESTINATION: IDENTIFIER) (:10:)'); OK:=FALSE END END; PROCEDURE CHECKARG; VAR X@V , 01 "2"34* 89": ;< ?@"AAB >" "C 6D  XEF J K" "LLM >"N O  P0> P  L"Q XR V-hRS "S \,T  TATTR: FILEATTR; FOUND: BOOLEAN; BEGIN N:=MAXARG; WHILE PARAM(.N.).TAG=NILTYPE DO N:=N-1; IF N<3 THEN HELP ELSE BEGIN DEST:=PARAM(.N.); WITH DEST DO IF TAG<>IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID,ATTR,FOUND); IF FOUND THEN CASE ATTR.KIND OF SCRATCH,CONCODE: ERROR('DESTINATION KIND MUST BE ASCII OR SEQCODE(:10:)'); ASCII: IF ATTR.PROTECTED THEN ERROR('DESTINATION FILE PROTECTED (:10:)') U V: Z["\\] >"^  _  X` bijklmm"n"o"p"q r s t uvxw> P  L"Q XR V-hRS "S \,T  T ELSE WHERE:=ONDISK; SEQCODE: WHERE:=ELSEWHERE END ELSE WHERE:=NOWHERE END; N:=N-2; FOR K:=1 TO N DO BEGIN SOURCE(.K.):=PARAM(.K+1.); WITH SOURCE(.K.) DO IF TAG<>IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID,ATTR,FOUND); IF NOT FOUND THEN IDERROR(ID,'UNKNOWN(:10:)') ELSE CASE ATTR.KIND OF SCRATCH,CONCODE: IDERROR(ID,'OF WRONG KIND; SHOULD BE ASCII OR SEQCODE(:10:)'); ASCI  $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     I,SEQCODE: END END END END END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('CONCAT:(:10:)'); J:=PAGELENGTH; OK := (TASK=JOBTASK); IF OK THEN CHECKARG END; PROCEDURE PUTPAGE(VAR P: UNIV TRIPPLEPAGE); BEGIN IF FIRSTTIME THEN FIRSTTIME:=FALSE ELSE WRITEPAGE(P(.1.),FALSE); P(.1.):=P(.2.) END; PROCEDURE GETPAGE(VAR P: UNIV TRIPPLEPAGE); BEGIN READPAGE(P(.3.),EOF) END; PROCEDURE RESTOREPAGE(VAR P: UNIV TRIPPLEPAGE); BEGIN P(.2.):=P(.1.); END; PROCEDURE PUTINDEXED(P: UNIV TR  $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     357r*L, )* "+",-* 12"3 4< 89"::; >" "< 6=  X>F C D" "EEF >"G H  P0> I  L"J XK V-hKL "L \,M  MXJ, /0 "1"23* 78"9 :< >?"@@A >" "B 6C  XDF I J" "KKL >"M N  P0> O  L"P XQ V-hQR "R \,S  SN O: ST"UUV >"W  X  XY [" de f" ffg" jk l" llm" o"z{T|"}~~ , L\J\T U: YZ"[[\ >"]  ^  X_ ag ilmnop q" q `>rs | ttu 2v"v `:wx  Zyyz{PROCESSES: MONITORS:  S" `" `D$0@" `Tp,p~BELL RESPONSE TERMINAL PASSIVE TERMINAL OUTPUT  L\J\ 6 &(-/240MOxz|y{}     57!#%')+-/136 "$&(*,.0249;=?ACEGIKMO:<>@BDFHJLN8UWY[]_acegQSVXZ\^`bdfPRTqsuwy{}  $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     357!#%')+(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC "################### # KERNEL TEST 11 # ###################" "NORMAL KERNEL WILL TEST: RUNNING (PARAMLIMIT) (ASSUMING THAT THE PARAMLIMIT IS 20)" VAR CHILD: PROCESS (P1 , P2 , P3 , P4 , P5 , P6 , P7 , P8 , P9 , P10, P11, P12, P13, P14, P15, P16, P17, P18, P19, P20, P21: INTEGER); BEGIN END; BEGIN INIT CHILD (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21); END.   + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w y { } h j n p r t v x z | ~        $`X  $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~     /1357!#%'  $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~     /1357!#%')+R     * "################### # KERNEL TEST 12 # ###################" "NORMAL KERNEL WILL TEST NESTED MONITOR CALLS AND PARAMETERIZED MONITORS: RUNNING.UPDATE (SLICE > MAXSLICE AND NESTING > 0) RUNNING.LEAVE (NESTING > 0 AND OVERTIME, NESTING = 0 AND OVERTIME) READY.RESCHEDULE (PRIORITY = 0)" TYPE "INSERT IO TYPES AND CONSOLE CLASS FROM KERNEL TEST 7 HERE" IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTTED.CALL END END; VAR A: CONSUMER; B: REPORTER; C, D: CHILD; BEGIN INIT A, B(A), C(B), D(B); END. ION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO  $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~     7!#%')+-/13(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')`F6 , /0 "1"23* 78"9 :< >?"@@A >" "B 6C  XDF I J" "KKL >"M N  P0> O  L"P XQ V-hQR "R \,S  S); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; ATTRINDEX = (INDEX, HEAPTOP, LINENO, RESULT, SEC, FRAC, SLICE, NESTING, PRIORITY, OVERTIME); CONSUMER = MONITOR PROCEDURE ENTRY WASTETIME; BEGIN REPEAT UNTIL ATTRIBUTE(OVERTIME) <> 0; END; BEGIN ET U: YZ"[[\ >"]  ^  X_ a" jkk ^l nnwxyz {" { `(|   "|}" } `*~   r~x  *  ND; REPORTER = MONITOR(GREEDY: CONSUMER); VAR TERMINAL: CONSOLE; PROCEDURE WRITESTATE; VAR SNAPSHOT: ARRAY (.ATTRINDEX.) OF INTEGER; I: ATTRINDEX; BEGIN WITH TERMINAL DO BEGIN WRITETEXT('(:10:) '); FOR I:= INDEX TO OVERTIME DO SNAPSHOT(.I.):= ATTRIBUTE(I); FOR I:= INDEX TO OVERTIME DO WRITEINT(SNAPSHOT(.I.)); END; END; PROCEDURE ENTRY CALL; BEGIN WRITESTATE; GREEDY.WASTETIME; WRITESTATE; END; BEGIN INIT TERMINAL END; CHILD = PROCESS(NESTED: REPORTER); BEGIN CYCLE NES  ^  X_ a" jkk ^l nnwxyz {" { `(|   "|}" } `*~   r~x  *     $&( "%')#m z | ~ n p r t v x       %'!#& "$)+-/13579;=?*,.02468:<>(EGIKMOQSUWACFHJLNPRTV@BDacegi#################" TYPE OPERATORPROCESS = PROCESS (TYPEUSE: RESOURCE; TASKLIST: TASKSET; WATCH: CLOCK; SCHEDULE: TIMETABLE); VAR OPERATOR: TERMINAL; BELL: BELLKEY; LETTERS, DIGITS: SET OF CHAR; OK: BOOLEAN; CH: CHAR; COMMAND: IDENTIFIER; PROCEDURE HELP; BEGIN IF OK THEN WITH OPERATOR DO BEGIN WRITE(NL); WRITETEXT('TRY AGAIN (:10:)(:0:)'); WRITETEXT(' START(TASK, HOUR:MIN:SEC)(:10:)(:0:)'); WRITETEXT(' PERIOD(TASK, HOUR:MIN:SEC) (:10:)(:0:)'); WRITETEXT(' (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, $&RTePsvm t v x z | ~ n p r $`Xy{}xz|~     7!#%')+-/135 "$ SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMED "################### # KERNEL TEST 13 # ###################" "NORMAL KERNEL WILL TEST: STOPJOB RANGEERROR" TYPE "INSERT IO TYPES AND CONSOLE CLASS FROM KERNEL TEST 7 HERE" IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); ESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHA PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE R; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGPUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; ATTRINDEX = (INDEX, HEAPTOP, LINENO, RESULT, SEC, FRAC, SLICE, NESTING, PRIORITY, OVERTIME, JOB, CONTINUE); MESSENGER = MONITOR VAR ID: INTEGER; PROCEDURE ENTRY PUT; BEGIN ID:= ATTRIBUTE(INDEX) END; FUNCTION ENTRY GET: INTEGER; BEGIN GET:= ID END; BEGIN ID:= 0 END; VAR A: MESSENGER; B: PROCESS(V: MESSENGER); VAR TERMINAL: CONSOLE; TROUBLE: ARRAY (.1..1.) OF INTEGER; BEGIN V.PUT; WAIT;EQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST);  INIT TERMINAL; WITH TERMINAL DO IF TRUE THEN BEGIN WRITETEXT('(:10:) '); WRITEINT(ATTRIBUTE(RESULT)); WRITEINT(ATTRIBUTE(CONTINUE)); WRITEINT(TROUBLE(.0.)); END; END; BEGIN INIT A, B(A); STOP(A.GET, 999); END.  STOP(TASK) (:10:)(:0:)'); WRITETEXT(' TIME(HOUR:MIN:SEC) (:10:)(:0:)'); WRITETEXT(' SOLO (:10:)(:0:)'); OK:= FALSE; END; END; PROCEDURE NEXTCHAR; BEGIN IF OK THEN REPEAT OPERATOR.READ(CH) UNTIL CH <> ' '; END; PROCEDURE SKIPCHAR(DELIM: CHAR); BEGIN IF CH = DELIM THEN NEXTCHAR ELSE HELP; END; PROCEDURE READINT(VAR INT: INTEGER); CONST MAXINT = 32767; VAR DIGIT: INTEGER; BEGIN INT:= 0; IF NOT (CH IN DIGITS) THEN HELP ELSE WHILE (CH IN DIGITS) & OK DO BEGIN DIGIT:= $&RTePsvm t v x z | ~ n p r $`Xxz|~y{}     7!#%')+-/135 "$        !#%'"$& =?)+-/13579;>(*,.02468:<ACEGIKMOQSUWBDFHJLNPRTV@]_acegikmoY[^`bdfhjlnXZ\y{}qsuwz|~prtvx0h, ,- "."/0* 45"6 7< ;<"==> >" "? 6@  XAF F G" "HHI >"J K  P0> L  L"M XN V-hNO "O \,P  P(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCQ R: VW"XXY >"Z  [  X\ ^" j"" m "" o"xy z{|\}~ ^   :V: P  PRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM      "$&!#%'02468:<>(*,.13579;=?)+-/LNPRTV@BDFHJAC     )+-/!#%'*,. "$&(EG13579;=?ACF02468:<>@     (*,.0246 "$&)+-/1357!#%'DFHJLN8:<>@BEGIKMO9;=?AC`bdfPRT, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); #################################### # CONCURRENT PASCAL DISTRIBUTION # # 3 AUG 76 # #################################### DISTRIBUTION COSTS ****************** SOLO MANUALS $ 30 REAL-TIME MANUAL $ 9 JOB-STREAM MANUAL $ 8 MACHINE MANUAL $ 8 NOTES $ 7 COMPILER THESIS $ 35 SOLO COPY $ 25 SOLO FILES $ 25 ALL FILES $ 25 STATISTICS ********** 336 USERS 85 COMPANIES 117 UNIVERSI"%')#(m z | ~ n p r t v x       %'!#& "$)+-/13579;=?*,.02468:<>(EGIKMOQSUWACFHJLNPRTV@BDacegikmoY[]_bdfhjlnXZ\^*,.0246+-/1357<>@BDFHJLN8:=?ACEGIKMO9;XZ\^`bdfPRTVY[]_acegQSUWtvxz|~hjlnpruwy{}ikmoqs      "$&!#%'<8  T ( " >" "   X" b"& " `D   ^    b" bb"<V " V XV VB" VV ~f V *f ^ J $ `D\pFf"> ( "*"2. d^* \" 0 b" d^ b2:28 0 b"$>   (  b" DU bX"X X V` b2<t X "X X>"fPJ$B CL"CD PX EJ$E& IJ "K \ LB" K LL>"L^RS ` `2 >\2 P`T2U" BU ` UV(dB 0t.f0XWnWX(b&-(<$Y YV d"d" d"V VB"X" V X `t X  X> *t X  ^ >v $ 0 |8 XX $Z"b*X" b$ ^^"   *$  $YZ (J"[ V, :J$\&\ N$\] ^@h. >"@N$_@_0b& B"@J$__`HN@$a@h& >"@N$ab"c@ DJ$d0 >(e.f `$  *$   0^" ZB" ZB" >"8" `6 >  x" Z `6  >  `BZ ZB"Z Z>" ZXZ ZB" Z\\ JTRY AGAIN CONCAT(SOURCE(.1.),...,SOURCE(.N.),DESTINATION: IDENTIFIER) DESTINATION KIND MUST BE ASCII OR SEQCODE DESTINATION FILE PROTECTED UNKNOWN OF WRONG KIND; SHOULD BE ASCII OR SEQCODE CONCAT: CREATE REPLACE ASCII FILE DESTINATION FILE LOST NEXT (  b" DU bX"X X V` b2<t X "X X>"fPZ Z>"Hp  n( n"p  n( dX n* n*p  n( nf*p  n( n \"p  n( n*p  n( n"p, ^p 06  2$ dX################# # DISK MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES AN EXISTING FILE TO OR FROM DISK. CALL: CAN ONLY BE USED TO PRODUCE INPUT/OUTPUT FOR OTHER PROGRAMS. ERROR MESSAGES: FILE UNKNOWN THE DISK DOES NOT CONTAIN THE GIVEN FILE. FILE LIMIT THE NUMBER OF PAGES OUTPUT TO A DISK FILE EXCEEDS ITS CAPACITY. ILES (TEMP1, TEMP2, AND NEXT) USED BY THE COMPILER ARE MISSING ON THE DISK. COMPILATION ERRORS THE PASCAL PROGRAM CONTAINS ERRORS OR THE COMPILE -/1357,.0GIKMO9;=?ACE>@B_acegQSUWY[]`bdfPRTVXZ\^{}ikmoqsuwy|~hjlnprtvxz     '!#% "$&+-/13579;=?),.0ID: IDENTIFIER; FILELENGTH: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE INITIALIZE; BEGIN IF TASK = INPUTTASK THEN IDENTIFY('DISKINPUT: (:10:)') ELSE IDENTIFY('DISKOUTPUT:(:10:)'); FILEID:= PARAM(.2.).ID; OPEN(1, FILEID, OK); IF NOT OK THEN WRITETEXT('FILE UNKNOWN (:10:)'); END; PROCEDURE RETURNLENGTH; VAR ARG: ARGTYPE; BEGIN IF FILEID = 'NEXT ' THEN(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, BEGIN WITH ARG DO BEGIN TAG:= INTTYPE; INT:= FILELENGTH END; WRITEARG(INP, ARG); END; END; PROCEDURE DISKINPUT; VAR PAGENO: INTEGER; TEXT: PAGE; BEGIN FILELENGTH:= LENGTH(1); FOR PAGENO:= 1 TO FILELENGTH DO BEGIN GET(1, PAGENO, TEXT); WRITEPAGE(TEXT, FALSE); END; WRITEPAGE(TEXT, TRUE); END; PROCEDURE DISKOUTPUT; VAR PAGENO, MAXNO: INTEGER; TEXT: PAGE; EOF: BOOLEAN; BEGIN PAGENO:= 0; MAXNO:= LENGTH(1); READPAGE(TEXT, EOF); WHILE NOT EOF & (PAGENO < MAXNO) DO BEGINSCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDI PAGENO:= PAGENO + 1; PUT(1, PAGENO, TEXT); READPAGE(TEXT, EOF); END; IF NOT EOF THEN BEGIN WRITETEXT('FILE LIMIT (:10:)'); OK:= FALSE; END; FILELENGTH:= PAGENO; RETURNLENGTH; END; PROCEDURE TERMINATE; BEGIN CLOSE(1); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK <> JOBTASK THEN BEGIN INITIALIZE; IF TASK = INPUTTASK THEN DISKINPUT ELSE DISKOUTPUT; TERMINATE; END; END. UM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); 46;=?ACEGIKMO9<>@BDFHJLN8:WY[]_acegQSUXZ\^`bdfPRTVsuwy{}ikmoqtvxz|~hjlnpr     !#%' "$&;=?)+-/13579< PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE P*'"8!. " "&" . " `F" `  L""0" f"  "  "$   Z"$   V""  L >v  P`>V  L >:  P@>" UT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSE *  **   2"*   2"(  >L  >L$" t h( dPHB dLHB8   >  > dH>|  dH>d  4   Q; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "######################### # DISK(ID: IDENTIFIER) # #########################" VAR OK: BOOLEAN; FILE*:HJLNSUWY[]_acegQTVXZ\^`bdfPRoqsuwy{}ikmprtvxz|~hjln     !#%' "$&79;=?)+-/1358:<>(*,.0246SUWACEGIKM@ t@j XpN <T`2g 0` /    7j "cH "& "xx %"VV M"44 "? "k |  " Z (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC(   "(    ""  x l `F  `" * * ," * *Z & * *" * *4(xd"-p b( 5" " #^<  " 8 , "U "hh "FF "$$ A" m"1l "]J " (  "z z  "X X G "w   "xhx . >" " , B dPH dLHBR`" K $R  X&\   X4 **X"f ""hp$m   (  " (x*$8 |2J$:N:JD$ VJV 8j4,4 HLd N.F X( d  r |hxh FZF z$<$ \t >V  8  zz XX :N J"lD  M"""  a"""  u"""p  p w "p" "L ^L #"L""( .( 7"(""%    "" "  K"""  _"""Bn Z" thD\pPD 8 ,   "(,).U248< @] D8# Z8V$ F|P(zG" p"G BX" B@"d H > fh 8 0 bJx (Vxb|> j^"pLd x."4pp p"ppLL L"L(Z( z("h(b(Vh 2"   " " ~bx fnx Nzx 6x dx DISPLAY: PICTURE UNKNOWN #GGjGSOLO SYSTEM: SPOOLING# INPUT #PROCESS# JOB#PROCESS#OUTPUT #PROCESS#CONTROL#BUFFER # INPUT #DEVICE # INPUT #BUFFER #CONTROL#BUFFER #OUTPUT #BUFFER #OUTPUT #DEVICE #EDIT(CARDS, TAPE)#JOB#DO #EDIT #IN #OUT#IO #IO #CARD #TAPE #PASCAL(PBH, PRINTER, RUN)#IN #IO #JOB#DO #OUT#IO #PASCAL #DISK #PRINT#PASS1#PASSZ2 * > "   ") "x x 3 "44 "V V K "5^ "< *" B"m6N 0  xx VlV  2#PASS3#PASS4#PASS5#PASS6#PASS7#FILE #SOLO SYSTEM: DISK FILES#- - -#- - -#EDIT #- - -#- - -#CATALOG#LENGTH #PAGE 1 #- - -#PAGE N #FILE MAP #- - -#FILE PAGES #SOLO SYSTEM: PROGRAM LOADING #1#2#3#4#5#6#7#8#1 1#2 3#3 5#4 7#5 2#6 4#7 6#8 8#9#10 #11 #12 #13 #14 #15 #16 #9 12#10 14 #11 16 #12 10 #13 13 #14 15 #15 9 #16 11 #SOLO SYSTEM: PROGRAM STRUCTURE #FIFO #RESOURCE #TYPEWRITER #TERMINAL #TERMINAL STREAM#DISK #DISK FILE#DISK TABLE #DISK CATALOG #DA4N4 nx4h( HVBT42&8 4 jB V  " 4 p"   ? "x  x  "V V ^ "4H4 "'  "h "TA FILE#PROGRAM FILE #PROGRAM STACK#BUFFERS#CHAR STREAM#JOB PROCESS#IO PROCESS #CARD PROCESS #PRINTER PROCESS#LOADER PROCESS #INITIAL PROCESS#PAGES#0.5#1#1#0.5#1#0.5#1#1#1#1#PAGES#1.5#1#1.5#1#2.5#2.5#0.5#0.5#1#21 #SPOOLING EDIT PASCAL DISK LOADING STRUCTURE PRETTY 16 #9 12#10 14 #11 16 #12 10 #13 13 #14 15 #15 9 #16 11 #SOLO SYSTEM: PROGRAM STRUCTURE #FIFO #RESOURCE #TYPEWRITER #TERMINAL #TERMINAL STREAM#DISK #DISK FILE#DISK TABLE #DISK CATALOG #DAF 5"$ "+ "hh "FF I"$$ R"z $"VX "6 O"f$Rj >4 B Fxx JxVV N4z4 RV4RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUMP Vpxj|Z4N`  ^*$ d4 j phfh vhF<F |\FVh$$ 2$,>   6`W , STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); N : & `  @k     r^Jp6A\`"m H_ <T@$ )Us   =r  PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT_D2 ^`<@r "j4~jV`bB@. H        z4t6z8f:`(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;R<x@>>d *4@PB<T* D$< L ` T`  \ B d l@ tt@j |Xp@,=`@ YjT ; NEWFRAME(PAGE1, 1251, 8, 5); NEWFRAME(PAGE2, 2051, 8, 5); LABEL(411, 'SOLO SYSTEM: DISK FILES#'); PAUSE; WRITEFRAME(CAT1); LABEL(1213, '- - -#'); WRITEFRAME(CAT2); LABEL(1513, '- - -#'); WRITEFRAME(CAT3); LABEL(1814, 'EDIT #'); WRITEFRAME(CAT4); LABEL(2113, '- - -#'); WRITEFRAME(CAT5); LABEL(2413, '- - -#'); LABEL(2911, 'CATALOG#'); PAUSE; WRITEFRAME(MAP1); LABEL(1233, 'LENGTH #'); WRITEFRAME(MAP2); LABEL(1533, 'PAGE 1 #'); WRITEFRAME(MAP3); LABEL(1833, '- - -#'); WRITEFRAM, 11, 4); BUFFER1.L:= 823; BUFFER1.M:= 923; NEWFRAME(CONTROL2.F, 2341, 11, 4); CONTROL2.L:= 2443; CONTROL2.M:= 2543; NEWFRAME(BUFFER2.F, 741, 11, 4); BUFFER2.L:= 843; BUFFER2.M:= 943; NEWFRAME(DEVICE2.F, 761, 11, 4); DEVICE2.L:= 863; DEVICE2.M:= 963; LABEL(221, 'SOLO SYSTEM: SPOOLING#'); PAUSE; WRITEFRAME(INPROC.F); LABEL(INPROC.L, ' INPUT #'); LABEL(INPROC.M, 'PROCESS#'); PAUSE; WRITEFRAME(JOBPROC.F); LABEL(JOBPROC.L, ' JOB#'); LABEL(JOBPROC.M, 'PROCESS#'); PAUSE; WRITEFRAME(OUTPE(MAP4); LABEL(2133, 'PAGE N #'); LABEL(2931, 'FILE MAP #'); CONNECT(CAT3, MAP2); PAUSE; WRITEFRAME(PAGE1); CONNECT(MAP2, PAGE1); LABEL(1853, '- - -#'); WRITEFRAME(PAGE2); CONNECT(MAP4, PAGE2); LABEL(2951, 'FILE PAGES #'); PAUSE; END; PROCEDURE SHOW_LOADING; VAR PAGE1, PAGE2, PAGE3, PAGE4, PAGE5, PAGE6, PAGE7, PAGE8, PAGE9, PAGE10, PAGE11, PAGE12, PAGE13, PAGE14, PAGE15, PAGE16, MAP1, MAP2, MAP3, MAP4: FRAME; BEGIN NEWFRAME(PAGE1, 2116, 4, 3); NEWFRAME(PAGE2, 1806, 4, 3); ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: CHAR); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "################################# # DISPLAY(PICTURE: IDENTIFIER) # #################################" "INSEROC.F); LABEL(OUTPROC.L, 'OUTPUT #'); LABEL(OUTPROC.M, 'PROCESS#'); PAUSE; WRITEFRAME(CONTROL1.F); LABEL(CONTROL1.L, 'CONTROL#'); LABEL(CONTROL1.M, 'BUFFER #'); CONNECT(JOBPROC.F, CONTROL1.F); CONNECT(CONTROL1.F, INPROC.F); PAUSE; WRITEFRAME(DEVICE1.F); LABEL(DEVICE1.L, ' INPUT #'); LABEL(DEVICE1.M, 'DEVICE #'); CONNECT(INPROC.F, DEVICE1.F); PAUSE; WRITEFRAME(BUFFER1.F); LABEL(BUFFER1.L, ' INPUT #'); LABEL(BUFFER1.M, 'BUFFER #'); CONNECT(INPROC.F, BUFFER1.F); CONNECT(BUFFER1.F,RT PREFIX HERE" CONST FF = '(:12:)'; ESC = '(:27:)'; GS = '(:29:)'; US = '(:31:)'; TYPE POINT = RECORD X, Y: INTEGER END; VECTOR = RECORD P, Q: POINT END; FRAME = RECORD TOP, RIGHT, BOTTOM, LEFT: VECTOR END; VAR OK: BOOLEAN; PICTURE: IDENTIFIER; LAST_RANDOM: REAL; "CHARACTER OPERATIONS" PROCEDURE WRITECHAR(C: CHAR); VAR PARAM: IOPARAM; X: CHAR; BEGIN PARAM.OPERATION:= OUTPUT; X:= C; IOTRANSFER(TYPEDEVICE, PARAM, X); END; PROCEDURE READCHAR(VAR C: CHAR); BEGIN ACCEPT(C) END; "MODE JOBPROC.F); PAUSE; WRITEFRAME(CONTROL2.F); LABEL(CONTROL2.L, 'CONTROL#'); LABEL(CONTROL2.M, 'BUFFER #'); CONNECT(JOBPROC.F, CONTROL2.F); CONNECT(CONTROL2.F, OUTPROC.F); PAUSE; WRITEFRAME(BUFFER2.F); LABEL(BUFFER2.L, 'OUTPUT #'); LABEL(BUFFER2.M, 'BUFFER #'); CONNECT(JOBPROC.F, BUFFER2.F); CONNECT(BUFFER2.F, OUTPROC.F); PAUSE; WRITEFRAME(DEVICE2.F); LABEL(DEVICE2.L, 'OUTPUT #'); LABEL(DEVICE2.M, 'DEVICE #'); CONNECT(OUTPROC.F, DEVICE2.F); PAUSE; END; PROCEDURE SHOW_EDIT; VAR JOPERATIONS" PROCEDURE WAIT(MSEC: INTEGER); VAR I, J, K: INTEGER; BEGIN FOR I:= 1 TO MSEC DO FOR J:= 1 TO 9 DO K:= 10 DIV 10; END; PROCEDURE GRAPHIC_MODE; BEGIN WRITECHAR(GS) END; PROCEDURE CHAR_MODE; BEGIN WAIT(10); WRITECHAR(US); END; "POINT OPERATIONS" PROCEDURE NEWPOINT(VAR P: POINT; X, Y: INTEGER); BEGIN P.X:= X; P.Y:= Y END; FUNCTION POINT_ABOVE(P, Q: POINT): BOOLEAN; BEGIN POINT_ABOVE:= (P.Y > Q.Y) END; FUNCTION POINT_LEFTOF(P, Q: POINT): BOOLEAN; BEGIN POINT_LEFTOF:= (P.X < OB, DO_, EDIT, IN_, OUT_, IO1, IO2, CARDS, TAPE: RECORD F: FRAME; L: INTEGER END; BEGIN NEWFRAME(JOB.F, 3033, 6, 3); JOB.L:= 3134; NEWFRAME(DO_.F, 2433, 6, 3); DO_.L:= 2535; NEWFRAME(EDIT.F, 1833, 6, 3); EDIT.L:= 1934; NEWFRAME(IN_.F, 3021, 6, 3); IN_.L:= 3123; NEWFRAME(IO1.F, 1821, 6, 3); IO1.L:= 1923; NEWFRAME(OUT_.F, 3045, 6, 3); OUT_.L:= 3147; NEWFRAME(IO2.F, 1845, 6, 3); IO2.L:= 1947; NEWFRAME(CARDS.F, 1221, 6, 3); CARDS.L:= 1322; NEWFRAME(TAPE.F, 1245, 6, 3); TAPE.L:= 1346; LQ.X) END; PROCEDURE WRITEPOINT(P: POINT); BEGIN WRITECHAR(CHR(P.Y DIV 32 + 32)); WRITECHAR(CHR(P.Y MOD 32 + 96)); WRITECHAR(CHR(P.X DIV 32 + 32)); WRITECHAR(CHR(P.X MOD 32 + 64)); END; "VECTOR OPERATIONS" PROCEDURE NEWVECTOR(VAR V: VECTOR; P, Q: POINT); BEGIN V.P:= P; V.Q:= Q END; FUNCTION VECTOR_ABOVE(U, V: VECTOR): BOOLEAN; BEGIN VECTOR_ABOVE:= POINT_ABOVE(U.P, V.P) & POINT_ABOVE(U.Q, V.Q); END; FUNCTION VECTOR_LEFTOF(U, V: VECTOR): BOOLEAN; BEGIN VECTOR_LEFTOF:= POINT_ABEL(621, 'EDIT(CARDS, TAPE)#'); PAUSE; WRITEFRAME(JOB.F); LABEL(JOB.L, 'JOB#'); PAUSE; WRITEFRAME(DO_.F); LABEL(DO_.L, 'DO #'); CONNECT(JOB.F, DO_.F); PAUSE; WRITEFRAME(EDIT.F); LABEL(EDIT.L, 'EDIT #'); CONNECT(DO_.F, EDIT.F); PAUSE; WRITEFRAME(IN_.F); LABEL(IN_.L, 'IN #'); WRITEFRAME(OUT_.F); LABEL(OUT_.L, 'OUT#'); PAUSE; WRITEFRAME(IO1.F); LABEL(IO1.L, 'IO #'); CONNECT(IN_.F, IO1.F); WRITEFRAME(IO2.F); LABEL(IO2.L, 'IO #'); CONNECT(OUT_.F, IO2.F); PAUSE; CONNECT(EDIT.FLEFTOF(U.P, V.P) & POINT_LEFTOF(U.Q, V.Q); END; PROCEDURE MIDDLE(V: VECTOR; VAR M: POINT); BEGIN WITH V DO NEWPOINT(M, (P.X + Q.X) DIV 2, (P.Y + Q.Y) DIV 2); END; PROCEDURE WRITEVECTOR(V: VECTOR); BEGIN GRAPHIC_MODE; WRITEPOINT(V.P); WRITEPOINT(V.Q); CHAR_MODE; END; "FRAME OPERATIONS" PROCEDURE NEWORIGIN(VAR P: POINT; POSITION: INTEGER); BEGIN NEWPOINT(P, POSITION MOD 100 * 14 - 2, 785 - POSITION DIV 100 * 22); END; PROCEDURE NEWFRAME(VAR S: FRAME; POSI, IO1.F); CONNECT(EDIT.F, IO2.F); PAUSE; WRITEFRAME(CARDS.F); LABEL(CARDS.L, 'CARD #'); CONNECT(IO1.F, CARDS.F); PAUSE; WRITEFRAME(TAPE.F); LABEL(TAPE.L, 'TAPE #'); CONNECT(IO2.F, TAPE.F); PAUSE; CONNECT(EDIT.F, CARDS.F); CONNECT(EDIT.F, TAPE.F); PAUSE; END; PROCEDURE SHOW_PASCAL; VAR IN_, IO1, JOB, DO_, OUT_, IO2, PASCAL, DISK, PRINT, PASS1, PASS2, PASS3, PASS4, PASS5, PASS6, PASS7, FILE_: RECORD F: FRAME; L: INTEGER END; BEGIN NEWFRAME(IN_.F, 3001, 7, 3); IN_.L:= 3104; TION, LENGTH, HEIGHT: INTEGER); VAR A, B, C, D: POINT; BEGIN NEWORIGIN(A, POSITION); NEWORIGIN(B, POSITION + LENGTH); NEWORIGIN(C, POSITION + LENGTH + HEIGHT*100); NEWORIGIN(D, POSITION + HEIGHT*100); WITH S DO BEGIN NEWVECTOR(TOP, A, B); NEWVECTOR(RIGHT, B, C); NEWVECTOR(BOTTOM, C, D); NEWVECTOR(LEFT, D, A); END; END; FUNCTION FRAME_ABOVE(S, T: FRAME): BOOLEAN; BEGIN FRAME_ABOVE:= VECTOR_ABOVE(S.BOTTOM, T.TOP) END; FUNCTION FRAME_LEFTOF(S, T: FRAME): BOOLEAN; BEGIN FRAME_LEF NEWFRAME(IO1.F, 1801, 7, 3); IO1.L:= 1904; NEWFRAME(JOB.F, 3031, 10, 3); JOB.L:= 3135; NEWFRAME(DO_.F, 2431, 10, 3); DO_.L:= 2535; NEWFRAME(OUT_.F, 3064, 7, 3); OUT_.L:= 3166; NEWFRAME(IO2.F, 1864, 7, 3); IO2.L:= 1966; NEWFRAME(PASCAL.F, 1831, 10, 3); PASCAL.L:= 1933; NEWFRAME(DISK.F, 402, 6, 3); DISK.L:= 503; NEWFRAME(PRINT.F, 464, 7, 3); PRINT.L:= 565; NEWFRAME(PASS1.F, 1207, 7, 3); PASS1.L:= 1308; NEWFRAME(PASS2.F, 811, 7, 3); PASS2.L:= 912; NEWFRAME(PASS3.F, 418, 7, 3); PASS3.L:= 51TOF:= VECTOR_LEFTOF(S.RIGHT, T.LEFT) END; PROCEDURE WRITEFRAME(S: FRAME); BEGIN WRITEVECTOR(S.TOP); WRITEVECTOR(S.RIGHT); WRITEVECTOR(S.BOTTOM); WRITEVECTOR(S.LEFT); END; PROCEDURE CONNECT(S, T: FRAME); VAR U, V, W: VECTOR; M, N: POINT; BEGIN IF FRAME_ABOVE(S, T) THEN BEGIN U:= S.BOTTOM; V:= T.TOP END ELSE IF FRAME_ABOVE(T, S) THEN BEGIN U:= S.TOP; V:= T.BOTTOM END ELSE IF FRAME_LEFTOF(S, T) THEN BEGIN U:= S.RIGHT; V:= T.LEFT END ELSE BEGIN U:= S.LEFT; V:= T.RIGHT END; MIDDLE9; NEWFRAME(PASS4.F, 228, 7, 3); PASS4.L:= 329; NEWFRAME(PASS5.F, 237, 7, 3); PASS5.L:= 338; NEWFRAME(PASS6.F, 447, 7, 3); PASS6.L:= 548; NEWFRAME(PASS7.F, 854, 7, 3); PASS7.L:= 955; NEWFRAME(FILE_.F, 1258, 7, 3); FILE_.L:= 1359; LABEL(102, 'PASCAL(PBH, PRINTER, RUN)#'); PAUSE; WRITEFRAME(IN_.F); LABEL(IN_.L, 'IN #'); WRITEFRAME(IO1.F); LABEL(IO1.L, 'IO #'); CONNECT(IN_.F, IO1.F); WRITEFRAME(JOB.F); LABEL(JOB.L, 'JOB#'); WRITEFRAME(DO_.F); LABEL(DO_.L, 'DO #'); CONNECT(JOB.F, DO_.F(U, M); MIDDLE(V, N); NEWVECTOR(W, M, N); WRITEVECTOR(W); END; "TEXT OPERATIONS" PROCEDURE WRITEFF; BEGIN WRITECHAR(ESC); WRITECHAR(FF); WAIT(1000); END; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> '#' DO BEGIN WRITECHAR(C); I:= I + 1; C:= TEXT(.I.); END; WRITECHAR(NL); END; PROCEDURE NEWPOSITION(POSITION: INTEGER); VAR P: POINT; BEGIN NEWPOINT(P, POSITION MOD 100 *14, 767 - POSITION DIV 100 *22); GR); WRITEFRAME(OUT_.F); LABEL(OUT_.L, 'OUT#'); WRITEFRAME(IO2.F); LABEL(IO2.L, 'IO #'); CONNECT(OUT_.F, IO2.F); PAUSE; WRITEFRAME(PASCAL.F); LABEL(PASCAL.L, 'PASCAL #'); CONNECT(DO_.F, PASCAL.F); PAUSE; CONNECT(PASCAL.F, IO1.F); CONNECT(PASCAL.F, IO2.F); PAUSE; WRITEFRAME(DISK.F); LABEL(DISK.L, 'DISK #'); CONNECT(IO1.F, DISK.F); WRITEFRAME(PRINT.F); LABEL(PRINT.L, 'PRINT#'); CONNECT(IO2.F, PRINT.F); PAUSE; WRITEFRAME(PASS1.F); LABEL(PASS1.L, 'PASS1#'); CONNECT(PASCAL.F, PASSAPHIC_MODE; WRITEPOINT(P); CHAR_MODE; END; PROCEDURE LABEL(POSITION: INTEGER; TEXT: LINE); BEGIN NEWPOSITION(POSITION); WRITETEXT(TEXT); END; PROCEDURE PAUSE; VAR C: CHAR; BEGIN NEWPOSITION(0); REPEAT READCHAR(C) UNTIL C = NL; END; "INITIALIZATION AND TERMINATION" PROCEDURE INITIALIZE; BEGIN WITH PARAM(.2.) DO IF TAG = IDTYPE THEN BEGIN PICTURE:= ID; OK:= (TASK = JOBTASK); WRITEFF; END ELSE OK:= FALSE; END; PROCEDURE UNKNOWN; BEGIN WRITETEXT('DISPLAY:(:10:)PICTUR1.F); PAUSE; WRITEFRAME(PASS2.F); LABEL(PASS2.L, 'PASS2#'); CONNECT(PASCAL.F, PASS2.F); PAUSE; WRITEFRAME(PASS3.F); LABEL(PASS3.L, 'PASS3#'); CONNECT(PASCAL.F, PASS3.F); PAUSE; WRITEFRAME(PASS4.F); LABEL(PASS4.L, 'PASS4#'); CONNECT(PASCAL.F, PASS4.F); PAUSE; WRITEFRAME(PASS5.F); LABEL(PASS5.L, 'PASS5#'); CONNECT(PASCAL.F, PASS5.F); PAUSE; WRITEFRAME(PASS6.F); LABEL(PASS6.L, 'PASS6#'); CONNECT(PASCAL.F, PASS6.F); PAUSE; WRITEFRAME(PASS7.F); LABEL(PASS7.L, 'PASS7#'); CONNECE UNKNOWN(:10:)#'); END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; IF OK THEN WRITEFF; END; "RANDOM NUMBER GENERATOR" PROCEDURE INIT_RANDOM; BEGIN LAST_RANDOM:= 19575.0 END; FUNCTION RANDOM(INTERVAL: INTEGER): INTEGER; CONST A = 31413.0; M = 32767.0; BEGIN LAST_RANDOM:= A * LAST_RANDOM; LAST_RANDOM:= LAST_RANDOM - CONV(TRUNC(LAST_RANDOM/M))*M; RANDOM:= TRUNC(LAST_RANDOM/M*CONV(INTERVAL)); END; "PICTURES" PROCEDURE SHOW_SPOOLING; VAR INPRT(PASCAL.F, PASS7.F); PAUSE; WRITEFRAME(FILE_.F); LABEL(FILE_.L, 'FILE #'); CONNECT(PASCAL.F, FILE_.F); PAUSE; END; PROCEDURE SHOW_DISK; VAR CAT1, CAT2, CAT3, CAT4, CAT5, MAP1, MAP2, MAP3, MAP4, PAGE1, PAGE2: FRAME; BEGIN NEWFRAME(CAT1, 1111, 10, 3); NEWFRAME(CAT2, 1411, 10, 3); NEWFRAME(CAT3, 1711, 10, 3); NEWFRAME(CAT4, 2011, 10, 3); NEWFRAME(CAT5, 2311, 10, 3); NEWFRAME(MAP1, 1131, 10, 3); NEWFRAME(MAP2, 1431, 10, 3); NEWFRAME(MAP3, 1731, 10, 3); NEWFRAME(MAP4, 2031, 10, 3)OC, JOBPROC, OUTPROC, CONTROL1, DEVICE1, BUFFER1, CONTROL2, BUFFER2, DEVICE2: RECORD F: FRAME; L, M: INTEGER END; BEGIN NEWFRAME(INPROC.F, 1511, 11, 4); INPROC.L:= 1613; INPROC.M:= 1713; NEWFRAME(JOBPROC.F, 1531, 11, 4); JOBPROC.L:= 1633; JOBPROC.M:= 1733; NEWFRAME(OUTPROC.F, 1551, 11, 4); OUTPROC.L:= 1653; OUTPROC.M:= 1753; NEWFRAME(CONTROL1.F, 2321, 11, 4); CONTROL1.L:= 2423; CONTROL1.M:= 2523; NEWFRAME(DEVICE1.F, 701, 11, 4); DEVICE1.L:= 803; DEVICE1.M:= 903; NEWFRAME(BUFFER1.F, 721 jlnrtvxz|~     !#%' "$&/13579;=?)+-02468:<>(*,.KMOQSUWACEGILNPRTV@BDFHJgikmoY[]_acehjlnXZ\^`bdfqsD PROCESS #'); PAUSE; WRITEFRAME(BOX18.F); LABEL(BOX18.L, 'PRINTER PROCESS#'); PAUSE; WRITEFRAME(BOX19.F); LABEL(BOX19.L, 'LOADER PROCESS #'); PAUSE; WRITEFRAME(BOX20.F); LABEL(BOX20.L, 'INITIAL PROCESS#'); PAUSE; LABEL(203, 'PAGES#'); LABEL(404, '0.5#'); LABEL(704, '1#'); LABEL(1004, '1#'); LABEL(1304, '0.5#'); LABEL(1604, '1#'); LABEL(1904, '0.5#'); LABEL(2204, '1#'); LABEL(2504, '1#'); LABEL(2804, '1#'); LABEL(3104, '1#'); LABEL(264, 'PAGES#'); LABEL(465, '1.5#'); N( " " ^<  >" "0 " " >"   P0>   L" X" BB `  V-  " \( * " `@  "  ^ LABEL(765, '1#'); LABEL(1065, '1.5#'); LABEL(1365, '1#'); LABEL(1665, '2.5#'); LABEL(1965, '2.5#'); LABEL(2265, '0.5#'); LABEL(2565, '0.5#'); LABEL(3165, '1#'); PAUSE; NEWFRAME(F, 3363, 4, 1); WRITEFRAME(F); LABEL(3364, '21 #'); PAUSE; END; PROCEDURE SHOW_PRETTY; CONST BEL = '(:7:)'; VAR X, Y, LENGTH, HEIGHT: INTEGER; BOX: FRAME; BEGIN INIT_RANDOM; REPEAT X:= RANDOM(71); Y:= RANDOM(32); LENGTH:= RANDOM(71 - X); HEIGHT:= RANDOM(32 - Y); NEWFRAME(BOX, 100*Y$ * * (* 4*| @*l L*\ X*L d*< p*, |* Zhv0  t   |  X"" ""~vnf^""@8""2H + X, LENGTH, HEIGHT); WRITEFRAME(BOX); WRITECHAR(BEL); WAIT(1000); UNTIL FALSE; END; BEGIN INITIALIZE; IF NOT OK THEN UNKNOWN ELSE IF PICTURE = 'SPOOLING ' THEN SHOW_SPOOLING ELSE IF PICTURE = 'EDIT ' THEN SHOW_EDIT ELSE IF PICTURE = 'PASCAL ' THEN SHOW_PASCAL ELSE IF PICTURE = 'DISK ' THEN SHOW_DISK ELSE IF PICTURE = 'LOADING ' THEN SHOW_LOADING ELSE IF PICTURE = 'STRUCTURE ' THEN SHOW_STRUCTURE ELSE IF PICTURE = 'PRETTY ' THEN SHOW_PRETTY"*    Xj  >"   "  >" " ^ &   "XX  "X X6 ^   ^x " ` _`2 , " " "NEWFRAME(PAGE3, 1202, 4, 3); NEWFRAME(PAGE4, 606, 4, 3); NEWFRAME(PAGE5, 316, 4, 3); NEWFRAME(PAGE6, 626, 4, 3); NEWFRAME(PAGE7, 1230, 4, 3); NEWFRAME(PAGE8, 1826, 4, 3); NEWFRAME(PAGE9, 2154, 4, 3); NEWFRAME(PAGE10, 1844, 4, 3); NEWFRAME(PAGE11, 1240, 4, 3); NEWFRAME(PAGE12, 644, 4, 3); NEWFRAME(PAGE13, 354, 4, 3); NEWFRAME(PAGE14, 664, 4, 3); NEWFRAME(PAGE15, 1268, 4, 3); NEWFRAME(PAGE16, 1864, 4, 3); NEWFRAME(MAP1, 2505, 6, 9); NEWFRAME(MAP2, 2529, 6, 9); NEWFRAME(MAP3, 25 ELSE UNKNOWN; TERMINATE; END.  744; ; APE: 47, 6, 9); NEWFRAME(MAP4, 2567, 6, 9); LABEL(122, 'SOLO SYSTEM: PROGRAM LOADING #'); PAUSE; WRITEFRAME(PAGE1); LABEL(2218, '1#'); WRITEFRAME(PAGE2); LABEL(1908, '2#'); WRITEFRAME(PAGE3); LABEL(1304, '3#'); WRITEFRAME(PAGE4); LABEL(708, '4#'); WRITEFRAME(PAGE5); LABEL(418, '5#'); WRITEFRAME(PAGE6); LABEL(728, '6#'); WRITEFRAME(PAGE7); LABEL(1332, '7#'); WRITEFRAME(PAGE8); LABEL(1928, '8#'); PAUSE; WRITEFRAME(MAP1); LABEL(2602, '1 1#'); PAUSE; CONNECT(PAGE1, PAGE3); LABEL(2 U~|zxvtrljfdbLHFDB@b`^\ZXVTRPNLJHFDB@><:86420 &,D  " (" X X6  `2@      >"  `6     >" nx& ( "< zx" 802, '2 3#'); PAUSE; CONNECT(PAGE3, PAGE5); LABEL(3002, '3 5#'); PAUSE; CONNECT(PAGE5, PAGE7); LABEL(3202, '4 7#'); PAUSE; CONNECT(PAGE7, PAGE2); WRITEFRAME(MAP2); LABEL(2626, '5 2#'); PAUSE; CONNECT(PAGE2, PAGE4); LABEL(2826, '6 4#'); PAUSE; CONNECT(PAGE4, PAGE6); LABEL(3026, '7 6#'); PAUSE; CONNECT(PAGE6, PAGE8); LABEL(3226, '8 8#'); PAUSE; WRITEFRAME(PAGE9); LABEL(2256, '9#'); WRITEFRAME(PAGE10); LABEL(1945, '10 #'); WRITEFRAME(PAGE11); LABEL(( ".`  ( "" X 02 0B"  B LZ".  H >"`  " "&vf " " "~ "l "z "l 1b`^\ZXVTRPNLJHDB@><:86420.,*Zj1341, '11 #'); WRITEFRAME(PAGE12); LABEL(745, '12 #'); WRITEFRAME(PAGE13); LABEL(455, '13 #'); WRITEFRAME(PAGE14); LABEL(765, '14 #'); WRITEFRAME(PAGE15); LABEL(1369, '15 #'); WRITEFRAME(PAGE16); LABEL(1965, '16 #'); PAUSE; CONNECT(PAGE8, PAGE12); WRITEFRAME(MAP3); LABEL(2644, '9 12#'); PAUSE; CONNECT(PAGE12, PAGE14); LABEL(2843, '10 14 #'); PAUSE; CONNECT(PAGE14, PAGE16); LABEL(3043, '11 16 #'); PAUSE; CONNECT(PAGE16, PAGE10); LABEL(3243, '12 10 #'); PAUSE; CONNE$"v j""""b( (   ( " "" `(   ((  >" X  `20    * "* " X X2 CT(PAGE10, PAGE13); WRITEFRAME(MAP4); LABEL(2663, '13 13 #'); PAUSE; CONNECT(PAGE13, PAGE15); LABEL(2863, '14 15 #'); PAUSE; CONNECT(PAGE15, PAGE9); LABEL(3063, '15 9 #'); PAUSE; CONNECT(PAGE9, PAGE11); LABEL(3263, '16 11 #'); PAUSE; END; PROCEDURE SHOW_STRUCTURE; VAR BOX1, BOX2, BOX3, BOX4, BOX5, BOX6, BOX7, BOX8, BOX9, BOX10, BOX11, BOX12, BOX13, BOX14, BOX15, BOX16, BOX17, BOX18, BOX19, BOX20: RECORD F: FRAME; L: INTEGER END; F: FRAME; BEGIN NEWFRAME(BOX1.F, *2 "d X< ^ X " X ^ X" 0*  $ 0   ^2  ,  ^  `N   X " ":  311, 20, 3); BOX1.L:= 419; NEWFRAME(BOX2.F, 611, 20, 3); BOX2.L:= 717; NEWFRAME(BOX3.F, 911, 20, 3); BOX3.L:= 1016; NEWFRAME(BOX4.F, 1211, 20, 3); BOX4.L:= 1317; NEWFRAME(BOX5.F, 1511, 20, 3); BOX5.L:= 1613; NEWFRAME(BOX6.F, 1811, 20, 3); BOX6.L:= 1919; NEWFRAME(BOX7.F, 2111, 20, 3); BOX7.L:= 2216; NEWFRAME(BOX8.F, 2411, 20, 3); BOX8.L:= 2516; NEWFRAME(BOX9.F, 2711, 20, 3); BOX9.L:= 2815; NEWFRAME(BOX10.F, 3011, 20, 3); BOX10.L:= 3116; NEWFRAME(BOX11.F, 341, 20, 3); BOX11.L:= 445; NEWF* ^ x"d $ 0*" Q*$^  \( \"^  \(  \* \*^  \( \*^  \( \ "^  \( \*RAME(BOX12.F, 641, 20, 3); BOX12.L:= 744; NEWFRAME(BOX13.F, 941, 20, 3); BOX13.L:= 1047; NEWFRAME(BOX14.F, 1241, 20, 3); BOX14.L:= 1345; NEWFRAME(BOX15.F, 1541, 20, 3); BOX15.L:= 1645; NEWFRAME(BOX16.F, 1841, 20, 3); BOX16.L:= 1946; NEWFRAME(BOX17.F, 2141, 20, 3); BOX17.L:= 2245; NEWFRAME(BOX18.F, 2441, 20, 3); BOX18.L:= 2543; NEWFRAME(BOX19.F, 2741, 20, 3); BOX19.L:= 2844; NEWFRAME(BOX20.F, 3041, 20, 3); BOX20.L:= 3143; LABEL(119, 'SOLO SYSTEM: PROGRAM STRUCTURE #'); PAUSE; WRITEFRA^  \( \"^, ^  r,^ 0 6% " ( 0*"  X 0 " " 0 " (7 ^26"$= ME(BOX1.F); LABEL(BOX1.L, 'FIFO #'); PAUSE; WRITEFRAME(BOX2.F); LABEL(BOX2.L, 'RESOURCE #'); PAUSE; WRITEFRAME(BOX3.F); LABEL(BOX3.L, 'TYPEWRITER #'); PAUSE; WRITEFRAME(BOX4.F); LABEL(BOX4.L, 'TERMINAL #'); PAUSE; WRITEFRAME(BOX5.F); LABEL(BOX5.L, 'TERMINAL STREAM#'); PAUSE; WRITEFRAME(BOX6.F); LABEL(BOX6.L, 'DISK #'); PAUSE; WRITEFRAME(BOX7.F); LABEL(BOX7.L, 'DISK FILE#'); PAUSE; WRITEFRAME(BOX8.F); LABEL(BOX8.L, 'DISK TABLE #'); PAUSE; WRITEFRAME(BOX9.F); LABEL(BOX9.L, 'DIS^""B<"$I@" > : " " p$Z   (  " aq*XR0>  RTERMINATED OVERFLOW POINTERERRORRANGEERROR VARIANTERRORHEAPLIMIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN PROGRAMNAK CATALOG #'); PAUSE; WRITEFRAME(BOX10.F); LABEL(BOX10.L, 'DATA FILE#'); PAUSE; WRITEFRAME(BOX11.F); LABEL(BOX11.L, 'PROGRAM FILE #'); PAUSE; WRITEFRAME(BOX12.F); LABEL(BOX12.L, 'PROGRAM STACK#'); PAUSE; WRITEFRAME(BOX13.F); LABEL(BOX13.L, 'BUFFERS#'); PAUSE; WRITEFRAME(BOX14.F); LABEL(BOX14.L, 'CHAR STREAM#'); PAUSE; WRITEFRAME(BOX15.F); LABEL(BOX15.L, 'JOB PROCESS#'); PAUSE; WRITEFRAME(BOX16.F); LABEL(BOX16.L, 'IO PROCESS #'); PAUSE; WRITEFRAME(BOX17.F); LABEL(BOX17.L, 'CARKIND:= OTHERCHAR; IF (NL <= CH) & (CH <= '_') THEN 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', '_': KIND:= LETTER; '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': KIND:= DIGIT; '(', ')', ',', ';', NL, EM: KIND:= SPECIAL END; END; END; "TOKEN INPUT" PROCEDURE SCANID; VAR I: INTEGER; BEGIN WITH TOKEN, ARG DO BEGIN KIND:= OPERAND; ALIZE; WHILE CONTINUE DO BEGIN IF ANYTHING THEN BEGIN NEXTCOMMAND; IF OK THEN CHECKCOMMAND; IF OK THEN EXECUTE; END; IF CONTINUE THEN INITNEXT; END; TERMINATE; END; END.  TAG:= IDTYPE; WITH SYMB DO BEGIN I:= 1; WHILE ((KIND = LETTER) OR (KIND = DIGIT)) & (I <= IDLENGTH) DO BEGIN ID(.I.):= CH; I:= I + 1; NEXTCHAR; END; WHILE I <= IDLENGTH DO BEGIN ID(.I.):= ' '; I:= I + 1 END; END; IF ID = 'FALSE ' THEN BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END ELSE IF ID = 'TRUE ' THEN BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; END; END; PROCEDURE SCANINT; CONST MAXINT = 32767; VAR D: INME OR PROGRAMNAME(ARG, ... , ARG) USING ARG: BOOLEAN, INTEGER, OR IDENTIFIER TRY AGAIN DO(SOURCE: IDENTIFIER) NOT EXECUTABLE, TRY LIST(CATALOG, SEQCODE, CONSOLE) FALSE TRUE DO: CONSOLE SOURCE FILE UNKNOWN SOURCE KIND MUST BE ASCII OR SEQCODE COMMANDS REPLACE CREATE ASCII FILE DO: FILE SOURCE COPY LOST NEXT DO: DO: ANTERRORHEAPLIMIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN PROGRAMNATEGER; OVERFLOW: BOOLEAN; BEGIN WITH TOKEN, ARG DO BEGIN TAG:= INTTYPE; WITH SYMB DO BEGIN INT:= 0; OVERFLOW:= FALSE; WHILE (KIND = DIGIT) & NOT OVERFLOW DO BEGIN D:= ORD(CH) - ORD('0'); IF INT > (MAXINT - D) DIV 10 THEN OVERFLOW:= TRUE ELSE INT:= 10 * INT + D; NEXTCHAR; END; END; IF OVERFLOW THEN KIND:= OTHERTOKEN ELSE KIND:= OPERAND; END; END; PROCEDURE SCANSPEC; BEGIN WITH TOKEN DO CASE SYMB6 6>"  6". .B""2 2 "08"" B `~ . Bd "  8"8 8 "  0"x8 8B". . B"D .d 2 T0  Xb  X:  X 2X2  .CH OF '(': BEGIN KIND:= LEFTPAR; NEXTCHAR END; ')': BEGIN KIND:= RIGHTPAR; NEXTCHAR END; ',': BEGIN KIND:= COMMA; NEXTCHAR END; ';': BEGIN KIND:= SEMICOLON; NEXTCHAR END; NL: KIND:= NEWLINE; EM: KIND:= ENDMEDIUM END; END; PROCEDURE SCANOTHER; BEGIN TOKEN.KIND:= OTHERTOKEN; NEXTCHAR; END; PROCEDURE NEXTTOKEN; BEGIN CASE SYMB.KIND OF LETTER: SCANID; DIGIT: SCANINT; SPECIAL: SCANSPEC; OTHERCHAR: SCANOTHER END; END; "COMMAND ANALYSIS" PROCEDURE xt T \@ T 4 n0Z .dT "X: % >" .d T T6" "" `\ . Bd "  "  ". .B"INITARG; VAR I: INTEGER; BEGIN WITH COMMAND DO BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; COUNT:= 1; FOR I:= 2 TO MAXARG DO LIST(.I.).TAG:= NILTYPE; END; END; PROCEDURE SCANARG; BEGIN WITH TOKEN, COMMAND DO BEGIN COUNT:= COUNT + 1; IF (KIND = OPERAND) & (COUNT <= MAXARG) THEN BEGIN LIST(.COUNT.):= ARG; NEXTTOKEN END ELSE OK:= FALSE; END; END; PROCEDURE NEXTCOMMAND; BEGIN WITH TOKEN, ARG, COMMAND DO BEGIN OK:= TRUE; IF (KIND$4 "" " 2= 2T 4 "" " P.K .d  8" d"4 8"8"    b߄Z      ߰$Y. .B",eh  X~  = OPERAND) & (TAG = IDTYPE) THEN BEGIN CODE:= ID; NEXTTOKEN END ELSE OK:= FALSE; INITARG; IF KIND = LEFTPAR THEN BEGIN REPEAT NEXTTOKEN; SCANARG; UNTIL KIND <> COMMA; IF KIND = RIGHTPAR THEN NEXTTOKEN ELSE OK:= FALSE; END; IF KIND = SEMICOLON THEN NEXTTOKEN; IF KIND <> NEWLINE THEN BEGIN REPEAT NEXTTOKEN UNTIL KIND = NEWLINE; OK:= FALSE; END; END; IF NOT OK THEN HELP1; END; PROCEDURE CHECKCOMMA X"  " "   ݄ ݰ(p .d X X6" "  >Rܰ&|: :>"h ے8t ^h  " 6 "@"2"8" : FILEATTR; LIST: ARGLIST; COUNT, HEAPTOP: INTEGER END; "CHARACTER OUTPUT" PROCEDURE WRITETEXT(TEXT: LINE); CONST NUL = '(:0:)'; VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> NUL DO BEGIN DISPLAY(C); I:= I + 1; C:= TEXT(.I.); END; END; PROCEDURE WRITEINT(INT, LENGTH: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MND; VAR I: INTEGER; BEGIN WITH COMMAND DO BEGIN LOOKUP(CODE, ATTR, OK); IF NOT OK THEN HELP3 ELSE IF ATTR.KIND <> SEQCODE THEN HELP3; END; END; PROCEDURE EXECUTE; VAR LINE: INTEGER; RESULT: PROGRESULT; C: CHAR; HEAPTOP: INTEGER; BEGIN WITH COMMAND DO BEGIN MARK(HEAPTOP); RUN(CODE, LIST, LINE, RESULT); RELEASE(HEAPTOP); IDENTIFY('DO:(:10:)'); IF RESULT <> TERMINATED THEN WRITERESULT(CODE, LINE, RESULT) ELSE BEGIN WITH LIST(.1.) DO IF TAG = BOOLOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO LENGTH - DIGIT - 1 DO DISPLAY(' '); IF INT < 0 THEN DISPLAY('-') ELSE DISPLAY(' '); FOR I:= DIGIT DOWNTO 1 DO DISPLAY(NUMBER(.I.)); END; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; C: CHAR; BEGIN FOR I:= 1 TO IDLENGTH DO BEGIN C:= ID(.I.); IF C <> ' ' THEN DISPLAY(C); END; END; PROCEDURE CONVRESULT(RESULT: PROGRESULT; VAR ID: IDENTIFIER); BEGIN CASE RESULT OF TERMINATED: ID:= 'TTYPE THEN OK:= BOOL ELSE OK:= FALSE; END; END; END; "INITIALIZATION AND TERMINATION" PROCEDURE CHECKARG; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> IDTYPE THEN HELP2 ELSE IF ID = 'CONSOLE ' THEN ONLINE:= TRUE ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN (:10:)(:0:)') ELSE CASE ATTR.KIND OF SCRATCH, CONCODE: ERROR('SOURCE KIND MUST BE ASCII OR SEQCERMINATED '; OVERFLOW: ID:= 'OVERFLOW '; POINTERERROR: ID:= 'POINTERERROR'; RANGEERROR: ID:= 'RANGEERROR '; VARIANTERROR: ID:= 'VARIANTERROR'; HEAPLIMIT: ID:= 'HEAPLIMIT '; STACKLIMIT: ID:= 'STACKLIMIT '; CODELIMIT: ID:= 'CODELIMIT '; TIMELIMIT: ID:= 'TIMELIMIT '; CALLERROR: ID:= 'CALLERROR ' END; END; PROCEDURE WRITERESULT (ID: IDENTIFIER; LINE: INTEGER; RESULT: PROGRESULT); VAR ARG: IDENTIFIER; BEGIN WRITEID(ID); WRITEODE(:10:)(:0:)'); ASCII, SEQCODE: END; ONLINE:= FALSE; END; END; PROCEDURE SAVECOPY(LENGTH: INTEGER); VAR ATTR: FILEATTR; FOUND: BOOLEAN; LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN COPY:= 'COMMANDS '; LOOKUP(COPY, ATTR, FOUND); WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF FOUND THEN ID:= 'REPLACE ' ELSE ID:= 'CREATE '; END; WITH LIST(.3.) DO BEGIN TAG:= IDTYPE; ID:= COPYTEXT(': LINE (:0:)'); WRITEINT(LINE, 4); DISPLAY(' '); CONVRESULT(RESULT, ARG); WRITEID(ARG); DISPLAY(NL); OK:= (RESULT = TERMINATED); END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP1; BEGIN WRITETEXT('TRY AGAIN (:10:)(:0:)'); WRITETEXT(' PROGRAMNAME(:10:)(:0:)'); WRITETEXT('OR(:10:)(:0:)'); WRITETEXT(' PROGRAMNAME(ARG, ... , ARG)(:10:)(:0:)'); WRITETEXT('USING (:10:)(:0:)'); WRITETEXT(' ARG: BOOLEAN, INTEGER, OR IDENTIFIER ( END; WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; WITH LIST(.5.) DO BEGIN TAG:= IDTYPE; ID:= 'ASCII ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('DO:(:10:)'); IF RESULT <> TERMINATED THEN WRITERESULT('FILE ', LINE, RESULT) ELSE IF NOT LIST(.1.).BOOL THEN ERROR('SOURCE COPY LOST(:10:)(:0:)'); END; PROCEDURE MAKECOPY; VAR ARG: ARGTYPE; LENGTH: INTEGER; C: CHAR; BEGIN WRITEARG:10:)(:0:)'); OK:= FALSE; END; PROCEDURE HELP2; BEGIN WRITETEXT('TRY AGAIN (:10:)(:0:)'); WRITETEXT(' DO(SOURCE: IDENTIFIER) (:10:)(:0:)'); OK:= FALSE; END; PROCEDURE HELP3; BEGIN WRITETEXT('NOT EXECUTABLE, TRY (:10:)(:0:)'); WRITETEXT(' LIST(CATALOG, SEQCODE, CONSOLE)(:10:)(:0:)'); OK:= FALSE; END; "CHARACTER INPUT" PROCEDURE READCHAR(VAR C: CHAR); VAR FOUND: BOOLEAN; BEGIN IF ONLINE THEN ACCEPT(C) ELSE WITH BUFFER DO BEGIN IF CHARNO = PAGELENGTH THEN BEGIN OPE(INP, SOURCE); WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'NEXT ' END; WRITEARG(OUT, ARG); REPEAT READ(C); WRITE(C); UNTIL C = EM; READARG(INP, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; READARG(OUT, ARG); LENGTH:= ARG.INT; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF OK THEN SAVECOPY(LENGTH); END; FUNCTION CONTINUE: BOOLEAN; BEGIN CONTINUE:= ONLINE OR OK & (TOKEN.KIND <> ENDMEDIUM); END; FUNCTION ANYTHING: BOOLEAN; BEGIN ANYTHING:= (TOKEN.KIND <> NEWLINE); END; N(1, COPY, FOUND); PAGENO:= PAGENO + 1; GET(1, PAGENO, TEXT); CLOSE(1); CHARNO:= 0; END; CHARNO:= CHARNO + 1; C:= TEXT(.CHARNO.); IF C <> EM THEN DISPLAY(C); END; END; PROCEDURE NEXTCHAR; BEGIN WITH SYMB DO BEGIN REPEAT "SKIP BLANKS" READCHAR(CH); WHILE CH = '"' DO BEGIN "SKIP COMMENT" REPEAT READCHAR(CH) UNTIL (CH = '"') OR (CH = EM); IF CH <> EM THEN READCHAR(CH); END; UNTIL CH <> ' '; PROCEDURE INITNEXT; BEGIN IDENTIFY('DO:(:10:)'); OK:= TRUE; NEXTCHAR; NEXTTOKEN; END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('DO:(:10:)'); OK:= TRUE; CHECKARG; IF ONLINE THEN INITNEXT ELSE BEGIN IF OK THEN MAKECOPY; WITH BUFFER DO BEGIN PAGENO:= 0; CHARNO:= PAGELENGTH; END; IF OK THEN INITNEXT; END; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; "MAIN CYCLE" BEGIN IF TASK = JOBTASK THEN BEGIN INITI 06 ,:*X"  * ^ nZ $ 0>*T  * ^ J $ 0z^ p  * ^ ^X $ 0"& "4E      !#%' "$&79;=?)+-/1358:<>(*,.0246SUWACEGIKMOQTV@BDFHJLNPRoY[]_acegikmXZ\^`bdfhjlnsuwy{}qtvxz|~pr      "$&!#%'8:<>(*,.02469;=?)+-/1357TV@BDFHJLNPRUWACEGIKMOQSXZ\^`bdfhjlnY[]_acegikmotvxz|~pruwy{}qs################# # EDIT MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: EDITS AN ASCII FILE INPUT FROM A SOURCE MEDIUM AND OUTPUTS IT ON A DESTINATION MEDIUM. EDITING COMMANDS ARE INPUT FROM THE CONSOLE. THERE ARE ONLY TWO KINDS OF COMMANDS: DELETE ONE OR MORE LINES, AND COMPLETE THE COPYING OF THE SOURCE FILE. ANYTHING ELSE INPUT FROM THE CONSOLE IS APPENDED TO THE DESTINATION FILE AT ITS CURRENT POSITION. INITIALLY, THE DESTINATION FILE IS EMPTY. THE EDITOR IS ONLY ABLE TO (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCDELETE AND INSERT COMPLETE LINES IDENTIFIED BY LINE NUMBERS. CALL: EDIT(FILE: IDENTIFIER) EDIT(SOURCE, DESTINATION: IDENTIFIER) THE COMMAND: EDIT(F) IS EQUIVALENT TO: EDIT(F, F). THE SOURCE CAN EITHER BE AN ASCII DISK FILE OR A SEQUENTIAL PROGRAM THAT INPUTS AN ASCII FILE. THE DESTINATION FILE CAN BE AN ASCII DISK FILE, A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE, OR A NON-EXISTING FILE. IN THE FIRST CASE, THE EXISTING FILE (WHICH MUST BE UNPROTECTED) IS REPLACED BY A NEW ONE OF THE SAME NARATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUMME. IN THE LAST CASE, A NEW FILE IS CREATED AND STORED ON DISK. IN BOTH CASES, THE RESULTING DISK FILE WILL BE AN UNPROTECTED ASCII FILE. DELETE COMMAND: DEL(LINENO: INTEGER) DEL(FIRSTLINE, LASTLINE: INTEGER) DEL(L) IS EQUIVALENT TO DEL(L, L). COPIES THE SOURCE FILE FROM THE CURRENT LINE NUMBER UP TO THE FIRST LINE - 1, AND DELETES THE FIRST LINE THROUGH THE LAST LINE INCLUSIVE. THE SOURCE LINES ARE NUMBERED 1, 2, 3, ... COMPLETE COMMAND: # COPIES THE SOURCE FILE FROM THE CURRENT LINE UP TO , STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); AND INCLUDING THE FINAL EM CHARACTER. INSERT COMMAND: ANY CONSOLE LINE THAT IS NEITHER A DELETE NOR A COMPLETE COMMAND IS IS APPENDED TO THE LAST LINE OUTPUT TO THE DESTINATION FILE. REPLACE COMMAND: SOURCE LINES CAN BE REPLACED BY DELETION FOLLOWED BY INSERTION. ERROR MESSAGES: LINE ALREADY PASSED THE FIRST LINE OF A DELETE COMMAND HAS ALREADY BEEN PASSED IN THE SOURCE FILE. LINE NUMBERS ILLEGAL THE FIRST LINE NUMBER IN A DELETE COMMAND IS GREATER THAN THE LAST LINE NUMBER. DESTINATION FILE L PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTOST THE FILE PROGRAM CALLED BY EDIT FAILED TO CREATE OR REPLACE THE DESTINATION FILE DUE TO RUN-TIME ERRORS. E COMMAND IS IS APPENDED TO THE LAST LINE OUTPUT TO THE DESTINATION FILE. REPLACE COMMAND: SOURCE LINES CAN BE REPLACED BY DELETION FOLLOWED BY INSERTION. ERROR MESSAGES: LINE ALREADY PASSED THE FIRST LINE OF A DELETE COMMAND HAS ALREADY BEEN PASSED IN THE SOURCE FILE. LINE NUMBERS ILLEGAL THE FIRST LINE NUMBER IN A DELETE COMMAND IS GREATER THAN THE LAST LINE NUMBER. DESTINATION FILE L(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;OKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN(:10:)') ELSE CASE ATTR.KIND OF SCRATCH, CONCODE: ERROR('SOURCE KIND MUST BE ASCII OR SEQCODE (:10:)'); ASCII, SEQCODE: END; END; DEST:= PARAM(.3.); IF DEST.TAG = NILTYPE THEN DEST:= SOURCE; WITH DEST DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN WHERE:= NOWHERE ELSE IF ATTR.KIND = SEQCODE THEN WHERE:= ELSEWHERE ELSE IF ATT ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "#################################################### # EDIT(VAR OK: BOOLEAN; SOURCE, DEST: IDENTIFIER) #R.PROTECTED THEN ERROR('DESTINATION FILE PROTECTED (:10:)') ELSE WHERE:= ONDISK; END; END; PROCEDURE INITIO; VAR ARG: ARGTYPE; BEGIN WRITEARG(INP, SOURCE); IF WHERE = ELSEWHERE THEN WRITEARG(OUT, DEST) ELSE BEGIN WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'NEXT ' END; WRITEARG(OUT, ARG); END; END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; BEGIN READARG(INP, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF WHERE <> ELSEWHERE THEN BEGIN READARG(OUT, ARG); LENGTH:   ۰ ی .d    X` TD ^6<    ڰ. .B"08 8" 8: ڒ$ 8 8B" z4  " "8 8 "  8: ####################################################" "INSERT PREFIX HERE" TYPE COMMANDTYPE = (INSERT, DELETE, COPY); BUFINDEX = 1..1024; BUFFER = ARRAY (.BUFINDEX.) OF CHAR; BUFPAIR = ARRAY (.1..2.) OF PAGE; VAR SOURCE, DEST: ARGTYPE; OK, EOF: BOOLEAN; WHERE: (NOWHERE, ONDISK, ELSEWHERE); LENGTH: INTEGER; TEXT: LINE; LINENO, CHARNO: INTEGER; NLOREM, DIGIT, DIGITORNL: SET OF CHAR; FROM: BUFFER; X: BUFINDEX; TO_: BUFFER; Y: BUFINDEX; LASTPAGE: BOOLEAN; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTE" T "  ". .B"ؒ$8 8B"ؒ",،," 9" -tؒ*/  ،*/  ْ,/  | ؒ0 jh  X^      ؄ GER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE WARNING(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= TRUE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT(' EDIT(FILE: IDENTIFIER)(:10:)'); WRITETEXT('OR (:10:)'); WRITETEXT(' EDIT(SOURCE, DESTINATION: IDENTIFIER) (:10:)'); OK:= FALSE; END; END; * " `@  "  ^ $ * $* 0* <*| H*l T*\ `*L l*< x*, * Zhv0    f   n  X"" B "" l PROCEDURE READTEXT; VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; ACCEPT(C); TEXT(.I.):= C; UNTIL C = NL; CHARNO:= 1; END; PROCEDURE SAVEFILE; VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF WHERE = NOWHERE THEN ID:= 'CREATE ' ELSE ID:= 'REPLACE '; END; WITH LIST(.3.) DO BEGIN TAG:= IDTYPE; ID:= DEST.ID END; WITd"(    0 . >L"B  ( "B  ( X * *B  ( *B  (  "B  (  *B  ( "B,$ ^BH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; WITH LIST(.5.) DO BEGIN TAG:= IDTYPE; ID:= 'ASCII ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('EDIT:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('DESTINATION FILE LOST(:10:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOLASTPAGE); END; PROCEDURE READBUF(VAR FROM: UNIV BUFPAIR); BEGIN FROM(.1.):= FROM(.2.); READPAGE(FROM(.2.), LASTPAGE); END; PROCEDURE WRITEBUF(VAR TO_: UNIV BUFPAIR); BEGIN WRITEPAGE(TO_(.1.), FALSE); TO_(.1.):= TO_(.2.); END; PROCEDURE TERMBUF(TO_: UNIV BUFPAIR); VAR TEXT: PAGE; BEGIN WRITEPAGE(TO_(.1.), FALSE); WRITEPAGE(TEXT, TRUE); WHILE NOT LASTPAGE DO READPAGE(TEXT, LASTPAGE); END; PROCEDURE READLINE; BEGIN IF X > PAGELENGTH THEN BEGIN READBUF(FROM); X:= X - PAGELENGTORD(CH) - ORD('0'); IF INT > (MAXINT - DIGIT) DIV 10 THEN HELP ELSE INT:= 10* INT + DIGIT; NEXTCHAR; END; END; PROCEDURE READID(VAR ID: IDENTIFIER); VAR LENGTH: INTEGER; BEGIN ID:= ' '; IF NOT (CH IN LETTERS) THEN HELP ELSE BEGIN LENGTH:= 0; WHILE (CH IN (LETTERS OR DIGITS)) & (LENGTH < IDLENGTH) DO BEGIN LENGTH:= LENGTH + 1; ID(.LENGTH.):= CH; NEXTCHAR; END; END; END; PROCEDURE READTIME(VAR TIME: REAL); VAR HOUR, MIN, SEC: INTEGER; BEGH; END; LINENO:= SUCC(LINENO); EOF:= (FROM(.X.) = EM); END; PROCEDURE WRITELINE; BEGIN IF Y > PAGELENGTH THEN BEGIN WRITEBUF(TO_); Y:= Y - PAGELENGTH; END; END; PROCEDURE READFIRST; BEGIN INITBUF(FROM); X:= 1; Y:= 1; LINENO:= 0; READLINE; END; PROCEDURE WRITELAST; BEGIN TO_(.Y.):= EM; Y:= SUCC(Y); WRITELINE; TERMBUF(TO_); END; PROCEDURE SKIPLINE; BEGIN IF FROM(.X.) <> NL THEN REPEAT X:= SUCC(X) UNTIL FROM(.X.) = NL; X:= SUCC(X); READLINE; END; PROCEDUREIN READINT(HOUR); SKIPCHAR(':'); READINT(MIN); SKIPCHAR(':'); READINT(SEC); IF (HOUR > 23) OR (MIN > 59) OR (SEC > 59) THEN HELP; IF OK THEN TIME:= ONEHOUR*CONV(HOUR) + ONEMIN*CONV(MIN) + CONV(SEC); END; PROCEDURE START; VAR ID: IDENTIFIER; TIME: REAL; BEGIN SKIPCHAR('('); READID(ID); SKIPCHAR(','); READTIME(TIME); SKIPCHAR(')'); IF OK THEN WITH TASKLIST, SCHEDULE, OPERATOR DO IF MEMBER(ID) THEN START(TASK(ID), TIME) ELSE WRITETEXT(' TASK UNKNOWN (:10:)(:0:)'); END COPYLINE; VAR C: CHAR; BEGIN REPEAT C:= FROM(.X.); X:= SUCC(X); TO_(.Y.):= C; Y:= SUCC(Y); UNTIL C = NL; READLINE; WRITELINE; END; PROCEDURE INSERTTEXT; VAR I: INTEGER; C: CHAR; BEGIN I:= 1; REPEAT C:= TEXT(.I.); I:= SUCC(I); TO_(.Y.):= C; Y:= SUCC(Y); UNTIL C = NL; WRITELINE; END; PROCEDURE DELETETEXT; VAR FIRSTLINE, LASTLINE: INTEGER; BEGIN SCANINT(FIRSTLINE); IF NOT OK THEN WARNING('LINE NUMBER(S) MISSING (:10:)') ELSE BEGIN SCANINT(LASTLIN; PROCEDURE PERIOD; VAR ID: IDENTIFIER; TIME: REAL; BEGIN SKIPCHAR('('); READID(ID); SKIPCHAR(','); READTIME(TIME); SKIPCHAR(')'); IF OK THEN WITH TASKLIST, SCHEDULE, OPERATOR DO IF MEMBER(ID) THEN PERIOD(TASK(ID), TIME) ELSE WRITETEXT(' TASK UNKNOWN (:10:)(:0:)'); END; PROCEDURE STOP; VAR ID: IDENTIFIER; BEGIN SKIPCHAR('('); READID(ID); SKIPCHAR(')'); IF OK THEN WITH TASKLIST, SCHEDULE, OPERATOR DO IF MEMBER(ID) THEN STOP(TASK(ID)) ELSE WRITETEXT(' TAE); IF NOT OK THEN BEGIN LASTLINE:= FIRSTLINE; OK:= TRUE END; IF FIRSTLINE < LINENO THEN WARNING('LINE ALREADY PASSED(:10:)') ELSE IF LASTLINE < FIRSTLINE THEN WARNING('LINE NUMBERS ILLEGAL (:10:)') ELSE BEGIN WHILE NOT EOF & (LINENO < FIRSTLINE) DO COPYLINE; WHILE NOT EOF & (LINENO <= LASTLINE) DO SKIPLINE; END; END; END; PROCEDURE COPYTEXT; BEGIN WHILE NOT EOF DO COPYLINE; END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('EDIT:(:10:)'); OKSK UNKNOWN (:10:)(:0:)'); END; PROCEDURE CORRECT; VAR TIME: REAL; BEGIN SKIPCHAR('('); READTIME(TIME); SKIPCHAR(')'); IF OK THEN WATCH.CORRECT(TIME); END; PROCEDURE SOLO; CONST SOLOADDR = 24; VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= CONTROL; ARG:= SOLOADDR; END; IO(PARAM, PARAM, DISKDEVICE); END; BEGIN INIT OPERATOR, BELL; LETTERS:= (.'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', ':= (TASK = JOBTASK); CHECKARG; NLOREM:= (.NL, EM.); DIGIT:= (.'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'.); DIGITORNL:= DIGIT OR (.NL.); END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN INITIALIZE; IF OK THEN BEGIN INITIO; READFIRST; REPEAT READTEXT; CASE COMMAND OF INSERT: INSERTTEXT; DELETE: DELETETEXT; COPY: COPYTEXT END; UNTIL EOF; WRITELAST; CHECKIO; END; TU', 'V', 'W', 'X', 'Y', 'Z', '_'.); DIGITS:= (.'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'.); WITH TYPEUSE, OPERATOR, BELL DO CYCLE AWAIT; REQUEST; OK:= TRUE; WRITETEXT('TYPE COMMAND (:10:)(:7:)(:0:)'); NEXTCHAR; READID(COMMAND); IF COMMAND = 'START ' THEN START ELSE IF COMMAND = 'PERIOD ' THEN PERIOD ELSE IF COMMAND = 'STOP ' THEN STOP ELSE IF COMMAND = 'TIME ' THEN CORRECT ELSE IF COMMAND = 'SOLO ' THEN SOLO ELSE ERMINATE; END. SK); ; AR BLOCK: UNIV PAGE); 0 >" >R 8 ^ L< " `(  R $  ,>"R *P*'" j" L      "$&!#%'8:<>(*,.02469;=?)+-/1357TV@BDFHJLNPRUWACEGIKMOQSXZ\^`bdfhjlnY[]_acegikmotvxz|~pruwy{}qs" ." " |" " "X" T$lRRR}R~RR&^ "* / * / P ################# # FILE MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: TO CREATE, REPLACE, DELETE, PROTECT, OR RENAME A DISK FILE. CALL: FILE(CREATE, ID, LENGTH, KIND, PROTECTED) FILE(REPLACE, ID, LENGTH, KIND, PROTECTED) FILE(DELETE, ID) FILE(PROTECT, ID, PROTECTED) FILE(RENAME, OLDID, NEWID) USING ID, OLDID, NEWID: IDENTIFIER "OF AT MOST 12 CHARACTERS"; LENGTH: 1..255; KIND: (SCRATCH, ASCII, SEQCODE, CONCODE); PROTECTED: BOOLEAN; CREATE COMMAND: CREATES A" f ``g"h@ DJ$i0 >jjkEzl V  :"-Nl+8lm0  L>n0  P>oppq qrrtuv rw xB|}"~"~ `" `d  T1 NEW FILE WITH GIVEN IDENTIFIER, LENGTH, KIND, AND PROTECTION ATTRIBUTES. THE FILE IDENTIFIER MUST BE ONE THAT DOES NOT ALREADY EXIST IN THE DISK CATALOG. THE LENGTH DEFINES THE NUMBER OF DISK PAGES IN THE FILE. THE DATA STORED IN THE NEW FILE ARE TAKEN FROM THE BEGINNING OF THE STANDARD FILE NEXT. REPLACE COMMAND: REPLACES AN EXISTING FILE WITH A NEW FILE DEFINED BY IDENTIFIER, LENGTH, KIND, AND PROTECTION ATTRIBUTES. THE FILE IDENTIFIER MUST BE ONE THAT ALREADY EXISTS IN THE DISK CATALOG. THE EXISTING 8MO9;=@BEG>[]_acegQSUWY\^`bdfRTVXZwy{}ikmoqsuxz|~hjlnprtv     #%'!$& "?)+-/13579;=(*,.0FILE MUST BE UNPROTECTED. THE LENGTH DEFINES THE NUMBER OF DISK PAGES IN THE FILE. THE DATA STORED IN THE NEW FILE ARE TAKEN FROM THE BEGINNING OF THE STANDARD FILE NEXT. DELETE COMMAND: DELETES AN EXISTING FILE THAT MUST BE UNPROTECTED. PROTECT COMMAND: ASSIGNS A PROTECTION VALUE TO AN EXISTING FILE. RENAME COMMAND: RENAMES AN EXISTING FILE THAT MUST BE UNPROTECTED. THE NEW FILE IDENTIFIER MUST BE ONE THAT DOES NOT ALREADY EXIST IN THE DISK CATALOG. READY EXISTS IN THE DISK CATALOG. THE EXISTING "AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 5: BODY SEMANTIC ANALYSIS DECEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; N= ARG.INT END; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF (WHERE <> ELSEWHERE) & OK THEN SAVEFILE; END; PROCEDURE SCANINT(VAR I: INTEGER); BEGIN WHILE NOT (TEXT(.CHARNO.) IN DIGITORNL) DO CHARNO:= CHARNO + 1; IF TEXT(.CHARNO.) IN DIGIT THEN BEGIN I:= 0; REPEAT I:= 10*I + ORD(TEXT(.CHARNO.)) - ORD('0'); CHARNO:= CHARNO + 1; UNTIL NOT (TEXT(.CHARNO.) IN DIGIT); END ELSE OK:= FALSE; END; FUNCTION STARTSWITH(WHAT: LINE): BOOLEAN; VAR I, J: INTEGER; BEGUMBEROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); IN I:= 1; WHILE TEXT(.I.) = ' ' DO I:= I + 1; STARTSWITH:= TRUE; J:= 1; WHILE WHAT(.J.) <> '(:0:)' DO BEGIN IF WHAT(.J.) <> TEXT(.I.) THEN STARTSWITH:= FALSE; I:= I + 1; J:= J + 1; END; END; FUNCTION COMMAND: COMMANDTYPE; BEGIN IF STARTSWITH('DEL((:0:) ') THEN COMMAND:= DELETE ELSE IF STARTSWITH('#(:10:)(:0:) ') THEN COMMAND:= COPY ELSE COMMAND:= INSERT; END; PROCEDURE INITBUF(VAR FROM: UNIV BUFPAIR); BEGIN READPAGE(FROM(.1.), LASTPAGE); READPAGE(FROM(.2.), INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FIL      "$&!#%'<>(*,.02468:=?)+-/13579;@BDFHJLNPRTVAC    "$&!#%'2468:<>(*,.03579;=?)+-/1NPRTV@BDFHJLOQSUWACEGIKMjlnXZ\^`bdfhkmoY[]_acegiprtvxz|~qsuwy{}      "$&!#%'8:<>(*,.02469;=?)+-/1357TV@BDFHJLNPRAC    "$&!#%'2468:<>(*,.03579;=?)+-/1NPRTV@BDFHJLOQSUWACEGIKMjlnXZ\^`bdfhkmoY[]_acegiprtvxz|~qsuwy{}P8." *+ z0v+, |*Bz"-x." 12 zx23| *Bz"4v5" 7z"0 DEz"jE z `:F| z zB zFG |$H$ JKz"K z `&L| z zLM|k N\]| v|^|" PIPELINE SYSTEM PER BRINCH HANSEN 11 MAY 1976 " "*********************** * INPUT/OUTPUT TYPES * ***********************" TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; E): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; BODY1=2; BODY_END1=3; ADDRESS1=4; RESULT1=5; STORE1=6; CALL_PROC1=7; CONSTPARM1=8; VARPARM1=9; FALSEJUMP1=10; DEF_LABEL1=11; JUMP_DEF1=12; CASE_JUMP1= v|_t"` c fgv dh t<XiHit t>"ij lv & z{ #^| "p|}~P"  X B" ^" npn" p v pNn" p13; JUMP1=14; CASE_LIST1=15; FOR_STORE1=16; FOR_LIM1=17; FOR_UP1=18; FOR_DOWN1=19; WITH1=20; INIT1=21; PROG_CALL1=22; INTF_LBL1=23; VALUE1=24; LT1=25; EQ1=26; GT1=27; LE1=28; NE1=29; GE1=30; IN1=31; UPLUS1=32; UMINUS1=33; PLUS1=34; MINUS1=35; OR1=36; STAR1=37; SLASH1=38; DIV1=39; MOD1=40; AND1=41; EMPTY_SET1=42; n""P `" ? "v ^ ^v*B vnj  j  "" vvXtt2 INCLUDE1=43; FUNCTION1=44; CALL_FUNC1=45; ROUTINE1=46; VAR1=47; ARROW1=48; VCOMP1=49; RCOMP1=50; SUB1=51; LCONST1=52; MESSAGE1=53; NEW_LINE1=54; CHK_TYPE1=55; SAVEPARM1=56; CALL_GEN1=57; NOT1=58; UNDEF1=59; RANGE1=60; "OUTPUT OPERATORS" PUSHCONST2=0; PUSHVAR2=1; PUSHIND2=2; PUSHADDR2=3; FIELD2=4; INDEX2=5; POINTER2=6; VARIANT2=7; RANGE2=8; ASSIGN2=9;t0"? "v ^ ^v*B vnj  j  "" vvXtt2 ASSIGNTAG2=10; COPY2=11; NEW2=12; NOT2=13; AND2=14; OR2=15; NEG2=16; ADD2=17; SUB2=18; MUL2=19; DIV2=20; MOD2=21; "NOT USED" "NOT USED" FUNCTION2=24; BUILDSET2=25; COMPARE2=26; COMPSTRCT2=27; FUNCVALUE2=28; DEFLABEL2=29; JUMP2=30; FALSEJUMP2=31; CASEJUMP2=32; INITVAR2=33; CALL2=34; ENTER2=35; RETURN2=36; POP2=37; NEWLINE2=3 ARG: INTEGER END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; "*************** * LINEBUFFER * ***************" TYPE LINEBUFFER = MONITOR VAR CONTENTS: LINE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY RECEIVE(VAR TEXT: LINE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXT:= CONTENTS; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY SEND(TEXT: LINE); BEGIN IF FULL THEN DELAY(SENDER); CONTENTS:=8; ERR2=39; LCONST2=40; MESSAGE2=41; INCREMENT2=42; DECREMENT2=43; PROCEDURE2=44; INIT2=45; PUSHLABEL2=46; CALLPROG2=47; EOM2=48; "CONTEXT" FUNC_RESULT=1; ENTRY_VAR=2; VARIABLE=3; VAR_PARM=4; UNIV_VAR=5; CONST_PARM=6; UNIV_CONST=7; FIELD=8; EXPR=10; CONSTANT=11; SAVE_PARM=12; WITH_CONST = 13; WITH_VAR = 14; "TYPE KIND" INT_KIND=0; REAL_KIND=1; BOOL_KIND=2; CHAR_KIND=3; ENUM_KIND TEXT; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "************** * LINEMAKER * **************" TYPE LINEMAKER = CLASS(BUFFER: LINEBUFFER); VAR IMAGE: LINE; CHARNO: INTEGER; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN FOR CHARNO:= 27 TO 106 DO IMAGE(.CHARNO.):= TEXT(.CHARNO - 26.); BUFFER.SEND(IMAGE); END; BEGIN FOR CHARNO:= 1 TO 26 DO IMAGE(.CHARNO.):= ' '; IMAGE(.107.):= NL; END; "************** * PAGEMAKER * **************" TYPE PAGEMAKER = CLASS(BUFFER: LI=4; SET_KIND=5; STRING_KIND=6; PASSIVE_KIND=7; POINTER_KIND=8; QUEUE_KIND= 9; GENERIC_KIND=10; UNDEF_KIND=11; SYSCOMP_KIND=12; ROUTINE_KIND=13; ACTIVE_KIND=14; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9 ; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=1NEBUFFER); VAR CONSUMER: LINEMAKER; LINENO: INTEGER; PROCEDURE NEWPAGE; VAR TEXT: LINE; BEGIN TEXT(.1.):= FF; CONSUMER.WRITE(TEXT); TEXT(.1.):= NL; CONSUMER.WRITE(TEXT); LINENO:= 1; END; PROCEDURE ENTRY SKIP; BEGIN NEWPAGE END; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN CONSUMER.WRITE(TEXT); IF LINENO = 60 THEN NEWPAGE ELSE LINENO:= LINENO + 1; END; BEGIN INIT CONSUMER(BUFFER); NEWPAGE END; "************** * FILEMAKER * **************" TYPE FILEMAKER = CLASS(BUFFER: LINEBU   >" B"   vZ   *     *   *6     *   **" VB    B  > H-""h" `P ~* >"  * ݌"> FFER); VAR CONSUMER: PAGEMAKER; EOF: BOOLEAN; FUNCTION MORE(TEXT: LINE): BOOLEAN; VAR CHARNO: INTEGER; BEGIN IF TEXT(.1.) <> '#' THEN MORE:= TRUE ELSE BEGIN CHARNO:= 80; WHILE TEXT(.CHARNO.) = ' ' DO CHARNO:= CHARNO - 1; MORE:= (CHARNO <> 1); END; END; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN IF EOF THEN BEGIN CONSUMER.SKIP; EOF:= FALSE END; IF MORE(TEXT) THEN CONSUMER.WRITE(TEXT) ELSE BEGIN CONSUMER.SKIP; EOF:= TRUE END; END; BEGIN INIT CONSUMER(BUFFER); EOF:= TR ME_MODE=5; PROCESS_MODE=6; CLASS_MODE=7; MONITOR_MODE=8; STD_MODE=9; UNDEF_MODE=10; TEMP_MODE=PROC_MODE; "COMPARISONS" LESS=0; EQUAL=1; GREATER=2; NOTLESS=3; NOTEQUAL=4; NOTGREATER=5; INSET=6; "ERRORS" COMPILER_ERROR=1; TYPE_ERROR=2; ADDRESS_ERROR=3; ASSIGN_ERROR=4; INIT_ERROR = 5; THIS_PASS=5; BYTELENGTH = 1; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; TYPE ADDR_STATE=(DIRECT,INDIRECT,ADDR,EXPRESSION);UE END; "**************** * CARDPROCESS * ****************" TYPE CARDPROCESS = PROCESS(BUFFER: LINEBUFFER); VAR PARAM: IOPARAM; TEXT, ERROR: LINE; CHARNO: INTEGER; BEGIN FOR CHARNO:= 1 TO 80 DO ERROR(.CHARNO.):= '?'; PARAM.OPERATION:= INPUT; WITH PARAM DO CYCLE REPEAT IO(TEXT, PARAM, CARDDEVICE) UNTIL STATUS <> INTERVENTION; IF STATUS <> COMPLETE THEN TEXT:= ERROR; BUFFER.SEND(TEXT); END; END; "**************** * COPYPROCESS * ****************" TYPE COPYPROCESS = PR ADDR_MODE=LCONST_MODE..SCONST_MODE; ADDR_MODES=SET OF ADDR_MODE; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; DISPLACEMENT=INTEGER; TYPE_KIND=INT_KIND..ROUTINE_KIND; TYPE_KINDS=SET OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; OPERAND_CLASS=(UNDEFINED,VALUE,ROUTINE); OPERAND= RECORD KIND:TYPE_KIND; NOUN:INTEGER; MODE:ADDR_MODE; DISP:DISPLACEMENT; LENGTH:DISPLACEMENT; CASE CLASS:OPERAND_CLASS OF VALUE:(CONTEXT:CONOCESS(INBUFFER, OUTBUFFER: LINEBUFFER); VAR CONSUMER: FILEMAKER; TEXT: LINE; BEGIN INIT CONSUMER(OUTBUFFER); WITH INBUFFER, CONSUMER DO CYCLE RECEIVE(TEXT); WRITE(TEXT) END; END; "******************* * PRINTERPROCESS * *******************" TYPE PRINTERPROCESS = PROCESS(BUFFER: LINEBUFFER); VAR PARAM: IOPARAM; TEXT: LINE; BEGIN PARAM.OPERATION:= OUTPUT; CYCLE BUFFER.RECEIVE(TEXT); REPEAT IO(TEXT, PARAM, PRINTDEVICE) UNTIL PARAM.STATUS = COMPLETE; END; END; "****************TEXT_KIND; STATE:ADDR_STATE); ROUTINE:(PARM_SIZE,VAR_SIZE,STACK_SIZE:DISPLACEMENT) END; OPERAND_PTR=@OPERAND; STACK_LINK=@STACK_ENTRY; STACK_ENTRY=RECORD OPND:OPERAND_PTR; RESET_POINT:INTEGER; NEXT_ENTRY:STACK_LINK END; VAR INT_EXPR,REAL_EXPR,BOOL_EXPR,SET_EXPR,UNDEF_EXPR: OPERAND; SY: INTEGER; S,T: OPERAND_PTR; INTER_PASS_PTR: PASSPTR; CURRENT_MODE: ADDR_MODE; ROUTINE_MODES, INIT_MODES: ADDR_MODES; TOP_**** * INITIAL PROCESS * ********************" VAR INBUFFER, OUTBUFFER: LINEBUFFER; READER: CARDPROCESS; COPIER: COPYPROCESS; PRINTER: PRINTERPROCESS; BEGIN INIT INBUFFER, OUTBUFFER, READER(INBUFFER), COPIER(INBUFFER, OUTBUFFER), PRINTER(OUTBUFFER); END.       "$&!#%'468:<>(*,.02579;=?)+-/13PRTV@BDFHJLNACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvs   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I  dxR& pxR& |xR&x xR&H x*RRRR&~  * ^ JJ $ 0^ 2   (  " j"H"$*X2J("$   ( "4"B `"j  jm>  R R RR&4""j  TP Xj  j > "4 mX "" " Lj$j j> LFEMPTY SCRATCH ASCII SEQCODE CONCODE PROTECTED UNPROTECTED TRY AGAIN LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) USING DETAIL = (CATALOG, FILES) FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL) CATALOG SOLO SYSTEM FILES PAGES ENTRIES PAGES LIST: CATALOG FILES SCRATCH ASCII SEQCODE CONCODE ALL OUTPUT FILE UNKNOWN OUTPUT FILE MUST BE SEQCODE $*X2 j$j j> j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `"z0" z x v t   X   ^$    "X   X "X6  X N X "X6 "X  *  X   X  ^ "^2T,n RRR&  " (XV,R)RR&j L *XPRINTER:  j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `"X 0 " 0 "$P""B  ( "B  ( "B  ( "$\   (  ", cB " B, ^&"  PXB00; FREQUENCY MONITOR BIT LKSINE = ^B0000000001000000; ENABLE INTERRUPT MODE ;* = ^B0000000000111111; 6 BITS - NOT USED ;* ;* .SBTTL MACHINE CORE PARAMETERS ;**** MACHINE CORE SIZE PARAMETERS ***** ;* ;* .BLKSW = 32.; SIZE OF SEGMENTATION BLOCK, WORDS .BLKSB = .BLKSW * 2.; SIZE OF SEGMENTATION BLOCK, BYTES .KWSBK = 1024. / .BLKSW; SIZE OF A KILOWORD IN BLOCKS ;* ;* .SEGSW = 4096.; SEGMENT S "B " 0 r t_      * 6 B Nn Z2 PASCAL: TERMINATED OVERFLOW POINTERERRORRANGEERROR VARIANTERRORHEAPLIMIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN IZE IN WORDS .SEGSB = .SEGSW * 2.; SEGMENT SIZE IN BYTES .SGSBK = .SEGSW / .BLKSW; SEGMENT SIZE IN BLOCKS ;* ;**** MEMORY SEGMENTATION REGISTERS ***** ;* SSR0 = 177572; SEGMENT STATUS REGISTER 0 ;* ;* UISDR = 177600; USER INSTR DESCR REGS 0-7 UDSDR = 177620; USER DATA DESCR REGS 0-7 UISAR = 177640; USER INSTR ADDR REGS 0-7 UDSAR = 177660; USER DATA ADDR REGS 0-7 CPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) TEMPORARY FILE MISSING CREATE REPLACE CONCODE FILE PASCAL: OBJECT FILE LOST SOURCE FILE UNKNOWN SOURCE KIND MUST BE ASCII OR SEQCODE DESTINATION FILE UNKNOWN DESTINATION KIND MUST BE SEQCODE OBJECT FILE PROTECTED COMPILATION ERRORS TEMP1 TEMP2 CPASS1 CPASS2 CPASS3 CPASS4 CPASS5 CPASS6 NEXT CPASS7 MIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN ;* ;* SISDR = 172200; SUPERVISOR INSTR DESCR REGS 0-7 SDSDR = 172220; SUPERVISOR DATA DESCR REGS 0-7 SISAR = 172240; SUPERVISOR INSTR ADDR REGS 0-7 SDSAR = 172260; SUPERVISOR DATA ADDR REGS 0-7 ;* ;* KISDR = 172300; KERNEL INSTR DESCR REGS 0-7 KDSDR = 172320; KERNEL DATA DESCR REGS 0-7 KISAR = 172340; KERNEL INSTR ADDR REGS 0-7 KDSAR = 17236X RF& SX R8& TX R8&V CX RF&* NX RF& T0x X )X6 )X  T" "J:"?"L `F|"r"z0"x0"v0"t0" ""~0; KERNEL DATA ADDR REGS 0-7 ;* ;* ;**** SEGMENT DESCRIPTOR REGISTER DEFINITIONS ***** ;* ;* THE SDR FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* SDRACF = ^B0000000000000001; 3 BITS - ACCESS CONTROL FIELD SDRED = ^B0000000000001000; 1 BIT - EXPANSION DIRECTION ;* = ^B0000000000110000; 2 BITS - NOT USED SDRWR = ^B0000000001000000; 1 BIT - WRITE TO SEGMENT SDRAT = ^B0000000010000000; 1 BIT - ACCESS TRAPPED SDRPLF = "$$ $N$0R1R2R3R4R5R6R7R8R9R&ARBRCRDRERFRGRHRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR_R&8&'R RR(R&&" `& R8&F&t*" `"ARE OF ;* ;* INFORMATION SCIENCE ;* ENGINEERING DIVISION ;* CALIFORNIA INSTITUTE OF TECHNOLOGY ;* PASADENA CALIFORNIA. ;* ;************** ;* ;* THE DATE OF THIS CURRENT VERSION IS 9 JUNE 1975. ;* ;* THE ORIGINAL VERSION WAS WRITTEN BY 10 DEC 1974. ;* ;* ;******************************************** .SBTTL PROCESSOR REGISTER NAMES ;**** REGISTER NAMES ***** ;* ;* ;* THE REGISTER NAMES WHICH ARE USED IN MOST OF THIS MODULE ARE THE ;* "j"8b], "$""l(J 0B@$ "  T0 .X  )X~" .X" " T0hl4J 0B@$ B"  T0 EX@ " "" +X NAMES SUPPLIED BY THE ASSEMBLER, TO WIT: ;* R0 = %0; R1 = %1; R2 = %2; R3 = %3; R4 = %4; R5 = %5; SP = %6; PC = %7; ;* ;* ;* WE WILL REFER TO THE REGISTERS BY THEIR CONVENTIONAL PASCAL ;* NAMES ONLY ON THE RARE OCCASIONS WHEN THIS IS RELEVANT. THE ;* PASCAL NAMES ARE: ;* W = R0; WORD OR REAL SCRATCH REGISTER 0, X = R1; WORD OR REAL SCRATCH REGISTER* -X"  T0\  `"  H0B >" "  T0 8& > \ B" " >"  X<f$  2$ V" " " &Z"" ` J$ 1, Y = R2; WORD SCRATCH REGISTER 2, Q = R3; USER CODE POINTER, B = R4; USER LOCAL BASE REGISTER, G = R5; USER GLOBAL BASE REGISTER, S = SP; PROCESSOR STACK TOP REGISTER, P = PC; PROCESSOR PROGRAM COUNTER. ;* ;* BLOCK NUMBER FOR PROCESSOR INTERNAL REGISTERS ;* .PRBLK = 7600; BLOCK NUMBER OF THE H  ""H G  T  " >" >" X >  N n2 "[ ݌J8 ݌:@V g"  T" " `4 ARDWARE ;* PERIPHERALS AND REGISTERS AREA ;* ;* PROCESSOR INTERNAL REGISTERS ;* PSW = 177776; PROCESSOR STATUS WORD SLR = 177774; STACK LIMIT REGISTER CSDR = 177570; CONSOLE SWITCH AND DISPLAY REG LKS = 177546; KW11-L LINE FREQUENCY CLOCK ;* ;* BIT DEFINITIONS FOR LKS ;* ;* = ^B1111111100000000; 8 BITS - NOT USED LKSMON = ^B00000000100000  2"4{"|" `   V " X@" `   *FF"  * ^ V Lx". Xx"  * ^ ALLOW READ AND WRITE, ;* EXPANSION DIRECTION UP, ;* 128 BLOCKS. ;* SDRDEF USDR,SDRNWN,SDREDU,.SGSBK; ;* ;* DEFINE THE KERNEL SDR VALUE: ;* ;* ALLOW READ AND WRITE, ;* EXPANSION DIRECTION UP, ;* 128 BLOCKS. ;* KSDR = USDR; ;* ;* .SBTTL PSW DEFINITIONS ;**** PROCESSOR d$h N$HNbJ$$V ?" `" 0 l ~ x" pZ   "" X " p>"F ~  x2"  " >" pZ X2" "STATUS WORD FORMAT ***** ;* ;* THE PSW FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* PSCBIT = ^B0000000000000001; 1 BIT - CARRY PSVBIT = ^B0000000000000010; 1 BIT - OVERFLOW PSZBIT = ^B0000000000000100; 1 BIT - RESULT = 0 PSNBIT = ^B0000000000001000; 1 BIT - RESULT < 0 PSTBIT = ^B0000000000010000; 1 BIT - TRAP SET PSPRTY = ^B0000000000100000; 3 BITS - PRIORITY ;* = ^B0000011100000000; 3 BITS - NOT USED PSPMOD = . lj j>" j\"  j"  ~ *  " pZ,:  " ~ *" p `F,:  " ~  * "  "(" l ^njH" \p "h "p "l l>P"$p "h j" ^B0001000000000000; 2 BITS - PREVIOUS MODE PSCMOD = ^B0100000000000000; 2 BITS - CURRENT MODE ;* ;* THE RELEVANT FIELD VALUES ARE: ;* PSCARR = PSCBIT * 1; CARRY = TRUE PSOVER = PSVBIT * 1; OVERFLOW = TRUE PSZERO = PSZBIT * 1; RESULT ZERO = TRUE PSNEGA = PSNBIT * 1; RESULT NEGATIVE = TRUE PSTTRP = PSTBIT * 1; T-BIT TRAP IS SET PSPRT7 = PSPRTY * 7; PROCESSOR PRIORITY = 7 PSPRT6 = 4%'.02468:<>(*,/13579;=?)+Yvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ B D F c e g Q S U W Y [ ] _ a d f P R T V X Z \ ^ ` b  i k m o q s u w y { } h j n p r t v x z | ~ PSPRTY * 6; PROCESSOR PRIORITY = 6 PSPRT5 = PSPRTY * 5; PROCESSOR PRIORITY = 5 PSPRT4 = PSPRTY * 4; PROCESSOR PRIORITY = 4 PSPRT3 = PSPRTY * 3; PROCESSOR PRIORITY = 3 PSPRT2 = PSPRTY * 2; PROCESSOR PRIORITY = 2 PSPRT1 = PSPRTY * 1; PROCESSOR PRIORITY = 1 PSPRT0 = PSPRTY * 0; PROCESSOR PRIORITY = 0 PSPMDK = PSPMOD * KRNLMD; PREVIOUS MODE = KERNEL PSPMDS = PSPMOD * SP(NUMBER) " PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY THE SOLO SYSTEM 8 JUNE 1975" "############# # IO TYPES # #############" TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERAVRMD; PREVIOUS MODE = SUPERVISOR PSPMDU = PSPMOD * USERMD; PREVIOUS MODE = USER PSCMDK = PSCMOD * KRNLMD; CURRENT MODE = KERNEL PSCMDS = PSCMOD * SPVRMD; CURRENT MODE = SUPERVISOR PSCMDU = PSCMOD * USERMD; CURRENT MODE = USER ;* ;* WHERE ;* KRNLMD = ^B00; KERNEL MODE SPVRMD = ^B01; SUPERVISOR MODE USERMD = ^B11; USER MODE ;* ;* DEFINE THE KERNEL PROCESSOR STATUSTION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; "########################## # PROCESSQUEUE AND FIFO # ##########################" CONST PROCESSCOUNT = 7; TYPE PROCESSQUEUE = ARRAY (.1..PROCESSCOUNT.) OF QUEUE; TYPE FIFO = CLASS(L WORD ;* KNLPSW = PSCMDK+PSPRT7 ; KERNEL MODE, ; REGISTER SET 0, ; PROCESSOR PRIORITY 7 ;* ;* DEFINE THE USER PROCESSOR STATUS WORD ;* USRPSW = PSCMDU+PSPRT0 ;<01> USER MODE, USRPSW = USRPSW+PSPMDU ; REGISTER SET 1, ; PROCESSOR PRIORITY 0 ;* ;* .SBTTL FLOATING POINT PROCESSOR DEFINITIONS ;**** FLOATING POINT UNIT STATUS REGISTER FORMAT ***IMIT: INTEGER); VAR HEAD, TAIL, LENGTH: INTEGER; FUNCTION ENTRY ARRIVAL: INTEGER; BEGIN ARRIVAL:= TAIL; TAIL:= TAIL MOD LIMIT + 1; LENGTH:= LENGTH + 1; END; FUNCTION ENTRY DEPARTURE: INTEGER; BEGIN DEPARTURE:= HEAD; HEAD:= HEAD MOD LIMIT + 1; LENGTH:= LENGTH - 1; END; FUNCTION ENTRY EMPTY: BOOLEAN; BEGIN EMPTY:= (LENGTH = 0) END; FUNCTION ENTRY FULL: BOOLEAN; BEGIN FULL:= (LENGTH = LIMIT) END; BEGIN HEAD:= 1; TAIL:= 1; LENGTH:= 0 END; "############# # RESOURCE # #############" TYPE RNTL-U" RETYPELINE = '(:18:)'; "CNTL-R" PROCEDURE WRITECHAR(X: CHAR); VAR PARAM: IOPARAM; C: CHAR; BEGIN PARAM.OPERATION:= OUTPUT; C:= X; IO(C, PARAM, DEVICE); END; PROCEDURE ENTRY WRITE(TEXT: LINE); VAR PARAM: IOPARAM; I:INTEGER; C: CHAR; BEGIN PARAM.OPERATION:= OUTPUT; I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); IO(C, PARAM, DEVICE); UNTIL (C = NL) OR (I = LINELIMIT); IF C <> NL THEN WRITECHAR(NL); END; PROCEDURE ENTRY READ(VAR TEXT: LINE); CONST BEL = '(:7:)'; VAR PESOURCE = MONITOR VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q(.NEXT.ARRIVAL.)); END; PROCEDURE ENTRY RELEASE; BEGIN IF NEXT.EMPTY THEN FREE:= TRUE ELSE CONTINUE(Q(.NEXT.DEPARTURE.)); END; BEGIN FREE:= TRUE; INIT NEXT(PROCESSCOUNT) END; "################# # TYPERESOURCE # #################" TYPE TYPERESOURCE = MONITOR VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; HEADER: LINE; PROCEDURE ENTRY REQUEST(TEXT: LINARAM: IOPARAM; I: INTEGER; C: CHAR; L: INTEGER; BEGIN WRITECHAR(BEL); PARAM.OPERATION:= INPUT; I:= 0; REPEAT IO(C, PARAM, DEVICE); IF C = CANCELLINE THEN BEGIN WRITECHAR('^'); WRITECHAR('U'); WRITECHAR(NL); I:= 0; END ELSE IF C = CANCELCHAR THEN BEGIN IF I > 0 THEN BEGIN WRITECHAR(TEXT(.I.)); I:= I - 1; END END ELSE IF C = RETYPELINE THEN BEGIN WRITECHAR(NL); L := 0; IF I > 0 THEN E; VAR CHANGED: BOOLEAN); BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q(.NEXT.ARRIVAL.)); CHANGED:= (HEADER <> TEXT); HEADER:= TEXT; END; PROCEDURE ENTRY RELEASE; BEGIN IF NEXT.EMPTY THEN FREE:= TRUE ELSE CONTINUE(Q(.NEXT.DEPARTURE.)); END; BEGIN FREE:= TRUE; HEADER(.1.):= NL; INIT NEXT(PROCESSCOUNT); END; "############### # TYPEWRITER # ###############" TYPE TYPEWRITER = CLASS(DEVICE: IODEVICE); CONST LINELIMIT = 80; CANCELCHAR = '(:127:)'; "RUBOUT" CANCELLINE = '(:21:)'; "C** ;* ;* ;* BIT DEFINITIONS FOR THE FPS REGISTER ;* FPSFER = ^B1000000000000000; FLOATING POINT ERROR FPSFID = ^B0100000000000000; FPP INTERRUPTS DISABLED ;* = ^B0011000000000000; 2 BITS - NOT USED FPSIUV = ^B0000100000000000; UNDEF. VARIABLE INT. ENABLED FPSFIU = ^B0000010000000000; UNDERFLOW INT. ENABLED FPSFIV = ^B0000001000000000; OVERFLOW INT. ENABLED FPSFIC = ^B0000000100000000; INTEGER CONVERSION INT. ENABLED FPSFD " H$ nPX8n n>" nO 8n" " T0 b R 'X  "@" :X>   ^" TR `  H 0B>"  T0   X  :X  D  = ^B0000000010000000; DOUBLE PRECISION MODE FPSFL = ^B0000000001000000; LONG INTEGER MODE FPSFT = ^B0000000000100000; TRUNCATE MODE FPSFMM = ^B0000000000010000; MAINTENANCE MODE FPSFN = ^B0000000000001000; RESULT NEGATIVE FPSFZ = ^B0000000000000100; RESULT ZERO FPSFV = ^B0000000000000010; RESULT OVERFLOW FPSFC = ^B0000000000000001; CONVERSION CARRY ;* ;* DEFINE THE INITIAL USER FLOATING POINT STATUS ;* FSTAT0   "$&!#%'02468:<>(*,.13579;=?)+-/LNPRTV@BDFHJACHJLO9;=Z\^`bdfPRTVX[]_aceQSUWYvy{}iksuw   m  + - / 1 3 5 7 ! # % ' ) , . 0 2 4 6 " $ & ( * G I K M O 9 ; = ? A C E H J L N 8 : < > @ ^B0000000100000000; 7 BITS - SEGMENT LENGTH ;* = ^B1000000000000000; 1 BIT - NOT USED ;* ;* ACCESS CONTROL FIELD BITS ;* SDRAWA = ^B000; READ ABORT, WRITE ABORT SDRTWA = ^B001; READ TRAP , WRITE ABORT SDRNWA = ^B010; READ , WRITE ABORT SDRTWT = ^B100; READ TRAP , WRITE TRAP SDRNWT = ^B101; READ , WRITE TRAP SDRNWN = ^B110; READ 8  ( " >" "   X" "" x"" ,RJ6B::"(" >"X   XT"Hp  n( n"p  n( X nf* nr*p  n( n, WRITE ;* ;* THE EXPANSION DIRECTION BIT ;* SDREDU = 0; SEGMENT EXPANDS UP SDREDD = 1; SEGMENT EXPANDS DOWN ;* ;* MACRO TO DEFINE SEGMENT DESCRIPTOR REGISTER CONTENTS ;* .MACRO SDRDEF NAME,AC,ED,PL $1 = SDRACF * AC; $2 = SDRED * ED + >; $3 = SDRPLF * <1 - <2 * ED>> * PL; NAME = $1 + $2 + $3; .ENDM SDRDEF ;* ;* DEFINE THE USER SDR VALUE: ;* ;* *p  n( n "p  n( n~*p  n( n"p, ^p 06 \:  * ^ \Z $ 0*  *X* ^ v l P>HP"  TR p X h^ p p5XH .X2   X|"&g  4|"  "X  X6  X "X X6 X &  0"> .X0@$ )X3& N  : RECORD COUNT: INTEGER; TEXT: LINE END; PROCEDURE INITIALIZE(TEXT: LINE); BEGIN HEADER:= TEXT; ENDINPUT:= TRUE; OUT.COUNT:= 0; END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN WITH INP DO BEGIN IF ENDINPUT THEN BEGIN OPERATOR.READ(HEADER, TEXT); COUNT:= 0; END; COUNT:= COUNT + 1; C:= TEXT(.COUNT.); ENDINPUT:= (C = NL); END; END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN WITH OUT DO BEGIN COUNT:= COUNT + 1; TEXT(.COUNT.):= C; IF (C = NL) OR (COUNT =X8 4  =X#$ >X" %2!&  =X$^ &t  .X 8 ~3~" /x2l.`TH<0$?*Nd2l;4װ, h    l׌R " """0֌:8 .d". .B"  .d". .B"  X" "  T>3     ք3   $ 0"DX"& "2" X"> ( *"2 0 " ^* " 0 " ^ 20 X T$T0T T>"X TP V``^~|zxvtrpn(&$"d  | (//ی  ۖPASS 1: FILE_LIMITEND IF THEN BEGIN ELSE DO WITH IN OF WHILE CASE REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT 4Tx "  HX T>0B"T T>"X T4T0 "( *"X  X >" "" ^Z X ^  " >" >"$7 "* "  "$ A  $ G  DIV CONST TYPE FUNCTION PROGRAM CLASS CYCLE ENTRY INIT MONITOR PROCESS UNIV FALSE TRUE INTEGER BOOLEAN CHAR QUEUE ABS ATTRIBUTE CHR CONTINUE CONV DELAY EMPTY IO ORD PRED STOP REALTIME SETHEAP SUCC TRUNC START WAIT REAL REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT  * $ M   *$ T  0$\ "Z$" "B"V V"$ "X"$g Z" B""p$:"" "V"@"x"   "j""$ " ^*V ݒ436 (  5X ݄ ; ܒV= 8&"\"BCx >" vT* 2X ܄B " ;X ܄ 8 " `DRQX 8&" EhFV" T" ""$ " X" ""&$ """ """   "  XB("X " ""   "  X,( 0Rx 0 "" VV6X VJ> 0 V V2 0 V `2   0 TB`* 2X ۄ"0 " Be 8 8 T dI"jL"\K"NM"@H"2J"$N"!G4ڌ  ڒTz 8&B &T:" XO" P"lڄ "  TG^ TH ,Q"*X"D RR&40R1R2R3R4R5R6R7R8R9R&$4 R8&$   (  "  q Nvb lXTRY AGAIN EDIT(FILE: IDENTIFIER) OR EDIT(SOURCE, DESTINATION: IDENTIFIER) CREATE REPLACE ASCII FILE EDIT: DESTINATION FILE LOST SOURCE FILE UN*R"S"لQ", " T0bR 8& TGn Th HT"JU"<V".W" X"؄T",  T0BR 8 T el׌(؄k |׌؄rg h׌؄^KNOWN SOURCE KIND MUST BE ASCII OR SEQCODE DESTINATION FILE PROTECTED NEXT DEL( # LINE NUMBER(S) MISSING LINE ALREADY PASSED LINE NUMBERS ILLEGAL EDIT:   (  "  q Nvb lXTRY AGAIN EDIT(FILE: IDENTIFIER) OR EDIT(SOURCE, DESTINATION: IDENTIFIER) CREATE REPLACE ASCII FILE EDIT: DESTINATION FILE LOST SOURCE FILE UNi T׌ׄJ R< 8 /X ׄ ߄ $Zք~[ v8& Th\r T& 2X ׄLt߄ 3X ք ߄ z _Ւ@ 8N 8 X ] ^tՄ YhՒb" f8&_"ְ   X  "   հ  X Ԅ)Ԅ~vZԄj :nԄZ ߄N߄F7*Ԍ6 *$ ߄'ӄ*ӄXބӄ p߄ӄph`DӄT R z fT X` =ԌV8&"a  T* 2X DՄ ݄ " 3X Մ T |݄@! 8V Tn Nc ԄNf ӄ>dӄ2h ӄ"j ӄ LԄ! cӒ X6Ռ  " Ζ8ӄH+,ӄ<4,ӄ :" ҄ ބބ&ބ҄҄5ބ#҄(҄ 6,ބlބx\҄l:P҄`$D҄TL^DX<" ҄08&  T2   ބ.&ф"%pфdфtPl@d\. .PASS 2: FILE_LIMIT X` =ԌV8&"a  T* 2X DՄ ݄ " 3X Մ T |݄@! 8V Tn Nc ԄNf ӄ>dӄ2h ӄ"j ӄ LԄ! cӒ X6Ռ  " ΖB"H@!$ф4;ф(n  фЄ/1*"\^4~~^6^6`b T&Rnvz*@hn<$&*r$,4:.L 6 ˖PASS 4: FILE_LIMIT  ބ.&ф"%pфdфtPl@d\. . BEGIN REPEAT L := L + 1; WRITECHAR(TEXT(.L.)); UNTIL L = I; END; END ELSE BEGIN I:= I + 1; TEXT(.I.):= C END; UNTIL (C = NL) OR (I = LINELIMIT); IF C <> NL THEN BEGIN WRITECHAR(NL); TEXT(.LINELIMIT + 1.):= NL; END; END; BEGIN END; "############# # TERMINAL # #############" TYPE TERMINAL = CLASS(ACCESS: TYPERESOURCE); VAR UNIT: TYPEWRITER; PROCEDURE ENTRY READ(HEADER: LINE; VAR TEXT: LINE); VAR CHANGED: BOOLEAN; BEGIN ACCESS.REQUE)X   Z?" nO F <:86420.,*(&$"t $l n`.~n"O? n nB" nZ( nP^ n" nX O  nt0Gp:"r "l" r X4r"p p"~ p t*r r"~ p r  l ST(HEADER, CHANGED); IF CHANGED THEN UNIT.WRITE(HEADER); UNIT.READ(TEXT); ACCESS.RELEASE; END; PROCEDURE ENTRY WRITE(HEADER, TEXT: LINE); VAR CHANGED: BOOLEAN; BEGIN ACCESS.REQUEST(HEADER, CHANGED); IF CHANGED THEN UNIT.WRITE(HEADER); UNIT.WRITE(TEXT); ACCESS.RELEASE; END; BEGIN INIT UNIT(TYPEDEVICE) END; "################### # TERMINALSTREAM # ###################" TYPE TERMINALSTREAM = CLASS(OPERATOR: TERMINAL); CONST LINELIMIT = 80; VAR HEADER: LINE; ENDINPUT: BOOLEAN; INP, OUTID, ATTR, FOUND); IF FOUND THEN BEGIN DISKUSE.REQUEST; FILE.OPEN(ATTR.ADDR); LENGTH:= FILE.LENGTH; DISKUSE.RELEASE; END; OPENED:= FOUND; END; PROCEDURE ENTRY CLOSE; BEGIN FILE.CLOSE; LENGTH:= 0; OPENED:= FALSE; END; PROCEDURE ENTRY READ(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF OPENED THEN BEGIN DISKUSE.REQUEST; FILE.READ(PAGENO, BLOCK); DISKUSE.RELEASE; END; END; PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF OPENED THEN ########### # JOBPROCESS # ###############" TYPE JOBPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER, OUTBUFFER: PAGEBUFFER; INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE: ARGBUFFER; STACK: PROGSTACK); "PROGRAM DATA SPACE = " +16000 CONST MAXFILE = 2; TYPE FILE = 1..MAXFILE; VAR OPERATOR: TERMINAL; OPSTREAM: TERMINALSTREAM; INSTREAM, OUTSTREAM: CHARSTREAM; FILES: ARRAY (.FILE.) OF DATAFILE; CODE: PROGFILE1; PROGRAM JOB(VAR PARAM: ARGLIST; STBEGIN DISKUSE.REQUEST; FILE.WRITE(PAGENO, BLOCK); DISKUSE.RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); LENGTH:= 0; OPENED:= FALSE; END; "########################### # PROGSTORE AND PROGFILE # ###########################" TYPE PROGSTATE = (READY, NOTFOUND, NOTSEQ, TOOBIG); CONST STORELENGTH1 = 40; TYPE PROGSTORE1 = ARRAY (.1..STORELENGTH1.) OF PAGE; TYPE PROGFILE1 = CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; ENTRY STORE: ORE: PROGSTORE1); ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH, MARK, RELEASE, IDENTIFY, ACCEPT, DISPLAY, READPAGE, WRITEPAGE, READLINE, WRITELINE, READARG, WRITEARG, LOOKUP, IOTRANSFER, IOMOVE, TASK, RUN; PROCEDURE CALL(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); VAR STATE: PROGSTATE; LASTID: IDENTIFIER; BEGIN WITH CODE, STACK DO BEGIN LINE:= 0; OPEN(ID, STATE); IF (STATE = READY) & SPACE THEN BEGIN PUSH(ID); JOB(PARAM, STORE)PROGSTORE1; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE); VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER; BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND); WITH DISKUSE, FILE, ATTR DO IF NOT FOUND THEN STATE:= NOTFOUND ELSE IF KIND <> SEQCODE THEN STATE:= NOTSEQ ELSE BEGIN REQUEST; OPEN(ADDR); IF LENGTH <= STORELENGTH1 THEN BEGIN FOR PAGENO:= 1 TO LENGTH DO READ(PAGENO, STORE(.PAGENO.)); STATE:= READY; END ELSE STATE:= TOOBIG; CLOS = FPSIUV+FPSFIU+FPSFIV+FPSFIC+FPSFD; UNDEF. VAR. INT., ; UNDERFLOW INT., ; OVERFLOW INT., ; INTEGER CONV INT., ; DOUBLE PRECISION, ; SHORT INTEGER, ; ROUNDED ARITHMETIC ;* ;* CODE DEFINITIONS FOR THE FEC RE= LINELIMIT) THEN BEGIN OPERATOR.WRITE(HEADER, TEXT); COUNT:= 0; END; END; END; PROCEDURE ENTRY RESET(TEXT: LINE); BEGIN INITIALIZE(TEXT) END; BEGIN INITIALIZE('UNIDENTIFIED:(:10:)') END; "######### # DISK # #########" TYPE DISK = CLASS(TYPEUSE: TYPERESOURCE); VAR OPERATOR: TERMINAL; PROCEDURE TRANSFER(COMMAND: IOOPERATION; PAGEADDR: UNIV IOARG; VAR BLOCK: PAGE); VAR PARAM: IOPARAM; RESPONSE: LINE; BEGIN WITH PARAM, OPERATOR DO BEGIN OPERATION:= COMMAND; ARG:= PE; RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); END; CONST STORELENGTH2 = 8; TYPE PROGSTORE2 = ARRAY (.1..STORELENGTH2.) OF PAGE; TYPE PROGFILE2 = CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; ENTRY STORE: PROGSTORE2; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE); VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER; BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND); WITH DISKUSE, FILE, ATTR DO IF NOT FOUND THEN STATE:= NOTFOUND AGEADDR; IO(BLOCK, PARAM, DISKDEVICE); WHILE STATUS <> COMPLETE DO BEGIN WRITE('DISK:(:10:)', 'ERROR(:10:)'); READ('PUSH RETURN(:10:)', RESPONSE); IO(BLOCK, PARAM, DISKDEVICE); END; END; END; PROCEDURE ENTRY READ(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN TRANSFER(INPUT, PAGEADDR, BLOCK) END; PROCEDURE ENTRY WRITE(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN TRANSFER(OUTPUT, PAGEADDR, BLOCK) END; BEGIN INIT OPERATOR(TYPEUSE) END; "######################### # ELSE IF KIND <> SEQCODE THEN STATE:= NOTSEQ ELSE BEGIN REQUEST; OPEN(ADDR); IF LENGTH <= STORELENGTH2 THEN BEGIN FOR PAGENO:= 1 TO LENGTH DO READ(PAGENO, STORE(.PAGENO.)); STATE:= READY; END ELSE STATE:= TOOBIG; CLOSE; RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); END; "############################# # RESULTTYPE AND PROGSTACK # #############################" TYPE RESULTTYPE = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERR FILEMAP AND DISKFILE # #########################" CONST MAPLENGTH = 255; TYPE FILEMAP = RECORD FILELENGTH: INTEGER; PAGESET: ARRAY (.1..MAPLENGTH.) OF INTEGER END; TYPE DISKFILE = CLASS(TYPEUSE: TYPERESOURCE); VAR UNIT: DISK; MAP: FILEMAP; OPENED: BOOLEAN; ENTRY LENGTH: INTEGER; FUNCTION INCLUDES(PAGENO: INTEGER): BOOLEAN; BEGIN INCLUDES:= OPENED & (1 <= PAGENO) & (PAGENO <= LENGTH); END; PROCEDURE ENTRY OPEN(MAPADDR: INTEGER); BEGIN UNIT.REOR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); TYPE ATTRINDEX = (CALLER, HEAPTOP, PROGLINE, PROGRESULT, RUNTIME); TYPE PROGSTACK = MONITOR CONST STACKLENGTH = 5; VAR STACK: ARRAY (.1..STACKLENGTH.) OF RECORD PROGID: IDENTIFIER; HEAPADDR: INTEGER END; TOP: 0..STACKLENGTH; FUNCTION ENTRY SPACE: BOOLEAN; BEGIN SPACE:= (TOP < STACKLENGTH) END; FUNCTION ENTRY ANY: BOOLEAN; BEGIN ANY:= (TOP > 0) END; PROCEDURE ENTRY PUSH(ID: IDENTIFIERAD(MAPADDR, MAP); LENGTH:= MAP.FILELENGTH; OPENED:= TRUE; END; PROCEDURE ENTRY CLOSE; BEGIN LENGTH:= 0; OPENED:= FALSE; END; PROCEDURE ENTRY READ(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF INCLUDES(PAGENO) THEN UNIT.READ(MAP.PAGESET(.PAGENO.), BLOCK); END; PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF INCLUDES(PAGENO) THEN UNIT.WRITE(MAP.PAGESET(.PAGENO.), BLOCK); END; BEGIN INIT UNIT(TYPEUSE); LENGTH:= 0; OPENED:= FALSE; END; "#################); BEGIN IF TOP < STACKLENGTH THEN BEGIN TOP:= TOP + 1; WITH STACK(.TOP.) DO BEGIN PROGID:= ID; HEAPADDR:= ATTRIBUTE(HEAPTOP); END; END; END; PROCEDURE ENTRY POP (VAR LINE, RESULT: UNIV INTEGER); CONST TERMINATED = 0; BEGIN LINE:= ATTRIBUTE(PROGLINE); RESULT:= ATTRIBUTE(PROGRESULT); IF RESULT <> TERMINATED THEN SETHEAP(STACK(.TOP.).HEAPADDR); TOP:= TOP - 1; END; PROCEDURE ENTRY GET(VAR ID: IDENTIFIER); BEGIN IF TOP > 0 THEN ID:= STACK(.TOP.).PROGID; END; ##### # CATALOG STRUCTURE # ######################" CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILEKIND = (EMPTY, SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE CATENTRY = RECORD ID: IDENTIFIER; ATTR: FILEATTR; KEY, SEARCBEGIN TOP:= 0 END; "######################### # TASKKIND AND ARGTYPE # #########################" TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); ARGTYPE = RECORD TAG: ARGTAG; ARG: IDENTIFIER END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); "############## # ARGBUFFER # ##############" TYPE ARGBUFFER = MONITOR VAR BUFFER: ARGTYHLENGTH: INTEGER END; CONST CATPAGELENGTH = 16; TYPE CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY; CONST CATADDR = 154; "############## # DISKTABLE # ##############" TYPE DISKTABLE = CLASS(TYPEUSE: TYPERESOURCE; CATADDR: INTEGER); VAR FILE: DISKFILE; PAGENO: INTEGER; BLOCK: CATPAGE; ENTRY LENGTH: INTEGER; PROCEDURE ENTRY READ(I: INTEGER; VAR ELEM: CATENTRY); VAR INDEX: INTEGER; BEGIN INDEX:= (I - 1) DIV CATPAGELENGTH + 1; IF PAGENO <> INDEX THEN BEGIN PAGENPE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR ARG: ARGTYPE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); ARG:= BUFFER; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(ARG: ARGTYPE); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= ARG; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # LINEBUFFER # ###############" TYPE LINEBUFFER = MONITOR VAR BUFFER: LINE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: O:= INDEX; FILE.READ(PAGENO, BLOCK); END; ELEM:= BLOCK(.(I - 1) MOD CATPAGELENGTH + 1.); END; BEGIN INIT FILE(TYPEUSE); FILE.OPEN(CATADDR); LENGTH:= FILE.LENGTH * CATPAGELENGTH; PAGENO:= 0; END; "################ # DISKCATALOG # ################" TYPE DISKCATALOG = MONITOR(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATADDR: INTEGER); VAR TABLE: DISKTABLE; FUNCTION HASH(ID: IDENTIFIER): INTEGER; VAR KEY, I: INTEGER; C: CHAR; BEGIN KEY:= 1; I:= 0; REPEAT I:= I + 1; C:= LINE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXT:= BUFFER; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= TEXT; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # PAGEBUFFER # ###############" TYPE PAGEBUFFER = MONITOR VAR BUFFER: PAGE; LAST, FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: PAGE; VAR EOF: BOOLEAN); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXID(.I.); IF C <> ' ' THEN KEY:= KEY * ORD(C) MOD TABLE.LENGTH + 1; UNTIL (C = ' ') OR (I = IDLENGTH); HASH:= KEY; END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); VAR KEY, MORE, INDEX: INTEGER; ELEM: CATENTRY; BEGIN DISKUSE.REQUEST; KEY:= HASH(ID); TABLE.READ(KEY, ELEM); MORE:= ELEM.SEARCHLENGTH; INDEX:= KEY; FOUND:= FALSE; WHILE NOT FOUND & (MORE > 0) DO BEGIN TABLE.READ(INDEX, ELEM); IF ELEM.ID = ID THEN BEGIN ATTR:= ELEM.ATTR;T:= BUFFER; EOF:= LAST; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(TEXT: PAGE; EOF: BOOLEAN); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= TEXT; LAST:= EOF; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # CHARSTREAM # ###############" TYPE CHARSTREAM = CLASS(BUFFER: PAGEBUFFER); VAR TEXT: PAGE; COUNT: INTEGER; EOF: BOOLEAN; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN IF COUNT = PAGELENGTH THEN BEGIN BUFFER.READ(TEXT, EOF); COUNT:= 0; FOUND:= TRUE END ELSE BEGIN IF ELEM.KEY = KEY THEN MORE:= MORE - 1; INDEX:= INDEX MOD TABLE.LENGTH + 1; END; END; DISKUSE.RELEASE; END; BEGIN INIT TABLE(TYPEUSE, CATADDR) END; "############# # DATAFILE # #############" TYPE DATAFILE = CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; OPENED: BOOLEAN; ENTRY LENGTH: INTEGER; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR FOUND: BOOLEAN); VAR ATTR: FILEATTR; BEGIN CATALOG.LOOKUP( END; COUNT:= COUNT + 1; C:= TEXT(.COUNT.); IF C = EM THEN BEGIN WHILE NOT EOF DO BUFFER.READ(TEXT, EOF); COUNT:= PAGELENGTH; END; END; PROCEDURE ENTRY INITREAD; BEGIN COUNT:= PAGELENGTH END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN COUNT:= COUNT + 1; TEXT(.COUNT.):= C; IF (COUNT = PAGELENGTH) OR (C = EM) THEN BEGIN BUFFER.WRITE(TEXT, FALSE); COUNT:= 0; IF C = EM THEN BUFFER.WRITE(TEXT, TRUE); END; END; PROCEDURE ENTRY INITWRITE; BEGIN COUNT:= 0 END; BEGIN END; "#### = 177406; WORD COUNT REGISTER RKBA = 177410; CURRENT BUS ADDRESS REGISTER RKDA = 177412; DISK ADDRESS REGISTER RKDB = 177416; DATA BUFFER REGISTER ;* ;* BIT AND FIELD DEFINITIONS FOR THE DRIVE STATUS REGISTER ;* ;* FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* RDSSC = ^B0000000000000001; 4 BITS - SECTOR COUNTER RDSCSA = ^B0000000000010000; 1 BIT - (SECTOR) COUNTER=A 1 BIT - FORMAT MODE RCSIBA = ^B0000100000000000; 1 BIT - INHIBIT INCREMENT ;* = ^B0001000000000000; 1 BIT - NOT USED RCSSCP = ^B0010000000000000; 1 BIT - SEARCH COMPLETE RCSHE = ^B0100000000000000; 1 BIT - HARD ERROR RCSERR = ^B1000000000000000; 1 BIT - ERROR (HARD OR SOFT) ;* ;* FIELD VALUE DEFINITIONS FOR RCSFUN ARE:__ ;* RCFCRE = ^B000; CONTROL RESET RCFWR = ^B001; WRITE RCFRD = ^B0DDR RDSWPS = ^B0000000000100000; 1 BIT - WRITE PROTECT STATUS RDSRDY = ^B0000000001000000; 1 BIT - READ/WRITE/SEEK READY RDSDRY = ^B0000000010000000; 1 BIT - DRIVE READY RDSSOK = ^B0000000100000000; 1 BIT - SECTOR COUNTER OK RDSSIN = ^B0000001000000000; 1 BIT - SEEK INCOMPLETE RDSDRU = ^B0000010000000000; 1 BIT - DRIVE UNSAFE RDRK05 = ^B0000100000000000; 1 BIT - RK05 DISK DRIVE RDSDPL = ^B0001000000000000; 1 BIT - DRIVE 10; READ RCFWRC = ^B011; WRITE CHECK RCFSK = ^B100; SEEK RCFRDC = ^B101; READ CHECK RCFDRE = ^B110; DRIVE RESET RCFWRL = ^B111; WRITE LOCK ;* ;* BIT AND FIELD DEFINITIONS FOR DISK ADDRESS REGISTER ;* ;* FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* RDASC = ^B0000000000000001; 4 BITS - SECTOR ADDRESS, 0..11 RDASUR = ^B0000000000010000;POWER LOW RDSID = ^B0010000000000000; 3 BITS - DRIVE IDENTIFIER ;* ;* BIT DEFINITIONS FOR THE ERROR REGISTER ;* RERWCE = ^B0000000000000001; WRITE CHECK ERROR (SOFT) RERCSE = ^B0000000000000010; CHECKSUM ERROR (SOFT) ;* = ^B0000000000011100; 3 BITS - NOT USED RERNXS = ^B0000000000100000; NONEXISTENT SECTOR RERNXC = ^B0000000001000000; NONEXISTENT CYLINDER RERNXD = ^B0000000010000000; NONEXISTENT DISK RERTE = ^B0000GIKMOQSUW\^`bdfhjlnXZ]_acegikmoY[xz|~prtvy{}qsuw        $`X000100000000; TIMING ERROR RERDLT = ^B0000001000000000; DATA LATE RERNXM = ^B0000010000000000; NONEXISTENT MEMORY RERPGE = ^B0000100000000000; PROGRAMMING ERROR RERSKE = ^B0001000000000000; SEEK ERROR RERWLO = ^B0010000000000000; WRITE LOCKOUT VIOLATION REROVR = ^B0100000000000000; OVERRUN RERDRE = ^B1000000000000000; DRIVE ERROR ;* ;* BIT AND FIELD DEFINITIONS FOR CONTROL STATUS REGISTER ;* ;* FIELDS ARE DECLARED BY .SBTTL DATA TYPES FOR THE I/O CONTROLLERS ;"################################### ; # I/O DATA TYPES # ;###################################" ; ; ; TYPE BUFFERTYPE = ANYTYPE; ; $ = 0 ; TYPE IODEVICE = ( TTY020 = GIVING THEIR RIGHTMOST BITS ;* RCSGO = ^B0000000000000001; 1 BIT - INITIATE FUNCTION RCSFUN = ^B0000000000000010; 3 BITS - FUNCTION FIELD RCSMEX = ^B0000000000010000; 2 BITS - MEMORY EXTENSION RCSIDE = ^B0000000001000000; 1 BIT - INTERRUPT ON DONE RCSRDY = ^B0000000010000000; 1 BIT - CONTROL READY RCSSSE = ^B0000000100000000; 1 BIT - STOP ON SOFT ERROR ;* = ^B0000001000000000; 1 BIT - NOT USED RCSFMT = ^B0000010000000000; $ ; TTY0, $ = $ + 1 ; DSK020 = $ ; DISK0, $ = $ + 1 ; TP9020 = $ ; TAPE90, $ = $ + 1 ; PRT020 = $ ; PRINTER0, $ = $ + 1 ; CRD020 = $ ; CARDREADER0, $ = $ + 1 ; TP9120 = $ GISTER ;* FECOPC = 2.; OPCODE ERROR FECDVZ = 4.; DIVIDE CHECK FECICE = 6.; INTEGER CONVERSION ERROR FECOVF = 8.; OVERFLOW FECUNF = 10.; UNDERFLOW FECUDV = 12.; UNDEFINED VARIABLE FECMTT = 14.; MAINTENANCE TRAP ;* ;* .SBTTL TM11 TAPE DEFINITIONS ;**** TM11 TAPE HARDWARE REGISTERS ***** ;* ;* ADDRESSES OF THE ; TAPE91 .IODEVIC= .INTEGER ; ); ; $ = 0 ; TYPE IOOPERATION = ( INPU21 = $ ; INPUT, $ = $ + 1 ; OUTP21 = $ ; OUTPUT, $ = $ + 1 ; MOVE21 = $ ; MOVE, $ = $ + 1 ; CONT21 = $ HARDWARE REGISTERS ;* MTS = 172520; STATUS REGISTER MTC = 172522; COMMAND REGISTER MTBRC = 172524; BYTE/RECORD COUNTER MTCMA = 172526; CURRENT MEMORY ADDRESS REGISTER MTD = 172530; DATA BUFFER ;* ;* BIT DEFINITIONS FOR THE STATUS REGISTER ;* MTSTUR = ^B0000000000000001; TAPE UNIT READY MTSRWS = ^B0000000000000010; REWIND STATUS MTSWRL = ^B000000000000 ; CONTROL .IOOPERA= .INTEGER ; ); ; $ = 0 ; TYPE IORESULT = ( COMP22 = $ ; COMPLETE, $ = $ + 1 ; INTE22 = $ ; INTERVENTION, $ = $ + 1 ; TRAN22 = $ ; TRANSMISSION, $ = $ + 1 ; FAIL22 0100; WRITE LOCK (FILE PROTECT) MTSDWN = ^B0000000000001000; TAPE SETTLE DOWN MTS7CH = ^B0000000000010000; SEVEN CHANNEL MTSBOT = ^B0000000000100000; BEGINNING OF TAPE MTSELR = ^B0000000001000000; SELECT REMOTE MTSNXM = ^B0000000010000000; NONEXISTENT MEMORY MTSBTE = ^B0000000100000000; BAD TAPE ERROR MTSRLE = ^B0000001000000000; RECORD LENGTH ERROR MTSEOT = ^B0000010000000000; END OF TAPE MTSBGL = ^B0000100000000000; = $ ; FAILURE, $ = $ + 1 ; ENDF22 = $ ; ENDFILE, $ = $ + 1 ; ENDM22 = $ ; ENDMEDIUM, $ = $ + 1 ; STAR22 = $ ; STARTMEDIUM .IORESUL= .INTEGER ; ); ; $ = 0 ; TYPE IOMOVE = ( OUTE23 BUS GRANT LATE MTSPAE = ^B0001000000000000; PARITY ERROR MTSCRE = ^B0010000000000000; CYCLIC REDUNDANCY ERROR MTSEOF = ^B0100000000000000; END OF FILE MTSILC = ^B1000000000000000; ILLEGAL COMMAND ;* ;* BIT AND FIELD DEFINITIONS FOR THE COMMAND REGISTER ;* ;* FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* MTCGO = ^B0000000000000001; 1 BIT - BEGIN OPERATION MTCFUN = ^B0000000000000010; 3 BITS - FUNCTION FIELD MTCADD = = $ ; OUTEOF, $ = $ + 1 ; REWI23 = $ ; REWIND, $ = $ + 1 ; UPSP23 = $ ; UPSPACE, $ = $ + 1 ; BACK23 = $ ; BACKSPACE, $ = $ + 1 ; UNLO23 = $ ; UNLOAD .IOMOVE = .INTEGER ; ); ^B0000000000010000; 2 BITS - ADDRESS EXTENSION MTCIEN = ^B0000000001000000; 1 BIT - INTERRUPT ENABLE MTCCUR = ^B0000000010000000; 1 BIT - CU READY MTCUS = ^B0000000100000000; 3 BITS - UNIT SELECT MTCPEV = ^B0000100000000000; 1 BIT - LATERAL PARITY (EVEN) MTCPCL = ^B0001000000000000; 1 BIT - POWER CLEAR MTCDEN = ^B0010000000000000; 2 BITS - DENSITY MTCERR = ^B1000000000000000; 1 BIT - HARD ERROR ;* ;* FIELD VALUE DEFINI ; IOPARAM = 0 ; TYPE IOPARAM = $ = IOPARAM ; RECORD OPER24 = $ ; OPERATION: $ = $ + .IOOPERATION ; IOOPERATION; STAT24 = $ ; STATUS: $ = $ + .IORESULT ; IORESULT; MODI24 = $ ; MODIFIER: $ = $ + .INTEGER ; UNIV INTEGER; .IOPARAM= $ - IOPARAM ; END; TIONS FOR MTCFUN ARE:__ ;* MTFOFL = ^B000; OFFLINE MTFRD = ^B001; READ MTFWR = ^B010; WRITE MTFWFM = ^B011; WRITE EOF MTFSPF = ^B100; SPACE FORWARD MTFSPR = ^B101; SPACE REVERSE MTFWGP = ^B110; WRITE GAP MTFREW = ^B111; REWIND ;* ;* FIELD VALUE DEFINITIONS FOR MTCDEN ARE:__ ;* MDS200 = ^B00; SEVE ; ; TYPE UNITTYPE = 0..7; ; ; .SBTTL PROCEDURES FOR ABSENT I/O DEVICES ;"################################### ; # MISSING DEVICES # ;###################################" ; ; PARAN TRACK, 200 BPI MDS556 = ^B01; SEVEN TRACK, 556 BPI MDS800 = ^B10; SEVEN TRACK, 800 BPI MDN800 = ^B11; NINE TRACK, 800 BPI ;* ;* .SBTTL RK11 DISK DEFINITIONS ;**** RK11 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* RKDS = 177400; DRIVE STATUS REGISTER RKER = 177402; ERROR REGISTER RKCS = 177404; CONTROL STATUS REGISTER RKWC 38: .BLKB .ADDRESS ; PROCEDURE IOFAIL(VAR PARAM: ; @IOPARAM); ; IOFA38: ; BEGIN MOV #FAIL22,-(SP) ; PARAM@.STATUS := FAILURE; MOV PARA38,R0 ; MTPD STAT24(R0) ; RTS PC ; END; ; ; DEVR39: .BLKB .ADDRESS ; FUNCTIG, TAPE25 = MTSTUR ; TAPEUNITREADY: BOOLEAN; ; END; COMR25 = MTC ; COMMANDREG: TAPECOMMAND; COUN25 = MTBRC ; COUNTREG: INTEGER; ADRG25 = MTCMA ; ADDRREG: ADDRESS; ; ; BUF25: .BLKB .ADDRESS ; PROCEDURE INITIO(VAR BUF: ; @BUFFERTYPANSMISSION ELSE BIT #ENDO25,R1 ; IF ENDOFFILE THEN BNE 3$ ; RESULT := ENDFILE ; ELSE BR 8$ ; RESULT := ; ENDMEDIUM; 5$: INC R0 ; 8$: INC R0 ; 3$: INC R0 ; 6$: INC R0 ;E; COM25: .BLKB .ADDRESS ; VAR COM: @IOPARAM; UNIN25: .BLKB .INTEGER ; UNITNUMBER: ; UNITTYPE); ; ;OPER IS R1 ; VAR OPER: IOOPERATION; SKEL25: .BLKB .TAPECOMMAND ; SKELETON: TAPECOMMAND; ; AND R2 ; ;MOVER IS R1 ; MOVER: IOMOVE; PREF25: .BLKB .INTEGER ; PR 9$: INC R0 ; 7$: INC R0 ; 4$: MOV R0,-(SP) ; MOV USER25,P10 ; VIRTUAL.GETMAP(USER); JSR PC,GETM10 ; BIS #PSPMDU,PSW ; MTPD @ADDR25 ; ADDR@ := RESULT; CLR USER25 ; USER := NIL; JSR PC,ENDI12 ; READY.ENDIO; RTS PC ; END; ; END;ON DEVICEPRESENT(DEVREG: DEV39R: .BLKB .BOOLEAN ; @INTEGER): BOOLEAN; ; NONE39: ; ON NONEXISTENTMEMORYTRAP DO CLR DEV39R ; DEVICEPRESENT := FALSE; RTI ; ; DEVI39: MOV #NONE39,FETRAP ; BEGIN MOV #1,DEV39R ; DEVICEPRESENT := TRUE; TST @DEVR39 ; IF DEVREG@ = 0 THEN ; MEFIX: 0..3; ; INIO25: ; BEGIN MOV COM25,R0 ; OPER := COM@.OPERATION; MFPD (R0)+ ; MOV (SP)+,R1 ; ASL R1 ; MOV R0,ADDR25 ; ADDR := @COM@.STATUS; MOV UNIN25,R2 ; SKELETON := UNITS(.UNITNUMBER.); MOV UNIS25(R2),R2 ; ; WITH SKELETON DO OV #FEINT,FETRAP ; END; RTS PC ; ; ; .SBTTL TAPE (TM11) I/O DRIVER ;"################################### ; # TM11TAPE # ;###################################" ; ; ; ; BEGIN JMP 1$(R1) ; IF OPER <> CONTROL THEN 1$: BR 2$ ; BEGIN BR 3$ ; CASE OPER OF BR 4$ ; BR 5$ ; 2$: 3$: ; INPUT, OUTPUT: ; BEGIN BIS FTBL25(R1),R2 ; FUNC := ; FUNCTABLE(.OPER VAR TM11TAPE: "9-TRACK TAPES ONLY" ; CLASS ; IOCO25 = -512. ; CONST IOCOUNT = -512; SPAC25 = -1. ; SPACECOUNT = -1; ; ; TYPE FUNCTYPE = ( OFFL25 = MTFOFL ; OFFLINE, READ25 = MTFRD ; READ, WRIT25 = MTFWR ; WRITE, .); MOV R2,SKEL25 ; VIRTUAL.REALADDRESS( MOV BUF25,VTLA10 ; BUF, MOV #PREF25,PREF10 ; PREFIX, MOV #ADRG25,REST10 ; ADDRREG); JSR PC,REAL10 ; MOV PREF25,R2 ; ADDRBITS := PREFIX; ASH #4.,R2 ; ADD SKEL25,R2 ; MOV #IOCO25,COUN25 ; WEOF25 = MTFWFM ; WRITEEOF, FORW25 = MTFSPF ; FORWARDSPACE, BACK25 = MTFSPR ; BACKWARDSPACE, WGAP25 = MTFWGP ; WRITEGAP, REWI25 = MTFREW ; REWINDTAPE .FUNCTYP= .INTEGER ; ); ; ; TYPE TAPEDENSITY = ( ST2025 = MDS200 COUNTREG := IOCOUNT; BR 6$ ; END; ; 4$: ; MOVE: ; BEGIN MFPD 2(R0) ; MOVER := COM@.MODIFIER; MOV (SP)+,R1 ; ASL R1 ; FUNC := BIS MTBL25(R1),R2 ; MOVETABLE(.MOVER.); MOV #SPAC25,COUN25 ; COUN ; ST200, ST5525 = MDS556 ; ST556, ST8025 = MDS800 ; ST800, NT8025 = MDN800 ; NT800 .TAPEDEN= .INTEGER ; ); ; ; TYPE TAPECOMMAND = .TAPECOM= .INTEGER ; PACKED RECORD ERRO25 = MTCERR ; ERROR: BOOLEAN; NTDE25 = MTCDEN * NTTREG := SPACECOUNT; ; END; ; END; 6$: MOV R2,COMR25 ; COMMANDREG := SKELETON; JSR PC,PREE11 ; USER := RUNNING.PREEMPTED; MOV PRE11R,USER25 ; RTS PC ; END ELSE 5$: ; BEGIN "OPER = CONTROL" CLR -(SP) ; COM@.STATUS := COMPLETE; MTPD @ADDR25 8025 ; DENSITY: TAPEDENSITY; POWE25 = MTCPCL ; POWERCLEAR: BOOLEAN; EVEN25 = MTCPEV ; EVENPARITY: BOOLEAN; UNIT25 = MTCUS ; UNIT: UNITTYPE; REDY25 = MTCCUR ; READY: BOOLEAN; INEN25 = MTCIEN ; INTERRUPT: BOOLEAN; ADDB25 = MTCADD ; ADDRBITS: 0..3; FUNC25 = MTCFUN ; FUNC: FUNCTYPE; GO25 = MTCGO ; GO: BOOLEAN; ; RTS PC ; END; ; END; ; END "OF INITIO"; ; ; ; PROCEDURE INTERRUPT; ; ;RESULT IS R0 ; VAR RESULT: IORESULT; ; INTE25: ; BEGIN MOV USER25,R0 ; IF USE ; END; ; UNIS25: ; VAR UNITS: ARRAY (.UNITTYPE.) OF $TC = NTDE25+INEN25+GO25 ; TAPECOMMAND; $UN = 0 ; .REPT 8. ; .WORD $TC + $UN ; $UN = $UN + UNIT25 ; .ENDR ; FTBL25: .WORD FUNC25 * READ25 ; FUNCTABLE: ARRAY .WORD FUNC25 * WRIT25 ; (.IOOPERAR <> NIL THEN BNE 1$ ; RTS PC ; 1$: ; WITH COMMANDREG, STATUSREG DO ; BEGIN MOV R0,P12 ; READY.ENTER(USER); JSR PC,ENTE12 ; CLR R0 ; MOV STAT25,R1 ; TST COMR25 ; IF NOT ERROR THEN BMI 2$ ; BIT #ENDO25,R1 TION.) OF FUNCTYPE; MTBL25: .WORD FUNC25 * WEOF25 ; MOVETABLE: ARRAY (.IOMOVE.) OF .WORD FUNC25 * REWI25 ; FUNCTYPE; .WORD FUNC25 * FORW25 ; .WORD FUNC25 * BACK25 ; .WORD FUNC25 * OFFL25 ; USER25: .WORD NIL ; USER: PROCESSREF; ADDR25: .BLKB .ADDRESS ; ADDR: @IORESULT; CONN25: .BLKB .BOOLEAN ; VAR ENTRY ; CONNECTED: BOOLEAN; ; IF ENDOFFILE THEN BNE 3$ ; RESULT := ENDFILE ELSE BIT #ENDT25,R1 ; IF ENDOFTAPE THEN BNE 8$ ; RESULT := ENDMEDIUM ; ELSE BIT #BEGI25,R1 ; IF BEGINNINGOFTAPE THEN BNE 5$ ; RESULT := STARTMEDIUM ; ; "HARDWARE" STAT25 = MTS ; STATUSREG: ; PACKED RECORD ILLE25 = MTSILC ; ILLEGALCOMMAND, ENDO25 = MTSEOF ; ENDOFFILE, CYCL25 = MTSCRE ; CYCLICREDUNDANCY, PARI25 = MTSPAE ; PARITYERROR, BUSG25 = MTSBGL ; BUSGRANTLATE, ENDT25 = MTSEOT ; ENDOFTAPE, RECO25 = ELSE BR 4$ ; RESULT := COMPLETE 2$: ; ELSE "ERROR" $ = RECO25 ; IF RECORDLENGTH OR $ = $ + NONE25 ; NONEXISTENTMEMORY THEN BIT #$,R1 ; BNE 6$ ; RESULT := FAILURE ELSE BIT #ILLE25,R1 ; IF ILLEGALCOMMAND THEN BNE 7$ ; RESULT := I MTSRLE ; RECORDLENGTH, BADT25 = MTSBTE ; BADTAPE, NONE25 = MTSNXM ; NONEXISTENTMEMORY, SELE25 = MTSELR ; SELECTREMOTE, BEGI25 = MTSBOT ; BEGINNINGOFTAPE, SVNC25 = MTS7CH ; SEVENCHANNEL, SETT25 = MTSDWN ; SETTLEDOWN, FILE25 = MTSWRL ; FILEPROTECT, REWS25 = MTSRWS ; REWINDINNTERVENTION ; ELSE $ = CYCL25 ; IF CYCLICREDUNDANCY OR $ = $ + PARI25 ; PARITYERROR OR $ = $ + BADT25 ; BADTAPE OR $ = $ + BUSG25 ; BUSGRANTLATE THEN BIT #$,R1 ; BNE 9$ ; RESULT := ; TR7 = RCSHE ; HARDERROR, SEAR27 = RCSSCP ; SEARCHCOMPLETE, INHI27 = RCSIBA ; INHIBITINCREMENT, FORM27 = RCSFMT ; FORMAT, STOP27 = RCSSSE ; STOPONSOFTERROR, CONR27 = RCSRDY ; CONTROLREADY, INEN27 = RCSIDE ; INTERRUPT: BOOLEAN; ADDB27 = RCSMEX ; ADDRBITS: 0..3; FUNC27 = RCSFUN ; FUNC: FUNCTYPE; GO27 = E(IOARG); JMP $RVM0 ; ; END; ; END "OF INITIO"; ; ; ; PROCEDURE INTERRUPT; ; ;RESULT IS R0 ; VAR RESULT: IORESULT; ; INTE27: ; BEGIN MOV USER27,R0 ; IF USER <> NIL THEN RCSGO ; GO: BOOLEAN; ; END; ; ; TYPE DISKADDRESS = ; PACKED RECORD DRIV27 = RDADRS ; DRIVE: UNITTYPE; CYLI27 = RDACYL ; CYLINDER: 0..199; SURF27 = RDASUR ; SURFACE: 0..1; SECT27 = RDASC ; SECTOR: 0..11; ; END; BNE 1$ ; RTS PC ; ; WITH COMMANDREG, ERRORREG DO 1$: ; BEGIN MOV R0,P12 ; READY.ENTER(USER); JSR PC,ENTE12 ; CLR R0 ; BIT #HARD27,COMM27 ; IF NOT HARDERROR THEN BNE 2$ ; TST COMM27 ; IF ERROR THEN BMI 3$ ; FTBL27: ; VAR FUNCTABLE: ARRAY $ = INEN27 + GO27 ; (.IOOPERATION.) OF FUNCTYPE; .WORD FUNC27 * READ27 + $ ; .WORD FUNC27 * WRIT27 + $ ; USER27: .WORD NIL ; USER: PROCESSREF; ADDR27: .BLKB .ADDRESS ; ADDR: @IORESULT; CONN27: .BLKB .BOOLEAN ; VAR ENTRY ; CONNECTED: BOOLEAN; ; "HARDWARE" ERRR ; RESULT := TRANSMISSION BR 4$ ; ELSE RESULT := COMPLETE 2$: ; ELSE "HARDERROR" $ = OVER27 ; IF OVERRUN OR $ = $ + PROG27 ; PROGRAMERROR OR $ = $ + NONE27 ; NONEXISTENTMEMORY OR $ = $ + NXDI27 ; NONEXISTENTDISK OR $ = $ + NXCY27 ; NONEXISTENTCYLINDER OR 27 = RKER ; ERRORREG: ; PACKED RECORD DRVE27 = RERDRE ; DRIVEERROR, OVER27 = REROVR ; OVERRUN, WRVI27 = RERWLO ; WRITEVIOLATION, SKER27 = RERSKE ; SEEKERROR, PROG27 = RERPGE ; PROGRAMERROR, NONE27 = RERNXM ; NONEXISTENTMEMORY, DATA27 = RERDLT ; DATALATE, TI $ = $ + NXSE27 ; NONEXISTENTSECTOR THEN BIT #$,ERRR27 ; BNE 5$ ; RESULT := FAILURE ELSE $ = DRVE27 ; IF DRIVEERROR OR $ = $ + WRVI27 ; WRITEVIOLATION THEN BIT #$,ERRR27 ; RESULT := INTERVENTION BNE 6$ ; ELSE ; IF SEEKER ; END "OF INTERRUPT"; ; ; ; PROCEDURE INITIALIZE; ; ; VAR I: UNITTYPE; ; INIZ25: ; BEGIN ; ALL OF THE INITIALIZATIONS SHOWN ; USER := NIL; ; HERE HAVE BEEN PERFORMED BY PRE- ; FOR I := 0 TO 7 DO ; CEDING CONSTANT DECLARATIONS AT ; MI27 = RERTE ; TIMINGERROR, NXDI27 = RERNXD ; NONEXISTENTDISK, NXCY27 = RERNXC ; NONEXISTENTCYLINDER, NXSE27 = RERNXS ; NONEXISTENTSECTOR, CHEC27 = RERCSE ; CHECKSUMERROR, WRCE27 = RERWCE ; WRITECHECKERROR: BOOLEAN; ; END; COMM27 = RKCS ; COMMANDREG: DISKCOMMAND; COUN27 = RKWC WITH UNITS(.I.) DO ; THE LABELS: ; BEGIN ; ; ERROR := FALSE; ; USER25, ; DENSITY := NT800; ; UNIS25, ; POWERCLEAR := FALSE; ; FTBL25, AND ; EVENPARITY := FALSE; ; MTBL25. ; UNIT := 2; ; ; READY := FALSE; ; ; INTERRUPT := TRUE; ; ; COUNTREG: INTEGER; ADRG27 = RKBA ; ADDRREG: ADDRESS; SRRG27 = RKDA ; SEARCHREG: DISKADDRESS; ; ; BUF27: .BLKB .ADDRESS ; PROCEDURE INITIO(VAR BUF: ; @BUFFERTYPE; COM27: .BLKB .ADDRESS ; VAR COM: @IOPARAM; UNIN27: .BLKB .INTEGER ; UNITNUMBER ; ADDRBITS := 0; ; ; FUNC := OFFLINE; ; ; GO := TRUE; ; ; END; ; ; FUNCTABLE(.INPUT.) := READ; ; ; FUNCTABLE(.OUTPUT.) := WRITE; ; ; MOVETABLE(.OUTEOF.) := WRITEEOF; ; ; MOVETABLE(.REWIND.) := ; ; : ; UNITTYPE); ; ;OPER IS R1 ; VAR OPER: IOOPERATION; IOAR27: .BLKB .INTEGER ; IOARG: UNIV INTEGER; ;BLOCK IS R0, R1 ; BLOCK: 0..4799; ;DISKADDR IS R0 ; DISKADDR: DISKADDRESS; DISK27: .BLKB .INTEGER ; DISKFUNC: DISKCOMMAND; PREF27: .BLKB .INTEGER ; PREFIX: 0..3; ; I REWINDTAPE; ; ; MOVETABLE(.UPSPACE.) := ; ; FORWARDSPACE; ; ; MOVETABLE(.BACKSPACE.) := ; ; BACKWARDSPACE; ; ; MOVETABLE(.UNLOAD.) := OFFLINE; RTS PC ; END "OF INITIALIZE"; ; ; INIT25:NIO27: ; BEGIN MOV COM27,R0 ; OPER := COM@.OPERATION; MFPD (R0)+ ; MOV (SP)+,R1 ; MOV R0,ADDR27 ; ADDR := @COM@.STATUS; ADD #2,R0 ; IOARG := COM@.MODIFIER; MFPD (R0) ; MOV (SP)+,IOAR27 ; ; WITH DISKADDR, DISKFUNC DO ASL R1 ; CASE OPER OF JMP 1$ ; BEGIN MOV #STAT25,DEVR39 ; CONNECTED := DEVICEPRESENT( JSR PC,DEVI39 ; STATUSREG); MOV DEV39R,CONN25 ; BEQ 1$ ; IF CONNECTED THEN JSR PC,INIZ25 ; INITIALIZE; 1$: RTS PC ; END "OF TM11TAPE"; ; ; .SBTTL DISK (RK11) I/O DRIVER (R1) ; 1$: BR 2$ ; BR 3$ ; BR 4$ ; BR 5$ ; 2$: 3$: ; INPUT, OUTPUT: ; BEGIN MOV FTBL27(R1),DISK27 ; DISKFUNC := ; FUNCTABLE(.OPER.); MOV BUF27,VTLA10 ; VIRTUAL.REALADDRESS(BUF, MOV #PREF27,PREF10 ; ;"################################### ; # RK11DISK # ;###################################" ; ; ; VAR RK11DISK: ; CLASS ; IOCO27 = -256. ; CONST IOCOUNT = -256; ; PREFIX, MOV #ADRG27,REST10 ; ADDRREG); JSR PC,REAL10 ; MOV PREF27,R0 ; ADDRBITS := PREFIX; ASH #4.,R0 ; ADD R0,DISK27 ; MOV #IOCO27,COUN27 ; COUNTREG := IOCOUNT; MOV IOAR27,R1 ; BLOCK := IOARG; CLR R0 ; SECTOR := BLOCK MOD 12; DIV #12.,R0 ; BLOCK ; TYPE FUNCTYPE = ( CONT27 = RCFCRE ; CONTROLRESET, WRIT27 = RCFWR ; WRITE, READ27 = RCFRD ; READ, WRCH27 = RCFWRC ; WRITECHECK, SEEK27 = RCFSK ; SEEK, RDCH27 = RCFRDC ; READCHECK, DRVR27 = RCFDRE ; DRIVERESET, WRLK27 = RCFWRL := BLOCK DIV 12; ; SURFACE := BLOCK MOD 2; MOV UNIN27,R2 ; DRIVE := UNITNUMBER; SWAB R2 ; BIS R2,R0 ; ASH #4,R0 ; CYLINDER := BLOCK DIV 2; BIS R1,R0 ; MOV R0,SRRG27 ; SEARCHREG := DISKADDR BIS UNITNO,SRRG27 ;<01> + UNIT; MOV DISK27,COMM27 ; COMMANDREG := DISKFUNC; J ; WRITELOCK ; ); ; $ = 0 ; TYPE DISKCONTROL = ( LOAD27 = $ ; LOAD ; ); ; ; TYPE DISKCOMMAND = ; PACKED RECORD ERRO27 = RCSERR ; ERROR, HARD2SR PC,PREE11 ; USER := RUNNING.PREEMPTED; MOV PRE11R,USER27 ; RTS PC ; END; ; 4$: ; MOVE: CLR -(SP) ; COM@.STATUS := COMPLETE; MTPD @ADDR27 ; RTS PC ; ; 5$: ; CONTROL: MOV IOAR27,$SDA0 ; KERNEL.INITIALIZ ; INITIALIZE; 1$: RTS PC ; END "OF RK11DISK"; ; ; .SBTTL TERMINAL (LT33) I/O DRIVER ;"################################### ; # LT33TERMINAL # ;###################################" ; ; .GETMAP(USER); JSR PC,GETM10 ; MOV INCH28,-(SP) ; CHARADDR@ := INCHAR; BIS #PSPMDU,PSW ; MTPD @CHAR28 ; END; 3$: JSR PC,ENDI12 ; READY.ENDIO; ; END; ; END; 1$: RTS PC ; END; ; ; BUF28: .BLKB .ADDRESS ; VAR LT33TERMINAL: ; CLASS ; BELC28 = 7. ; CONST BELCHAR = '(:7:)'; LFCH28 = 10. ; LFCHAR = '(:10:)'; CRCH28 = 13. ; CRCHAR = '(:13:)'; ; $ = 0 ; TYPE TERMINALSTATE = ( PASS28 = $ ; PASSIVE, $ = $ + 1 ; READ28 = ; PROCEDURE INITIO(VAR BUF: ; @BUFFERTYPE; COM28: .BLKB .ADDRESS ; VAR COM: ; @IOPARAM); ; OPER28: .BLKB .INTEGER ; VAR OPER: IOOPERATION; ; INIO28: ; BEGIN MOV COM28,R0 ; OPER := COM@.OPERATION; MFPD (R0)+ $ ; READING, $ = $ + 1 ; WRIT28 = $ ; WRITING ; ); ; $ = 0 ; TYPE TERMCONTROL = ( WAIT28 = $ ; WAITFORBELL ; ); ; ; MOV (SP)+,R1 ; MOV R1,OPER28 ; CLR -(SP) ; COM@.STATUS := COMPLETE; MTPD (R0) ; ASL R1 ; CASE OPER OF JMP 1$(R1) ; 1$: BR 2$ ; BR 3$ ; BR 4$ ; BR 5$ ; 2$: 3$: ; INPUT, OUTPUT: ; TYPE STATUSTYPE = ; PACKED RECORD BUSY28 = TSRBSY ; BUSY, DONE28 = TSRRDY ; DONE, INEN28 = TSRIDE ; INTERRUPT, GO28 = TSRGO ; GO: BOOLEAN; ; END; ; ; VAR ENTRY STAT28: .WORD PASS28 ; STATE: TERMINALSTATE; BELL28: .BLKB .SIGNAL ; VAR B ; BEGIN JSR PC,PREE11 ; USER := RUNNING.PREEMPTED; MOV PRE11R,USER28 ; TST OPER28 ; IF OPER = INPUT THEN BNE 6$ ; BEGIN MOV BUF28,CHAR28 ; CHARADDR := BUF; MOV #READ28,STAT28 ; STATE := READING; RTS PC ; END ELSE 6$: MFPD @BUF28 ; WRITECHAR(BUF@); MOV (SP)+,CH28 ELL: SIGNAL; CHAR28: .BLKB .ADDRESS ; CHARADDR: @BUFFERTYPE; USER28: .BLKB .ADDRESS ; USER: PROCESSREF; OUTL28: .WORD 0 ; OUTLF: BOOLEAN; ECHO28: .WORD 0 ; ECHO: BOOLEAN; INCH28: .BLKB .CHAR ; INCHAR: CHAR; CONN28: .BLKB .BOOLEAN ; VAR ENTRY ; CONNECTED: BOOLEAN; ; "HARDWARE" ; READREGS: ; JSR PC,WRCH28 ; RTS PC ; END; 5$: ; CONTROL: MOV #BELL28,SIG26T ; BELL.AWAIT; JSR PC,AWAI26 ; 4$: ; MOVE: ; RTS PC ; END; ; END; ; ; CHR28: .BLKB .CHAR ; PROCEDURE KERNELWRITE(CHR: CHAR); ; PACKED RECORD RDST28 = RCSR ; READSTATUS: STATUSTYPE; RDBF28 = RBUF ; READBUF: CHAR; ; END; ; WRITEREGS: ; PACKED RECORD WRST28 = XCSR ; WRITESTATUS: STATUSTYPE; WRBF28 = XBUF ; WRITEBUF: CHAR; ; ; KERN28: ; BEGIN ; WITH WRITEREGS, WRITESTATUS DO ; BEGIN 1$: TSTB WRST28 ; REPEAT UNTIL DONE; BGE 1$ ; MOV #PASS28,STAT28 ; STATE := PASSIVE; MOV CHR28,WRBF28 ; WRITEBUF := CHR; 2$: TSTB WRST28 ; REPEAT UNTIL DONE; BGE 2$ ; ROR OR ; TIMINGERROR OR ; DATALATE THEN BR 3$ ; RESULT := ; TRANSMISSION; 5$: INC R0 ; IF RESULT <> COMPLETE THEN 3$: INC R0 ; BEGIN 6$: INC R0 ; FUNC := CONTROLRESET; $ = FUNC27*CONT27+GO27 ; I END; ; ; CH28: .BLKB .CHAR ; PROCEDURE WRITECHAR(CH: CHAR); ; WRCH28: ; BEGIN MOV #WRIT28,STAT28 ; STATE := WRITING; CMP #LFCH28,CH28 ; IF CH = LFCHAR THEN BNE 1$ ; BEGIN MOV #1,OUTL28 ; OUTLF := TRUE; MOV #CRCH28,WRBF28 ; WRITEBUF := CRCNTERRUPT := FALSE; MOV #$,COMM27 ; GO := TRUE; 7$: TSTB COMM27 ; REPEAT UNTIL BGE 7$ ; CONTROLREADY; ; END; 4$: MOV R0,-(SP) ; MOV USER27,P10 ; VIRTUAL.GETMAP(USER); JSR PC,GETM10 ; BIS #PSPMDU,PSW ; MTPD @ADDR27 ; ADDR@ := RESULT; CLR HAR; BR 2$ ; END ELSE 1$: MOV CH28,WRBF28 ; WRITEBUF := CH; 2$: BIS #INEN28,WRST28 ; WRITEREGS.WRITESTATUS.INTERRUPT ; := TRUE; RTS PC ; END; ; ; ; PROCEDURE READINTERRUPT; ; RINT28: ; BEGIUSER27 ; USER := NIL; JSR PC,ENDI12 ; READY.ENDIO; RTS PC ; END; ; END "OF INTERRUPT"; ; ; ; PROCEDURE INITIALIZE; ; INIZ27: ; BEGIN ; ALL OF THE INITIALIZATIONS SHOWN ; USER := NIL; ; HERE HAVE BEEN PERFORMED BY PRE- ; WITH FUNN MOV RDBF28,INCH28 ; INCHAR := READBUF; BIC #ASCII8,INCH28 ; CMP #BELC28,INCH28 ; IF INCHAR = BELCHAR THEN BNE 1$ ; MOV #BELL28,SIG26T ; BELL.SEND ELSE $$ = SEND26 ; BLTICK ; JSR PC,$$ ; BR 2$ ; 1$: CMP #READ28,STAT28 ; IF STATE = READING THEN BNE 2$ ; BECTABLE(.INPUT.) DO ; CEDING CONSTANT DECLARATIONS AT ; BEGIN ; THE LABELS: ; INTERRUPT := TRUE; ; ; FUNC := READ; ; USER27, AND ; GO := TRUE; ; FTBL27. ; INHIBITINCREMENT := FALSE; ; ; FORMAT := FALSE; ; ; STOPONSOFTERROR := FALSE; ; ; ADDRBITS := 0; ; GIN CMP #CRCH28,INCH28 ; IF INCHAR = CRCHAR THEN BNE 3$ ; INCHAR := LFCHAR; MOV #LFCH28,INCH28 ; 3$: MOV #1,ECHO28 ; ECHO := TRUE; MOV INCH28,CH28 ; WRITECHAR(INCHAR); JSR PC,WRCH28 ; END; 2$: INC RDST28 ; READREGS.READSTATUS.GO := TRUE; RTS PC ; END; ; ; END; ; ; WITH FUNCTABLE(.OUTPUT.) DO ; ; BEGIN ; ; INTERRUPT := TRUE; ; ; FUNC := WRITE; ; ; GO := TRUE; ; ; INHIBITINCREMENT := FALSE; ; ; FORMAT := FALSE; ; ; STOPONSOFTERROR := FALSE; ; ; ; PROCEDURE WRITEINTERRUPT; ; WINT28: ; BEGIN CMP #WRIT28,STAT28 ; IF STATE = WRITING THEN BNE 1$ ; BEGIN TST OUTL28 ; IF OUTLF THEN BEQ 2$ ; BEGIN CLR OUTL28 ; OUTLF := FALSE; MOV #LFCH28,WRBF28 ; WRITEBUF := LFCHAR; ; ADDRBITS := 0; ; ; END; RTS PC ; END "OF INITIALIZE"; ; ; INIT27: ; BEGIN MOV #ERRR27,DEVR39 ; CONNECTED := DEVICEPRESENT( JSR PC,DEVI39 ; ERRORREG); MOV DEV39R,CONN27 ; BEQ 1$ ; IF CONNECTED THEN JSR PC,INIZ27 BR 1$ ; END ELSE 2$: ; BEGIN MOV USER28,P12 ; READY.ENTER(USER); JSR PC,ENTE12 ; MOV #PASS28,STAT28 ; STATE := PASSIVE; TST ECHO28 ; IF ECHO THEN BEQ 3$ ; BEGIN CLR ECHO28 ; ECHO := FALSE; MOV USER28,P10 ; VIRTUAL ; # LPXXPRINTER # ;###################################" ; ; ; VAR LPXXPRINTER: ; CLASS ; ; TYPE LINE = ARRAY (.1..124.) OF ; CHAR; USER29: .WORD NIL ; 7; ; TYPE CARD = ARRAY (.1..80.) OF ; CHAR; USER30: .WORD NIL ; VAR USER: PROCESSREF; ADDR30: .BLKB .ADDRESS ; ADDR: @IORESULT; IMAG30: .BLKB .ADDRESS ; IMAGE: @CARD; ; I: INTEGER; BUFF30: .BLKB 80. ; BUFFER: ARRAY (.1..80.) OF ; CHARCODE; TRVAR USER: PROCESSREF; ADDR29: .BLKB .ADDRESS ; ADDR: @IORESULT; CONN29: .BLKB .BOOLEAN ; VAR ENTRY ; CONNECTED: BOOLEAN; ; "HARDWARE" STAT29 = LPS ; STATUSREG: ; PACKED RECORD ERRO29 = LPSERR ; ERROR, READ29 = LPSRDY ; READY, INEN29 = LPSIDE ; INTERRUPT: BOOLEANAN30 = TTBL30 + 128. ; TRANSLATE: ARRAY (.CHARCODE.) ; OF CHAR; CONN30: .BLKB .BOOLEAN ; VAR ENTRY ; CONNECTED: BOOLEAN; ; "HARDWARE" STAT30 = CDST ; STATUSREG ; PACKED RECORD ERRO30 = CDSERR ; ERROR, RDCH30 = CDSRDC ; READERCHE; ; END; BUFF29 = LPB ; BUFFER: CHAR; ; ; BUF29: .BLKB .ADDRESS ; PROCEDURE INITIO(BUF: @LINE; COM29: .BLKB .ADDRESS ; VAR COM: ; @IOPARAM); ; ;CURSOR IS R0 ; VAR CURSOR: @LINE; ;I IS R0 ; CK, ENDO30 = CDSEOF ; ENDOFFILE, OFFL30 = CDSOFL ; OFFLINE, DTER30 = CDSDER ; DATAERROR, DTLT30 = CDSDTL ; DATALATE, NONE30 = CDSNXM ; NONEXISTENTMEMORY, POWE30 = CDSPCL ; POWERCLEAR, READ30 = CDSRDY ; READY, INEN30 = CDSIDE ; INTERRUPT: BOOLEAN; ADDB30 = CDSMEX ; ADDR I: INTEGER; ; INIO29: MOV COM29,R0 ; BEGIN MFPD (R0)+ ; MOV (SP)+,R1 ; TST STAT29 ; IF STATUSREG.ERROR THEN "OFFLINE" BGE 1$ ; COM@.STATUS := INTERVENTION MOV #INTE22,R2 ; ELSE BR 2$ ; 1$: DEC R1 ; IF COM@.OPERATION <> OUTPUT BEQ 3$ BITS: 0..3; TRNS30 = CDSOLT ; TRANSITION, HOPP30 = CDSHPC ; HOPPERCHECK, DTPK30 = CDSDPK ; DATAPACKING, GO30 = CDSGO ; GO: BOOLEAN; ; END; COUN30 = CDCC ; COUNTREG: INTEGER; ADRG30 = CDBA ; ADDRREG: ADDRESS; ; ; BUF30: .BLKB .ADDRESS ; THEN CLR R2 ; COM@.STATUS := COMPLETE ELSE 2$: MOV R2,-(SP) ; MTPD (R0) ; RTS PC ; 3$: ; BEGIN MOV R0,ADDR29 ; ADDR := @COM@.STATUS; MOV BUF29,R0 ; CURSOR := BUF; ; I := 1; 4$: MFPD (R0)+ ; REPE ; PROCEDURE INITIO(VAR BUF: @CARD; COM30: .BLKB .ADDRESS ; VAR COM: ; @IOPARAM); ; INIO30: MOV COM30,R0 ; BEGIN MFPD (R0)+ ; WITH STATUSREG DO MOV (SP)+,R1 ; BEGIN BIT #OFFL30,STAT30 ; IF OFFLINE THEN BEQ 1$ ; MOV #INTE22,-(SP) ; COM@.STATUS := AT MOV (SP)+,R1 ; STATUSREG.INTERRUPT:= BIS #INEN29,STAT29 ; TRUE; MOV #8.,R2 5$: SOB R2,5$ MOVB R1,BUFF29 ; BUFFER:= CURSOR@.(.I.); MOV #8.,R2 6$: SOB R2,6$ TSTB STAT29 ; BGE 9$ ; SWAB R1 ; BIS #INEN29,STAT29 ; MOV #8.,R2 7$: SOB R2,7$ MOVB R1,BUFF29 ; INTERVENTION BR 2$ ; ELSE 1$: TST R1 ; IF COM@.OPERATION <> INPUT ; THEN BEQ 3$ ; COM@.STATUS := COMPLETE CLR -(SP) ; ELSE 2$: MTPD (R0) ; RTS PC ; BEGIN 3$: MOV R0,ADDR30 ; ADDR : I:= I + 1; MOV #8.,R2 8$: SOB R2,8$ TSTB STAT29 ; BMI 4$ ; UNTIL NOT STATUSREG.READY; 9$: JSR PC,PREE11 ; USER := RUNNING.PREEMPTED; MOV PRE11R,USER29 ; RTS PC ; END; ; END; ; ; ; PROCEDURE INTERRUPT; = @COM@.STATUS; MOV BUF30,IMAG30 ; IMAGE := BUF; MOV #BUFF30,ADRG30 ; ADDRREG := @BUFFER; MOV #IOCO30,COUN30 ; COUNTREG := IOCOUNT; $ = INEN30 ; INTERRUPT := TRUE; BIS #<$+GO30>,STAT30 ; GO := TRUE; JSR PC,PREE11 ; USER := MOV PRE11R,USER30 ; RUNNING.PREEMPTED; RTS PC ; EN ; INTE29: ; BEGIN TST USER29 ; IF USER <> NIL THEN BNE 1$ ; RTS PC ; BEGIN 1$: MOV USER29,P12 ; READY.ENTER(USER); JSR PC,ENTE12 ; MOV USER29,P10 ; VIRTUAL.GETMAP(USER); JSR PC,GETM10 ; CLR -(SP) ; TST STAT29 ; IF STATUSREGD; ; END; ; END; ; ; ; PROCEDURE INTERRUPT; ; ;RESULT IS R0 ; VAR RESULT: IORESULT; ;I IS R0 ; I: INTEGER; ; INTE30: MOV USER30,R0 ; BEGIN BNE 1$ ; IF USER <> NIL THEN CLR OUTL28 ; OUTLF := FALSE; CLR ECHO28 ; ECHO := FALSE; RTS PC ; END; ; END; ; ; ; PROCEDURE INITIALIZE; ; INIZ28: ; BEGIN MOV #BELL28,SIG26T ; BELL.INITIALIZE; JSR PC,INIT26 ; .ERROR THEN BGE 2$ ; INC (SP) ; ADDR@ := INTERVENTION ELSE 2$: BIS #PSPMDU,PSW ; MTPD @ADDR29 ; ADDR@ := COMPLETE; CLR USER29 ; USER := NIL; JSR PC,ENDI12 ; READY.ENDIO; RTS PC ; END; ; END; ; ; ; STATE := PASSIVE; ; OUTLF := FALSE; ; ECHO := FALSE; ; WITH READREGS, READSTATUS DO ; BEGIN $ = INEN28 + GO28 ; INTERRUPT := TRUE; MOV #$,RDST28 ; GO := TRUE; ; END; ; WRITEREGS.WRITESTATUS.INTERRUPT ; PROCEDURE INITIALIZE; ; INIZ29: ; BEGIN ; DONE AT LABEL "USER29". ; USER := NIL; ; ; STATUSREG.INTERRUPT := FALSE; RTS PC ; END "OF INITIALIZE"; ; ; INIT29: ; BEGIN MOV #STAT29,DEVR39 ; CONNECTED := DEVICEPRESENT( JSR PC,DEVI39 ; := FALSE; RTS PC ; END "OF INITIALIZE"; ; ; INIT28: ; BEGIN MOV #RDST28,DEVR39 ; CONNECTED := DEVICEPRESENT( JSR PC,DEVI39 ; READREGS.READSTATUS); MOV DEV39R,CONN28 ; BEQ 1$ ; IF CONNECTED THEN MOV #WRST28,DEVR39 ; CONNECTED : ; STATUSREG); MOV DEV39R,CONN29 ; BEQ 1$ ; IF CONNECTED THEN JSR PC,INIZ29 ; INITIALIZE; 1$: RTS PC ; END "OF LPXXPRINTER"; ; ; .SBTTL CARDREADER (CD11-A) I/O DRIVER ;"################################### ; # CD11ACARDRE= DEVICEPRESENT( JSR PC,DEVI39 ; WRITEREGS.WRITESTATUS); MOV DEV39R,CONN28 ; BEQ 1$ ; IF CONNECTED THEN JSR PC,INIZ28 ; INITIALIZE; 1$: RTS PC ; END "OF LT33TERMINAL"; ; ; .SBTTL LINE PRINTER (LPXX) I/O DRIVER ;"################################### ADER # ;###################################" ; ; ; VAR CD11ACARDREADER: ; CLASS ; IOCO30 = -80. ; CONST IOCOUNT = -80; SUBC30 = 26. ; SUBCHAR = '(:26:)'; ; ; TYPE CHARCODE = -128..12 ; TRANSMISSION; 7$: INC R0 ; 6$: INC R0 ; 3$: INC R0 ; 2$: MOV R0,-(SP) ; ADDR@ := RESULT; BIS #PSPMDU,PSW ; MTPD @ADDR30 ; TST R0 ; IF (RESULT = COMPLETE) OR BEQ 9$ ; CMP #TRAN22,R0 ; (RESULT = TRANSMISSION) BNE 4$ ; E(.67.) := 'L'; ; TRANSLATE(.68.) := 'M'; ; TRANSLATE(.69.) := 'N'; ; TRANSLATE(.70.) := 'O'; ; TRANSLATE(.71.) := 'P'; ; TRANSLATE(.72.) := 'Q'; .ASCII ; TRANSLATE(.73.) := SUBCHAR; ; TRANSLATE(.74.) := SUBCHAR; .ASCII /$*);^R/ ; TRANSLAT THEN 9$: MOV #40.,R0 ; FOR I := 1 TO 80 DO MOV IMAG30,R1 ; MOV #BUFF30,R2 ; 5$: MOVB (R2)+,R3 ; IMAGE@(.I.) := MOVB TRAN30(R3),R4 ; TRANSLATE(.BUFFER(.I.).); MOVB (R2)+,R3 ; MOVB TRAN30(R3),R3 ; SWAB R3 ; BIS R4,R3 ; MOV R3,-(SP) ; MTPD (R1)+ E(.75.) := '$'; ; TRANSLATE(.76.) := '*'; ; TRANSLATE(.77.) := ')'; ; TRANSLATE(.78.) := ';'; ; TRANSLATE(.79.) := '^'; ; TRANSLATE(.80.) := 'R'; .REPT 23. ; FOR I := 81 TO 127 DO .ASCII ; TRANSLATE(.I.) := SUBCHAR; .ENDR ; .ASCII ; ; END "OF INITIALIZE"; ; ; INIT30: ; BEGIN MOV #STAT30,DEVR39 ; CONNECTED := DEVICEPRESENT( JSR PC,DEVI39 ; STATUSREG); MOV DEV39R,CONN30 ; BEQ 1$ ; IF CONNECTED THEN JSR PC,INIZ30 ; INITIALIZE; 1$: RTS PC ; WITH STATUSREG DO ; ; BEGIN BIS #POWE30,STAT30 ; POWERCLEAR := TRUE; $ = 0 ; INTERRUPT := FALSE; ; ADDRBITS := 0; $ = $ + DTPK30 ; DATAPACKING := TRUE; ; GO := FALSE; BIS #$,STAT30 ; END; RTS PC ; TTBL30: ; ; END "OF CD11ACARDREADER"; ; ; .SBTTL COMMON I/O CONTROL ;"################################### ; # IO/INTERRUPT # ;###################################" ; ; ; PROCEDURE ENTRY IO(VAR BUFFER: .ASCII /&ABCDEFGH/ ; TRANSLATE(.-128.) := '&'; ; TRANSLATE(.-127.) := 'A'; ; TRANSLATE(.-126.) := 'B'; ; TRANSLATE(.-125.) := 'C'; ; TRANSLATE(.-124.) := 'D'; ; TRANSLATE(.-123.) := 'E'; ; TRANSLATE(.-122.) := 'F'; ; TRANSLATE(.-121.) ; BUFFERTYPE; ; VAR PARAM: ; @IOPARAM; ; DEVICE: ; IODEVICE); ; UNI031 = 0 ; CONST UNIT0 = 0; UNI131 = 2 ; UNIT1 = 2; := 'G'; ; TRANSLATE(.-120.) := 'H'; .ASCII ; TRANSLATE(.-119.) := SUBCHAR; ; TRANSLATE(.-118.) := SUBCHAR; .ASCII /.<(+!I/ ; TRANSLATE(.-117.) := '.'; ; TRANSLATE(.-116.) := '<'; ; TRANSLATE(.-115.) := '('; ; TRANSLATE(.-114.) := '+'; ; TR ; ; VAR NODEVICE: BOOLEAN; ; IO31: ; BEGIN STIO11 ; RUNNING.STARTIO; ; NODEVICE := FALSE; MOV #,R0 ; MOV (R0)+,R1 ; MOV (R0)+,R2 ; MOV (R0),R0 ; CASE DEVICE OF ASL R0 ; JMP 1$(R0) ; 1$: ANSLATE(.-113.) := '!'; ; TRANSLATE(.-112.) := 'I'; .REPT 55. ; FOR I := -111 TO -1 DO .ASCII ; TRANSLATE(.I.) := SUBCHAR; .ENDR ; .ASCII ; .ASCII / 12345678/ ; TRANSLATE(.0.) := ' '; ; TRANSLATE(.1.) := '1'; ; TRANSLATE(.2.) := '2'; BR 2$ ; BR 3$ ; BR 4$ ; BR 5$ ; BR 6$ ; BR 7$ ; 2$: TST CONN28 ; TTY0: BEQ NODE31 ; WITH LT33TERMINAL DO MOV R1,BUF28 ; IF CONNECTED THEN MOV R2,COM28 ; INITIO(BUFFER, PARAM) ELSE JMP INIO28 ; NODEVICE := TRUE;; TRANSLATE(.3.) := '3'; ; TRANSLATE(.4.) := '4'; ; TRANSLATE(.5.) := '5'; ; TRANSLATE(.6.) := '6'; ; TRANSLATE(.7.) := '7'; ; TRANSLATE(.8.) := '8'; .ASCII ; TRANSLATE(.9.) := SUBCHAR; .ASCII /:#@'="9/ ; TRANSLATE(.10.) := ':'; ; TRANSLA ; 3$: TST CONN27 ; DISK0: BEQ NODE31 ; WITH RK11DISK DO MOV R1,BUF27 ; IF CONNECTED THEN MOV R2,COM27 ; INITIO(BUFFER, PARAM, UNIT0) CLR UNIN27 ; ELSE NODEVICE := TRUE; JMP INIO27 ; ; 4$: CLR UNIN25 ; TAPE90: 41$: TST CONN25 ; WITH TMTE(.11.) := '#'; ; TRANSLATE(.12.) := '@'; ; TRANSLATE(.13.) := ''''; ; TRANSLATE(.14.) := '='; ; TRANSLATE(.15.) := '"'; ; TRANSLATE(.16.) := '9'; .REPT 7 ; FOR I := 17 TO 31 DO .ASCII ; TRANSLATE(.I.) := SUBCHAR; .ENDR ; .ASCII <11TAPE DO BEQ NODE31 ; IF CONNECTED THEN MOV R1,BUF25 ; INITIO(BUFFER, PARAM, UNIT0) MOV R2,COM25 ; ELSE NODEVICE := TRUE; JMP INIO25 ; ; 5$: TST CONN29 ; PRINTER0: BEQ NODE31 ; WITH LPXXPRINTER DO MOV R1,BUF29 ; IF CONNECTED THEN MOV R2,COM29 ; INITIO(BUFFER, PASUBC30> ; .ASCII ;0/STUVWXY; ; TRANSLATE(.32.) := '0'; ; TRANSLATE(.33.) := '/'; ; TRANSLATE(.34.) := 'S'; ; TRANSLATE(.35.) := 'T'; ; TRANSLATE(.36.) := 'U'; ; TRANSLATE(.37.) := 'V'; ; TRANSLATE(.38.) := 'W'; ; TRANSLATE(.     "$&(*,. #%')+-/!>@BDF02468:<?ACEG13579;=Z\^HJLNPRTVX[]_IKMOQSUWYv`b        $`X RTS PC ; WITH STATUSREG DO 1$: MOV R0,P12 ; BEGIN JSR PC,ENTE12 ; READY.ENTER(USER); MOV USER30,P10 ; VIRTUAL.GETMAP(USER); JSR PC,GETM10 ; CLR R0 ; RESULT := COMPLETE; MOV STAT30,R1 ; IF ERROR THEN BGE 2$ ; BIT #OFFL30,R1 ; IF OFFLINE AND BEQ 8$ 39.) := 'X'; ; TRANSLATE(.40.) := 'Y'; .ASCII ; TRANSLATE(.41.) := SUBCHAR; ; TRANSLATE(.42.) := SUBCHAR; .ASCII /,%_>?Z/ ; TRANSLATE(.43.) := ','; ; TRANSLATE(.44.) := '%'; ; TRANSLATE(.45.) := '_'; ; TRANSLATE(.46.) := '>'; ; TRANSLATE(. ; BIT #HOPP30,R1 ; NOT HOPPERCHECK THEN BEQ 3$ ; RESULT := INTERVENTION ; ELSE 8$: BIT #DTLT30,R1 ; IF DATALATE THEN BNE 7$ ; RESULT := FAILURE ELSE BIT #DTER30,R1 ; IF DATAERROR THEN BNE 6$ ; RESULT := BR 2$ 47.) := '?'; ; TRANSLATE(.48.) := 'Z'; .REPT 7 ; FOR I := 49 TO 63 DO .ASCII ; TRANSLATE(.I.) := SUBCHAR; .ENDR ; .ASCII ; .ASCII /-JKLMNOPQ/ ; TRANSLATE(.64.) := '-'; ; TRANSLATE(.65.) := 'J'; ; TRANSLATE(.66.) := 'K'; ; TRANSLAT ; ; USER99: .BLKB .PROCREF ; USER = USER99 ; TABL99: .WORD CONSTA-USER,LOCALA-USER,GLOBAL-USER,PUSHCO-USER .WORD PUSHLO-USER,PUSHGL-USER,PUSHIN-USER,PUSHBY-USER .WORD PUSHRE-USER,PUSHSE-USER,FIELD -USER,INDEX -USER .WORD POINTE-USER,VARIAN-USER,RANGE -USER,COPYBY-USER .WORD COPYWO-USER,COPYRE-USER,COPYSE-USER,COPYTA-USER .WORD COPYST-USER,NEW -USER,NEWINI- ; BEGIN GLOBAL: MOV G,-(S) ; S:-2; ST(S):=G; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL PUSHCONST ;PROCEDURE PUSHCONST(VALUE); ; BEGIN PUSHCO: MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; NEXT ; END; ; ; .SBUSER,NOT -USER .WORD ANDWOR-USER,ANDSET-USER,ORWORD-USER,ORSET -USER .WORD NEGWOR-USER,NEGREA-USER,ADDWOR-USER,ADDREA-USER .WORD SUBWOR-USER,SUBREA-USER,SUBSET-USER,MULWOR-USER .WORD MULREA-USER,DIVWOR-USER,DIVREA-USER,MODWOR-USER .WORD BUILDS-USER,INSET -USER,LSWORD-USER,EQWORD-USER .WORD GRWORD-USER,NLWORD-USER,NEWORD-USER,NGWORD-USER .WORD LSREAL-USER,EQREAL-USER,GRREAL-USER,NLREAL-USER .WORD NEREAL-USER,NGREAL-USER,EQSET -TTL PUSHLOCAL ;PROCEDURE PUSHLOCAL(DISPL); ; BEGIN PUSHLO: MOV B,W ; W:=B; ADD (Q)+,W ; W:+ST(Q); Q:+2; MOV (W),-(S) ; S:-2; ST(S):=ST(W); NEXT ; END; ; ; .SBTTL PUSHGLOBAL ;PROCEDURE PUSHGLOBAL(DISPL); ; BEGIN PUSHGL: MOV G,W ; W:=G; ADD USER,NLSET -USER .WORD NESET -USER,NGSET -USER,LSSTRU-USER,EQSTRU-USER .WORD GRSTRU-USER,NLSTRU-USER,NESTRU-USER,NGSTRU-USER .WORD FUNCVA-USER,JUMP -USER,FALSEJ-USER,CASEJU-USER .WORD INITVA-USER,CALL -USER,CALLSY-USER,ENTER -USER .WORD EXIT -USER,ENPROG-USER,EXPROG-USER,BEGINC-USER .WORD ENDCLA-USER,ENTERC-USER,EXITCL-USER,BEGINM-USER .WORD ENDMON-USER,ENTERM-USER,EXITMO-USER,BEGINP-USER .WORD ENDPRO-USER,ENPROC-USER,EXPROC- (Q)+,W ; W:+ST(Q); Q:+2; MOV (W),-(S) ; S:-2; ST(S):=ST(W); NEXT ; END; ; ; .SBTTL PUSHIND ;PROCEDURE PUSHIND; ; BEGIN PUSHIN: MOV @(S),(S) ; ST(S):=ST(ST(S)); NEXT ; END; ; ; .SBTTL PUSHBYTE ;PROCEDURE PUSHBYTE;USER,POP -USER .WORD NEWLIN-USER,INCWOR-USER,DECWOR-USER,INITCL-USER .WORD INITMO-USER,INITPR-USER,PUSHLA-USER,CALLPR-USER .WORD TRUNCR-USER,ABSWOR-USER,ABSREA-USER,SUCCWO-USER .WORD PREDWO-USER,CONVWO-USER,EMPTY -USER,ATTRIB-USER .WORD REALTI-USER,DELAY -USER,CONTIN-USER,IO -USER .WORD START -USER,STOP -USER,SETHEA-USER,WAIT -USER HEAD99: .BLKB .HEADTYPE ; CONS99: .BLKB .INTEGER ; ; ; BEGIN PUSHBY: MOVB @(S),W ; W:=ST(ST(S)); MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL PUSHREAL ;PROCEDURE PUSHREAL; ; BEGIN PUSHRE: MOV (S)+,W ; W:=ST(S); S:+2; ADD #8.,W ; W:+8; MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); ; KLEN99 = . - ZERO ; ; ; .SBTTL .SBTTL ######################################################### .SBTTL .TITLE PASCAL INTERPRETER ; TOM ZEPKO ; JORGENSEN LAB 286-80 ; CALIFORNIA INSTITUTE OF TECHNOLOGY ; OCTOBER 1974 .SBTTL PROCESS HEAD ; ; HEAD = HEAD99 - USER99 ; "THESE ENTRIES IN THE PR MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); NEXT ; END; ; ; .SBTTL PUSHSET ;PROCEDURE PUSHSET; ; BEGIN PUSHSE: MOV (S)+,W ; W:=ST(S); S:+2; ADD #16.,W ; W:+16; MOV -(W),-(S) OCESS HEAD HEAPTO= HEAD99 + HEAPT1 ; ARE USED BY THE INTERPRETER." LINE = HEAD99 + LINE1 ; RESULT= HEAD99 + RESUL1 ; JOB = HEAD99 + JOB1 ; CONT = HEAD99 + CONTI1 ; OPCODE= HEAD99 + OPCOD1 ; ARG1 = HEAD99 + PARAM1 ; ARG2 = HEAD99 + PARAM1 + 2 ; ARG3 = HEAD99 + PARAM1 + 4 ; ARG4 = HEAD99 + PARAM1 + 6 ; OPLINE= HEAD99 + OPLIN1 ; CONST = CONS99 ; ; ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); MOV -(W),-(S) ; W:-2; S:-2; ST(S):=ST(W); NEXT ; END ; .SBTTL KERNEL OPERATIONS ; INITG1= INIT18 ;INITGATE1 ENTEG1= ENTE17 ;ENTERGATE1 LEAVG1= LEAV17 ;LEAVEGATE1 ENDPR1= ENDP14 ;ENDPROCESS1 INITP1= INIT13 ;INITPROCESS1 REALT1= REALT7 ;REALTIME1 DELAY1= DELA17 ;DELAYGATE1 CONTG1= CONT17 ;CONTGATE1 STOPJ1= STOP15 ;STOPJOB1 WAIT1 = WAIT7 ;WAIT1 SY; ; ; .SBTTL FIELD ;PROCEDURE FIELD(DISPL); ; BEGIN FIELD: ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL INDEX ;PROCEDURE INDEX(MIN,MAX-MIN,LENGTH); ; BEGIN INDEX: MOV (S)+,X ; X:=ST(S); S:+2; SUB STE1= SYST11 ;SYSTEMERROR1 IO1 = IO31 ;INPUT_OUTPUT ; ; .SBTTL NEXT INSTRUCTION MACRO .MACRO NEXT .IF NE $.DBIT JSR PC,ITRACE .ENDC MOV @(Q)+,P .ENDM NEXT ; ; .SBTTL KERNEL CALL MACRO .MACRO KNCALL MOV (B),OPLINE IOT .ENDM KNCALL (Q)+,X ; X:-ST(Q); Q:+2; BGE 1$ ; IF LESS THEN JMP RANGER ; GOTO RANGEERROR; 1$: CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; BLE 2$ ; IF GREATER THEN JMP RANGER ; GOTO RANGEERROR 2$: MUL (Q)+,X ; X:*ST(Q); Q:+2; ADD X,(S) ; ST(S):+X; NEXT ; END; ; ; ; .SBTTL INTERPRETER TRACE MACRO .MACRO INTRCE .IF NE $.DBIT MOV HEAD99+INDEX1,R0 DEC R0 ASL R0 MOV S,ENDSTK-USER99(R0) BR ITRACX ENDSTK: .REPT PROCS .WORD 0 .ENDR ITRACE: MOV (Q),ARG1 MOV Q,ARG2 SUB #2.,ARG2 MOV S,ARG3 ADD #2.,ARG3 MOV HEAD99+INDEX1,R1 DEC R1 ; .SBTTL POINTER ;PROCEDURE POINTER; ; BEGIN POINTE: TST (S) ; TEST ST(S); BNE 1$ ; IF ZERO THEN JMP POINER ; GOTO POINTERERROR; 1$: NEXT ; END; ; ; .SBTTL VARIANT ;PROCEDURE VARIANT(DISPL,TAGSET) ; BEGIN VARIAN: MOV #1,W ; W: ASL R1 MOV ENDSTK-USER99(R1),ARG4 TRAP RTS PC ITRACX: .ENDC .ENDM INTRCE ; ; .SBTTL START ADDRESS ; STARTA: INTRCE ;STARTADDR: P:=ST(Q); Q:+2; NEXT ; ; ; .SBTTL REAL OVERFLOW ; REALOV: JMP OVERFL ;REALOVERFLOW: GOTO OVERFLOWERROR; =1; MOV (S),X ; X:=ST(S); "X=RECORD ADDR" ADD (Q)+,X ; X:+ST(Q); Q:+2; "X=TAG ADDR" ASH (X),W ; W: SHIFT ST(X); "W=1 SHIFT TAGVALUE" BIT W,(Q)+ ; ST(Q) TESTBIT W; Q:+2; BNE 1$ ; IF BITZERO THEN JMP VARIER ; GOTO VARIANTERROR; 1$: NEXT ; END; ; ; ; ; .SBTTL CONSTADDR ;PROCEDURE CONSTADDR(DISPL); ; BEGIN CONSTA: TST JOB ; TEST ST(JOB); BNE 1$ ; IF ZERO MOV CONST,-(S) ; THEN S:-2; ST(S):=ST(CONSTADDR) "SYSTEM" BR 2$ ; 1$: MOV 10.(G),-(S) ; ELSE S:-2; ST(S):=ST(G+10); "JOB" 2$: ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; .SBTTL RANGE ;PROCEDURE RANGE(MIN,MAX); ; BEGIN RANGE: CMP (S),(Q)+ ; ST(S) COMPARE ST(Q); Q:+2; BGE 1$ ; IF LESS THEN JMP RANGER ; GOTO RANGEERROR; 1$: CMP (S),(Q)+ ; ST(S) COMPARE ST(Q); Q:+2; BLE 2$ ; IF GREATER THEN JMP RANGER ; GOTO RANGEERROR; 2$: NEXT ; END; .SBTTL KERNEL/INTERPRETER INTERFACE .DSABL AMA ;<01> THE FOLLOWING CODE MUST BE ;<01> RELOCATABLE ; ; INTL99: .WORD ; CONST INTERPRETERLENGTH = ...; ; ; $1 = . - ZERO ; "ENSURE BLOCK ALIGNMENT" $2 = <$1 + 63.> / 64. ; $2 = <$2 * 64.> - $1 ; .BLKB $2 ; NEXT ; END; ; ; .SBTTL LOCALADDR ;PROCEDURE LOCALADDR(DISPL); ; BEGIN LOCALA: MOV B,-(S) ; S:-2; ST(S):=B; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL GLOBALADDR ;PROCEDURE GLOBALADDR(DISPL); :=NOT ST(S); BIC (S)+,14.(S) ; ST(S+16):ANDNOT ST(S); S:+2; SOB W,1$ ; END; NEXT ; END; ; ; .SBTTL ORWORD ;PROCEDURE ORWORD; ; BEGIN ORWORD: BIS (S)+,(S) ; ST(S+2):OR ST(S); S:+2; NEXT ; END; ; ; .SBTTL CEDURE BUILDSET; ; BEGIN BUILDS: MOV (S)+,W ; W:=ST(S); S:+2; BLT 1$ ; IF W<0 THEN GOTO RANGEERROR; CMP W,#127. ; W COMPARE 127; BLE 2$ ; IF GREATER THEN 1$: JMP RANGER ; GOTO RANGEERROR; 2$: MOV W,X ; X:=W; "X=MEMBER" BIC #177770,W ; W:MOD 8; "W=MEMBER MOD 8" ASH #- ; ; .SBTTL COPYBYTE ;PROCEDURE COPYBYTE; ; BEGIN COPYBY: MOVB (S)+,@(S)+ ; ST(ST(S+2)):=ST(S); S:+4; NEXT ; END; ; ; .SBTTL COPYWORD ;PROCEDURE COPYWORD; ; BEGIN COPYWO: MOV (S)+,@(S)+ ; ST(ST(S+2)):=ST(S); S:+4; NEXT ; END; ORSET ;PROCEDURE ORSET; ; BEGIN ORSET: MOV #8.,W ; W:=8; 1$: BIS (S)+,14.(S) ; ITERATE W TIMES SOB W,1$ ; ST(S+16):OR ST(S); S:+2; NEXT ; END; ; ; .SBTTL NEGWORD ;PROCEDURE NEGWORD; ; BEGIN NEGWOR: NEG (S) ; ST(S):=-ST(S) BVC 1$ ; ; .SBTTL COPYREAL ;PROCEDURE COPYREAL; ; BEGIN COPYRE: MOV 8.(S),W ; W:=ST(S+8); MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; TST (S)+ ; TEST ST(S); S:+ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: NEXT ; END; ; ; .SBTTL NEGREAL ;PROCEDURE NEGREAL; ; BEGIN NEGREA: ADD #100000,(SP) ; ST(S):=-ST(S); ;<01> NEXT ; END; ; ; .SBTTL ADDWORD ;PROCEDURE ADDWORD; 2; NEXT ; END; ; ; .SBTTL COPYSET ;PROCEDURE COPYSET; ; BEGIN COPYSE: MOV 16.(S),W ; W:=ST(S+16); MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; ; BEGIN ADDWOR: ADD (S)+,(S) ; ST(S+2):+ST(S); S:+2; BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: NEXT ; END; ; ; .SBTTL ADDREAL ;PROCEDURE ADDREAL; ; BEGIN ADDREA: .IF DF,F$PU ;<01> IF FPU, USE IT LDD (S)+,W ; W:=ST(S); S:+8; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; MOV (S)+,(W)+ ; ST(W):=ST(S); W:+2; S:+2; TST (S)+ ; TEST ST(S); S:+2; NEXT ; END; ; ; .SBTTL COPYTAG ;PROCEDURE COPYTAG(LENGTH DIV 2); ; BE ADDD (S),W ; W:+ST(S); STD W,(S) ; ST(S):=W; .IFF ;<01> IF NOT, USE SOFTWARE ROUTINES JSR PC,$ADD ;<01> .ENDC ;<01> F$PU NEXT ; END; ; ; .SBTTL SUBWORD ;PROCEDURE SUBWORD; ; BEGIN SUBWOR: SUB (S)+,(S) ; ST(S+2):-ST(S): S:+2; BVC 1$ ; IF OVERFLOW THEN JMPGIN "LENGTH>0" COPYTA: MOV (S)+,@(S) ; ST(ST(S+2)):=ST(S); S:+2; MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S) S:+2; "X=TAG ADDR" TST (X)+ ; TEST ST(X); X:+2; 1$: CLR (X)+ ; ITERATE W TIMES SOB W,1$ ; CLEAR ST(X); X:+2; NEXT ; END; ; OVERFL ; GOTO OVERFLOWERROR; 1$: NEXT ; END; ; ; .SBTTL SUBREAL ;PROCEDURE SUBREAL; ; BEGIN SUBREA: .IF DF,F$PU ;<01> GOT FPU? LDD (S)+,W ; W:=ST(S); S:+8; LDD (S),X ; X:=ST(S); SUBD W,X ; X:-W; STD X,(S) ; ST(S):=X; .IFF ;<01> IF NO ; .SBTTL COPYSTRUC ;PROCEDURE COPYSTRUC(LENGTH DIV 2); ; BEGIN COPYST: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S)+,Y ; Y:=ST(S); S:+2; "Y=DEST ADDR" 1$: MOV (X)+,(Y)+ ; ITERATE W TIMES SOB W,1$ ; ST(Y):=ST(X); Y:+2; X:+2; NEXT T, USE SOFTWARE JSR PC,$SBD ;<01> .ENDC ;<01> F$PU NEXT ; END; ; ; .SBTTL SUBSET ;PROCEDURE SUBSET; ; BEGIN SUBSET: MOV #8.,W ; W:=8; 1$: BIC (S)+,14.(S) ; ITERATE W TIMES SOB W,1$ ; ST(S+16):ANDNOT ST(S); S:+2; NEXT ; END; ; ; END; ; ; .SBTTL NEW ;PROCEDURE NEW(STACKLENGTH+LENGTH,LENGTH); ; BEGIN NEW: MOV B,X ; X:=B; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; BHIS 1$ ; IF LESS THEN JMP HEAPLI ; GOTO HEAPLIMIT; 1$: MOV HEAPTO,@(S)+ ; ST(S ; .SBTTL MULWORD ;PROCEDURE MULWORD; ; BEGIN MULWOR: MOV (S)+,X ; X:=ST(S); S:+2; CLC ; CARRY:=FALSE; MUL (S),X ; X:*ST(S); BCC 1$ ; IF CARRY THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: MOV X,(S) ; ST(S):=X; NEXT ; END; ; T(S)):=ST(HEAPTOP); S:+2; ADD (Q)+,HEAPTO ; ST(HEAPTOP):+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL NEWINIT ;PROCEDURE NEWINIT(STACKLENGTH+LENGTH,LENGTH); ; BEGIN "LENGTH>0" NEWINI: MOV B,X ; B:=X SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; ; .SBTTL MULREAL ;PROCEDURE MULREAL; ; BEGIN MULREA: .IF DF,F$PU ;<01> FPU PRESENT? LDD (S)+,W ; W:=ST(S); S:+8; MULD (S),W ; W:*ST(S); STD W,(S) ; ST(S):=W; .IFF ;<01> IF NOT, USE SOFTWARE JSR PC,$MLD ;<01> .ENDC ;<01> F$PU NEXT ; END; ; ; .SBTTL DIVWORD BHIS 1$ ; IF LESS THEN JMP HEAPLI ; GOTO HEAPLIMIT; 1$: MOV HEAPTO,@(S)+ ; ST(ST(S)):=ST(HEAPTOP); S:+2; MOV (Q)+,W ; W:=ST(Q); Q:+2; ADD W,HEAPTO ; ST(HEAPTOP):+W; ASR W ; HALVE W MOV HEAPTO,X ; X:=ST(HEAPTOP); 2$: CLR -(X) ; ITERATE W TIMES SOB W,2$ ; X:-2; CLEAR ST(X); NEXT ;PROCEDURE DIVWORD; ; BEGIN DIVWOR: MOV 2(S),X ; X:=ST(S+2); SXT W ; EXTENDSIGN W; DIV (S)+,W ; WX:/ST(S); S:+2; BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL DIVREA ; END; ; ; .SBTTL NOT ;PROCEDURE NOT; ; BEGIN NOT: NEG (S) ; ST(S):=-ST(S); INC (S) ; INCREMENT ST(S); NEXT ; END; ; ; .SBTTL ANDWORD ;PROCEDURE ANDWORD; ; BEGIN ANDWOR: MOV (S)+,W L ;PROCEDURE DIVREAL; ; BEGIN DIVREA: .IF DF,F$PU ;<01> FPU PRESENT? LDD 8.(S),W ; W:=ST(S+8); DIVD (S)+,W ; W:/ST(S); S:+8; STD W,(S) ; ST(S):=W; .IFF ;<01> NO, USE SOFTWARE JSR PC,$DVD ;<01> CALL DP DIVIDE ROUTINE .ENDC ;<01> F$PU NEXT ; END; ; ; .SBTTL MODWORD ;PROCED ; W:=ST(S); S:+2; COM W ; W:=NOT W; BIC W,(S) ; ST(S):ANDNOT W; NEXT ; END; ; ; .SBTTL ANDSET ;PROCEDURE ANDSET; ; BEGIN ANDSET: MOV #8.,W ; W:=8; ; ITERATE W TIMES ; BEGIN 1$: COM (S) ; ST(S)URE MODWORD; ; BEGIN MODWOR: MOV 2(S),X ; X:=ST(S+2); SXT W ; EXTENDSIGN W; DIV (S)+,W ; WX:/ST(S); S:+2; BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: MOV X,(S) ; ST(S):=X; NEXT ; END; ; ; .SBTTL BUILDSET ;PROONDITIONS; .IFF ;<01> IF NOT, USE SOFTWARE JSR PC,$DCMP ;<01> CALL FLT COMPARE ROUTINE .ENDC ;<01> F$PU BGE 1$ ; IF LESS THEN INC W ; INCREMENT W; 1$: MOV W,-(S) ; S:-2; ST(S):=W; NEXT ; END; ; ; .SBTTL EQREAL ;PROCEDURE EQREAL; ; BEGIN EQREAL: CLR W ; CLEAR W; NTIL (Y=0) OR NOTZERO; INC W ; IF ZERO THEN INCREMENT W; 2$: ADD #30.,S ; S:+30; MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL LSSTRUCT ;PROCEDURE LSSTRUCT(LENGTH DIV 2); ; BEGIN LSSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; "W .IF DF,F$PU ;<01> LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X ; ST(S) COMPARE X; S:+8; CFCC ; COPYCONDITIONS; .IFF ;<01> JSR PC,$DCMP ;<01> .ENDC ;<01> F$PU BNE 1$ ; IF EQUAL THEN INC W ; INCREMENT W; 1$: MOV W,-(S) ; S:-2; ST(S):=W; NEXT ; END; ; ; =LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BGE 3$ ; IF LESS THEN INC .SBTTL GRREAL ;PROCEDURE GRREAL ; BEGIN GRREAL: CLR W ; CLEAR W; .IF DF,F$PU ;<01> LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X ; ST(S) COMPARE X; S:+8; CFCC ; COPYCONDITIONS; .IFF ;<01> JSR PC,$DCMP ;<01> .ENDC ;<01> F$PU BLE 1$ ; IF GREATER THEN INC W ; INCREMENT W; 1$: MOV W,-(S) (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL EQSTRUCT ;PROCEDURE EQSTRUCT(LENGTH DIV 2); ; BEGIN EQSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (3.,X ; X:DIV 8; ADD S,X ; X:+S; "X=SET BYTE ADR" MOV #1,Y ; Y:=1; ASH W,Y ; Y:SHIFT W; "Y=SET BYTE BIT" BISB Y,(X) ; ST(X):OR Y; NEXT ; END; ; ; .SBTTL INSET ;PROCEDURE INSET; ; BEGIN INSET: MOV 16.(S),W ; S:-2; ST(S):=W; NEXT ; END; ; ; .SBTTL NLREAL ;PROCEDURE NLREAL ; BEGIN NLREAL: CLR W ; CLEAR W; .IF DF,F$PU ;<01> LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X ; ST(S) COMPARE X; S:+8; CFCC ; COPYCONDITIONS; .IFF ;<01> JSR PC,$DCMP ;<01> .ENDC ;<01> ; W:=ST(S+16); BLT 1$ ; IF W<0 THEN GOTO RANGEERROR; CMP W,#127. ; W COMPARE 127; BLE 2$ ; IF GREATER THEN 1$: JMP RANGER ; GOTO RANGEERROR; 2$: MOV W,X ; X:=W; "X=MEMBER" BIC #177770,W ; W:MOD 8; "W=MEMBER MOD 8" ASH #-3.,X ; X:DIV 8; ADD S,X ; X:+S; F$PU BLT 1$ ; IF NOTLESS THEN INC W ; INCREMENT W; 1$: MOV W,-(S) ; S:-2; ST(S):=W; NEXT ; END; ; ; .SBTTL NEREAL ;PROCEDURE NEREAL; ; BEGIN NEREAL: CLR W ; CLEAR W; .IF DF,F$PU ;<01> LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X "X=SET BYTE ADR" MOVB (X),Y ; Y:= ST(X); "Y=SET BYTE" NEG W ; W:=-W; ASH W,Y ; Y:SHIFT W; BIC #177776,Y ; Y:MOD 2; "Y=SET BIT" ADD #16.,S ; S:+16; MOV Y,(S) ; ST(S):=Y; NEXT ; END; ; ; .SBTTL LSWORD ;PROCEDURE LS ; ST(S) COMPARE X; S:+8; CFCC ; COPYCONDITIONS; .IFF ;<01> JSR PC,$DCMP ;<01> .ENDC ;<01> BEQ 1$ ; IF NOTEQUAL THEN INC W ; INCREMENT W; 1$: MOV W,-(S) ; S:-2; ST(S):=W; NEXT ; END; ; ; .SBTTL NGREAL ;PROCEDURE NGREAL ; BEGIN NGREAL: CLR WORD; ; BEGIN LSWORD: CLR W ; CLEAR W; CMP (S)+,(S) ; ST(S) COMPARE ST(S+2); S:+2; BLE 1$ ; IF GREATER THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL EQWORD ;PROCEDURE EQWORD; ; BEGIN W ; CLEAR W; .IF DF,F$PU ;<01> LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X ; ST(S) COMPARE X; S:+8; CFCC ; COPYCONDITIONS; .IFF ;<01> JSR PC,$DCMP ;<01> .ENDC ;<01> F$PU BGT 1$ ; IF NOTGREATER THEN INC W ; INCREMENT W; 1$: MOV W,-(S) ; S:-2; ST(S):=W; NEXT ; END; ; EQWORD: CLR W ; CLEAR W; CMP (S)+,(S) ; ST(S) COMPARE ST(S+2); S:+2; BNE 1$ ; IF EQUAL THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL GRWORD ;PROCEDURE GRWORD; ; BEGIN GRWORD: CLR W ; CLEAR W; ; .SBTTL EQSET ;PROCEDURE EQSET; ; BEGIN EQSET: CLR W ; CLEAR W; MOV S,X ; X:=S; MOV #8.,Y ; Y:=8; ; REPEAT 1$: CMP 16.(X),(X)+ ; ST(X+16) COMPARE ST(X); X:+2; BNE 2$ ; Y:-1; SOB Y,1$ ; UNTIL (Y=0) OR NOTEQUAL; INC W ; CMP (S)+,(S) ; ST(S) COMPARE ST(S+2); S:+2; BGE 1$ ; IF LESS THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL NLWORD ;PROCEDURE NLWORD; ; BEGIN NLWORD: CLR W ; CLEAR W; CMP (S)+,(S) ; ST(S) COMPARE ST( IF EQUAL THEN INCREMENT W; 2$: ADD #30.,S ; S:+30; MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL NLSET ;PROCEDURE NLSET; ; BEGIN NLSET: CLR W ; CLEAR W; MOV S,X ; X:=S; MOV #8.,Y ; Y:=8; ; REPEAT 1$: BIC 1S+2); S:+2; BGT 1$ ; IF NOTGREATER THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL NEWORD ;PROCEDURE NEWORD; ; BEGIN NEWORD: CLR W ; CLEAR W; CMP (S)+,(S) ; ST(S) COMPARE ST(S+2); S:+2; BEQ 1$ ;6.(X),(X)+ ; ST(X):ANDNOT ST(X+16); X:+2; BNE 2$ ; Y:-1; SOB Y,1$ ; UNTIL (Y=0) OR NOTZERO; INC W ; IF ZERO THEN INCREMENT W; 2$: ADD #30.,S ; S:+30; MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL NESET ;PROCEDURE NESET; ; BEGIN NE IF NOTEQUAL THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL NGWORD ;PROCEDURE NGWORD; ; BEGIN NGWORD: CLR W ; CLEAR W; CMP (S)+,(S) ; ST(S) COMPARE ST(S+2); S:+2; BLT 1$ ; IF NOTLESS THEN INC W SET: MOV #1,W ; W:=1; MOV S,X ; X:=S; MOV #8.,Y ; Y:=8; ; REPEAT 1$: CMP 16.(X),(X)+ ; ST(X+16) COMPARE ST(X); X:+2; BNE 2$ ; Y:-1; SOB Y,1$ ; UNTIL (Y=0) OR NOTEQUAL; CLR W ; IF EQUAL THEN CLEAR W; 2$: ADD #30.,S ; S:+30; MOV W,(S) ; ST(S):=W; NEXT ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL LSREAL ;PROCEDURE LSREAL; ; BEGIN LSREAL: CLR W ; CLEAR W; .IF DF,F$PU ;<01> FPU PRESENT? LDD (S)+,X ; X:=ST(S); S:+8; CMPD (S)+,X ; ST(S) COMPARE X; S:+8; CFCC ; COPYC ; END; ; ; .SBTTL NGSET ;PROCEDURE NGSET; ; BEGIN NGSET: CLR W ; CLEAR W; MOV S,X ; X:=S; MOV #8.,Y ; Y:=8; ; REPEAT 1$: BIC (X)+,14.(X) ; ST(X+16):ANDNOT ST(X); X:+2; BNE 2$ ; Y:-1; SOB Y,1$ ; U$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BGT 3$ ; IF NOT GREATER THEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL FUNCVALUE ;PROCEDURE FUNCVALUE(KIND); ; BEGIN FUNCVA: ADD (Q)+,P ; CASE KIND OF ; SIMPLEWORD ; BEGIN ENTER: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S: "0" ; BEGIN CLR -(S) ; S:-2; CLEAR ST(S); BR 1$ ; END; .WORD 0,0 ; "FILLER" ; SIMPLEREAL: "8" ; BEGIN SUB #8.,S ; S:-8; BR 1$ ; END; .WORD 0 ; "FILLER" ,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL EXIT ;PROCEDURE EXIT; ; BEGIN EXIT: MOV B,S ; S:=B; TST (S) ; CLASSWORD: "16" ; BEGIN MOV (S),W ; W:=ST(S); CLR (S) ; CLEAR ST(S); MOV W,-(S) ; S:-2; ST(S):=W; BR 1$ ; END; ; CLASSREAL: "24" ; BEGIN MOV (S),W ; W:=ST(S); SUB #8.,S ; + ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL ENTERPROG ;PROCEDURE ENTERPROG(POPLENGTH,LINE,STACKLENGTH, S:-8; MOV W,(S) ; ST(S):=W; 1$: NEXT ; END; ; END; ; END; ; ; .SBTTL JUMP ;PROCEDURE JUMP(DISTANCE); ; BEGIN JUMP: ADD (Q),Q ; Q:+ST(Q); NEXT ; END; ; ; VARLENGTH); ; BEGIN ENPROG: INC JOB ; INCREMENT ST(JOB); MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; ; .SBTTL FALSEJUMP ;PROCEDURE FALSEJUMP(DISTANCE); ; BEGIN FALSEJ: ADD CONT,P ; IF (ST(CONTINUE) = 0) TST JOB ; & BEQ 1$ ; (ST(JOB) <> 0) JMP EXCEPT ; THEN GOTO EXCEPTION ; ELSE ; BEGIN 1$: TST (S)+ ; TEST ST(S); S:+2; "CONTINUE=10" BNE 2$ MOV B,G ; G:=B; MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE 1 OF USER 1$: SUB (Q)+,S ; S:-ST(Q); Q:+2; PROGRAM" NEXT ; END; S) ; CLEAR ST(S); ; REPEAT 1$: CMP (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+2; X:+2; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; INC (S) ; IF EQUAL THEN INCREMENT ST(S); 2$: NEXT ; END; ; ; .SBTTL GRSTRUCT ;PROCEDURE GRSTRUCT(LENGTH DIV 2); ; IF ZERO ADD (Q),Q ; THEN Q:+ST(Q) NEXT ; 2$: TST (Q)+ ; ELSE Q:+2; ; END NEXT ; END; ; ; .SBTTL CASEJUMP ;PROCEDURE CASEJUMP(MIN,MAX-MIN,DISTANCES); ; BEGIN CASEJU: MOV (S)+,W ; W:=ST(S); S:+2; SUB (Q)+,W ; W:-ST ; BEGIN GRSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2$ (Q); Q:+2; BLT 1$ ; IF LESS THEN GOTO RANGEERROR; CMP W,(Q)+ ; W COMPARE ST(Q); Q:+2; BLE 2$ ; IF GREATER THEN 1$: JMP RANGER ; GOTO RANGEERROR; 2$: ASL W ; DOUBLE W; ADD W,Q ; Q:+W; ADD (Q),Q ; Q:+ST(Q); NEXT ; END; ; ; .SBTTL INIT ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BLE 3$ ; IF GREATER THEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL NLSTRUCT ;PROCEDURE NLSTRUCT(LENGTH DIV 2); ; BEGIN NLSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; VAR ;PROCEDURE INITVAR(LENGTH DIV 2); ; BEGIN INITVA: MOV (Q)+,W ; W:=ST(Q); Q:+2; MOV S,X ; X:=S; 1$: CLR (X)+ ; ITERATE W TIMES SOB W,1$ ; CLEAR ST(X); X:+2; NEXT ; END; ; ; .SBTTL CALL ;PROCEDURE CALL(DISTANCE); ; BEGIN CALL: MO "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BLT 3$ ; IF NOTLESS THEN V Q,W ; W:=Q; ADD (Q)+,W ; W:+ST(Q); Q:+2; MOV Q,-(S) ; S:-2; ST(S):=Q; MOV W,Q ; Q:=W; NEXT ; END; ; ; .SBTTL CALLSYS ;PROCEDURE CALLSYS((ENTRY-2)*2); ; BEGIN CALLSY: MOV 2(G),W ; W:=ST(G+2); "OLD S BEFORE PROGRAM CALL" ADD (Q)+,W ; INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL NESTRUCT ;PROCEDURE NESTRUCT(LENGTH DIV 2); ; BEGIN NESTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S) S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" W:+ST(Q); Q:+2; "W = ENTRY POINT ADDR" MOV Q,-(S) ; S:-2; ST(S):=Q; MOV (W),Q ; Q:=ST(W); NEXT ; END; .SBTTL ACTIVATION REC ;"ACTIVATION RECORD: ; ; HEAPTOP: ; S: ; ; B (OR G): MOV #1,(S) ; ST(S):=1; ; REPEAT 1$: CMP (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+2; X:+2; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; CLR (S) ; IF EQUAL THEN CLEAR ST(S); 2$: NEXT ; END; ; ; .SBTTL NGSTRUCT ;PROCEDURE NGSTRUCT(LENGTH DIV 2); ; + 2 ; + 4 ; + 6 ; + 8 ; + 10 ; () ; ; MONITOR VARIABLE: ; ; ; BEGIN NGSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2 G: ; ; ; STACKLENGTH = VARLENGTH + TEMPLENGTH + 10 ; POPLENGTH = PARAMLENGTH + 8" ; ; .SBTTL ENTER ;PROCEDURE ENTER(STACKLENGTH,POPLENGTH,LINE, ; VARLENGTH); ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ; ST(B):=ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL INCRWORD ;PROCEDURE INCRWORD; ; BEGIN INCWOR: INC @(S)+ ; INCREMENT ST(ST(S)); S:+2; NEXT ; END; ; ; .SBTTL DECRWORD ;PROCEDURE DECRWORD; ; BEGIN DECWOR: DEC ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); MOV #INITG1,OPCODE ; ST(KERNELOP):=INITGATE1; MOV G,ARG1 ; ST(KERNELARG1):=G; KNCALL ; KERNELCALL; NEXT @(S)+ ; DECREMENT ST(ST(S)); S:+2; NEXT ; END; ; ; .SBTTL INITCLASS ;PROCEDURE INITCLASS(PARAMLENGTH,DISTANCE); ; BEGIN INITCL: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=PARAMLENGTH" BEQ 2$ ; IF NONZERO THEN ; BEGIN MOV S,X ; X:=S; ADD ; END; ; ; .SBTTL ENDMON ;PROCEDURE ENDMON; ; BEGIN ENDMON: MOV #LEAVG1,OPCODE ; ST(KERNELOP):=LEAVEGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); KNCALL ; KERNELCALL; MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+ W,X ; X:+W; "X=S+PARAMLENGTH" MOV (X),X ; X:=ST(X); TST (X)+ ; TEST ST(X); X:+2; "X=CLASS ADDR+2" ASR W ; HALVE W 1$: MOV (S)+,(X)+ ; ITERATE W TIMES SOB W,1$ ; ST(X):=ST(S); X:+2; S:+2; ; END; 2$: MOV Q,W ; W:=Q; ADD (Q)+,W ; W:+ST(Q); Q:,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL ENTERMON ;PROCEDURE ENTERMON(STACKLENGTH, POPLENGTH, ; LINE, VARLENGTH); ; BEGIN ENTERM: MOV S,X +2; MOV Q,-(S) ; S:-2; ST(S):=Q; MOV W,Q ; Q:=W; NEXT ; END; ; ; .SBTTL INITMON ;PROCEDURE INITMON(PARAMLENGTH,DISTANCE); ; BEGIN INITMO= INITCL ; "SAME AS INITCLASS" ; END; ; ; .SBTTL INITPRO ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; C ;PROCEDURE INITPROC(PARAMLENGTH,VARLENGTH, ; STACKLENGTH,DISTANCE); ; BEGIN INITPR: MOV #INITP1,OPCODE ; ST(KERNELOP):=INITPROCESS1; MOV (Q)+,ARG1 ; ST(KERNELARG1):=ST(Q); Q:+2; MOV (Q)+,ARG2 ; ST(KERNELARG2):=ST(Q); Q:+2; MOV (Q)+,ARG3 ; ST(KERNELARG3):=ST(Q); Q:+2; MOV Q,ARG4 ; ST(KERNELARG4):=Q; ADD (Q) ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); MOV #ENTEG1,OPCODE ; ST(KERNELOP):=ENTERGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); KNCALL ; KERNELCALL; NEXT +,ARG4 ; ST(KERNELARG4):+ST(Q); Q:+2; KNCALL ; KERNELCALL; TST (S)+ ; TEST ST(S); S:+2; NEXT ; END; ; ; .SBTTL PUSHLABEL ;PROCEDURE PUSHLABEL(DISTANCE); ; BEGIN PUSHLA: MOV Q,-(S) ; S:-2; ST(S):=Q; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; NEXT ; END ; END; ; ; .SBTTL EXITMON ;PROCEDURE EXITMON; ; BEGIN EXITMO= ENDMON ; "SAME AS ENDMON" ; END; ; ; .SBTTL BEGINPROC ;PROCEDURE BEGINPROC(LINE); ; BEGIN BEGINP: MOV (Q)+,(B) ; ST(B):=ST(Q); Q:+2; NEXT ; ; ; .SBTTL CALLPROG ;PROCEDURE CALLPROG; ; BEGIN CALLPR: MOV Q,W ; W:=Q; "W=OLD Q" MOV (S),Q ; Q:=ST(S); "Q=CODE ADDR" TST (Q)+ ; TEST ST(Q); Q:+2; MOV (Q)+,(S) ; ST(S):=ST(Q); Q:+2; "ST(S)=CODELENG" ADD #4.,Q ; Q:+4; ; ; .SBTTL EXITPROG ;PROCEDURE EXITPROG; ; BEGIN EXPROG: TST CONT ; TEST ST(CONTINUE); BNE 1$ ; IF ZERO JMP EXCEPT ; THEN GOTO EXCEPTION 1$: JMP TERMIN ; ELSE GOTO TERMINATED; ; END; ; ; .SBTTL BEGINCLASS ;PROCEDURE ; END; ; ; .SBTTL ENDPROC ;PROCEDURE ENDPROC; ; BEGIN ENDPRO: MOV #ENDPR1,OPCODE ; ST(KERNELOP):=ENDPROCESS1; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL ENTERPROC ;PROCEDURE ENTERPROC(STACKLENGTH,POPLENGTH, BEGINCLASS(STACKLENGTH,10,LINE,0); ; BEGIN BEGINC: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S): ; LINE,VARLENGTH); ; BEGIN ENPROC: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; =B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); NEXT ; END; ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 6(G),G ; G:=ST(G+6); CLR JOB ; CLEAR ST(JOB); NEXT ; END; ; ; .SBTTL ENDCLASS ;PROCEDURE ENDCLASS; ; BEGIN ENDCLA= EXIT ; "SAME AS EXIT" ; END; ; ; .SBTTL ENTERCLASS ;PROCEDURE ENTERCLASS(STACKLENGTH,POPLENGTH, ; LINE,VARLENGTH); ; BEGIN ENTERC= BEGINC ; "SAME AS BEGI ; .SBTTL EXITPROC ;PROCEDURE EXITPROC; ; BEGIN EXPROC: MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; INC JOB ; INCLASS" ; END; ; ; .SBTTL EXITCLASS ;PROCEDURE EXITCLASS; ; BEGIN EXITCL= EXIT ; "SAME AS EXIT" ; END; ; ; .SBTTL BEGINMON ;PROCEDURE BEGINMON(STACKLENGTH,10,LINE,0); ; BEGIN BEGINM: MOV S,X NCREMENT ST(JOB); NEXT ; END; ; ; .SBTTL POP ;PROCEDURE POP(LENGTH); ; BEGIN POP: ADD (Q)+,S ; S:+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL NEWLINE ;PROCEDURE NEWLINE(NUMBER); ; BEGIN NEWLIN: MOV (Q)+,(B) DS NEXT ; END; ; ; .SBTTL SUCCWORD ;PROCEDURE SUCCWORD; ; BEGIN SUCCWO: INC (S) ; INCREMENT ST(S); NEXT ; END; ; ; .SBTTL PREDWORD ;PROCEDURE PREDWORD; ; BEGIN PREDWO: DEC (S) ; DECREMENT ST(S ; ; .SBTTL HEAPLIMIT ;HEAPLIMIT: HEAPLI: MOV #5,RESULT ; ST(RESULT):=5; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL STACKLIMIT ;STACKLIMIT: STACKL: MOV #6,RESULT ; ST(RESULT):=6; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL EXCEPTION ;EXCEPTION: EXCE); NEXT ; END; ; ; .SBTTL CONVWORD ;PROCEDURE CONVWORD; ; BEGIN CONVWO: .IF DF,F$PU ;<01> LDCID (S)+,W ; W:=CONV(ST(S)); S:+2; STD W,-(S) ; S:-8; ST(S):=W; .IFF ;<01> JSR PC,$ID ;<01> .ENDC NEXT ; END; ; ; .SBTTL EMPTYPT: MOV (B),LINE ; ST(LINE):=ST(B); TST JOB ; TEST ST(JOB); BNE 1$ ; IF ZERO THEN "INSYSTEM" ; BEGIN MOV #SYSTE1,OPCODE ; ST(KERNELOP):=SYSTEMERROR; KNCALL ; KERNELCALL; BR 2$ ; END ; ELSE "IN JOB" ; BEGIN 1$: MOV G,B ; B:=G; MOV B,S ;PROCEDURE EMPTY; ; BEGIN EMPTY: CLR W ; CLEAR W; TST (S) ; TEST ST(S); BNE 1$ ; IF ZERO THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL ATTRIBUTE ;PROCEDURE ATTRIBUTE; ; B ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; CLR JOB ; CLEAR ST(JOB); 2$: NEXT ; END; ; ; .EGIN ATTRIB: MOV (S),W ; W:=ST(S); ASL W ; DOUBLE W; MOV HEAD(W),(S) ; ST(S):=ST(W+HEAD); NEXT ; END; .SBTTL REALTIME ;PROCEDURE REALTIME; ; BEGIN REALTI: MOV #REALT1,OPCODE ; ST(KERNELOP):=REALTIME1; KNCALL ; KERNELCALL; MOV ARG1,-(S) ; S:-2; ST(S):=ST(KERNELARG1); NEXT ; END; TITLE DADD DOUBLE FLOATING ADD AND SUBTRACT .IF NDF,F$PU ;<01> .GLOBL $ADD,$SBD,OVERFL ; $ADD --- THE DOUBLE PRECISION ADD ROUT1INE ; ADD THE TOP STACK ITEM TO THE SECOND ITEM ; AND LEAVE THE SUM IN THEIR PLACE. ; $SBD --- THE DOUBLE PRECISION SUBTRACT ROUT1INE ; SUBTRACT THE TOP STACK ITEM FROM THE SECOND ITEM ; AND LEAVE THE DIFFERENCE IN PLACE OF THEM A1=6+10 B1=8.+10 C1=10.+10 D1=12.+10 A2=14.+10 B2=16.+10 C2=18.+10 D2=20.+10 SIGNS=0. ;ADD AND SUBTRACT TO STACK FROM STACK SUD$SS: $ ; ; .SBTTL DELAY ;PROCEDURE DELAY; ; BEGIN DELAY: MOV #DELAY1,OPCODE ; ST(KERNELOP):=DELAYGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBSBD: ADD #100000,2(SP) ;<01> NEGATE TOP STACK ITEM $ADD: ADD$SS: POP R0 ;<01> PUT RETURN ADDRESS IN R0 PUSH ;<01> SAVE THE REGISTERS CLR -(SP) ;CLEAR SIGNS CLR R4 ;CLEAR EXPONENTS CLR R5 ASL D1(SP) ;SHIFT OUT1 SIGN OF TOP ITEM ROL C1(SP) ROL B1(SP) ROL A1(SP) ;SHIFT A1 BISB A1+1(SP),R4 ;GET E1 BEQ A1Z ;JUMP IF $ZERO ROLB @SP ;GET S1 ASL D2(SP) ;SHIFT OUT1 SIGN OF SECOND ITEM ROL C2(SP) ROL B2(SP) ROL A2(SP) ;SHIFT A2 BISB A2+1(SP),R5 ;GET E2 BNE A2NZ ;JUMP IF TTL CONTINUE ;PROCEDURE CONTINUE; ; BEGIN CONTIN: MOV #CONTG1,OPCODE ; ST(KERNELOP):=CONTGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; KNCALL ; KERNELCALL; MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=SNOT 0 RORB @SP ;RECONSTRUCT A1 ROR A1(SP) ROR B1(SP) ROR C1(SP) ROR D1(SP) MOV A1(SP),A2(SP) ;FIRST ARG TO TOP OF STACK MOV B1(SP),B2(SP) MOV C1(SP),C2(SP) MOV D1(SP),D2(SP) A1Z: TST (SP)+ ;FLUSH SIGNS JMP OUT1 ;DONE A2NZ: ROLB SIGNS+1(SP) ;GET S2 MOVB #1,A2+1(SP) ;INSERT NORMAL BIT MOVB #1,A1+1(SP) ;INSERT NORMAL BIT SUB R4,R5 ;R5=E2-E1, R4=E1 BGT EXPA ;JUMP IF E2>E1 MOV A2(SP),R0 ;R0=A2 MOV B2(SP),R1 ;R1=B2 MOV C2(SP),R2 MOV D2(SP),R3 BR SCHK ;GO CHECK SIGNS EXPA: ADD R5,R4 ;RT(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL IO ;PROCEDURE IO; ; BEGIN IO: MOV #IO1,OPCODE ; ST(KERNELOP):=IO1; MOV (S)+,ARG3 ; ST(KERNELARG3):=ST(S); S:+2; MOV (S)+,ARG2 5=E2-E1,R4=E2,E2>E1 MOV A1(SP),R0 ;R0=A1 MOV B1(SP),R1 ;R1=B1 MOV C1(SP),R2 MOV D1(SP),R3 MOV A2(SP),A1(SP) MOV B2(SP),B1(SP) MOV C2(SP),C1(SP) MOV D2(SP),D1(SP) SWAB @SP ;EXCHANGE SIGNS NEG R5 ;E1-E2 SCHK: CMPB SIGNS+1(SP),@SP ;COMPARE SIGNS BEQ ECHK ;THEY'RE THE SAME. CHECK EXPONENT NEG R3 ;NEGATE OPERAND ADC R2 ADC R1 ADC R0 NEG R2 ADC R1 ADC R0 NEG R1 ADC R0 NEG R0 ECHK: TST R5 ;CHECK EXPONENTS BEQ SHFT1D ;JUMP IF E1=E2 SHFT1: CMP #-57.,R5 ;IS THERE ANY POINT IN SHIFTING? BL; ST(KERNELARG2):=ST(S); S:+2; MOV (S)+,ARG1 ; ST(KERNELARG1):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL START ;PROCEDURE START; ; BEGIN START: MOV #10.,CONT ; ST(CONTINUE):=10; NEXT ; END; ; ; E SHFTR ;YES MOV A1(SP),R0 ;NO, ANSWER IS OPERAND MOV B1(SP),R1 ;WITH THE LARGER EXPONENT MOV C1(SP),R2 MOV D1(SP),R3 BR NORMD1 SHFTR: CMP #-8.,R5 ;CHECK # OF BITS TO SHIFT BLE SR8 ;JUMP IF NOT MORE THAN 1/2 WORD TST R0 SXT -(SP) ;EXTEND SIGN SHFTR1: CMP #-16.,R5 BLT SR16 ;JUMP IF NOT MORE THAN A WORD TO SHIFT MOV R2,R3 ;SHIFT A WORD AT A TIME MOV R1,R2 MOV R0,R1 MOV @SP,R0 ;USE EXTENSION ADD #16.,R5 ;ADJUST EXPONENT BNE SHFTR1 ;TRY AGAIN TST (SP)+ ;POP EXTENSION BR SHFT1D ;SHIFT .SBTTL STOP ;PROCEDURE STOP; ; BEGIN STOP: MOV #STOPJ1,OPCODE ; ST(KERNELOP):=STOPJOB1; MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; MOV (S)+,ARG1 ; ST(KERNELARG1):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL SETHEAP ;PROCEDURE SETHEAP; IS ALL DONE SR16: CMP #-3,R5 ;JUMP IF NOT MORE THAN 3 TO SHIFT BLE SR8A MOV R4,@SP ;SAVE EXP AND SHIFT COUNT MOV R5,-(SP) MOV R1,R4 ;SAVE R1 ASHC R5,R0 ;SHIFT HIGH ORDER MOV R2,R5 ;SAVE R2 ASHC @SP,R4 ;SHIFT IT MOV R2,R4 MOV R5,R2 ;R2 DONE MOV R3,R5 ;SET UP LOW ORDER ASHC (SP)+,R4 ;DO LOW ORDER MOV R5,R3 MOV (SP)+,R4 ;RESTORE EXPONENT TO R4 BR SHFT1D SR8A: TST (SP)+ ;POP EXTENSION SR8: ASR R0 ;SHIFT RIGHT ROR R1 ROR R2 ROR R3 INC R5 ;COUNT LOOP BLT SR8 SHFT1D: ADD D1(SP),R3 ;F "Q=CODEADDR+8" ADD Q,(S) ; ST(S):+Q; "ST(S)=CONSTADR" MOV W,-(S) ; S:-2; ST(S):=W; "PUSH(OLD Q)" NEXT ; END; ; ; .SBTTL TRUNCREAL ;PROCEDURE TRUNCREAL; ; BEGIN TRUNCR: .IF DF,F$PU ;<01> LDD (S)+,W ; W:= ST(S); S:+8; STCDI W,-(S) ; S:-2; ST(S):=T ; BEGIN SETHEA: MOV (S)+,HEAPTO ; ST(HEAPTOP):=ST(S); S:+2; NEXT ; END; ; ; .SBTTL WAIT ;PROCEDURE WAIT; ; BEGIN WAIT: MOV #WAIT1,OPCODE ; ST(KERNELOP):=WAIT1; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL RUNC(W); BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; .IFF ;<01> JSR PC,$DI ;<01> CONVERT DOUBLE -> INTEGER .ENDC ;<01> F$PU 1$: NEXT ; END; ; ; .SBTTL ABSWORD ;PROCEDURE ABSWORD; ; BEGIN ABSWOR: TST (S) ; TEST ST(S); BGE 1$ ; IF NEGATIVE THEN TERMINATED ;TERMINATED: TERMIN: MOV #0,RESULT ; ST(RESULT):=0; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL OVERFLOWERROR ;OVERFLOWERROR: OVERFL: MOV #1,RESULT ; ST(RESULT):=1; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL POINTERERROR ;POINTERERROR: POINER: MOV #2,RESULT ; ST(RESULT):=2; ; BEGIN NEG (S) ; ST(S):=-ST(S); BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; ; END; 1$: NEXT ; END; ; ; .SBTTL ABSREAL ;PROCEDURE ABSREAL; ; BEGIN ABSREA: BIC #100000,(S) ;<01> SAVE A FEW MICRO-SECON JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL RANGEERROR ;RANGEERROR: RANGER: MOV #3,RESULT ; ST(RESULT):=3; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL VARIANTERROR ;VARIANTERROR: VARIER: MOV #4,RESULT ; ST(RESULT):=4; JMP EXCEPT ; GOTO EXCEPTION; OVER1 ;JUMP IF OVERFLOW ON ROUND BCS OVER1 MOV R4,A2+0-2(SP) ;STORE EXPONENT AND SIGN MOV R1,B2+0-2(SP) ;INSERT LOW ORDER FRACTION MOV R2,C2+0-2(SP) MOV R3,D2+0-2(SP) OUT1: POP ADD #8.,SP ;POP SECOND ARGUMENT JMP @R0 ;<01> RETURN OVER1F: TST (SP)+ ;POP SIGN OVER1: POP ;<01> UNSAVE REGISTERS ADD #8.,SP ;<01> POP 1ST OPD JMP OVERFL UTEST: TST R4 ;CHECK FOR UNDERFLOW BGT NORMD1 UNDERF: ;<01> UNDERFLOW! UNDER: CLR R0 CLR R1 ;UNDERFLOW. TREAT AS 0 cegikmoqsuwdfhjlnprty{}z|~x        $`X CLR R2 CLR R3 $ZERO: CLR @SP ;SET SIGN PLUS CLR R4 BR NFLOW ;FINISH OUT1 NORMALLY SUB: TST R0 ;CHECK HIGH ORDER RESULT FRACTION BGT BIT9 ;IF POSITIVE SIGN IS OK BEQ ZTEST ;CHECK FOR $ZERO RESULT NEG R3 ;GET ABSOLUTE VALUE ADC R2 ADC R1 ADC R0 NEG R2 ADC R1 ADC R0 NEG R1 ADC R0 SWAB @SP ;EXCHANGE SIGNS NEG R0 BEQ ZTEST ;CHECK FOR $ZERO RESULT BIT9: BIT9A: BIT R0,#400 ;CHECK NORMAL BIT BNE UTEST ;JUMP IF FOUND DEC R4 ;DECREASE EXPONENT ASL R3 ;DOUBLE FRACTION ROL R2 ROL R1 .NLIST .IF NDF,$$PASS ;ONLY ON PASS #1 .MACRO SMACIT $DIDDO=0 $L$=0 $T=0 $L=0 $LL=0 $R=-1 IIII=-1 .ENDM .MACRO ..PUSH AA1,AA2 IIII=IIII+1 .IRP TT,\IIII TYPS'TT = AA1 LBLS'TT = AA2 .ENDM .ENDM .MACRO ..POP AA1,AA2 .IIF LT IIII,.ERROR IIII ;STACK UNDERFLOW!!!!!! .IRP TT,\IIII AA1 = TYPS'TT AA2 = LBLS'TT .ENDM IIII=IIII-1 .ENDM .MACRO ..TAG TG,WH .EMITL .ENDM .MACRO ..BRAN BRA,TG,WH,SPLBRN .IF NB .IF GE .-WH'TG-126. .EMIT .IFF .EMIT .EMIT .EMIT .IRP TT,\$T .EMIT .ENDR ..PUSH 4,$T $T=$T+1 .ENDM .MACRO FOR A,BBB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z .IIF DIF ,,FOR A,BBB,C,D,EE,BY,#1,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X .IIF DI> .ENDC .IFF .EMIT .ENDC .ENDM .MACRO .EMIT VAL $E$=1 .IIF DF LST$$ .LIST MEB VAL .IIF DF LST$$ .NLIST MEB .ENDM .MACRO .EMITL VAL .IIF DF LST$$ .LIST VAL .IIF DF LST$$ .NLIST .ENDM .MACRO .EMITR S1,S2 .EMIT .IIF GT S2-1 .EMITR ,\S2-1 .ENDM .MACRO .IFOPR OPRA,RELA,TTG .EMIT OPRA .IF GT $R .IIF EQ $L$ .EMIT .IIF EQ $L$-1 .EMIT .IIF EQ $L$-2 .EMIT .IIF EQ $L$-3 .EMIT .IFF .IIF EQ $L$ .EMIT ,,.MEXIT ; .SIMPLE A,BBB,C ..TAG \$L,B .IF B ..PUSH 2,$L $LL=$L .IRP TT,\<$L> .MACRO $.$'TT D A,EE,G,TT .ENDM .ENDM .IFF $SDO=$DIDDO H I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z D A,EE,G,\$L .IIF GT $DIDDO-$SDO $DIDDO=$DIDDO-1 .ENDC $L=$L+1 .ENDM .MACRO TO A1,A2,A3,A4 $E$=0 .OPADD A1,A3 .EMIT .EMIT .EMITL .ENDM .MACRO DOWNTO A1,A2,A3,A4 $E$=0 .OPSUB A1,A3 .EMIT .EMIT .EMITL .ENDM .MACLA L'TTG> .IIF EQ $L$-1 .EMIT .IIF EQ $L$-2 .EMIT .IIF EQ $L$-3 .EMIT .ENDC ..PUSH 0,$T $I$=1 .ENDM .MACRO .IS Q1,Q2,QB,QT $I$=0 .IIF IDN , .IFOPR <>,NE,QT .IIF IDN , .IFOPR <>,EQ,QT .IIF NE $I$ .MEXIT .IIF DIF ,,.IFOPR <>,Q2,QT .IIF IDN ,,.IFOPR <<.=.>>,Q2,QT .ENDM .MACRO .GENBR A1,B1,C1,D1,E1 $I$=0 .IIF IDN .IFOPR <>,NE,E1 .IIF IDN RO REPEAT A,BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z .IF IDN THRU BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V .MEXIT .ENDC ..TAG \$L,B ..PUSH 5,$L $LL=$L $L=$L+1 .IIF B .MEXIT .IF IDN UNTILB BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z .MEXIT .ENDC .IF IDN UNTIL BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z .MEXIT .ENDC LET A,BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z .ENDM .MACRO UNTIL A,BE,C,D,EE,F,G,H,I,J,K .IFOPR <>,EQ,E1 .IIF IDN .IFOPR <>,EQ,E1 .IIF IDN <#0> .IFOPR <>,B1,E1 .IIF IDN <#0> .IFOPR <>,B1,E1 .IIF IDN .IS A1,C1,D1,E1 .IIF IDN <=> .IFOPR <>,EQ,E1 .IIF EQ $I$ .IFOPR <>,B1,E1 .ENDM .MACRO .OPADD V1,V2,V3 .IIF IDN <#1> .EMIT .IIF NE $E$ .MEXIT .IIF IDN .EMIT .IIF NE $E$ .MEXIT .EMIT .ENDM .MACRO .OPSUB V1,V2,,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB $L$=1 ..POP $T1,$T2 .IF NE $T1-5 .ERROR ; UNTIL SEEN IN OTHER THAN REPEAT BLOCK .MEXIT .ENDC IF A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB ..POP $$T,$$T ..TAG \$T2,E $L$=0 .ENDM .MACRO THRU A,BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V .NTYPE A3,A .IF NE A3&70 .ERROR ; A MUST BE A REGISTER .MEXIT .ENDC .IIF NB ,LET A,BB,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V ..TAG \$L,B ..PUSH 6,$L $LL=$L .IRP TT,\$L .MACRO $.$'TT ; .EMIT <#1> .EMIT .IIF NE $E$ .MEXIT .IIF IDN .EMIT .IIF NE $E$ .MEXIT .EMIT .ENDM .MACRO RNE LOC .EMIT .ENDM .MACRO REQ LOC .EMIT .ENDM .MACRO RLT LOC .EMIT .ENDM .MACRO RGE LOC .EMIT .ENDM .MACRO RGT LOC .EMIT .ENDM .MACRO RLE LOC .EMIT .ENDM .MACRO RPL LOC .EMIT .ENDM .MACRO RMI LOC .EMIT .ENDM .MACRO RHI LOC .EMIT .ENDM .MACRO RLOS LOC .EMIT .EMIT .EMIT .ENDM .ENDM $L=$L+1 .ENDM .MACRO END COMM ..POP $T1,$T2 .IIF EQ $T1 ..TAG \$T2,L ;-0- IF .IIF EQ $T1 .MEXIT ; $LL = $LL -1 .IIF EQ $T1-3 ..TAG \$T2,E ;-3- BEGIN/END .IIF EQ $T1-3 .MEXIT ; .IIF EQ $T1-5 ..BRAN BR,\$T2,B,1 ;-5- REPEAT .IIF EQ $T1-5 ..TAG \$T2,E .IIF EQ $T1-5 .MEXIT ; .IF EQ $T1-1 ;-1- WHILE ..BRAN BR,\$T2,B,1 ..POP $$T,$$T ..TAG \$$T,L ..TAG \$T2,E .MEXIT .ENDC ; .IF EQ $T1-2 ;-2- REPEAT/FOR .IRP TTOC> .ENDM .MACRO RHIS LOC .EMIT .ENDM .MACRO RLO LOC .EMIT .ENDM .MACRO RCS LOC .EMIT .ENDM .MACRO RCC LOC .EMIT .ENDM .MACRO RVS LOC .EMIT .ENDM .MACRO RVC LOC .EMIT .ENDM .MACRO IF A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .IIF B .MEXIT $F$=0 .IIF IDN <:=> $F$=1 .IIF IDN <:B=> $F$=1 .IF NE $F$ .IFARI A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .MEXIT .ENDC $O$=0 $I$=0 .IIF IDN .,<\$T2> $.$'TT .ENDM .MEXIT .ENDC ; .IF EQ $T1-4 ;-4- CASE $LL = $LL + 1 ..TAG \$T2,L .EMIT .EMIT .EMIT .MEXIT .ENDC ; .IF EQ $T1-6 ; -6- THRU (REPEAT THRU) .IRP TT,\$T2 $.$'TT .ENDM ..TAG \$T2,E .MEXIT .ENDC ; .ERROR ; $T STRANGE SUPER-MAC STACK VALUE .ENDM .MACRO BEGIN BNAME .IIF NB BNAME=$L ..PUSH 3,$L ..TAG \$L,B $LL = $L $L=$L+1 .ENDM .MACRO $$END .IF GE IIII .PRINT ; MISSING END END $$END .ENDC .LEAVE A,BE,C,BB,F .IIF NE $I$ .MEXIT .IIF IDN .GOTO A,BE,C,BB,F .IIF NE $I$ .MEXIT .IIF IDN .OR A,BE,C,BB .IIF IDN .OR A,BE,C,BB .IF EQ $O$ .IIF EQ $L$-1 .GENBR A,BE,C,BB,\$T2 .IIF NE $L$-1 .GENBR A,BE,C,BB,\$T .ENDC $T=$T+1 .IIF B ,.MEXIT .IIF B ,.MEXIT ; D EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .IIF LE $DIDDO .MEXIT ..POP $$T,$$T ..TAG \$$T,L $DIDDO=$DIDDO-1 .ENDM .MACRO .OR OA,OB,OC,OD $R=-$R $O$=1 $SV$=$L$ $L$=0 .IIF NE $L$-1 .GENBR ENDM .MACRO LEAVE AAAA,A,BB,C,D,EE,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V .IF B .IRP QQ,\<$LL> .EMIT
.ENDM .MEXIT .ENDC .IRP QQ,\AAAA .EMIT
.ENDM .ENDM .MACRO JUMPTO AAAA,A,B,C,D,E,F,H,G,I,J,K,L,M,N,O,P,Q,R,S,T,U,V .EMIT .ENDM .MACRO GOTO BBBB .EMIT
.ENDM .MACRO PUSH P0,P1,P2,P3,P4,P5,P6,P7,P8,P9,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q22 .IF NB P0 .EMIT PUSH P1,P2,P3,P4,P5,P6,P7,P8,P9 .ENDC .ENDM .MACRO POP P0,P1,P2,P3,P4,P5,P6,P7,P8,P9,Q0,QOA,OB,OC,OD,\$T .IIF EQ $L$-1 .GENBR OA,OB,OC,OD,\$T2 $L$=$SV$ $R=-$R .ENDM .MACRO .IFARI A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .SIMPLE A,BE,C,D,EE .IIF IDN IF RESULT,IS,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .IIF IDN .MEXIT .IIF IDN IF RESULT,IS,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .IIF IDN .MEXIT IF RESULT,IS,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .ENDM .MACRO .LEAVE LA,LB,LC,LD,LE $L$=2 .IIF B $K$=$L1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q22 .IF NB P0 .EMIT POP P1,P2,P3,P4,P5,P6,P7,P8,P9 .ENDC .ENDM .MACRO LET A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V .SIMPLE A,BE,C,D,EE .IIF B .MEXIT .IIF B .MEXIT .IIF B .MEXIT .IF LT $Y$ LET A,BE,A,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V .MEXIT .ENDC LET A,BE,A,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V .ENDM .MACRO .SIMPLE X1,X2,X3,X4,X5,X6 .IF IDN <:B=> .SIMPLE X1,:=,X3,X4,X5,B .MEXIT .ENDC $Y$=0 $Z$=0 .IIF IDN $K$=LE $R=-$R .GENBR LA,LB,LC,LD,\$K$ ..POP $$TT,$$TT $R=-$R $L$=0 .ENDM .MACRO .GOTO GA,GB,GC,GD,GEE $R=-$R $L$=3 .GENBR GA,GB,GC,GD,GEE ..POP $$TT,$$TT $R=-$R $L$=0 .ENDM .MACRO OR EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .IIF B .MEXIT .IIF IDN ..POP $T1,$T .IIF IDN ..POP $T1,$T IF'BB EE,F,G,H .IF DIF .IF DIF ..POP $$TT,$$TT ..POP $$T,$$T ..TAG \$$T,L .IIF B ..PUSH 0,$$TT .IIF B .MEXIT .IIF IDN > $Y$=7 .IIF IDN <0> $Y$=7 .IIF IDN <#0> $Y$=7 .IIF IDN $Y$=4 .IIF IDN $Y$=-1 ; .IIF IDN $Y$=-1 .IIF IDN <-> $Y$=-2 .IF DIF .IIF EQ $Y$-7 .EMIT .IIF EQ $Y$-4 .EMIT .IIF EQ $Y$ .EMIT .ENDC .IF DIF .IIF LT $Y$ .EMIT .ENDC .IIF IDN <+1> $Y$=-5 .IIF IDN <-1> $Y$=-6 .IF LT $Y$ .IIF EQ $Y$+1 .EMIT .IIF EQ $Y$+2 .EMIT .IIF EQ $ ..PUSH 0,$$TT .IIF IDN .MEXIT H I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z ..TAG \$$TT,L $DIDDO=0 .MEXIT .ENDC .ENDC H I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .ENDM .MACRO AND EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,BB .IIF B .MEXIT $$S=0 .IIF IDN ,,$$S=1 .IIF IDN ,,$$S=1 .IF GT $$S ..POP $$T,$$T IF'BB EE,F,G,H ..TAG \$$T,L H I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .IFF ..POP $T,$T IF'BB EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .ENDC .ENDM .MACRO DO ORM THE SUM ADC R2 ADC R1 ADC R0 ADD C1(SP),R2 ADC R1 ADC R0 ADD B1(SP),R1 ADC R0 ADD A1(SP),R0 CMPB SIGNS+1(SP),@SP ;CHECK FOR UNEQUAL SIGNS BNE SUB ;GO CLEAN UP SUBTRACT BIT R0,#1000 BEQ NORMD1 ;JUMP IF NO NORMAL BIT OVERFLOW ASR R0 ROR R1 ROR R2 ROR R3 INC R4 ;INCREASE EXPONENT NORMD1: SWAB R4 ;MOVE EXPONENT LEFT BNE OVER1F ;JUMP IF OVERFLOW NFLOW: BISB R0,R4 ;INSERT HIGH ORDER FRACTION ROR (SP)+ ;INSERT SIGN ROR R4 ROR R1 ROR R2 ROR R3 ADC R3 ADC R2 ADC R1 ADC R4 BVS EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .IIF B ,.MEXIT LET EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z $DIDDO=$DIDDO+1 .ENDM .MACRO THEN EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z .IIF B .MEXIT EE F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z $DIDDO=$DIDDO+1 .ENDM .MACRO ELSE ..POP $T1,$T2 .IIF NE $T1,.ERROR $T1 ;ELSE SEEN IN OTHER THAN IF BLOCK ..BRAN BR,\$T,L ..TAG \$T2,L ..PUSH $T1,$T $T=$T+1 .ENDM .MACRO WHILE A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,BB $z|~        $`XY$+5 .EMIT .IIF EQ $Y$+6 .EMIT .MEXIT .ENDC ; .IIF B .MEXIT .IIF IDN .MEXIT $E$=0 .IIF EQ $E$ .ARITH X1,X5,X6,X4 .ENDM .MACRO .ARITH Y1,Y2,Y3,Y4 .IIF IDN <+> .OPADD Y1,Y2,Y3 .IIF IDN <-> .OPSUB Y1,Y2,Y3 .IIF NE $E$ .MEXIT .IIF IDN .EMIT .IIF IDN .EMIT .IIF IDN .EMIT .IIF NE $E$ .MEXIT .IIF IDN .EMIT .IIF IDN /* * Build -- This program is used to build a new copy of the Concurrent * Pascal Kernel program and the SOLO code file onto RK0. * The Kernel program must reside in "kernel.sav" on the * System device (which had better NOT be RK0: !!), and the * SOLO Code file must be in "SOLO.COD" on the same device. * */ main() { int ifile; /* Input file descriptor*/ int ofile; /* Output file */ int block; /* block number */ extern fout; /* Printf destination */ fout = 2; /* Set u .EMIT .IIF IDN .EMIT .IIF IDN .EMIT .IIF NE $E$ .MEXIT .IIF IDN .EMITR ,Y2 .IIF IDN .EMITR ,Y2 .IIF IDN .EMITR ,Y2 .IIF IDN .EMITR ,Y2 .IIF NE $E$ .MEXIT .IIF IDN <*> .EMIT .IIF IDN .EMIT
.IIF IDN .EMIT .IIF p printf */ if ((ofile=open("rk0:")) < 0) /* Try opening rk0 */ { printf("Cannot open RK0:\n"); /* Error message */ flush(); exit(); } if ((ifile=open("sy:kernel.sav")) < 0) /* Open kernel file */ { printf("Cannot open SY:KERNEL.SAV\n"); flush(); exit(); } block=transfer(ifile,ofile,1); /* Copy kernel file */ printf("Kernel file -- %d blocks\n",block); /* print blocks */ flush(); close(ifile); /* Close input */ if ((ifile=open("sy:solo.cod")) < 0) /* Open SOLO file */ { pIDN .EMIT .IIF NE $E$ .MEXIT ; .IIF IDN .EMIT .IIF EQ $E$ .ERROR ; Y4 NOT A LEGAL OPERATOR .ENDM .MACRO ORB EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z OR EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,B .ENDM .MACRO ANDB EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z AND EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,B .ENDM .MACRO IFB A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z IF A,BE,C,D,EE,F,G,H,Irintf("Cannot open SY:SOLO.COD\n"); flush(); exit(); } block=transfer(ifile,ofile,24); /* Copy file */ printf("Solo file -- %d blocks\n",block); flush(); exit(); } /* * Transfer subroutine: * * result = transfer(input,output,i); * * where: * "input" is input file descriptor * "output" is output file descriptor * "result" is number of blocks transferred * "i" is offset on target disk * * */ transfer(input,output,i) { int buffer[256]; /* Block buffer */ int result; ,J,K,LL,M,N,O,P,Q,R,S,TE,U,V,W,X,Y,Z,B .ENDM .MACRO UNTILB A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z UNTIL A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,B .ENDM .MACRO WHILEB A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z WHILE A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,B .ENDM .MACRO ON.NOERROR A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S IF RESULT IS,CC,A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S .ENDM .MACRO ON.ERROR A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S IF RESUL /* #blocks transferred */ result = 0; /* Clear result */ while (_read(input,buffer,512,result) == 512) /* Until EOF */ { if (_write(output,buffer,512,result+i) != 512) /* Check for write err */ { printf("Output error -- block %o\n",result); flush(); } result++; /* Bump block counter */ } return(result); /* Return Blocks copied */ } T IS,CS,A,BE,C,D,EE,F,G,H,I,J,K,LL,M,N,O,P,Q,R,S .ENDM .MACRO FI COMM END .ENDM .macro $line num mov #^d'num,^o-12(%5) .endm $line .macro $chksp num .globl $chksp jsr 0,$chksp .word num .endm $chksp ; ; ; 11/34 instruction set simulators ; .macro sob r,a dec r bne a .endm sob .macro sxt d,?a,?b bmi $'a clr d br $'b $'a: mov #-1,d $'b: .endm sxt .macro $$$ c,r,rtn .globl rtn mov c,-(6) jsr 0,rtn .byte , .endm $$$ .macro ash r,s $$$ r,s,$ash .endm ash .macro ash         $`X  c r,s $$$ r,s,$ashc .endm ashc .macro xor r,d .ntype $$$.,d mov d,-(6) .if ne,$$$.-16 ;if on stack bis r,d ;set bits in d .iff bis r,2(6) .endc mov r,-(6) com (6) ;compute bic (6)+,(6) ; R & D bic (6)+,d ;clear these bits in "d" .endm xor .macro mul r,s $$$ r,s,$mul .endm mul .macro div r,s $$$ r,s,$div .endm div ; ; ; The following macros allow assembly-language calls to higher level ; language routines (C or FORTRAN). ; ; .macro call r,a,b .if nb,b mov r5,-(sp) .endc#define CATADDR 154 /* -> catalog page map */ #define FREEADR 152 /* Free page map */ #define FMAX 116 /* # files in dist. */ #define DSKSIZ 4800 /* #blocks/RK05 */ #define CATFIL 9 /* # of catalog file */ struct file /* Control for each file*/ { int nextblk; /* -> next block # */ int length; /* # blocks in file */ int blocks[255]; /* list of block #'s */ } cat, cfile; /* used for catalog & */ /* current file */ int schn; /* Channel for SOLO disk*/ int fch ...arg a .if nb,b ;calling FORTRAN routine mov #...a,-(sp) ;# of arguments mov sp,r5 ;r5 -> arguments ...a = ...a+1 ;1 more item to pop .endc .globl r jsr pc,@#r ;call subroutine .if ne,...a ;if any args at all add #<...a*2>,sp ;fix stack .endc .if nb,b mov (sp)+,r5 .endc .endm call ; ; ; The "...arg" macro puts the arguments on the stack in reverse order. ; .macro ...arg a,b,c,d,e,f,g,h,i,j,k,l ...a = 0 ;no args yet ....f = 0 ;no args encountered .irp x, ;note reverse order .n; /* Channel for filenames*/ int findex; /* RT-11 file index */ int ichn; /* Channel for RT file */ int u_block[DSKSIZ]; /* Block allocation */ /* Matrix */ main() { int ior; /* I/O result */ char rtname[20]; /* RT-11 file name */ char solonm[20]; /* Solo file name */ extern fout; /* printf output */ int ii; /* Temp */ fout = 2; /* init printf */ for (ii=0; ii < CATADDR; ii++) /* Init static blocks */ u_block[ii] = -2; /* Mark as system blocks */ for if nb,x ;arg specified? mov x,-(sp) ;yes, put on stack ...a = ...a+1 ;and bump counter ....f = 1 ;arg encountered flag .iff .if ne,....f ;if 1st arg encountered clr -(sp) ;give default arg of 0 ...a = ...a+1 ;and bump counter .endc .endc .endr .endm ...arg ; ; ; The following macro is used to simulate "C" function protocol ; for assembly-language routines. ; .macro function name arg,usr=swap .psect name,i,ro,gbl,con .globl name name: br .+10 ;follow "C" conventions .byte 40,40,40,40,40,(ii=CATADDR; ii < DSKSIZ; ii++) /* For dynamic region */ u_block[ii] = 0; /* Mark as free */ if((schn=open("SOL:")) < 0) /* Device present? */ { printf("Please assign device SOL:\n"); /* no, error */ flush(); exit(); } if((fchn=open("DK:SOLO.FIL")) < 0) /* Try to open directory */ { printf("Cant find DK:SOLO.FIL\n"); /* Error */ flush(); exit(); } findex = 2; /* Start at F2.PAS */ while(findex <= FMAX) /* For all files */ { printf(-1,rtname,"RT:F%d.PAS",findex); /* Comput40 $$$$. = . . = .-6 .ascii \name\ . = $$$$. .globl $csv,$cret jsr 5,$csv ....a. = s.arg1 .irp x, mov ....a.(r5),x ....a. = ....a. + 2 .endr .if idn
.globl $usrsw .if idn , $usrsw = 0 .iff $usrsw = 1 .endc .endc .endm function ; ; ; entry point into a function (assembly-language functions only). ; ; .macro entry name .globl name name: br .+10 .byte 40,40,40,40,40,40 $$$$. = . . = .-6 .ascii \name\ . = $$$$. jsr 5,$csv .endm entry ; ; "C" style return ; .e RT-11 name */ if((ichn=open(rtname)) < 0) /* File present? */ { printf("Cant find %s\n",rtname);/* No, error */ flush(); exit(); } ior = read(fchn,solonm,14); /* Read next file name */ if (ior != 14) /* Wrong!! */ { printf("Error in directory read\n"); /* Print message */ flush(); exit(); } solonm[12]='\0'; /* Set terminator */ findfil(solonm); /* See if in directory */ if(cfile.nextblk < 0) /* then it isn't */ { printf("File %s not in SOLO directory\n",solonm); macro return val .if nb,val mov val,r0 .endc .globl $cret jmp $cret .endm return ; ; "C" Argument offsets: ; S.ARG1 = 04 S.ARG2 = 06 S.ARG3 = 10 .ENDC $$PASS = 1 SMACIT .PAGE .LIST  flush(); exit(); } checkfile(solonm); /* See if RT-11 file */ /* Matches SOLO file */ findex++; /* Then go to next file */ if(findex == 9) /* Skip CATALOG */ findex++; close(ichn); /* Close RT-11 File */ } } /* * Findfil (name); * * This function finds a file "name" in the SOLO directory, * and sets up the cfile structure accordingly. * */ findfil(name) char name[14]; /* Solo file name */ { int i,j; /* char subscripts */ char catbuff[512]; /* Catalog buffet one */ if (i == 11) /* then match */ { block=(catbuff[j+14]&0377)|(catbuff[j+15]<<8); cfile.nextblk = 0; /* indicate found */ _read(schn,&cfile.length,512,block); chkblk(block,findex); /* Mark blk in use */ return; /* done! */ } } quit: j =+ 32; /* j --> next */ } cat.nextblk++; /* try next block */ cat.length--; /* Count down */ } /* * Failed to find file "name" in solo catalog ... * */ cfile.nextblk = -1; /* indicate failure */ return; r */ int block; /* Temp for block # */ i =_read(schn,&cat.length,512,CATADDR); /* Read catalog header */ if(i < 0) /* Error in read */ { printf("Error in cat read\n"); /* Print message */ flush(); /* */ exit(); /* */ } cat.nextblk = 0; /* Set next block pointer */ while (cat.length > 0) { _read(schn,catbuff,512,cat.blocks[cat.nextblk]); /* read next block */ j = 0; while (j < 512) { for (i=0; i < 12; i++) { if (catbuff[j+i] != name[i]) goto quit; /* get nex/* quit */ } /* * * checkfile(name) * * This function checks the solo file against the RT-11 file. * */ checkfile(name) char *name; { int buffer1[256]; /* RT-11 buffer */ int buffer2[256]; /* SOLO buffer */ int i,j,k,l; /* Temporaries */ i=0; k=0; l=0; while (cfile.length > 0) /* Check all of file */ { _read(ichn,buffer1,512,i); /* Read RT-11 file */ _read(schn,buffer2,512,cfile.blocks[cfile.nextblk]); /* read solo */ chkblk(cfile.blocks[cfile.nextblk],findex); /* Mark b        $`X            $`X     +/* * CONCURRENT PASCAL CONVERSION PROGRAM * */ extern fin; extern fout; main() { int chr; /* Uses single character mode */ fout = 2; openinput: printf ("input file: "); flush(); fopen (0,&fin); if (fin < 0) { printf("Wrong, try again\n"); goto openinput; } openoutput: printf ("output file: "); flush(); fout = creat (0); if (fout < 0) { fout = 2; printf ("Wrong, try again\n"); goto openoutput; } /* * Real meat of the program * */ chr = 1; /*********** Fake! *********/ /* * /* * Mag tape (TM-11) subroutine to perform any TM-11 function * * called by: * * mtop (cmd,buffer,count); * * where: * * 'cmd' is desired contents of MTC (command word) * 'buffer' is buffer address * 'count' is byte count for transfer operations * * */ #define MTS 0172520 /* TM-11 Status Word */ #define MTC 0172522 /* TM-11 Command Register */ #define MTBC 0172524 /* TM-11 Byte Count Register */ #define MTBA 0172526 /* TM-11 Bus Address Register */ #definelock in use */ for (j=0; j < 256; j++) /* for 256 words */ { if(buffer1[j] != buffer2[j]) /* Difference */ { k++; /* Count differences */ } } if (k != 0) { _write(schn,buffer1,512,cfile.blocks[cfile.nextblk]); printf("File %s block %o (%o) different\n",name,i, cfile.blocks[cfile.nextblk]); l =+ k; k = 0; } cfile.length--; /* Count down */ i++; /* Increment block # */ cfile.nextblk++; /* Bump block count */ } printf("File %s -- %d differences\n",name,l); flush()*/ while (chr != 0) { chr = getchar (); if (chr == 012) putchar (015); if (chr == ('Y'&077)) chr = 0; /* Force EOF on EOM char */ if (chr != 0) putchar(chr); } flush(); close (fin); close (fout); fout = 2; goto openinput; } ; return; } /* * * Chkblk (block,id); * * This function keeps track of all the blocks used on the disk * If a block appears in two or more files, an error message * will be printed. * */ chkblk(blkno,id) { if(u_block[blkno] != 0) { printf("Block %o allocated twice F%d and F%d\n", blkno,u_block[blkno],id); /* Error message */ flush(); } else u_block[blkno] = id; return; }  EOF 042000 /* EOF bit in MTS */ #define ERROR 0100000 /* Error bit in MTC */ #define RWDST 02 /* Rewind status bit in MTS */ #define DONE 0200 /* Done bit in MTC */ int recnum; /* Record number; externally set */ struct { /* TM-11 dummy variables */ int mts; int mtc; int mtbc; int mtba; } mtop (cmd,buffer,count) { register tmp; /* Temporary for "return" statement */ /* * Wait for Previous (possibly manual) operations to finish */ while (MTS -> m        $`X     +-/ts & RWDST); /* wait on rewind to finish */ while ((MTS -> mtc & DONE) == 0); /* Wait on controller ready */ /* * * Perform Mag Tape Operation ... * */ MTS -> mtbc = -count; /* Load Negative of Count */ MTS -> mtba = buffer; /* Load Buffer address */ MTS -> mtc = cmd; /* Load Command Word */ /* * * Wait on Control Unit ready * */ while ((MTS -> mtc & DONE) == 0); /* Note rewind will not cause wait */ /* * * Check for, and process, any errors which occur ... * */ if (M/* * * Totape -- This program writes a non-labeled tape which can be read * by the concurrent pascal program copy, and can thus be * used to transfer files from RT-11 format to Concurrent * Pascal disks. * */ /* * TM-11 Operation codes: */ #define MTRWD 060017 /* Rewind Command */ #define MTWRT 060005 /* Write Command */ #define MTEOF 060007 /* Write EOF Command */ #define MTBAK 060013 /* Backspace Command */ /* * * ASCII Definitions: * */ #define CR 015 /* Carriage TS -> mtc < 0) { if (MTS -> mts & EOF) { /* EOF Errors are ok, just */ return (0); } /* return 0 bytes read */ else { /* Any other errors are nfg, print a message */ printf ("Mag Tape error -- Record #%d MTS=%o\n",recnum, MTS -> mts); flush(); } } /* * Compute number of bytes transferred, and return this value ... */ tmp = MTS -> mtba; tmp =- buffer; /* amount transferred */ return (tmp); } return */ #define LF 012 /* "newline" character */ main() { register int ch; /* index into block */ register char c; /* Next char from file */ char buff[512]; /* Buffer */ extern fin,fout; /* structured buffers */ fout = 2; /* Set Printf => TTY */ mtop(MTRWD,0,0); /* Rewind tape */ nextfile: for(ch=0;ch<512;ch++) /* Init buffer */ buff[ch]=0; /* To zeros */ printf("Next file: "); /* Request next file name */ if(fopen(0,&fin) < 0) /* Get from tt: */ { printf("Ca        $`X     +-/!#%'nnot open input\n"); /* NFG */ goto nextfile; /* Try again */ } ch = 0; /* Start at buff[0] */ c = 1; /* Klutz!! */ while (c != ('Y'&077)) /* or EOF Character */ { c=getchar(); /* Fetch next character */ if (c == CR) /* Ignore cr */ c=getchar(); /* characters*/ if (c == 0) /* RT-11 EOF */ c=('Y'&077); /* Cpascal EOF */ buff[ch++] = c; /* Place in buffer */ if (ch >= 512) /* or -> End of buffer */ { mtop(MTWRT,buff,512); /* Write buf$JOB/RT11/TIME TTYIO ! ! THIS BATCH STREAM IS USED TO RECONSTRUCT ALL THE PROGRAMS INVOLVED ! WITH A SOLO SYSGEN. THESE PROGRAMS ARE: ! ! 1). THE SOLO SYSTEM KERNEL (KERNEL.MAC) ! 2). THE SOLO BUILD PROGRAM (BUILD.C) ! 3). THE RT-11 TAPE TRANSFER PROGRAM (TOTAPE.C & MTOP.C) ! 4). THE SOLO TO RT-11 FILE CONVERSION PROGRAM (CP.C) ! 5). THE SOLO DISK INTEGRITY PROGRAM (CDISK.C) ! ! USE OF THIS BATCH STREAM REQUIRES THE RT-11 ASSEMBLER, RT-11 ! C COMPILER AND LIBRARY, AND THE SOLO SOURCE FOR fer */ for (ch=0;ch<512;ch++) /* Init buffer */ buff[ch]=0; /* to 0's */ ch = 0; /* Reset pointer */ } } if (ch != 0) /* Incomplete buffer */ mtop(MTWRT,buff,512); /* Write buffer */ mtop(MTEOF,0,0); /* Write 2 */ mtop(MTEOF,0,0); /* Tape Marks */ mtop(MTBAK,0,1); /* Skip back over last */ /* Tape Mark */ goto nextfile; /* and loop back for */ /* additional files */ } THE KERNEL (WHICH ! MUST ALREADY BE IN RT-11 FORMAT). ! ! ! ASSIGN DEVICES: ! ! .ASSIGN '"SOURCE DEVICE: "''CTY' S .ASSIGN '"OBJECT DEVICE: "''CTY' O .ASSIGN '"LISTING DEVICE: "''CTY' L .ASSIGN '"SAVE FILE DEVICE: "''CTY' SAV .ASSIGN '"CREF DEVICE: "''CTY' C ! ! ASSEMBLE THE KERNEL AND BOOTSTRAP ! .R MACRO *O:KERNEL,L:KERNEL=S:KERNEL/C:S:R:M:P:E *O:RKBOOT,L:RKBOOT=S:RKBOOT/C:S:R:M:P:E *O:X,L:X=S:SUPER,X ! ! COMPILE THE UTILITIES ! .R C *O:BUILD,L:BUILD=S:BUILD .R C *O:TOTAPE,L:TOTAPE=S:TOTAPE        $`X     +-/!#%'),. .R C *O:MTOP,L:MTOP=S:MTOP .R C *O:CP,L:CP=S:CP .R C *O:CDISK,L:CDISK=S:CDISK ! ! NOTE: THE TWO "UNIMPLEMENTED STRUCTURE OPERATION" ERRORS GENERATED ! BY THE MTOP COMPILATION ARE INTENTIONAL. THE CODE GENERATED ! IS IN FACT CORRECT. ! ! ! LINK THE UTILITIES ! .R LINK *SAV:BUILD,L:BUILD=O:BUILD,X,SY:CLIB.LIB/B:4000/Z:0 *SAV:TOTAPE,L:TOTAPE=O:TOTAPE,MTOP,SY:CLIB.LIB/B:4000/Z:0 *SAV:CP,L:CP=O:CP,SY:CLIB.LIB/B:4000/Z:0 *SAV:CDISK,L:CDISK=O:CDISK,X,SY:CLIB.LIB/B:4000/Z:0 ! ! ! LINK TH$JOB/RT11/TIME TTYIO ! ! ! THIS BATCH STREAM IS USED TO RE-BUILD A SOLO DISK (ONLY THE SOLO, ! KERNEL, AND BOOT SEGMENTS) FROM THE CORRESPONDING RT-11 FILES. ! ! ! .ASSIGN '"SOLO DISK IS: "''CTY' RK0 .ASSIGN '"SAVE FILES ARE ON"''CTY' SAV ! ! COPY FILES USED BY THE BUILD PROGRAM TO SY: ! .COP SAV:(KERNEL.SAV,SOLO.COD) SY: ! ! USE NORMAL RT-11 BOOT COPY FOR BOOTSTRAP: ! .COP/BOO SAV:RKBOOT.SAV RK0: ! ! RUN THE BUILD PROGRAM TO PUT THE FILES ON RK0: ! ! .RUN SAV:BUILD ! ! DONE ! $EOJ E KERNEL AND BOOTSTRAP ! ! .R LINK *SAV:KERNEL,L:KERNEL=O:KERNEL *SAV:RKBOOT,L:RKBOOT=O:RKBOOT ! ! ! DONE, SEE BATCH STREAM "BUILD" FOR DETAILS ON SOLO DISK RECONSTRUCTION ! $EOJ MOVE(1) WRITE(AUTOLOAD) BACKUP(WRITE) MOVE(2) BACKUP(CHECK) MOVE(1) MOVE(1) WRITE(AUTOLOAD) BACKUP(WRITE) MOVE(2) BACKUP(CHECK) MOVE(1)  SCRATCH PROTECTED 255 PAGES TOTAPETEXT ASCII UNPROTECTED 4 PAGES WRITE SEQCODE PROTECTED 2 PAGES WRITEMAN ASCII PROTECTED 1 PAGES WRITETEXT ASCII PROTECTED 9 PAGES XMAC ASCII UNPROTECTED 1 PAGES 125 ENTRIES 3392 PAGES  3 PAGES TAPEMAN ASCII PROTECTED 2 PAGES TAPETEXT ASCII PROTECTED ; ; B (OR G): ; + 2 ; + 4 ; + 6 ; + 8 ; + 10 ; () ; ; MONITOR VARIABLE: (LENGTH DIV 2); ; BEGIN NGSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+ ; ; G: ; ; ; STACKLENGTH = VARLENGTH + TEMPLENGTH + 10 ; POPLENGTH = PARAMLENGTH + 8" ; ; .SBTTL ENTER ;PROCEDURE ENTER(STACKLENGTH,POPLENGTH,LINE, 1; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BGT 3$ ; IF NOT GREATER THEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL FUNCVALUE ;PROCEDURE FUNCVALUE(KIND); ; BEGIN FUNCVA: ADD (Q)+,P ; CASE KIND OF ; VARLENGTH); ; BEGIN ENTER: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; SIMPLEWORD: "0" ; BEGIN CLR -(S) ; S:-2; CLEAR ST(S); BR 1$ ; END; .WORD 0,0 ; "FILLER" ; SIMPLEREAL: "8" ; BEGIN SUB #8.,S ; S:-8; BR 1$ ; END; .WORD 0 ; "FILLER" ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL EXIT ;PROCEDURE EXIT; ; CLASSWORD: "16" ; BEGIN MOV (S),W ; W:=ST(S); CLR (S) ; CLEAR ST(S); MOV W,-(S) ; S:-2; ST(S):=W; BR 1$ ; END; ; CLASSREAL: "24" ; BEGIN MOV (S),W ; W:=ST(S); SUB #8.,S ; BEGIN EXIT: MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL ENTERPROG "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BGE 3$ ; IF LESS T ; S:-8; MOV W,(S) ; ST(S):=W; 1$: NEXT ; END; ; END; ; END; ; ; .SBTTL JUMP ;PROCEDURE JUMP(DISTANCE); ; BEGIN JUMP: ADD (Q),Q ; Q:+ST(Q); NEXT ; END; ; HEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL EQSTRUCT ;PROCEDURE EQSTRUCT(LENGTH DIV 2); ; BEGIN EQSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADD ; .SBTTL FALSEJUMP ;PROCEDURE FALSEJUMP(DISTANCE); ; BEGIN FALSEJ: ADD CONT,P ; IF (ST(CONTINUE) = 0) TST JOB ; & BEQ 1$ ; (ST(JOB) <> 0) JMP EXCEPT ; THEN GOTO EXCEPTION ; ELSE ; BEGIN 1$: TST (S)+ ; TEST ST(S); S:+2; "CONTINUE=10" BNE R" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMP (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+2; X:+2; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; INC (S) ; IF EQUAL THEN INCREMENT ST(S); 2$: NEXT ; END; ; ; .SBTTL GRSTRUCT ;PROCEDURE GRSTRUCT(LENGTH D 2$ ; IF ZERO ADD (Q),Q ; THEN Q:+ST(Q) NEXT ; 2$: TST (Q)+ ; ELSE Q:+2; ; END NEXT ; END; ; ; .SBTTL CASEJUMP ;PROCEDURE CASEJUMP(MIN,MAX-MIN,DISTANCES); ; BEGIN CASEJU: MOV (S)+,W ; W:=ST(S); S:+2; SUB (Q)+,W IV 2); ; BEGIN GRSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; DOUBLE W; "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; ; W:-ST(Q); Q:+2; BLT 1$ ; IF LESS THEN GOTO RANGEERROR; CMP W,(Q)+ ; W COMPARE ST(Q); Q:+2; BLE 2$ ; IF GREATER THEN 1$: JMP RANGER ; GOTO RANGEERROR; 2$: ASL W ; DOUBLE W; ADD W,Q ; Q:+W; ADD (Q),Q ; Q:+ST(Q); NEXT ; END; ; ; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BLE 3$ ; IF GREATER THEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL NLSTRUCT ;PROCEDURE NLSTRUCT(LENGTH DIV 2); ; BEGIN NLSTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; ASL W ; .SBTTL INITVAR ;PROCEDURE INITVAR(LENGTH DIV 2); ; BEGIN INITVA: MOV (Q)+,W ; W:=ST(Q); Q:+2; MOV S,X ; X:=S; 1$: CLR (X)+ ; ITERATE W TIMES SOB W,1$ ; CLEAR ST(X); X:+2; NEXT ; END; ; ; .SBTTL CALL ;PROCEDURE CALL(DISTANCE); ; DOUBLE W; "W=LENGTH" MOV (S)+,X ; X:=ST(S); S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); "Y=DEST ADDR" CLR (S) ; CLEAR ST(S); ; REPEAT 1$: CMPB (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+1; X:+1; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; 2$: BLT 3$ ; BEGIN CALL: MOV Q,W ; W:=Q; ADD (Q)+,W ; W:+ST(Q); Q:+2; MOV Q,-(S) ; S:-2; ST(S):=Q; MOV W,Q ; Q:=W; NEXT ; END; ; ; .SBTTL CALLSYS ;PROCEDURE CALLSYS((ENTRY-2)*2); ; BEGIN CALLSY: MOV 2(G),W ; W:=ST(G+2); "OLD S BEFORE PROGRAM CALL" ADD ( IF NOTLESS THEN INC (S) ; INCREMENT ST(S); 3$: NEXT ; END; ; ; .SBTTL NESTRUCT ;PROCEDURE NESTRUCT(LENGTH DIV 2); ; BEGIN NESTRU: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=LENGTH DIV 2" MOV (S)+,X ; X:=ST(S) S:+2; "X=SOURCE ADDR" MOV (S),Y ; Y:=ST(S); Q)+,W ; W:+ST(Q); Q:+2; "W = ENTRY POINT ADDR" MOV Q,-(S) ; S:-2; ST(S):=Q; MOV (W),Q ; Q:=ST(W); NEXT ; END; ; ; .SBTTL ACTIVATION REC ;"ACTIVATION RECORD: ; ; HEAPTOP: ; S: "Y=DEST ADDR" MOV #1,(S) ; ST(S):=1; ; REPEAT 1$: CMP (Y)+,(X)+ ; ST(Y) COMPARE ST(X); Y:+2; X:+2; BNE 2$ ; W:-1; SOB W,1$ ; UNTIL (W=0) OR NOTEQUAL; CLR (S) ; IF EQUAL THEN CLEAR ST(S); 2$: NEXT ; END; ; ; .SBTTL NGSTRUCT ;PROCEDURE NGSTRUCT NEXT ; END; ; ; .SBTTL EXITPROC ;PROCEDURE EXITPROC; ; BEGIN EXPROC: MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; ; BEGIN ENTERC= BEGINC ; "SAME AS BEGINCLASS" ; END; ; ; .SBTTL EXITCLASS ;PROCEDURE EXITCLASS; ; BEGIN EXITCL= EXIT ; "SAME AS EXIT" ; END; ; ; .SBTTL BEGINMON ;PROCEDURE BEGINMON(STACKL MOV W,S ; S:=W; INC JOB ; INCREMENT ST(JOB); NEXT ; END; ; ; .SBTTL POP ;PROCEDURE POP(LENGTH); ; BEGIN POP: ADD (Q)+,S ; S:+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL NEWLINE ;PROCEDURE NEWLENGTH,10,LINE,0); ; BEGIN BEGINM: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST INE(NUMBER); ; BEGIN NEWLIN: MOV (Q)+,(B) ; ST(B):=ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL INCRWORD ;PROCEDURE INCRWORD; ; BEGIN INCWOR: INC @(S)+ ; INCREMENT ST(ST(S)); S:+2; NEXT ; END; ; ; .SBTTL DECRWORD -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); MOV #INITG1,OPCODE ; ST(KERNELOP):=INITGATE1; MOV G,ARG1 ; ST(KERNELARG1):=G ;PROCEDURE DECRWORD; ; BEGIN DECWOR: DEC @(S)+ ; DECREMENT ST(ST(S)); S:+2; NEXT ; END; ; ; .SBTTL INITCLASS ;PROCEDURE INITCLASS(PARAMLENGTH,DISTANCE); ; BEGIN INITCL: MOV (Q)+,W ; W:=ST(Q); Q:+2; "W=PARAMLENGTH" BEQ 2$ ; IF NONZERO THEN ; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL ENDMON ;PROCEDURE ENDMON; ; BEGIN ENDMON: MOV #LEAVG1,OPCODE ; ST(KERNELOP):=LEAVEGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); KNCALL ; KERNELCALL; MOV B,S ; S:=B; TST (S)+ ; TEST ST(S ; BEGIN MOV S,X ; X:=S; ADD W,X ; X:+W; "X=S+PARAMLENGTH" MOV (X),X ; X:=ST(X); TST (X)+ ; TEST ST(X); X:+2; "X=CLASS ADDR+2" ASR W ; HALVE W 1$: MOV (S)+,(X)+ ; ITERATE W TIMES SOB W,1$ ; ST(X):=ST(S); X:+2; S:+2; ; END; 2$: MOV ); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL ENTERMON ;PROCEDURE ENTERMON(STACKLENGTH, POPLENGTH, ; L Q,W ; W:=Q; ADD (Q)+,W ; W:+ST(Q); Q:+2; MOV Q,-(S) ; S:-2; ST(S):=Q; MOV W,Q ; Q:=W; NEXT ; END; ; ; .SBTTL INITMON ;PROCEDURE INITMON(PARAMLENGTH,DISTANCE); ; BEGIN INITMO= INITCL ; "SAME AS INITCLASS" ; END; INE, VARLENGTH); ; BEGIN ENTERM: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST ; ; .SBTTL INITPROC ;PROCEDURE INITPROC(PARAMLENGTH,VARLENGTH, ; STACKLENGTH,DISTANCE); ; BEGIN INITPR: MOV #INITP1,OPCODE ; ST(KERNELOP):=INITPROCESS1; MOV (Q)+,ARG1 ; ST(KERNELARG1):=ST(Q); Q:+2; MOV (Q)+,ARG2 ; ST(KERNELARG2):=ST(Q); Q:+2; MOV (Q)+,ARG3 ; ST(KERNELARG3):=ST(Q); Q: ;PROCEDURE ENTERPROG(POPLENGTH,LINE,STACKLENGTH, ; VARLENGTH); ; BEGIN ENPROG: INC JOB ; INCREMENT ST(JOB); MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-( -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); MOV #ENTEG1,OPCODE ; ST(KERNELOP):=ENTERGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=SS) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; MOV B,G ; G:=B; MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE 1 OF USER 1$: SUB (Q)+,S ; S:-ST(Q); Q:+2;T(G); KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL EXITMON ;PROCEDURE EXITMON; ; BEGIN EXITMO= ENDMON ; "SAME AS ENDMON" ; END; ; ; .SBTTL BEGINPROC ;PROCEDURE BEGINPROC(LINE); ; PROGRAM" NEXT ; END; ; ; .SBTTL EXITPROG ;PROCEDURE EXITPROG; ; BEGIN EXPROG: TST CONT ; TEST ST(CONTINUE); BNE 1$ ; IF ZERO JMP EXCEPT ; THEN GOTO EXCEPTION 1$: JMP TERMIN ; ELSE GOTO TERMINATED; ; END; BEGIN BEGINP: MOV (Q)+,(B) ; ST(B):=ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL ENDPROC ;PROCEDURE ENDPROC; ; BEGIN ENDPRO: MOV #ENDPR1,OPCODE ; ST(KERNELOP):=ENDPROCESS1; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL ENTERPROC ; ; .SBTTL BEGINCLASS ;PROCEDURE BEGINCLASS(STACKLENGTH,10,LINE,0); ; BEGIN BEGINC: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: MOV G,- ;PROCEDURE ENTERPROC(STACKLENGTH,POPLENGTH, ; LINE,VARLENGTH); ; BEGIN ENPROC: MOV S,X ; X:=S; SUB HEAPTO,X ; X:-ST(HEAPTOP); CMP X,(Q)+ ; X COMPARE ST(Q); Q:+2; "ERROR MESSAGE BHIS 1$ ; IF LESS THEN WILL REFER TO JMP STACKL ; GOTO STACKLIMIT; LINE OF CALL" 1$: (S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 2(B),W ; W:=ST(B+2); MOV -2(W),G ; G:=ST(W-2); NEXT MOV G,-(S) ; S:-2; ST(S):=G; MOV B,-(S) ; S:-2; ST(S):=B; TST -(S) ; S:-2; MOV S,(S) ; ST(S):=S; ADD (Q)+,(S) ; ST(S):+ST(Q); Q:+2; MOV (Q)+,-(S) ; S:-2; ST(S):=ST(Q); Q:+2; MOV S,B ; B:=S; SUB (Q)+,S ; S:-ST(Q); Q:+2; MOV 6(G),G ; G:=ST(G+6); CLR JOB ; CLEAR ST(JOB); ; END; ; ; .SBTTL ENDCLASS ;PROCEDURE ENDCLASS; ; BEGIN ENDCLA= EXIT ; "SAME AS EXIT" ; END; ; ; .SBTTL ENTERCLASS ;PROCEDURE ENTERCLASS(STACKLENGTH,POPLENGTH, ; LINE,VARLENGTH); ;TERMINATED: TERMIN: MOV #0,RESULT ; ST(RESULT):=0; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL OVERFLOWERROR ;OVERFLOWERROR: OVERFL: MOV #1,RESULT ; ST(RESULT):=1; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL POINTERERROR ;POINTERERROR: POINER: MOV #2,RESULT ; ST(RESULT):=2; JMP ; BEGIN NEG (S) ; ST(S):=-ST(S); BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; ; END; 1$: NEXT ; END; ; ; .SBTTL ABSREAL ;PROCEDURE ABSREAL; ; BEGIN ABSREA: ABSD (S) ; ST:=ABS(ST(S)); NEXT EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL RANGEERROR ;RANGEERROR: RANGER: MOV #3,RESULT ; ST(RESULT):=3; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL VARIANTERROR ;VARIANTERROR: VARIER: MOV #4,RESULT ; ST(RESULT):=4; JMP EXCEPT ; GOTO EXCEPTION; ; ; END; ; ; .SBTTL SUCCWORD ;PROCEDURE SUCCWORD; ; BEGIN SUCCWO: INC (S) ; INCREMENT ST(S); NEXT ; END; ; ; .SBTTL PREDWORD ;PROCEDURE PREDWORD; ; BEGIN PREDWO: DEC (S) ; DECREMENT ST(S); NEXT ; .SBTTL HEAPLIMIT ;HEAPLIMIT: HEAPLI: MOV #5,RESULT ; ST(RESULT):=5; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL STACKLIMIT ;STACKLIMIT: STACKL: MOV #6,RESULT ; ST(RESULT):=6; JMP EXCEPT ; GOTO EXCEPTION; ; ; .SBTTL EXCEPTION ;EXCEPTION: EXCEPT: MOV ; END; ; ; .SBTTL CONVWORD ;PROCEDURE CONVWORD; ; BEGIN CONVWO: LDCID (S)+,W ; W:=CONV(ST(S)); S:+2; STD W,-(S) ; S:-8; ST(S):=W; NEXT ; END; ; ; .SBTTL EMPTY ;PROCEDURE EMPTY; ; BEGIN EMPTY: (B),LINE ; ST(LINE):=ST(B); TST JOB ; TEST ST(JOB); BNE 1$ ; IF ZERO THEN "INSYSTEM" ; BEGIN MOV #SYSTE1,OPCODE ; ST(KERNELOP):=SYSTEMERROR; KNCALL ; KERNELCALL; BR 2$ ; END ; ELSE "IN JOB" ; BEGIN 1$: MOV G,B ; B:=G; MOV B,S CLR W ; CLEAR W; TST (S) ; TEST ST(S); BNE 1$ ; IF ZERO THEN INC W ; INCREMENT W; 1$: MOV W,(S) ; ST(S):=W; NEXT ; END; ; ; .SBTTL ATTRIBUTE ;PROCEDURE ATTRIBUTE; ; BEGIN ATTRIB: MOV (S),W ; W:=ST(S); ASL W ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; CLR JOB ; CLEAR ST(JOB); 2$: NEXT ; END; ; ; INTEND= . ; DOUBLE W; MOV HEAD(W),(S) ; ST(S):=ST(W+HEAD); NEXT ; END; ; ; .SBTTL REALTIME ;PROCEDURE REALTIME; ; BEGIN REALTI: MOV #REALT1,OPCODE ; ST(KERNELOP):=REALTIME1; KNCALL ; KERNELCALL; MOV ARG1,-(S) ; S:-2; ST(S):=ST(KERNELARG1); NEXT ; END; THE 8-BIT ASCII BIT FOR THE RECEIVER BUFFER REGISTER ;* ASCII8 = ^B0000000010000000; 1 FOR 8-BIT, 0 FOR 7-BIT ASCII ;* ;* .SBTTL LP11 PRINTER DEFINITIONS ;**** LP11 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* LPS = 177514; LINE PRINTER STATUS REGISTER LPB = 177516; LINE PRINTER DATA BUFFER REGISTER ;* ;* BIT DEFINITIONS FOR THE STATUS REGISTER ;* ;* = ^B0000000000111111; 6 ; ; .SBTTL DELAY ;PROCEDURE DELAY; ; BEGIN DELAY: MOV #DELAY1,OPCODE ; ST(KERNELOP):=DELAYGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL CONTI BITS - NOT USED LPSIDE = ^B0000000001000000; INTERRUPT ENABLE LPSRDY = ^B0000000010000000; PRINTER READY ;* = ^B0111111100000000; 7 BITS - NOT USED LPSERR = ^B1000000000000000; ERROR ;* ;* .SBTTL CD11 CARD READER DEFINITIONS ;**** CD11 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* CDST = 172460; STATUS AND CONTROL REGISTER CDCC = 172462; COLUMN COUNT REGISTER CDBA = 1NUE ;PROCEDURE CONTINUE; ; BEGIN CONTIN: MOV #CONTG1,OPCODE ; ST(KERNELOP):=CONTGATE1; MOV (G),ARG1 ; ST(KERNELARG1):=ST(G); MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; KNCALL ; KERNELCALL; MOV B,S ; S:=B; TST (S)+ ; TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2 1 BIT - SURFACE, 0..1 RDACYL = ^B0000000000100000; 8 BITS - CYLINDER, 0..202 RDADRS = ^B0010000000000000; 3 BITS - DRIVE SELECT, 0..7 ;* ;* .SBTTL LT33 TERMINAL DEFINITIONS ;**** LT33 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* RCSR = 177560; RECEIVER STATUS REGISTER RBUF = 177562; RECEIVER BUFFER REGISTER XCSR = 177564; TRANSMITTER STATUS REGISTER XBUF = 17756; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; NEXT ; END; ; ; .SBTTL IO ;PROCEDURE IO; ; BEGIN IO: MOV #IO1,OPCODE ; ST(KERNELOP):=IO1; MOV (S)+,ARG3 ; ST(KERNELARG3):=ST(S); S:+2; MOV (S)+,ARG2 ; ST(KER6; TRANSMITTER BUFFER REGISTER ;* ;* BIT DEFINITIONS FOR THE STATUS REGISTERS ;* ;* = ^B1111000000000000; 4 BITS - NOT USED TSRBSY = ^B0000100000000000; BUSY (RECEIVER ONLY) ;* = ^B0000011100000000; 3 BITS - NOT USED TSRRDY = ^B0000000010000000; READY TSRIDE = ^B0000000001000000; INTERRUPT ENABLE ;* = ^B0000000000111110; 5 BITS - NOT USED TSRGO = ^B0000000000000001; START (RECEIVER ONLY) ;* ;* +2; MOV Q,ARG4 ; ST(KERNELARG4):=Q; ADD (Q)+,ARG4 ; ST(KERNELARG4):+ST(Q); Q:+2; KNCALL ; KERNELCALL; TST (S)+ ; TEST ST(S); S:+2; NEXT ; END; ; ; .SBTTL PUSHLABEL ;PROCEDURE PUSHLABEL(DISTANCE); ; BEGIN PUSHLA: MOV Q,-(S) ; S:-2; ST(S):=Q; ADD NELARG2):=ST(S); S:+2; MOV (S)+,ARG1 ; ST(KERNELARG1):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL START ;PROCEDURE START; ; BEGIN START: MOV #10.,CONT ; ST(CONTINUE):=10; NEXT ; END; ; ; .SBT(Q)+,(S) ; ST(S):+ST(Q); Q:+2; NEXT ; END; ; ; .SBTTL CALLPROG ;PROCEDURE CALLPROG; ; BEGIN CALLPR: MOV Q,W ; W:=Q; "W=OLD Q" MOV (S),Q ; Q:=ST(S); "Q=CODE ADDR" TST (Q)+ ; TEST ST(Q); Q:+2; MOV (Q)+,(S) ; ST(S):=ST(Q); Q:+2; TL STOP ;PROCEDURE STOP; ; BEGIN STOP: MOV #STOPJ1,OPCODE ; ST(KERNELOP):=STOPJOB1; MOV (S)+,ARG2 ; ST(KERNELARG2):=ST(S); S:+2; MOV (S)+,ARG1 ; ST(KERNELARG1):=ST(S); S:+2; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL SETHEAP ;PROCEDURE SETHEAP; "ST(S)=CODELENG" ADD #4.,Q ; Q:+4; "Q=CODEADDR+8" ADD Q,(S) ; ST(S):+Q; "ST(S)=CONSTADR" MOV W,-(S) ; S:-2; ST(S):=W; "PUSH(OLD Q)" NEXT ; END; ; ; .SBTTL TRUNCREAL ;PROCEDURE TRUNCREAL; ; BEGIN TRUNCR: LDD (S)+,W ; W:= ST(S); BEGIN SETHEA: MOV (S)+,HEAPTO ; ST(HEAPTOP):=ST(S); S:+2; NEXT ; END; ; ; .SBTTL WAIT ;PROCEDURE WAIT; ; BEGIN WAIT: MOV #WAIT1,OPCODE ; ST(KERNELOP):=WAIT1; KNCALL ; KERNELCALL; NEXT ; END; ; ; .SBTTL TERMINATED ; S:+8; STCDI W,-(S) ; S:-2; ST(S):=TRUNC(W); BVC 1$ ; IF OVERFLOW THEN JMP OVERFL ; GOTO OVERFLOWERROR; 1$: NEXT ; END; ; ; .SBTTL ABSWORD ;PROCEDURE ABSWORD; ; BEGIN ABSWOR: TST (S) ; TEST ST(S); BGE 1$ ; IF NEGATIVE THEN      $&(*,.0246 "%')+-/1357!#@BDFHJLN8:<>ACEGIKMO9;=?\^`bdfPRTVXZ]_acegQSUWY[xz|~hjlnprtvy{}ikmoqsuwRMINATED IO IOPROCESS: TERMINATED CARDS: ERROR PRINTER: INSPECT ~dr`b`D~PH$ `D H$ `D H \@~D@UNIDENTIFIED: DISK: ERROR PUSH RETURN CONSOLE DO JOBPROCESS: TE################# # LIST MANUAL # ################# PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: TO SCAN THE DISK CATALOG IN ALPHABETIC ORDER AND PERFORM ONE OF THE FOLLOWING OPERATIONS ON ALL DISK FILES (OR A SUBSET OF THEM): (1) LIST THE CATALOG ENTRIES ON AN OUTPUT MEDIUM. (2) LIST THE CATALOG ENTRIES AND THE DISK FILES ON AN OUTPUT MEDIUM. CALL: LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) USING DETAIL = (CATALOG, FILES); FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL); THE DETA. ;**** PRELIMINARY DEFINITIONS: ***** ;* ;* MACRO TO SET A SINGLE TRAP VECTOR ;* .MACRO TVDEF TRPROC,TPSW .WORD TRPROC,TPSW .ENDM TVDEF ;* ;* TRAP VECTOR AREA EXTENT DEFINITIONS ;* TVABEG = 004; START OF TRAP VECTOR AREA TVAEND = 400; END OF TRAP VECTOR AREA TVECS = / 4; NUMBER OF TRAP VECTORS POSSIBLE ;* ;* THE LOCATIONS OF RELEVANT TRAP VECTORS ;* FETRAP = 004IL DEFINES THE OPERATION TO BE PERFORMED ON THE FILES. THE KIND DEFINES THE SUBSET OF THE FILES TO BE LISTED. THE OUTPUT MEDIUM (WHERE) MUST BE A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE. SK FILES (OR A SUBSET OF THEM): (1) LIST THE CATALOG ENTRIES ON AN OUTPUT MEDIUM. (2) LIST THE CATALOG ENTRIES AND THE DISK FILES ON AN OUTPUT MEDIUM. CALL: LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) USING DETAIL = (CATALOG, FILES); FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL); THE DETA     %')+-/1357!#&(*,.0246 "$ACEGIKMO9;=?BDFHJLN8:<>@]_acegQSUWY[^`bdfPRTVXZ\y{}ikmoqsuwz|~hjlnprtvxH: WRITEID('SCRATCH '); ASCII: WRITEID('ASCII '); SEQCODE: WRITEID('SEQCODE '); CONCODE: WRITEID('CONCODE ') END; END; PROCEDURE WRITEPROTECT(PROTECT: BOOLEAN); BEGIN IF PROTECT THEN WRITEID('PROTECTED ') ELSE WRITEID('UNPROTECTED '); END; PROCEDURE WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(REM MOD 10(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO 6 - DIGIT DO WRITE(' '); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(' '); END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN OK:= FALSE; WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT (' LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) (:10:)'); WRITETEXT('USING(:10:)'); WRITETEXT(' DETAIL = (CATALOG, FILES) (:10:)');RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM WRITETEXT(' FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL)(:10:)'); END; END; PROCEDURE INITCAT; VAR FOUND: BOOLEAN; BEGIN OPEN(1, 'CATALOG ', FOUND); CATLENGTH:= LENGTH(1) * CATPAGELENGTH; PAGENO:= 0; END; PROCEDURE READCAT(ELEMNO: INTEGER; VAR ELEM: CATENTRY); VAR INDEX: INTEGER; BEGIN INDEX:= (ELEMNO - 1) DIV CATPAGELENGTH + 1; IF PAGENO <> INDEX THEN BEGIN PAGENO:= INDEX; GET(1, PAGENO, BLOCK); END; ELEM:= BLOCK(.(ELEMNO - 1) MOD CATPAGELENGTH + 1.); END; PR, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); OCEDURE TERMCAT; BEGIN CLOSE(1) END; PROCEDURE PARTITION(VAR TABLE: CATSET; FIRST,LAST: INTEGER; VAR MIDDLE: INTEGER); VAR I: INTEGER; MIDDLE_ELEM, TEMP: CATENTRY; BEGIN I:= FIRST; MIDDLE:= LAST; MIDDLE_ELEM:= TABLE(.LAST.); WHILE I < MIDDLE DO IF TABLE(.I.).ID <= MIDDLE_ELEM.ID THEN I:= I + 1 ELSE BEGIN MIDDLE:= MIDDLE - 1; IF TABLE(.MIDDLE.).ID < MIDDLE_ELEM.ID THEN BEGIN TEMP:= TABLE(.I.); TABLE(.I.):= TABLE(.MIDDLE.); TABLE(.MIDDLE.):= TEMP; END; END; PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT TABLE(.LAST.):= TABLE(.MIDDLE.); TABLE(.MIDDLE.):= MIDDLE_ELEM; END; PROCEDURE QUICKSORT(VAR TABLE: CATSET; LEFT, RIGHT: INTEGER); VAR MIDDLE: INTEGER; BEGIN IF LEFT < RIGHT THEN BEGIN PARTITION(TABLE, LEFT, RIGHT, MIDDLE); QUICKSORT(TABLE, LEFT, MIDDLE - 1); QUICKSORT(TABLE, MIDDLE + 1, RIGHT); END; END; PROCEDURE SORT_CATALOG; VAR NO: INTEGER; THIS: CATENTRY; BEGIN TABLELENGTH:= 0; INITCAT; FOR NO:= 1 TO CATLENGTH DO BEGIN READCAT(NO, THIS); IF THIS.ID <> ' (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; ' THEN BEGIN TABLELENGTH:= TABLELENGTH + 1; TABLE(.TABLELENGTH.):= THIS; END; END; TERMCAT; QUICKSORT(TABLE, 1, TABLELENGTH); END; PROCEDURE BEFORE; BEGIN WRITETEXT('SOLO SYSTEM FILES(:10:)'); WRITE(NL); ENTRIES:= 0; PAGES:= 0; END; PROCEDURE EXAMINE1(THIS: CATENTRY); VAR ATTR: FILEATTR; FOUND: BOOLEAN; FILELENGTH: INTEGER; BEGIN WITH THIS, ATTR DO IF KIND IN KINDSET THEN BEGIN OPEN(2, ID, FOUND); FILELENGTH:= LENGTH(2); CLOSE(2); ENTRIES:= ENT ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "########################################################## # LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDRIES + 1; PAGES:= PAGES + FILELENGTH; IF ACTION = LISTFILES THEN WRITEINT(ENTRIES + 1); WRITEID(ID); WRITEKIND(KIND); WRITEPROTECT(PROTECTED); WRITEINT(FILELENGTH); WRITETEXT('PAGES(:10:)'); END; END; PROCEDURE AFTER; BEGIN WRITEINT(ENTRIES); WRITETEXT('ENTRIES(:10:)'); WRITEINT(PAGES); WRITETEXT('PAGES(:10:)'); WRITE(EM); END; PROCEDURE EXAMINE2(THIS: CATENTRY); VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER; BLOCK: PAGE; ARG: ARGTYPE; BEGIN WIENTIFIER) # ##########################################################" "INSERT PREFIX HERE" CONST CATPAGELENGTH = 16; MAXSET = 256; TYPE CATENTRY = RECORD ID: IDENTIFIER; ATTR: FILEATTR; KEY, SEARCHLENGTH: INTEGER END; CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY; CATSET = ARRAY (.1..MAXSET.) OF CATENTRY; VAR OK: BOOLEAN; WHAT, KIND, WHERE: ARGTYPE; ACTION: (LISTCATALOG, LISTFILES); KINDSET: SET OF FILEKIND; PAGENO: INTEGER; BLOCK: CATPAGTH THIS, ATTR DO IF KIND IN KINDSET THEN BEGIN WRITEARG(OUT, WHERE); OPEN(2, ID, FOUND); FOR PAGENO:= 1 TO LENGTH(2) DO BEGIN GET(2, PAGENO, BLOCK); WRITEPAGE(BLOCK, FALSE); END; WRITEPAGE(BLOCK, TRUE); CLOSE(2); READARG(OUT, ARG); OK:= OK & ARG.BOOL; END; END; PROCEDURE SCAN_CATALOG; VAR NO: INTEGER; ARG: ARGTYPE; BEGIN WRITEARG(OUT, WHERE); BEFORE; FOR NO:= 1 TO TABLELENGTH DO EXAMINE1(TABLE(.NO.)); AFTER; READARG(OUT, ARG); OK:= ARG.BOO72464; CURRENT ADDRESS REGISTER CDDB = 172466; DATA BUFFER REGISTER ;* ;* BIT AND FIELD DEFINITIONS FOR THE STATUS AND CONTROL REG ;* CDSERR = ^B1000000000000000; ERROR CDSRDC = ^B0100000000000000; READER CHECK CDSEOF = ^B0010000000000000; END OF FILE CDSOFL = ^B0001000000000000; OFF LINE CDSDER = ^B0000100000000000; DATA ERROR CDSDTL = ^B0000010000000000; DATA LATE CDSNXM = ^B00000010000000E; CATLENGTH: INTEGER; TABLE: CATSET; TABLELENGTH: INTEGER; ENTRIES, PAGES: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); IF OK THEN WRITE(C) ELSE DISPLAY(C); UNTIL C = NL; END; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; BEGIN FOR I:= 1 TO IDLENGTH DO WRITE(ID(.I.)); WRITE(' '); END; PROCEDURE WRITEKIND(KIND: FILEKIND); BEGIN CASE KIND OF EMPTY: WRITEID('EMPTY '); SCRATC00; NONEXISTENT MEMORY CDSPCL = ^B0000000100000000; POWER CLEAR CDSRDY = ^B0000000010000000; READY CDSIDE = ^B0000000001000000; INTERRUPT ENABLE CDSMEX = ^B0000000000110000; 2 BITS - MEMORY EXTENSION CDSOLT = ^B0000000000001000; ONLINE TRANSITION CDSHPC = ^B0000000000000100; HOPPER CHECK CDSDPK = ^B0000000000000010; DATA PACKING MODE CDSGO = ^B0000000000000001; START READ ;* ;* .SBTTL KERNEL TRAP VECTOR DEFINITIONS  $&(*,.0246 "%')+-/1357!#@BDFHJLN8:<>ACEGIKMO9;=?\^`bdfPRTVXZ]_acegQSUWY[xz|~hjlnprtvy{}ikmoqsuw     L; IF ACTION = LISTFILES THEN FOR NO:= 1 TO TABLELENGTH DO EXAMINE2(TABLE(.NO.)); END; PROCEDURE INITIALIZE; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN IDENTIFY('LIST:(:10:)'); OK:= TRUE; WHAT:= PARAM(.2.); WITH WHAT DO IF TAG <> IDTYPE THEN HELP ELSE IF ID = 'CATALOG ' THEN ACTION:= LISTCATALOG ELSE IF ID = 'FILES ' THEN ACTION:= LISTFILES ELSE HELP; KIND:= PARAM(.3.); WITH KIND DO IF TAG <> IDTYPE THEN HELP ELSE IF ID = 'SCRATCH ' THEN KINDSET:= <(v( " >" "   X0 "  " & ^:P  X & Hp  n( n"p  n( n*p  n( n *p  n( n"p  n( n(.SCRATCH.) ELSE IF ID = 'ASCII ' THEN KINDSET:= (.ASCII.) ELSE IF ID = 'SEQCODE ' THEN KINDSET:= (.SEQCODE.) ELSE IF ID = 'CONCODE ' THEN KINDSET:= (.CONCODE.) ELSE IF ID = 'ALL ' THEN KINDSET:= (.SCRATCH, ASCII, SEQCODE, CONCODE.) ELSE HELP; WHERE:= PARAM(.4.); WITH WHERE DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('OUTPUT FILE UNKNOWN(:10:)') ELSE IF ATTR.KIND <> SEQCODE THEN ER(*p  n( n"4p,@ ^p 06J|"8  $ TF"*  $ "&h"rx~l .  *" `D  HB"" `D ROR('OUTPUT FILE MUST BE SEQCODE(:10:)'); END; END; PROCEDURE TERMINATE; VAR ARG: ARGTYPE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; IF OK THEN BEGIN SORT_CATALOG; SCAN_CATALOG; END; TERMINATE; END; END.  HB"" `>  H"" `D  HB"""& . 4    (  " (*Xb ^DISK ERROR CREATE SCRATCH FILE MAKETEMP: FILE#%')+-/1357!$&(*,.0246 "?ACEGIKMO9;=@BDFHJLN8:<>[]_acegQSUWY\^`bdfPRTVXZwy{}ikmoqsuxz|~hjlnprtv      LOST FILE ALREADY EXISTS MAKETEMP: TEMP1 TEMP2 " `>  H"" `D  HB"""& . 4    (  " (*Xb ^DISK ERROR CREATE SCRATCH FILE MAKETEMP: FILE##################### # MAKETEMP MANUAL # ##################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: CREATES TWO PROTECTED SCRATCH FILES (TEMP1 AND TEMP2) OF 255 DISK PAGES EACH AND INTERLEAVES THEM ON THE DISK. THESE FILES ARE USED BY THE PASCAL COMPILERS DURING TRANSLATION. CALL: MAKETEMP S AND THE DISK FILES ON AN OUTPUT MEDIUM. CALL: LIST(WHAT: DETAIL; KIND: FILEKIND; WHERE: IDENTIFIER) USING DETAIL = (CATALOG, FILES); FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE, ALL); THE DETA $&(*,.0246 "%')+-/1357!#@BDFHJLN8:<>ACEGIKMO9;=?\^`bdfPRTVXZ]_acegQSUWY[xz|~hjlnprtvy{}ikmoqsuw     $& LENGTH: INTEGER; PAGESET: ARRAY (.1..255.) OF INTEGER END; VAR OK: BOOLEAN; MAPADDR1, MAPADDR2: INTEGER; OLDMAP1, NEWMAP1, OLDMAP2, NEWMAP2: FILEMAP; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE TRANSFER(HOW: IOOPERATION; ADDR: UNIV IOARG; VAR MAP: FILEMAP); VAR PARAM: IOPARAM; RESPONSE: CHAR; BEGIN WITH PARAM DO BEGIN OPERATION:= HOW; (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, ARG:= ADDR; IOTRANSFER(DISKDEVICE, PARAM, MAP); WHILE STATUS <> COMPLETE DO BEGIN WRITETEXT('DISK ERROR (:10:)'); REPEAT ACCEPT(RESPONSE) UNTIL RESPONSE = NL; IOTRANSFER(DISKDEVICE, PARAM, MAP); END; END; END; PROCEDURE MAKEFILE(TEMP: IDENTIFIER); VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; ID:= 'CREATE ' END; WITH LIST(.3.) DO BEGSCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIIN TAG:= IDTYPE; ID:= TEMP END; WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= 255 END; WITH LIST(.5.) DO BEGIN TAG:= IDTYPE; ID:= 'SCRATCH ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('MAKETEMP:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN BEGIN WRITETEXT('FILE LOST(:10:)'); OK:= FALSE; END; END; PROCEDURE GETFILE(ID: IDENTIFIER; VAR ADDR: INTEGER); VAR ATTR: FILEATTR; FOUND: BOOLEAN;UM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); BEGIN LOOKUP(ID, ATTR, FOUND); IF FOUND THEN BEGIN WRITETEXT('FILE ALREADY EXISTS(:10:)'); OK:= FALSE; END ELSE BEGIN MAKEFILE(ID); LOOKUP(ID, ATTR, FOUND); ADDR:= ATTR.ADDR; END; END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('MAKETEMP:(:10:)'); OK:= TRUE; GETFILE('TEMP1 ', MAPADDR1); GETFILE('TEMP2 ', MAPADDR2); IF OK THEN BEGIN TRANSFER(INPUT, MAPADDR1, OLDMAP1); TRANSFER(INPUT, MAPADDR2, OLDMAP2); END; END; PROCEDURE INTERLEAVE; VAR I: INTE PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PGER; BEGIN FOR I:= 1 TO 128 DO NEWMAP1.PAGESET(.I.):= OLDMAP1.PAGESET(.2*I - 1.); FOR I:= 129 TO 255 DO NEWMAP1.PAGESET(.I.):= OLDMAP2.PAGESET(.2*I - 256.); FOR I:= 1 TO 127 DO NEWMAP2.PAGESET(.I.):= OLDMAP1.PAGESET(.2*I.); FOR I:= 128 TO 255 DO NEWMAP2.PAGESET(.I.):= OLDMAP2.PAGESET(.2*I - 255.); NEWMAP1.LENGTH:= 255; NEWMAP2.LENGTH:= 255; END; PROCEDURE TERMINATE; BEGIN IF OK THEN BEGIN TRANSFER(OUTPUT, MAPADDR1, NEWMAP1); TRANSFER(OUTPUT, MUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEAPADDR2, NEWMAP2); END; WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; IF OK THEN INTERLEAVE; TERMINATE; END; END. Q; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############# # MAKETEMP # #############" "INSERT PREFIX HERE" TYPE FILEMAP = RECORD "$&(*,.0246 #%')+-/1357!>@BDFHJLN8:<?ACEGIKMO9;=Z\^`bdfPRTVX[]_acegQSUWYvxz|~hjlnprtwy{}ikmoqsu     "$& #%', STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;b&( " >" "   X" "$ 26`6>T*DHL<",  "  "( "& ^ ^2 ("H X" ^  &F ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "########################################### # MOVE(VAR OK: BOOLEAN; FILENO: INTEGER) # #################" V2j >"$V"   X "$   (  " &*XB TRY AGAIN MOVE(FILENO: INTEGER) INSPECT ERROR FAILURE ENDMEDIUM MOVE: ^ ^2 ("H X" ^  &F##########################" "INSERT PREFIX HERE" VAR OK: BOOLEAN; FILENO: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT(' MOVE(FILENO: INTEGER) (:10:)'); OK:= FALSE; END; END; PROCEDURE TAPEERROR(RESULT: IORESULT); BEGIN CASE RESULT OF INTERVENTION: WRITETEXT('INSPECT(:10:)'); PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT TRANSMISSION: WRITETEXT('ERROR(:10:)'); FAILURE: WRITETEXT('FAILURE(:10:)'); ENDMEDIUM: WRITETEXT('ENDMEDIUM(:10:)') END; OK:= FALSE; END; PROCEDURE MOVETAPE(WHERE: IOARG; VAR RESULT: IORESULT); VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= MOVE; ARG:= WHERE; IOMOVE(TAPEDEVICE, PARAM); RESULT:= STATUS; END; END; PROCEDURE REWINDTAPE; VAR RESULT: IORESULT; BEGIN MOVETAPE(REWIND, RESULT); IF (RESULT <> COMPLETE) & (RESULT <> ST(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;ARTMEDIUM) THEN TAPEERROR(RESULT); END; PROCEDURE NEXTFILE; VAR RESULT: IORESULT; DONE: BOOLEAN; BEGIN DONE:= FALSE; REPEAT MOVETAPE(UPSPACE, RESULT); IF RESULT = ENDFILE THEN DONE:= TRUE ELSE IF RESULT <> COMPLETE THEN TAPEERROR(RESULT); UNTIL DONE; END; PROCEDURE FINDFILE; VAR POSITION: INTEGER; BEGIN REWINDTAPE; POSITION:= 1; WHILE OK & (POSITION < FILENO) DO BEGIN NEXTFILE; POSITION:= POSITION + 1; END; END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('MO,.0246-/LN8:<>@BDFHJMO9;=?ACEGIKPRTVXZ\^`bdfQSUWY[]_aceglnprtvxz|~hjmoqsuwy{}ik      "$&!#%'468:<>(VE:(:10:)'); OK:= TRUE; WITH PARAM(.2.) DO IF TAG = INTTYPE THEN FILENO:= INT ELSE HELP; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; IF OK THEN FINDFILE; TERMINATE; END; END. #################### # PRINTER MANUAL # #################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: OUTPUTS AN ASCII FILE TO A LINE PRINTER. THE FILE MUST BE TERMINATED BY AN EM CHARACTER. THE PRINTER OUTPUTS A FF CHARACTER AT THE BEGINNING OF THE FILE, A BLANK LINE AT THE BEGINNING OF EACH PAGE, AND 23 BLANKS AT THE BEGINNING OF EACH LINE. A FILE IS LIMITED TO AT MOST 100 PAGES, A PAGE TO AT MOST 60 LINES, AND A LINE TO AT MOST 86 CHARACTERS. (THESE CONVENTIONS CAN BE CHANGED BY REDEFINITION OF ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################# # PRINTER(VAR OK: BOOLEAN) # #############################" "INSERT PREFIPROGRAM CONSTANTS.) CALL: CAN ONLY BE USED TO PRINT OUTPUT FOR OTHER PROGRAMS. ERROR MESSAGES: INSPECT INSPECTION OF THE LINE PRINTER IS REQUIRED. THE ERRONEOUS LINE IS REPRINTED AND THE OUTPUT CONTINUES. PUTS A FF CHARACTER AT THE BEGINNING OF THE FILE, A BLANK LINE AT THE BEGINNING OF EACH PAGE, AND 23 BLANKS AT THE BEGINNING OF EACH LINE. A FILE IS LIMITED TO AT MOST 100 PAGES, A PAGE TO AT MOST 60 LINES, AND A LINE TO AT MOST 86 CHARACTERS. (THESE CONVENTIONS CAN BE CHANGED BY REDEFINITION OF X HERE" CONST FIRSTCHAR = 24; LASTCHAR = 109; "(< 132)" FIRSTLINE = 2; LASTLINE = 61; FIRSTPAGE = 2; LASTPAGE = 101; AFTERFILE = 0; VAR CONTROLCHAR: SET OF CHAR; C: CHAR; TEXT: LINE; PROCEDURE INITIALIZE; BEGIN IDENTIFY('PRINTER: (:10:)'); END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= TRUE END; END; PROCEDURE SETMARGIN; VAR I: INTEGER; BEGIN FOR I:= 1 TO FIRSTCHAR - 1 DO TEXT(.I.):= ' '; TEXT(.LASTCHAR + 1.):= NL; CONTROLCHAR:= (.CR, NL, FF, EM.); END ENDPAGE:= TRUE END UNTIL ENDPAGE; END; PROCEDURE PRINTFILE; VAR ENDFILE: BOOLEAN; PAGENO: INTEGER; BEGIN SETMARGIN; ENDFILE:= FALSE; FOR PAGENO:= 1 TO FIRSTPAGE - 1 DO PRINTFF; PAGENO:= FIRSTPAGE; REPEAT PRINTPAGE; IF (C = EM) OR (PAGENO = LASTPAGE) THEN ENDFILE:= TRUE ELSE PAGENO:= PAGENO + 1; UNTIL ENDFILE; FOR PAGENO:= PAGENO TO PAGENO + AFTERFILE - 1 DO PRINTFF; END; BEGIN IF TASK = OUTPUTTASK THEN BEGIN INITIALIZE; PRINTFILE; TERMIN(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC; PROCEDURE PRINTLINE; VAR ENDLINE: BOOLEAN; CHARNO: INTEGER; BEGIN ENDLINE:= FALSE; CHARNO:= FIRSTCHAR; REPEAT READ(C); TEXT(.CHARNO.):= C; IF C IN CONTROLCHAR THEN BEGIN IF C = EM THEN TEXT(.CHARNO.):= NL; TEXT(.CHARNO + 1.):= ' '; ENDLINE:= TRUE; END ELSE IF CHARNO = LASTCHAR THEN BEGIN C:= NL; ENDLINE:= TRUE END ELSE CHARNO:= SUCC(CHARNO); UNTIL ENDLINE; WRITELINE(TEXT); END; PROCEDURE PRINTNL; BEGIN TEXT(.FIRSTCHAR.):= NL; TEXT(.FIRSTCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUMHAR + 1.):= ' '; WRITELINE(TEXT); END; PROCEDURE PRINTFF; BEGIN TEXT(.FIRSTCHAR.):= FF; TEXT(.FIRSTCHAR + 1.):= ' '; WRITELINE(TEXT); END; PROCEDURE PRINTPAGE; VAR ENDPAGE: BOOLEAN; LINENO: INTEGER; BEGIN ENDPAGE:= FALSE; FOR LINENO:= 1 TO FIRSTLINE - 1 DO PRINTNL; LINENO:= FIRSTLINE; REPEAT PRINTLINE; CASE C OF CR: ; NL: IF LINENO = LASTLINE THEN BEGIN PRINTFF; ENDPAGE:= TRUE; END ELSE LINENO:= LINENO + 1; FF, EM:, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT:<>@BDFHJLN?ACEGIKPRTVXZ\^`bdfQSUWY[]_aceglnprtvxz|~hjmoqsuwy{}ik      "$&!#%'468:<>(*,.02579;=?)+- ; (NOT USED) FPTRAP = 244; FLOATING POINT EXCEPTION SGTRAP = 250; SEGMENT VIOLATION ; (INDICATES SYSTEM ERROR) ;**** SET THE TRAP VECTORS ***** ;* ;* ; ;<01> ****** W A R N I N G ! ! ! ! ! ! ! THE AUTOLOAD PROGRAM CHECKS TO SEE ;* IF LOCATION 0 IS A 137!!!!!! ;* ZERO: JMP @#$KNL0;<01> JUMP TO INITIALIZATION. THESE ;* TWO WORDS ARE RESERVED Fr&>( " >" "   X" "" ,phX`^X" Hp  n( n"p  n(  n* n*p   *p  n( n "p   *p   *OR USE ;* BY THE MACHINE IN THE RARE CASE ;* WHEN POWER FAILURE PREVENTS THE ;* COMPLETION OF A FATAL STACK ;* VIOLATION TRAP. ;* ;* FILL TRAP VECTOR AREA WITH ILLEGAL TRAPS TO LABEL XXXINT ;* DEFINED BELOW. THE NEW PSW IS USED TO TRANSMIT THE TRAP ;* VECTOR ADDRESS TO THE COMMON INTERCEPTOR, XXXINT. ;* .REPT TVECS p, ^p 06 8   ^ 8 $ 2    ^ h ~ ~2 ~2 ~2<   ^2 (  *" ( *" TVDEF XXXINT,.-2; UNEXPECTED CALL; .ENDR ;* ;* PLANT THE RELEVANT TRAP VECTORS ;* ;* BECAUSE THE ASSEMBLY IS RELOCATABLE, THE FOLLOWING ;* TRAP VECTORS MUST BE MADE RELATIVE TO ;* RELOCATABLE ZERO. ;* . = ZERO+FETRAP ;FATAL ERROR TRAP TVDEF FEINT,KNLPSW . = ZERO+IITRAP ;<01> ON 11/34 TRAPS COME HERE TVDEF FEINT,KNLPSW ;<01> HANDLE AS IF TRAPPED TO 4 . = ZERO+TBTRAP ;T-BIT TRAP TVDEF TBTIN4 0 " " 0 " "$"&  $   (  " &*XF \TRY AGAIN READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOLEAN) USING FILEKIND = (SCRATCH, ASCII, SEQCODERATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, CONCODE) REPLACE CREATE FILE READ: DISK FILE LOST FILE PROTECTED SCRATCH ASCII SEQCODE CONCODE TAPE NEXT READ: "$"&  $   (  " &*XF \TRY AGAIN READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOLEAN) USING FILEKIND = (SCRATCH, ASCII, SEQCODE, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); HELP ELSE IF (ID <> 'SCRATCH ') & (ID <> 'ASCII ') & (ID <> 'SEQCODE ') & (ID <> 'CONCODE ') THEN HELP; WITH PARAM(.4.) DO IF TAG <> BOOLTYPE THEN HELP; END; PROCEDURE INITIO; VAR ARG: ARGTYPE; BEGIN WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'TAPE ' END; WRITEARG(INP, ARG); WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'NEXT ' END; WRITEARG(OUT, ARG); END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; LENGTH: INTEGER; BEGIN READARG(INP, ARG); IF NOT ARG PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT.BOOL THEN OK:= FALSE; READARG(OUT, ARG); LENGTH:= ARG.INT; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF OK THEN SAVEFILE(LENGTH); END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('READ:(:10:)'); OK:= TRUE; CHECKARG; END; PROCEDURE COPY; VAR BLOCK: PAGE; EOF: BOOLEAN; BEGIN INITIO; REPEAT READPAGE(BLOCK, EOF); WRITEPAGE(BLOCK, EOF); UNTIL EOF; CHECKIO; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOB(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;TASK THEN BEGIN INITIALIZE; IF OK THEN COPY; TERMINATE; END; END.  ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################ # READ(VAR OK: BOOLEAN; DEST: IDENTIFIER; # # KIND: F; FATAL ERRORS:__ ; ODD ADDRESS, ; FATAL STACK VIOLATION (RED), ; TIMEOUT (NXM), ; PARITY ERROR, ; WARNING STACK VIOLATION. IITRAP = 010; ILLEGAL INSTRUCTIONS:__ ; "JMP R", ; "JSR M,R", ILEKIND; PROTECT: BOOLEAN) # ############################################" "INSERT PREFIX HERE" VAR OK, OLDFILE: BOOLEAN; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT (' READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOL ; USER MODE "HALT", ; RESERVED OPCODES:__ ; 000007 - 000077 ; 000210 - 000227 ; 007000 - 007777 ; 075000 - 076777 ; 106400 - 107777 ;<01> AND FLOATING POINT IF NO FPU!! TBTRAP = 014; T-BITEAN)(:10:)'); WRITETEXT('USING(:10:)'); WRITETEXT (' FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE) (:10:)'); OK:= FALSE; END; END; PROCEDURE SAVEFILE(LENGTH: INTEGER); VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF OLDFILE THEN ID:= 'REPLACE ' ELSE ID:= 'CREATE '; END; LIST(.3.):= PARAM(.2.); WITH LIST(.4.) DO BEGIN TAG:= INT TRAP (NOT USED) IOTRAP = 020; IOT TRAP (KERNEL CALL) PFTRAP = 024; POWER FAILURE EMTRAP = 030; EMULATOR TRAP (NOT USED) TRTRAP = 034; TRAP INSTRUCTION (USED BY INTER- ; PRETER TRACE) UNITNO = 040 ;<01> UNIT NUMBER FOR RK05 DISK (RKDA IMAGE) RESTRT = 042 ;<01> PLACE TO RESTART AFTER CRASH TITRAP = 060; CONSOLE TTY (LT33) INPUTATE; END; END. ER; VAR BLOCK: UNIV PAGE); TYPE; INT:= LENGTH END; LIST(.5.):= PARAM(.3.); LIST(.6.):= PARAM(.4.); RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('READ:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('DISK FILE LOST (:10:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; BEGIN WITH PARAM(.2.) DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, OLDFILE); IF OLDFILE & ATTR.PROTECTED THEN ERROR('FILE PROTECTED (:10:)'); END; WITH PARAM(.3.) DO IF TAG <> IDTYPE THEN INTRPT. TOTRAP = 064; CONSOLE TTY (LT33) OUTPUT INTRPT. CLTRAP = 100; CLOCK (KW11-L) INTERRUPT LPTRAP = 200; LINE PRINTER (LPXX) INTERRUPT RKTRAP = 220; DISK (RK11) INTERRUPT TMTRAP = 224; MAG TAPE (TM11) INTERRUPT CDTRAP = 230; CARD READER (CD11) INTERRUPT PITRAP = 240; PROGRAMMING INTERRUPT REQUEST 1: DO NOT REWIND THE SYSTEM TAPE $.DBVC = 0; 1: VERIFY PRELIMINARY CORE CLEARING $.DBIT = 0; 1: INCLUDE INTERPRETER TRACE ;* ;* MACRO TO TERMINATE KERNEL ERROR PROCESSING ;* .MACRO SYSERR TEXT ;<01> A LITTLE MORE HELPFUL .IF NE $.DBCD JMP $.DBDC .ENDC .IF EQ $.DBCD JSR R0,$SERR .ASCII \TEXT\<200> .EVEN .ENDC .ENDM SYSERR ;* ;* MACRO TO SET 'JMP DUMP' IN LOCATION 0 ;* ; PRINT(BASEADDR); JSR PC,$.DB04 ; MOV #TOP16,$.DB03 ; PRINT(TOP); JSR PC,$.DB04 ; MOV #FREE16,$.DB03 ; PRINT(FREE); JSR PC,$.DB04 ; RTS PC ; END; 1$: .WORD BASE16 ; ;* ;* $.DB10: .WORD 0 ; PROCEDURE PRINTQUEUE(Q); $.DB11: MOV #$.DB10,$.DB03 ; PRINT(@Q); JSR PC,$.DB04 ; .MACRO SETDMP $$ = ZERO .IF NE $.DBCD $$ = $.DBDC .ENDC MOV #<$$-4>,ZERO+2 .ENDM SETDMP ;* ;* MACRO TO VERIFY CORE CONTENTS ;* .MACRO VERCOR .IF NE $.DBVC .IF NE $.DBCD JSR PC,$.DBDC .ENDC .IF EQ $.DBCD JSR PC,$.DBCV .ENDC .ENDC .ENDM VERCOR ;* ;* MACRO TO PRINT KERNEL STATE ;* .MACRO KNSTAT .IF NE $.DBPS JSR PC,$.DBSP MOV $.DB10,$.DB06 ; PRINT IT; MOV #<.QUEUETYPE/2>,$.DB07 ; 1$: JSR PC,$.DB08 ; MOV @$.DB06,$.DB06 ; CMP $.DB06,$.DB10 ; BNE 1$ ; RTS PC ; END; ;* ;* $.DB12: .WORD 0 ; PROCEDURE PRINTTIME(T); $.DB13: MOV $.DB12,$.DB06 ; PRINT IT; MOV #<.TIME/2>,$.DB07 ; JSR PC,$.DB08 ; .ENDC .ENDM KNSTAT ;* ;* MACRO TO TYPE CURRENT RUNNING PROCESS ;* .MACRO KNSERV .IF NE $.DBST JSR PC,$.DBTS .ENDC .ENDM KNSERV ;* ;* MACRO TO TRACE GET AND PUT OPERATIONS ON PROCESS QUEUES ;* .MACRO QTRACE OP .IF NE $.DBST .IF IDN OP,GET JSR PC,$.DBTG .ENDC .IF IDN OP,PUT JSR PC,$.DBTP .ENDC .ENDC .ENDM QTRACE ;* ;* MACRO TO SIMULATE CLOCK INTERRUPT BY TH RTS PC ; END; ;* ;* $.DB14: ; PROCEDURE PRINTCLOCK; MOV #NOW7,$.DB12 ; PRINTTIME(NOW); JSR PC,$.DB13 ; MOV #NEXTT7,$.DB10 ; PRINTQUEUE(NEXTTIME.AWAITING) JSR PC,$.DB11 ; RTS PC ; END; ;* ;* $.DB15: ; PROCEDURE PRINTCORE; MOV #USER99,R1 ; PRINT(HEADADDR DIV 64); E TELETYPE BELL KEY ;* .MACRO BLTICK .IF NE $.DBNC $$ = CLOCK8 .ENDC .ENDM BLTICK ;* ;* ;**** PROCEDURES TO TYPE SERVICE TRACES ***** ;* ;* .IF NE $.DBST ;* ;* TYPE CURRENT RUNNING PROCESS ;* $.DBTS: MOV #1$,$.DB00 MOV USER99,$.DB01 BR $.DB02 1$: .ASCIZ <13.><10.>/SERVICE/ .EVEN ;* ;* TYPE PROCESS DEPARTURES ;* $.DBTG: MOV #1$,$.DB00 MOV GET4R,$.DB01 BR $.DB02 1$: .ASCIZ <13.>< CLR R0 ; DIV #64.,R0 ; MOV R0,1$ ; MOV #1$,$.DB03 ; JSR PC,$.DB04 ; MOV #COREC9,$.DB03 ; PRINT(CORECAPACITY); JSR PC,$.DB04 ; MOV #TOP9,$.DB03 ; PRINT(TOP); JSR PC,$.DB04 ; MOV #FREE9,$.DB03 ; PRINT(FREE); JSR PC,$.DB04 ; RTS 10.>/DEPARTURE/ .EVEN ;* ;* TYPE PROCESS ARRIVALS ;* $.DBTP: MOV #1$,$.DB00 MOV NEWEL4,$.DB01 BR $.DB02 1$: .ASCIZ <13.><10.>/ARRIVAL/ .EVEN ;* ;* $.DB00: .WORD 0 $.DB01: .WORD 0 $.DB02: MOV STAT28,$.DB31 MOV OUTL28,$.DB32 MOV ECHO28,$.DB33 MOV $.DB00,TEXT33 JSR PC,WRIT33 MOV $.DB01,NN34 JSR PC,WRIT34 MOV $.DB31,STAT28 CMP $.DB31,#WRIT28 BNE 2$ MO; POP(LINE, RESULT); END ELSE IF STATE = TOOBIG THEN RESULT:= CODELIMIT ELSE RESULT:= CALLERROR; IF ANY THEN BEGIN GET(LASTID); OPEN(LASTID, STATE) END; END; END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN INSTREAM.READ(C) END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN OUTSTREAM.WRITE(C) END; PROCEDURE ENTRY OPEN (F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); BEGIN FILES(.F.).OPEN(ID, FOUND) END; PROCEDURE ENTRY CLOSE(F: FILE); BEGIN FILES(.F.).CLOSE END; PROCEDUT,KNLPSW . = ZERO+IOTRAP ;KERNELCALL TVDEF KNCALL,KNLPSW .IF NDF,F$PU ;<01> . = ZERO+EMTRAP ;<01> USED BY GETPSW MACRO TVDEF EMTPRO,KNLPSW ;<01> RETURN PSW IN R0 .ENDC ;<01> . = ZERO+UNITNO ;<01> DUMMY THIS WORD .WORD 0 ;<01> FOR RE-BOOT PURPOSES . = ZERO+RESTRT ;<01> RESTART KINDNESS JMP @#$RVM0 ;<01> CALLS SYSTEM INIT ROUTINE . = ZERO+TITRAP ;LT33TERMINAL.READINTERRUPT TVDEF LTIN32V $.DB32,OUTL28 MOV $.DB33,ECHO28 RTS PC 2$: MOV #1$,TOTRAP BIS #INEN28,WRST28 SPL 0 WAIT SPL 7 RTS PC 1$: MOV #LTOU32,TOTRAP RTI $.DB31: .WORD 0 $.DB32: .WORD 0 $.DB33: .WORD 0 .ENDC ;* ;* ;**** PROCEDURES TO PRINT THE KERNEL STATE ***** ;* ;* .IF NE $.DBPS+$.DBVC+$.DBIT $.DB03: .WORD 0 ; PROCEDURE PRINT(VAR I: ; ,KNLPSW . = ZERO+TOTRAP ;LT33TERMINAL.WRITEINTERRUPT TVDEF LTOU32,KNLPSW . = ZERO+CLTRAP ;CLOCK INTERRUPT TVDEF CLKINT,KNLPSW . = ZERO+LPTRAP ;LPXXPRINTER.INTERRUPT TVDEF LPIN32,KNLPSW . = ZERO+RKTRAP ;RK11DISK.INTERRUPT TVDEF RKIN32,KNLPSW . = ZERO+TMTRAP ;TM11TAPE.INTERRUPT TVDEF TMIN32,KNLPSW . = ZERO+CDTRAP ;CD11CARDREADER.INTERRUPT TVDEF CDIN32,KNLPSW . = INTEGER); $.DB04: MOV #1$,R3 ; MOV #6.,R4 ; CONVERT TO OCTAL; MOV #8.,R2 ; JSR PC,$.DB05 ; MOV #5.,R4 ; CONVERT TO DECIMAL; MOV #10.,R2 ; JSR PC,$.DB05 ; 7$: TST LPS ; READY THE PRINTER; BGE 2$ ; MOV #3$,TEXT33 ; JSR PC,WRI ZERO+FPTRAP ;REAL INTERRUPT TVDEF FPPINT,KNLPSW ;* ;* END THE TRAP VECTOR AREA ;* . = ZERO+TVAEND ;MOVE TO END OF TRAP VECTORS ;* ;* .SBTTL DEFINITIONS OF THE KERNEL STACK ;**** KERNEL STACK DEFINITIONS ***** ;* ;* KSTKSZ = 32.; SIZE OF THE STACK, WORDS. ;* ;* KSTTOP = .; ABSOLUTE STACK TOP .BLKW KSTKSZ; KSR0: .WORD 0 ;<01> REGISTER STORAGE AREA KSR1: .WORD 0 ;<01> KSR2: .WORD 0 ;<01T33 ; 4$: TST LPS ; BLT 4$ ; 2$: TSTB LPS ; BGE 2$ ; MOV #5$,R1 ; 6$: MOVB (R1)+,LPB ; PRINT INTEGER VALUES; TSTB LPS ; BMI 6$ ; RTS PC ; END; 5$: .BLKB <1+5+1+6> 1$: .ASCII <10.> 3$: .ASCIZ <13.><10.>/READY THE PRINTER/ > KSR3: .WORD 0 ;<01> KSR4: .WORD 0 ;<01> KSR5: .WORD 0 ;<01> KSOPC: .WORD 0 ;<01> PC KSOPSW: .WORD 0 ;<01> PSW KSTBOT = .; STACK BOTTOM .SBTTL DEFINE PRIMITIVE DATA TYPES ;**** LENGTHS OF THE PASCAL PRIMITIVE DATA TYPES ***** ;* ;* .INTEGER= 2.; BYTES ;* ;* .REAL = 8.; BYTES ;* ;* .BOOLEAN= 2.; BYTES ;* ;* .CHAR = 2.; BYTES ;* ;* .ADDRESS= 2.; .EVEN $.DB29 = 5$ $.DB30 = 7$ $.DB05: MOV @$.DB03,R1 ; CONVERT INTEGER TO ASCII; 1$: CLR R0 DIV R2,R0 ADD #'0,R1 MOVB R1,-(R3) MOV R0,R1 SOB R4,1$ MOVB #' ,-(R3) RTS PC $.DB27: ; PROCEDURE GRABPRINTER; MOV #12.,$.DB29 ; NEW PAGE; JSR PC,$.DB30 ; RTS PC ; END; $.DB28: BYTES ;* ;*********************************************************************** ;* ;* ANTICIPATE SOME KERNEL DATATYPE LENGTHS ;* ;* .TIME = 4.; BYTES ;* ;* .GATE = 6.; BYTES ;* ;* .QUEUETY= 4.; BYTES ;* ;* .HEADTYP= 36.; BYTES ;* ;* .REGTYPE= 36.; BYTES ;* ;* .MAPTYPE= 16.; BYTES ;* ;****************************************************** ; PROCEDURE RELEASEPRINTER; 1$: TSTB LPS ; RELEASE IT; BGE 1$ ; TST USER29 ; BNE 2$ ; MOV #3$,LPTRAP ; BIS #INEN29,STAT29 ; SPL 0 ; WAIT ; SPL 7 ; 2$: RTS PC ; 3$: MOV #LPIN32,LPTRAP ; ***************** ;* ;* MACROS TO CHECK DATATYPE LENGTHS ;* ;* .MACRO GENERR A,B,C,D,E .ERROR A''B''C''D''E .ENDM .MACRO CHKDTL SYM $ = $ - SYM .IF NE $ - .'SYM GENERR $,<;>,,SYM,<", ABOVE.> .ENDC .ENDM ;* ;* .SBTTL DEBUGGING FACILITIES ;**** DEFINITIONS OF DEBUGGING SWITCHES AND MACRO'S ***** ;* ;* DEFINE THE DEBUGGING STATE: ;* ;* NORMALLY ALL OF THE SWITCHES, BELOW, WILL HAVE THE ;* RTI ; END; ;* ;* $.DB06: .WORD 0 ; PRINT AN ARRAY OF INTEGERS; $.DB07: .WORD 0 $.DB08: MOV $.DB06,$.DB03 MOV $.DB07,R0 1$: MOV R0,2$ JSR PC,$.DB04 ADD #2,$.DB03 MOV 2$,R0 SOB R0,1$ RTS PC 2$: .WORD 0 .ENDC .IF NE $.DBPS ;* ;* PRINT THE KERNEL STATUS: ;* $.DB09: ; PROCEDURE PRINTNEWCORE; MOV #1$,$.DB03 VALUE 0. ;* $.DBPS = 0; 1: PRINT THE KERNEL STATE $.DBNC = 0; 1: NO CLOCK INTERRUPTS: THE BELL ; OF THE CONSOLE TELETYPE WILL ; SIMULATE A CLOCK INTERRUPT. $.DBST = 0; 1: TYPE SERVICE TRACE $.DBCD = 0; 1: INCLUDE THE CORE DUMP FACILITY $.DBTA = 0; 1: LOAD OPERATING SYSTEM FROM TAPE 0 $.DBLT = 0; jlnprtm9;=?ACEGIKMO>@B_acegQSUWY[]`bdfPRTVXZ\^{}ikmoqsuwy|~hjlnprtvxz     '!#% "$& 3); INIT FLOW(TYPEUSE, WAITING, TASKLIST, WATCH); INCLUDE('LOG ', 4); INIT LOG(TYPEUSE, WAITING, TASKLIST, WATCH); END; INIT SCHEDULE(WAITING), CLOCKPULSE(WATCH, SCHEDULE), OPERATOR(TYPEUSE, TASKLIST, WATCH, SCHEDULE); END. KCATALOG; SLOWIO: LINEBUFFER; BUFFER: PAGEBUFFER; REQUEST, RESPONSE: ARGBUFFER; STACK: PROGSTACK; IOTASK: TASKKIND); "PROGRAM DATA SPACE = " +2000 TYPE FILE = 1..1; VAR OPERATOR: TERMINAL; OPSTREAM: TERMINALSTREAM; IOSTREAM: CHARSTREAM; IOFILE: DATAFILE; CODE: PROGFILE2; PROGRAM DRIVER(VAR PARAM: ARGLIST; STORE: PROGSTORE2); ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH, MARK, RELEASE, IDENTIFY, ACCEPT, DISPLAY, READPAGE, WRITEPAGE, READLINE, WRITELINE, READARG, WRITEARG, LOOKUP, IOTRA<~p, 4 ""* ;"  @: N > R" G" ^@ : >" G"F _  "" >"   P0>   L" X " \, \8 k d* mr$ {NSFER, IOMOVE, TASK, RUN; PROCEDURE CALL(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); VAR STATE: PROGSTATE; LASTID: IDENTIFIER; BEGIN WITH CODE, STACK DO BEGIN LINE:= 0; OPEN(ID, STATE); IF (STATE = READY) & SPACE THEN BEGIN PUSH(ID); DRIVER(PARAM, STORE); POP(LINE, RESULT); END ELSE IF STATE = TOOBIG THEN RESULT:= CODELIMIT ELSE RESULT:= CALLERROR; IF ANY THEN BEGIN GET(LASTID); OPEN(LASTID, ST" }"$  " P>" >"$  " P>" B"$  X"$  X"" """4 "  4 F"  . " &"  "    &" 8T  V20 >"   |l ::r Z ;Z6 ;Z6 . $ J J@ @$(,.) f   z*    (@,*|) f  " `$  *( " " V@  x " >" ""  *:  J x"8  "$  *0 (  $( $0 <@$4h4D$( D$P 1 OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; "########################## # PROCESSQUEUE AND FIFO # ##########################" CONST PROCESSCOUNT = 8; TYPE PROCESSQUEUE = ARRAY (.1..PROCESSCOUNT.) OF QUEUE; TYPE FI"  BH `  " `,     d> $N"  $JD$N" JD" : : n  K f    x @FO = CLASS(LIMIT: INTEGER); VAR HEAD, TAIL, LENGTH: INTEGER; FUNCTION ENTRY ARRIVAL: INTEGER; BEGIN ARRIVAL:= TAIL; TAIL:= TAIL MOD LIMIT + 1; LENGTH:= LENGTH + 1; END; FUNCTION ENTRY DEPARTURE: INTEGER; BEGIN DEPARTURE:= HEAD; HEAD:= HEAD MOD LIMIT + 1; LENGTH:= LENGTH - 1; END; FUNCTION ENTRY EMPTY: BOOLEAN; BEGIN EMPTY:= (LENGTH = 0) END; FUNCTION ENTRY FULL: BOOLEAN; BEGIN FULL:= (LENGTH = LIMIT) END; BEGIN HEAD:= 1; TAIL:= 1; LENGTH:= 0 END; "############# # RESOURCE # ###########&i" `"L  "8p D$,hLb"Th"*xL   "  $(~L    $" L  "b " `L     f   0    @$ 4h  4D$LATE) END; END; END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN IOSTREAM.READ(C) END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN IOSTREAM.WRITE(C) END; PROCEDURE ENTRY OPEN (F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); BEGIN IOFILE.OPEN(ID, FOUND) END; PROCEDURE ENTRY CLOSE(F: FILE); BEGIN IOFILE.CLOSE END; PROCEDURE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN IOFILE.READ(P, BLOCK) END; PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN IOFILE.WRITE(P, BLOCK) END; FUNCTION ENTRY L0    l ,N r   \ h    "F   ^X  X (Z  " T0 x T 2b 0B"  B LZ   H >" Z  * T0 T^ENGTH(F: FILE): INTEGER; BEGIN LENGTH:= IOFILE.LENGTH END; PROCEDURE ENTRY MARK(VAR TOP: INTEGER); BEGIN TOP:= ATTRIBUTE(HEAPTOP) END; PROCEDURE ENTRY RELEASE(TOP: INTEGER); BEGIN SETHEAP(TOP) END; PROCEDURE ENTRY IDENTIFY(HEADER: LINE); BEGIN OPSTREAM.RESET(HEADER) END; PROCEDURE ENTRY ACCEPT(VAR C: CHAR); BEGIN OPSTREAM.READ(C) END; PROCEDURE ENTRY DISPLAY(C: CHAR); BEGIN OPSTREAM.WRITE(C) END; PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN); BEGIN BUFFER.READ(BLOCK, EOF) END; PROCEDURERE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN FILES(.F.).READ(P, BLOCK) END; PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN FILES(.F.).WRITE(P, BLOCK) END; FUNCTION ENTRY LENGTH(F: FILE): INTEGER; BEGIN LENGTH:= FILES(.F.).LENGTH END; PROCEDURE ENTRY MARK(VAR TOP: INTEGER); BEGIN TOP:= ATTRIBUTE(HEAPTOP) END; PROCEDURE ENTRY RELEASE(TOP: INTEGER); BEGIN SETHEAP(TOP) END; PROCEDURE ENTRY IDENTIFY(HEADER: LINE); BEGIN OPSTREAM.RESET(HEADER) END; PROCEDURE ENTRY ACCEPT(VAR C ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN); BEGIN BUFFER.WRITE(BLOCK, EOF) END; PROCEDURE ENTRY READLINE(VAR TEXT: LINE); BEGIN SLOWIO.READ(TEXT) END; PROCEDURE ENTRY WRITELINE(TEXT: LINE); BEGIN SLOWIO.WRITE(TEXT) END; PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE); BEGIN REQUEST.READ(ARG) END; PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE); BEGIN RESPONSE.WRITE(ARG) END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) ENzt | ~ ^`ikmX\  ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}: CHAR); BEGIN OPSTREAM.READ(C) END; PROCEDURE ENTRY DISPLAY(C: CHAR); BEGIN OPSTREAM.WRITE(C) END; PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN); BEGIN INBUFFER.READ(BLOCK, EOF) END; PROCEDURE ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN); BEGIN OUTBUFFER.WRITE(BLOCK, EOF) END; PROCEDURE ENTRY READLINE(VAR TEXT: LINE); BEGIN END; PROCEDURE ENTRY WRITELINE(TEXT: LINE); BEGIN END; PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE); BEGIN IF S = INP THEN INRESPONSE.READ(ARG) (NUMBER) "############### # JOBSERVICE # ###############" CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); ELSE OUTRESPONSE.READ(ARG); END; PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE); BEGIN IF S = INP THEN INREQUEST.WRITE(ARG) ELSE OUTREQUEST.WRITE(ARG); END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) END; PROCEDURE ENTRY IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE); BEGIN IF DEVICE = DISKDEVICE THEN BEGIN DISKUSE.REQUEST; IO(BLOCK, PARAM, DEVICE); DISKUSE.RELEASE; END ELSE 6    > 0*  4Z G   "B Y ` X " "  " ^" "B i" ,"" o"B  d "  X X6( " ^""  IO(BLOCK, PARAM, DEVICE); END; PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); BEGIN IO(PARAM, PARAM, DEVICE) END; FUNCTION ENTRY TASK: TASKKIND; BEGIN TASK:= JOBTASK END; PROCEDURE ENTRY RUN (ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); BEGIN CALL(ID, PARAM, LINE, RESULT) END; PROCEDURE INITIALIZE; VAR I: INTEGER; PARAM: ARGLIST; LINE: INTEGER; RESULT: RESULTTYPE; BEGIN INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR), INSTREAM(INBUFFER), OUTST HELP; WRITE(NL); RELEASE; END; END; "#################### # INITIAL PROCESS # ####################" VAR TYPEUSE: RESOURCE; WAITING: TASKQUEUE; TASKLIST: TASKSET; WATCH: CLOCK; SCAN, FLOW, LOG: TASKPROCESS; SCHEDULE: TIMETABLE; CLOCKPULSE: CLOCKPROCESS; OPERATOR: OPERATORPROCESS; BEGIN INIT TYPEUSE, WAITING, TASKLIST, WATCH; WITH TASKLIST DO BEGIN INCLUDE('SCAN ', 2); INIT SCAN(TYPEUSE, WAITING, TASKLIST, WATCH); INCLUDE('FLOW ',REAM(OUTBUFFER); INSTREAM.INITREAD; OUTSTREAM.INITWRITE; FOR I:= 1 TO MAXFILE DO INIT FILES(.I.)(TYPEUSE, DISKUSE, CATALOG); INIT CODE(TYPEUSE, DISKUSE, CATALOG); WITH PARAM(.2.) DO BEGIN TAG:= IDTYPE; ARG:= 'CONSOLE ' END; CALL('DO ', PARAM, LINE, RESULT); OPERATOR.WRITE('JOBPROCESS:(:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "############## # IOPROCESS # ##############" TYPE IOPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); """ "~  r  0 " ^ " R  (`\"  `(  ' " " F N  ~  @  0 " ^ " ^ `\"  PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PACEGIKMO9;=?B>@]_acegQSUWY[^`bdfPRTVXZ\y{}ikmoqsuwz|~hjlnprtvx     %'!#& "$)+-/13579;=?*,.### # CARDPROCESS # ################" TYPE CARDPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; TEXT: LINE; PARAM: IOPARAM; OK: BOOLEAN; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= INPUT; CYCLE REPEAT IO(TEXT, PARAM, CARDDEVICE); CASE PARAM.STATUS OF COMPLETE: OK:= TRUE; INTERVENTION, FAILURE: BEGIN OK:= FALSE; WAIT END; TRANSMISSION: BEGIN OPERATOR.WRITE('CARDS: (:10:UT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSE)', 'ERROR(:10:)'); OK:= FALSE; END END; UNTIL OK; BUFFER.WRITE(TEXT); END; END; "################### # PRINTERPROCESS # ###################" TYPE PRINTERPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; PARAM: IOPARAM; TEXT: LINE; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= OUTPUT; CYCLE BUFFER.READ(TEXT); IO(TEXT, PARAM, PRINTDEVICE); IF PARAM.STATUS <> COMPLETE THEN BEGIN OPERATOR.WRITT2( " >" "   X&*X   * 0 (.26x< (  ""* "" `4 ," " E('PRINTER: (:10:)', 'INSPECT(:10:)'); REPEAT WAIT; IO(TEXT, PARAM, PRINTDEVICE); UNTIL PARAM.STATUS = COMPLETE; END; END; END; "################## # LOADERPROCESS # ##################" TYPE LOADERPROCESS= PROCESS(DISKUSE: RESOURCE); CONST SOLOADDR = 24; VAR PARAM: IOPARAM; PROCEDURE INITIALIZE(PAGENO: UNIV IOARG); BEGIN WITH PARAM DO BEGIN OPERATION:= CONTROL; ARG:= PAGENO; END; END; BEGIN INITIALIZE(SOLOADDR); "AWAIT BEL SIGNAL" IO(PARAM, PARAM0 V28 >"   0B" "r$   (  " 2*^(*X FrDISKINPUT: DISKOUTPUT: FILE UNKNOWN NEXT FILE LIMIT  "" `4 ," " , TYPEDEVICE); "LOAD SOLO SYSTEM" DISKUSE.REQUEST; IO(PARAM, PARAM, DISKDEVICE); DISKUSE.RELEASE; END; "#################### # INITIAL PROCESS # ####################" VAR TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER, OUTBUFFER: PAGEBUFFER; CARDBUFFER, PRINTERBUFFER: LINEBUFFER; INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE: ARGBUFFER; INSTACK, OUTSTACK, JOBSTACK: PROGSTACK; READER: CARDPROCESS; WRITER: PRINTERPROCESS; PRODUCER, CONSUMER: IOPROCESS; MASTER: J *   8r (R)x `   ,$ F : (J)  F*% " ".TvARBRCRDRERFRGRHRIRJRKRLRMRNRORPROBPROCESS; WATCHDOG: LOADERPROCESS; BEGIN INIT TYPEUSE, DISKUSE, CATALOG(TYPEUSE, DISKUSE, CATADDR), INBUFFER, OUTBUFFER, CARDBUFFER, PRINTERBUFFER, INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE, INSTACK, OUTSTACK, JOBSTACK, READER(TYPEUSE, CARDBUFFER), WRITER(TYPEUSE, PRINTERBUFFER), PRODUCER(TYPEUSE, DISKUSE, CATALOG, CARDBUFFER, INBUFFER, INREQUEST, INRESPONSE, INSTACK, INPUTTASK), CONSUMER(TYPEUSE, DISKUSE, CATALOG, PRINTERBUFFER, OUTBUFFER, OUTRQRRRSRTRURVRWRXRYRZR_R&0R1R2R3R4R5R6R7R8R9R&  J L"  .x f:x NFx L6Rx ^x    6T TNxD(Nx j B NxDv PC ; END; 1$: .WORD 0 ; ;* ;* $.DB16: .WORD 0 ; PROCEDURE PRINTHEAD(H); $.DB17: MOV $.DB16,$.DB06 ; PRINT IT; MOV #<.HEADTYPE/2>,$.DB07 ; JSR PC,$.DB08 ; RTS PC ; END; ;* ;* $.DB18: .WORD 0 ; PROCEDURE PRINTREG(R); $.DB19: MOV $.DB18,$.DB06 ; PRINT THEM; MOV #<.REGTYPE/2>,$.DB07 ; JSR PC,$. v @ NxDvj  b> NxDv&dDzV NxD< pCaF(HH@TRY AGAIN START(TASK, HOUR:MIN:SEC) PERIOD(TASK, HOUR:MIN:SEC) STOP(TASK) TIME(HOUR:MIN:SEC) SOLO TASK UNKNOWN TASK UNKNOWN EQUEST, OUTRESPONSE, OUTSTACK, OUTPUTTASK), MASTER(TYPEUSE, DISKUSE, CATALOG, INBUFFER, OUTBUFFER, INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE, JOBSTACK), WATCHDOG(DISKUSE); END.  TASK UNKNOWN TYPE COMMAND START PERIOD STOP TIME SOLO SCAN FLOW LOG v&dDzV NxD< pCaF(HH@TRY AGAIN START(TASK, HOUR:MIN:SEC) PERIOD(TASK, HOUR:MIN:SEC) STOP(TASK) TIME(HOUR:MIN:SEC) SOLO TASK UNKNOWN TASK UNKNOWN DB08 ; RTS PC ; END; ;* ;* $.DB20: .WORD 0 ; PROCEDURE PRINTMAP(M); $.DB21: MOV $.DB20,$.DB06 ; PRINT IT; MOV #<.MAPTYPE/2>,$.DB07 ; JSR PC,$.DB08 ; RTS PC ; END; ;* ;* $.DB22: ; PROCEDURE PRINTVIRTUAL; MOV #HARD10,$.DB20 ; PRINTMAP(HARDWAREMAP); JSR PC,$.DB21 ; MOV #Q; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "####### # IO # #######" "INSERT PREFIX HERE" VAR DRIVER: ARGTYPE; ARG: ARGLIST; OK: BOOLEAN; PD; PROCEDURE ENTRY IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE); BEGIN IF DEVICE = DISKDEVICE THEN BEGIN DISKUSE.REQUEST; IO(BLOCK, PARAM, DEVICE); DISKUSE.RELEASE; END ELSE IO(BLOCK, PARAM, DEVICE); END; PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); BEGIN IO(PARAM, PARAM, DEVICE) END; FUNCTION ENTRY TASK: TASKKIND; BEGIN TASK:= IOTASK END; PROCEDURE ENTRY RUN (ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); BEGROCEDURE INITWRITE; BEGIN IF TASK = INPUTTASK THEN IDENTIFY('INPUT: (:10:)') ELSE IDENTIFY('OUTPUT:(:10:)'); END; PROCEDURE WRITETEXT(TEXT: LINE); CONST NUL = '(:0:)'; VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> NUL DO BEGIN DISPLAY(C); I:= I + 1; C:= TEXT(.I.); END; END; PROCEDURE WRITEINT(INT, LENGTH: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= IN CALL(ID, PARAM, LINE, RESULT) END; PROCEDURE INITIALIZE; VAR PARAM: ARGLIST; LINE: INTEGER; RESULT: RESULTTYPE; BEGIN INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR), IOSTREAM(BUFFER), IOFILE(TYPEUSE, DISKUSE, CATALOG), CODE(TYPEUSE, DISKUSE, CATALOG); IF IOTASK = INPUTTASK THEN IOSTREAM.INITWRITE ELSE IOSTREAM.INITREAD; CALL('IO ', PARAM, LINE, RESULT); OPERATOR.WRITE('IOPROCESS: (:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "############# CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO LENGTH - DIGIT - 1 DO DISPLAY(' '); IF INT < 0 THEN DISPLAY('-') ELSE DISPLAY(' '); FOR I:= DIGIT DOWNTO 1 DO DISPLAY(NUMBER(.I.)); END; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; C: CHAR; BEGIN FOR I:= 1 TO IDLENGTH DO BEGIN C:= ID(.I.); IF C <> ' ' THEN DISPLAY(C); END; END; PROCEDURE CONVRESULT(RESULT: PROGRESULT; VAR ID: IDENTIFIER); BEGIN CASE RESULT OF TERMIN@6^ d@6^ 0 D @00 Z"@j@0^ D t@^ b`8DISK: ERROR PUSH RETURN JOBPREFIX JOBINPUT JOBOUTPUT JOBSERVICE JOBBUFFER1 JOBBUFFER2 JOB TEMP1 TEMP2 CARDS: ERROR JOB INPUT: TERMINATED JOB OUTPUT: TERMINATED PRINTER: INSPECT JOB STREAM: FILES MISSING       "$&!#%'02468:<>(*,.13579;=?)+-/LNPRTV@BDFHJMOQSUWACEGIKhjlnXZ\^`bdfikmoY[]_acegprtvxz|~qsuwy{} <x L" Hf6P  > X   ^  " `2   R 0R1R2R3R4R5R6R7R8R9R&t+R-R&dt8R8&b:B" R F """ X  ( " " ^<  >" "0 " " >"   P0>   L" X" BB `  V-| j " \( 2" "0  B   &D   2 d    (j @j X$`D  < " nn^:nX| %  * " `@  "  ^ $ * $* 0* <*| H*l T*\ `*L l*< x*, * Zhv0    f   n  X"" B "" lATED: ID:= 'TERMINATED '; OVERFLOW: ID:= 'OVERFLOW '; POINTERERROR: ID:= 'POINTERERROR'; RANGEERROR: ID:= 'RANGEERROR '; VARIANTERROR: ID:= 'VARIANTERROR'; HEAPLIMIT: ID:= 'HEAPLIMIT '; STACKLIMIT: ID:= 'STACKLIMIT '; CODELIMIT: ID:= 'CODELIMIT '; TIMELIMIT: ID:= 'TIMELIMIT '; CALLERROR: ID:= 'CALLERROR ' END; END; PROCEDURE WRITERESULT(ID: IDENTIFIER; LINE: INTEGER; RESULT: PROGRESULT); VAR ARG: IDENTIFIER; BEGIN WRITEIDd"(    0 . >L"B  ( "B  ( X * *B  ( *B  (  "B  (  *B  ( "B,$ ^B(ID); WRITETEXT(': LINE (:0:)'); WRITEINT(LINE, 4); DISPLAY(' '); CONVRESULT(RESULT, ARG); WRITEID(ARG); DISPLAY(NL); OK:= (RESULT = TERMINATED); END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE STARTIO; BEGIN OK:= TRUE; IF TASK = INPUTTASK THEN READARG(OUT, DRIVER) ELSE READARG(INP, DRIVER); IF DRIVER.TAG <> IDTYPE THEN ERROR('FILE IDENTIFIER MISSING (:10:)(:0:)'); INITWRITE; END; PROCEDURE TERMIO; VAR ARG: ARGTYPE; BLOCK: PAGE; EO `(  b " "  N  " " "$  B" ` 2 "" $"" '"" ,""9 b8 e   *B6 o  , *BF: BOOLEAN; BEGIN WITH ARG DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; IF TASK = INPUTTASK THEN BEGIN IF NOT OK THEN BEGIN BLOCK(.1.):= EM; WRITEPAGE(BLOCK, TRUE); END; WRITEARG(OUT, ARG); END ELSE BEGIN IF NOT OK THEN REPEAT READPAGE(BLOCK, EOF) UNTIL EOF; WRITEARG(INP, ARG); END; END; PROCEDURE SELECTDRIVER; VAR ATTR: FILEATTR; I: INTEGER; BEGIN WITH ARG(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; FOR I:= 2 TO MAXARG DO ARG(.I.).TAG:= NILTYP. x n"tnnBl"Bl"2.l" l t" "0  F   BB        ( 4 X$`D  <P  X2"+V@8@@^@(B4,2L2@2p2X2d2|220@0@0X0dV0`6^ ^  P  LZ  n dT tT" +X" 2 "" " 0 T2p 0B"  b > LV"  H B" | T n .  bX" :" ` #  "" >"   P0E; LOOKUP(DRIVER.ID, ATTR, OK); IF OK & (ATTR.KIND <> SEQCODE) THEN WITH DRIVER DO BEGIN ARG(.2.):= DRIVER; ID:= 'DISK '; LOOKUP(ID, ATTR, OK); END; IF NOT OK THEN ERROR('FILE UNKNOWN(:10:)(:0:)') ELSE IF ATTR.KIND <> SEQCODE THEN ERROR('NOT EXECUTABLE(:10:)(:0:)'); END; PROCEDURE CALLDRIVER; VAR HEAPTOP, LINENO: INTEGER; RESULT: PROGRESULT; BEGIN MARK(HEAPTOP); RUN(DRIVER.ID, ARG, LINENO, RESULT); IF RESULT <> TERMINATED THEN WRITERESULT(DRIVER.ID, LINENO>   L" X" BB `  " V -   " \,  V 8" " #^ V2@ . >" "F   : I  0M   r t | ~ p  $& #%!*<     ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdr u }  p `X     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegjlnprtv`bdfhH0. $#" >^ >"(,"B `  "&8" `"|  * ? ( (~" " ( (~ " " (  ( (NUMBER) "############## # JOBOUTPUT # ##############" CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; FUNCTION PREFIXLENGTH: INTEGER; PROCEDURE READPREFIX(PAGENO: INTEGER; VAR BLOCK: PAGE); PROCEDURE READSTREAM(VAR BLOCK: PAGE); PROCEDURE WRITELINE(TEXT: LINE); PROGRAM JOBOUTPUT; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; FIRSTCHAR = 24; LASTCHAR = 109; FIRSTLINE = 2; LASTLINE = 61;  ~"r (  (  ~" " H >H > H"(M|6" Z.  X " X#X2 $ "  ,], B" V" `6 > VAR PREFIXPAGES: INTEGER; BLOCK: PAGE; BLOCKLENGTH, INITLENGTH: INTEGER; IMAGE: LINE; CONTROLCHAR: SET OF CHAR; PROCEDURE INITPREFIX; VAR FOUND: BOOLEAN; C: CHAR; PAGENO, CHARNO, CHARS: INTEGER; BEGIN CHARS:= 0; FOR PAGENO:= 1 TO PREFIXLENGTH DO BEGIN READPREFIX(PAGENO, BLOCK); CHARNO:= 0; REPEAT CHARNO:= CHARNO + 1; C:= BLOCK(.CHARNO.); IF C = NL THEN CHARS:= CHARS + 5; UNTIL (CHARNO = PAGELENGTH) OR (C = EM); CHARS:= CHARS + CHARNO; END;  B"" `6  > f" `6 >   >" X" t.@d#X2 $ "  ,], B" V" `6 > 0Q   $ T   "" W " Z aR   F"f6:   " " ^ L tR  p "t$j  " " H LXR >     !#%' "$&;=?)+-/13579<>(*,.02468:WACEGIKMOQSU@BDFHJLNPRTV[]_acegikmoY\^`bdfhjlnXZwy{}qsuxz|~prtv     !#%' "$&;=?)+-/13579<>(*,.02468:WACEGIKMOQSU@BDFHJLNPRTV[]_acegikmoY\^`bdfhjlnXZwy{}qsuxz|~prtv#################### # SPASCAL MANUAL # #################### PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COMPILES A SEQUENTIAL PASCAL PROGRAM INPUT FROM A SOURCE MEDIUM, OUTPUTS A LISTING OF IT ON A DESTINATION MEDIUM, AND STORES THE CODE AS AN OBJECT FILE ON DISK. CALL: SPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) THE SOURCE CAN EITHER BE AN ASCII DISK FILE OR A SEQUENTIAL PROGRAM THAT INPUTS AN ASCII FILE. THE DESTINATION MUST BE A SEQUENTIAL PROGRAM THAT OUTPUTS AN ASCII FILE. THE OBJEC(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCT CAN EITHER BE AN EXISTING (UNPROTECTED) DISK FILE OR A NON-EXISTING FILE. IN THE FIRST CASE, THE EXISTING FILE IS REPLACED BY A A NEW ONE OF THE SAME NAME. IN THE SECOND CASE, A NEW FILE IS CREATED AND STORED ON DISK. IN BOTH CASES, THE OBJECT FILE WILL BE AN UNPROTECTED SEQUENTIAL CODE FILE. ERROR MESSAGES: TEMPORARY FILE MISSING: ONE OR MORE OF THE SCRATCH FILES (TEMP1, TEMP2, AND NEXT) USED BY THE COMPILER ARE MISSING ON THE DISK. COMPILATION ERRORS: THE PASCAL PROGRAM CONTAINS ERRORS OR THE COMRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUMPILER HAS EXCEEDED ITS TABLE LIMITS. SEE THE PROGRAM LISTING FOR FURTHER DETAILS. OBJECT FILE LOST THE FILE PROGRAM CALLED BY THE COMPILER FAILED TO CREATE OR REPLACE THE OBJECT FILE DUE TO A RUN-TIME ERROR. N DISK. IN BOTH CASES, THE OBJECT FILE WILL BE AN UNPROTECTED SEQUENTIAL CODE FILE. ERROR MESSAGES: TEMPORARY FILE MISSING: ONE OR MORE OF THE SCRATCH FILES (TEMP1, TEMP2, AND NEXT) USED BY THE COMPILER ARE MISSING ON THE DISK. COMPILATION ERRORS: THE PASCAL PROGRAM CONTAINS ERRORS OR THE COM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); DENTIFIER); VAR FOUND: BOOLEAN; BEGIN OPEN(F, ID, FOUND); IF NOT FOUND THEN ERROR('TEMPORARY FILE MISSING(:10:)(:0:)'); END; PROCEDURE SAVEFILE; VAR LENGTH, LINE: INTEGER; RESULT: PROGRESULT; BEGIN LENGTH:= (CODELENGTH + 511) DIV 512; WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF WHERE = NOWHERE THEN ID:= 'CREATE ' ELSE ID:= 'REPLACE '; END; WITH LIST(.3.) DO BEGIN TAG:= IDTYPE; ID:= OBJECT.ID E PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTND; WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; WITH LIST(.5.) DO BEGIN TAG:= IDTYPE; ID:= 'SEQCODE ' END; WITH LIST(.6.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('PASCAL:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('OBJECT FILE LOST(:10:)(:0:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN OK:= (TASK = JOBTASK); SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; 06 ,:*X"  * ^ nZ $ 0>*T  * ^ J $ 0z^ p  * ^ ^X $ 0"& "4E  ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################################### # SPASCAL(VAR OK: BOOLEAN; SOURCE, DEST,X 0 " 0 "$P""B  ( "B  ( "B  ( "$\   (  ", cB " B, ^&"  PXB OBJECT: IDENTIFIER) # ###############################################################" "INSERT PREFIX HERE" "THE PARAMETERS OF THE COMPILER PASSES HAVE THE FOLLOWING MEANING: LIST(.1.) : BOOLEAN (COMPILATION OK) LIST(.2.) : POINTER (HEAP POINTER) LIST(.3.) : INTEGER (CODE LENGTH) " VAR OK: BOOLEAN; SOURCE, DEST, OBJECT: ARGTYPE; CODELENGTH: INTEGER; WHERE: (NOWHERE, ONDISK); REPORT: (MAIN, OUTP); LIST: ARGLIST; PROCEDURE INITWRITE; BEGIN IDENTIFY('PASCAL:(:10:)'); REPORT:=  "B " 0 r t_      * 6 B Nn Z2 PASCAL: TERMINATED OVERFLOW POINTERERRORRANGEERROR VARIANTERRORHEAPLIMIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN MAIN; END; PROCEDURE WRITECHAR(C: CHAR); BEGIN IF REPORT = MAIN THEN DISPLAY(C) ELSE WRITE(C); END; PROCEDURE WRITETEXT(TEXT: LINE); CONST NUL = '(:0:)'; VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> NUL DO BEGIN WRITECHAR(C); I:= I + 1; C:= TEXT(.I.); END; END; PROCEDURE WRITEINT(INT, LENGTH: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS( SPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) TEMPORARY FILE MISSING CREATE REPLACE SEQCODE FILE PASCAL: OBJECT FILE LOST SOURCE FILE UNKNOWN SOURCE KIND MUST BE ASCII OR SEQCODE DESTINATION FILE UNKNOWN DESTINATION KIND MUST BE SEQCODE OBJECT FILE PROTECTED COMPILATION ERRORS TEMP1 TEMP2 SPASS1 SPASS2 SPASS3 SPASS4 SPASS5 SPASS6 NEXT SPASS7 MIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE TRY AGAIN REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO LENGTH - DIGIT - 1 DO WRITECHAR(' '); IF INT < 0 THEN WRITECHAR('-') ELSE WRITECHAR(' '); FOR I:= DIGIT DOWNTO 1 DO WRITECHAR(NUMBER(.I.)); END; PROCEDURE WRITEID(ID: IDENTIFIER); VAR I: INTEGER; C: CHAR; BEGIN FOR I:= 1 TO IDLENGTH DO BEGIN C:= ID(.I.); IF C <> ' ' THEN WRITECHAR(C); END; END; PROCEDURE CONVRESULT(RESULT: PROGRESULT; VAR ID: IDENTIFIER); BEGIN CASE RESULT OF TERMINAIDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN (:10:)(:0:)') ELSE CASE ATTR.KIND OF SCRATCH, CONCODE: ERROR('SOURCE KIND MUST BE ASCII OR SEQCODE(:10:)(:0:)'); ASCII, SEQCODE: END; END; DEST:= PARAM(.3.); WITH DEST DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('DESTINATION FILE UNKNOWN(:10:)(:0:)') ELSE IF ATTR.KIND <> SEQCODE THEN ERRORTED: ID:= 'TERMINATED '; OVERFLOW: ID:= 'OVERFLOW '; POINTERERROR: ID:= 'POINTERERROR'; RANGEERROR: ID:= 'RANGEERROR '; VARIANTERROR: ID:= 'VARIANTERROR'; HEAPLIMIT: ID:= 'HEAPLIMIT '; STACKLIMIT: ID:= 'STACKLIMIT '; CODELIMIT: ID:= 'CODELIMIT '; TIMELIMIT: ID:= 'TIMELIMIT '; CALLERROR: ID:= 'CALLERROR ' END; END; PROCEDURE WRITERESULT (ID: IDENTIFIER; LINE: INTEGER; RESULT: PROGRESULT); VAR ARG: IDENTIFIER; BEGIN WRITE('DESTINATION KIND MUST BE SEQCODE(:10:)(:0:)'); END; OBJECT:= PARAM(.4.); WITH OBJECT DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN WHERE:= NOWHERE ELSE IF ATTR.PROTECTED THEN ERROR('OBJECT FILE PROTECTED (:10:)(:0:)') ELSE WHERE:= ONDISK; END; END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; C: CHAR; BEGIN "COMPLETE SOURCE TEXT INPUT/OUTPUT:" REPEAT READ(C) UNTIL C = EM; WRITE(EM); READARG(INP, ARG); IF NOT ARG.BOOL THEN OCHAR(NL); WRITEID(ID); WRITETEXT(': LINE (:0:)'); WRITEINT(LINE, 4); WRITECHAR(' '); CONVRESULT(RESULT, ARG); WRITEID(ARG); WRITECHAR(NL); OK:= (RESULT = TERMINATED); END; PROCEDURE ERROR(TEXT: LINE); BEGIN INITWRITE; WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN (:10:)(:0:)'); WRITETEXT (' SPASCAL(SOURCE, DESTINATION, OBJECT: IDENTIFIER) (:10:)(:0:)'); OK:= FALSE; END; END; PROCEDURE OPENFILE(F: FILE; ID: I                       ' ) + - / 1 3 5 7 ! # % ( * , . 0 2 4 6 " x z | ~ n p r t v        #%'-X  8 V 8& X  J""R >" D T* .X   " /X   8 -X   8l " `>F 80l 1X   T22`2&  " `(  "b"$  "b"`"^"\"Z"& ZZ< \ Z L \^   (  b"   (  "   (  \"& ^XRK:= FALSE; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; END; PROCEDURE INITIALIZE; BEGIN WRITEARG(INP, SOURCE); WRITEARG(OUT, DEST); WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= NIL END; WITH LIST(.3.) DO BEGIN TAG:= INTTYPE; INT:= 0 END; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; PROCEDURE CALLPASS(ID: IDENTIFIER); VAR LINE: INTEGER; RESULT: PROGRESULT; BEGIN LIST( ` Z \$ `b` `"^"^ ^" b ^"& Z Z"^ Z " ZXR \ Z $ \^ \ \"Z"0   "" >"   P0>   L" X " \(  >" ` .1.).BOOL:= FALSE; RUN(ID, LIST, LINE, RESULT); IF RESULT <> TERMINATED THEN BEGIN REPORT:= OUTP; WRITERESULT(ID, LINE, RESULT); END ELSE BEGIN OK:= LIST(.1.).BOOL; CODELENGTH:= LIST(.3.).INT; IF NOT OK THEN ERROR('COMPILATION ERRORS(:10:)(:0:)'); END; END; BEGIN CHECKARG; IF OK THEN BEGIN OPENFILE(1, 'TEMP1 '); OPENFILE(2, 'TEMP2 '); IF OK THEN BEGIN INITIALIZE; CALLPASS('SPASS1 '); IF OK THEN CALLPASS('SPASS2 "$ d"&(" `2$ - dXvC dd d>"$ 4 dX2 V-  d d>"" @ P |" F , " L   $"T    &]   > '); IF OK THEN CALLPASS('SPASS3 '); IF OK THEN CALLPASS('SPASS4 '); IF OK THEN CALLPASS('SPASS5 '); IF OK THEN CALLPASS('SPASS6 '); IF OK THEN OPENFILE(2, 'NEXT '); IF OK THEN CALLPASS('SPASS7 '); CHECKIO; IF OK & (CODELENGTH > 0) THEN SAVEFILE; TERMINATE; END; CLOSE(1); CLOSE(2); END; END. " T a " L `~ J\Tb &8` ;f " , FT B"  T" ;R<R=R&6.R& R&+R&R&1R&*R&R&vR&f$R 8&"  ^ $ 0X  Zv  l T* *X B  " " 0 X  b" &8& 8&c  0X  Xd f -X Z "d . T* *X  %R&V'R(R&Ff&R8V8&6R*RR&&R*R0R&R R R R R&68& RRRRR8&68&68&,R8&.R/R-R8&-R8&&8&F8&8&vR.R&fR R8&FR R R " e@ 8g v  X   88D 8\ +X F  Rf8&" 8  FT* .X   " gX  0X x 84!V $lR, 8&   0X  R&VfvF&Ff0R8&6v8&&fF&&3R&R8&RRRRRRRR&8&8&4R R&5R6R8&v5RF&f80R.R*R8&Vf-R1R8&F68&fF0R8&67R8&&RR& RR  4 *X  ~  T0nR;v8& ""  n >" . vT* .X   " 2I X  r PW V8& d ' *X 4   VT0@R8&&8&68&8&8R8&84R9R:R7R8&4RF&RRR R!R"R#R&RRR&RRRRR&8&8&v/R8&fRRR&V/R8&668&68&)R&R*R&d 8B 8 2X  (>m &8 8j *X P @v 8B 8 2X 4  dP &88&  *^Z &8v 0X d 8 8X h *X  XR R&RR&v*RR&8&&0R-R*R8&8& R+R8&2R8&20 b   T0 2  T0  $  >" ">8V X p0 ^zP) f8V88&% 88& 8  XT" &X#" "" 0X J 2 3X!"  "  F T* *X r " +X x 8@$ X @ 8 80%L 1X fT: $XH % 8 zP6 V8&&r VT: 'X V&.@@ )X   88 88  8 *X  T>N 8 `Y  F8& V8& fT: $X R 8&"\ T* *X D " @ 8B T r z l  ^ P B 4 & L|P 8& l 4X$&J 'x(l  )ZR 8d  &X x  VT   `h  8& F&Xn X 4P *X  Tx`x  8& F& X r2N *X <$ Tx@  X*"" 8&n+ T* .X ~> " +X D 2" 4 1X  T v8& 8v,  5X X$v 6X8. ߌD - ߄- ߒX f8& 8 T V f X J < 6.      @n* 8 +X   B Xj " 8 ,X(W  2 R 8 ,X : 8 N@ & V8h 0" -X ߄p/ 0H1 \ fT* *X 2߄ " n2 1X ބ D'- ތ 68P, 7X zބ 82 . ݒB4f- ݌" 8, 8X ݄I      "                        r t v x z | ~ l n p        !#%'ROR=31; VARIABLE_ERROR=32; CONSTANT_ERROR=33; INTERFACE_ERROR=38; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=16; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; "AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 2: SYNTAX ANALYSIS OCTOBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPTXWAIT=23; XREAL=24; TYPE SPELLING_INDEX=0..SPELLING_MAX; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; LABEL=INTEGER; SYMBOL=EOM1..NEW_LINE1; SETS=SET OF SYMBOL; VAR INTER_PASS_PTR:PASSPTR; SY:SYMBOL; ARG:INTEGER; CURRENT_LABEL:LABEL; TEST:BOOLEAN; "KEY SETS" QIGNORE, QOPEN, QCLOSE, QEOM, QEND, QSEMICOLON, QBODY, QID, QDEFINITIONS, QROUTINES, QDECLARATIONS, QDEF, QDEC, QCONSION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTANT, QCONST_DEF, QTYPE, QTYPE_DEF, QSUBR_LIMIT, QDIMENSION, QOF_TYPE, QVAR_DEF, QBLOCK, QPARM_END, QID_LIST, QPROC_END, QPROC_PARMS, QFUNC_END, QFUNC_TYPE, QPROG_END, QFBLOCK, QPARM_LIST, QSTAT, QBODY_END, QENTRY, QSTAT_LIST, QID_END, QARGUMENT, QARG_END, QIF_END, QTHEN_END, QCASES, QCASE_END, QLABEL_LIST, TYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTE QDO_TAIL, QUNARY, QFACTOR, QEXPR, QUNTIL_TAIL, QFOR_END, QFORB_END, QEXPR_OP, QSEXPR_OP, QTERM_OP, QTERM_LIST, QFACTOR_LIST, QSET_EXPR, QSELECT, QSUB_END, QARG, QCOMMA, QVARIANT_PART, QTYPE_LIST, QWITH_LIST, QFIELD_LIST, QTO_TAIL, QFIELD_PACK, QID_SEMI, QVARIANT, QPROGRAM, QID_OPEN, QID_CASE, QSEMI_CASE,GER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=0; BEGIN1=1; IF1=2; CASE1=3; WHILE1=4; REPEAT1=5; FOR1=6; WITH1=7; ID1=8; REAL1=9; STRING1=10; INTEGER1=11; CHAR1=12; OPEN1=13; QLABEL_TAIL: SETS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_L NOT1=14; SUB1=15; SET1=16; ARRAY1=17; RECORD1=18; ARROW1=19; PERIOD1=20; STAR1=21; SLASH1=22; DIV1=23; MOD1=24; AND1=25; PLUS1=26; MINUS1=27; OR1=28; EQ1=29; NE1=30; LE1=31; GE1=32; LT1=33; GT1=34; IN1=35; CONST1=36; TYPE1=37; VAR1=38; PROCEDURE1=39; FUNCTION1=40; PROGRAM1=41; SEMICOLON1=42; IMIT; BEGIN PRINT_TEXT('PASS 2: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LI CLOSE1=43; UP_TO1=44; OF1=45; COMMA1=46; BUS1=47; COLON1=48; END1=49; FORWARD1=50; UNIV1=51; BECOMES1=52; THEN1=53; ELSE1=54; DO1=55; UNTIL1=56; TO1=57; DOWNTO1=58; LCONST1=59; MESSAGE1=60; NEW_LINE1=61; "OUTPUT OPERATORS" EOM2=1; CONST_ID2=2; CONST_DEF2=3; TYPE_ID2=4; TYPE_DEF2=5; VAR_ID2=6; VAR_LIST2=7; PROC_ID2=8; PROC_DEF2=9; LBL_END2NK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT =10; FORWARD2=11; FUNC_ID2=12; FUNC_DEF2=13; POINTER2=14; FUNC_TYPE2=15; PROG_ID2=16; PROG_DEF2=17; VARNT_END2=18; TYPE2=19; ENUM2=20; ENUM_ID2=21; ENUM_DEF2=22; SUBR_DEF2=23; SET_DEF2=24; ARRAY_DEF2=25; REC2=26; FIELD_ID2=27; FIELDLIST2=28; REC_DEF2=29; VARNT2=30; PARM_ID2=31; PARM_TYPE2=32; UNIV_TYPE2=33; CPARMLIST2=34; VPARMLIST2=35; BODY2=36; BODY_END2=37; ANAME2=38; = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIG STORE2=39; CALL_NAME2=40; CALL2=41; ARG_LIST2=42; ARG2=43; FALSEJUMP2=44; DEF_LABEL2=45; JUMP_DEF2=46; DEF_CASE2=47; CASE2=48; JUMP2=49; END_CASE2=50; ADDRESS2=51; FOR_STORE2=52; FOR_LIM2=53; FOR_UP2=54; FOR_DOWN2=55; WITH_VAR2=56; WITH_TEMP2=57; WITH2=58; VALUE2=59; LT2=60; EQ2=61; GT2=62; LE2=63; NE2=64; GE2=65; IN2=66; UPLUS2=67; IT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('2'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END UMINUS2=68; PLUS2=69; MINUS2=70; OR2=71; STAR2=72; SLASH2=73; DIV2=74; MOD2=75; AND2=76; FNAME2=77; NOT2=78; EMPTY_SET2=79; INCLUDE2=80; FUNCTION2=81; CALL_FUNC2=82; NAME2=83; COMP2=84; SUB2=85; ARROW2=86; CONSTANT2=87; REAL2=88; FREAL2=89; INTEGER2=90; FINTEGER2=91; CHAR2=92; FCHAR2=93; STRING2=94; FSTRING2=95; NEW_LINE2=96; LCO; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARGNST2=97; MESSAGE2=98; TAG_ID2=99; TAG_TYPE2=100; PART_END2=101; TAG_DEF2=102; LABEL2=103; CASE_JUMP2=104; "OTHER CONSTANTS" TEXT_LENGTH = 18; INFILE = 2; OUTFILE = 1; THIS_PASS=2; SPELLING_MAX=700; COMP_BLOCK=TRUE; ROUTINE_BLOCK=FALSE; "MODES" CLASS_MODE=1; MONITOR_MODE=2; PROCESS_MODE=3; PROC_MODE=4; PROCE_MODE=5; FUNC_MODE=6; FUNCE_MODE=7; PROGRAM_MODE=8; "ERRORS" PROG_ERROR=1; DEC_ERROR=2; CONSTDEF_ERR1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; "#############" "PASS ROUTINES" "#############" "PARSING ROUTINES" PROCEDURE PROGRAM_ ; FORWARD; PROCEDURE PREFIX(KEYS: SETS); FORWARD; PROCEDURE INTERFACE (KEYS: SETS); FORWARD; PROCEDURE PROG_HEADING (KEYS: SETS); FORWARD; PROCEDURE BLOCK (KEYS: SETS); FORWARD; PROCEOR=3; TYPEDEF_ERROR=4; TYPE_ERROR=5; ENUM_ERROR=6; SUBR_ERROR=7; SET_ERROR=8; ARRAY_ERROR=9; RECORD_ERROR=10; STACK_ERROR=11; VAR_ERROR=12; ROUTINE_ERROR=13; PROC_ERROR=14; FUNC_ERROR=15; WITH_ERROR=16; PARM_ERROR=17; BODY_ERROR=18; STATS_ERROR=19; STAT_ERROR=20; IDSTAT_ERROR=21; ARG_ERROR=22; COMP_ERROR=23; IF_ERROR=24; CASE_ERROR=25; POINTER_ERROR=36; WHILE_ERROR=27; REPEAT_ERROR=28; FOR_ERROR=29; PREFIX_ERROR=37; EXPR_ERDURE DECLARATIONS (KEYS: SETS); FORWARD; PROCEDURE CONST_DEC (KEYS: SETS); FORWARD; PROCEDURE TYPE_DEC (KEYS: SETS); FORWARD; PROCEDURE TYPE_ (KEYS: SETS); FORWARD; PROCEDURE ENUM_TYPE (KEYS: SETS); FORWARD; PROCEDURE SUBR_TYPE (KEYS: SETS); FORWARD; PROCEDURE SET_TYPE (KEYS: SETS); FORWARD; PROCEDURE ARRAY_TYPE (KEYS: SETS); FORWARD; PROCEDURE RECORD_TYPE (KEYS: SETS); FORWARD; PROCEDURE FIELD_LIST (KEYS: SETS); FORWARD; PROCEDURE VARIANT_PART (KEYS: SETS); FORWARD; PROCEQID_CASE OR (.OPEN1, CLOSE1.); QFBLOCK := QBLOCK OR (.FORWARD1.); GET END; PROCEDURE ERROR(NUMBER:INTEGER; KEYS:SETS); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); WHILE NOT (SY IN KEYS) DO GET END; PROCEDURE CHECK(NUMBER:INTEGER; KEYS:SETS); BEGIN IF NOT (SY IN KEYS) THEN ERROR(NUMBER,KEYS) END; PROCEDURE NEW_LABEL(VAR L:LABEL); BEGIN CURRENT_LABEL:=CURRENT_LABEL+1; L:=CURRENT_LABEL END; "#######" "PROGRAM" "#######" PROCEDURE PROGRAM_; BEGIN PREFIX(QB IF SY=OF1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2); DONE := FALSE; REPEAT VARIANT(LKEYS2); CHECK(RECORD_ERROR, LKEYS2); IF SY IN QVARIANT THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2) ELSE DONE := TRUE UNTIL DONE; PUT0(PART_END2) END; PROCEDURE VARIANT; BEGIN PUT0(VARNT2); LABEL_LIST(KEYS OR QFIELD_PACK, LABEL2, RECORD_ERROR); IF SY=OPEN1 THEN GET ELSE ERROR(RECORD_ERROR, KEYS OR QID_CASE OR QCLOSE); FIELD_LIST(KEYS OLOCK OR QEOM); BLOCK(QEOM); IF SY=PERIOD1 THEN GET ELSE ERROR(PROG_ERROR,QEOM); IF SY<>EOM1 THEN ERROR(PROG_ERROR,QEOM); PUT0(EOM2) END; PROCEDURE PREFIX; VAR LKEYS1: SETS; BEGIN LKEYS1:=KEYS OR QDEFINITIONS OR QROUTINES OR QPROGRAM; CHECK(PREFIX_ERROR, LKEYS1); WHILE SY IN QDEFINITIONS DO BEGIN IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1); CHECK(PREFIX_ERROR, LKEYS1) END; INTERFACE(KEYS OR QPROGRAM); PROG_HEADING(KEYS) END; PROCR QCLOSE); PUT0(VARNT_END2); IF SY=CLOSE1 THEN GET ELSE ERROR(RECORD_ERROR, KEYS); END; PROCEDURE LABEL_LIST; VAR LKEYS1: SETS; DONE: BOOLEAN; BEGIN LKEYS1 := KEYS OR QLABEL_TAIL; DONE := FALSE; REPEAT CONSTANT(LKEYS1); PUT0(OP); CHECK(ERROR_NUM, LKEYS1); IF SY IN QLABEL_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM, LKEYS1) ELSE DONE := TRUE UNTIL DONE; IF OP=LABEL2 THEN PUT0(LBL_END2); IF SY=COLON1 THEN GET ELSE ERROR(ERROR_DURE VARIANT (KEYS: SETS); FORWARD; PROCEDURE LABEL_LIST (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD; PROCEDURE POINTER_TYPE (KEYS: SETS); FORWARD; PROCEDURE VAR_DEC (KEYS: SETS); FORWARD; PROCEDURE ID_LIST (KEYS: SETS; OP,ERROR_NUM: INTEGER; VAR ID_COUNT: INTEGER); FORWARD; PROCEDURE IDENTIFIER (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD; PROCEDURE ROUTINE_DEC (KEYS: SETS); FORWARD; PROCEDURE PROC_DEC (KEYS: SETS); FORWARD; PROCEDURE PROC_HEADING (KEYS: SETS); FORWARD; PROEDURE INTERFACE; VAR LKEYS1: SETS; BEGIN LKEYS1:=KEYS OR QROUTINES; CHECK(INTERFACE_ERROR, LKEYS1); WHILE SY IN QROUTINES DO BEGIN IF SY=PROCEDURE1 THEN PROC_HEADING(LKEYS1) ELSE FUNC_HEADING (LKEYS1); CHECK(INTERFACE_ERROR, LKEYS1) END END; PROCEDURE PROG_HEADING; BEGIN IF SY=PROGRAM1 THEN GET ELSE ERROR(PROG_ERROR, KEYS OR QID_OPEN OR QSEMICOLON); IDENTIFIER(KEYS OR QOPEN OR QSEMICOLON, PROG_ID2, PROG_ERROR); PARM_LIST(KEYS OR QSEMICOCEDURE FUNC_DEC (KEYS: SETS); FORWARD; PROCEDURE FUNC_HEADING (KEYS: SETS); FORWARD; PROCEDURE PARM_LIST (KEYS: SETS); FORWARD; PROCEDURE BODY (KEYS: SETS); FORWARD; PROCEDURE STAT_LIST (KEYS: SETS); FORWARD; PROCEDURE STAT (KEYS: SETS); FORWARD; PROCEDURE ID_STAT (KEYS: SETS); FORWARD; PROCEDURE ARG_LIST (KEYS: SETS); FORWARD; PROCEDURE COMPOUND_STAT (KEYS: SETS); FORWARD; PROCEDURE IF_STAT (KEYS: SETS); FORWARD; PROCEDURE CASE_STAT (KEYS: SETS); FORWARD; PROCEDURE LON); PUT0(PROG_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROG_ERROR, KEYS); END; "#####" "BLOCK" "#####" PROCEDURE BLOCK; BEGIN DECLARATIONS(KEYS OR QBODY); BODY(KEYS) END; "############" "DECLARATIONS" "############" PROCEDURE DECLARATIONS; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QDECLARATIONS; LKEYS2:=KEYS OR QROUTINES; CHECK(DEC_ERROR,LKEYS1); WHILE SY IN QDEFINITIONS DO BEGIN IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1); WHILE_STAT (KEYS: SETS); FORWARD; PROCEDURE REPEAT_STAT (KEYS: SETS); FORWARD; PROCEDURE FOR_STAT (KEYS: SETS); FORWARD; PROCEDURE WITH_STAT (KEYS: SETS); FORWARD; PROCEDURE EXPR (KEYS: SETS); FORWARD; PROCEDURE SEXPR (KEYS: SETS); FORWARD; PROCEDURE TERM (KEYS: SETS); FORWARD; PROCEDURE FACTOR (KEYS: SETS); FORWARD; PROCEDURE FACTOR_ID (KEYS: SETS); FORWARD; PROCEDURE VARIABLE (KEYS: SETS); FORWARD; PROCEDURE CONSTANT (KEYS: SETS); FORWARD; "##########" "INITIALIZE" " CHECK(DEC_ERROR,LKEYS1) END; IF SY=VAR1 THEN VAR_DEC(LKEYS2); CHECK(DEC_ERROR,LKEYS2); IF SY IN QROUTINES THEN ROUTINE_DEC(KEYS) END; PROCEDURE CONST_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QCONST_DEF; LKEYS2:=KEYS-QCONST_DEF; GET; REPEAT IDENTIFIER(LKEYS1,CONST_ID2,CONSTDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1); CONSTANT(LKEYS1); PUT0(CONST_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKE##########" PROCEDURE GET; VAR LENGTH,I,VAL,PASS_NO,MESSAGE_NO,LINE_NO:INTEGER; DONE:BOOLEAN; BEGIN DONE:=FALSE; REPEAT READ_IFL(SY); IF SY IN QIGNORE THEN CASE SY OF LCONST1: BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); FOR I:=1 TO LENGTH DIV 2 DO BEGIN READ_IFL(VAL); PUT_ARG(VAL) END END; MESSAGE1: BEGIN READ_IFL(PASS_NO); READ_IFL(MESSAGE_NO); PUT2(MESSAGE2,PASS_YS1); CHECK(CONSTDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; PROCEDURE TYPE_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QTYPE_DEF; LKEYS2:=KEYS-QTYPE_DEF; GET; REPEAT IDENTIFIER(LKEYS1,TYPE_ID2,TYPEDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); TYPE_(LKEYS1); PUT0(TYPE_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); CHECK(TYPEDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; "####" "TYPE" "####" NO,MESSAGE_NO) END; NEW_LINE1: BEGIN READ_IFL(LINE_NO); PUT1(NEW_LINE2,LINE_NO) END END ELSE DONE:=TRUE UNTIL DONE; IF SY IN QARG THEN READ_IFL(ARG) END; PROCEDURE INITIALIZE; BEGIN CURRENT_LABEL:=1 "THE MAIN PROGRAM"; INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN TEST:=TESTOPTION IN OPTIONS END; IF TEST THEN PRINTFF; QIGNORE:=(.LCONST1,MESSAGE1,NEW_LINE1.); QCOMMA:=(.COMMA1.); QOPEN:=(.OPEN PROCEDURE TYPE_; BEGIN CHECK(TYPE_ERROR,KEYS OR QTYPE); IF SY IN QTYPE THEN CASE SY OF OPEN1: ENUM_TYPE(KEYS); ID1,INTEGER1,REAL1,CHAR1,STRING1: SUBR_TYPE(KEYS); SET1: SET_TYPE(KEYS); ARRAY1: ARRAY_TYPE(KEYS); RECORD1: RECORD_TYPE(KEYS); ARROW1: POINTER_TYPE(KEYS) END ELSE BEGIN ERROR(TYPE_ERROR,KEYS); PUT1(TYPE2,XUNDEF) END END; PROCEDURE ENUM_TYPE; VAR NUMBER:INTEGER; BEGIN PUT0(ENUM2); GET; ID_LI1.); QCLOSE:=(.CLOSE1.); QEOM:=(.EOM1.); QEND:=(.END1.); QSEMICOLON:=(.SEMICOLON1.); QBODY:=(.BEGIN1.); QID:=(.ID1.); QDEFINITIONS:=(.CONST1,TYPE1.); QROUTINES:=(.PROCEDURE1,FUNCTION1.); QDECLARATIONS:=QDEFINITIONS OR (.VAR1.) OR QROUTINES; QDEF:=(.ID1,SEMICOLON1,EQ1.); QDEC:=(.ID1,SEMICOLON1,COLON1.); QCONSTANT:=(.ID1,INTEGER1,REAL1,CHAR1,STRING1.); QCONST_DEF:=QDEF OR QCONSTANT; QTYPE:=(.OPEN1,SET1,ARRAY1,RECORD1,ARROW1.) OR QCONSTANT; QTYPE_DEF:=QDEF OR QTYST(KEYS OR QCLOSE,ENUM_ID2,ENUM_ERROR,NUMBER); IF SY=CLOSE1 THEN GET ELSE ERROR(ENUM_ERROR,KEYS); PUT0(ENUM_DEF2) END; PROCEDURE SUBR_TYPE; VAR SPIX:SPELLING_INDEX; BEGIN IF SY=ID1 THEN BEGIN SPIX:=ARG; GET; CHECK(SUBR_ERROR,KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THEN BEGIN PUT1(CONSTANT2,SPIX); GET; CONSTANT(KEYS); PUT0(SUBR_DEF2) END ELSE PUT1(TYPE2,SPIX) END ELSE BEGIN CONSTANT(KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THENPE; QTYPE_LIST:=QTYPE OR QCOMMA; QSUBR_LIMIT:=(.UP_TO1.) OR QCONSTANT; QDIMENSION:=QTYPE OR (.COMMA1,BUS1,OF1.); QOF_TYPE:=QTYPE OR (.OF1.); QVAR_DEF:=QDEC OR QTYPE; QBLOCK:=QDECLARATIONS OR QBODY; QPARM_END:=QSEMICOLON OR QBLOCK; QID_LIST:=(.ID1,COMMA1.); QPROC_END := (.ID1, OPEN1.) OR QPARM_END; QARG:=(.ID1,INTEGER1,CHAR1,STRING1.); QPROC_PARMS:=QPROC_END-QID; QFUNC_END:=QPROC_END OR (.COLON1.); QFUNC_TYPE:=QPARM_END OR QID; QPROG_END:=QPROC_END-QBLO GET ELSE ERROR(SUBR_ERROR,KEYS OR QCONSTANT); CONSTANT(KEYS); PUT0(SUBR_DEF2) END END; PROCEDURE SET_TYPE; BEGIN GET; IF SY=OF1 THEN GET ELSE ERROR(SET_ERROR,KEYS OR QTYPE); TYPE_(KEYS); PUT0(SET_DEF2) END; PROCEDURE ARRAY_TYPE; VAR LKEYS1:SETS; I,DIMENSIONS:INTEGER; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QDIMENSION; GET; IF SY=SUB1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1); DIMENSIONS:=0; DONE:=FALSE; REPEAT "INDEX"TYPE_(LKEYS1); DIMENSICK; QPARM_LIST:=QDEC OR (.UNIV1,VAR1.); QSTAT:=(.ID1,BEGIN1,IF1,CASE1,WHILE1,REPEAT1,FOR1,WITH1.); QBODY_END:=QSTAT OR QEND; QSTAT_LIST :=QSTAT OR QSEMICOLON; QID_END:=(.BECOMES1,OPEN1.); QIF_END:=(.THEN1,ELSE1.) OR QSTAT; QTHEN_END:=QIF_END-(.THEN1.); QCASES:=QCONSTANT OR QSTAT OR (.COLON1,COMMA1,SEMICOLON1.); QCASE_END:=QCASES OR (.OF1,END1.); QLABEL_LIST:=QCONSTANT OR QCOMMA; QLABEL_TAIL:=QLABEL_LIST OR (.COLON1.); QDO_TAIL:=QSTAT OR (.DO1.); QUNARY:=(.ONS:=DIMENSIONS+1; CHECK(ARRAY_ERROR,LKEYS1); IF SY IN QTYPE_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=BUS1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QOF_TYPE); IF SY=OF1 THEN GET ELSE ERROR(ARRAY_ERROR,KEYS OR QTYPE); "ELEMENT"TYPE_(KEYS); FOR I:=1 TO DIMENSIONS DO PUT0(ARRAY_DEF2) END; PROCEDURE RECORD_TYPE; BEGIN PUT0(REC2); GET; FIELD_LIST(KEYS OR QEND); PUT0(REC_DEF2); IF SY=END1 THPLUS1,MINUS1.); QFACTOR:=QCONSTANT OR (.OPEN1,NOT1,SUB1.); QEXPR:=QUNARY OR QFACTOR; QARGUMENT:=QEXPR OR QCOMMA; QARG_END:=QARGUMENT OR QCLOSE; QUNTIL_TAIL:=QEXPR OR (.UNTIL1.); QFOR_END:=QEXPR OR QSTAT OR (.BECOMES1,TO1,DOWNTO1,DO1.); QFORB_END:=QFOR_END-(.BECOMES1.); QEXPR_OP:=(.EQ1,NE1,LE1,GE1,LT1,GT1,IN1.); QSEXPR_OP:=(.PLUS1,MINUS1,OR1.); QTERM_OP:=(.STAR1,SLASH1,DIV1,MOD1,AND1.); QTERM_LIST:=QFACTOR OR QSEXPR_OP; QFACTOR_LIST:=QFACTOR OR QTERM_OP; QSEN GET ELSE ERROR(RECORD_ERROR,KEYS); END; PROCEDURE FIELD_LIST; VAR LKEYS1: SETS; NUMBER: INTEGER; DONE: BOOLEAN; BEGIN LKEYS1 := KEYS OR QFIELD_LIST; DONE := FALSE; REPEAT CHECK(RECORD_ERROR, LKEYS1); IF SY<>CASE1 THEN BEGIN ID_LIST(LKEYS1, FIELD_ID2, RECORD_ERROR, NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1); TYPE_(LKEYS1); PUT1(FIELDLIST2, NUMBER); CHECK(RECORD_ERROR, LKEYS1); IF SY IN QFIELD_LIST THEN ET_EXPR:=QARGUMENT OR (.BUS1.); QSELECT:=(.PERIOD1,SUB1,ARROW1.); QSUB_END:=QARGUMENT OR (.BUS1.); QWITH_LIST:=QDO_TAIL OR QCOMMA; QTO_TAIL:=QDO_TAIL OR QEXPR; QPROGRAM := (.PROGRAM1.); QID_SEMI := (.ID1, SEMICOLON1.); QID_OPEN := (.ID1, OPEN1.); QID_CASE := (.ID1, CASE1.); QSEMI_CASE := (.SEMICOLON1, CASE1.); QFIELD_LIST := QVAR_DEF OR QID_CASE; QVARIANT_PART := QCONSTANT OR (.COLON1, OF1, SEMICOLON1.); QVARIANT := QCONSTANT OR QSEMICOLON; QFIELD_PACK := IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1) ELSE DONE := TRUE END ELSE DONE := TRUE UNTIL DONE; IF SY=CASE1 THEN VARIANT_PART(KEYS); END; PROCEDURE VARIANT_PART; VAR LKEYS1, LKEYS2: SETS; DONE: BOOLEAN; BEGIN LKEYS1 := KEYS OR QVARIANT_PART; LKEYS2 := KEYS OR QVARIANT; GET; IDENTIFIER(LKEYS1, TAG_ID2, RECORD_ERROR); IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1); IDENTIFIER(LKEYS1, TAG_TYPE2, RECORD_ERROR); PUT0(TAG_DEF2); #!#%'$&+-/13579;                       / 1 3 5 7 ! # % ' ) + - 0 2 4 6 " ( * , . n p r t v x z | ~        !#%' T  (  "  " (  "b (  "  "p * B"   B".op" ^<    X" 2x DDD>& O " `(  "V8"$ \  "8"6"4"2"0"& d 0Z< 2 Z L 24   (  8"   (  "   (  2"& q 4XRX  ^" B"""T  " 4   (" (   ",4 B X<   XP "   " " X " " B"2 n@ 6 Z \$ 686 6"4"4 4" 8 4"& 0 0"4 0 " 0XR 2 Z $ 24 2 2"0"$  "0   "" >"   P0>   L" X " \(  >" `T0"(4 (  8&T<h B"J (  " >"  " B"& :"  ( @ " "4"""4  X2 " " Z4 B  " :"&" `3$  :XvC d: :>"$  :X2 V-  : :>""  , |"   "   $"    &XJ " Z  ^6   B"F  ( @ "  d& B" ( z, B"" " B"H   (  "  " $  * NUM, KEYS) END; PROCEDURE POINTER_TYPE; BEGIN GET; IDENTIFIER(KEYS, POINTER2, POINTER_ERROR) END; "#########" "VARIABLES" "#########" PROCEDURE VAR_DEC; VAR NUMBER:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QVAR_DEF; GET; REPEAT ID_LIST(LKEYS1,VAR_ID2,VAR_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); "VAR"TYPE_(LKEYS1); PUT1(VAR_LIST2, NUMBER); IF SY=SEMICOLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); CHECK(VAR_E   (    &  * rj (. F>6 4*  >"" L ` & Q d" "$  .,  "<  " " "&   RROR,LKEYS1) UNTIL NOT(SY IN QVAR_DEF); END; PROCEDURE ID_LIST; VAR LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QID_LIST; ID_COUNT:=0; DONE:=FALSE; REPEAT IDENTIFIER(LKEYS1,OP,ERROR_NUM); ID_COUNT:=ID_COUNT+1; CHECK(ERROR_NUM,LKEYS1); IF SY IN QID_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE IDENTIFIER; BEGIN IF SY=ID1 THEN BEGIN PUT1(OP,ARG); GET END ELSE BEGIN (  "  "&* .,  " ..  " (  " "$ 9 .,  "  (&D ^  (  "  "$ N   ( @ "T[   T" `"" ERROR(ERROR_NUM,KEYS); PUT1(OP,XUNDEF) END END; "########" "ROUTINES" "########" PROCEDURE ROUTINE_DEC; VAR LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QROUTINES; REPEAT CASE SY OF PROCEDURE1: PROC_DEC(LKEYS1); FUNCTION1: FUNC_DEC(LKEYS1) END; IF SY=SEMICOLON1 THEN GET ELSE ERROR(ROUTINE_ERROR, LKEYS1); CHECK(ROUTINE_ERROR,LKEYS1); UNTIL NOT(SY IN QROUTINES) END; PROCEDURE PROC_DEC; BEGIN PROC_HEADING(KEYS OR QFBLOCK); CHECK(P""""0"""RRR&R R R RR R&RRR&RRR& RRR&:" :""" `&< "jN22ROC_ERROR, KEYS OR QFBLOCK); IF SY=FORWARD1 THEN BEGIN PUT0(FORWARD2); GET; END ELSE BLOCK(KEYS); END; PROCEDURE PROC_HEADING; BEGIN GET; IDENTIFIER(KEYS OR QDEC, PROC_ID2, PROC_ERROR); PARM_LIST(KEYS OR QSEMICOLON); PUT0(PROC_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROC_ERROR, KEYS); END; PROCEDURE FUNC_DEC; BEGIN FUNC_HEADING(KEYS OR QFBLOCK); CHECK(FUNC_ERROR, KEYS OR QFBLOCK); IF SY=FORWARD1 THEN BEGIN PUT0(FORWARD2); GET END ELSEN<*      p Z             j T& Z X 26"&  \ f  BLOCK(KEYS) END; PROCEDURE FUNC_HEADING; VAR LKEYS1: SETS; BEGIN LKEYS1 := KEYS OR QDEC OR QOPEN; GET; IDENTIFIER(LKEYS1, FUNC_ID2, FUNC_ERROR); CHECK(FUNC_ERROR, LKEYS1); IF SY<>SEMICOLON1 THEN BEGIN PARM_LIST(KEYS OR QDEC); IF SY=COLON1 THEN GET ELSE ERROR(FUNC_ERROR, KEYS OR QID_SEMI); IDENTIFIER(KEYS OR QSEMICOLON, FUNC_TYPE2, FUNC_ERROR) END; PUT0(FUNC_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(FUNC_ERROR, KEYS); END; PROCEDURE PARM_LIST>"  >"  "  "  ""*  " " "  \>. d<  * B" B"$ \  >"$  \  >" .,  "  ($ ` 4  (   ; VAR LIST_OP,TYPE_OP,NUMBER:INTEGER; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QPARM_LIST OR QCLOSE; CHECK(PARM_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN GET; DONE:=FALSE; REPEAT CHECK(PARM_ERROR,LKEYS1); IF SY=VAR1 THEN BEGIN GET; LIST_OP:=VPARMLIST2 END ELSE LIST_OP:=CPARMLIST2; ID_LIST(LKEYS1,PARM_ID2,PARM_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1); CHECK(PARM_ERROR,LKEYS1); IF"  "& b d\  >". d " < *<  "  "  ", ^<  ^  X2j  X2: " "" B""&  np4  X& (  N  " 2" B"" `h4    (   "   "       B"(  (4z Z V  &&  " "  "  X (   "   "  <64 <   T (8 (   "   "&  " " ^N   X "" " X 2"& .,  "  " " X " " @" " >"2*&.8  "  " "&5,4  " "@<4r  8&  "D "2J B" `BV  & " "DV " "$ &<  " B"* - " ^D    ~ "$7 4 ^"$< 4  "$ A4  X  " 2"&K:" B"6Q4 B Xr  4 [*,.02468:<>)=?DFHJLNPRTV@BEGIKMOQSUWAC`bdfhjlnXZ\^acegikmoY[]_|~prtvx             l n p r t v x z | ~        !#%' XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; "STANDARD NOUN INDICES" ZARITHMETIC=17; ZINDEX=18; ZPASSIVE=19; ZPOINTER=20; ZVPARM=21; ZCPARM=22; ZSPARM=23; ZNPARM=24; ZWITH=25; "ERRORS" UNRES_ERROR=1; AMBIGUITY_ERROR=2; ABORT_ERROR=3; CONSTID_ERROR=4; SUBR_ERROR=5; "AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91109 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 3: SCOPE ANALYSIS JANUARY 1975" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPTIO4  X V Z6 ( R8&  ^    B"(c   (  " tN<n 2"| ^$<   T "   b >"b  X` " N = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTY^ "  "  nxj6   (  " " . ( B"" `4 b   (  "   B"Z&  U 2&PE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGE  " <" 6 H (  " " ް   B"$"* "  B"  2"X0r" 0 L "  P (  " R; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; CONST_ID1=2; CONST_DEF1=3; TYPE_ID1=4; TYPE_DEF1=5; VAR_ID1=6; VAR_LIST1=7; PROC_ID1=8; PROC_DEF1=9; LBL_END1=10; FORWARD1=11; FUNC_ID1=12; FUNC_DEF1=13; POINT "  ݰ"  B". n  " \4 B X   (  "    h<  "8 BB"" "ے$  "0" B"ے$pۂF4ER1=14; FUNC_TYPE1=15; PROG_ID1=16; PROG_DEF1=17; VARNT_END1=18; TYPE1=19; ENUM1=20; ENUM_ID1=21; ENUM_DEF1=22; SUBR_DEF1=23; SET_DEF1=24; ARRAY_DEF1=25; REC1=26; FIELD_ID1=27; FIELDLIST1=28; REC_DEF1=29; VARNT1=30; PARM_ID1=31; PARM_TYPE1=32; UNIV_TYPE1=33; CPARMLIST1=34; VPARMLIST1=35; BODY1=36; BODY_END1=37; ANAME1=38; STORE1=39; CALL_NAME1=40; CALL1=41; ARG_LIST1=42;   >" B"&4  XJ  0X$ 0ڄ ڄ ڰ&"4  X: ^" "  (( '4  X ^   GX:G (   ARG1=43; FALSEJUMP1=44; DEF_LABEL1=45; JUMP_DEF1=46; DEF_CASE1=47; CASE1=48; JUMP1=49; END_CASE1=50; ADDRESS1=51; FOR_STORE1=52; FOR_LIM1=53; FOR_UP1=54; FOR_DOWN1=55; WITH_VAR1=56; WITH_TEMP1=57; WITH1=58; VALUE1=59; LT1=60; EQ1=61; GT1=62; LE1=63; NE1=64; GE1=65; IN1=66; UPLUS1=67; UMINUS1=68; PLUS1=69; MINUS1=70; OR1=71; "* XR Xل (ٰ ٰ G^ B"$74  ^ (,A"4 B Xl X"@  "  " " ^, X #؄ #   Xf4  XB  STAR1=72; SLASH1=73; DIV1=74; MOD1=75; AND1=76; FNAME1=77; NOT1=78; EMPTY_SET1=79; INCLUDE1=80; FUNCTION1=81; CALL_FUNC1=82; NAME1=83; COMP1=84; SUB1=85; ARROW1=86; CONSTANT1=87; REAL1=88; FREAL1=89; INTEGER1=90; FINTEGER1=91; CHAR1=92; FCHAR1=93; STRING1=94; FSTRING1=95; NEW_LINE1=96; LCONST1=97; MESSAGE1=98; TAG_ID1=99; TAG_TYPE1=100  X " B"$[% ג(b4  X(  " (  " \ `2  "  B" B" װ2v ~" `"  "4 X24 " "; PART_END1=101; TAG_DEF1=102; LABEL1=103; CASE_JUMP1=104; "OUTPUT OPERATORS" EOM2=1; PROG_DEF2=2; TYPE_DEF2=3; TYPE2=4; ENUM_DEF2=5; SUBR_DEF2=6; SET_DEF2=7; ARRAY_DEF2=8; POINTER2=9; REC2=10; REC_DEF2=11; NEW_NOUN2=12; FIELDLIST2=13; TAG_DEF2=14; PART_END2=15; CASE_JUMP2=16; VARNT_END2=17; VAR_LIST2=18; FORWARD2=19; PROC_DEF2=20; PROCF_DEF2=21; LCONST2=22; FUNC_DEF2=23; ""4 X4   X4  "   Z "2  V " B" B")  " `"  Ӓ."4  X   X~t /  FUNCF_DEF2=24; PARM_TYPE2=25; UNIV_TYPE2=26; CPARMLIST2=27; VPARMLIST2=28; BODY2=29; BODY_END2=30; ADDRESS2=31; RESULT2=32; STORE2=33; CALL_PROC2=34; PARM2=35; FALSEJUMP2=36; DEF_LABEL2=37; JUMP_DEF2=38; JUMP2=39; CHK_TYPE2=40; CASE_LIST2=41; FOR_STORE2=42; FOR_LIM2=43; FOR_UP2=44; FOR_DOWN2=45; WITH_VAR2=46; WITH_TEMP2=47; WITH2=48; VALUE2=49; LT2=50; EQ2=51;  (  "  " "  2D/ B"*4  X  X* 2" "F > ^ G (  ""  4 (("4  XX GT2=52; LE2=53; NE2=54; GE2=55; IN2=56; UPLUS2=57; UMINUS2=58; PLUS2=59; MINUS2=60; OR2=61; STAR2=62; SLASH2=63; DIV2=64; MOD2=65; AND2=66; NOT2=67; EMPTY_SET2=68; INCLUDE2=69; FUNCTION2=70; CALL_FUNC2=71; ROUTINE2=72; VAR2=73; ARROW2=74; VCOMP2=75; SUB2=76; INDEX2=77; REAL2=78; STRING2=79; NEW_LINE2=80; MESSAGE2=81; FEW_ARGS_ERROR=6; ARG_LIST_ERROR=7; MANY_ARGS_ERROR=8; LBLRANGE_ERROR=9; LBLTYPE_ERROR=10; AMBILBL_ERROR=11; WITH_ERROR=12; ARROW_ERROR=20; PROC_USE_ERROR=14; NAME_ERROR=15; COMP_ERROR=16; SUB_ERROR=17; CALL_NAME_ERROR=19; RESOLVE_ERROR=21; "MISCELANEOUS" NOT_POSSIBLY_FORWARD=FALSE; POSSIBLY_FORWARD=TRUE; OUTPUT=TRUE; RETAIN=FALSE; PROC_TYPE=NIL; STD_LEVEL=0; PREFIX_LEVEL=1; GLOBAL_LEVEL=2; TYPE ENTRY_KIND=(INDEX_CONST,REAL_CONST,STRING_CONST,V CALL_NEW2=82; UNDEF2=83; VARIANT2=84; MODE2=85; "OTHER CONSTANTS" MIN_CASE=0; MAX_CASE=127; THIS_PASS=3; SPELLING_MAX=700; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; NOUN_MAX=700; OPERAND_MAX=150; UPDATE_MAX=100; UPDATE_MAX1=101; MAX_LEVEL=15; MAX_TAG=15; MIN_TAG=0; TAG_STACK_MAX=5; "MODES" PROC_MODE=1; FUNC_MODE=2; PROGRAM_MODE=3; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; ARIABLE, PARAMETER,FIELD,SCALAR_KIND,ROUTINE_KIND,SET_KIND, POINTER_KIND,ARRAY_KIND,RECORD_KIND,WITH_KIND,UNDEF_KIND); OPERAND_CLASS=(VAR_CLASS,ROUTINE_CLASS,ICONST_CLASS,RCONST_CLASS,SCONST_CLASS, DEF_CLASS,UNDEF_CLASS,FCONST_CLASS,CASE_LABEL); ERROR_NOTE=(YES,NO,SUPPRESS); TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; TAG_SET=SET OF MIN_TAG..MAX_TAG; TAG_INDEX=0..TAG_STACK_MAX; UNIV_SET = ARRAY (.1..8.) OF INTEGER; SPELLING_INDEX=0..SPELLING_MAX; NOUN_INDEX= 0..NOUN_MAXDIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('3'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "X_SW; END; PROCEDURE PUSH_LEVEL(E:ENTRY_PTR); BEGIN IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1; UPDATE_CHECK; WITH DISPLAY(.THIS_LEVEL.) DO BEGIN BASE:=THIS_UPDATE+1; LEVEL_ENTRY:=E; PREV_HEAD:=NAME_HEAD; PREV_TAIL:=NAME_TAIL; NAME_HEAD:=NIL END END; PROCEDURE POP_LEVEL; VAR U:UPDATE_INDEX; BEGIN WITH DISPLAY (.THIS_LEVEL.) DO BEGIN NAME_HEAD:=PREV_HEAD; NAME_TAIL:=PREV_TAIL; FOR U:=THIS_UPDATE DOWNTO BASE DO WINOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" "#############" "PASS ROUTINES" "#############" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGETH UPDATES(.U.) DO BEGIN SPELLING_TABLE(.UPDATE_SPIX.):=OLD_ENTRY END; THIS_UPDATE:=BASE-1 END; THIS_LEVEL:= THIS_LEVEL - 1; UPDATE_CHECK END; "#############" "NAME HANDLING" "#############" PROCEDURE PUSH; BEGIN IF T>= OPERAND_MAX THEN ABORT ELSE T:=T+1 END; PROCEDURE NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN IF THIS_NOUN>=NOUN_MAX THEN ABORT ELSE THIS_NOUN:=THIS_NOUN+1; NEW(E); WITH E@ DO BEGIN NOUN:=THIS_NOUN; KIND:=UNDEF_KIND E; STACK_INDEX=0..OPERAND_MAX; UPDATE_INDEX=0..UPDATE_MAX; NAME_PTR=@NAME_REC; VARIANT_PTR=@VARIANT_REC; ENTRY_PTR=@ENTRY_REC; ENTRY_REC= RECORD NOUN:NOUN_INDEX; CASE KIND:ENTRY_KIND OF INDEX_CONST:(CONST_TYPE:NOUN_INDEX; CONST_VAL:INTEGER); REAL_CONST:(REAL_DISP:INTEGER); STRING_CONST:(STRING_LENGTH,STRING_DISP:INTEGER); VARIABLE:(VAR_TYPE:ENTRY_PTR); PARAMETER:(PARM_TYPE:ENTRY_PTR); FIELD:(FIELD_TYPE:ENTRY_PTR; VARIANT:VARIANR); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4) END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR AT_PTR); SCALAR_KIND:(RANGE_TYPE:NOUN_INDEX); ROUTINE_KIND:(ROUT_PARM: NAME_PTR; ROUT_TYPE:ENTRY_PTR); POINTER_KIND:(OBJECT_TYPE,NEXT_FWD:ENTRY_PTR); ARRAY_KIND:(INDEX_TYPE:NOUN_INDEX; EL_TYPE:ENTRY_PTR); WITH_KIND:(WITH_TYPE:NOUN_INDEX); RECORD_KIND:(FIELD_NAME:NAME_PTR) END; OPERAND= RECORD CASE CLASS:OPERAND_CLASS OF VAR_CLASS:(VTYPE:ENTRY_PTR); ROUTINE_CLASS:(ROUT:ENTRY_PTR; PARM:NAME_PTR); ICONST_CLASS:(ICONST_TYPE:RG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; PROCEDURE IGNORE3(OP:INTEGER); VAR ARG1,ARG2,ARG3:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); PUT3(OP,ARG1,ARG2,ARG3) END; PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); CONST_DISP:=CONST_DISP+LENGTH; FOR I:=1 TO LENGTH DIV 2 DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE ERROR(NUMBER:INTEGER); NOUN_INDEX; ICONST_VAL:INTEGER); RCONST_CLASS:(RCONST_DISP:INTEGER); SCONST_CLASS:(SCONST_LENGTH,SCONST_DISP:INTEGER); CASE_LABEL:(LABEL,INDEX:INTEGER); DEF_CLASS:(DEF_ENTRY:ENTRY_PTR; DEF_SPIX:SPELLING_INDEX) END; NAME_ACCESS=(GENERAL,INCOMPLETE, UNRES_TYPE,UNRES_ROUTINE,QUALIFIED,UNDEFINED); LEVEL_INDEX=0..MAX_LEVEL; SPELLING_ENTRY= RECORD ENTRY:ENTRY_PTR; LEVEL:LEVEL_INDEX; ACCESS:NAME_ACCESS END; DISPLAY_REC= RECORD BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); END; PROCEDURE ABORT; BEGIN ERROR(ABORT_ERROR); HALT:=TRUE END; "##############" "INITIALIZATION" "##############" PROCEDURE STD_ID(VAR STD_ENTRY:ENTRY_PTR; INDEX:SPELLING_INDEX); BEGIN NEW(STD_ENTRY); STD_ENTRY@.NOUN:=INDEX; WITH SPELLING_TABLE(.INDEX.) DO BEGIN ENTRY:=STD_ENTRY; LEVEL:=STD_LEVEL; ACCESS:=GENERAL END END; PROCEDURE STD_CONST(CONST_INDEX,TYPE_INDEX:SPELLING_INDEX; CONST_VALUE:INTEGER); VARBASE:0..UPDATE_MAX1; LEVEL_ENTRY:ENTRY_PTR; PREV_HEAD,PREV_TAIL: NAME_PTR END; UPDATE_REC= RECORD UPDATE_SPIX:SPELLING_INDEX; OLD_ENTRY:SPELLING_ENTRY END; PACKED_SET=INTEGER; VARIANT_REC= RECORD TAG_NOUN:NOUN_INDEX; LABEL_SET:PACKED_SET; PARENT_VARIANT:VARIANT_PTR END; NAME_REC= RECORD NAME_SPIX:SPELLING_INDEX; NAME_ENTRY:ENTRY_PTR; NEXT_NAME:NAME_PTR END; VAR INTER_PASS_PTR: PASSPTR; CONSTANTS: SET O CONST_ENTRY:ENTRY_PTR; BEGIN STD_ID(CONST_ENTRY,CONST_INDEX); WITH CONST_ENTRY@ DO BEGIN KIND:=INDEX_CONST; CONST_TYPE:=TYPE_INDEX; CONST_VAL:=CONST_VALUE END END; PROCEDURE STD_PARM(VAR PARM_ENTRY: NAME_PTR; PARMTYPE:ENTRY_PTR; PARM_INDEX:NOUN_INDEX); BEGIN NEW(PARM_ENTRY); WITH PARM_ENTRY@ DO BEGIN NAME_SPIX:=XUNDEF; NEW(NAME_ENTRY); WITH NAME_ENTRY@ DO BEGIN NOUN:=PARM_INDEX; KIND:=PARAMETER; PARM_TYPE:=PARMTYPEF OPERAND_CLASS; TYPES,CONST_KINDS: SET OF ENTRY_KIND; NAME_HEAD,NAME_TAIL: NAME_PTR; HALT,TEST,RESOLUTION,FUNC_TYPE_SW,UPDATE_SW,PREFIX_SW: BOOLEAN; OPS:ARRAY (.STACK_INDEX.) OF OPERAND; UENTRY,THIS_FUNCTION:ENTRY_PTR; INACCESSIBLE,OP_ACCESS: SET OF NAME_ACCESS; LABELS: ARRAY (.MIN_CASE..MAX_CASE.) OF INTEGER; THIS_UPDATE: UPDATE_INDEX; T:STACK_INDEX; ENUM_VAL,THIS_LABEL,SY,UNRESOLVED,TAG_TOP,RESET_POINT,CONST_DISP: INTEGER; ENUM_TYPE,THIS_NOUN,NEW_TYPE,LABEL_TYPE,TAG_F END; NEXT_NAME:=NIL END END; PROCEDURE STD_ENTRY(VAR E:ENTRY_PTR; INDEX:NOUN_INDEX); BEGIN NEW(E); WITH E@ DO BEGIN NOUN:=INDEX; KIND:=UNDEF_KIND END END; PROCEDURE STD_ROUT (ROUT_INDEX: NOUN_INDEX; ROUTTYPE: ENTRY_PTR; FIRST_PARM: NAME_PTR); VAR ROUT_ENTRY:ENTRY_PTR; BEGIN STD_ID(ROUT_ENTRY,ROUT_INDEX); WITH ROUT_ENTRY@ DO BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=FIRST_PARM; ROUT_TYPE:=ROUTTYPE END END; PROCEDURE STIELD,NEW_TAG_FIELD, RESET_NOUN: NOUN_INDEX; THIS_VARIANT:VARIANT_PTR; VARIANT_LABELS,TAG_LABELS: TAG_SET; TAG_STACK: ARRAY (.TAG_INDEX.) OF RECORD PREV_LABELS:TAG_SET; PREV_TAG,PREV_TYPE:NOUN_INDEX END; UPDATES:ARRAY (.UPDATE_INDEX.) OF UPDATE_REC; DISPLAY:ARRAY (.LEVEL_INDEX.) OF DISPLAY_REC; THIS_LEVEL,BODY_LEVEL: LEVEL_INDEX; SPELLING_TABLE:ARRAY (.SPELLING_INDEX.) OF SPELLING_ENTRY; "############################" "COMMON TEST OUTPUT MECHANISM" "###############D_SCALAR(VAR SCALAR_ENTRY:ENTRY_PTR; SCALAR_INDEX:SPELLING_INDEX); BEGIN STD_ID(SCALAR_ENTRY,SCALAR_INDEX); WITH SCALAR_ENTRY@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=SCALAR_INDEX END END; PROCEDURE INITIALIZE; VAR I:INTEGER; INT_TYPE,REAL_TYPE,BOOL_TYPE,CHAR_TYPE,POINTER_TYPE, INDEX_TYPE,ARITH_TYPE,PASSIVE_TYPE: ENTRY_PTR; ARITH_SPARM,INT_CPARM,PTR_VPARM,CHAR_CPARM,INDEX_CPARM,REAL_CPARM, INDEX_SPARM: NAME_PTR; BEGIN INIT_PASS(INTER_PASS_PTR); WITH IN#############" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 3: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGINTER_PASS_PTR@ DO BEGIN TEST:=TESTOPTION IN OPTIONS END; IF TEST THEN PRINTFF; THIS_NOUN:=ZWITH; NEW_TYPE:=XUNDEF; HALT:=FALSE; RESOLUTION:=FALSE; FUNC_TYPE_SW:=FALSE; PREFIX_SW:=TRUE; THIS_FUNCTION:=NIL; CONST_DISP:=0; UNRESOLVED:=0 "UNRESOLVED IDENTIFIERS"; CONSTANTS:=(.ICONST_CLASS,RCONST_CLASS,SCONST_CLASS.); TYPES:=(.SCALAR_KIND,ARRAY_KIND,RECORD_KIND,POINTER_KIND,SET_KIND, UNDEF_KIND.); OP_ACCESS:=(.GENERAL,UNRES_ROUTINE,QUALIFIED.); CONST_KINDS LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INT:=(.INDEX_CONST,REAL_CONST,STRING_CONST.); INACCESSIBLE:=(.UNDEFINED,INCOMPLETE,UNRES_TYPE.); THIS_UPDATE:= -1; T:= -1; THIS_LEVEL:= PREFIX_LEVEL; FOR I:=0 TO SPELLING_MAX DO SPELLING_TABLE(.I.).ACCESS:=UNDEFINED; "STANDARD ENTRYS" STD_CONST(XFALSE,XBOOLEAN,0); STD_CONST(XTRUE,XBOOLEAN,1); STD_CONST(XNIL,ZPOINTER,0); STD_ENTRY(UENTRY,XUNDEF); STD_ENTRY(INDEX_TYPE,ZINDEX); STD_ENTRY(ARITH_TYPE,ZARITHMETIC); STD_ENTRY(PASSIVE_TYPE,ZPASSIVE); STD_ENTRY(POINEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE,TER_TYPE,ZPOINTER); STD_SCALAR(INT_TYPE,XINTEGER); STD_SCALAR(REAL_TYPE,XREAL); STD_SCALAR(BOOL_TYPE,XBOOLEAN); STD_SCALAR(CHAR_TYPE,XCHAR); STD_PARM(ARITH_SPARM,ARITH_TYPE,ZSPARM); STD_PARM(INT_CPARM,INT_TYPE,ZCPARM); STD_PARM(CHAR_CPARM,CHAR_TYPE,ZCPARM); STD_PARM(INDEX_CPARM,INDEX_TYPE,ZCPARM); STD_PARM(INDEX_SPARM,INDEX_TYPE,ZSPARM); STD_PARM(REAL_CPARM,REAL_TYPE,ZCPARM); STD_PARM(PTR_VPARM,POINTER_TYPE,ZNPARM); STD_ROUT(XABS, ARITH_TYPE, ARITH_SPARM); PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PACK(LONG_SET: UNIV UNIV_SET; VAR SHORT_SET: PACKED_SET); BEGIN SHORT_SET:= LONG_SET(.1.) END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= STD_ROUT(XATTRIBUTE, INT_TYPE, INT_CPARM); STD_ROUT(XCHR, CHAR_TYPE, INT_CPARM); STD_ROUT(XCONV, REAL_TYPE, INT_CPARM); STD_ROUT(XORD, INT_TYPE, CHAR_CPARM); STD_ROUT(XPRED, INDEX_TYPE, INDEX_SPARM); STD_ROUT(XSUCC, INDEX_TYPE, INDEX_SPARM); STD_ROUT(XTRUNC, INT_TYPE, REAL_CPARM); STD_ROUT(XNEW, PROC_TYPE, PTR_VPARM); END; "#######" "NESTING" "#######" PROCEDURE UPDATE_CHECK; BEGIN UPDATE_SW:= (THIS_LEVEL > GLOBAL_LEVEL) OR (THIS_LEVEL = GLOBAL_LEVEL) AND PREFIRROR(CONSTID_ERROR); T:=T-1; SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-2 END; "#################" "TYPE DECLARATIONS" "#################" PROCEDURE TYPE_ID; VAR SPIX:SPELLING_INDEX; ERROR_SW:BOOLEAN; BEGIN READ_IFL(SPIX); ERROR_SW:=FALSE; IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO CASE ACCESS OF GENERAL: IF LEVEL=THIS_LEVEL THEN ERROR_SW:=TRUE ELSE UPDATE(SPIX,NIL,INCOMPLETE); UNDEFINED: UPDATE(SP; PROCEDURE POINTER; VAR SPIX:SPELLING_INDEX; OBJ_TYP,PTR_TYP,FWD_REF:ENTRY_PTR; BEGIN READ_IFL(SPIX); OBJ_TYP:=UENTRY; PUSH_NEW_ENTRY(PTR_TYP); IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO CASE ACCESS OF GENERAL: IF ENTRY@.KIND IN TYPES THEN OBJ_TYP:=ENTRY ELSE ERROR(NAME_ERROR); UNDEFINED: BEGIN UPDATE(SPIX,PTR_TYP,UNRES_TYPE); UNRESOLVED:=UNRESOLVED+1 END; INCOMPLEIX,NIL,INCOMPLETE); UNRES_TYPE: IF LEVEL<>THIS_LEVEL THEN ERROR_SW:=TRUE ELSE UNRESOLVED:=UNRESOLVED-1; UNRES_ROUTINE: ERROR_SW:=TRUE END ELSE ERROR_SW:=TRUE; IF ERROR_SW THEN ERROR(NAME_ERROR); PUSH; WITH OPS(.T.) DO IF ERROR_SW THEN CLASS:=UNDEF_CLASS ELSE BEGIN CLASS:=DEF_CLASS; DEF_SPIX:=SPIX END END; PROCEDURE TYPE_DEF; VAR TYP,FWD_REF:ENTRY_PTR; BEGIN WITH OPS(.T-1.) DO IF CLASSTE,UNRES_ROUTINE: ERROR(NAME_ERROR); UNRES_TYPE: IF LEVEL=THIS_LEVEL THEN BEGIN FWD_REF:=ENTRY; WHILE FWD_REF@.NEXT_FWD<>NIL DO FWD_REF:=FWD_REF@.NEXT_FWD; FWD_REF@.NEXT_FWD:=PTR_TYP END ELSE ERROR(NAME_ERROR) END; WITH PTR_TYP@ DO BEGIN KIND:=POINTER_KIND; OBJECT_TYPE:=OBJ_TYP; NEXT_FWD:=NIL; PUT1(POINTER2,NOUN) END END; "#####################" "VARIABLE DECLARA=DEF_CLASS THEN WITH SPELLING_TABLE(.DEF_SPIX.) DO BEGIN DEFINE(TYP); IF ACCESS=UNRES_TYPE THEN BEGIN "RESOLVE" FWD_REF:=ENTRY; REPEAT WITH FWD_REF@ DO BEGIN OBJECT_TYPE:=TYP; FWD_REF:=NEXT_FWD END UNTIL FWD_REF=NIL END; ENTRY:=TYP; ACCESS:=GENERAL END; T:=T-2; PUT0(TYPE_DEF2) END; PROCEDURE TYPE_(OUTPUT:BOOLEAN; OP:INTEGER); VAR TYP: ENTIONS" "#####################" PROCEDURE VAR_LIST; VAR I,NUMBER:INTEGER; TYP:ENTRY_PTR; BEGIN READ_IFL(NUMBER); PUT1(VAR_LIST2,NUMBER); DEFINE(TYP); T:=T-1; FOR I:=1 TO NUMBER DO WITH OPS(.T.) DO IF DEFINED THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=VARIABLE; VAR_TYPE:=TYP END; SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-1 END; "###################" "ROUTINE DECLARATIONS" "###################" PROCEDURE ROUTINE_ID(ACCTRY_PTR; BEGIN PUSH_OLD_NAME; IF DEFINED THEN IF NOT(TOP@.KIND IN TYPES) THEN BEGIN ERROR(NAME_ERROR); OPS(.T.).CLASS:=UNDEF_CLASS END; IF OUTPUT THEN BEGIN DEFINE(TYP); PUT1(OP, TYP@.NOUN) END END; PROCEDURE ENUM_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,GENERAL); IF DEFINED THEN BEGIN THIS_NOUN:=THIS_NOUN-1; "CONST IDS DON'T HAVE NOUNS" WITH TOP@ DO BEGIN KIND:=INDEX_CONST; CONST_TYPE:=ENUM_TYPE; ESS:NAME_ACCESS; MODE:INTEGER); BEGIN PUSH_NEW_NAME(POSSIBLY_FORWARD,RETAIN,ACCESS); PUT1(MODE2,MODE); PUSH_LEVEL(UENTRY); END; PROCEDURE PROC_DEF(OP:INTEGER); BEGIN MARK(RESET_POINT); RESET_NOUN:=THIS_NOUN; IF DEFINED THEN WITH TOP@ DO IF RESOLUTION THEN BEGIN RESOLUTION:=FALSE; PUT1(PROCF_DEF2,NOUN); ENTER_NAMES(ROUT_PARM,GENERAL) END ELSE BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=NAME_HEAD; ROUT_TYPE:=PROC_TYPE; PUTND END; PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN PUSH; NEW_ENTRY(E); WITH OPS(.T.) DO BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=E; DEF_SPIX:=XUNDEF END END; PROCEDURE UPDATE(SPIX:SPELLING_INDEX; E:ENTRY_PTR; A:NAME_ACCESS); BEGIN IF UPDATE_SW THEN BEGIN "SAVE OLD ENTRY" IF THIS_UPDATE>=UPDATE_MAX THEN ABORT ELSE THIS_UPDATE:=THIS_UPDATE+1; WITH UPDATES(.THIS_UPDATE.) DO BEGIN UPDATE_SPIX:=SPIX; OLD_ENTRY:=SPELLING_TABLE(.SPIX ENUM_VAL:=ENUM_VAL+1; CONST_VAL:=ENUM_VAL END END; T:=T-1 END; PROCEDURE ENUM; VAR E:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(E); ENUM_VAL:=-1; WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=NOUN; ENUM_TYPE:=NOUN END END; PROCEDURE SUBR_DEF; VAR MIN,MAX:INTEGER; TYPE1:NOUN_INDEX; E:ENTRY_PTR; BEGIN MIN:=0; MAX:=1; TYPE1:=XUNDEF; WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN MAX:=ICONST_VAL; TYPE1:=ICONST_TYPE END ELSE.) END END; WITH SPELLING_TABLE(.SPIX.) DO BEGIN ENTRY:=E; LEVEL:=THIS_LEVEL; ACCESS:=A END END; PROCEDURE PUSH_NEW_NAME(RESOLVE,OUTPUT:BOOLEAN; A:NAME_ACCESS); VAR SPIX:SPELLING_INDEX; E:ENTRY_PTR; BEGIN READ_IFL(SPIX); IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO IF (ACCESS<>UNDEFINED) AND (LEVEL=THIS_LEVEL) THEN IF RESOLVE AND (ACCESS=UNRES_ROUTINE) THEN BEGIN E:=ENTRY; ACCESS:=GENERAL; RESOLUTION:=TRUE; UNRES ERROR(SUBR_ERROR); WITH OPS(.T-1.) DO IF CLASS=ICONST_CLASS THEN BEGIN MIN:=ICONST_VAL; IF (MIN>MAX) OR (ICONST_TYPE<>TYPE1) THEN ERROR(SUBR_ERROR) END ELSE ERROR(SUBR_ERROR); T:=T-2; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=TYPE1; PUT4(SUBR_DEF2,NOUN,TYPE1,MIN,MAX) END END; PROCEDURE SET_DEF; VAR E:ENTRY_PTR; BEGIN T:=T-1; PUSH_NEW_ENTRY(E); E@.KIND:=SET_KIND; PUT1(SET_DEF2,E@.NOUN) END; POLVED:=UNRESOLVED-1 END ELSE BEGIN ERROR(AMBIGUITY_ERROR); SPIX:=XUNDEF; END ELSE BEGIN NEW_ENTRY(E); UPDATE(SPIX,E,A) END; PUSH; WITH OPS(.T.) DO IF SPIX=XUNDEF THEN BEGIN CLASS:=UNDEF_CLASS; IF OUTPUT THEN PUT1(NEW_NOUN2,XUNDEF) END ELSE BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=E; DEF_SPIX:=SPIX; IF OUTPUT THEN PUT1(NEW_NOUN2,E@.NOUN) END END; PROCEDURE PUSH_OLD_NAME; VAR SPIX:SPEROCEDURE ARRAY_DEF; VAR INDEX:NOUN_INDEX; E,EL:ENTRY_PTR; BEGIN DEFINE(EL); T:=T-1; IF DEFINED THEN INDEX:=TOP@.NOUN ELSE INDEX:=XUNDEF; T:=T-1; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=ARRAY_KIND; INDEX_TYPE:=INDEX; EL_TYPE:=EL; PUT1(ARRAY_DEF2,NOUN) END END; PROCEDURE REC; VAR E:ENTRY_PTR; BEGIN PUT0(REC2); PUSH_NEW_ENTRY(E); PUSH_LEVEL(E) END; PROCEDURE FIELD_DEF(NUMBER:INTEGER; VAR TYP:ENTRY_PTR); VAR I:INTEGER; BEGINLLING_INDEX; BEGIN PUSH; READ_IFL(SPIX); WITH OPS(.T.),SPELLING_TABLE(.SPIX.) DO IF ACCESS IN INACCESSIBLE THEN BEGIN ERROR(NAME_ERROR); CLASS:=UNDEF_CLASS END ELSE BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=ENTRY; DEF_SPIX:=SPIX END END; PROCEDURE FIND_NAME(LIST:NAME_PTR; SPIX:SPELLING_INDEX; VAR E:ENTRY_PTR); VAR NAME:NAME_PTR; BEGIN E:=NIL; NAME:=LIST; WHILE NAME<>NIL DO WITH NAME@ DO IF NAME_SPIX=SPIX THEN BEGIN IF DEFINED THEN TYP:=TOP ELSE TYP:=UENTRY; T:=T-1; FOR I:=1 TO NUMBER DO IF DEFINED THEN WITH OPS(.T.) DO BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=FIELD; FIELD_TYPE:=TYP; VARIANT:=THIS_VARIANT END; CHAIN_NAME(DEF_ENTRY,DEF_SPIX); SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-1; END; PROCEDURE FIELD_LIST; VAR NUMBER:INTEGER; TYP:ENTRY_PTR; BEGIN READ_IFL(NUMBER); FIELD_DEF(NUMBER,TYP); E:=NAME_ENTRY; NAME:=NIL END ELSE NAME:=NEXT_NAME; IF E=NIL THEN BEGIN ERROR(NAME_ERROR); E:=UENTRY END END; PROCEDURE CHAIN_NAME(E:ENTRY_PTR; SPIX:SPELLING_INDEX); VAR N:NAME_PTR; BEGIN NEW(N); WITH N@ DO BEGIN NAME_SPIX:=SPIX; NAME_ENTRY:=E; NEXT_NAME:=NIL; IF NAME_HEAD=NIL THEN BEGIN NAME_HEAD:=N; NAME_TAIL:=N END ELSE BEGIN NAME_TAIL@.NEXT_NAME:=N; NAME_TAIL:=N END END END; PROCEDURE SET_ACCESS(SPIX:SPELLING_INDEX; A:NA PUT1(FIELDLIST2,NUMBER) END; PROCEDURE TAG_DEF; VAR TYP:ENTRY_PTR; BEGIN FIELD_DEF(1,TYP); IF TAG_TOP>TAG_STACK_MAX THEN ABORT ELSE WITH TAG_STACK(.TAG_TOP.) DO BEGIN PREV_LABELS:=TAG_LABELS; TAG_LABELS:=(..); PREV_TAG:=TAG_FIELD; TAG_FIELD:=NEW_TAG_FIELD; PREV_TYPE:=LABEL_TYPE; WITH TYP@ DO IF KIND=SCALAR_KIND THEN LABEL_TYPE:=RANGE_TYPE ELSE LABEL_TYPE:=XUNDEF END; TAG_TOP:=TAG_TOP+1 END; PROCEDURE VARNT; VAR VARNT_PTME_ACCESS); BEGIN SPELLING_TABLE(.SPIX.).ACCESS:=A; T:=T-1 END; PROCEDURE ENTER_NAMES(LIST:NAME_PTR; ACCESS:NAME_ACCESS); VAR THIS_NAME:NAME_PTR; BEGIN THIS_NAME:=LIST; WHILE THIS_NAME<>NIL DO WITH THIS_NAME@ DO BEGIN UPDATE(NAME_SPIX,NAME_ENTRY,ACCESS); THIS_NAME:=NEXT_NAME END END; FUNCTION DEFINED:BOOLEAN; BEGIN DEFINED:=OPS(.T.).CLASS<>UNDEF_CLASS END; FUNCTION TOP:ENTRY_PTR; BEGIN TOP:=OPS(.T.).DEF_ENTRY END; PROCEDURE DER:VARIANT_PTR; BEGIN VARIANT_LABELS:=(..); NEW(VARNT_PTR); WITH VARNT_PTR@ DO BEGIN TAG_NOUN:=TAG_FIELD; PARENT_VARIANT:=THIS_VARIANT; THIS_VARIANT:=VARNT_PTR END END; PROCEDURE TAG_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,OUTPUT,INCOMPLETE); IF DEFINED THEN NEW_TAG_FIELD:=OPS(.T.).DEF_ENTRY@.NOUN ELSE NEW_TAG_FIELD:=XUNDEF END; PROCEDURE LBL_END; BEGIN IF VARIANT_LABELS AND TAG_LABELS <> (..) THEN ERROR(AMBILBL_ERROR); TAG_LABELS:=TAFINE (VAR E: ENTRY_PTR); BEGIN WITH OPS(.T.) DO IF CLASS = DEF_CLASS THEN E:= DEF_ENTRY ELSE E:= UENTRY END; "#####################" "CONSTANT DECLARATIONS" "#####################" PROCEDURE CONST_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,INCOMPLETE); IF DEFINED THEN THIS_NOUN:=THIS_NOUN-1 "CONST IDS DON'T HAVE NOUNS" END; PROCEDURE CONST_DEF; BEGIN WITH OPS(.T-1.) DO IF CLASS=DEF_CLASS THEN BEGIN WITH DEF_ENTRY@, OPS(.T.) DO IF CLASS G_LABELS OR VARIANT_LABELS; WITH THIS_VARIANT@ DO PACK(VARIANT_LABELS,LABEL_SET); END; PROCEDURE VARNT_END; BEGIN THIS_VARIANT:=THIS_VARIANT@.PARENT_VARIANT; PUT0(VARNT_END2) END; PROCEDURE PART_END; BEGIN PUT0(PART_END2); TAG_TOP:=TAG_TOP-1; IF TAG_TOP<=TAG_STACK_MAX THEN WITH TAG_STACK(.TAG_TOP.) DO BEGIN TAG_LABELS:=PREV_LABELS; TAG_FIELD:=PREV_TAG; LABEL_TYPE:=PREV_TYPE END END; PROCEDURE LABEL; BEGIN IF DEFINED TIN CONSTANTS THEN CASE CLASS OF ICONST_CLASS: BEGIN KIND:=INDEX_CONST; CONST_TYPE:=ICONST_TYPE; CONST_VAL:=ICONST_VAL END; RCONST_CLASS: BEGIN KIND:=REAL_CONST; REAL_DISP:=RCONST_DISP END; SCONST_CLASS: BEGIN KIND:=STRING_CONST; STRING_LENGTH:=SCONST_LENGTH; STRING_DISP:=SCONST_DISP END END ELSE EHEN WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN IF (ICONST_VALMAX_TAG) THEN ERROR(LBLRANGE_ERROR) ELSE VARIANT_LABELS:=VARIANT_LABELS OR (.ICONST_VAL.); IF ICONST_TYPE<>LABEL_TYPE THEN ERROR(LBLTYPE_ERROR) END ELSE ERROR(LBLTYPE_ERROR); T:=T-1 END; PROCEDURE REC_DEF; VAR E:ENTRY_PTR; BEGIN WITH TOP@ DO BEGIN KIND:=RECORD_KIND; FIELD_NAME:=NAME_HEAD; PUT1(REC_DEF2,NOUN) END; POP_LEVEL ENDERROR_NOTE; BEGIN ERR:=NO; WITH OPS(.T-1.) DO IF CLASS=ROUTINE_CLASS THEN BEGIN IF PARM=NIL THEN ERR:=YES ELSE WITH PARM@ DO BEGIN THIS_PARM:=NAME_ENTRY; PARM:=NEXT_NAME END END ELSE ERR:=SUPPRESS; IF ERR<>NO THEN BEGIN IF ERR=YES THEN ERROR(MANY_ARGS_ERROR); PUT2(PARM2,XUNDEF,XUNDEF) END ELSE WITH THIS_PARM@ DO BEGIN PUT2(PARM2,NOUN,PARM_TYPE@.NOUN); IF NOUN=ZNPARM THEN WITH OPS(.T.suwy{}z                       ' ) + - / 1 3 5 7 ! # % ( * , . 0 2 4 6 " x z | ~ n p r t v        #%') DO IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=POINTER_KIND THEN NEW_TYPE:=OBJECT_TYPE@.NOUN END; T:=T-1 "POP ARGUMENT" END; PROCEDURE DEF_CASE; BEGIN READ_IFL(THIS_LABEL); PUT1(DEF_LABEL2,THIS_LABEL) END; PROCEDURE CASE_; VAR VAL:INTEGER; BEGIN WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN PUT1(CHK_TYPE2,ICONST_TYPE); VAL:=ICONST_VAL; CLASS:=CASE_LABEL; LABEL:=THIS_LABEL; I21 X-&  " `(  ""$ !  """"""& ) Z<  Z L    (  "   (  "   (  "& 6 XRF (VAL>=MIN_CASE) AND (VAL<=MAX_CASE) THEN INDEX:=VAL ELSE BEGIN ERROR(LBLRANGE_ERROR); T:=T-1 END END ELSE BEGIN T:=T-1; ERROR(LBLTYPE_ERROR) END END; PROCEDURE END_CASE; VAR L0,LN,MIN,MAX,I:INTEGER; BEGIN READ_IFL(L0); READ_IFL(LN); FOR I:=MIN_CASE TO MAX_CASE DO LABELS(.I.):=LN; IF OPS(.T.).CLASS=CASE_LABEL THEN BEGIN MIN:=OPS(.T.).INDEX; MAX:=MIN; END ELSE BEGIN MIN:=0; MAX:=0 END; WHILE OPS(.T.).CL  Z \$  "" "  "& D "  " XR  Z $   ""0 S  "" >"   P0>   L" X " \(  >" ` ASS=CASE_LABEL DO BEGIN WITH OPS(.T.) DO BEGIN IF LABELS(.INDEX.)=LN THEN LABELS(.INDEX.):=LABEL ELSE ERROR(AMBILBL_ERROR); IF INDEX>MAX THEN MAX:=INDEX ELSE IF INDEX"$ o X2 V-   >"" w P |" } , "    $"    "   x IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=RECORD_KIND THEN BEGIN NEW_ENTRY(TEMP); WITH TEMP@ DO BEGIN PUT1(WITH_TEMP2,NOUN); KIND:=WITH_KIND; WITH_TYPE:=VTYPE@.NOUN END; PUSH_LEVEL(TEMP); ENTER_NAMES(FIELD_NAME,QUALIFIED) END ELSE ERR:=TRUE ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(WITH_ERROR); PUSH_LEVEL(UENTRY); PUT1(WITH_TEMP2,XUNDEF) END; " `  " < 4 ,  X P H(    L (    $ \ T&,2 j  "  "  " "  "  "  "& ,2 j  "  "  " "  "& ": Bd TL   2""  d X@ P^"" "X T " " " B"  "  "  "  "& 4 X ,2 j  "  "  "  " " "&,2 j  "  "  "  "  "6z  T" ":"":"":"""4"RRRRR&RRRRRR1(OP,NOUN) END ELSE PUT1(OP,XUNDEF); IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END END; PROCEDURE FUNC_TYPE; BEGIN TYPE_(RETAIN,0); FUNC_TYPE_SW:=TRUE END; PROCEDURE FUNC_DEF; VAR TYP: ENTRY_PTR; BEGIN MARK(RESET_POINT); RESET_NOUN:=THIS_NOUN; IF FUNC_TYPE_SW THEN BEGIN DEFINE(TYP); T:=T-1 END ELSE TYP:= UENTRY; IF DEFINED THEN BEGIN THIS_FUNCTION:=TOP; WITH THIS_FUNCTION@ DO IF RESOLUTION THEN BEGIN IF FRR R&R R&8" ,B  " " "  "RRRR&$RR&R RR&RRRRRR&RRRRRR&,B "j " :2   UNC_TYPE_SW THEN ERROR(RESOLVE_ERROR); RESOLUTION:=FALSE; PUT1(FUNCF_DEF2,NOUN); ENTER_NAMES(ROUT_PARM,GENERAL) END ELSE BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=NAME_HEAD; ROUT_TYPE:= TYP; PUT2(FUNC_DEF2, TYP@.NOUN, NOUN) END END ELSE PUT2(FUNC_DEF2,XUNDEF,XUNDEF); FUNC_TYPE_SW:=FALSE; IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END END; PROCEDURE PARMLIST(OP:INTEGER); VAR I,NUMBER:INTEGER; PTYPE:ENTRY_PTR; BEGIN DEFINE(PTYPE);    f  J .j"  :      r& 7 $!    8"|"&+7 READ_IFL(NUMBER); PUT1(OP,NUMBER); FOR I:=NUMBER DOWNTO 1 DO WITH OPS(.T-I.) DO IF CLASS=DEF_CLASS THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=PARAMETER; PARM_TYPE:=PTYPE; END; CHAIN_NAME(DEF_ENTRY,DEF_SPIX); SPELLING_TABLE(.DEF_SPIX.).ACCESS:=GENERAL END; T:=T-NUMBER-1 END; "####" "BODY" "####" PROCEDURE BODY; BEGIN BODY_LEVEL:=THIS_LEVEL; PUT0(BODY2) END; PROCEDURE BODY_END; BEGIN RELEASE(RESET_PO06 B"  " > `j *A@8 " L ` 0& J J* P R$Z d\  >" d "$ `L ,0 ^j  " d\  >" INT); THIS_NOUN:=RESET_NOUN; THIS_FUNCTION:=NIL; T:=T-1; POP_LEVEL; PUT0(BODY_END2) END; PROCEDURE FORWARD_; BEGIN PUT0(FORWARD2); IF DEFINED THEN BEGIN SET_ACCESS(OPS(.T.).DEF_SPIX,UNRES_ROUTINE); UNRESOLVED:=UNRESOLVED+1 END ELSE T:=T-1; POP_LEVEL END; PROCEDURE ANAME; BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN IF ROUT = THIS_FUNCTION THEN PUT1(RESULT2, THIS_FUNCTION@.ROUT_TYPE@.NOUN) ELSE PUT0(ADDRESS2) d "$ h j " d\  >" d "& s \ ^ >"<  4"  :" ^ :" 4^ V  ,4".4" 4 "  ""$< 4 ": " " B"$  B \ >" ELSE PUT0(ADDRESS2) END; PROCEDURE CALL_NAME; VAR ERR:BOOLEAN; BEGIN ERR:=FALSE; WITH OPS(.T.) DO BEGIN IF CLASS=ROUTINE_CLASS THEN IF ROUT@.ROUT_TYPE<>PROC_TYPE THEN ERR:=TRUE ELSE "OK" ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(CALL_NAME_ERROR); CLASS:=UNDEF_CLASS END END END; PROCEDURE CALL(OP:INTEGER); BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN BEGIN IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR); W "$   L` H" "<(  \ \2 B"H V V2 B" :"$& X d "&h  "  " " " "  F  Z   4 X  ( ITH ROUT@ DO IF OP = CALL_FUNC2 THEN BEGIN PUT0(CALL_FUNC2); CLASS:= VAR_CLASS; VTYPE:= ROUT_TYPE END ELSE IF NOUN=XNEW THEN PUT1(CALL_NEW2,NEW_TYPE) ELSE PUT0(OP) END ELSE PUT0(OP); IF OP<>CALL_FUNC2 THEN T:=T-1 END; PROCEDURE ARG_LIST; BEGIN WITH OPS(.T.) DO IF CLASS<>ROUTINE_CLASS THEN BEGIN ERROR(ARG_LIST_ERROR); CLASS:=UNDEF_CLASS END END; PROCEDURE ARG; VAR THIS_PARM:ENTRY_PTR; ERR: "  " X "> j " 0  2 d TP V  Z6 6  &(Z d" B"  "  " "                                         ! # % ' ) + - / 1 3 5 7 " ( * , . 0 2 4 6 v x z | ~ n p r t        !#%' "  " B"$ "" " $ 6X  "" " R, d  :"     9 :"$ B" *&j  X:  %%d"&  " `(  ""$  """"""&  Z<  Z L    (  "   (  "   (  "&  XR  $ d>B& Bd XD X  V J B"8 ^j  " 6 "B "4" "    ߰  ߌ  Z \$  "" "  "& ! "  " XR  Z $   ""0 0  "" >"   P0>   L" X " \(  >" `  d    X` TD ^6;   ް B"48 d T" "  Xް B"0C~v: :B" ::  B"$ K: :B" B4R  ""< "&@" `5$ E XvC d >"$ L X2 V-   >"" T P |" Z , " `   $"h    &p   " ": :"  ::" T " " B"ܒ$`: :B"ܒ"j /d" .Nܒ"r-:܌$ x B" d " ے*1  l܌D*b1  <ܒ,&1   <ܒ,v l d \ T L * 4 p h ` X"     2     " " "  X" "$ ".*  ,4 "  "  "B"  T" DLRR&l B"  X4 B۰.  3X B"    ی " """2.ڌ d ": d" B"n d" B"  X" "  T>5 RRRR&,lRRR8&|lRRRR8&\RR R&<\&RRRR& RR&RRRRR&R R&RR&RR&RR R&"".H "  " "  " " "  "     ل5   ٰ    |ٰ B" d ".  XN0     ل :װ  ` n ׄV)rJrBV:2.*"h B"< "    "  "* " " "* " "* " " "*  " "X(    X) V *&   X  X6)  *"  &  0 p"&8׌8'+ׄj߄  B"rj4^VքJ> 6$x &,@߄߄j߄7߄#Rz(n6z߄bVrJ*Մ>$Z2*J"2"6 Ar t v x z | ~ n p        !#%'~  "  " " "< d T6" "$ " \ Bd "  4" "  :": : t"p BB"8)F d TL V  Z6 dP.&%Fxxph` B"L8D!Ԅ8:Ԅ($  nԄbԄ 1\3Pz"lTHZ*T4"*nJJZJRB8P>tj 8H6`hl2n,4.8r ϖ | " T6" B" d "  4" " "  :": : ".> d<  "  " "  : H" B"*I d<  : B" ZPASS 4: FILE_LIMITP.&%Fxxph` B"L8D!Ԅ8:Ԅ($  nԄbԄ 1\3Pz"lTHZ*T4"*nJJZJRB8P>tj 8H6`hl2n,4.8r ϖ  ": "&SJ  "  "  :"   " "<c d " T6" " \ Bd "  4" ": : 0"  ::"n BB"0w:"" )~&   " " X "  "T "F "8f "" |xtlf8  ^  ^6"    T8 |T  X2"t  X   X"  X   T6"| B `~ Bd "  :": : `"  4"x: :B" B"(  2 Z"  "  :" "  "  4"8 8>"  8":"  B"$ " B" X X6 X6"0"" <:864T.*p  XT 6 LT"& lT"  " 0 ` "*2( B" L ` & ;x * AXP $K     "    l$" 8"8"|8 "2  0Lt dT0  B" "6 6"0 dT h":  >" d $T T6" "" `\ Bd "  WITH_CONTEXT:CONTEXT_KIND; N:NOUN_INDEX; DEBUG,DONE,UNIVERSAL,SAVE_CONTEXT,GENERIC_FUNCTION,PREFIX_SW,INITIALIZE, NO_FORWARD: BOOLEAN; NOUN_TABLE:ARRAY (.NOUN_INDEX.) OF ENTRY_PTR; STACK:ARRAY (.STACK_INDEX.) OF ENTRY_PTR; THIS_LEVEL, T: INTEGER; DISPLAY: ARRAY (.DISPLAY_INDEX.) OF DISPLAY_REC; CURRENT_DISP,CURRENT_LABEL: DISPLACEMENT; CHK_MODE:INPUT_MODE; MODE: OUTPUT_MODE; PASS_BY_REFERENCE, ASSIGNABLE: CONTEXTS; UENTRY,NEW_ENTRY,OLD_ENTRY,UTYPE: ENTRY_PTR; SMALLS,LI TAG_DEF1=14; PART_END1=15; CASE_JUMP1=16; VARNT_END1=17; VAR_LIST1=18; FORWARD1=19; PROC_DEF1=20; PROCF_DEF1=21; LCONST1=22; FUNC_DEF1=23; FUNCF_DEF1=24; PARM_TYPE1=25; UNIV_TYPE1=26; CPARMLIST1=27; VPARMLIST1=28; BODY1=29; BODY_END1=30; ADDRESS1=31; RESULT1=32; STORE1=33; CALL_PROC1=34; PARM1=35; FALSEJUMP1=36; DEF_LABEL1=37; JUMP_DEF1=38; JUMP1=39; CHK_TYPE1=40; CASE_LIST1=41; STS,NONLISTS,FUNC_TYPES,INDEXS,LARGES: TYPE_KINDS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; FOR_STORE1=42; FOR_LIM1=43; FOR_UP1=44; FOR_DOWN1=45; WITH_VAR1=46; WITH_TEMP1=47; WITH1=48; VALUE1=49; LT1=50; EQ1=51; GT1=52; LE1=53; NE1=54; GE1=55; IN1=56; UPLUS1=57; UMINUS1=58; PLUS1=59; MINUS1=60; OR1=61; STAR1=62; SLASH1=63; DIV1=64; MOD1=65; AND1=66; NOT1=67; EMPTY_SET1=68; INCLUDE1=69; FUNCTION1=70; CAL PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 4: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= L_FUNC1=71; ROUTINE1=72; VAR1=73; ARROW1=74; VCOMP1=75; SUB1=76; INDEX1=77; REAL1=78; STRING1=79; NEW_LINE1=80; MESSAGE1=81; CALL_NEW1=82; UNDEF1=83; VARIANT1=84; MODE1=85; "OUTPUT OPERATORS" EOM2=1; BODY2=2; BODY_END2=3; ADDRESS2=4; RESULT2=5; TAG_STORE2=6; STORE2=7; CALL_PROC2=8; CALL_NEW2=9; CONSTPARM2=10; VARPARM2=11; SAVEPARM2=12; FALSEJUMP2=13; JUPTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= IMP2=14; JUMP_DEF2=15; DEF_LABEL2=16; CHK_TYPE2=17; CASE_LIST2=18; FOR_STORE2=19; FOR_LIM2=20; FOR_UP2=21; FOR_DOWN2=22; WITH2=23; VALUE2=24; LT2=25; EQ2=26; GT2=27; LE2=28; NE2=29; GE2=30; IN2=31; UPLUS2=32; UMINUS2=33; PLUS2=34; MINUS2=35; OR2=36; STAR2=37; SLASH2=38; DIV2=39; MOD2=40; AND2=41; NOT2=42; EMPTY_; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG:INTEGER); VAR T:ARRAY (.1..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER; BEGIN REM:=ARG; DIGIT:=0; REPEAT DIGIT:=DIGIT+1; T(.DIGIT.):=CHR(ABS(REM MOD 10) + ORD('0')); REM:=REM DIV 10; UNTIL REM=0; FOR I:=DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:=DSET2=43; INCLUDE2=44; FUNCTION2=45; CALL_FUNC2=46; CALL_GEN2=47; ROUTINE2=48; VAR2=49; ARROW2=50; VCOMP2=51; VARIANT2=52; SUB2=53; NEW_LINE2=54; MESSAGE2=55; LCONST2=56; INITVAR2=57; UNDEF2=58; RANGE2=59; CASE_JUMP2=60; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHRIGIT+1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:=0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('4'); PRINTEOL END; PROCEDURE PRINTOP(OP:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:=PRINTED+1; END; PROCEDURE PRINTARG(ARG:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; IF ARG<0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:=PRINTED+1; END; PROCEDURE PUT_ARG(=9; XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; "STANDARD NOUN INDICES" ZARITHMETIC=17; ZINDEX=18; ZPASSIVE=19; ZPOINTER=20; ZVPARM=21; ZCPARM=22; ZSPARM=23; ZNPARM=24; ZWITH=25; "CONTEXT" FUNC_RESULT=1; ENTRY_VAR=2; VARIABLE=3; VAR_PARM=4; UNIV_VAR=5; CONST_PARM=6; UNIV_CONST=7; FIELD=8; EXPR=10; CONSTANT=11; SAVE_PARM=12; NARG:INTEGER); BEGIN WRITE_IFL(ARG); IF DEBUG THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF DEBUG THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG1:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) ENDEW_PARM=13; TAG_FIELD=14; WITH_CONST = 15; WITH_VAR = 16; "TYPE KIND" INT_KIND=0; REAL_KIND=1; BOOL_KIND=2; CHAR_KIND=3; ENUM_KIND=4; SET_KIND=5; STRING_KIND=6; NONLIST_KIND=7; POINTER_KIND=8; LIST_KIND=9; GENERIC_KIND=10; UNDEF_KIND=11; ROUTINE_KIND=12; "ERRORS" NESTING_ERROR=1; ADDRESS_ERROR=2; RESOLVE_ERROR=23; TAG_ERROR=24; POINTER_ERROR=25; ENTRY_ERROR=6; FUNCTYPE_ERROR=7; TYPEID_ERROR=8; ENUM1_ERROR=9; ENUM2_ERROR=10; END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3) END END; PROCEDURE PUT3_ARG(ARG1,ARG2,ARG3:INTEGER); BEGIN WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF DEBUG THEN BEGIN PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3) END END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN PUT3(OP,AR INDEX_ERROR=11; MEMBER_ERROR=12; STACK_ERROR=13; PARM1_ERROR=14; PARM2_ERROR=15; PARM3_ERROR=16; PARM4_ERROR=17; PARM5_ERROR=18; PARM6_ERROR=19; PARM7_ERROR=20; COMPILER_ERROR=21; STRING_ERROR=22; "INPUT_MODES" PROC1_MODE=1; FUNC1_MODE=2; PROGRAM1_MODE=3; RECORD_MODE=4; VARIANT_MODE=5; "OUTPUT_MODES" SCONST2_MODE=11; LCONST2_MODE=0; PROC2_MODE=1; PROGRAM2_MODE=2; PE2_MODE=3; CE2_MODE=4; ME2_MODE=5; PROCESS2_MODE=6; CLASS2_MODG1,ARG2,ARG3); PUT_ARG(ARG4) END; PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4); PUT_ARG(ARG5) END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF" "##########" "INITIALIZE" "##########" PROCEDURE STD_INDEX(N:NOUN_INDEX; K:TYPE_KIND; L,U:INTEGER); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=WORDLENGTH; KIND:=K; MIN:=L; MAX:=U EN"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 4: DECLARATION ANALYSIS JANUARY 1975" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBE=7; MONITOR2_MODE=8; STD2_MODE=9; UNDEF2_MODE=10; "MISCELANEOUS" MAX_INT=32667; SET_MIN=0; SET_MAX=127; THIS_PASS=4; STACK_MAX=100; NOUN_MAX=700; MAX_LEVEL=15; TAG_MIN=0; TAG_MAX=15; INITIAL_LEVEL=0; RESOLVE=TRUE; DONT_RESOLVE=FALSE; INITIALBLOCK = 1; BYTELENGTH = 1; TEXT_LENGTH = 18; INFILE = 2; OUTFILE = 1; TYPE INPUT_MODE = PROC1_MODE..VARIANT_MODE; DISPLACEMENT=INTEGER; OUTPUT_MODE=LCONST2_MODE..SCONST2_MODE; STACK_INDEXEROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); =0..STACK_MAX; NOUN_INDEX=0..NOUN_MAX; TYPE_KIND=INT_KIND..ROUTINE_KIND; TYPE_KINDS=SET OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; PACKED_SET=0..15; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; ENTRY_CLASS=(UNDEFINED,VALUE,ROUTINE,TEMPLATE); ENTRY_PTR=@ENTRY; ENTRY= RECORD CASE CLASS:ENTRY_CLASS OF VALUE:( VMODE:OUTPUT_MODE; VDISP,CLEAR_SIZE:DISPLACEMENT; CONTEXT:CONTEXT_KIND); ROUTINE:( INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): RMODE:OUTPUT_MODE; RDISP:DISPLACEMENT; PARM_SIZE,VAR_SIZE:DISPLACEMENT); TEMPLATE:( NOUN:NOUN_INDEX; SIZE:DISPLACEMENT; CASE KIND:TYPE_KIND OF INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND:( MIN,MAX:INTEGER)) END; DISPLAY_INDEX=0..MAX_LEVEL; DISPLAY_REC= RECORD LAST_MODE: OUTPUT_MODE; LAST_ADDRESS:DISPLACEMENT; LAST_INITIALIZE:BOOLEAN END; VAR SY,PARM_NUMBER,RESET_POINT:INTEGER; INTER_PASS_PTR: PASSPTR; INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; PROG_DEF1=2; TYPE_DEF1=3; TYPE1=4; ENUM_DEF1=5; SUBR_DEF1=6; SET_DEF1=7; ARRAY_DEF1=8; POINTER1=9; REC1=10; REC_DEF1=11; NEW_NOUN1=12; FIELDLIST1=13; THEN IF (MINSET_MAX) THEN ERROR(MEMBER_ERROR) ELSE "OK" ELSE ERROR(MEMBER_ERROR) END; PROCEDURE SET_DEF; VAR SET_NOUN:NOUN_INDEX; SET_ENTRY:ENTRY_PTR; BEGIN MEMBER_CHECK; SET_NOUN:=STACK(.T.)@.NOUN; T:=T-1 "POP MEMBER TYPE"; PUSH_NEW_ENTRY(SET_ENTRY); WITH SET_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=SET_NOUN; SIZE:=SETLENGTH; KIND:=SET_KIND END END; PROCEDURE ARRAY_DEF; VAR SPAN,ARRAY_SIZE:DISPLACEMENT; AARD:= FALSE; MODE:=PROGRAM2_MODE; ASSIGNABLE:= (.FUNC_RESULT, VARIABLE, VAR_PARM, UNIV_VAR, WITH_VAR.); NONLISTS:=(.INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND, SET_KIND,STRING_KIND,NONLIST_KIND,UNDEF_KIND.); LISTS:=(.POINTER_KIND,LIST_KIND.); CURRENT_LABEL:=INITIALBLOCK; NEW(UTYPE); WITH UTYPE@ DO BEGIN CLASS:=TEMPLATE; NOUN:=XUNDEF; SIZE:=1; KIND:=UNDEF_KIND END; INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); PASS_BY_REFERENCE:=(.VARRAY_KIND:TYPE_KIND; ARRAY_ENTRY:ENTRY_PTR; BEGIN WITH STACK(.T-1.)@ DO IF KIND IN INDEXS THEN SPAN:=ADD(SUBTRACT(MAX,MIN),1) ELSE BEGIN SPAN:=1; ERROR(INDEX_ERROR) END; WITH STACK(.T.)@ DO BEGIN IF KIND=CHAR_KIND THEN BEGIN IF SPAN MOD WORDLENGTH <>0 THEN BEGIN ERROR(STRING_ERROR); SPAN:=WORDLENGTH END; ARRAY_KIND:=STRING_KIND; ARRAY_SIZE:=SPAN END ELSE BEGIN IF KIND IN LISTS THEN ARRAY_KIND:=LISR_PARM,UNIV_VAR.); LARGES:=(.STRING_KIND,LIST_KIND,NONLIST_KIND.); SMALLS:=(.INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND.); FUNC_TYPES:= (.INT_KIND, CHAR_KIND, BOOL_KIND, ENUM_KIND, POINTER_KIND, REAL_KIND.); NEW(UENTRY); UENTRY@.CLASS:=UNDEFINED; NOUN_TABLE(.XUNDEF.):=UENTRY; STD_INDEX(XINTEGER,INT_KIND,-32767,32767); STD_NONINDEX(XREAL,REAL_KIND,REALLENGTH); STD_INDEX(XBOOLEAN,BOOL_KIND,0,1); STD_INDEX(XCHAR,CHAR_KIND,0,127); STD_NONINDEX(ZWITH,POINTT_KIND ELSE ARRAY_KIND:=NONLIST_KIND; ARRAY_SIZE:=MULTIPLY(SPAN,SIZE) END; END; T:=T-2 "POP INDEX AND ELEMENT TYPES"; PUSH_NEW_ENTRY(ARRAY_ENTRY); WITH ARRAY_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=ARRAY_SIZE; KIND:=ARRAY_KIND END END; PROCEDURE POINTER; VAR PTR_ENTRY:ENTRY_PTR; BEGIN IF MODE=UNDEF2_MODE "IN RECORD" THEN ERROR(POINTER_ERROR); PUSH_NEW_ENTRY(PTR_ENTRY); WITH PTR_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUER_KIND,WORDLENGTH); STD_NONINDEX(ZARITHMETIC,GENERIC_KIND,0); STD_NONINDEX(ZINDEX,GENERIC_KIND,0); STD_NONINDEX(ZPOINTER,POINTER_KIND,WORDLENGTH); NOUN_TABLE(.ZPOINTER.)@.NOUN:=XUNDEF "GENERIC POINTERS HAVE UNDEF NOUN"; STD_PARM(ZVPARM,VAR_PARM); STD_PARM(ZCPARM,CONST_PARM); STD_PARM(ZSPARM,SAVE_PARM); STD_PARM(ZNPARM,NEW_PARM); STD_ROUTINE( XNEW,-1); STD_ROUTINE( XTRUNC,0); STD_ROUTINE( XABS,1); STD_ROUTINE( XSUCC,2); STD_ROUTINE( XPRED,3); STD_ROUTIN:=N; SIZE:=WORDLENGTH; KIND:=POINTER_KIND END END; PROCEDURE FIELDLIST; VAR THIS_SIZE:DISPLACEMENT; NUMBER,I:INTEGER; BEGIN WITH STACK(.T.)@ DO BEGIN INITIALIZE:=INITIALIZE OR (KIND IN LISTS); THIS_SIZE:=SIZE END; READ_IFL(NUMBER); FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION" WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VMODE:=MODE; CONTEXT:=FIELD; VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE) END;NE( XCONV,4); STD_ROUTINE( XATTRIBUTE,6); STD_ROUTINE( XORD,8); STD_ROUTINE( XCHR,9); END; "######" "ERRORS" "######" PROCEDURE ERROR(NUMBER:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER) END; PROCEDURE EOM; BEGIN WITH INTER_PASS_PTR@ DO BEGIN RELEASE(RESETPOINT); BLOCKS:=CURRENT_LABEL; END; PUT1(EOM2,0); DONE:=TRUE END; PROCEDURE ABORT; BEGIN PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR); EOM END; "######" "IGNORE" "######" PROCEDUR T:=T-NUMBER-1 "POP DECLARATION LIST" END; PROCEDURE TAG_DEF; VAR THIS_SIZE:DISPLACEMENT; BEGIN "TAG" TYPE_; WITH STACK(.T.)@ DO BEGIN IF KIND IN INDEXS THEN BEGIN IF (MINTAG_MAX) THEN ERROR(TAG_ERROR) END ELSE ERROR(TAG_ERROR); THIS_SIZE:=SIZE; INITIALIZE:=INITIALIZE OR (KIND IN LISTS) END; T:=T-1; WITH STACK(.T.)@ DO BEGIN CLASS:=VALUE; VMODE:=MODE; CONTEXT:=TAG_FIELD; CLEAR_SIZE:=0; VDISP:=CURRENTE CASE_LIST; VAR I,ARG,MIN,MAX:INTEGER; BEGIN T:=T-1; READ_IFL(ARG); READ_IFL(MIN); READ_IFL(MAX); PUT3(CASE_LIST2,ARG,MIN,MAX); FOR I:=MIN TO MAX+1 DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG1:INTEGER; BEGIN READ_IFL(ARG1); PUT1(O_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE) END; PUSH_LEVEL(VARIANT_MODE) END; PROCEDURE PART_END; VAR VARNT_SIZE:DISPLACEMENT; BEGIN WITH STACK(.T.)@ "TAG FIELD", DISPLAY(.THIS_LEVEL.) DO BEGIN VARNT_SIZE:=CLEAR_SIZE; IF INITIALIZE THEN LAST_INITIALIZE:=TRUE ELSE CLEAR_SIZE:=0; LAST_ADDRESS:=ADD(CURRENT_DISP,VARNT_SIZE) END; T:=T-1; POP_LEVEL END; PROCEDURE VARNT_END; VAR VARNT_SIZE:DISPLACEMENT; BEGIN WITH STACK(.T.)@ "TAG_FIELD", DISPLAY(.TP,ARG1) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; "#############" "NOUN HANDLING" "#############" PROCEDURE PUSH; BEGIN IF T>=STACK_MAX THEN ABORT ELSE T:=T+1; STACK(.T.):=UENTRY "***** TEMPORARY *****" END; PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN READ_IFL(N); NEW(E); IF N<>XUNDEF THEN NOUN_TABLE(.N.):=E; IF T>=STACK_MAX THEN ABORT ELSE T:=T+1; STACK(.T.):=E END; HIS_LEVEL.) DO BEGIN VARNT_SIZE:=CURRENT_DISP-LAST_ADDRESS; IF VARNT_SIZE>CLEAR_SIZE THEN CLEAR_SIZE:=VARNT_SIZE; CURRENT_DISP:=LAST_ADDRESS END END; PROCEDURE REC_DEF; VAR REC_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(REC_ENTRY); WITH REC_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=CURRENT_DISP; IF INITIALIZE THEN KIND:=LIST_KIND ELSE KIND:=NONLIST_KIND END; POP_LEVEL END; "#####################" "VARIABLE DECLARATIONS" "################## PROCEDURE PUSH_OLD_ENTRY(VAR E:ENTRY_PTR); BEGIN READ_IFL(N); E:=NOUN_TABLE(.N.); IF T>=STACK_MAX THEN ABORT ELSE T:=T+1; STACK(.T.):=E END; "#######" "NESTING" "#######" PROCEDURE PUSH_LEVEL(M:INPUT_MODE); BEGIN IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1; WITH DISPLAY(.THIS_LEVEL.) DO BEGIN LAST_MODE:=MODE; LAST_ADDRESS:=CURRENT_DISP; IF M<>VARIANT_MODE THEN CURRENT_DISP:=0; IF MODE<>PROGRAM2_MODE THEN IF M< RECORD_MODE###" PROCEDURE VAR_LIST; VAR NUMBER,I:INTEGER; THIS_SIZE:DISPLACEMENT; BEGIN WITH STACK(.T.)@ "TYPE" DO BEGIN THIS_SIZE:=SIZE; INITIALIZE:=INITIALIZE OR (KIND IN LISTS) END; READ_IFL(NUMBER); FOR I:=NUMBER DOWNTO 1 DO "ASSIGN ADDRESSES IN FORWARD DIRECTION" WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VMODE:=MODE; CONTEXT:=VARIABLE; CURRENT_DISP:=ADD(CURRENT_DISP,THIS_SIZE); VDISP:=-CURRENT_DISP END; T:=T-NUMBER-1 "POP DECLARATION LIST" END; THEN ERROR(NESTING_ERROR); CASE M OF PROC1_MODE,FUNC1_MODE: MODE:=PROC2_MODE; PROGRAM1_MODE: MODE:=PROGRAM2_MODE; VARIANT_MODE,RECORD_MODE: MODE:=UNDEF2_MODE END; LAST_INITIALIZE:=INITIALIZE; INITIALIZE:=FALSE END END; PROCEDURE POP_LEVEL; BEGIN WITH DISPLAY(.THIS_LEVEL.) DO BEGIN MODE:=LAST_MODE; CURRENT_DISP:=LAST_ADDRESS; INITIALIZE:=LAST_INITIALIZE END; THIS_LEVEL:=THIS_LEVEL-1 END; "###################" "ADDRESS COMP "####################" "ROUTINE DECLARATIONS" "####################" PROCEDURE PEND; VAR VSIZE:DISPLACEMENT; I:INTEGER; BEGIN CURRENT_DISP:=WORDLENGTH; "LEAVE A WORD FOR LINE NUMBER" FOR I:=0 TO PARM_NUMBER-1 DO "ASSIGN ADDRESSES IN REVERSE ORDER" WITH STACK(.T-I.)@ DO BEGIN VSIZE:=VDISP; VDISP:=CURRENT_DISP; CURRENT_DISP:=ADD(CURRENT_DISP,VSIZE); VMODE:=MODE END; CURRENT_DISP:=CURRENT_DISP-WORDLENGTH "CENTER"; T:=T-PARM_NUMBER "POP PARMS"; END; UTATION" "###################" FUNCTION ADD(A,B:INTEGER):INTEGER; BEGIN "ASSERT (A>=0) AND (B>=0);" IF MAX_INT-A>=B THEN ADD:=A+B ELSE BEGIN ERROR(ADDRESS_ERROR); ADD:=A END END; FUNCTION MULTIPLY(A,B:INTEGER):INTEGER; BEGIN "ASSERT (A>=0) AND (B>=0);" IF A<=MAX_INT DIV B THEN MULTIPLY:=A*B ELSE BEGIN MULTIPLY:=A; ERROR(ADDRESS_ERROR) END END; FUNCTION SUBTRACT(A,B:INTEGER):INTEGER; BEGIN "ASSERT A>=B;" IF (A>=0) AND (B>=0) THE PROCEDURE ROUTINE_DEF(RESOLVE:BOOLEAN); VAR ROUTINE_ENTRY:ENTRY_PTR; BEGIN IF RESOLVE THEN BEGIN IF PARM_NUMBER>0 THEN BEGIN ERROR(RESOLVE_ERROR); PEND END; NO_FORWARD:= TRUE; PUSH_OLD_ENTRY(ROUTINE_ENTRY); END ELSE BEGIN PEND; PUSH_NEW_ENTRY(ROUTINE_ENTRY); WITH ROUTINE_ENTRY@ DO BEGIN CLASS:=ROUTINE; PARM_SIZE:=CURRENT_DISP; VAR_SIZE:= 0; IF PREFIX_SW THEN RMODE:=PE2_MODE ELSE RMODE:=MODE; CURRENT_LABEN SUBTRACT:=A-B ELSE IF (A<0) AND (B<0) THEN SUBTRACT:=A-B ELSE SUBTRACT:=ADD(A,-B) END; "#################" "TYPE DECLARATIONS" "#################" PROCEDURE TYPE_; VAR TYP:ENTRY_PTR; BEGIN PUSH_OLD_ENTRY(TYP); IF TYP=UENTRY THEN STACK(.T.):=UTYPE; END; PROCEDURE ENUM_DEF; VAR ENUM_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(ENUM_ENTRY); WITH ENUM_ENTRY@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=WORDLENGTH; KIND:=ENUM_KIND; MIN:=0; READ_IFL(MAX); L:=CURRENT_LABEL+1; RDISP:=CURRENT_LABEL END END; CURRENT_DISP:=0; MARK(RESET_POINT); IF PREFIX_SW THEN BEGIN T:=T-1; POP_LEVEL END END; PROCEDURE FORWARD_; BEGIN IF NO_FORWARD THEN BEGIN ERROR(RESOLVE_ERROR); NO_FORWARD:= FALSE END; T:= T- 1; POP_LEVEL END; PROCEDURE PROG_DEF; VAR SAVE_LABEL:INTEGER; BEGIN PREFIX_SW:=FALSE; SAVE_LABEL:=CURRENT_LABEL; CURRENT_LABEL:=0; ROUTINE_DEF(DONT_RESOLVE); CURRENT_LABEL:=SAVE_LABEL D END; PROCEDURE STD_PARM(N:NOUN_INDEX; C:CONTEXT_KIND); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=VALUE; VMODE:=UNDEF2_MODE; VDISP:= 0; CONTEXT:=C END END; PROCEDURE STD_ROUTINE(N:NOUN_INDEX; NO:INTEGER); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=ROUTINE; RMODE:=STD2_MODE; RDISP:=NO; PARM_SIZE:= 0; VAR_SIZE:= 0; END END; PROCEDURE STD_NONINDEX(N:NOUN_INDEX; K:TYPE_K IF MAX>SET_MAX THEN ERROR(ENUM2_ERROR) END; IF MODE=UNDEF2_MODE THEN ERROR(ENUM1_ERROR) END; PROCEDURE SUBR_DEF; VAR SUBR_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(SUBR_ENTRY); WITH SUBR_ENTRY@ DO BEGIN CLASS:=TEMPLATE; READ_IFL(NOUN); SIZE:=WORDLENGTH; IF NOUN=XUNDEF THEN KIND:=ENUM_KIND ELSE KIND:=NOUN_TABLE(.NOUN.)@.KIND; READ_IFL(MIN); READ_IFL(MAX) END END; PROCEDURE MEMBER_CHECK; BEGIN WITH STACK(.T.)@ DO IF KIND IN INDEXSIND; S:DISPLACEMENT); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=S; KIND:=K END END; PROCEDURE INITIALIZE_; VAR I:INTEGER; BEGIN INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; GENERIC_FUNCTION:=FALSE; CURRENT_DISP:=0; PREFIX_SW:=TRUE; T:=-1; DONE:=FALSE; THIS_LEVEL:=-1; SAVE_CONTEXT:=FALSE; NO_FORW6   ! # % ' ) + - /    " $ & ( * , .     ; = ? A C E G 1 3 5 7 9 < > @ B D F 0 2 4 6 8 : W Y [ ] _ I K M O Q S U X Z \ ^ t v x z | ~ n p r        !#%'END; PROCEDURE FUNC_DEF(RESOLVE:BOOLEAN); VAR FUNC_TYPE:ENTRY_PTR; BEGIN IF NOT RESOLVE THEN BEGIN TYPE_; IF NOT(STACK(.T.)@.KIND IN FUNC_TYPES) THEN ERROR(FUNCTYPE_ERROR); T:=T-1 END; ROUTINE_DEF(RESOLVE) END; PROCEDURE MODE_; BEGIN READ_IFL(CHK_MODE); PUSH_LEVEL(CHK_MODE); PARM_NUMBER:=0 END; PROCEDURE UNIV_TYPE; BEGIN TYPE_; IF STACK(.T.)@.KIND IN LISTS THEN ERROR(PARM6_ERROR); UNIVERSAL:=TRUE; END; PROCEDURE PARMLIST(C:CONTEXT_KCK(.T.):=ELEMENT END; PROCEDURE ROUTINE_; VAR ROUT:ENTRY_PTR; BEGIN PUSH_OLD_ENTRY(ROUT); WITH ROUT@ DO IF CLASS=ROUTINE THEN PUT4(ROUTINE2,RMODE,RDISP,PARM_SIZE,VAR_SIZE) ELSE PUT0(UNDEF2) END; "#########" "MAIN LOOP" "#########" BEGIN INITIALIZE_; REPEAT READ_IFL(SY); CASE SY OF ADDRESS1: PUT0(ADDRESS2); AND1: BINARY(AND2); ARRAY_DEF1: ARRAY_DEF; ARROW1: ARROW; BODY_END1: BODY_END; BODY1: BODY; CALL_FUNC1: CALL_FUNC; CALL_NEW1: CALL_NEW; CALL_PROC1: BEGIND); VAR I,NUMBER:INTEGER; THIS_SIZE:DISPLACEMENT; BEGIN READ_IFL(NUMBER); PARM_NUMBER:=PARM_NUMBER+NUMBER; WITH STACK(.T.)@ DO IF (C IN PASS_BY_REFERENCE) OR (KIND IN LARGES) THEN THIS_SIZE:=WORDLENGTH ELSE THIS_SIZE:=SIZE; FOR I:=1 TO NUMBER DO WITH STACK(.T-I.)@ DO BEGIN CLASS:=VALUE; VDISP:=THIS_SIZE; CONTEXT:=C END; T:=T-1 "POP TYPE" END; PROCEDURE CPARM_LIST; VAR C:CONTEXT_KIND; BEGIN IF UNIVERSAL THEN BEGIN C:=UNIV_CONSIN PUT0(CALL_PROC2); T:=T-1 END; CASE_JUMP1: IGNORE1(CASE_JUMP2); CASE_LIST1: CASE_LIST; CHK_TYPE1: BEGIN PUT0(CHK_TYPE2); PUT_TYPE END; CPARMLIST1: CPARM_LIST; DEF_LABEL1: IGNORE1(DEF_LABEL2); DIV1: BINARY(DIV2); EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END; EOM1: EOM; ENUM_DEF1: ENUM_DEF; EQ1: BINARY(EQ2); FALSEJUMP1: BEGIN IGNORE1(FALSEJUMP2); T:=T-1 END; FIELDLIST1: FIELDLIST; FOR_DOWN1: FOR_LOOP(FOR_DOWN2); FOR_LIM1: FOR_LIM; FOR_STORE1: PUT0(FOR_STORE2); FOR_UP1: FOR_LOOP(FOR_UP2); FOT; UNIVERSAL:=FALSE END ELSE C:=CONST_PARM; PARMLIST(C) END; PROCEDURE VPARMLIST; VAR C:CONTEXT_KIND; BEGIN IF CHK_MODE=FUNC1_MODE THEN ERROR(PARM7_ERROR); IF UNIVERSAL THEN BEGIN C:=UNIV_VAR; UNIVERSAL:=FALSE END ELSE C:=VAR_PARM; PARMLIST(C) END; "####" "BODY" "####" PROCEDURE BODY; BEGIN WITH STACK(.T.)@ DO BEGIN VAR_SIZE:=CURRENT_DISP; PUT4(BODY2,RMODE,RDISP,PARM_SIZE,VAR_SIZE); IF INITIALIZE THEN PUT1(INITVAR2,CURRENT_DISP) END; RWARD1: FORWARD_; FUNC_DEF1: FUNC_DEF(DONT_RESOLVE); FUNCF_DEF1: FUNC_DEF(RESOLVE); FUNCTION1: FUNCTION_; GE1: BINARY(GE2); GT1: BINARY(GT2); INCLUDE1: BINARY(INCLUDE2); INDEX1: INDEX; IN1: BINARY(IN2); JUMP_DEF1: IGNORE2(JUMP_DEF2); JUMP1: IGNORE1(JUMP2); LCONST1: LCONST; LE1: BINARY(LE2); LT1: BINARY(LT2); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: BINARY(MINUS2); MODE1: MODE_; MOD1: BINARY(MOD2); NEW_LINE1: IGNORE1(NEW_LINE2); NEW_NOUN1: PUSH_NEW_ENTRY(NEW_ENTRY); NE1: BINARY(NE2); NOT1: P NO_FORWARD:= FALSE; END; PROCEDURE BODY_END; BEGIN PUT0(BODY_END2); T:=T-1; RELEASE(RESET_POINT); POP_LEVEL END; "##########" "STATEMENTS" "##########" PROCEDURE PUT_TYPE; VAR N:NOUN_INDEX; BEGIN READ_IFL(N); WITH NOUN_TABLE(.N.)@ DO IF CLASS=TEMPLATE THEN PUT3_ARG(KIND,NOUN,SIZE) ELSE PUT3_ARG(UNDEF_KIND,XUNDEF,1) END; PROCEDURE RESULT; BEGIN PUT1(RESULT2, STACK(.T.)@.PARM_SIZE + WORDLENGTH "CENTER"); PUT_TYPE END; PROCEDURE STOREUT0(NOT2); OR1: BINARY(OR2); PARM_TYPE1: TYPE_; PARM1: PARM; PART_END1: PART_END; PLUS1: BINARY(PLUS2); POINTER1: POINTER; PROC_DEF1: ROUTINE_DEF(DONT_RESOLVE); PROCF_DEF1: ROUTINE_DEF(RESOLVE); PROG_DEF1: PROG_DEF; REAL1: REAL_; REC_DEF1: REC_DEF; REC1: PUSH_LEVEL(RECORD_MODE); RESULT1: RESULT; ROUTINE1: ROUTINE_; SET_DEF1: SET_DEF; SLASH1: BINARY(SLASH2); STAR1: BINARY(STAR2); STORE1:STORE; STRING1: STRING; SUBR_DEF1: SUBR_DEF; SUB1: SUB; TAG_DEF1: TAG_DEF; TYPE_DEF1: T:=T-1; TYPE1; BEGIN WITH STACK(.T-1.)@ DO IF CLASS=VALUE THEN IF CONTEXT=TAG_FIELD THEN PUT1(TAG_STORE2,CLEAR_SIZE) ELSE PUT0(STORE2) ELSE PUT0(STORE2); T:=T-2 END; PROCEDURE PARM; VAR PARM_NOUN:NOUN_INDEX; OP:INTEGER; PARM_CONTEXT:CONTEXT_KIND; BEGIN READ_IFL(PARM_NOUN); IF PARM_NOUN<>XUNDEF THEN WITH NOUN_TABLE(.PARM_NOUN.)@ DO BEGIN PARM_CONTEXT:= CONTEXT; CASE PARM_CONTEXT OF VAR_PARM,UNIV_VAR,NEW_PARM: OP:=VARPARM2; CONST_PARM,: TYPE_; UMINUS1: PUT0(UMINUS2); UNDEF1: BEGIN PUSH; PUT0(UNDEF2) END; UNIV_TYPE1: UNIV_TYPE; UPLUS1: PUT0(UPLUS2); VALUE1: PUT0(VALUE2); VAR_LIST1: VAR_LIST; VARIANT1: VARIANT; VARNT_END1: VARNT_END; VAR1: VCOMP(VAR2); VCOMP1: VCOMP(VCOMP2); VPARMLIST1: VPARMLIST; WITH_TEMP1: WITH_TEMP; WITH_VAR1: SAVE_CONTEXT:=TRUE; WITH1: WITH_ END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END. UNIV_CONST: OP:=CONSTPARM2; SAVE_PARM: BEGIN GENERIC_FUNCTION:=TRUE; OP:=SAVEPARM2 END END; PUT3(OP,VMODE,VDISP,CONTEXT) END ELSE PUT3(CONSTPARM2,UNDEF2_MODE,0,CONST_PARM); TYPE_; WITH STACK(.T.)@ DO BEGIN PUT3_ARG(KIND,NOUN,SIZE); IF PARM_CONTEXT = CONST_PARM THEN IF KIND IN INDEXS THEN IF N "TYPE NOUN" <> XINTEGER THEN PUT2(RANGE2,MIN,MAX) END; T:=T-2 END; PROCEDURE CALL_NEW; VAR INITIALIZE:0..1; BEGIN TYPE_; WITH ST"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 5: BODY SEMANTIC ANALYSIS DECEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NACK(.T.)@ DO BEGIN IF KIND IN LISTS THEN INITIALIZE:=1 ELSE INITIALIZE:=0; PUT2(CALL_NEW2,SIZE,INITIALIZE) END; T:=T-2 END; PROCEDURE FOR_LIM; VAR ARG1,ARG2,ARG4:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG4); CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH); PUT4(FOR_LIM2,ARG1,-CURRENT_DISP,ARG2,ARG4); T:=T-3 END; PROCEDURE FOR_LOOP(OP:INTEGER); BEGIN CURRENT_DISP:=CURRENT_DISP-WORDLENGTH; IGNORE2(OP) END; PROCEDURE WITH_TEMP; VAR UMBEROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); WITH_ENTRY:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(WITH_ENTRY); WITH WITH_ENTRY@ DO BEGIN CLASS:=VALUE; VMODE:=PROC2_MODE "ALL TEMPS HAVE PROCEDURE MODE"; CURRENT_DISP:=ADD(CURRENT_DISP,WORDLENGTH); VDISP:=-CURRENT_DISP; IF WITH_CONTEXT IN ASSIGNABLE THEN CONTEXT:= WITH_VAR ELSE CONTEXT:= WITH_CONST END; T:=T-2; PUT0(ADDRESS2) END; PROCEDURE WITH_; BEGIN CURRENT_DISP:=CURRENT_DISP-WORDLENGTH; PUT0(WITH2) END; "##########" "EXPRESSION" "######## INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FIL##" PROCEDURE CALL_FUNC; BEGIN IF GENERIC_FUNCTION THEN BEGIN PUT0(CALL_GEN2); GENERIC_FUNCTION:= FALSE END ELSE PUT0(CALL_FUNC2) END; PROCEDURE FUNCTION_; BEGIN PUT0(FUNCTION2); PUT_TYPE END; PROCEDURE BINARY(OP:INTEGER); BEGIN T:=T-1; STACK(.T.):=UENTRY; PUT0(OP) END; "################" "VALUE OR ROUTINE" "################" PROCEDURE INDEX; VAR VALUE:INTEGER; BEGIN PUSH; READ_IFL(VALUE); PUT3(VAR2,SCONST2_MODE,VALUE,CONSTANE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; BODY1=2; BODY_END1=3; ADDRESS1=4; RESULT1=5; TAG_STORE1=6; STORE1=7; CALL_PROC1=8; CALL_NEW1=9; CONSTPARM1=10; VARPARM1=11; SAVEPARM1=12; FALSEJUMP1=T); PUT_TYPE END; PROCEDURE REAL_; VAR DISP:DISPLACEMENT; BEGIN PUSH; READ_IFL(DISP); PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT); PUT3_ARG(REAL_KIND,XREAL,REALLENGTH) END; PROCEDURE STRING; VAR LENGTH:INTEGER; DISP:DISPLACEMENT; BEGIN PUSH; READ_IFL(LENGTH); READ_IFL(DISP); PUT3(VAR2,LCONST2_MODE,DISP,CONSTANT); PUT3_ARG(STRING_KIND,LENGTH,LENGTH) END; PROCEDURE VARIANT; VAR TAGSET:INTEGER; TAGFIELD:ENTRY_PTR; BEGIN READ_IFL(TAGSET); PUSH_O13; JUMP1=14; JUMP_DEF1=15; DEF_LABEL1=16; CHK_TYPE1=17; CASE_LIST1=18; FOR_STORE1=19; FOR_LIM1=20; FOR_UP1=21; FOR_DOWN1=22; WITH1=23; VALUE1=24; LT1=25; EQ1=26; GT1=27; LE1=28; NE1=29; GE1=30; IN1=31; UPLUS1=32; UMINUS1=33; PLUS1=34; MINUS1=35; OR1=36; STAR1=37; SLASH1=38; DIV1=39; MOD1=40; AND1=41; NOT1=42; LD_ENTRY(TAGFIELD); T:=T-1; WITH TAGFIELD@ DO IF CLASS=VALUE THEN PUT2(VARIANT2,TAGSET,VDISP) END; PROCEDURE VCOMP(OP:INTEGER); VAR N:NOUN_INDEX; VAR_ENTRY:ENTRY_PTR; BEGIN IF OP=VCOMP2 THEN T:=T-1 "POP RECORD"; PUSH_OLD_ENTRY(VAR_ENTRY); WITH VAR_ENTRY@ DO BEGIN PUT3(OP,VMODE,VDISP,CONTEXT); PUT_TYPE; IF SAVE_CONTEXT THEN BEGIN WITH_CONTEXT:=CONTEXT; SAVE_CONTEXT:=FALSE END END END; PROCEDURE ARROW; BEGIN PUT0(ARROW2); PUT_TYPE; S EMPTY_SET1=43; INCLUDE1=44; FUNCTION1=45; CALL_FUNC1=46; CALL_GEN1=47; ROUTINE1=48; VAR1=49; ARROW1=50; VCOMP1=51; VARIANT1=52; SUB1=53; NEW_LINE1=54; MESSAGE1=55; LCONST1=56; INITVAR1=57; UNDEF1=58; RANGE1=59; CASE_JUMP1=60; "OUTPUT OPERATORS" PUSHCONST2=0; PUSHVAR2=1; PUSHIND2=2; PUSHADDR2=3; FIELD2=4; INDEX2=5; POINTER2=6; VARIANT2=7; RANGE2=8; ASSTACK(.T.):=UENTRY END; PROCEDURE SUB; VAR N:NOUN_INDEX; INDEX,ELEMENT:ENTRY_PTR; LENGTH:DISPLACEMENT; BEGIN "INDEX" TYPE_; INDEX:=STACK(.T.); T:=T-1; "ELEMENT" TYPE_; ELEMENT:=STACK(.T.); T:=T-1; WITH ELEMENT@ DO IF KIND=CHAR_KIND THEN LENGTH:=BYTELENGTH ELSE LENGTH:=SIZE; WITH INDEX@ DO BEGIN IF KIND IN INDEXS THEN PUT3(SUB2,MIN,MAX,LENGTH) ELSE PUT3(SUB2,0,0,1); PUT3_ARG(KIND,NOUN,SIZE) END; WITH ELEMENT@ DO PUT3_ARG(KIND,NOUN,LENGTH); T:=T-1; STA" ^6 X 0    ^b$   " L @   .6n    T   T \T26  "  "*   XX  X, ."     " " M=0; FOR I:=DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:=DIGIT+1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:=0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('5'); PRINTEOL END; PROCEDURE PRINTOP(OP:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:=PRINTED+1; END; PROCEDURE PRINTARG(ARG:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; IF ARG<0 THEN WRITE('-') ELSE WRITE(' '); PRINTA.   X  "   *x0LTd*   T0 ,(&~ ^ 6  v&< N& .&   " *L<.,j6.  " ` IGN2=9; ASSIGNTAG2=10; COPY2=11; NEW2=12; NOT2=13; AND2=14; OR2=15; NEG2=16; ADD2=17; SUB2=18; MUL2=19; DIV2=20; MOD2=21; "NOT USED" "NOT USED" FUNCTION2=24; BUILDSET2=25; COMPARE2=26; COMPSTRCT2=27; FUNCVALUE2=28; DEFLABEL2=29; JUMP2=30; FALSEJUMP2=31; CASEJUMP2=32; INITVAR2=33; CALL2=34; ENTER2=35; RETURN2=36; POP2=37; NEW $%%:"+R  ".1b  "V 0: " " = Pf( I6n B dJ H." T *( V6n B XJ .b" LINE2=38; ERR2=39; LCONST2=40; MESSAGE2=41; INCREMENT2=42; DECREMENT2=43; PROCEDURE2=44; INIT2=45; PUSHLABEL2=46; CALLPROG2=47; EOM2=48; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; "STANDARD BS(ARG); PRINTED:=PRINTED+1; END; PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF DEBUG THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF DEBUG THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG1:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF DEBUG THEN BEGIN NOUN INDICES" ZARITHMETIC=17; ZINDEX=18; ZPASSIVE=19; ZPOINTER=20; ZVPARM=21; ZCPARM=22; ZSPARM=23; ZNPARM=24; ZWITH=25; "CONTEXT" FUNC_RESULT=1; ENTRY_VAR=2; VARIABLE=3; VAR_PARM=4; UNIV_VAR=5; CONST_PARM=6; UNIV_CONST=7; FIELD=8; EXPR=10; CONSTANT=11; SAVE_PARM=12; NEW_PARM=13; TAG_FIELD=14; WITH_CONST = 15; WITH_VAR = 16; "TYPE KIND" INT_KIND=0; REAL_KIND=1; BOOL_KIND=2; PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4) END END; PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER); BEGIN CHAR_KIND=3; ENUM_KIND=4; SET_KIND=5; STRING_KIND=6; NONLIST_KIND=7; POINTER_KIND=8; LIST_KIND=9; GENERIC_KIND=10; UNDEF_KIND=11; ROUTINE_KIND=12; "DATA TYPS" BYTE_TYP=0; WORD_TYP=1; REAL_TYP=2; SET_TYP=3; STRUCT_TYP=4; "ADDRESS MODES" SCONST_MODE=11; LCONST_MODE=0; PROC_MODE=1; PROG_MODE=2; PE_MODE=3; CE_MODE=4; ME_MODE=5; PROCESS_MODE=6; CLASS_MODE=7; MONITOR_MODE=8; STD_MODE=9; UNDEF_ WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); WRITE_IFL(ARG5); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4); PRINTARG(ARG5) END END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF" "##########################" "OPERAND STACK MANIPULATION" "##########################" PROCEDURE POP; BEGIN T:=S; TOP_STACK:=TOP_STACK@.NEXT_ENTRY; RELEASE(TOP_STACK@.RESET_POINT); MODE=10; TEMP_MODE=PROC_MODE; "COMPARISONS" LESS=0; EQUAL=1; GREATER=2; NOTLESS=3; NOTEQUAL=4; NOTGREATER=5; INSET=6; "ERRORS" COMPILER_ERROR=1; TYPE_ERROR=2; ADDRESS_ERROR=3; ASSIGN_ERROR=4; THIS_PASS=5; BYTELENGTH = 1; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; TYPE TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; DISPLACEMENT=INTEGER; ADDR_STATE=(DIRECT,INDIRECT,ADDR,EXPRESSION); ADDR_MODE= LCONST_MODE..SCONST_MODE; ADDR IF TOP_STACK=EMPTY_STACK THEN S:=NIL ELSE S:=TOP_STACK@.NEXT_ENTRY@.OPND; END; PROCEDURE PUSH; BEGIN S:=T; NEW(THIS_STACK); WITH THIS_STACK@ DO BEGIN NEW(OPND); T:=OPND; NEXT_ENTRY:=TOP_STACK; MARK(RESET_POINT) END; TOP_STACK:=THIS_STACK END; "##########" "INITIALIZE" "##########" PROCEDURE INITIALIZE; BEGIN DONE:=FALSE; INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; _MODES=SET OF ADDR_MODE; TYPE_KIND=INT_KIND..ROUTINE_KIND; STORE_CLASS=(STORE_FOR,STORE_TAG,STORE_USUAL); TYPE_KINDS=SET OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; OPERAND_CLASS=(UNDEFINED,VALUE,ROUTINE); OPERAND= RECORD KIND:TYPE_KIND; NOUN:INTEGER; MODE:ADDR_MODE; DISP:DISPLACEMENT; LENGTH:DISPLACEMENT; CASE CLASS:OPERAND_CLASS OF VALUE:(CONTEXT:CONTEXT_KIND; STATE:ADDR_STATE); ROUTINE:(PARM_SIZE,VAR_SIZE:DISPL ARITHMETIC:=(.INT_KIND,REAL_KIND.); INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); SMALLS:=INDEXS OR (.REAL_KIND,SET_KIND,POINTER_KIND.); NONLISTS:=INDEXS OR (.REAL_KIND,SET_KIND,STRING_KIND,NONLIST_KIND.); LARGES:=(.STRING_KIND,NONLIST_KIND,LIST_KIND.); INDIRECTS:=LARGES; ROUTINE_MODES:= (.PROC_MODE,PE_MODE,CE_MODE,ME_MODE.); UNIVERSAL:=(.UNIV_VAR,UNIV_CONST.); ASSIGNS:=(.FUNC_RESULT,VARIABLE,VAR_PARM,UNIV_VAR, WITH_VAR.); POINTERS:=(.POINTER_KIND,UNDEF_KIND.); ACEMENT) END; OPERAND_PTR=@OPERAND; STACK_LINK=@STACK_ENTRY; STACK_ENTRY=RECORD OPND:OPERAND_PTR; RESET_POINT:INTEGER; NEXT_ENTRY:STACK_LINK END; VAR INT_EXPR,REAL_EXPR,BOOL_EXPR,SET_EXPR,UNDEF_EXPR: OPERAND; SY: INTEGER; S,T: OPERAND_PTR; INTER_PASS_PTR: PASSPTR; CURRENT_MODE: ADDR_MODE; ROUTINE_MODES: ADDR_MODES; TOP_STACK,THIS_STACK,EMPTY_STACK:STACK_LINK; DEBUG,DONE: BOOLEAN; NONLISTS,INDEXS,LARGES,ARI WITHED:= (.WITH_CONST, WITH_VAR.); CNST_PARMS:=(.CONST_PARM,UNIV_CONST.); VAR_PARMS:=(.VAR_PARM,UNIV_VAR,NEW_PARM.); S:=NIL; T:=NIL; NEW(EMPTY_STACK); TOP_STACK:=EMPTY_STACK; WITH EMPTY_STACK@ DO BEGIN NEXT_ENTRY:=NIL; OPND:=NIL; MARK(RESET_POINT) END; WITH INT_EXPR DO BEGIN KIND:=INT_KIND; NOUN:=XINTEGER; LENGTH:=WORDLENGTH; MODE:=UNDEF_MODE; CLASS:=VALUE; CONTEXT:=EXPR; STATE:=EXPRESSION END; REAL_EXPR:=INT_EXPR; WITH REAL_EXPR DO BEGIN KTHMETIC,INDIRECTS,SMALLS,POINTERS: TYPE_KINDS; UNIVERSAL,ASSIGNS,VAR_PARMS,CNST_PARMS, WITHED: CONTEXTS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:=IND:=REAL_KIND; NOUN:=XREAL; LENGTH:=REALLENGTH END; BOOL_EXPR:=INT_EXPR; WITH BOOL_EXPR DO BEGIN KIND:=BOOL_KIND; NOUN:=XBOOLEAN END; SET_EXPR:=INT_EXPR; WITH SET_EXPR DO BEGIN KIND:=SET_KIND; NOUN:=XUNDEF; LENGTH:=SETLENGTH END; UNDEF_EXPR:=INT_EXPR; WITH UNDEF_EXPR DO BEGIN KIND:=UNDEF_KIND; NOUN:=XUNDEF END; PUT1(JUMP2,1) "JUMP TO BLOCK LABEL 1, THE INITIAL PROCESS" END; "######" "ERRORS" "######" PROCEDURE ERROR1(ERROR: INTEGER 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 5: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOL.U #        "$^$ @$hd,n   X  n  X   n@  B  "$~  H < 0(   "   TYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN    "  "Z2  ,T    X &z  \  2p(\\ X "  "( <T N    "8  X 6"    Tb WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG:INTEGER); VAR T:ARRAY (.1..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER; BEGIN REM:=ARG; DIGIT:=0; REPEAT DIGIT:=DIGIT+1; T(.DIGIT.):=CHR(ABS(REM MOD 10) + ORD('0')); REM:=REM DIV 10; UNTIL RE); BEGIN WITH T@ DO IF KIND=UNDEF_KIND THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); T@:=UNDEF_EXPR END; PROCEDURE ERROR2(ERROR:INTEGER); BEGIN IF (T@.KIND=UNDEF_KIND) OR (S@.KIND=UNDEF_KIND) THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); S@:=UNDEF_EXPR END; PROCEDURE ERROR2P(ERROR:INTEGER); BEGIN ERROR2(ERROR); POP END; PROCEDURE EOM; VAR VAR_LENGTH:DISPLACEMENT; BEGIN WITH INTER_PASS_PTR@ DO RELEASE(RESETPO             N P R T V H J L i k m o q s u w a c e g                       7 ! # % ' ) + - / 1 3 5 " ( * , . 0 2 4 6 t v x z | ~ n p r        !#%'INT); READ_IFL(VAR_LENGTH); PUT1(EOM2,VAR_LENGTH); DONE:=TRUE END; PROCEDURE ABORT; BEGIN PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR); EOM END; "#############" "TYPE CHECKING" "#############" FUNCTION TTYP:INTEGER "TYPE CODE"; BEGIN WITH T@ DO CASE KIND OF INT_KIND,BOOL_KIND,ENUM_KIND,POINTER_KIND, UNDEF_KIND: TTYP:=WORD_TYP; REAL_KIND: TTYP:=REAL_TYP; CHAR_KIND: IF LENGTH=WORDLENGTH THEN TTYP:=WORD_TYP ELSE TTYP:=BYTE_TYP; f<h&  " `(  ""$  """"""& Z<  Z L    (  "   (  "   (  "& XR B Z   N  . BN@>0.8 D H X L,lh  L JF X 2 B . V X8(d h Xn2 6 X   Z \$  "" "  "&  "  " XR  Z $   ""0   "" >"   P0>   L" X " \(  >" `  XF 2 ~.!nx"^ X#,$&X\ X%&&*'r* \ `2 ` Xa~ brlcf`dZTeN@f:4g.(h"ll~D(4L & & 6" "&!" `6$ & XvC d >"$ - X2 V-   >""9"<"?"Bnf^V"HB:2*"$ T V   r X@@V X@@   FJ B X 6A *Br > B"C >:" ` x| D LrV X(F BHD"`E *( dn B 0J ."  *2rh X lT2  X2r & *0{ LT 0 LT \& z  X X$ l >""$ \  0 l ( V >"N"$e    V >""$p " H  | t 0 (  V >"F"$} *       | * X$ 8 *v X X2|2F "L *  "  $l X X2d L *$  X X2  l *&   X X$  *j X2F h V  >""$  d V >"N""  $  B"(  02"p "$ V >" Z  "$ B"$ V >" Z  "$ B"$ " *  " l `" ^  * ( *"0t lTf X  "(  ^ " ( *   "   X  ^2 Z*   X`  V >" Z  "$ B"$   BV >"4 Z  "$  B"$  V " >"*  n p " Z >" 0  p*  ~ ^ Fr " X  t."       *l(     "  *$l *t(   "bt  0  "   X   "   ".D<4 p *4Z >" 2 " ~$  BVDJ8>$ *L$  J*P+D,8-,. />$ ) J0P1vD2j83^,4R 5F:6r$ 6 >6D788,9 )  Xn   "   "   T0   " ~ !d@8 Z*0zV|PtbZN@Fl>2L*+h*L!^"4) : ^ ($ D J:P;D<t8=h,>\ ?P L* W . " dB" Z6  . " dB"(d " " dZ$ " dB"  c "( p " " dZ$ " dB"  c"~~r&:fZ R2F`:".Z&>r 8zXj;4DvF0@6D& XFpn.$ZB tzTh,xV0Dx  ZۖPASS 5: FILE_LIMIT^"4)$  "" 2X """& " " " " >""" X R >"&  B BV" > > >" "4  T" T" T" T""    2 ^ >" P" " >V* G I > U M > Q > xhS XK  L<O  0  *Jd~ fH&tJhV\NPRDT8L,P L"" D   R8& .T  > >"  "  "  "  "  "  "  "." P  X   f j V n B F ^ < T  W  "" L `0 >" xVn BY2Z"& \ `2 riLvj<fkxRl|FmpX2n\"oLt X0] N  >` X[ 2\ BER" VALUE_; IF T@.KIND IN INDEXS THEN BEGIN IF S@.NOUN=XUNDEF THEN S@.NOUN:=T@.NOUN ELSE IF S@.NOUN<>T@.NOUN THEN ERROR2(TYPE_ERROR); PUT0(BUILDSET2) END ELSE ERROR2(TYPE_ERROR); POP END; PROCEDURE FUNCTION_; BEGIN PUSH; T@:= UNDEF_EXPR; T@.CONTEXT:= FUNC_RESULT; "FUNC" TYPE_; WITH S@ DO IF (CLASS = ROUTINE) AND (MODE <> STD_MODE) THEN PUT2(FUNCVALUE2, MODE, TTYP); END; PROCEDURE CALL_FUNC; BEGIN WITH S@ DO IF CLASS = ROUTIPUT3(CALL2,MODE,DISP,PARM_SIZE); POP END; PROCEDURE CALL_NEW; BEGIN IGNORE2(NEW2); POP END; PROCEDURE CONSTPARM (GENERIC: BOOLEAN); BEGIN "PARAMETER" VAR_; IF COMPATIBLE THEN IF T@.CONTEXT = UNIV_CONST THEN S@.KIND:= T@.KIND; POP "PARAMETER"; "ARGUMENT" VALUE_; IF GENERIC THEN S@ "FUNCTION RESULT" := T@ "ACTUAL ARGUMENT"; POP "ARGUMENT" END; PROCEDURE VARPARM; BEGIN "ARGUMENT" ADDRESS; "PARAMETER" VAR_; IF COMPATIBLE THEN IF NONE THEN IF MODE=STD_MODE THEN PUT2(FUNCTION2, DISP, TTYP) ELSE PUT3(CALL2, MODE, DISP, PARM_SIZE); S@:=T@; POP END; PROCEDURE CALL_GEN; BEGIN WITH S@ DO PUT2(FUNCTION2,DISP,TTYP); T@.CONTEXT:= FUNC_RESULT; S@:= T@; POP "ARG" END; "########" "VARIABLE" "########" PROCEDURE UNDEF; BEGIN PUSH; T@:=UNDEF_EXPR; PUT1(PUSHCONST2,0) END; PROCEDURE VCOMP; VAR SAVE_CONTEXT:INTEGER; BEGIN SAVE_CONTEXT:= T@.CONTEXT; VAR_REF; TYPE_; WITH T@ DO BEGINT (S@.CONTEXT IN ASSIGNS) THEN ERROR2(ASSIGN_ERROR); POP "PARAMETER"; POP "ARGUMENT" END; PROCEDURE FALSE_JUMP; VAR L:DISPLACEMENT; BEGIN "BOOLEAN" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); READ_IFL(L); PUT1(FALSEJUMP2,L); POP END; PROCEDURE CASE_JUMP; VAR L:DISPLACEMENT; BEGIN "SELECTOR" VALUE_; READ_IFL(L); PUT1(JUMP2,L) END; PROCEDURE DEF_LABEL; VAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(DEFLABEL2,L) END; PROCEDURE JUMP; PUT1(FIELD2,DISP); STATE:=ADDR; IF CONTEXT=VARIABLE THEN CONTEXT:=ENTRY_VAR ELSE CONTEXT:=SAVE_CONTEXT; END END; PROCEDURE SUB; VAR MIN,MAX,SIZE: INTEGER; BEGIN "SUBSCRIPT" VALUE_; READ_IFL(MIN); READ_IFL(MAX); READ_IFL(SIZE); PUT3(INDEX2,MIN,MAX,SIZE); PUSH; T@:=UNDEF_EXPR; "INDEX" TYPE_; IF COMPATIBLE THEN "OK"; POP; POP; "ELEMENT" TYPE_; END; PROCEDURE ARROW; VAR SAVE_CONTEXT:CONTEXT_KIND; BEGIN WITH T@ DO IF KIND=POINTEVAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(JUMP2,L) END; PROCEDURE JUMP_DEF; BEGIN JUMP; DEF_LABEL END; PROCEDURE CHK_TYPE; BEGIN PUSH; T@:=INT_EXPR; TYPE_; IF COMPATIBLE THEN "OK"; POP END; PROCEDURE CASE_LIST; VAR I,MIN,MAX:INTEGER; L:DISPLACEMENT; BEGIN POP "SELECTOR"; DEF_LABEL; READ_IFL(MIN); READ_IFL(MAX); PUT2(CASEJUMP2,MIN,MAX); FOR I:=MIN TO MAX DO BEGIN READ_IFL(L); PUT_ARG(L) END; DEF_LABEL END; PROCEDURE POP_TEMP; R_KIND THEN BEGIN SAVE_CONTEXT:=CONTEXT; "POINTER" VALUE_; CONTEXT:=SAVE_CONTEXT; IF NOT (CONTEXT IN WITHED) THEN PUT0(POINTER2); STATE:=ADDR END ELSE ERROR1(TYPE_ERROR); "OBJECT" TYPE_ END; "#########" "MAIN LOOP" "#########" BEGIN "MAIN PROGRAM" INITIALIZE; REPEAT "MAIN LOOP" READ_IFL(SY); CASE SY OF ADDRESS1: ADDRESS; AND1: OR_AND(AND2); ARROW1: ARROW; BODY_END1: BODY_END; BODY1: BODY; CALL_FUNC1: CALL_FUNC; CALL_GEN1: CALL_GEN; CALL_NEW1: CALL_NEW SET_KIND: TTYP:=SET_TYP; STRING_KIND,NONLIST_KIND,LIST_KIND: TTYP:=STRUCT_TYP; GENERIC_KIND,ROUTINE_KIND: BEGIN ERROR1(TYPE_ERROR); TTYP:=WORD_TYP END END END; FUNCTION COMPATIBLE:BOOLEAN; VAR RESULT:BOOLEAN; BEGIN IF (T@.CLASS <> VALUE) OR (S@.CLASS <> VALUE) THEN RESULT:= FALSE ELSE IF T@.CONTEXT IN UNIVERSAL THEN RESULT:=(S@.KIND IN NONLISTS) AND (T@.LENGTH=S@.LENGTH) ELSE IF T@.KIND=S@.KIND THEN CASE T@.KIND OF INT_KIND,REAL BEGIN POP; PUT1(POP2,WORDLENGTH) END; PROCEDURE FOR_STORE; BEGIN "INITIAL" VALUE_; STORE(STORE_FOR); T@.STATE:=DIRECT END; PROCEDURE FOR_LIM; VAR OP:INTEGER; LIMIT_DISP:DISPLACEMENT; LABEL:DISPLACEMENT; BEGIN "FINAL" VALUE_; DEF_LABEL; POP "LIMIT"; "CONTROL VAR" VALUE_; T@.STATE:=DIRECT; READ_IFL(LIMIT_DISP); PUT3(PUSHVAR2,WORD_TYP,TEMP_MODE,LIMIT_DISP); READ_IFL("COMPARISON"OP); PUT2(COMPARE2,OP,WORD_TYP); READ_IFL(LABEL); PUT1(FALSEJUMP2,LABEL) _KIND,BOOL_KIND,CHAR_KIND, ENUM_KIND,NONLIST_KIND,LIST_KIND: RESULT:=T@.NOUN=S@.NOUN; STRING_KIND: RESULT:=(T@.LENGTH=S@.LENGTH) OR (T@.CONTEXT IN CNST_PARMS); SET_KIND,POINTER_KIND: RESULT:=(T@.NOUN=S@.NOUN) OR (T@.NOUN=XUNDEF) OR (S@.NOUN=XUNDEF); UNDEF_KIND,ROUTINE_KIND: RESULT:=FALSE END ELSE IF T@.KIND=GENERIC_KIND THEN CASE T@.NOUN OF ZARITHMETIC: RESULT:=S@.KIND IN ARITHMETIC; ZINDEX: RESULT:=S@.KIND IN IN END; PROCEDURE FOR_LOOP(OP:INTEGER); BEGIN "CONTROL VAR" ADDRESS; PUT0(OP); JUMP_DEF; POP_TEMP END; "##########" "EXPRESSION" "##########" PROCEDURE EQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF CHAR_KIND,INT_KIND,BOOL_KIND, ENUM_KIND,POINTER_KIND, REAL_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND,NONLIST_KIND,LIST_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); GENERIC_KIND,UNDEF_KIND,ROUTINE_KDEXS END ELSE RESULT:=FALSE; IF NOT RESULT THEN ERROR2(TYPE_ERROR); COMPATIBLE:=RESULT END; "######" "IGNORE" "######" PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); POINTER_KIND,GENERIC_KIND,LIST_KIND,NONLIST_KIND, UNDEF_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE STRICT_INEQU_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; "####" "BODY" "####" PROCEDURE ROUTINE_; BEGIN PUSH; WITH T@ DO BEGIN READ_IFL(MODE); READ_IFL(DISP); CLASS:=ROUTINE; READ_IFL(PARM_SIZE); READ_IFL(VAR_SIZE); END END; PROCEDURE BODY; BEGIN ROUTINE_; WITH T@ DO BEGIN PUT5(ENTER2,MODE,DISP,PARM_SIZE,VAR_SIZE,0); CURRENT_MODE:=MODE END END; PROCEDURE BODY_END; BEGIN PUT1(RETURN2,CURRENT_MODE); POP END; "#######" "LOADIALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); SET_KIND,POINTER_KIND,LIST_KIND,NONLIST_KIND, ROUTINE_KIND,UNDEF_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INCLUSION; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=SET_KIND) AND (S@.KIND IN INDEXS) AND (NG" "#######" PROCEDURE ADDR_ERROR; BEGIN ERROR1(ADDRESS_ERROR); PUT1(PUSHCONST2,0) END; PROCEDURE ADDRESS; BEGIN WITH T@ DO IF CLASS=VALUE THEN BEGIN CASE STATE OF DIRECT: IF MODE=SCONST_MODE THEN ADDR_ERROR ELSE PUT2(PUSHADDR2,MODE,DISP); INDIRECT: PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); ADDR: ; EXPRESSION: ADDR_ERROR END; STATE:=ADDR END ELSE ADDR_ERROR END; PROCEDURE TYPE_; BEGINS@.NOUN=T@.NOUN) THEN PUT2(COMPARE2,INSET,SET_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=BOOL_EXPR END; PROCEDURE UMINUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN PUT1(NEG2,TTYP) ELSE ERROR1(TYPE_ERROR) END; PROCEDURE UPLUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN "OK" ELSE ERROR1(TYPE_ERROR) END; PROCEDURE PLUS_MINUS_STAR(OP:INTEGER); VAR TNOUN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=INT_KI WITH T@ DO BEGIN READ_IFL(KIND); READ_IFL(NOUN); READ_IFL(LENGTH) END END; PROCEDURE RESULT; BEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(DISP); PUT2(PUSHADDR2,MODE,DISP); CONTEXT:=FUNC_RESULT; STATE:=ADDR; "RESULT" TYPE_ END END; PROCEDURE VALUE_; BEGIN WITH T@ DO BEGIN IF KIND IN SMALLS THEN BEGIN "LOAD VALUE" CASE STATE OF DIRECT: IF MODE=SCONST_MODE THEN PUT1(PUSHCONST2,DISP) ELSE PUT3(PUSHVAR2,TTND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=INT_EXPR END ELSE IF T@.KIND=REAL_KIND THEN BEGIN PUT1(OP,REAL_TYP); POP; T@:=REAL_EXPR END ELSE IF (T@.KIND=SET_KIND) AND (OP=SUB2) AND COMPATIBLE THEN BEGIN PUT1(SUB2,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE SLASH; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=REAL_KIND) AND (S@.KIND=REAL_KYP,MODE,DISP); INDIRECT: BEGIN PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); PUT1(PUSHIND2,TTYP) END; ADDR: PUT1(PUSHIND2,TTYP); EXPRESSION: END; IF LENGTH=BYTELENGTH THEN LENGTH:=WORDLENGTH; STATE:=EXPRESSION END ELSE IF KIND IN INDIRECTS THEN ADDRESS ELSE "ERROR" PUT1(PUSHCONST2,0); CONTEXT:=EXPR END END; PROCEDURE STORE(STORE_WHAT:STORE_CLASS); VAR TYP:INTEGER; SIMILAR:BOOLEAN; CLEAR_LENGTH:DISPLACEMIND) THEN PUT1(DIV2,REAL_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=REAL_EXPR END; PROCEDURE DIV_MOD(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=INT_KIND) AND (S@.KIND=INT_KIND) THEN PUT1(OP,WORD_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=INT_EXPR END; PROCEDURE OR_AND(OP:INTEGER); VAR TNOUN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=BOOL_KIND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=BOOL_EXPR ENT; BEGIN IF STORE_WHAT=STORE_TAG THEN READ_IFL(CLEAR_LENGTH); "EXPRESSION" VALUE_; SIMILAR:=COMPATIBLE; POP "EXPRESSION"; IF SIMILAR THEN WITH T@ DO IF CONTEXT IN ASSIGNS THEN BEGIN TYP:=TTYP; IF STORE_WHAT<>STORE_TAG THEN IF TYP=STRUCT_TYP THEN PUT1(COPY2,LENGTH) ELSE PUT1(ASSIGN2,TYP) ELSE PUT1(ASSIGNTAG2,CLEAR_LENGTH) END ELSE ERROR1(ASSIGN_ERROR); IF STORE_WHAT<>STORE_FOR THEN POP "VARIABLE" END; "##########" "STATEMENTS" END ELSE IF (T@.KIND=SET_KIND) AND COMPATIBLE THEN BEGIN PUT1(OP,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE NOT_; BEGIN "OPERAND" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); T@:=BOOL_EXPR; PUT0(NOT2) END; PROCEDURE EMPTY_SET; BEGIN PUSH; T@:=SET_EXPR; PUT3(PUSHVAR2,SET_TYP,LCONST_MODE,0) END; PROCEDURE INCLUDE; BEGIN "SET MEM "##########" PROCEDURE VAR_REF; BEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(MODE); READ_IFL(DISP); READ_IFL(CONTEXT) END END; PROCEDURE VAR_; BEGIN PUSH; VAR_REF; "VAR" TYPE_; WITH T@ DO IF(CONTEXT IN VAR_PARMS) OR (CONTEXT IN CNST_PARMS) AND (KIND IN LARGES) THEN STATE:=INDIRECT ELSE STATE:=DIRECT END; PROCEDURE CALL_PROC; BEGIN WITH T@ DO IF CLASS=ROUTINE THEN IF MODE=STD_MODE THEN PUT1(PROCEDURE2,DISP) ELSE 52 4 6 8 : < > @ B D F 1 3 5 7 9 A C E G M O Q S U W Y [ ] _ I K X Z \ ^ d f h j l n p r t v ` b  y { } x z | ~ n p r t v x z | ~        !#%' ENDPROC2 = 84; ENTERPROC2 = 85; EXITPROC2 = 86; POP2 = 87; NEWLINE2 = 88; INCRWORD2 = 89; DECRWORD2 = 90; INITCLASS2 = 91; INITMON2 = 92; INITPROC2 = 93; PUSHLABEL2 = 94; CALLPROG2 = 95; TRUNCREAL2 = 96; ABSWORD2 = 97; ABSREAL2 = 98; SUCCWORD2 = 99; PREDWORD2 = 100; CONVWORD2 = 101; EMPTY2 = 102; ATTRIBUTE2 = 103; REALTIME2 = 104; DELAY2 = 105; CONTINUE2 = 106; IO2 = 107; START2 = 108; STOP2 = 109; SETHEAP2 = 110; WAIT2 = 1"PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT/SEQUENTIAL PASCAL COMPILER PASS 6: CODE SELECTION 9 SEPTEMBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTI11; MESSAGE2 = 112; EOM2=113; "OTHER CONSTANTS" PDP11 = TRUE; CONCURRENT=FALSE; INITIALBLOCK = 1; SPLITLENGTH = 4 "WORDS PER REAL"; TWOWORDS = 4; THREEWORDS = 6; FOURWORDS = 8; FIVEWORDS = 10; STACK_LIMIT = 32667 "GREATEST INTEGER - 100"; CODE_LIMIT = 32667; THIS_PASS = 6; INFILE = 2; OUTFILE = 1; STACK_ERROR = 1; CODE_ERROR = 2; VAR LINK: PASSPTR; SUMMARY, TEST, CHECK, GENERATE, NUMBER, AFTERBEGIN, AFTERERROR, DONE: BOOLEAN; JUMPTABLE, BLOCKTABLE, STACKTABLE, COON = 4; NUMBEROPTION = 5; MAXWORD = 100; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; TABLEPTR = @TABLE; TABLE = RECORD NEXTPORTION: TABLEPTR; CONTENTS: ARRAY (.1..MAXWORD.) OF INTEGER END; TABLEPART = RECORD PROGLENGTH, CODELENGTH, STACKLENGTH, VARLENGTH: INTEGER; JUMPTABLE, BLOCKTABLE, STACKTABLE, CONSTTABLE: TABLEPTR END; TABLESPTNSTTABLE: TABLEPTR; CONSTANTS, STACKLENGTH, VARLENGTH, PARAMLENGTH, POPLENGTH, TEMP, MAXTEMP, BLOCK, LOCATION, LINE, OP, ARG1, ARG2, ARG3, ARG4, ARG5: INTEGER; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXTR = @TABLEPART; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: TABLESPTR END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) _TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 6: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, END; CONST MAXARG = 10; TEXT_LENGTH = 18; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCE PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDSDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" PUSHCONST1 = 0; PUSHVAR1 = 1; PUSHIND1 = 2; PUSHADDR1 = 3; FIELD1 = 4; INDEX1 = 5; POINTER1 = 6; VARIANT1 = 7; RANGE1 = 8; ASSIGN1 = 9; ASSIGNTAG1 = 10; COPY1 = 11; NEW1 = 12; NOT1 = 13; AND1 = 14; OR1; CALL_PROC1: CALL_PROC; CASE_JUMP1: CASE_JUMP; CASE_LIST1: CASE_LIST; CHK_TYPE1: CHK_TYPE; CONSTPARM1: CONSTPARM(FALSE); DEF_LABEL1: DEF_LABEL; DIV1: DIV_MOD(DIV2); EMPTY_SET1: EMPTY_SET; EOM1: EOM; EQ1: EQUALITY(EQUAL); FALSEJUMP1: FALSE_JUMP; FOR_DOWN1: FOR_LOOP(DECREMENT2); FOR_LIM1: FOR_LIM; FOR_STORE1: FOR_STORE; FOR_UP1: FOR_LOOP(INCREMENT2); FUNCTION1: FUNCTION_; GE1: INEQUALITY(NOTLESS); GT1: STRICT_INEQUALITY(GREATER); INCLUDE1: INCLUDE; INITVAR1: IGNORE1(INITVAR2); IN1: INCLU = 15; NEG1 = 16; ADD1 = 17; SUB1 = 18; MUL1 = 19; DIV1 = 20; MOD1 = 21; "NOT USED" "NOT USED" FUNCTION1 = 24; BUILDSET1 = 25; COMPARE1 = 26; COMPSTRUC1 = 27; FUNCVALUE1 = 28; DEFLABEL1 = 29; JUMP1 = 30; FALSEJUMP1 = 31; CASEJUMP1 = 32; INITVAR1 = 33; CALL1 = 34; ENTER1 = 35; RETURN1 = 36; POP1 = 37; NEWLINE1 = 38; ERROR1 = 39; CONSTANT1 = 40; MESSAGE1 = 41; INCREMENT1 = 42; DECREMENT1SION; JUMP_DEF1: JUMP_DEF; JUMP1: JUMP; LCONST1: LCONST; LE1: INEQUALITY(NOTGREATER); LT1: STRICT_INEQUALITY(LESS); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: PLUS_MINUS_STAR(SUB2); MOD1: DIV_MOD(MOD2); NEW_LINE1: IGNORE1(NEWLINE2); NE1: EQUALITY(NOTEQUAL); NOT1: NOT_; OR1: OR_AND(OR2); PLUS1: PLUS_MINUS_STAR(ADD2); RANGE1: IGNORE2(RANGE2); RESULT1: RESULT; ROUTINE1: ROUTINE_; SAVEPARM1: CONSTPARM(TRUE); SLASH1: SLASH; STAR1: PLUS_MINUS_STAR(MUL2); STORE1: STORE(STORE_USUAL); SUB1: SUB; TAG_ = 43; PROCEDURE1 = 44; INIT1 = 45; PUSHLABEL1 = 46; CALLPROG1 = 47; EOM1=48; "VIRTUAL DATA TYPES" BYTETYPE = 0; WORDTYPE = 1; REALTYPE = 2; SETTYPE = 3; "VIRTUAL ADDRESSING MODES" MODE0 = 0 "CONSTANT"; MODE1 = 1 "PROCEDURE"; MODE2 = 2 "PROGRAM"; MODE3 = 3 "PROCESS ENTRY"; MODE4 = 4 "CLASS ENTRY"; MODE5 = 5 "MONITOR ENTRY"; MODE6 = 6 "PROCESS"; MODE7 = 7 "CLASS"; MODE8 = 8 "MONITOR"; MODE9 = 9 "STANDARD"; MODE10=10 "UNDEFINED"; "COMPARISON OPERATORS" LESS = 0; EQSTORE1: STORE(STORE_TAG); UMINUS1: UMINUS; UNDEF1: UNDEF; UPLUS1: UPLUS; VALUE1: VALUE_; VARIANT1: IGNORE2(VARIANT2); VARPARM1: VARPARM; VAR1: VAR_; VCOMP1: VCOMP; WITH1: POP_TEMP END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END. UAL = 1; GREATER = 2; NOTLESS = 3; NOTEQUAL = 4; NOTGREATER = 5; INSET = 6; "STANDARD FUNCTIONS" TRUNC1 = 0; ABS1 = 1; SUCC1 = 2; PRED1 = 3; CONV1 = 4; EMPTY1 = 5; ATTRIBUTE1 = 6; REALTIME1 = 7; MIN_FUNC = 0; MAX_FUNC = 7; "STANDARD PROCEDURES" DELAY1 = 0; CONTINUE1 = 1; IO1 = 2; START1 = 3; STOP1 = 4; SETHEAP1 = 5; WAIT1 = 6; MIN_PROC = 0; MAX_PROC = 6; "OUTPUT OPERATORS" CONSTADDR2 =_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= C 0; LOCALADDR2 = 1; GLOBADDR2 = 2; PUSHCONST2 = 3; PUSHLOCAL2 = 4; PUSHGLOB2 = 5; PUSHIND2 = 6; PUSHBYTE2 = 7; PUSHREAL2 = 8; PUSHSET2 = 9; FIELD2 = 10; INDEX2 = 11; POINTER2 = 12; VARIANT2 = 13; RANGE2 = 14; COPYBYTE2 = 15; COPYWORD2 = 16; COPYREAL2 = 17; COPYSET2 = 18; COPYTAG2 = 19; COPYSTRUC2 = 20; NEW2 = 21; NEWINIT2 = 22; NOT2 = 23; ANDWORD2 = 24; ANDSET2 = 25; ORWORD2 = 26; ORSET2 = 27; NEGWORD2 = 2HR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('6'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED 8; NEGREAL2 = 29; ADDWORD2 = 30; ADDREAL2 = 31; SUBWORD2 = 32; SUBREAL2 = 33; SUBSET2 = 34; MULWORD2 = 35; MULREAL2 = 36; DIVWORD2 = 37; DIVREAL2 = 38; MODWORD2 = 39; BUILDSET2 = 40; INSET2 = 41; LSWORD2 = 42; EQWORD2 = 43; GRWORD2 = 44; NLWORD2 = 45; NEWORD2 = 46; NGWORD2 = 47; LSREAL2 = 48; EQREAL2 = 49; GRREAL2 = 50; NLREAL2 = 51; NEREAL2 = 52; NGREAL2 = 53; EQSET2 = 54; NLSET2 = 55; NESET2 = 56= PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "################" "INPUT PROCEDURES" "################" PROCEDURE READ1ARG; BEGIN READ_IFL(ARG1) END; PROCEDURE READ2ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2) END; PROCEDURE READ3ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3) END; PROCEDURE READ4ARG; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); READ_IFL(ARG4); END; PROCEDURE READ5ARG; BEGIN READ_IFL(ARG1);; NGSET2 = 57; LSSTRUCT2 = 58; EQSTRUCT2 = 59; GRSTRUCT2 = 60; NLSTRUCT2 = 61; NESTRUCT2 = 62; NGSTRUCT2 = 63; FUNCVALUE2 = 64; JUMP2 = 65; FALSEJUMP2 = 66; CASEJUMP2 = 67; INITVAR2 = 68; CALL2 = 69; CALLSYS2 = 70; ENTER2 = 71; EXIT2 = 72; ENTERPROG2 = 73; EXITPROG2 = 74; BEGINCLAS2 = 75; ENDCLASS2 = 76; ENTERCLAS2 = 77; EXITCLASS2 = 78; BEGINMON2 = 79; ENDMON2 = 80; ENTERMON2 = 81; EXITMON2 = 82; BEGINPROC2 = 83; READ_IFL(ARG2); READ_IFL(ARG3); READ_IFL(ARG4); READ_IFL(ARG5) END; "#################" "OUTPUT PROCEDURES" "#################" PROCEDURE ERROR (PASS, NUMBER: INTEGER); FORWARD; PROCEDURE WRITE1(OP: INTEGER); BEGIN IF TEST THEN PRINTOP(OP); WRITE_IFL(OP); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE2(OP, ARG: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END; WRITE_IFL(OP)J L P R T V s u w a c e g i k m o q                       / 1 3 5 7 ! # % ' ) + - 0 2 4 6 " ( * , . n p r t v x z | ~        !#%' LESS: WRITE1(LSSTRUCT2); EQUAL: WRITE1(EQSTRUCT2); GREATER: WRITE1(GRSTRUCT2); NOTLESS: WRITE1(NLSTRUCT2); NOTEQUAL: WRITE1(NESTRUCT2); NOTGREATER: WRITE1(NGSTRUCT2) END; WRITEARG(ARG2 DIV WORDLENGTH); POPWORD; END; "################" "TABLE PROCEDURES" "################" PROCEDURE ALLOCATE(VAR T: TABLEPTR; ENTRIES: INTEGER); VAR PORTION: TABLEPTR; I: INTEGER; BEGIN NEW(T); PORTION:= T; I:= ENTRIES - MAXWORD; WHILE I > 0 DO WITH PORTION@ DO BEG"~LX&  " `(  ""$  """"""& Z<  Z L    (  "   (   " "   (  IN NEW(NEXTPORTION); PORTION:= NEXTPORTION; I:= I - MAXWORD; END; END; PROCEDURE ENTER(T: TABLEPTR; I, J: INTEGER); VAR PORTION: TABLEPTR; K: INTEGER; BEGIN PORTION:= T; K:= I; WHILE K > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; K:= K - MAXWORD; END; PORTION@.CONTENTS(.K.):= J; END; FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER; VAR PORTION: TABLEPTR; J: INTEGER; BEGIN PORTION:= T; J:= I; WHILE J > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; J:= J -"   (  "& XR  Z $  "" "  "&  "  " XR  Z X$   ""0   "" >"   P0>   L" X " \( ; WRITE_IFL(ARG); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + TWOWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE3(OP, ARG1, ARG2: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); END; WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + THREEWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE4(OP, ARG1, ARG2, ARG3: INTEGER); " v" 8 >V ^v: _Z" "q*j0:^p Ff:j64":L(Fx.HVbB`n 4 OhF#l* PASS 6: FILE_LIMIT2n\"oLt X0] N  >` X[ 2\ BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); END; WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FOURWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITE5(OP, ARG1, ARG2, ARG3, ARG4: INTEGER); BEGIN IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4); END; WRITE_IFL(OP); WRITE_IFL >" ` " "&" `7$  XvC d >"$ % X2 V-   >"" 2  H ," 8   @$?b   (ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + FIVEWORDS ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITEARG(ARG: INTEGER); BEGIN IF TEST THEN PRINTARG(ARG); WRITE_IFL(ARG); IF LOCATION < CODE_LIMIT THEN LOCATION:= LOCATION + WORDLENGTH ELSE BEGIN ERROR(THIS_PASS, CODE_ERROR); LOCATION:= 0 END; END; PROCEDURE WRITELOCATION; BEGIN IF TEST THEN PRINTARG(LOCATION); WRITE_IFL(LOCATION); END; P$ G*    & Q  X P H"  , h `( ^zr & * " ( r X"d " " dZ$ " dB"  c"*  tl B B0  lROCEDURE COMMENT(LENGTH: INTEGER); BEGIN LOCATION:= LOCATION - LENGTH END; PROCEDURE ERROR; BEGIN IF NOT AFTERERROR THEN BEGIN AFTERERROR:= TRUE; COMMENT(FOURWORDS); WRITE4(MESSAGE2, PASS, NUMBER, LINE); GENERATE:= FALSE END END; "################" "STACK PROCEDURES" "################" PROCEDURE PUSHWORD; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + WORDLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPWORD; BEGIN TEMP:2 "" `> BB >"*   x B&  ld > (: >" t"  0"  "  TPtH*  0 h B*  PH = TEMP - WORDLENGTH END; PROCEDURE PUSHREAL; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + REALLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPREAL; BEGIN TEMP:= TEMP - REALLENGTH END; PROCEDURE PUSHSET; BEGIN IF TEMP < STACK_LIMIT THEN TEMP:= TEMP + SETLENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POPSET; BEGIN TEMP:= TEMP - SETLENGTH END; PROCEDURE PUSH(LENGTH: INTEGER); BEGIN IF  B" 0P(#  B : 2 **" L ` t , #)( " " .^<  >" "( " " .^<  >" "( " TEMP < STACK_LIMIT - LENGTH THEN TEMP:= TEMP + LENGTH ELSE ERROR(THIS_PASS, STACK_ERROR); IF TEMP > MAXTEMP THEN MAXTEMP:= TEMP; END; PROCEDURE POP(LENGTH: INTEGER); BEGIN TEMP:= TEMP - LENGTH END; "###################" "VARIABLE PROCEDURES" "###################" FUNCTION DISPL(ARG: INTEGER): INTEGER; BEGIN IF ARG < 0 THEN DISPL:= ARG ELSE DISPL:= ARG + FOURWORDS; END; PROCEDURE PUSHVALUE(MODE, ARG: INTEGER); VAR ADDR: INTEGER; BEGIN CASE MODE OF MODE1, MODE3, MODE4, MODE5: MAXWORD; END; ENTRY:= PORTION@.CONTENTS(.J.); END; "###############" "LINE PROCEDURES" "###############" PROCEDURE NEWLINE(ARG: INTEGER); BEGIN LINE:= ARG; AFTERERROR:=FALSE; IF NUMBER AND AFTERBEGIN THEN WRITE2(NEWLINE2,LINE) END; PROCEDURE INITLINE; BEGIN LINE:=0; AFTERBEGIN:=FALSE END; "################" "BLOCK PROCEDURES" "################" PROCEDURE ENTERBLOCK(I, J, K, L: INTEGER); BEGIN BLOCK:= I; PARAMLENGTH:= J; VARLENGTH:= K; STACKLENGTH:=L; POPLENGTH:= PARAMLENGTH + FOURWORDS WRITE2(PUSHLOCAL2, DISPL(ARG)); MODE2: BEGIN ADDR:= DISPL(ARG); IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH; WRITE2(PUSHGLOB2, ADDR) END; MODE6, MODE7, MODE8: WRITE2(PUSHGLOB2, ARG); MODE10: END; PUSHWORD; END; PROCEDURE PUSHADDRESS(MODE, ARG: INTEGER); VAR ADDR: INTEGER; BEGIN CASE MODE OF MODE0: WRITE2(CONSTADDR2, ARG); MODE1, MODE3, MODE4, MODE5: WRITE2(LOCALADDR2, DISPL(ARG)); MODE2: BEGIN ADDR:= DISPL(A; TEMP:= 0; MAXTEMP:= 0; IF BLOCK=INITIALBLOCK THEN ENTER(JUMPTABLE,BLOCK,LOCATION) ELSE ENTER(BLOCKTABLE,BLOCK,LOCATION); "THE INITIAL BLOCK IS ONLY REFERENCED BY THE FIRST JUMP INSTRUCTION IN A PROGRAM, BUT NOT BY ANY CALL OR INIT INSTRUCTION" AFTERBEGIN:=TRUE END; PROCEDURE EXITBLOCK; BEGIN IF STACKLENGTH < STACK_LIMIT - MAXTEMP - VARLENGTH THEN STACKLENGTH:= STACKLENGTH + MAXTEMP + VARLENGTH + FIVEWORDS ELSE ERROR(THIS_PASS, STACK_ERROR); ENTER(STACKTABLE, BLOCK, STACKLENGTH); RG); IF ADDR > 0 THEN ADDR:= ADDR + WORDLENGTH; WRITE2(GLOBADDR2, ADDR) END; MODE6, MODE7, MODE8: WRITE2(GLOBADDR2, ARG); MODE10: END; PUSHWORD; END; PROCEDURE PUSHINDIRECT(VARTYPE: INTEGER); BEGIN CASE VARTYPE OF BYTETYPE: WRITE1(PUSHBYTE2); WORDTYPE: WRITE1(PUSHIND2); REALTYPE: BEGIN WRITE1(PUSHREAL2); POPWORD; PUSHREAL; END; SETTYPE: BEGIN WRITE1(PUSHSET2); POPWORD; PUSHSET; END END; END; "# AFTERBEGIN:=FALSE END; "#########################################" "INITIALIZATION AND TERMINATION PROCEDURES" "#########################################" PROCEDURE BEGINPASS; BEGIN WITH LINK@ DO BEGIN SUMMARY:= SUMMARYOPTION IN OPTIONS; TEST:= TESTOPTION IN OPTIONS; CHECK:= CHECKOPTION IN OPTIONS; NUMBER:= NUMBEROPTION IN OPTIONS; GENERATE:= TRUE; MARK(RESETPOINT); ALLOCATE(JUMPTABLE, LABELS); ALLOCATE(BLOCKTABLE, BLOCKS); ALLOCATE(STACKTABLE, BLOCKS); ALLOCAT####################" "COMPARISON PROCEDURES" "#####################" PROCEDURE COMPAREWORD(ARG: INTEGER); BEGIN CASE ARG OF LESS: WRITE1(LSWORD2); EQUAL: WRITE1(EQWORD2); GREATER: WRITE1(GRWORD2); NOTLESS: WRITE1(NLWORD2); NOTEQUAL: WRITE1(NEWORD2); NOTGREATER: WRITE1(NGWORD2) END; POPWORD; END; PROCEDURE COMPAREREAL(ARG: INTEGER); BEGIN CASE ARG OF LESS: WRITE1(LSREAL2); EQUAL: WRITE1(EQREAL2); GREATER: WRITE1(GRREAL2)E(CONSTTABLE, CONSTANTS DIV WORDLENGTH); END; LOCATION:= 0; CONSTANTS:= 0; INITLINE; IF TEST THEN PRINTFF; END; PROCEDURE ENDPASS; BEGIN WITH LINK@ DO BEGIN IF GENERATE THEN OPTIONS:= OPTIONS OR (.CODEOPTION.); NEW(TABLES); TABLES@.PROGLENGTH:= FOURWORDS + LOCATION + CONSTANTS; TABLES@.CODELENGTH:= LOCATION; TABLES@.STACKLENGTH:= STACKLENGTH; TABLES@.VARLENGTH:= VARLENGTH; TABLES@.JUMPTABLE:=JUMPTABLE; TABLES@.BLOCKTABLE:=BLOCKTABLE; TABLES@.STACKTABLE:=STACK; NOTLESS: WRITE1(NLREAL2); NOTEQUAL: WRITE1(NEREAL2); NOTGREATER: WRITE1(NGREAL2) END; POPREAL; POPREAL; PUSHWORD; END; PROCEDURE COMPARESET(ARG: INTEGER); BEGIN CASE ARG OF EQUAL: WRITE1(EQSET2); NOTLESS: WRITE1(NLSET2); NOTEQUAL: WRITE1(NESET2); NOTGREATER: WRITE1(NGSET2); INSET: WRITE1(INSET2) END; POPSET; IF ARG <> INSET THEN BEGIN POPSET; PUSHWORD END; END; PROCEDURE COMPARESTRUCT(ARG1, ARG2: INTEGER); BEGIN CASE ARG1 OF MODE, LABEL, PARAMLENGTH)": BEGIN READ3ARG; IF ARG1 = MODE3 THEN BEGIN WRITE2(CALLSYS2, (ARG2 - 2) * WORDLENGTH); ARG1:= WORDLENGTH; END ELSE BEGIN WRITE1(CALL2); WRITELOCATION; WRITEARG(ARG2); IF ARG1<>MODE1 THEN ARG3:=ARG3+WORDLENGTH; "INCLUDES COMPONENT ADDRESS IN PARAMLENGTH" IF CONCURRENT THEN ARG1:= ENTRY(STACKTABLE, ARG2) ELSE ARG1:= WORDLENGTH; END; PUSH(ARG1); POP(ARG1 + ARG3); END; ENTER1"(MODE, LABEL, PARAMLENGTH, VARLENGTX >\BP6D*8$   , "xp b d .T dD 4 $ ," z*4  T" T" T" 02" 6"" H, TEMPLENGTH)": BEGIN READ5ARG; ENTERBLOCK(ARG2, ARG3, ARG4, ARG5); CASE ARG1 OF MODE1: WRITE5(ENTER2, BLOCK, POPLENGTH, LINE, VARLENGTH); MODE2: WRITE5(ENTERPROG2, POPLENGTH + WORDLENGTH, LINE, BLOCK, VARLENGTH); MODE3: WRITE5(ENTERPROC2, BLOCK, POPLENGTH, LINE, VARLENGTH); MODE4: WRITE5(ENTERCLAS2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH); MODE5: WRITE5(ENTERMON2, BLOCK, POPLENGTH + WORDLENGTH, LINE, VARLENGTH); " " >" " "  "  " " "N"  j &". X6*  l "v$j&t^(TABLE; TABLES@.CONSTTABLE:=CONSTTABLE; END; END; "#########" "OPERATORS" "#########" PROCEDURE SCAN; BEGIN DONE:=FALSE; REPEAT READ_IFL(OP); CASE OP OF PUSHCONST1"(VALUE)": BEGIN READ1ARG; WRITE2(PUSHCONST2, ARG1); PUSHWORD; END; PUSHVAR1"(TYPE, MODE, DISPL)": BEGIN READ3ARG; IF ARG1 = WORDTYPE THEN PUSHVALUE(ARG2, ARG3) ELSE BEGIN PUSHADDRESS(ARG2, ARG3); PUSHINDIRECT(ARG1); END; END; PUSHIND1"(TYPE)": BEGIN READ1ARG;R*F,:..08"2,4 68:<>@BDFHJLzNnPxbRlVT`JVT>XH2Z<&\0^$`b dfhjlnprtv,~x rzf|Z PUSHINDIRECT(ARG1) END; PUSHADDR1"(MODE, DISPL)": BEGIN READ2ARG; PUSHADDRESS(ARG1, ARG2) END; FIELD1"(DISPL)": BEGIN READ1ARG; IF ARG1<>0 THEN WRITE2(FIELD2,ARG1) END; INDEX1"(MIN, MAX, LENGTH)": BEGIN READ3ARG; WRITE4(INDEX2, ARG1, ARG2 - ARG1, ARG3); POPWORD; END; POINTER1: IF CHECK THEN WRITE1(POINTER2); VARIANT1"(TAGSET, DISPL)": BEGIN READ2ARG; IF CHECK THEN WRITE3(VARIANT2, ARG2, ARG1); END; RANGE1"(MIN, MAX)": BEGIN READ2ARG; IF CHECK THEN WRITE3(RANGE2, ARG1, ~NB6*z pXpv@jX^R@F:(." $NznxblARG2); END; ASSIGN1"(TYPE)": BEGIN READ1ARG; CASE ARG1 OF BYTETYPE: BEGIN WRITE1(COPYBYTE2); POPWORD END; WORDTYPE: BEGIN WRITE1(COPYWORD2); POPWORD END; REALTYPE: BEGIN WRITE1(COPYREAL2); POPREAL END; SETTYPE: BEGIN WRITE1(COPYSET2); POPSET END END; POPWORD; END; ASSIGNTAG1"(LENGTH)": BEGIN READ1ARG; IF ARG1 = 0 THEN WRITE1(COPYWORD2) ELSE WRITE2(COPYTAG2, ARG1 DIV WORDLENGTH); POPWORD; POPWORD; END; COPY1"(LENGTHV`JT>H2<&0$H"q&0:DNXblv  *4>HR\fpz$.8BLV`jt~ (2= MIN_FUNC) AND (ARG1 <= MAX_FUNC) THEN CASE ARG1 OF TRUNC1: BEGIN WRITE1(TRUNCREAL2); POPREAL; PUSHWORD END; ABS1: IF ARG2 = WORDTYPE THEN WRITE1(ABSWORD2) ELSE WRITE1(ABSREAL2); SUCC1: WRITE1(SUCCWORD2); PRED1: WRITE1(PREDWORD2); CONV1: BEGIN WRITE1(CONVWORD2); POPWORD; PUSHREAL END; EMPTY1: WRITE1(EMPTY2); ATTRIBUTE1: . RECORD POINTER TYPE. COMPILER ABORT. OPERAND TYPE. NOT A VARIABLE. NOT ASSIGNABLE. INVALID INITIALIZATION. TOO MUCH STACK. TOO MUCH CODE. PROCEDURE PRINTSUMMARY .CALLED. QUEUE VARIABLE. NESTED PROCESS. INVALID ENTRY VARIABLE. INVALID FUNCTION TYPE. RECORD ENUMERATION. LONG ENUMERATION. INVALID INDEX TYPE. INVALID MEMBER TYPE. PROCESS STACK USAGE. INVALID PARAMETER. COMPILER ABORT. ODD LENGTH STRING TYPE. INVALID RESOLUTION. INVALID TAG TYPE WRITE1(ATTRIBUTE2); REALTIME1: BEGIN WRITE1(REALTIME2); PUSHWORD END END; END; BUILDSET1: BEGIN WRITE1(BUILDSET2); POPWORD END; COMPARE1"(COMPARISON, TYPE)": BEGIN READ2ARG; CASE ARG2 OF WORDTYPE: COMPAREWORD(ARG1); REALTYPE: COMPAREREAL(ARG1); SETTYPE: COMPARESET(ARG1) END; END; COMPSTRUC1"(COMPARISON, LENGTH)": BEGIN READ2ARG; COMPARESTRUCT(ARG1, ARG2) END; FUNCVALUE1"(MODE)": BEGIN READ2ARG; CASE ARG1 OF " .^<  >" ": "* 2*b  $ % >:BJ6Z*jvzj8$ = & * *:JZtjhzv\ MODE1, MODE3: IF ARG2 = WORDTYPE THEN BEGIN WRITE2(FUNCVALUE2, 0); PUSHWORD END ELSE BEGIN WRITE2(FUNCVALUE2, 8); PUSHREAL END; MODE4, MODE5: IF ARG2 = WORDTYPE THEN BEGIN WRITE2(FUNCVALUE2, 16); PUSHWORD END ELSE BEGIN WRITE2(FUNCVALUE2, 24); PUSHREAL END; MODE9, MODE10: END; END; DEFLABEL1"(LABEL)": BEGIN READ1ARG; ENTER(JUMPTABLE, ARG1, LOCATION); IF NUMBER THEN WRITE2(NEWLINE2,LINE) END; JUMP1"(LABEL)"jP^DR8F,: ."  *:JZjzxlz`nT%2j2&0:DNXblv$   2Jbz vv"jj:^^RRRjFF::(2= MIN_PROC) AND (ARG1 <= MAX_PROC) THEN CASE ARG1 OF DELAY1: BEGIN WRITE1(DELAY2); POPWORD END; CONTINUE1: BEGIN WRITE1(CONTINUE2); POPWORD END; IO1: BEGIN WRITE1(IO2); POP(THREEWORDS) END; START1: WRITE1(START2); STOP1: BEGIN WRITE1(STOP2); POP(TWOWORDS) END; SETHEAP1: BEGIN WRITE = 13; RANGE1 = 14; COPYBYTE1 = 15; COPYWORD1 = 16; COPYREAL1 = 17; COPYSET1 = 18; COPYTAG1 = 19; COPYSTRUC1 = 20; NEW1 = 21; NEWINIT1 = 22; NOT1 = 23; ANDWORD1 = 24; ANDSET1 = 25; ORWORD1 = 26; ORSET1 = 27; NEGWORD1 = 28; NEGREAL1 = 29; ADDWORD1 = 30; ADDREAL1 = 31; SUBWORD1 = 32; SUBREAL1 = 33; SUBSET1 = 34; MULWORD1 = 35; MULREAL1 = 36; DIVWORD1 = 37; DIVREAL1 = 38; MODWORD1 = 39; BUILDSET1 = 40; INSET1 1(SETHEAP2); POPWORD END; WAIT1: WRITE1(WAIT2) END; END; INIT1"(MODE, LABEL, PARAMLENGTH, VARLENGTH)": BEGIN READ4ARG; IF ARG1 = MODE6 THEN BEGIN WRITE4(INITPROC2, ARG3, ARG4, ARG2); PUSH(FOURWORDS); POP(ARG3 + FIVEWORDS); END ELSE BEGIN IF ARG1 = MODE7 THEN WRITE2(INITCLASS2, ARG3) ELSE WRITE2(INITMON2, ARG3); ARG1:= ENTRY(STACKTABLE, ARG2); POP(ARG3); PUSH(ARG1); POP(ARG1 + WORDLENGTH); END; WRITELOCATION; WRITEARG(ARG2= 41; LSWORD1 = 42; EQWORD1 = 43; GRWORD1 = 44; NLWORD1 = 45; NEWORD1 = 46; NGWORD1 = 47; LSREAL1 = 48; EQREAL1 = 49; GRREAL1 = 50; NLREAL1 = 51; NEREAL1 = 52; NGREAL1 = 53; EQSET1 = 54; NLSET1 = 55; NESET1 = 56; NGSET1 = 57; LSSTRUCT1 = 58; EQSTRUCT1 = 59; GRSTRUCT1 = 60; NLSTRUCT1 = 61; NESTRUCT1 = 62; NGSTRUCT1 = 63; FUNCVALUE1 = 64; JUMP1 = 65; FALSEJUMP1 = 66; CASEJUMP1 = 67; INITVAR1 = 68; CAL); END; PUSHLABEL1"(LABEL)": BEGIN READ1ARG; WRITE1(PUSHLABEL2); WRITELOCATION; WRITEARG(ARG1); PUSHWORD; END; CALLPROG1: BEGIN WRITE1(CALLPROG2); PUSHWORD END; EOM1"(VARLENGTH)": BEGIN DONE:=TRUE; READ1ARG; VARLENGTH:=ARG1; COMMENT(WORDLENGTH); WRITE1(EOM2) END END UNTIL DONE END; BEGIN INIT_PASS(LINK); BEGINPASS; SCAN; ENDPASS; NEXT_PASS(LINK); END. L1 = 69; CALLSYS1 = 70; ENTER1 = 71; EXIT1 = 72; ENTERPROG1 = 73; EXITPROG1 = 74; BEGINCLAS1 = 75; ENDCLASS1 = 76; ENTERCLAS1 = 77; EXITCLASS1 = 78; BEGINMON1 = 79; ENDMON1 = 80; ENTERMON1 = 81; EXITMON1 = 82; BEGINPROC1 = 83; ENDPROC1 = 84; ENTERPROC1 = 85; EXITPROC1 = 86; POP1 = 87; NEWLINE1 = 88; INCRWORD1 = 89; DECRWORD1 = 90; INITCLASS1 = 91; INITMON1 = 92; INITPROC1 = 93; PUSHLABEL1 = 94; CALLPROG1 = 95; TRUNCREAL1 = 9VERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 7: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PRO6; ABSWORD1 = 97; ABSREAL1 = 98; SUCCWORD1 = 99; PREDWORD1 = 100; CONVWORD1 = 101; EMPTY1 = 102; ATTRIBUTE1 = 103; REALTIME1 = 104; DELAY1 = 105; CONTINUE1 = 106; IO1 = 107; START1 = 108; STOP1 = 109; SETHEAP1 = 110; WAIT1 = 111; MESSAGE1=112; EOM1=113; "OUTPUT OPERATORS" CONSTADDR2 = 2; LOCALADDR2 = 4; GLOBADDR2 = 6; PUSHCONST2 = 8; PUSHLOCAL2 = 10; PUSHGLOB2 = 12; PUSHIND2 = 14; PUSHBYTE2 = 16; PUSHREAL2 = 18; PUSHSET2 = 20CEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.3.) DO BEGIN TAG:= INTTYPE; IF GENERATE THEN INT:= PROGLENGTH ELSE INT:= 0 END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN ; FIELD2 = 22; INDEX2 = 24; POINTER2 = 26; VARIANT2 = 28; RANGE2 = 30; COPYBYTE2 = 32; COPYWORD2 = 34; COPYREAL2 = 36; COPYSET2 = 38; COPYTAG2 = 40; COPYSTRUC2 = 42; NEW2 = 44; NEWINIT2 = 46; NOT2 = 48; ANDWORD2 = 50; ANDSET2 = 52; ORWORD2 = 54; ORSET2 = 56; NEGWORD2 = 58; NEGREAL2 = 60; ADDWORD2 = 62; ADDREAL2 = 64; SUBWORD2 = 66; SUBREAL2 = 68; SUBSET2 = 70; MULWORD2 = 72; MULREAL2 = 74; DIVWORD2 = 7 IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, P6; DIVREAL2 = 78; MODWORD2 = 80; BUILDSET2 = 82; INSET2 = 84; LSWORD2 = 86; EQWORD2 = 88; GRWORD2 = 90; NLWORD2 = 92; NEWORD2 = 94; NGWORD2 = 96; LSREAL2 = 98; EQREAL2 = 100; GRREAL2 = 102; NLREAL2 = 104; NEREAL2 = 106; NGREAL2 = 108; EQSET2 = 110; NLSET2 = 112; NESET2 = 114; NGSET2 = 116; LSSTRUCT2 = 118; EQSTRUCT2 = 120; GRSTRUCT2 = 122; NLSTRUCT2 = 124; NESTRUCT2 = 126; NGSTRUCT2 = 128; FUNCVALUE2 = 130; JUMPAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTE ; PROCEDURE PRINTRUNNING; MOV USER99,$.DB23 ; PRINTPROCESS(USER); JSR PC,$.DB24 ; MOV #HEAD99,$.DB16 ; PRINTHEAD(HEAD); JSR PC,$.DB17 ; MOV #CONS99,$.DB03 ; PRINT(CONST); JSR PC,$.DB04 ; MOV #PARA11,$.DB06 ; PRINTPARAMS; MOV #MAX11,$.DB07 ; JSR PC,$.DB08 ; MOV #NEXT11,$.DB03M); PRINTABS(PASS); S:= ' LINE . '; PRINTSHORT(S); PRINTABS(LINE); WRITE(' '); END; PROCEDURE PASS1ERROR(NO, LINE: INTEGER); CONST COMMENT_ERROR=1; NUMBER_ERROR=2; INSERT_ERROR=3; STRING_ERROR=4; CHAR_ERROR=5; BEGIN PRINTHEAD(1, LINE); CASE NO OF COMMENT_ERROR: PRINTMED('ENDLESS COMMENT.'); NUMBER_ERROR: PRINTMED('INVALID NUMBER. '); INSERT_ERROR: PRINTMED('TABLE OVERFLOW. '); STRING_ERROR: PRINTMED('INVALID STRING. '); CHAR_ERROR: PRINTMED('BAD CHARACTER. ') ; PRINT(NEXTINDEX); JSR PC,$.DB04 ; MOV #PRID11,$.DB06 ; PRINTPROCESSIDS; MOV #PROCS,$.DB07 ; JSR PC,$.DB08 ; MOV #1$,R0 ; PRINTREG(REG); MOV R0,$.DB18 ; MOV SP,R1 ; MOV R0,SP ; BIS #PSREG1,PSW ; MOV W,(SP)+ ; MOV X,(SP)+ END; PRINTEOL; END; PROCEDURE PASS2ERROR(NO, LINE: INTEGER); CONST PROG_ERROR=1; DEC_ERROR=2; CONSTDEF_ERROR=3; TYPEDEF_ERROR=4; TYPE_ERROR=5; ENUM_ERROR=6; SUBR_ERROR=7; SET_ERROR=8; ARRAY_ERROR=9; RECORD_ERROR=10; STACK_ERROR=11; VAR_ERROR=12; ROUTINE_ERROR=13; PROC_ERROR=14; FUNC_ERROR=15; WITH_ERROR=16; PARM_ERROR=17; BODY_ERROR=18; STATS_ERROR=19; STAT_ERROR=20; IDSTAT_ERROR=21; ARG_ERROR=22; COMP_ERROR=23; IF_ERROR=24 ; MOV Y,(SP)+ ; MOV Q,(SP)+ ; MOV B,(SP)+ ; MOV G,(SP)+ ; BIC #PSREG1,PSW ; MOV SP,R0 ; MOV R1,SP ; BIS #PSPMDU,PSW ; MFPI SP ; MOV (SP)+,(R0)+ ; MOV KSOPC,(R0)+ ; MOV KSOPSW,(R0)+ ; STD GER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('7'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "#######################" "INPUT/OUTPUT PROCEDURES" "#######################" PROCEDURE WRITEOP(OP: INTEGER); BEGIN IF GENERATCOMM10,$.DB03 ; PRINT(COMMON); JSR PC,$.DB04 ; MOV #HEAP10,$.DB03 ; PRINT(HEAPTOP); JSR PC,$.DB04 ; RTS PC ; END; ;* ;* $.DB23: .WORD 0 ; PROCEDURE PRINTPROCESS(P); $.DB24: MOV #$.DB23,$.DB03 ; PRINT(@P); JSR PC,$.DB04 ; MOV $.DB23,R0 ; PRINTHEAD(P.HEAD); ADD #HEAD0,R0 ; MOVE THEN WRITE_IFL(OP) ELSE IF TEST THEN PRINTOP(OP); END; PROCEDURE WRITEARG(ARG: INTEGER); BEGIN IF GENERATE THEN WRITE_IFL(ARG) ELSE IF TEST THEN PRINTARG(ARG); END; PROCEDURE COPYARG; VAR ARG: INTEGER; BEGIN READ_IFL(ARG); IF GENERATE THEN WRITE_IFL(ARG) ELSE IF TEST THEN PRINTARG(ARG); END; PROCEDURE COPY1(OP: INTEGER); VAR ARG: INTEGER; BEGIN READ_IFL(ARG); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG) END ELSE IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END; END; PROC; CASE_ERROR=25; LABEL_ERROR=26; WHILE_ERROR=27; REPEAT_ERROR=28; FOR_ERROR=29; CYCLE_ERROR=30; EXPR_ERROR=31; VARIABLE_ERROR=32; CONSTANT_ERROR=33; INIT_ERROR=34; MPROG_ERROR=35; POINTER_ERROR=36; PREFIX_ERROR=37; INTERFACE_ERROR=38; BEGIN PRINTHEAD(2, LINE); CASE NO OF PROG_ERROR: PRINTMED('SEQL PROGRAM. '); DEC_ERROR: PRINTMED('DECLARATION. '); CONSTDEF_ERROR: PRINTMED('CONSTANT DFN. '); TYPEDEF_ERROR: PRINTMED('TYPE DFEDURE COPY2(OP: INTEGER); VAR ARG1, ARG2: INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); END ELSE IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); END; END; PROCEDURE COPY3(OP: INTEGER); VAR ARG1, ARG2, ARG3: INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); IF GENERATE THEN BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); END ELSE IF TEST THEN BEGINN. '); TYPE_ERROR: PRINTMED('TYPE. '); ENUM_ERROR: PRINTMED('ENUMERATION TYP.'); SUBR_ERROR: PRINTMED('SUBRANGE TYPE. '); SET_ERROR: PRINTMED('SET TYPE. '); ARRAY_ERROR: PRINTMED('ARRAY TYPE. '); RECORD_ERROR: PRINTMED('RECORD TYPE. '); STACK_ERROR: PRINTMED('STACK LENGTH. '); VAR_ERROR: PRINTMED('VAR DECLARATION.'); ROUTINE_ERROR: PRINTMED('ROUTINE. '); PROC_ERROR: PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); END; END; "################" "TABLE PROCEDURES" "################" FUNCTION ENTRY(T: TABLEPTR; I: INTEGER): INTEGER; VAR PORTION: TABLEPTR; J: INTEGER; BEGIN IF I=0 THEN ENTRY:=0 "REFERENCE TO UNDEFINED ROUTINE" ELSE BEGIN PORTION:= T; J:= I; WHILE J > MAXWORD DO BEGIN PORTION:= PORTION@.NEXTPORTION; J:= J - MAXWORD; END; ENTRY:= PORTION@.CONTENTS(.J.); END END; "########################" "JUMP AND CALL PROCEDURES PRINTMED('PROCEDURE. '); FUNC_ERROR: PRINTMED('FUNCTION. '); WITH_ERROR: PRINTMED('WITH STMT. '); PARM_ERROR: PRINTMED('PARAMETER. '); BODY_ERROR: PRINTMED('BODY. '); STATS_ERROR: PRINTMED('STMT LIST. '); STAT_ERROR: PRINTMED('STATEMENT. '); IDSTAT_ERROR: PRINTMED('ID STMT. '); ARG_ERROR: PRINTMED('ARGUMENT. '); COMP_ERROR: PRINTMED('COMPOUND STMT. '); " "########################" PROCEDURE WRITEJUMP(OP: INTEGER); VAR LOCATION, JUMPLABEL: INTEGER; BEGIN WRITEOP(OP); READ_IFL(LOCATION); READ_IFL(JUMPLABEL); WRITEARG(ENTRY(JUMPTABLE, JUMPLABEL) - LOCATION); END; PROCEDURE WRITECASE(OP: INTEGER); VAR DIFF, LOCATION, CASELABEL, I: INTEGER; BEGIN WRITEOP(OP); COPYARG; READ_IFL(DIFF); WRITEARG(DIFF); READ_IFL(LOCATION); FOR I:= 0 TO DIFF DO BEGIN READ_IFL(CASELABEL); WRITEARG(ENTRY(JUMPTABLE, CASELABEL) - LOCATION); LOCATION:= LOIF_ERROR: PRINTMED('IF STMT. '); CASE_ERROR: PRINTMED('CASE STMT. '); LABEL_ERROR: PRINTMED('LABEL LIST. '); WHILE_ERROR: PRINTMED('WHILE STMT. '); REPEAT_ERROR: PRINTMED('REPEAT STMT. '); FOR_ERROR: PRINTMED('FOR STMT. '); CYCLE_ERROR: PRINTMED('CYCLE STMT. '); EXPR_ERROR: PRINTMED('EXPRESSION. '); VARIABLE_ERROR: PRINTMED('VARIABLE. '); CONSTANT_ERROR: PRINTMED('CONSTACATION + WORDLENGTH; END; END; PROCEDURE WRITECALL(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WRITEOP(OP); READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; "###############################" "NEW, ENTER, AND EXIT PROCEDURES" "##############################" PROCEDURE WRITENEW(OP: INTEGER); VAR BLOCK, LENGTH: INTEGER; BEGIN WRITEOP(OP); READ_IFL(BLOCK); READ_IFL(LENGTH); WRITEARG(STACKLENGTH + LENGTH); WRITEARG(LENGTH); END; PROCEDURE COPYBLOCNT. '); INIT_ERROR: PRINTMED('INIT STMT. '); MPROG_ERROR: PRINTMED('TERMINATION. '); PREFIX_ERROR: PRINTMED('PREFIX. '); INTERFACE_ERROR: PRINTMED('INTERFACE. '); POINTER_ERROR: PRINTMED('POINTER TYPE. ') END; PRINTSHORT(' SYNTAX.'); PRINTEOL; END; PROCEDURE PASS3ERROR(NO, LINE: INTEGER); CONST UNRES_ERROR=1; AMBIGUITY_ERROR=2; ABORT_ERROR=3; CONSTID_ERROR=4; SUBR_ERROR=5; FEW_ARGS_ERROR=6; ARG_LIST_ERROR=7; MK; BEGIN READ_IFL(BLOCK); STACKLENGTH:= ENTRY(STACKTABLE, BLOCK) + STACKMARGIN; WRITEARG(STACKLENGTH); END; PROCEDURE WRITEENTER(OP: INTEGER); BEGIN WRITEOP(OP); COPYBLOCK; COPYARG; COPYARG; COPYARG; END; PROCEDURE WRITEEXIT(OP: INTEGER); BEGIN WRITEOP(OP); END; PROCEDURE WRITEPROG(OP: INTEGER); BEGIN WRITEOP(OP); COPYARG; COPYARG; COPYBLOCK; COPYARG; END; "###############" "INIT PROCEDURES" "###############" PROCEDURE WRITEINIT(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WRANY_ARGS_ERROR=8; CASERANGE_ERROR=9; CASETYPE_ERROR=10; AMBICASE_ERROR=11; WITH_ERROR=12; INIT_ERROR=13; PROC_USE_ERROR=14; NAME_ERROR=15; COMP_ERROR=16; SUB_ERROR=17; INTERFACE_ERROR=18; CALL_NAME_ERROR=19; ARROW_ERROR=20; RESOLVE_ERROR=21; BEGIN PRINTHEAD(3, LINE); CASE NO OF UNRES_ERROR: PRINTLONG ('UNRESOLVED ROUTINE. '); AMBIGUITY_ERROR: PRINTLONG ('AMBIGUOUS IDENTIFIER. '); ABORT_ERROR: PRINTLONG ('COMPILER ABORT. '); CONSTID_ERROR: ITEOP(OP); COPYARG; READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; PROCEDURE WRITEPROC(OP: INTEGER); VAR LOCATION, BLOCK: INTEGER; BEGIN WRITEOP(OP); COPYARG; COPYARG; COPYBLOCK; READ_IFL(LOCATION); READ_IFL(BLOCK); WRITEARG(ENTRY(BLOCKTABLE, BLOCK) - LOCATION); END; "########################" "HEAD AND TAIL PROCEDURES" "########################" PROCEDURE WRITEHEAD; BEGIN IF TEST THEN BEGIN PRINTFF; WRITE('('); WRITE('#'); WRITE(EOL); END; PRINTLONG ('INVALID CONSTANT. '); SUBR_ERROR: PRINTLONG ('INVALID SUBRANGE. '); FEW_ARGS_ERROR: PRINTLONG ('MISSING ARGUMENT. '); ARG_LIST_ERROR: PRINTLONG ('NOT A ROUTINE. '); MANY_ARGS_ERROR: PRINTLONG ('TOO MANY ARGUMENTS. '); CASERANGE_ERROR: PRINTLONG ('LABEL VALUE TOO LARGE. '); CASETYPE_ERROR: PRINTLONG ('INVALID LABEL. '); AMBICASE_ERROR: PRINTLONG ('AMBIGUOUS LABEL. '); WITH_ERROR: PRINTLON WRITEARG(PROGLENGTH); WRITEARG(CODELENGTH); WRITEARG(STACKLENGTH); WRITEARG(VARLENGTH); END; PROCEDURE WRITETAIL; VAR I: INTEGER; BEGIN FOR I:= 1 TO CONSTANTS DIV WORDLENGTH DO WRITEARG(ENTRY(CONSTTABLE, I)); IF TEST THEN BEGIN WRITE(EOL); WRITE('#'); WRITE(')'); END; END; "###################" "PRINTING PROCEDURES" "###################" PROCEDURE PRINTSHORT(T: SHORTTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= T R0,$.DB16 ; JSR PC,$.DB17 ; MOV $.DB23,R0 ; PRINTREG(P.REG); ADD #REG0,R0 ; MOV R0,$.DB18 ; JSR PC,$.DB19 ; MOV $.DB23,R0 ; PRINTMAP(P.MAP); ADD #MAP0,R0 ; MOV R0,$.DB20 ; JSR PC,$.DB21 ; RTS PC ; END; ;* ;* $.DB25: (.I.) END; END; PROCEDURE PRINTMED(T: MEDTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END; END; PROCEDURE PRINTLONG(T: LONGTEXT); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= T(.I.); WHILE C <> '.' DO BEGIN WRITE(C); I:= I + 1; C:= T(.I.) END; END; "################" "ERROR PROCEDURES" "################" PROCEDURE PRINTHEAD(PASS, LINE: INTEGER); VAR M: MEDTEXT; S: SHORTTEXT; BEGIN PRINTEOL; M:= '****** PASS . '; PRINTMED()": WRITENEW(NEW2); NEWINIT1"(BLOCK, LENGTH)": WRITENEW(NEWINIT2); NOT1: WRITEOP(NOT2); ANDWORD1: WRITEOP(ANDWORD2); ANDSET1: WRITEOP(ANDSET2); ORWORD1: WRITEOP(ORWORD2); ORSET1: WRITEOP(ORSET2); NEGWORD1: WRITEOP(NEGWORD2); NEGREAL1: WRITEOP(NEGREAL2); ADDWORD1: WRITEOP(ADDWORD2); ADDREAL1: WRITEOP(ADDREAL2); SUBWORD1: WRITEOP(SUBWORD2); SUBREAL1: WRITEOP(SUBREAL2); SUBSET1: WRITEOP(SUBSET2); MULWORD1: WRITEOP(MULWORD2); MULREAL1: WRITEOP(MULREAL2); DIVWORD1:$,$.DB03 ; JSR PC,$.DB04 ; 1$: MFPD @$$ ; PRINTSTACK; MOV SP,$.DB03 ; JSR PC,$.DB04 ; TST (SP)+ ; CMP $$,$$+.INTEGER ; BEQ 2$ ; ADD #2.,$$ ; BR 1$ ; 2$: RTI ; END; .ENDC ;* ;* .SBTTL FIRST LEVEL TRAP/INTERRG ('INVALID WITH VARIABLE. '); INIT_ERROR: PRINTLONG ('INVALID INITIALIZATION. '); PROC_USE_ERROR: PRINTLONG ('NOT A FUNCTION. '); NAME_ERROR: PRINTLONG ('INVALID NAME USAGE. '); COMP_ERROR: PRINTLONG ('INVALID SELECTION. '); SUB_ERROR: PRINTLONG ('INVALID SUBSCRIPTING. '); INTERFACE_ERROR: PRINTLONG ('INVALID INTERFACE. '); CALL_NAME_ERROR: PRINTLONG ('INVALID CALL. '); ARROW_ERROR: PRINTLONG ('INVAUPT INTERCEPTORS ;**** TRAPS AND INTERRUPTS WITH COMMON PREPROCESSING COME HERE ***** ;* ;* ;* ;* FATAL ERROR TRAP: ;* FEINT: INTSRV ;<01> STACK THE REGS SO CAN TELL WHERE IT ;<01> CAME FROM!! MOV #FETRAP,R0 ; R0 := TRAP VECTOR ADDRESS; SYSERR ;<01> ;* ;* T-BIT TRAP: ;* TBTINT: INTSRV ;<01> PRESERVE REGISTER CONTENTS CMP 14(SP),#XXXIN0 ;<01> TRAP FROM XXXINT ? BEQ XXXIN1 ; BRANCH IF SO; LID POINTING. '); RESOLVE_ERROR: PRINTLONG ('INVALID RESOLUTION. ') END; PRINTEOL; END; PROCEDURE PASS4ERROR(NO, LINE: INTEGER); CONST NESTING_ERROR=1; ADDRESS_ERROR=2; ACTIVE_ERROR=3; QUEUE_ERROR=4; PROCESS_ERROR=5; ENTRY_ERROR=6; FUNCTYPE_ERROR=7; TYPEID_ERROR=8; ENUM1_ERROR=9; ENUM2_ERROR=10; INDEX_ERROR=11; MEMBER_ERROR=12; STACK_ERROR=13; PARM1_ERROR=14; PARM2_ERROR=15; PARM3_ERROR=16; PARM4_ERROR=17; PARM5_ERROR=18; PARM6_ERROR=19; MOV #TBTRAP,R0 ; R0 := TRAP VECTOR ADDRESS; SYSERR ;<01> ;* ;* UNEXPECTED CALL: ;* XXXINT: INTSRV ;<01> PRESERVE THE REGISTERS MOV PSW,XXXIN2 ; R0 := TRAP OR INTERRUPT VECTOR XXXIN0: SPL 7 ; ADDRESS; THIS CAUSES IT XXXIN1: MOV XXXIN2,R0 ; TO BE DISPLAYED AT THE BIC #^C,R0 ; COMPUTER CONSOLE. SYSERR ;<01> XXXIN2: .WORD PARM7_ERROR=20; COMPILER_ERROR=21; STRING_ERROR=22; RESOLVE_ERROR=23; TAG_ERROR=24; POINTER_ERROR=25; BEGIN PRINTHEAD(4, LINE); CASE NO OF NESTING_ERROR: PRINTLONG ('INVALID NESTING. '); ADDRESS_ERROR: PRINTLONG ('ADDRESS OVERFLOW. '); ACTIVE_ERROR: PRINTLONG ('ACTIVE VARIABLE. '); QUEUE_ERROR: PRINTLONG ('QUEUE VARIABLE. '); PROCESS_ERROR: PRINTLONG ('NESTED PROCESS. '); ENTRY_ERROR: PRINTLONG ('INVALID E 0 ; .SBTTL SYSTEM ERROR HANDLER ; ; THIS ENTIRE SECTION ADDED BY EDIT <01> ; ; ; THE FOLLOWING SECTION OF CODE IS USED TO DUMP OUT THE REGISTERS, PC, ; AND PSW OF THE PROCESS CAUSING A SYSTEM CRASH. OBVIOUSLY, MORE STUFF ; COULD BE ADDED LATER (AND PROBABLY WILL). THIS IS MUCH BETTER THAN ; A SIMPLE HALT!!!!!!!!! ; ; ; ; LOCAL MACROS: ; .MACRO PRINT X ;PRINT ASCII STRING ON TERMINAL .IF NB,X MOV X,R0 ;R0 -> ASCII .ENDC JSR PC,PRINT ;CALL PRINT ROUTINE .ENDM PRINT .MACNTRY VARIABLE. '); FUNCTYPE_ERROR: PRINTLONG ('INVALID FUNCTION TYPE. '); TYPEID_ERROR: ; ENUM1_ERROR: PRINTLONG ('RECORD ENUMERATION. '); ENUM2_ERROR: PRINTLONG ('LONG ENUMERATION. '); INDEX_ERROR: PRINTLONG ('INVALID INDEX TYPE. '); MEMBER_ERROR: PRINTLONG ('INVALID MEMBER TYPE. '); STACK_ERROR: PRINTLONG ('PROCESS STACK USAGE. '); PARM1_ERROR,PARM2_ERROR,PARM3_ERROR,PARM4_ERROR, PARM5_ERROR,PARM6_ERROR, PARM7_ERR W,(R0)+ ; STD X,(R0)+ ; STFPS (R0) ; JSR PC,$.DB19 ; RTS PC ; END; 1$: .BLKB .REGTYPE ; ;* ;* $.DB26: ; PROCEDURE PRINTREADY; MOV #TOP12,$.DB10 ; PRINTQUEUE(TOP); JSR PC,$.DB11 ; MOV #MIDD12,$.DB10 ; PRINTQUEUE(MIDDLE); JSR PC,$.DB11 ; OR: PRINTLONG ('INVALID PARAMETER. '); COMPILER_ERROR: PRINTLONG ('COMPILER ABORT. '); STRING_ERROR: PRINTLONG ('ODD LENGTH STRING TYPE. '); RESOLVE_ERROR: PRINTLONG ('INVALID RESOLUTION. '); TAG_ERROR: PRINTLONG ('INVALID TAG TYPE. '); POINTER_ERROR: PRINTLONG ('RECORD POINTER TYPE. ') END; PRINTEOL; END; PROCEDURE PASS5ERROR(NO, LINE: INTEGER); CONST COMPILER_ERROR=1; TYPE_ERROR=2; ADDRESS_ERROR=3; ASSIGN_ERROR=4; I MOV #BOTT12,$.DB10 ; PRINTQUEUE(BOTTOM); JSR PC,$.DB11 ; MOV #IDLI12,$.DB03 ; PRINT(IDLING); JSR PC,$.DB04 ; RTS PC ; END; ;* ;* PRINT THE KERNEL STATE: ;* $.DBSP: ; PROCEDURE KNSTAT; JSR PC,$.DB27 ; GRABPRINTER; JSR PC,$.DB09 ; PRINTNEWCORE; MOV #PERIO6,$.DB03 ; PRINT(TIMENIT_ERROR = 5; BEGIN PRINTHEAD(5, LINE); CASE NO OF COMPILER_ERROR: PRINTMED('COMPILER ABORT. '); TYPE_ERROR: PRINTMED('OPERAND TYPE. '); ADDRESS_ERROR: PRINTMED('NOT A VARIABLE. '); ASSIGN_ERROR: PRINTMED('NOT ASSIGNABLE. '); INIT_ERROR: PRINTLONG ('INVALID INITIALIZATION. ') END; PRINTEOL; END; PROCEDURE PASS6ERROR(NO, LINE: INTEGER); CONST STACK_ERROR = 1; CODE_ERROR = 2; BEGIN PRINTHEAD(6, LINE); CASE NO OF STACK_ERROR: PRINTMED('TOO MUCHR.PERIOD); JSR PC,$.DB04 ; JSR PC,$.DB14 ; PRINTCLOCK; JSR PC,$.DB15 ; PRINTCORE; JSR PC,$.DB22 ; PRINTVIRTUAL; JSR PC,$.DB25 ; PRINTRUNNING; JSR PC,$.DB26 ; PRINTREADY; JSR PC,$.DB28 ; RELEASEPRINTER; RTS PC ; END; .ENDC ;* ;* ;**** CORE DUMP PROCEDURE ***** ;* ;* .IF NE $ STACK. '); CODE_ERROR: PRINTMED('TOO MUCH CODE. ') END; PRINTEOL; END; PROCEDURE PRINTMESSAGE; VAR PASS, ERROR, LINE: INTEGER; BEGIN OK:= TEST; READ_IFL(PASS); READ_IFL(ERROR); READ_IFL(LINE); CASE PASS OF 1: PASS1ERROR(ERROR, LINE); 2: PASS2ERROR(ERROR, LINE); 3: PASS3ERROR(ERROR, LINE); 4: PASS4ERROR(ERROR, LINE); 5: PASS5ERROR(ERROR, LINE); 6: PASS6ERROR(ERROR, LINE) END; END; "##################" "SUMMARY PROCEDURES" "##################" PROCEDURE PRI.DBCD $.DBDC: MOV PC,R0 SYSERR .ENDC ;* ;* ;**** CORE VERIFICATION PROCEDURE ***** ;* ;* .IF NE $.DBVC .IF EQ $.DBCD $.DBCV: ; PROCEDURE VERIFYCORE; MOV KISAR+12.,R0 ; MOV #.PRBLK,R1 ; SUB #.SGSBK,R1 ; MOV R1,KISAR+12. ; MOV #2$,FETRAP ; 1$: TST 140000 ; BR 3$ ;NTSUMMARY; BEGIN WRITE(EOL); PRINTLONG('PROCEDURE PRINTSUMMARY .'); PRINTSHORT('CALLED. ') END; "#########################################" "INITIALIZATION AND TERMINATION PROCEDURES" "#########################################" PROCEDURE BEGINPASS; BEGIN INIT_PASS(LINK); WITH LINK@ DO BEGIN SUMMARY:= SUMMARYOPTION IN OPTIONS; TEST:= TESTOPTION IN OPTIONS; GENERATE:= CODEOPTION IN OPTIONS; IF PDP11 THEN GENERATE:= GENERATE & NOT TEST ELSE BEGIN TEST:= TE 2$: SUB #.SGSBK,KISAR+12. ; ADD #4,SP ; BR 1$ ; 3$: MOV #FEINT,FETRAP ; MOV KISAR+12.,6$ ; ADD #.SGSBK,6$ ; 4$: MOV #<.SEGSB-2>,R1 ; 10$: TST 140000(R1) ; BNE 5$ ; SUB #2,R1 ; BGE 10$ ; SUB #.SGSBK,KISAR+12. ; BR 4$ ST OR GENERATE; GENERATE:= FALSE; END; PROGLENGTH:= TABLES@.PROGLENGTH; CODELENGTH:= TABLES@.CODELENGTH; STACKLENGTH:= TABLES@.STACKLENGTH + STACKMARGIN; VARLENGTH:= TABLES@.VARLENGTH; JUMPTABLE:= TABLES@.JUMPTABLE; BLOCKTABLE:= TABLES@.BLOCKTABLE; STACKTABLE:= TABLES@.STACKTABLE; CONSTTABLE:= TABLES@.CONSTTABLE; END; CONSTANTS:= LINK@.CONSTANTS; WRITEHEAD; END; PROCEDURE ENDPASS; BEGIN WRITETAIL; IF SUMMARY THEN PRINTSUMMARY; RELEASE(LINK ; 5$: MOV KISAR+12.,7$ ; MOV R1,8$ ; MOV 140000(R1),9$ ; MOV R0,KISAR+12. ; JSR PC,$.DB27 ; GRABPRINTER; MOV #6$,$.DB06 ; PRINTRESULTS; MOV #4,$.DB07 ; JSR PC,$.DB08 ; JSR PC,$.DB28 ; RELEASEPRINTER; RTS PC ; END; 6$: .WORD 0 @.RESETPOINT); END; "#################" "OPERATOR SCANNING" "#################" PROCEDURE SCAN; VAR OP: INTEGER; BEGIN DONE:= FALSE; REPEAT READ_IFL(OP); CASE OP OF CONSTADDR1"(DISPL)": COPY1(CONSTADDR2); LOCALADDR1"(DISPL)": COPY1(LOCALADDR2); GLOBADDR1"(DISPL)": COPY1(GLOBADDR2); PUSHCONST1"(VALUE)": COPY1(PUSHCONST2); PUSHLOCAL1"(DISPL)": COPY1(PUSHLOCAL2); PUSHGLOB1"(DISPL)": COPY1(PUSHGLOB2); PUSHIND1: WRITEOP(PUSHIND2); PUSHBYTE1: WRITEOP(PUSHBYTE2); PUSHREAL1: WRITEOP(PU ; 7$: .WORD 0 ; 8$: .WORD 0 ; 9$: .WORD 0 ; .ENDC .ENDC ;**** PROCEDURE TO PRINT INTERPRETER TRACE ***** ;* ;* .IF NE $.DBIT $$ = . . = TRTRAP TVDEF $.DBTI,KNLPSW . = $$ ;* ;* $.DBTI: ; PROCEDURE PRINTTRACE(OPCODE, Q, ; S, SMAX); MOV #10.,$.DB29 SHREAL2); PUSHSET1: WRITEOP(PUSHSET2); FIELD1"(DISPL)": COPY1(FIELD2); INDEX1"(MIN, MAX-MIN, LENGTH)": COPY3(INDEX2); POINTER1: WRITEOP(POINTER2); VARIANT1"(DISPL, TAGSET)": COPY2(VARIANT2); RANGE1"(MIN, MAX)": COPY2(RANGE2); COPYBYTE1: WRITEOP(COPYBYTE2); COPYWORD1: WRITEOP(COPYWORD2); COPYREAL1: WRITEOP(COPYREAL2); COPYSET1: WRITEOP(COPYSET2); COPYTAG1"(LENGTH DIV WORDLENGTH)": COPY1(COPYTAG2); COPYSTRUC1"(LENGTH DIV WORDLENGTH)": COPY1(COPYSTRUC2); NEW1"(BLOCK, LENGTH ; PRINTNEWLINE; JSR PC,$.DB30 ; MOV #,$.DB03 ; PRINT(INDEX); JSR PC,$.DB04 ; $$ = HEAD99+PARAM1 ; PRINT(OPCODE); MOV #$$,$.DB03 ; JSR PC,$.DB04 ; $$ = $$ + .INTEGER ; PRINT(Q); MOV #$$,$.DB03 ; JSR PC,$.DB04 ; $$ = $$ + .INTEGER ; PRINT(S); MOV #$                       ' ) + - / 1 3 5 7 ! # % ( * , . 0 2 4 6 " x z | ~ n p r t v        #%'T0 8& > \ B" " >"  X<f$  02$ V" " " &Z,"" ` J$d$h N$HNlJ$h$ B;b&N$(/$&  " `"  ""$  """"""& Z0 Ђ Z X Ў   (  "   (  "   (  "   (  X"& XF Z" `" 0 l ~ x" pZ   "" X " p>"F ~  x2"  " >" pZ X2" ". lj j>" j\"  j"  ~ *  " pZ,: ӂ Z R ӎ "" "  "&  "  " XF Ђ Z  Ў  """  *$  " :"  "  "0 %  "" >"   P0>   L" X " WRITEOP(DIVWORD2); DIVREAL1: WRITEOP(DIVREAL2); MODWORD1: WRITEOP(MODWORD2); BUILDSET1: WRITEOP(BUILDSET2); INSET1: WRITEOP(INSET2); LSWORD1: WRITEOP(LSWORD2); EQWORD1: WRITEOP(EQWORD2); GRWORD1: WRITEOP(GRWORD2); NLWORD1: WRITEOP(NLWORD2); NEWORD1: WRITEOP(NEWORD2); NGWORD1: WRITEOP(NGWORD2); LSREAL1: WRITEOP(LSREAL2); EQREAL1: WRITEOP(EQREAL2); GRREAL1: WRITEOP(GRREAL2); NLREAL1: WRITEOP(NLREAL2); NEREAL1: WRITEOP(NEREAL2); NGREAL1: WRITEOP(NGREAL2); EQS \"  >" ` "1 ""4 "$ 7 XC  >"$ > X V-   X >"$ F 2V( >" 1 "&O"" `" 1$ "" Y z @ET1: WRITEOP(EQSET2); NLSET1: WRITEOP(NLSET2); NESET1: WRITEOP(NESET2); NGSET1: WRITEOP(NGSET2); LSSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(LSSTRUCT2); EQSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(EQSTRUCT2); GRSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(GRSTRUCT2); NLSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NLSTRUCT2); NESTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NESTRUCT2); NGSTRUCT1"(LENGTH DIV WORDLENGTH)": COPY1(NGSTRUCT2); FUNCVALUE1"(KIND)": COPY1(FUNCVALUE2); JUMP1"(LOCATION, LA" _ V  " f " " l  "t    x p& } t; h" L `" '& < :, l"" `X   ^2l l  P>HP" l^BEL)": WRITEJUMP(JUMP2); FALSEJUMP1"(LOCATION, LABEL)": WRITEJUMP(FALSEJUMP2); CASEJUMP1"(MIN, MAX-MIN, LOCATION, LABELS)": WRITECASE(CASEJUMP2); INITVAR1"(LENGTH DIV WORDLENGTH)": COPY1(INITVAR2); CALL1"(LOCATION, BLOCK)": WRITECALL(CALL2); CALLSYS1"(ENTRY * WORDLENGTH)": COPY1(CALLSYS2); ENTER1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTER2); EXIT1: WRITEEXIT(EXIT2); ENTERPROG1"(POPLENGTH, LINE, BLOCK, VARLENGTH)": WRITEPROG(ENTERPROG2); EXITPROG1: WRITEEXIT(EXITPROG2l l>P" l "  *  "*l"" `<l l   P>HP"" `X   ^2l l  P>HP" l^l l>P" l "  *  ,6   *  "$"1:\); BEGINCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(BEGINCLAS2); ENDCLASS1: WRITEEXIT(ENDCLASS2); ENTERCLAS1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERCLAS2); EXITCLASS1: WRITEEXIT(EXITCLASS2); BEGINMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(BEGINMON2); ENDMON1: WRITEEXIT(ENDMON2); ENTERMON1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERMON2); EXITMON1: WRITEEXIT(EXITMON2); BEGINPROC1"(LINE)": COPY1(BEGINPROC2); ENDPROC1: WRITEEXIT(ENDP,:N65:@@:2J6:$T7:^:h#:r-:|:::8:':&:::|:n:`9:R::D:6:(:: :&$:0%::(:D2:N3:X):blvznbROC2); ENTERPROC1"(BLOCK, POPLENGTH, LINE, VARLENGTH)": WRITEENTER(ENTERPROC2); EXITPROC1: WRITEEXIT(EXITPROC2); POP1"(LENGTH)": COPY1(POP2); NEWLINE1"(NUMBER)": COPY1(NEWLINE2); INCRWORD1: WRITEOP(INCRWORD2); DECRWORD1: WRITEOP(DECRWORD2); INITCLASS1"(PARAMLENGTH, LOCATION, BLOCK)": WRITEINIT(INITCLASS2); INITMON1"(PARAMLENGTH, LOCATION, BLOCK)": WRITEINIT(INITMON2); INITPROC1"(PARAMLENGTH, VARLENGTH, BLOCK, LOCATION, BLOCK)": WRITEPROC(INITPROC2); PUSHLABEL1"(LOCATION, BLOCK)":VJ> 2 &   &  r r>"= r t9Vt t>"t0" v9Vv v>"dv0" x9Vx x>"8x0" z9Vz z>" z0" z x v t   X   ^$    "X   WRITECALL(PUSHLABEL2); CALLPROG1: WRITEOP(CALLPROG2); TRUNCREAL1: WRITEOP(TRUNCREAL2); ABSWORD1: WRITEOP(ABSWORD2); ABSREAL1: WRITEOP(ABSREAL2); SUCCWORD1: WRITEOP(SUCCWORD2); PREDWORD1: WRITEOP(PREDWORD2); CONVWORD1: WRITEOP(CONVWORD2); EMPTY1: WRITEOP(EMPTY2); ATTRIBUTE1: WRITEOP(ATTRIBUTE2); REALTIME1: WRITEOP(REALTIME2); DELAY1: WRITEOP(DELAY2); CONTINUE1: WRITEOP(CONTINUE2); IO1: WRITEOP(IO2); START1: WRITEOP(START2); STOP1: WRITEOP(STOP2); SETHEAP1: W X "X6  X N X "X6 "X    X   X  ^ "^2T ,n RRR&  " (XV,R)RR&j LX RF& SX R8& TX R8&V CX RF&RITEOP(SETHEAP2); WAIT1: WRITEOP(WAIT2); MESSAGE1"(PASS, ERROR, LINE)": PRINTMESSAGE; EOM1: DONE:=TRUE END UNTIL DONE; END "OF SCAN"; BEGIN BEGINPASS; SCAN; ENDPASS; NEXT_PASS(LINK) END. * NX RF& T0x X )X6 )X  T" "H)";"L `$$ $N$ "|""~"r"z0"x0"v0"t0"0R1R2R3R4R5R6R7R8R9R&ARBRCR " ~ *" p `F,:  " ~  * "  "(" l ^njH" \p"h "p "l l>P"$p"h j"" H$ nPX8n n>" nO 8n" " DRERFRGRHRIRJRKRLRMRNRORPRQRRRSRTRURVRWRXRYRZR_R&8&&" `& R8&F&'R RR(R&t*" `" "j"`8bL, "$""l(J 0B@$ T0 b R 'X  "" :X>   ^" TR `  H 0B>"  T0 6  X  :X   )X   Z?" nO F <:86420.,*(&$"t $l "  T0 .X  )X~" .X" " T0hl4J 0B@$ B"  T0 EX@ " "" +X * -X"  T0\  `"  H0B >" "   n`.$n"O? n nB" nZ( nP^n" nX  O n06p:"r "l" r X4r"p p"~ p t*r r"~ p r  l l P>HP"  TR pX hf px p1XP .X:L  INTED TO BY R0 ; ON THE CONSOLE TERMINAL. THE STRING IS TERMINATED IN TWO WAYS: ; ; 1). A NULL CHARACTER, WHICH CAUSES A CR/LF SEQUENCE TO BE ; APPENDED TO THE END OF THE STRING. ; ; 2). A NEGATIVE BYTE (PARITY BIT SET), WHICH CAUSES THE STRING ; TO BE OUTPUT "AS IS". ; PRINT: TSTB XCSR ;WAIT ON BPL PRINT ; DONE MOVB (R0)+,XBUF ;OUTPUT NEXT CHARACTER BGT PRINT ;GT => MORE CHARACTERS IN STRING BMI RETURN ;MI => DO NO MORE MOV #CRLF,R0 ;R0 -> CR,LF,-1 SEQUENCE BR PRINT ;PRINB"*,LƄjxpfh7\4PEDN28&&ń'ń&*ń52Qpń<hA\LP$ń6<C$Ą=$t؄ld;XPxD .V""ۄڄ?x>lT THIS RETURN: RTS PC ;RETURN TO CALLER CRLF: .BYTE 15,12,-1 ;CR,LF SEQUENCE .EVEN ;ALIGNMENT ; ; ; THE OCTAL SUBROUTINE CONVERTS THE NUMBER IN R0 TO OCTAL ASCII ; (6 DIGITS) IN THE AREA POINTED TO BY R1. THIS CODE COURTESY THE ; AUTHORS OF THE RT-11 OPERATING SYSTEM. ; ; OCTAL: MOV #30,R4 ;SEED DIGIT SEC ;USED AS END FLAG 1$: ROL R0 ;SHIFT OUT TOP BIT ROLB R4 ;NOTE R4 NOW = ASCII DIGIT MOVB R4,(R1)+ ;PUT IN BUFFER MOV #206,R4 ;SEED NEXT DIGIT 2$: ASL R0 ;SHIFT OUT NEXT BIT BE!hDلf4݄TބׄքxՄpbׄZ:„N@ׄ89„,1„ ބt݄.~„|0n„gTTJr.$`>>&6h`D8.DJ RHXxpfx2r`vn`zxD|t&|8"|Zxb2pvb P Z Rn  .Q 3$ ;EQ => DONE ROLB R4 ;SHIFT INTO DESTINATION BCS 2$ ;CS => 1ST TIME AROUND BR 1$ ;ELSE, DONE 3$: RTS PC ;RETURN TO CALLER .SBTTL CLOCK INTERRUPT SERVICE ;* ;* KW11-L LINE CLOCK INTERRUPT: ;* CLKINT: BIS #LKSINE,@#LKS ;<01> RE-ENABLE INTERRUPT INTSRV CLOCK8 ;<01> GOTO CLOCK 8 TO SERVICE INTRPT ;* ;* FLOATING POINT PROCESSOR INTERRUPT: ;* FPPINT: INTSRV REAL11 ;<01> REALINTERRUPT; .SBTTL KERNEL CALL INTERRUPT SERVICE ;* ;* KERNEL CA X |"&W  ,|"  "X  X6  X "X X6 Xt 2  ,6"> .X,$ )X/   =X4 0  =XX$ >X> !f>&2  =XLL: ;* KNCALL: INTSRV ;<01> SERVICE INTERRUPT IMMEDIATELY JSR PC,@ ; CASE RUNNING.HEAD.OPCODE OF ; 0: WAIT; ; 2: REALTIME; ; 4: SYSTEMERROR; ; 6: INITPROCESS; ; 8: ENDPROCESS; ; 10: STOPJOB; ; 12: ENTER;  "$l  .X   ~/~" +x.lx*`lT`HT<H0<$0$?6zBX&`tDJT`R~|zxvtrpnljhfdb(&$"X  Xp " DF ђ$   B"$   B"2  0\4   F (M  Є0 (N 6Є (O  2Є ( n  "V   "2   | (//R܌r  ܖPASS 1: FILE_LIMITEND IF THEN BEGIN ELSE DO WITH IN OF WHILE CASE REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT DIV CONST TYPE FUNCTION FORWARD UNIV PROGRAM FALSE TRUE INTEGER BOOLEAN CHAR NIL NEW AB" jK"  " ^8 T  H " I"  τ (  "  "H |΄N( ( 0 S.΄$ HFDp:r""<  T " dp"L IS ATTRIBUTE CHR CONV ORD PRED SUCC TRUNC REAL PASS 1: FILE_LIMITEND IF THEN BEGIN ELSE DO WITH IN OF WHILE CASE REPEAT UNTIL PROCEDURE VAR FOR ARRAY RECORD SET TO DOWNTO MOD OR AND NOT DIV CONST TYPE FUNCTION FORWARD UNIV PROGRAM FALSE TRUE INTEGER BOOLEAN CHAR NIL NEW AB 8 , 2ݒXA 8& 8S3 4X f݄&4<"6" 9X ݄: :X"7" 68x5 7X ܄ Z & ܒVU 8&"@"8nr9\ >" J ^Ͱ "  2" 80.V"4  Xr   X """ ل " ̈́ R&<L2̒*B B"4  X   XPL  vT* .X ۄ " 7X ۄ 8Z &" `:Bm 8 8 T d="j@"\?"NA"@<"2>"$B";ٌ~  ْT 8&F &T:" XC" D"  "."$OJ˒(U<4  Xp   X@  "J ʄNB4f2ׂنB4    T  (  "  " (  "^ ( ل "  T; TH ,E"*F"G"ZلE", l& T0bR 8& T; Th HH"JI"<J".K" L"J؄ H", \ T0B "  "*x (ʰ$~4  (  "$l4 (N Ȓ$ 84  (  " İ( 4 (M @Ȓ$4  ( 4  "(L4 (R 8 T Y֌ׄ_ ׌ׄr[ ֌ׄ^] ֌zׄJ R<d 8 +X @ׄ & $NTք OD v8& ThP T& .X քPx߄ /X Zք ߄z SՒ@ 8NO ǒ  &DŽB|tTlބd\&TLG@F8",$DŽ"քք.pX%DDŽ@\D@Ƅ, |Ƅ ۄۄ~"p3d$ B"H6фn߄h-Ƅ+ RO OCTAL X,Y ;CONVERT TO OCTAL ASCII .IF NB,X MOV X,R0 .ENDC .IF NB,Y MOV Y,R1 .ENDC JSR PC,OCTAL ;CALL CONVERSION SUBROUTINE .ENDM OCTAL $SERR: .ENABL LSB SPL 7 ;UP PRIORITY IF NOT ALREADY PRINT ;PRINT STRING ASSOCIATED WITH ERROR ;(CONTAINED IN SYSERR MACRO CALL) PRINT #HEADER ;PRINT OUT HEADINGS MOV #KSR0,R2 ;R2 -> REGISTERS MOV #8.,R3 ;R3 COUNTS 1$: OCTAL (R2)+,#ONUM ;CONVERT A REGISTER TO ASCII PRINT #ONUM ;AND PRINT DEC R3 ;COUNT BNE 1$  8  X Q RՄ MԒd" f8&S  ~ fT 3ԌRT h3tԌ0V8&"U@  T* .X Ԅ ݄ " /X Ԅ V݄$VӌtԄ.  X݄@! 82 Tn NW jӄNZ ; DOWN PRINT #NULL ;RETURN THE CARRIAGE HALT ;NOW STOP! BR .-2 ;DISALLOW CONTINUE ; ; AT THIS POINT, COULD PROBABLY FORCE AN EXCEPTION CONDITION ON USER ; (IF TRAP CAME FROM USER STATE), AND CONTINUE SYSTEM EXECUTION. ; ; ; DATA: ; HEADER: .ASCII <15><12>\SYSTEM FAILURE\<15><12> .ASCII \ R0 R1 R2 R3 R4 R5 PC PSW\ NULL: .BYTE 0 ONUM: .ASCII \XXXXXX \<200> .EVEN .DSABL LSB .SBTTL SYSERR SUBROUTINES ; ; ; THE FOLLOWING SUBROUTINE PRINTS THE ASCII STRING POZӄ>X*ӄ2\ >ӄ"^ .ӄӄ! rWҒ )SԌ  " bΖPASS 2: FILE_LIMIT3tԌ0V8&"U@  T* .X Ԅ ݄ " /X Ԅ V݄$VӌtԄ.  X݄@! 82 Tn NW jӄNZ CS, RKER ; VAR ERROR: BOOLEAN; ;* = R0 ; I: MAPINDEX; ;* ; ;* ; BEGIN ;* THIS PROCEDURE IS EXECUTED FOR ; ;* THE FIRST TIME BY ACTION OF A ; ;* HUMAN OPERATOR AT THE COMPUTER ; ;* CONSOLE, WHO PERFORMS A STANDARD; ;* INITIAL PROGRAM LOAD FROM DISK ; ;* DRIVE 0. WHEN THIS HAS BEEN ; ;* DONE, THE CODE WHICH IMPLEMENTS ; ;* THE VIRTUAL MACHINE (KERNEL + ; ;* INTERPRETER) WILL HAVE BEEN READ; ;* IN ; 5$: HALT ; HALT; SYSERR ; END; 2$: ; ; END; ; ; ;* ; PROCEDURE LOADSYSTEMPROGRAM; ;* ; ;* ; ;* ; CONST PROGRAMEND = ...; ;* ; ENDTO CORE STARTING AT PHYSICAL ; ;* ADDRESS 000000. CONTROL IS ; ;* PASSED TO "$KNL0" VIA A 'JMP' ; ;* INSTRUCTION SITUATED AT 000000. ; ;* ; ;* SUBSEQUENTLY, THIS PROCEDURE MAY; ;* BE RE-EXECUTED BY JUMPING TO THE; ;* LABEL "$RVM0", BELOW, AFTER ; ;* HAVING MOVED THE STARTING PAGE ; ;* NUMBER OF THE NEW OPERATING SYS-; ;* TEM INTO "$SDA0", ABOVE. ; ;* ; ;*<01> ALSO BY LOADING ADDR 42 AND ; ;*<01> START FROM FRONT PANEL (NICE;OFCORE = ...; ;* ; ;* ; TYPE PAGE = ARRAY (.1..256.) OF ;* ; INTEGER; ;* ; SEGMENTINDEX = 1..4096; ;* ; SEGMENT = ARRAY ;* ; (.SEGMENTINDEX.) OF INTEGER; ;* ; ;* = KISAR+12. ; VAR SEGADDR: @SEGMENT; ;* = R1 ;*<01> FOR DEBUGGING CHANGES THAT ; ;*<01> DON'T QUITE WORK!) ; ;* ; $RVM0: RESET ; RESETUNIBUS; $ = ; READ(DISK0, 0, 1, KERNELLENGTH, $ = <$/512.> * 256. ; ERROR); MOV #<-$>,RKWC ; MOV #1,RKDA ;<01> THIS VERSION STARTS @ BLK 1 BIS UNITNO,RKDA ;<01> AND FROM ANY UNIT MOV $SDA0,R0 ; MOV UNITNO,R1 ;<01> SA ; I: SEGMENTINDEX; ;* = R2 ; SEGINDEX: SEGMENTINDEX; ;* ; $LSP0: ; ;* IT IS EXPECTED THAT THE HUMAN ; PROCEDURE LOADFROMTAPE; ;* OPERATOR WILL MOUNT A TAPE REEL ; ;* CONTAINING THE CODE OF THE OP- ; ;* ERATING SYSTEM ON THE (9-TRACK) ; ;* TAPE DRIVE 0. ; ;* ; ;* ; CONST TAPE0 = 0; ;* ; ;* VE THIS ALSO $ = +RCSGO; MOV #$,RKCS ; 1$: TSTB RKCS ; BGE 1$ ; MOV R0,$SDA0 ; MOV R1,UNITNO ;<01> REPLACE UNIT NUMBER ; ; $KNL0: SPL 7 ; EXCLUDEINTERRUPTS; SETDMP ; MOV #KSR0,SP ;<01> STACKPOINTER := 1; "THIS RESERVES = MTC ; VAR ERROR: BOOLEAN; ;* = MTCMA ; ADDR: @PAGE; ;* ; .IF NE $.DBTA ; BEGIN $R = MDN800 * MTCDEN ; WHILE NOT MOUNTED(TAPE0) DO $R = $R + ; BEGIN MOV #$R,MTC ; BIT #MTSELR,MTS ; BNE 1$ ; MOV #12$,TEXT33 ; TYPE('(:13:)(:10:)'); JSR PC,WRIT33 ;  . " ڼPASS 3: FILE_LIMITׄքxՄpbׄZ:„N@ׄ89„,1„ ބt݄.~„|0n„gTTJr.$`>>&6h`D8.DJ RHXxpfx2r`vn`zxD|t&|8"|Zxb2pvb P Z Rn  . ; 8 STACK ENTRIES WHICH WILL ; BE SUBSEQUENTLY FILLED WITH THE ; STATUS, RETURN, & REGISTERS ; OF THE INITIAL PROCESS." MOV #8.,R0 ; FOR I := 0 TO 7 DO CLR R1 ; MOV #KISDR,R2 ; MOV #KISAR,R3 ; BEGIN 1$: MOV #KSDR,(R2)+ ; KERNELSDRS(.I.) := ; TYPE('MOUNT SYSTEM TAPE '); ; TYPE('ON DRIVE 0 AND THEN '); ; TYPE('PRESS "CONTINUE".'); HALT ; HALT; BR $LSP0 ; 12$: .ASCII <13.><10.> ; .ASCII /MOUNT SYSTEM TAPE /; .ASCII /ON DRIVE 0 / ; .ASCII /AND THEN / ; .ASCIZ /PRESS "CONTINUE"./ ; .EVEN ; 1$: ; ; 14: LEAVE; ; 16: DELAY; ; 18: CONTINUE; ; 20: INITGATE; ; 22: IO; ; END; KNEXIT: TST USER99 ; IF RUNNING.USER = NIL THEN BNE 1$ ; JSR PC,SELE12 ; READY.SELECT; 1$: KNSTAT ; KNSERV ; POP ;<01> DONE, RESTORE REGISTERS RTI ; KERNELEXIT; ;* ;* .SBTTL INITIALIZE THE VIRTUAL MACHINE ;**** INITIALIZE THE KERNEL AND LOAD THE SYSTEM PROGRAM ;* ;* ;*********************************************************************** ;* ; ;* ; ;* ; CONST PROGRAMSTART = ...; ;* ; KERNELLENGTH = ...; ;* BEGIN BGE 3$ ; TYPE('(:13:)(:10:)'); MOV #4$,R0 ; TYPE('KERNEL LOAD ERROR'); 7$: TSTB (R0) ; TYPE('(:13:)(:10:)'); BEQ 5$ ; MOVB (R0)+,XBUF ; 6$: TSTB XCSR ; BGE 6$ ; BR 7$ ; 4$: .ASCII <13.><10.> ; .ASCII /KERNEL LOAD ERROR/ ; .ASCIZ <13.><10.> ; .EVEN 6                        ' ) + - / 1 3 5 7 ! # % ( * , . 0 2 4 6 " ? A G I K M O 9 ; = Z \ ^ ` b d f P R T V X [ ] _ a c e g Q S U W Y h j l n k m z | ~ n p r t v x       %'! ; ;* ; TYPE STACKINDEX = 0..31; ;* ; MAPINDEX = 0..7; ;* ; DISKBLOCK = 0..4799; ;* ; ;* = SP ; VAR STACKPOINTER: STACKINDEX; $SDA0: .WORD 24. ; SYSTEMBLOCK: DISKBLOCK INIT 40; ;* = $.DBTA ; SYSTEMTAPE: BOOLEAN; ;* ; KERNELSTACK: ARRAY ;* "AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 1: LEXICAL ANALYSIS OCTOBER 1974" (CHECK, NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; SPLITLENGTH = 4 "WORDS PER SPLIT REAL"; MAX_STRING_LENGTH = 80 "CHARS"; WORDS_PER_STRING = 40 "M ; (.STACKINDEX.) OF INTEGER; ;* = SSR0 ; ADDRESSMAPPING: BOOLEAN; ;* = KISDR ; KERNELSDRS: ARRAY (.MAPINDEX.) ;* ; OF INTEGER; ;* = KISAR ; KERNELMAP: ARRAY (.MAPINDEX.) ;* ; OF INTEGER; ;* = COREC9 ; CORECAPACITY: INTEGER; ;* ; ;*AX_STRING_LENGTH DIV WORDLENGTH"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPTION = 5; "************************ CAUTION ************************" "THE 'LARGEST_REAL' PROCEDURE IS MACHINE DEPENDANT. IT MAY HAVE TO BE CHANGED " "IF THE COMPILER IS MOVED TO ANOTHER MACHINE . " TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOP ; ;* ; PROCEDURE LOADVIRTUALMACHINE; ;* ; ;* = .SGSBK ; CONST BLOCKINCR = 128; ;* = .PRBLK ; REGISTERBLOCK = 3968; ;* ; DISK0 = 0; ;* = KSDR ; SEGMENTDESCRIPTOR = ... ;* ; "8K BYTES, UPWARDS, READ/WRITE"; ;* ; ;* = RKTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG########### # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "OUTPUT OPERATORS" EOM2=0; BEGIN2=1; IF2=2; CASE2=3; WHILE2=4; REPEAT2=5; FOR2=6; CYCLE2=7; WITH2=8; INIT2=9; ID2=10; REAL2=11; STRING2=12; INTEGER2=13; CHAR2=14; OPEN2=15; NOT2=16; SUB2=17; SET2=18; ARRAY2=19; RECORD2=20; CLASS2=21; = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "##################################); BEGIN IF SKIP_FIRST THEN BEGIN WRITE(CH); READ(CH) END; REPEAT IF CH='"' THEN BEGIN REPEAT REPEAT WRITE(CH); READ(CH) UNTIL (CH=EOL) OR (CH='"'); WHILE CH = EOL DO END_LINE UNTIL (CH=EOM) OR (CH='"'); IF CH = '"' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(COMMENT_ERROR) END; WHILE CH = ' ' DO BEGIN WRITE(CH); READ(CH) END; WHILE CH=EOL DO END_LINE UNTIL (CH<>' ') AND (CH<>'"') END; PROCEDURE INIT_OPTIONS; VAR STOPMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; PROCEDURE STORE_TEST (ARG: INTEGER); BEGIN IF TEST_INDEX < TEST_MAX THEN BEGIN TEST_INDEX:= TEST_INDEX + 1; TEST_BUF(.TEST_INDEX.):= ARG END END; PROCEDURE PRINT_TEST; VAR I: INTEGER; BEGIN PRINTED:= PRINTLIMIT; FOR I:= 1 TO TEST_INDEX DO P:SET OF CHAR; BEGIN END_LINE; NEW(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN OPTIONS:=(.LISTOPTION,CHECKOPTION,NUMBEROPTION.); MARK(RESETPOINT); TABLES:=NIL; GET_CHAR(FALSE); IF CH='(' THEN BEGIN STOP:=(.',' , ')' , EOM.); REPEAT GET_CHAR(TRUE); IF CH='L' THEN OPTIONS:=OPTIONS-(.LISTOPTION.) ELSE IF CH='S' THEN OPTIONS:=OPTIONS OR (.SUMMARYOPTION.) ELSE IF CH='T' THEN OPTIONS:=OPTIONS OR (.TESTOPTION.) EL MONITOR2=22; PROCESS2=23; PERIOD2=24; STAR2=25; SLASH2=26; DIV2=27; MOD2=28; AND2=29; PLUS2=30; MINUS2=31; OR2=32; EQ2=33; NE2=34; LE2=35; GE2=36; LT2=37; GT2=38; IN2=39; CONST2=40; TYPE2=41; VAR2=42; PROCEDURE2=43; FUNCTION2=44; PROGRAM2=45; SEMICOLON2=46; CLOSE2=47; UP_TO2=48; OF2=49; COMMA2=50; RINTARG(TEST_BUF(.I.)); TEST_INDEX:= 0 END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN STORE_TEST(ARG) END; PROCEDURE PUT0NC(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP); WRITE(CH); READ(CH) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL( BUS2=51; COLON2=52; END2=53; ENTRY2=54; UNIV2=55; BECOMES2=56; THEN2=57; ELSE2=58; DO2=59; UNTIL2=60; TO2=61; DOWNTO2=62; LCONST2=63; MESSAGE2=64; NEW_LINE2=65; "OTHER CONSTANTS" "ERRORS" COMMENT_ERROR=1; NUMBER_ERROR=2; INSERT_ERROR=3; STRING_ERROR=4; CHAR_ERROR=5; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; OP); WRITE_IFL(ARG); IF TEST THEN BEGIN STORE_TEST(OP); STORE_TEST(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN STORE_TEST(OP); STORE_TEST(ARG1); STORE_TEST(ARG2) END END; PROCEDURE PUT_STRING (STRING: UNIV PACKED_STRING; STRING_LENGTH: INTEGER); VAR I: INTEGER; BEGIN PUT1(STRING2, STRING_LENGTH); PUT1(LCONST2, STRING_LENGTH); FOR I:= 1 TO STRING_LENGTH DIV WORDLENGTH XQUEUE=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONTINUE=10; XCONV=11; XDELAY=12; XEMPTY=13; XIO=14; XORD=15; XPRED=16; XSTOP=17; XREALTIME=18; XSETHEAP=19; XSUCC=20; XTRUNC=21; XSTART=22; XWAIT=23; XREAL=24; ID_PIECE_LENGTH = 9 "TEN CHARS PER PIECE"; MAX_PIECES = 13; "FOURTEEN PIECES => 140 CHARS" TEST_MAX = 50; NULL=32767; THIS_PASS=1; SPAN=26 "NUMBER OF DISTINCT ID CHARS"; MIN_ORD=0; DO PUT_ARG(STRING(.I.)) END; PROCEDURE ERROR(ERROR_NUM:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,ERROR_NUM) END; "##########" "INITIALIZE" "##########" PROCEDURE STD_ID(ID:PIECE; INDEX:SPELLING_INDEX); VAR S:SPELLING_INDEX; CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY: MAX_ORD=127; MAX_INTEGER=32767; INTEGER_LIMIT="(MAX_INTEGER-9) DIV 10" 3275; MAX_EXPONENT=38; HASH_MAX=750; "HASH_TABLE UPPER_BOUND" HASH_MAX1=751; "PRIME LENGTH OF HASH_TABLE" MAX_INDEX=700; "MAX LOADING=0.98*HASH_MAX1-NO. OF RES.WDS." TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; TYPE ALFA=ARRAY (.1..10.) OF CHAR; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; SPELLING_INDEX=INTEGER; PIECE=ARRAY(.0..ID_PIECE_LENGTH.) OF CHAR; PIECE_PTR=@ID_PIECE; ID_PIECE= RECORD =(HASH_KEY+1) MOD HASH_MAX1; "NOW WE HAVE ENTRY SLOT" WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID; NEXT:=NIL END END END; PROCEDURE LONG_STD_ID(ID1,ID2:PIECE; INDEX:SPELLING_INDEX); VAR CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO HASH_KEY:=HASH_KEY*(ORD(ID1(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID2(.CHAR_INDEX.)<>' ' THEN HASH_K PART:PIECE; NEXT:PIECE_PTR END; SPLITREAL = ARRAY (.1..SPLITLENGTH.) OF INTEGER; PACKED_STRING = ARRAY (.1..WORDS_PER_STRING.) OF INTEGER; VAR REAL0, REAL1, REAL10, MAX_REAL, REAL_LIMIT: REAL; INTER_PASS_PTR:PASSPTR; CH:CHAR; LETTERS, DIGITS, ALFAMERICS, NON_ALFAS, STRING_SPECIAL: SET OF CHAR; TEST, UPTO_SW, BUS_SW, END_SCAN: BOOLEAN; CL1,CL2,CL3,CL4 "LINE NUMBER": CHAR; LINE_NO:INTEGER; PIECES: INTEGER "ID LENGTH IN PIECES"; TEST_BUF: ARRAY (.1..TEST_MEY:=HASH_KEY*(ORD(ID2(.CHAR_INDEX.)) MOD SPAN+1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID1; NEW(NEXT); WITH NEXT@ DO BEGIN PART:=ID2; NEXT:=NIL END END END END; PROCEDURE STD_NAMES; BEGIN STD_ID('END ',-END2); STD_ID('IF ',-IF2); STD_ID('THEN ',-THEN2); STD_ID('BEGIN ',-BEGIN2); AX.) OF INTEGER; TEST_INDEX: INTEGER; ID_TEXT: ARRAY(.0..MAX_PIECES.) OF PIECE; BLANK: PIECE "BLANK PADDING"; CHAR_INDEX:0..ID_PIECE_LENGTH "CURRENT CHAR INDEX"; SYMB: INTEGER "ID SYMBOL"; STRING_LENGTH:INTEGER; HASH_KEY: 0..HASH_MAX; "INDEX TO HASH_TABLE" CURRENT_INDEX "LAST ASSIGNED INDEX", INDEX "LAST SCANNED INDEX" : SPELLING_INDEX; STRING_TEXT: ARRAY (.1..MAX_STRING_LENGTH.) OF CHAR; HASH_TABLE: ARRAY (.0..HASH_MAX.) OF RECORD SPIX:SPELLING_INDEX; STD_ID('ELSE ',-ELSE2); STD_ID('DO ',-DO2); STD_ID('WITH ',-WITH2); STD_ID('IN ',-IN2); STD_ID('OF ',-OF2); STD_ID('WHILE ',-WHILE2); STD_ID('CASE ',-CASE2); STD_ID('REPEAT ',-REPEAT2); STD_ID('UNTIL ',-UNTIL2); STD_ID('PROCEDURE ',-PROCEDURE2); STD_ID('VAR ',-VAR2); STD_ID('FOR ',-FOR2); STD_ID('ARRAY ',-ARRAY2); STD_ID('RECORD ',-RECORD2); STD_ID('SET ',-SET2); STD_ID('TO NAME:ID_PIECE END; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMI ',-TO2); STD_ID('DOWNTO ',-DOWNTO2); STD_ID('MOD ',-MOD2); STD_ID('OR ',-OR2); STD_ID('AND ',-AND2); STD_ID('NOT ',-NOT2); STD_ID('DIV ',-DIV2); STD_ID('CONST ',-CONST2); STD_ID('TYPE ',-TYPE2); STD_ID('FUNCTION ',-FUNCTION2); STD_ID('PROGRAM ',-PROGRAM2); STD_ID('CLASS ',-CLASS2); STD_ID('CYCLE ',-CYCLE2); STD_ID('ENTRY ',-ENTRY2); STD_ID('INIT ',-INIT2); STD_ID('MONITOR ',-MONT; BEGIN PRINT_TEXT('PASS 1: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK ITOR2); STD_ID('PROCESS ',-PROCESS2); STD_ID('UNIV ',-UNIV2); STD_ID('FALSE ',XFALSE); STD_ID('TRUE ',XTRUE); STD_ID('INTEGER ',XINTEGER); STD_ID('BOOLEAN ',XBOOLEAN); STD_ID('CHAR ',XCHAR); STD_ID('QUEUE ',XQUEUE); STD_ID('ABS ',XABS); STD_ID('ATTRIBUTE ',XATTRIBUTE); STD_ID('CHR ',XCHR); STD_ID('CONTINUE ',XCONTINUE); STD_ID('CONV ',XCONV); STD_ID('DELAY ',XDELAY); STD_ID('EMPTY ',XEMPTY); END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; WITH PARAM(.5.) DO BEGIN TAG:= BOOLTYPE; BOOL:= CH = EOM END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OU STD_ID('IO ',XIO); STD_ID('ORD ',XORD); STD_ID('PRED ',XPRED); STD_ID('STOP ',XSTOP); STD_ID('REALTIME ',XREALTIME); STD_ID('SETHEAP ',XSETHEAP); STD_ID('SUCC ',XSUCC); STD_ID('TRUNC ',XTRUNC); STD_ID('START ',XSTART); STD_ID('WAIT ',XWAIT); STD_ID('REAL ',XREAL); END; PROCEDURE END_LINE; VAR I: INTEGER; BEGIN IF TEST THEN PRINT_TEST; WRITE(CH); READ(CH); LINE_NO:=LINE_NO+1; PUT1(NEW_LINE2,LINT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE SPLIT (INPUT: UNIV SPLITREAL; VAR OUTPUT: SPLITREAL); BEGIN OUTPUT:= INPUT END; PROCEDURE LARGEST_REAL (VAR MAX: UNIV SPLITREAL); BEGIN MAX(.1.):= 32767; MAX(.2.):= -1; MAX(.3.):= MAX(.2.); MAX(.4.):= MAX(.3.) END; PE_NO); IF CL4<'9' THEN CL4:=CHR(ORD(CL4)+1) ELSE BEGIN CL4:='0'; IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEGIN CL3:='0'; IF CL2<'9' THEN CL2:=CHR(ORD(CL2)+1) ELSE BEGIN CL2:='0'; IF CL1<'9' THEN CL1:=CHR(ORD(CL1)+1) ELSE CL1:='0' END END END; WRITE(CL1); WRITE(CL2); WRITE(CL3); WRITE(CL4); WRITE(' '); IF CH = ' ' THEN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' ' END; PROCEDURE GET_CHAR(SKIP_FIRST:BOOLEANROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTFF; BEGIN WRITE(FF); PRINTED:= 0 END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(LE2) ELSE IF CH='>' THEN PUT0NC(NE2) ELSE PUT0(LT2) END; '=': PUT0NC(EQ2); '>': BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(GE2) ELSE PUT0(GT2) END; '''': STRING; '0','1','2','3','4','5','6','7','8','9': NUMBER; 'A','B','C','D','E','F','G','H','I','J','K','L','M','N', 'O','P','Q','R','S','T','U','V','W'ON SAME_ID:BOOLEAN; VAR SAME:BOOLEAN; THIS_PIECE:PIECE_PTR; I:INTEGER; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SAME:=NAME.PART=ID_TEXT(.0.); IF PIECES>0 THEN IF SAME THEN BEGIN THIS_PIECE:=NAME.NEXT; I:=1; REPEAT IF THIS_PIECE=NIL THEN BEGIN SAME:=FALSE "CANDIDATE IS TOO SHORT"; I:=PIECES+1 "QUIT" END ELSE BEGIN "COMPARE AND INCREMENT" SAME:=SAME AND (THIS_PIECE@.PART=ID_TEXT(.I.));,'X','Y','Z','_': IDENTIFIER; '(': BEGIN WRITE(CH); READ(CH); IF CH='.' THEN PUT0NC(SUB2) ELSE PUT0(OPEN2) END; ')': IF BUS_SW THEN BEGIN PUT0NC(BUS2); BUS_SW:=FALSE END ELSE PUT0NC(CLOSE2); ',': PUT0NC(COMMA2); ';': PUT0NC(SEMICOLON2); '*': PUT0NC(STAR2); '/': PUT0NC(SLASH2); '+': PUT0NC(PLUS2); '-': THIS_PIECE:=THIS_PIECE@.NEXT; I:=I+1; END UNTIL I>PIECES; SAME:=SAME AND (THIS_PIECE=NIL) END; SAME_ID:=SAME END END; PROCEDURE INSERT_ID; VAR I:INTEGER; P,P1:PIECE_PTR; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN CURRENT_INDEX:=CURRENT_INDEX+1; IF CURRENT_INDEX>=MAX_INDEX THEN BEGIN ERROR(INSERT_ERROR); CH:=EOM; WRITE(EOL) END; SPIX:=CURRENT_INDEX; WITH NAME DO BEGIN PART:=ID_TEX 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; WITH PARAM(.5.) DO BEGIN TAG:= BOOLTYPE; BOOL:= CH = EOM END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDST(.0.); NEXT:=NIL END; IF PIECES>0 THEN BEGIN NEW(P); NAME.NEXT:=P; P@.PART:=ID_TEXT(.1.); FOR I:=2 TO PIECES DO BEGIN NEW(P1); P@.NEXT:=P1; P1@.PART:=ID_TEXT(.I.); P:=P1 END; P@.NEXT:=NIL END END END; PROCEDURE SEARCH_ID; VAR FINISHED:BOOLEAN; BEGIN FINISHED:=FALSE; REPEAT WITH HASH_TABLE(.HASH_KEY.) DO IF SPIX<>NULL THEN IF SAME_ID THEN "FOUND IT" BEGIN FINISHED:=TRUE; _IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); SE IF CH='C' THEN OPTIONS:=OPTIONS-(.CHECKOPTION.) ELSE IF CH='N' THEN OPTIONS:=OPTIONS-(.NUMBEROPTION.); WHILE NOT(CH IN STOP) DO GET_CHAR(TRUE) UNTIL (CH=EOM) OR (CH=')'); IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END END; IF TESTOPTION IN OPTIONS THEN BEGIN TEST:=TRUE; TEST_INDEX:= 0 END END END; PROCEDURE INITIALIZE; VAR S:SPELLING_INDEX; C:MIN_ORD..MAX_ORD; I:INTEGER; BEGIN TEST:= FALSE; "EMPTY SET" PUT1(L IF SPIX>=0 THEN BEGIN SYMB:=ID2; INDEX:=SPIX END ELSE SYMB:=ABS(SPIX) END ELSE HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1 ELSE "SYM=NULL" BEGIN INSERT_ID; SYMB:=ID2; INDEX:=CURRENT_INDEX; FINISHED:=TRUE END UNTIL FINISHED "WITH SEARCH" END; "######" "STRING" "######" PROCEDURE STRING_CHAR; BEGIN IF STRING_LENGTH = MAX_STRING_LENGTH THEN ERROR(STRING_ERROR) ELSE BEGIN STRING_LENGTH:=STRING_LENGTCONST2, SETLENGTH); FOR I:=1 TO SETLENGTH DIV WORDLENGTH DO PUT_ARG(0); END_SCAN:=FALSE; LINE_NO:=0; CL1:='0'; CL2:='0'; CL3:='0'; CL4:='0'; CH:= EOL; UPTO_SW:=FALSE; BUS_SW:=FALSE; REAL0:= CONV(0); REAL1:= CONV(1); REAL10:= CONV(10); LARGEST_REAL(MAX_REAL); REAL_LIMIT:= MAX_REAL / REAL10; DIGITS:=(.'0','1','2','3','4','5','6','7','8','9'.); LETTERS:=(.'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','_'H+1; STRING_TEXT(.STRING_LENGTH.):= CH; WRITE(CH); READ(CH) END END; PROCEDURE STRING; VAR ORD_VALUE, I: INTEGER; DONE: BOOLEAN; BEGIN STRING_LENGTH:= 0; WRITE(CH); READ(CH); DONE:= FALSE; REPEAT WHILE NOT (CH IN STRING_SPECIAL) DO STRING_CHAR; CASE CH OF '''': BEGIN STRING_CHAR; IF CH = '''' THEN BEGIN WRITE(CH); READ(CH) END ELSE DONE:= TRUE END; EOL, EOM: BEGIN ERROR(STRING_ERRO.); ALFAMERICS:=LETTERS OR DIGITS; STRING_SPECIAL:= (.'''', EOL, EOM, '('.); NON_ALFAS:= (..); FOR C:= MIN_ORD TO MAX_ORD DO NON_ALFAS:= NON_ALFAS OR (.CHR(C).); NON_ALFAS:= NON_ALFAS - ALFAMERICS; BLANK:=' '; FOR S:=0 TO HASH_MAX DO HASH_TABLE(.S.).SPIX:=NULL; CURRENT_INDEX:=XREAL; STD_NAMES; INIT_OPTIONS; END; "######" "NUMBER" "######" PROCEDURE NUMBER; VAR MANTISSA, POWER_OF_TEN, RESULT: REAL; ERROR_SW,EXPONENT_SIGN:BOOLEAN; REAL_VAL:SPLITR); DONE:= TRUE END; '(': BEGIN STRING_CHAR; IF CH = ':' THEN BEGIN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' '; ORD_VALUE:= 0; IF CH IN DIGITS THEN REPEAT IF ORD_VALUE <= MAX_ORD THEN ORD_VALUE:= ORD_VALUE * 10 + (ORD(CH) - ORD('0')); WRITE(CH); READ(CH) UNTIL NOT (CH IN DIGITS) ELSE ERROR(STRING_ERROR); REAL; OP:INTEGER; EXPONENT,EXPONENT_PART,I:INTEGER; BEGIN OP:= INTEGER2; MANTISSA:= REAL0; ERROR_SW:= FALSE; EXPONENT:= 0; "COLLECT INTEGER PART" REPEAT IF MANTISSA<=REAL_LIMIT THEN MANTISSA:=MANTISSA*REAL10+CONV(ORD(CH)-ORD('0')) ELSE ERROR_SW:=TRUE; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); "COLLECT FRACTIONAL PART" IF CH='.' THEN BEGIN WRITE(CH); READ(CH); IF CH=')' THEN BUS_SW:=TRUE ELSE IF CH='.' THEN UPTO_SW:=TRUE ELSE WHILE CH=' ' DO BEGIN WRITE(CH); READ(CH) END; IF CH=':' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); IF ORD_VALUE > MAX_ORD THEN BEGIN ERROR(STRING_ERROR); ORD_VALUE:= ORD('?') END; STRING_TEXT(.STRING_LENGTH.):= CHR(ORD_VALUE) END END END UNTIL DONE; IF STRING_LENGTH <= 1 THEN BEGIN BEGIN OP:=REAL2; IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF MANTISSA <= REAL_LIMIT THEN BEGIN MANTISSA:=MANTISSA*REAL10+CONV(ORD(CH)-ORD('0')); EXPONENT:=EXPONENT-1 END; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); END END; "COLLECT EXPONENT PART" IF CH='E' THEN BEGIN OP:=REAL2; WRITE(CH); READ(CH); EXPONENT_PART:=0; EXPONENT_SIGN:=FALSE; IF CH='+' THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1; STRING_TEXT(.1.):= '?' END ELSE STRING_LENGTH:= STRING_LENGTH - 1; IF STRING_LENGTH > 1 THEN IF STRING_LENGTH MOD WORDLENGTH <> 0 THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1 END; IF STRING_LENGTH = 1 THEN PUT1(CHAR2, ORD(STRING_TEXT(.1.))) ELSE PUT_STRING(STRING_TEXT, STRING_LENGTH) END; "##########" "IDENTIFIER" "##########" PROCEDURE IDENTIFIER; BEGIN PIECES:=-1; CHAR_INDEX:=ID_PIECE_LENGTH; HASH_KEY:= 1; RWRITE(CH); READ(CH) END ELSE IF CH='-' THEN BEGIN EXPONENT_SIGN:= TRUE; WRITE(CH); READ(CH) END; IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF EXPONENT_PART<=INTEGER_LIMIT THEN EXPONENT_PART:=EXPONENT_PART*10-ORD('0') +ORD(CH) ELSE ERROR_SW:=TRUE; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); "ASSERT EXPONENT <= 0;" IF EXPONENT_SIGN THEN IF MAX_EXPONENT + EXPONENT >= EXPONENT_PART THEN EXPONENT:EPEAT IF CHAR_INDEX=ID_PIECE_LENGTH THEN BEGIN CHAR_INDEX:= 0; PIECES:= SUCC(PIECES); ID_TEXT(.PIECES.):=BLANK; END ELSE CHAR_INDEX:= SUCC(CHAR_INDEX); ID_TEXT(.PIECES,CHAR_INDEX.):=CH; HASH_KEY:=HASH_KEY*(ORD(CH) MOD SPAN +1) MOD HASH_MAX1; WRITE(CH); READ(CH) UNTIL CH IN NON_ALFAS; SEARCH_ID; IF SYMB=ID2 THEN PUT1(ID2,INDEX) ELSE BEGIN PUT0(SYMB); IF SYMB=END2 THEN BEGIN GET_CHAR(FALSE); IF CH='.' THEN BEGIN = EXPONENT - EXPONENT_PART ELSE ERROR_SW:= TRUE ELSE EXPONENT:=EXPONENT+EXPONENT_PART END; "NOW CONSTRUCT THE NUMBER" IF OP=INTEGER2 THEN BEGIN IF MANTISSA>CONV(MAX_INTEGER) THEN BEGIN ERROR(NUMBER_ERROR); MANTISSA:= REAL0 END; PUT1(INTEGER2,TRUNC(MANTISSA)) END ELSE "OP=REAL2" BEGIN IF ERROR_SW THEN BEGIN ERROR(NUMBER_ERROR); SPLIT(REAL0, REAL_VAL) END ELSE BEGIN "COMPUTE THE APPROPRIATE POWER OF TEN" POWE PUT0(PERIOD2); REPEAT WRITE(CH); READ(CH) UNTIL CH = EOL; END_SCAN:=TRUE END END END END; "#######" "SCANNER" "#######" PROCEDURE SCAN; BEGIN REPEAT CASE CH OF ' ': BEGIN WRITE(CH); READ(CH) END; EOL: END_LINE; EOM: END_SCAN:=TRUE; '"': BEGIN REPEAT REPEAT WRITE(CH); READ(CH) UNTIL (CH = '"') OR (CH = EOL); WHILE CH = EOL DO END_LINE UNTIL (CH='"')R_OF_TEN:=REAL1; IF EXPONENT<0 THEN BEGIN EXPONENT_SIGN:=TRUE; EXPONENT:=ABS(EXPONENT) END ELSE EXPONENT_SIGN:=FALSE; IF EXPONENT>MAX_EXPONENT THEN BEGIN ERROR(NUMBER_ERROR); EXPONENT:=0 END; FOR I:=1 TO EXPONENT DO POWER_OF_TEN:=POWER_OF_TEN*REAL10; "NOW EITHER MANTISSA=0.0 OR MANTISSA>=1.0" IF MANTISSA = REAL0 THEN RESULT:= REAL0 ELSE IF EXPONENT_SIGN THEN RESULT:= MANTISSA / POWER_OF_TEN ELSE " OR (CH=EOM); IF CH=EOM THEN ERROR(COMMENT_ERROR) ELSE BEGIN WRITE(CH); READ(CH) END END; '.': BEGIN WRITE(CH); READ(CH); IF UPTO_SW THEN BEGIN PUT0(UP_TO2); UPTO_SW:=FALSE END ELSE IF CH='.' THEN PUT0NC(UP_TO2) ELSE IF CH=')' THEN PUT0NC(BUS2) ELSE PUT0(PERIOD2) END; ':' : BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(BECOMES2) ELSE PUT0(COLON2) END; '<': BIF MANTISSA>=1.0 THEN WE MUST HAVE: MANTISSA*POWER_OF_TEN<=MAX_REAL => POWER_OF_TEN<=MAX_REAL/MANTISSA<=MAX_REAL" IF POWER_OF_TEN < MAX_REAL / MANTISSA THEN RESULT:= MANTISSA * POWER_OF_TEN ELSE BEGIN ERROR(NUMBER_ERROR); RESULT:= REAL0 END; SPLIT(RESULT, REAL_VAL) END; PUT0(REAL2); PUT1(LCONST2,REALLENGTH); FOR I:= 1 TO SPLITLENGTH DO PUT_ARG(REAL_VAL(.I.)) END END; "#######" "HASHING" "#######" FUNCTI : < > @ B D F H J L N 9 ; = ? A G I K M O T V X Z \ ^ ` b d f P R U W Y [ ] _ a c e g Q S p r t v x z | ~ h j l n q s u w y { }  i k m o             " $ &         ! # % '       8 : < > ( * , . 0 2 4 6 9 ; = ? ) + IF SY=SEMICOLON1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; PUT2(END_CASE2,L0,LN); IF SY=END1 THEN GET ELSE ERROR(CASE_ERROR,KEYS); END; PROCEDURE LABEL_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QLABEL_LIST; DONE:=FALSE; REPEAT CONSTANT(LKEYS1); PUT0(CASE2); CHECK(LABEL_ERROR,LKEYS1); IF SY IN QLABEL_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(LABEL_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL D(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCONE END; PROCEDURE WHILE_STAT; VAR L1,L2:LABEL; BEGIN NEW_LABEL(L1); NEW_LABEL(L2); PUT1(DEF_LABEL2,L1); GET; EXPR(KEYS OR QDO_TAIL); PUT1(FALSEJUMP2,L2); IF SY=DO1 THEN GET ELSE ERROR(WHILE_ERROR,KEYS OR QSTAT); STAT(KEYS); PUT2(JUMP_DEF2,L1,L2) END; PROCEDURE REPEAT_STAT; VAR L:LABEL; BEGIN NEW_LABEL(L); PUT1(DEF_LABEL2,L); GET; STAT_LIST (KEYS OR QUNTIL_TAIL); IF SY=UNTIL1 THEN GET ELSE ERROR(REPEAT_ERROR,KEYS OR QEXPR); EXPR(KEYS)RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM; PUT1(FALSEJUMP2,L) END; PROCEDURE FOR_STAT; CONST UP=5; DOWN=3; VAR L1,L2:LABEL; LKEYS1:SETS; OP,DIRECTION:INTEGER; BEGIN LKEYS1:=KEYS OR QFORB_END; GET; NEW_LABEL(L1); NEW_LABEL(L2); IDENTIFIER(KEYS OR QFOR_END,NAME2,FOR_ERROR); PUT0(ADDRESS2); IF SY=BECOMES1 THEN GET ELSE ERROR(FOR_ERROR,LKEYS1); EXPR(LKEYS1); PUT0(FOR_STORE2); CHECK(FOR_ERROR,LKEYS1); DIRECTION:=UP; OP:=FOR_UP2; IF SY=TO1 THEN GET ELSE IF SY=DOWNTO1 THEN BEGIN GET; DIRECTION:=DOWN; O, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PUT0NC(MINUS2); '&': PUT0NC(AND2); '(:0:)', '(:1:)', '(:2:)', '(:3:)', '(:4:)', '(:5:)', '(:6:)', '(:7:)', '(:8:)', '(:9:)', '(:11:)', '(:12:)', '(:13:)', '(:14:)', '(:15:)', '(:16:)', '(:17:)', '(:18:)', '(:19:)', '(:20:)', '(:21:)', '(:22:)', '(:23:)', '(:24:)', '(:26:)', '(:27:)', '(:28:)', '(:29:)', '(:30:)', '(:31:)', '(:33:)', '(:35:)', '(:36:)', '(:37:)', '(:63:)', '(:64:)', '(:91:)', '(:92:)', '(:93:)', '(:94:)', '(:96:)', '(:97:)' PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT, '(:98:)', '(:99:)', '(:100:)', '(:101:)', '(:102:)', '(:103:)', '(:104:)', '(:105:)', '(:106:)', '(:107:)', '(:108:)', '(:109:)', '(:110:)', '(:111:)', '(:112:)', '(:113:)', '(:114:)', '(:115:)', '(:116:)', '(:117:)', '(:118:)', '(:119:)', '(:120:)', '(:121:)', '(:122:)', '(:123:)', '(:124:)', '(:125:)', '(:126:)', '(:127:)': BEGIN WRITE('?'); READ(CH); ERROR(CHAR_ERROR) END END UNTIL END_SCAN; PUT0(EOM2) END; "####(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE SPLIT (INPUT: UNIV SPLITREAL; VAR OUTPUT: SPLITREAL); BEGIN OUTPUT:= INPUT END; PROCEDURE LARGEST_REAL (VAR MAX: UNIV SPLITREAL); BEGIN MAX(.1.):= 32767; MAX(.2.):= -1; MAX(.3.):= MAX(.2.); MAX(.4.):= MAX(.3.) END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD(' ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "################################################################# # START(VAR OK: BOOLEAN; SOURCE: IDENTI0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTFF; BEGIN WRITE(FF); PRINTED:= 0 END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' FIER; INITIAL: BOOLEAN) # #################################################################" "INSERT PREFIX HERE" CONST INITIAL_BASE = 24; OTHER_BASE = 88; MAXLENGTH = 64; VAR OK: BOOLEAN; SOURCE, INITIAL: ARGTYPE; BASE: INTEGER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN " "MAIN" "####" BEGIN INIT_PASS(INTER_PASS_PTR); INITIALIZE; SCAN; RELEASE(INTER_PASS_PTR@.RESETPOINT); NEXT_PASS(INTER_PASS_PTR) END.  WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT(' START(SYSTEM: IDENTIFIER) (:10:)'); WRITETEXT('OR (:10:)'); WRITETEXT (' START(SYSTEM: IDENTIFIER; INITIAL: BOOLEAN) (:10:)'); OK:= FALSE; END; END; PROCEDURE WRITEDISK(PAGENO: UNIV IOARG; VAR BLOCK: PAGE); CONST MAXTIMES = 3; VAR PARAM: IOPARAM; TIMES: INTEGER; BEGIN WITH PARAM DO BEGIN OPERATION:= OUTPUT; ARG:= PAGENO; TIMES:= 0; REPEAT TIMES:= TIMES + 1; IOTRANSFER(DISKDEVICE, PARAM, BLOCK); P:=FOR_DOWN2 END ELSE ERROR(FOR_ERROR,QTO_TAIL); EXPR(KEYS OR QDO_TAIL); PUT3(FOR_LIM2,L1,DIRECTION,L2); IF SY=DO1 THEN GET ELSE ERROR(FOR_ERROR,KEYS); STAT(KEYS); PUT2(OP,L1,L2) END; PROCEDURE CYCLE_STAT; VAR L:LABEL; BEGIN GET; NEW_LABEL(L); PUT1(DEF_LABEL2,L); STAT_LIST (KEYS); IF SY=END1 THEN GET ELSE ERROR(CYCLE_ERROR,KEYS); PUT1(JUMP2,L) END; PROCEDURE WITH_STAT; VAR WITH_COUNT,I:INTEGER; LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS ORUNTIL (STATUS = COMPLETE) OR (TIMES = MAXTIMES); IF STATUS <> COMPLETE THEN ERROR('DISK ERROR (:10:)'); END; END; PROCEDURE COPY(BASE: INTEGER); VAR PAGENO: INTEGER; BLOCK: PAGE; BEGIN FOR PAGENO:= 1 TO LENGTH(1) DO BEGIN GET(1, PAGENO, BLOCK); WRITEDISK(BASE + PAGENO - 1, BLOCK); END; END; PROCEDURE CALL(BASE: UNIV IOARG); VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= CONTROL; ARG:= BASE; END; IOMOVE(DISKDEVICE, PARAM); END; PROCEDURE INITIE ARG_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN CHECK(ARG_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(ARG_LIST2); GET; DONE:=FALSE; LKEYS1:=KEYS OR QARG_END; REPEAT EXPR(LKEYS1); PUT0(ARG2); CHECK(ARG_ERROR,LKEYS1); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(ARG_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(ARG_ERROR,KEYS) END END; PROCEDURE COMPOUND_STAT; BEGIN GET;ALIZE(VAR BASE: INTEGER); VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN IDENTIFY('START: (:10:)'); OK:= TRUE; SOURCE:= PARAM(.2.); WITH SOURCE DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF NOT FOUND THEN ERROR('SOURCE FILE UNKNOWN(:10:)') ELSE IF ATTR.KIND <> CONCODE THEN ERROR('SOURCE KIND MUST BE CONCODE(:10:)'); IF OK THEN BEGIN OPEN(1, ID, FOUND); IF LENGTH(1) > MAXLENGTH THEN ERROR('SOURCE FILE TOO LONG (:10:)'); END STAT_LIST (KEYS); IF SY=END1 THEN GET ELSE ERROR(COMP_ERROR,KEYS) END; PROCEDURE IF_STAT; VAR L1,L2:LABEL; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QTHEN_END; GET; EXPR(KEYS OR QIF_END); NEW_LABEL(L1); PUT1(FALSEJUMP2,L1); IF SY=THEN1 THEN GET ELSE ERROR(IF_ERROR,LKEYS1); STAT(LKEYS1); CHECK(IF_ERROR,LKEYS1); IF SY=ELSE1 THEN BEGIN NEW_LABEL(L2); PUT2(JUMP_DEF2,L2,L1); GET; STAT(KEYS); PUT1(DEF_LABEL2,L2) END ELSE PUT1(DEF_LABEL2,L1) ; END; INITIAL:= PARAM(.3.); WITH INITIAL DO IF TAG = NILTYPE THEN BASE:= OTHER_BASE ELSE IF TAG <> BOOLTYPE THEN HELP ELSE IF BOOL THEN BASE:= INITIAL_BASE ELSE BASE:= OTHER_BASE; END; PROCEDURE TERMINATE; BEGIN CLOSE(1); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE(BASE); IF OK THEN COPY(BASE); IF OK THEN CALL(BASE); TERMINATE; END; END. END; PROCEDURE CASE_STAT; VAR L0,LI,LN:LABEL; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QCASES; GET; NEW_LABEL(L0); NEW_LABEL(LN); EXPR(KEYS OR QCASE_END); PUT1(CASE_JUMP2,L0); DONE:=FALSE; IF SY=OF1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1); REPEAT NEW_LABEL(LI); PUT1(DEF_CASE2,LI); LABEL_LIST(LKEYS1); IF SY=COLON1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1); STAT(LKEYS1); PUT1(JUMP2,LN); CHECK(CASE_ERROR,LKEYS1); IF SY IN QCASES THEN N GET; LKEYS1:=KEYS OR QINIT_LIST; DONE:=FALSE; REPEAT VARIABLE(LKEYS1); PUT0(INIT_NAME2); ARG_LIST(LKEYS1); PUT0(INIT2); CHECK(INIT_ERROR,LKEYS1); IF SY IN QINIT_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(INIT_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; "##########" "EXPRESSION" "##########" PROCEDURE EXPR; VAR OP:INTEGER; BEGIN SEXPR(KEYS OR QEXPR_OP); CHECK(EXPR_ERROR,KEYS OR QEXPR_OP); IF SY IN QEXPR_OP THEN BEGIN CA ICONST_TYPE:=CONST_TYPE; ICONST_VAL:=CONST_VAL END; REAL_CONST: BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=REAL_DISP END; STRING_CONST:BEGIN CLASS:=SCONST_CLASS; SCONST_LENGTH:=STRING_LENGTH; SCONST_DISP:=STRING_DISP END END ELSE BEGIN CLASS:=UNDEF_CLASS; ERROR(CONSTID_ERROR) END END; PROCEDURE REAL_; BEGIN PUSH; SE SY OF EQ1: OP:=EQ2; NE1: OP:=NE2; LE1: OP:=LE2; GE1: OP:=GE2; LT1: OP:=LT2; GT1: OP:=GT2; IN1: OP:=IN2 END; PUT0(VALUE2); GET; SEXPR(KEYS); PUT0(OP) END END; PROCEDURE SEXPR; VAR UNARY:BOOLEAN; LKEYS1:SETS; OP:INTEGER; BEGIN LKEYS1:=KEYS OR QTERM_LIST; CHECK(EXPR_ERROR,LKEYS1); IF SY IN QUNARY THEN BEGIN UNARY:=TRUE; IF SY=PLUS1 THEN OP:=UPLUS2 ELSE OP:=UMINUS2; GET END ELSE UNARWITH OPS(.T.) DO BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=CONST_DISP END END; PROCEDURE FREAL; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; PUT1(REAL2,CONST_DISP) END; PROCEDURE INDEX(TYP:NOUN_INDEX); BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=ICONST_CLASS; ICONST_TYPE:=TYP; READ_IFL(ICONST_VAL) END END; PROCEDURE FINDEX(TYP:NOUN_INDEX); VAR VALUE:INTEGER; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; READ_IFL(VALUE); PUT2(INDEX2,VALUY:=FALSE; TERM(LKEYS1); IF UNARY THEN PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QTERM_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QSEXPR_OP THEN BEGIN CASE SY OF PLUS1: OP:=PLUS2; MINUS1: OP:=MINUS2; OR1: OP:=OR2 END; GET END ELSE BEGIN ERROR(EXPR_ERROR,LKEYS1); OP:=PLUS2 END; TERM(LKEYS1); PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); UNTIL NOT(SY IN QTERM_LIST) E,TYP) END; PROCEDURE STRING; BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=SCONST_CLASS; READ_IFL(SCONST_LENGTH); SCONST_DISP:=CONST_DISP END END; PROCEDURE FSTRING; VAR LENGTH:INTEGER; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; READ_IFL(LENGTH); PUT2(STRING2,LENGTH,CONST_DISP) END; "#########" "MAIN LOOP" "#########" BEGIN INITIALIZE; REPEAT READ_IFL(SY); CASE SY OF ADDRESS1: PUT0(ADDRESS2); ANAME1: ANAME; AND1: BINARY(AND2); ARG_LIST1: ARG_LIS END END; PROCEDURE TERM; VAR OP:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QFACTOR_LIST; FACTOR(LKEYS1); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QFACTOR_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QTERM_OP THEN BEGIN CASE SY OF STAR1: OP:=STAR2; SLASH1: OP:=SLASH2; DIV1: OP:=DIV2; MOD1: OP:=MOD2; AND1: OP:=AND2 END; GET END ELSE BEGIN ERROR(EXPR_ERROR,LKEYT; ARG1: ARG; ARRAY_DEF1: ARRAY_DEF; BODY_END1: PUT0(BODY_END2); BODY1: BODY; CALL_FUNC1: CALL(CALL_FUNC2); CALL_NAME1: CALL_NAME; CALL1: CALL(CALL_PROC2); CASE_JUMP1: IGNORE1(CASE_JUMP2); CASE1: CASE_; CHAR1: INDEX(XCHAR); CLASS1: COMP_DEF(CLASS2); COMP1: COMP; CONST_DEF1: CONST_DEF; CONST_ID1: CONST_ID; CONSTANT1: CONSTANT; CPARMLIST1: PARMLIST(CPARMLIST2); DEF_CASE1: DEF_CASE; DEF_LABEL1: IGNORE1(DEF_LABEL2); DIV1: BINARY(DIV2); EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END; END_CASE1S1); OP:=STAR2 END; FACTOR(LKEYS1); PUT0(OP); CHECK(EXPR_ERROR,LKEYS1) UNTIL NOT(SY IN QFACTOR_LIST) END END; PROCEDURE FACTOR; VAR LKEYS1:SETS; BEGIN CHECK(EXPR_ERROR,KEYS OR QFACTOR); IF SY IN QFACTOR THEN CASE SY OF REAL1: BEGIN PUT0(FREAL2); GET END; STRING1: BEGIN PUT1(FSTRING2,ARG); GET END; INTEGER1: BEGIN PUT1(FINTEGER2,ARG); GET END; CHAR1: BEGIN PUT1(FCHAR2,ARG); GET END; ID1: FACTOR_UNDEF; WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN WITH ROUT@ DO IF ROUT_TYPE = PROC_TYPE THEN FUNCTION_ERROR(PROC_USE_ERROR) ELSE TYP:= ROUT_TYPE ELSE FUNCTION_ERROR(NAME_ERROR); PUT1(FUNCTION2, TYP) END; PROCEDURE BINARY(OP:INTEGER); BEGIN PUT0(OP); T:=T-1 END; PROCEDURE POP2(OP:INTEGER); BEGIN PUT0(OP); T:=T-2 END; "########" "VARIABLE" "########" PROCEDURE PUSH_OPERAND(OP_ENTRY:ENTRY_PTR; COMP,RESULT:BOOLEANID(KEYS); OPEN1: BEGIN GET; EXPR(KEYS OR QCLOSE); IF SY=CLOSE1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END; NOT1: BEGIN GET; FACTOR(KEYS); PUT0(NOT2) END; SUB1: BEGIN GET; PUT0(EMPTY_SET2); LKEYS1:=KEYS OR QSET_EXPR; CHECK(EXPR_ERROR,LKEYS1); WHILE SY IN QARGUMENT DO BEGIN EXPR(LKEYS1); PUT0(INCLUDE2); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QARGUMENT THEN I); VAR OP:INTEGER; BEGIN IF NOT COMP THEN PUSH; WITH OPS(.T.) , OP_ENTRY@ DO CASE KIND OF INDEX_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(INDEX2,CONST_VAL,CONST_TYPE) END; REAL_CONST: BEGIN CLASS:=FCONST_CLASS; PUT1(REAL2,REAL_DISP) END; STRING_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(STRING2,STRING_LENGTH,STRING_DISP) END; VARIABLE,FIELD,PARAMETER: BEGIN CLASS:=VAR_CLASF SY=COMMA1 THEN GET ELSE ERROR(EXPR_ERROR,LKEYS1); CHECK(EXPR_ERROR,LKEYS1) END; IF SY=BUS1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END END ELSE PUT1(NAME2,XUNDEF) END; PROCEDURE FACTOR_ID; BEGIN VARIABLE(KEYS OR QOPEN); CHECK(EXPR_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(FUNCTION2); ARG_LIST(KEYS); PUT0(CALL_FUNC2) END ELSE PUT0(FNAME2) END; "########" "VARIABLE" "########" PROCEDURE VARIABLE; VAR LKEYS; CASE KIND OF VARIABLE:VTYPE:=VAR_TYPE; FIELD: VTYPE:=FIELD_TYPE; PARAMETER: VTYPE:=PARM_TYPE END; IF COMP THEN OP:=VCOMP2 ELSE OP:=VAR2; PUT2(OP,NOUN,VTYPE@.NOUN) END; ROUTINE_KIND: BEGIN IF RESULT THEN BEGIN CLASS:=FUNCVALUE_CLASS; FUNC_TYPE:=OP_ENTRY@.ROUT_TYPE END ELSE BEGIN CLASS:=ROUTINE_CLASS; ROUT:=OP_ENTRY; PARM:=ROUT_PARM S1,LKEYS2:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QSELECT; IDENTIFIER(LKEYS1,NAME2,VARIABLE_ERROR); CHECK(VARIABLE_ERROR,LKEYS1); WHILE SY IN QSELECT DO BEGIN IF SY=PERIOD1 THEN BEGIN GET; IDENTIFIER(LKEYS1,COMP2,VARIABLE_ERROR) END ELSE BEGIN "SY=SUB1" PUT0(ADDRESS2); GET; LKEYS2:=LKEYS1 OR QSUB_END; DONE:=FALSE; REPEAT EXPR(LKEYS2); PUT0(SUB2); CHECK(VARIABLE_ERROR,LKEYS2); IF SY IN QARGUMENT THEN END; IF COMP THEN OP:=RCOMP2 ELSE OP:=ROUTINE2; PUT1(OP,NOUN) END; PROGRAM_KIND: BEGIN CLASS:=PROGRAM_CLASS; PROG:=OP_ENTRY; PPARM:=PROG_PARM; PUT1(ROUTINE2,NOUN) END; SCALAR_KIND,SYSCOMP_KIND,POINTER_KIND,ARRAY_KIND,RECORD_KIND, SET_KIND, UNDEF_KIND: BEGIN ERROR(NAME_ERROR); CLASS:=UNDEF_CLASS; IF NOT COMP THEN PUT0(UNDEF2) END END END; PROCEDURE NAME; IF SY=COMMA1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS2) ELSE DONE:=TRUE UNTIL DONE; IF SY=BUS1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS1) END; CHECK(VARIABLE_ERROR,LKEYS1) END END; PROCEDURE CONSTANT; BEGIN CHECK(CONSTANT_ERROR,KEYS OR QCONSTANT); IF SY IN QCONSTANT THEN BEGIN CASE SY OF ID1: PUT1(CONSTANT2,ARG); INTEGER1: PUT1(INTEGER2,ARG); REAL1: PUT0(REAL2); CHAR1: PUT1(CHAR2,ARG); STRING1: PUT1(S VAR SPIX:SPELLING_INDEX; COMP,ERR,RESULT:BOOLEAN; NAME_ENTRY:ENTRY_PTR; BEGIN READ_IFL(SPIX); ERR:=FALSE; COMP:=FALSE; RESULT:=FALSE; WITH SPELLING_TABLE(.SPIX.) DO IF ACCESS IN OP_ACCESS THEN BEGIN NAME_ENTRY:=ENTRY; CASE ACCESS OF GENERAL: ; FUNCTIONAL: RESULT:=TRUE; INTERNAL: IF LEVEL 0 THEN ERROR(UNRES_ERROR); PUT0(EOM2); WITH INTER_PASS_PTR@ DO BEGIN RELEASE(RESETPOINT);o q s v x z | ~ p r t  $&      ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoq); FOR_UP1: IGNORE2(FOR_UP2); FREAL1: FREAL; FSTRING1: FSTRING; FUNC_DEF1: FUNC_DEF(FUNC_DEF2); FUNC_END1, PROC_END1: ROUT_END(INTERNAL); FUNCE_DEF1: FUNC_DEF(FUNCE_DEF2); FUNC_ID1: PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,FUNCTIONAL); FUNCE_END1, PROCE_END1: ROUT_END(EXTERNAL); FUNCE_ID1: PUSH_NEW_NAME(POSSIBLY_FORWARD,RETAIN,FUNCTIONAL); FUNCTION1: FUNCTION_; GE1: BINARY(GE2); GT1: BINARY(GT2); INCLUDE1: BINARY(INCLUDE2); INIT_NAME1: INIT_NAME; INITS_DEF1: INITS_DEF; INITS_END1: POP_LEVEL CONSTANTS:=CONST_DISP END; NEXT_PASS(INTER_PASS_PTR) END. RY_PTR; ; INIT1: CALL(INIT2); INTEGER1: INDEX(XINTEGER); INTF_ID1: INTF_ID; INTF1: BEGIN POP_LEVEL; OLD_NAMES:= NAME_LIST; NAME_LIST:= NIL END; IN1: BINARY(IN2); JUMP_DEF1: IGNORE2(JUMP_DEF2); JUMP1: IGNORE1(JUMP2); LCONST1: LCONST; LE1: BINARY(LE2); LT1: BINARY(LT2); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: BINARY(MINUS2); MOD1: BINARY(MOD2); MONITOR1: COMP_DEF(MONITOR2); NAME1: NAME; NEW_LINE1: IGNORE1(NEW_LINE2); NE1: BINARY(NE2); NOT1: PUT0(NOT2); OR1: BINARY(OR2); PARM_TYPE1: TYPE_(OUTPUT,PARM_ END; .IF EQ $.DBLT ; INC MTC ; REWIND(TAPE0, ERROR); 2$: TSTB MTC ; BGE 2$ ; TST MTC ; IF ERROR THEN BGE 3$ ; CLR HEAD99+OPLIN1 ; MOV #10$,RESU19 ; KERNELERROR( JSR PC,KERN19 ; 'TAPE REWIND ERROR(:0:)'); 10$: .ASCIZ /TAPE REWIND ERROR/ ; .EVEN ; TYPE2); PEND1: PUT0(PEND2); PLUS1: BINARY(PLUS2); PROC_DEF1: PROC_DEF(PROC_DEF2); PROC_ID1,PROG_ID1: PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,RETAIN,INCOMPLETE); PROCE_DEF1: PROC_DEF(PROCE_DEF2); PROCE_ID1: PUSH_NEW_NAME(POSSIBLY_FORWARD,RETAIN,INCOMPLETE); PROCESS1: COMP_DEF(PROCESS2); PROG_DEF1: PROG_DEF; PSTART1: PSTART; REAL1: REAL_; REC_DEF1: REC_DEF; REC1: REC; SET_DEF1: SET_DEF; SLASH1: BINARY(SLASH2); STACK1: IGNORE1(STACK2); STAR1: BINARY(STAR2); STORE1: POP2(STORE2); STRING1: STRING; (NUMBER) "############# # JOBINPUT # #############" CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; FUNCTION PREFIXLENGTH: INTEGER; PROCEDURE READPREFIX(PAGENO: INTEGER; VAR BLOCK: PAGE); PROCEDURE READLINE(VAR TEXT: LINE); PROCEDURE WRITESTREAM(BLOCK: PAGE); PROGRAM JOBINPUT; CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; TYPE HEADTYPE = ARRAY (.1..2, 1..2, 1..2, 1..10.) OF CHAR; TAILTYPE = ARRAY (.1..5 $`X     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegjlnprtv`bdfh2.) OF CHAR; IMAGE = RECORD HEAD: HEADTYPE; TAIL: TAILTYPE END; VAR BLANK, CARD: LINE; CARDLENGTH: INTEGER; BLOCK: PAGE; BLOCKLENGTH, INITLENGTH: INTEGER; PROCEDURE INITPREFIX; BEGIN READPREFIX(PREFIXLENGTH, BLOCK); INITLENGTH:= 0; WHILE BLOCK(.INITLENGTH + 1.) <> EM DO INITLENGTH:= INITLENGTH + 1; END; PROCEDURE COPYPREFIX; VAR PAGENO: INTEGER; BEGIN FOR PAGENO:= 1 TO PREFIXLENGTH - 1 DO BEGIN READPREFIX(PAGENO, BLOCK); WRITESTREAM(BLOCK); END; READPREFIX(PREFIXLENGTH, BL PREFIXPAGES:= (CHARS + PAGELENGTH - 1) DIV PAGELENGTH; INITLENGTH:= (CHARS - 1) MOD PAGELENGTH; END; PROCEDURE SKIPPREFIX; VAR PAGENO: INTEGER; BEGIN FOR PAGENO:= 1 TO PREFIXPAGES DO READSTREAM(BLOCK); BLOCKLENGTH:= INITLENGTH; END; PROCEDURE INITLINE; VAR CHARNO: INTEGER; BEGIN FOR CHARNO:= 1 TO FIRSTCHAR - 1 DO IMAGE(.CHARNO.):= ' '; IMAGE(.LASTCHAR + 1.):= NL; CONTROLCHAR:= (.CR, NL, FF, EM.); END; PROCEDURE PRINTCHAR(C: CHAR); BEGIN IMAGE(.FIRSTCHAR.):= C; WRITELINE(IMAGOCK); BLOCKLENGTH:= INITLENGTH; END; PROCEDURE INITBLANK; VAR CHARNO: INTEGER; BEGIN FOR CHARNO:= 1 TO LINELENGTH DO BLANK(.CHARNO.):= ' '; END; FUNCTION CARDLIMIT(CARD, BLANK: UNIV IMAGE): INTEGER; VAR I, J, K: INTEGER; BEGIN IF CARD.HEAD(.2.) <> BLANK.HEAD(.2.) THEN I:= 2 ELSE I:= 1; IF CARD.HEAD(.I, 2.) <> BLANK.HEAD(.I, 2.) THEN J:= 2 ELSE J:= 1; IF CARD.HEAD(.I, J, 2.) <> BLANK.HEAD(.I, J, 2.) THEN K:= 2 ELSE IF CARD.HEAD(.I, J, 1.) <> BLANK.HEAD(.I, J, 1.) THEN K:= 1 INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROCEDURE OPEN(FILENO: FILE; IE); END; PROCEDURE PRINTLINE(VAR ENDPAGE, ENDFILE: BOOLEAN); VAR CHARNO: INTEGER; C: CHAR; BEGIN CHARNO:= PRED(FIRSTCHAR); REPEAT IF BLOCKLENGTH = PAGELENGTH THEN BEGIN READSTREAM(BLOCK); BLOCKLENGTH:= 0; END; BLOCKLENGTH:= SUCC(BLOCKLENGTH); C:= BLOCK(.BLOCKLENGTH.); CHARNO:= SUCC(CHARNO); IMAGE(.CHARNO.):= C; UNTIL (C IN CONTROLCHAR) OR (CHARNO = LASTCHAR); IF C = FF THEN BEGIN WRITELINE(IMAGE); ENDPAGE:= TRUE END ELSE IF C = EM THEN BEGIN ENDPELSE K:= 0; CARDLIMIT:= ((PRED(I)*2 + PRED(J))*2 + K)*10; END; PROCEDURE READCARD; BEGIN READLINE(CARD); CARDLENGTH:= CARDLIMIT(CARD, BLANK); IF CARDLENGTH > 0 THEN WHILE CARD(.CARDLENGTH.) = ' ' DO CARDLENGTH:= PRED(CARDLENGTH); IF (CARDLENGTH = 1) & (CARD(.1.) = '#') THEN CARD(.1.):= EM ELSE BEGIN CARDLENGTH:= SUCC(CARDLENGTH); CARD(.CARDLENGTH.):= NL; END; END; PROCEDURE COPYCARDS; VAR BLOCKSPACE, I: INTEGER; BEGIN REPEAT READCARD; BLOCKSPACE:= PAGELENGTH##" TYPE RESOURCE = MONITOR VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q(.NEXT.ARRIVAL.)); END; PROCEDURE ENTRY RELEASE; BEGIN IF NEXT.EMPTY THEN FREE:= TRUE ELSE CONTINUE(Q(.NEXT.DEPARTURE.)); END; BEGIN FREE:= TRUE; INIT NEXT(PROCESSCOUNT) END; "################# # TYPERESOURCE # #################" TYPE TYPERESOURCE = MONITOR VAR FREE: BOOLEAN; Q: PROCESSQUEUE; NEXT: FIFO; HEADER: LINE; PROCEDURE ENTRY REQUE - BLOCKLENGTH; IF BLOCKSPACE < CARDLENGTH THEN BEGIN FOR I:= 1 TO BLOCKSPACE DO BLOCK(.BLOCKLENGTH + I.):= CARD(.I.); WRITESTREAM(BLOCK); BLOCKLENGTH:= CARDLENGTH - BLOCKSPACE; FOR I:= 1 TO BLOCKLENGTH DO BLOCK(.I.):= CARD(.BLOCKSPACE + I.); END ELSE BEGIN FOR I:= 1 TO CARDLENGTH DO BLOCK(.BLOCKLENGTH + I.):= CARD(.I.); BLOCKLENGTH:= BLOCKLENGTH + CARDLENGTH; END UNTIL BLOCK(.BLOCKLENGTH.) = EM; WRITESTREAM(BLOCK); BLOCKLST(TEXT: LINE; VAR CHANGED: BOOLEAN); BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q(.NEXT.ARRIVAL.)); CHANGED:= (HEADER <> TEXT); HEADER:= TEXT; END; PROCEDURE ENTRY RELEASE; BEGIN IF NEXT.EMPTY THEN FREE:= TRUE ELSE CONTINUE(Q(.NEXT.DEPARTURE.)); END; BEGIN FREE:= TRUE; HEADER(.1.):= NL; INIT NEXT(PROCESSCOUNT); END; "############### # TYPEWRITER # ###############" TYPE TYPEWRITER = CLASS(DEVICE: IODEVICE); CONST LINELIMIT = 73; CANCELCHAR = '(:3:)'; "CONTROL C" CANCELLINE =ENGTH:= 0; END; BEGIN INITPREFIX; INITBLANK; REPEAT COPYPREFIX; COPYCARDS; UNTIL FALSE; END. .BLOCKLENGTH + I.):= CARD(.I.); WRITESTREAM(BLOCK); BLOCKLENGTH:= CARDLENGTH - BLOCKSPACE; FOR I:= 1 TO BLOCKLENGTH DO BLOCK(.I.):= CARD(.BLOCKSPACE + I.); END ELSE BEGIN FOR I:= 1 TO CARDLENGTH DO BLOCK(.BLOCKLENGTH + I.):= CARD(.I.); BLOCKLENGTH:= BLOCKLENGTH + CARDLENGTH; END UNTIL BLOCK(.BLOCKLENGTH.) = EM; WRITESTREAM(BLOCK); BLOCKL '(:12:)'; "CONTROL L" PROCEDURE WRITECHAR(X: CHAR); VAR PARAM: IOPARAM; C: CHAR; BEGIN PARAM.OPERATION:= OUTPUT; C:= X; IO(C, PARAM, DEVICE); END; PROCEDURE ENTRY WRITE(TEXT: LINE); VAR PARAM: IOPARAM; I: INTEGER; C: CHAR; BEGIN PARAM.OPERATION:= OUTPUT; I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); IO(C, PARAM, DEVICE); UNTIL (C = NL) OR (I = LINELIMIT); IF C <> NL THEN WRITECHAR(NL); END; PROCEDURE ENTRY READ(VAR TEXT: LINE); CONST BEL = '(:7:)'; VAR PARAM: IOPARAM; I: INTEGED: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(FILENO: FILE); PROCEDURE GET(FILENO: FILE; PAGENO: INTEGER; VAR BLOCK: PAGE); PROCEDURE PUT(FILENO: INTEGER; PAGENO: INTEGER; BLOCK: PAGE); FUNCTION LENGTH(FILENO: FILE): INTEGER; PROCEDURE RUNPASS(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINENO: INTEGER; VAR RESULT: PROGRESULT); PROCEDURE RUNJOB(VAR LINENO: INTEGER; VAR RESULT: PROGRESULT); PROGRAM JOBSERVICE; CONST TEMP1 = 'TEMP1 '; TEMP2 = 'TEMP2 '; PASS1 = 'SPASS1 '; PASS2 = 'SAGE:= TRUE; ENDFILE:= TRUE END ELSE WRITELINE(IMAGE); END; PROCEDURE PRINTPAGE(VAR ENDFILE: BOOLEAN); VAR LINENO: INTEGER; ENDPAGE: BOOLEAN; BEGIN ENDPAGE:= FALSE; FOR LINENO:= 1 TO FIRSTLINE - 1 DO PRINTCHAR(NL); LINENO:= FIRSTLINE - 1; REPEAT LINENO:= SUCC(LINENO); PRINTLINE(ENDPAGE, ENDFILE); UNTIL (LINENO = LASTLINE) OR ENDPAGE; PRINTCHAR(FF); END; PROCEDURE PRINTFILE; VAR PAGENO: INTEGER; ENDFILE: BOOLEAN; BEGIN ENDFILE:= FALSE; REPEAT PRINTPAGE(ENDFILE) UNTILPASS2 '; PASS3 = 'SPASS3 '; PASS4 = 'SPASS4 '; PASS5 = 'SPASS5 '; PASS6 = 'SPASS6 '; PASS7 = 'SPASS7 '; JOB = 'JOB '; NL = '(:10:)'; EM = '(:25:)'; VAR OK: BOOLEAN; LIST: ARGLIST; PROCEDURE WRITEID(ID: IDENTIFIER); VAR CHARNO: INTEGER; BEGIN FOR CHARNO:= 1 TO IDLENGTH DO IF ID(.CHARNO.) <> ' ' THEN WRITE(ID(.CHARNO.)); END; PROCEDURE WRITERESULT(RESULT: PROGRESULT); BEGIN CASE RESULT OF TERMINATED: WRITETEXT('TERMINATED #'); OVERFLOW: ENDFILE; END; BEGIN INITPREFIX; INITLINE; REPEAT SKIPPREFIX; PRINTFILE; UNTIL FALSE; END.            " &     # ' . 2 6 : > * / 3 7 ; ? + J N R V B F K O S W C G f j n Z ^ b g k o [ _ c r v z ~ u y }         ,   $ ( -   ! % ) 0 4 8 < @ D 1 5 9 = A E L P T X \ H M Q U Y ] I h l p t ` d i m q u a e x  & (  *  %&$&&&&#&  & &  &   & &$&&&#  $&&&#"  $&&&#AM 4 kNM ; kNK @LM N E|NM R  G.BE  GANM _    '0 %+Bl-B EZAWNM k ENK m[LM )Bd )0    %,B *E .A +   #E /A (HG2   )B ,E .A -  ) *B$ /   EN /AR .HG3 Ef 1:Et 0E| 1:E 0E 1,;,;,B 0E .B 1 $e$e$eHG4(E 0E 2,E 0(&&&&&&&&& & & & & &&&&&&&&&&&&&&&&&&& &!&"&#&$&%&&&'&(&)&*&+&,&-&.&/&0&1&2&3&4#&5  &6,&7$&8&9&:&;#&< &=,&>$&?&@#$&A&B&C&D&E&F&G&H&I&J&K&L&M&N#" $&&&# $&&#"$&&&&&&&&(pC& (aF& ((H& (H& & &&&&&&&# $&&&#  $&&&#!&(@< &4&4 &$&& #( {kNK }LM  'NM  ' NM  +NM  +NK LQ BA @E$  iRQ  @EJBN A\  @Ep  jRO   [ PQ g  iRQ  E( 3)E6 0B> 2 @E^ Bb 3@Ev  E (A 4E WWWHG5(E 0E 2,E 0E 3)E 0B 5 @EB6@E( E8)A<7EHWWWHG6 (En0Ev2)E0B8 @EB9@E E*A:EWW"$&O&P&Q&R#&S H &T&U&V"&W &XH &Y&Z$&[&\&]&^&_# &`  &a&b &c 0  &d  &e&f D $&!&"&#&$&%&&&'&(&)&*&+&,&-&.&/&0&1##&2&3&4 "&5 "*%&6  &7 "*%&8 ""&9%%&:$&;&<&=&>#$&? jRO PG /B   YA6 WHG  *Bh   ;BAA  HQ   RQ @ E   ;RQ @ E"RQ  g  RO EZPQ  RQ  RQ! <43BWHG7(E0E 3)E0B";E0 HG8% WkHS. [~ [  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(_( 0(1(2(3(4(5(6(7(8(9(  E EEE/E2&g"+%&h$&i&j&k# "$&l&m#-$&n&o&p&q&r&s&t&u&v&w&x&y&z&{# ,$&|&}#  $&~&&&&&&&&&&&&&# & & & $ &@$ &A &B &C&D&E":"&F":"&G" "&H%&I$&J&K#"&L-"&M&N"&O"&P"#&Q4!RO DPG# 1 @ E #/B4 EFYAPW /Bp   EYAW EEWWHG$> $&` e$$!&`e$!` EP:EbEn:EE EWHS.;B=E4A>:;B?E5A@F;BAE 6ABR;B CE$7A(D^;B8EE<8A@FED. EVE^Ab<WWWTST \ \N x\D \N xj EB  N xD ]""v E@  N xD ]"<" ER>  N xD ]""W  &$&&&#& & & &$&&&# $&&&# $&&#    $&&&&&&&&&&&&&&&&&&&#&& "  ,&$&&&""$&R"&S&T$&U&V&W&X&Y&Z&[&\&]&^&_&`&a&b&c&d&e&f&g&h&i#&&j  &kL  *%&l$&m&n&o&p#'&q  &r&s,(L&t (T &u$&v&w&x#( &yK [EEEE#@EE$EATG&i /BL  YA>WHG'p !b,3BvL0AT3HQ(xL    WRQ)~L    RQ* L  RQ+  /BN L  Bh @  E 'B \%D  ],, N xD  ]<--Tq;B CE$7A(D^;B8EE<8A@FED. EVE^Ab<WWWTST \ \N x\D \N xj EB  N xD ]""v E@  N xD ]"<" ER>  N xD ]""W  #&" &   " , &$&&#  - $&&&&&&&&&&&&&&&&&# ,$&&&# ,$&&#$&&&&&&&&&&&&&&&&&&&#&   L  &z  %&{$&|&}&~#) L    $&&&#*L  $&&&&#+ &  &L &&"'&& "&  &4 E     43B   4!WYA WRO% E &PSoE" !@E2 E6 +A: WWTG.BV !  Ep \E| hE E E E E WHG/B " E  .B #HG0  +B $E /A %E .HG1   )BF &EJ .AN '/  #/  %65/0 42/ <66//  / 67/0 42/d /3 <68/0 42/ </0 42/  <696:6;6<6=6>$6?/. " & ") 76( TASK UNKNOWN "7%%%5& $&&&&#6 &("0"2&)"0&8&&"9" &"*:9( TASK UNKNOWN ":%%%8&$&&&&#7&("0"3&)"0&x4WZMNePoT vU FLOW &pdR&qT#W[MPMV&VM]&]Me&eMx&x4W\MNePoT U LOG &pdR&qT#W]MPMV&VM]&]Me&eMx&x4W^3W_MPM]&]4MPMx&xM&4W`MPMV&VMe&eMx&xM&4WaXMNePoT jU SCAN &pdR&qT#WYMPMV&VM]&]Me&eMx&01 /01 /01 "6/01 /4  6/01 /01 /4 # 6  666%.&66666666666,6/ x/ 6 . / 0 x2!/ 0 26/ 16//$ . ,/ -%/ . ,/ -%". ,/ -" 16666646.0/ ( <.2/d d 6.0/ , <.3/ 6.0/ ) <&4 &%*%&$&&#%"&$&&&&&&&&&&&#,&& ,"!""+ %%&$&&&&&&&&&&&&&&&&&&#.&!&&& "&( TRY AGAIN \"&( START(T;" ;& $&!&"&#&$&%#8&&&'&( &) &*%&+,&,$&-&.#-&/-- &0ABCDEFGHIJ&1KLMNOPQRST&2UVWXYZ_ &30123456789 ,//$ & -6@//. ,/ -/$ %#6A/. ,// & -6B/. ,/. ,/ -/ %# -6C/ 46D6E/0 42 //+ / 0 x2,- 6666666666666666666.6/ !6/ 466/0 42/ <6/0 42/\  4 TRY AGAIN *H6/0 42/h  4 START(TASK, HOUR:MIN:SEC) *H6/0 42ASK, HOUR:MIN:SEC) h"&(" PERIOD(TASK, HOUR:MIN:SEC) "&( STOP(TASK) "&( TIME(HOUR:MIN:SEC) "&( SOLO "& &%!&$&&&#/&"&#"  #"&$&&&#0&$"/%$".%&$&&&&&#1&&4&5&6<" &7"&8 &9(TYPE COMMAND "&:"/&;"2&<( START . ="4>=&=( PERIOD : ?"5@?&>( STOP F A"6BA&?( TIME R C"7DC&@( SOLO ^ E"8FE&A".FDB@>&B0 42/ : <6F/0 42 //0 42/ : <6G/0 42 //0 42/ <6H6I6J6K"6L/ 42/ ex2/d d 6M6N / ]26O/ V / ""4" PERIOD(TASK, HOUR:MIN:SEC) *H6/0 42/ 4 STOP(TASK) *H6/0 42/ 4 TIME(HOUR:MIN:SEC) *H6/0 42/  4 SOLO *H6// 6 !6666/6/ "6 #/ 42 / / & &".'&&()&&0 && *".+*&  +&"/&()'&$&&&&#2&(  & ,".-,&& &. "&C"&D<%%%&E$&F&G&H&I&J&K&L&M&N&O&P&Q&R&S&T#&U - -Nx-xD-&VNx&W&X( SCAN j "&YB NxD-"&Z( FLOW v "&[@ NxD-"&\( LOG 26P.#/d d 6Q.$/ x2,-6R/ V 26S6T6U6V6W6X6Y6Z6[6\6]6^6_6`6a6b6c6d6e6f6g6h6i&6j//  / 6k/L/3 1 / 6l6m6n6o6p'6q// /#6/  # "666606// $./ %$.. %66666616// 6//: &.. '&6 (///) )66/. ,/ <-. ,/ 0  <-#6//   /&&   &"/&./&-&$&&&&&#3&"1:"0&"1:"0&"1&;;0".0&1&$ 1&$&&&&#4&("0" "&]> NxD-"&^%&_-%D-,&` NxD--<&a$0~x&W&X( SCAN j "&YB NxD-"&Z( FLOW v "&[@ NxD-"&\( LOG r. @, /8 9/, 6s .'//L 46t .'//T 4 6u6v6w6x( 6y/L/ 3 6z/01 /  /01 /6{6|6}6~) /L/ 3 1 /#/ 6' *.. +*6// /%/" +6./6 () '6666626/d /  4 6//: ,.. -,66// 6 .///$// ) /66///  2&,"0"3&)"0&2&&"3" &"( 43( TASK UNKNOWN "4%%%2&$&&&&#5&("0"2&,"0"3&)"0& 5& & "6Md5T ^U SOLO 7'EL#)FEWAL#(F(D(B(@(>WBMN4P7R &8#WCMNVP\#WD+<333WEWFWGWHWIWJWKWLWMWN V ]WO e xWP WQ WR  WSWTWUMVPW4M]P^4MePf4MxPy4WV1Me2WWWXMNePoT jU SCAN &pdR&qT#WYMPMV&VM]&]Me&eMx& /666*/L/3 1 / 6666+ 6//  / 6/L/3 6/01  6.',/ /01 - 66/ ]2/< 6/"/d /3 /6./6 ./6 -66666636.1/ .0/ : <6.1/ .0/ : <6.1/ 6//  // ; $// ; $ 0.. 0\"^$&&&&&#_&-b-&Z-@R -@&Z"BR"D& TlU& -(*TU%&R--R&r &l l( CONSOLE 6"B^&( IO ftrp"y&( IOPROCESS: r( TERMINATED ~"&$&&#`"z$&&&&&&&&&&&&&&#{&-&n &&_`&tn,&na&c&l b&d&l ,b&e&&(CARDS: (ERROR "&l &/  #6)/0%1 /  6*6+. /%  /%  /  "  6,6-6.-6// 42/ F2 60/*/ A +/ B +/ C +/ D +/ E +/ F +/ G +/ H +/ I +/ J +61/ K +/ L +/ M +/ N  6a~ LOG d /  < 6]/> 2"/ V  V"/ ] ]/N ex ez/D x x 6^6_/ 2%/ ] ]/ 2,/D x x /  6`/ 2-</ V  V"/N ex ez/D x x / %&( DO Brpn"^& ( JOBPROCESS: N( TERMINATED Z"& $& & #E>"_$& &&&&&&&&&&&&&&&&&&& &!&"&#&$&%&&&'&(&)&*&+&,&-&.&/&0#y&1&2&3 &4"0&5"2V&6&7"4&8.w.v.u.t.s.&ba cdedb&l`&t"<&_&$&&&&&&&&&&&&&&&#|&-& &&fn";&n,&g&&( PRINTER: (INSPECT "&h&,&n,&h&g&f&$&&&&&&&&&&&&+/ O +/ P +/ Q +/ R +/ S +/ T +62/ U +/ V +/ W +/ X +/ Y +/ Z +/ _ +63/*/ 0 +/ 1 +/ 2 +/ 3 +/ 4 +/ 5 +/ 6 +/ 7 +/ 8 +/ 9 +64/ V / 4/ F6566 </0 F2 67/6I6J6KA6L//   C6M6N/ @2>/- -/ 6O// 6P C6Q///  "6R//-/36S//   D6T6U E/: F/ @2>/- -/  EF6V// && &".&"2I&&"4&.\.[.Z.Y.X.W.V.U.T.S.R.Q.P.O.N.M.L.K.J.I.H.G.F/%.&"5&JI&K& LK LJ&"3M&"6".M&%%&$&&&r.q.p.o.n.m.l.k.j.i.h.g.f.e.d.c.b.a/%.&9"5&:WV&;X&< YX YW&="3Z&>"6"0Z&?%%&@$&A&B&C#aZ"A$&D&E&F#bZ"C$&G&H&I&J#c:")$&6/ 26/ ex/ / 46/ 0 ex2,/d d - 3/ 0 2( / 0 ex2,/d d - < /6 43/0 42/ 4 TASK UNKNOWN *H 4 26666656.0/ ( <.2 0 V 268//  69/0 42/ 4TYPE COMMAND *H6:./6;.2/d d 6</d /.  4 START  =.4 >=6=/d /:  4 PERIOD  ?.5 @?6>/d /F  4 STOP  A.6  BA6?/d /R  4 TIME  C.7#FZ"A$&&&#GR"C$&&&&#H ")$&&&#I "*$&&&#J "+$&&&#K ",$&&&#L  $&&&#MK&L&M#d:"*$&N&O&P#e:"+$&Q&R&S#f:",$&T&U&V#g: $&W&X&Y#h $&Z&[&\#i,$&]&^&_#jb"$&`&a&b#kb"$&c&d&e#lb"$&f&g&h#m/d d 6.0/ , <.3/ 6.0/ ) <6 / 56 / ex/ / 46 / 0 ex2,/d d - 6/ 0 2) / 0 ex2,/d d - < /6  76/ DC6@/d /^  4 SOLO  E.8 FE6A.. F D B @ >6B/0 42/ <6C/ 0 V 26D<6E6F6G6H6I6J6K6L6M6N6O6P6Q6R6S6T6U/ V 2 / ]2/N ex2x/D x26V/N ex6W6X/0 ex2/ $&&&#N,$&&&#Ob"$&&&#Pb"$&&&#Qb"$&&&#R">$&&&#S "?$&&&#T$&&&#U$&&&#V&N&"8ON"8 ">$&i&j&k#n "?$&l&m&n#o ";$&o&p&q#p "<$&r&s&t#q"8$&u&v&w#r"9$&x&y&z&{#s"'$&|&}&~&#t&[&&"&,&" &0 42/ 4 TASK UNKNOWN *H 7 56 66666 6.0/ ( <.2/d d 6.0/ ) <6/ 86/ ex/ / 46/ 0 ex2,/d d - 9/ 0 2*/ 0 ex2,/d j  4 SCAN d /  < 6Y/B 2"/ V  V"/ ] ]/N ex ez/D x x 6Z/0 ex2/v  4 FLOW d /  < 6[/@ 2"/ V  V"/ ] ]/N ex ez/D x x 6\/0 ex2O&$&&&#W&P &"9QP"9Q&$&&&&#X"'$&&&&#Y&R&&"&,&" &SR&,S&$&&&#Z,$&&&#[ $&&&&&#\[&,\&$&&&#u,$&&&#v $&&&&&#w"y$&&&&&#z&-b-&Z -@&:-(&-/&]Z&"D^]Zd -< 6 :9/0 42/ 4 TASK UNKNOWN *H : 86666676.0/ ( <.3/ 6.0/ ) <6/ ;/ x2 / ;6 6!6"6#6$6%86&/%6'6(/0%1 #/  4 LOG d /  < 6]/> 2"/ V  V"/ ] ]/N ex ez/D x x 6^6_/ 2%/ ] ]/ 2,/D x x /  6`/ 2-</ V  V"/N ex ez/D x x / \ZWYM LJR&K"WZW[\ZW\LM&#W]W^+\ZW_MiP{M+&|+#W`Wa\ZWbMiPuM&v#WcWd\ZWeMiPxM&y#WfWg-\ZWhM@PGM-&H-M&I#WiWj-\ZWkM@PJM-&K-M&L#WlWm+\ZWnM6P<M$"W3WWWWL1R&2$#WWLM0&&M0&&R"&#WWM.:P?#WLM0&&M0&&R"&#WM.:P@#WWWWWWWWWW 4 AW W 5 :6 W W 78 @WW9: 6WW;<=> ,WW?@A WWB C &WWDE F YWWWG -WWWWM4APB4M5:P; LK//  L J6/ 0 H23,- M6/ 0 H26/  /0 R2./  /  M66666F/Z M2A/ 666G/R M2C/<6666H/k@/3 ]2/ A A/b i2/ ] ]6/Z M2@/ @ @ /R M2@/  @ @ 6/Z M2B/R M2D6//  /  TlU6/k@/3  2(/ A A/ : :/  &TU6/+&=+#WoWp +\ZWqM6P>M +&?+#WrWs + &\ZWtM,P2M &&3&#WuWv + &\ZWwM,P4M &&5&#WxWyWz\ZW{MPM&M&M&#W|W}W~"&-\ZWWM"5R"7'[WWM:P?#WLM-&M&&M"&#WM:P@#W4WM6PM4A&AM5:&:R&4W M7@PA4M8@PA4W!M96P74M:6P74W"M;,P-4M<,P-4M=,P-4M>,P-4W#M?P4M@P4MAP4W$MBP!M4A&AM96& 64W%MC&P)M4A&'AM:6&(64W&MDPM4A&AM5:&:M6&M96&6W'M7@&@M;,&,M<,&,M?&R$&$4W(MEPM4A&AM5:&:M6&M:6&6W)M8@&@M=,&,M>,&,  2)/  / 666I/k@/3  2*666J/k@/3  2+//- -666K/k@/3  2,//- -666L.L R2-R/ A A/ : :/  &6/r*/  3 &6/l0&1 %/  %/l0&1  /6  4 CONSOLE 6.^/B  4 DO  /r* */p /n 6 / ]2/N  4 JOBPROCESS: +/)\[WLM-&M&&M"&#(\WWW"&\ZWLM&&M&&M"&#WW*$WL!$M$"WWW*W\ZWLM&M*&*M&M&#WWWW *  WWM]P_MA&^A4MiPkM]&j]4WMMPOM@&N@4WMPMA&AM:&M@&R$&$4W*MFYPdM4A&ZAM5:&[:M6&\M7@&]@M8@&^@W+M;,&_,M<,&`,M=,&a,M>,&b,W,MA&c4W-MG-P/M5:&.:4W.MBP!M4A&AM96& 64W%MC&P)M4A&'AM:6&(64W&MDPM4A&AM5:&:M6&M96&6W'M7@&@M;,&,M<,&,M?&R$&$4W(MEPM4A&AM5:&:M6&M:6&6W)M8@&@M=,&,M>,&,/k@/3  1666M/. ,/    -666N. $/ 666O/b i2/++666P/b i2/ 666Q/b i2/<666R/Z  4 TERMINATED +6 6 6 E>._6 6666666666666666666 6!6"6#6$6%6&6'6(6)6*6+6,6-6.6/60y61/ / H6263// 64/0 20/  / 65// / 0 H22,-) V6667/&&#~&&& & &%&$&&#}&"~&&,&&"&,&" &$&&&&&&&&& & & & & &&&&&&&&&&&&&&&#&&`- D-&`D-%& -= -=&!:M&4WMPMA&AM:&:M&4WM$5R$7']MMPXW#)^]MMPU#(^WLT fU IO &M*&*M&M&#WM]PeT rU IOPROCESS: &f+T ~U TERMINATED &g+#WWWL#WWWWWWWWWWA 6\!WW" ]# +W$ &% WWM"]P_MA&^A4WM$&O'# R#"WW 6W D6X6Y6Z6[B//  6\6]6^C6_///  "6`/-/3/6a//  //  $ G6b6c/ @2?/--/ <// 6d//   H/ @2?/ @2>/- -/ 666S/  @2?/--/<666T666U666V6/+/ + N/ ,28/& &6 ON/ ,28/& & O6666W6/+/ + P~-:-:&"-7-7-7-7&#PH-1HH-1HH-1H&$`~-{&%`-|&&`D~&'PH-`&(`D&) H-`&(_(`WLM#+&M$&&R"&#WM$&O(%]aW(cY%WM% R"+bW(dY%Y%WM% R"L#+bW(eY%WWM"]PeTUCARDS: &f+TUERROR &g+#WM% R"WW+b,acdedbWM%'`WM 6P>M#+&?+#W+_WWWWWWWWWWW'A(6\&)WW* ]+ &W, +WWWM*]P_M'A&^A4WM--/  < H6e G6f6g6h6iD// 6j6k@6l6m6n6o6p6q6r6s6t6u6v6w6x6y6z6{6|6}6~66666666666666666666^6/ R/ H66// 6/0 R2./  / 6//  ,29/&&6 QP/ ,29/&& Q66666X/ 2'&/  / / 6666Y6/"/  " R66/ :26. /-  /&  /"  6/ :2 *`D &+&,H-E \&-D-}&.$0P -1H&$`~-{&%`-|&&`D~&'PH-`&(`D&) H-`&+&O'# R#"WW(fM(6P<M,+&=+#WLM,+&M+&&R"&#WM+&O(%5R%:'gWWM*]PeT U PRINTER: &f+TUINSPECT &g+#W(hWL#WLM,+&M+&&R"&#WM+&O(%5R%7'hW(gW+fWWWWWWWWW.:\-/WWW0 &WW2$\1WW1M0&23WWM3N&O'# R#"WM3N&O)$ M2/ / 0 H22,-) I66/ 0 H24/  6.]\[ZYXWVUTSRQPONMLKJIHGF/* */0 R1PP.6/ 0 H25/ / 6 JI6//   K//  66 SR6. /-  /&  /"   S6666Z. /&  /&  /"  666[.[$/  $66666\.^/  /* */ / 66666_6/" &G&H &I&J%$&K&L&M&N&O&P&Q&R#Y&S&T&U&V&W" &X&Y  &ZJ"&[" &\K&]"&^% &_" %$&`&a&b#Z& &&"^$&&&&&&#`!&" &&&&   &&   %&&"1 %&& 2*6N6O6Pe/: 2+//- -6Q6R6Sf/: 2,//- -6T6U6Vg.g/: 16W6X6Yh/. ,/    -6Z6[6\i. $/ 6]6^6_j/ ]2/ A A6/n&1 #/ #66 _ `6. /t+  /n&  /  "  6/n&1 % a6 c7%6/l/  b6 d7%7%6/l/ . b6 e7%66/ ]2/ 4CARDS: +/ 4ERROR c" &d&e $&f&g&h&i#[&j &k&l&m&n&o&p"Z&q %"Z%&rJ&s"$&t&u&v#\&w"&x&y $&z&{&|#]&}"&~" &"^$&&&#a&" &Q&"$&&&#b& &&&& &Q"&& &"a%&"a%$&&&&&&b i2/++6`6a6bk/b i2/ 6c6d6el/b i2/<6f6g6hm/  @2>/- -/ 6i6j6kn/  @2?/--/<6l6m6no/  62;/++6/l/ 66bacdedb6/l `6/ 62</t++6_6666666666666666|6/ ]2/ A A6/&1 #/  #66 f/ 62;/n+ +6. /n+  /&  /  " & $&&&&&&&&#^& "+&&&& &R&"&& &S&"&& &T&"&& &&&#c&"0&&& &&&&  &  & &  & & & && & & +6o6p6qp/  62</++6r6s6tq/ ,28/& &6u6v6wr/ ,29/&&6x6y6z6{s/ 2'&/  / / 6|6}6~6t6/"/  " [66/ :2 6/&1 %/ % g66/ ]2/  4 PRINTER: +/ 4INSPECT +6 h6. 6. /n+  /&  /  "  6/&1 %/ % h6 g6f666666666666666~6/&66/0&1  &  &&  &O M &&"&&& && & & &&& & & " &%%$&&&#d&"+&& & &%$& &!&"#e&#"+ &$S&%"$&&&'&(#f&)"+&*&+ &, &-&."&/%$6. /-  /&  /"  6/ :2 6 \[6. /-  /&  /"   \6666u. /&  /&  /"  666v.v$/$66666w.y/ #/  #6/0&1 $/$6666}6.~/  $66. /&  /&  / "  66/ :26. /&  /&  /  "  6/ :2 6666666666 6 6 6 6 6666& &!&"&#",&$&%2"&& &'@&( %&)")&*  &+"4"4&,&- % %&.&/ " &0 &P L &&"&& & & &L&"&&&" & & [&"& &%%$&&&&#_ ! &"   0 H24/  68.xwvutsrqponmlkjihgfedcba/* */0 1.69/ 0 H25/ / 6: WV6;//   X//  6< YX//  Y W6=/ 0 H23 /* */ / 66666z6/ ]2/ A A/b i2/ ] ]6/Z M2@/  @ @ 6/: 2(/ A A/ : :/  &6/ 2// A A/ : :/ ")2&1"&2&3 $&4&5&6&7#X&8 &9&:&;&<&=&>P"&? &@&A %&B&C &D % &E&F &&& &&& & && "+& &M"&N@&"&%& & %&&" &&,- Z6>/ 0 H26/  /0 20/  /  Z6?6@6A6B6Ca/Z M2A/ 6D6E6Fb/Z M2C/<6G6H6I6Jc/: 2)/  / 6K6L6Md/: &6/$/ $ ]/Z M2D6 ^]/Z M2B ^6.y/f  4 IO  /t* */r /p 6/ ]2/r  4 IOPROCESS: +/~  4 TERMINATED +666`.z66666666666666{6/&Q&R "&S "O&T F"\&U "R&V "S&W "@&X"&Y"N&ZK"Q&["P&\#"Q&]]"&^"U&_"f&`"D&a"`&b"8&c"7&d"c&e"M&f"T&g("&hD"\"&&" & %&&"$0&q"W&r1"&s"*3"& r$ih)o&>?WVX4763547W[Bj#"!f` _)*^MZb\)Slp d  'ECF /.0-rqs=@nI%;HP:DmkUKRcaL ,Q<9Ng]1A+(e2OGJY8T&&&t" t& H21H/ H21H6$/ 2{/` A A/~ 6 66%/ &2|/` A A/ 6 66&/ 2`/` A A/D : :/  &/~ 6  66'/ @  @ / , ,/ , ,/P H J/ $$<11  #x6]1R1R6^6_6`6a6b6cK96d01 6e11  y6f1 n15 6g12 3 1  12 3 1) z6h12 3 1 {6i0212 3 T T&i"+H"&j "V&k! "&l""<&m#"=&n$ &o%7"\&p&"F&q''" &r("g&s)&t"/&u*"B&v+"g&w,"Y&x-0"&y.." &z/-"]KzItJUTWK\P!P')P&IsJnKoJMJ!HM#"P%0%0PPUsPPH"P.IINLNn/tPItJnKoJMJ!ItJnToKxIP!P0P P!UtP"P#H"IINLNnKoJMJ!P$HMS#I#P%"P&P'U vMuP(P)H"P*.IINLNn/wP+IwJnKoJMJ!P,IwJnToKvMI6(/ 2`/` A A/D : :/  &/ 6  66)/  @  @ / , ,/ , ,/ H J/  $$<6*/ Y2E \>/` A A/D : :/  &/ @ @ /  @  @ 6+/ ,  ,/ 1 ;6j|{0 1   6k|}z6l0,1T T01 X  1T2 U3  6m021T T1 ;6n0.1 ;1T T1   ;6o111  6p"6q}y6r6s6&{0/"&|1"e&}2"i&~3 "H&4"I&5 "H&6"/&7"I&8"/&9"[&:;"\&;8"\&<I"\&="X&>"E&?"*&@4"Q&A"f&B"K&C"*vM!P-HIwJnToKw#P."P/0P0P1U xMwP2 yP3P4H"IINLNnKoJMJ!P5HIy#"P6HMR#Iy#IxM#P7"P8P9UyP:P;H"P<.IINLNn/zP=IzJnKoJMJ!P>HIzJnToKy#"P?IzJnToKzIP@!PA0PBPCUzPD {PEPFH"IINLNnKoJMJ!PGHI{#, ,/ , ,/ , ,6,/ H J6-/ -2}/D : :6.P / , ,/ , ,/ H J/  $$<6*/ Y2E \>/` A A/D : :/  &/ @ @ /  @  @ 6+/ ,  ,/ t6uL96v01 01   1 6w11 ~0-1T T6x~11 6y05-. 6z1 15 n0212 n4 3 T T12 n4 3  ;6{05-.   &D<"\&E)"&F+"&G"&H9"\&I6"\&JV"&K@"\&LE"\&M"D&N"_&OW"&P:"\&QG"&RA"\&S";&T\"&U?"\&V"G&W"HMT#I{#I#PH"PIPJPKPLPMPNPOH"PP%HI#"IPQPR%(HM #"'PS% (HW"'PT% (HfMF#g"'PU% (H["'PV% (H\"'PW% (HB"'PX%(HM#"'PY%(HV"'PZ%(HYMK#Z"'P[%(HX"'P\%(HYM##Z"'P]%(HM]#"'P^%(H^"'P_%(HuM#vM6A12 U3 I1  I6B12 U43 T1T6C12 U43 16D1 r6E11 01 *  1 12 U3  6Fsr01 1 12 U3  6Gs6H1T06-T.1T1T6|0)1T T6}1T1 6~6666M9605-. 1T06-T.1T1T601 601 1 6111  61 1"/&X"G&Y"/&Z"D&["J&\"L&]"d&^"C&_"A&`"?&aC"\&b"&cB"\&d""]&e"h&f">&g"b&h":&i"9&j ";&k>"&"'P`%(HFM#G"'Pa%(Ho"'Pb%(H8"'Pc%(H7"'Pd%(Hr"'Pe%(HTM#U"'Pf%(H]"'Pg%(HM(#"'Ph%(HfMD#g"'Pi%(H"HMH#"'Pj% (H_"'Pk%!(HM #IM#I#"'Pl%"(H>"'Pm%#(H?"'Pn%$(IM!'Po%%(HfM7#g"'Pp%&(HIM#J"tq01 1  1  6It6J6K6LI6M05-. u031 15 n4 3  ;1 ;vu111  #v6N0*6O6P6Q6RJ6S1 15 n6T05-. w6U12 n1#5 n612 n3 J1  J 612 n4 3 T2 U612 U3 I1  I612 U43 T1T61T1  1T12 n4 3 T61T2 U43 T12 n4 3 T61T1&0&1&2&3#g&4"+ &5"&6R&7"$&8&9&:#h&;"+&<&= &>"&?&@ &A%$&B&C&D&E#i&F"+ &G"T&H"$&I&J&K&L&M&N#v!v&O"(&P"l";&m="&n5"&o"F&p"M&q"W&r1"&s"*3"& r$ih)o&>?WVX4763547W[Bj#"!f` _)*^MZb\)Slp d  'ECF /.0-rqs=@nI%;HP:DmkUKRcaL ,Q<9Ng]1A+(e2OGJY8T&&&t" t&6666666666666/` A2 /D :26/ 2%/` A A/D : :/ 6 / @2=/  @2=6!/~ 62:/ 62:6"/ ,27/ ,27/ ,27/ ,276#/P H21H/4 3 T2 U6V12 U3 I1 I6W12 U43 T1T6X12 U43 R1R6Y01  12 U3  6Z6[0312 n4 3  ;1   ;6\xw01  1  1'Pq%'(HM'#"ININ1M<!'Pr%((HwM#xM"'Ps%)(((H$M#%PtM#&M#'"'Pu%*(HD"'Pv%+(HwM#xM"'Pw%,(Hb"'Px%-(HM0#"'Py%.(HM.#"ININ1M<!'Pz%/(HhM-#i"'P{%0(HM/#"'P|%1(Ht"'P}%2(Hz"'P~%3(HMM #N"'P%4((HOM"'P%n(H^"'P%o(HY"'P%p(HV"'P%q(HfM#g"'P%r(Ht"'P%s(HM.#"'P%t(H$"HM0#"P') h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ_^%L2P&@=Mc!Z8A1.a9NGJefSdEPPI$ PI1M4$uHM# "%uPHM#2 n4 3 T612 U43 T1 661 n12 n4 3 5 3 1  66111#1  6#6666666N611601   6666O61 15n43 T1T2 U43 T612 n3 J1  J 61T12 n43 T61T1  1K1 K12 n43 T1T2 U43 T61K1  K61K1  K 61K1 K #P"'P%5(HMM #N"'P%6(H$M#%M#&M#'"'P%7((HOM#P"'P%8(H$M#%M#&M#'"'P%9(He"'P%:(HfM;#g"'P%;(HfM8#g"'P%<(HfMI#g"'P%=(Ha"'P%>(HH"'P%?(H"'P%@(HYM4#Z"'P%A(HuM#vM"'P%B(HR"'P%C(H"IRIR"P.IJ /P HEIJ K&#F"IJ K%IP!!0P"HI#P#"r(Ht"'P%s(HM.#"'P%t(H$"HM0#"P') h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ_^%L2P&@=Mc!Z8A1.a9NGJefSdEPPI$ PI1M4$uHM# "%uPHM# n612 n3 J1 J 01 !  12 n43  601  66666P9611 61 15 n612 n3 J1  J 601   61R12 n43 0 1   601 &  1  1  661T2 U601 &  12 U3  12 U43 T2 U3  6666T601 601 (  1 6!IRM!'P%D(HfM<#g"'P%E(HM)#"'P%F(HM+#"'P%G(H"'P%H(HfM9#g"'P%I(HfM6#g"'P%J(HMV#"'P%K(HfM@#g"'P%L(HfME#g"'P%M(HFM#G"'P%N(Hn"'P%O(HMW#"'P%P(HfM:#g"'P%Q(HMG#"'P%R(HfMA#g"'PWMi R"Mj R"WMk R"Ml R"WWWMm R"WL#WMop M^`5M_`AHR+IR-IR_IR"IR'IWR#IR&IR(IR)IR*IR=IR<IR>IR,IR.IWR/IR?IR@IR:IR;IA"WWW1M2WWMNO R"WMNO R"WM R-R.XYW1MNO[ MQZU2WWMNUOV# T ^U T2 U43 R61R1  61R2 601 %  12 3 T2 U3  61R12 3 R6612 n3 J1  J 612 n43 T2 U43 1   11  66666U61 15 n612 n3 J1  J 601 Y  12 n43  6112 n43 612 n3 J1 J612 n43 1611 11  ) 6%S(H;M#<M#="'P%T(HM\#"'P%U(HfM?#g"'P%V(HKM#L"'P%W((H$M#%M#&M#'"'P%X(HKM#L"'P%Y(H$M#%M#&M#'"'P%Z(HFM#G"'P%[(HQ"'P%\(HS"'P%](Hs"'P%^(HE"'P%_(HC"'P%`(HA"'P%a(HfMC#g"'P%b(H "WMNUOWNOOM RM"WMNUOX R"WMNUOY RW"3/XYW3WM R"W1M2WWMNO# T jU "WMNO R"WMNO R"WMNO RW"3WML RL-RL.Z[WWM MLQLGOH R"WM MLQL RW"/Z[WWWM R"WLTvUSYSTEM INITIALIZER PROGRAM# &211  61 60 1   612 n3 J1  J666666Q61 15 n612 n3 J1  J 612 n43 T1  0 1   601 6112 n43 160 1  611 666111  #60 1  666666V 601 01 611 1  1151M#"'P%c(HfMB#g"'P%d(HhM"#i"'P%e(Hy"'P%f(H@"'P%g(Hq"'P%h(H:"'P%i(H9"'P%j(H;M#<M #="'P%k(HM>#"'P%l(H;M#<M#="'P%m(HM=#"'P%n(HM5#"'P%o(HIM#J"'P%p(HTM#U"'P%q(H`"'P%r(HM1#"#WLTU**************************# &2#WL#WL}W#WWWWL#W(\WWLyJK]]]W(_Y]L-M\&.\#+^W(`Y]L3#+^W (aY]L4#+^W (bY]L:#+^W (cY]L?#+^W (dY]LE#+^W (eY]LL#+^W(fY]LS#+^W(gY]L[#+^W(hY]Lb#+^W(iY]Lh#+^W(jY]Ln#+^W(kY]Lo#+^W(lY]LxW#+^,] _abcdekfighjl`^WLmW2 n3 J1  J 612 n43 T1  0 1   601 $  601 611 K  111  6#666R61 15 n612 n3 J1J 6661 15 n3 J1 J 6 11 15 n43 116 11 11 6 1 15 n3 J1 J 6 1 15 n6 112 n43 'P%s(H"HM3#"P')r$ih)o&>?WVX4763547W[Bj#"!f` _)*^MZb\)Slp d  'ECF /.0-rqs=@nI%;HP:DmkUKRcaL ,Q<9Ng]1A+(e2OGJY8TPPI$PI1M4$tHM#"%tPHM#"P.IJ /{PHEI{J K&#F"I{J K%IP!0PHI#P"%r(HM1#"#WM'\W********************# &2#WL#WL}W#WWWWL#W(\WWLyJK]]]W(_Y]L-M\&.\#+^W(`Y]L3#+^W (aY]L4#+^W (bY]L:#+^W (cY]L?#+^W (dY]LE#+^W (eY]LL#+^W(fY]LS#+^W(gY]L[#+^W(hY]Lb#+^W(iY]Lh#+^W(jY]Ln#+^W(kY]Lo#+^W(lY]LxW#+^,] _abcdekfighjl`^WLmW0 1   612 n3 J1  J666666S96111  #1K1  K61 15 n612 n3 J1  J 61T12 n43 T61T1  1K1 K12 51 6112 n43 512 n43 60 1  612 n43 1 112 n43 612 n43 1 112 n43 66 CLOSE1=43; UP_TO1=44; OF1=45; COMMA1=46; BUS1=47; COLON1=48; END1=49; FORWARD1=50; UNIV1=51; BECOMES1=52; THEN1=53; ELSE1=54; DO1=55; UNTIL1=56; TO1=57; DOWNTO1=58; LCONST1=59; MESSAGE1=60; NEW_LINE1=61; "OUTPUT OPERATORS" EOM2=1; CONST_ID2=2; CONST_DEF2=3; TYPE_ID2=4; TYPE_DEF2=5; VAR_ID2=6; VAR_LIST2=7; PROC_ID2=8; PROC_DEF2=9; LBL_END2PE; QTYPE_LIST:=QTYPE OR QCOMMA; QSUBR_LIMIT:=(.UP_TO1.) OR QCONSTANT; QDIMENSION:=QTYPE OR (.COMMA1,BUS1,OF1.); QOF_TYPE:=QTYPE OR (.OF1.); QVAR_DEF:=QDEC OR QTYPE; QBLOCK:=QDECLARATIONS OR QBODY; QPARM_END:=QSEMICOLON OR QBLOCK; QID_LIST:=(.ID1,COMMA1.); QPROC_END := (.ID1, OPEN1.) OR QPARM_END; QARG:=(.ID1,INTEGER1,CHAR1,STRING1.); QPROC_PARMS:=QPROC_END-QID; QFUNC_END:=QPROC_END OR (.COLON1.); QFUNC_TYPE:=QPARM_END OR QID; QPROG_END:=QPROC_END-QBLO n3 J1  J6H6I6J6K6L6M6N6O6P6Q6RY6S1 15 n6T12 n3 J1  J 6U12 n43 T2 U6V12 U43 1   6W0 1   6X11 6Y112 U43 6Z02 n43 T12 U43 T661 11 O 11 M 601 12 U3  12 n43 T2 U3  66I61 612 n3 J1 J612 n4 EXPONENT_SIGN:=TRUE; EXPONENT:=ABS(EXPONENT) END ELSE EXPONENT_SIGN:=FALSE; IF EXPONENT>MAX_EXPONENT THEN BEGIN ERROR(NUMBER_ERROR); EXPONENT:=0 END; FOR I:=1 TO EXPONENT DO POWER_OF_TEN:=POWER_OF_TEN*REAL10; "NOW EITHER MANTISSA=0.0 OR MANTISSA>=1.0" IF MANTISSA = REAL0 THEN RESULT:= REAL0 ELSE IF EXPONENT_SIGN THEN RESULT:= MANTISSA / POWER_OF_TEN ELSE "IF MANTISSA>=1.0 THEN WE MUST HAVE: MANTNST2=97; MESSAGE2=98; TAG_ID2=99; TAG_TYPE2=100; PART_END2=101; TAG_DEF2=102; LABEL2=103; CASE_JUMP2=104; "OTHER CONSTANTS" TEXT_LENGTH = 18; INFILE = 2; OUTFILE = 1; THIS_PASS=2; SPELLING_MAX=700; COMP_BLOCK=TRUE; ROUTINE_BLOCK=FALSE; "MODES" CLASS_MODE=1; MONITOR_MODE=2; PROCESS_MODE=3; PROC_MODE=4; PROCE_MODE=5; FUNC_MODE=6; FUNCE_MODE=7; PROGRAM_MODE=8; "ERRORS" PROG_ERROR=1; DEC_ERROR=2; CONSTDEF_ERR111  6#6111  #601 ,  1 1 1 61110115 601 66666W9611 611 J  1 6[12 n43 T1  0 1   6\01 K  6]6^12 n3 J1 J 0 1   6_6`6a6bZ6c0 1 6d1 15 n3 J1  J6e6f6CEDURE FUNC_DEC (KEYS: SETS); FORWARD; PROCEDURE FUNC_HEADING (KEYS: SETS); FORWARD; PROCEDURE PARM_LIST (KEYS: SETS); FORWARD; PROCEDURE BODY (KEYS: SETS); FORWARD; PROCEDURE STAT_LIST (KEYS: SETS); FORWARD; PROCEDURE STAT (KEYS: SETS); FORWARD; PROCEDURE ID_STAT (KEYS: SETS); FORWARD; PROCEDURE ARG_LIST (KEYS: SETS); FORWARD; PROCEDURE COMPOUND_STAT (KEYS: SETS); FORWARD; PROCEDURE IF_STAT (KEYS: SETS); FORWARD; PROCEDURE CASE_STAT (KEYS: SETS); FORWARD; PROCEDURE RROR,LKEYS1) UNTIL NOT(SY IN QVAR_DEF); END; PROCEDURE ID_LIST; VAR LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QID_LIST; ID_COUNT:=0; DONE:=FALSE; REPEAT IDENTIFIER(LKEYS1,OP,ERROR_NUM); ID_COUNT:=ID_COUNT+1; CHECK(ERROR_NUM,LKEYS1); IF SY IN QID_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(ERROR_NUM,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE IDENTIFIER; BEGIN IF SY=ID1 THEN BEGIN PUT1(OP,ARG); GET END ELSE BEGIN 15 n6 12 n3 J1 J 6!12 n43 T2 U6"12 U3 I1I 6#0,1T T6$1T2 U6%01 2  12 U3  6&12 U3 I1  I6'12 U4@3 1g6h6i[6j11 6k1 15 n6l12 n3 J1  J 6m12 n43 T2 U6n12 U43 1   6o0Z1   6p112 U43 6q0Z1   6r01 J  IMIT; BEGIN PRINT_TEXT('PASS 2: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LIST(KEYS OR QCLOSE,ENUM_ID2,ENUM_ERROR,NUMBER); IF SY=CLOSE1 THEN GET ELSE ERROR(ENUM_ERROR,KEYS); PUT0(ENUM_DEF2) END; PROCEDURE SUBR_TYPE; VAR SPIX:SPELLING_INDEX; BEGIN IF SY=ID1 THEN BEGIN SPIX:=ARG; GET; CHECK(SUBR_ERROR,KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THEN BEGIN PUT1(CONSTANT2,SPIX); GET; CONSTANT(KEYS); PUT0(SUBR_DEF2) END ELSE PUT1(TYPE2,SPIX) END ELSE BEGIN CONSTANT(KEYS OR QSUBR_LIMIT); IF SY=UP_TO1 THEN2 n43 T2 U3 6(6)0)1T T6*12 U3 I1 I 0412 U4 3 R R6+0412 U43 R R6,11  6-11  6.1 6/0 1  600)1T 1 6s6t6u6v\6w01 6x111  6y#6z6{6|]6}01 6~111  6#66666666^61* 0+61 15 n1T2 U612 U3 I<6I; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1) ELSE DONE := TRUE END ELSE DONE := TRUE UNTIL DONE; IF SY=CASE1 THEN VARIANT_PART(KEYS); END; PROCEDURE VARIANT_PART; VAR LKEYS1, LKEYS2: SETS; DONE: BOOLEAN; BEGIN LKEYS1 := KEYS OR QVARIANT_PART; LKEYS2 := KEYS OR QVARIANT; GET; IDENTIFIER(LKEYS1, TAG_ID2, RECORD_ERROR); IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1); IDENTIFIER(LKEYS1, TAG_TYPE2, RECORD_ERROR); PUT0(TAG_DEF2); T01 2  1  6162111  63#64656667X6811 691 15 n6:12 n3 J1 J 6;12 n43 T2 U6<12 U3 I1  I 6=12 U43 T2 U6>0612 n3 J1  J601 R  12 U43  12 U43  66I612 n3 J1  J601 S  12 U43  66I612 n3 J1  J601 T TANT, QCONST_DEF, QTYPE, QTYPE_DEF, QSUBR_LIMIT, QDIMENSION, QOF_TYPE, QVAR_DEF, QBLOCK, QPARM_END, QID_LIST, QPROC_END, QPROC_PARMS, QFUNC_END, QFUNC_TYPE, QPROG_END, QFBLOCK, QPARM_LIST, QSTAT, QBODY_END, QENTRY, QSTAT_LIST, QID_END, QARGUMENT, QARG_END, QIF_END, QTHEN_END, QCASES, QCASE_END, QLABEL_LIST, CHECK(DEC_ERROR,LKEYS1) END; IF SY=VAR1 THEN VAR_DEC(LKEYS2); CHECK(DEC_ERROR,LKEYS2); IF SY IN QROUTINES THEN ROUTINE_DEC(KEYS) END; PROCEDURE CONST_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QCONST_DEF; LKEYS2:=KEYS-QCONST_DEF; GET; REPEAT IDENTIFIER(LKEYS1,CONST_ID2,CONSTDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKEYS1); CONSTANT(LKEYS1); PUT0(CONST_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(CONSTDEF_ERROR,LKE1 P  12 U3  6?12 n3 J1  J6@12 n43 T12 U43 T6A6B12 n43 T12 U43 T6C11  6D11  6E1 6F0 1  6G12 12 U43  12 U43  66III612 n3 J1 J612 U3 I<6I12 n43 T12 U43 T6I12 n43 T12 U4 3 T6I1(KEYS OR QFOR_END,NAME2,FOR_ERROR); PUT0(ADDRESS2); IF SY=BECOMES1 THEN GET ELSE ERROR(FOR_ERROR,LKEYS1); EXPR(LKEYS1); PUT0(FOR_STORE2); CHECK(FOR_ERROR,LKEYS1); DIRECTION:=UP; OP:=FOR_UP2; IF SY=TO1 THEN GET ELSE IF SY=DOWNTO1 THEN BEGIN GET; DIRECTION:=DOWN; OP:=FOR_DOWN2 END ELSE ERROR(FOR_ERROR,QTO_TAIL); EXPR(KEYS OR QDO_TAIL); PUT3(FOR_LIM2,L1,DIRECTION,L2); IF SY=DO1 THEN GET ELSE ERROR(FOR_ERROR,KEYS); STAT(KEYS); PUT2(OP,L1,L2) END; PROCEDURE XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; "STANDARD NOUN INDICES" ZARITHMETIC=17; ZINDEX=18; ZPASSIVE=19; ZPOINTER=20; ZVPARM=21; ZCPARM=22; ZSPARM=23; ZNPARM=24; ZWITH=25; "ERRORS" UNRES_ERROR=1; AMBIGUITY_ERROR=2; ABORT_ERROR=3; CONSTID_ERROR=4; SUBR_ERROR=5; 2 U4@3  666611  61 60 1   61T1T660^1T T1 ;1 ;6666666`9601 11 61 143 612 n43 12 U43 66612 n3 J1  J0 1   6666d60+61 15 n612 n3 J1  J12 n43 1666 6!6"e SY=UNIV1 THEN BEGIN GET; TYPE_OP:=UNIV_TYPE2 END ELSE TYPE_OP:=PARM_TYPE2; "TYPE"IDENTIFIER(LKEYS1,TYPE_OP,PARM_ERROR); PUT1(LIST_OP,NUMBER); CHECK(PARM_ERROR,LKEYS1); IF SY IN QPARM_LIST THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(PARM_ERROR,KEYS) END END; "####" "BODY" "####" PROCEDURE BODY; BEGIN PUT0(BODY2); IF SY=BEGIN1 THEN GR; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROGRAM MAIN(VAR PARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "INPUT OPERATORS" EOM1=1; CONST_ID1=2; CONST_DEF1=3; TYPE_ID1=4; TYPE_DEF1=5; VAR_ID1=6; VAR_LIST1=7; PROC_ID1=8; PROC_DEF1=9; LBL_END1=10; FORWARD1=11; FUNC_ID1=12; FUNC_DEF1=13; POINT5 n612 n3 J1 J 612 n43 T2 U612 U3 I1 I 1R12 U4 3 R612 U3 I1  I 1R12 U43 R611  1R1 6011R 6#0+1 15 n3 J1  J6$01 S  1 6%6&6'6(f6)0+6*1 15 n6+12 n3 J1  J6,12 n43 16-012 n43  6.6/60616263g6QID_CASE OR (.OPEN1, CLOSE1.); QFBLOCK := QBLOCK OR (.FORWARD1.); GET END; PROCEDURE ERROR(NUMBER:INTEGER; KEYS:SETS); BEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); WHILE NOT (SY IN KEYS) DO GET END; PROCEDURE CHECK(NUMBER:INTEGER; KEYS:SETS); BEGIN IF NOT (SY IN KEYS) THEN ERROR(NUMBER,KEYS) END; PROCEDURE NEW_LABEL(VAR L:LABEL); BEGIN CURRENT_LABEL:=CURRENT_LABEL+1; L:=CURRENT_LABEL END; "#######" "PROGRAM" "#######" PROCEDURE PROGRAM_; BEGIN PREFIX(QB ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(ARG_ERROR,KEYS) END END; PROCEDURE COMPOUND_STAT; BEGIN GET; STAT_LIST (KEYS); IF SY=END1 THEN GET ELSE ERROR(COMP_ERROR,KEYS) END; PROCEDURE IF_STAT; VAR L1,L2:LABEL; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QTHEN_END; GET; EXPR(KEYS OR QIF_END); NEW_LABEL(L1); PUT1(FALSEJUMP2,L1); IF SY=THEN1 THEN GET ELSE ERROR(IF_ERROR,LKEYS1); STAT(LKEYS1); CHECK(IF_ERROR,LKEYS1); I3 1T2 U43 6612 n3 J1  J612 n43 T1T612 n43 T12 U43 T661 11 P 11 L 601 12 U3  66IR1 ;1T T611  61 0 1   60^1T T1   ;1  ;6666a60 1   601 Q  1  1  6666b61 "############" BEGIN INITIALIZE; PROGRAM_; INTER_PASS_PTR@.LABELS:= CURRENT_LABEL; NEXT_PASS(INTER_PASS_PTR) END. EGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE,612 n3 J1  J612 n43 T1T612 n43 T12 U43 T601 L  12 U3  66IIIII6II60 1   612 n3 J1  J61* 11  #61 15 n612 n3 J1 J 612 n43 T2 U612 U3 I1 I 601 Q  12 U43  12 U43 T2 U3  612 n43 T1 LKEYS1:SETS; OP:INTEGER; BEGIN LKEYS1:=KEYS OR QTERM_LIST; CHECK(EXPR_ERROR,LKEYS1); IF SY IN QUNARY THEN BEGIN UNARY:=TRUE; IF SY=PLUS1 THEN OP:=UPLUS2 ELSE OP:=UMINUS2; GET END ELSE UNARY:=FALSE; TERM(LKEYS1); IF UNARY THEN PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QTERM_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QSEXPR_OP THEN BEGIN CASE SY OF PLUS1: OP:=PLUS2; MINUS1: OP:=MINUS2; ; STACK_INDEX=0..OPERAND_MAX; UPDATE_INDEX=0..UPDATE_MAX; NAME_PTR=@NAME_REC; VARIANT_PTR=@VARIANT_REC; ENTRY_PTR=@ENTRY_REC; ENTRY_REC= RECORD NOUN:NOUN_INDEX; CASE KIND:ENTRY_KIND OF INDEX_CONST:(CONST_TYPE:NOUN_INDEX; CONST_VAL:INTEGER); REAL_CONST:(REAL_DISP:INTEGER); STRING_CONST:(STRING_LENGTH,STRING_DISP:INTEGER); VARIABLE:(VAR_TYPE:ENTRY_PTR); PARAMETER:(PARM_TYPE:ENTRY_PTR); FIELD:(FIELD_TYPE:ENTRY_PTR; VARIANT:VARIAN01 [  6666666_ 9 601 11 11 11 61 n15 612 3 1 61T12 3 T612 3 <62 U43 T60a60a66666666c60061 15 n612 n3 J1  J 612 n4 3 T2 U612 U3 I1I 612 U3 I<6I6 12 n3 J1  JYS OR QSET_EXPR; CHECK(EXPR_ERROR,LKEYS1); WHILE SY IN QARGUMENT DO BEGIN EXPR(LKEYS1); PUT0(INCLUDE2); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(EXPR_ERROR,LKEYS1); CHECK(EXPR_ERROR,LKEYS1) END; IF SY=BUS1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END END ELSE PUT1(NAME2,XUNDEF) END; PROCEDURE FACTOR_ID; BEGIN VARIABLE(KEYS OR QOPEN); CHEF OPERAND_CLASS; TYPES,CONST_KINDS: SET OF ENTRY_KIND; NAME_HEAD,NAME_TAIL: NAME_PTR; HALT,TEST,RESOLUTION,FUNC_TYPE_SW,UPDATE_SW,PREFIX_SW: BOOLEAN; OPS:ARRAY (.STACK_INDEX.) OF OPERAND; UENTRY,THIS_FUNCTION:ENTRY_PTR; INACCESSIBLE,OP_ACCESS: SET OF NAME_ACCESS; LABELS: ARRAY (.MIN_CASE..MAX_CASE.) OF INTEGER; THIS_UPDATE: UPDATE_INDEX; T:STACK_INDEX; ENUM_VAL,THIS_LABEL,SY,UNRESOLVED,TAG_TOP,RESET_POINT,CONST_DISP: INTEGER; ENUM_TYPE,THIS_NOUN,NEW_TYPE,LABEL_TYPE,TAG_F611  612 3 1 11  6611  0+61  12 3 5 3 T2 U601 M  12 U3  1   601 N  16 12 n43 12 U43 6 12 n43 12 U43 6 6 I612 n3 J1  J12 n43 12 U43 66I612 n3 J1  J612 n43 12 U E:=NAME_ENTRY; NAME:=NIL END ELSE NAME:=NEXT_NAME; IF E=NIL THEN BEGIN ERROR(NAME_ERROR); E:=UENTRY END END; PROCEDURE CHAIN_NAME(E:ENTRY_PTR; SPIX:SPELLING_INDEX); VAR N:NAME_PTR; BEGIN NEW(N); WITH N@ DO BEGIN NAME_SPIX:=SPIX; NAME_ENTRY:=E; NEXT_NAME:=NIL; IF NAME_HEAD=NIL THEN BEGIN NAME_HEAD:=N; NAME_TAIL:=N END ELSE BEGIN NAME_TAIL@.NEXT_NAME:=N; NAME_TAIL:=N END END END; PROCEDURE SET_ACCESS(SPIX:SPELLING_INDEX; A:NA ELSE PUT0(ADDRESS2) END; PROCEDURE CALL_NAME; VAR ERR:BOOLEAN; BEGIN ERR:=FALSE; WITH OPS(.T.) DO BEGIN IF CLASS=ROUTINE_CLASS THEN IF ROUT@.ROUT_TYPE<>PROC_TYPE THEN ERR:=TRUE ELSE "OK" ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(CALL_NAME_ERROR); CLASS:=UNDEF_CLASS END END END; PROCEDURE CALL(OP:INTEGER); BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN BEGIN IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR); W_0f1   ;6`0D1   6a0`6b086c076d0c6e0M1   6f0T6g01 (  6h0\1 D  6i0+01 H 9  6I0\1 6  6J01 V  6K0\1 @  6L0\1 E  6M0D1   6N0_ 6O01 W  6P0\1 :  6Q01 STD_ROUT(XATTRIBUTE, INT_TYPE, INT_CPARM); STD_ROUT(XCHR, CHAR_TYPE, INT_CPARM); STD_ROUT(XCONV, REAL_TYPE, INT_CPARM); STD_ROUT(XORD, INT_TYPE, CHAR_CPARM); STD_ROUT(XPRED, INDEX_TYPE, INDEX_SPARM); STD_ROUT(XSUCC, INDEX_TYPE, INDEX_SPARM); STD_ROUT(XTRUNC, INT_TYPE, REAL_CPARM); STD_ROUT(XNEW, PROC_TYPE, PTR_VPARM); END; "#######" "NESTING" "#######" PROCEDURE UPDATE_CHECK; BEGIN UPDATE_SW:= (THIS_LEVEL > GLOBAL_LEVEL) OR (THIS_LEVEL = GLOBAL_LEVEL) AND PREFITE,UNRES_ROUTINE: ERROR(NAME_ERROR); UNRES_TYPE: IF LEVEL=THIS_LEVEL THEN BEGIN FWD_REF:=ENTRY; WHILE FWD_REF@.NEXT_FWD<>NIL DO FWD_REF:=FWD_REF@.NEXT_FWD; FWD_REF@.NEXT_FWD:=PTR_TYP END ELSE ERROR(NAME_ERROR) END; WITH PTR_TYP@ DO BEGIN KIND:=POINTER_KIND; OBJECT_TYPE:=OBJ_TYP; NEXT_FWD:=NIL; PUT1(POINTER2,NOUN) END END; "#####################" "VARIABLE DECLARA 6j 0V 6k!01  1 1 6l"0<6m#0=6n$11  6o%0\1 7  6p&0F1   6q'01 '  111  # G  6R0\1 A  6S0;1   ;1   6T01 \  6U0\1 ?  6V0G1   6W0/1  ;1  ;1   ;6RG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; PROCEDURE IGNORE3(OP:INTEGER); VAR ARG1,ARG2,ARG3:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); READ_IFL(ARG3); PUT3(OP,ARG1,ARG2,ARG3) END; PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LENGTH); CONST_DISP:=CONST_DISP+LENGTH; FOR I:=1 TO LENGTH DIV 2 DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE ERROR(NUMBER:INTEGER); ERROR(SUBR_ERROR); WITH OPS(.T-1.) DO IF CLASS=ICONST_CLASS THEN BEGIN MIN:=ICONST_VAL; IF (MIN>MAX) OR (ICONST_TYPE<>TYPE1) THEN ERROR(SUBR_ERROR) END ELSE ERROR(SUBR_ERROR); T:=T-2; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=TYPE1; PUT4(SUBR_DEF2,NOUN,TYPE1,MIN,MAX) END END; PROCEDURE SET_DEF; VAR E:ENTRY_PTR; BEGIN T:=T-1; PUSH_NEW_ENTRY(E); E@.KIND:=SET_KIND; PUT1(SET_DEF2,E@.NOUN) END; P6r(0g1   ;6s)0/1  ;6t1   ;1   ;6u*0B6v+0g1   ;6w,0Y6x-01 0  6y.01 .  111  X0G1   6Y0/1   ;1  ;1   ;6Z0D1   6[0J6\0L6]0d6^0C6_0A6`0?6a0\1 C  6b; PART_END1=101; TAG_DEF1=102; LABEL1=103; CASE_JUMP1=104; "OUTPUT OPERATORS" EOM2=1; PROG_DEF2=2; TYPE_DEF2=3; TYPE2=4; ENUM_DEF2=5; SUBR_DEF2=6; SET_DEF2=7; ARRAY_DEF2=8; POINTER2=9; REC2=10; REC_DEF2=11; NEW_NOUN2=12; FIELDLIST2=13; TAG_DEF2=14; PART_END2=15; CASE_JUMP2=16; VARNT_END2=17; VAR_LIST2=18; FORWARD2=19; PROC_DEF2=20; PROCF_DEF2=21; LCONST2=22; FUNC_DEF2=23; D_SCALAR(VAR SCALAR_ENTRY:ENTRY_PTR; SCALAR_INDEX:SPELLING_INDEX); BEGIN STD_ID(SCALAR_ENTRY,SCALAR_INDEX); WITH SCALAR_ENTRY@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=SCALAR_INDEX END END; PROCEDURE INITIALIZE; VAR I:INTEGER; INT_TYPE,REAL_TYPE,BOOL_TYPE,CHAR_TYPE,POINTER_TYPE, INDEX_TYPE,ARITH_TYPE,PASSIVE_TYPE: ENTRY_PTR; ARITH_SPARM,INT_CPARM,PTR_VPARM,CHAR_CPARM,INDEX_CPARM,REAL_CPARM, INDEX_SPARM: NAME_PTR; BEGIN INIT_PASS(INTER_PASS_PTR); WITH IN40+1 15 n3 J1  J6501 6601 R  1 1 6768696:h6;0+6<1 15 n6=12 n3 J1  J6>012 n43  6?12 n43 #6z/0]1 -  6{001 /  6|10e6}20i6~30H1  640I1   ;650H1  660/1  ;1  ;1   RROR(CONSTID_ERROR); T:=T-1; SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-2 END; "#################" "TYPE DECLARATIONS" "#################" PROCEDURE TYPE_ID; VAR SPIX:SPELLING_INDEX; ERROR_SW:BOOLEAN; BEGIN READ_IFL(SPIX); ERROR_SW:=FALSE; IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO CASE ACCESS OF GENERAL: IF LEVEL=THIS_LEVEL THEN ERROR_SW:=TRUE ELSE UPDATE(SPIX,NIL,INCOMPLETE); UNDEFINED: UPDATE(SPVAL; CLASS:=CASE_LABEL; LABEL:=THIS_LABEL; IF (VAL>=MIN_CASE) AND (VAL<=MAX_CASE) THEN INDEX:=VAL ELSE BEGIN ERROR(LBLRANGE_ERROR); T:=T-1 END END ELSE BEGIN T:=T-1; ERROR(LBLTYPE_ERROR) END END; PROCEDURE END_CASE; VAR L0,LN,MIN,MAX,I:INTEGER; BEGIN READ_IFL(L0); READ_IFL(LN); FOR I:=MIN_CASE TO MAX_CASE DO LABELS(.I.):=LN; IF OPS(.T.).CLASS=CASE_LABEL THEN BEGIN MIN:=OPS(.T.).INDEX; MA16@6A6B6C6D6Ei6F0+1 15 n3 J1  J6G01 01 T  1 1 6H6I6J6K6L6M6Nv9v6O0((6P01 1<6Q6R01  6S ;670I1   ;680/1   ;1  ;1   ;690[6:0\1 ;  6;0\1 8  6<0\1 I  6=0X6>0E6?ND END; PROCEDURE PUSH_NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN PUSH; NEW_ENTRY(E); WITH OPS(.T.) DO BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=E; DEF_SPIX:=XUNDEF END END; PROCEDURE UPDATE(SPIX:SPELLING_INDEX; E:ENTRY_PTR; A:NAME_ACCESS); BEGIN IF UPDATE_SW THEN BEGIN "SAVE OLD ENTRY" IF THIS_UPDATE>=UPDATE_MAX THEN ABORT ELSE THIS_UPDATE:=THIS_UPDATE+1; WITH UPDATES(.THIS_UPDATE.) DO BEGIN UPDATE_SPIX:=SPIX; OLD_ENTRY:=SPELLING_TABLE(.SPIX1(OP,NOUN) END ELSE PUT1(OP,XUNDEF); IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END END; PROCEDURE FUNC_TYPE; BEGIN TYPE_(RETAIN,0); FUNC_TYPE_SW:=TRUE END; PROCEDURE FUNC_DEF; VAR TYP: ENTRY_PTR; BEGIN MARK(RESET_POINT); RESET_NOUN:=THIS_NOUN; IF FUNC_TYPE_SW THEN BEGIN DEFINE(TYP); T:=T-1 END ELSE TYP:= UENTRY; IF DEFINED THEN BEGIN THIS_FUNCTION:=TOP; WITH THIS_FUNCTION@ DO IF RESOLUTION THEN BEGIN IF F0O6T 0\1 F  6U 0R6V 0S6W 0@6X01   6Y0N6Z0Q1 K  6[0P6\0Q1 #  6]01 ]  6^0U60*6@0Q1 4  6A0f1   ;6B0K6C0*1R1R1R1 6D0\1 <  6E01 )  6F01 +  6G06H0\1 CONST_DEF1: CONST_DEF; CONST_ID1: CONST_ID; CONSTANT1: CONSTANT; CPARMLIST1: PARMLIST(CPARMLIST2); DEF_CASE1: DEF_CASE; DEF_LABEL1: IGNORE1(DEF_LABEL2); DIV1: BINARY(DIV2); EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END; END_CASE1: END_CASE; ENUM_DEF1: PUT2(ENUM_DEF2,ENUM_TYPE,ENUM_VAL); ENUM_ID1: ENUM_ID; ENUM1: ENUM; EOM1: HALT:=TRUE; EQ1: BINARY(EQ2); FALSEJUMP1: BEGIN IGNORE1(FALSEJUMP2); T:=T-1 END; FCHAR1: FINDEX(XCHAR); FIELD_ID1,PARM_ID1, VAR_ID1: PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,         $     ! % , 0 4 8 < ( - 1 5 9 = ) H L P T @ D I M Q U A E d h l X \ ` e i m Y ] a p t x | s w {            .   " & * /   # ' + 2 6 : > B F 3 7 ; ? C G N R V Z ^ J O S W [ _ K j n r v b f k o s w c g z 63547W[Bj#"!f` _)*^MZb\)Slp d  'ECF /.0-rqs=@nI%;HP:DmkUKRcaL ,Q<9Ng]1A+(e2OGJY8T661 611  t0 1   t601   612 60 12 3  12 3 166?AAAAAAAAA A (A A A ! .A ! .A ! .A ! .A ! .A ! .A ! .A ! .A !! .AAA "! .A #! .A $! .A %! .A &! x.A '! w.A (! .A )! .A *! .A! +! .A" ,! .A# -! .A$ .! A%.A& /! .A'A(A) 0! .A* 1! .A+ 2! .A, US1: PUT0(UPLUS2); VALUE1: PUT0(VALUE2); VAR_LIST1: VAR_LIST; VARNT_END1: VARNT_END; VARNT1: VARNT; VPARMLIST1: PARMLIST(VPARMLIST2); WITH_TEMP1: WITH_TEMP; WITH_VAR1: PUT0(WITH_VAR2); WITH1: BEGIN POP_LEVEL; PUT0(WITH2) END END UNTIL HALT; IF UNRESOLVED > 0 THEN ERROR(UNRES_ERROR); PUT0(EOM2); WITH INTER_PASS_PTR@ DO BEGIN RELEASE(RESETPOINT); CONSTANTS:=CONST_DISP END; NEXT_PASS(INTER_PASS_PTR) END. 3! .A-A.A/ 4! . 5! .A0 6! .A1 7! ? .A2 8! . 9! . :! . ;!.A3 <!. =!. >!.A4 ?!.A5A6A7 @! H.A8 A! .A9A:A; B! .A<A=A>)A?A@AA C! 0 331 .AB D! 0 31 .ACADAE E! F2 G2 H2 I2AF J/.AG K! L2 M2 N2 O/.AH P! Q2 R2 S2 T/.AI U! V2 W201 6Slp d  'ECF /.0-rqs=@nI%;HP:DmkUKRcaL ,Q<9Ng]1A+(e2OGJY8T661 611  t0 1   t601   612 60 12 3  12 3 166 X2 Y2 Z2AJ [2 \/.AK ]!AL ^4 K.AM _4 U.AN `4 PAO5.AP a! b2 c2 d/.AQARAS e! 0 @31 .AT f! 0 A31 .AUAVAW g! h2 i2 j2 k2 l/.AX m!AY n4 g.AZ `4 C.A[ o4 .A\ p4 A]5.A^A_A` q! 0 B31 .Aa r! s2 t/.Ab u! 0 031 .AcAdAe v!1 0 '.Af w! 0 )31 vLASS:=SCONST_CLASS; SCONST_LENGTH:=STRING_LENGTH; SCONST_DISP:=STRING_DISP END END ELSE BEGIN CLASS:=UNDEF_CLASS; ERROR(CONSTID_ERROR) END END; PROCEDURE REAL_; BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=CONST_DISP END END; PROCEDURE FREAL; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; PUT1(REAL2,CONST_DISP) END; PROCEDURE INDEX(TYP:NOUN_INDEX); BEGIN PUSH; WITH OP.Ag x!Ah y4 w.Ai z4 0 !31 Aj5.Ak {!Al |4 .Am }4 0 031 An5.Ao ~! 2 /.Ap ! 2 2 2 2 /.Aq !Ar 4 .As 4 .At 4 .Au 4 0 31 Av5.AwAx !Ay 4 C.Az 4 .A{ 2 4 A|5.A} ! 0 131 .A~ ! 2 2 2 2 2 2A 2 /.AAA ! 2 /01 # /j  4 6/01 / 6/01 / 6/01 / 66/L/ L/  LZ[66//L3LG1 / 6//L3L/  6Z[666/2 2 2 2 2A 2A 2 2 2 2 2 2 /.AAA*AAA 2 41 .A 4 0 631 m.A 4 e.A 4 m.A 4 .A 2 4 .AAA 2 4 .A 2 4 .AAA 4 .A 4 q.A 41 .AAA 4A 2 2 4 .A 4 .A 4 wA5.A 2 2 4 v.A 4 0 %31 v.A 2 OCEDURE POP2(OP:INTEGER); BEGIN PUT0(OP); T:=T-2 END; "########" "VARIABLE" "########" PROCEDURE PUSH_OPERAND(OP_ENTRY:ENTRY_PTR; COMP:BOOLEAN); VAR OP:INTEGER; VARNT_PTR:VARIANT_PTR; BEGIN IF NOT COMP THEN PUSH; WITH OPS(.T.) , OP_ENTRY@ DO CASE KIND OF INDEX_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(INDEX2,CONST_VAL,CONST_TYPE) END; REAL_CONST: BEGIN CLASS:=FCONST_CLASS; PUT1(REAL2,REAL_DISP) END; 2 2 2 2A 4 .AAA 4 .A 2 2 2 4 .A 4A 4 .A 4 .A 4 A5.A 4 .A 4A 4 C.A 2 2 4 A5.A 4 ~31 {.A 4 ~31 .AAA 4 .A 4 .AAAAAAAA+ * 4 .* 4 ]. 4 E/.A  2 2 /5.AA+  4 a.* 4 /.A* 4 ]./ 6. /v 4SYSTEM INITIALIZER PROGRAM# 26. / 4**************************# 26.$6.x66666.y6 \66.w,-] ]6 _7].h/\ \^6 `7].i^6  a7].j^6  b7].k^6  c7].l(^6  d7AAA  ^8 L.A  2 2 F/A< " <A5.AA+  4 a. 4 /.A* 4 ]. 4 .AA 8 .A  ^8 M.A  2 2 F/A5.AA+  4 /.A  b2 /5.AA+ * 4 /.A  b2 /5.AA+ .AA  :/.A5.A+  4 e/.A* 4 . 4 .AA 8 .AA 8  . R:VARIANT_PTR; BEGIN VARIANT_LABELS:=(..); NEW(VARNT_PTR); WITH VARNT_PTR@ DO BEGIN TAG_NOUN:=TAG_FIELD; PARENT_VARIANT:=THIS_VARIANT; THIS_VARIANT:=VARNT_PTR END END; PROCEDURE TAG_ID; BEGIN PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD,OUTPUT,INCOMPLETE); IF DEFINED THEN NEW_TAG_FIELD:=OPS(.T.).DEF_ENTRY@.NOUN ELSE NEW_TAG_FIELD:=XUNDEF END; PROCEDURE LBL_END; BEGIN IF VARIANT_LABELS AND TAG_LABELS <> (..) THEN ERROR(AMBILBL_ERROR); TAG_LABELS:=TA PUT1(ARROW2,WITH_TYPE) END END END END ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(NAME_ERROR); NAME_ENTRY:=UENTRY END; PUSH_OPERAND(NAME_ENTRY,COMP) END; PROCEDURE COMP; CONST QUALIFIED=TRUE; VAR SPIX:SPELLING_INDEX; COMPONENT:ENTRY_PTR; NAME_LIST:NAME_PTR; ERR:BOOLEAN; BEGIN READ_IFL(SPIX); ERR:=FALSE; WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN BEGIN WITH VTYPE@ DO IF KIND=RECORD_KIND THEN NAME_LIST:=FIE01   6c0\1 B  6d0]1 "  6e0h6f0>6g0b6h0:6i096j0;1   ;1  6k01 >  6l0;1].m ^6  e7].n ^6 f7].o0^6 g7].p^6 h7].q^6 i7].r^6 j7].t^6 k7].u^6 l7].v6^] _abcdekfighjl`^6.s66/ \68 ^6  a7].j^6  b7].k^6  c7].l(^6  d7EROPTION = 5; TYPE FILE = 1..2; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); =0..STACK_MAX; NOUN_INDEX=0..NOUN_MAX; TYPE_KIND=INT_KIND..ROUTINE_KIND; TYPE_KINDS=SET OF TYPE_KIND; CONTEXT_KIND=FUNC_RESULT..WITH_VAR; CONTEXTS=SET OF CONTEXT_KIND; PACKED_SET=0..15; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; ENTRY_CLASS=(UNDEFINED,VALUE,ROUTINE,TEMPLATE); ENTRY_PTR=@ENTRY; ENTRY= RECORD CASE CLASS:ENTRY_CLASS OF VALUE:( VMODE:OUTPUT_MODE; VDISP,CLEAR_SIZE:DISPLACEMENT; CONTEXT:CONTEXT_KIND); ROUTINE:(   ;1   6m01 =  6n01 5  6o0F1   6p0M1   6q0W6r01 1  6s0*01 3  6r$ih)o&>?WVX47IND; S:DISPLACEMENT); VAR E:ENTRY_PTR; BEGIN NEW(E); NOUN_TABLE(.N.):=E; WITH E@ DO BEGIN CLASS:=TEMPLATE; NOUN:=N; SIZE:=S; KIND:=K END END; PROCEDURE INITIALIZE_; VAR I:INTEGER; BEGIN INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; GENERIC_FUNCTION:=FALSE; CURRENT_DISP:=0; PREFIX_SW:=TRUE; T:=-1; DONE:=FALSE; THIS_LEVEL:=-1; SAVE_CONTEXT:=FALSE; NO_FORWND MUST BE SEQCODE " -,&5*%&6  &7&8."!/.&9&:"&; 0&< 10&=2&>(OBJECT FILE PROTECTED " 32&? 31&@/%&A$&B&C&D&E#%!&F&G4"4&H"&I"&J1&"F"+F (PASS4#|"0&#F",&$"1&%$"+$ (PASS5#"0&&$",&'"1&("+ (PASS6#"0&)",&*"1&+"+ (PASS7#"0&,",&-"1&."+ (FILE #"0&/", 5 5&K"&L 6 6&M$&N&O&P#&&Q"&R"&SB &T  %&UB &V  %&WB &X  %&Y$&Z&[&\#'&] &^ &0"1&1$&2&3&4&5&6#:`&7W "(&8 "(&9 "(&: "(&;` "(&<@k "(&=  "(&> "(&? "(&@"(&A"(&B(SOLO SYSTEM: DISK FILES#"0&C"1&D"+(- - -#"0&E"+ %&_$&`&a&b&c#(&dB  &eB"&f7&g&h &i "&j87&k&lB  &mB  &n 9&o(COMPILATION ERRORS " 9&p8&q$&r&s&t#!&u"$&v:&w&x( TEMP1 "(- - -#"0&F"+(EDIT #"0&G"+A(- - -#"0&H`"+m (- - -#"0&I_ (CATALOG#"0&J"1&K@"+(LENGTH #"0&L "+(PAGE 1 #"0&M"+)(- - -#"0&N"+U(PAGE N #"0&Os ( FILE MAP #"0&P ",&Q"1&R"+&S ""&y( TEMP2 ""&z;&{&|"&&}( SPASS1 "(&~<( SPASS2 "(<&=( SPASS3 "(=&>( SPASS4 "(>&?( SPASS5 *"(?&@( SPASS6 6"(@&A( NEXT B""A&B( SPASS7 N"(B&"%&,&T=(- - -#"0&U"+&V",&W ( FILE PAGES #"0&X"1&Y$&Z&[&\&]&^&_#;&`D"(&a"(&b"(&c^"(&d`<"(&e@r"(&f "(&g""(&hj"(&i4"(&j"(&kC"#C&"'&;&""&:&$0"(&~<( SPASS2 "(<&=( SPASS3 "(=&>( SPASS4 "(>&?( SPASS5 *"(?&@( SPASS6 6"(@&A( NEXT B""A&B( SPASS7 N"(B&"%&"(&l`b"(&m@"(&n "(&oH"(&p  "(&q  "(&r  "(&s  "(&tz( SOLO SYSTEM: PROGRAM LOADING #"0&u"1&v"+(1#4"0&w"+t(2#6"0&x"+(3#8"0&y"+(4#:"0&z`"P\P].I~;ML:4/P^IJ4K52M2!IJ4T5K6I!0P_P`PaU Pb  =PcPdI;ML:4T5K6M!PeHxI#yI;#z;I#{I=#|="PfI=1M=6$7PgPhIM!PiHI#I#I=#="Pj&87PkPlII;ML:4T5K6!PmII;ML:4T5K7!PnIC$9PoHO+(5#<"0&{@"+(6#>"0&| "+4(7#@"0&}"+(8#B"0&~"1&"+* (1 1#D"0&"1&", (2 3#L"0&"1&`", (3 5#T"0&"1&` ", (4 7#\"0&"1& ",&"+B (5 2#d"0&"1&COMPILATION ERRORS #"%9Pp%8PqPrPsPtPuH"PvI$:PwPxHM# O  TEMP1 #"PyHM# O  TEMP2 #"PzI$;P{P|H"P}HO  SPASS1 #"P~I$<HO  SPASS2 #"%<PI$=HO  SPASS3 #"%=PI$>HO  SPASS4 #"%>PI$?HO * SPASS5 #"%?PI$@HO 6 SPASS6 #", (6 4#l"0&"1&@", (7 6#t"0&"1&@", (8 8#|"0&"1&"+(9#"0&"+(10 #"0&"+=(11 #"0&"+(12 #"0&`"+(13 #"0&@"+(14 #"0& "+Y(15 #"0&""%@PI$AHM# O B NEXT #"%API$BHO N SPASS7 #"%BPH"PI1I1M4B$CH"%CPH"P%;PHFM#G "HFM#G "P%:P#"P~I$<HO  SPASS2 #"%<PI$=HO  SPASS3 #"%=PI$>HO  SPASS4 #"%>PI$?HO * SPASS5 #"%?PI$@HO 6 SPASS6 #+(16 #"0&"1&",&"+T (9 12#"0&"1&@", ( 10 14 #"0&"1&@", ( 11 16 #"0&"1&", ( 12 10 #"0&"1&`",&"+g ( 13 13 #"0&"1&` ",/ ( 14 15 #"0&"1& ", & "( p & "( ? &x "(x &V "(V ^ &4H"(4  &' "(  &"(  &"( 5 &"(  &+"( ( 15 9 #"0&"1&", ( 16 11 #"0&"1&$&&&&&&&#<&7"(  &c"(  &"(  &x"(x % &V"(V M &4"(4  &?"(  &h"(h  &F"(F I &$"($ R &"( $ &V"(  &"( O &f(PASCAL(PBH, PRINTER, RUN)#$"0&"1&"+ (IN #>"0&"+ (IO #B"0  &k "( & "( & "( , &U"(  &h"(h  &F"(F  &$"($ A &"( m &1"(  &]"(8  3.A  /A< ! :/  ! @/.A " :9 .A5.AA+  4 f/.A* 4 . 4 .AA 8 . 8  3.A "#/ % A/;AA  /.A 8  . 8  3.A5.A  ?/.A A5.AA+  4 C/.A* 4 f. 4 .AA .A 8 = 3;  38  3.A  3 38#.A&",&"+ (JOB#F"0&x"+x (DO #J"0& x",& V"+V (OUT#N"0& 4"+4 (IO #R"0& V4",& "1&"+ (PASCAL #V"0&x",&"1&",&4",&  /A5.AA+  4 /.A* 4 C. 2 2 2 4 .AA 8 . 8 . 8 0/.AA 8  .A  38    / /.A 8  A< ! .A 8  .A % 9  38-A :  38 .A  8 > ;   3/.A  8  = 3;  /A 5.A A+  4 .* 4 .* 4 e/.A"1&"+ (DISK #^"0&",&"+ (PRINT#d"0&4",&"1&"+ (PASS1#j"0&",&"1&"+ (PASS2#p"0&",&"1&h"+h (PASS3#v"0& h",&!"  & "( &z "(z  &X "(X G &w("SOLO SYSTEM: PROGRAM STRUCTURE #"0&"1&"+ (FIFO #"0&"1&"+ ( RESOURCE #"0&"1&"+ ( TYPEWRITER #""0&"1&x"+x ( PHIK#M#M#M#"IKM!PHIK#M#M#M#"IKM%!PHIK#M#M#M#"IKMM!PHIK#M#M#M#"IKM!PHIK#M?#M#M#"IKM!PHIK#Mk #M#M#TERMINAL #."0&"1&V"+V (TERMINAL STREAM#8"0&"1&4"+4 (DISK #H"0&"1&"+ ( DISK FILE#N"0&"1&"+ ( DISK TABLE #X"0&"1&"+ (DISK CATALOG #d"0&"1&"+ ( DATA FILE#r"0&"1&"IKM !PHIK#M #M#M#"IKM !PHIK#M #M#M#"IKM, !PHIK#MU#M#M#"IKM!PHIK#M#M#M#"IKM!PHIK#M#M#M#"IKM!PHIK#M"+ (PROGRAM FILE #|"0&"1&h"+h (PROGRAM STACK#"0&"1&F"+F (BUFFERS#"0&"1&$"+$ ( CHAR STREAM#"0&"1&"+ ( JOB PROCESS#"0&"1&"+ ( IO PROCESS #"0&"1&"+ (CARD PROCESS ##M#M#"IKMA!PHIK#M#M#M#"IKMm!PHIK#M1#M#M#"IKM!PHIK#M]#M#M#"IKM!PHIK#M #M#M#"IKM !PHIK#M #M#M#"IKM !PH"0&"1&"+ (PRINTER PROCESS#"0&"1&z"+z (LOADER PROCESS #"0&"1&X"+X (INITIAL PROCESS#"0&"1&(PAGES#"0&(0.5#"0&(1# "0&(1#"0&(0.5#"0&D(1#"0&p(0.5#"0&(1#"0& IK#M #M#M#"IKMG !PHMw#O""SOLO SYSTEM: PROGRAM STRUCTURE ##"PH"PHIK#"HIK#OFIFO ##"PH"PHIK#"HIK#O  RESOURCE ##"PH"PHIK#"HIK#O " TYPEWRITER ##"PH"PHIK#"HIK#O . TERMINAL(1#"0& (1#"0& (1# "0&(PAGES#""0&(1.5#("0&(1#,"0&)(1.5#."0&U(1#2"0&(2.5#4"0&(2.5#8"0&(0.5#<"0& (0.5#@"0&] (1#D"0&"1&8# "(&8"+$ (21 #F"0& "1& $& & & &&&#=( ##"PH"PHIK#"HIK#O8TERMINAL STREAM##"PH"PHIK#"HIK#OHDISK ##"PH"PHIK#"HIK#O N DISK FILE##"PH"PHIK#"HIK#O X DISK TABLE ##"PH"PHIK#"HIK#OdDISK CATALOG ##"PH"PHIK#&"5&&G"6 & "6 &G"6 & "6 &d"(&"+&"&"&&$&&&#& "2&! "3&"( SPOOLING J "7&#( EDIT V "8&$( PASCAL "HIK#O r DATA FILE##"PH"PHIK#"HIK#O|PROGRAM FILE ##"PH"PHIK#"HIK#OPROGRAM STACK##"PH"PHIK#"HIK#OBUFFERS##"PH"PHIK#"HIK#O  CHAR STREAM##"PH"PHIK#"HIK#O  JOB b "9&%( DISK n ":&&( LOADING z ";&'( STRUCTURE  "< &(( PRETTY  !"="!&)"3" &*"4&+$02&! "3&"( SPOOLING J "7&#( EDIT V "8&$( PASCAL PROCESS##"PH"PHIK#"HIK#O  IO PROCESS ##"PH"PHIK#"HIK#OCARD PROCESS ##"PH"PHIK#"HIK#OPRINTER PROCESS##"PH"PHIK#"HIK#OLOADER PROCESS ##"PH"PHIK#"HIK#OINITIAL PROCESS##"PH"PHM#O:4##"PzHI#"HM#O<5##"P{HI#"HM#O>6##"P|HI#"HM4#O@7##"P}HI#"HM#OB8##"P~H"PHI#"HM* #OD1 1##"PH"PHI#I#"HM #OL2 3##"PH"PHI#I#"HM #OT3 5##HM#OPAGES##"PHM#O0.5##"PHM#O 1##"PHM#O1##"PHM#O0.5##"PHMD#O1##"PHMp#O0.5##"PHM#O1##"PHM #O1##"PHM #O1##"PHM #O 1##"PHM#O"PAGES##"PHM#"PH"PHI#I#"HM #O\4 7##"PH"PHI#I#"PHI#"HMB #Od5 2##"PH"PHI#I#"HM #Ol6 4##"PH"PHI#I#"HM #Ot7 6##"PH"PHI#I#"HM #O|8 8##"PH"PHI#"HM#OO(1.5##"PHM#O,1##"PHM)#O.1.5##"PHMU#O21##"PHM#O42.5##"PHM#O82.5##"PHM#O<0.5##"PHM #O@0.5##"PHM] #OD1##"PH"PHI#M# #M#M#"PHI#"HM$ #OF21 ##"P H"P P P U9##"PHI#"HM#O10 ##"PHI#"HM=#O11 ##"PHI#"HM#O12 ##"PHI#"HM#O13 ##"PHI#"HM#O14 ##"PHI#"HMY#O15 ##"PHI#"HM#O16 ##"PH"PHI#I#"PHI#"HMT #P P P PPH"P%PIHFMG#G!PIHFM #G!PIHFMG1I<#G!PIHFM 1I<#G!PHI#Md1I>1I;#I#I#"PHI#"PHM#"PHM#"PM$PPPPP H"P!IC$H"&P"I1O J SPOOLING 3$H"&P#IO9 12##"PH"PHI#I#"HM #O  10 14 ##"PH"PHI#I#"HM #O  11 16 ##"PH"PHI#I#"HM #O  12 10 ##"PH"PHI#I#"PHI#"HMg #O  13 13 ##"PH"PHI#I#"HM/ #O  14 15 ##"PH"PHI1O V EDIT 3$H"&P$I1O b PASCAL 3$H"&P%I1O n DISK 3$H"&P&I1O z LOADING 3$H"&P'I1O  STRUCTURE 3$H"& P(I1O  PRETTY 3$!H"&"!P)H"%"% %%%%%%P*H"P+M#"PM$PPPPP H"P!IC$H"&P"I1O J SPOOLING 3$H"&P#I#I#"HM #O  15 9 ##"PH"PHI#I#"HM #O  16 11 ##"PH"PPPUP P P     P PPHIK#M7#M#M#"IKM!PHIK#Mc#M#M#"IKM!&  &&K &  &&&T"&& &%I &&"&& & & &H="e&R">&S"L&T;"e&U"O&V"R&W"Q&X"R&Y "Q&Z"o&["N&\"D&]"B&^?"e&_>"e&`!"f&a"s&b"A&c"k& d"G& e"I& f"'P%n(H^"'P%o(HY"'P%p(HV"'P%q(HfM#g"'P%r(Ht"'P%s(HM.#"'P%t(H$"HM0#"P') h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ_^%L2P&@=Mc!Z8A1.a9NGJefSdEPPI$ PI1M4$uHM# "%uPHM#">& g"=& h"<&i">&j:"&k">&l9"&m1"&n"P&o"K&p"H&q"U&r"a&s."&t",0"&  h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ"P.IJ /P HEIJ K&#F"IJ K%IP!!0P"HI#P#"r(Ht"'P%s(HM.#"'P%t(H$"HM0#"P') h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ_^%L2P&@=Mc!Z8A1.a9NGJefSdEPPI$ PI1M4$uHM# "%uPHM#&"&&&"!& &  S& "&  & %%$& &&&#h!&"  &<&& &&&& "-&&I"&J_^%L2P&@=Mc!Z8A1.a9NGJefSdE&& &u"!u&"&& ." .&! %&"&#"$0&q"U&r"a&s."&t",0"&  h+ hg/nWVF7;:U<YXoi*)(b]\/0[p/Rk"q`-$C#D'5463srtmI,?HO>BljTKQ&"&%& & %& &!"!&"&#2 &$&%"g$&&&'&(&)&*&+#i!&," &-4 &.&/&0 &1   %&2PcPdH2"PeH@FG$Pf.IIULUo/.IJoT pK{YJZ/PgIJZK\I1I8$PhIJZK\IPi%(IPjIJoKpJMJ!PkIJoTpKtTIJZT\K]T!PlIJoTpKuIJZT\K^Pm!'Pn% (IPoIJoKpJMJ!IJoTpKvIJZT\K_Pp!'Pq% (IPrIJoKpJMJ!PsIJoTpKwIJZT\K`!PtI&3"3 %&4&5"!&6"g$&7&8&9#j&:"!&;L&<"$&=&>&?#k&@   &A4 &B&C&D &EL"&F&G &H"jJoTpKxIJZT\KaPu!Pv')  Pw& IJoKpJMJ!HM# "Px% 00%PyPzUP{P|H%"P}.IIULUo/P~IJoKpJMJ!IJoTpKvIP!P0PPUPPH%"IIULUoKpJMJ!PHMN#I#P"PPU TPPH%"P.IIULUo/PIJoKpJMJ!PIJoT%&I"j%$&J&K&L#l&M"!&NJ&O"$&P&Q&R#m&S"b&T4 &U&V&W &X &YJ&Z"&["l%&\"l%$&]&^&_&`&a&b&c#n&d"2&e"7&f4 pKtTIT!PHIJoTpKu#P"P0PPU TP PPH%"IIULUoKpJMJ!PHI#"PHMM#I#IT#P"PPUPPH%"P.IIULUo/PIJoKpJMJ!PHIJoTpKw#"PIJoTpKxIP!P0PPUP PPH%"IIULUoKpJMJ!PH &g&h&i&j &k &l&m &n &o &p &q &r &s &t&u &v   &w  "!I#"HMO#I#I#P"PPPPPPPH "P% HI#"I PP%(HM#"'P%(Hk"'P%(HyMB#z"'P%(Ho"'P%(Hp"'P%(HO"'P%(H"'P%(Hi"'P%(Hh"'P%(HmMG#n"'P%(Hl"'P%(HmM"#n"'P%(Hr"'P%(HM#"'P&x %%$&y&z&{#o&|"-&}4 &~ & &%$&&&#p&"-4  &N&"$&&&#q&"-&4 & & &&"&%$&&&&#r&"-4  &"%(HM#T"'P%(H"'P%(HE"'P% (HD"'P%!(H"'P%"(HfM#g"'P%#(Hq"'P%$(HM%#"'P%%(HyM@#z"'P%&(H%"HMD#"'P%'(Hs"'P%((HM#IT#I#"'P%)(HK"'P%*(HL"'P%+(IM!'P%,(HyM3#z"'P%-(HM$#"IUI&M&"$&&&#s&"-&4 & &"&& &%$&&&&#t&"-4  &"O&"$&&&&&&#!&")& " &&"&"Y&B"e&"\U1M<!'P%.(HM#T"'P%/(((H.M#/PM#0M}#1}"'P%0(HT"'P%1(HM#T"'P%2(Hu"'P%3(HM-#"'P%4(HM+#"IUIU1M<!'P%5(H{M*#|"'P%6(HM,#"'P%7(Hj"'P%8(H"'P%9(H"'P%:(He"'P%;(H_M}#`}M#a"'P%<(H&"]&"C&"m&"W&"V&G"[&"Z&""[&"_&"&"q&"i&";& ":&!"n&""U&#"^&$%"&%@"e&&"-D"&'"`&( "&d"'P%=(Hx"'P%>(HyM7#z"'P%?(HyM4#z"'P%@(HyME#z"'P%A(HM#T"'P%B(HyM8#z"'P%C(HM&#"'P%D(HM'#"'P%E(H["'P%F(HX"'P%G(H"'P%H(HyM5#z"'P%I(HyM2#z"'P%J(HMQ#"'P%K(HyM<#z"'P%L(HyMA#z"'P%M)"?&*"@&+ &,3"e&-$"   &."r&/&"1&0"F&1"r&2"b&3-"&4+"   &5*"f&6,"&7"X&8"p&9"t&:"T&;(H"'P%N(HMP#"'P%O(HyM6#z"'P%P(HMC#"'P%Q(HyM=#z"'P%R(HHM#IM#J"'P%S(HZ"'P%T(HyM;#z"'P%U(H]"'P%V(HbM#c"'P%W(H_M}#`}M#a"'P%X(HbM#c"'P%Y(IM!H_M}#`}M#a"'P%Z(H"'P%[(H\"'P%\(HP""Q&<"S&="d&>7"e&?4"e&@E"e&A"q&B8"e&C&"&D'"&E"M&F"J&G" &H5"e&I2"e&JQ"&K<"e&LA"e&M"h&NP"&O6"e&PC"&Q'P%](HN"'P%^(HyM?#z"'P%_(HyM>#z"'P%`(H{M!#|"'P%a(H"'P%b(HM"'P%c(H"'P %d(HU"'P %e(HW"'P %f(HHM#IM#J"'P %g(HG"'P %h(HF"'P%i(HHM#IM#J"'P%j(HM:#"'P%k(HHM#IM#J"'P%l(HM9#"'P%m(HM1# 1; IF INDEX <> PAGENO THEN BEGIN IF CHANGED THEN PUT(CATFILE, INDEX, BLOCK); INDEX := PAGENO; GET(CATFILE, INDEX, BLOCK); CHANGED := FALSE END; END END "GETCAT"; PROCEDURE READCAT (I: INTEGER; VAR ELEM: CATENTRY); BEGIN WITH CAT DO BEGIN GETCAT(I); ELEM := BLOCK(.(I-1) MOD CATPAGELENGTH + 1.); END END "READCAT"; PROCEDURE WRITECAT (I: INTEGER; ELEM: CATENTRY); BEGIN WITH CAT DO BEGIN GETCAT(I); BLOCK(.(I-1) MOD CATPAGELENGTH + 1.) := ELEM; CHANGED := TRUE END END "WRITECAT"; PROCEDURCAT(INDEX,ELEM); READCAT(START, ELEM); ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH + 1; WRITECAT(START, ELEM) END "WITH" END "INCLUDE"; PROCEDURE EXCLUDE (ID: IDENTIFIER); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ELEM.ID := NONAME; ELEM.KEY := NOKEY; WRITECAT(INDEX, ELEM); READCAT(START, ELEM); ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH - 1; WRITECAT(START, ELEM) END "WITH" END "EXCLUDE"; PROCEDURE INCLUDESPECIAL (ID: IDENTIFIER; ATRT END END; PROCEDURE SEARCHOLD (ID: IDENTIFIER); VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY; BEGIN INITBUCKET(ID); WITH BUCKET DO IF ID <> NAME THEN BEGIN MORE := LENGTH; INDEX := START MOD CATLENGTH + 1; FOUND := FALSE; WHILE (MORE>0) & NOT FOUND DO BEGIN READCAT(INDEX, ELEM); NAME := ELEM.ID; IF ID = NAME THEN FOUND := TRUE ELSE BEGIN IF ELEM.KEY = START THEN MORE := MORE - 1; INDEX := INDEX MOD CATLENGTH + 1; HCAT; BEGIN WITH CAT DO BEGIN IF CHANGED THEN PUTPAGE(CATFILE, INDEX, BLOCK); CHANGED := FALSE END END "FINISHCAT"; PROCEDURE RESETCAT; VAR ELEM: CATENTRY; I: INTEGER; BEGIN OPEN_INTERNAL(CATFILE, CATADDRESS); CATLENGTH := FILES(.CATFILE.).FILELENGTH * CATPAGELENGTH; WITH ELEM DO BEGIN ID := NONAME; WITH ATTR DO BEGIN KIND := EMPTY; ADDR := 0; PROTECTED := FALSE; FOR I := 1 TO 5 DO NOTUSED(.I.) := 0; END; SEARCHLENGTH := 0; FORNGTH + 1 END; END END END "SEARCHNEW"; FUNCTION CATSPACE (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHNEW(ID); CATSPACE := (BUCKET.NAME = NONAME) END "CATSPACE"; FUNCTION CONTAINS (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHOLD (ID); WITH BUCKET DO CONTAINS := (NAME=ID) & (ID<>NONAME); END "CONTAINS"; PROCEDURE READATTR (ID: IDENTIFIER; VAR ATTR: FILEATTR); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ATTR := ELEM.ATTR END "WITH" END "READATTR";CATFULL ELSE IF (LENGTH<1)OR(LENGTH>MAPLENGTH) THEN RESULT := FILELIMIT ELSE IF NOT DISKSPACE(LENGTH) THEN RESULT := DISKFULL ELSE WITH ATTR DO BEGIN ALLOCATE(LENGTH, ADDR); KIND := SCRATCH; PROTECTED := FALSE; INCLUDE(ID, ATTR); RESULT := SUCCES END END "CREATE"; PROCEDURE DELETEIT (ID: IDENTIFIER; VAR RESULT: CATR.SEARCHLENGTH + 1; WRITECAT(START, ELEM) END "WITH" END "INCLUDE"; PROCEDURE EXCLUDE (ID: IDENTIFIER); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ELEM.ID := NONAME; ELEM.KEY := NOKEY; WRITECAT(INDEX, ELEM); READCAT(START, ELEM); ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH - 1; WRITECAT(START, ELEM) END "WITH" END "EXCLUDE"; " CLASS CATALOG **************" PROCEDURE SHORTEN (ADDR, NEWLENGTH: INTEGER); VAR I: INTEGER; MAP: FILEMAP; BEGIN ATTR DO BEGIN READATTR(OLDID, ATTR); IF ATTR.PROTECTED THEN RESULT := PROTECTION ELSE BEGIN EXCLUDE(OLDID); INCLUDE(NEWID, ATTR); RESULT := SUCCES END END; END "RENAME"; PROCEDURE GETIT (ID: IDENTIFIER; VAR KIND: FILEKIND; VAR PROTECTED: BOOLEAN; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF NOT CONTAINS(ID) THEN RESULT := NAMING ELSE BEGIN READATTR(ID, ATTR); KIND := AEMPTY, SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, IND := NEWKIND; PROTECTED := PROTECTION; INCLUDE(ID, ATTR); EXCLUDE('NEXT '); ALLOCATE(MAPLENGTH, ADDR); KIND := SCRATCH; PROTECTED := TRUE; INCLUDE('NEXT ',ATTR) END END; PROCEDURE MOVENEXT; VAR ATTR: FILEATTR; BEGIN WITH ATTR DO BEGIN READATTR('NEXT ', ATTR); EXCLUDE('NEXT '); RELEASE(ADDR); ALLOCATE(MAPLENGTH, ADDR); INCLUDE('NEXT ', ATTR) END END; PROCEDURE CREATEIT (ID: IDENTIFIER; SIZE: INTEGER); PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCD; PROTECTION: BOOLEAN; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF NOT CONTAINS(ID) THEN RESULT := NAMING ELSE IF (SIZE<1) OR (SIZE>MAPLENGTH) THEN RESULT := FILELIMIT ELSE BEGIN READATTR(ID, ATTR); EXCLUDE(ID); RELEASE(ATTR.ADDR); RESULT := SUCCES; CREATENEXT(ID, SIZE, KIND, PROTECTION) END END; PROCEDURE PROTECTIT (ID: IDENTIFIER; PROTECTION: BOOLEAN; VAR RESULT: CATRESULT); VAR ATTR: F: ARGSEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "######### # FILE # #########" CONST "IMPLEMENTATION CONSTANTS" DISK_SIZE = 4800 "PAGESE(ADDR); MOVENEXT; RESULT := SUCCES END END; END "DELETE"; PROCEDURE RENAMEIT (OLDID, NEWID: IDENTIFIER; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF CONTAINS(NEWID) OR NOT CONTAINS(OLDID) THEN RESULT := NAMING ELSE WITH ATTR DO BEGIN READATTR(OLDID, ATTR); IF ATTR.PROTECTED THEN RESULT := PROTECTION ELSE BEGIN EXCLUDE(OLDID); INCLUDE(NEWID, ATTR); RESULT := SUCCES )"; MAPLENGTH = 255; CATPAGELENGTH = 16; CATADDRESS = 154 "FIRSTPAGE+FREELISTLENGTH"; MAXDIGIT = 32767; ASCIIMAX = 127; "USEFUL CONSTANTS" NULL = 0; NOKEY = 0; NONAME = ' '; CATFILE = 1; "CLASS TELETYPE" SHORTTTYLINE = 70; TYPE "CLASS TELETYPE" STTYLINE = ARRAY (.1..SHORTTTYLINE.) OF CHAR; "CLASS CATALOG" FREESET = SET OF 0..FREESETLIMIT; FREESETEQUIVALENT = ARRAY (.1..SETLENGTH.) OF INTEGER; FREEPAGE = ARRAY (.0..FREEPAGEL r t v x z |                   " $ &         ! # % ' , . 0 2 4 6 8 : < > ( * - / 1 3 5 7 9 ; = ? ) + H J L N P R T V @ B D F I K M O Q S U W A C E G d f h j l n X Z \ ^ ` b e g i k m o Y [ ] _ a c p r t v x z | ~ q s u w y { }  AX); "CLASS MANAGER" COMMANDTYPE = (REPLACE, CREATE, DELETE, RENAME, PROTECT, NOTHING); VAR "CLASS CATALOG" FREELIST: RECORD FIRST, INDEX, FREEPAGES: INTEGER; CHANGED: BOOLEAN; FREE: FREEPAGE END; CAT: RECORD INDEX: INTEGER; CHANGED: BOOLEAN; BLOCK: CATPAGE END; CATLENGTH: INTEGER; BUCKET: RECORD NAME: IDENTIFIER; PROCEDURE GETBOOL (ARGNO: INTEGER; VAR BOOLIN: BOOLEAN; VAR OK: BOOLEAN); BEGIN WITH PARAM(.ARGNO.) DO BEGIN IF TAG <> BOOLTYPE THEN OK := FALSE ELSE BEGIN BOOLIN := BOOL; OK := TRUE END END END; PROCEDURE CHECKKIND (ID: IDENTIFIER; VAR KIND: FILEKIND; VAR OK: BOOLEAN); BEGIN OK := TRUE; IF ID = 'SCRATCH ' THEN KIND := SCRATCH ELSE IF ID = 'ASCII ' THEN KIND := ASCII ELSE IF ID = 'SEQCODE ' THEN KIND := SEQCODE ELSE IF ID = 'CONCODE ' THTYLINE); VAR I: INTEGER; C: CHAR; BEGIN I := 1; C := TEXT(.1.); WHILE (C <> '#') & (I < SHORTTTYLINE) DO BEGIN DISPLAY(C); I := I + 1; C := TEXT(.I.); END; DISPLAY(NL) END; PROCEDURE WRITEID (ID: IDENTIFIER); VAR TEXT: STTYLINE; I: INTEGER; BEGIN DISPLAY(NL); FOR I := 1 TO IDLENGTH DO TEXT(.I.) := ID(.I.); TEXT(.IDLENGTH + 1.) := '#'; WRITETEXT(TEXT) END; PROCEDURE WRITEINT(INT: INTEGER); VAR T: IDENTIFIER; REM, DIGIT, I, ZERO: INTEGER; BEGIN REM := INT; DIGIT := 0; ZERO := 1 .) END END; FUNCTION HASH (ID: IDENTIFIER): INTEGER; VAR KEY, I: INTEGER; C: CHAR; BEGIN KEY := 1; I := 0; REPEAT I := I+1; C := ID(.I.); IF C <> ' ' THEN KEY := KEY * ORD(C) MOD CATLENGTH + 1; UNTIL (C=' ') OR (I=IDLENGTH); HASH := KEY END "HASH"; PROCEDURE GETCAT (I: INTEGER); VAR PAGENO: INTEGER; BEGIN WITH CAT DO BEGIN PAGENO := (I-1) DIV CATPAGELENGTH + 1; IF INDEX <> PAGENO THEN BEGIN IF CHANGED THEN PUTPAGE(CATFILE, INDEX, BLOCK); INDEX := PAGENO; GETPAGE(CATFILE, INDEX, BLOC: INTEGER); BEGIN ADDR := FIRSTFREE; WITH FREELIST DO FREEPAGES := FREEPAGES - 1; END; PROCEDURE WRITEFREE (ADDR: INTEGER); VAR PPAGE, PSET, PELEM: INTEGER; BEGIN PELEM := ADDR MOD FREESETLENGTH; PSET := ADDR DIV FREESETLENGTH; PPAGE := PSET DIV FREEPAGELIMIT; PSET := PSET MOD FREEPAGELIMIT; GETFREE(PPAGE); WITH FREELIST DO BEGIN FREE(.PSET.) := FREE(.PSET.) OR (.PELEM.); CHANGED := TRUE; FREEPAGES := FREEPAGES + 1; FIRST := MIN(FIRST, ADDR) END END; PROCEDURE ALLOC; NAME := ELEM.ID; LENGTH := ELEM.SEARCHLENGTH; INDEX := START END END; PROCEDURE SEARCHOLD (ID: IDENTIFIER); VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY; BEGIN INITBUCKET(ID); WITH BUCKET DO IF ID <> NAME THEN BEGIN MORE := LENGTH; INDEX := START MOD CATLENGTH + 1; FOUND := FALSE; WHILE (MORE>0) & NOT FOUND DO BEGIN READCAT(INDEX, ELEM); NAME := ELEM.ID; IF ID = NAME THEN FOUND := TRUE ELSE BEGIN IF ELEM.KEY = START THENULT); BEGIN IF RESULT <> SUCCES THEN BEGIN CASE RESULT OF NAMING: WRITETEXT('NAME ERROR# '); CATFULL: WRITETEXT('CATALOG FULL# '); DISKFULL: WRITETEXT('DISK FULL#'); FILELIMIT: WRITETEXT('FILE LIMIT# '); PROTECTION: WRITETEXT('FILE PROTECTED# '); SYNTAX: HELP END; BADERROR := TRUE END END; PROCEDURE READCATPAGE (I: INTEGER; VAR ELEM: CATENTRY); VAR PAGENO: INTEGER; BEGIN WITH CAT DO BEGIN PAGENO := (I - 1) DIV CATPAGELENGTH + 1; IF INDEX < MORE := MORE - 1; INDEX := INDEX MOD CATLENGTH + 1 END; END END END "SEARCHNEW"; FUNCTION CATSPACE (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHNEW(ID); CATSPACE := (BUCKET.NAME = NONAME) END "CATSPACE"; FUNCTION CONTAINS (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHOLD (ID); WITH BUCKET DO CONTAINS := (NAME=ID) & (ID<>NONAME); END "CONTAINS"; PROCEDURE READATTR (ID: IDENTIFIER; VAR ATTR: FILEATTR); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN D: BOOLEAN; RESULT: CATRESULT; OK: BOOLEAN; ARG: IDENTIFIER; BEGIN GETID(2, ID, OK); IF NOT OK THEN RESULT := SYNTAX ELSE GETIT(ID, KIND, PROTECTED, RESULT); IF RESULT = SUCCES THEN TELLATTR(ID, KIND, PROTECTED); CATERROR(RESULT) END; PROCEDURE LISTCATALOG; VAR DUMMY: IDENTIFIER; ELEM: CATENTRY; LONG, OK: BOOLEAN; BEGIN GETID(2, DUMMY, OK); IF OK & (DUMMY = 'LONG ') THEN LONG := TRUE ELSE LONG := FALSE; PRINTFF; PRINTTEXT('CATALOG LIST# '); OTECT FILE: )# FILE(DELETE, ID)# FILE(PROTECT, ID, PROTECTED)# FILE(RENAME, OLDID, NEWID)#USING# ID, OLDID, NEWID: IDENTIFIER; # LENGTH: 0..255; # KIND: (SCRATCH, ASCII, SEQCODE, CONCODE); # PROTECTED: BOOLEAN; #DISK FAILURE PROCEED?#NAME ERROR# CATALOG FULL# DISK FULL#FILE LIMIT# FILE PROTECTED# CATALOG NEXT NEXT NEXT NEXT NEXT NEXT SCRATCH ASCII SEQCODE CONCODE REPLACE CREATE DELETE RENAME PRRINTINT(FILELENGTH); IF LONG THEN BEGIN PRINTNL; PRINTID(' '); PRINTID('PAGESET '); FOR J := 1 TO FILELENGTH DO PRINTINT(PAGESET(.J.)); PRINTNL END END; PRINTNL END END; END "LIST"; PROCEDURE DUMPDISK; VAR FIRST, LAST: INTEGER; OK: BOOLEAN; RESULT: CATRESULT; MODE: DUMPMODE; ID: IDENTIFIER; BEGIN GETINT(2, FIRST, OK); IF OK THEN GETINT(3, LAST, OK); IF OK THEN GETID(4,  j ( " >" "   X& " `(   $ >B|6(p*4d@X" L( X0 " " >"   P0>   L" X" B ` D; PROCEDURE LOADFILE; VAR ID: IDENTIFIER; OK: BOOLEAN; SOURCE: INTEGER; RESULT: CATRESULT; BEGIN GETID(2, ID, OK); IF OK THEN GETINT(3, SOURCE, OK); IF OK THEN LOADIT(ID, SOURCE, RESULT) ELSE RESULT := SYNTAX; CATERROR(RESULT) END; PROCEDURE SAVEFILES; BEGIN FINISHCAT; FINISHFREE END; PROCEDURE FINISHSESSION; BEGIN WRITETEXT('BYE, IT WAS A NICE SESSION# '); DONE := TRUE END; PROCEDURE DUMPFREE; VAR I, J, K, L: INTEGER; BEGIN L := 0; WITH FREELIST DO BEGIN FOR I := 0 TO F z ~ "    P>"" Z 02r  * x"2 B"   P>"|$   x"(   x ~2"F     *F  d  * F   p *: COMMANDTYPE; VAR OK, ERROR: BOOLEAN; ID: IDENTIFIER; BEGIN ERROR := FALSE; ASK('ACTION?# '); GETID(1, ID, OK); IF OK THEN IF ID = 'NEWCAT ' THEN COMMAND := NEWCAT ELSE IF ID = 'OLDCAT ' THEN COMMAND := OLDCAT ELSE IF ID = 'CREATE ' THEN COMMAND := CREATE ELSE IF ID = 'DELETE ' THEN COMMAND := DELETE ELSE IF ID = 'RENAME ' THEN COMMAND := RENAME ELSE IF ID = 'PUTATTR ' THEN COMMAND := PUTATTR ELSE IF ID = 'GETATTR ' THEN COMMAND := GET!  !#%' "$;=?),.02468:<>(*~ h j l n p i k m             ! # % '        " $ &        9 ; = ? ) + - / 1 3 5 7 : < > ( * , . 0 2 4 6 8 U W A C E G I K M O Q S V @ B D F H J L N P R T Y [ ] _ a c e g i k m o Z \ ^ ` b d f h j l n X u w y { }  q s v x z | ~ p r t SULT; BEGIN INITIALIZED := FALSE; REPEAT WRITETEXT('OLDCAT OR NEWCAT #'); CASE COMMAND OF OLDCAT: BEGIN INITFILES; INITIALIZED := TRUE END; NEWCAT: BEGIN CREATECATALOG(RESULT); IF RESULT = SUCCES THEN INITIALIZED := TRUE END; CREATE, DELETE, RENAME, PUTATTR, GETATTR, LIST, DUMP, DUMPF, LOAD, FINISH, DEBUGFREE, NOTHING: ; WHILE CH = EOL DO END_LINE UNTIL (CH=EOM) OR (CH='"'); IF CH = '"' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(COMMENT_ERROR) END; WHILE CH = ' ' DO BEGIN WRITE(CH); READ(CH) END; WHILE CH=EOL DO END_LINE UNTIL (CH<>' ') AND (CH<>'"') END; PROCEDURE INIT_OPTIONS; VAR STOP:SET OF CHAR; BEGIN END_LINE; NEW(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN OPTIONS:=(.LISTOPTION,CHECKOPTION,NUMBEROPTION.); MARK(RESETPOINT); := 1 TO MAXTTYLINE DO BUF(.I.) := ' '; WITH PAR DO BEGIN TAG := NILTYPE; ARG := ' '; ARG2 := 0 END; PARSED := FALSE; I := 0; J := 0; "CLASS TAPE" ERROR := FALSE; EF := FALSE; CPAGE := 0; CFILE := 0; "CLASS PRINTER" COL := 0; PRINTFF; PRINTABLES := LETTERS OR DIGITS OR (.'+', '-', '_', '"', '''', '#','&', '(', ')', '*', '=', '<', '>', ',', '.', '/', '?', '@', ':', ';'.); "CLASS CATALOG" WITH CAT DO BEGIN INDEX := 0;  >" B"   vZ   *     *   *6     *   **  VB    B  > J+""h" `X  ~* >"  * "=  LT: CATRESULT); VAR I: INTEGER; BLOCKALPHA: PAGE; BLOCKINT: INTPAGE; BEGIN PRINTNL; PRINTID('** PAGE NO '); PRINTINT(PAGENO); IF MODE = ALPHAMODE THEN BEGIN IOPAGE(BLOCKALPHA, INPUT, PAGENO); PRINTPAGEALPHA(BLOCKALPHA) END ELSE BEGIN IOPAGE(BLOCKINT, INPUT, PAGENO); PRINTPAGEINT(BLOCKINT) END; RESULT := SUCCES END; PROCEDURE DUMPIT (ID: IDENTIFIER; MODE: DUMPMODE; VAR RESULT: CATRESULT); VAR I: INTEGER; BEGIN IF CONTAINS(ID) THEN BEGIN PRINTFF; PRINTID(ID); TEM INITIALIZER PROGRAM# '); WRITETEXT('**************************# '); PRINTNL; FIRSTCOMMAND END; BEGIN "MANAGER" INITIALIZE; REPEAT BEGIN CASE COMMAND OF NEWCAT: CREATECATALOG(DUMMYRESULT); OLDCAT: INITFILES; CREATE: CREATEFILE; DELETE: DELETEFILE; RENAME: RENAMEFILE; PUTATTR: PUTFILE; GETATTR: GETFILE; LIST: LISTCATALOG; DUMP: DUMPDISK; LOAD: LOADFILE; DUMPF: DUMPFILE; FINISH: FINISHSESSION; DEBUGFREE: DUMPFREOR THEN WHILE (I <= FILELENGTH) & OK DO BEGIN READTAPE(BLOCK, TAPERESULT); IF TAPERESULT = COMPLETE THEN BEGIN IOPAGE(BLOCK, OUTPUT, PAGESET(.I.)); I := I + 1 END ELSE IF (TAPERESULT = ENDFILE) OR (TAPERESULT = ENDMEDIUM) THEN OK := FALSE ELSE BEGIN OK := FALSE; BLOCK(.1.) := EM; IOPAGE(BLOCK, OUTPUT, PAGESET(.I.)); I := 0 END; END; IF (I-1>"  :"(   ""  `$   B  (  "  `&  D$  ^l F~NB6*"* / BL>"  ^" "  LSE BEGIN INT := ARG2; OK := TRUE END END END; PROCEDURE GETBOOL (ARGNO: INTEGER; VAR BOOL: BOOLEAN; VAR OK: BOOLEAN); BEGIN WITH ARGS(.ARGNO.) DO BEGIN IF TAG <> BOOLTYPE THEN OK := FALSE ELSE BEGIN BOOL := ARG3; OK := TRUE END END END; PROCEDURE GETNIL (ARGNO: INTEGER; VAR OK: BOOLEAN); BEGIN WITH ARGS(.ARGNO.) DO IF TAG <> NILTYPE THEN OK := FALSE ELSE OK := TRUE END; PROCEDURE CHECKKIND (ID: IDENTIFIER; VAR KIND: FILEKIND; VAR OK: BOOLEAN); BEGIN OK    "$&(*,.!#%')+-/<>@BDF02468:=?A# % ' ) $ & ! n p ~ h j l i k m             ! # % '        " $ &        9 ; = ? ) + - / 1 3 5 7 : < > ( * , . 0 2 4 6 8 U W A C E G I K M O Q S V @ B D F H J L N P R T Y [ ] _ a c e g i k m o Z \ ^ ` b d f h j l n X u w y { }  p r t v x z | ~ q s NVKIND (KIND: FILEKIND; VAR ID: IDENTIFIER); BEGIN CASE KIND OF EMPTY: ID := 'EMPTY '; SCRATCH: ID := 'SCRATCH '; ASCII: ID := 'ASCII '; SEQCODE: ID := 'SEQCODE '; CONCODE: ID := 'CONCODE ' END END "CONVKIND"; PROCEDURE CONVPROTECTION (PROT: BOOLEAN; VAR ID: IDENTIFIER); BEGIN CASE PROT OF TRUE: ID := 'PROTECTED '; FALSE: ID := 'UNPROTECTED ' END END; PROCEDURE CONVBOOL (BOOL: BOOLEAN; VAR ID: IDENTIFIER); BEGIN CASE BOOL OF TRUE: ID := 'TR"t( " E" #^ FV26  >" E" n H " `0 E    >E# 8  ""0" >"    P >   L" X >" V  -     " \" XT); CONVKIND(KIND, ID); FILLBUFFER(2, ID, TEXT); CONVPROTECTION(PROTECTED, ID); FILLBUFFER(3, ID, TEXT) END; "CLASS MANAGER *************" PROCEDURE CREATECATALOG (VAR RESULT: CATRESULT); VAR CATSIZE, CATPAGES, DUMMYADDR: INTEGER; OK: BOOLEAN; BEGIN GETINT(2, CATSIZE, OK); IF NOT OK THEN RESULT := SYNTAX ELSE IF NOT (CATSIZE<=(MAPLENGTH*CATPAGELENGTH)) OR (CATSIZE<=0) THEN RESULT := FILELIMIT ELSE BEGIN RESETFREE; CATPAGES := (CATSIZE+CATPAGELENGTH-1) DIV  Z"JQ&"   "  L" H""    B" ` `2h R8& >"  >"  Z" " 8Jj"   B>P"  " " \ TTINT(3, LENGTH, OK); IF NOT OK THEN RESULT := SYNTAX ELSE CREATEIT(ID, LENGTH, RESULT); CATERROR(RESULT) END "CREATEFILE"; PROCEDURE DELETEFILE; VAR ID: IDENTIFIER; RESULT: CATRESULT; OK: BOOLEAN; ARG: IDENTIFIER; BEGIN GETID(2, ID, OK); IF NOT OK THEN RESULT := SYNTAX ELSE DELETEIT(ID, RESULT); CATERROR(RESULT) END "DELETEFILE"; PROCEDURE RENAMEFILE; VAR OLDID, NEWID: IDENTIFIER; OK: BOOLEAN; ARG: IDENTIFIER; RESULT: CATRESULT; BEGIN GETID(2, OLDID, OK); IF OK THEN GETID(3, NEWID, OK); IF NOT> "( >" B" Z   "(B  d  "$  V"\" P" L"  L"  P"   &n" >" ` 02F  n" Bx "Nx "fZx "Hfx "*rx " " 06  "4~"& tR*X\2<n4z,$vB  TRY AGAIN# FILE(CREATE, ID, LENGTH, KIND, PROTECTED) # FILE(REPLACE, ID, LENGTH,N BEGIN ERROR(NUMBER_ERROR); EXPONENT:=0 END; FOR I:=1 TO EXPONENT DO POWER_OF_TEN:=POWER_OF_TEN*REAL10; "NOW EITHER MANTISSA=0.0 OR MANTISSA>=1.0" IF MANTISSA = REAL0 THEN RESULT:= REAL0 ELSE IF EXPONENT_SIGN THEN RESULT:= MANTISSA / POWER_OF_TEN ELSE "IF MANTISSA>=1.0 THEN WE MUST HAVE: MANTISSA*POWER_OF_TEN<=MAX_REAL => POWER_OF_TEN<=MAX_REAL/MANTISSA<=MAX_REAL" IF POWER_OF_TEN<=MAX_REAL/MANTISSA THEN : " ^ "6 J 0 "V   "&  "6Z B 606 "P L " d  "$l   ^ " * "$u   ^ " " "$~   AME THEN BEGIN THIS_PIECE:=NAME.NEXT; I:=1; REPEAT IF THIS_PIECE=NIL THEN BEGIN SAME:=FALSE "CANDIDATE IS TOO SHORT"; I:=PIECES+1 "QUIT" END ELSE BEGIN "COMPARE AND INCREMENT" SAME:=SAME AND (THIS_PIECE@.PART=ID_TEXT(.I.)); THIS_PIECE:=THIS_PIECE@.NEXT; I:=I+1; END UNTIL I>PIECES; SAME:=SAME AND (THIS_PIECE=NIL) END; SAME_ID:=SAME END MONITOR2=22; PROCESS2=23; PERIOD2=24; STAR2=25; SLASH2=26; DIV2=27; MOD2=28; AND2=29; PLUS2=30; MINUS2=31; OR2=32; EQ2=33; NE2=34; LE2=35; GE2=36; LT2=37; GT2=38; IN2=39; CONST2=40; TYPE2=41; VAR2=42; PROCEDURE2=43; FUNCTION2=44; PROGRAM2=45; SEMICOLON2=46; CLOSE2=47; UP_TO2=48; OF2=49; COMMA2=50; PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN OPTIONS:=(.LISTOPTION,CHECKOPTION,NUMBEROPTION.); MARK(RESETPOINT); TABLES:=NIL; GET_CHAR(FALSE); IF CH='(' THEN BEGIN STOP:=(.',' , ')' , EOM.); REPEAT GET_CHAR(TRUE); IF CH='L' THEN OPTIONS:=OPTIONS-(.LISTOPTION.) ELSE IF CH='S' THEN OPTIONS:=OPTIONS OR (.SUMMARYOPTION.) ELSE IF CH='T' THEN OPTIONS:=OPTIONS OR (.TESTOPTION.) ELSE IF CH='C' THEN OPTIONS:=OPTIONS-(.CHE6579;CEG3PRTVXZ\^HJLNQSUWY[]_IKMOlnprtv`bdfhjmoqsuwac! & ~ h j l n p i k m             ! # % '        " $ &        9 ; = ? ) + - / 1 3 5 7 : < > ( * , . 0 2 4 6 8 U W A C E G I K M O Q S V @ B D F H J L N P R T Y [ ] _ a c e g i k m o Z \ ^ ` b d f h j l n X u w y { }  p r t v x z | ~ q s WORDLENGTH DO PUT_ARG(0); END_SCAN:=FALSE; LINE_NO:=0; CL1:='0'; CL2:='0'; CL3:='0'; CL4:='0'; CH:= EOL; UPTO_SW:=FALSE; BUS_SW:=FALSE; REAL0:= CONV(0); REAL1:= CONV(1); REAL10:= CONV(10); LARGEST_REAL(MAX_REAL); REAL_LIMIT:= MAX_REAL / REAL10; DIGITS:=(.'0','1','2','3','4','5','6','7','8','9'.); LETTERS:=(.'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','_'.); ALFAMERICS:=LETTERS OR DIGITS; STRING_"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 CONCURRENT PASCAL COMPILER PASS 1: LEXICAL ANALYSIS OCTOBER 1974" (CHECK, NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; SPLITLENGTH = 4 "WORDS PER SPLIT REAL"; MAX_STRING_LENGTH = 80 "CHARS"; WORDS_PER_STRING = 40 "MWITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID; NEXT:=NIL END END END; PROCEDURE LONG_STD_ID(ID1,ID2:PIECE; INDEX:SPELLING_INDEX); VAR CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO HASH_KEY:=HASH_KEY*(ORD(ID1(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID2(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID2(.CHAR_INDEX.)) MOD SPAN+1) MOD HASH_MAX1TION..NUMBEROPTION; PASSPTR = @PASSLINK; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG STD_ID('WITH ',-WITH2); STD_ID('IN ',-IN2); STD_ID('OF ',-OF2); STD_ID('WHILE ',-WHILE2); STD_ID('CASE ',-CASE2); STD_ID('REPEAT ',-REPEAT2); STD_ID('UNTIL ',-UNTIL2); STD_ID('PROCEDURE ',-PROCEDURE2); STD_ID('VAR ',-VAR2); STD_ID('FOR ',-FOR2); STD_ID('ARRAY ',-ARRAY2); STD_ID('RECORD ',-RECORD2); STD_ID('SET ',-SET2); STD_ID('TO ',-TO2); STD_ID('DOWNTO ',-DOWNTO2); STD_ID('HEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1 END; IF STRING_LENGTH = 1 THEN PUT1(CHAR2, ORD(STRING_TEXT(.1.))) ELSE PUT_STRING(STRING_TEXT, STRING_LENGTH) END; "##########" "IDENTIFIER" "##########" PROCEDURE IDENTIFIER; BEGIN PIECES:=-1; CHAR_INDEX:=ID_PIECE_LENGTH; HASH_KEY:= 1; REPEAT IF CHAR_INDEX=ID_PIECE_LENGTH THEN BEGIN CHAR_INDEX:= 0; PIECES:= SUCC(PIECES); ID_TEXT(.PIECES.):=BLANK; END ELSE CHAR_INDEX:= SUCC(CHAR_INDEX); ID_T ',-UNIV2); STD_ID('FALSE ',XFALSE); STD_ID('TRUE ',XTRUE); STD_ID('INTEGER ',XINTEGER); STD_ID('BOOLEAN ',XBOOLEAN); STD_ID('CHAR ',XCHAR); STD_ID('QUEUE ',XQUEUE); STD_ID('ABS ',XABS); STD_ID('ATTRIBUTE ',XATTRIBUTE); STD_ID('CHR ',XCHR); STD_ID('CONTINUE ',XCONTINUE); STD_ID('CONV ',XCONV); STD_ID('DELAY ',XDELAY); STD_ID('EMPTY ',XEMPTY); STD_ID('IO ',XIO); STD_ID('ORD ',XORD); CEDURE SCAN; BEGIN REPEAT CASE CH OF ' ': BEGIN WRITE(CH); READ(CH) END; EOL: END_LINE; EOM: END_SCAN:=TRUE; '"': BEGIN WRITE(CH); READ(CH); REPEAT WHILE (CH<>'"') AND (CH<>EOL)DO BEGIN WRITE(CH); READ(CH) END; IF CH=EOL THEN END_LINE UNTIL (CH='"') OR (CH=EOM); IF CH=EOM THEN ERROR(COMMENT_ERROR) ELSE BEGIN WRITE(CH); READ(CH) END END; '.': BEGIN WR CL4:='0'; IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEGIN CL3:='0'; IF CL2<'9' THEN CL2:=CHR(ORD(CL2)+1) ELSE BEGIN CL2:='0'; IF CL1<'9' THEN CL1:=CHR(ORD(CL1)+1) ELSE CL1:='0' END END END; WRITE(CL1); WRITE(CL2); WRITE(CL3); WRITE(CL4); WRITE(' '); WRITE(' '); IF CH = ' ' THEN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' ' END; PROCEDURE GET_CHAR(SKIP_FIRST:BOOLEAN); BEGIN IF SKIP_FIRST THEN BEGIN WRITE(CH);(.'''', EOL, EOM, '('.); BLANK:=' '; FOR S:=0 TO HASH_MAX DO HASH_TABLE(.S.).SPIX:=NULL; CURRENT_INDEX:=XREAL; STD_NAMES; INIT_OPTIONS; END; "######" "NUMBER" "######" PROCEDURE NUMBER; VAR MANTISSA,POWER_OF_TEN, RESULT: REAL; ERROR_SW,EXPONENT_SIGN:BOOLEAN; REAL_VAL:SPLITREAL; OP:INTEGER; EXPONENT,EXPONENT_PART,I:INTEGER; BEGIN OP:= INTEGER2; MANTISSA:= REAL0; ERROR_SW:= FALSE; EXPONENT:= 0; "COLLECT INTEGER PART" REPEAT IF MANTISSA<=RID_TEXT(.I.); P:=P1 END; P@.NEXT:=NIL END END END; PROCEDURE SEARCH_ID; VAR FINISHED:BOOLEAN; BEGIN FINISHED:=FALSE; REPEAT WITH HASH_TABLE(.HASH_KEY.) DO IF SPIX<>NULL THEN IF SAME_ID THEN "FOUND IT" BEGIN FINISHED:=TRUE; IF SPIX>=0 THEN BEGIN SYMB:=ID2; INDEX:=SPIX END ELSE SYMB:=ABS(SPIX) END ELSE HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1 ELSE "SYM=NULL" BEGIN TD_ID('UNTIL ',-UNTIL2); STD_ID('PROCEDURE ',-PROCEDURE2); STD_ID('VAR ',-VAR2); STD_ID('FOR ',-FOR2); STD_ID('ARRAY ',-ARRAY2); STD_ID('RECORD ',-RECORD2); STD_ID('SET ',-SET2); STD_ID('TO ',-TO2); STD_ID('DOWNTO ',-DOWNTO2); STD_ID('MOD ',-MOD2); STD_ID('OR ',-OR2); STD_ID('AND ',-AND2); STD_ID('NOT ',-NOT2); STD_ID('DIV ',-DIV2); STD_ID('CONST ',-CONST2); STD_ID('TYPE ; READ(CH); DONE:= FALSE; REPEAT WHILE NOT (CH IN STRING_SPECIAL) DO STRING_CHAR; CASE CH OF '''': BEGIN STRING_CHAR; IF CH = '''' THEN BEGIN WRITE(CH); READ(CH) END ELSE DONE:= TRUE END; EOL, EOM: BEGIN ERROR (STRING_ERROR); DONE:= TRUE END; '(': BEGIN STRING_CHAR; IF CH = ':' THEN BEGIN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' '; ; STD_ID('ORD ',XORD); STD_ID('PRED ',XPRED); STD_ID('SUCC ',XSUCC); STD_ID('TRUNC ',XTRUNC); STD_ID('REAL ',XREAL); END; PROCEDURE END_LINE; VAR I: INTEGER; BEGIN IF TEST THEN PRINT_TEST; WRITE(CH); READ(CH); LINE_NO:=LINE_NO+1; PUT1(NEW_LINE2,LINE_NO); IF CL4<'9' THEN CL4:=CHR(ORD(CL4)+1) ELSE BEGIN CL4:='0'; IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEGIN CL3:='0'; IF CL2<'9' THEN CL2:=CHR(ORD(ELSE ERROR(STRING_ERROR); IF ORD_VALUE > MAX_ORD THEN BEGIN ERROR(STRING_ERROR); ORD_VALUE:= ORD('?') END; STRING_TEXT(.STRING_LENGTH.):= CHR(ORD_VALUE) END END END UNTIL DONE; IF STRING_LENGTH <= 1 THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1; STRING_TEXT(.1.):= '?' END ELSE STRING_LENGTH:= STRING_LENGTH - 1; IF STRING_LENGTH > 1 THEN IF STRING_LENGTH MOD WORDLENGTH <> 0 T^ " " "" " x "f x "H *x "* 6x " "&$ H"$L" \   l   " zL"j  : IF EXPONENT_PART<=INTEGER_LIMIT THEN EXPONENT_PART:=EXPONENT_PART*10-ORD('0') +ORD(CH) ELSE ERROR_SW:=TRUE; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); "ASSERT EXPONENT <= 0;" IF EXPONENT_SIGN THEN IF MAX_EXPONENT + EXPONENT >= EXPONENT_PART THEN EXPONENT:= EXPONENT - EXPONENT_PART ELSE ERROR_SW:= TRUE ELSE EXPONENT:=EXPONENT+EXPONENT_PART END; "NOW CONSTRUCT THE NUMBER" IF OP=INTEGER2 THEN BEGIN IF MANTISSA> PART:PIECE; NEXT:PIECE_PTR END; SPLITREAL = ARRAY (.1..SPLITLENGTH.) OF INTEGER; PACKED_STRING = ARRAY (.1..WORDS_PER_STRING.) OF INTEGER; VAR REAL0, REAL1, REAL10, MAX_REAL, REAL_LIMIT: REAL; INTER_PASS_PTR:PASSPTR; CH:CHAR; LETTERS, DIGITS, ALFAMERICS, NON_ALFAS, STRING_SPECIAL: SET OF CHAR; TEST, UPTO_SW, BUS_SW, END_SCAN: BOOLEAN; CL1,CL2,CL3,CL4 "LINE NUMBER": CHAR; LINE_NO:INTEGER; PIECES: INTEGER "ID LENGTH IN PIECES"; TEST_BUF: ARRAY (.1..TEST_MDIGITS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF MANTISSA <= REAL_LIMIT THEN BEGIN MANTISSA:=MANTISSA*REAL10+CONV(ORD(CH)-ORD('0')); EXPONENT:=EXPONENT-1 END; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); END END; "COLLECT EXPONENT PART" IF CH='E' THEN BEGIN OP:=REAL2; WRITE(CH); READ(CH); EXPONENT_PART:=0; EXPONENT_SIGN:=FALSE; IF CH='+' THEN BEGIN WRITE(CH); READ(CH) END ELSE IF CH='-' THEN NAME:ID_PIECE END; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMI TRUE ELSE EXPONENT:=EXPONENT+EXPONENT_PART END; "NOW CONSTRUCT THE NUMBER" IF OP=INTEGER2 THEN BEGIN IF MANTISSA>CONV(MAX_INTEGER) THEN BEGIN ERROR(NUMBER_ERROR); MANTISSA:= REAL0 END; PUT1(INTEGER2,TRUNC(MANTISSA)) END ELSE "OP=REAL2" BEGIN IF ERROR_SW THEN BEGIN ERROR(NUMBER_ERROR); SPLIT(REAL0, REAL_VAL) END ELSE BEGIN "COMPUTE THE APPROPRIATE POWER OF TEN" POWER_OF_TEN:=REAL1; IF EXPONENT<0 THEN BEGIN END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PISSA*POWER_OF_TEN<=MAX_REAL => POWER_OF_TEN<=MAX_REAL/MANTISSA<=MAX_REAL" IF POWER_OF_TEN < MAX_REAL / MANTISSA THEN RESULT:= MANTISSA * POWER_OF_TEN ELSE BEGIN ERROR(NUMBER_ERROR); RESULT:= REAL0 END; SPLIT(RESULT, REAL_VAL) END; PUT0(REAL2); PUT1(LCONST2,REALLENGTH); FOR I:= 1 TO SPLITLENGTH DO PUT_ARG(REAL_VAL(.I.)) END END; "#######" "HASHING" "#######" FUNCTION SAME_ID:BOOLEAN; VAR SAME:BOOLEAN; THIS_PIECEOF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTFF; BEGIN WRITE(FF); PRINTED:= 0 END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRI I:=I+1; END UNTIL I>PIECES; SAME:=SAME AND (THIS_PIECE=NIL) END; SAME_ID:=SAME END END; PROCEDURE INSERT_ID; VAR I:INTEGER; P,P1:PIECE_PTR; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN CURRENT_INDEX:=CURRENT_INDEX+1; IF CURRENT_INDEX>=MAX_INDEX THEN BEGIN ERROR(INSERT_ERROR); CH:=EOM; WRITE(EOL) END; SPIX:=CURRENT_INDEX; WITH NAME DO BEGIN PART:=ID_TEXT(.0.); NEXT:=NIL END; IF PIECES>0 THEN BEGIIikgxz|~y{}     0246 "$&(*,.1357!#%')+-/LN8:<>@BDFHJMO9;=?ACEGIKPRTVXZ\^`bdfQSUWY[]_aceglnprhjmoqsikWHILE_STAT (KEYS: SETS); FORWARD; PROCEDURE REPEAT_STAT (KEYS: SETS); FORWARD; PROCEDURE FOR_STAT (KEYS: SETS); FORWARD; PROCEDURE WITH_STAT (KEYS: SETS); FORWARD; PROCEDURE EXPR (KEYS: SETS); FORWARD; PROCEDURE SEXPR (KEYS: SETS); FORWARD; PROCEDURE TERM (KEYS: SETS); FORWARD; PROCEDURE FACTOR (KEYS: SETS); FORWARD; PROCEDURE FACTOR_ID (KEYS: SETS); FORWARD; PROCEDURE VARIABLE (KEYS: SETS); FORWARD; PROCEDURE CONSTANT (KEYS: SETS); FORWARD; "##########" "INITIALIZE" ""AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 2: SYNTAX ANALYSIS OCTOBER 1974" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBEROPT QLABEL_TAIL: SETS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LEND; IF CH=':' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); IF ORD_VALUE > MAX_ORD THEN BEGIN ERROR(STRING_ERROR); ORD_VALUE:= ORD('?') END; STRING_TEXT(.STRING_LENGTH.):= CHR(ORD_VALUE) END END END UNTIL DONE; IF STRING_LENGTH <= 1 THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1;NK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(WORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT IN CHAR_INDEX:= 0; PIECES:= SUCC(PIECES); ID_TEXT(.PIECES.):=BLANK; END ELSE CHAR_INDEX:= SUCC(CHAR_INDEX); ID_TEXT(.PIECES,CHAR_INDEX.):=CH; HASH_KEY:=HASH_KEY*(ORD(CH) MOD SPAN +1) MOD HASH_MAX1; WRITE(CH); READ(CH) UNTIL CH IN NON_ALFAS; SEARCH_ID; IF SYMB=ID2 THEN PUT1(ID2,INDEX) ELSE BEGIN PUT0(SYMB); IF SYMB=END2 THEN BEGIN GET_CHAR(FALSE); IF CH='.' THEN BEGIN PUT0(PERIOD2); REPEAT WRITE(CH); READIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('2'); PRINTEOL END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END IF CH=EOM THEN ERROR(COMMENT_ERROR) ELSE BEGIN WRITE(CH); READ(CH) END END; '.': BEGIN WRITE(CH); READ(CH); IF UPTO_SW THEN BEGIN PUT0(UP_TO2); UPTO_SW:=FALSE END ELSE IF CH='.' THEN PUT0NC(UP_TO2) ELSE IF CH=')' THEN PUT0NC(BUS2) ELSE PUT0(PERIOD2) END; ':' : BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(BECOMES2) ELSE PUT0(COLON2) END; '<': BEGIN WRI1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; "#############" "PASS ROUTINES" "#############" "PARSING ROUTINES" PROCEDURE PROGRAM_ ; FORWARD; PROCEDURE PREFIX(KEYS: SETS); FORWARD; PROCEDURE INTERFACE (KEYS: SETS); FORWARD; PROCEDURE PROG_HEADING (KEYS: SETS); FORWARD; PROCEDURE BLOCK (KEYS: SETS); FORWARD; PROCE: IDENTIFIER; '(': BEGIN WRITE(CH); READ(CH); IF CH='.' THEN PUT0NC(SUB2) ELSE PUT0(OPEN2) END; ')': IF BUS_SW THEN BEGIN PUT0NC(BUS2); BUS_SW:=FALSE END ELSE PUT0NC(CLOSE2); ',': PUT0NC(COMMA2); ';': PUT0NC(SEMICOLON2); '*': PUT0NC(STAR2); '/': PUT0NC(SLASH2); '+': PUT0NC(PLUS2); '-': PUT0NC(MINUS2DURE VARIANT (KEYS: SETS); FORWARD; PROCEDURE LABEL_LIST (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD; PROCEDURE POINTER_TYPE (KEYS: SETS); FORWARD; PROCEDURE VAR_DEC (KEYS: SETS); FORWARD; PROCEDURE ID_LIST (KEYS: SETS; OP,ERROR_NUM: INTEGER; VAR ID_COUNT: INTEGER); FORWARD; PROCEDURE IDENTIFIER (KEYS: SETS; OP, ERROR_NUM: INTEGER); FORWARD; PROCEDURE ROUTINE_DEC (KEYS: SETS); FORWARD; PROCEDURE PROC_DEC (KEYS: SETS); FORWARD; PROCEDURE PROC_HEADING (KEYS: SETS); FORWARD; PRORUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN STORE_TEST(ARG) END; PROCEDURE PUT0NC(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP); WRITE(CH); READ(CH) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN STORE_TEST(OINDEX:=SPIX END ELSE SYMB:=ABS(SPIX) END ELSE HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1 ELSE "SYM=NULL" BEGIN INSERT_ID; SYMB:=ID2; INDEX:=CURRENT_INDEX; FINISHED:=TRUE END UNTIL FINISHED "WITH SEARCH" END; "######" "STRING" "######" PROCEDURE STRING_CHAR; BEGIN IF STRING_LENGTH = MAX_STRING_LENGTH THEN ERROR(STRING_ERROR) ELSE BEGIN STRING_LENGTH:=STRING_LENGTH+1; STRING_TEXT(.STRING_LENGTH.):= CH; NUM:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,ERROR_NUM) END; "##########" "INITIALIZE" "##########" PROCEDURE STD_ID(ID:PIECE; INDEX:SPELLING_INDEX); VAR S:SPELLING_INDEX; CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; "NOW WE HAVE ENTRY SLOT" '(': BEGIN STRING_CHAR; IF CH = ':' THEN BEGIN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' '; ORD_VALUE:= 0; IF CH IN DIGITS THEN REPEAT IF ORD_VALUE <= MAX_ORD THEN ORD_VALUE:= ORD_VALUE * 10 + (ORD(CH) - ORD('0')); WRITE(CH); READ(CH) UNTIL NOT (CH IN DIGITS) ELSE ERROR(STRING_ERROR); WHILE CH=' ' DO BEGIN WRITE(CH); READ(CH) QDO_TAIL, QUNARY, QFACTOR, QEXPR, QUNTIL_TAIL, QFOR_END, QFORB_END, QEXPR_OP, QSEXPR_OP, QTERM_OP, QTERM_LIST, QFACTOR_LIST, QSET_EXPR, QSELECT, QSUB_END, QARG, QCOMMA, QVARIANT_PART, QTYPE_LIST, QWITH_LIST, QFIELD_LIST, QTO_TAIL, QFIELD_PACK, QID_SEMI, QVARIANT, QPROGRAM, QID_OPEN, QID_CASE, QSEMI_CASE,YS1); CHECK(CONSTDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; PROCEDURE TYPE_DEC; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QTYPE_DEF; LKEYS2:=KEYS-QTYPE_DEF; GET; REPEAT IDENTIFIER(LKEYS1,TYPE_ID2,TYPEDEF_ERROR); IF SY=EQ1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); TYPE_(LKEYS1); PUT0(TYPE_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(TYPEDEF_ERROR,LKEYS1); CHECK(TYPEDEF_ERROR,LKEYS1) UNTIL SY IN LKEYS2 END; "####" "TYPE" "####" NOT1=14; SUB1=15; SET1=16; ARRAY1=17; RECORD1=18; ARROW1=19; PERIOD1=20; STAR1=21; SLASH1=22; DIV1=23; MOD1=24; AND1=25; PLUS1=26; MINUS1=27; OR1=28; EQ1=29; NE1=30; LE1=31; GE1=32; LT1=33; GT1=34; IN1=35; CONST1=36; TYPE1=37; VAR1=38; PROCEDURE1=39; FUNCTION1=40; PROGRAM1=41; SEMICOLON1=42; 1.); QCLOSE:=(.CLOSE1.); QEOM:=(.EOM1.); QEND:=(.END1.); QSEMICOLON:=(.SEMICOLON1.); QBODY:=(.BEGIN1.); QID:=(.ID1.); QDEFINITIONS:=(.CONST1,TYPE1.); QROUTINES:=(.PROCEDURE1,FUNCTION1.); QDECLARATIONS:=QDEFINITIONS OR (.VAR1.) OR QROUTINES; QDEF:=(.ID1,SEMICOLON1,EQ1.); QDEC:=(.ID1,SEMICOLON1,COLON1.); QCONSTANT:=(.ID1,INTEGER1,REAL1,CHAR1,STRING1.); QCONST_DEF:=QDEF OR QCONSTANT; QTYPE:=(.OPEN1,SET1,ARRAY1,RECORD1,ARROW1.) OR QCONSTANT; QTYPE_DEF:=QDEF OR QTY=10; FORWARD2=11; FUNC_ID2=12; FUNC_DEF2=13; POINTER2=14; FUNC_TYPE2=15; PROG_ID2=16; PROG_DEF2=17; VARNT_END2=18; TYPE2=19; ENUM2=20; ENUM_ID2=21; ENUM_DEF2=22; SUBR_DEF2=23; SET_DEF2=24; ARRAY_DEF2=25; REC2=26; FIELD_ID2=27; FIELDLIST2=28; REC_DEF2=29; VARNT2=30; PARM_ID2=31; PARM_TYPE2=32; UNIV_TYPE2=33; CPARMLIST2=34; VPARMLIST2=35; BODY2=36; BODY_END2=37; ANAME2=38; CK; QPARM_LIST:=QDEC OR (.UNIV1,VAR1.); QSTAT:=(.ID1,BEGIN1,IF1,CASE1,WHILE1,REPEAT1,FOR1,WITH1.); QBODY_END:=QSTAT OR QEND; QSTAT_LIST :=QSTAT OR QSEMICOLON; QID_END:=(.BECOMES1,OPEN1.); QIF_END:=(.THEN1,ELSE1.) OR QSTAT; QTHEN_END:=QIF_END-(.THEN1.); QCASES:=QCONSTANT OR QSTAT OR (.COLON1,COMMA1,SEMICOLON1.); QCASE_END:=QCASES OR (.OF1,END1.); QLABEL_LIST:=QCONSTANT OR QCOMMA; QLABEL_TAIL:=QLABEL_LIST OR (.COLON1.); QDO_TAIL:=QSTAT OR (.DO1.); QUNARY:=(. UMINUS2=68; PLUS2=69; MINUS2=70; OR2=71; STAR2=72; SLASH2=73; DIV2=74; MOD2=75; AND2=76; FNAME2=77; NOT2=78; EMPTY_SET2=79; INCLUDE2=80; FUNCTION2=81; CALL_FUNC2=82; NAME2=83; COMP2=84; SUB2=85; ARROW2=86; CONSTANT2=87; REAL2=88; FREAL2=89; INTEGER2=90; FINTEGER2=91; CHAR2=92; FCHAR2=93; STRING2=94; FSTRING2=95; NEW_LINE2=96; LCOET_EXPR:=QARGUMENT OR (.BUS1.); QSELECT:=(.PERIOD1,SUB1,ARROW1.); QSUB_END:=QARGUMENT OR (.BUS1.); QWITH_LIST:=QDO_TAIL OR QCOMMA; QTO_TAIL:=QDO_TAIL OR QEXPR; QPROGRAM := (.PROGRAM1.); QID_SEMI := (.ID1, SEMICOLON1.); QID_OPEN := (.ID1, OPEN1.); QID_CASE := (.ID1, CASE1.); QSEMI_CASE := (.SEMICOLON1, CASE1.); QFIELD_LIST := QVAR_DEF OR QID_CASE; QVARIANT_PART := QCONSTANT OR (.COLON1, OF1, SEMICOLON1.); QVARIANT := QCONSTANT OR QSEMICOLON; QFIELD_PACK := OR=3; TYPEDEF_ERROR=4; TYPE_ERROR=5; ENUM_ERROR=6; SUBR_ERROR=7; SET_ERROR=8; ARRAY_ERROR=9; RECORD_ERROR=10; STACK_ERROR=11; VAR_ERROR=12; ROUTINE_ERROR=13; PROC_ERROR=14; FUNC_ERROR=15; WITH_ERROR=16; PARM_ERROR=17; BODY_ERROR=18; STATS_ERROR=19; STAT_ERROR=20; IDSTAT_ERROR=21; ARG_ERROR=22; COMP_ERROR=23; IF_ERROR=24; CASE_ERROR=25; POINTER_ERROR=36; WHILE_ERROR=27; REPEAT_ERROR=28; FOR_ERROR=29; PREFIX_ERROR=37; EXPR_ERLOCK OR QEOM); BLOCK(QEOM); IF SY=PERIOD1 THEN GET ELSE ERROR(PROG_ERROR,QEOM); IF SY<>EOM1 THEN ERROR(PROG_ERROR,QEOM); PUT0(EOM2) END; PROCEDURE PREFIX; VAR LKEYS1: SETS; BEGIN LKEYS1:=KEYS OR QDEFINITIONS OR QROUTINES OR QPROGRAM; CHECK(PREFIX_ERROR, LKEYS1); WHILE SY IN QDEFINITIONS DO BEGIN IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1); CHECK(PREFIX_ERROR, LKEYS1) END; INTERFACE(KEYS OR QPROGRAM); PROG_HEADING(KEYS) END; PROCXWAIT=23; XREAL=24; TYPE SPELLING_INDEX=0..SPELLING_MAX; TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; LABEL=INTEGER; SYMBOL=EOM1..NEW_LINE1; SETS=SET OF SYMBOL; VAR INTER_PASS_PTR:PASSPTR; SY:SYMBOL; ARG:INTEGER; CURRENT_LABEL:LABEL; TEST:BOOLEAN; "KEY SETS" QIGNORE, QOPEN, QCLOSE, QEOM, QEND, QSEMICOLON, QBODY, QID, QDEFINITIONS, QROUTINES, QDECLARATIONS, QDEF, QDEC, QCONSLON); PUT0(PROG_DEF2); IF SY=SEMICOLON1 THEN GET ELSE ERROR(PROG_ERROR, KEYS); END; "#####" "BLOCK" "#####" PROCEDURE BLOCK; BEGIN DECLARATIONS(KEYS OR QBODY); BODY(KEYS) END; "############" "DECLARATIONS" "############" PROCEDURE DECLARATIONS; VAR LKEYS1,LKEYS2:SETS; BEGIN LKEYS1:=KEYS OR QDECLARATIONS; LKEYS2:=KEYS OR QROUTINES; CHECK(DEC_ERROR,LKEYS1); WHILE SY IN QDEFINITIONS DO BEGIN IF SY=CONST1 THEN CONST_DEC(LKEYS1) ELSE TYPE_DEC(LKEYS1); ERROR(ERROR_NUM,KEYS); PUT1(OP,XUNDEF) END END; "########" "ROUTINES" "########" PROCEDURE ROUTINE_DEC; VAR LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QROUTINES; REPEAT CASE SY OF PROCEDURE1: PROC_DEC(LKEYS1); FUNCTION1: FUNC_DEC(LKEYS1) END; IF SY=SEMICOLON1 THEN GET ELSE ERROR(ROUTINE_ERROR, LKEYS1); CHECK(ROUTINE_ERROR,LKEYS1); UNTIL NOT(SY IN QROUTINES) END; PROCEDURE PROC_DEC; BEGIN PROC_HEADING(KEYS OR QFBLOCK); CHECK(P[     0246 "$&(*,.1357!#%')+-/LN8:<>@BDFHJMO9;=?ACEGIKPRTVXZ\^`bdfQSUWY[]_aceglnprtvxz|~hjmoqsuwy{}ik PROCEDURE TYPE_; BEGIN CHECK(TYPE_ERROR,KEYS OR QTYPE); IF SY IN QTYPE THEN CASE SY OF OPEN1: ENUM_TYPE(KEYS); ID1,INTEGER1,REAL1,CHAR1,STRING1: SUBR_TYPE(KEYS); SET1: SET_TYPE(KEYS); ARRAY1: ARRAY_TYPE(KEYS); RECORD1: RECORD_TYPE(KEYS); ARROW1: POINTER_TYPE(KEYS) END ELSE BEGIN ERROR(TYPE_ERROR,KEYS); PUT1(TYPE2,XUNDEF) END END; PROCEDURE ENUM_TYPE; VAR NUMBER:INTEGER; BEGIN PUT0(ENUM2); GET; ID_LIH_COUNT DO PUT0(WITH2) END; "##########" "EXPRESSION" "##########" PROCEDURE EXPR; VAR OP:INTEGER; BEGIN SEXPR(KEYS OR QEXPR_OP); CHECK(EXPR_ERROR,KEYS OR QEXPR_OP); IF SY IN QEXPR_OP THEN BEGIN CASE SY OF EQ1: OP:=EQ2; NE1: OP:=NE2; LE1: OP:=LE2; GE1: OP:=GE2; LT1: OP:=LT2; GT1: OP:=GT2; IN1: OP:=IN2 END; PUT0(VALUE2); GET; SEXPR(KEYS); PUT0(OP) END END; PROCEDURE SEXPR; VAR UNARY:BOOLEAN; GET ELSE ERROR(SUBR_ERROR,KEYS OR QCONSTANT); CONSTANT(KEYS); PUT0(SUBR_DEF2) END END; PROCEDURE SET_TYPE; BEGIN GET; IF SY=OF1 THEN GET ELSE ERROR(SET_ERROR,KEYS OR QTYPE); TYPE_(KEYS); PUT0(SET_DEF2) END; PROCEDURE ARRAY_TYPE; VAR LKEYS1:SETS; I,DIMENSIONS:INTEGER; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QDIMENSION; GET; IF SY=SUB1 THEN GET ELSE ERROR(ARRAY_ERROR,LKEYS1); DIMENSIONS:=0; DONE:=FALSE; REPEAT "INDEX"TYPE_(LKEYS1); DIMENSIOR1: OP:=OR2 END; GET END ELSE BEGIN ERROR(EXPR_ERROR,LKEYS1); OP:=PLUS2 END; TERM(LKEYS1); PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); UNTIL NOT(SY IN QTERM_LIST) END END; PROCEDURE TERM; VAR OP:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QFACTOR_LIST; FACTOR(LKEYS1); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QFACTOR_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QTERM_OP THEN BEGIN CASE SY OF EN GET ELSE ERROR(RECORD_ERROR,KEYS); END; PROCEDURE FIELD_LIST; VAR LKEYS1: SETS; NUMBER: INTEGER; DONE: BOOLEAN; BEGIN LKEYS1 := KEYS OR QFIELD_LIST; DONE := FALSE; REPEAT CHECK(RECORD_ERROR, LKEYS1); IF SY<>CASE1 THEN BEGIN ID_LIST(LKEYS1, FIELD_ID2, RECORD_ERROR, NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS1); TYPE_(LKEYS1); PUT1(FIELDLIST2, NUMBER); CHECK(RECORD_ERROR, LKEYS1); IF SY IN QFIELD_LIST THEN SY OF REAL1: BEGIN PUT0(FREAL2); GET END; STRING1: BEGIN PUT1(FSTRING2,ARG); GET END; INTEGER1: BEGIN PUT1(FINTEGER2,ARG); GET END; CHAR1: BEGIN PUT1(FCHAR2,ARG); GET END; ID1: FACTOR_ID(KEYS); OPEN1: BEGIN GET; EXPR(KEYS OR QCLOSE); IF SY=CLOSE1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END; NOT1: BEGIN GET; FACTOR(KEYS); PUT0(NOT2) END; SUB1: BEGIN GET; PUT0(EMPTY_SET2); LKEYS1:=KE IF SY=OF1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2); DONE := FALSE; REPEAT VARIANT(LKEYS2); CHECK(RECORD_ERROR, LKEYS2); IF SY IN QVARIANT THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(RECORD_ERROR, LKEYS2) ELSE DONE := TRUE UNTIL DONE; PUT0(PART_END2) END; PROCEDURE VARIANT; BEGIN PUT0(VARNT2); LABEL_LIST(KEYS OR QFIELD_PACK, LABEL2, RECORD_ERROR); IF SY=OPEN1 THEN GET ELSE ERROR(RECORD_ERROR, KEYS OR QID_CASE OR QCLOSE); FIELD_LIST(KEYS OCK(EXPR_ERROR, KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(FUNCTION2); ARG_LIST(KEYS); PUT0(CALL_FUNC2) END ELSE PUT0(FNAME2) END; "########" "VARIABLE" "########" PROCEDURE VARIABLE; VAR LKEYS1,LKEYS2:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QSELECT; IDENTIFIER(LKEYS1,NAME2,VARIABLE_ERROR); CHECK(VARIABLE_ERROR,LKEYS1); WHILE SY IN QSELECT DO BEGIN CASE SY OF PERIOD1: BEGIN PUT0(ADDRESS2); GET; IDENTIFIER(LKEYSNUM, KEYS) END; PROCEDURE POINTER_TYPE; BEGIN GET; IDENTIFIER(KEYS, POINTER2, POINTER_ERROR) END; "#########" "VARIABLES" "#########" PROCEDURE VAR_DEC; VAR NUMBER:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QVAR_DEF; GET; REPEAT ID_LIST(LKEYS1,VAR_ID2,VAR_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); "VAR"TYPE_(LKEYS1); PUT1(VAR_LIST2, NUMBER); IF SY=SEMICOLON1 THEN GET ELSE ERROR(VAR_ERROR,LKEYS1); CHECK(VAR_E END END; CHECK(VARIABLE_ERROR,LKEYS1) END END; PROCEDURE CONSTANT; BEGIN CHECK(CONSTANT_ERROR,KEYS OR QCONSTANT); IF SY IN QCONSTANT THEN BEGIN CASE SY OF ID1: PUT1(CONSTANT2,ARG); INTEGER1: PUT1(INTEGER2,ARG); REAL1: PUT0(REAL2); CHAR1: PUT1(CHAR2,ARG); STRING1: PUT1(STRING2,ARG) END; GET END ELSE BEGIN ERROR(CONSTANT_ERROR,KEYS); PUT1(CONSTANT2,XUNDEF) END END; "############" "MAIN PROGRAM"IELD,NEW_TAG_FIELD, RESET_NOUN: NOUN_INDEX; THIS_VARIANT:VARIANT_PTR; VARIANT_LABELS,TAG_LABELS: TAG_SET; TAG_STACK: ARRAY (.TAG_INDEX.) OF RECORD PREV_LABELS:TAG_SET; PREV_TAG,PREV_TYPE:NOUN_INDEX END; UPDATES:ARRAY (.UPDATE_INDEX.) OF UPDATE_REC; DISPLAY:ARRAY (.LEVEL_INDEX.) OF DISPLAY_REC; THIS_LEVEL,BODY_LEVEL: LEVEL_INDEX; SPELLING_TABLE:ARRAY (.SPELLING_INDEX.) OF SPELLING_ENTRY; "############################" "COMMON TEST OUTPUT MECHANISM" "###############ME_ACCESS); BEGIN SPELLING_TABLE(.SPIX.).ACCESS:=A; T:=T-1 END; PROCEDURE ENTER_NAMES(LIST:NAME_PTR; ACCESS:NAME_ACCESS); VAR THIS_NAME:NAME_PTR; BEGIN THIS_NAME:=LIST; WHILE THIS_NAME<>NIL DO WITH THIS_NAME@ DO BEGIN UPDATE(NAME_SPIX,NAME_ENTRY,ACCESS); THIS_NAME:=NEXT_NAME END END; FUNCTION DEFINED:BOOLEAN; BEGIN DEFINED:=OPS(.T.).CLASS<>UNDEF_CLASS END; FUNCTION TOP:ENTRY_PTR; BEGIN TOP:=OPS(.T.).DEF_ENTRY END; PROCEDURE DE LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTIN CONSTANTS THEN CASE CLASS OF ICONST_CLASS: BEGIN KIND:=INDEX_CONST; CONST_TYPE:=ICONST_TYPE; CONST_VAL:=ICONST_VAL END; RCONST_CLASS: BEGIN KIND:=REAL_CONST; REAL_DISP:=RCONST_DISP END; SCONST_CLASS: BEGIN KIND:=STRING_CONST; STRING_LENGTH:=SCONST_LENGTH; STRING_DISP:=SCONST_DISP END END ELSE EWITH_STAT; VAR WITH_COUNT,I:INTEGER; LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QWITH_LIST; WITH_COUNT:=0; GET; DONE:=FALSE; REPEAT PUT0(WITH_VAR2); VARIABLE(LKEYS1); PUT0(WITH_TEMP2); WITH_COUNT:=WITH_COUNT+1; CHECK(WITH_ERROR,LKEYS1); IF SY IN QID_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(WITH_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=DO1 THEN GET ELSE ERROR(WITH_ERROR,KEYS OR QSTAT); STAT(KEYS); FOR I:=1 TO WIT FEW_ARGS_ERROR=6; ARG_LIST_ERROR=7; MANY_ARGS_ERROR=8; LBLRANGE_ERROR=9; LBLTYPE_ERROR=10; AMBILBL_ERROR=11; WITH_ERROR=12; ARROW_ERROR=20; PROC_USE_ERROR=14; NAME_ERROR=15; COMP_ERROR=16; SUB_ERROR=17; CALL_NAME_ERROR=19; RESOLVE_ERROR=21; "MISCELANEOUS" NOT_POSSIBLY_FORWARD=FALSE; POSSIBLY_FORWARD=TRUE; OUTPUT=TRUE; RETAIN=FALSE; PROC_TYPE=NIL; STD_LEVEL=0; PREFIX_LEVEL=1; GLOBAL_LEVEL=2; TYPE ENTRY_KIND=(INDEX_CONST,REAL_CONST,STRING_CONST,V; VAR LIST_OP,TYPE_OP,NUMBER:INTEGER; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QPARM_LIST OR QCLOSE; CHECK(PARM_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN GET; DONE:=FALSE; REPEAT CHECK(PARM_ERROR,LKEYS1); IF SY=VAR1 THEN BEGIN GET; LIST_OP:=VPARMLIST2 END ELSE LIST_OP:=CPARMLIST2; ID_LIST(LKEYS1,PARM_ID2,PARM_ERROR,NUMBER); IF SY=COLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1); CHECK(PARM_ERROR,LKEYS1); IFPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: PASSPTR) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; CONST PAGELENGTH = 256; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE NOTUSED1; PROCEDURE NOTUSED2; PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE); FUNCTION FILE_LENGTH(F:FILE): INTEGEET ELSE ERROR(BODY_ERROR,KEYS OR QBODY_END); STAT_LIST (KEYS OR QEND); PUT0(BODY_END2); IF SY=END1 THEN GET ELSE ERROR(BODY_ERROR,KEYS) END; PROCEDURE STAT_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QSTAT_LIST; DONE:=FALSE; REPEAT STAT(LKEYS1); CHECK(STATS_ERROR,LKEYS1); IF SY IN QSTAT_LIST THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(STATS_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE STAT; BEGIN CHECK(SER1=14; FUNC_TYPE1=15; PROG_ID1=16; PROG_DEF1=17; VARNT_END1=18; TYPE1=19; ENUM1=20; ENUM_ID1=21; ENUM_DEF1=22; SUBR_DEF1=23; SET_DEF1=24; ARRAY_DEF1=25; REC1=26; FIELD_ID1=27; FIELDLIST1=28; REC_DEF1=29; VARNT1=30; PARM_ID1=31; PARM_TYPE1=32; UNIV_TYPE1=33; CPARMLIST1=34; VPARMLIST1=35; BODY1=36; BODY_END1=37; ANAME1=38; STORE1=39; CALL_NAME1=40; CALL1=41; ARG_LIST1=42;0(ANAME2); GET; EXPR(KEYS); PUT0(STORE2) END ELSE BEGIN PUT0(CALL_NAME2); ARG_LIST(KEYS); PUT0(CALL2) END END; PROCEDURE ARG_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN CHECK(ARG_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(ARG_LIST2); GET; DONE:=FALSE; LKEYS1:=KEYS OR QARG_END; REPEAT EXPR(LKEYS1); PUT0(ARG2); CHECK(ARG_ERROR,LKEYS1); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(ARG_ERROR,LKEYS1) STAR1=72; SLASH1=73; DIV1=74; MOD1=75; AND1=76; FNAME1=77; NOT1=78; EMPTY_SET1=79; INCLUDE1=80; FUNCTION1=81; CALL_FUNC1=82; NAME1=83; COMP1=84; SUB1=85; ARROW1=86; CONSTANT1=87; REAL1=88; FREAL1=89; INTEGER1=90; FINTEGER1=91; CHAR1=92; FCHAR1=93; STRING1=94; FSTRING1=95; NEW_LINE1=96; LCONST1=97; MESSAGE1=98; TAG_ID1=99; TAG_TYPE1=100F SY=ELSE1 THEN BEGIN NEW_LABEL(L2); PUT2(JUMP_DEF2,L2,L1); GET; STAT(KEYS); PUT1(DEF_LABEL2,L2) END ELSE PUT1(DEF_LABEL2,L1) END; PROCEDURE CASE_STAT; VAR L0,LI,LN:LABEL; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QCASES; GET; NEW_LABEL(L0); NEW_LABEL(LN); EXPR(KEYS OR QCASE_END); PUT1(CASE_JUMP2,L0); DONE:=FALSE; IF SY=OF1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1); REPEAT NEW_LABEL(LI); PUT1(DEF_CASE2,LI); LABEL_LIST(LKEYS1, CASE2 FUNCF_DEF2=24; PARM_TYPE2=25; UNIV_TYPE2=26; CPARMLIST2=27; VPARMLIST2=28; BODY2=29; BODY_END2=30; ADDRESS2=31; RESULT2=32; STORE2=33; CALL_PROC2=34; PARM2=35; FALSEJUMP2=36; DEF_LABEL2=37; JUMP_DEF2=38; JUMP2=39; CHK_TYPE2=40; CASE_LIST2=41; FOR_STORE2=42; FOR_LIM2=43; FOR_UP2=44; FOR_DOWN2=45; WITH_VAR2=46; WITH_TEMP2=47; WITH2=48; VALUE2=49; LT2=50; EQ2=51; _ERROR,KEYS OR QSTAT); STAT(KEYS); PUT2(JUMP_DEF2,L1,L2) END; PROCEDURE REPEAT_STAT; VAR L:LABEL; BEGIN NEW_LABEL(L); PUT1(DEF_LABEL2,L); GET; STAT_LIST (KEYS OR QUNTIL_TAIL); IF SY=UNTIL1 THEN GET ELSE ERROR(REPEAT_ERROR,KEYS OR QEXPR); EXPR(KEYS); PUT1(FALSEJUMP2,L) END; PROCEDURE FOR_STAT; CONST UP=5; DOWN=3; VAR L1,L2:LABEL; LKEYS1:SETS; OP,DIRECTION:INTEGER; BEGIN LKEYS1:=KEYS OR QFORB_END; GET; NEW_LABEL(L1); NEW_LABEL(L2); IDENTIFIER CALL_NEW2=82; UNDEF2=83; VARIANT2=84; MODE2=85; "OTHER CONSTANTS" MIN_CASE=0; MAX_CASE=127; THIS_PASS=3; SPELLING_MAX=700; TEXT_LENGTH = 18; INFILE = 1; OUTFILE = 2; NOUN_MAX=700; OPERAND_MAX=150; UPDATE_MAX=100; UPDATE_MAX1=101; MAX_LEVEL=15; MAX_TAG=15; MIN_TAG=0; TAG_STACK_MAX=5; "MODES" PROC_MODE=1; FUNC_MODE=2; PROGRAM_MODE=3; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PACK(LONG_SET: UNIV UNIV_SET; VAR SHORT_SET: PACKED_SET); BEGIN SHORT_SET:= LONG_SET(.1.) END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= IX,NIL,INCOMPLETE); UNRES_TYPE: IF LEVEL<>THIS_LEVEL THEN ERROR_SW:=TRUE ELSE UNRESOLVED:=UNRESOLVED-1; UNRES_ROUTINE: ERROR_SW:=TRUE END ELSE ERROR_SW:=TRUE; IF ERROR_SW THEN ERROR(NAME_ERROR); PUSH; WITH OPS(.T.) DO IF ERROR_SW THEN CLASS:=UNDEF_CLASS ELSE BEGIN CLASS:=DEF_CLASS; DEF_SPIX:=SPIX END END; PROCEDURE TYPE_DEF; VAR TYP,FWD_REF:ENTRY_PTR; BEGIN WITH OPS(.T-1.) DO IF CLASSARIABLE, PARAMETER,FIELD,SCALAR_KIND,ROUTINE_KIND,SET_KIND, POINTER_KIND,ARRAY_KIND,RECORD_KIND,WITH_KIND,UNDEF_KIND); OPERAND_CLASS=(VAR_CLASS,ROUTINE_CLASS,ICONST_CLASS,RCONST_CLASS,SCONST_CLASS, DEF_CLASS,UNDEF_CLASS,FCONST_CLASS,CASE_LABEL); ERROR_NOTE=(YES,NO,SUPPRESS); TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR; TAG_SET=SET OF MIN_TAG..MAX_TAG; TAG_INDEX=0..TAG_STACK_MAX; UNIV_SET = ARRAY (.1..8.) OF INTEGER; SPELLING_INDEX=0..SPELLING_MAX; NOUN_INDEX= 0..NOUN_MAXTH UPDATES(.U.) DO BEGIN SPELLING_TABLE(.UPDATE_SPIX.):=OLD_ENTRY END; THIS_UPDATE:=BASE-1 END; THIS_LEVEL:= THIS_LEVEL - 1; UPDATE_CHECK END; "#############" "NAME HANDLING" "#############" PROCEDURE PUSH; BEGIN IF T>= OPERAND_MAX THEN ABORT ELSE T:=T+1 END; PROCEDURE NEW_ENTRY(VAR E:ENTRY_PTR); BEGIN IF THIS_NOUN>=NOUN_MAX THEN ABORT ELSE THIS_NOUN:=THIS_NOUN+1; NEW(E); WITH E@ DO BEGIN NOUN:=THIS_NOUN; KIND:=UNDEF_KIND ET_PTR); SCALAR_KIND:(RANGE_TYPE:NOUN_INDEX); ROUTINE_KIND:(ROUT_PARM: NAME_PTR; ROUT_TYPE:ENTRY_PTR); POINTER_KIND:(OBJECT_TYPE,NEXT_FWD:ENTRY_PTR); ARRAY_KIND:(INDEX_TYPE:NOUN_INDEX; EL_TYPE:ENTRY_PTR); WITH_KIND:(WITH_TYPE:NOUN_INDEX); RECORD_KIND:(FIELD_NAME:NAME_PTR) END; OPERAND= RECORD CASE CLASS:OPERAND_CLASS OF VAR_CLASS:(VTYPE:ENTRY_PTR); ROUTINE_CLASS:(ROUT:ENTRY_PTR; PARM:NAME_PTR); ICONST_CLASS:(ICONST_TYPE:.) END END; WITH SPELLING_TABLE(.SPIX.) DO BEGIN ENTRY:=E; LEVEL:=THIS_LEVEL; ACCESS:=A END END; PROCEDURE PUSH_NEW_NAME(RESOLVE,OUTPUT:BOOLEAN; A:NAME_ACCESS); VAR SPIX:SPELLING_INDEX; E:ENTRY_PTR; BEGIN READ_IFL(SPIX); IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO IF (ACCESS<>UNDEFINED) AND (LEVEL=THIS_LEVEL) THEN IF RESOLVE AND (ACCESS=UNRES_ROUTINE) THEN BEGIN E:=ENTRY; ACCESS:=GENERAL; RESOLUTION:=TRUE; UNRESBASE:0..UPDATE_MAX1; LEVEL_ENTRY:ENTRY_PTR; PREV_HEAD,PREV_TAIL: NAME_PTR END; UPDATE_REC= RECORD UPDATE_SPIX:SPELLING_INDEX; OLD_ENTRY:SPELLING_ENTRY END; PACKED_SET=INTEGER; VARIANT_REC= RECORD TAG_NOUN:NOUN_INDEX; LABEL_SET:PACKED_SET; PARENT_VARIANT:VARIANT_PTR END; NAME_REC= RECORD NAME_SPIX:SPELLING_INDEX; NAME_ENTRY:ENTRY_PTR; NEXT_NAME:NAME_PTR END; VAR INTER_PASS_PTR: PASSPTR; CONSTANTS: SET OLLING_INDEX; BEGIN PUSH; READ_IFL(SPIX); WITH OPS(.T.),SPELLING_TABLE(.SPIX.) DO IF ACCESS IN INACCESSIBLE THEN BEGIN ERROR(NAME_ERROR); CLASS:=UNDEF_CLASS END ELSE BEGIN CLASS:=DEF_CLASS; DEF_ENTRY:=ENTRY; DEF_SPIX:=SPIX END END; PROCEDURE FIND_NAME(LIST:NAME_PTR; SPIX:SPELLING_INDEX; VAR E:ENTRY_PTR); VAR NAME:NAME_PTR; BEGIN E:=NIL; NAME:=LIST; WHILE NAME<>NIL DO WITH NAME@ DO IF NAME_SPIX=SPIX THEN BEGIN UNC_TYPE_SW THEN ERROR(RESOLVE_ERROR); RESOLUTION:=FALSE; PUT1(FUNCF_DEF2,NOUN); ENTER_NAMES(ROUT_PARM,GENERAL) END ELSE BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=NAME_HEAD; ROUT_TYPE:= TYP; PUT2(FUNC_DEF2, TYP@.NOUN, NOUN) END END ELSE PUT2(FUNC_DEF2,XUNDEF,XUNDEF); FUNC_TYPE_SW:=FALSE; IF PREFIX_SW THEN BEGIN POP_LEVEL; T:=T-1 END END; PROCEDURE PARMLIST(OP:INTEGER); VAR I,NUMBER:INTEGER; PTYPE:ENTRY_PTR; BEGIN DEFINE(PTYPE); OUTPUT,INCOMPLETE); FIELDLIST1: FIELD_LIST; FINTEGER1: FINDEX(XINTEGER); FNAME1: FNAME; FOR_DOWN1: IGNORE2(FOR_DOWN2); FOR_LIM1: BEGIN IGNORE3(FOR_LIM2); T:=T-1 END; FOR_STORE1: POP2(FOR_STORE2); FOR_UP1: IGNORE2(FOR_UP2); FORWARD1: FORWARD_; FREAL1: FREAL; FSTRING1: FSTRING; FUNC_DEF1: FUNC_DEF; FUNC_ID1: ROUTINE_ID(GENERAL,FUNC_MODE); FUNC_TYPE1: FUNC_TYPE; FUNCTION1: FUNCTION_; GE1: BINARY(GE2); GT1: BINARY(GT2); INCLUDE1: BINARY(INCLUDE2); INTEGER1: INDEX(XINTEGER); IN1: BINARY(ININT); THIS_NOUN:=RESET_NOUN; THIS_FUNCTION:=NIL; T:=T-1; POP_LEVEL; PUT0(BODY_END2) END; PROCEDURE FORWARD_; BEGIN PUT0(FORWARD2); IF DEFINED THEN BEGIN SET_ACCESS(OPS(.T.).DEF_SPIX,UNRES_ROUTINE); UNRESOLVED:=UNRESOLVED+1 END ELSE T:=T-1; POP_LEVEL END; PROCEDURE ANAME; BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN IF ROUT = THIS_FUNCTION THEN PUT1(RESULT2, THIS_FUNCTION@.ROUT_TYPE@.NOUN) ELSE PUT0(ADDRESS2) ROG_DEF1: PROC_DEF(PROG_DEF2); PROG_ID1: BEGIN PREFIX_SW:= FALSE; ROUTINE_ID(INCOMPLETE, PROGRAM_MODE) END; REAL1: REAL_; REC_DEF1: REC_DEF; REC1: REC; SET_DEF1: SET_DEF; SLASH1: BINARY(SLASH2); STAR1: BINARY(STAR2); STORE1: POP2(STORE2); STRING1: STRING; SUBR_DEF1: SUBR_DEF; SUB1: SUB; TAG_DEF1: TAG_DEF; TAG_ID1: TAG_ID; TAG_TYPE1: TYPE_(OUTPUT,TAG_DEF2); TYPE_DEF1: TYPE_DEF; TYPE_ID1: TYPE_ID; TYPE1: TYPE_(OUTPUT,TYPE2); UMINUS1: PUT0(UMINUS2); UNIV_TYPE1: TYPE_(OUTPUT,UNIV_TYPE2); UPLITH ROUT@ DO IF OP = CALL_FUNC2 THEN BEGIN PUT1(CALL_FUNC2, ROUT_TYPE@.NOUN); CLASS:= VAR_CLASS; VTYPE:= ROUT_TYPE END ELSE IF NOUN=XNEW THEN PUT1(CALL_NEW2,NEW_TYPE) ELSE PUT0(OP) END ELSE IF OP=CALL_FUNC2 THEN PUT1(CALL_FUNC2,XUNDEF) ELSE PUT0(OP); IF OP<>CALL_FUNC2 THEN T:=T-1 END; PROCEDURE ARG_LIST; BEGIN WITH OPS(.T.) DO IF CLASS<>ROUTINE_CLASS THEN BEGIN ERROR(ARG_LIST_ERROR); CLASS:=UNDEF_CLASA  (*,.0246 "$&)+-/1357!#%'DFHJLN8:<>@BEGIKMO9;=?AC`bdfPRTVXZ\^acegQSUWY[]_|~hjlnprtvxz}ikmoqsuwy{     PARM_TYPE@.NOUN); IF NOUN=ZNPARM THEN WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=POINTER_KIND THEN NEW_TYPE:=OBJECT_TYPE@.NOUN END; T:=T-1 "POP ARGUMENT" END; PROCEDURE DEF_CASE; BEGIN READ_IFL(THIS_LABEL); PUT1(DEF_LABEL2,THIS_LABEL) END; PROCEDURE CASE_; VAR VAL:INTEGER; BEGIN WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN PUT1(CHK_TYPE2,ICONST_TYPE); VAL:=ICONST_"AL HARTMANN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY PASADENA, CALIFORNIA 91125 PDP 11/45 SEQUENTIAL PASCAL COMPILER PASS 4: DECLARATION ANALYSIS JANUARY 1975" (NUMBER) "########### # PREFIX # ###########" CONST EOL = '(:10:)'; FF = '(:12:)'; EOM = '(:25:)'; PRINTLIMIT = 18; MAXDIGIT = 6; WORDLENGTH = 2 "BYTES"; REALLENGTH = 8 "BYTES"; SETLENGTH = 16 "BYTES"; LISTOPTION = 0; SUMMARYOPTION = 1; TESTOPTION = 2; CHECKOPTION = 3; CODEOPTION = 4; NUMBX_SW; END; PROCEDURE PUSH_LEVEL(E:ENTRY_PTR); BEGIN IF THIS_LEVEL>=MAX_LEVEL THEN ABORT ELSE THIS_LEVEL:=THIS_LEVEL+1; UPDATE_CHECK; WITH DISPLAY(.THIS_LEVEL.) DO BEGIN BASE:=THIS_UPDATE+1; LEVEL_ENTRY:=E; PREV_HEAD:=NAME_HEAD; PREV_TAIL:=NAME_TAIL; NAME_HEAD:=NIL END END; PROCEDURE POP_LEVEL; VAR U:UPDATE_INDEX; BEGIN WITH DISPLAY (.THIS_LEVEL.) DO BEGIN NAME_HEAD:=PREV_HEAD; NAME_TAIL:=PREV_TAIL; FOR U:=THIS_UPDATE DOWNTO BASE DO WITIONS" "#####################" PROCEDURE VAR_LIST; VAR I,NUMBER:INTEGER; TYP:ENTRY_PTR; BEGIN READ_IFL(NUMBER); PUT1(VAR_LIST2,NUMBER); DEFINE(TYP); T:=T-1; FOR I:=1 TO NUMBER DO WITH OPS(.T.) DO IF DEFINED THEN BEGIN WITH DEF_ENTRY@ DO BEGIN KIND:=VARIABLE; VAR_TYPE:=TYP END; SET_ACCESS(DEF_SPIX,GENERAL) END ELSE T:=T-1 END; "###################" "ROUTINE DECLARATIONS" "###################" PROCEDURE ROUTINE_ID(ACCR); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN PUT3(OP,ARG1,ARG2,ARG3); PUT_ARG(ARG4) END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR A ENUM_VAL:=ENUM_VAL+1; CONST_VAL:=ENUM_VAL END END; T:=T-1 END; PROCEDURE ENUM; VAR E:ENTRY_PTR; BEGIN PUSH_NEW_ENTRY(E); ENUM_VAL:=-1; WITH E@ DO BEGIN KIND:=SCALAR_KIND; RANGE_TYPE:=NOUN; ENUM_TYPE:=NOUN END END; PROCEDURE SUBR_DEF; VAR MIN,MAX:INTEGER; TYPE1:NOUN_INDEX; E:ENTRY_PTR; BEGIN MIN:=0; MAX:=1; TYPE1:=XUNDEF; WITH OPS(.T.) DO IF CLASS=ICONST_CLASS THEN BEGIN MAX:=ICONST_VAL; TYPE1:=ICONST_TYPE END ELSEBEGIN PUT2(MESSAGE2,THIS_PASS,NUMBER); END; PROCEDURE ABORT; BEGIN ERROR(ABORT_ERROR); HALT:=TRUE END; "##############" "INITIALIZATION" "##############" PROCEDURE STD_ID(VAR STD_ENTRY:ENTRY_PTR; INDEX:SPELLING_INDEX); BEGIN NEW(STD_ENTRY); STD_ENTRY@.NOUN:=INDEX; WITH SPELLING_TABLE(.INDEX.) DO BEGIN ENTRY:=STD_ENTRY; LEVEL:=STD_LEVEL; ACCESS:=GENERAL END END; PROCEDURE STD_CONST(CONST_INDEX,TYPE_INDEX:SPELLING_INDEX; CONST_VALUE:INTEGER); VARROCEDURE ARRAY_DEF; VAR INDEX:NOUN_INDEX; E,EL:ENTRY_PTR; BEGIN DEFINE(EL); T:=T-1; IF DEFINED THEN INDEX:=TOP@.NOUN ELSE INDEX:=XUNDEF; T:=T-1; PUSH_NEW_ENTRY(E); WITH E@ DO BEGIN KIND:=ARRAY_KIND; INDEX_TYPE:=INDEX; EL_TYPE:=EL; PUT1(ARRAY_DEF2,NOUN) END END; PROCEDURE REC; VAR E:ENTRY_PTR; BEGIN PUT0(REC2); PUSH_NEW_ENTRY(E); PUSH_LEVEL(E) END; PROCEDURE FIELD_DEF(NUMBER:INTEGER; VAR TYP:ENTRY_PTR); VAR I:INTEGER; BEGIN END; NEXT_NAME:=NIL END END; PROCEDURE STD_ENTRY(VAR E:ENTRY_PTR; INDEX:NOUN_INDEX); BEGIN NEW(E); WITH E@ DO BEGIN NOUN:=INDEX; KIND:=UNDEF_KIND END END; PROCEDURE STD_ROUT (ROUT_INDEX: NOUN_INDEX; ROUTTYPE: ENTRY_PTR; FIRST_PARM: NAME_PTR); VAR ROUT_ENTRY:ENTRY_PTR; BEGIN STD_ID(ROUT_ENTRY,ROUT_INDEX); WITH ROUT_ENTRY@ DO BEGIN KIND:=ROUTINE_KIND; ROUT_PARM:=FIRST_PARM; ROUT_TYPE:=ROUTTYPE END END; PROCEDURE ST PUT1(FIELDLIST2,NUMBER) END; PROCEDURE TAG_DEF; VAR TYP:ENTRY_PTR; BEGIN FIELD_DEF(1,TYP); IF TAG_TOP>TAG_STACK_MAX THEN ABORT ELSE WITH TAG_STACK(.TAG_TOP.) DO BEGIN PREV_LABELS:=TAG_LABELS; TAG_LABELS:=(..); PREV_TAG:=TAG_FIELD; TAG_FIELD:=NEW_TAG_FIELD; PREV_TYPE:=LABEL_TYPE; WITH TYP@ DO IF KIND=SCALAR_KIND THEN LABEL_TYPE:=RANGE_TYPE ELSE LABEL_TYPE:=XUNDEF END; TAG_TOP:=TAG_TOP+1 END; PROCEDURE VARNT; VAR VARNT_PTTER_PASS_PTR@ DO BEGIN TEST:=TESTOPTION IN OPTIONS END; IF TEST THEN PRINTFF; THIS_NOUN:=ZWITH; NEW_TYPE:=XUNDEF; HALT:=FALSE; RESOLUTION:=FALSE; FUNC_TYPE_SW:=FALSE; PREFIX_SW:=TRUE; THIS_FUNCTION:=NIL; CONST_DISP:=0; UNRESOLVED:=0 "UNRESOLVED IDENTIFIERS"; CONSTANTS:=(.ICONST_CLASS,RCONST_CLASS,SCONST_CLASS.); TYPES:=(.SCALAR_KIND,ARRAY_KIND,RECORD_KIND,POINTER_KIND,SET_KIND, UNDEF_KIND.); OP_ACCESS:=(.GENERAL,UNRES_ROUTINE,QUALIFIED.); CONST_KINDSG_LABELS OR VARIANT_LABELS; WITH THIS_VARIANT@ DO PACK(VARIANT_LABELS,LABEL_SET); END; PROCEDURE VARNT_END; BEGIN THIS_VARIANT:=THIS_VARIANT@.PARENT_VARIANT; PUT0(VARNT_END2) END; PROCEDURE PART_END; BEGIN PUT0(PART_END2); TAG_TOP:=TAG_TOP-1; IF TAG_TOP<=TAG_STACK_MAX THEN WITH TAG_STACK(.TAG_TOP.) DO BEGIN TAG_LABELS:=PREV_LABELS; TAG_FIELD:=PREV_TAG; LABEL_TYPE:=PREV_TYPE END END; PROCEDURE LABEL; BEGIN IF DEFINED TTER_TYPE,ZPOINTER); STD_SCALAR(INT_TYPE,XINTEGER); STD_SCALAR(REAL_TYPE,XREAL); STD_SCALAR(BOOL_TYPE,XBOOLEAN); STD_SCALAR(CHAR_TYPE,XCHAR); STD_PARM(ARITH_SPARM,ARITH_TYPE,ZSPARM); STD_PARM(INT_CPARM,INT_TYPE,ZCPARM); STD_PARM(CHAR_CPARM,CHAR_TYPE,ZCPARM); STD_PARM(INDEX_CPARM,INDEX_TYPE,ZCPARM); STD_PARM(INDEX_SPARM,INDEX_TYPE,ZSPARM); STD_PARM(REAL_CPARM,REAL_TYPE,ZCPARM); STD_PARM(PTR_VPARM,POINTER_TYPE,ZNPARM); STD_ROUT(XABS, ARITH_TYPE, ARITH_SPARM); ; PROCEDURE POINTER; VAR SPIX:SPELLING_INDEX; OBJ_TYP,PTR_TYP,FWD_REF:ENTRY_PTR; BEGIN READ_IFL(SPIX); OBJ_TYP:=UENTRY; PUSH_NEW_ENTRY(PTR_TYP); IF SPIX<>XUNDEF THEN WITH SPELLING_TABLE(.SPIX.) DO CASE ACCESS OF GENERAL: IF ENTRY@.KIND IN TYPES THEN OBJ_TYP:=ENTRY ELSE ERROR(NAME_ERROR); UNDEFINED: BEGIN UPDATE(SPIX,PTR_TYP,UNRES_TYPE); UNRESOLVED:=UNRESOLVED+1 END; INCOMPLEX:=MIN; END ELSE BEGIN MIN:=0; MAX:=0 END; WHILE OPS(.T.).CLASS=CASE_LABEL DO BEGIN WITH OPS(.T.) DO BEGIN IF LABELS(.INDEX.)=LN THEN LABELS(.INDEX.):=LABEL ELSE ERROR(AMBILBL_ERROR); IF INDEX>MAX THEN MAX:=INDEX ELSE IF INDEX @ B D F H J g Q S U W Y [ ] _ a c e P R T V X Z \ ^ ` b d f k m o q s u w y { }  i l n p r t v x z | ~ h j ARD:= FALSE; MODE:=PROGRAM2_MODE; ASSIGNABLE:= (.FUNC_RESULT, VARIABLE, VAR_PARM, UNIV_VAR, WITH_VAR.); NONLISTS:=(.INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND, SET_KIND,STRING_KIND,NONLIST_KIND,UNDEF_KIND.); LISTS:=(.POINTER_KIND,LIST_KIND.); CURRENT_LABEL:=INITIALBLOCK; NEW(UTYPE); WITH UTYPE@ DO BEGIN CLASS:=TEMPLATE; NOUN:=XUNDEF; SIZE:=1; KIND:=UNDEF_KIND END; INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); PASS_BY_REFERENCE:=(.VAT0( " >" "   X" "" ph":   ^ F $  * 8@6 ( F*"2 0 ""R"~                            0 2 4 6 " $ & ( * , . 1 3 5 7 ! # % ' ) + - / L N 8 : < > @ B D F H J M O 9 ; = ? A C E G I K P R T V X Z \ ^ ` b d f Q S U W Y [ ] _ a c e g l n p r t v x z | ~ h j m o q s u w y { }  i k * " `4  $   (  " 0*X TRY AGAIN WRITE(FILE: IDENTIFIER) FILE UNKNOWN TAPE WRITE: ( F*"2 0 ""R"################## # WRITE MANUAL # ################## PER BRINCH HANSEN 14 AUGUST 1975 PURPOSE: COPIES A FILE FROM DISK TO TAPE AND TERMINATES IT WITH AN END_OF_FILE MARK. THE TAPE MUST BE POSITIONED CORRECTLY BEFORE USING THE WRITE PROGRAM. CALL: WRITE(FILE: IDENTIFIER) TAPE PROGRAM. CALL: CAN ONLY BE USED TO PRODUCE INPUT/OUTPUT FOR OTHER PROGRAMS. ERROR MEESAGES: INSPECT INSPECTION OF THE DEVICE REQUIRED. ERROR TRANSMISSION ERROR DURING A BLOCK TRANSFER. FAILURE DEVICE FAILURE DURIN                           / 1 3 5 7 ! # % ' ) + - 0 2 4 6 " $ & ( * , . K M O 9 ; = ? A C E G I L N 8 : < > @ B D F H J g Q S U W Y [ ] _ a c e P R T V X Z \ ^ ` b d f k m o q s u w y { }  i l n p r t v x z | ~ h j PROCEDURE INITIALIZE; BEGIN IDENTIFY('WRITE: (:10:)'); OK:= TRUE; CHECKARG; END; PROCEDURE COPY; VAR PAGENO: INTEGER; BLOCK: PAGE; BEGIN INITIO; FOR PAGENO:= 1 TO LENGTH(1) DO BEGIN GET(1, PAGENO, BLOCK); WRITEPAGE(BLOCK, FALSE); END; WRITEPAGE(BLOCK, TRUE); CHECKIO; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; IF OK THEN COPY; TERMINATE; END; END. (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SC .ENDC ; 3$: MOV #INTEND,MTCMA ; ADDR := @PROGRAMSTART; MOV #-512.,MTBRC ; READ(TAPE0, ADDR, ERROR); $R = MDN800 * MTCDEN ; $R = $R + MTCGO ; $R = $R + ; MOV #$R,MTC ; 4$: TSTB MTC ; BGE 4$ ; TST MTC ; IF ERROR THEN BGE 5$ ; 9$: CLR HEAD99+OPLIN1 ; RATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUMS(.T.) DO BEGIN CLASS:=ICONST_CLASS; ICONST_TYPE:=TYP; READ_IFL(ICONST_VAL) END END; PROCEDURE FINDEX(TYP:NOUN_INDEX); VAR VALUE:INTEGER; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; READ_IFL(VALUE); PUT2(INDEX2,VALUE,TYP) END; PROCEDURE STRING; BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=SCONST_CLASS; READ_IFL(SCONST_LENGTH); SCONST_DISP:=CONST_DISP END END; PROCEDURE FSTRING; VAR LENGTH:INTEGER; BEGIN PUSH; OPS(.T.).CL, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); ; CLASS:= VAR_CLASS; VTYPE:= TYP END END; PROCEDURE FUNCTION_ERROR(ERROR_NUM:INTEGER); BEGIN ERROR(ERROR_NUM); OPS(.T.).CLASS:=UNDEF_CLASS END; PROCEDURE FUNCTION_; BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN IF ROUT@.ROUT_TYPE=PROC_TYPE THEN FUNCTION_ERROR(PROC_USE_ERROR) ELSE "OK" ELSE FUNCTION_ERROR(NAME_ERROR); PUT0(FUNCTION2) END; PROCEDURE BINARY(OP:INTEGER); BEGIN PUT0(OP); T:=T-1 END; PR PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT STRING_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(STRING2,STRING_LENGTH,STRING_DISP) END; VARIABLE,FIELD,PARAMETER: BEGIN CLASS:=VAR_CLASS; CASE KIND OF VARIABLE:VTYPE:=VAR_TYPE; FIELD: VTYPE:=FIELD_TYPE; PARAMETER: VTYPE:=PARM_TYPE END; IF COMP THEN BEGIN OP:=VCOMP2; VARNT_PTR:=VARIANT; WHILE VARNT_PTR<>NIL DO WITH VARNT_PTR@ DO BEGIN (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ;0(UNDEF2) END END END; PROCEDURE NAME; VAR SPIX:SPELLING_INDEX; COMP,ERR:BOOLEAN; NAME_ENTRY:ENTRY_PTR; BEGIN READ_IFL(SPIX); ERR:=FALSE; COMP:=FALSE; WITH SPELLING_TABLE(.SPIX.) DO IF ACCESS IN OP_ACCESS THEN BEGIN NAME_ENTRY:=ENTRY; CASE ACCESS OF GENERAL,UNRES_ROUTINE: ; QUALIFIED: BEGIN COMP:=TRUE; PUSH "WITH TEMP"; WITH DISPLAY(.LEVEL.).LEVEL_ENTRY@ DO BEGIN PUT2(VAR2,NOUN,ZWITH); ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################### # WRITE(VAR OK: BOOLEAN; SOURCE: IDENTIFIER) # #########LD_NAME ELSE BEGIN ERR:=TRUE; NAME_LIST:=NIL END; FIND_NAME(NAME_LIST,SPIX,COMPONENT) END ELSE ERR:=TRUE; IF ERR THEN ERROR(COMP_ERROR) ELSE PUSH_OPERAND(COMPONENT,QUALIFIED) END; PROCEDURE SUB_ERR; BEGIN ERROR(SUB_ERROR); PUT2(SUB2,XUNDEF,XUNDEF) END; PROCEDURE SUB; BEGIN T:=T-1; WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=ARRAY_KIND THEN BEGIN PUT2(SUB2,INDEX_TYPE,EL_TYPE@.NOUN); ######################################" "INSERT PREFIX HERE" VAR OK: BOOLEAN; FILEID: IDENTIFIER; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT(' WRITE(FILE: IDENTIFIER) (:10:)'); OK:= FALSE; END; END; PROCEDURE CHECKARG; VANT" "########" PROCEDURE CONSTANT; BEGIN PUSH_OLD_NAME; IF DEFINED THEN WITH OPS(.T.), DEF_ENTRY@ DO IF KIND IN CONST_KINDS THEN CASE KIND OF INDEX_CONST: BEGIN CLASS:=ICONST_CLASS; ICONST_TYPE:=CONST_TYPE; ICONST_VAL:=CONST_VAL END; REAL_CONST: BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=REAL_DISP END; STRING_CONST:BEGIN CR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN WITH PARAM(.2.) DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, FOUND); IF FOUND THEN FILEID:= ID ELSE ERROR('FILE UNKNOWN (:10:)'); END; END; PROCEDURE INITIO; VAR ARG: ARGTYPE; FOUND: BOOLEAN; BEGIN OPEN(1, FILEID, FOUND); WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'TAPE ' END; WRITEARG(OUT, ARG); END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; BEGIN READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; CLOSE(1); END; ; X: $ = $ + .INTEGER ; INTEGER; Y2 = $ ; Y: $ = $ + .INTEGER ; INTEGER; Q2 = $ ; Q: $ = $ + .INTEGER ; INTEGER; B2 = $ ; B: $ = $ + .INTEGER ; INTEGER; G2 = $ ; G: $ = $ + .INTEGER ; INTEGER; S2 = $ ; S: $ = 0 ; SYSTEMLENGTH := MOV INTEND,R1 ; ((PROGRAMSTART(.1.) - 1) DEC R1 ; DIV 512) * 512; ASHC #<-9.>,R0 ; BEQ 7$ ; ASH #8.,R1 ; NEG R1 ; MOV R1,RKWC ; READ(DISK0, ADDR, SYSTEM+1, INC RKCS ; SYSTEMLENGTH, ERROR); 6$: TSTB RKCS ; BG$ + .INTEGER ; INTEGER; P2 = $ ; P: $ = $ + .INTEGER ; INTEGER; PSTAT2 = $ ; PSTATUS: $ = $ + .INTEGER ; INTEGER; FW2 = $ ; FW: $ = $ + .REAL ; REAL; FX2 = $ ; FX: $ = $ + .REAL ; REAL; FSTAT2 = $ ; FSTATUS: $ = $ + .INTEGE 6$ ; TST RKCS ; IF ERROR THEN BLT 2$ ; KERNELERROR( 7$: ; 'SYSTEM LOAD ERROR(:0:)'); .ENDC ; END "LOADFROMDISK"; ; ; ; BEGIN "LOADSYSTEMPROGRAM" ;* CONDITIONAL ASSEMBLY, ABOVE, ; IF SYSTEMTAPE THEN ;* DEPENDING ON "$.DBTA". ; LOADFROMTAPE .SBTTL DEFINITIONS OF BASIC KERNEL DATA TYPES ;"################################### ; # BASIC DATA TYPES # ;###################################" ; ; ;**********************************; ; IN THE CODE THAT FOLLOWS WE SHALL; ; ALWAYS FEEL FREE TO ASSUME THAT ; ; ALL RECORD FIELDS ARE ALLOCATED ; ; CONSECUTIVELY I ELSE ; LOADFROMDISK(SYSTEMBLOCK); RESET ; RESETUNIBUS; SPL 7 ; EXCLUDEINTERRUPTS; INC SSR0 ; ADDRESSMAPPING := TRUE; $CLC0: ; "CLEAR REMAINING CORE" CLR R0 ; SEGADDR := GETSEGMENTADDRESS( MOV #INTEND,R1 ; PROGRAMEND); ADD INTEND,R1 ; ADC R0 N THE ORDER OF ; ; THEIR DECLARATION. ; ;**********************************; ; ; NIL = 0 ; CONST NIL = 0; GATES = 25. ; GATES = 25; "MONITOR GATES" PROCS = 10. ; PROCESSES = 10; "PROCESSES" ; ; PROCESS = 0 ; TYPE PROCESS = $ = PROCESS ; MOV R1,R2 ; BIC #017777,R1 ; ASHC #-6,R0 ; MOV KISAR+12.,R0 ; MOV R1,KISAR+12. ; BIC #160000,R2 ; SEGINDEX := GETSEGMENTINDEX( MOV R2,R1 ; PROGRAMEND); ASR R1 ; NEG R1 ; MOV #3$,FETRAP ; REPEAT 2$: ADD #.SEGSW,R1 ; FOR I := SEG ; RECORD LINK0 = $ ; "QUEUE LINK" $ = $ + .QUEUETYPE ; HEAD0 = $ ; HEAD: $ = $ + .HEADTYPE ; HEADTYPE; REG0 = $ ; REG: $ = $ + .REGTYPE ; REGTYPE; MAP0 = $ ; MAP: $ = $ + .MAPTYPE ; MAPTYPE; .PROCESS= $ - PROCESS ; END; ; INDEX TO 4096 DO ADD #140000,R2 ; 1$: CLR (R2)+ ; SEGADDR@(.I.) := 0; SOB R1,1$ ; ADD #.SGSBK,KISAR+12. ; SEGADDR := GETNEXTSEGMENT( CLR R2 ; SEGADDR); CMP #.PRBLK,KISAR+12. ; SEGINDEX := 1; BNE 2$ ; UNTIL SEGADDR = ENDOFCORE; SUB #4,SP ; 3$: MOV #FEINT,FETRAP ; ADD #4,SP ; HEADTYPE= 0 ; TYPE HEADTYPE = $ = HEADTYPE ; RECORD INDEX1 = $ ; INDEX: $ = $ + .INTEGER ; INTEGER; HEAPT1 = $ ; HEAPTOP: $ = $ + .INTEGER ; INTEGER; LINE1 = $ ; LINE: $ = $ + .INTEGER ; INTEGER; RESUL1 = $ ; RESULT: $ = $ + .IN ; MOV KISAR+12.,COREC9 ; CORECAPACITY := BLOCKNUMBER( MOV R0,KISAR+12. ; SEGADDR); VERCOR ; .IF EQ $.DBNC ; MOV #LKSINE,LKS ; STARTLINEFREQUENCYCLOCK; .ENDC ; MOV #KNEXIT,R0 ; END; JSR R0,INIT36 ; ; ; .SBTTL END OF THE KETEGER ; INTEGER; RUNTI1 = $ ; RUNTIME: $ = $ + .TIME ; TIME; SLICE1 = $ ; SLICE: $ = $ + .INTEGER ; INTEGER; NESTI1 = $ ; NESTING: $ = $ + .INTEGER ; INTEGER; PRIOR1 = $ ; PRIORITY: $ = $ + .INTEGER ; INTEGER; OVERT1 = $ ; OVERRNEL MODULE PREFACE .SBTTL .SBTTL ######################################################### .SBTTL ;* ;* ;* ;* ;* ;* ;* ;* ;*********************************************************************** ;*********************************************************************** ;*********************************************************************** ;**** ***** ;**** *****TIME: $ = $ + .BOOLEAN ; BOOLEAN; JOB1 = $ ; JOB: $ = $ + .BOOLEAN ; BOOLEAN; CONTI1 = $ ; CONTINUE: $ = $ + .BOOLEAN ; BOOLEAN; OPCOD1 = $ ; OPCODE: $ = $ + .INTEGER ; INTEGER; PARAM1 = $ ; PARAM: $ = $ + <4. * .INTEGER> ; ARRAY (.1..4.) OF MOV #11$,RESU19 ; KERNELERROR( JSR PC,KERN19 ; 'TAPE READ ERROR(:0:)'); 11$: .ASCIZ /TAPE READ ERROR/ ; .EVEN ; 5$: CLR R0 ; FOR I := 2 TO MOV INTEND,R1 ; (ADDR@(.1.) + 511) DIV 512 DO ADD #511.,R1 ; ADC R0 ; ASHC #-9.,R0 ; DEC R1 ; BEGIN BEQ 8$ ; ;**** ***** ;**** THIS MARKS THE END OF THE KERNEL MODULE PREFACE. ***** ;**** ***** ;**** THE CODE PROPER OF THE KERNEL FOLLOWS: ***** ;**** ***** ;**** ***** ;**** ***** ADDR := NEXTPAGE(ADDR); 6$: MOV #-512.,MTBRC ; READ(TAPE0, ADDR, ERROR); INC MTC ; 7$: TSTB MTC ; BGE 7$ ; TST MTC ; IF ERROR THEN BLT 9$ ; KERNELERROR( ; 'TAPE READ ERROR(:0:)'); SOB R1,6$ ; END; 8$: ; END "LOADFROMTAPE"; .ENDC ;*********************************************************************** ;*********************************************************************** ;*********************************************************************** ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; ; ;* ; PROCEDURE LOADFROMDISK(SYSTEM: ;* = $SDA0 ; DISKBLOCK); ;* ; ;* ; CONST DISK0 = 0; ;* ; ;* = RKCS ; VAR ERROR: BOOLEAN; ;* = RKBA ; ADDR: @PAGE; ;* = R1 ; SYSTEMLENGTH: INTEGER; ; ;* ; ;* ;  ; .IF EQ $.DBTA ; BEGIN MOV #INTEND, RKBA ; ADDR := @PROGRAMSTART; MOV #<-256.>,RKWC ; READ(DISK0, ADDR, SYSTEM, 512, MOV $SDA0,R1 ; ERROR); CLR R0 ; ADDR := NEXTPAGE(ADDR); DIV #12.,R0 ; ASH #4,R0 ; BIS R1,R0 ; MOV R0,RKDA ; BIS UNITNO,RKDA ;<01> SET ; INTEGER; OPLIN1 = $ ; OPLINE: $ = $ + .INTEGER ; INTEGER; CHKDTL HEADTYPE ; END; ; ; REGTYPE = 0 ; TYPE REGTYPE = $ = REGTYPE ; RECORD W2 = $ ; W: $ = $ + .INTEGER ; INTEGER; X2 = $ PROPER UNIT NUMBER $ = +RCSGO; MOV #$,RKCS ; 1$: TSTB RKCS ; BGE 1$ ; TST RKCS ; IF ERROR THEN BGE 5$ ; KERNELERROR( 2$: CLR HEAD99+OPLIN1 ; 'SYSTEM LOAD ERROR(:0:)'); MOV #3$,RESU19 ; JSR PC,KERN19 ; 3$: .ASCIZ /SYSTEM LOAD ERROR/ ; .EVEN ; 5$: CLR R $& "%'!#(*,.02468:<>)+-/579;=?DFHJL@BEGIKMC      "$&(*,.!#%')+-/:<>@BDF02468;=?ACEG13579VXZ\^HJLNPRTWECOND.PRED := FIRST.PRED; MOV R5,GET4R ; GET := FIRST; QTRACE GET ; RTS PC ; END; ; ; ; PROCEDURE PUT(NEWELEM: NEWEL4: .BLKB .ADDRESS ; @ QUEUETYPE); ;LAST IS R5 ; VAR LAST: @ QUEUETYPE; ; PUT4: MOV QUTP4T,R0 ; BEGIN "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB;  MOV NEWEL4,R1 ; MOV PRED4(R0),R5 ; LAST := PRED; MOV R1,PRED4(R0) ; PRED := NEWELEM; MOV R5,PRED4(R1) ; NEWELEM.PRED := LAST; MOV (R5),(R1) ; NEWELEM.SUCC := LAST.SUCC; MOV R1,(R5) ; LAST.SUCC := NEWELEM; QTRACE PUT ; RTS PC ; END; ; ; .MACRO ANY4 Q,FL v4 T" X" " " "v  fT mX6  Xv "0 X " " v( m""B ` B" " =X 6 P&|"H D8 ; MACRO FUNCTION ANY: BOOLEAN; ; ; "WE ASSUME THAT THIS FUNCTION AND ; EMPTY, BELOW, WILL NOT BE USED ; IN ASSIGNMENT STATEMENTS" ; ; BEGIN CMP Q,(Q) ; ANY := SUCC <> THIS QUEUETYPE; BEQ FL ; .ENDM ANY4 ; END; 6       %'!#& "$)+-/13579;=?*,.02468:<>(EGIKMOQSUWACFHJLNPRTV@BDacegikmoY[]_bdfhjlnXZ\^`}qsuwy{~prtvxz|ER ; INTEGER; CHKDTL REGTYPE ; END; ; ; MAPTYPE = 0 ; TYPE MAPTYPE = $ = MAPTYPE ; $ = $ + <8. * .INTEGER> ; ARRAY (.0..7.) OF INTEGER; CHKDTL MAPTYPE ; ; ; PROCREF = 0 ; TYPE PROCESSREF = $ = PROCREF ; (NUMBER) "LUIS MANUEL MEDINA INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 10 SEPTEMBER 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (E $ = $ + .ADDRESS ; @ PROCESS; .PROCREF= $ - PROCREF ; ; ; PROCQUE = 0 ; TYPE PROCESSQUEUE = $ = PROCQUE ; $ = $ + .QUEUETYPE ; SEQUENCE OF PROCESSREF; .PROCQUE= $ - PROCQUE ; ;"################################### ; # NEWCORE # MPTY, SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, E ;###################################" ; ; ; THIS CLASS MUST BE PLACED FIRST ; VAR NEWCORE: ; IN THE KERNEL SO AS TO OVERLAP ; CLASS ; THE CORE OCCUPIED BY THE TRANSI- ; ; ENT INITIALIZER BEGINNING AT LOC-; ; ATION "$KNL0". ; ; $G = GATES * .GATE ; CONST SPACE = GATES*GATELENG + $P = PROCS * .PROCESS ; PROCESSES*PROCESSNDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIELENG $S = $G + $P ; $M = . - $KNL0 ; $D = $S - $M ; .IF LT $D ; $S = $M ; $D = 0 ; .ENDC ; .BLKB $D ; SPAC16 = $S ; SLIM16: ; SPACELIMIT = .ASCIZ /SPACE LIMIT/ ; 'SPACE LIMIT(:0:)'; .EVEN ; BASE16 R); PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCE= $KNL0 ; BASEADDR = ...; .EVEN ; TOP16: .WORD BASE16 ; VAR TOP: INTEGER; FREE16: .WORD SPAC16 ; FREE: INTEGER; ; ; LENG16: .BLKB .INTEGER ; FUNCTION NEW(LENGTH: INTEGER): NEW16R: .BLKB .INTEGER ; INTEGER; ; NEW16: MOV LENG16,R0 ; BEGIN CMP R0, WRITETEXT('OVERFLOW #'); POINTERERROR: WRITETEXT('POINTER ERROR#'); RANGEERROR: WRITETEXT('RANGE ERROR#'); VARIANTERROR: WRITETEXT('VARIANT ERROR#'); HEAPLIMIT: WRITETEXT('HEAP LIMIT #'); STACKLIMIT: WRITETEXT('STACK LIMIT#'); CODELIMIT: WRITETEXT('CODE LIMIT #'); TIMELIMIT: WRITETEXT('TIME LIMIT #'); CALLERROR: WRITETEXT('SYSTEM ERROR #') END; END; PROCEDURE WRITEERROR(ID: IDENTIFIER; LINENO: INTEGER; RESULT: PROGRESULT); BEGIN WRITE(NL); WRITEID(IDFREE16 ; IF LENGTH > FREE THEN BLE 1$ ; MOV #SLIM16,RESU19 ; KERNELERROR(SPACELIMIT); JSR PC,KERN19 ; 1$: MOV TOP16,NEW16R ; NEW := TOP; ADD R0,TOP16 ; TOP :+ LENGTH; SUB R0,FREE16 ; FREE :- LENGTH; RTS PC ; END; ; ; INIT16: ; BEGIN ; DONE AT ; ; .MACRO EMPTY4 Q,FL ; MACRO FUNCTION EMPTY: BOOLEAN; ; CMP Q,(Q) ; EMPTY := SUCC = THIS QUEUETYPE; BNE FL ; .ENDM EMPTY4 ; END; ; ; INIT4: MOV QUTP4T,R0 ; BEGIN MOV R0,R1 ; MOV R1,(R0)+ ; LABEL "TOP16". ; TOP := BASEADDR; ; DONE AT LABEL "FREE16". ; FREE := SPACE; RTS PC ; END; ; ; ;"################################### ; # QUEUETYPE # ;###################################" ; ; QU SUCC := THIS QUEUETYPE; MOV R1,(R0) ; PRED := THIS QUEUETYPE; RTS PC ; END; ; ; ;"################################### ; # SIGNAL # ;###################################" ; ; SIG26T: .BLKBTP4T: .BLKB .ADDRESS ; TYPE QUEUETYPE = ; CLASS ; QUEUETYP= 0 ; VAR $ = QUEUETYPE ; SUCC4 = $ ; SUCC: $ = $ + .ADDRESS ; @ QUEUETYPE; PRED4 = $ ; PRED: $ = $ + .ADDRESS ; @ QUEUETYPE; CHKDTL QUEUETYPE ; ; 0' "" ` " >" "  X >" X X6 >"d >BL" BP"&=" ` "4E"B `"v  vm> f R R RR&" Mv ; GET4R: .BLKB .ADDRESS ; FUNCTION GET: @ QUEUETYPE; ; ;FIRST IS R5 ; VAR FIRST, SECOND: @ QUEUETYPE; ;SECOND IS R4 ; ; GET4: MOV QUTP4T,R0 ; BEGIN MOV (R0),R5 ; FIRST := SUCC; MOV (R5),R4 ; SECOND := FIRST.SUCC; MOV R4,(R0) ; SUCC := SECOND; MOV PRED4(R5),PRED4(R4) ; SNTEGER; "FRACTION ; UNIT = 0.1 MILLISECOND" CHKDTL TIME ; ; ; INCR5: .BLKB .INTEGER ; PROCEDURE ADD(INCR: INTEGER); ; ADD5: MOV TIME5T,R0 ; BEGIN ADD INCR5,FRACT5(R0) ; FRACTION :+ INCR; CMP FRACT5(R0),#10000. ; IF FRACTION >= 10000 THEN BLT 1$ ; BEGIN CALLPASS(PASS6); IF OK THEN CALLPASS(PASS7); IF OK THEN OPEN(2, JOB, OK); IF OK THEN CALLPASS(PASS7); IF OK THEN CALLJOB; TERMINATE; END. ).BOOL; END; PROCEDURE CALLJOB; VAR LINENO: INTEGER; RESULT: PROGRESULT; BEGIN RUNJOB(LINENO, RESULT); IF RESULT <> TERMINATED THEN WRITEERROR(JOB, LINENO, RESULT); END; BEGIN INITIALIZE; IF OK THEN CALLPASS(PASS1); IF OK THEN CALLPASS(PASS2); IF OK THEN CALLPASS(PASS3); IF OK THEN CALLPASS(PASS4); IF OK THEN CALLPASS(PASS5); IF OK THEN .ADDRESS ; TYPE SIGNAL = ; CLASS ; SIGNAL = 0 ; VAR AWAITING: PROCESSQUEUE; $ = SIGNAL ; $ = $ + .PROCQUE ; .SIGNAL = $ - SIGNAL ; ; ; PROCEDURE AWAIT; ; AWAI26: ; BEGIN JSR PC,PREE11 ; AWAITING INC SEC5(R0) ; SEC :+ 1; SUB #10000.,FRACT5(R0) ; FRACTION :- 10000; 1$: ; END; RTS PC ; END; ; ; INIT5: MOV TIME5T,R0 ; BEGIN CLR SEC5(R0) ; SEC := 0; CLR FRACT5(R0) ; FRACTION := 0; RTS PC ; END; ;                           r t v x z | ~ l n p        !#%' "$&.PUT(RUNNING.PREEMPTED); MOV PRE11R,NEWEL4 ; MOV SIG26T,QUTP4T ; JSR PC,PUT4 ; RTS PC ; END; ; ; ; PROCEDURE SEND; ; SEND26: ; BEGIN MOV SIG26T,R0 ; IF AWAITING.ANY THEN ANY4 R0,1$ ; BEGIN 2$:  B( " >" "   X" "" ,ph:`>X"0  "  "" >" & X X6 ^ p* " `:  >B*  "  " /13579-ikmoZ\^`X  ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}(: |"  * ^ 0 $ 0^  F  @Z z  * X X"F ^ F.  " X"$   (  " B *X. ` ; REPEAT MOV R0,QUTP4T ; READY.ENTER(AWAITING.GET); JSR PC,GET4 ; MOV GET4R,P12 ; JSR PC,ENTE12 ; MOV SIG26T,R0 ; UNTIL AWAITING.EMPTY; EMPTY4 R0,2$ ; JSR PC,RESC12 ; READY.RESCHEDULE; ; END; 1$: RTS PC ; END; ; hTRY AGAIN START(SYSTEM: IDENTIFIER) OR START(SYSTEM: IDENTIFIER; INITIAL: BOOLEAN) DISK ERROR START: SOURCE FILE UNKNOWN SOURCE KIND MUST BE CONCODE SOURCE FILE TOO LONG @Z z  * X X"F ^ F.  " X"$   (  " B *X. ` ; INIT26: ; BEGIN MOV SIG26T,QUTP4T ; AWAITING.INITIALIZE; JSR PC,INIT4 ; RTS PC ; END "OF SIGNAL"; ; ; .SBTTL KERNEL TIMING PROCESSES ;"################################### ; # TIME # ;########'); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; PROCEDURE STORE_TEST (ARG: INTEGER); BEGIN IF TEST_INDEX < TEST_MAX THEN BEGIN TEST_INDEX:= TEST_INDEX + 1; TEST_BUF(.TEST_INDEX.):= ARG END END; PROCEDURE PRINT_TEST; VAR I: INTEGER; BEGIN PRINTED:= PRINTLIMIT; FOR I:= 1 TO TEST_INDEX DO PRINTARG(TEST_BUF(.I.)); TEST_INDEX:= 0 END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TDURE PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S:EST THEN STORE_TEST(ARG) END; PROCEDURE PUT0NC(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP); WRITE(CH); READ(CH) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN STORE_TEST(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN STORE_TEST(OP); STORE_TEST(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); ARGSEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "######### # FILE # #########" CONST "IMPLEMENTATION CONSTANTS" DISK_SIZE = 4800 "PAGE IF TEST THEN BEGIN STORE_TEST(OP); STORE_TEST(ARG1); STORE_TEST(ARG2) END END; PROCEDURE PUT_STRING (STRING: UNIV PACKED_STRING; STRING_LENGTH: INTEGER); VAR I: INTEGER; BEGIN PUT1(STRING2, STRING_LENGTH); PUT1(LCONST2, STRING_LENGTH); FOR I:= 1 TO STRING_LENGTH DIV WORDLENGTH DO PUT_ARG(STRING(.I.)) END; PROCEDURE ERROR(ERROR_NUM:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,ERROR_NUM) END; "##########" "INITIALIZE" "##########" PROCEDURE STD_ID(ID:PIECE; INS"; PAGE_SIZE = 256 "WORDS"; WORDSIZE = 16 "BITS"; SETSIZE = 8 "WORDS"; VIRTUALMACHINESIZE = 152; "PAGES" FIRSTPAGE = 152; "AFTER VIRTUAL MACHINE" "FREELIST PARAMETERS" CYLINDERSIZE = 24 "PAGES/CYLINDER"; CYLINDERLIMIT = 23 "SIZE - 1"; GROUPSIZE = 5 "CYLINDERS/GROUP"; GROUPLIMIT = 4 "SIZE - 1"; FIVECYLINDERSIZE = 120 "CYLINDERSIZE*GROUPSIZE"; FIVECYLINDERLIMIT = 119 "SIZE - 1"; FREEPAGESIZE = 31 "GROUPS/FREEPAGE"; FREEPAGELIMIT = 30 "SIZE - 1"; FDEX:SPELLING_INDEX); VAR S:SPELLING_INDEX; CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; "NOW WE HAVE ENTRY SLOT" WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID; NEXT:=NIL END END END; PROCEDURE LONG_ST0& K" `D   ^  $ R z|pdXL@4( $c        X"&o r  ( "###########################" ; ; TIME5T: .BLKB .ADDRESS ; TYPE TIME = ; CLASS ; TIME = 0 ; VAR ENTRY $ = TIME ; SEC5 = $ ; SEC: $ = $ + .INTEGER ; INTEGER; FRACT5 = $ ; FRACTION: $ = $ + .INTEGER ; I); WRITETEXT(': LINE #'); WRITEINT(LINENO, 4); WRITE(' '); WRITERESULT(RESULT); WRITE(NL); OK:= (RESULT = TERMINATED); END; PROCEDURE INITIALIZE; BEGIN OPEN(1, TEMP1, OK); IF OK THEN OPEN(2, TEMP2, OK); WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= NIL END; WITH LIST(.3.) DO BEGIN TAG:= INTTYPE; INT:= 0 END; END; PROCEDURE TERMINATE; BEGIN CLOSE(1); CLOSE(2) END; PROCEDURE CALLPASS(ID: IDENTIFIER); VAR LINENO: INTEGER; Ruwacxz|~y{}     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlESULT: PROGRESULT; BEGIN RUNPASS(ID, LIST, LINENO, RESULT); IF RESULT <> TERMINATED THEN WRITEERROR(ID, LINENO, RESULT) ELSE OK:= LIST(.1.).BOOL; END; PROCEDURE CALLJOB; VAR LINENO: INTEGER; RESULT: PROGRESULT; BEGIN RUNJOB(LINENO, RESULT); IF RESULT <> TERMINATED THEN WRITEERROR(JOB, LINENO, RESULT); END; BEGIN INITIALIZE; IF OK THEN CALLPASS(PASS1); IF OK THEN CALLPASS(PASS2); IF OK THEN CALLPASS(PASS3); IF OK THEN CALLPASS(PASS4); IF OK THEN CALLPASS(PASS5); IF OK THENN BEGIN MANTISSA:=MANTISSA*REAL10 + CONV(ORD(CH)-ORD('0')); EXPONENT:=EXPONENT-1 END; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); END END; "COLLECT EXPONENT PART" IF CH='E' THEN BEGIN OP:=REAL2; WRITE(CH); READ(CH); EXPONENT_PART:=0; EXPONENT_SIGN:=FALSE; IF CH='+' THEN BEGIN WRITE(CH); READ(CH) END ELSE IF CH='-' THEN BEGIN EXPONENT_SIGN:= TRUE; WRITE(CH); READ(CH) END; IF NOT(CH IN DIGISPIX:=INDEX; WITH NAME DO BEGIN PART:=ID1; NEW(NEXT); WITH NEXT@ DO BEGIN PART:=ID2; NEXT:=NIL END END END END; PROCEDURE STD_NAMES; BEGIN STD_ID('END ',-END2); STD_ID('IF ',-IF2); STD_ID('THEN ',-THEN2); STD_ID('BEGIN ',-BEGIN2); STD_ID('ELSE ',-ELSE2); STD_ID('DO ',-DO2); STD_ID('WITH ',-WITH2); STD_ID('IN ',-IN2); STD_ID('OF ',-OF2); STD_ID('WHILE ',-WHILE2); STD_ID(TS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF EXPONENT_PART<=INTEGER_LIMIT THEN EXPONENT_PART:=EXPONENT_PART*10-ORD('0') +ORD(CH) ELSE ERROR_SW:=TRUE; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); "ASSERT EXPONENT <= 0;" IF EXPONENT_SIGN THEN IF MAX_EXPONENT + EXPONENT >= EXPONENT_PART THEN EXPONENT:= EXPONENT - EXPONENT_PART ELSE ERROR_SW:= TRUE ELSE EXPONENT:=EXPONENT+EXPONENT_PART END; "NOW CONSTRUCT THE NUMBER'CASE ',-CASE2); STD_ID('REPEAT ',-REPEAT2); STD_ID('UNTIL ',-UNTIL2); STD_ID('PROCEDURE ',-PROCEDURE2); STD_ID('VAR ',-VAR2); STD_ID('FOR ',-FOR2); STD_ID('ARRAY ',-ARRAY2); STD_ID('RECORD ',-RECORD2); STD_ID('SET ',-SET2); STD_ID('TO ',-TO2); STD_ID('DOWNTO ',-DOWNTO2); STD_ID('MOD ',-MOD2); STD_ID('OR ',-OR2); STD_ID('AND ',-AND2); STD_ID('NOT ',-NOT2); STD_ID('DIV ',-" IF OP=INTEGER2 THEN BEGIN IF MANTISSA>CONV(MAX_INTEGER) THEN BEGIN ERROR(NUMBER_ERROR); MANTISSA:= REAL0 END; PUT1(INTEGER2,TRUNC(MANTISSA)) END ELSE "OP=REAL2" BEGIN IF ERROR_SW THEN BEGIN ERROR(NUMBER_ERROR); SPLIT(REAL0, REAL_VAL) END ELSE BEGIN "COMPUTE THE APPROPRIATE POWER OF TEN" POWER_OF_TEN:=REAL1; IF EXPONENT<0 THEN BEGIN EXPONENT_SIGN:=TRUE; EXPONENT:=ABS(EXPONENT) END ELSE EXPONENTDIV2); STD_ID('CONST ',-CONST2); STD_ID('TYPE ',-TYPE2); STD_ID('FUNCTION ',-FUNCTION2); STD_ID('FORWARD ',-FORWARD2); STD_ID('UNIV ',-UNIV2); STD_ID('PROGRAM ',-PROGRAM2); STD_ID('FALSE ',XFALSE); STD_ID('TRUE ',XTRUE); STD_ID('INTEGER ',XINTEGER); STD_ID('BOOLEAN ',XBOOLEAN); STD_ID('CHAR ',XCHAR); STD_ID('NIL ',XNIL); STD_ID('NEW ',XNEW); STD_ID('ABS ',XABS); STD_ID('ATTRIBUTE ',XATTRIBUTE);_SIGN:=FALSE; IF EXPONENT>MAX_EXPONENT THEN BEGIN ERROR(NUMBER_ERROR); EXPONENT:=0 END; FOR I:=1 TO EXPONENT DO POWER_OF_TEN:=POWER_OF_TEN*REAL10; "NOW EITHER MANTISSA=0.0 OR MANTISSA>=1.0" IF MANTISSA = REAL0 THEN RESULT:= REAL0 ELSE IF EXPONENT_SIGN THEN RESULT:= MANTISSA / POWER_OF_TEN ELSE "IF MANTISSA>=1.0 THEN WE MUST HAVE: MANTISSA*POWER_OF_TEN<=MAX_REAL => POWER_OF_TEN<=MAX_REAL/MANTISSA<=MAX_REAL" STD_ID('CHR ',XCHR); STD_ID('CONV ',XCONV); STD_ID('ORD ',XORD); STD_ID('PRED ',XPRED); STD_ID('SUCC ',XSUCC); STD_ID('TRUNC ',XTRUNC); STD_ID('REAL ',XREAL); END; PROCEDURE END_LINE; VAR I: INTEGER; BEGIN IF TEST THEN PRINT_TEST; WRITE(CH); READ(CH); LINE_NO:=LINE_NO+1; PUT1(NEW_LINE2,LINE_NO); IF CL4<'9' THEN CL4:=CHR(ORD(CL4)+1) ELSE BEGIN CL4:='0'; IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEG IF POWER_OF_TEN<=MAX_REAL/MANTISSA THEN RESULT:= MANTISSA * POWER_OF_TEN ELSE BEGIN ERROR(NUMBER_ERROR); RESULT:= REAL0 END; SPLIT(RESULT, REAL_VAL) END; PUT0(REAL2); PUT1(LCONST2,REALLENGTH); FOR I:= 1 TO SPLITLENGTH DO PUT_ARG(REAL_VAL(.I.)) END END; "#######" "HASHING" "#######" FUNCTION SAME_ID:BOOLEAN; VAR SAME:BOOLEAN; THIS_PIECE:PIECE_PTR; I:INTEGER; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SAME:=NAME.PARTIN CL3:='0'; IF CL2<'9' THEN CL2:=CHR(ORD(CL2)+1) ELSE BEGIN CL2:='0'; IF CL1<'9' THEN CL1:=CHR(ORD(CL1)+1) ELSE CL1:='0' END END END; WRITE(CL1); WRITE(CL2); WRITE(CL3); WRITE(CL4); WRITE(' '); IF CH = ' ' THEN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' ' END; PROCEDURE GET_CHAR(SKIP_FIRST: BOOLEAN); BEGIN IF SKIP_FIRST THEN BEGIN WRITE(CH); READ(CH) END; REPEAT IF CH='"' THEN BEGIN REPEAT REP=ID_TEXT(.0.); IF PIECES>0 THEN IF SAME THEN BEGIN THIS_PIECE:=NAME.NEXT; I:=1; REPEAT IF THIS_PIECE=NIL THEN BEGIN SAME:=FALSE "CANDIDATE IS TOO SHORT"; I:=PIECES+1 "QUIT" END ELSE BEGIN "COMPARE AND INCREMENT" SAME:=SAME AND (THIS_PIECE@.PART=ID_TEXT(.I.)); THIS_PIECE:=THIS_PIECE@.NEXT; I:=I+1; END UNTIL I>PIECES; SAME:=SAME AND (THIS_PIEEAT WRITE(CH); READ(CH) UNTIL (CH=EOL) OR (CH='"'); WHILE CH = EOL DO END_LINE UNTIL (CH=EOM) OR (CH='"'); IF CH = '"' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(COMMENT_ERROR) END; WHILE CH = ' ' DO BEGIN WRITE(CH); READ(CH) END; WHILE CH=EOL DO END_LINE UNTIL (CH<>' ') AND (CH<>'"') END; PROCEDURE INIT_OPTIONS; VAR STOP:SET OF CHAR; BEGIN END_LINE; NEW(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN OPTIONS:=(.LISTOPTION,CHECKOPTCE=NIL) END; SAME_ID:=SAME END END; PROCEDURE INSERT_ID; VAR I:INTEGER; P,P1:PIECE_PTR; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN CURRENT_INDEX:=CURRENT_INDEX+1; IF CURRENT_INDEX>=MAX_INDEX THEN BEGIN ERROR(INSERT_ERROR); CH:=EOM; WRITE(EOL) END; SPIX:=CURRENT_INDEX; WITH NAME DO BEGIN PART:=ID_TEXT(.0.); NEXT:=NIL END; IF PIECES>0 THEN BEGIN NEW(P); NAME.NEXT:=P; P@.PART:=ID_TEXT(.1.); FOR I:=2 TO PIECES DO BEGIN ION,NUMBEROPTION.); MARK(RESETPOINT); TABLES:=NIL; GET_CHAR(FALSE); IF CH='(' THEN BEGIN STOP:=(.',' , ')' , EOM.); REPEAT GET_CHAR(TRUE); IF CH='L' THEN OPTIONS:=OPTIONS-(.LISTOPTION.) ELSE IF CH='S' THEN OPTIONS:=OPTIONS OR (.SUMMARYOPTION.) ELSE IF CH='T' THEN OPTIONS:=OPTIONS OR (.TESTOPTION.) ELSE IF CH='C' THEN OPTIONS:=OPTIONS-(.CHECKOPTION.) ELSE IF CH='N' THEN OPTIONS:=OPTIONS-(.NUMBEROPTION.); NEW(P1); P@.NEXT:=P1; P1@.PART:=ID_TEXT(.I.); P:=P1 END; P@.NEXT:=NIL END END END; PROCEDURE SEARCH_ID; VAR FINISHED:BOOLEAN; BEGIN FINISHED:=FALSE; REPEAT WITH HASH_TABLE(.HASH_KEY.) DO IF SPIX<>NULL THEN IF SAME_ID THEN "FOUND IT" BEGIN FINISHED:=TRUE; IF SPIX>=0 THEN BEGIN SYMB:=ID2; INDEX:=SPIX END ELSE SYMB:=ABS(SPIX) END ELSE HASH_KEY:=(HASH_KEY+1 WHILE NOT(CH IN STOP) DO GET_CHAR(TRUE) UNTIL (CH=EOM) OR (CH=')'); IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END END; IF TESTOPTION IN OPTIONS THEN BEGIN TEST:=TRUE; TEST_INDEX:= 0 END END END; PROCEDURE INITIALIZE; VAR S:SPELLING_INDEX; C:MIN_ORD..MAX_ORD; BEGIN TEST:= FALSE; "EMPTY SET" PUT1(LCONST2,SETLENGTH); FOR S:=1 TO SETLENGTH DIV WORDLENGTH DO PUT_ARG(0); REAL0:= CONV(0); REAL1:= CONV(1); REAL10:= CONV(10); LARG) MOD HASH_MAX1 ELSE "SYM=NULL" BEGIN INSERT_ID; SYMB:=ID2; INDEX:=CURRENT_INDEX; FINISHED:=TRUE END UNTIL FINISHED "WITH SEARCH" END; "######" "STRING" "######" PROCEDURE STRING_CHAR; BEGIN IF STRING_LENGTH = MAX_STRING_LENGTH THEN ERROR(STRING_ERROR) ELSE BEGIN STRING_LENGTH:=STRING_LENGTH+1; STRING_TEXT(.STRING_LENGTH.):= CH; WRITE(CH); READ(CH) END END; PROCEDURE STRING; VAR ORD_VALUE, I: INTEGER; DONE: BOEST_REAL(MAX_REAL); REAL_LIMIT:= MAX_REAL / REAL10; CH:= EOL; END_SCAN:=FALSE; UPTO_SW:=FALSE; BUS_SW:=FALSE; LINE_NO:=0; CL1:='0'; CL2:='0'; CL3:='0'; CL4:='0'; DIGITS:=(.'0','1','2','3','4','5','6','7','8','9'.); LETTERS:=(.'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','_'.); ALFAMERICS:=LETTERS OR DIGITS; NON_ALFAS:= (..); FOR C:= MIN_ORD TO MAX_ORD DO NON_ALFAS:= NON_ALFAS OR (.CHR(C).); NON_ALFOLEAN; BEGIN STRING_LENGTH:=0; WRITE(CH); READ(CH); DONE:= FALSE; REPEAT WHILE NOT (CH IN STRING_SPECIAL) DO STRING_CHAR; CASE CH OF '''': BEGIN STRING_CHAR; IF CH = '''' THEN BEGIN WRITE(CH); READ(CH) END ELSE DONE:= TRUE END; EOL, EOM: BEGIN ERROR (STRING_ERROR); DONE:= TRUE END; '(': BEGIN STRING_CHAR; IF CH = ':' THEN BEGIN AS:= NON_ALFAS - ALFAMERICS; STRING_SPECIAL:= (.'''', EOL, EOM, '('.); BLANK:=' '; FOR S:=0 TO HASH_MAX DO HASH_TABLE(.S.).SPIX:=NULL; CURRENT_INDEX:=XREAL; STD_NAMES; INIT_OPTIONS; END; "######" "NUMBER" "######" PROCEDURE NUMBER; VAR MANTISSA,POWER_OF_TEN, RESULT: REAL; ERROR_SW,EXPONENT_SIGN:BOOLEAN; REAL_VAL:SPLITREAL; OP:INTEGER; EXPONENT,EXPONENT_PART,I:INTEGER; BEGIN OP:= INTEGER2; MANTISSA:= REAL0; ERROR_SW:= FALSE; EXPONENT:= 0; "COL REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' '; ORD_VALUE:= 0; IF CH IN DIGITS THEN REPEAT IF ORD_VALUE <= MAX_ORD THEN ORD_VALUE:= ORD_VALUE * 10 + (ORD(CH) - ORD('0')); WRITE(CH); READ(CH) UNTIL NOT (CH IN DIGITS) ELSE ERROR (STRING_ERROR); WHILE CH=' ' DO BEGIN WRITE(CH); READ(CH) END; IF CH=':' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); LECT INTEGER PART" REPEAT IF MANTISSA<=REAL_LIMIT THEN MANTISSA:=MANTISSA*REAL10 + CONV(ORD(CH)-ORD('0')) ELSE ERROR_SW:=TRUE; WRITE(CH); READ(CH) UNTIL NOT(CH IN DIGITS); "COLLECT FRACTIONAL PART" IF CH='.' THEN BEGIN WRITE(CH); READ(CH); IF CH=')' THEN BUS_SW:=TRUE ELSE IF CH='.' THEN UPTO_SW:=TRUE ELSE BEGIN OP:=REAL2; IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF MANTISSA <= REAL_LIMIT THE IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR); IF ORD_VALUE > MAX_ORD THEN BEGIN ERROR(STRING_ERROR); ORD_VALUE:= ORD('?') END; STRING_TEXT(.STRING_LENGTH.):= CHR(ORD_VALUE) END END END UNTIL DONE; IF STRING_LENGTH <= 1 THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1; STRING_TEXT(.1.):= '?' END ELSE STRING_LENGTH:= STRING_LENGTH - 1; IF STRING_LENGD_ID(ID1,ID2:PIECE; INDEX:SPELLING_INDEX); VAR CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO HASH_KEY:=HASH_KEY*(ORD(ID1(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID2(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID2(.CHAR_INDEX.)) MOD SPAN+1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; WITH HASH_TABLE(.HASH_KEY.) DO BEGIN _ERROR,KEYS OR QSTAT); STAT(KEYS); PUT2(JUMP_DEF2,L1,L2) END; PROCEDURE REPEAT_STAT; VAR L:LABEL; BEGIN NEW_LABEL(L); PUT1(DEF_LABEL2,L); GET; STAT_LIST (KEYS OR QUNTIL_TAIL); IF SY=UNTIL1 THEN GET ELSE ERROR(REPEAT_ERROR,KEYS OR QEXPR); EXPR(KEYS); PUT1(FALSEJUMP2,L) END; PROCEDURE FOR_STAT; CONST UP=5; DOWN=3; VAR L1,L2:LABEL; LKEYS1:SETS; OP,DIRECTION:INTEGER; BEGIN LKEYS1:=KEYS OR QFORB_END; GET; NEW_LABEL(L1); NEW_LABEL(L2); IDENTIFIER SY OF REAL1: BEGIN PUT0(FREAL2); GET END; STRING1: BEGIN PUT1(FSTRING2,ARG); GET END; INTEGER1: BEGIN PUT1(FINTEGER2,ARG); GET END; CHAR1: BEGIN PUT1(FCHAR2,ARG); GET END; ID1: FACTOR_ID(KEYS); OPEN1: BEGIN GET; EXPR(KEYS OR QCLOSE); IF SY=CLOSE1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END; NOT1: BEGIN GET; FACTOR(KEYS); PUT0(NOT2) END; SUB1: BEGIN GET; PUT0(EMPTY_SET2); LKEYS1:=KE(KEYS OR QFOR_END,NAME2,FOR_ERROR); PUT0(ADDRESS2); IF SY=BECOMES1 THEN GET ELSE ERROR(FOR_ERROR,LKEYS1); EXPR(LKEYS1); PUT0(FOR_STORE2); CHECK(FOR_ERROR,LKEYS1); DIRECTION:=UP; OP:=FOR_UP2; IF SY=TO1 THEN GET ELSE IF SY=DOWNTO1 THEN BEGIN GET; DIRECTION:=DOWN; OP:=FOR_DOWN2 END ELSE ERROR(FOR_ERROR,QTO_TAIL); EXPR(KEYS OR QDO_TAIL); PUT3(FOR_LIM2,L1,DIRECTION,L2); IF SY=DO1 THEN GET ELSE ERROR(FOR_ERROR,KEYS); STAT(KEYS); PUT2(OP,L1,L2) END; PROCEDURE TH > 1 THEN IF STRING_LENGTH MOD WORDLENGTH <> 0 THEN BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1 END; IF STRING_LENGTH = 1 THEN PUT1(CHAR2, ORD(STRING_TEXT(.1.))) ELSE PUT_STRING(STRING_TEXT, STRING_LENGTH) END; "##########" "IDENTIFIER" "##########" PROCEDURE IDENTIFIER; BEGIN PIECES:=-1; CHAR_INDEX:=ID_PIECE_LENGTH; HASH_KEY:= 1; REPEAT IF CHAR_INDEX=ID_PIECE_LENGTH THEN BEGIN CHAR_INDEX:= 0; PIECES:= SUCC(PIECES); ID_TEXT(.PIECES.):=BLANK; WITH_STAT; VAR WITH_COUNT,I:INTEGER; LKEYS1:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QWITH_LIST; WITH_COUNT:=0; GET; DONE:=FALSE; REPEAT PUT0(WITH_VAR2); VARIABLE(LKEYS1); PUT0(WITH_TEMP2); WITH_COUNT:=WITH_COUNT+1; CHECK(WITH_ERROR,LKEYS1); IF SY IN QID_LIST THEN IF SY=COMMA1 THEN GET ELSE ERROR(WITH_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=DO1 THEN GET ELSE ERROR(WITH_ERROR,KEYS OR QSTAT); STAT(KEYS); FOR I:=1 TO WITEND ELSE CHAR_INDEX:= SUCC(CHAR_INDEX); ID_TEXT(.PIECES,CHAR_INDEX.):=CH; HASH_KEY:=HASH_KEY*(ORD(CH) MOD SPAN +1) MOD HASH_MAX1; WRITE(CH); READ(CH) UNTIL CH IN NON_ALFAS; SEARCH_ID; IF SYMB=ID2 THEN PUT1(ID2,INDEX) ELSE BEGIN PUT0(SYMB); IF SYMB=END2 THEN BEGIN GET_CHAR(FALSE); IF CH='.' THEN BEGIN PUT0(PERIOD2); REPEAT WRITE(CH); READ(CH) UNTIL CH = EOL; WRITE(CH); END_SCAN:=TRUE END END H_COUNT DO PUT0(WITH2) END; "##########" "EXPRESSION" "##########" PROCEDURE EXPR; VAR OP:INTEGER; BEGIN SEXPR(KEYS OR QEXPR_OP); CHECK(EXPR_ERROR,KEYS OR QEXPR_OP); IF SY IN QEXPR_OP THEN BEGIN CASE SY OF EQ1: OP:=EQ2; NE1: OP:=NE2; LE1: OP:=LE2; GE1: OP:=GE2; LT1: OP:=LT2; GT1: OP:=GT2; IN1: OP:=IN2 END; PUT0(VALUE2); GET; SEXPR(KEYS); PUT0(OP) END END; PROCEDURE SEXPR; VAR UNARY:BOOLEAN; END END; "#######" "SCANNER" "#######" PROCEDURE SCAN; BEGIN REPEAT CASE CH OF ' ': BEGIN WRITE(CH); READ(CH) END; EOL: END_LINE; EOM: END_SCAN:=TRUE; '"': BEGIN REPEAT REPEAT WRITE(CH); READ(CH) UNTIL (CH = '"') OR (CH = EOL); WHILE CH = EOL DO END_LINE UNTIL (CH='"') OR (CH=EOM); IF CH=EOM THEN ERROR(COMMENT_ERROR) ELSE BEGIN WRITE(CH); READ(CH) END END; '.' LKEYS1:SETS; OP:INTEGER; BEGIN LKEYS1:=KEYS OR QTERM_LIST; CHECK(EXPR_ERROR,LKEYS1); IF SY IN QUNARY THEN BEGIN UNARY:=TRUE; IF SY=PLUS1 THEN OP:=UPLUS2 ELSE OP:=UMINUS2; GET END ELSE UNARY:=FALSE; TERM(LKEYS1); IF UNARY THEN PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QTERM_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QSEXPR_OP THEN BEGIN CASE SY OF PLUS1: OP:=PLUS2; MINUS1: OP:=MINUS2; : BEGIN WRITE(CH); READ(CH); IF UPTO_SW THEN BEGIN PUT0(UP_TO2); UPTO_SW:=FALSE END ELSE IF CH='.' THEN PUT0NC(UP_TO2) ELSE IF CH=')' THEN PUT0NC(BUS2) ELSE PUT0(PERIOD2) END; ':' : BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(BECOMES2) ELSE PUT0(COLON2) END; '<': BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(LE2) ELSE IF CH='>' THEN PUT0NC(NE2) ELSE SY=UNIV1 THEN BEGIN GET; TYPE_OP:=UNIV_TYPE2 END ELSE TYPE_OP:=PARM_TYPE2; "TYPE"IDENTIFIER(LKEYS1,TYPE_OP,PARM_ERROR); PUT1(LIST_OP,NUMBER); CHECK(PARM_ERROR,LKEYS1); IF SY IN QPARM_LIST THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(PARM_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(PARM_ERROR,KEYS) END END; "####" "BODY" "####" PROCEDURE BODY; BEGIN PUT0(BODY2); IF SY=BEGIN1 THEN G PUT0(LT2) END; '=': PUT0NC(EQ2); '>': BEGIN WRITE(CH); READ(CH); IF CH='=' THEN PUT0NC(GE2) ELSE PUT0(GT2) END; '''': STRING; '0','1','2','3','4','5','6','7','8','9': NUMBER; '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','_': IDENTIFIER; '(': BEGIN WRITE(CH); READ(CH); IF CH='.' THEN PUT0ET ELSE ERROR(BODY_ERROR,KEYS OR QBODY_END); STAT_LIST (KEYS OR QEND); PUT0(BODY_END2); IF SY=END1 THEN GET ELSE ERROR(BODY_ERROR,KEYS) END; PROCEDURE STAT_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QSTAT_LIST; DONE:=FALSE; REPEAT STAT(LKEYS1); CHECK(STATS_ERROR,LKEYS1); IF SY IN QSTAT_LIST THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(STATS_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE END; PROCEDURE STAT; BEGIN CHECK(SNC(SUB2) ELSE PUT0(OPEN2) END; ')': IF BUS_SW THEN BEGIN PUT0NC(BUS2); BUS_SW:=FALSE END ELSE PUT0NC(CLOSE2); ',': PUT0NC(COMMA2); ';': PUT0NC(SEMICOLON2); '*': PUT0NC(STAR2); '/': PUT0NC(SLASH2); '+': PUT0NC(PLUS2); '-': PUT0NC(MINUS2); '&': PUT0NC(AND2); '@': PUT0NC(ARROW2); '(:0:)', '(:1:TAT_ERROR,KEYS OR QSTAT); IF SY IN QSTAT THEN CASE SY OF ID1: ID_STAT(KEYS); BEGIN1: COMPOUND_STAT(KEYS); IF1: IF_STAT(KEYS); CASE1: CASE_STAT(KEYS); WHILE1: WHILE_STAT(KEYS); REPEAT1: REPEAT_STAT(KEYS); FOR1: FOR_STAT(KEYS); WITH1: WITH_STAT(KEYS) END END; PROCEDURE ID_STAT; VAR LKEYS1: SETS; BEGIN LKEYS1:=KEYS OR QID_END; VARIABLE(LKEYS1); CHECK(IDSTAT_ERROR,LKEYS1); IF SY=BECOMES1 THEN BEGIN PUT)', '(:2:)', '(:3:)', '(:4:)', '(:5:)', '(:6:)', '(:7:)', '(:8:)', '(:9:)', '(:11:)', '(:12:)', '(:13:)', '(:14:)', '(:15:)', '(:16:)', '(:17:)', '(:18:)', '(:19:)', '(:20:)', '(:21:)', '(:22:)', '(:23:)', '(:24:)', '(:26:)', '(:27:)', '(:28:)', '(:29:)', '(:30:)', '(:31:)', '(:33:)', '(:35:)', '(:36:)', '(:37:)', '(:63:)', '(:91:)', '(:92:)', '(:93:)', '(:94:)', '(:96:)', '(:97:)', '(:98:)', '(:99:)', '(:100:)', '(:101:)', '(:102:)', '(:103:)', '(:10(ANAME2); GET; EXPR(KEYS); PUT0(STORE2) END ELSE BEGIN PUT0(CALL_NAME2); ARG_LIST(KEYS); PUT0(CALL2) END END; PROCEDURE ARG_LIST; VAR DONE:BOOLEAN; LKEYS1:SETS; BEGIN CHECK(ARG_ERROR,KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(ARG_LIST2); GET; DONE:=FALSE; LKEYS1:=KEYS OR QARG_END; REPEAT EXPR(LKEYS1); PUT0(ARG2); CHECK(ARG_ERROR,LKEYS1); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(ARG_ERROR,LKEYS1) 04:)', '(:105:)', '(:106:)', '(:107:)', '(:108:)', '(:109:)', '(:110:)', '(:111:)', '(:112:)', '(:113:)', '(:114:)', '(:115:)', '(:116:)', '(:117:)', '(:118:)', '(:119:)', '(:120:)', '(:121:)', '(:122:)', '(:123:)', '(:124:)', '(:125:)', '(:126:)', '(:127:)': BEGIN WRITE('?'); READ(CH); ERROR(CHAR_ERROR) END END UNTIL END_SCAN; PUT0(EOM2) END; "####" "MAIN" "####" BEGIN INIT_PASS(INTER_PASS_PTR); INITIALIZE; SCAN; ELSE DONE:=TRUE UNTIL DONE; IF SY=CLOSE1 THEN GET ELSE ERROR(ARG_ERROR,KEYS) END END; PROCEDURE COMPOUND_STAT; BEGIN GET; STAT_LIST (KEYS); IF SY=END1 THEN GET ELSE ERROR(COMP_ERROR,KEYS) END; PROCEDURE IF_STAT; VAR L1,L2:LABEL; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QTHEN_END; GET; EXPR(KEYS OR QIF_END); NEW_LABEL(L1); PUT1(FALSEJUMP2,L1); IF SY=THEN1 THEN GET ELSE ERROR(IF_ERROR,LKEYS1); STAT(LKEYS1); CHECK(IF_ERROR,LKEYS1); I RELEASE(INTER_PASS_PTR@.RESETPOINT); NEXT_PASS(INTER_PASS_PTR) END. ); F SY=ELSE1 THEN BEGIN NEW_LABEL(L2); PUT2(JUMP_DEF2,L2,L1); GET; STAT(KEYS); PUT1(DEF_LABEL2,L2) END ELSE PUT1(DEF_LABEL2,L1) END; PROCEDURE CASE_STAT; VAR L0,LI,LN:LABEL; DONE:BOOLEAN; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QCASES; GET; NEW_LABEL(L0); NEW_LABEL(LN); EXPR(KEYS OR QCASE_END); PUT1(CASE_JUMP2,L0); DONE:=FALSE; IF SY=OF1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1); REPEAT NEW_LABEL(LI); PUT1(DEF_CASE2,LI); LABEL_LIST(LKEYS1, CASE2OR1: OP:=OR2 END; GET END ELSE BEGIN ERROR(EXPR_ERROR,LKEYS1); OP:=PLUS2 END; TERM(LKEYS1); PUT0(OP); CHECK(EXPR_ERROR,LKEYS1); UNTIL NOT(SY IN QTERM_LIST) END END; PROCEDURE TERM; VAR OP:INTEGER; LKEYS1:SETS; BEGIN LKEYS1:=KEYS OR QFACTOR_LIST; FACTOR(LKEYS1); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QFACTOR_LIST THEN BEGIN PUT0(VALUE2); REPEAT IF SY IN QTERM_OP THEN BEGIN CASE SY OF , CASE_ERROR); STAT(LKEYS1); PUT1(JUMP2,LN); CHECK(CASE_ERROR,LKEYS1); IF SY IN QCASES THEN IF SY=SEMICOLON1 THEN GET ELSE ERROR(CASE_ERROR,LKEYS1) ELSE DONE:=TRUE UNTIL DONE; PUT2(END_CASE2,L0,LN); IF SY=END1 THEN GET ELSE ERROR(CASE_ERROR,KEYS); END; PROCEDURE WHILE_STAT; VAR L1,L2:LABEL; BEGIN NEW_LABEL(L1); NEW_LABEL(L2); PUT1(DEF_LABEL2,L1); GET; EXPR(KEYS OR QDO_TAIL); PUT1(FALSEJUMP2,L2); IF SY=DO1 THEN GET ELSE ERROR(WHILE STAR1: OP:=STAR2; SLASH1: OP:=SLASH2; DIV1: OP:=DIV2; MOD1: OP:=MOD2; AND1: OP:=AND2 END; GET END ELSE BEGIN ERROR(EXPR_ERROR,LKEYS1); OP:=STAR2 END; FACTOR(LKEYS1); PUT0(OP); CHECK(EXPR_ERROR,LKEYS1) UNTIL NOT(SY IN QFACTOR_LIST) END END; PROCEDURE FACTOR; VAR LKEYS1:SETS; BEGIN CHECK(EXPR_ERROR,KEYS OR QFACTOR); IF SY IN QFACTOR THEN CASELENGTH:INTEGER; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; READ_IFL(LENGTH); PUT2(STRING2,LENGTH,CONST_DISP) END; "#########" "MAIN LOOP" "#########" BEGIN INITIALIZE; REPEAT READ_IFL(SY); CASE SY OF ADDRESS1: PUT0(ADDRESS2); ANAME1: ANAME; AND1: BINARY(AND2); ARG_LIST1: ARG_LIST; ARG1: ARG; ARRAY_DEF1: ARRAY_DEF; ARROW1: ARROW; BODY_END1: BODY_END; BODY1: BODY; CALL_FUNC1: CALL(CALL_FUNC2); CALL_NAME1: CALL_NAME; CALL1: CALL(CALL_PROC2); CASE1: CASE_; CASE_JUMP1: IGNORE1(CASOCEDURE FUNCTION_ERROR(ERROR_NUM:INTEGER); BEGIN ERROR(ERROR_NUM); OPS(.T.).CLASS:=UNDEF_CLASS END; PROCEDURE FUNCTION_; VAR FUNC_TYPE: NOUN_INDEX; BEGIN FUNC_TYPE:= XUNDEF; WITH OPS(.T.) DO IF CLASS = ROUTINE_CLASS THEN WITH ROUT@ DO IF ROUT_TYPE = PROC_TYPE THEN FUNCTION_ERROR(PROC_USE_ERROR) ELSE FUNC_TYPE:= ROUT_TYPE@.NOUN ELSE FUNCTION_ERROR(NAME_ERROR); PUT1(FUNCTION2, FUNC_TYPE) END; PROCEDURE BINARY(OP:INTEGER); E_JUMP2); CHAR1: INDEX(XCHAR); COMP1: COMP; CONST_DEF1: CONST_DEF; CONST_ID1: CONST_ID; CONSTANT1: CONSTANT; CPARMLIST1: PARMLIST(CPARMLIST2); DEF_CASE1: DEF_CASE; DEF_LABEL1: IGNORE1(DEF_LABEL2); DIV1: BINARY(DIV2); EMPTY_SET1: BEGIN PUSH; PUT0(EMPTY_SET2) END; END_CASE1: END_CASE; ENUM_DEF1: PUT2(ENUM_DEF2,ENUM_TYPE,ENUM_VAL); ENUM_ID1: ENUM_ID; ENUM1: ENUM; EOM1: HALT:=TRUE; EQ1: BINARY(EQ2); FALSEJUMP1: BEGIN IGNORE1(FALSEJUMP2); T:=T-1 END; FCHAR1: FINDEX(XCHAR); FIELD_ID1,PARM_ID1, BEGIN PUT0(OP); T:=T-1 END; PROCEDURE POP2(OP:INTEGER); BEGIN PUT0(OP); T:=T-2 END; "########" "VARIABLE" "########" PROCEDURE PUSH_OPERAND(OP_ENTRY:ENTRY_PTR; COMP:BOOLEAN); VAR OP:INTEGER; VARNT_PTR:VARIANT_PTR; BEGIN IF NOT COMP THEN PUSH; WITH OPS(.T.) , OP_ENTRY@ DO CASE KIND OF INDEX_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(INDEX2,CONST_VAL,CONST_TYPE) END; REAL_CONST: BEGIN CLASS:=FCONST_CLASS; ; ;"################################### ; # TIMER # ;###################################" ; ; ; VAR TIMER: ; CLASS ; SMALL6 = 10. ; CONST SMALLINCR = 10; LARGE6 = PUT1(REAL2,REAL_DISP) END; STRING_CONST: BEGIN CLASS:=FCONST_CLASS; PUT2(STRING2,STRING_LENGTH,STRING_DISP) END; VARIABLE,FIELD,PARAMETER: BEGIN CLASS:=VAR_CLASS; CASE KIND OF VARIABLE:VTYPE:=VAR_TYPE; FIELD: VTYPE:=FIELD_TYPE; PARAMETER: VTYPE:=PARM_TYPE END; IF COMP THEN BEGIN OP:=VCOMP2; VARNT_PTR:=VARIANT; WHILE VARNT_PTR<>NIL DO 167. ; LARGEINCR = 167; ; PERIO6: .WORD 0 ; VAR PERIOD: INTEGER; ; ; ; MACRO FUNCTION ELAPSED: INTEGER; ; .MACRO ELAPS6 ; BEGIN MOV PERIO6,R0 ; ELAPSED := PERIOD + SMALLINCR; ADD #SMALL6,R0 ; CLR PERIO6 ; PYS OR QSET_EXPR; CHECK(EXPR_ERROR,LKEYS1); WHILE SY IN QARGUMENT DO BEGIN EXPR(LKEYS1); PUT0(INCLUDE2); CHECK(EXPR_ERROR,LKEYS1); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(EXPR_ERROR,LKEYS1); CHECK(EXPR_ERROR,LKEYS1) END; IF SY=BUS1 THEN GET ELSE ERROR(EXPR_ERROR,KEYS) END END ELSE PUT1(NAME2,XUNDEF) END; PROCEDURE FACTOR_ID; BEGIN VARIABLE(KEYS OR QOPEN); CHE WITH VARNT_PTR@ DO BEGIN PUT2(VARIANT2,LABEL_SET,TAG_NOUN); VARNT_PTR:=PARENT_VARIANT END END ELSE OP:=VAR2; PUT2(OP,NOUN,VTYPE@.NOUN) END; ROUTINE_KIND: BEGIN CLASS:=ROUTINE_CLASS; ROUT:=OP_ENTRY; PARM:=ROUT_PARM; PUT1(ROUTINE2,NOUN) END; SCALAR_KIND,POINTER_KIND,ARRAY_KIND,RECORD_KIND,SET_KIND, UNDEF_KIND: BEGIN ERROR(NAME_ERROR); CLASSCK(EXPR_ERROR, KEYS OR QOPEN); IF SY=OPEN1 THEN BEGIN PUT0(FUNCTION2); ARG_LIST(KEYS); PUT0(CALL_FUNC2) END ELSE PUT0(FNAME2) END; "########" "VARIABLE" "########" PROCEDURE VARIABLE; VAR LKEYS1,LKEYS2:SETS; DONE:BOOLEAN; BEGIN LKEYS1:=KEYS OR QSELECT; IDENTIFIER(LKEYS1,NAME2,VARIABLE_ERROR); CHECK(VARIABLE_ERROR,LKEYS1); WHILE SY IN QSELECT DO BEGIN CASE SY OF PERIOD1: BEGIN PUT0(ADDRESS2); GET; IDENTIFIER(LKEYS:=UNDEF_CLASS; IF NOT COMP THEN PUT0(UNDEF2) END END END; PROCEDURE NAME; VAR SPIX:SPELLING_INDEX; COMP,ERR:BOOLEAN; NAME_ENTRY:ENTRY_PTR; BEGIN READ_IFL(SPIX); ERR:=FALSE; COMP:=FALSE; WITH SPELLING_TABLE(.SPIX.) DO IF ACCESS IN OP_ACCESS THEN BEGIN NAME_ENTRY:=ENTRY; CASE ACCESS OF GENERAL,UNRES_ROUTINE: ; QUALIFIED: BEGIN COMP:=TRUE; PUSH "WITH TEMP"; WITH DISPLAY(.LEVEL.).LEVEL_ENTRY@ DO BEGIN 1,COMP2,VARIABLE_ERROR) END; SUB1: BEGIN PUT0(ADDRESS2); GET; LKEYS2:=LKEYS1 OR QSUB_END; DONE:=FALSE; REPEAT EXPR(LKEYS2); PUT0(SUB2); CHECK(VARIABLE_ERROR,LKEYS2); IF SY IN QARGUMENT THEN IF SY=COMMA1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS2) ELSE DONE:=TRUE UNTIL DONE; IF SY=BUS1 THEN GET ELSE ERROR(VARIABLE_ERROR,LKEYS1) END; ARROW1: BEGIN PUT0(ARROW2); GET PUT2(VAR2,NOUN,ZWITH); PUT1(ARROW2,WITH_TYPE) END END END END ELSE ERR:=TRUE; IF ERR THEN BEGIN ERROR(NAME_ERROR); NAME_ENTRY:=UENTRY END; PUSH_OPERAND(NAME_ENTRY,COMP) END; PROCEDURE COMP; CONST QUALIFIED=TRUE; VAR SPIX:SPELLING_INDEX; COMPONENT:ENTRY_PTR; NAME_LIST:NAME_PTR; ERR:BOOLEAN; BEGIN READ_IFL(SPIX); ERR:=FALSE; WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN BEGIN WITH VTYPE@ DO END END; CHECK(VARIABLE_ERROR,LKEYS1) END END; PROCEDURE CONSTANT; BEGIN CHECK(CONSTANT_ERROR,KEYS OR QCONSTANT); IF SY IN QCONSTANT THEN BEGIN CASE SY OF ID1: PUT1(CONSTANT2,ARG); INTEGER1: PUT1(INTEGER2,ARG); REAL1: PUT0(REAL2); CHAR1: PUT1(CHAR2,ARG); STRING1: PUT1(STRING2,ARG) END; GET END ELSE BEGIN ERROR(CONSTANT_ERROR,KEYS); PUT1(CONSTANT2,XUNDEF) END END; "############" "MAIN PROGRAM" IF KIND=RECORD_KIND THEN NAME_LIST:=FIELD_NAME ELSE BEGIN ERR:=TRUE; NAME_LIST:=NIL END; FIND_NAME(NAME_LIST,SPIX,COMPONENT) END ELSE ERR:=TRUE; IF ERR THEN ERROR(COMP_ERROR) ELSE PUSH_OPERAND(COMPONENT,QUALIFIED) END; PROCEDURE SUB_ERR; BEGIN ERROR(SUB_ERROR); PUT2(SUB2,XUNDEF,XUNDEF) END; PROCEDURE SUB; BEGIN T:=T-1; WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=ARRAY_KIND THEN BEGIN P "############" BEGIN INITIALIZE; PROGRAM_; INTER_PASS_PTR@.LABELS:= CURRENT_LABEL; NEXT_PASS(INTER_PASS_PTR) END. UT2(SUB2,INDEX_TYPE,EL_TYPE@.NOUN); VTYPE:=EL_TYPE END ELSE SUB_ERR ELSE SUB_ERR END; PROCEDURE ARROW_ERR; BEGIN ERROR(ARROW_ERROR); PUT1(ARROW2,XUNDEF) END; PROCEDURE ARROW; BEGIN FNAME "CALL PARAMETERLESS POINTER-VALUED FUNCTION, IF ANY" ; WITH OPS(.T.) DO IF CLASS=VAR_CLASS THEN WITH VTYPE@ DO IF KIND=POINTER_KIND THEN BEGIN VTYPE:=OBJECT_TYPE; PUT1(ARROW2,VTYPE@.NOUN) END ELSE ARROW_ERR VAR_ID1: PUSH_NEW_NAME(NOT_POSSIBLY_FORWARD, OUTPUT,INCOMPLETE); FIELDLIST1: FIELD_LIST; FINTEGER1: FINDEX(XINTEGER); FNAME1: FNAME; FOR_DOWN1: IGNORE2(FOR_DOWN2); FOR_LIM1: BEGIN IGNORE3(FOR_LIM2); T:=T-1 END; FOR_STORE1: POP2(FOR_STORE2); FOR_UP1: IGNORE2(FOR_UP2); FORWARD1: FORWARD_; FREAL1: FREAL; FSTRING1: FSTRING; FUNC_DEF1: FUNC_DEF; FUNC_ID1: ROUTINE_ID(GENERAL,FUNC_MODE); FUNC_TYPE1: FUNC_TYPE; FUNCTION1: FUNCTION_; GE1: BINARY(GE2); GT1: BINARY(GT2); INCLUDE1: BINARY(INCLUDE2) ELSE ARROW_ERR END; "########" "CONSTANT" "########" PROCEDURE CONSTANT; BEGIN PUSH_OLD_NAME; IF DEFINED THEN WITH OPS(.T.), DEF_ENTRY@ DO IF KIND IN CONST_KINDS THEN CASE KIND OF INDEX_CONST: BEGIN CLASS:=ICONST_CLASS; ICONST_TYPE:=CONST_TYPE; ICONST_VAL:=CONST_VAL END; REAL_CONST: BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=REAL_DISP END; ; INTEGER1: INDEX(XINTEGER); IN1: BINARY(IN2); JUMP_DEF1: IGNORE2(JUMP_DEF2); JUMP1: IGNORE1(JUMP2); LABEL1: LABEL; LBL_END1: LBL_END; LCONST1: LCONST; LE1: BINARY(LE2); LT1: BINARY(LT2); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: BINARY(MINUS2); MOD1: BINARY(MOD2); NAME1: NAME; NEW_LINE1: IGNORE1(NEW_LINE2); NE1: BINARY(NE2); NOT1: PUT0(NOT2); OR1: BINARY(OR2); PARM_TYPE1: TYPE_(OUTPUT,PARM_TYPE2); PART_END1: PART_END; PLUS1: BINARY(PLUS2); POINTER1: POINTER; PROC_DEF1: PROC_DEF(PROC_DEF2); STRING_CONST:BEGIN CLASS:=SCONST_CLASS; SCONST_LENGTH:=STRING_LENGTH; SCONST_DISP:=STRING_DISP END END ELSE BEGIN CLASS:=UNDEF_CLASS; ERROR(CONSTID_ERROR) END END; PROCEDURE REAL_; BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=RCONST_CLASS; RCONST_DISP:=CONST_DISP END END; PROCEDURE FREAL; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; PUT1(REAL2,CONST_DISP) END; PROCEDURE INDEX(T PROC_ID1: ROUTINE_ID(GENERAL,PROC_MODE); PROG_DEF1: PROC_DEF(PROG_DEF2); PROG_ID1: BEGIN PREFIX_SW:= FALSE; ROUTINE_ID(INCOMPLETE, PROGRAM_MODE) END; REAL1: REAL_; REC_DEF1: REC_DEF; REC1: REC; SET_DEF1: SET_DEF; SLASH1: BINARY(SLASH2); STAR1: BINARY(STAR2); STORE1: POP2(STORE2); STRING1: STRING; SUBR_DEF1: SUBR_DEF; SUB1: SUB; TAG_DEF1: TAG_DEF; TAG_ID1: TAG_ID; TAG_TYPE1: TYPE_(OUTPUT,TAG_DEF2); TYPE_DEF1: TYPE_DEF; TYPE_ID1: TYPE_ID; TYPE1: TYPE_(OUTPUT,TYPE2); UMINUS1: PUT0(UMINUS2)YP:NOUN_INDEX); BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=ICONST_CLASS; ICONST_TYPE:=TYP; READ_IFL(ICONST_VAL) END END; PROCEDURE FINDEX(TYP:NOUN_INDEX); VAR VALUE:INTEGER; BEGIN PUSH; OPS(.T.).CLASS:=FCONST_CLASS; READ_IFL(VALUE); PUT2(INDEX2,VALUE,TYP) END; PROCEDURE STRING; BEGIN PUSH; WITH OPS(.T.) DO BEGIN CLASS:=SCONST_CLASS; READ_IFL(SCONST_LENGTH); SCONST_DISP:=CONST_DISP END END; PROCEDURE FSTRING; VAR T:=T-1 END; "##########" "EXPRESSION" "##########" PROCEDURE FNAME; VAR TYP: ENTRY_PTR; BEGIN WITH OPS(.T.) DO IF CLASS=ROUTINE_CLASS THEN WITH ROUT@ DO BEGIN IF ROUT_TYPE=PROC_TYPE THEN BEGIN ERROR(PROC_USE_ERROR); TYP:= UENTRY END ELSE TYP:=ROUT_TYPE; PUT1(FUNCTION2, TYP@.NOUN); IF PARM<>NIL THEN ERROR(FEW_ARGS_ERROR); PUT0(CALL_FUNC2); CLASS:= VAR_CLASS; VTYPE:= TYP END END; PR MUL #.SEGSB,R1 ; MOV R1,HEAP10 ; RTS PC ; END; ; ; ; PROCEDURE DEFPRIVATE(LENGTH: PLEN10: .BLKB .INTEGER ; INTEGER); PBAS10: .BLKB .INTEGER ; VAR BASE: INTEGER; ;PAGE IS R3 : PAGE: INTEGER; ;TOTAL IS R0 ; TOTAL: INTEGER; ; ; ;"################################### ; # CLOCK INTERRUPT # ;###################################" ; ; ; PROCEDURE ENTRY CLOCKINTERRUPT; ; INTER8 = LARGE6 ; CONST INTERVAL = 167; ; DEFP10: ; BEGIN MOV PLEN10,LENGT9 ; CORE.ALLOC(LENGTH, BASE); MOV #PBAS10,FIRST9 ; JSR PC,ALLOC9 ; MOV PLEN10,R1 ; TOTAL := (LENGTH + 8191) DIV 8192 ADD #<.SEGSB-1>,R1 ; + COMMON; CLR R0 ; DIV #.SEGSB,R0 ; MOV COMM10,R3 ; ADD R3,R0 ; CMP R0,#8. ; "UNIT = 0.1 MILLISECOND" ; CLOCK8: ; BEGIN MOV #INTER8,INTER6 ; TIMER.TICK(INTERVAL); JSR PC,TICK6 ; MOV #INTER8,INTER7 ; CLOCK.INCREMENT(INTERVAL); JSR PC,INCRE7 ; JSR PC,RESC12 ; READY.RESCHEDULE; RTS PC ; END; ; ; IF TOTAL > 8 THEN BLE 1$ ; KERNELERROR(VIRTUALLIMIT); MOV #VIRT10,RESU19 ; JSR PC,KERN19 ; 1$: MOV PBAS10,R1 ; FOR PAGE := COMMON TO TOTAL - 1 SUB R3,R0 ; DO ASL R3 ; ADD #HARD10,R3 ; BEGIN 2$: MOV R1,(R3)+ ; HARDWAREMAP(.PAGE.) := BASE; ADD #.SGSBK,R1 ; BASE :+ 128; SOB R0,2$ ; .SBTTL CORE ALLOCATION ;"################################### ; # CORE # ;###################################" ; ; ; VAR CORE: ; CLASS ; COREL9: ; CONST CORELIMIT = ; END; RTS PC ; END; ; ; P10: .BLKB .PROCREF ; PROCEDURE GETMAP(P: PROCESSREF); ;PAGE IS R0, R2 ; VAR PAGE: INTEGER; ; GETM10: ; BEGIN MOV COMM10,R0 ; FOR PAGE := COMMON TO 7 DO MOV #8.,R1 ; SUB R0,R1 ; ASL R0 .ASCIZ /CORE LIMIT/ ; 'CORE LIMIT(:0:)'; .EVEN ; COREC9: .WORD 1536. ; CORECAPACITY = 1536 "BLOCKS"; ; " = 48 KILOWORDS" ; $ = USER99 - ZERO ; VAR TOP "BLOCK": INTEGER; TOP9: .WORD $ / .BLKSB ; FREE9: .BLKB .INTEGER ; FREE "BLOCKS": INTEGER; ; ; MOV R0,R2 ; ADD #HARD10,R0 ; ADD P10,R2 ; WITH P@ DO ADD #MAP0,R2 ; 1$: MOV (R2)+,(R0)+ ; HARDWAREMAP(.PAGE.) := ; MAP(.PAGE.); SOB R1,1$ ; END; RTS PC ; ; ; ; PROCEDURE PUTMAP; ;PAGE ; LENGT9: .BLKB .INTEGER ; PROCEDURE ALLOC(LENGTH: INTEGER; FIRST9: .BLKB .ADDRESS ; VAR FIRST: INTEGER); ;BLOCKS IS R4 ; VAR BLOCKS: INTEGER; ; ALLOC9: ; BEGIN MOV LENGT9,R5 ; BLOCKS := (LENGTH + 63) DIV 64; CLR R4 ; ADD #<.BLKSB-1>,R5 ; ADC R4 ; DIV #.BLKSB,R4 ; IS R0, R2 ; VAR PAGE: INTEGER; ; PUTM10: ; BEGIN MOV COMM10,R0 ; FOR PAGE := COMMON TO 7 DO MOV #8.,R1 ; SUB R0,R1 ; ASL R0 ; MOV R0,R2 ; ADD #HARD10,R0 ; ADD USER99,R2 ; WITH RUNNING.USER @ DO ADD #MAP0,R2 ; 1$: MOV (R0)+,(R2)+ ERIOD := 0; .ENDM ELAPS6 ; END; ; ; INTER6: .BLKB .INTEGER ; PROCEDURE TICK(INTERVAL: INTEGER); ; TICK6: ; BEGIN ADD #LARGE6,PERIO6 ; PERIOD :+ LARGEINCR; RTS PC ; END; ; ; ; MACRO PROCEDURE RES CMP R4,FREE9 ; IF BLOCKS > FREE THEN BLE 1$ ; MOV #COREL9,RESU19 ; KERNELERROR(CORELIMIT); JSR PC,KERN19 ; 1$: MOV TOP9,@FIRST9 ; FIRST := TOP; ADD R4,TOP9 ; TOP :+ BLOCKS; SUB R4,FREE9 ; FREE :- BLOCKS; RTS PC ; END; ; ; INIT9: ET; ; .MACRO RESET6 ; BEGIN CLR PERIO6 ; PERIOD := 0; .ENDM RESET6 ; END; ; ; INIT6: ; BEGIN ; DONE AT LABEL "PERIO6". ; PERIOD := 0; RTS PC ; END; ; ;"################################### ; BEGIN ; DONE AT LABEL "TOP9". ; TOP := HEADADDR DIV 64; MOV COREC9,R0 ; FREE := CORECAPACITY - TOP; SUB TOP9,R0 ; MOV R0,FREE9 ; RTS PC ; END; ; ; .SBTTL VIRTUAL MEMORY ;"################################### ; # VIRTUAL # ; # CLOCK # ;###################################" ; ; ; VAR CLOCK: ; CLASS ; WAITT7 = 1 ; CONST WAITTIME = 1; ; NOW7: .BLKB .TIME ; VAR NOW: TIME; NEXTT7: .BLKB .SIGNAL ;###################################" ; ; ; VAR VIRTUAL: ; CLASS ; VIRT10: ; CONST VIRTUALLIMIT = .ASCIZ /VIRTUAL LIMIT/ ; 'VIRTUAL LIMIT(:0:)'; .EVEN ; ; HARD10 = UISAR ; ; NEXTTIME: SIGNAL; ; ; ; PROCEDURE INCREMENT(INTERVAL: INTER7: .BLKB .INTEGER ; INTEGER); ;P IS GET4R, P12 ; VAR P: PROCESSREF; LASTT7: .BLKB .INTEGER ; LASTTIME: INTEGER; ; INCRE7: ; BEGIN MOV NOW7+SEC5,LASTT7 ; LASTTIME := NOW.SEC; MOV #VAR HARDWAREMAP: MAPTYPE; COMM10: .BLKB .INTEGER ; COMMON: INTEGER; HEAP10: .BLKB .INTEGER ; ENTRY HEAPTOP: INTEGER; ; ; ; PROCEDURE DEFCOMMON(LENGTH: CLEN10: .BLKB .INTEGER ; INTEGER); CBAS10: .BLKB .INTEGER ; VAR BASE: INTEGER; ;PAGE IS R3 ; PAGE: INTEGER; ; DENOW7,TIME5T ; NOW.ADD(INTERVAL); MOV INTER7,INCR5 ; JSR PC,ADD5 ; MOV LASTT7,R0 ; IF NOW.SEC >= ADD #WAITT7,R0 ; LASTTIME + WAITTIME THEN CMP NOW7+SEC5,R0 ; BLT 1$ ; MOV #NEXTT7,SIG26T ; NEXTTIME.SEND; JSR PC,SEND26 ; 1$: RTS PC ; END; ; FC10: ; BEGIN MOV CLEN10,LENGT9 ; CORE.ALLOC(LENGTH, BASE); MOV #CBAS10,FIRST9 ; JSR PC,ALLOC9 ; MOV CLEN10,R1 ; COMMON := (LENGTH + 8191) DIV CLR R0 ; 8192; ADD #<.SEGSB-1>,R1 ; ADC R0 ; DIV #.SEGSB,R0 ; MOV R0,COMM10 ; CMP R0,#8. ; IF ; WAIT7: ; PROCEDURE ENTRY WAIT; ; ; BEGIN MOV #NEXTT7,SIG26T ; NEXTTIME.AWAIT; JSR PC,AWAI26 ; RTS PC ; END; ; ; REALT7: ; FUNCTION ENTRY REALTIME: INTEGER; ; $$ = NOW7 + SEC5 ; BEGIN COMMON > 8 THEN BLE 1$ ; KERNELERROR(VIRTUALLIMIT); MOV #VIRT10,RESU19 ; JSR PC,KERN19 ; 1$: MOV CBAS10,R1 ; FOR PAGE := 0 TO COMMON - 1 DO MOV #HARD10,R3 ; BEGIN 2$: MOV R1,(R3)+ ; HARDWAREMAP(.PAGE.) := BASE; ADD #.SGSBK,R1 ; BASE :+ 128; SOB R0,2$ ; END; MOV COMM10,R1 ; HEAPTOP := COMMON * 8192; MOV $$, ; REALTIME := NOW.SEC; RTS PC ; END; ; ; INIT7: ; BEGIN MOV #NOW7,TIME5T ; NOW.INITIALIZE; JSR PC,INIT5 ; MOV #NEXTT7,SIG26T ; NEXTTIME.INITIALIZE; JSR PC,INIT26 ; RTS PC ; END; ; ,HEAD11+SLICE1 ; CMP R1,#MAXS11 ; IF SLICE >= MAXSLICE THEN BLT 1$ ; BEGIN CLR R0 ; NEWSLICE := DIV #MAXS11,R0 ; SLICE MOD MAXSLICE; MOV R1,NEWS11 ; MOV HEAD11+SLICE1,R0 ; RUNTIME.ADD(SLICE - SUB R1,R0 ; NEWSLICE); MOV R0,INCR5 ; $$ = HEAD11 + RUNTI1 ; ; VAR RUNNING: ; CLASS ; PLIM11: ; CONST PARAMLIMIT = .ASCIZ /PARAMETER LIMIT/ ; 'PARAMETER LIMIT(:0:)'; .EVEN ; MAX11 = 20. ; MAX = 20; FLOA11 = FSTAT0 ; FLOATSTATUS = ...; PGST11 = USRPSW ; PROGSTATUS = ...; STAR11 = STARTADDR - USER99 ; STARTADDR = MOV #$$,TIME5T ; JSR PC,ADD5 ; MOV NEWS11,HEAD11+SLICE1; SLICE := NEWSLICE; INC HEAD11+OVERT1 ; OVERTIME := TRUE; TST HEAD11+NESTI1 ; IF NESTING = 0 THEN BNE 1$ ; MOV #2.,HEAD11+PRIOR1 ; PRIORITY := 2; ; END; ; END; 1$: RTS PC ; END; ...; ; ; VAR ENTRY USER11 = USER99 ; USER: PROCESSREF; ; ENTRY HEAD11 = HEAD99 ; HEAD: HEADTYPE; CONS11 = CONS99 ; CONSTADDR: INTEGER; ; PARA11: .REPT MAX11 ; PARAM: ARRAY (.1..MAX.) OF .BLKB .INTEGER ; INTEGER; .ENDR ; ; .MACRO ENTE11 ; MACRO PROCEDURE ENTER; ; ; BEGIN ; WITH HEAD DO ; BEGIN INC HEAD11+NESTI1 ; NESTING :+ 1; CLR HEAD11+PRIOR1 ; PRIORITY := 0; ; END; .ENDM ENTE11 ; END; ; NEXT11: .WORD 1 ; NEXTINDEX: INTEGER; ; ENTRY PRID11: .REPT PROCS ; PROCESSID: ARRAY (.1..PROCESSES.) .BLKB .PROCREF ; OF PROCESSREF; .ENDR ; ; "HARDWARE" ; REG: REGTYPE; ; ; P11: .BLKB .PROCREF ; PR ; ; ; MACRO PROCEDURE LEAVE; ; .MACRO LEAV11 ?L ; BEGIN ; WITH HEAD DO ; BEGIN DEC HEAD11+NESTI1 ; NESTING :- 1; BNE L ; IF NESTING = 0 THEN ; BEGIN MOV #2.,HEAD11+PRIOR1 ; PRIORITY := 2; JSR OCEDURE SERVE(P: PROCESSREF); ; SERV11: ; BEGIN RESET6 ; TIMER.RESET; MOV P11,R0 ; USER := P; MOV R0,USER11 ; MOV #HEAD11,R1 ; HEAD := USER@.HEAD; ADD #HEAD0,R0 ; $ = .HEADTYP / .INTEGER ; .REPT $ ; MOV (R0)+,(R1)+ ; .ENDR ; MOV SP,R PC,RESC12 ; READY.RESCHEDULE; ; END; L: ; END; .ENDM LEAV11 ; END; ; ; ; MACRO PROCEDURE STARTIO; ; .MACRO STIO11 ?L ; BEGIN ; WITH HEAD DO TST HEAD11+NESTI1 ; IF NESTING = 0 THEN 1 ; REG := USER@.REG; MOV R0,SP ; BIS #,PSW ;<01> SET PREVIOUS USER MODE MOV (SP)+,KSR0 ;<01> MOV (SP)+,KSR1 ;<01> MOV (SP)+,KSR2 ;<01> MOV (SP)+,KSR3 ;<01> MOV (SP)+,KSR4 ;<01> MOV (SP)+,KSR5 ;<01> MOV SP,R0 ; MOV R1,SP ; MOV (R0)+,-(SP) ; MTPI SP BNE L ; MOV #1.,HEAD11+PRIOR1 ; PRIORITY := 1; L: ; .ENDM STIO11 ; END; ; ; ; PROCEDURE POPPARAM(PARAMLENGTH: PLEN11: .BLKB .INTEGER ; INTEGER); ;I IS R0, R1 ; VAR I: INTEGER; ; POPP11: MOV PLEN11,R0 ; BEG ; MOV (R0)+,KSOPC ; .IF DF,F$PU ;<01> ONLY IF FPU PRESENT MOV (R0)+,KSOPSW ; LDD (R0)+,W ; LDD (R0)+,X ; LDFPS (R0) ; .IFF ;<01> MOV (R0),KSOPSW ;<01> .ENDC ;<01> MOV USER11,P10 ; VIRTUAL.GETMAP(USER); JSR PC,GETM10 ; ; WITH HEAD DO TST HEAD11+NESTI1 ; IIN BEQ 1$ ; ASR R0 ; CMP R0,#MAX11 ; IF PARAMLENGTH > MAX THEN BLE 2$ ; MOV #PLIM11,RESU19 ; KERNELERROR(PARAMLIMIT); JSR PC,KERN19 ; 2$: MOV #PARA11,R1 ; FOR I := 1 TO PARAMLENGTH DO MFPI SP ; MOV (SP)+,R2 ; 3$: MFPD (R2)+ ; POP(PARAM(.I.), REG.S); MOV (SP)+,(R1)F NESTING = 0 THEN BNE 1$ ; CLR HEAD11+OVERT1 ; OVERTIME := FALSE; 1$: RTS PC ; END; ; ; .SBTTL PSW FETCH ROUTINE ;<01> ;<01> THIS SERVICE RETURNS THE PSW CONTENTS IN R0 (USED ONLY BY SOFTWARE ;<01> FLOATING POINT). ;<01> .IF NDF,F$PU ;<01> ONLY IF NO FPU EMTPRO: MOV KSOPSW,R0 ;<01> FETCH PSW RTI ;<01> AND RETURN .ENDC ;<01> PRE11R: .BLKB .PROCREF + ; SOB R0,3$ ; MOV R2,-(SP) ; MTPI SP ; 1$: RTS PC ; END; ; ; PARL11: .BLKB .INTEGER ; PROCEDURE INITCHILD(PARAMLENGTH, VARL11: .BLKB .INTEGER ; VARLENGTH, STAC11: .BLKB .INTEGER ; STACKLENGTH, QVAL11: .BLKB .INTEGER ; QVALUE: ; MAP(.PAGE.) := ; HARDWAREMAP(.PAGE.); SOB R1,1$ ; END; RTS PC ; ; ; ; PROCEDURE REALADDRESS( VTLA10: .BLKB .ADDRESS ; VIRTUALADDRESS: ADDRESS; PREF10: .BLKB .ADDRESS ; VAR PREFIX: 0..3; REST10: .BLKB .ADDRESS ; VAR REST: ADDRESS) ; FUNCTION PREEMPTED: PROCESSREF; ; PREE11: ; BEGIN JSR PC,UPDA11 ; UPDATE; MOV USER11,R0 ; USER@.HEAD := HEAD; ADD #HEAD0,R0 ; MOV #HEAD11,R1 ; $ = .HEADTYP / .INTEGER ; .REPT $ ; MOV (R1)+,(R0)+ ; .ENDR ; MOV SP,R1 ; USER@.REG := REG; MOV ; ; ; TYPE LONGADDRESS = 0..262143; ; ;AD IS R1 ; VAR AD: ADDRESS; ;I IS R0 ; I: 0..7; ;RAD IS R2 AND R3 ; RAD: LONGADDRESS; ; REAL10: ; BEGIN MOV VTLA10,R1 ; AD := VIRTUALADDRESS; MOV R1,R0 ; I := AD DIV 8192; R0,SP ; MOV KSR0,(SP)+ ;<01> MOV KSR1,(SP)+ ;<01> MOV KSR2,(SP)+ ;<01> MOV KSR3,(SP)+ ;<01> MOV KSR4,(SP)+ ;<01> MOV KSR5,(SP)+ ;<01> MOV SP,R0 ; MOV R1,SP ; MFPI SP ; MOV (SP)+,(R0)+ ; MOV KSOPC,(R0)+ ; .IF DF,F$PU ;<01> ONLY IF FPU PRESENT SWAB R0 ; ASH #-4,R0 ; BIC #^C000016,R0 ; "I=PAGENUMBER(VIRTUALADDRESS)" BIC #^C017777,R1 ; AD := AD MOD 8192; ; "AD=BYTE NUMBER IN PAGE" CLR R2 ; RAD := AD + HARDWAREMAP(.I.)*64; MOV HARD10(R0),R3 ; ASHC #6,R2 ; ADD R1,R3 ; ADC R2 ; "RAD=REAL ADDRESS OF BYTE" MOV KSOPSW,(R0)+ ; STD W,(R0)+ ; STD X,(R0)+ ; STFPS (R0) ; .IFF ;<01> MOV KSOPSW,(R0) ;<01> .ENDC ;<01> MOV USER11,PRE11R ; PREEMPTED := USER; CLR USER11 ; USER := NIL; RTS PC ; END; ; ; ; PROCEDURE UPDATE; MOV R2,@PREF10 ; PREFIX := RAD DIV 65536; MOV R3,@REST10 ; REST := RAD MOD 65536; RTS PC ; END; ; ; INIT10: ; BEGIN MOV #UISDR,R0 ; "SET ALL SEGMENTS TO 4K WORDS MOV #8.,R1 ; WITH READ/WRITE/EXECUTE ACCESS 1$: MOV #USDR,(R0)+ ; AND LET THE DATA SPACE SEGMEN- SOB R1,1$ ; MAXS11 = 167. ; CONST MAXSLICE = 167; ; NEWS11: .BLKB .INTEGER ; VAR NEWSLICE: INTEGER; ; UPDA11: ; BEGIN ; WITH HEAD DO ; BEGIN ELAPS6 ; SLICE :+ TIMER.ELAPSED; MOV R0,R1 ; ADD HEAD11+SLICE1,R1 ; MOV R1 ; TATION REMAIN DISABLED" RTS PC ; END; ; ; .SBTTL THE CURRENTLY RUNNING PROGRAM ;"################################### ; # RUNNING # ;###################################" ; ; MOV R0,-(SP) ; MTPI S ; MOV R0,KSR4 ;<01> B := S; MOV INTL11,R0 ; Q := INTERPRETERLENGTH + 8; ADD #8.,R0 ; MOV R0,KSR3 ;<01> .IF DF,F$PU ;<01> ONLY IF FPU IS PRESENT LDFPS #FLOA11 ; FSTATUS := FLOATSTATUS; .ENDC ;<01> MOV #PGST11,KSOPSW ; PSTATUS := PROGSTATUS; MOV #STAR11,KSOPC ; P := STAPTOP := VIRTUAL.HEAPTOP; $$ = HEAD11+RUNTI1 ; RUNTIME.INITIALIZE; MOV #$$,TIME5T ; JSR PC,INIT5 ; MOV #,R0 ; SLICE := 0; CLR (R0)+ ; CLR (R0)+ ; NESTING := 0; MOV #2.,(R0)+ ; PRIORITY := 2; CLR (R0)+ ; OVERTIME := FALSE; CLR (R0)+ ; JOB := FALSE "0"; MOV #10.,(R0) RTADDR; ADD CODL11,R0 ; CONSTADDR := Q + CODELENGTH; MOV R0,CONS11 ; MOV R0,KSR0 ;<01> PASS R0 POP R0 ;<01> RESTORE R0 RTS PC ; END; ; ; ; PROCEDURE ENTRY SYSTEMERROR; ; TERM11: ; CONST TERMINATED = .ASCIZ /TERMINATED/ ; ' ; CONTINUE := TRUE "10"; ; END; ; WITH REG DO PUSH ;<01> SAVE REGISTERS BIS #,PSW ;<01> BEGIN MOV LENG11,R0 ; S := HEAD.HEAPTOP + LENGTH; ADD HEAD11+HEAPT1,R0 ; MOV PARL11,R1 ; FOR I := PARAMLENGTH DOWNTO 1 BEQ 1$ ; DO MOV R1,R2 ; ADD #PARA11,R1 ; TERMINATED(:0:)'; OVER11: ; OVERFLOWERROR = .ASCIZ /OVERFLOW ERROR/ ; 'OVERFLOW ERROR(:0:)'; POIN11: ; POINTERERROR = .ASCIZ /POINTER ERROR/ ; 'POINTER ERROR(:0:)'; RANG11: ; RANGEERROR = .ASCIZ /RANGE ERROR/ ; 'RANGE ERROR(:0:)'; VARI11: ; VARIANTERROR = .ASCIZ /VARIANT ERROR/ ; ASR R2 ; 2$: MOV -(R1),-(SP) ; PUSH(PARAM(.I.), S); MTPI -(R0) ; SOB R2,2$ ; 1$: SUB #2,R0 ; S :- 2; MOV R0,KSR5 ;<01> G := S; SUB VARL11,R0 ; S :- (VARLENGTH + 2); SUB #2,R0 ; MOV R0,KSR4 ;<01> B := S; MOV QVAL11,KSR3 ;<01> Q := QVALUE; MOV R0,-(SP) ; 'VARIANT ERROR(:0:)'; HEAP11: ; HEAPLIMIT = .ASCIZ /HEAP LIMIT/ ; 'HEAP LIMIT(:0:)'; STAK11: ; STACKLIMIT = .ASCIZ /STACK LIMIT/ ; 'STACK LIMIT(:0:)'; .EVEN ; ;TEXT IS RESU19 ; VAR TEXT: LINE; ; SYST11: ; BEGIN MOV HEAD11+RESUL1,R0 ; CASE HEAD.RESULT MTPI S ; MOV R0,KSR0 ;<01> PASS REGS BACK MOV R1,KSR1 ;<01> MOV R2,KSR2 ;<01> POP ;<01> RESTORE REGISTERS .IF DF,F$PU ;<01> FPU VERSION ONLY LDFPS #FLOA11 ; FSTATUS := FLOATSTATUS; .ENDC ;<01> F$PU MOV #PGST11,KSOPSW ; PSTATUS := PROGSTATUS; MOV #STAR11,KSOPC ; P := STARTADDR; ; END; JSR PC,PUTM10 ; VIROF ASL R0 ; MOV 1$(R0),RESU19 ; BR 2$ ; 1$: .WORD TERM11 ; 0: TEXT := TERMINATED; .WORD OVER11 ; 1: TEXT := OVERFLOWERROR; .WORD POIN11 ; 2: TEXT := POINTERERROR; .WORD RANG11 ; 3: TEXT := RANGEERROR; .WORD VARI11 ; 4: TEXT := VARIANTERROR; .WORD HEAP11 ; 5: TEXT := HEAPLIMIT; TUAL.PUTMAP; JSR PC,RESC12 ; READY.RESCHEDULE; RTS PC ; END; ; ; ; PROCEDURE INITPARENT( INTL11: .BLKB .INTEGER ; INTERPRETERLENGTH: INTEGER); ; ;PROGADDR IS R0 ; VAR PROGADDR, PRGL11: .BLKB .INTEGER ; PROGLENGTH, CODL11: .BLKB .INTEGER ; CODELENGTH, .WORD STAK11 ; 6: TEXT := STACKLIMIT; ; END; 2$: JSR PC,KERN19 ; KERNELERROR(TEXT); ; RTS PC ; END; ; ; ; PROCEDURE ENTRY REALINTERRUPT; ; RIAD11 = REALOV - USER99 ; CONST REALINTERRUPTADDR = ...; ; REAL11: STKL11: .BLKB .INTEGER ; STACKLENGTH, VRLE11: .BLKB .INTEGER ; VARLENGTH, LNTH11: .BLKB .INTEGER ; LENGTH: INTEGER; ; INPA11: ; BEGIN CLR HEAD11+LINE1 ; HEAD.LINE := 0; MOV #USER99,R0 ; PROGADDR := HEADADDR + ADD INTL11,R0 ; INTERPRETERLENGTH; MOV #PRGL11,R1 ; GETDATA(PROGADDR, MOV (R0)+,(R1 ; BEGIN MOV #RIAD11,KSOPC ; REG.P := REALINTERRUPTADDR; RTS PC ; END; ; ; INIT11: ; BEGIN ; DONE AT LABEL "NEXT11". ; NEXTINDEX := 1; RTS PC ; END "OF RUNNING"; ; ; .SBTTL PROCESS INITIATION/TERMINATION ;"###)+ ; PROGLENGTH, MOV (R0)+,(R1)+ ; CODELENGTH, MOV (R0)+,(R1)+ ; STACKLENGTH, MOV (R0)+,(R1)+ ; VARLENGTH); MOV #.PROCESS,LENG16 ; USER := NEW(PROCESS); JSR PC,NEW16 ; MOV NEW16R,USER11 ; MOV NEXT11,R0 ; PROCESSID(.NEXTINDEX.) := USER; ADD R0,R0 ; $$ = PRID11 - 2 ; MOV USER################################ ; # INIT/END/STOP PROCESS # ;###################################" ; ; ; PROCEDURE ENTRY INITPROCESS( ; PARAMLENGTH, ; VARLENGTH, ; STAC11,$$(R0) ; MOV #,R0 ; WITH HEAD DO ; BEGIN MOV NEXT11,(R0)+ ; INDEX := NEXTINDEX; INC NEXT11 ; NEXTINDEX :+ 1; MOV INTL11,R1 ; HEAPTOP := INTERPRETERLENGTH + CLR R2 ; ADD PRGL11,R1 ; PROGLENGTH; ADC R2 ; MOV R1,(R0) ; ADD STKL11,R1 KLENGTH, ; QVALUE: INTEGER); ; INIT13: MOV #,R0 ; BEGIN MOV (R0),PLEN11 ; MOV (R0)+,PARL11 ; MOV (R0)+,VARL11 ; MOV (R0)+,STAC11 ; MOV (R0),QVAL11 ; JSR PC,POPP11 ; RUNNING.POPPARAM(PARAMLENGTH); JSR PC,PREE11 ; READY.ENTER(RUNNING.PREEMPTED); MOV PRE11R,P1 ; LENGTH := HEAPTOP + STACKLENGTH ADC R2 ; ADD VRLE11,R1 ; + VARLENGTH ADC R2 ; ADD #2,R1 ; + 2; ADC R2 ; BEQ 1$ ; IF LENGTH > 65535 THEN MOV #VIRT10,RESU19 ; KERNELERROR(VIRTUALLIMIT); JSR PC,KERN19 ; 1$: MOV R1,LNTH11 ; MOV R12 ; JSR PC,ENTE12 ; JSR PC,INCH11 ; RUNNING.INITCHILD(PARAMLENGTH, ; VARLENGTH, ; STACKLENGTH, ; QVALUE); RTS PC ; END; ; ; ; PROCEDURE ENTRY ENDPROCESS; ; INTEGER); LENG11: .BLKB .INTEGER ; VAR LENGTH: INTEGER; ;I IS R1 ; I: INTEGER; ; INCH11: ; BEGIN MOV #.PROCESS,LENG16 ; USER := NEW(PROCESS); JSR PC,NEW16 ; MOV NEW16R,USER11 ; MOV NEXT11,R0 ; PROCESSID(.NEXTINDEX.) := USER; ADD R0,R0 ; ,CLEN10 ; VIRTUAL.DEFCOMMON(LENGTH); JSR PC,DEFC10 ; $$ = HEAD11+RUNTI1 ; RUNTIME.INITIALIZE; MOV #$$,TIME5T ; JSR PC,INIT5 ; MOV #,R0 ; SLICE := 0; CLR (R0)+ ; CLR (R0)+ ; NESTING := 0; MOV #2.,(R0)+ ; PRIORITY := 2; CLR (R0)+ ; OVERTIME := FALSE; CLR (R0)+ $$ = PRID11 - 2 ; MOV USER11,$$(R0) ; MOV PARL11,R0 ; LENGTH := PARAMLENGTH + CLR R1 ; ADD VARL11,R0 ; VARLENGTH + ADC R1 ; ADD STAC11,R0 ; STACKLENGTH + ADC R1 ; ADD #2,R0 ; 2; ADC R1 ; BEQ 3$ ; IF LENGTH > 6553 ; JOB := FALSE "0"; MOV #10.,(R0) ; CONTINUE := TRUE "10"; ; END; ; WITH REG DO BIS #,PSW ;<01> BEGIN PUSH R0 ;<01> SAVE R0 MOV LNTH11,R0 ; S := LENGTH - 2; SUB #2.,R0 ; MOV R0,KSR5 ;<01> G := S; SUB VRLE11,R0 ; S :- (VARLENGTH + 2); SUB #2.,R0 ; 5 THEN MOV #VIRT10,RESU19 ; KERNELERROR(VIRTUALLIMIT); JSR PC,KERN19 ; 3$: MOV R0,LENG11 ; MOV R0,PLEN10 ; VIRTUAL.DEFPRIVATE(LENGTH); JSR PC,DEFP10 ; ; WITH HEAD DO MOV #,R0 ; BEGIN MOV NEXT11,(R0)+ ; INDEX := NEXTINDEX; INC NEXT11 ; NEXTINDEX :+ 1; MOV HEAP10,(R0)+ ; HEA ; END; ; ; ; PROCEDURE ENDIO; ; ENDI12: ; BEGIN JSR PC,RESC12 ; RESCHEDULE; ; WITH RUNNING DO TST USER11 ; IF USER <> NIL THEN BEQ 1$ ; MOV USER11,P10 ; VIRTUAL.GETMAP(USER); WHY: INTEGER); ; ;PROC IS R1 ; VAR PROC: PROCESSREF; ;HEAD IS R1 ; HEAD: @HEADTYPE; ; STOP15: ; BEGIN MOV #,R0 ; PROC := RUNNING.PROCESSID(.P.); MOV (R0)+,R1 ; ADD R1,R1 ; MOV (R1),R1 ; CMP R1,USER11 ; IF PROC = RUNNING.USER JSR PC,GETM10 ; 1$: RTS PC ; END; ; ; INIT12: ; BEGIN MOV #TOP12,QUTP4T ; TOP.INITIALIZE; JSR PC,INIT4 ; MOV #MIDD12,QUTP4T ; MIDDLE.INITIALIZE; JSR PC,INIT4 ; MOV #BOTT12,QUTP4T ; BOTTOM.INITIALIZE; JSR PC,INIT4 ; ; DONE AT LABEL "IDLI12". ; BNE 1$ ; MOV #HEAD11,R1 ; THEN HEAD := @RUNNING.HEAD BR 2$ ; 1$: ADD #HEAD0,R1 ; ELSE HEAD := @PROC@.HEAD; 2$: ; WITH HEAD@ DO ; BEGIN MOV (R0),RESUL1(R1) ; RESULT := WHY; CLR CONTI1(R1) ; CONTINUE := FALSE "0"; ; END; RTS PC ; END; UNIV_TYPE1: TYPE_(OUTPUT,UNIV_TYPE2); UPLUS1: PUT0(UPLUS2); VALUE1: PUT0(VALUE2); VAR_LIST1: VAR_LIST; VARNT_END1: VARNT_END; VARNT1: VARNT; VPARMLIST1: PARMLIST(VPARMLIST2); WITH_TEMP1: WITH_TEMP; WITH_VAR1: PUT0(WITH_VAR2); WITH1: BEGIN POP_LEVEL; PUT0(WITH2) END END UNTIL HALT; IF UNRESOLVED > 0 THEN ERROR(UNRES_ERROR); PUT0(EOM2); WITH INTER_PASS_PTR@ DO BEGIN RELEASE(RESETPOINT); CONSTANTS:=CONST_DISP END; NEXT_PASS(INTER_PASS_PTR) END. ; ; ; .SBTTL THE READY PROCESS QUEUES ;"################################### ; # READY # ;###################################" ; ; ; VAR READY ; CLASS IDLING := FALSE; RTS PC ; END "OF READY"; ; ; .SBTTL MONITOR GATES ;"################################### ; # GATE # ;###################################" ; ; GATE = 0 ; TYPE GAT ; TOP12: .BLKB .PROCQUE ; VAR TOP, MIDD12: .BLKB .PROCQUE ; MIDDLE, BOTT12: .BLKB .PROCQUE ; BOTTOM: PROCESSQUEUE; IDLI12: .WORD 0 ; IDLING: BOOLEAN; ; ; P12: .BLKB .PROCREF ; PROCEDURE ENTER(P: PROCESSREF); ; ENTE12: MOV P12,R0 ; BEGIN MOV R0,NEWEL4 ; MOVE = $ = GATE ; CLASS ; OPEN15 = $ ; VAR OPEN: $ = $ + .BOOLEAN ; BOOLEAN; WAIT15 = $ ; WAITING: $ = $ + .PROCQUE ; PROCESSQUEUE; CHKDTL GATE ; ; ; ; PROCEDURE ENTRY ENTER; ; ENT HEAD0+PRIOR1(R0),R1 ; CASE P@.HEAD.PRIORITY OF BNE 1$ ; MOV #TOP12,QUTP4T ; 0: TOP.PUT(P); JSR PC,PUT4 ; RTS PC ; 2$: MOV #BOTT12,QUTP4T ; 2: BOTTOM.PUT(P); JSR PC,PUT4 ; RTS PC ; 1$: SOB R1,2$ ; MOV #MIDD12,QUTP4T ; 1: MIDDLE.PUT(P); JSR PC,PUT4 ; RTS PC E17: ; BEGIN ENTE11 ; RUNNING.ENTER; MOV ,R0 ; IF OPEN THEN DEC (R0) ; BEQ 1$ ; OPEN := FALSE ELSE CLR (R0)+ ; MOV R0,QUTP4T ; WAITING.PUT(RUNNING.PREEMPTED); JSR PC,PREE11 ; MOV PRE11R,NEWEL4 ; JSR PC,PUT4 ; 1$: RTS PC ; END; ; END; ; END; ; ; ; PROCEDURE SELECT; ; ;Q IS R0 ; VAR Q: @PROCESSQUEUE; ; SELE12: ; BEGIN TST IDLI12 ; IF NOT IDLING THEN BNE 1$ ; BEGIN 2$: ; RE ; ; ; PROCEDURE ENTRY LEAVE; ; ;P IS GET4R, P12 ; VAR P: PROCESSREF; ; LEAV17: MOV ,R0 ; BEGIN INC (R0)+ ; ANY4 R0,1$ ; IF NOT WAITING.ANY THEN ; OPEN := TRUE ELSE MOV R0,QUTP4T ; BEGIN PEAT MOV #TOP12,R0 ; Q := @TOP; EMPTY4 R0,3$ ; IF Q@.EMPTY THEN ; BEGIN MOV #MIDD12,R0 ; Q := @MIDDLE; EMPTY4 R0,3$ ; IF Q@.EMPTY THEN ; BEGIN MOV #BOTT12,R0 ; Q := @BOTTOM; EMPTY4 R0,3$ ; IF Q@.EMPTY THEN ; CLR -(R0) ; JSR PC,GET4 ; P := WAITING.GET; MOV GET4R,P12 ; READY.ENTER(P); JSR PC,ENTE12 ; ; END; 1$: LEAV11 ; RUNNING.LEAVE; RTS PC ; END; ; ; ; PROCEDURE ENTRY DELAY(VAR Q: ; BEGIN INC IDLI12 ; IDLING := TRUE; SPL 0 ; IDLE; WAIT ; SPL 7 ; CLR IDLI12 ; IDLING := FALSE; ; Q := NIL; ; END; ; END; ; END; TST USER11 ; PROCESSREF); ;P IS GET4R, P12 ; VAR P: PROCESSREF; ; DELA17: ; BEGIN JSR PC,PREE11 ; Q := RUNNING.PREEMPTED; MOV PRE11R,-(SP) ; $$ = HEAD11 + PARAM1 ; $$ = $$ + .INTEGER ; MTPD @$$ ; MOV ,R0 ; IF WAITING.ANY THEN INC (R0)+ ; BEGIN ANY4 R0,1$ UNTIL (RUNNING.USER <> NIL) OR BEQ 2$ ; (Q <> NIL); RTS PC ; IF (RUNNING.USER = NIL) THEN 3$: MOV R0,QUTP4T ; RUNNING.SERVE(Q@.GET); JSR PC,GET4 ; MOV GET4R,P11 ; JSR PC,SERV11 ; 1$: RTS PC ; END; ; END; ; ; ; MOV R0,QUTP4T ; P := WAITING.GET; CLR -(R0) ; JSR PC,GET4 ; MOV GET4R,P12 ; READY.ENTER(P); JSR PC,ENTE12 ; END ELSE 1$: ; OPEN := TRUE; RTS PC ; END; ; ; ; PROCEDURE ENTRY CONTINUE(VAR Q: ; PROCEDURE RESCHEDULE; ; RESC12: ; BEGIN ; WITH RUNNING, HEAD DO TST USER11 ; IF USER <> NIL THEN BEQ 1$ ; BEGIN JSR PC,UPDA11 ; UPDATE; TST HEAD11+PRIOR1 ; IF PRIORITY > 0 THEN BEQ 1$ ; IF MOV #TOP12,R0 ; TOP.ANY ; PROCESSREF); ;P IS R1, P12 ; VAR P: PROCESSREF; ; CONT17: ; BEGIN $$ = HEAD11 + PARAM1 ; P := Q; MOV <$$ + .INTEGER>,R0 ; MFPD (R0) ; MOV (SP)+,R1 ; IF P = NIL THEN BEQ LEAV17 ; LEAVE ELSE CLR -(SP) ; BEGIN MTPD (R0) ; Q := NIL; OR EMPTY4 R0,2$ ; TST HEAD11+OVERT1 ; OVERTIME OR BNE 2$ ; CMP #2.,HEAD11+PRIOR1 ; (PRIORITY = 2 AND BNE 1$ ; MOV #MIDD12,R0 ; MIDDLE.ANY) THEN ANY4 R0,1$ ; 2$: JSR PC,PREE11 ; ENTER(PREEMPTED); MOV PRE11R,P12 ; JSR PC,ENTE12 ; 1$: RTS PC ; END; MOV R1,P12 ; READY.ENTER(P); JSR PC,ENTE12 ; LEAV11 ; RUNNING.LEAVE; ; END; RTS PC ; END; ; ; GAT17T: .BLKB .INTEGER ; BEGIN INIT17: ENTE11 ; RUNNING.ENTER; MOV GAT17T,R0 ; CLR (R0)+ ; OPEN := FALSE; MOV R0,QU ; ;PROC IS PRE11R ; VAR PROC: PROCESSREF; ; ENDP14: ; BEGIN JSR PC,PREE11 ; PROC := RUNNING.PREEMPTED; RTS PC ; END; ; ; ; PROCEDURE ENTRY STOPJOB( ; P, ; SRV RINT28 ;<01> READINTERRUPT; LTOU32: ;<01> WRITING: WRITEINTERRUPT; INTSRV WINT28 ;<01> END; RKIN32: ;<01> DISK0: RK11DISK.INTERRUPT; INTSRV INTE27 ;<01> TMIN32: ;<01> TAPE90, TAPE91: INTSRV INTE25 ;<01> TM11TAPE.INTERRUPT; LPIN32: ;<01> PRINTER0: INTSRV INTE29 ;< ; INT(.I.) := BLANK; MOV R2,TEXT33 ; WRITETEXT(@INT(.I.)); JSR PC,WRIT33 ; RTS PC ; END; ; ; RESU19: .BLKB .INTEGER ; PROCEDURE KERNELERROR(RESULT: ; LINE); SYST19: .ASCIZ /SYSTEM LINE/ ; CONST SYSTEM = 'SYSTEM LINE(:0:)'; BLAN19: .ASCIZ / / 01> LPXXPRINTER.INTERRUPT; CDIN32: ;<01> CARDREADER0: INTSRV INTE30 ;<01> CD11ACARDREADER.INTERRUPT; ; END; ; END; ; ; .SBTTL MESSAGE WRITERS ;"################################### ; # MESSAGES # TP4T ; WAITING.INITIALIZE; JSR PC,INIT4 ; RTS PC ; END "OF GATE"; ; ; ; PROCEDURE ENTRY INITGATE(VAR G: @ ; GATE); INIT18: ; BEGIN MOV #.GATE,LENG16 ; G := NEW(GATE); JSR PC,NEW16 ; MOV NEW16R,-(SP) ;###################################" ; ; NEWL35: .ASCIZ <13.><10.> ; CONST NEWLINE = .EVEN ; '(:13:)(:10:)(:0:)'; ; ; TYPE LINE = UNIV STRING; ; ; TEXT33: .BLKB .ADDRESS ; PROCEDURE WRITETEXT(TEXT: @LINE); ; MTPD @ ; MOV NEW16R,GAT17T ; G@.INITIALIZE; JSR PC,INIT17 ; RTS PC ; END; ; ;  ; NULC33 = 0 ; CONST NULCHAR = '(:0:)'; ; I33: .BLKB .ADDRESS ; VAR I: INTEGER; ; WRIT33: ; BEGIN MOV TEXT33,I33 ; I := 1; 1$: MOV I33,R0 ; WHILE NOT (TEXT@(.I.) = NULCHAR) MOVB (R0)+,R1 ; DO BNE 2$ ; RTS PC ; BLANK = ' (:0:)'; .EVEN ; KERN19: ; BEGIN MOV #NEWL35,TEXT33 ; WRITETEXT(NEWLINE); JSR PC,WRIT33 ; MOV #SYST19,TEXT33 ; WRITETEXT(SYSTEM); JSR PC,WRIT33 ; MOV HEAD11+OPLIN1,NN34 ; WRITEINT(RUNNING.HEAD.OPLINE); JSR PC,WRIT34 ; MOV #BLAN19,TEXT33 ; WRITETEXT(BLANK); JSR PC,WRIT33 ; ; 2$: MOV R0,I33 ; BEGIN MOV R1,CHR28 ; LT33TERMINAL.KERNELWRITE( JSR PC,KERN28 ; TEXT@(.I.)); BR 1$ ; I :+ 1; ; END; ; END; ; ; NN34: .BLKB .INTEGER ; PROCEDURE WRITEINT(NN: INTEGER); ; BLAN34 MOV RESU19,TEXT33 ; WRITETEXT(RESULT); JSR PC,WRIT33 ; MOV #NEWL35,TEXT33 ; WRITETEXT(NEWLINE); JSR PC,WRIT33 ; HALT ; CYCLE END; SYSERR ; ; END; ; ; ; PROCEDURE KERNELREADY; ; READ37: .ASCIZ /SYSTEM READY = ' ; CONST BLANK = ' '; NULC34 = 0 ; NULCHAR = '(:0:)'; ZERO34 = '0 ; ; ;N IS R0, R1 ; VAR N: INTEGER; ;I IS R2 ; I: INTEGER; INT34: .ASCIZ /012345/ ; INT: ARRAY (.1..7.) OF CHAR; .EVEN ; WRIT34: ; BEGIN ; INT(.7.) := NULCHAR; MOV PREFIX HERE" CONST INCREMENT = 6; TYPE OPERATION = (READ, WRITE, CHECK, NONSENSE); VAR OK: BOOLEAN; CYLINDER: 0..200; SECTOR: 0..23; ALLSECTORS, SECTORS: SET OF 0..23; PAGENO: 0..4799; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRAM) ELSE JMP INIO29 ; NODEVICE := TRUE; ; 6$: TST CONN30 ; CARDREADER0: BEQ NODE31 ; WITH CD11ACARDREADER DO MOV R1,BUF30 ; IF CONNECTED THEN MOV R2,COM30 ; INITIO(BUFFER, PARAM) ELSE JMP INIO30 ; NODEVICE := TRUE; ; 7$: ; TAPE91: MRITETEXT(' BACKUP(HOW: OPERATION)(:10:)'); WRITETEXT('USING(:10:)'); WRITETEXT(' OPERATION = (READ, WRITE, CHECK)(:10:)'); OK:= FALSE; END; END; PROCEDURE DISK(COMMAND: IOOPERATION; PAGENO: UNIV IOARG; VAR BLOCK: PAGE); CONST MAXTIMES = 3; VAR PARAM: IOPARAM; TIMES: INTEGER; BEGIN WITH PARAM DO BEGIN OPERATION:= COMMAND; ARG:= PAGENO; TIMES:= 0; REPEAT TIMES:= TIMES + 1; IOTRANSFER(DISKDEVICE, PARAM, BLOCK); UNTIL (STATUS = COMPLETE) OR N READARG(SEQ, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; END; PROCEDURE READTAPE; VAR BLOCK: PAGE; EOF: BOOLEAN; C: CHAR; BEGIN INITTAPE(INP); WRITETEXT('PUSH RETURN TO OVERWRITE DISK(:10:)'); REPEAT ACCEPT(C) UNTIL C = NL; FIRSTPAGE; READPAGE(BLOCK, EOF); WHILE NOT EOF & MOREPAGES DO BEGIN WRITEDISK(BLOCK); READPAGE(BLOCK, EOF); NEXTPAGE; END; IF EOF = MOREPAGES THEN BEGIN ERROR('FILE LENGTH INCORRECT(:10:)'); WHILE NOT EOF DO READPAGE(BLOCK, EOF); END; TERMTAP (TIMES = MAXTIMES); IF STATUS <> COMPLETE THEN ERROR('DISK ERROR (:10:)'); END; END; PROCEDURE READDISK(VAR BLOCK: PAGE); BEGIN DISK(INPUT, PAGENO, BLOCK) END; PROCEDURE WRITEDISK(VAR BLOCK: PAGE); BEGIN DISK(OUTPUT, PAGENO, BLOCK) END; PROCEDURE FIRSTPAGE; BEGIN ALLSECTORS:= (..); FOR SECTOR:= 0 TO 23 DO ALLSECTORS:= ALLSECTORS OR (.SECTOR.); CYLINDER:= 0; SECTOR:= 0; SECTORS:= ALLSECTORS - (.0.); PAGENO:= 0; END; PROCEDURE NEXTPAGE; BEGIN IF SECTORS = (..) THEN BEGIN E(INP); END; PROCEDURE WRITETAPE; VAR BLOCK: PAGE; BEGIN INITTAPE(OUT); FIRSTPAGE; WHILE MOREPAGES DO BEGIN READDISK(BLOCK); WRITEPAGE(BLOCK, FALSE); NEXTPAGE; END; WRITEPAGE(BLOCK, TRUE); TERMTAPE(OUT); END; PROCEDURE CHECKTAPE; VAR BLOCK1, BLOCK2: PAGE; EOF: BOOLEAN; BEGIN INITTAPE(INP); FIRSTPAGE; READPAGE(BLOCK1, EOF); WHILE NOT EOF & MOREPAGES DO BEGIN READDISK(BLOCK2); IF BLOCK1 <> BLOCK2 THEN ERROR('CHECK ERROR(:10:)'); READPAGE(BLOCK1, EOF); CYLINDER:= CYLINDER + 1; SECTORS:= ALLSECTORS; END; SECTOR:= (SECTOR + INCREMENT) MOD 24; WHILE NOT (SECTOR IN SECTORS) DO SECTOR:= (SECTOR + 1) MOD 24; SECTORS:= SECTORS - (.SECTOR.); PAGENO:= 24*CYLINDER + SECTOR; END; FUNCTION MOREPAGES: BOOLEAN; BEGIN MOREPAGES:= (CYLINDER < 200) END; PROCEDURE INITTAPE(SEQ: ARGSEQ); VAR ARG: ARGTYPE; BEGIN WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'TAPE ' END; WRITEARG(SEQ, ARG); END; PROCEDURE TERMTAPE(SEQ: ARGSEQ); VAR ARG: ARGTYPE; BEGI PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUTOV #UNI131,UNIN25 ; WITH TM11TAPE DO BR 41$ ; IF CONNECTED THEN ; INITIO(BUFFER, PARAM, UNIT1) ; ELSE NODEVICE := TRUE; ; ; END; NODE31: MOV R2,PARA38 ; IF NODEVICE THEN JMP IOFA38 ; IOFAIL(PARAM); ; END; NN34,R1 ; N := NN; MOV #,R2 ; I := 7; ; REPEAT 1$: CLR R0 ; I :- 1; DIV #10.,R0 ; INT(.I.) := CHR(N MOD 10 + ADD #ZERO34,R1 ; ORD('0')); MOVB R1,-(R2) ; MOV R0,R1 ; N := N DIV 10; BNE 1$ ; UNTIL N = 0; MOVB #BLAN34,-(R2) ; I :- 1; (F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; ; ; ; PROCEDURE ENTRY INTERRUPT(DEVICE: ; IODEVICE); ; BEGIN ; CASE DEVICE OF ; TTY0: ; WITH LT33TERMINAL DO ; CASE STATE OF LTIN32: ; PASSIVE, READING: INT ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################### # BACKUP(VAR HOW: OPERATION) # ###############################" "INSERT         "$&!#%'<>(*,.02468:=?)+-/13579;@BDFHJLNPRTVACEGIKMOQSUW\^`bdfhjlnXZ]_acegikmoY[xz|~prtvy{}qsuwAN; #') END; "******************* * CLASS PARAMETERS * *******************" PROCEDURE GETID (ARGNO: INTEGER; VAR IDIN: IDENTIFIER; VAR OK: BOOLEAN); BEGIN WITH PARAM(.ARGNO.) DO BEGIN IF TAG <> IDTYPE THEN OK := FALSE ELSE BEGIN IDIN := ID; OK := TRUE END END END; PROCEDURE GETINT (ARGNO: INTEGER; VAR INTIN: INTEGER; VAR OK: BOOLEAN); BEGIN WITH PARAM(.ARGNO.) DO BEGIN IF TAG <> INTTYPE THEN OK := FALSE ELSE BEGIN INTIN := INT; OK := TRUE J~( " >" "   X" "" ,ph6`<X"0 "  "" >" & X X6 ^ b&  J&  (D&" `& R8&REEPAGECONTENTS = 3720 "FIVECYLINDERSIZE * FREEPAGESIZE"; FREELISTSIZE = 2 "PAGES IN CORE"; FREELISTLIMIT = 1 "SIZE - 1"; FREELISTFIRST = 152 "FIRSTPAGE"; FREELISTLAST = 153 "FREELISTFIRST + FREELISTLIMIT, HAS TO BE LESS THAN FREEPAGECONTENTS - 1"; STANDARDGAP = 2; "IF NOT USING RK11, MODIFY ALSO FUNCTION SECTORGAP" "CATALOG PARAMETERS" MAPLENGTH = 255; CATPAGELENGTH = 16; CATADDRESS = 154 "FIRSTPAGE+FREELISTLENGTH"; MAXDIGIT = 32767; ASC""RF&"Bn >"& >P" T0 >P" RF& H >"$ V"2  ( n* "2   0 "(\zf  X 02: IIMAX = 127; "USEFUL CONSTANTS" NULL = 0; NOKEY = 0; NONAME = ' '; CATFILE = 1; "TELETYPE PARAMETERS" MAXTTYLINE = 70; TYPE "CLASS TELETYPE" TTYLINE = ARRAY (.1..MAXTTYLINE.) OF CHAR; "CLASS FREELIST" FIVECYLINDER = SET OF 0..FIVECYLINDERLIMIT; FREEPAGE = ARRAY (.0..FREEPAGELIMIT.) OF FIVECYLINDER; FREEONDISK = RECORD FREEPAGEONDISK: FREEPAGE; MISCELLANEOUS: ARRAY (.1..SETSIZE.) OF INTEGER X$P 0$Bz$&6 026j~ ^ X$0 0"%"$+   (  "$1   ^ ~  END; "CLASS CATALOG" FILEMAP = RECORD FILELENGTH: INTEGER; PAGESET: ARRAY (.1..MAPLENGTH.) OF INTEGER END; FILEINCORE = CATFILE..CATFILE; CATENTRY = RECORD ID: IDENTIFIER; ATTR: FILEATTR; KEY, SEARCHLENGTH: INTEGER END; CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY; CATRESULT = (NAMING, CATFULL, DISKFULL, FILELIMIT, SUCCES, PROTECTION, x "V x ". x " 0  " =J(*X@$TRY AGAIN BACKUP(HOW: OPERATION) USING OPERATION = (READ, WRITE, CHECK) DISK ERROR TAPE PUSH RETURN TO OVERWRITE DISK FILE LENGTH INCORRECT CHECK ERROR FILE LENGTH INCORRECT BACKUP: READ WRITE CHECK ^ ~   "%'!#-/13579;=?*,.02468(+ikmoZ\^`X     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPR SYNTAX); "CLASS MANAGER" COMMANDTYPE = (REPLACE, CREATE, DELETE, RENAME, PROTECT, NOTHING); VAR "CLASS FREELIST" FREELIST: RECORD FIRST, FREEPAGES, PAGEINDEX: INTEGER; CHANGED: BOOLEAN; FREE: FREEPAGE END; GROUPSET, CYLINDERSET, EMPTYSET: FIVECYLINDER; CYLINDERMASK: ARRAY (.0..GROUPLIMIT.) OF FIVECYLINDER; PAGEPOINTER, PAGEBASE, GROUPPOINTER, GROUPBASE, CYLINDERPOINTER, CYLINDERBASE: INTEGER;"############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; BEGIN REPEAT WRITE('(:12:)') UNTIL FALSE; END.  "EACH POINTER POINTS TO AN ELEMENT INSIDE THE DATA STRUCTURES, EACH BASE GIVES THE NUMBER OF SECTORS BEFORE THE POINTED ELEMENT" DISPLACEMENT: INTEGER "EQUAL TO PAGEBASE+GROUPBASE"; SECTOR, FIND, FOUND, CYLINDERGAP: INTEGER; "CLASS CATALOG" CAT: RECORD INDEX: INTEGER; CHANGED: BOOLEAN; BLOCK: CATPAGE END; CATLENGTH: INTEGER; BUCKET: RECORD NAME: IDENTIFIER; START, "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################## # VARIANT ERROR # ##################" TYPE PAIR = 1..2; VAR V: RECORD CASE TAG: PAIR OF 1: (C: CHAR); LENGTH, INDEX: INTEGER END; "CLASS MANAGER" BADERROR: BOOLEAN; "***************** * TELETYPE CLASS * *****************" PROCEDURE WRITETEXT (TEXT: TTYLINE); VAR I: INTEGER; C: CHAR; BEGIN I := 1; C := TEXT(.1.); WHILE (C <> '#') & (I < MAXTTYLINE) DO BEGIN DISPLAY(C); I := I + 1; C := TEXT(.I.) END; DISPLAY(NL) END; PROCEDURE WRITEID (ID: IDENTIFIER); VAR TEXT: TTYLINE; I: INTEGER; BEGIN DISPLAY(NL); FOR I := 1 TO IDLENGTH DO TEXT(.I.) := ID(.I.); TEXT(.I 2: (I: INTEGER) END; BEGIN V.TAG:= 2; WRITE(V.C); END. ; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################## # VARIANT ERROR # ##################" TYPE PAIR = 1..2; VAR V: RECORD CASE TAG: PAIR OF 1: (C: CHAR); DLENGTH + 1.) := '#'; WRITETEXT(TEXT) END; PROCEDURE WRITEINT(INT: INTEGER); VAR T: IDENTIFIER; REM, DIGIT, I, ZERO: INTEGER; BEGIN REM := INT; DIGIT := 0; ZERO := ORD('0'); REPEAT DIGIT := DIGIT + 1; T(.DIGIT.) := CHR(ABS(REM MOD 10) + ZERO); REM := REM DIV 10 UNTIL REM = 0; DIGIT := DIGIT + 1; IF INT < 0 THEN T(.DIGIT.) := '-' ELSE T(.DIGIT.) := ' '; FOR I := DIGIT DOWNTO 1 DO DISPLAY(T(.I.)); FOR I := DIGIT+1 TO IDLENGTH DO DISPLAY(' ') END; PROCEDURE HELP; BEGI"############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "############### # HEAP LIMIT # ###############" VAR P: @INTEGER; BEGIN REPEAT NEW(P) UNTIL FALSE; END. "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "############### # TIME LIMIT # ###############" BEGIN REPEAT UNTIL FALSE END. "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################ # STACK LIMIT # ################" PROCEDURE P; BEGIN P END; BEGIN P END. / ; CONST READYMESSAGE = .EVEN ; 'SYSTEM READY(:0:)'; ; KERN37: ; BEGIN MOV #NEWL35,TEXT33 ; WRITETEXT(NEWLINE); JSR PC,WRIT33 ; MOV #READ37,TEXT33 ; WRITETEXT(READYMESSAGE); JSR PC,WRIT33 ; MOV #NEWL35,TEXT33 ; WRITETEXT(NEWLINE); JSR PC,WRIT33 ; RTS PC ; NEXTPAGE; END; IF EOF = MOREPAGES THEN BEGIN ERROR('FILE LENGTH INCORRECT(:10:)'); WHILE NOT EOF DO READPAGE(BLOCK1, EOF); END; TERMTAPE(INP); END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('BACKUP:(:10:)'); OK:= TRUE; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; FUNCTION HOW: OPERATION; BEGIN WITH PARAM(.2.) DO IF TAG <> IDTYPE THEN HELP ELSE IF ID = 'READ ' THEN HOW:= READ ELSE IF ID = 'WRITE ' THEN HOW:N WRITETEXT('TRY AGAIN#'); WRITETEXT(' FILE(CREATE, ID, LENGTH, KIND, PROTECTED) #'); WRITETEXT(' FILE(DELETE, ID)#'); WRITETEXT(' FILE(PROTECT, ID, PROTECTED)#'); WRITETEXT(' FILE(RENAME, OLDID, NEWID)#'); WRITETEXT(' FILE(REPLACE, ID, LENGTH, KIND, PROTECTED)#'); WRITETEXT('USING#'); WRITETEXT(' ID, OLDID, NEWID: IDENTIFIER; #'); WRITETEXT(' LENGTH: 1..255; #'); WRITETEXT(' KIND: (SCRATCH, ASCII, SEQCODE, CONCODE); #'); WRITETEXT(' PROTECTED: BOOLE= WRITE ELSE IF ID = 'CHECK ' THEN HOW:= CHECK ELSE HELP; IF NOT OK THEN HOW:= NONSENSE; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; CASE HOW OF READ: READTAPE; WRITE: WRITETAPE; CHECK: CHECKTAPE; NONSENSE: END; TERMINATE; END; END. AGES; FREEPAGEONDISK := FREE END; IOPAGE(FREEOUT, OUTPUT, FREELISTFIRST) END; PROCEDURE ALLOCATE (AMOUNT: INTEGER; VAR ADDR: INTEGER); VAR MAP: FILEMAP; BEGIN ADDR := FREELIST.FIRST; MAP.FILELENGTH := AMOUNT; REMOVEPAGES(MAP, ADDR); IOPAGE(MAP, OUTPUT, ADDR) END; PROCEDURE RELEASE (ADDR: INTEGER); VAR MAP: FILEMAP; BEGIN INITRELEASE(MAP, ADDR); RELEASEMAP(MAP) END; PROCEDURE SHORTEN (ADDR, NEWLENGTH: INTEGER); VAR MAP: FILEMAP; BEGIN IF NEWLENGTH < MAPLENGTH THEN BEGIN INITSHORTYLINDERSET := GROUPSET & CYLINDERMASK(.CYLINDERPOINTER.); CYLINDERGAP := CYLINDERGAP + 1 END END; PROCEDURE MOVEGROUP (DELTA: INTEGER); BEGIN IF DELTA > 0 THEN FREELIST.FREE(.GROUPPOINTER.) := GROUPSET; GROUPPOINTER := GROUPPOINTER + DELTA; IF GROUPPOINTER <= FREEPAGELIMIT THEN BEGIN GROUPBASE := GROUPPOINTER * FIVECYLINDERSIZE; GROUPSET := FREELIST.FREE(.GROUPPOINTER.); DISPLACEMENT := PAGEBASE + GROUPBASE; CYLINDERPOINTER := 0; MOVECYLINDER(0) END END; PROCEDURE MOVEPAGE;EN(MAP, ADDR, NEWLENGTH); RELEASEMAP(MAP); IOPAGE(MAP, OUTPUT, ADDR) END END; FUNCTION DISKSPACE (AMOUNT: INTEGER): BOOLEAN; BEGIN DISKSPACE := (AMOUNT < FREELIST.FREEPAGES) END; "**************** * CLASS CATALOG * ****************" PROCEDURE CATERROR (RESULT: CATRESULT); BEGIN IF RESULT <> SUCCES THEN BEGIN CASE RESULT OF NAMING: WRITETEXT('NAME ERROR# '); CATFULL: WRITETEXT('CATALOG FULL# '); DISKFULL: WRITETEXT('DISK FULL#'); FILELIMIT: WRITETEXT('FILE LIMIT# BEGIN PAGEPOINTER := PAGEPOINTER + 1; PAGEBASE := PAGEPOINTER * FREEPAGECONTENTS; GETFREE(PAGEPOINTER); GROUPPOINTER := 0; MOVEGROUP(0) END; PROCEDURE FINISHREMOVE (TOTAL: INTEGER); BEGIN WITH FREELIST DO BEGIN FREEPAGES := FREEPAGES - TOTAL - 1; FREE(.GROUPPOINTER.) := GROUPSET; CHANGED := TRUE END END; PROCEDURE REMOVEPAGES (VAR MAP: FILEMAP; ADDR: INTEGER); VAR FINISH: BOOLEAN; BEGIN INITREMOVE(ADDR, MAP.FILELENGTH, FINISH); REPEAT "WITHIN THE FREELIST" REPEAT "WITHIN'); PROTECTION: WRITETEXT('FILE PROTECTED# '); SYNTAX: HELP END; BADERROR := TRUE END END; PROCEDURE READCATPAGE (I: INTEGER; VAR ELEM: CATENTRY); VAR PAGENO: INTEGER; BEGIN WITH CAT DO BEGIN PAGENO := (I - 1) DIV CATPAGELENGTH + 1; IF INDEX <> PAGENO THEN BEGIN INDEX := PAGENO; GET(CATFILE, INDEX, BLOCK) END; ELEM := BLOCK(.(I - 1) MOD CATPAGELENGTH + 1 .) END END; FUNCTION HASH (ID: IDENTIFIER): INTEGER; VAR KEY, I: INTEGER; C: CHAR; BEGIN KE A FREEPAGE" REPEAT "WITHIN FIVE CYLINDERS GROUP" IF (CYLINDERSET <> EMPTYSET) THEN GETCYLINDER(MAP, FINISH); IF NOT FINISH THEN MOVECYLINDER(1) UNTIL (CYLINDERPOINTER > GROUPLIMIT) OR FINISH; IF NOT FINISH THEN MOVEGROUP(1) UNTIL (GROUPPOINTER > FREEPAGELIMIT) OR FINISH; IF NOT FINISH THEN MOVEPAGE UNTIL FINISH; FINISHREMOVE(MAP.FILELENGTH) END; PROCEDURE INITRELEASE (VAR MAP: FILEMAP; ADDR: INTEGER); BEGIN WITH FREELIST, MAP DO BEGIN IOPAGE(MAP, INPUT END END END; PROCEDURE GETBOOL (ARGNO: INTEGER; VAR BOOLIN: BOOLEAN; VAR OK: BOOLEAN); BEGIN WITH PARAM(.ARGNO.) DO BEGIN IF TAG <> BOOLTYPE THEN OK := FALSE ELSE BEGIN BOOLIN := BOOL; OK := TRUE END END END; PROCEDURE CHECKKIND (ID: IDENTIFIER; VAR KIND: FILEKIND; VAR OK: BOOLEAN); BEGIN OK := TRUE; IF ID = 'SCRATCH ' THEN KIND := SCRATCH ELSE IF ID = 'ASCII ' THEN KIND := ASCII ELSE IF ID = 'SEQCODE ' THEN KIND := SEQCODE ELSE IF ID , ADDR); SETPARAMETERS(ADDR); FIND := FILELENGTH; FOUND := 0; GROUPSET := GROUPSET OR (.SECTOR.); FREEPAGES := FREEPAGES + FILELENGTH + 1; IF ADDR < FIRST THEN FIRST := ADDR END END; PROCEDURE INITSHORTEN (VAR MAP: FILEMAP; ADDR, NEWLENGTH: INTEGER); VAR I, P, OUTOFCYL: INTEGER; BEGIN WITH FREELIST, MAP DO BEGIN IOPAGE(MAP, INPUT, ADDR); SETPARAMETERS(PAGESET(.NEWLENGTH+1.)); FIND := FILELENGTH; FOUND := NEWLENGTH + 1; GROUPSET := GROUPSET OR (.SECTOR.); FREEPA= 'CONCODE ' THEN KIND := CONCODE ELSE OK := FALSE END; "************* * CLASS DISK * *************" PROCEDURE IOPAGE (VAR P: UNIV PAGE; ORDER: IOOPERATION; ADDRESS: UNIV IOARG); VAR PARAM: IOPARAM; C: CHAR; BEGIN WITH PARAM DO BEGIN OPERATION := ORDER; ARG := ADDRESS; REPEAT IOTRANSFER(DISKDEVICE, PARAM, P); IF STATUS <> COMPLETE THEN BEGIN WRITETEXT('DISK ERROR #'); WRITETEXT('PUSH RETURN#'); REPEAT ACCEPT(C) UNTIL C = NL END GES := FREEPAGES + (MAPLENGTH - NEWLENGTH); OUTOFCYL := (SECTOR DIV CYLINDERSIZE +1) * CYLINDERSIZE + DISPLACEMENT; I := NEWLENGTH + 1; REPEAT P := PAGESET(.I.); IF P < FIRST THEN FIRST := P; I := I + 1 UNTIL (P>=OUTOFCYL) OR (I>FILELENGTH); FILELENGTH := NEWLENGTH END END; PROCEDURE RELEASEGROUP (MAP: FILEMAP; VAR FINISH: BOOLEAN; VAR NEXTOUT: INTEGER); VAR DIFFERENCE: INTEGER; MORE: BOOLEAN; BEGIN MORE := TRUE; FINISH := (FIND=FOUND); W UNTIL (STATUS=COMPLETE) END END; "***************** * CLASS FREELIST * *****************" PROCEDURE GETFREE (FREENO: INTEGER); VAR FREEDUMMY: FREEONDISK; BEGIN WITH FREELIST, FREEDUMMY DO IF FREENO <> PAGEINDEX THEN BEGIN IF CHANGED THEN BEGIN FREEPAGEONDISK := FREE; IOPAGE(FREEDUMMY, OUTPUT, FREELISTFIRST+PAGEINDEX) END; IOPAGE(FREEDUMMY, INPUT, FREELISTFIRST+FREENO); PAGEINDEX := FREENO; CHANGED := FALSE; FREE := FREEPAGEONDISK END END; PROCEDURE SETHILE MORE & NOT FINISH DO BEGIN NEXTOUT := MAP.PAGESET(.FOUND + 1.); DIFFERENCE := NEXTOUT - DISPLACEMENT; IF DIFFERENCE <= FIVECYLINDERLIMIT THEN BEGIN GROUPSET := GROUPSET OR (.DIFFERENCE.); FOUND := FOUND + 1 END ELSE MORE := FALSE; FINISH := (FIND = FOUND) END; FREELIST.FREE(.GROUPPOINTER.) := GROUPSET END; PROCEDURE RELEASEMAP(MAP: FILEMAP); VAR FINISH: BOOLEAN; NEXTOUT: INTEGER; BEGIN REPEAT RELEASEGROUP(MAP, FINISH, NEXTOUT); IF NOT FINISH THEN END; ; ; .SBTTL KERNEL INITIALIZATION ;"################################### ; # INITIALIZATION # ;###################################" ; ; ; "INITIALIZE THE KERNEL" ; INIPARAMETERS (POINTER: INTEGER); BEGIN GROUPPOINTER := POINTER DIV FIVECYLINDERSIZE; PAGEPOINTER := GROUPPOINTER DIV FREEPAGESIZE; PAGEBASE := PAGEPOINTER * FREEPAGECONTENTS; GROUPPOINTER := GROUPPOINTER MOD FREEPAGESIZE; GROUPBASE := GROUPPOINTER * FIVECYLINDERSIZE; DISPLACEMENT := PAGEBASE + GROUPBASE; SECTOR := POINTER MOD FIVECYLINDERSIZE; GETFREE(PAGEPOINTER); WITH FREELIST DO BEGIN CHANGED := TRUE "NOT YET, BUT SOON..."; GROUPSET := FREE(.GROUPPOINTER.) END END; PROCEDURE T36: ; BEGIN ; THE CODE FOR THESE STANDARD PRO- ; LOADVIRTUALMACHINE; ; CEDURES IS TO BE FOUND IN THE ; LOADSYSTEMPROGRAM; ; PROCESSOR DEFINITION PREFIX OF ; ; THIS PROGRAM. IT IS INVOKED AS ; ; PART OF THE INITIAL PROGRAM LOAD-; ; ING BY MEANS OF A JUMP TO ADDRESS; ; ZERO. ; ; JSR PC,INIT16 ; NEWCORE.INITIALIZE; JSR PC,INIT6 ; TIMER.INITIALIZE; JSR PCINITREMOVE (START, TOTAL: INTEGER; VAR FINISH: BOOLEAN); BEGIN CYLINDERMASK(.0.) := (.0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23.); CYLINDERMASK(.1.) := (.24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47.); CYLINDERMASK(.2.) := (.48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71.); CYLINDERMASK(,INIT7 ; CLOCK.INITIALIZE; JSR PC,INIT9 ; CORE.INITIALIZE; JSR PC,INIT10 ; VIRTUAL.INITIALIZE; JSR PC,INIT11 ; RUNNING.INITIALIZE; JSR PC,INIT12 ; READY.INITIALIZE; JSR PC,INIT25 ; TM11TAPE.INITIALIZE; JSR PC,INIT27 ; RK11DISK.INITIALIZE; JSR PC,INIT28 ; LT33TERMINAL.INITIALIZE; JSR PC,INIT29 ; LPXXPRINTER.INITIA.3.) := (.72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95.); CYLINDERMASK(.4.) := (.96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119.); SETPARAMETERS(START); CYLINDERPOINTER := SECTOR DIV CYLINDERSIZE; CYLINDERBASE := CYLINDERPOINTER * CYLINDERSIZE; FIND := TOTAL; FOUND := 0; CYLINDERGAP := 0; GROUPSET := GROUPLIZE; JSR PC,INIT30 ; CD11ACARDREADER.INITIALIZE; ; MOV INTL99,INTL11 ; RUNNING.INITPARENT( JSR PC,INPA11 ; INTERPRETERLENGTH); JSR PC,KERN37 ; KERNELREADY; RTS PC ; END "OF KERNEL"; ; ; .SBTTL .SBTTL ######################################################### SET - (.SECTOR.); CYLINDERSET := GROUPSET & CYLINDERMASK(.CYLINDERPOINTER.); FINISH := FALSE END; FUNCTION SECTORGAP (CYLINDERGAP: INTEGER): INTEGER; CONST LINEARMIN = 44; VAR F: REAL; ABSGAP: INTEGER; BEGIN IF CYLINDERGAP = 0 THEN SECTORGAP := STANDARDGAP ELSE BEGIN F := CONV(CYLINDERGAP); IF CYLINDERGAP < LINEARMIN THEN ABSGAP := TRUNC(5.388+F*(0.60186564+F*(-0.01681706+F*0.00018523))) ELSE ABSGAP := TRUNC(0.1*F+10.5); SECTORGAP := ABSGAP - STANDARDGAP END END; PROCEDUR .SBTTL E SETFIRST; VAR I: INTEGER; BEGIN I := 0; WHILE NOT (I IN CYLINDERSET) DO I := I + 1; FREELIST.FIRST := I + DISPLACEMENT END; PROCEDURE GETCYLINDER (VAR MAP: FILEMAP; VAR FINISH: BOOLEAN); BEGIN SECTOR := (SECTOR + SECTORGAP(CYLINDERGAP)) MOD CYLINDERSIZE + CYLINDERBASE; CYLINDERGAP := 0; WHILE (CYLINDERSET <> EMPTYSET) & (FIND > FOUND) DO BEGIN WHILE NOT (SECTOR IN CYLINDERSET) DO SECTOR := (SECTOR + 1) MOD CYLINDERSIZE + CYLINDERBASE; GROUPSET := GROUPSET - (.SECTOR.); CYLINDE SETPARAMETERS(NEXTOUT) UNTIL FINISH END; "FREELIST PRIMITIVES" PROCEDURE INITFREE; VAR FREEIN: FREEONDISK; BEGIN IOPAGE(FREEIN, INPUT, FREELISTFIRST); WITH FREELIST, FREEIN DO BEGIN FIRST := MISCELLANEOUS(.1.); FREEPAGES := MISCELLANEOUS(.2.); PAGEINDEX := 0; CHANGED := FALSE; FREE := FREEPAGEONDISK END END; PROCEDURE FINISHFREE; VAR FREEOUT: FREEONDISK; BEGIN GETFREE(0); WITH FREELIST, FREEOUT DO BEGIN MISCELLANEOUS(.1.) := FIRST; MISCELLANEOUS(.2.) := FREEPRSET := CYLINDERSET - (.SECTOR.); FOUND := FOUND + 1; MAP.PAGESET(.FOUND.) := SECTOR + DISPLACEMENT; SECTOR := (SECTOR + STANDARDGAP) MOD CYLINDERSIZE + CYLINDERBASE END; IF (FIND = FOUND) & (CYLINDERSET <> EMPTYSET) THEN BEGIN SETFIRST; FINISH := TRUE END ELSE FINISH := FALSE END; PROCEDURE MOVECYLINDER (DELTA: INTEGER); BEGIN CYLINDERPOINTER := CYLINDERPOINTER + DELTA; IF CYLINDERPOINTER <= GROUPLIMIT THEN BEGIN CYLINDERBASE := CYLINDERPOINTER * CYLINDERSIZE; C ;JUMP IF ANSWER IS $ZERO1 MOVB A(SP),A+1(SP) ;SHIFT FRACTION LEFT SEC ;INSERT NORMAL BIT ROR A(SP) MOVB A+3(SP),A(SP) SWAB A+2(SP) MOVB A+5(SP),A+2(SP) SWAB A+4(SP) MOVB A+7(SP),A+4(SP) SWAB A+6(SP) CLRB A+6(SP) ;MAKE ROOM FOR EXTRA BITS ASL B(SP) ;SHIFT HIGH MULTIPLIER ADC $SIGN(SP) ;GET PRODUCT $SIGN TSTB B+1(SP) BNE NONZ ;JUMP IF NOT $ZERO1 $ZERO1: CMP (SP)+,(SP)+ ;FLUSH $SIGN AND EXPONENT ZERO11: JMP ZERO12 NONZ: CLR R0 ;CLEAR PRODUCT CLR R1 CLR R4 BISB B+1(SP),R4 ;GET EXPONENT SP) ROR R4 ADC R4 ;ROUND ADC Q+4-4(SP) ADC Q+2-4(SP) ADC Q+0-4(SP) MOV R4,Q+6-4(SP) ;INSERT LOW ORDER FRACTION BCS OVER31 BVS OVER31 $RTN: POP ;<01> ADD #8.,SP ;FLUSH FIRST ARGUMENT JMP @R0 ;<01> RETURN OVER31: TST -(SP) ;FAKE EXP OVER3: TST (SP)+ ;<01> POP GARBAGE WORD POP ;<01> POP REGISTERS JMP OVERFL ;<01> JUMP TO ERROR HANDLER DIV1: ASL R4 ;SHIFT QUOTIENT ASL R3 ;SHIFT NUMERATOR ROL R2 ROL R1 ROL R0 BCS GO ;GUARANTEED TO GO CMP D+0+2 "CATALOG PRIMITIVES" PROCEDURE INITCAT; VAR FOUND: BOOLEAN; BEGIN OPEN(CATFILE, 'CATALOG ', FOUND); WITH CAT DO BEGIN INDEX := 0; CHANGED := FALSE END END; PROCEDURE FINISHCAT; BEGIN WITH CAT DO BEGIN IF CHANGED THEN PUT(CATFILE, INDEX, BLOCK); CLOSE(CATFILE) END END; FUNCTION CATSPACE (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHNEW(ID); CATSPACE := (BUCKET.NAME = NONAME) END; FUNCTION CONTAINS (ID: IDENTIFIER): BOOLEAN; BEGIN SEARCHOLD (ID); WITH BUCKET DO CONTAI ADD R4,@SP ;GET SUM OF EXPONENTS MOVB #1,B+1(SP) ;INSERT NORMAL BIT ROR B(SP) SWAB B(SP) ;LEFT JUSTIFY FRACTION MOVB B+3(SP),B(SP) SWAB B+2(SP) MOVB B+5(SP),B+2(SP) SWAB B+4(SP) MOVB B+7(SP),B+4(SP) SWAB B+6(SP) CLRB B+6(SP) MOV A(SP),-(SP) MOV B+6+2(SP),R4 ;GET A1*B4 JSR PC,EMULT MOV R4,R2 ;RESULT TO PRODUCT MOV R5,R3 MOV A+2(SP),-(SP) MOV B+4+2(SP),R4 ;GET A2*B3 JSR PC,EMULT ADD R4,R2 ;ADD TO PRODUCT ADC R1 ADD R5,R3 ADC R2 ADC R1 MOV A+4(SP),-(SP) MOV B+2+2(SP),R4 ;GET A3*B2NS := (NAME=ID) & (ID<>NONAME) END; PROCEDURE READATTR (ID: IDENTIFIER; VAR ATTR: FILEATTR); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ATTR := ELEM.ATTR END END; PROCEDURE WRITEATTR (ID: IDENTIFIER; ATTR: FILEATTR); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ELEM.ATTR := ATTR; WRITECAT(INDEX, ELEM) END END; PROCEDURE INCLUDE (ID: IDENTIFIER; ATTR: FILEATTR); VAR ELEM: CATENTRY; BEGIN S JSR PC,EMULT ADD R4,R2 ADC R1 ADD R5,R3 ADC R2 ADC R1 MOV A+6(SP),-(SP) MOV B+0+2(SP),R4 ;GET A4*B1 JSR PC,EMULT ADD R4,R2 ADC R1 ADD R5,R3 ADC R2 ADC R1 MOV R2,R3 ;DIVIDE BY 2**16 MOV R1,R2 CLR R1 MOV A(SP),-(SP) MOV B+4+2(SP),R4 ;GET A1*B3 JSR PC,EMULT ADD R4,R2 ADC R1 ADD R5,R3 ADC R2 ADC R1 MOV A+2(SP),-(SP) MOV B+2+2(SP),R4 ;GET A2*B2 JSR PC,EMULT ADD R4,R2 ADC R1 ADD R5,R3 ADC R2 ADC R1 MOV A+4(SP),-(SP) MOV B+0+2(SP),R4 ;GET A3*B1 JSR PC,EMULT ADD R4,R2 ADC R1 EARCHNEW(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ELEM.ID := ID; ELEM.ATTR := ATTR; ELEM.KEY := START; WRITECAT(INDEX,ELEM); READCAT(START, ELEM); ELEM.SEARCHLENGTH := ELEM.SEARCHLENGTH + 1; WRITECAT(START, ELEM) END END; PROCEDURE EXCLUDE (ID: IDENTIFIER); VAR ELEM: CATENTRY; BEGIN SEARCHOLD(ID); WITH BUCKET DO BEGIN READCAT(INDEX, ELEM); ELEM.ID := NONAME; ELEM.KEY := NOKEY; WRITECAT(INDEX, ELEM); READCAT(START, ELEM); ELEM.SEARCH ADD R5,R3 ADC R2 ADC R1 MOV A(SP),-(SP) MOV B+2+2(SP),R4 ;GET A1*B2 JSR PC,EMULT ADD R4,R1 ADC R0 ADD R5,R2 ADC R1 ADC R0 MOV A+2(SP),-(SP) MOV B+0+2(SP),R4 ;GET A2*B1 JSR PC,EMULT ADD R4,R1 ADC R0 ADD R5,R2 ADC R1 ADC R0 MOV A(SP),-(SP) MOV B+0+2(SP),R4 ;GET A1*B1 JSR PC,EMULT ADD R4,R0 ADD R5,R1 ADC R0 MOV (SP)+,R4 ;GET SUM OF EXPONENTS ASL R3 ;SHIFT OUT NORMAL BIT ROL R2 ROL R1 ROL R0 BCS NORM2 ;JUMP IF IT WAS FOUND ASL R3 ROL R2 ROL R1 ROL R0 ;MUST HAVE GOT IT NOW LENGTH := ELEM.SEARCHLENGTH - 1; WRITECAT(START, ELEM) END END; "****************** * CLASS SECRETARY * ******************" PROCEDURE CREATENEXT (ID: IDENTIFIER; SIZE: INTEGER; NEWKIND: FILEKIND; PROTECTION: BOOLEAN); VAR ATTR: FILEATTR; BEGIN WITH ATTR DO BEGIN READATTR('NEXT ',ATTR); SHORTEN(ADDR, SIZE); KIND := NEWKIND; PROTECTED := PROTECTION; INCLUDE(ID, ATTR); ALLOCATE(MAPLENGTH, ADDR); KIND := SCRATCH; PROTECTED := TRUE; WRITDEC R4 ;ADJUST EXPONENT NORM2: SUB #200,R4 ;TAKE OUT ONE OF THE EXCESS 128'S BLE UNDER2 ;JUMP IF UNDERFLOW CMP #377,R4 BLT OVER2 ;JUMP IF OVERFLOW CLRB R3 BISB R2,R3 ;SHIFT FRACTION RIGHT SWAB R3 CLRB R2 BISB R1,R2 SWAB R2 CLRB R1 BISB R0,R1 SWAB R1 CLRB R0 BISB R4,R0 SWAB R0 ROR (SP)+ ;GET PRODUCT $SIGN ROR R0 ;INSERT IT IN RESULT ROR R1 ROR R2 ROR R3 ADC R3 ;ROUND RESULT ADC R2 ADC R1 ADC R0 BCS OVER21 ;JUMP IF OVERFLOW ON ROUND BVS OVER21 OUT: MOV R0,RESLT(SP) ;PUT OUT Y := 1; I := 0; REPEAT I := I+1; C := ID(.I.); IF C <> ' ' THEN KEY := KEY * ORD(C) MOD CATLENGTH + 1 UNTIL (C=' ') OR (I=IDLENGTH); HASH := KEY END; PROCEDURE GETCAT (I: INTEGER); VAR PAGENO: INTEGER; BEGIN WITH CAT DO BEGIN PAGENO := (I-1) DIV CATPAGELENGTH + 1; IF INDEX <> PAGENO THEN BEGIN IF CHANGED THEN PUT(CATFILE, INDEX, BLOCK); INDEX := PAGENO; GET(CATFILE, INDEX, BLOCK); CHANGED := FALSE END END END; PROCEDURE READCAT (I: INTEGER;ANSWER MOV R1,RESLT+2(SP) MOV R2,RESLT+4(SP) MOV R3,RESLT+6(SP) POP ;<01> UNSAVE REGISTERS ADD #8.,SP ;FLUSH TOP ARGUMENT JMP @R0 ;<01> AND RETURN OVER21: TST -(SP) ;FAKE $SIGN OVER2: TST (SP)+ ;GET RID OF SIGN POP ;<01> UNSAVE REGISTERS ADD #8.,SP ;<01> POP OPD 1 JMP OVERFL ;<01> CEASE EXECUTION UNDER2: ECALL2: TST (SP)+ ;FLUSH $SIGN ZERO12: CLR R0 ;CLEAR HIGH ORDER RESULT CLR R1 ;CLEAR LOW ORDER CLR R2 CLR R3 BR OUT EMULT: CLR -(SP) ;CLEAR VAR ELEM: CATENTRY); BEGIN WITH CAT DO BEGIN GETCAT(I); ELEM := BLOCK(.(I-1) MOD CATPAGELENGTH + 1.) END END; PROCEDURE WRITECAT (I: INTEGER; ELEM: CATENTRY); BEGIN WITH CAT DO BEGIN GETCAT(I); BLOCK(.(I-1) MOD CATPAGELENGTH + 1.) := ELEM; CHANGED := TRUE END END; PROCEDURE INITBUCKET (ID: IDENTIFIER); VAR ELEM: CATENTRY; BEGIN WITH BUCKET DO BEGIN START := HASH(ID); READCAT(START, ELEM); NAME := ELEM.ID; LENGTH := ELEM.SEARCHLENGTH; INDEX := START HIGH PRODUCT TST R4 ;TEST MULTIPLICAND BEQ MZ ;JUMP IF 0 BGT MPLUS ;+ TST 4(SP) ;TEST MULTIPLIER BEQ MZ ;JUMP IF 0 BGT MNEG1 ;+ BR MNEG MPLUS: TST 4(SP) ;TEST MULTIPLIER BEQ MZ ;JUMP IF 0 BGT MLTQ ;+ ADD R4,@SP BR MLTQ MNEG: ADD R4,@SP MNEG1: ADD 4(SP),@SP MLTQ: MUL 4(SP),R4 ;GET PRODUCT MDONE: ADD (SP)+,R4 ;ADD IN HIGH ORDER PARTS MOV (SP)+,@SP ;FLUSH MULTIPLIER RTS PC ;RETURN MZ: CLR R4 ;RESULT IS 0 CLR R5 BR MDONE .ENDC .TITLE DDIV DOUBLE FLOATING DIVIDE .IF NDF,F$PU ;<01> END END; PROCEDURE SEARCHOLD (ID: IDENTIFIER); VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY; BEGIN INITBUCKET(ID); WITH BUCKET DO IF ID <> NAME THEN BEGIN MORE := LENGTH; INDEX := START MOD CATLENGTH + 1; FOUND := FALSE; WHILE (MORE>0) & NOT FOUND DO BEGIN READCAT(INDEX, ELEM); NAME := ELEM.ID; IF ID = NAME THEN FOUND := TRUE ELSE BEGIN IF ELEM.KEY = START THEN MORE := MORE - 1; INDEX := INDEX MOD CATLENGTH + 1 END END .GLOBL $DVD,OVERFL ; $DVD --- THE DOUBLE DIVIDE ROUT3INE ; CALLED IN THE POLISH MODE ; THE NUMERATOR IS THE SECOND ITEM ON THE STACK ; AND THE DENOMINATOR IS ON TOP. ; TAKES THE QUOTIENT AND PUTS IT ON TOP ; OF THE STACK IN THEIR PLACE D=8.+10 N=16.+10 Q=16.+10 $DVD: POP R0 ;<01> POP RETURN @ TO R0 PUSH ;<01> SAVE THE REGISTERS CLR R0 CLR R1 CLR R2 CLR R3 CLR -(SP) ASL N+0-2(SP) ;SHIFT NUMERATOR ROL @SP ;GET NUMERATOR SIGN CLR -(SP) TST D(SP) ;CHECK FOR 0.0 DENOM END END; PROCEDURE SEARCHNEW (ID: IDENTIFIER); VAR MORE: INTEGER; FOUND: BOOLEAN; ELEM: CATENTRY; BEGIN INITBUCKET(ID); WITH BUCKET DO IF NAME <> NONAME THEN BEGIN MORE := CATLENGTH; INDEX := START MOD CATLENGTH + 1; FOUND := FALSE; WHILE (MORE > 0) & NOT FOUND DO BEGIN READCAT(INDEX, ELEM); NAME := ELEM.ID; IF NAME = NONAME THEN FOUND := TRUE ELSE BEGIN MORE := MORE - 1; INDEX := INDEX MOD CATLENGTH + 1 END END END END;INATOR BEQ DCHK ;JUMP TO ERROR EXIT BISB N+1(SP),@SP ;GET NUMERATOR EXPONENT BEQ $$ZERO ;JUMP IF NUMERATOR IS $$ZERO BISB N(SP),R0 SWAB R0 ;LEFT JUSTIFY NUMERATOR FRACTION SEC ;INSERT NORMAL BIT ROR R0 BISB N+3(SP),R0 BISB N+2(SP),R1 SWAB R1 BISB N+5(SP),R1 BISB N+4(SP),R2 SWAB R2 BISB N+7(SP),R2 BISB N+6(SP),R3 SWAB R3 ASL D(SP) ;SHIFT DENOMINATOR ADC 2(SP) ;GET RESULT SIGN CLR R4 BISB D+1(SP),R4 ;GET DIVISOR EXPONENT SUB R4,@SP ;SUBTRACT EXPONENTS SWAB D(SP) ;LEFT JUSTIFY DE(SP),R0 ;COMPARE HIGH DIVISOR AND DIVIDEND BHI NOGO ;JUMP IF DIVISOR BIGGER BLO GO ;JUMP IF DIVISOR SMALLER CMP D+2+2(SP),R1 ;CHECK THE LOW ORDERS BHI NOGO BLO GO CMP D+4+2(SP),R2 BHI NOGO BLO GO CMP D+6+2(SP),R3 BHI NOGO BEQ NEQD ;JUMP IF NUMERATOR =DENOMINATOR GO: SUB D+6+2(SP),R3 ;N=N-D SBC R2 SBC R1 SBC R0 SUB D+4+2(SP),R2 SBC R1 SBC R0 SUB D+2+2(SP),R1 SBC R0 SUB D+0+2(SP),R0 INC R4 ;INSERT QUOTIENT BIT NOGO: DEC R5 ;COUNT LOOP BGT DIV1 RTS PC NEQD: INC R4 ;INSERT LAST 1 BINOMINATOR SEC ;INSERT NORMAL BIT ROR D(SP) MOVB D+3(SP),D(SP) MOVB D+2(SP),D+3(SP) MOVB D+5(SP),D+2(SP) MOVB D+4(SP),D+5(SP) MOVB D+7(SP),D+4(SP) MOVB D+6(SP),D+7(SP) CLRB D+6(SP) CLR Q(SP) ;CLEAR QUOTIENT CLR Q+2(SP) CLR Q+4(SP) CMP R0,D(SP) ;COMPARE HIGH NUM. AND DEN. BHI DLOW ;JUMP IF DENOMINATOR LOW BLO DHI ;JUMP IF DENOMINATOR HIGH CMP R1,D+2(SP) ;COMPARE LOW ORDER PARTS BHI DLOW BLO DHI CMP R2,D+4(SP) BHI DLOW BLO DHI CMP R3,D+6(SP) BHI DLOW BNE DHI INC @SP ;BUMP EXPONEN ROL R0 BR BIT9A ;TRY AGAIN ZTEST: SUB #8.,R4 ;REDUCE EXPONENT TST R1 BNE ZT1 ;JUMP IF ONLY R0=0 SUB #16.,R4 MOV R2,R1 BNE ZT2 ;JUMP IF R2 NOT 0 SUB #16.,R4 TST R3 BEQ $ZERO ;ANSWER IS 0 BISB R3,R1 ;MOVE BYTES TO R0,R1 SWAB R1 SWAB R3 BISB R3,R0 CLR R3 ;MAKE ALL OTHERS 0 BR BIT9 ;GO NORMALIZE ZT2: MOV R3,R2 CLR R3 ZT1: SWAB R1 ;MOVE ALL BYTES LEFT BISB R1,R0 CLRB R1 SWAB R2 BISB R2,R1 CLRB R2 SWAB R3 BISB R3,R2 CLRB R3 BR BIT9 ;GO NORMALIZE WHAT'S LEFT .ENDC .TITLE DMUT CLR R4 BR FLOAT DCHK: JMP OVERFL ;$$ZERO DIVIDE => OVERFLOW! BR $ECLL UNDER3: ECALL3: TST -(SP) ;FAKE SIGN $ECLL: $$ZERO: CMP (SP)+,(SP)+ ;FLUSH EXP AND SIGN CLR Q+0-4(SP) CLR Q+2-4(SP) CLR Q+4-4(SP) CLR Q+6-4(SP) BR $RTN DLOW: ROR R0 ;HALVE DENOMINATOR (C=0) ROR R1 ;TO ENSURE THAT N .GLOBL $MLD,OVERFL ; $MLD THE DOUBLE MULTIPLY ROUTINE ; CALLED IN POLISH MODE. ; REPLACES THE TOP TWO DOUBLES ON THE STACK ; WITH THEIR PRODUCT. A=8.+10 B=16.+10 RESLT=12.+10 $SIGN=2 ;MULTIPLY STACK AND STACK $MLD: MUD$SS: POP R0 ;<01> POP RETURN TO R0 PUSH ;<01> SAVE THE REGISTERS ASL A+0-4(SP) ;SHIFT MULTIPLICAND ROL -(SP) ;KEEP $SIGN CLR -(SP) ;CLEAR EXPONENT MOVB A+1(SP),@SP ;KEEP MULTIPLICAND EXPONENT BEQ $ZERO1 ;YES, REST OF NUMERATOR IS 0 MOV #16.,R5 ;GO DO 16 MORE BITS JSR PC,DIV1 MOV R4,Q+2(SP) TST R5 BNE FLOAT1 MOV #16.,R5 JSR PC,DIV1 MOV R4,Q+4(SP) TST R5 BNE FLOAT1 MOV #16.,R5 JSR PC,DIV1 BR FLOAT FLOAT1: CLR R4 ;CLEAR LOWEST ORDER QUOTIENT FLOAT: MOV (SP)+,R5 ;PUSH UP EXPONENT ADD #200,R5 ;ADD IN EXCESS 200 BLE UNDER3 ;UNDER3FLOW CMP #377,R5 BLT OVER3 ;OVERFLOW MOVB R5,Q+1-2(SP) ;INSERT EXPONENT IN RESLT SIGN: ROR (SP)+ ;INSERT QUOTIENT SIGN ROR Q+0-4(SP) ROR Q+2-4(SP) ROR Q+4-4(T IN QUOTIENT BR EQ1 EQ2: ASL R4 ;FINISH OUT3 QUOTIENT WITH 0'S EQ1: DEC R5 BGT EQ2 INC R5 ;FLAG NO MORE NUMERATOR RTS: RTS PC ;RETURN TO CALLER .ENDC .TITLE CMPD THE DOUBLE COMPARE ROUTINES .IF NDF,F$PU ;<01> ; H.J. .GLOBL $DCMP ;DOUBLE COMPARE ROUTINE. UPON EXIT THE ;CONDITION CODES WILL BE SET FOR THE SIGNED BRANCHES $DCMP: CMD$SS: MOV (SP),-(SP) ;<01> MAKE ROOM FOR PSW PUSH ;<01> SAVE REGS USED MOV SP,R1 ;ADDR OF ARG 2 MOV SP,R0 ADD #18.,R0 ;<01> ADDR OF ARG 1 CMDIS: ADD REPLACEIT(ID, SIZE, KIND, PROTECTION, RESULT) ELSE RESULT := SYNTAX; CATERROR(RESULT) END; PROCEDURE CREATEFILE; VAR ID: IDENTIFIER; OK, PROTECTION: BOOLEAN; SIZE: INTEGER; KIND: FILEKIND; RESULT: CATRESULT; IDKIND: IDENTIFIER; BEGIN GETID(3, ID, OK); IF OK THEN GETINT(4, SIZE, OK); IF OK THEN GETID(5, IDKIND, OK); IF OK THEN CHECKKIND(IDKIND, KIND, OK); IF OK THEN GETBOOL(6, PROTECTION, OK); IF OK THEN CREATEIT(ID, SIZE, KIND, PROTECTION, RESULT) ELSE RESULT := SYNTAX; CATERRO #10.,R1 ;<01> ADJUST ADDR OF ARG2 COMP: MOV @R0,R3 BIS @R1,R3 ;SET UP N BIT SAYING EITHER WAS NEGATIVE CMP (R0)+,(R1)+ ;ARE HIGH PARTS EQUAL BNE 1$ CMP (R0)+,(R1)+ ;CHECK REST TO SET C BIT BNE 1$ CMP (R0)+,(R1)+ BNE 1$ CMP @R0,@R1 ;LOW PARTS BNE 1$ ;GO HANDLE NOT EQUAL CASE, C BIT CLR R3 ;SET CONDITION CODES BR $XIT ;<01> DONE, EXIT ;AT THIS POINT THE C BIT SAYS WHETHER OPERAND 1 WAS BIGGER ;OR NOT THAN OPERAND 2 IN UNSIGNED MODE. C SET IF 1ST SMALLER 1$: ROR R3 ;GETS C AND N BITS R(RESULT) END; PROCEDURE PROTECTFILE; VAR ID: IDENTIFIER; PROTECTION, OK: BOOLEAN; RESULT: CATRESULT; BEGIN GETID(3, ID, OK); IF OK THEN GETBOOL(4, PROTECTION, OK); IF OK THEN PROTECTIT(ID, PROTECTION, RESULT) ELSE RESULT := SYNTAX; CATERROR(RESULT) END; PROCEDURE DELETEFILE; VAR ID: IDENTIFIER; RESULT: CATRESULT; OK: BOOLEAN; ARG: IDENTIFIER; BEGIN GETID(3, ID, OK); IF NOT OK THEN RESULT := SYNTAX ELSE DELETEIT(ID, RESULT); CATERROR(RESULT) END; PROCEDURE RENAMEFILE; VAR OLDID, TOGETHER ROL R3 ;SET V BIT ON FINAL RESULT .WORD CLN!CLZ ;DONT WANT N OR Z TO INTERFERE $XIT: GETPSW 10(SP) ;<01> PUT PSW IN STACK POP ;<01> POP REGS MOV 2(SP),22(SP) ;<01> PUT PSW IN PLACE MOV 0(SP),20(SP) ;<01> PUT PC IN PLACE ADD #20,SP ;<01> SP -> NEW PC RTI ;<01> AND RETURN .ENDC ;<01> .SBTTL CONVERT TO INTEGER .IF NDF,F$PU ;<01> .GLOBL $DI .GLOBL OVERFL ;<01> OVERFLOW LABEL ; REAL TO INTEGER CONVERSION. ; ARGUMENT IS A DOUBLE WORD REAL NUMBER ON THE TOP ; OF THE STNEWID: IDENTIFIER; OK: BOOLEAN; ARG: IDENTIFIER; RESULT: CATRESULT; BEGIN GETID(3, OLDID, OK); IF OK THEN GETID(4, NEWID, OK); IF NOT OK THEN RESULT := SYNTAX ELSE RENAMEIT(OLDID, NEWID, RESULT); CATERROR(RESULT) END; PROCEDURE SAVEFILES; BEGIN FINISHCAT; FINISHFREE END; PROCEDURE GIVEANSWER (RESULT: BOOLEAN); BEGIN WITH PARAM(.1.) DO BEGIN TAG := BOOLTYPE; BOOL := RESULT END END; PROCEDURE FINISH; BEGIN SAVEFILES; GIVEANSWER(NOT BADERROR) END; PROCEDURE COMPLAIN; BEGACK. ; TRUNCATE IT AND CONVERT IT TO AN INTEGER ON THE ; TOP OF THE STACK. CLC$: CLD$: CIC$: CID$: $DI: POP R0 ;<01> POP RETURN TO R0 MOV (SP)+,2(SP) ;TRUNCATE TO REAL FORMAT MOV (SP)+,2(SP) CLF$: CIF$: $RI: CLR R2 ;CLEAR WORK SPACE INC R2 ;SET UP NORMAL BIT MOV (SP)+,R1 ;GET REAL ARGUMENT ROL @SP ;GET SIGN ROL R1 ;AND PUSH ;<01> SAVE REGISTERS (NOTE: C-BIT UNAFFECTED!) ROL -(SP) ;SAVE IT MOVB R1,R3 ;GET HIGH ORDER FRACTION CLRB R1 SWAB R1 ;GET EXPONENT SUB #201,R1 BLT .ZERO IN CATERROR(SYNTAX); BADERROR := TRUE END; FUNCTION COMMAND: COMMANDTYPE; VAR OK, ERROR: BOOLEAN; ID: IDENTIFIER; BEGIN ERROR := FALSE; GETID(2, ID, OK); IF OK THEN IF ID = 'REPLACE ' THEN COMMAND := REPLACE ELSE IF ID = 'CREATE ' THEN COMMAND := CREATE ELSE IF ID = 'DELETE ' THEN COMMAND := DELETE ELSE IF ID = 'RENAME ' THEN COMMAND := RENAME ELSE IF ID = 'PROTECT ' THEN COMMAND := PROTECT ELSE ERROR := TRUE; IF ERROR OR NOT OK THEN COMMAND := ;JUMP IF IT IS TOO SMALL BEQ DONE CMP #15.,R1 BLT OVER4 ;JUMP IF IT IS TOO BIG SWAB R3 ;FORM 16 BITS OF HIGH ORDER FRACTION CLRB R3 BISB 7(SP),R3 SHFT4: ASHC R1,R2 ;SHIFT DONE: NEG R2 ;MAKE - BVS NEGM ;JUMP IF POSSIBLE NEGMAX BGT OVER4 ;JUMP IF MORE THAN 15 BITS SIGN4: ROR (SP)+ ;GET SIGN BCS OUT4 ;JUMP IF - NEG R2 ;- RESULT OUT4: MOV R2,4(SP) ;<01> STORE INTEGER RESULT POP ;<01> RESTORE SACRED REGISTERS JMP @R0 ;RETURN TO CALLER NEGM: ROR (SP)+ BCS OUT4 ;OK IF RESULT TO BNOTHING END; "**************** * CLASS MANAGER * ****************" PROCEDURE INITIALIZE; VAR I: INTEGER; K: FILEINCORE; BEGIN IDENTIFY('FILE:(:10:)'); BADERROR := FALSE; EMPTYSET := (. .); INITFILES END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; CASE COMMAND OF REPLACE: REPLACEFILE; CREATE: CREATEFILE; DELETE: DELETEFILE; RENAME: RENAMEFILE; PROTECT: PROTECTFILE; NOTHING: COMPLAIN END; FINISH END ELSE GIVEANSWER(FALSE) END. E - TST -(SP) ;<01> FAKE OUT STACK OVER4: TST (SP)+ ;<01> POP SIGN POP ;<01> RESTORE REGISTERS JMP OVERFL ;<01> ERROR, INT OVERFLOW .ZERO: CLR R2 ;ANSWER IS 0 BR SIGN4 .ENDC ;<01> .SBTTL CONVERT FROM INTEGER TO DOUBLE .IF NDF,F$PU ;<01> .GLOBL $ID ; INTEGER TO REAL CONVERSION. ; ARGUMENT IS A FULL WORD ON THE TOP OF THE STACK ; CONVERT IT TO REAL FORMAT AND RETURN IT AS THE TOP ; TWO WORDS ON THE STACK. CCI$: CDI$: $IC: $ID: POP R0 ;<01> PUT RETURN ADDRESS IN R0 MOV @SP,-(SP) T: RESULTTYPE); VAR STATE: PROGSTATE; LASTID: IDENTIFIER; BEGIN WITH CODE, STACK DO BEGIN LINE:= 0; OPEN(ID, STATE); IF (STATE = READY) & SPACE THEN BEGIN PUSH(ID); JOB(PARAM, STORE); POP(LINE, RESULT); END ELSE IF STATE = TOOBIG THEN RESULT:= CODELIMIT ELSE RESULT:= CALLERROR; IF ANY THEN BEGIN GET(LASTID); OPEN(LASTID, STATE) END; END; END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN INSTREAM.READ(C) END; PROCEDURE ENTRY WRITE(C:;PUSH ARGUMENT DOWN MOV @SP,-(SP) CLR 2(SP) ;CLEAR LOWEST ORDER DOUBLE CLR 4(SP) CFI$: $IR: CLR -(SP) ;MAKE ROOM FOR RESULT MOV 2(SP),R1 ;GET INTEGER ARGUMENT BGT POS BEQ ..ZERO NEG R1 ;GET ABSOLUTE VALUE POS: ROL -(SP) ;SAVE SIGN MOV #220,R2 ;GET MAX. POSSIBLE EXPONENT +1 CLRB 4(SP) ;CLEAR LOWEST ORDER FRACTION NORM5: ROL R1 ;LOOK FOR NORM5AL BIT BCS NORM5D ;JUMP IF FOUND DEC R2 ;DECREASE EXPONENT BR NORM5 ;TRY AGAIN NORM5D: MOVB R1,5(SP) ;SAVE LOW ORDER FRACTION CLRB R1 BISB R2,R1EATTR('NEXT ', ATTR) END END; PROCEDURE MOVENEXT; VAR ATTR: FILEATTR; BEGIN WITH ATTR DO BEGIN READATTR('NEXT ', ATTR); EXCLUDE('NEXT '); RELEASE(ADDR); ALLOCATE(MAPLENGTH, ADDR); INCLUDE('NEXT ', ATTR) END END; PROCEDURE CREATEIT (ID: IDENTIFIER; SIZE: INTEGER; KIND: FILEKIND; PROTECTION: BOOLEAN; VAR RESULT: CATRESULT); BEGIN IF CONTAINS(ID) THEN RESULT := NAMING ELSE IF NOT CATSPACE(ID) THEN RESULT := CATFULL ELSE I ;COMBINE EXPONENT AND HIGH ORDER FRACTION SWAB R1 ROR (SP)+ ;GET SIGN ROR R1 ;INSERT SIGN IN RESULT RORB 3(SP) MOV R1,@SP ;OUTPUT RESULT ..ZERO: JMP @R0 .ENDC ;<01> .SBTTL END INTEND: ... = INTEND - ZERO ;LENGTH OF KERNEL ... = ...+511/512 ;# BLOCKS .END F (SIZE<1) OR (SIZE>MAPLENGTH) THEN RESULT := FILELIMIT ELSE IF NOT DISKSPACE(SIZE) THEN RESULT := DISKFULL ELSE BEGIN RESULT := SUCCES; CREATENEXT(ID, SIZE, KIND, PROTECTION) END END; PROCEDURE REPLACEIT (ID: IDENTIFIER; SIZE: INTEGER; KIND: FILEKIND; PROTECT: BOOLEAN; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; MAP: FILEMAP; BEGIN IF NOT CONTAINS(ID) THEN RESULT := NAMING ELSE IF (SIZE<1) OR (SIZE>MAPLENGTH) THEN REST:= ATTRIBUTE(PROGRESULT); IF RESULT <> TERMINATED THEN SETHEAP(STACK(.TOP.).HEAPADDR); TOP:= TOP - 1; END; PROCEDURE ENTRY GET(VAR ID: IDENTIFIER); BEGIN IF TOP > 0 THEN ID:= STACK(.TOP.).PROGID; END; BEGIN TOP:= 0 END; "######################### # TASKKIND AND ARGTYPE # #########################" TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); ARGTYPE = RECORD TAG: ARGTAG; ARG: IDENTULT := FILELIMIT ELSE WITH ATTR DO BEGIN READATTR(ID, ATTR); IF PROTECTED THEN RESULT := PROTECTION ELSE BEGIN IOPAGE(MAP, INPUT, ADDR); IF NOT DISKSPACE(SIZE-MAP.FILELENGTH-1) THEN RESULT := DISKFULL ELSE BEGIN EXCLUDE(ID); RELEASE(ADDR); CREATENEXT(ID, SIZE, KIND, PROTECT); RESULT := SUCCES END END END END; PROCEDURE PROTECTIT (ID: IDENTIFIER; PROTECTIFIER END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); "############## # ARGBUFFER # ##############" TYPE ARGBUFFER = MONITOR VAR BUFFER: ARGTYPE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR ARG: ARGTYPE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); ARG:= BUFFER; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(ARG: ARGTYPE); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= ARG; FULL:= TRUE; CONTINUION: BOOLEAN; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF NOT CONTAINS(ID) THEN RESULT := NAMING ELSE BEGIN READATTR(ID, ATTR); ATTR.PROTECTED := PROTECTION; WRITEATTR(ID, ATTR); RESULT := SUCCES END END; PROCEDURE DELETEIT (ID: IDENTIFIER; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF NOT CONTAINS(ID) THEN RESULT := NAMING ELSE WITH ATTR DO BEGIN READATTR(ID, ATTR); IF PROTECTED THEN RESULT := PROTECTION E(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # LINEBUFFER # ###############" TYPE LINEBUFFER = MONITOR VAR BUFFER: LINE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: LINE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXT:= BUFFER; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= TEXT; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # PAGEBUFFER # ### ELSE BEGIN EXCLUDE(ID); RELEASE(ADDR); MOVENEXT; RESULT := SUCCES END END END; PROCEDURE RENAMEIT (OLDID, NEWID: IDENTIFIER; VAR RESULT: CATRESULT); VAR ATTR: FILEATTR; BEGIN IF CONTAINS(NEWID) OR NOT CONTAINS(OLDID) THEN RESULT := NAMING ELSE WITH ATTR DO BEGIN READATTR(OLDID, ATTR); IF ATTR.PROTECTED THEN RESULT := PROTECTION ELSE BEGIN EXCLUDE(OLDID); INCLUDE(NEWID, ATTR); RESULT := SUCCES EN############" TYPE PAGEBUFFER = MONITOR VAR BUFFER: PAGE; LAST, FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: PAGE; VAR EOF: BOOLEAN); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXT:= BUFFER; EOF:= LAST; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(TEXT: PAGE; EOF: BOOLEAN); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= TEXT; LAST:= EOF; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; "############### # CHARSTREAM # ###############" D END END; "****************** * CLASS ASSISTANT * ******************" PROCEDURE INITFILES; BEGIN INITCAT; CATLENGTH := LENGTH(CATFILE)*CATPAGELENGTH; INITFREE END; PROCEDURE REPLACEFILE; VAR ID: IDENTIFIER; OK, PROTECTION: BOOLEAN; SIZE: INTEGER; KIND: FILEKIND; RESULT: CATRESULT; IDKIND: IDENTIFIER; BEGIN GETID(3, ID, OK); IF OK THEN GETINT(4, SIZE, OK); IF OK THEN GETID(5, IDKIND, OK); IF OK THEN CHECKKIND(IDKIND, KIND, OK); IF OK THEN GETBOOL(6, PROTECTION, OK); IF OK THENGIN CALL(ID, PARAM, LINE, RESULT) END; PROCEDURE INITIALIZE; VAR I: INTEGER; PARAM: ARGLIST; LINE: INTEGER; RESULT: RESULTTYPE; BEGIN INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR), INSTREAM(INBUFFER), OUTSTREAM(OUTBUFFER); INSTREAM.INITREAD; OUTSTREAM.INITWRITE; FOR I:= 1 TO MAXFILE DO INIT FILES(.I.)(TYPEUSE, DISKUSE, CATALOG); INIT CODE(TYPEUSE, DISKUSE, CATALOG); WITH PARAM(.2.) DO BEGIN TAG:= IDTYPE; ARG:= 'CONSOLE ' END; CALL('DO ', PARAM, LINE, RESULT); OPERATOR.RINTERBUFFER: LINEBUFFER; INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE: ARGBUFFER; INSTACK, OUTSTACK, JOBSTACK: PROGSTACK; READER: CARDPROCESS; WRITER: PRINTERPROCESS; PRODUCER, CONSUMER: IOPROCESS; MASTER: JOBPROCESS; WATCHDOG: LOADERPROCESS; BEGIN INIT TYPEUSE, DISKUSE, CATALOG(TYPEUSE, DISKUSE, CATADDR), INBUFFER, OUTBUFFER, CARDBUFFER, PRINTERBUFFER, INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE, INSTACK, OUTSTACK, JOBSTACK, READER(TYPEUSE, CARDBUFFER), WRITERWRITE('JOBPROCESS:(:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "############## # IOPROCESS # ##############" TYPE IOPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; SLOWIO: LINEBUFFER; BUFFER: PAGEBUFFER; REQUEST, RESPONSE: ARGBUFFER; STACK: PROGSTACK; IOTASK: TASKKIND); "PROGRAM DATA SPACE = " +2000 TYPE FILE = 1..1; VAR OPERATOR: TERMINAL; OPSTREAM: TERMINALSTREAM; IOSTREAM: CHARSTREAM; IOFILE: DATAFILE; CODE: PROGFILE2; PROGRAM DRIVE(TYPEUSE, PRINTERBUFFER), PRODUCER(TYPEUSE, DISKUSE, CATALOG, CARDBUFFER, INBUFFER, INREQUEST, INRESPONSE, INSTACK, INPUTTASK), CONSUMER(TYPEUSE, DISKUSE, CATALOG, PRINTERBUFFER, OUTBUFFER, OUTREQUEST, OUTRESPONSE, OUTSTACK, OUTPUTTASK), MASTER(TYPEUSE, DISKUSE, CATALOG, INBUFFER, OUTBUFFER, INREQUEST, INRESPONSE, OUTREQUEST, OUTRESPONSE, JOBSTACK), WATCHDOG(DISKUSE); END. R(VAR PARAM: ARGLIST; STORE: PROGSTORE2); ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH, MARK, RELEASE, IDENTIFY, ACCEPT, DISPLAY, READPAGE, WRITEPAGE, READLINE, WRITELINE, READARG, WRITEARG, LOOKUP, IOTRANSFER, IOMOVE, TASK, RUN; PROCEDURE CALL(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); VAR STATE: PROGSTATE; LASTID: IDENTIFIER; BEGIN WITH CODE, STACK DO BEGIN LINE:= 0; OPEN(ID, STATE); IF (STATE = READY) & SPACE THEN BEGIN PUSH(ID);ASCAL ONLY" "COPYSTRUC" S:='ABCD'; WRITE_STRING(S); "ABCD" "NEW" "SEQUENTIAL PASCAL ONLY" "NEWINIT" "SEQUENTIAL PASCAL ONLY" "NOT" B:=FALSE; WRITE_BOOL(B); "0" B:=NOT(B); WRITE_BOOL(B); "1" B:=NOT(B); WRITE_BOOL(B); "0" "ANDWORD" WRITE_BOOL(FALSE&FALSE); "0" WRITE_BOOL(FALSE&TRUE ); DRIVER(PARAM, STORE); POP(LINE, RESULT); END ELSE IF STATE = TOOBIG THEN RESULT:= CODELIMIT ELSE RESULT:= CALLERROR; IF ANY THEN BEGIN GET(LASTID); OPEN(LASTID, STATE) END; END; END; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN IOSTREAM.READ(C) END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN IOSTREAM.WRITE(C) END; PROCEDURE ENTRY OPEN (F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); BEGIN IOFILE.OPEN(ID, FOUND) END; PROCEDURE ENTRY CLOSE(F: FILE); BEGIN IOFILE.C "0" WRITE_BOOL(TRUE &FALSE); "0" WRITE_BOOL(TRUE &TRUE ); "1" "ANDSET" SET1:=(.1,2,3,125,126,127.)&(.2,126.); WRITE_SET(SET1); "00100...0010" "ORWORD" WRITE_BOOL(FALSE OR FALSE); "0" WRITE_BOOL(FALSE OR TRUE ); "1" WRITE_BOOL(TRUE OR FALSE); "1" WRITE_BOOL(TRUE OR TRUE ); LOSE END; PROCEDURE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN IOFILE.READ(P, BLOCK) END; PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN IOFILE.WRITE(P, BLOCK) END; FUNCTION ENTRY LENGTH(F: FILE): INTEGER; BEGIN LENGTH:= IOFILE.LENGTH END; PROCEDURE ENTRY MARK(VAR TOP: INTEGER); BEGIN TOP:= ATTRIBUTE(HEAPTOP) END; PROCEDURE ENTRY RELEASE(TOP: INTEGER); BEGIN SETHEAP(TOP) END; PROCEDURE ENTRY IDENTIFY(HEADER: LINE); BEGIN OPSTREAM.RESET(HEADER) END; PROCEDURE ENTRY ACCEPT "1" "ORSET" SET1:=(.1,2,3,125,126,127.) OR (.4,124.); WRITE_SET(SET1); "011110...01111" "NEGWORD" Y:=22; X:=-Y; WRITE_INT(X); "-22" WRITE_INT(-X); "22" "NEGREAL" W:=13.6; W:=-W; WRITE_REAL(W); "-13.6" WRITE_REAL(-W); "13.6" "ADDWORD" WRITE_INT(256+17); (VAR C: CHAR); BEGIN OPSTREAM.READ(C) END; PROCEDURE ENTRY DISPLAY(C: CHAR); BEGIN OPSTREAM.WRITE(C) END; PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN); BEGIN BUFFER.READ(BLOCK, EOF) END; PROCEDURE ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN); BEGIN BUFFER.WRITE(BLOCK, EOF) END; PROCEDURE ENTRY READLINE(VAR TEXT: LINE); BEGIN SLOWIO.READ(TEXT) END; PROCEDURE ENTRY WRITELINE(TEXT: LINE); BEGIN SLOWIO.WRITE(TEXT) END; PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE); BEGIN REQUEST.READ(A "273" "ADDREAL" WRITE_REAL(10.0+16.2); "26.2" "SUBWORD" WRITE_INT(256-17); "239" "SUBREAL" WRITE_REAL(10.0-16.2); "-6.2" "SUBSET" SET1:=(.1,2,3,125,125,127.)-(.2,126.); WRITE_SET(SET1); "01010...0101" "MULWORD" WRITE_INT(4*24); "96" "MULREAL" WRITE_REAL(1.5*20.0); RG) END; PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE); BEGIN RESPONSE.WRITE(ARG) END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) END; PROCEDURE ENTRY IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE); BEGIN IF DEVICE = DISKDEVICE THEN BEGIN DISKUSE.REQUEST; IO(BLOCK, PARAM, DEVICE); DISKUSE.RELEASE; END ELSE IO(BLOCK, PARAM, DEVICE); END; PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PA "30.0" "DIVWORD" WRITE_INT(556 DIV 2); "278" "DIVREAL" WRITE_REAL(16.4/4.0); "4.1" "MODWORD" WRITE_INT(14 MOD 12); "2" "BUILDSET" WRITE_SET((.1,2,126,127.)); "01100...0011" "INSET" WRITE_BOOL(2 IN (.1,2,126,127.)); "1" WRITE_BOOL(3 IN (.1,2,126,127.)); "0" "LSWORD" WRITE_BOOL(2<1); RAM: IOPARAM); BEGIN IO(PARAM, PARAM, DEVICE) END; FUNCTION ENTRY TASK: TASKKIND; BEGIN TASK:= IOTASK END; PROCEDURE ENTRY RUN (ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); BEGIN CALL(ID, PARAM, LINE, RESULT) END; PROCEDURE INITIALIZE; VAR PARAM: ARGLIST; LINE: INTEGER; RESULT: RESULTTYPE; BEGIN INIT OPERATOR(TYPEUSE), OPSTREAM(OPERATOR), IOSTREAM(BUFFER), IOFILE(TYPEUSE, DISKUSE, CATALOG), CODE(TYPEUSE, DISKUSE, CATALOG); IF IOTASK = INPUTTASK THEN IO "0" WRITE_BOOL(2<2); "0" WRITE_BOOL(2<3); "1" "EQWORD" WRITE_BOOL(2=1); "0" WRITE_BOOL(2=2); "1" WRITE_BOOL(2=3); "0" "GRWORD" WRITE_BOOL(2>1); "1" WRITE_BOOL(2>2); "0" WRITE_BOOL(2>3); CHAR); BEGIN OUTSTREAM.WRITE(C) END; PROCEDURE ENTRY OPEN (F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); BEGIN FILES(.F.).OPEN(ID, FOUND) END; PROCEDURE ENTRY CLOSE(F: FILE); BEGIN FILES(.F.).CLOSE END; PROCEDURE ENTRY GET(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN FILES(.F.).READ(P, BLOCK) END; PROCEDURE ENTRY PUT(F: FILE; P: INTEGER; VAR BLOCK: PAGE); BEGIN FILES(.F.).WRITE(P, BLOCK) END; FUNCTION ENTRY LENGTH(F: FILE): INTEGER; BEGIN LENGTH:= FILES(.F.).LENGTH END; PROCEDURE ENTRY MARK(VAR TOP: STREAM.INITWRITE ELSE IOSTREAM.INITREAD; CALL('IO ', PARAM, LINE, RESULT); OPERATOR.WRITE('IOPROCESS: (:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "################ # CARDPROCESS # ################" TYPE CARDPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; TEXT: LINE; PARAM: IOPARAM; OK: BOOLEAN; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= INPUT; CYCLE REPEAT IO(TEXT, PARAM, CARDDEVICE);INTEGER); BEGIN TOP:= ATTRIBUTE(HEAPTOP) END; PROCEDURE ENTRY RELEASE(TOP: INTEGER); BEGIN SETHEAP(TOP) END; PROCEDURE ENTRY IDENTIFY(HEADER: LINE); BEGIN OPSTREAM.RESET(HEADER) END; PROCEDURE ENTRY ACCEPT(VAR C: CHAR); BEGIN OPSTREAM.READ(C) END; PROCEDURE ENTRY DISPLAY(C: CHAR); BEGIN OPSTREAM.WRITE(C) END; PROCEDURE ENTRY READPAGE(VAR BLOCK: PAGE; VAR EOF: BOOLEAN); BEGIN INBUFFER.READ(BLOCK, EOF) END; PROCEDURE ENTRY WRITEPAGE(BLOCK: PAGE; EOF: BOOLEAN); BEGIN OUTBUFFER.WRITE(BLOCK, EOF) END; PRO CASE PARAM.STATUS OF COMPLETE: OK:= TRUE; INTERVENTION, FAILURE: BEGIN OK:= FALSE; WAIT END; TRANSMISSION: BEGIN OPERATOR.WRITE('CARDS: (:10:)', 'ERROR(:10:)'); OK:= FALSE; END END; UNTIL OK; BUFFER.WRITE(TEXT); END; END; "################### # PRINTERPROCESS # ###################" TYPE PRINTERPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; PARAM: IOPCEDURE ENTRY READLINE(VAR TEXT: LINE); BEGIN END; PROCEDURE ENTRY WRITELINE(TEXT: LINE); BEGIN END; PROCEDURE ENTRY READARG(S: ARGSEQ; VAR ARG: ARGTYPE); BEGIN IF S = INP THEN INRESPONSE.READ(ARG) ELSE OUTRESPONSE.READ(ARG); END; PROCEDURE ENTRY WRITEARG(S: ARGSEQ; ARG: ARGTYPE); BEGIN IF S = INP THEN INREQUEST.WRITE(ARG) ELSE OUTREQUEST.WRITE(ARG); END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND) ENARAM; TEXT: LINE; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= OUTPUT; CYCLE BUFFER.READ(TEXT); IO(TEXT, PARAM, PRINTDEVICE); IF PARAM.STATUS <> COMPLETE THEN BEGIN OPERATOR.WRITE('PRINTER: (:10:)', 'INSPECT(:10:)'); REPEAT WAIT; IO(TEXT, PARAM, PRINTDEVICE); UNTIL PARAM.STATUS = COMPLETE; END; END; END; "################## # LOADERPROCESS # ##################" TYPE LOADERPROCESS= PROCESS(DISKUSE: RESOURCE); CONST SOLOADDR = 24; VARD; PROCEDURE ENTRY IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: PAGE); BEGIN IF DEVICE = DISKDEVICE THEN BEGIN DISKUSE.REQUEST; IO(BLOCK, PARAM, DEVICE); DISKUSE.RELEASE; END ELSE IO(BLOCK, PARAM, DEVICE); END; PROCEDURE ENTRY IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); BEGIN IO(PARAM, PARAM, DEVICE) END; FUNCTION ENTRY TASK: TASKKIND; BEGIN TASK:= JOBTASK END; PROCEDURE ENTRY RUN (ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: RESULTTYPE); BE PARAM: IOPARAM; PROCEDURE INITIALIZE(PAGENO: UNIV IOARG); BEGIN WITH PARAM DO BEGIN OPERATION:= CONTROL; ARG:= PAGENO; END; END; BEGIN INITIALIZE(SOLOADDR); "AWAIT BEL SIGNAL" IO(PARAM, PARAM, TYPEDEVICE); "LOAD SOLO SYSTEM" DISKUSE.REQUEST; IO(PARAM, PARAM, DISKDEVICE); DISKUSE.RELEASE; END; "#################### # INITIAL PROCESS # ####################" VAR TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER, OUTBUFFER: PAGEBUFFER; CARDBUFFER, P!#(*,.02468;=?+-/13579oZ\^`ikmX     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegRE PARTITION(VAR TABLE: TABLETYPE; LEFT, RIGHT: INTEGER; VAR MIDDLE: INTEGER); VAR ELEM, TEMP, I: INTEGER; BEGIN "INITIALIZE LEFT AND RIGHT PARTS" I:= LEFT; MIDDLE:= RIGHT; ELEM:= TABLE(.RIGHT.); WHILE "MORE ELEMENTS" I < MIDDLE DO IF TABLE(.I.) <= ELEM THEN "EXTEND LEFT PART" I:= I + 1 ELSE BEGIN "EXTEND RIGHT PART" MIDDLE:= MIDDLE - 1; IF TABLE(.MIDDLE.) < ELEM THEN BEGIN "EXCHANGE ELEMENTS" TEMP:= TABLE(.I.); TABLE(.I.):= TABLE(.M"############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################# # READ & WRITE # #################" VAR I: INTEGER; BEGIN WRITETEXT('(:10:)READ AND WRITE TEST(:10:)#'); READINT(I); WRITEINT(I,IDDLE.); TABLE(.MIDDLE.):= TEMP; END; END; "PLACE MIDDLE ELEMENT" TABLE(.MAX.):= TABLE(.MIDDLE.); TABLE(.MIDDLE.):= ELEM; END; PROCEDURE QUICKSORT(VAR TABLE: TABLETYPE; LEFT, RIGHT: INTEGER); VAR MIDDLE: INTEGER; BEGIN IF LEFT < RIGHT THEN BEGIN PARTITION(TABLE, LEFT, RIGHT, MIDDLE); QUICKSORT(TABLE, LEFT, MIDDLE - 1); QUICKSORT(TABLE, MIDDLE + 1, RIGHT); END; END; BEGIN "INPUT TABLE" WRITE(NL); WRITETEXT('BEFORE #'); WRITE(NL); FOR I:= 1 TO 6); WRITE(NL); READINT(I); WRITEINT(I, 6); WRITE(NL); READINT(I); WRITEINT(I, 6); WRITE(NL); READINT(I); WRITEINT(I, 6); WRITE(NL); READINT(I); WRITEINT(I, 6); WRITE(NL); END. 0 32767 -32767 -32768 32769 (C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################# # READ & WRITE # #################" VAR I: INTEGER; BEGIN WRITETEXT('(:10:)READ AND WRITE TEST(:10:)#'); READINT(I); WRITEINT(I,MAX DO BEGIN READINT(TABLE(.I.)); WRITEINT(TABLE(.I.), 3); END; WRITE(NL); QUICKSORT(TABLE, 1, MAX); "OUTPUT TABLE" WRITE(NL); WRITETEXT('AFTER#'); WRITE(NL); FOR I:= 1 TO MAX DO WRITEINT(TABLE(.I.), 3); WRITE(NL); END. 8 3 9 4 7 2 1 6 5  < RIGHT THEN BEGIN PARTITION(TABLE, LEFT, RIGHT, MIDDLE); QUICKSORT(TABLE, LEFT, MIDDLE - 1); QUICKSORT(TABLE, MIDDLE + 1, RIGHT); END; END; BEGIN "INPUT TABLE" WRITE(NL); WRITETEXT('BEFORE #'); WRITE(NL); FOR I:= 1 TO "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################## # WRITE FOREVER # ##################" VAR C: CHAR; I: INTEGER; BEGIN REPEAT FOR C:= 'A' TO 'Z' DO FOR I:= 1 TO 86 DO WRI TE(C); UNTIL FALSE; END. SOME GARBAGE TO BE SKIPPED I HOPE :10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "################## # WRITE FOREVER # ##################" VAR C: CHAR; I: INTEGER; BEGIN REPEAT FOR C:= 'A' TO 'Z' DO FOR I:= 1 TO 86 DO WRI "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "#################### # QUEEN POSITIONS # ####################" VAR QUEEN_ROW, QUEEN_COLUMN, ROW, COLUMN: 1..8; BEGIN FOR QUEEN_ROW:= 1 TO 8 DO FOR QUEEN_COLUMN:= 1 TO 8 DO BEGIN FOR ROW:= 1 TO 8 DO BEGIN FOR COLUMN:= 1 TO 8 DO BEGIN IF (ROW = QUEEN_ROW) & (COLUMN = QUEEN_COLUMN) THEN WRITE('Q') ELSE IF (ROW = QUEEN_ROW) OR (COLUMN = QUEEN_COLUMN) OR (ABS(ROW - QUEEN_ROW) = ABS(COLUMN - QUEEN_COLUMN)) THEN WRITE('*') ELSE WRITE('.'); WRITE(' '); END; WRITE(NL); END; WRITE(NL); END; END. TO 8 DO "############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "##################### # FIBONACCI SEARCH # #####################" CONST MAX = 9; TYPE TABLETYPE = ARRAY (.1..MAX.) OF INTEGER; VAR TABLE: TABLETYPE; ARG, INDEX: INTEGER; FOUND: BOOLEAN; PROCEDURE FIBSEARCH(TABLE: TABLETYPE; ARG: INTEGER; VAR INDEX: INTEGER; VAR FOUND: BOOLEAN); VAR E, F: INTEGER; BEGIN "SELECT INITIAL PORTION" E:= 1; F:= 1; WHILE E + F <= MAX DO BEGIN F:= F + E; E:= F - E END; "F IS THE LARGEST FIB NUMBER <= MAX AND E IS THE PREDECESSOR OF F" IF TABLE(.F.) >= ARG THEN INDEX:= 1 ELSE INDEX:= MAX - F + 1; "INDEX IS THE STARTING POINT OF THE INTERVAL F" WHILE "MORE THAN ONE ELEMENT" F > 1 DO IF "SOLUTIO N IMPOSSIBLE IN LEFT PART" TABLE(.INDEX + E - 1.) < ARG THEN BEGIN "SELECT RIGHT PART" INDEX:= INDEX + E; F:= F - E; E:= E - F; END ELSE BEGIN "SELECT LEFT PART" E:= F - E; F:= F - E; END; "EXAMINE CHOSEN PART" FOUND:= (TABLE(.INDEX.) = ARG); END; BEGIN "INITIALIZE TABLE" WRITETEXT('(:10:)TABLE(:10:)#'); FOR INDEX:= 1 TO MAX DO BEGIN READINT(TABLE(.INDEX.)); WRITEINT(TABLE(.INDEX.), 3); END; "TEST CASES" REPEAT "0" "NLWORD" WRITE_BOOL(2>=1); "1" WRITE_BOOL(2>=2); "1" WRITE_BOOL(2>=3); "0" "NEWORD" WRITE_BOOL(2<>1); "1" WRITE_BOOL(2<>2); "0" WRITE_BOOL(2<>3); "1" "NGWORD" WRITE_BOOL(2<=1); "0" W READINT(ARG); WRITE(NL); WRITEINT(ARG, 3); FIBSEARCH(TABLE, ARG, INDEX, FOUND); IF FOUND THEN BEGIN WRITETEXT(' FOUND AT#'); WRITEINT(INDEX, 3); END ELSE WRITETEXT(' NOT FOUND #'); WRITE(NL); UNTIL ARG = 0; END. "TABLE" 2 4 6 8 10 12 14 16 18 "ARG" 1 2 18 19 10 9 0  BEGIN "INITIALIZE TABLE" WRITETEXT('(:10:)TABLE(:10:)#'); FOR INDEX:= 1 TO MAX DO BEGIN READINT(TABLE(.INDEX.)); WRITEINT(TABLE(.INDEX.), 3); END; "TEST CASES" REPEAT R; C: CHAR; BEGIN WRITECHAR(BEL); PARAM.OPERATION:= INPUT; I:= 0; REPEAT IO(C, PARAM, DEVICE); IF C = CANCELLINE THEN BEGIN WRITECHAR(NL); WRITECHAR('?'); I:= 0; END ELSE IF C = CANCELCHAR THEN BEGIN IF I > 0 THEN BEGIN WRITECHAR('?'); I:= I - 1; END END ELSE BEGIN I:= I + 1; TEXT(.I.):= C END; UNTIL (C = NL) OR (I = LINELIMIT); IF C <> NL THEN BEGIN WRITECHAR(NL); TEXT(.LINELIMIT + 1.):= NL; END; END"############## # JOBPREFIX # ##############" CONST NL = '(:10:)'; FF = '(:12:)'; EM = '(:25:)'; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE READINT(VAR VALUE: INTEGER); PROCEDURE WRITEINT(VALUE, LENGTH: INTEGER); PROCEDURE WRITETEXT(TEXT: LINE); PROGRAM JOB; "############## # QUICKSORT # ##############" CONST MAX = 9; TYPE TABLETYPE = ARRAY (.1..MAX.) OF INTEGER; VAR TABLE: TABLETYPE; I: INTEGER; PROCEDU * CATPAGELENGTH; PAGENO:= 0; END; "################ # DISKCATALOG # ################" TYPE DISKCATALOG = MONITOR(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATADDR: INTEGER); VAR TABLE: DISKTABLE; FUNCTION HASH(ID: IDENTIFIER): INTEGER; VAR KEY, I: INTEGER; C: CHAR; BEGIN KEY:= 1; I:= 0; REPEAT I:= I + 1; C:= ID(.I.); IF C <> ' ' THEN KEY:= KEY * ORD(C) MOD TABLE.LENGTH + 1; UNTIL (C = ' ') OR (I = IDLENGTH); HASH:= KEY; END; PROCEDURE ENTRY LOOKUP (ID: IDENTIFIER; V ; BEGIN END; "############# # TERMINAL # #############" TYPE TERMINAL = CLASS(ACCESS: TYPERESOURCE); VAR UNIT: TYPEWRITER; PROCEDURE ENTRY READ(HEADER: LINE; VAR TEXT: LINE); VAR CHANGED: BOOLEAN; BEGIN ACCESS.REQUEST(HEADER, CHANGED); IF CHANGED THEN UNIT.WRITE(HEADER); UNIT.READ(TEXT); ACCESS.RELEASE; END; PROCEDURE ENTRY WRITE(HEADER, TEXT: LINE); VAR CHANGED: BOOLEAN; BEGIN ACCESS.REQUEST(HEADER, CHANGED); IF CHANGED THEN UNIT.WRITE(HEADER); UNIT.WRITE(TEXT); ACCESS.RELEASE; EN r  ( "r  ( ""{  ,  r ^  L$r "* ^|  GF (: 4* @ L X d p | p  t TEMP1 TEMP2 SPASS1 SPASS2 SPASS3 SPASS4 SPASS5 SPASS6 SPASS7 JOB TERMINATED #OVERFLOW #POINTER ERROR#RANGE ERROR#VARIANT ERROR#HEAP LIMIT #STACK LIMIT#CODE LIMIT #TIME LIMIT #SYSTEM ERROR #: LINE # ^|  GF (: 4* @ L X d p | p  t D; BEGIN INIT UNIT(TYPEDEVICE) END; "######### # DISK # #########" TYPE DISK = CLASS(TYPEUSE: TYPERESOURCE); VAR OPERATOR: TERMINAL; PROCEDURE TRANSFER(COMMAND: IOOPERATION; PAGEADDR: UNIV IOARG; VAR BLOCK: PAGE); VAR PARAM: IOPARAM; RESPONSE: LINE; BEGIN WITH PARAM, OPERATOR DO BEGIN OPERATION:= COMMAND; ARG:= PAGEADDR; IO(BLOCK, PARAM, DISKDEVICE); WHILE STATUS <> COMPLETE DO BEGIN WRITE('DISK:(:10:)', 'ERROR(:10:)'); READ('PUSH RETURN(:10:)', RESPONSE); IO(BLOCK, PARAM, DISKDEVICE); END; END; END; PROCEDURE ENTRY READ(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN TRANSFER(INPUT, PAGEADDR, BLOCK) END; PROCEDURE ENTRY WRITE(PAGEADDR: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN TRANSFER(OUTPUT, PAGEADDR, BLOCK) END; BEGIN INIT OPERATOR(TYPEUSE) END; "######################### # FILEMAP AND DISKFILE # #########################" CONST MAPLENGTH = 255; TYPE FILEMAP = RECORD FILELENGTH: INTEGER; PAGESET: ARRAY (.1..M APLENGTH.) OF INTEGER END; TYPE DISKFILE = CLASS(TYPEUSE: TYPERESOURCE); VAR UNIT: DISK; MAP: FILEMAP; OPENED: BOOLEAN; ENTRY LENGTH: INTEGER; FUNCTION INCLUDES(PAGENO: INTEGER): BOOLEAN; BEGIN INCLUDES:= OPENED & (1 <= PAGENO) & (PAGENO <= LENGTH); END; PROCEDURE ENTRY OPEN(MAPADDR: INTEGER); BEGIN UNIT.READ(MAPADDR, MAP); LENGTH:= MAP.FILELENGTH; OPENED:= TRUE; END; PROCEDURE ENTRY CLOSE; BEGIN LENGTH:= 0; OPENED:= FALSE; END; PROCEDURE ENTRY READ(PAGENO: INTEGER; VA R BLOCK: UNIV PAGE); BEGIN IF INCLUDES(PAGENO) THEN UNIT.READ(MAP.PAGESET(.PAGENO.), BLOCK); END; PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF INCLUDES(PAGENO) THEN UNIT.WRITE(MAP.PAGESET(.PAGENO.), BLOCK); END; BEGIN INIT UNIT(TYPEUSE); LENGTH:= 0; OPENED:= FALSE; END; "###################### # CATALOG STRUCTURE # ######################" CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILEKIND = (EMPTY, SCRATCH, ASCII, SEQCODAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); VAR KEY, MORE, INDEX: INTEGER; ELEM: CATENTRY; BEGIN DISKUSE.REQUEST; KEY:= HASH(ID); TABLE.READ(KEY, ELEM); MORE:= ELEM.SEARCHLENGTH; INDEX:= KEY; FOUND:= FALSE; WHILE NOT FOUND & (MORE > 0) DO BEGIN TABLE.READ(INDEX, ELEM); IF ELEM.ID = ID THEN BEGIN ATTR:= ELEM.ATTR; FOUND:= TRUE END ELSE BEGIN IF ELEM.KEY = KEY THEN MORE:= MORE - 1; INDEX:= INDEX MOD TABLE.LENGTH + 1; END; END; DISKUSE.RELEASE; END; BEGIN INI E, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE CATENTRY = RECORD ID: IDENTIFIER; ATTR: FILEATTR; KEY, SEARCHLENGTH: INTEGER END; CONST CATPAGELENGTH = 16; TYPE CATPAGE = ARRAY (.1..CATPAGELENGTH.) OF CATENTRY; CONST CATADDR = 154; "############## # DISKTABLE # ##############" TYPE DISKTABLE = CLASS(TYPEUSE: TYPERESOURCE; CATADDR: INTEGER); VAR FILE: DISKFILE; PAGENO: INTEGER; BLOCK: CATPAGE; ENTRY LENGTH: INTEGER; PROCEDURE ENTRY READ(I: INTEGER; VAR ELEM: CATENTRY); VAR INDEX: INTEGER; BEGIN INDEX:= (I - 1) DIV CATPAGELENGTH + 1; IF PAGENO <> INDEX THEN BEGIN PAGENO:= INDEX; FILE.READ(PAGENO, BLOCK); END; ELEM:= BLOCK(.(I - 1) MOD CATPAGELENGTH + 1.); END; BEGIN INIT FILE(TYPEUSE); FILE.OPEN(CATADDR); LENGTH:= FILE.LENGTH #########" TYPE CLOCKPROCESS = PROCESS(TIMER: PROGTIMER); BEGIN CYCLE WAIT; TIMER.TICK; END; END; "############### # FILE NAMES # ###############" CONST JOBPREFIX = 'JOBPREFIX '; JOBINPUT = 'JOBINPUT '; JOBOUTPUT = 'JOBOUTPUT '; JOBSERVICE = 'JOBSERVICE '; JOBBUFFER1 = 'JOBBUFFER1 '; JOBBUFFER2 = 'JOBBUFFER2 '; JOB = 'JOB '; TEMP1 = 'TEMP1 '; TEMP2 = 'TEMP2 '; "############### # LINEBUFFER # ###############" TYPE LINEBUFFER = MDATAFILE # #############" TYPE DATAFILE = CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; OPENED: BOOLEAN; ENTRY LENGTH: INTEGER; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR FOUND: BOOLEAN); VAR ATTR: FILEATTR; BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND); IF FOUND THEN BEGIN DISKUSE.REQUEST; FILE.OPEN(ATTR.ADDR); LENGTH:= FILE.LENGTH; DISKUSE.RELEASE; END; OPENED:= FOUND; END; PROCEDURE ENTRY CLOSE; BEGIN FILE.CLOSE; LENGTH:= 0; ONITOR CONST MAXLINE = 20; TYPE LINES = ARRAY (.1..MAXLINE.) OF LINE; VAR BUFFER: LINES; NEXT: FIFO; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: LINE); BEGIN WITH NEXT DO BEGIN IF EMPTY THEN DELAY(RECEIVER); TEXT:= BUFFER(.DEPARTURE.); CONTINUE(SENDER); END; END; PROCEDURE ENTRY WRITE(TEXT: LINE); BEGIN WITH NEXT DO BEGIN IF FULL THEN DELAY(SENDER); BUFFER(.ARRIVAL.):= TEXT; CONTINUE(RECEIVER); END; END; BEGIN INIT NEXT(MAXLINE) END; "##############OPENED:= FALSE; END; PROCEDURE ENTRY READ(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF OPENED THEN BEGIN DISKUSE.REQUEST; FILE.READ(PAGENO, BLOCK); DISKUSE.RELEASE; END; END; PROCEDURE ENTRY WRITE(PAGENO: INTEGER; VAR BLOCK: UNIV PAGE); BEGIN IF OPENED THEN BEGIN DISKUSE.REQUEST; FILE.WRITE(PAGENO, BLOCK); DISKUSE.RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); LENGTH:= 0; OPENED:= FALSE; END; "############### # PAGEBUFFER # ###############" TYPE PAGEBUFFE## # CARDPROCESS # ################" TYPE CARDPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; TEXT: LINE; PARAM: IOPARAM; OK: BOOLEAN; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= INPUT; CYCLE REPEAT IO(TEXT, PARAM, CARDDEVICE); CASE PARAM.STATUS OF COMPLETE: OK:= TRUE; INTERVENTION, FAILURE: BEGIN OK:= FALSE; WAIT END; TRANSMISSION: BEGIN OPERATOR.WRITE('CARDS: (:10:)R = MONITOR (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR OPENED: BOOLEAN; BUFFER: DATAFILE; NEXT: FIFO; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR BLOCK: PAGE); BEGIN WITH BUFFER, NEXT DO IF OPENED THEN BEGIN IF EMPTY THEN DELAY(RECEIVER); READ(DEPARTURE, BLOCK); CONTINUE(SENDER); END; END; PROCEDURE ENTRY WRITE(VAR BLOCK: PAGE); BEGIN WITH BUFFER, NEXT DO IF OPENED THEN BEGIN IF FULL THEN DELAY(SENDER); WRITE(ARRIVAL, BLOCK);', 'ERROR(:10:)'); OK:= FALSE; END END; UNTIL OK; BUFFER.WRITE(TEXT); END; END; "################# # INPUTPROCESS # #################" TYPE INPUTPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER: LINEBUFFER; OUTBUFFER: PAGEBUFFER); "PROGRAM DATA SPACE = " +1000 VAR OPERATOR: TERMINAL; PREFIX: DATAFILE; CODE: PROGFILE2; PROGRAM DRIVER(STORE: PROGSTORE2); ENTRY PREFIXLENGTH, READPREFIX, READLINE, WRITESTREAM; CONTINUE(RECEIVER); END; END; PROCEDURE ENTRY OPEN(ID: IDENTIFIER); BEGIN WITH BUFFER DO IF NOT OPENED THEN BEGIN OPEN(ID, OPENED); INIT NEXT(LENGTH); END; END; BEGIN INIT BUFFER(TYPEUSE, DISKUSE, CATALOG); OPENED:= FALSE; END; "################ # INPUTSTREAM # ################" TYPE INPUTSTREAM = CLASS(BUFFER: PAGEBUFFER); VAR TEXT: PAGE; COUNT: INTEGER; MORE: BOOLEAN; PROCEDURE ENTRY READ(VAR C: CHAR); BEGIN IF MORE THEN BEGIN IF COUNT = PAGELENGTH THEN FUNCTION ENTRY PREFIXLENGTH: INTEGER; BEGIN PREFIXLENGTH:= PREFIX.LENGTH END; PROCEDURE ENTRY READPREFIX (PAGENO: INTEGER; VAR BLOCK: PAGE); BEGIN PREFIX.READ(PAGENO, BLOCK) END; PROCEDURE ENTRY READLINE(VAR TEXT: LINE); BEGIN INBUFFER.READ(TEXT) END; PROCEDURE ENTRY WRITESTREAM(VAR BLOCK: PAGE); BEGIN OUTBUFFER.WRITE(BLOCK) END; PROCEDURE INITIALIZE; VAR FOUND: BOOLEAN; STATE: PROGSTATE; BEGIN INIT OPERATOR(TYPEUSE), PREFIX(TYPEUSE, DISKUSE, CATALOG), CODE(TYPEUSE, DISKUSE, CATALOG); PREFIX BEGIN BUFFER.READ(TEXT); COUNT:= 0; END; COUNT:= SUCC(COUNT); C:= TEXT(.COUNT.); MORE:= (C <> EM); END ELSE C:= EM; END; PROCEDURE ENTRY NEXT; BEGIN MORE:= TRUE; BUFFER.READ(TEXT); COUNT:= 0; END; BEGIN MORE:= FALSE END; "################# # OUTPUTSTREAM # #################" TYPE OUTPUTSTREAM = CLASS(BUFFER: PAGEBUFFER); VAR TEXT: PAGE; COUNT: INTEGER; MORE: BOOLEAN; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN IF MORE THEN BEGIN COUNT:= SUCC(COUNT); .OPEN(JOBPREFIX, FOUND); CODE.OPEN(JOBINPUT, STATE); IF STATE = READY THEN DRIVER(CODE.STORE); OPERATOR.WRITE('JOB INPUT: (:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "############### # JOBPROCESS # ###############" TYPE JOBPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER, OUTBUFFER: PAGEBUFFER; TIMER: PROGTIMER); "PROGRAM DATA SPACE = " +16000 CONST MAXFILE = 2; TYPE FILE = 1..MAXFILE; VAR INSTREAM: INPUTS TEXT(.COUNT.):= C; IF (COUNT = PAGELENGTH) OR (C = EM) THEN BEGIN BUFFER.WRITE(TEXT); COUNT:= 0; MORE:= (C <> EM); END; END; END; PROCEDURE ENTRY NEXT; BEGIN MORE:= TRUE; COUNT:= 0; END; BEGIN MORE:= FALSE END; "################## # PROGRAM TYPES # ##################" TYPE ATTRINDEX = (CALLER, HEAPTOP, PROGLINE, PROGRESULT); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD TAG: ARGTAG; ATREAM; OUTSTREAM: OUTPUTSTREAM; FILES: ARRAY (.FILE.) OF DATAFILE; CODE: PROGFILE1; DIGITS, SIGN, NUMERIC: SET OF CHAR; MININTEGER: INTEGER; PROGRAM PASCAL(STORE: PROGSTORE1); ENTRY READ, WRITE, WRITEINT, WRITETEXT, OPEN, CLOSE, GET, PUT, LENGTH, RUNPASS, RUNJOB; PROGRAM PASS(VAR PARAM: ARGLIST; STORE: PROGSTORE1); ENTRY READ, WRITE, OPEN, CLOSE, GET, PUT, LENGTH, MARK, RELEASE; PROGRAM USER(STORE: PROGSTORE1); ENTRY READ, WRITE, READINT, WRITEINT, WRITETEXT; PROCEDURE ENTRY READ(VAR C: CHAR); RG: IDENTIFIER END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE RESULTTYPE = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); "########################### # PROGSTORE AND PROGFILE # ###########################" TYPE PROGSTATE = (READY, NOTFOUND, NOTSEQ, TOOBIG); CONST STORELENGTH1 = 40; TYPE PROGSTORE1 = ARRAY (.1..STORELENGTH1.) OF PAGE; TYPE PROGFILE1 = CLASS(TYPEUSE: TYPERESOBEGIN INSTREAM.READ(C) END; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN OUTSTREAM.WRITE(C) END; PROCEDURE ENTRY READINT(VAR VALUE: INTEGER); VAR POSITIVE, OVERFLOW: BOOLEAN; C: CHAR; DIGIT: INTEGER; BEGIN WITH INSTREAM DO BEGIN REPEAT READ(C) UNTIL C IN NUMERIC; IF C IN SIGN THEN BEGIN POSITIVE:= (C = '+'); READ(C); END ELSE POSITIVE:= TRUE; OVERFLOW:= FALSE; VALUE:= 0; WHILE NOT OVERFLOW & (C IN DIGITS) DO BEGIN DIGIT:= ORD(C) - ORD('0'); IF VALURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; ENTRY STORE: PROGSTORE1; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE); VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER; BEGIN CATALOG.LOOKUP(ID, ATTR, FOUND); WITH DISKUSE, FILE, ATTR DO IF NOT FOUND THEN STATE:= NOTFOUND ELSE IF KIND <> SEQCODE THEN STATE:= NOTSEQ ELSE BEGIN REQUEST; OPEN(ADDR); IF LENGTH <= STORELENGTH1 THEN BEGIN FOR PAGENO:= 1 TO LENGTH DO READ(PUE < (MININTEGER + DIGIT) DIV 10 THEN OVERFLOW:= TRUE ELSE VALUE:= 10*VALUE - DIGIT; READ(C); END; WHILE C IN DIGITS DO READ(C); IF POSITIVE THEN IF VALUE = MININTEGER THEN OVERFLOW:= TRUE ELSE VALUE:= - VALUE; END; IF OVERFLOW THEN STOP(ATTRIBUTE(CALLER), RANGEERROR); END; PROCEDURE ENTRY WRITEINT(VALUE, LENGTH: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGITS, REMAINDER, I: INTEGER; BEGIN WITH OUTSTREAM DO BEGIN REMAINDER:= VAGENO, STORE(.PAGENO.)); STATE:= READY; END ELSE STATE:= TOOBIG; CLOSE; RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); END; CONST STORELENGTH2 = 4; TYPE PROGSTORE2 = ARRAY (.1..STORELENGTH2.) OF PAGE; TYPE PROGFILE2 = CLASS(TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG); VAR FILE: DISKFILE; ENTRY STORE: PROGSTORE2; PROCEDURE ENTRY OPEN(ID: IDENTIFIER; VAR STATE: PROGSTATE); VAR ATTR: FILEATTR; FOUND: BOOLEAN; PAGENO: INTEGER; BEGIN CATALOG.LOOKUP(ALUE; DIGITS:= 0; REPEAT DIGITS:= DIGITS + 1; NUMBER(.DIGITS.):= CHR(ABS(REMAINDER MOD 10) + ORD('0')); REMAINDER:= REMAINDER DIV 10; UNTIL REMAINDER = 0; FOR I:= 1 TO LENGTH - DIGITS - 1 DO WRITE(' '); IF VALUE < 0 THEN WRITE('-') ELSE WRITE(' '); FOR I:= DIGITS DOWNTO 1 DO WRITE(NUMBER(.I.)); END; END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR CHARNO: INTEGER; C: CHAR; BEGIN WITH OUTSTREAM DO BEGIN CHARNO:= 1; C:= TEXT(ID, ATTR, FOUND); WITH DISKUSE, FILE, ATTR DO IF NOT FOUND THEN STATE:= NOTFOUND ELSE IF KIND <> SEQCODE THEN STATE:= NOTSEQ ELSE BEGIN REQUEST; OPEN(ADDR); IF LENGTH <= STORELENGTH2 THEN BEGIN FOR PAGENO:= 1 TO LENGTH DO READ(PAGENO, STORE(.PAGENO.)); STATE:= READY; END ELSE STATE:= TOOBIG; CLOSE; RELEASE; END; END; BEGIN INIT FILE(TYPEUSE); END; "############## # PROGTIMER # ##############" TYPE PROGTIMER = MONITOR VAR WHO, .1.); WHILE (C <> '#') & (CHARNO < LINELENGTH) DO BEGIN WRITE(C); CHARNO:= CHARNO + 1; C:= TEXT(.CHARNO.); END; END; END; PROCEDURE ENTRY OPEN(FILENO: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); BEGIN FILES(.FILENO.).OPEN(ID, FOUND) END; PROCEDURE ENTRY CLOSE(FILENO: FILE); BEGIN FILES(.FILENO.).CLOSE END; PROCEDURE ENTRY GET(FILENO: FILE; PAGENO: INTEGER; VAR BLOCK: PAGE); BEGIN FILES(.FILENO.).READ(PAGENO, BLOCK) END; PROCEDURE ENTRY PUT(FILENO: FILE; PAGENO: INTEGER; VATIMELEFT: INTEGER; RUNNING: BOOLEAN; PROCEDURE ENTRY LIMIT(MAXTIME: INTEGER); BEGIN WHO:= ATTRIBUTE(CALLER); TIMELEFT:= MAXTIME; END; PROCEDURE ENTRY TICK; BEGIN TIMELEFT:= TIMELEFT - 1; IF (TIMELEFT <= 0) & RUNNING THEN BEGIN STOP(WHO, TIMELIMIT); RUNNING:= FALSE; END; END; PROCEDURE ENTRY ENTERPROG; BEGIN RUNNING:= TRUE END; PROCEDURE ENTRY ENDPROG; BEGIN RUNNING:= FALSE; START; END; BEGIN TIMELEFT:= 0; RUNNING:= FALSE; END; "################# # CLOCKPROCESS # ########R BLOCK: PAGE); BEGIN FILES(.FILENO.).WRITE(PAGENO, BLOCK) END; FUNCTION ENTRY LENGTH(FILENO: FILE): INTEGER; BEGIN LENGTH:= FILES(.FILENO.).LENGTH END; PROCEDURE ENTRY MARK(VAR TOP: INTEGER); BEGIN TOP:= ATTRIBUTE(HEAPTOP) END; PROCEDURE ENTRY RELEASE(TOP: INTEGER); BEGIN SETHEAP(TOP) END; PROCEDURE ENTRY RUNPASS (ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE, RESULT: UNIV INTEGER); CONST TERMINATED = 0; VAR STATE: PROGSTATE; HEAPADDR: INTEGER; BEGIN WITH CODE, TIMER DO BEGIN OPEN(ID, STATE); T TABLE(TYPEUSE, CATADDR) END; "################## # LOADERPROCESS # ##################" TYPE LOADERPROCESS= PROCESS(DISKUSE: RESOURCE); CONST SOLOADDR = 24; VAR PARAM: IOPARAM; PROCEDURE INITIALIZE(PAGENO: UNIV IOARG); BEGIN WITH PARAM DO BEGIN OPERATION:= CONTROL; ARG:= PAGENO; END; END; BEGIN INITIALIZE(SOLOADDR); "AWAIT BEL SIGNAL" IO(PARAM, PARAM, TYPEDEVICE); "LOAD SOLO SYSTEM" DISKUSE.REQUEST; IO(PARAM, PARAM, DISKDEVICE); DISKUSE.RELEASE; END; "############# # "0" "GRREAL" WRITE_BOOL(2.0>1.0); "1" WRITE_BOOL(2.0>2.0); "0" WRITE_BOOL(2.0>3.0); "0" "NLREAL" WRITE_BOOL(2.0>=1.0); "1" WRITE_BOOL(2.0>=2.0); "1" WRITE_BOOL(2.0>=3.0); "0" "NEREAL" WRITE_BOOL(2.0<>1.0); "1" WRITE_BOOL(2.0<>2.0); ([]_acfhjlndqsuwy{}prtvxz|~     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoOG, OUTBUFFER, PRINTERBUFFER), WRITER(TYPEUSE, PRINTERBUFFER); END ELSE OPERATOR.WRITE('JOB STREAM:(:10:)', 'FILES MISSING(:10:)'); END. J2" "  ENTERPROG; HEAPADDR:= ATTRIBUTE(HEAPTOP); PASS(PARAM, STORE); LINE:= ATTRIBUTE(PROGLINE); RESULT:= ATTRIBUTE(PROGRESULT); IF RESULT <> TERMINATED THEN SETHEAP(HEAPADDR); ENDPROG; OPEN(JOBSERVICE, STATE); END; END; PROCEDURE ENTRY RUNJOB (VAR LINE, RESULT: UNIV INTEGER); VAR STATE: PROGSTATE; HEAPADDR: INTEGER; BEGIN WITH CODE, TIMER DO BEGIN OPEN(JOB, STATE); ENTERPROG; HEAPADDR:= ATTRIBUTE(HEAPTOP); USER(STORE); LINE:= ATTRIBUTE(PROGLINE); F GH  B>"I  B>"J B"KL*PQ"Q `RS"S `<T  TU VfVW>" W ` WX*\]"] `$^ 0^_ " RESULT:= ATTRIBUTE(PROGRESULT); SETHEAP(HEAPADDR); ENDPROG; OPEN(JOBSERVICE, STATE); END; END; PROCEDURE NEXTJOB; CONST MAXTIME = 60 "SECONDS"; VAR STATE: PROGSTATE; HEAPADDR: INTEGER; C: CHAR; BEGIN WITH CODE, TIMER DO BEGIN INSTREAM.NEXT; OUTSTREAM.NEXT; LIMIT(MAXTIME); OPEN(JOBSERVICE, STATE); HEAPADDR:= ATTRIBUTE(HEAPTOP); PASCAL(STORE); SETHEAP(HEAPADDR); REPEAT INSTREAM.READ(C) UNTIL C = EM; WITH OUTSTREAM DO BEGIN WRITE(NL); WRITE(EM) EN_ \.` Z`a&effg 0B"h ` `2i jk*pq Z" B  qr  dZs Z" B jst vZ2wx  y0^_ "RITE_BOOL(2<=2); "1" WRITE_BOOL(2<=3); "1" "LSREAL" WRITE_BOOL(2.0<1.0); "0" WRITE_BOOL(2.0<2.0); "0" WRITE_BOOL(2.0<3.0); "1" "EQREAL" WRITE_BOOL(2.0=1.0); "0" WRITE_BOOL(2.0=2.0); "1" WRITE_BOOL(2.0=3.0); D; END; END; PROCEDURE INITIALIZE; VAR F: FILE; BEGIN INIT INSTREAM(INBUFFER), OUTSTREAM(OUTBUFFER); FOR F:= 1 TO MAXFILE DO INIT FILES(.F.)(TYPEUSE, DISKUSE, CATALOG); INIT CODE(TYPEUSE, DISKUSE, CATALOG); DIGITS:= (.'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'.); SIGN:= (.'+', '-'.); NUMERIC:= DIGITS OR SIGN OR (.EM.); MININTEGER:= -32767 - 1; END; BEGIN INITIALIZE; CYCLE NEXTJOB END; END; "################## # OUTPUTPROCESS # ##################" TYPE OUTPUTPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; DISKUSE: RESOURCE; CATALOG: DISKCATALOG; INBUFFER: PAGEBUFFER; OUTBUFFER: LINEBUFFER); "PROGRAM DATA SPACE = " +1000 VAR OPERATOR: TERMINAL; PREFIX: DATAFILE; CODE: PROGFILE2; PROGRAM DRIVER(STORE: PROGSTORE2); ENTRY PREFIXLENGTH, READPREFIX, READSTREAM, WRITELINE; FUNCTION ENTRY PREFIXLENGTH: INTEGER; BEGIN PREFIXLENGTH:= PREFIX.LENGTH END; PROCEDURE ENTRY READPREFIX (PAGENO: INTEGER; VAR BLOCK: PAGE); BEGIN PREFIX.READ(PAGENO, BLOCK) END; PROCEDURE ENTRY READSTREAM(VAR BLOCK: PAGE); BEGIN INBUFFER.READ(BLOCK) END; PROCEDURE ENTRY WRITELINE(TEXT: LINE); BEGIN OUTBUFFER.WRITE(TEXT) END; PROCEDURE INITIALIZE; VAR FOUND: BOOLEAN; STATE: PROGSTATE; BEGIN INIT OPERATOR(TYPEUSE), PREFIX(TYPEUSE, DISKUSE, CATALOG), CODE(TYPEUSE, DISKUSE, CATALOG); PREFIX.OPEN(JOBPREFIX, FOUND); CODE.OPEN(JOBOUTPUT, STATE); IF STATE = READY THEN DRIVER(CODE.STORE); OPERATOR.WRITE('JOB OUTPUT:(:10:)', 'TERMINATED (:10:)'); END; BEGIN INITIALIZE END; "################### # PRINTERPROCESS # ###################" TYPE PRINTERPROCESS = PROCESS (TYPEUSE: TYPERESOURCE; BUFFER: LINEBUFFER); VAR OPERATOR: TERMINAL; PARAM: IOPARAM; TEXT: LINE; BEGIN INIT OPERATOR(TYPEUSE); PARAM.OPERATION:= OUTPUT; CYCLE BUFFER.READ(TEXT); IO(TEXT, PARAM, PRINTDEVICE); IF PARAM.STATUS <> COMPLETE THEN BEGIN OPERATOR.WRITE('PRINTER: (:10:)', 'INSPECT(:10:)'); REPEAT WAIT; IO(TEXT, PARAM, PRINTDEVICE); UNTIL PARAM.STATUS = COMPLETE; END; END; END; "#################### # INITIAL PROCESS # ####################" VAR DISKUSE: RESOURCE; TYPEUSE: TYPERESOURCE; OPERATOR: TERMINAL; CATALOG: DISKCATALOG; WATCHDOG: LOADERPROCESS; INBUFFER, OUTBUFFER: PAGEBUFFER; TIMER: PROGTIMER; CLOCK: CLOCKPROCESS; CARDBUFFER, PRINTERBUFFER: LINEBUFFER; READER: CARDPROCESS; PRODUCER: INPUTPROCESS; MASTER: JOBPROCESS; CONSUMER: OUTPUTPROCESS; WRITER: PRINTERPROCESS; FUNCTION EXISTS(FILE: ID (.1..IDLENGTH.) OF CHAR; TYPE POINTER = @ INTEGER; OPTION = LISTOPTION..NUMBEROPTION; PASSLINK = RECORD OPTIONS: SET OF OPTION; LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER; TABLES: POINTER END; TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYENTIFIER; KIND: FILEKIND): BOOLEAN; VAR ATTR: FILEATTR; FOUND: BOOLEAN; BEGIN CATALOG.LOOKUP(FILE, ATTR, FOUND); EXISTS:= FOUND & (ATTR.KIND = KIND); END; BEGIN INIT DISKUSE, TYPEUSE, OPERATOR(TYPEUSE), CATALOG(TYPEUSE, DISKUSE, CATADDR), WATCHDOG(DISKUSE); IF EXISTS(JOBPREFIX, ASCII) & EXISTS(JOBINPUT, SEQCODE) & EXISTS(JOBSERVICE, SEQCODE) & EXISTS(JOBOUTPUT, SEQCODE) & EXISTS(JOB, SEQCODE) & EXISTS(JOBBUFFER1, SCRATCH) & EXISTS(JOBBUFFER2, SCRARAM: ARGLIST); "############################################# # PASS(VAR OK: BOOLEAN; VAR LINK: POINTER) # #############################################" CONST "OUTPUT OPERATORS" EOM2=0; BEGIN2=1; IF2=2; CASE2=3; WHILE2=4; REPEAT2=5; FOR2=6; WITH2=7; ID2=8; REAL2=9; STRING2=10; INTEGER2=11; CHAR2=12; OPEN2=13; NOT2=14; SUB2=15; SET2=16; ARRAY2=17; RECORD2=TCH) & EXISTS(TEMP1, SCRATCH) & EXISTS(TEMP2, SCRATCH) THEN BEGIN INIT INBUFFER(TYPEUSE, DISKUSE, CATALOG), OUTBUFFER(TYPEUSE, DISKUSE, CATALOG); INBUFFER.OPEN(JOBBUFFER1); OUTBUFFER.OPEN(JOBBUFFER2); INIT TIMER, CLOCK(TIMER), CARDBUFFER, PRINTERBUFFER, READER(TYPEUSE, CARDBUFFER), PRODUCER(TYPEUSE, DISKUSE, CATALOG, CARDBUFFER, INBUFFER), MASTER(TYPEUSE, DISKUSE, CATALOG, INBUFFER, OUTBUFFER, TIMER), CONSUMER(TYPEUSE, DISKUSE, CATAL2=48; END2=49; FORWARD2=50; UNIV2=51; BECOMES2=52; THEN2=53; ELSE2=54; DO2=55; UNTIL2=56; TO2=57; DOWNTO2=58; LCONST2=59; MESSAGE2=60; NEW_LINE2=61; "OTHER CONSTANTS" "ERRORS" COMMENT_ERROR=1; NUMBER_ERROR=2; INSERT_ERROR=3; STRING_ERROR=4; CHAR_ERROR=5; "STANDARD SPELLING/NOUN INDICES" XUNDEF=0; XFALSE=1; XTRUE=2; XINTEGER=3; XBOOLEAN=4; XCHAR=5; XNIL=6; XABS=7; XATTRIBUTE=8; XCHR=9; XCONV=10; XORD=11; XPRED=12; XSUCC=13; XTRUNC=14; XNEW=15; XREAL=16; ID_PIECE_LENGTH=9; "TEN CHARS PER PIECE" MAX_PIECES=7; "EIGHT PIECES => 80 CHARS" NULL=32767; "SYMBOL" SPAN=26; "NUMBER OF DISTINCT ID CHARS" THIS_PASS=1; HASH_MAX=700; "HASH TABLE UPPER BOUND" HASH_MAX1=701; "PRIME LENGTH OF HASH TABLE" MAX_INDEX=654; "MAX_LOADING=0.98 * HASH_MAX1-NO. OF RES.WDS." MIN_ORD=0; MAX_ORD=127; MAX_INTEGER=32767; INTEGER_LIMIT="(MAX_INTEGER-9) DIV 10" 3275; BYTE_SIZE=256; MAX_REAL=1E30; REAL_LIMIT=1E30; MAX_SIGNIFICANCE="10**(NUMBER OF SIGNIFICANT DIGITS+1)" 1E18; MAX_EXPONENT=38; TYPE ALFA=ARRAY (.1..10.) OF CHAR; SPELLING_INDEX=INTEGER; PIECE=ARRAY(.0..ID_PIECE_LENGTH.) OF CHAR; PIECE_PTR=@ID_PIECE; ID_PIECE= RECORD PART:PIECE; NEXT:PIECE_PTR END; VAR "*****" REAL10, REAL1: REAL; "*****" INTER_PASS_PTR:PASSPTR; CH:CHAR; LETTERS,DIGITS,ALFAMERICS,STANDARD_CHAR,ILLEGAL_CHAR: SET OF CHAR; LIST,TEST,NORMAL,UPTO_SW,BUS_SW,END_SCAN: BOOLEAN; CL1,CL2,CL3,CL4 "LINE NUMBER": CHAR; LINE_NO:INTEGER; LINE_BUF:ARRAY (.0..133.) OF CHAR; CI:-1..132; PIECES:-1..MAX_PIECES "ID LENGTH IN PIECES"; LENGTH: 0..80; "ID LENGTH IN CHARS" ID_TEXT: ARRAY(.0..MAX_PIECES.) OF PIECE; BLANK: PIECE "BLANK PADDING"; CHAR_INDEX:0..ID_PIECE_LENGTH "CURRENT CHAR INDEX"; SYMB: INTEGER "ID SYMBOL"; STRING_LENGTH:INTEGER; HASH_KEY: 0..HASH_MAX; "INDEX TO HASH_TABLE" CURRENT_INDEX "LAST ASSIGNED INDEX", INDEX "LAST SCANNED INDEX" : SPELLING_INDEX; STRING_TEXT: ARRAY (.1..80.) OF INTEGER; HASH_TABLE: ARRAY (.0..HASH_MAX.) OF RECORD SPIX:SPELLING_INDEX; NAME:ID_PIECE END; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE1: PAGE; INDEX1, COUNT1: INTEGER; PAGE2: PAGE; INDEX2, COUNT2: INTEGER; PROCEDURE INIT_PASS(VAR LINK: POINTER); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; INDEX1:= 1; COUNT1:= PAGELENGTH; INDEX2:= 1; COUNT2:= 0; END; PROCEDURE NEXT_PASS(LINK: POINTER); BEGIN IF COUNT2 > 0 THEN IF INDEX2 > LENGTH(2) THEN OK:= FALSE ELSE PUT(2, INDEX2, PAGE2); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END END; PROCEDURE READ_IFL(VAR I: INTEGER); BEGIN IF COUNT1 = PAGELENGTH THEN BEGIN IF INDEX1 > LENGTH(1) THEN OK:= FALSE ELSE BEGIN GET(1, INDEX1, PAGE1); INDEX1:= INDEX1 + 1 END; COUNT1:= 0; END; COUNT1:= COUNT1 + 1; I:= PAGE1(.COUNT1.); END; PROCEDURE WRITE_IFL(I: INTEGER); BEGIN COUNT2:= COUNT2 + 1; PAGE2(.COUNT2.):= I; IF COUNT2 = PAGELENGTH THEN BEGIN IF INDEX2 > LENGTH(2) THEN OK:= FALSE ELSE BEGIN PUT(2, INDEX2, PAGE2); INDEX2:= INDEX2 + 1 END; COUNT2:= 0; END; END; PROCEDURE PRINTABS(ARG: INTEGER); VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER; BEGIN REM:= ARG; DIGIT:= 0; REPEAT DIGIT:= DIGIT + 1; T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTFF; BEGIN WRITE(FF); PRINTED:= 0 END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:= 0 END; PROCEDURE PRINTOP(OP: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:= PRINTED + 1; END; PROCEDURE PRINTARG(ARG: INTEGER); BEGIN IF PRINTED = PRINTLIMIT THEN PRINTEOL; IF ARG < 0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:= PRINTED + 1; END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START BY CALLING PROCEDURE PRINTFF" PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF TEST THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF TEST THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE ERROR(ERROR_NUM:INTEGER); BEGIN PUT2(MESSAGE2,THIS_PASS,ERROR_NUM) END; PROCEDURE NEXT_CHAR; BEGIN IF NORMAL THEN BEGIN READ(CH); IF (ORD(CH)MAX_ORD) THEN CH:='?' ELSE IF CH IN ILLEGAL_CHAR THEN CH:='?'; WRITE(CH) END ELSE BEGIN IF TEST THEN BEGIN IF CH<>EOL THEN BEGIN CI:=CI+1; CH:=LINE_BUF(.CI.) END ELSE BEGIN CI:=-1; REPEAT CI:=CI+1; READ(CH); IF (ORD(CH)MAX_ORD) THEN CH:='?' ELSE IF CH IN ILLEGAL_CHAR THEN CH:='?'; WRITE(CH); LINE_BUF(.CI.):=CH UNTIL (CH=EOL) OR (CH=EOM); CI:=0; CH:=LINE_BUF(.0.) END END ELSE "NOT LIST" BEGIN READ(CH); IF (ORD(CH)MAX_ORD) THEN CH:='?' ELSE IF CH IN ILLEGAL_CHAR THEN CH:='?' END END END; PROCEDURE PUT0NC(OP:INTEGER); BEGIN WRITE_IFL(OP); IF TEST THEN PRINTOP(OP); NEXT_CHAR END; "##########" "INITIALIZE" "##########" PROCEDURE STD_ID(ID:PIECE; INDEX:SPELLING_INDEX); VAR S:SPELLING_INDEX; CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; "NOW WE HAVE ENTRY SLOT" WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID; NEXT:=NIL END END END; PROCEDURE LONG_STD_ID(ID1,ID2:PIECE; INDEX:SPELLING_INDEX); VAR CHAR_INDEX:INTEGER; BEGIN HASH_KEY:=1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO HASH_KEY:=HASH_KEY*(ORD(ID1(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1; FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO IF ID2(.CHAR_INDEX.)<>' ' THEN HASH_KEY:=HASH_KEY*(ORD(ID2(.CHAR_INDEX.)) MOD SPAN+1) MOD HASH_MAX1; WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1; WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SPIX:=INDEX; WITH NAME DO BEGIN PART:=ID1; NEW(NEXT); WITH NEXT@ DO BEGIN PART:=ID2; NEXT:=NIL END END END END; PROCEDURE STD_NAMES; BEGIN STD_ID('END ',-END2); STD_ID('IF ',-IF2); STD_ID('THEN ',-THEN2); STD_ID('BEGIN ',-BEGIN2); STD_ID('ELSE ',-ELSE2); STD_ID('DO ',-DO2); STD_ID('WITH ',-WITH2); STD_ID('IN ',-IN2); STD_ID('OF ',-OF2); STD_ID('WHILE ',-WHILE2); STD_ID('CASE ',-CASE2); STD_ID('REPEAT ',-REPEAT2); STD_ID('UNTIL ',-UNTIL2); STD_ID('PROCEDURE ',-PROCEDURE2); STD_ID('VAR ',-VAR2); STD_ID('FOR ',-FOR2); STD_ID('ARRAY ',-ARRAY2); STD_ID('RECORD ',-RECORD2); STD_ID('SET ',-SET2); STD_ID('TO ',-TO2); STD_ID('DOWNTO ',-DOWNTO2); STD_ID('MOD ',-MOD2); STD_ID('OR ',-OR2); STD_ID('AND ',-AND2); STD_ID('NOT ',-NOT2); STD_ID('DIV ',-DIV2); STD_ID('CONST ',-CONST2); STD_ID('TYPE ',-TYPE2); STD_ID('FUNCTION ',-FUNCTION2); STD_ID('FORWARD ',-FORWARD2); STD_ID('UNIV ',-UNIV2); STD_ID('PROGRAM ',-PROGRAM2); STD_ID('FALSE ',XFALSE); STD_ID('TRUE ',XTRUE); STD_ID('INTEGER ',XINTEGER); STD_ID('BOOLEAN ',XBOOLEAN); STD_ID('CHAR ',XCHAR); STD_ID('NIL ',XNIL); STD_ID('NEW ',XNEW); STD_ID('ABS ',XABS); STD_ID('ATTRIBUTE ',XATTRIBUTE); STD_ID('CHR ',XCHR); STD_ID('CONV ',XCONV); STD_ID('ORD ',XORD); STD_ID('PRED ',XPRED); STD_ID('SUCC ',XSUCC); STD_ID('TRUNC ',XTRUNC); STD_ID('REAL ',XREAL); END; PROCEDURE END_LINE; BEGIN LINE_NO:=LINE_NO+1; PUT1(NEW_LINE2,LINE_NO); IF LIST THEN BEGIN IF TEST THEN PRINTEOL; IF CL4<'9' THEN CL4:=CHR(ORD(CL4)+1) ELSE BEGIN CL4:='0'; IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEGIN CL3:='0'; IF CL2<'9' THEN CL2:=CHR(ORD(CL2)+1) ELSE BEGIN CL2:='0'; IF CL1<'9' THEN CL1:=CHR(ORD(CL1)+1) ELSE CL1:='0' END END END; WRITE(CL1); WRITE(CL2); WRITE(CL3); WRITE(CL4); WRITE(' ') END; NEXT_CHAR END; PROCEDURE GET_CHAR(SKIP_FIRST: BOOLEAN); BEGIN IF SKIP_FIRST THEN NEXT_CHAR; REPEAT IF CH='"' THEN BEGIN REPEAT REPEAT NEXT_CHAR UNTIL (CH=EOL) OR (CH='"'); WHILE CH = EOL DO END_LINE UNTIL (CH=EOM) OR (CH='"') IF CH='"' THEN NEXT_CHAR ELSE ERROR(COMMENT_ERROR) END; WHILE CH=' ' DO NEXT_CHAR; WHILE CH=EOL DO END_LINE UNTIL (CH<>' ') AND (CH<>'"') END; PROCEDURE INIT_OPTIONS; VAR STOP:SET OF CHAR; BEGIN PRINTFF; END_LINE; NEW(INTER_PASS_PTR); WITH INTER_PASS_PTR@ DO BEGIN OPTIONS:=(.LISTOPTION,CHECKOPTION,NUMBEROPTION.); MARK(RESETPOINT); TABLES:=NIL; GET_CHAR(FALSE); IF CH='(' THEN BEGIN STOP:=(.',' , ')' , EOM.); REPEAT GET_CHAR(TRUE); IF CH='L' THEN OPTIONS:=OPTIONS-(.LISTOPTION.) ELSE IF CH='S' THEN OPTIONS:=OPTIONS OR (.SUMMARYOPTION.) ELSE IF CH='T' THEN OPTIONS:=OPTIONS OR (.TESTOPTION.) ELSE IF CH='C' THEN OPTIONS:=OPTIONS-(.CHECKOPTION.) ELSE IF CH='N' THEN OPTIONS:=OPTIONS-(.NUMBEROPTION.); WHILE NOT(CH IN STOP) DO GET_CHAR(TRUE) UNTIL (CH=EOM) OR (CH=')'); IF CH=')' THEN NEXT_CHAR END; IF TESTOPTION IN OPTIONS THEN BEGIN TEST:=TRUE; CI:=0; LINE_BUF(.0.):=CH; WHILE (CH<>EOL) AND (CH<>EOM) DO BEGIN CI:=CI+1; NEXT_CHAR; LINE_BUF(.CI.):=CH END; CH:=LINE_BUF(.0.); CI:=0 END ELSE LIST:=LISTOPTION IN OPTIONS END END; PROCEDURE INITIALIZE; VAR S:SPELLING_INDEX; C:MIN_ORD..MAX_ORD; BEGIN "EMPTY SET" PUT1(LCONST2,SETLENGTH); FOR S:=1 TO SETLENGTH DIV WORDLENGTH DO PUT_ARG(0); "*****" REAL10:=CONV(10); REAL1:=CONV(1); "*****" END_SCAN:=FALSE; UPTO_SW:=FALSE; BUS_SW:=FALSE; LINE_NO:=0; CL1:='0'; CL2:='0'; CL3:='0'; CL4:='0'; TEST:=FALSE; LIST:=TRUE; NORMAL:=TRUE; DIGITS:=(.'0','1','2','3','4','5','6','7','8','9'.); LETTERS:=(.'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','_'.); ALFAMERICS:=LETTERS OR DIGITS; STANDARD_CHAR:=ALFAMERICS OR (.EOL,EOM,CR,FF,'+','-','*','/','(',')','$','=',',','.','''','%',':', '#','"','&','@','<','>','?',';',' '.); ILLEGAL_CHAR:=(..); FOR C:=MIN_ORD TO MAX_ORD DO IF NOT(CHR(C) IN STANDARD_CHAR) THEN ILLEGAL_CHAR:=ILLEGAL_CHAR OR (.CHR(C).); BLANK:=' '; FOR S:=0 TO HASH_MAX DO HASH_TABLE(.S.).SPIX:=NULL; CURRENT_INDEX:=XREAL; STD_NAMES; INIT_OPTIONS; NORMAL:=NOT TEST AND LIST; END; "######" "NUMBER" "######" PROCEDURE NUMBER; VAR MANTISSA,POWER_OF_TEN:REAL; E     ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}UPTO_SW:=TRUE ELSE BEGIN OP:=REAL2; IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE REPEAT IF MANTISSA<=MAX_SIGNIFICANCE THEN BEGIN MANTISSA:=MANTISSA*REAL10 + CONV(ORD(CH)-ORD('0')); EXPONENT:=EXPONENT-1 END; NEXT_CHAR UNTIL NOT(CH IN DIGITS); END END; "COLLECT EXPONENT PART" IF CH='E' THEN BEGIN OP:=REAL2; NEXT_CHAR; EXPONENT_PART:=0; EXPONENT_SIGN:=FALSE; IF CH='+' THENZT( > B"" ` " H> `X" ` (  "" `&  "& >"  B> "(  B>"  B>" THEN BEGIN IF MANTISSA>CONV(MAX_INTEGER) THEN BEGIN ERROR(NUMBER_ERROR); MANTISSA:=0.0 END; PUT1(INTEGER2,TRUNC(MANTISSA)) END ELSE "OP=REAL2" BEGIN IF ERROR_SW THEN BEGIN ERROR(NUMBER_ERROR); SPLIT(0.0,REAL_VAL) END ELSE BEGIN "COMPUTE THE APPROPRIATE POWER OF TEN" POWER_OF_TEN:=REAL1; IF EXPONENT<0 THEN BEGIN EXPONENT_SIGN:=TRUE; EXPONENT:=ABS(EXPONENT) END ELSE EXPONENT_SIGN:=FALSE; IF EXB"*" `p" `8   >" ` *" `   " \* & 0B" ` `2 :* Z" B X_REAL/MANTISSA THEN SPLIT(MANTISSA*POWER_OF_TEN,REAL_VAL) ELSE BEGIN ERROR(NUMBER_ERROR); SPLIT(0.0,REAL_VAL) END END; PUT0(REAL2); PUT1(LCONST2,REALLENGTH); FOR I:=1 TO 4 DO PUT_ARG(REAL_VAL(.I.)); END END; "#######" "HASHING" "#######" FUNCTION SAME_ID:BOOLEAN; VAR SAME:BOOLEAN; THIS_PIECE:PIECE_PTR; I:INTEGER; BEGIN WITH HASH_TABLE(.HASH_KEY.) DO BEGIN SAME:=NAME.PART=ID_TEXT(.0.); IF PIECES>0 THEN IF SAM |  Z" B z Z2 ,` *" `   " \* & 0B" ` `2 :* Z" B  "0" WRITE_BOOL(2.0<>3.0); "1" "NGREAL" WRITE_BOOL(2.0<=1.0); "0" WRITE_BOOL(2.0<=2.0); "1" WRITE_BOOL(2.0<=3.0); "1" "EQSET" WRITE_BOOL((.1,2,3.)=(.1,2.)); "0" WRITE_BOOL((.1,2,3.)=(.1,2,3.)); "1" WRITE_BOOL((.1,2,3.)=(.1,2,3,4.)); "0" "NLSET" WRITE_BOOL((.1,2,3     -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegjlnprtv`bdfhy{}xz|~.)>=(.1,2.)); "1" WRITE_BOOL((.1,2,3.)>=(.1,2,3.)); "1" WRITE_BOOL((.1,2,3.)>=(.1,2,3,4.)); "0" "NESET" WRITE_BOOL((.1,2,3.)<>(.1,2.)); "1" WRITE_BOOL((.1,2,3.)<>(.1,2,3.)); "0" WRITE_BOOL((.1,2,3.)<>(.1,2,3,4.)); "1" "NGSET" WRITE_BOOL((.1,2,3.)<=(.1,2.)); "0" WRITE_BOOL((.1,2,3.)<=(.1,2,3.)); "1" WRITE_BOOL 0 " " >"   P0>   L" X" B `  " \(  @ ( *" ( *"@        -/!#%')+. "$&(*,13579;=?ACEG2468:<>@BDF0MOQSUWY[]_IKNPRTVXZ\^HJLikmoqsuwacegjlnprtv`bdfhy{}xz|~2"( " ^\ >"  ^   XNUSERS PRINTER  @ ( *" ( *"@    (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY,((.1,2,3.)<=(.1,2,3,4.)); "1" "LSSTRUCT" WRITE_BOOL('XXXB'<'XXXA'); "0" WRITE_BOOL('XXXB'<'XXXB'); "0" WRITE_BOOL('XXXB'<'XXXC'); "1" "EQSTRUCT" WRITE_BOOL('XXXB'='XXXA'); "0" WRITE_BOOL('XXXB'='XXXB'); "1" WRITE_BOOL('XXXB'='XXXC'); "0" "GRSTRUCT" WRITE_BOOL('XXXB'>'XXXA'); SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############## # COPYUSERS # ##############" PROCEDURE WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1.IUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); .6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(REM MOD 10 + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; FOR I:= 1 TO 4 - DIGIT DO WRITE(' '); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(' '); END; PROCEDURE STARTIO; VAR SOURCE, DEST: ARGTYPE; BEGIN WITH SOURCE DO BEGIN TAG:= IDTYPE; ID:= 'USERS ' END; WRITEARG(INP, SOURCE); WITH DEST DO BEGIN TAG:= IDTYPE; ID:= 'PRINTER ' PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE END; WRITEARG(OUT, DEST); END; PROCEDURE STOPIO; VAR SOURCE, DEST: ARGTYPE; BEGIN READARG(INP, SOURCE); READARG(OUT, DEST); PARAM(.1.).BOOL:= SOURCE.BOOL & DEST.BOOL; END; PROCEDURE COPYTEXT; VAR C: CHAR; LINENO: INTEGER; BEGIN WRITE(FF); LINENO:= 0; READ(C); WHILE C <> EM DO BEGIN LINENO:= LINENO + 1; WRITEINT(LINENO); WHILE C <> NL DO BEGIN WRITE(C); READ(C) END; WRITE(NL); READ(C); END; WRITE(EM); END; BEGIN STARTIO; COPYTEXT; STOPIO; END. PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGS     ,. "$&(*-/!#%')+02468:<>@BDF13579;=?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{} SOLO FILES 24 FEB 76 KYOTO UNIVERSITY MACHINE MANUAL 24 FEB 76 **************** NOTES 24 FEB 76 SAKYO-KU KYOTO 606 JAPAN MR. ARTHUR BROWN MACHINE MANUAL 8 MAR 76 ARTHUR D. LITTLE INC. NOTES 8 MAR 76 ********************* 35 ACORN PARK CAMBRIDGE MASSACHUSETTS 02140 MR. LES HAYDEN SOLO MANUALS 10 MAY 76 LOGICA LTD. MOVE(1) WRITE(AUTOLOAD) BACKUP(WRITE) MOVE(2) BACKUP(CHECK) MOVE(1)  SOLO FILES 10 MAY 76 *********** MACHINE MANUAL 10 MAY 76 31 - 36 FOLEY STREET NOTES 10 MAY 76 LONDON W1P FLB ENGLAND MR. THOMAS R. BLAKESLEE SOLO MANUALS 8 APR 76 LOGISTICON INC. REAL-TIME MANUAL 26 APR 76 *************** JOB-STREAM MANUAL 26 APR 76 617 NORTH MARY AVENUE MACHINE MANUAL 26 AP?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{} "1" WRITE_BOOL('XXXB'>'XXXB'); "0" WRITE_BOOL('XXXB'>'XXXC'); "0" "NLSTRUCT" WRITE_BOOL('XXXB'>='XXXA'); "1" WRITE_BOOL('XXXB'>='XXXB'); "1" WRITE_BOOL('XXXB'>='XXXC'); "0" "NESTRUCT" WRITE_BOOL('XXXB'<>'XXXA'); "1" WRITE_BOOL('XXXB'<>'XXXB'); "0" WRITE_BOOL('XXXB'<>'XXXC'); "################## # KERNEL TEST 1 # ##################" "NO CLOCK INTERRUPT, INITIAL TEST OUTPUT WILL TEST: SYSTEM LOADING TEST OUTPUT MECHANISM KERNEL INITIALIZATION (BUT NOT PERIPHERALS) KERNEL CALL KERNEL EXIT (USER = NIL, USER <> NIL) NEWCORE.NEW (BUT NOT SPACELIMIT) QUEUETYPE.GET QUEUETYPE.PUT QUEUETYPE.ANY QUEUETYPE.EMPTY TIMER.ELAPSED TIMER.RESET CORE.ALLOC (BUT NOT CORE LIMIT) VIRTUAL.DEFCOMMON (BUT NOT VIRTUALLIMIT) VIRTUAL.DEFPRIVATE (BUT NOT VIRTUALLIMIT) VI "1" "NGSTRUCT" WRITE_BOOL('XXXB'<='XXXA'); "0" WRITE_BOOL('XXXB'<='XXXB'); "1" WRITE_BOOL('XXXB'<='XXXC'); "1" "FUNCVALUE" X:=FUNCTION1(0); WRITE_INT(X); "300" "JUMP" IF TRUE THEN X:=0 ELSE X:=1; WRITE_INT(X); "0" "FALSEJUMP" IF FALSE THEN X:=0 ELSE X:=1; WRITE_INT(X); RTUAL.GETMAP VIRTUAL.PUTMAP RUNNING.SERVE (NESTING = 0) RUNNING.PREEMPTED RUNNING.UPDATE (SLICE < MAXSLICE) RUNNING.POPPARAM (PARAMLENGTH = 0) RUNNING.INITCHILD (PARAMLENGTH = 0) RUNNING.INITPARENT INITPROCESS ENDPROCESS READY.ENTER (BOTTOM) READY.SELECT (BOTTOM) READY.RESCHEDULE (USER <> NIL, NO EFFECT) TERMINAL.KERNELWRITE WRITETEXT KERNELREADY" CONST MAX1 = 100; MAX2 = 10000; VAR X: ARRAY (.1..MAX1.) OF INTEGER; Y: PROCESS VAR Z: ARRAY (.1..MAX2.) OF INTEGER; ?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{} BEGIN END; BEGIN INIT Y END. NG.SERVE (NESTING = 0) RUNNING.PREEMPTED RUNNING.UPDATE (SLICE < MAXSLICE) RUNNING.POPPARAM (PARAMLENGTH = 0) RUNNING.INITCHILD (PARAMLENGTH = 0) RUNNING.INITPARENT INITPROCESS ENDPROCESS READY.ENTER (BOTTOM) READY.SELECT (BOTTOM) READY.RESCHEDULE (USER <> NIL, NO EFFECT) TERMINAL.KERNELWRITE WRITETEXT KERNELREADY" CONST MAX1 = 100; MAX2 = 10000; VAR X: ARRAY (.1..MAX1.) OF INTEGER; Y: PROCESS VAR Z: ARRAY (.1..MAX2.) OF INTEGER; "################## # KERNEL TEST 3 # ##################" "TEST OUTPUT, BELL KEY IS CLOCK INTERRUPT, CLOCK INTERVAL = 10000 (1 SEC) WILL TEST: SIGNAL.AWAIT SIGNAL.SEND (BUT NOT EMPTY) TIME.ADD (FRACTION = 10000) CLOCK.INCREMENT (INCR = 10000) CLOCK.WAIT RUNNING.UPDATE (SLICE > MAXSLICE, NESTING = 0 - IF RUN LONG ENOUGH) RUNNING.POPPARAM (PARAMLENGTH <> 0 BUT NOT PARAMLIMIT) RUNNING.INITCHILD (PARAMLENGTH <> 0) INITPROCESS (PARAMLENGTH <> 0) RUNNING.ENTER RUNNING.LEAVE (NESTING = ?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}0) READY.ENTER (TOP) READY.SELECT (IDLING, TOP) READY.RESCHEDULE (USER = NIL, TOP.ANY) GATE.ENTER (OPEN) GATE.LEAVE (OPEN) GATE.DELAY (OPEN) GATE.CONTINUE (CLOSED) GATE.INITIALIZE INITGATE" TYPE RESOURCE = MONITOR VAR FREE: BOOLEAN; Q: QUEUE; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q); END; PROCEDURE ENTRY RELEASE; BEGIN IF EMPTY(Q) THEN FREE:=TRUE ELSE CONTINUE(Q); END; BEGIN FREE:= TRUE END; VAR ACCESS: RESOURCE; B: PROCESS(AC "################## # KERNEL TEST 4 # ##################" "TEST OUTPUT, BELL KEY IS CLOCK INTERRUPT, CLOCK INTERVAL = 10000 (1 SEC) WILL TEST: RUNNING.SERVE (NESTING <> 0) GATE.ENTER (CLOSED) GATE.LEAVE (CLOSED) GATE.DELAY (CLOSED) GATE.CONTINUE (OPEN)" TYPE TEST = MONITOR VAR Q: QUEUE; PROCEDURE ENTRY P1; BEGIN WAIT END; PROCEDURE ENTRY P2; BEGIN WAIT; DELAY(Q); CONTINUE(Q) END; PROCEDURE ENTRY P3; BEGIN CONTINUE(Q) END; BEGIN END; VAR T: TEST; A: PROCESS(T: TEST); BEGIN T.P1; CESS: RESOURCE); BEGIN CYCLE ACCESS.REQUEST; WAIT; ACCESS.RELEASE; END; END; BEGIN "A" WAIT; WAIT; INIT ACCESS, B(ACCESS); CYCLE ACCESS.REQUEST; WAIT; ACCESS.RELEASE; END; END. ESOURCE = MONITOR VAR FREE: BOOLEAN; Q: QUEUE; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q); END; PROCEDURE ENTRY RELEASE; BEGIN IF EMPTY(Q) THEN FREE:=TRUE ELSE CONTINUE(Q); END; BEGIN FREE:= TRUE END; VAR ACCESS: RESOURCE; B: PROCESS(ACT.P3 END; BEGIN "B" INIT T, A(T); T.P2; END. #######" "TEST OUTPUT, BELL KEY IS CLOCK INTERRUPT, CLOCK INTERVAL = 10000 (1 SEC) WILL TEST: RUNNING.SERVE (NESTING <> 0) GATE.ENTER (CLOSED) GATE.LEAVE (CLOSED) GATE.DELAY (CLOSED) GATE.CONTINUE (OPEN)" TYPE TEST = MONITOR VAR Q: QUEUE; PROCEDURE ENTRY P1; BEGIN WAIT END; PROCEDURE ENTRY P2; BEGIN WAIT; DELAY(Q); CONTINUE(Q) END; PROCEDURE ENTRY P3; BEGIN CONTINUE(Q) END; BEGIN END; VAR T: TEST; A: PROCESS(T: TEST); BEGIN T.P1; ?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}T + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; VAR TERMINAL: CONSOLE; I: INTEGER; TEXT: LINE; R: REAL; BEGIN INIT TERMINAL; WITH TERMINAL DO BEGIN WRITETEXT('INPUT 5 LINES( "################## # KERNEL TEST 5 # ##################" "NO TEST OUTPUT, NO CLOCK INTERRUPT WILL TEST: RUNNING.SYSTEMERROR RUNNING.REALINTERRUPT READY.ENTER (MIDDLE) READY.SELECT (MIDDLE) TERMINAL.WRITECHAR (CH <> LF, CH = LF) TERMINAL.READINTERRUPT (BUT NOT BELL) TERMINAL.WRITEINTERRUPT (ECHO, NOT ECHO) TERMINAL.INITIO (INPUT, OUTPUT) TERMINAL.INITIALIZE IO INTERRUPT WRITEINT KERNELERROR (OVERFLOW)" TYPE IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (:10:)'); FOR I:= 1 TO 5 DO BEGIN READTEXT(TEXT); WRITETEXT(TEXT) END; WRITEINT(0); WRITEINT(32767); WRITEINT(-32767); R:=R / 0.0; END; END.  1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; VAR TERMINAL: CONSOLE; I: INTEGER; TEXT: LINE; R: REAL; BEGIN INIT TERMINAL; WITH TERMINAL DO BEGIN WRITETEXT('INPUT 5 LINES(INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGI?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}"################## # KERNEL TEST 6 # ##################" "NO TEST OUTPUT, BELL KEY IS CLOCK INTERRUPT, SMALLINCR = 100, INTERVAL = 5000 (0.5 SEC) WILL TEST: TIME.ADD TIMER.ELAPSED TIMER.TICK TIMER.RESET CLOCK.INCREMENT CLOCK.REALTIME CLOCKINTERRUPT RUNNING.UPDATE (SLICE < MAXSLICE, SLICE > MAXSLICE)" TYPE IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, "################## # KERNEL TEST 7 # ##################" "NO TEST OUTPUT, NORMAL CLOCK WILL TEST: BELL KEY" TYPE IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENG STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); HAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; CONST RUNTIMESEC = 4; RUNTIMEFRAC = 5; SLICE = 6; VAR TERMINAL: CONSOLE; I, J, K, L: INTEGER; BEGIN INIT TERMINAL; WITH TERMINAL DO CYCLE I:= REALTIME; J:= ATTRIBUTE(RUNTIMESEC); K:= ATTRIBUTE(RUNTIMEFRAC); L:= ATTRIBUTE(SLICE TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; TYPE RESOURCE = MONITOR VAR FREE: BOOLEAN; Q: QUEUE; PROCEDURE ENTRY REQUEST; BEGIN IF FREE THEN FREE:= FALSE ELSE DELAY(Q); END; PROCEDURE ENTRY RELEASE; BEGIN IF EMPTY(Q) THEN FREE:=TRUE ELSE CONTINUE(Q); END; BEGIN FREE:= TRUE END; CONST MAX1 = 10; MAX2 = 10; MAX3 = 10; VAR TERMINAL: CONSOLE; ACCESS: RESOURCE; A: PROCESS(ACCESS: RESOURCE); VAR TERMINAL: CONSOLE; PARAM: IOPARAM; BEGIN INIT TERMINAL; PARAM.OPERAT); WRITEINT(I); WRITEINT(J); WRITEINT(K); WRITEINT(L); WAIT; END; END. ROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; CONST RUNTIMESEC = 4; RUNTIMEFRAC = 5; SLICE = 6; VAR TERMINAL: CONSOLE; I, J, K, L: INTEGER; BEGIN INIT TERMINAL; WITH TERMINAL DO CYCLE I:= REALTIME; J:= ATTRIBUTE(RUNTIMESEC); K:= ATTRIBUTE(RUNTIMEFRAC); L:= ATTRIBUTE(SLICEION:= CONTROL; CYCLE IO(PARAM, PARAM, TTY); ACCESS.REQUEST; TERMINAL.WRITETEXT('BELL RESPONSE(:10:)'); ACCESS.RELEASE; END; END; I: INTEGER; TEXT: LINE; BEGIN INIT TERMINAL, ACCESS, A(ACCESS); CYCLE ACCESS.REQUEST; TERMINAL.WRITETEXT('TERMINAL PASSIVE (:10:)'); ACCESS.RELEASE; FOR I:= 1 TO MAX1 DO WAIT; FOR I:= 1 TO MAX2 DO BEGIN ACCESS.REQUEST; TERMINAL.WRITETEXT('TERMINAL OUTPUT(:10:)'); ACCESS.RELEASE; END; FOR I:= 1 TO MAX3 DO ?ACEGLNPRTVXZ\^HJMOQSUWY[]_IKhjlnprtv`bdfikmoqsuwacegxz|~y{}   BEGIN ACCESS.REQUEST; TERMINAL.READTEXT(TEXT); TERMINAL.WRITETEXT(TEXT); ACCESS.RELEASE; END; END; END.  END; END; I: INTEGER; TEXT: LINE; BEGIN INIT TERMINAL, ACCESS, A(ACCESS); CYCLE ACCESS.REQUEST; TERMINAL.WRITETEXT('TERMINAL PASSIVE (:10:)'); ACCESS.RELEASE; FOR I:= 1 TO MAX1 DO WAIT; FOR I:= 1 TO MAX2 DO BEGIN ACCESS.REQUEST; TERMINAL.WRITETEXT('TERMINAL OUTPUT(:10:)'); ACCESS.RELEASE; END; FOR I:= 1 TO MAX3 DO "################## # KERNEL TEST 8 # ##################" "NORMAL KERNEL WILL TEST: NEWCORE (SPACELIMIT)" CONST PROCESSLIMIT = 10; MONITORLIMIT = 25; TYPE "INSERT IO TYPES AND CONSOLE CLASS FROM KERNEL TEST 7 HERE" IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERuwacxz|~y{}     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnprATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; BEGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WR,X, 67 "8"9:* >?"@ A< EF"GGH >" "I 6J  XKF P Q" "RRS >"T U  P0> V  L"W XX V-hXY "Y \,Z  ZITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE E[ \: `a"bbc >"d  e  Xf hquvwxV" x V `6yX V VVyz"T U  P0> V  L"W XX V-hXY "Y \,Z  ZNTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; VAR TERMINAL: CONSOLE; CHILD: ARRAY (.2..PROCESSLIMIT.) OF PROCESS BEGIN END; RESOURCE: ARRAY (.0..MONITORLIMIT.) OF MONITOR BEGIN END; I: INTEGER; BEGIN INIT TERMINAL; WITH TERMINAL DO BEGIN WRITETEXT('PROCESSES: (:10:)'); FOR I:= 2 TO PROCESSLIMIT DO BEGIN INIT CHILD(.I.); WRITEINT(I); END; WRITETEXT(MOVE(1) LIST(FILES, ALL, TAPE) MOVE(1) COPY(TAPE, PRINTER) MOVE(183) COPY(TAPE, PRINTER) MOVE(1) 'MONITORS:(:10:)'); FOR I:= 0 TO MONITORLIMIT DO BEGIN INIT RESOURCE(.I.); WRITEINT(I); END; END; END.  UNTIL C = NL; END; BEGIN END; VAR TERMINAL: CONSOLE; CHILD: ARRAY (.2..PROCESSLIMIT.) OF PROCESS BEGIN END; RESOURCE: ARRAY (.0..MONITORLIMIT.) OF MONITOR BEGIN END; I: INTEGER; BEGIN INIT TERMINAL; WITH TERMINAL DO BEGIN WRITETEXT('PROCESSES: (:10:)'); FOR I:= 2 TO PROCESSLIMIT DO BEGIN INIT CHILD(.I.); WRITEINT(I); END; WRITETEXT( PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FRTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "********** * PATCH * **********" VAR OK, DONE: BOOLEAN; ID: IDENTIFIER; ADDR, VALUE: INTEGER; BLOCK?ACEGLNPRTVXHJMOQSUWy{}xz|~     !#%')+-/1357"$&(*,.0246 =?ACEGIKMO9;>@BDFH: ARRAY (.0..255.) OF INTEGER; C: CHAR; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 1; C:= TEXT(.1.); WHILE C <> '#' DO BEGIN DISPLAY(C); I:= I + 1; C:= TEXT(.I.); END; DISPLAY(NL); END; PROCEDURE WRITEOCTAL(N: INTEGER); VAR D: ARRAY (.1..6.) OF CHAR; R, I: INTEGER; BEGIN IF N < 0 THEN BEGIN R:= ABS(N + 1); FOR I:= 6 DOWNTO 1 DO BEGIN D(.I.):= CHR(7 - R MOD 8 + ORD('0')); R:= R DIV 8; END END ELSE BEGIN R:= N; 0$  " " "$  """"   "!""$()e"*+, J-6789d:0;0<"=">ILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; ARG:?ACEGLoqsuwacxz|~y{}     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfINDEXLESS.INDEXGREATER. NEGOVER.ADDOVER.SUBOVER.MULOVER.DIVOVER.MODOVER.BUILDSETLESS. BUILDSETGREATER.INSETLESS.INSETGREATER. CASELESS. CASEGREATER.ENTERSTACKLIM.TRUNCOVER.GG@ABSOVER.,h@"@":B":B".A.d PJ244$"" 0 " " >"   P0>   L" X V-V " \(  :"" `" `L  T10 >" Xr" 1(0 bbdxd`dHf0 (f08f@HhPXh`hhpxjjjplXl@l(RRRRRnRRRRR"  & " `(  : $$ " ZR PX J$J$ L" PX J$&  " \ LB" L>"P ` `2 >\2 `2f" B RnRRRRRRRntRRRRRp>RRRRRRpRRRRRRRpRRRRRrRRRRRRrNRRRRRRRr RRRRRtR ` (d> 0.0(b"-z<$ Z$ pJ" V( :J$" tN$ T@h* >"@N$80b& B"@J$HN@$@h& >"@N$RRRRRtRRRRRRRtXvBv,vxxxz zz|| $|f(,|P04~:8<~$@D~HLPTX\ "1" "CASEJUMP" CASE 3 OF 1: X:=101; 2: X:=102; 3: X:=103; 4: X:=104 END; WRITE_INT(X); "103" "INITVAR" "SEQUENTIAL PASCAL ONLY" "CALL" PROCEDURE1(1539); "1539" "CALLSYS" "SEQUENTIAL PASCAL ONLY" "ENTER & EXIT" PROCEDURE1(1984); "1984" "ENTERPROG & EXITPROG" "TESTED ON EXECUTION OF THIS PROGRAM" "POP" FOR I:=1 TO 4 DO S(.I.):='Z'; WRITE_ST"@ DJ$0 >." `P"@ DJ$0 >\E@ V  :"-+0  L>0  P>,  > $  ,>""  "  j$#.( g" 8v34RING(S); "ZZZZ" FOR I:=1 TO 4 DO S(.I.):='X'; WRITE_STRING(S); "XXXX" "NEWLINE" "WILL BE CHECKED IN A PROGRAM THAT CAUSES AN ERROR" "INCRWORD" FOR I:=1 TO 3 DO WRITE_INT(600+I); "601 602 603" "DECWORD" FOR I:=3 DOWNTO 1 DO WRITE_INT(500+I); "503 502 501" "PUSHLABEL" "SEQUENTIAL PASCAL ONLY" "TRUNCREAL" WRITE_INT(TRUNC(7.5)); "7" "ABSWORD"P*'" " " " " |" " "X" ^T$RRR}R~RR& "* / * / ,x  " ""\P T  WRITE_INT(ABS(637)); "637" WRITE_INT(ABS(-625)); "625" "ABSREAL" WRITE_REAL(ABS(24.8)); "24.8" WRITE_REAL(ABS(-22.4)); "22.4" "SUCCWORD" WRITE_INT(SUCC(572)); "573" "PREDWORD" WRITE_INT(PRED(429)); "428" "CONVWORD" WRITE_REAL(CONV(68)); "68.0" "SETHEAP" L  " \$RRR~R&"#"Pd*d z",x {" ,  ".z  "  " b 0" H 0" .2222RR "SEQUENTIAL PASCAL ONLY" END; BEGIN INTERPRETER_TEST; END. R}R~RRR~R4&6|6h6T6@RRR}R~RRR|R8&:" :" 4 :*h$<$.<">px@BDRRR}R}RRR~RF&TH^Jt,L>NTp" " " " " :e":f",g"h" l" `" Z " `" X " `X >" \ >f`L}Bq:6hR PRR~RRRR~RRTnRR~RRT@V,VVXXXZZZ\x\d\P^<^(^```bp<D<D& S$ B@? @A B@ TMZCffffffC333333ABCDYB BB BB@BB333333AA@AAA@AA@AAA@AA@AAA@AA@AAA@AA@AAA@AA@AAA FOR I:= 6 DOWNTO 1 DO BEGIN D(.I.):= CHR(R MOD 8 + ORD('0')); R:= R DIV 8; END END; FOR I:= 1 TO 6 DO DISPLAY(D(.I.)); DISPLAY(NL); END; PROCEDURE HELP; BEGIN WRITETEXT('TRY AGAIN#'); WRITETEXT(' EXAM(ADDR)#'); WRITETEXT(' DEP(ADDR, VALUE)#'); WRITETEXT(' EXIT#'); WRITETEXT('USING#'); WRITETEXT(' ADDR, VALUE: 000000..777776 #'); OK:= FALSE; DONE:= TRUE; END; PROCEDURE READCHAR; BEGIN REPEAT ACCEPT(C) UNTIL C <> ' '; END; PROCEDURE READSPEC(S: ILLS SOLO MANUALS 4 FEB 76 SOFTWARE ENGINEER SOLO FILES 4 FEB 76 MILLS INTERNATIONAL MACHINE MANUAL 4 FEB 76 ******************* NOTES 4 FEB 76 203 NORTH GREGORY URBANA ILLINOIS 61801 DR. DAVID A. SPENCER SOLO MANUALS 17 NOV 75 D-355 SOLO FILES 5 JAN 76 M. I. T. LINCOLN LABORATORY **********************CHAR); BEGIN IF C = S THEN READCHAR ELSE OK:= FALSE; END; PROCEDURE READWORD(VAR ID: IDENTIFIER); VAR I: INTEGER; BEGIN ID:= ' '; I:= 0; WHILE ('A' <= C) & (C <= 'Z') & (I < IDLENGTH) DO BEGIN I:= I + 1; ID(.I.):= C; READCHAR END; END; PROCEDURE READDIGIT(VAR I: INTEGER); BEGIN IF ('0' <= C) & (C <= '7') THEN BEGIN I:= ORD(C) - ORD('0'); READCHAR; END ELSE OK:= FALSE; END; PROCEDURE READOCTAL(VAR N: INTEGER); VAR D: ARRAY (.1..6.) OF INTEGER; I: INTEG***** LEXINGTON MASSACHUSETTS 02173 MR. JOHN C. C. WHITE SOLO MANUALS 28 OCT 75 MITRE CORPORATION SOLO COPY 28 OCT 75 ***************** SOLO FILES 13 FEB 76 P. O. BOX 208 MACHINE MANUAL 13 FEB 76 BEDFORD NOTES 13 FEB 76 MASSACHUSETTS 01730 MR. WALTER WUENSCH SOLO MANUALS 12 APR 76 MOBYDATA INC. @AXXXBXXXAXXXBXXXBXXXBXXXCXXXBXXXAXXXBXXXBXXXBXXXCXXXBXXXAXXXBXXXBXXXBXXXCXXXBXXXAXXXBXXXBXXXBXXXCXXXBXXXAXXXBXXXBXXXBXXXCXXXBXXXAXXXBXXXBXXXBXXXCABffffffB333333B BB@BB333333AA@AAA@AA@AAA@AA@AAA@AA@AAA@AA@AAA@AA@AAA SOLO FILES 12 APR 76 ************* REAL-TIME MANUAL 12 APR 76 P.O. BOX 462 JOB-STREAM MANUAL 12 APR 76 ONTARIO MACHINE MANUAL 12 APR 76 NEW YORK 14519 NOTES 12 APR 76 PROFESSOR C.S. WALLACE SOLO MANUALS 8 JUN 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 8 JUN 76 MONASH UNIVERSITY 15 MR. ERIK LILLEVOLD SOLO MANUALS 20 OCT 75 NORWEGIAN DEFENSE RESEARCH ESTABLISHMENT **************************************** P. O. BOX 25 SOLO FILES 20 OCT 75 N-2007 KJELLER NORWAY MR. DAVID N. SAMSKY SOLO MANUALS 10 NOV 75 MANAGER, SOFTWARE DEVELOPMENT NUCLEAR DATA INC. ***************** GOLF & MEACHAM ROADS SCHAUMBURG ILLINOIS 60172 MR. ALESSANDRO OSNAGI SOLO MANUALS 11 MA JOB-STREAM MANUAL 8 JUN 76 ***************** MACHINE MANUAL 8 JUN 76 CLAYTON 3168 NOTES 8 JUN 76 AUSTRALIA MS. CAROLYN SHULTZ SOLO MANUALS 24 JUN 76 NATIONAL CASH REGISTER SOLO FILES 24 JUN 76 ********************** REAL-TIME MANUAL 24 JUN 76 3718 NORTH ROCK ROAD JOB-STREAM MANUAL 24 JUN 76 WICHITA R 76 ING. C. OLIVETTI S.P.A. SOLO FILES 11 MAR 76 *********************** REAL-TIME MANUAL 11 MAR 76 VIA JERVIS 13 JOB-STREAM MANUAL 11 MAR 76 10015 IVREA MACHINE MANUAL 11 MAR 76 ITALY NOTES 11 MAR 76 DR. RUSTY WHITNEY SOLO MANUALS 2 OCT 75 OREGON MUSEUM OF SCIENCE AND INDUSTRY SOLO COPY 2 OCT 75 MACHINE MANUAL 24 JUN 76 KANSAS 67226 NOTES 24 JUN 76 MR. M. WOODGER SOLO MANUALS * SEP 75 NATIONAL PHYSICAL LABORATORY **************************** TEDDINGTON MIDDLESEX TW11 0LW ENGLAND MR. JOHN D. FLETCHER SOLO MANUALS 11 JUN 76 NAVAL ELECTRONICS LABORATORY SOLO COPY 11 JUN 76 **************************** SOLO FILES R 76 SUNNYVALE NOTES 26 APR 76 CALIFORNIA 94086 DR. E. ARMSTRONG 2 REAL-TIME MANUALS 30 MAR 76 LOS ALAMOS SCIENTIFIC LABORATORY 2 JOB-STREAM MANUALS 30 MAR 76 ******************************** 2 MACHINE MANUALS 30 MAR 76 LOS ALAMOS 2 NOTES 30 MAR 76 NEW MEXICO 87545 DR. J. ARTHUR FREY SOLO MANUALS 30 MAR 76 ATT. REPORT LIBRARIAN M5-364 11 JUN 76 271 CATALINA BOULEVARD SAN DIEGO CALIFORNIA 92152 LT. GORDON E. EUBANKS, JR. MACHINE MANUAL 6 MAY 76 NAVAL POSTGRADUATE SCHOOL NOTES 6 MAY 76 ************************* SMC 2242 MONTEREY CALIFORNIA 93940 MR. DONALD A. QUICK SOLO MANUALS 20 FEB 76 CONTRACTING OFFICER SOLO COPY 20 FEB 76 NAVAL POSTGRADUATE SCHOOL ************************* MONTEREY CALIFORNIA 93940 MR. EDMUND FR MACHINE MANUAL 30 MAR 76 LOS ALAMOS SCIENTIFIC LABORATORY NOTES 30 MAR 76 ******************************** P.O. BOX 1663 LOS ALAMOS NEW MEXICO 87545 DR. JAMES B. MORRIS, JR. SOLO MANUALS 8 DEC 75 LOS ALAMOS SCIENTIFIC LABORATORY SOLO COPY 8 DEC 75 ******************************** SOLO FILES 8 DEC 75 LOS ALAMOS NEW MEXICO 87545 MR. ALAN A. KORTESOJA SOLO MANUALS 9 JAN 76 MEEMAN SOLO FILES 22 JUN 76 NAVAL RESEARCH LABORATORY ************************* 1222 MOUNT PLEASANT DRIVE ROUTE 9 ANNAPOLIS MARYLAND 21401 MR. MICHAEL S. BALL SOLO MANUALS 24 OCT 75 CODE 2522 SOLO FILES 24 OCT 75 NAVAL UNDERSEA CENTER ********************* SAN DIEGO CALIFORNIA 92132 MR. JAMES A. ZAUN REAL-TIME MANUAL 2 FEB 76 NAVAL UNDERSEA CENTER JOB-STREANUFACTURING DATA SYSTEMS SOLO FILES 9 JAN 75 ************************** 320 NORTH MAIN STREET ANN ARBOR MICHIGAN 48104 PROFESSOR BARBARA LISKOV SOLO MANUALS * SEP 75 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ************************************* PROJECT MAC 545 TECHNOLOGY SQUARE CAMBRIDGE MASSACHUSETTS 02139 PROFESSOR STEPHEN A. WARD SOLO MANUALS 24 OCT 75 MASSACHUSETTS INSTITUTE OF TECHNOLOGY SOLO COPY 24 OCT 75 ****AM MANUAL 2 FEB 76 ********************* MACHINE MANUAL 2 FEB 76 SAN DIEGO NOTES 2 FEB 76 CALIFORNIA 92132 MS. LYNN A. DENOIA SOLO MANUALS 16 APR 76 NAVAL UNDERWATER SYSTEMS CENTER SOLO COPY 16 APR 76 ******************************* SOLO FILES 16 APR 76 FORT TRUMBULL REAL-TIME MANUAL 16 APR 76 NEW LONDON ********************************* SOLO FILES 24 OCT 75 PROJECT MAC - 519 545 TECHNOLOGY SQUARE CAMBRIDGE MASSACHUSETTS 02139 DR. GEORGE MARSAGLIA, DIRECTOR SOLO MANUALS 15 MAR 76 SCHOOL OF COMPUTER SCIENCE SOLO COPY 15 MAR 76 MCGILL UNIVERSITY ***************** P.O. BOX 6070, STATION A MONTREAL QUEBEC H3C 3G1 CANADA DR. N. SOLNTSEFF SOLO MANUALS 30 JAN 76 APPLIED MATHEMATICS SOLO COPY JOB-STREAM MANUAL 16 APR 76 CONNECTICUT 06320 MACHINE MANUAL 16 APR 76 NOTES 16 APR 76 MR. ROBERT G. NELSON SOLO MANUALS 28 MAY 76 1076 EL COLORADO DRIVE REAL-TIME MANUAL 28 MAY 76 LIVERMORE JOB-STREAM MANUAL 28 MAY 76 CALIFORNIA 94550 MACHINE MANUAL 28 MAY 76 30 JAN 76 MCMASTER UNIVERSITY SOLO FILES 30 JAN 76 ******************* REAL-TIME MANUAL 10 MAY 76 HAMILTON JOB-STREAM MANUAL 10 MAY 76 ONTARIO L8S 4K1 MACHINE MANUAL 10 MAY 76 CANADA NOTES 10 MAY 76 MR. CHARLES B. SHIPMAN, JR. SOLO MANUALS 28 JUN 76 MEDIA REACTIONS INC. SOLO FILES 28 J NOTES 28 MAY 76 DR. H. SANDMAYR SOLO MANUALS 24 OCT 75 NEU-TECHNIKUM BUCHS SOLO FILES 24 OCT 75 ******************* REAL-TIME MANUAL 17 MAR 76 CH-9470 BUCHS JOB-STREAM MANUAL 17 MAR 76 SWITZERLAND MACHINE MANUAL 17 MAR 76 NOTES 17 MAR 76 MR. STEVEN KNUDSEN UN 76 ******************** REAL-TIME MANUAL 28 JUN 76 2205 SANDBURG STREET JOB-STREAM MANUAL 28 JUN 76 DUNN LORING MACHINE MANUAL 28 JUN 76 VIRGINIA 22027 NOTES 28 JUN 76 COMPILER THESIS 21 JUL 76 MR. JERRY L. HAYES, DIRECTOR SOLO MANUALS 29 JAN 76 METROLOGY ENGINEERING CENTER **************************** NAVAL PLANT R SOLO MANUALS 29 JUN 76 NEW MEXICO INSTITUTE OF SOLO FILES 29 JUN 76 MINING AND TECHNOLOGY MACHINE MANUAL 29 JUN 76 *********************** NOTES 29 JUN 76 NASA - JOCR SOCORRO NEW MEXICO 87801 MR. R.F. STREIT SOLO MANUALS 27 MAY 76 DIRECTOR, LIBRARY COURANT INSTITUTE OF MATHEMATICAL SCIENCES NEW YORK UNIVERSITY ******************* 251 MERCER STREET NEW YORK NEW YORK 10012 MR. DAEPRESENTATIVE OFFICE P. O. BOX 2505 POMONA CALIFORNIA 91766 DR. STEVEN L. HUYSER SOLO MANUALS 10 MAY 76 COMPUTER LABORATORY SOLO FILES 10 MAY 76 MICHIGAN STATE UNIVERSITY REAL-TIME MANUAL 10 MAY 76 ************************* JOB-STREAM MANUAL 10 MAY 76 EAST LANSING MACHINE MANUAL 10 MAY 76 MICHIGAN 48824 NOTES 10 MAY 76 MR. CARLTON MN TRACY SOLO MANUALS 22 JUN 76 NOAA PACIFIC MARINE SOLO COPY 22 JUN 76 ENVIRONMENTAL LABORATORY SOLO FILES 22 JUN 76 ************************ REAL-TIME MANUAL 22 JUN 76 NSA BUILDING 68 JOB-STREAM MANUAL 22 JUN 76 7500 SAND POINT WAY N.E. MACHINE MANUAL 22 JUN 76 SEATTLE NOTES 22 JUN 76 WASHINGTON 981 JOB-STREAM MANUAL 3 AUG 76 NASHUA MACHINE MANUAL 3 AUG 76 NEW HAMPSHIRE 03060 NOTES 3 AUG 76 DR. DONALD S. KLETT SOLO MANUALS 20 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 20 MAY 76 SANGAMON STATE UNIVERSITY REAL-TIME MANUAL 20 MAY 76 ************************* JOB-STREAM MANUAL 20 MAY 76 SPRINGFIELD VERSITY JOB-STREAM MANUAL 14 JUL 76 ***************** MACHINE MANUAL 14 JUL 76 WEST LAFAYETTE NOTES 14 JUL 76 INDIANA 47907 PROFESSOR C. A. R. HOARE SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT MACHINE MANUAL * 25 NOV 75 QUEEN'S UNIVERSITY SOLO FILES 6 FEB 76 ****************** BELFAST BT7 1NN NORTHERN IRELAND PROFESSOR G. H. M MACHINE MANUAL 20 MAY 76 ILLINOIS 62708 NOTES 20 MAY 76 DR. HIROSHI WADA SOLO MANUALS 20 FEB 76 SEIKEI UNIVERSITY SOLO FILES 20 FEB 76 ***************** REAL-TIME MANUAL 20 FEB 76 KICHIJOJI KITAMACHI 3 JOB-STREAM MANUAL 20 FEB 76 MUSASHINO-SHI MACHINE MANUAL 20 FEB 76 TOKYO 180 ACEWEN SOLO MANUALS SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY SEP 75 QUEEN'S UNIVERSITY MACHINE MANUAL 1 JUN 76 ****************** NOTES 1 JUN 76 KINGSTON ONTARIO CANADA MR. CHARLES RATTRAY SOLO MANUALS 10 NOV 75 4 DIDCOT ROAD SOLO FILES 10 NOV 75 WOODHOUSE PARK REAL-TIME MANUAL FEB 7 NOTES 20 FEB 76 JAPAN MR. DIETER HESSE SOLO MANUALS 3 AUG 76 SIEMENS AG SOLO FILES 3 AUG 76 ********** REAL-TIME MANUAL 3 AUG 76 ZFA FTE 3 JOB-STREAM MANUAL 3 AUG 76 SCHERTLINSTRASSE 8 MACHINE MANUAL 3 AUG 76 8 MUNICH 70 NOTES 3 AUG 76 GERMANY DR. KARL MAERZ 6 WYTHENSHAWE JOB-STREAM MANUAL FEB 76 MANCHESTER MACHINE MANUAL FEB 76 ENGLAND NOTES FEB 76 MR. EINAR MOSSIN SOLO MANUALS 7 OCT 75 REGNECENTRALEN SOLO FILES 7 OCT 75 ************** FALKONER ALLE 1 2000 COPENHAGEN F DENMARK MRS. MARY DOWNEY, LIBRARIAN SOLO MANUALS 10 NOV 75 REPUBLIC ELEC SOLO MANUALS 9 APR 76 BEREICH DATENVERARBEITUNG SOLO FILES 9 APR 76 SIEMENS AG MACHINE MANUAL 9 APR 76 ********** SOLO FILES 7 JUL 76 POSTFACH 70 00 78 D-8000 MUNICH 70 GERMANY DR. MANFRED SOMMER SOLO MANUALS 20 MAY 76 SIEMENS AG REAL-TIME MANUAL 20 MAY 76 ********** JOB-STREAM MANUAL TRONICS SOLO COPY 10 NOV 75 ******************** SOLO FILES 10 NOV 75 P. O. BOX 7065 5801 LEE HIGHWAY ARLINGTON VIRGINIA 22207 DR. JAMES C. WRIGHT SOLO MANUALS 7 MAY 76 RESEARCH TRIANGLE INSTITUTE SOLO FILES 7 MAY 76 *************************** REAL-TIME MANUAL 7 MAY 76 P.O. BOX 12194 JOB-STREAM MANUAL 7 MAY 76 RESEARCH TRIANGLE PARK 20 MAY 76 ABT. ZB VUE MACHINE MANUAL 20 MAY 76 BOSCHETSRIEDERSTRASSE 41 NOTES 20 MAY 76 8000 MUNICH 70 GERMANY MR. RICHARD M. SMITH SOLO MANUALS 29 DEC 75 P. O. BOX 5882 SOLO FILES 15 JAN 76 RALEIGH REAL-TIME MANUAL 3 FEB 76 NORTH CAROLINA 27607 JOB-STREAM MANUAL 3 FEB 76 MAC MACHINE MANUAL 7 MAY 76 NORTH CAROLINA 27709 NOTES 7 MAY 76 DR. CLIFFORD E. RHOADES, JR. SOLO MANUALS 31 MAR 76 1101 MADEIRA DRIVE, S.E. SOLO FILES 31 MAR 76 # 109 REAL-TIME MANUAL 20 APR 76 ALBUQUERQUE JOB-STREAM MANUAL 20 APR 76 NEW MEXICO 87108 MACHINE MANUAL 20 APR 76 HINE MANUAL 3 FEB 76 NOTES 3 FEB 76 MR. PETER SCHNUPP SOLO MANUALS 29 MAR 76 SOFTLAB ******* MOZARTSTRASSE 17 8 MUNICH 2 GERMANY MR. D. T. ROSS SOLO MANUALS * SEP 75 SOFTECH INC. ************ 460 TOTTEN POND ROAD WALTHAM MASSACHUSETTS 02154 MR. F.E. FALLA SOLO MANUALS 26 JUL 76 SOFTWARE SCIENCES LTD. REAL-TIME MANUAL NOTES 20 APR 76 DR. EDDIE R. NORTON SOLO MANUALS 23 APR 76 CLINICAL COMPUTER LABORATORY 3MR SOLO COPY 23 APR 76 MICHAEL REESE HOSPITAL SOLO FILES 23 APR 76 ********************** REAL-TIME MANUAL 23 APR 76 2900 SOUTH ELLIS AVENUE JOB-STREAM MANUAL 23 APR 76 CHICAGO MACHINE MANUAL 23 APR 76 ILLINOIS 60616 N 26 JUL 76 ********************** MACHINE MANUAL 26 JUL 76 LONDON & MANCHESTER HOUSE PARK STREET MACCLESFIELD CHESHIRE ENGLAND SK11 6SR MR. FRANK TEPLITZKY SOLO MANUALS 2 DEC 75 SOUTHWEST REGIONAL LABORATORY ***************************** 4665 RAMPSON AVENUE LOS ALAMITOS CALIFORNIA 90720 MS. PHYLLIS TADLOCK SOLO MANUALS 26 APR 76 LIBRARY C11-1 MACHINE MANUAL 26 APR 76 SPERRY UNIVAC ************************************* SOLO FILES 2 OCT 75 4015 SOUTH WEST CANYON ROAD PORTLAND OREGON 97221 DIPL.ING. KONRAD MAYER SOLO MANUALS 12 APR 76 OESTERREICHISCHE STUDIENGESELLSCHAFT SOLO COPY 12 APR 76 FUER ATOMENERGIE REAL-TIME MANUAL 12 APR 76 ************************************ JOB-STREAM MANUAL 12 APR 76 LENAUGASSE 10 MACHINE MANUAL 12 APR 76 A-1082 VIENNA OTES 23 APR 76 MR. B.R. ANSCOMBE SOLO MANUALS 8 JUL 76 TECHNICAL INFORMATION GROUP SOLO FILES 8 JUL 76 REUTERS LTD. REAL-TIME MANUAL 8 JUL 76 ************ JOB-STREAM MANUAL 8 JUL 76 85 FLEET STREET MACHINE MANUAL 8 JUL 76 LONDON E.C. 4 NOTES 8 JUL 76 ENGLAND PROFESSOR DAVE R. ELAND NOTES 12 APR 76 AUSTRIA MR. O. VOJNOVIC SOLO MANUALS 8 APR 76 PHILIPS CTI REAL-TIME MANUAL 8 APR 76 *********** MACHINE MANUAL 8 APR 76 4 - 16 AV. GAL. LECLERC NOTES 8 APR 76 92260 FONTENAY-AUX-ROSES FRANCE MR. DIETER KOENIG SOLO MANUALS 21 OCT 75 PHILIPS - GMBH ************** WERK FUER BASISCOMPUTERSYSTE SOLO MANUALS 9 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 9 APR 76 ORAL ROBERTS UNIVERSITY REAL-TIME MANUAL 9 APR 76 *********************** JOB-STREAM MANUAL 9 APR 76 7777 SOUTH LEWIS MACHINE MANUAL 9 APR 76 TULSA NOTES 9 APR 76 OKLAHOMA 74105 MS. WANDA FOX SOLO MANUALS 25 JUN 76 COLLINS RADIO GROUP ME UND INFORMATIONSTECHNIK POSTFACH 17 BAHNHOFSTRASSE 5904 EISERFELD GERMANY MR. DEAN PITTMAN SOLO MANUALS 26 MAY 76 50 EAST EMERSON CHULA VISTA CALIFORNIA 92011 MR. THOMAS PITTMAN SOLO MANUALS 10 MAY 76 P.O. BOX 23189 SOLO FILES 10 MAY 76 SAN JOSE MACHINE MANUAL 10 MAY 76 CALIFORNIA 95153 NOTES 10 MAY 76 DR. CHRISTIAN JAH REAL-TIME MANUAL 25 JUN 76 ROCKWELL INTERNATIONAL MACHINE MANUAL 25 JUN 76 ********************** NOTES 25 JUN 76 M/S 407-120 DALLAS TEXAS 75207 MR. ROLF MOLICH SOLO MANUALS 23 MAR 76 CHRISTIAN ROVSING A/S SOLO FILES 23 MAR 76 ********************* REAL-TIME MANUAL 23 MAR 76 MARIELUNDVEJ 46 B JOB-STREAM MANUAL 23 MAR 76L SOLO MANUALS 23 SEP 75 MAX PLANCK INSTITUT FUER BIOCHEMIE SOLO FILES 23 SEP 75 ********************************** 8033 MARTINSRIED GERMANY DR. ALBERTO SANGIOVANNI-VINCENTELLI SOLO MANUALS 2 DEC 75 INSTITUTO DI ELETTROTECNICA SOLO FILES 2 DEC 75 ED ELETTRONICA POLITECNICO DI MILANO ********************* PIAZZA L. DA VINCI 32 20133 MILANO ITALY MR. J. ERIC POLLACK SOLO MANUALS 12 FEB 76 P. 2730 HERLEV MACHINE MANUAL 23 MAR 76 DENMARK NOTES 23 MAR 76 DR. LARS-ERIK THORELLI SOLO MANUALS 10 DEC 75 TELECOMMUNICATION AND SOLO COPY 10 DEC 75 COMPUTER SYSTEMS REAL-TIME MANUAL 12 MAY 76 ROYAL INSTITUTE OF TECHNOLOGY JOB-STREAM MANUAL 12 MAY 76 ***************************** MACHINE MANUAL 12 MAY 76 S-1 O. BOX 5052 MACHINE MANUAL 2 MAR 76 SEATTLE NOTES 2 MAR 76 WASHINGTON 98105 PROFESSOR BRUCE ARDEN SOLO MANUAL * 17 NOV 75 COMPUTER SCIENCE DEPARTMENT ENGINEERING QUADRANGLE ROOM B212 PRINCETON UNIVERSITY ******************** PRINCETON NEW JERSEY 08540 MR. M. VAN DORSSER-WILLEMS SOLO MANUALS 20 JAN 76 PSYCHOLOGISCH LABORATORIUM ************************** BIBLIOTEK ERASMUS00 44 STOCKHOLM 70 NOTES 12 MAY 76 SWEDEN THE DIRECTOR SOLO MANUALS 13 FEB 76 ROYAL RADAR ESTABLISHMENT ************************* MINISTRY OF DEFENSE LEIGH SINTON ROAD MALVERN WORCS ENGLAND MR. PAUL WERKOWSKI SOLO MANUALS 3 AUG 76 SANDERS ASSOCIATES SOLO FILES 3 AUG 76 ****************** REAL-TIME MANUAL 3 AUG 76 24 SIMON STREET LAAN 16 NIJMEGEN THE NETHERLANDS ACQUISITION DEPARTMENT SOLO MANUALS 7 JUN 76 PURDUE UNIVERSITY LIBRARIES MACHINE MANUAL 7 JUN 76 *************************** NOTES 7 JUN 76 WEST LAFAYETTE INDIANA 47907 DR. JAMES J. BESEMER SOLO MANUALS 14 JUL 76 ELECTRICAL ENGINEERING SOLO COPY 14 JUL 76 ROOM 172 REAL-TIME MANUAL 14 JUL 76 PURDUE UNI NOTES 8 APR 76 AUSTRIA MR. DANIEL S. MARCUS SOLO MANUALS 27 MAY 76 TECHNOLOGY MARKETING INC. SOLO COPY 27 MAY 76 ************************* SOLO FILES 27 MAY 76 3170 RED HILL AVENUE REAL-TIME MANUAL 27 MAY 76 COSTA MESA JOB-STREAM MANUAL 27 MAY 76 CALIFORNIA 92626 MACHINE MANUAL 27 MAY 76 76 STANFORD JOB-STREAM MANUAL 24 MAY 76 CALIFORNIA 94305 MACHINE MANUAL 24 MAY 76 NOTES 24 MAY 76 DR. JOHN C. REYNOLDS SOLO MANUALS * SEP 75 SYSTEMS AND INFORMATION SCIENCE SYRACUSE UNIVERSITY ******************* 313 LINK HALL SYRACUSE NEW YORK 13210 MR. R. E. WARD SOLO MANUALS 20 OCT 75 SYSTEMS AND INFORMATION SCIENCE NOTES 27 MAY 76 MR. TERRY HAMM SOLO MANUALS 10 NOV 75 TEKTRONIX INC. SOLO COPY 10 NOV 75 ************** SOLO FILES 10 NOV 75 P. O. BOX 500 BEAVERTON OREGON 97077 DR. RAFAEL M. BONET SOLO MANUALS 11 DEC 75 TELESINCRO S. A. SOLO COPY 11 DEC 75 **************** SOLO FILES 11 DE SOLO COPY 20 OCT 75 SYRACUSE UNIVERSITY SOLO FILES 20 OCT 75 ******************* REAL-TIME MANUAL 8 MAR 76 313 LINK HALL JOB-STREAM MANUAL 8 MAR 76 SYRACUSE MACHINE MANUAL 8 MAR 76 NEW YORK 13210 NOTES 8 MAR 76 MR. ERWIN BOOK SOLO MANUALS 29 APR 76 SYSTEM DEVELOPMENT CORPORATION C 75 INVESTIGACION Y DESSAROLLO 3 SOLO MANUALS 26 JAN 76 ROCAFORT 100 REAL-TIME MANUAL 3 FEB 76 BARCELONA JOB-STREAM MANUAL 3 FEB 76 SPAIN MACHINE MANUAL 3 FEB 76 NOTES 3 FEB 76 MR. EDWARD E. FERGUSON SOLO MANUALS 20 NOV 75 TEXAS INSTRUMENTS INC. SOLO FILES 20 NOV 75 * SOLO COPY 29 APR 76 ****************************** SOLO FILES 29 APR 76 MAIL DROP 5238 REAL-TIME MANUAL 29 APR 76 2500 COLORADO AVENUE JOB-STREAM MANUAL 29 APR 76 SANTA MONICA MACHINE MANUAL 29 APR 76 CALIFORNIA 90406 NOTES 29 APR 76 REAL-TIME MANUAL 1 JUN 76 JOB-S********************* 304 WYNN DRIVE N.W. HUNTSVILLE ALABAMA 35806 MR. GERALD G. MAXWELL SOLO MANUALS 11 JUN 76 EQUIPMENT GROUP SOLO FILES 11 JUN 76 TEXAS INSTRUMENTS INC. REAL-TIME MANUAL 11 JUN 76 ********************** JOB-STREAM MANUAL 11 JUN 76 P.O. BOX 6015 MACHINE MANUAL 11 JUN 76 DALLAS NOTES 11 JUN 76 TEXAS 752TREAM MANUAL 1 JUN 76 MACHINE MANUAL 1 JUN 76 NOTES 1 JUN 76 MR. VIC STENNING SOLO MANUALS 10 NOV 75 SYSTEMS DESIGNERS LTD. SOLO COPY 10 NOV 75 ********************** SOLO FILES 10 NOV 75 SYSTEMS HOUSE REAL-TIME MANUAL 4 FEB 76 57 - 61 HIGH STREET JOB-22 MR. GARY D. THOMAS SOLO FILES 18 FEB 76 8236 RESEARCH BOULEVARD #166 AUSTIN TEXAS 78758 PROFESSOR J. G. BYRNE SOLO MANUALS 3 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 3 DEC 75 TRINITY COLLEGE JOB-STREAM MANUAL 17 FEB 76 *************** MACHINE MANUAL 17 FEB 76 DUBLIN 2 NOTES 17 FEB 76 IRELAND MR. DENNSTREAM MANUAL 4 FEB 76 FRIMLEY MACHINE MANUAL 4 FEB 76 SURREY GU16 5HJ NOTES 4 FEB 76 UNITED KINGDOM DR. FRANS VERVERS SOLO MANUALS 10 NOV 75 DEPARTMENT OF MATHEMATICS SOLO COPY 10 NOV 75 TECHNICAL UNIVERSITY OF DELFT SOLO FILES 10 NOV 75 ***************************** JULIANALAAN 132 DELFT THE NETHERLANDS MRS. PETRA DALGAARD IS HEIMBIGNER SOLO MANUALS 10 NOV 75 TRW SYSTEMS GROUP SOLO FILES 10 NOV 75 ***************** REAL-TIME MANUAL 3 FEB 76 MAIL STATION R3/1072 JOB-STREAM MANUAL 3 FEB 76 1 SPACE PARK MACHINE MANUAL 3 FEB 76 REDONDO BEACH NOTES 3 FEB 76 CALIFORNIA 90278 MR. E. J. HOLDER SOLO MANUALS 15 DEC SOLO MANUALS 9 MAR 76 LIBRARIAN REAL-TIME MANUAL 9 MAR 76 INSTITUTE OF DATALOGY MACHINE MANUAL 9 MAR 76 TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 344 2800 LYNGBY DENMARK PROFESSOR CHRISTIAN GRAM SOLO MANUALS * SEP 75 INSTITUTE OF DATALOGY TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 344 2800 LYNGBY DENMARK MR. THOMAS JACOBSEN 75 TRW SYSTEMS GROUP SOLO COPY 15 DEC 75 ***************** SOLO FILES 15 DEC 75 ONE SPACE PARK REDONDO BEACH CALIFORNIA 90278 MR. GARY KANG REAL-TIME MANUAL 19 JUL 76 TRW SYSTEMS GROUP JOB-STREAM MANUAL 19 JUL 76 ***************** MACHINE MANUAL 19 JUL 76 BLDG. 90, RM. 2824 NOTES 19 JUL 76 ONE SPACE PARK REDONDO BEA SOLO MANUALS 24 NOV 75 NEUCC TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 305 2800 LYNGBY DENMARK MR. MOGENS THORSEN SOLO MANUALS 26 NOV 75 POLYTEKNISK BOGHANDEL TECHNICAL UNIVERSITY OF DENMARK ******************************* ANKER ENGELUNDSVEJ 1 2800 LYNGBY DENMARK MR. B. TER BRAAKE SOLO MANUALS 9 JAN 76 LIBRARY ADMINISTRATION SOLO COPY 9 JAN 76 TECHNICAL UNIVERSITY OF EINCH CALIFORNIA 90278 MR. LARRY MICHELS SOLO MANUALS 22 JUL 76 ADVANCED PRODUCTS LABORATORY MACHINE MANUAL 22 JUL 76 TRW NOTES 22 JUL 76 *** P.O. BOX 2921 TORRANCE CALIFORNIA 90510 MR. M. VERGES TRIAS SOLO MANUALS 11 DEC 75 CENTRO DE CALCULO DE LA SOLO COPY 11 DEC 75 UNIVERSIDAD POLITECNICA SOLO FILES 11 DEC 75 **********DHOVEN SOLO FILES 9 JAN 76 ********************************* P. O. BOX 513 EINDHOVEN THE NETHERLANDS IR. J.J. VAN AMSTEL SOLO MANUALS 9 JUL 76 COMPUTING CENTER TECHNICAL UNIVERSITY OF EINDHOVEN ********************************* P.O. BOX 513 EINDHOVEN THE NETHERLANDS DR. R. RECKERS SOLO MANUALS 2 AUG 76 TECHNISCHE HOGESCHOOL TWENTE **************************** POSTBUS 217 DRIENERLO ENSCHEDE THE NETHERLANDS JR. W. A. V************* REAL-TIME MANUAL 3 FEB 76 AVDA. DR. GREGORIO MARANON JOB-STREAM MANUAL 3 FEB 76 BARCELONA 14 MACHINE MANUAL 3 FEB 76 SPAIN NOTES 3 FEB 76 MR. HERNAN SUAREZ-FLAMERICH 3 SOLO MANUALS 24 JUN 76 EXECUTIVE DIRECTOR SOLO COPY 24 JUN 76 CENTRO DE INFORMACION Y COMPUTACION SOLO FILES 24 JUN 76 UNIVERSIDAD SIM NOTES 26 APR 76 ************* 322 NORTH 22ND WEST SALT LAKE CITY UTAH 84116 MR. ROBERT D. VAVRA SOLO MANUALS 16 FEB 76 SPERRY UNIVAC ************* M. S. 4993 2276 HIGHCREST DRIVE ROSEVILLE MINNESOTA 55113 DR. P. J. BLACK SOLO MANUALS 1 APR 76 E. R. SQUIBB & SONS INC. ************************ P.O. BOX 4000 PRINCETON NEW JERSEY 08540 MRS. LUCILLE STEELMAN SOLO MANUALS 21ERVOORT SOLO MANUALS 20 OCT 75 TECHNISCHE HOGESCHOOL TWENTE SOLO COPY 20 OCT 75 **************************** REAL-TIME MANUAL 13 FEB 76 POSTBUS 217 JOB-STREAM MANUAL 13 FEB 76 DRIENERLO MACHINE MANUAL 13 FEB 76 ENSCHEDE NOTES 13 FEB 76 THE NETHERLANDS DR. DAVID GRIES SOLO MANUALS * SEP 75 NOV 75 LIBRARIAN STANFORD RESEARCH INSTITUTE *************************** MENLO PARK CALIFORNIA 94025 DR. THOMAS H. BREDT SOLO MANUALS 21 OCT 75 DIGITAL SYSTEMS LABORATORY SOLO COPY 21 OCT 75 ERL 233 C SOLO FILES 21 OCT 75 STANFORD UNIVERSITY SOLO MANUALS 24 FEB 76 ******************* 2 REAL-TIME MANUALS 24 FEB 76 STANFORD 3 JOB-MATHEMATISCHES INSTITUT DER TECHNISCHEN HOCHSCHULE ********************** ARCISSTRASSE 21 D - 8 MUNICH 2 GERMANY DR. K.-P. LOEHR SOLO MANUALS 24 OCT 75 FORSCHUNGSGRUPPE BETRIEBSSYSTEME SOLO COPY 24 OCT 75 TECHNISCHE UNIVERSITAET BERLIN SOLO FILES 24 OCT 75 ****************************** REAL-TIME MANUAL 3 FEB 76 ROOM 1905 JOB-STREAM MANUAL 3 FEB 76 ERNST REUTER PLATZ 7 STREAM MANUALS 24 FEB 76 CALIFORNIA 94305 2 MACHINE MANUALS 24 FEB 76 3 NOTES 24 FEB 76 DR. ROGER L. COTTRELL SOLO MANUALS 26 SEP 75 STANFORD LINEAR ACCELERATOR CENTER SOLO FILES 10 NOV 75 STANFORD UNIVERSITY ******************* P. O. BOX 4349 STANFORD CALIFORNIA 94305 PROFESSOR R. W. FLOYD SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT STANFORD UNI MACHINE MANUAL 3 FEB 76 1 BERLIN 10 NOTES 3 FEB 76 GERMANY DR. W. BARTH SOLO MANUALS 9 DEC 75 INSTITUT FUER INFORMATIONSSYSTEME SOLO FILES 9 DEC 75 TECHNISCHE UNIVERSITAET WIEN REAL-TIME MANUAL 8 APR 76 **************************** JOB-STREAM MANUAL 8 APR 76 ARGENTIENERSTRASSE 8 MACHINE MANUAL 8 APR 76 A-1040 VIENNA VERSITY ******************* STANFORD CALIFORNIA 94305 PROFESSOR DONALD E. KNUTH SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT STANFORD UNIVERSITY ******************* STANFORD CALIFORNIA 94304 DR. DAVID LUCKHAM SOLO MANUALS 13 OCT 75 ARTIFICIAL INTELLIGENCE LABORATORY SOLO COPY 13 OCT 75 STANFORD UNIVERSITY SOLO MANUALS 24 MAY 76 ******************* REAL-TIME MANUAL 24 MAY NOTES 21 MAY 76 SOUTH AFRICA PROFESSOR WILLIAM M. WAITE MACHINE MANUAL * 30 SEP 75 ELECTRICAL ENGINEERING UNIVERSITY OF COLORADO ********************** BOULDER COLORADO 80302 MR. DAVID WOOD SOLO MANUALS 7 JUL 76 COMPUTING CENTER SOLO FILES 7 JUL 76 UNIVERSITY OF COLORADO NOTES 7 JUL 76 ********************** 3645 MARINE STREET BOULDER COLORADO 80309 UEBEC CANADA DR. PIERRE DESJARDINS JOB-STREAM MANUAL 3 FEB 76 DEPT. D'INFORMATIQUE NOTES 3 FEB 76 UNIVERSITE DE MONTREAL ********************** CASE POSTALE 6128 MONTREAL 101 PQ QUEBEC CANADA DR. GUY LOUCHARD SOLO MANUALS 19 JUL 76 LAB. INF. THEORIQUE REAL-TIME MANUAL 19 JUL 76 UNIVERSITE LIBRE DE BRUXELLES JOB-STREAM MANUAL 19 JUL 76 ***************************** C.P. 212 CA MR. OLE CAPRANI SOLO MANUALS 24 OCT 75 DATALOGISK INSTITUT SOLO COPY 24 OCT 75 UNIVERSITY OF COPENHAGEN REAL-TIME MANUAL 20 FEB 76 ************************ JOB-STREAM MANUAL 20 FEB 76 SIGURDSGADE 41 MACHINE MANUAL 20 FEB 76 2200 COPENHAGEN NOTES 20 FEB 76 DENMARK PROFESSOR PETER NAUR SOLO MANUALS * SEMPUS DE LA PLAINE ULB BOULEVARD DU TRIOMPHE 1050 BRUSSELS BELGIUM PROFESSOR C. GIRAULT SOLO MANUALS 10 NOV 75 INSTITUT DE PROGRAMMATION SOLO FILES 10 NOV 75 UNIVERSITE PARIS 6, T55 **************** 4 PLACE JUSSIEU 75230 PARIS CEDEX OS FRANCE DR. P. VANDEGINSTE MACHINE MANUAL 3 FEB 76 INSTITUT DE PROGRAMMATION NOTES 3 FEB 76 UNIVERSITE PARIS **************** TOUR 55 - 65 11 QUAI SAINT BERNARD P 75 DATALOGISK INSTITUT UNIVERSITY OF COPENHAGEN ************************ SIGURDSGADE 41 2200 COPENHAGEN DENMARK DR. T. KIMURA SOLO MANUALS 27 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO COPY 27 MAY 76 UNIVERSITY OF DELAWARE REAL-TIME MANUAL 27 MAY 76 ********************** JOB-STREAM MANUAL 27 MAY 76 NEWARK MACHINE MANUAL 27 MAY 76 DELAWARE 19711 75005 PARIS FRANCE DR. R. B. LAKE SOLO MANUALS 10 DEC 75 BIOMETRY SOLO COPY 10 DEC 75 WEARN BUILDING UNIVERSITY HOSPITALS ********************* CLEVELAND OHIO 44106 THE LIBRARY SOLO MANUALS SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES SEP 75 UNIVERSITY OF AARHUS MACHINE MANUAL 5 FEB 76 ******************** NOTES NOTES 27 MAY 76 DR. H. KEISTNER SOLO MANUALS 24 MAY 76 INFORMATIK III SOLO FILES 24 MAY 76 UNIVERSITY OF DORTMUND ********************** POSTFACH 50 05 00 46 DORTMUND 50 GERMANY DR. R. M. BURSTALL SOLO MANUALS * SEP 75 DEPARTMENT OF MACHINE INTELLIGENCE UNIVERSITY OF EDINBURGH *********************** HOPE PARK SQUARE MEADOW LANE EDINBURGH EH8 9NW UNITED KINGDOM DR. GILBERT J. HAN 5 FEB 76 NY MUNKEGADE 8000 AARHUS C DENMARK THE LIBRARY SOLO MANUALS 26 SEP 75 RECAU UNIVERSITY OF AARHUS ******************** NY MUNKEGADE 8000 AARHUS C DENMARK DR. W. P. BEAUMONT SOLO MANUALS 10 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY 10 DEC 75 UNIVERSITY OF ADELAIDE SOLO FILES 10 DEC 75 ********************** ADELAIDE SOUTH AUSTRALIA 5001 DR. ROGER HART SEN SOLO MANUALS 12 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 12 MAR 76 UNIVERSITY OF FLORIDA REAL-TIME MANUAL 12 MAR 76 ********************* JOB-STREAM MANUAL 12 MAR 76 512 WEIL HALL MACHINE MANUAL 12 MAR 76 GAINESVILLE NOTES 12 MAR 76 FLORIDA 32611 DR. WILLIAM FINDLAY SOLO MANUALS 17 DEC 75 COMPUTER SOLO MANUALS 17 JUN 76 COMPUTER SCIENCE DEPARTMENT REAL-TIME MANUAL 17 JUN 76 UNIVERSITY OF ALBERTA MACHINE MANUAL 17 JUN 76 ********************* NOTES 17 JUN 76 EDMONTON ALBERTA CANADA T6G 2E2 DR. T.A. MARSLAND SOLO COPY 27 JUL 76 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF ALBERTA ********************* EDMONTON ALBERTA CANADA T6G 2H1 DR. THEODORUS J. DEKKER SCIENCE DEPARTMENT SOLO COPY 17 DEC 75 UNIVERSITY OF GLASGOW REAL-TIME MANUAL 8 APR 76 ********************* JOB-STREAM MANUAL 8 APR 76 GLASGOW G12 8QQ MACHINE MANUAL 8 APR 76 SCOTLAND NOTES 8 APR 76 UNITED KINGDOM MS. E. CRIEGEE, LIBRARIAN REAL-TIME MANUAL 1 JUN 76 INFORMATION SCIENCE MACHINE MANUAL 1 JUN 76 SOLO MANUALS 6 JUL 76 UNIVERSITY OF AMSTERDAM *********************** ROETERSSTRAAT 15 AMSTERDAM THE NETHERLANDS MR. PATRICK G. PECORARO SOLO MANUALS 14 JUN 76 ASSISTANT DIRECTOR REAL-TIME MANUAL 14 JUN 76 UNIVERSITY COMPUTER CENTER JOB-STREAM MANUAL 14 JUN 76 UNIVERSITY OF ARIZONA MACHINE MANUAL 14 JUN 76 ********************* NOTES 14 JUN 76 TUCSON ARIZONA UNIVERSITY OF HAMBURG NOTES 1 JUN 76 ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY DR. HARTMUT FICHTEL SOLO MANUALS 23 SEP 75 INFORMATION SCIENCE SOLO FILES 23 SEP 75 UNIVERSITY OF HAMBURG ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY DR. D.L. EPLEY SOLO MANUALS 7 JUN 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 7 85721 PROFESSOR HANS ZIMA REAL-TIME MANUAL 20 JUL 76 INSTITUT FUER INFORMATIK MACHINE MANUAL 20 JUL 76 ABT. III UNIVERSITY OF BONN ****************** KURFUERSTENSTRASSE 74 5300 BONN GERMANY DR. GRAHAM BIRTWISTLE SOLO MANUALS 25 JUN 76 COMPUTING LABORATORY SOLO FILES 25 JUN 76 UNIVERSITY OF BRADFORD REAL-TIME MANUAL 25 JUN 76 ********************** JOB-STREAM MANJUN 76 UNIVERSITY OF IOWA REAL-TIME MANUAL 7 JUN 76 ****************** JOB-STREAM MANUAL 7 JUN 76 IOWA CITY MACHINE MANUAL 7 JUN 76 IOWA 52333 NOTES 7 JUN 76 PROFESSOR GERHARD GOOS SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF KARLSRUHE *********************** POSTFACH 6380 75 KARLSRUHE 1 D-75 GERMANY DR. V. HAASE UAL 25 JUN 76 BRADFORD MACHINE MANUAL 25 JUN 76 ENGLAND NOTES 25 JUN 76 PROFESSOR J.E.L. PECK SOLO MANUALS 20 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO COPY 20 APR 76 UNIVERSITY OF BRITISH COLUMBIA SOLO FILES 20 APR 76 ****************************** REAL-TIME MANUAL 20 APR 76 VANCOUVER JOB-STREAM MANUAL SOLO MANUALS 13 MAY 76 COMPUTER SCIENCE DEPARTMENT REAL-TIME MANUAL 13 MAY 76 UNIVERSITY OF KARLSRUHE MACHINE MANUAL 13 MAY 76 *********************** KAISERSTRASSE 12 7500 KARLSRUHE GERMANY DR. P. KAMMERER SOLO MANUALS 13 OCT 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 13 OCT 75 UNIVERSITY OF KARLSRUHE REAL-TIME MANUAL 25 MAR 76 *********************** 20 APR 76 BRITISH COLUMBIA V6T 1W5 MACHINE MANUAL 20 APR 76 CANADA NOTES 20 APR 76 DR. JAY EARLEY SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF CALIFORNIA, BERKELEY ********************************** BERKELEY CALIFORNIA 94720 PROFESSOR ROBERT FABRY SOLO MANUAL * 17 NOV 75 COMPUTER SCIENCE DEPARTMENT 573 EWANS HALL UNIVERSITY OF CALIFORNIA, BERKELEY *DLoqsuwacxz|~y{}     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?ACEGdfPRTVXZ\^`begQSUWY[]_achjlnpr********************************* BERKELEY CALIFORNIA 94720 DR. ERIC OLSEN REAL-TIME MANUAL 13 JUL 76 ICS DEPARTMENT JOB-STREAM MANUAL 13 JUL 76 UNIVERSITY OF CALIFORNIA, IRVINE MACHINE MANUAL 13 JUL 76 ******************************** NOTES 13 JUL 76 IRVINE CALIFORNIA 92717 DR. MARK OVERGAARD REAL-TIME MANUAL 24 MAY 76 UNIVERSITY OF CALIFORNIA, SAN DIEGO MACHINE MANUAL "################## # KERNEL TEST 9 # ##################" "NORMAL KERNEL WILL TEST: CORE (CORELIMIT) COMMON = INTERPRETERLENGTH + PROGRAMLENGTH + STACKLENGTH + VARLENGTH + 2 PRIVATE = STACKLENGTH + 2 SELECT MAX1 SUCH THAT KERNELLENGTH + COMMON = 16448 (16 K + 64) SELECT MAX2 SUCH THAT PRIVATE = 8130 (8 K - 62)" CONST MAX1 = 8084; PROCESSLIMIT = 10; TYPE "INSERT IO TYPES AND CONSOLE CLASS FROM KERNEL TEST 7 HERE" IODEVICE =(TTY, DISK, TAPE, PRINTER, CARDREADER); IOOPERATION = (INPUT, OUTPUT, MON BOLIVAR 3 REAL-TIME MANUALS 24 JUN 76 ************************* 3 JOB-STREAM MANUALS 24 JUN 76 APARTADO POSTAL 80659 3 MACHINE MANUALS 24 JUN 76 CARACAS 3 NOTES 24 JUN 76 VENEZUELA PROFESSOR E. MILGROM SOLO MANUALS 20 OCT 75 UNITE D'INFORMATIQUE SOLO COPY 20 OCT 75 UNIVERSITE CATHOLIQUE DE LOUVAIN SOLO FILES 20 OCT 75 *********** 24 MAY 76 *********************************** NOTES 24 MAY 76 APIS (C-014) LA JOLLA CALIFORNIA 92093 PROFESSOR K.J. MACGREGOR SOLO MANUALS 16 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 16 APR 76 UNIVERSITY OF CAPE TOWN REAL-TIME MANUAL 21 MAY 76 *********************** JOB-STREAM MANUAL 21 MAY 76 PRIVATE BAG MACHINE MANUAL 21 MAY 76 RONDEBOSCH 7700 ********************* CHEMIN DU CYCLOTRON 2 B-1348 LOUVAIN-LA-NEUVE BELGIUM DR. G. V. BOCHMANN SOLO MANUALS 8 OCT 75 DEPT. D'INFORMATIQUE SOLO COPY 8 OCT 75 UNIVERSITE DE MONTREAL MACHINE MANUAL 17 NOV 75 ********************** REAL-TIME MANUAL 3 FEB 76 CASE POSTALE 6128 JOB-STREAM MANUAL 3 FEB 76 MONTREAL 101 PQ NOTES 3 FEB 76 Q$JMOQSUWZ\^NPRTVX[]_dfhjlnprtv`begikmoqsuwacxz|~y{}     ,.0246 "$&(*-/1357!#%')+HJLN8:<>@BDFIKMO9;=?KY[]_Z\^cegikmoqsuwadfhjlnprtv`by{}xz|~     +-/1357!#%'),.0246 "$&(*GIKMO9;=?ACEHJLN8:<>@BDFcegQSUW (NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY,"INTERPRETER TEST #3" "TESTS CLASSES, MONITORS, PROCESSES, AND QUEUES" "-- RUN WITH INTERPRETER TRACE" TYPE CLTYP = CLASS VAR I: INTEGER; PROCEDURE ENTRY ENTCL; VAR I: INTEGER; BEGIN I:=656; END; BEGIN I:=724; END; MONTYP = MONITOR VAR Q: QUEUE; B: BOOLEAN; PROCEDURE ENTRY ENTMON; VAR I: INTEGER; BEGIN IF B THEN BEGIN B:=FALSE; DELAY(Q); END; I:=473; CONTINUE(Q); END; BEGIN "CLEAR(Q);" B:=EMPTY(Q); B:=TRUE; END; OVE, CONTROL); IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); IOARG = (OUTEOF, REWIND, UPSPACE, BACKSPACE, UNLOAD); IOPARAM = RECORD OPERATION: IOOPERATION; RESULT: IORESULT; ARG: IOARG END; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE CONSOLE = CLASS PROCEDURE WRITE(C: CHAR); VAR PARAM: IOPARAM; CTEMP:CHAR; B SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDEHALF = 0.5; VAR S,X:REAL; I,EXP,TEMP: INTEGER; BEGIN IF (0<=FP) & (FP<=MAX_SIGNIF_DIGITS) & (TP>=FP+7) & (TP<=LINELENGTH) THEN BEGIN FOR I:=8 TO TP-FP DO WRITE(' '); IF R=ZERO THEN BEGIN WRITE(' '); WRITE('0'); WRITE('.'); WRITE('0') END ELSE BEGIN IF R=TEN THEN BEGIN EXP:=EXP+1; S:=S/TEN END ELSE IF S=TEN THEN BEGIN EXP:=EXP+1; S:=S/TEN END; TEMP:=TRUNC(S); S:= TEN * (S-CONV(TEMP)); WRITE(CHR(ORD('0')+TEMP)); WRITE('.'); FOR I:=1 TO FP DO BEGIN TEMP:=TRUNC(S); S:= TEN * (S-CONV(TEMP)); WRITE(CHR(ORD('0')+TEMP) PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE ) END; WRITE('E'); IF EXP<0 THEN BEGIN EXP:=-EXP; WRITE('-') END ELSE WRITE('+'); WRITE(CHR(ORD('0')+ EXP DIV 10)); WRITE(CHR(ORD('0')+ EXP MOD 10)) END END ELSE "ERROR" END; PROCEDURE WRITE_REAL (R: REAL); BEGIN PRINTREAL(R,23,16); WRITE(NL); END; FUNCTION FUNCTION1(X: INTEGER): INTEGER; BEGIN FUNCTION1:=X+300; END; PROCEDURE PROCEDURE1(X: INTEGER); BEGIN WRITE_INT(X); END; PROCEDURE PROCEDURE2(VAR X: INTEGER); BEGIN WRITPUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSE_INT(X); END; PROCEDURE PROCEDURE3; VAR RECORD_PTR: RECPTR; BEGIN NEW(RECORD_PTR); RECORD_PTR@.N := 103; WRITE_INT(RECORD_PTR@.N); END; PROCEDURE INTERPRETER_TEST; VAR I, X, Y: INTEGER; S: STRING; W: REAL; C: CHAR; B: BOOLEAN; R: RECORD I, N: INTEGER END; SET1: SETTYPE; PTR1, PTR2: INTPTR; PTR3: RECPTR; REC: VARREC; BEGIN "CONSTADDR" S:=' TMZ'; WRITE_STRING(S); " TMZ" "LOCALADDR" X:=1319; WRITE_INT(X); EQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "INTERPRETER TEST #4" "TESTS THE NORMAL EXECUTION OF ALL INSTRUCTIONS USED BY SEQUENTIAL PASCAL" CONS "1319" "GLOBADDR" GX:=1776; WRITE_INT(GX); "1776" "PUSHCONST" X:=1492; WRITE_INT(X); "1492" "PUSHLOCAL" Y:=6; X:=Y; WRITE_INT(X); "6" "PUSHGLOB" GY:=636; X:=GY; WRITE_INT(X); "636" "PUSHIND" X:=1004; PROCEDURE2(X); "1004" "PUSHBYTE" C:='X'; WRITE_CHAT NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; TYPE SPLITREAL = ARRAY(.1..4.) OF INTEGER; STRING = ARRAY (.1..4.) OF CHAR; SETTYPE = SET OF 0..127; INTPTR = @ INTEGER; REC = RECORD N: INTEGER; P: INTPTR END; RECPTR = @ REC; FORMTAG = (CHARTYPE,INTTYPE); VARREC = RECORD CASE FORM: FORMTAG OF CHARTYPE: (C: CHAR); INTTYPE: (N: INTEGER) END; VAR GX, GY: INTEGER; PROCEDURE WRITE(C: CHAR); BEGIN DISPLAY(C) END; PROCEDUR(C); "X" "PUSHREAL" W:=106.2; WRITE_REAL(W); "106.2" "PUSHSET" SET1:=(.1,2,3,125,126,127.); WRITE_SET(SET1); "01110...0111" "FIELD" R.N:=11; WRITE_INT(R.N); "11" "INDEX" S(.1.):='*'; S(.2.):='/'; S(.3.):='*'; S(.4.):='/'; WRITE_STRING(S); "*/*/" "POINTER" NEW(PTR1); PTR1@ := 524; WPROCTYP = PROCESS(M: MONTYP); VAR I: INTEGER; PROCEDURE ENTRY ENTPROC; VAR I: INTEGER; BEGIN I:=101; END; BEGIN M.ENTMON; END; VAR I: INTEGER; CL: CLTYP; MON: MONTYP; PROC1, PROC2: PROCTYP; BEGIN INIT CL; CL.ENTCL; INIT MON; INIT PROC1(MON); INIT PROC2(MON); I:=ATTRIBUTE(4); "LINE" I:=REALTIME; END. EGIN IF B THEN BEGIN B:=FALSE; DELAY(Q); END; I:=473; CONTINUE(Q); END; BEGIN "CLEAR(Q);" B:=EMPTY(Q); B:=TRUE; END; RE WRITE_INT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBER(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE WRITE_SET(S: SETTYPE); VAR I, J, K: INTEGER; BEGIN I:=0; FOR J:=0 TO 7 DO BEGIN FOR K:=0 TO 15 DO BEGIN IF I IN S THEN WRITE(RITE_INT(PTR1@); "524" "VARIANT" REC.FORM := INTTYPE; REC.N := 739; WRITE_INT(REC.N); "739" "RANGE" "NOT CURRENTLY USED" "COPYBYTE" S(.1.):='P'; S(.2.):='T'; S(.3.):='L'; S(.4.):=' '; WRITE_STRING(S); "PTL " "COPYWORD" X:=26; WRITE_INT(X); "26" "COPYREAL" W:=98.6; WRITE_REAL(W); "98.6" '1') ELSE WRITE('0'); I:=I+1; END; WRITE(NL); END; END; PROCEDURE WRITE_BOOL(B: BOOLEAN); BEGIN IF B THEN WRITE('1') ELSE WRITE('0'); WRITE(NL); END; PROCEDURE WRITE_CHAR(C: CHAR); BEGIN WRITE(C); WRITE(NL); END; PROCEDURE WRITE_STRING(S: STRING); VAR I: INTEGER; BEGIN FOR I:=1 TO 4 DO WRITE(S(.I.)); WRITE(NL); END; PROCEDURE POWER(VAR R: REAL; P: INTEGER); CONST TEN = 10.0; ONE = 1.0; VAR LOCALP: INTEGER; MULTIPLIER: REAL; BEGIN R:=ONE; MULTIPLIER:=TEN; LOCALP:=P; "COPYSET" SET1:=(.1,2,3,126.); WRITE_SET(SET1); "01110...0010" "COPYTAG" REC.FORM := CHARTYPE; REC.C := '#'; WRITE_CHAR(REC.C); "#" "COPYSTRUC" S:='ABCD'; WRITE_STRING(S); "ABCD" "NEW" PTR1@ := 634; NEW(PTR2); PTR2@ := 635; WRITE_INT(PTR1@); "634" WRITE_INT(PTR2@); "635" "NEWINIT" PTR2@ := WHILE LOCALP>1 DO BEGIN IF (LOCALP MOD 2) = 1 THEN R:=R*MULTIPLIER; MULTIPLIER:=MULTIPLIER*MULTIPLIER; LOCALP:=LOCALP DIV 2 END; IF (LOCALP MOD 2) = 1 THEN R:=R*MULTIPLIER END; FUNCTION EXPO(A: UNIV SPLITREAL): INTEGER; VAR I: INTEGER; BEGIN I:=A(.1.); IF I>=0 THEN EXPO:=I DIV 128 - 129 ELSE EXPO:=I DIV 128 + 127 END; PROCEDURE PRINTREAL(R: REAL; TP,FP: INTEGER); CONST MAX_SIGNIF_DIGITS = 17; LOG2BASE10 = 0.301029995663981195; ZERO = 0.0; ONE = 1.0; TWO = 2.0; TEN = 10.0; ON 987; NEW(PTR3); PTR3@.P := PTR2; WRITE_INT (PTR2@); "987" WRITE_INT (PTR3@.P@); "987" "NOT" B:=FALSE; WRITE_BOOL(B); "0" B:=NOT(B); WRITE_BOOL(B); "1" B:=NOT(B); WRITE_BOOL(B); "0" "ANDWORD" WRITE_BOOL(FALSE&FALSE); "0" WRITE_BOOL(FALSE&TRUE ); 2,3.)<=(.1,2,3,4.)); "1" "LSSTRUCT" WRITE_BOOL('XXXB'<'XXXA'); "0" WRITE_BOOL('XXXB'<'XXXB'); "0" WRITE_BOOL('XXXB'<'XXXC'); "1" "EQSTRUCT" WRITE_BOOL('XXXB'='XXXA'); "0" WRITE_BOOL('XXXB'='XXXB'); "1" WRITE_BOOL('XXXB'='XXXC'); "0" "GRSTRUCT" WRITE_BOOL('XXXB'>'XXXA'); HELP; END ELSE IF ID = 'DEP ' THEN BEGIN READSPEC('('); READOCTAL(ADDR); READSPEC(','); READOCTAL(VALUE); READSPEC(')'); IF OK THEN BEGIN DISKIO(INPUT, PAGENO, BLOCK); BLOCK(.WORDNO.):= VALUE; DISKIO(OUTPUT, PAGENO, BLOCK); END ELSE HELP; END ELSE IF ID = 'EXIT ' THEN DONE:= TRUE ELSE HELP; UNTIL DONE; PARAM(.1.).BOOL:= OK; END.  "1" WRITE_BOOL('XXXB'>'XXXB'); "0" WRITE_BOOL('XXXB'>'XXXC'); "0" "NLSTRUCT" WRITE_BOOL('XXXB'>='XXXA'); "1" WRITE_BOOL('XXXB'>='XXXB'); "1" WRITE_BOOL('XXXB'>='XXXC'); "0" "NESTRUCT" WRITE_BOOL('XXXB'<>'XXXA'); "1" WRITE_BOOL('XXXB'<>'XXXB'); "0" WRITE_BOOL('XXXB'<>'XXXC'); ~xz|y{}     *,.0246 "$&(+-/1357!#%')FHJLN8:<>@BDGIKMO9;=?ACEbdfPRTVXZ\^`cegQSUWY[]_a~hjlnprtvxz|ik "0" WRITE_BOOL(TRUE &FALSE); "0" WRITE_BOOL(TRUE &TRUE ); "1" "ANDSET" SET1:=(.1,2,3,125,126,127.)&(.2,126.); WRITE_SET(SET1); "00100...0010" "ORWORD" WRITE_BOOL(FALSE OR FALSE); "0" WRITE_BOOL(FALSE OR TRUE ); "1" WRITE_BOOL(TRUE OR FALSE); "1" WRITE_BOOL(TRUE OR TRUE ); "1" "NGSTRUCT" WRITE_BOOL('XXXB'<='XXXA'); "0" WRITE_BOOL('XXXB'<='XXXB'); "1" WRITE_BOOL('XXXB'<='XXXC'); "1" "FUNCVALUE" X:=FUNCTION1(0); WRITE_INT(X); "300" "JUMP" IF TRUE THEN X:=0 ELSE X:=1; WRITE_INT(X); "0" "FALSEJUMP" IF FALSE THEN X:=0 ELSE X:=1; WRITE_INT(X); "1" "ORSET" SET1:=(.1,2,3,125,126,127.) OR (.4,124.); WRITE_SET(SET1); "011110...01111" "NEGWORD" Y:=22; X:=-Y; WRITE_INT(X); "-22" WRITE_INT(-X); "22" "NEGREAL" W:=13.6; W:=-W; WRITE_REAL(W); "-13.6" WRITE_REAL(-W); "13.6" "ADDWORD" WRITE_INT(256+17); "1" "CASEJUMP" CASE 3 OF 1: X:=101; 2: X:=102; 3: X:=103; 4: X:=104 END; WRITE_INT(X); "103" "INITVAR" PROCEDURE3; "103" "CALL" PROCEDURE1(1539); "1539" "CALLSYS" "USED TO CALL WRITE" "ENTER & EXIT" PROCEDURE1(1984); "1984" "ENTERPROG & EXITPROG" "TESTED ON EXECUTION OF THIS PROGRAM" "POP" FOR I:=1 TO "273" "ADDREAL" WRITE_REAL(10.0+16.2); "26.2" "SUBWORD" WRITE_INT(256-17); "239" "SUBREAL" WRITE_REAL(10.0-16.2); "-6.2" "SUBSET" SET1:=(.1,2,3,125,125,127.)-(.2,126.); WRITE_SET(SET1); "01010...0101" "MULWORD" WRITE_INT(4*24); "96" "MULREAL" WRITE_REAL(1.5*20.0); 4 DO S(.I.):='Z'; WRITE_STRING(S); "ZZZZ" FOR I:=1 TO 4 DO S(.I.):='X'; WRITE_STRING(S); "XXXX" "NEWLINE" "WILL BE CHECKED IN A PROGRAM THAT CAUSES AN ERROR" "INCRWORD" FOR I:=1 TO 3 DO WRITE_INT(600+I); "601 602 603" "DECWORD" FOR I:=3 DOWNTO 1 DO WRITE_INT(500+I); "503 502 501" "PUSHLABEL" "????" "TRUNCREAL" WRITE_INT(TRUNC(7.5)); "7 "30.0" "DIVWORD" WRITE_INT(556 DIV 2); "278" "DIVREAL" WRITE_REAL(16.4/4.0); "4.1" "MODWORD" WRITE_INT(14 MOD 12); "2" "BUILDSET" WRITE_SET((.1,2,126,127.)); "01100...0011" "INSET" WRITE_BOOL(2 IN (.1,2,126,127.)); "1" WRITE_BOOL(3 IN (.1,2,126,127.)); "0" "LSWORD" WRITE_BOOL(2<1); " "ABSWORD" WRITE_INT(ABS(637)); "637" WRITE_INT(ABS(-625)); "625" "ABSREAL" WRITE_REAL(ABS(24.8)); "24.8" WRITE_REAL(ABS(-22.4)); "22.4" "SUCCWORD" WRITE_INT(SUCC(572)); "573" "PREDWORD" WRITE_INT(PRED(429)); "428" "CONVWORD" WRITE_REAL(CONV(68)); "68.0" "0" WRITE_BOOL(2<2); "0" WRITE_BOOL(2<3); "1" "EQWORD" WRITE_BOOL(2=1); "0" WRITE_BOOL(2=2); "1" WRITE_BOOL(2=3); "0" "GRWORD" WRITE_BOOL(2>1); "1" WRITE_BOOL(2>2); "0" WRITE_BOOL(2>3); "SETHEAP" "????" END; BEGIN INTERPRETER_TEST; END.  "428" "CONVWORD" WRITE_REAL(CONV(68)); "68.0" "0" "NLWORD" WRITE_BOOL(2>=1); "1" WRITE_BOOL(2>=2); "1" WRITE_BOOL(2>=3); "0" "NEWORD" WRITE_BOOL(2<>1); "1" WRITE_BOOL(2<>2); "0" WRITE_BOOL(2<>3); "1" "NGWORD" WRITE_BOOL(2<=1); "0" WRITE_EGIN CTEMP:=C; PARAM.OPERATION:= OUTPUT; IO(CTEMP, PARAM, TTY); END; PROCEDURE READ(VAR C: CHAR); VAR PARAM: IOPARAM; BEGIN PARAM.OPERATION:= INPUT; IO(C, PARAM, TTY); END; PROCEDURE ENTRY WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); WRITE(C); UNTIL C = NL; END; PROCEDURE ENTRY WRITEINT(INT: INTEGER); VAR NUMBER: ARRAY (.1..6.) OF CHAR; DIGIT, REM, I: INTEGER; BEGIN DIGIT:= 0; REM:= INT; REPEAT DIGIT:= DIGIT + 1; NUMBEBOOL(2<=2); "1" WRITE_BOOL(2<=3); "1" "LSREAL" WRITE_BOOL(2.0<1.0); "0" WRITE_BOOL(2.0<2.0); "0" WRITE_BOOL(2.0<3.0); "1" "EQREAL" WRITE_BOOL(2.0=1.0); "0" WRITE_BOOL(2.0=2.0); "1" WRITE_BOOL(2.0=3.0); "0R(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0')); REM:= REM DIV 10; UNTIL REM = 0; IF INT < 0 THEN WRITE('-'); FOR I:= DIGIT DOWNTO 1 DO WRITE(NUMBER(.I.)); WRITE(NL); END; PROCEDURE ENTRY READTEXT(VAR TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; READ(C); TEXT(.I.):= C; UNTIL C = NL; END; BEGIN END; VAR TERMINAL: CONSOLE; FILLER: ARRAY (.1..MAX1.) OF CHAR; CHILD: ARRAY (.2..PROCESSLIMIT.) OF PROCESS "MAX2 = " +8098 BEGIN END; I: INTEGER; BEGIN " "GRREAL" WRITE_BOOL(2.0>1.0); "1" WRITE_BOOL(2.0>2.0); "0" WRITE_BOOL(2.0>3.0); "0" "NLREAL" WRITE_BOOL(2.0>=1.0); "1" WRITE_BOOL(2.0>=2.0); "1" WRITE_BOOL(2.0>=3.0); "0" "NEREAL" WRITE_BOOL(2.0<>1.0); "1" WRITE_BOOL(2.0<>2.0); INIT TERMINAL; WITH TERMINAL DO FOR I:= 2 TO PROCESSLIMIT DO BEGIN INIT CHILD(.I.); WRITEINT(I) END; END.  "0" WRITE_BOOL(2.0<>3.0); "1" "NGREAL" WRITE_BOOL(2.0<=1.0); "0" WRITE_BOOL(2.0<=2.0); "1" WRITE_BOOL(2.0<=3.0); "1" "EQSET" WRITE_BOOL((.1,2,3.)=(.1,2.)); "0" WRITE_BOOL((.1,2,3.)=(.1,2,3.)); "1" WRITE_BOOL((.1,2,3.)=(.1,2,3,4.)); "0" "NLSET" WRITE_BOOL((.1,2,3.)>=(ER; BEGIN FOR I:= 1 TO 6 DO READDIGIT(D(.I.)); N:= 0; IF D(.1.) <> 0 THEN BEGIN FOR I:= 2 TO 6 DO N:= 8*N + (7 - D(.I.)); N:= -(N + 1); END ELSE FOR I:= 2 TO 6 DO N:= 8*N + D(.I.); END; FUNCTION PAGENO: INTEGER; BEGIN PAGENO:= ADDR DIV 512 END; FUNCTION WORDNO: INTEGER; BEGIN WORDNO:= ADDR MOD 512 DIV 2 END; PROCEDURE DISKIO(COMMAND: IOOPERATION; PAGENO: UNIV IOARG; VAR BLOCK: UNIV PAGE); VAR PARAM: IOPARAM; BEGIN WITH PARAM DO BEGIN OPERATION:= COMMAND; ARG.1,2.)); "1" WRITE_BOOL((.1,2,3.)>=(.1,2,3.)); "1" WRITE_BOOL((.1,2,3.)>=(.1,2,3,4.)); "0" "NESET" WRITE_BOOL((.1,2,3.)<>(.1,2.)); "1" WRITE_BOOL((.1,2,3.)<>(.1,2,3.)); "0" WRITE_BOOL((.1,2,3.)<>(.1,2,3,4.)); "1" "NGSET" WRITE_BOOL((.1,2,3.)<=(.1,2.)); "0" WRITE_BOOL((.1,2,3.)<=(.1,2,3.)); "1" WRITE_BOOL((.1,:= PAGENO; IOTRANSFER(DISKDEVICE, PARAM, BLOCK); WHILE STATUS <> COMPLETE DO BEGIN WRITETEXT('DISK ERROR #'); IOTRANSFER(DISKDEVICE, PARAM, BLOCK); END; END; END; BEGIN IDENTIFY('PATCH: (:10:)'); OK:= TRUE; DONE:= FALSE; REPEAT READCHAR; READWORD(ID); IF ID = 'EXAM ' THEN BEGIN READSPEC('('); READOCTAL(ADDR); READSPEC(')'); IF OK THEN BEGIN DISKIO(INPUT, PAGENO, BLOCK); WRITEOCTAL(BLOCK(.WORDNO.)); END ELSE z     246 "$&(*,.0357!#%')+-/1N8:<>@BDFHJLO9;=?ACEGIKMRTVXZ\^`bdfPSUWY[]_acegQnprtvxz|~hjloqsuwy{}ikm= 172220; SUPERVISOR DATA DESCR REGS 0-7 SISAR = 172240; SUPERVISOR INSTR ADDR REGS 0-7 SDSAR = 172260; SUPERVISOR DATA ADDR REGS 0-7 ;* ;* KISDR = 172300; KERNEL INSTR DESCR REGS 0-7 KDSDR = 172320; KERNEL DATA DESCR REGS 0-7 KISAR = 172340; KERNEL INSTR ADDR REGS 0-7 KDSAR = 172360; KERNEL DATA ADDR REGS 0-7 ;* ;* .PAGE ;**** SEGMENT DESCRMOVE(1) WRITE(AUTOLOAD) BACKUP(WRITE) MOVE(2) BACKUP(CHECK) MOVE(1)  .END ;END THE ASSEMBLY  TEST ST(S); S:+2; MOV (S)+,W ; W:=ST(S); S:+2; MOV (S)+,B ; B:=ST(S); S:+2; MOV (S)+,G ; G:=ST(S); S:+2; MOV (S)+,Q ; Q:=ST(S); S:+2; MOV W,S ; S:=W; CLR JOB ; CLEAR ST(JOB); 2$: NEXT ; END; ; ; INTEND= . IPTOR REGISTER DEFINITIONS ***** ;* ;* THE SDR FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* SDRACF = ^B0000000000000001; 3 BITS - ACCESS CONTROL FIELD SDRED = ^B0000000000001000; 1 BIT - EXPANSION DIRECTION ;* = ^B0000000000110000; 2 BITS - NOT USED SDRWR = ^B0000000001000000; 1 BIT - WRITE TO SEGMENT SDRAT = ^B0000000010000000; 1 BIT - ACCESS TRAPPED SDRPLF = ^B0000000100000000; 7 BITS - SEGMENT LENGTH ;* = ^B10 EXPANSION DIRECTION UP, ;* 128 BLOCKS. ;* SDRDEF USDR,SDRNWN,SDREDU,.SGSBK; ;* ;* DEFINE THE KERNEL SDR VALUE: ;* ;* ALLOW READ AND WRITE, ;* EXPANSION DIRECTION UP, ;* 128 BLOCKS. ;* KSDR = USDR; ;* ;* .PAGE .SBTTL PSW DEFINITIONS ;**** PROCESSOR STATUS WORD FORMAT ***** ;* ;* THE PSW FIELDS ARE DEC " <( " " #^P  >" " 2 V >"" \^  PB0>  L" "" \X  P0>  L"00000000000000; 1 BIT - NOT USED ;* ;* ACCESS CONTROL FIELD BITS ;* SDRAWA = ^B000; READ ABORT, WRITE ABORT SDRTWA = ^B001; READ TRAP , WRITE ABORT SDRNWA = ^B010; READ , WRITE ABORT SDRTWT = ^B100; READ TRAP , WRITE TRAP SDRNWT = ^B101; READ , WRITE TRAP SDRNWN = ^B110; READ , WRITE ;* ;* THE EXPANSION DIRECTION BIT ;* SDREDU = 0; " `(  "th*\@PJDP8"""  ^" X"&  r*"A ` Z`2  V24 >"   $ E CARD SERIALIZATION ;* ;* ;* ;* ;* THE RSX11M KERNEL BUILDER REQUIRES A RELOCATABLE ;* ASSEMBLY. THEREFORE, THE FOLLOWING ;* ASECT IS CONVERTED INTO A COMMENT. ; .ASECT ; ;* ;* ;* .PAGE .SBTTL PROGRAMMER IDENTIFICATION ;**** A DECLARATION OF RESPONSIBILITY ***** ;* ;* ;************** ;* ;* THE DESIGN OF THIS KERNEL FOR CONCURRENT PASCAL IS BY ;* ;* PER BRINCH HANSEN; ;* ;* THE HIGH LEVEL ENCODING IS BY ;* ;* PER BRINCH HANSEN, ;* 0 ` 7`26 0B""8 " `  H "^" `<  H B>" >:"f" `6  H >"$  ROBERT S. DEVERILL; ;* ;* THE ASSEMBLER LEVEL ENCODING IS BY ;* ;* ROBERT S. DEVERILL:_ ;* ;* BOTH OF WHOM ARE OF ;* ;* INFORMATION SCIENCE ;* ENGINEERING DIVISION ;* CALIFORNIA INSTITUTE OF TECHNOLOGY ;* PASADENA CALIFORNIA. ;* ;************** ;* ;* THE DATE OF THIS CURRENT VERSION IS 9 JUNE 1975. ;* ;* THE ORIGINAL VERSION WAS WRITTEN BY 10 DEC 1974. ;* ;* ;******************************************** .PAGE L"$ PL". "  " & ^4~j & <""Fx() Jdh $  x  (, .SBTTL PROCESSOR REGISTER NAMES ;**** REGISTER NAMES ***** ;* ;* ;* THE REGISTER NAMES WHICH ARE USED IN MOST OF THIS MODULE ARE THE ;* NAMES SUPPLIED BY THE ASSEMBLER, TO WIT: ;* R0 = %0; R1 = %1; R2 = %2; R3 = %3; R4 = %4; R5 = %5; SP = %6; PC = %7; ;* ;* ;* WE WILL REFER TO THE REGISTERS BY THEIR CONVENTIONAL PASCAL ;* NAMES ONLY ON THE RARE OCCASIONS WHEN THIS IS RELEVANT. THE ;* PASCAL NAn ,T) h "^8x"     "TRY AGAIN# EXAM(ADDR)# DEP(ADDR, VALUE)# EXIT#USING# ADDR, VALUE: 000000..777776 # DISK ERROR #PATCH: EXAM DEP EXIT   (,MES ARE: ;* W = R0; WORD OR REAL SCRATCH REGISTER 0, X = R1; WORD OR REAL SCRATCH REGISTER 1, Y = R2; WORD SCRATCH REGISTER 2, Q = R3; USER CODE POINTER, B = R4; USER LOCAL BASE REGISTER, G = R5; USER GLOBAL BASE REGISTER, S = SP; PROCESSOR STACK TOP REGISTER, P = PC; J("$   ( "4"B `"j  jm>  R R RR&4""j  TP Xj  j > "4 mX "" " Lj$j j> PROCESSOR PROGRAM COUNTER. ;* ;* BLOCK NUMBER FOR PROCESSOR INTERNAL REGISTERS ;* .PRBLK = 7600; BLOCK NUMBER OF THE HARDWARE ;* PERIPHERALS AND REGISTERS AREA ;* ;* PROCESSOR INTERNAL REGISTERS ;* PSW = 177776; PROCESSOR STATUS WORD SLR = 177774; STACK LIMIT REGISTER PIR = 177772; PROGRAM INTERRUPT REGISTER CSDR = 177570; CONSOLE SWITC j$j j> j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `"H AND DISPLAY REG LKS = 177546; KW11-L LINE FREQUENCY CLOCK ;* ;* BIT DEFINITIONS FOR LKS ;* ;* = ^B1111111100000000; 8 BITS - NOT USED LKSMON = ^B0000000010000000; FREQUENCY MONITOR BIT LKSINE = ^B0000000001000000; ENABLE INTERRUPT MODE ;* = ^B0000000000111111; 6 BITS - NOT USED ;* ;* .PAGE .SBTTL MACHINE CORE PARAMETERS ;**** MACHINE CORE SIZE PARAMETERS ***** ;* ;* .BLKSW = 32.;  *XPRINTER:  j*""B `<"B Hj =XH" >"6"(   ($""B `" X eX6" >"  " >B `" SIZE OF SEGMENTATION BLOCK, WORDS .BLKSB = .BLKSW * 2.; SIZE OF SEGMENTATION BLOCK, BYTES .KWSBK = 1024. / .BLKSW; SIZE OF A KILOWORD IN BLOCKS ;* ;* .SEGSW = 4096.; SEGMENT SIZE IN WORDS .SEGSB = .SEGSW * 2.; SEGMENT SIZE IN BYTES .SGSBK = .SEGSW / .BLKSW; SEGMENT SIZE IN BLOCKS ;* ;**** MEMORY SEGMENTATION REGISTERS ***** ;* SSR0 = 177572; SEGMENT STATUS REGISTER 0 SSR1 = 177574; SEGMENT EXPANDS UP SDREDD = 1; SEGMENT EXPANDS DOWN ;* ;* MACRO TO DEFINE SEGMENT DESCRIPTOR REGISTER CONTENTS ;* .MACRO SDRDEF NAME,AC,ED,PL $1 = SDRACF * AC; $2 = SDRED * ED + >; $3 = SDRPLF * <1 - <2 * ED>> * PL; NAME = $1 + $2 + $3; .ENDM SDRDEF ;* ;* DEFINE THE USER SDR VALUE: ;* ;* ALLOW READ AND WRITE, ;* SEGMENT STATUS REGISTER 1 SSR2 = 177576; SEGMENT STATUS REGISTER 2 SSR3 = 172516; SEGMENT STATUS REGISTER 3 ;* ;* UISDR = 177600; USER INSTR DESCR REGS 0-7 UDSDR = 177620; USER DATA DESCR REGS 0-7 UISAR = 177640; USER INSTR ADDR REGS 0-7 UDSAR = 177660; USER DATA ADDR REGS 0-7 ;* ;* SISDR = 172200; SUPERVISOR INSTR DESCR REGS 0-7 SDSDR OW FPSFC = ^B0000000000000001; CONVERSION CARRY ;* ;* DEFINE THE INITIAL USER FLOATING POINT STATUS ;* FSTAT0 = FPSIUV+FPSFIU+FPSFIV+FPSFIC+FPSFD; UNDEF. VAR. INT., ; UNDERFLOW INT., ; OVERFLOW INT., ; INTEGER CONV INT., ; DOUBLE PRECISION, ; N RERDRE = ^B1000000000000000; DRIVE ERROR ;* ;* BIT AND FIELD DEFINITIONS FOR CONTROL STATUS REGISTER ;* ;* FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS ;* RCSGO = ^B0000000000000001; 1 BIT - INITIATE FUNCTION RCSFUN = ^B0000000000000010; 3 BITS - FUNCTION FIELD RCSMEX = ^B0000000000010000; 2 BITS - MEMORY EXTENSION RCSIDE = ^B0000000001000000; 1 BIT - INTERRUPT ON DONE RCSRDY = ^B0000000010000000; 1 BIT - CONTROL READY SHORT INTEGER, ; ROUNDED ARITHMETIC ;* ;* CODE DEFINITIONS FOR THE FEC REGISTER ;* FECOPC = 2.; OPCODE ERROR FECDVZ = 4.; DIVIDE CHECK FECICE = 6.; INTEGER CONVERSION ERROR FECOVF = 8.; OVERFLOW FECUNF = 10.; UNDERFLOW FECUDV = 12.; UNDEFINED VARIABLE FECMTT = 14.; MAINTENRCSSSE = ^B0000000100000000; 1 BIT - STOP ON SOFT ERROR ;* = ^B0000001000000000; 1 BIT - NOT USED RCSFMT = ^B0000010000000000; 1 BIT - FORMAT MODE RCSIBA = ^B0000100000000000; 1 BIT - INHIBIT INCREMENT ;* = ^B0001000000000000; 1 BIT - NOT USED RCSSCP = ^B0010000000000000; 1 BIT - SEARCH COMPLETE RCSHE = ^B0100000000000000; 1 BIT - HARD ERROR RCSERR = ^B1000000000000000; 1 BIT - ERROR (HARD OR SOFT) ;* ;* FIANCE TRAP ;* ;* .PAGE .SBTTL TM11 TAPE DEFINITIONS ;**** TM11 TAPE HARDWARE REGISTERS ***** ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* MTS = 172520; STATUS REGISTER MTC = 172522; COMMAND REGISTER MTBRC = 172524; BYTE/RECORD COUNTER MTCMA = 172526; CURRENT MEMORY ADDRESS REGISTER MTD = 172530; DATA BUFFER ;* ;* BIT DEFINITIONS FOR THE STATUS REGELD VALUE DEFINITIONS FOR RCSFUN ARE:__ ;* RCFCRE = ^B000; CONTROL RESET RCFWR = ^B001; WRITE RCFRD = ^B010; READ RCFWRC = ^B011; WRITE CHECK RCFSK = ^B100; SEEK RCFRDC = ^B101; READ CHECK RCFDRE = ^B110; DRIVE RESET RCFWRL = ^B111; WRITE LOCK ;* ;* BIT AND FIELD DEFINITIONS FOR DISK ADDRESS REGISTER ;* ;* ISTER ;* MTSTUR = ^B0000000000000001; TAPE UNIT READY MTSRWS = ^B0000000000000010; REWIND STATUS MTSWRL = ^B0000000000000100; WRITE LOCK (FILE PROTECT) MTSDWN = ^B0000000000001000; TAPE SETTLE DOWN MTS7CH = ^B0000000000010000; SEVEN CHANNEL MTSBOT = ^B0000000000100000; BEGINNING OF TAPE MTSELR = ^B0000000001000000; SELECT REMOTE MTSNXM = ^B0000000010000000; NONEXISTENT MEMORY MTSBTE = ^B0000000100000000; BAD TAPE ERRORFIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST BITS: ;* RDASC = ^B0000000000000001; 4 BITS - SECTOR ADDRESS, 0..11 RDASUR = ^B0000000000010000; 1 BIT - SURFACE, 0..1 RDACYL = ^B0000000000100000; 8 BITS - CYLINDER, 0..202 RDADRS = ^B0010000000000000; 3 BITS - DRIVE SELECT, 0..7 ;* ;* .PAGE .SBTTL LT33 TERMINAL DEFINITIONS ;**** LT33 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* RCSR = 177560; RECE MTSRLE = ^B0000001000000000; RECORD LENGTH ERROR MTSEOT = ^B0000010000000000; END OF TAPE MTSBGL = ^B0000100000000000; BUS GRANT LATE MTSPAE = ^B0001000000000000; PARITY ERROR MTSCRE = ^B0010000000000000; CYCLIC REDUNDANCY ERROR MTSEOF = ^B0100000000000000; END OF FILE MTSILC = ^B1000000000000000; ILLEGAL COMMAND ;* ;* BIT AND FIELD DEFINITIONS FOR THE COMMAND REGISTER ;* ;* FIELDS ARE DECLARED BY GIVING THEIR RIGHTMOST IVER STATUS REGISTER RBUF = 177562; RECEIVER BUFFER REGISTER XCSR = 177564; TRANSMITTER STATUS REGISTER XBUF = 177566; TRANSMITTER BUFFER REGISTER ;* ;* BIT DEFINITIONS FOR THE STATUS REGISTERS ;* ;* = ^B1111000000000000; 4 BITS - NOT USED TSRBSY = ^B0000100000000000; BUSY (RECEIVER ONLY) ;* = ^B0000011100000000; 3 BITS - NOT USED TSRRDY = ^B0000000010000000; READY TSRIDE = LARED BY GIVING THEIR RIGHTMOST BITS: ;* PSCBIT = ^B0000000000000001; 1 BIT - CARRY PSVBIT = ^B0000000000000010; 1 BIT - OVERFLOW PSZBIT = ^B0000000000000100; 1 BIT - RESULT = 0 PSNBIT = ^B0000000000001000; 1 BIT - RESULT < 0 PSTBIT = ^B0000000000010000; 1 BIT - TRAP SET PSPRTY = ^B0000000000100000; 3 BITS - PRIORITY ;* = ^B0000011100000000; 3 BITS - NOT USED PSREGS = ^B0000100000000000; 1 BIT - GENERAL REGISTER SET PSBITS: ;* MTCGO = ^B0000000000000001; 1 BIT - BEGIN OPERATION MTCFUN = ^B0000000000000010; 3 BITS - FUNCTION FIELD MTCADD = ^B0000000000010000; 2 BITS - ADDRESS EXTENSION MTCIEN = ^B0000000001000000; 1 BIT - INTERRUPT ENABLE MTCCUR = ^B0000000010000000; 1 BIT - CU READY MTCUS = ^B0000000100000000; 3 BITS - UNIT SELECT MTCPEV = ^B0000100000000000; 1 BIT - LATERAL PARITY (EVEN) MTCPCL = ^B0001000000000000; 1 BIT - POWER CLEAPMOD = ^B0001000000000000; 2 BITS - PREVIOUS MODE PSCMOD = ^B0100000000000000; 2 BITS - CURRENT MODE ;* ;* THE RELEVANT FIELD VALUES ARE: ;* PSCARR = PSCBIT * 1; CARRY = TRUE PSOVER = PSVBIT * 1; OVERFLOW = TRUE PSZERO = PSZBIT * 1; RESULT ZERO = TRUE PSNEGA = PSNBIT * 1; RESULT NEGATIVE = TRUE PSTTRP = PSTBIT * 1; T-BIT TRAP IS SET PSPRT7 = PSPRTY * 7; PROCESSOR PRIORITY = 7 R MTCDEN = ^B0010000000000000; 2 BITS - DENSITY MTCERR = ^B1000000000000000; 1 BIT - HARD ERROR ;* ;* FIELD VALUE DEFINITIONS FOR MTCFUN ARE:__ ;* MTFOFL = ^B000; OFFLINE MTFRD = ^B001; READ MTFWR = ^B010; WRITE MTFWFM = ^B011; WRITE EOF MTFSPF = ^B100; SPACE FORWARD MTFSPR = ^B101; SPACE REVERSE MTFWGP = ^B110; WRITE GAPPSPRT6 = PSPRTY * 6; PROCESSOR PRIORITY = 6 PSPRT5 = PSPRTY * 5; PROCESSOR PRIORITY = 5 PSPRT4 = PSPRTY * 4; PROCESSOR PRIORITY = 4 PSPRT3 = PSPRTY * 3; PROCESSOR PRIORITY = 3 PSPRT2 = PSPRTY * 2; PROCESSOR PRIORITY = 2 PSPRT1 = PSPRTY * 1; PROCESSOR PRIORITY = 1 PSPRT0 = PSPRTY * 0; PROCESSOR PRIORITY = 0 PSREG1 = PSREGS * 1; REGISTER SET 1 PSREG0 = PSREGS * MTFREW = ^B111; REWIND ;* ;* FIELD VALUE DEFINITIONS FOR MTCDEN ARE:__ ;* MDS200 = ^B00; SEVEN TRACK, 200 BPI MDS556 = ^B01; SEVEN TRACK, 556 BPI MDS800 = ^B10; SEVEN TRACK, 800 BPI MDN800 = ^B11; NINE TRACK, 800 BPI ;* ;* .PAGE .SBTTL RK11 DISK DEFINITIONS ;**** RK11 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* RKDS = 177400; 0; REGISTER SET 0 PSPMDK = PSPMOD * KRNLMD; PREVIOUS MODE = KERNEL PSPMDS = PSPMOD * SPVRMD; PREVIOUS MODE = SUPERVISOR PSPMDU = PSPMOD * USERMD; PREVIOUS MODE = USER PSCMDK = PSCMOD * KRNLMD; CURRENT MODE = KERNEL PSCMDS = PSCMOD * SPVRMD; CURRENT MODE = SUPERVISOR PSCMDU = PSCMOD * USERMD; CURRENT MODE = USER ;* ;* WHERE ;* KRNLMD = ^B00; KERNEL MODE SPVRMD = ^B01; DRIVE STATUS REGISTER RKER = 177402; ERROR REGISTER RKCS = 177404; CONTROL STATUS REGISTER RKWC = 177406; WORD COUNT REGISTER RKBA = 177410; CURRENT BUS ADDRESS REGISTER RKDA = 177412; DISK ADDRESS REGISTER RKDB = 177416; DATA BUFFER REGISTER ;* ;* BIT AND FIELD DEFINITIONS FOR THE DRIVE STATUS REGISTER ;* ;* FIELDS ARE DECLARED BY GI SUPERVISOR MODE USERMD = ^B11; USER MODE ;* ;* DEFINE THE KERNEL PROCESSOR STATUS WORD ;* KNLPSW = PSCMDK+PSREG0+PSPRT7; KERNEL MODE, ; REGISTER SET 0, ; PROCESSOR PRIORITY 7 ;* ;* DEFINE THE USER PROCESSOR STATUS WORD ;* USRPSW = PSCMDU+PSREG1+PSPRT0; USER MODE, USRPSW = USRPSW+PSPMDU ; REGISTER SET 1, ; PROCESSOR PRIORVING THEIR RIGHTMOST BITS: ;* RDSSC = ^B0000000000000001; 4 BITS - SECTOR COUNTER RDSCSA = ^B0000000000010000; 1 BIT - (SECTOR) COUNTER=ADDR RDSWPS = ^B0000000000100000; 1 BIT - WRITE PROTECT STATUS RDSRDY = ^B0000000001000000; 1 BIT - READ/WRITE/SEEK READY RDSDRY = ^B0000000010000000; 1 BIT - DRIVE READY RDSSOK = ^B0000000100000000; 1 BIT - SECTOR COUNTER OK RDSSIN = ^B0000001000000000; 1 BIT - SEEK INCOMPLETE RDSDRU = ^B000ITY 0 ;* ;* .PAGE .SBTTL FLOATING POINT PROCESSOR DEFINITIONS ;**** FLOATING POINT UNIT STATUS REGISTER FORMAT ***** ;* ;* ;* BIT DEFINITIONS FOR THE FPS REGISTER ;* FPSFER = ^B1000000000000000; FLOATING POINT ERROR FPSFID = ^B0100000000000000; FPP INTERRUPTS DISABLED ;* = ^B0011000000000000; 2 BITS - NOT USED FPSIUV = ^B0000100000000000; UNDEF. VARIABLE INT. ENABLED FPSFIU = ^B0000010000000000; UNDERFLOW INT. ENABLED FPSFI0010000000000; 1 BIT - DRIVE UNSAFE RDRK05 = ^B0000100000000000; 1 BIT - RK05 DISK DRIVE RDSDPL = ^B0001000000000000; 1 BIT - DRIVE POWER LOW RDSID = ^B0010000000000000; 3 BITS - DRIVE IDENTIFIER ;* ;* BIT DEFINITIONS FOR THE ERROR REGISTER ;* RERWCE = ^B0000000000000001; WRITE CHECK ERROR (SOFT) RERCSE = ^B0000000000000010; CHECKSUM ERROR (SOFT) ;* = ^B0000000000011100; 3 BITS - NOT USED RERNXS = ^B0000000000100000; V = ^B0000001000000000; OVERFLOW INT. ENABLED FPSFIC = ^B0000000100000000; INTEGER CONVERSION INT. ENABLED FPSFD = ^B0000000010000000; DOUBLE PRECISION MODE FPSFL = ^B0000000001000000; LONG INTEGER MODE FPSFT = ^B0000000000100000; TRUNCATE MODE FPSFMM = ^B0000000000010000; MAINTENANCE MODE FPSFN = ^B0000000000001000; RESULT NEGATIVE FPSFZ = ^B0000000000000100; RESULT ZERO FPSFV = ^B0000000000000010; RESULT OVERFL NONEXISTENT SECTOR RERNXC = ^B0000000001000000; NONEXISTENT CYLINDER RERNXD = ^B0000000010000000; NONEXISTENT DISK RERTE = ^B0000000100000000; TIMING ERROR RERDLT = ^B0000001000000000; DATA LATE RERNXM = ^B0000010000000000; NONEXISTENT MEMORY RERPGE = ^B0000100000000000; PROGRAMMING ERROR RERSKE = ^B0001000000000000; SEEK ERROR RERWLO = ^B0010000000000000; WRITE LOCKOUT VIOLATION REROVR = ^B0100000000000000; OVERRUVAEND = 400; END OF TRAP VECTOR AREA TVECS = / 4; NUMBER OF TRAP VECTORS POSSIBLE ;* ;* THE LOCATIONS OF RELEVANT TRAP VECTORS ;* FETRAP = 004; FATAL ERRORS:__ ; ODD ADDRESS, ; FATAL STACK VIOLATION (RED), ; TIMEOUT (NXM), ; PARITY ERROR, . ;* $.DBPS = 0; 1: PRINT THE KERNEL STATE $.DBNC = 0; 1: NO CLOCK INTERRUPTS: THE BELL ; OF THE CONSOLE TELETYPE WILL ; SIMULATE A CLOCK INTERRUPT. $.DBST = 0; 1: TYPE SERVICE TRACE $.DBCD = 0; 1: INCLUDE THE CORE DUMP FACILITY $.DBTA = 0; 1: LOAD OPERATING SYSTEM FROM TAPE 0 $.DBLT = 0; 1: ; WARNING STACK VIOLATION. IITRAP = 010; ILLEGAL INSTRUCTIONS:__ ; "JMP R", ; "JSR M,R", ; USER MODE "HALT", ; RESERVED OPCODES:__ ; 000007 - 000077 ; 000210 - 000227 ; 007000 - 007777 DO NOT REWIND THE SYSTEM TAPE $.DBVC = 0; 1: VERIFY PRELIMINARY CORE CLEARING $.DBIT = 0; 1: INCLUDE INTERPRETER TRACE ;* ;* MACRO TO TERMINATE KERNEL ERROR PROCESSING ;* .MACRO SYSERR .IF NE $.DBCD JMP $.DBDC .ENDC .IF EQ $.DBCD HALT BR .-2 .ENDC .ENDM SYSERR ;* ;* MACRO TO SET 'JMP DUMP' IN LOCATION 0 ;* .MACRO SETDMP $$ = ZERO .IF NE $.DBCD ; 075000 - 076777 ; 106400 - 107777 TBTRAP = 014; T-BIT TRAP (NOT USED) IOTRAP = 020; IOT TRAP (KERNEL CALL) PFTRAP = 024; POWER FAILURE EMTRAP = 030; EMULATOR TRAP (NOT USED) TRTRAP = 034; TRAP INSTRUCTION (USED BY INTER- ; PRETER TRACE) TITRAP = 060; $$ = $.DBDC .ENDC MOV #<$$-4>,ZERO+2 .ENDM SETDMP ;* ;* MACRO TO VERIFY CORE CONTENTS ;* .MACRO VERCOR .IF NE $.DBVC .IF NE $.DBCD JSR PC,$.DBDC .ENDC .IF EQ $.DBCD JSR PC,$.DBCV .ENDC .ENDC .ENDM VERCOR ;* ;* MACRO TO PRINT KERNEL STATE ;* .MACRO KNSTAT .IF NE $.DBPS JSR PC,$.DBSP .ENDC .ENDM KNSTAT ;* ;* MACRO TO TYPE CURRENT CONSOLE TTY (LT33) INPUT INTRPT. TOTRAP = 064; CONSOLE TTY (LT33) OUTPUT INTRPT. CLTRAP = 100; CLOCK (KW11-L) INTERRUPT LPTRAP = 200; LINE PRINTER (LPXX) INTERRUPT RKTRAP = 220; DISK (RK11) INTERRUPT TMTRAP = 224; MAG TAPE (TM11) INTERRUPT CDTRAP = 230; CARD READER (CD11) INTERRUPT PITRAP = 240; PROGRAMMING INTERRUPT REQRUNNING PROCESS ;* .MACRO KNSERV .IF NE $.DBST JSR PC,$.DBTS .ENDC .ENDM KNSERV ;* ;* MACRO TO TRACE GET AND PUT OPERATIONS ON PROCESS QUEUES ;* .MACRO QTRACE OP .IF NE $.DBST .IF IDN OP,GET JSR PC,$.DBTG .ENDC .IF IDN OP,PUT JSR PC,$.DBTP .ENDC .ENDC .ENDM QTRACE ;* ;* MACRO TO SIMULATE CLOCK INTERRUPT BY THE TELETYPE BELL KEY ;* .MACRO BLTICK .IF NE $UEST ; (NOT USED) FPTRAP = 244; FLOATING POINT EXCEPTION SGTRAP = 250; SEGMENT VIOLATION ; (INDICATES SYSTEM ERROR) .PAGE ;**** SET THE TRAP VECTORS ***** ;* ;* ZERO: JMP $KNL0; JUMP TO INITIALIZATION. THESE ;* TWO WORDS ARE RESERVED FOR USE ;* BY THE MACHINE IN THE RARE CASE.DBNC $$ = CLOCK8 .ENDC .ENDM BLTICK ;* ;* .PAGE ;**** PROCEDURES TO TYPE SERVICE TRACES ***** ;* ;* .IF NE $.DBST ;* ;* TYPE CURRENT RUNNING PROCESS ;* $.DBTS: MOV #1$,$.DB00 MOV USER99,$.DB01 BR $.DB02 1$: .ASCIZ <13.><10.>/SERVICE/ .EVEN ;* ;* TYPE PROCESS DEPARTURES ;* $.DBTG: MOV #1$,$.DB00 MOV GET4R,$.DB01 BR $.DB02 1$: .ASCIZ <13.><10.>/DEPARTURE/ .EVEN ;* ;* TYPE P ;* WHEN POWER FAILURE PREVENTS THE ;* COMPLETION OF A FATAL STACK ;* VIOLATION TRAP. ;* ;* FILL TRAP VECTOR AREA WITH ILLEGAL TRAPS TO LABEL XXXINT ;* DEFINED BELOW. THE NEW PSW IS USED TO TRANSMIT THE TRAP ;* VECTOR ADDRESS TO THE COMMON INTERCEPTOR, XXXINT. ;* .REPT TVECS TVDEF XXXINT,.-2; UNEXPECTED CALL; .ENDR ;* ;* ROCESS ARRIVALS ;* $.DBTP: MOV #1$,$.DB00 MOV NEWEL4,$.DB01 BR $.DB02 1$: .ASCIZ <13.><10.>/ARRIVAL/ .EVEN ;* ;* $.DB00: .WORD 0 $.DB01: .WORD 0 $.DB02: MOV STAT28,$.DB31 MOV OUTL28,$.DB32 MOV ECHO28,$.DB33 MOV $.DB00,TEXT33 JSR PC,WRIT33 MOV $.DB01,NN34 JSR PC,WRIT34 MOV $.DB31,STAT28 CMP $.DB31,#WRIT28 BNE 2$ MOV $.DB32,OUTL28 MOV $.DB33,ECHO28 PLANT THE RELEVANT TRAP VECTORS ;* ;* BECAUSE THE ASSEMBLY IS RELOCATABLE, THE FOLLOWING ;* TRAP VECTORS MUST BE MADE RELATIVE TO ;* RELOCATABLE ZERO. ;* . = ZERO+FETRAP ;FATAL ERROR TRAP TVDEF FEINT,KNLPSW . = ZERO+TBTRAP ;T-BIT TRAP TVDEF TBTINT,KNLPSW . = ZERO+IOTRAP ;KERNELCALL TVDEF KNCALL,KNLPSW . = ZERO+TITRAP ;LT33TERMINAL.READINTERRUPT TVDEF LTIN32,KNLPSW . = ZERO+TOTRAP RTS PC 2$: MOV #1$,TOTRAP BIS #INEN28,WRST28 SPL 0 WAIT SPL 7 RTS PC 1$: MOV #LTOU32,TOTRAP RTI $.DB31: .WORD 0 $.DB32: .WORD 0 $.DB33: .WORD 0 .ENDC ;* ;* .PAGE ;**** PROCEDURES TO PRINT THE KERNEL STATE ***** ;* ;* .IF NE $.DBPS+$.DBVC+$.DBIT $.DB03: .WORD 0 ; PROCEDURE PRINT(VAR I: ; INTEGER); $.DB04: MOV ^B0000000001000000; INTERRUPT ENABLE ;* = ^B0000000000111110; 5 BITS - NOT USED TSRGO = ^B0000000000000001; START (RECEIVER ONLY) ;* ;* THE 8-BIT ASCII BIT FOR THE RECEIVER BUFFER REGISTER ;* ASCII8 = ^B0000000010000000; 1 FOR 8-BIT, 0 FOR 7-BIT ASCII ;* ;* .PAGE .SBTTL LP11 PRINTER DEFINITIONS ;**** LP11 HARDWARE REGISTERS ;* ;* ADDRESSES OF THE HARDWARE REGISTERS ;* LPS = 177514; LINE PRINTER STATU ;LT33TERMINAL.WRITEINTERRUPT TVDEF LTOU32,KNLPSW . = ZERO+CLTRAP ;CLOCK INTERRUPT TVDEF CLKINT,KNLPSW . = ZERO+LPTRAP ;LPXXPRINTER.INTERRUPT TVDEF LPIN32,KNLPSW . = ZERO+RKTRAP ;RK11DISK.INTERRUPT TVDEF RKIN32,KNLPSW . = ZERO+TMTRAP ;TM11TAPE.INTERRUPT TVDEF TMIN32,KNLPSW . = ZERO+CDTRAP ;CD11CARDREADER.INTERRUPT TVDEF CDIN32,KNLPSW . = ZERO+FPTRAP ;REAL INTERRUPS REGISTER LPB = 177516; LINE PRINTER DATA BUFFER REGISTER ;* ;* BIT DEFINITIONS FOR THE STATUS REGISTER ;* ;* = ^B0000000000111111; 6 BITS - NOT USED LPSIDE = ^B0000000001000000; INTERRUPT ENABLE LPSRDY = ^B0000000010000000; PRINTER READY ;* = ^B0111111100000000; 7 BITS - NOT USED LPSERR = ^B1000000000000000; ERROR ;* ;* .PAGE .SBTTL CD11 CARD READER DEFINITIONS ;**** CD11 HARDWARE REGISTERS ;* T TVDEF FPPINT,KNLPSW ;* ;* END THE TRAP VECTOR AREA ;* . = ZERO+TVAEND ;MOVE TO END OF TRAP VECTORS ;* ;* .PAGE .SBTTL DEFINITIONS OF THE KERNEL STACK ;**** KERNEL STACK DEFINITIONS ***** ;* ;* KSTKSZ = 32.; SIZE OF THE STACK, WORDS. ;* ;* KSTTOP = .; ABSOLUTE STACK TOP .BLKW KSTKSZ; KSTBOT = .; STACK BOTTOM ;* ;* STANDARD LOCATIONS AT THE STACK BOTTOM ;;* ADDRESSES OF THE HARDWARE REGISTERS ;* CDST = 172460; STATUS AND CONTROL REGISTER CDCC = 172462; COLUMN COUNT REGISTER CDBA = 172464; CURRENT ADDRESS REGISTER CDDB = 172466; DATA BUFFER REGISTER ;* ;* BIT AND FIELD DEFINITIONS FOR THE STATUS AND CONTROL REG ;* CDSERR = ^B1000000000000000; ERROR CDSRDC = ^B0100000000000000; READER CHECK CDSEOF = ^B00100000000000* KSOPSW = KSTBOT - 2; OLD PROCESSOR STATUS WORD KSOPC = KSTBOT - 4; OLD PROGRAM COUNTER ;* ;* .PAGE .SBTTL DEFINE PRIMITIVE DATA TYPES ;**** LENGTHS OF THE PASCAL PRIMITIVE DATA TYPES ***** ;* ;* .INTEGER= 2.; BYTES ;* ;* .REAL = 8.; BYTES ;* ;* .BOOLEAN= 2.; BYTES ;* ;* .CHAR = 2.; BYTES ;* ;* .ADDRESS= 2.; BYTES ;* ;******00; END OF FILE CDSOFL = ^B0001000000000000; OFF LINE CDSDER = ^B0000100000000000; DATA ERROR CDSDTL = ^B0000010000000000; DATA LATE CDSNXM = ^B0000001000000000; NONEXISTENT MEMORY CDSPCL = ^B0000000100000000; POWER CLEAR CDSRDY = ^B0000000010000000; READY CDSIDE = ^B0000000001000000; INTERRUPT ENABLE CDSMEX = ^B0000000000110000; 2 BITS - MEMORY EXTENSION CDSOLT = ^B0000000000001000; ONLINE TRANSITION CDSHPC = ***************************************************************** ;* ;* ANTICIPATE SOME KERNEL DATATYPE LENGTHS ;* ;* .TIME = 4.; BYTES ;* ;* .GATE = 6.; BYTES ;* ;* .QUEUETY= 4.; BYTES ;* ;* .HEADTYP= 36.; BYTES ;* ;* .REGTYPE= 36.; BYTES ;* ;* .MAPTYPE= 16.; BYTES ;* ;*********************************************************************** ;* ;* MA ^B0000000000000100; HOPPER CHECK CDSDPK = ^B0000000000000010; DATA PACKING MODE CDSGO = ^B0000000000000001; START READ ;* ;* .PAGE .SBTTL KERNEL TRAP VECTOR DEFINITIONS. ;**** PRELIMINARY DEFINITIONS: ***** ;* ;* MACRO TO SET A SINGLE TRAP VECTOR ;* .MACRO TVDEF TRPROC,TPSW .WORD TRPROC,TPSW .ENDM TVDEF ;* ;* TRAP VECTOR AREA EXTENT DEFINITIONS ;* TVABEG = 004; START OF TRAP VECTOR AREA TCROS TO CHECK DATATYPE LENGTHS ;* ;* .MACRO GENERR A,B,C,D,E .ERROR A''B''C''D''E .ENDM .MACRO CHKDTL SYM $ = $ - SYM .IF NE $ - .'SYM GENERR $,<;>,,SYM,<", ABOVE.> .ENDC .ENDM ;* ;* .PAGE .SBTTL DEBUGGING FACILITIES ;**** DEFINITIONS OF DEBUGGING SWITCHES AND MACRO'S ***** ;* ;* DEFINE THE DEBUGGING STATE: ;* ;* NORMALLY ALL OF THE SWITCHES, BELOW, WILL HAVE THE ;* VALUE 0EPRINTER; 1$: TSTB LPS ; RELEASE IT; BGE 1$ ; TST USER29 ; BNE 2$ ; MOV #3$,LPTRAP ; BIS #INEN29,STAT29 ; SPL 0 ; WAIT ; SPL 7 ; 2$: RTS PC ; 3$: MOV #LPIN32,LPTRAP ; RTI ; MOV Q,(SP)+ ; MOV B,(SP)+ ; MOV G,(SP)+ ; BIC #PSREG1,PSW ; MOV SP,R0 ; MOV R1,SP ; BIS #PSPMDU,PSW ; MFPI SP ; MOV (SP)+,(R0)+ ; MOV KSOPC,(R0)+ ; MOV KSOPSW,(R0)+ ; STD W,(R0)+ ; ; END; ;* ;* $.DB06: .WORD 0 ; PRINT AN ARRAY OF INTEGERS; $.DB07: .WORD 0 $.DB08: MOV $.DB06,$.DB03 MOV $.DB07,R0 1$: MOV R0,2$ JSR PC,$.DB04 ADD #2,$.DB03 MOV 2$,R0 SOB R0,1$ RTS PC 2$: .WORD 0 .ENDC .IF NE $.DBPS ;* ;* PRINT THE KERNEL STATUS: ;* $.DB09: ; PROCEDURE PRINTNEWCORE; MOV #1$,$.DB03 ; PRINT(BASEADDR); J STD X,(R0)+ ; STFPS (R0) ; JSR PC,$.DB19 ; RTS PC ; END; 1$: .BLKB .REGTYPE ; ;* ;* $.DB26: ; PROCEDURE PRINTREADY; MOV #TOP12,$.DB10 ; PRINTQUEUE(TOP); JSR PC,$.DB11 ; MOV #MIDD12,$.DB10 ; PRINTQUEUE(MIDDLE); JSR PC,$.DB11 ; MOV #BOTT12,$.DB10 SR PC,$.DB04 ; MOV #TOP16,$.DB03 ; PRINT(TOP); JSR PC,$.DB04 ; MOV #FREE16,$.DB03 ; PRINT(FREE); JSR PC,$.DB04 ; RTS PC ; END; 1$: .WORD BASE16 ; ;* ;* $.DB10: .WORD 0 ; PROCEDURE PRINTQUEUE(Q); $.DB11: MOV #$.DB10,$.DB03 ; PRINT(@Q); JSR PC,$.DB04 ; MOV $.DB10,$.DB06 ; PRINTQUEUE(BOTTOM); JSR PC,$.DB11 ; MOV #IDLI12,$.DB03 ; PRINT(IDLING); JSR PC,$.DB04 ; RTS PC ; END; ;* ;* PRINT THE KERNEL STATE: ;* $.DBSP: ; PROCEDURE KNSTAT; JSR PC,$.DB27 ; GRABPRINTER; JSR PC,$.DB09 ; PRINTNEWCORE; MOV #PERIO6,$.DB03 ; PRINT(TIMER.PERIOD); JSR PC,$.DB ; PRINT IT; MOV #<.QUEUETYPE/2>,$.DB07 ; 1$: JSR PC,$.DB08 ; MOV @$.DB06,$.DB06 ; CMP $.DB06,$.DB10 ; BNE 1$ ; RTS PC ; END; ;* ;* $.DB12: .WORD 0 ; PROCEDURE PRINTTIME(T); $.DB13: MOV $.DB12,$.DB06 ; PRINT IT; MOV #<.TIME/2>,$.DB07 ; JSR PC,$.DB08 ; RTS PC 04 ; JSR PC,$.DB14 ; PRINTCLOCK; JSR PC,$.DB15 ; PRINTCORE; JSR PC,$.DB22 ; PRINTVIRTUAL; JSR PC,$.DB25 ; PRINTRUNNING; JSR PC,$.DB26 ; PRINTREADY; JSR PC,$.DB28 ; RELEASEPRINTER; RTS PC ; END; .ENDC ;* ;* .PAGE ;**** CORE DUMP PROCEDURE ***** ;* ;* .IF NE $.DBCD $.DBDC: ; END; ;* ;* $.DB14: ; PROCEDURE PRINTCLOCK; MOV #NOW7,$.DB12 ; PRINTTIME(NOW); JSR PC,$.DB13 ; MOV #NEXTT7,$.DB10 ; PRINTQUEUE(NEXTTIME.AWAITING) JSR PC,$.DB11 ; RTS PC ; END; ;* ;* $.DB15: ; PROCEDURE PRINTCORE; MOV #USER99,R1 ; PRINT(HEADADDR DIV 64); CLR R0 MOV PC,R0 SYSERR .ENDC ;* ;* .PAGE ;**** CORE VERIFICATION PROCEDURE ***** ;* ;* .IF NE $.DBVC .IF EQ $.DBCD $.DBCV: ; PROCEDURE VERIFYCORE; MOV KISAR+12.,R0 ; MOV #.PRBLK,R1 ; SUB #.SGSBK,R1 ; MOV R1,KISAR+12. ; MOV #2$,FETRAP ; 1$: TST 140000 ; BR 3$ ; 2$: ; DIV #64.,R0 ; MOV R0,1$ ; MOV #1$,$.DB03 ; JSR PC,$.DB04 ; MOV #COREC9,$.DB03 ; PRINT(CORECAPACITY); JSR PC,$.DB04 ; MOV #TOP9,$.DB03 ; PRINT(TOP); JSR PC,$.DB04 ; MOV #FREE9,$.DB03 ; PRINT(FREE); JSR PC,$.DB04 ; RTS PC ; END; SUB #.SGSBK,KISAR+12. ; ADD #4,SP ; BR 1$ ; 3$: MOV #FEINT,FETRAP ; MOV KISAR+12.,6$ ; ADD #.SGSBK,6$ ; 4$: MOV #<.SEGSB-2>,R1 ; 10$: TST 140000(R1) ; BNE 5$ ; SUB #2,R1 ; BGE 10$ ; SUB #.SGSBK,KISAR+12. ; BR 4$ 1$: .WORD 0 ; ;* ;* $.DB16: .WORD 0 ; PROCEDURE PRINTHEAD(H); $.DB17: MOV $.DB16,$.DB06 ; PRINT IT; MOV #<.HEADTYPE/2>,$.DB07 ; JSR PC,$.DB08 ; RTS PC ; END; ;* ;* $.DB18: .WORD 0 ; PROCEDURE PRINTREG(R); $.DB19: MOV $.DB18,$.DB06 ; PRINT THEM; MOV #<.REGTYPE/2>,$.DB07 ; JSR PC,$.DB08 ; RTS ; 5$: MOV KISAR+12.,7$ ; MOV R1,8$ ; MOV 140000(R1),9$ ; MOV R0,KISAR+12. ; JSR PC,$.DB27 ; GRABPRINTER; MOV #6$,$.DB06 ; PRINTRESULTS; MOV #4,$.DB07 ; JSR PC,$.DB08 ; JSR PC,$.DB28 ; RELEASEPRINTER; RTS PC ; END; 6$: .WORD 0 PC ; END; ;* ;* $.DB20: .WORD 0 ; PROCEDURE PRINTMAP(M); $.DB21: MOV $.DB20,$.DB06 ; PRINT IT; MOV #<.MAPTYPE/2>,$.DB07 ; JSR PC,$.DB08 ; RTS PC ; END; ;* ;* $.DB22: ; PROCEDURE PRINTVIRTUAL; MOV #HARD10,$.DB20 ; PRINTMAP(HARDWAREMAP); JSR PC,$.DB21 ; MOV #COMM10,$.DB03 ; PRINT( ; 7$: .WORD 0 ; 8$: .WORD 0 ; 9$: .WORD 0 ; .ENDC .ENDC .PAGE ;**** PROCEDURE TO PRINT INTERPRETER TRACE ***** ;* ;* .IF NE $.DBIT $$ = . . = TRTRAP TVDEF $.DBTI,KNLPSW . = $$ ;* ;* $.DBTI: ; PROCEDURE PRINTTRACE(OPCODE, Q, ; S, SMAX); MOV #10.,COMMON); JSR PC,$.DB04 ; MOV #HEAP10,$.DB03 ; PRINT(HEAPTOP); JSR PC,$.DB04 ; RTS PC ; END; ;* ;* $.DB23: .WORD 0 ; PROCEDURE PRINTPROCESS(P); $.DB24: MOV #$.DB23,$.DB03 ; PRINT(@P); JSR PC,$.DB04 ; MOV $.DB23,R0 ; PRINTHEAD(P.HEAD); ADD #HEAD0,R0 ; MOV R0,$.DB16 ; $.DB29 ; PRINTNEWLINE; JSR PC,$.DB30 ; MOV #,$.DB03 ; PRINT(INDEX); JSR PC,$.DB04 ; $$ = HEAD99+PARAM1 ; PRINT(OPCODE); MOV #$$,$.DB03 ; JSR PC,$.DB04 ; $$ = $$ + .INTEGER ; PRINT(Q); MOV #$$,$.DB03 ; JSR PC,$.DB04 ; $$ = $$ + .INTEGER ; PRINT(S); #1$,R3 ; MOV #6.,R4 ; CONVERT TO OCTAL; MOV #8.,R2 ; JSR PC,$.DB05 ; MOV #5.,R4 ; CONVERT TO DECIMAL; MOV #10.,R2 ; JSR PC,$.DB05 ; 7$: TST LPS ; READY THE PRINTER; BGE 2$ ; MOV #3$,TEXT33 ; JSR PC,WRIT33 ; 4$: TST JSR PC,$.DB17 ; MOV $.DB23,R0 ; PRINTREG(P.REG); ADD #REG0,R0 ; MOV R0,$.DB18 ; JSR PC,$.DB19 ; MOV $.DB23,R0 ; PRINTMAP(P.MAP); ADD #MAP0,R0 ; MOV R0,$.DB20 ; JSR PC,$.DB21 ; RTS PC ; END; ;* ;* $.DB25: ; PROCEDURE PRINT LPS ; BLT 4$ ; 2$: TSTB LPS ; BGE 2$ ; MOV #5$,R1 ; 6$: MOVB (R1)+,LPB ; PRINT INTEGER VALUES; TSTB LPS ; BMI 6$ ; RTS PC ; END; 5$: .BLKB <1+5+1+6> 1$: .ASCII <10.> 3$: .ASCIZ <13.><10.>/READY THE PRINTER/ .EVEN $.DB29 = 5$ $.DBRUNNING; MOV USER99,$.DB23 ; PRINTPROCESS(USER); JSR PC,$.DB24 ; MOV #HEAD99,$.DB16 ; PRINTHEAD(HEAD); JSR PC,$.DB17 ; MOV #CONS99,$.DB03 ; PRINT(CONST); JSR PC,$.DB04 ; MOV #PARA11,$.DB06 ; PRINTPARAMS; MOV #MAX11,$.DB07 ; JSR PC,$.DB08 ; MOV #NEXT11,$.DB03 ; PRINT(NEXTINDEX); 30 = 7$ $.DB05: MOV @$.DB03,R1 ; CONVERT INTEGER TO ASCII; 1$: CLR R0 DIV R2,R0 ADD #'0,R1 MOVB R1,-(R3) MOV R0,R1 SOB R4,1$ MOVB #' ,-(R3) RTS PC $.DB27: ; PROCEDURE GRABPRINTER; MOV #12.,$.DB29 ; NEW PAGE; JSR PC,$.DB30 ; RTS PC ; END; $.DB28: ; PROCEDURE RELEAS JSR PC,$.DB04 ; MOV #PRID11,$.DB06 ; PRINTPROCESSIDS; MOV #PROCS,$.DB07 ; JSR PC,$.DB08 ; MOV #1$,R0 ; PRINTREG(REG); MOV R0,$.DB18 ; MOV SP,R1 ; MOV R0,SP ; BIS #PSREG1,PSW ; MOV W,(SP)+ ; MOV X,(SP)+ ; MOV Y,(SP)+ IRST LEVEL TRAP/INTERRUPT INTERCEPTORS ;**** TRAPS AND INTERRUPTS WITH COMMON PREPROCESSING COME HERE ***** ;* ;* ;* ;* FATAL ERROR TRAP: ;* FEINT: MOV #FETRAP,R0 ; R0 := TRAP VECTOR ADDRESS; SYSERR ; ;* ;* T-BIT TRAP: ;* TBTINT: CMP (SP),#XXXIN0 ; TRAP FROM XXXINT ? BEQ XXXIN1 ; BRANCH IF SO; MOV #TBTRAP,R0 ; R0 := TRAP VECTOR ADDRESS; SYSERR ; ;* ;* MOV #8.,R0 ; FOR I := 0 TO 7 DO CLR R1 ; MOV #KISDR,R2 ; MOV #KISAR,R3 ; BEGIN 1$: MOV #KSDR,(R2)+ ; KERNELSDRS(.I.) := ; SEGMENTDESCRIPTOR; MOV R1,(R3)+ ; KERNELMAP(.I.) := ADD #.SGSBK,R1 ; I * BLOCKINCR; SOB R0,1$ ; END; MOV #.PRBLK,-(R3) UNEXPECTED CALL: ;* XXXINT: MOV PSW,XXXIN2 ; R0 := TRAP OR INTERRUPT VECTOR XXXIN0: SPL 7 ; ADDRESS; THIS CAUSES IT XXXIN1: MOV XXXIN2,R0 ; TO BE DISPLAYED AT THE BIC #^C,R0 ; COMPUTER CONSOLE. SYSERR ; XXXIN2: .WORD 0 ; ;* ;* KW11-L LINE CLOCK INTERRUPT: ;* CLKINT: MOV #KNEXIT,R0 ; CLOCKINTERRUPT; MOV #LKSINE,LKS ; KERNELMAP(.7.) := REGISTERBLOCK; ; TST RKCS ; IF ERROR THEN BGE 2$ ; CMP #RERNXM,RKER ; BEQ 2$ ; 3$: TSTB XCSR ; BEGIN BGE 3$ ; TYPE('(:13:)(:10:)'); MOV #4$,R0 ; TYPE('KERNEL LOAD ERROR'); 7$: TSTB (R0) ; TYPE('(:13:)(:10:)'); BEQ 5$ ; JSR R0,CLOCK8 ; ;* ;* FLOATING POINT PROCESSOR INTERRUPT: ;* FPPINT: MOV #KNEXIT,R0 ; REALINTERRUPT; JSR R0,REAL11 ; ;* ;* KERNEL CALL: ;* KNCALL: JSR PC,@ ; CASE RUNNING.HEAD.OPCODE OF ; 0: WAIT; ; 2: REALTIME; ; 4: SYSTEMERROR; ; 6: INITPROCESS; ; MOVB (R0)+,XBUF ; 6$: TSTB XCSR ; BGE 6$ ; BR 7$ ; 4$: .ASCII <13.><10.> ; .ASCII /KERNEL LOAD ERROR/ ; .ASCIZ <13.><10.> ; .EVEN ; 5$: HALT ; HALT; SYSERR ; END; 2$: ; ; END; ; ; 8: ENDPROCESS; ; 10: STOPJOB; ; 12: ENTER; ; 14: LEAVE; ; 16: DELAY; ; 18: CONTINUE; ; 20: INITGATE; ; 22: IO; ; END; KNEXIT: TST USER99 ; IF RUNNING.USER = NIL THEN ; ;* ; PROCEDURE LOADSYSTEMPROGRAM; ;* ; ;* ; ;* ; CONST PROGRAMEND = ...; ;* ; ENDOFCORE = ...; ;* ; ;* ; TYPE PAGE = ARRAY (.1..256.) OF ;* ; INTEGER; ;* ; BNE 1$ ; JSR PC,SELE12 ; READY.SELECT; 1$: KNSTAT ; KNSERV ; RTI ; KERNELEXIT; ;* ;* .PAGE .SBTTL INITIALIZE THE VIRTUAL MACHINE ;**** INITIALIZE THE KERNEL AND LOAD THE SYSTEM PROGRAM ;* ;* ;*********************************************************************** ;* ; ;* ; ;* SEGMENTINDEX = 1..4096; ;* ; SEGMENT = ARRAY ;* ; (.SEGMENTINDEX.) OF INTEGER; ;* ; ;* = KISAR+12. ; VAR SEGADDR: @SEGMENT; ;* = R1 ; I: SEGMENTINDEX; ;* = R2 ; SEGINDEX: SEGMENTINDEX; ;* ; $LSP0: ; ;* IT IS EXPECTED THAT THE HUMAN ; PROCEDURE LOADFROMTAPE ; CONST PROGRAMSTART = ...; ;* ; KERNELLENGTH = ...; ;* ; ;* ; TYPE STACKINDEX = 0..31; ;* ; MAPINDEX = 0..7; ;* ; DISKBLOCK = 0..4799; ;* ; ;* = SP ; VAR STACKPOINTER: STACKINDEX; $SDA0: .WORD 24. ; SYSTEMBLOCK: DISKBLOCK INIT 24; ;* = $; ;* OPERATOR WILL MOUNT A TAPE REEL ; ;* CONTAINING THE CODE OF THE OP- ; ;* ERATING SYSTEM ON THE (9-TRACK) ; ;* TAPE DRIVE 0. ; ;* ; ;* ; CONST TAPE0 = 0; ;* ; ;* = MTC ; VAR ERROR: BOOLEAN; ;* = MTCMA ; ADDR: @PAGE; ;* ; .IF NE $.DBTA ; BEGIN $R = MDN800 * MTCDEN ; WHIL.DBTA ; SYSTEMTAPE: BOOLEAN; ;* ; KERNELSTACK: ARRAY ;* ; (.STACKINDEX.) OF INTEGER; ;* = SSR0 ; ADDRESSMAPPING: BOOLEAN; ;* = KISDR ; KERNELSDRS: ARRAY (.MAPINDEX.) ;* ; OF INTEGER; ;* = KISAR ; KERNELMAP: ARRAY (.MAPINDEX.) ;* ; E NOT MOUNTED(TAPE0) DO $R = $R + ; BEGIN MOV #$R,MTC ; BIT #MTSELR,MTS ; BNE 1$ ; MOV #12$,TEXT33 ; TYPE('(:13:)(:10:)'); JSR PC,WRIT33 ; TYPE('MOUNT SYSTEM TAPE '); ; TYPE('ON DRIVE 0 AND THEN '); ; TYPE('PRESS "CONTINUE".'); HALT ; HALT; BR OF INTEGER; ;* = COREC9 ; CORECAPACITY: INTEGER; ;* ; ;* ; ;* ; PROCEDURE LOADVIRTUALMACHINE; ;* ; ;* = .SGSBK ; CONST BLOCKINCR = 128; ;* = .PRBLK ; REGISTERBLOCK = 3968; ;* ; DISK0 = 0; ;* = KSDR ; SEGMENTDESCRIPTOR = ... ;* $LSP0 ; 12$: .ASCII <13.><10.> ; .ASCII /MOUNT SYSTEM TAPE /; .ASCII /ON DRIVE 0 / ; .ASCII /AND THEN / ; .ASCIZ /PRESS "CONTINUE"./ ; .EVEN ; 1$: ; END; .IF EQ $.DBLT ; INC MTC ; REWIND(TAPE0, ERROR); 2$: TSTB MTC ; BGE 2$ ; TST MTC ; IF ERROR THE ; "8K BYTES, UPWARDS, READ/WRITE"; ;* ; ;* = RKCS, RKER ; VAR ERROR: BOOLEAN; ;* = R0 ; I: MAPINDEX; ;* ; ;* ; BEGIN ;* THIS PROCEDURE IS EXECUTED FOR ; ;* THE FIRST TIME BY ACTION OF A ; ;* HUMAN OPERATOR AT THE COMPUTER ; ;* CONSOLE, WHO PERFORMS A STANDARD; ;* INITIAL PROGRAM LOAD FROM DISK ; ;* DRIVE 0. WHEN THIS HAS BN BGE 3$ ; CLR HEAD99+OPLIN1 ; MOV #10$,RESU19 ; KERNELERROR( JSR PC,KERN19 ; 'TAPE REWIND ERROR(:0:)'); 10$: .ASCIZ /TAPE REWIND ERROR/ ; .EVEN ; .ENDC ; 3$: MOV #INTEND,MTCMA ; ADDR := @PROGRAMSTART; MOV #-512.,MTBRC ; READ(TAPE0, ADDR, ERROR); $R = MDN800 * MTCDEN ; $R = $R + MTCGO ;EEN ; ;* DONE, THE CODE WHICH IMPLEMENTS ; ;* THE VIRTUAL MACHINE (KERNEL + ; ;* INTERPRETER) WILL HAVE BEEN READ; ;* INTO CORE STARTING AT PHYSICAL ; ;* ADDRESS 000000. CONTROL IS ; ;* PASSED TO "$KNL0" VIA A 'JMP' ; ;* INSTRUCTION SITUATED AT 000000. ; ;* ; ;* SUBSEQUENTLY, THIS PROCEDURE MAY; ;* BE RE-EXECUTED BY JUMPING TO THE; ;* LABEL "$RVM0", BELOW, AFTER ; ;* HAVING MOVED THE STARTING PAGE ; ;* NUMBER OF THE NEW OPERATING SYS-; ;* TEM INTO "$SDA0", A $R = $R + ; MOV #$R,MTC ; 4$: TSTB MTC ; BGE 4$ ; TST MTC ; IF ERROR THEN BGE 5$ ; 9$: CLR HEAD99+OPLIN1 ; MOV #11$,RESU19 ; KERNELERROR( JSR PC,KERN19 ; 'TAPE READ ERROR(:0:)'); 11$: .ASCIZ /TAPE READ ERROR/ ; .EVEN ; 5$: CLR R0 ; BOVE. ; ;* ; $RVM0: RESET ; RESETUNIBUS; $ = ; READ(DISK0, 0, 0, KERNELLENGTH, $ = <$/512.> * 256. ; ERROR); MOV #<-$>,RKWC ; MOV $SDA0,R0 ; $ = +RCSGO; MOV #$,RKCS ; 1$: TSTB RKCS ; BGE 1$ ; MOV R0,$SDA0 ; FOR I := 2 TO MOV INTEND,R1 ; (ADDR@(.1.) + 511) DIV 512 DO ADD #511.,R1 ; ADC R0 ; ASHC #-9.,R0 ; DEC R1 ; BEGIN BEQ 8$ ; ADDR := NEXTPAGE(ADDR); 6$: MOV #-512.,MTBRC ; READ(TAPE0, ADDR, ERROR); INC MTC ; 7$: TSTB MTC ; BGE 7$ ; TST MTC MOV #$$,$.DB03 ; JSR PC,$.DB04 ; 1$: MFPD @$$ ; PRINTSTACK; MOV SP,$.DB03 ; JSR PC,$.DB04 ; TST (SP)+ ; CMP $$,$$+.INTEGER ; BEQ 2$ ; ADD #2.,$$ ; BR 1$ ; 2$: RTI ; END; .ENDC ;* ;* .PAGE .SBTTL F ; ; $KNL0: SPL 7 ; EXCLUDEINTERRUPTS; SETDMP ; MOV #KSOPC,SP ; STACKPOINTER := 1; "THIS RESERVES ; TWO STACK ENTRIES WHICH WILL ; BE SUBSEQUENTLY FILLED WITH THE ; STATUS AND RETURN OF THE INI- ; TIAL PROCESS." ***** ;**** ***** ;**** ***** ;**** ***** ;*********************************************************************** ;*********************************************************************** ;*********************************************************************** ;* ; ;*      (*,.0246 "$&)+-/1357!#%'DFHJLN8:<>@BEGIKMO9;=?AC`bdfPRTVXZ\^acegQSUWY[]_|~hjlnprtvxz}ikmoqsuwy{  ; IF ERROR THEN BLT 9$ ; KERNELERROR( ; 'TAPE READ ERROR(:0:)'); SOB R1,6$ ; END; 8$: ; END "LOADFROMTAPE"; .ENDC ; ; ;* ; PROCEDURE LOADFROMDISK(SYSTEM: ;* = $SDA0 ; DISKBLOCK); ;* ; ; ; ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; ;* ; * ; CONST DISK0 = 0; ;* ; ;* = RKCS ; VAR ERROR: BOOLEAN; ;* = RKBA ; ADDR: @PAGE; ;* = R1 ; SYSTEMLENGTH: INTEGER; ; .IF EQ $.DBTA ; BEGIN MOV #INTEND, RKBA ; ADDR := @PROGRAMSTART; MOV #<-256.>,RKWC ; READ(DISK0, ADDR, SYSTEM, 512, MOV $SDA0,R1 TYPE CHARSTREAM = CLASS(BUFFER: PAGEBUFFER); VAR TEXT: PAGE; COUNT: INTEGER; PROCEDURE ENTRY WRITE(C: CHAR); BEGIN COUNT:= COUNT + 1; TEXT(.COUNT.):= C; IF (COUNT = PAGELENGTH) OR (C = EM) THEN BEGIN BUFFER.WRITE(TEXT); COUNT:= 0 END; END; BEGIN COUNT:= 0 END; ; ERROR); CLR R0 ; ADDR := NEXTPAGE(ADDR); DIV #12.,R0 ; ASH #4,R0 ; BIS R1,R0 ; MOV R0,RKDA ; $ = +RCSGO; MOV #$,RKCS ; 1$: TSTB RKCS ; BGE 1$ ; TST RKCS ; IF ERROR THEN BGE 5$ ; KERNELERROR( 2$:      (*,.0246 "$&)+-/1357!#%'DFHJLN8:<>@BEGIKMO9;=?AC`bdfPRTVXZ\^acegQSUWY[]_|~hjlnprtvxz}ikmoqsuwy{ CLR HEAD99+OPLIN1 ; 'SYSTEM LOAD ERROR(:0:)'); MOV #3$,RESU19 ; JSR PC,KERN19 ; 3$: .ASCIZ /SYSTEM LOAD ERROR/ ; .EVEN ; 5$: CLR R0 ; SYSTEMLENGTH := MOV INTEND,R1 ; ((PROGRAMSTART(.1.) - 1) DEC R1 ; DIV 512) * 512; ASHC #<-9.>,R0 ; BEQ 7$ ; ASH #8.,R1 "CONCURRENT PASCAL DEMONSTRATION" "MOUNT TAPE" DISPLAY(PRETTY) "EXPLAIN DURING COMPILATION" SPASCAL(PROGTEXT, TAPE, PROG) COPY(ERRORS,CONSOLE) EDIT(PROGTEXT, NEWTEXT) DEL(222) VAR C: CHAR; DEL(225) REPEAT # SPASCAL(NEWTEXT,CONSOLE,PROG) PROG 3 SPASCAL COPY(SPASCALMAN, CONSOLE) DO(SOLOCOPY) START(REALTIME) START(SCAN, 12:0:0) PERIOD(SCAN, 0:0:1) START(FLOW, 12:0:10) PERIOD(FLOW, 0:0:3) START(LOG, 12:0:20) PERIOD(LOG, 0:0:5) TIME(11:59:55) ... SOLO DISPLAY(SPOOLING) DISPLAY(EDIT) DISPLAY(PASCAL) DI ; NEG R1 ; MOV R1,RKWC ; READ(DISK0, ADDR, SYSTEM+1, INC RKCS ; SYSTEMLENGTH, ERROR); 6$: TSTB RKCS ; BGE 6$ ; TST RKCS ; IF ERROR THEN BLT 2$ ; KERNELERROR( 7$: ; 'SYSTEM LOAD ERROR(:0:)'); .ENDC ; END "LOADFROMDISK"; SPLAY(STRUCTURE) COPY(MONITOR, CONSOLE) COPY(CLASS, CONSOLE) COPY(PROCESS, CONSOLE) START(JOBSTREAM) "LISTINGS PRESENTED: CATALOG SOLO REALTIME USERS "  ; ; ; BEGIN "LOADSYSTEMPROGRAM" ;* CONDITIONAL ASSEMBLY, ABOVE, ; IF SYSTEMTAPE THEN ;* DEPENDING ON "$.DBTA". ; LOADFROMTAPE ELSE ; LOADFROMDISK(SYSTEMBLOCK); RESET ; RESETUNIBUS; SPL 7 ; EXCLUDEINTERRUPTS; INC SSR0 ; ADDRESSMAPPING := TRUE; $CLC0: ;     (*,.0246 "$&)+-/1357!#%'DFHJLN8:<>@BEGIKMO9;=?AC`bdfPRTVXZ\^acegQSUWY[]_|~hjlnprtvxz}ikmoqsuwy{  "CLEAR REMAINING CORE" CLR R0 ; SEGADDR := GETSEGMENTADDRESS( MOV #INTEND,R1 ; PROGRAMEND); ADD INTEND,R1 ; ADC R0 ; MOV R1,R2 ; BIC #017777,R1 ; ASHC #-6,R0 ; MOV KISAR+12.,R0 ; MOV R1,KISAR+12. ; BIC #160000,R2 ; SEGINDEX := GETSEGMENTINDEX( MOV R2 TYPE PAGEBUFFER = MONITOR VAR BUFFER: PAGE; FULL: BOOLEAN; SENDER, RECEIVER: QUEUE; PROCEDURE ENTRY READ(VAR TEXT: PAGE); BEGIN IF NOT FULL THEN DELAY(RECEIVER); TEXT:= BUFFER; FULL:= FALSE; CONTINUE(SENDER); END; PROCEDURE ENTRY WRITE(TEXT: PAGE); BEGIN IF FULL THEN DELAY(SENDER); BUFFER:= TEXT; FULL:= TRUE; CONTINUE(RECEIVER); END; BEGIN FULL:= FALSE END; ,R1 ; PROGRAMEND); ASR R1 ; NEG R1 ; MOV #3$,FETRAP ; REPEAT 2$: ADD #.SEGSW,R1 ; FOR I := SEGINDEX TO 4096 DO ADD #140000,R2 ; 1$: CLR (R2)+ ; SEGADDR@(.I.) := 0; SOB R1,1$ ; ADD #.SGSBK,KISAR+12. ; SEGADDR := GETNEXTSEGMENT( CLR R2 ; JOB-STREAM MANUAL 25 MAR 76 KAISERSTRASSE 12 MACHINE MANUAL 25 MAR 76 7500 KARLSRUHE NOTES 25 MAR 76 GERMANY COMPILER THESIS 7 JUL 76 MR. H.-D. PATOCK SOLO MANUALS 14 NOV 75 FACHBEREICH INFORMATIK SOLO COPY 14 NOV 75 UNIVERSITY OF KAISERSLAUTERN SOLO FILES 14 NOV 75 **************************** SEGADDR); CMP #.PRBLK,KISAR+12. ; SEGINDEX := 1; BNE 2$ ; UNTIL SEGADDR = ENDOFCORE; SUB #4,SP ; 3$: MOV #FEINT,FETRAP ; ADD #4,SP ; MOV KISAR+12.,COREC9 ; CORECAPACITY := BLOCKNUMBER( MOV R0,KISAR+12. ; SEGADDR); VERCOR ; .IF EQ $.DBNC ; MOV #LKSINE,LKS ; STARTLINEFREQUE REAL-TIME MANUAL 5 MAR 76 PFAFFENBERGSTRASSE 95 JOB-STREAM MANUAL 5 MAR 76 675 KAISERSLAUTERN MACHINE MANUAL 5 MAR 76 GERMANY NOTES 5 MAR 76 DR. HANS LANGMAACK SOLO MANUALS 8 DEC 75 INSTITUT FUER INFORMATIK UNIVERSITY OF KIEL ****************** OLSHAUSENSTRASSE 40 - 60 23 KIEL 14 GERMANY DR. HOWARD J. FERCH SOLO MANUALS 27 MAY 76 COMPUNCYCLOCK; .ENDC ; MOV #KNEXIT,R0 ; END; JSR R0,INIT36 ; ; ; .PAGE .SBTTL END OF THE KERNEL MODULE PREFACE .SBTTL .SBTTL ######################################################### .SBTTL ;* ;* ;* ;* ;* ;* ;* ;* ;*********************************************************************** ;************************************************TER SCIENCE DEPARTMENT SOLO FILES 27 MAY 76 UNIVERSITY OF MANITOBA REAL-TIME MANUAL 27 MAY 76 ********************** JOB-STREAM MANUAL 27 MAY 76 WINNIPEG MACHINE MANUAL 27 MAY 76 MANITOBA NOTES 27 MAY 76 CANADA R3T 2N2 PROFESSOR VICTOR R. BASILI SOLO MANUALS 10 NOV 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF MARYLAND *************************************** ;*********************************************************************** ;**** ***** ;**** ***** ;**** ***** ;**** THIS MARKS THE END OF THE KERNEL MODULE PREFACE. ***** ;**** ***** ;**** THE CODE PROPER OF THE KERNEL FOLLOWS: ****** BUILDING MM, ROOM 4105 COLLEGE PARK MARYLAND 20742 DR. JAMES W. CONKLIN SOLO MANUALS 9 JAN 76 SCHOOL OF DENTISTRY SOLO FILES 9 JAN 76 UNIVERSITY OF MICHIGAN MACHINE MANUAL 2 FEB 76 ********************** NOTES 2 FEB 76 ANN ARBOR MICHIGAN 48104 DR. PAUL PICKELMANN SOLO MANUALS 13 APR 76 UNIVERSITY OF MICHIGAN MACHINE MANUAL TREAM MANUAL 24 MAY 76 ********************** MACHINE MANUAL 24 MAY 76 GPO BOX 252 C HOBART AUSTRALIA 7008 MR. CHARLES H. WARLICK, DIRECTOR SOLO MANUALS 28 APR 76 COMPUTATION CENTER SOLO FILES 28 APR 76 UNIVERSITY OF TEXAS, AUSTIN REAL-TIME MANUAL 28 APR 76 *************************** JOB-STREAM MANUAL 28 APR 76 AUSTIN MACHINE MANUAL 28 APR 76 TEXAS 78712 20755 MR. WAYNE SCHMIDT, CHIEF SOLO MANUALS 8 JUN 76 COMPUTER SERVICES SOLO COPY 8 JUN 76 U.S. ARMY CONSTRUCTION ENGINEERING SOLO FILES 8 JUN 76 RESEARCH LABORATORY ********************************** P.O. BOX 4005 CHAMPAIGN ILLINOIS 61820 DR. RALPH LONDON SOLO MANUALS * SEP 75 USC INFORMATION SCIENCES INSTITUTE ********************************** 4676 ADMIRALTY WAY MARINA DEL REY CALIFORNIA 9029 NOTES 28 APR 76 DR. MASARU WATANABE SOLO MANUALS 3 FEB 76 INSTITUTE OF INDUSTRIAL RESEARCH SOLO FILES 3 FEB 76 UNIVERSITY OF TOKYO REAL-TIME MANUAL 3 FEB 76 ******************* JOB-STREAM MANUAL 3 FEB 76 22-1 ROPPONGI MACHINE MANUAL 3 FEB 76 7 CHOME, MINATO-KU NOTES 3 FEB 76 TOKYO 106 1 PROFESSOR ANDREI P. ERSHOV SOLO MANUALS * 9 SEP 75 COMPUTING CENTER SIBERIAN DIVISION OF THE U.S.S.R ACADEMY OF SCIENCES *************************** NOVOSIBIRSK 630090 U. S. S. R. MR. DAVID D. DETERMAN SOLO MANUALS 10 JUN 76 VARATEK COMPUTER SYSTEMS INC. SOLO COPY 10 JUN 76 ***************************** SOLO FILES 10 JUN 76 2 ELM SQUARE REAL-TIME MANUAL 10 JUN 76 ANDOVER 13 APR 76 ********************** NOTES 13 APR 76 424 NORTH STATE STREET ANN ARBOR MICHIGAN 48104 DR. SCOTT BERTILSON SOLO FILES 13 MAY 76 UNIVERSITY OF MINNESOTA *********************** R.R. # 2 SPICER MINNESOTA 56288 DR. JONATHAN GROSS SOLO MANUALS 2 FEB 76 SOCIAL SCIENCE RESEARCH CENTER NOTES 2 FEB 76 25 BLEGEN HALL SOLO FILES 19 APR 76 UNIVER SOLO COPY 20 FEB 76 JAPAN COMPILER THESIS 14 MAY 76 DR. ALLAN CHAN SOLO MANUALS SEP 75 COMPUTER SYSTEMS RESEARCH GROUP SOLO COPY SEP 75 UNIVERSITY OF TORONTO ********************* SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 PROFESSOR RICHARD C. HOLT REAL-TIME MANUAL 22 MAR 76 COMPUTER SYSTEMS RESEARCH GROUP JOBSITY OF MINNESOTA REAL-TIME MANUAL 19 APR 76 *********************** JOB-STREAM MANUAL 19 APR 76 MINNEAPOLIS MACHINE MANUAL 19 APR 76 MINNESOTA 55455 DR. EARL D. JENSEN SOLO MANUALS 8 APR 76 COMPUTER SCIENCE DEPARTMENT 114 LIND HALL UNIVERSITY OF MINNESOTA *********************** MINNEAPOLIS MINNESOTA 55455 DR. G. MICHAEL SCNEIDER NOTES 16 APR 76 COMPUTER SCIENCE D-STREAM MANUAL 22 MAR 76 UNIVERSITY OF TORONTO MACHINE MANUAL 22 MAR 76 ********************* NOTES 22 MAR 76 SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 PROFESSOR J. J. HORNING SOLO MANUALS * SEP 75 COMPUTER SYSTEMS RESEARCH GROUP UNIVERSITY OF TORONTO ********************* SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 MR. JOHN DALSENG EPARTMENT 114 LIND HALL UNIVERSITY OF MINNESOTA *********************** MINNEAPOLIS MINNESOTA 55455 PROFESSOR BRIAN RANDELL SOLO MANUALS * SEP 75 UNIVERSITY COMPUTING LABORATORY UNIVERSITY OF NEWCASTLE UPON TYNE ********************************* CLAREMONT TOWER CLAREMONT ROAD NEWCASTLE UPON TYNE NE1 7RU ENGLAND DR. C. R. SNOW SOLO MANUALS 20 OCT 75 UNIVERSITY COMPUTING LABORATORY SOLO COPY 20 OCT 75 UNIVERSITY OF NEWCASTLE SOLO MANUALS 26 NOV 75 DATAFAGSEKSJONEN SOLO FILES 26 NOV 75 UNIVERSITY OF TROMSOE ********************* STORGATAN 25 N-9000 TROMSOE NORWAY MR. RANDI MIDTSAND REAL-TIME MANUAL 12 MAY 76 COMPUTING CENTER MACHINE MANUAL 12 MAY 76 UNIVERSITY OF TRONDHEIM *********************** 7034 TRONDHEIM - NTH NORWAY PROFESSOR ELLIOTT ORGANICK SOLO MANUALS * 18 SEP 75 COMPUTER SCIENCE DEUPON TYNE SOLO FILES 20 OCT 75 ********************************* REAL-TIME MANUAL 8 MAR 76 CLAREMONT TOWER JOB-STREAM MANUAL 8 MAR 76 CLAREMONT ROAD MACHINE MANUAL 8 MAR 76 NEWCASTLE UPON TYNE NOTES 8 MAR 76 NE1 7RU ENGLAND DR. JOHN LIONS SOLO MANUALS 26 FEB 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 26 FEB 76 UNIVERSITY OF PARTMENT SOLO COPY * 18 SEP 75 UNIVERSITY OF UTAH MACHINE MANUAL * 30 OCT 75 ****************** REAL-TIME MANUAL 12 FEB 76 SALT LAKE CITY JOB-STREAM MANUAL 12 FEB 76 UTAH 84112 MACHINE MANUAL 12 FEB 76 NOTES 12 FEB 76 DR. D.M.R. PARK SOLO MANUALS 10 JUN 76 COMPUTER SCIENCE DEPARTMNEW SOUTH WALES ***************************** KENSINGTON AUSTRALIA 2033 PROFESSOR F. P. BROOKS SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF NORTH CAROLINA **************************** NEW WEST HALL CHAPEL HILL NORTH CAROLINA 27514 MS. HELEN R. MILLER SOLO MANUALS 2 AUG 76 WILSON LIBRARY 024 A REAL-TIME MANUAL 2 AUG 76 UNIVERSITY OF NORTH CAROLINA JOB-STREAM MANUAL 2 AUG 76 ***************ENT REAL-TIME MANUAL 10 JUN 76 UNIVERSITY OF WARWICK JOB-STREAM MANUAL 10 JUN 76 ********************* MACHINE MANUAL 10 JUN 76 COVENTRY CV4 7AL ENGLAND MR. DANIEL E. LIPKIE SOLO MANUALS 10 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 10 MAR 76 UNIVERSITY OF WASHINGTON MACHINE MANUAL 10 MAR 76 ************************ NOTES 10 MAR 76 M.S************* MACHINE MANUAL 2 AUG 76 CHAPEL HILL NOTES 2 AUG 76 NORTH CAROLINA 27514 PROFESSOR OLE-JOHAN DAHL SOLO MANUALS * SEP 75 INSTITUTE OF MATHEMATICS UNIVERSITY OF OSLO ****************** OSLO - BLINDERN 3 NORWAY DR. ROBERT N. KAVANAGH SOLO MANUALS 11 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 11 MAY 76 UNIVERSITY OF SASKATCHEWAN REAL-TIME MA. FR-35 SEATTLE WASHINGTON 98195 PROFESSOR A. C. SHAW SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WASHINGTON ************************ SEATTLE WASHINGTON 98195 PROFESSOR D. D. COWAN SOLO MANUAL * 18 NOV 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WATERLOO ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. J. PULLIN SOLO MANUALS 19 MAY 76 ELECTRICAL ENGINEERING REALNUAL 11 MAY 76 ************************** JOB-STREAM MANUAL 11 MAY 76 SASKATOON MACHINE MANUAL 11 MAY 76 SASKATCHEWAN NOTES 11 MAY 76 CANADA S7N 0W0 DR. BRUCE MITCHELL SOLO MANUALS 9 MAR 76 COMPUTING LABORATORY SOLO COPY 9 MAR 76 UNIVERSITY OF ST. ANDREWS SOLO FILES 9 MAR 76 ************************* RE-TIME MANUAL 19 MAY 76 UNIVERSITY OF WATERLOO MACHINE MANUAL 19 MAY 76 ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. RAUL J. RAMIREZ SOLO MANUALS 31 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 31 MAR 76 UNIVERSITY OF WATERLOO REAL-TIME MANUAL 31 MAR 76 ********************** JOB-STREAM MANUAL 31 MAR 76 WATERLOO MACHINE MANUAL 31 MAL-TIME MANUAL 9 MAR 76 NORTH HAUGH JOB-STREAM MANUAL 9 MAR 76 ST. ANDREWS MACHINE MANUAL 9 MAR 76 SCOTLAND NOTES 9 MAR 76 PROFESSOR KLAUS LAGALLY SOLO MANUALS 30 JUL 76 INSTITUT FUER INFORMATIK SOLO FILES 30 JUL 76 UNIVERSITY OF STUTTGART REAL-TIME MANUAL 30 JUL 76 *********************** JOB-STRAR 76 ONTARIO NOTES 31 MAR 76 CANADA N2L 3G1 DR. GARY R. SAGER SOLO MANUALS 31 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY 31 DEC 75 UNIVERSITY OF WATERLOO SOLO FILES 31 DEC 75 ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. E. J. DESAUTELS SOLO MANUALS 8 OCT 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 8 OCT 7EAM MANUAL 30 JUL 76 AZENBERGSTRASSE 12 MACHINE MANUAL 30 JUL 76 D-7000 STUTTGART 1 NOTES 30 JUL 76 GERMANY DR. IAN JACKSON SOLO MANUALS 13 JAN 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 13 JAN 76 UNIVERSITY OF SYDNEY ******************** SYDNEY 2006 AUSTRALIA DR. JUHA HEINANEN SOLO MANUALS 20 MAY 76 MATHEMATICAL SCIENCES SOLO FIL5 UNIVERSITY OF WISCONSIN SOLO COPY 10 MAR 76 *********************** REAL-TIME MANUAL 10 MAR 76 1210 WEST DAYTON JOB-STREAM MANUAL 10 MAR 76 MADISON MACHINE MANUAL 10 MAR 76 WISCONSIN 53706 NOTES 10 MAR 76 DR. HENRY R. BAUER III SOLO MANUALS 23 SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 23 SEP 75 UNIES 20 MAY 76 UNIVERSITY OF TAMPERE REAL-TIME MANUAL 20 MAY 76 ********************* JOB-STREAM MANUAL 20 MAY 76 PL 607, SF-33101 MACHINE MANUAL 20 MAY 76 TAMPERE 10 NOTES 20 MAY 76 FINLAND PROFESSOR A.H.J. SALE SOLO MANUALS 24 MAY 76 INFORMATION SCIENCE REAL-TIME MANUAL 24 MAY 76 UNIVERSITY OF TASMANIA JOB-SVERSITY OF WYOMING REAL-TIME MANUAL 12 FEB 76 ********************* JOB-STREAM MANUAL 12 FEB 76 P. O. BOX 3682 MACHINE MANUAL 12 FEB 76 LARAMIE NOTES 12 FEB 76 WYOMING 82071 MR. RAY MCFARLAND SOLO MANUALS 30 MAR 76 MARYLAND PROCUREMENT OFFICE SOLO FILES 30 MAR 76 U.S. ARMY ********* 9800 SAVAGE ROAD FT. GEORGE G. MEADE MARYLAND MEDICAL CENTER MACHINE MANUAL 1 APR 76 WEST VIRGINIA UNIVERSITY ************************ 450 MEDICAL CENTER DRIVE B-302 MORGENTOWN WEST VIRGINIA 26505 MR. BUTLER W. LAMPSON SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 DR. J. H. MORRIS SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 DR. BEN WTER SCIENCE DEPARTMENT ORAL ROBERTS UNIVERSITY *********************** 7777 SOUTH LEWIS TULSA, OKLAHOMA 74105 DATA GENERAL NOVA 840 48 K WORDS (16 BITS) DISK (5 M WORDS) CARD READER LINE PRINTER MAGNETIC TAPE DISPLAY TELETYPE PAPER TAPE READER PAPER TAPE PUNCH COMPUTER SCIENCE COURSES INCOMPLETE DR. HIROSHI WADA SEIKEI UNIVERSITY ***************** KICHIJOJI KITAMACHI 3 MUSASHINO-SHI TOKYO 180, JAPAN FACOM 230/25 64 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER MAGNETIC TAPE DRUM TELETYPE TERMINALEGBREIT SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 MR. KENNETH YOUNG SOLO MANUALS 10 NOV 75 3311 WEST 3RD STREET SOLO FILES 8 DEC 75 APARTMENT 1-319 REAL-TIME MANUAL 2 FEB 76 LOS ANGELES JOB-STREAM MANUAL 2 FEB 76 CALIFORNIA 90020 MACHINE MANUAL 2 FEB SYSTEM INCOMPLETE MR. RICHARD M. SMITH P.O. BOX 5882 RALEIGH, NORTH CAROLINA 27607 PDP 11 (LSI) 20 K WORDS (16 BITS) DISK (300 K WORDS) IMP-16 MICROPROCESSOR 32 K WORDS (16 BITS) DISK (300 K WORDS) DISPLAY LINE PRINTER HOBBY COMPUTING INCOMPLETE DR. ROGER L. COTTRELL STANFORD LINEAR ACCELERATOR CENTER STANFORD UNIVERSITY ******************* P.O. BOX 4349 STANFORD, CALIFORNIA 94305 PDP 11 (LSI) 16 K WORDS (16 BITS) CAMAC INTERFACE IBM 370/168 LINK REAL-TIME DATA ANALYSIS INCOMPLETE MR. VIC ST 76 NOTES 2 FEB 76 ###################################### # CONCURRENT PASCAL IMPLEMENTATION # # 3 AUG 76 # ###################################### MR. LEE M. SCHWANKE BOEING AEROSPACE COMPANY ************************ P.O. BOX 3707 SEATTLE, WASHINGTON 98124 PDP 11/40 48 K WORDS (16 BITS) DISK (RK11, 1.2 M WORDS) CLOCK (KW11-P) TELETYPE CARD READER (CR11) LINE PRINTER (LP11-K) PAPER TAPE READER COMPILER DEVELOPMENT UENNING SYSTEMS DESIGNERS LTD. ********************** SYSTEMS HOUSE 57 - 61 HIGH STREET FRIMLEY, SURREY GU16 5HJ ENGLAND PRIME 300 40 K WORDS (16 BITS) DISK (7 M WORDS) LINE PRINTER PAPER TAPE TELETYPE PROCESS CONTROL DATA COMMUNICATIONS PLANNED BUT NOT STARTED DR. K.-P. LOEHR FORSCHUNGSGRUPPE BETRIEBSSYSTEME TECHNISCHE UNIVERSITAET BERLIN ****************************** ROOM 1905 ERNST REUTER PLATZ 7 1 BERLIN 10, GERMANY PDP 11/40 48 K WORDS (16 BITS) DISK (90 M WORDS) CARD READER (CR 11) LINE PRINTER SED LOCALLY PROFESSOR J. W. ATWOOD COMPUTER SCIENCE DEPARTMENT CONCORDIA UNIVERSITY ******************** 1455 DE MAISONNEUVE BLRD. WEST MONTREAL, QUEBEC H3G 1M8 CANADA TEXAS INSTRUMENTS 980B 64 K WORDS (16 BITS) DISK (1.2 M WORDS) CARD READER LINE PRINTER MAGNETIC TAPES MODEMS OPERATING SYSTEM RESEARCH AND TEACHING INCOMPLETE DR. SIMON WADDELL ECOLE POLYTECHNIQUE FEDERALE **************************** AVENUE DE COUR 67 CH-1007 LAUSANNE SWITZERLAND PDP 11/40 32 K WORDS (16 BITS) DISK (1.2 M WORDS) CA(LP 11) CONSOLE (LA 36) DECTAPE 6 TERMINALS USED LOCALLY IBM 370/158 VIRTUAL STORE (32 BITS) VIRTUAL PERIPHERALS OPERATING SYSTEM EDUCATION INCOMPLETE DR. RAFAEL M. BONET TELESINCRO S.A. *************** INVESTIGACION Y DESARROLLO ROCAFORT 100 BARCELONA, SPAIN DATA GENERAL NOVA 840 80 K WORDS (16 BITS) DISK (2 * 1.2 M WORDS) LINE PRINTER CARD READER MAGNETIC TAPE TELETYPE 4 DISPLAYS BOOTSTRAP SYSTEM FOR THE TELESINCRO FACTOR F2 INCOMPLETE MR. GARY D. THOMAS 8236 RESEARCH BOULEVARD # 166 AUSTIN, TE JOB-STREAM MANUAL 10 JUN 76 MASSACHUSETTS 01810 MACHINE MANUAL 10 JUN 76 NOTES 10 JUN 76 MR. ROBERT A. STILLMAN SOLO MANUALS 12 MAR 76 INSTRUMENT DIVISION SOLO FILES 12 MAR 76 VARIAN ASSOCIATES REAL-TIME MANUAL 12 MAR 76 ***************** JOB-STREAM MANUAL 12 MAR 76 611 HANSEN WAY RD READER LINE PRINTER CASETTE TAPE PAPER TAPE PROCESSOR BUFFER (PDP 11/10) EDUCATION INCOMPLETE PROFESSOR ASHOK N. ULLALL FACHHOCHSCHULE REUTLINGEN ************************* KAISERSTRASSE 99 D-7410 REUTLINGEN GERMANY IBM 1130 16 K WORDS (16 BITS) DISK (2 * 0.5 M WORDS) CARD READER CARD PUNCH LINE PRINTER PLOTTER PAPER TAPE READER PAPER TAPE PUNCH INCOMPLETE DIETZ 621 48 - 96 K WORDS (8 BITS) DISK (10 M WORDS) CARD READER LINE PRINTER COMMUNICATION LINES INCOMPLETE MR. LELAND E. VANDERGRIFF FISHE MACHINE MANUAL 12 MAR 76 PALO ALTO NOTES 12 MAR 76 CALIFORNIA 94303 MR. ALAN FRITCHOFF SOLO MANUALS 15 APR 76 VARIAN DATA MACHINES SOLO FILES 15 APR 76 ******************** 2722 MICHELSON DRIVE IRVINE CALIFORNIA 92664 MR. JOHN ROMEY SOLO MANUALS 26 JUL 76 VARIAN DATA MACHINES REAL-TIME MANUAL 26 JUL 76 *********R CONTROLS COMPANY *********************** R. A. ENGEL TECHNICAL CENTER MARSHALLTOWN, IOWA 50158 INTERDATA 70 (DOUBLE ADDRESS SPACE) 65 K WORDS (16 BITS) DISK (2.4 M WORDS) DISPLAY LINE PRINTER PAPER TAPE READER PAPER TAPE WRITER PROGRAM DEVELOPMENT OPERATING SYSTEM DEVELOPMENT INCOMPLETE MR. ALDEN J. CARLSON JOHN FLUKE MANUFACTURING COMPANY ******************************** P.O. BOX 7428 SEATTLE, WASHINGTON 98113 PDP 11 28 K WORDS (16 BITS) DISK LINE PRINTER PAPER TAPE DISPLAY PROGRAM DEVELOPMENT PLA*********** JOB-STREAM MANUAL 26 JUL 76 2722 MICHELSON DRIVE MACHINE MANUAL 26 JUL 76 IRVINE NOTES 26 JUL 76 CALIFORNIA 92715 DR. ANDREW S. TANENBAUM SOLO MANUALS 25 MAR 76 WISKUNDIG SEMINARIUM SOLO COPY 25 MAR 76 VRIJE UNIVERSITEIT SOLO FILES 25 MAR 76 ****************** REAL-TIME MANUAL 25 MARNNED, BUT NOT STARTED MR. HERBERT W. SILVERMAN MANAGER, SOFTWARE DEVELOPMENT GENERAL AUTOMATION INC. *********************** 1055 SOUTH EAST STREET ANAHEIM, CALIFORNIA 92805 GENERAL AUTOMATION 16/440 64 K WORDS (16 BITS) DISK (2.5 M WORDS) TELETYPE LINE PRINTER CARD READER MAGNETIC TAPE SOFTWARE DEVELOPMENT INCOMPLETE MR. MICHAEL GREEN 11483 HESSLER ROAD, # 11 CLEVELAND, OHIO 44106 DATAPOINT 5500 55 K WORDS (8 BITS) DISKS (2 * 2.5 M WORDS) LINE PRINTER COMMUNICATIONS INTERFACE OPERATING SYSTEM EXP 76 BOX 7161 JOB-STREAM MANUAL 25 MAR 76 AMSTERDAM MACHINE MANUAL 25 MAR 76 THE NETHERLANDS NOTES 25 MAR 76 MR. RALPH S. GOODELL SOLO MANUALS 4 MAY 76 WANG LABORATORIES SOLO FILES 4 MAY 76 ***************** MACHINE MANUAL 4 MAY 76 HILLCREST DRIVE NOTES 4 MAY 76 HERIMENTS SYSTEM PROGRAMMING INCOMPLETE MR. MALCOLM F. WELCH MANAGER OF SOFTWARE GRI COMPUTER CORPORATION ************************ 320 NEEDHAM STREET NEWTON, MASSACHUSETTS 02164 GRI 99/50 8 - 32 K WORDS (16 BITS) DISK (10.6 - 42.4 M WORDS) LINE PRINTER CARD READER CARD PUNCH MAGNETIC TAPE PAPER TAPE READER PAPER TAPE PUNCH VIDEO DISPLAY FLOPPY DISK COMMUNICATIONS EQUIPMENT COMPILER WRITING INCOMPLETE DR. SAM GEBALA HEWLETT PACKARD CORPORATION *************************** 3500 DEER CREEK ROAD PALO ALTOARVARD MASSACHUSETTS 01451 DR. JOHN P. LEE MACHINE MANUAL 16 MAR 76 WASHINGTON STATE UNIVERSITY NOTES 16 MAR 76 *************************** 103 NORTH CAMPUS HEIGHTS PULLMAN WASHINGTON 99163 MISS ANDREA MELIUS SOLO MANUALS 20 OCT 75 DIVISION OF PURCHASING SOLO FILES 20 OCT 75 WASHINGTON STATE UNIVERSITY *************************** PULLMAN WASHINGTON 99163 DR. GERALD C. JOHNS CALIFORNIA 94304 HEWLETT PACKARD 21MX 48 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER MAGNETIC TAPE (1600 BPI) CONSOLE OPERATING SYSTEM RESEARCH PROGRAMMING LANGUAGE RESEARCH INCOMPLETE MR. ERIC SCHNELLMAN HONEYWELL MARINE SYSTEMS ************************ 5303 SHILSHOLE AVENUE SEATTLE, WASHINGTON 98107 HONEYWELL H516 32 K WORDS (16 BITS) DISK (3 - 12 M WORDS) LINE PRINTER CARD READER MAGNETIC TAPE (7 & 9 TRACK) PAPER TAPE READER PAPER TAPE PUNCH DISPLAY (TEKTRONIX, HAZELTINE 2000) REAL-TIME PRO SOLO MANUALS 27 MAY 76 COMPUTER SYSTEMS LABORATORY SOLO FILES 27 MAY 76 WASHINGTON UNIVERSITY REAL-TIME MANUAL 27 MAY 76 ********************* JOB-STREAM MANUAL 27 MAY 76 724 SOUTH EUCLID MACHINE MANUAL 27 MAY 76 ST. LOUIS NOTES 27 MAY 76 MISSOURI 63110 DR. FRANK M. STEPEZYK REAL-TIME MANUAL 20 FEB 76 WEST COAST UNIVEGRAMMING INCOMPLETE MR. ROBERT A. STRYK HONEYWELL RESEARCH CENTER ************************* 10701 LYNDALE AVENUE SOUTH BLOOMINGTON MINNESOTA 55420 HONEYWELL H316 24 K WORDS (16 BITS) DISK (1.2 M WORDS) TERMINAL (ASR 33) LINE PRINTER 2 MAGNETIC TAPES (7 TRACK) PAPER TAPE READER PAPER TAPE PUNCH LINE CONTROLLERS (SYNCHRONOUS & ASYNCHRONOUS) REAL-TIME INTERFACE (ANALOG AND DIGITAL) DEMONSTRATION AND EVALUATION INCOMPLETE DR. MASAAKI SHIMASAKI INFORMATION SCIENCE DEPARTMENT KYOTO UNIVERSITY ************RSITY JOB-STREAM MANUAL 20 FEB 76 ********************* MACHINE MANUAL 20 FEB 76 440 SHATTO PLACE NOTES 20 FEB 76 LOS ANGELES CALIFORNIA 90020 DR. FRED M. IVES SOLO MANUALS 14 OCT 75 COMPUTER SCIENCE DEPARTMENT WESTERN WASHINGTON STATE COLLEGE ******************************** BELLINGHAM WASHINGTON 98225 MR. RAINER F. MCCOWN SOLO MANUALS 18 MAR 76 WESTINGHO**** SAKYO-KU, KYOTO 606 JAPAN HITAC 8350 64 K WORDS (32 BITS) DISK (7.25 M WORDS) CARD READER LINEPRINTER INCOMPLETE DR. N. SOLNTSEFF APPLIED MATHEMATICS MCMASTER UNIVERSITY ******************* HAMILTON ONTARIO L8S 4K1 CANADA HEWLETT PACKARD HP2100 16 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD RADER LINE PRINTER PAPER TAPE READER PAPER TAPE PUNCH OPERATING SYSTEM TEACHING AND RESEARCH INCOMPLETE CONTROL DATA CORPORATION CDC 6400 64 K WORDS (60 BITS) DISK CARD READER LINE PRINTER MAGNETIC TAPE PAPER USE ELECTRIC CORPORATION SOLO FILES 18 MAR 76 ********************************* REAL-TIME MANUAL 18 MAR 76 9537 LONGLOOK LANE JOB-STREAM MANUAL 18 MAR 76 COLUMBIA MACHINE MANUAL 18 MAR 76 MARYLAND 21045 NOTES 18 MAR 76 DR. PAUL B. BROWN SOLO MANUALS 1 APR 76 PHYSIOLOGY & BIOPHYSICS DEPARTMENT REAL-TIME MANUAL 1 APR 76 WEST VIRGINIATAPE READER CROSS COMPILER FOR THE HP 2100 INCOMPLETE MR. MICHAEL S. BALL CODE 2522 NAVAL UNDERSEA CENTER ********************* SAN DIEGO, CALIFORNIA 92132 INTERDATA 7/16 32 K WORDS (16 BITS) DISK (10 M WORDS) MAGNETIC TAPES DISPLAY SIGNAL PROCESSING EXECUTIVE INCOMPLETE MR. CHARLES RATTRAY 4 DIDCOT ROAD WOODHOUSE PARK WYTHENSHAWE MANCHESTER, ENGLAND PDP 11/40 48 K WORDS (16 BITS) DISK (10 M WORDS) LINE PRINTER MAGNETIC TAPE SOFTWARE CONSTRUCTION SYSTEM INCOMPLETE PROFESSOR DAVE R. ELAND COMPU0) CASETTE DRIVES EDUCATIONAL PROJECTS INCOMPLETE MR. ROBERT A. STILLMAN INSTRUMENT DIVISION VARIAN ASSOCIATES ***************** 611 HANSEN WAY PALO ALTO, CALIFORNIA 94303 VARIAN DATA MACHINES V73 32 K WORDS (16 BITS) DISK (5 M WORDS) LINE PRINTERS MAGNETIC TAPES PAPER TAPE PLOTTER REAL-TIME OPERATING SYSTEM INCOMPLETE (USED LOCALLY) DR. ANDREW S. TANENBAUM WISKUNDIG SEMINARIUM VRIJE UNIVERSITEIT ****************** BOX 7161 AMSTERDAM, THE NETHERLANDS PDP 11/45 108 K WORDS (16 BITS) DISK (40 M WORD ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT); WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:=OK END; WITH PARAM(.2.) DO BEGIN TAG:= PTRTYPE; PTR:= LINK END; WITH PARAM(.4.) DO BEGIN TAG:= INTTYPE; INT:= PAGES_OUT END; END; PROCEDURE READ_IFL (VAR I: INTEGER); BEGIN IF WORDS_IN = PAGELENGTH THEN BEGIN IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT ELSE BEGIN GET(INFILE, PAGES_IN, PAGE_IN); PAGES_IN:= SUCC(PAGES_IN) END; WORDS_IN:= 0 END; WORDS_IN:= SUCC(S) CLOCK (KW11P) LINE PRINTER DECTAPE PAPER TAPE 30 TERMINALS INCOMPLETE MR. RAINER F. MCCOWN WESTINGHOUSE ELECTRIC CORPORATION ********************************* 9537 LONGLOOK LANE COLUMBIA MARYLAND 21045 DATA GENERAL NOVA 1200 32 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER DISPLAY MANETIC TAPE PAPER TAPE READER SYSTEM IMPLEMENTATION LANGUAGE INCOMPLETE MR. KENNETH YOUNG 3311 WEST 3RD STREET AAPARTMENT 1-319 LOS ANGELES CALIFORNIA 90020 IBM 370/140 128 K WORDS (32 BITS) DISK (3 M WORDS) DISPWORDS_IN); I:= PAGE_IN(.WORDS_IN.) END; PROCEDURE WRITE_IFL (I: INTEGER); BEGIN WORDS_OUT:= SUCC(WORDS_OUT); PAGE_OUT(.WORDS_OUT.):= I; IF WORDS_OUT = PAGELENGTH THEN BEGIN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT ELSE BEGIN PUT(OUTFILE, PAGES_OUT, PAGE_OUT); PAGES_OUT:= SUCC(PAGES_OUT) END; WORDS_OUT:= 0 END END; PROCEDURE PRINTABS(ARG:INTEGER); VAR T:ARRAY (.1..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER; BEGIN REM:=ARG; DIGIT:=0; REPEAT DIGIT:=DIGITLAY (TEKTRONIX 4006-1) TEXAS INSTRUMENTS TI 735 SELF-STUDY INCOMPLETE +1; T(.DIGIT.):=CHR(ABS(REM MOD 10) + ORD('0')); REM:=REM DIV 10; UNTIL REM=0; FOR I:=DIGIT DOWNTO 1 DO WRITE(T(.I.)); FOR I:=DIGIT+1 TO MAXDIGIT DO WRITE(' '); END; PROCEDURE PRINTEOL; BEGIN WRITE(EOL); PRINTED:=0 END; PROCEDURE PRINTFF; VAR I:INTEGER; BEGIN PRINTEOL; FOR I:=1 TO 130 DO WRITE('5'); PRINTEOL END; PROCEDURE PRINTOP(OP:INTEGER); BEGIN IF PRINTED=PRINTLIMIT THEN PRINTEOL; WRITE('C'); PRINTABS(OP); PRINTED:=PRINTED+1; END; PROCEDURE PRINTARG(ARG:INTEGER); BEGIN IF PRDO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; ARITHMETIC:=(.INT_KIND,REAL_KIND.); INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); SMALLS:=INDEXS OR (.REAL_KIND,SET_KIND,QUEUE_KIND,POINTER_KIND.); PASSIVES:=INDEXS OR (.REAL_KIND,SET_KIND,POINTER_KIND,STRING_KIND, PASSIVE_KIND.); LARGES:=(.STRING_KIND,PASSIVE_KIND,ACTIVE_KIND,SYSCOMP_KIND.); INDIRECTS:=LARGES; INIT_MODES:= (.CLASS_MODE, MONITOR_MODE, PROCESS_MODE.); ROUTINE_MODES:= CIKPRTVXZ\^`bdfQSUWY[]_aceglnprtvxz|~hjmoqsuwy{}ik      "$&!#%'468:<>(*,.02579;=?)+-/13PRTV@BDFHJLNINTED=PRINTLIMIT THEN PRINTEOL; IF ARG<0 THEN WRITE('-') ELSE WRITE(' '); PRINTABS(ARG); PRINTED:=PRINTED+1; END; PROCEDURE PUT_ARG(ARG:INTEGER); BEGIN WRITE_IFL(ARG); IF DEBUG THEN PRINTARG(ARG) END; PROCEDURE PUT0(OP:INTEGER); BEGIN WRITE_IFL(OP); IF DEBUG THEN PRINTOP(OP) END; PROCEDURE PUT1(OP,ARG1:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1) END END; PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER); , RESULT) ELSE OK:= ARG(.1.).BOOL; RELEASE(HEAPTOP); INITWRITE; END; BEGIN IF TASK <> JOBTASK THEN REPEAT STARTIO; IF OK THEN SELECTDRIVER; IF OK THEN CALLDRIVER; TERMIO; UNTIL FALSE; END.  BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2) END END; PROCEDURE PUT3(OP,ARG1,ARG2,ARG3:INTEGER); BEGIN PUT2(OP,ARG1,ARG2); PUT_ARG(ARG3) END; PROCEDURE PUT4(OP,ARG1,ARG2,ARG3,ARG4:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4"*X ( " " ^<  >" "0 " " >"   P0>   L" X" BB `  V-  " \( * " XAS 78758 TEXAS INSTRUMENTS 990/10 32 K WORDS (16 BITS) DISK (1.2 M WORDS) LINE PRINTER (CENTRONICS) CARD READER DATA TERMINAL (SILENT 700 ASR) OPERATING SYSTEM EXPERIMENTS PASCAL PROGRAMMING INCOMPLETE MR. DENNIS HEIMBIGNER TRW SYSTEMS GROUP ***************** MAIL STATION R3/1072 1 SPACE PARK REDONDO BEACH CALIFORNIA 90278 NANODATA QM-1 10 K WORDS MICRO STORE (18 BITS) 60 K WORDS MAIN STORE (18 BITS) DISK (55 M BYTES) MAGNETIC TAPE (9 TRACK, 800 & 1600 BPI) PRINTER PLOTTER EXPERIMENTAL EVALUATION US) END END; PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); WRITE_IFL(ARG5); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4); PRINTARG(ARG5) END END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF" "##########################" "OPERAND STACK MANIPULATION" "##########################" PROCEDURE POP; BEGINED LOCALLY READY FOR DISTRIBUTION MR. M. VERGES TRIAS CENTRO DE CALCULO DE LA UNIVERSIDAD POLITECNICA *********************** AVDA. DR. GREGORIO MARANON BARCELONA 14, SPAIN FACOM 230/25 64 K WORDS (16 BITS) DISK (2.8 M WORDS) CARD READER LINE PRINTER TERMINAL MAGNETIC TAPE EDUCATIONAL INCOMPLETE DR. HARTMUT FICHTEL INFORMATION SCIENCE UNIVERSITY OF HAMBURG ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY INTERDATA M85 32 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD READER LINE PRINTER T:=S; TOP_STACK:=TOP_STACK@.NEXT_ENTRY; RELEASE(TOP_STACK@.RESET_POINT); IF TOP_STACK=EMPTY_STACK THEN S:=NIL ELSE S:=TOP_STACK@.NEXT_ENTRY@.OPND; END; PROCEDURE PUSH; BEGIN S:=T; NEW(THIS_STACK); WITH THIS_STACK@ DO BEGIN NEW(OPND); T:=OPND; NEXT_ENTRY:=TOP_STACK; MARK(RESET_POINT) END; TOP_STACK:=THIS_STACK END; "##########" "INITIALIZE" "##########" PROCEDURE INITIALIZE; BEGIN DONE:=FALSE; INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ TELETYPE PAPER TAPE READER PAPER TAPE PUNCH USED LOCALLY MR. H.D. PATOCK FACHBEREICH INFORMATIK UNIVERSITY OF KAISERSLAUTERN **************************** PFAFFENBERGSTRASSE 95 675 KAISERSLAUTERN GERMANY INTERDATA 7/32 40 K WORDS (32 BITS) DISK (2 * 2.5 M WORDS) INTERTAPE (M46-400) PAPER TAPE READER (M46-241) PRINTER (M46-205) DISPLAY (HP 2640 A) TELETYPE (ASR 33) INCOMPLETE DR. P. KAMMERER COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF KARLSRUHE *********************** KAISERSTRASSE 12 7500 KARLSRUHE GE `@  "  ^ $  * ,* 8* D*| P*l \*\ h*L t*< *, * Zhv0  t   | d X"" d"$d"*X  RMANY BURROUGHS B1726 128 K BYTES DISK (2 * 4.6 M BYTES) CARD READER PRINTER TAPE TELETYPE RESEARCH INCOMPLETE DR. JAMES W. CONKLIN SCHOOL OF DENTISTRY UNIVERSITY OF MICHIGAN ********************** ANN ARBOR, MICHIGAN 48104 PRIME 300 56 K WORDS (16 BITS) DISK (6 M WORDS) 4 TERMINALS LINE PRINTER MAGNETIC TAPE PASCAL PROGRAMMING READY FOR DISTRIBUTION PRIME 400 96 K WORDS (16 BITS) DISK (12 M WORDS) 28 TERMINALS PASCAL PROGRAMMING INCOMPLETE DR. JONATHAN GROSS SOCIAL SCIENCE RESEARCH CENTER UNIVE^ ~4 (  d"*XJ d0* "2 d0 ":f  ( "" `$f  (d$ d^2Rf * * d$ d0^ RSITY OF MINNESOTA *********************** 25 BLEGEN HALL MINNEAPOLIS, MINNESOTA 55455 PDP 8E 32 K WORDS (12 BITS) DISK (3 M WORDS) CARD READER MAGNETIC TAPE (9 TRACK) PAPER TAPE READER PAPER TAPE PUNCH DISPLAY (TEKTRONIX 4015) PLOTTER (CALCOMP 563) DIGITIZING TABLE MODEMS (SYNCHRONOUS & ASYNCHRONOUS) EDUCATION INCOMPLETE DR. IAN JACKSON COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF SYDNEY ******************** SYDNEY 2006 AUSTRALIA CYBER 72 (VIRTUAL MACHINE) 24 K WORDS (60 BITS) DISK (ENOUGH) TERMINAL STSTACK,THIS_STACK,EMPTY_STACK:STACK_LINK; DEBUG,DONE: BOOLEAN; PASSIVES,INDEXS,LARGES,ARITHMETIC,INDIRECTS,SMALLS: TYPE_KINDS; UNIVERSAL,ASSIGNS,VAR_PARMS,CNST_PARMS, PARMS: CONTEXTS; "############################" "COMMON TEST OUTPUT MECHANISM" "############################" PRINTED: INTEGER; OK: BOOLEAN; "PASS1 TO 6: OK = NOT DISK OVERFLOW PASS7: OK = NOT DISK OVERFLOW & PROGRAM CORRECT" PAGE_IN: PAGE; PAGES_IN, WORDS_IN: INTEGER; PAGE_OUT: PAGE; PAGES_OUT, WORDS_OUT: INTEGER; PUDENT PROJECT INCOMPLETE DR. MASARU WATANABE INSTITUTE OF INDUSTRIAL RESEARCH UNIVERSITY OF TOKYO ******************* 22-1 ROPPONGI, 7 CHOME MINATO-KU TOKYO 106, JAPAN FACOM U-200 32 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD READER LINE PRINTER OPERATING SYSTEM STUDIES INCOMPLETE DR. HENRY R. BAUER, III COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WYOMING ********************* P.O. BOX 3682 LARAMIE, WYOMING 82071 TEXAS INSTRUMENTS 980A 16 K WORDS (16 BITS) DISK (2 FLOPPY AED DRIVES) DISPLAY (SILENT 70ROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE); VAR I: INTEGER; BEGIN WRITE(EOL); FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.)); WRITE(EOL) END; PROCEDURE FILE_LIMIT; BEGIN PRINT_TEXT('PASS 5: FILE_LIMIT'); OK:= FALSE END; PROCEDURE INIT_PASS (VAR LINK: PASSPTR); BEGIN LINK:= PARAM(.2.).PTR; OK:= TRUE; PAGES_IN:= 1; WORDS_IN:= PAGELENGTH; PAGES_OUT:= 1; WORDS_OUT:= 0 END; PROCEDURE NEXT_PASS (LINK: PASSPTR); BEGIN IF WORDS_OUT > 0 THEN IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT .f, ^&  $df " x N*^* d d4>INPUT: OUTPUT: TERMINATED OVERFLOW POINTERERRORRANGEERROR VARIANTERRORHEAPLIMIT STACKLIMIT CODELIMIT TIMELIMIT CALLERROR : LINE FILE IDENTIFIER MISSING DISK FILE UNKNOWN NOT EXECUTABLE d$ d0^ NGTH); FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; "####" "BODY" "####" PROCEDURE ROUTINE_; BEGIN PUSH; WITH T@ DO BEGIN READ_IFL(MODE); READ_IFL(DISP); CLASS:=ROUTINE; READ_IFL(PARM_SIZE); READ_CEMENT; BEGIN READ_IFL(L); PUT1(PUSHLABEL2,L) END; PROCEDURE PROG_CALL; VAR INTF_LENGTH:INTEGER; BEGIN READ_IFL(INTF_LENGTH); PUT0(CALLPROG2); PUT1(POP2,INTF_LENGTH); POP END; "##########" "EXPRESSION" "##########" PROCEDURE EQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF CHAR_KIND,INT_KIND,BOOL_KIND, ENUM_KIND,POINTER_KIND, REAL_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND,PASSIVE_KIND: PIFL(VAR_SIZE); READ_IFL(STACK_SIZE) END END; PROCEDURE BODY; BEGIN ROUTINE_; WITH T@ DO BEGIN PUT5(ENTER2,MODE,DISP,PARM_SIZE,VAR_SIZE,STACK_SIZE); CURRENT_MODE:=MODE END END; PROCEDURE BODY_END; BEGIN PUT1(RETURN2,CURRENT_MODE); POP END; "#######" "LOADING" "#######" PROCEDURE ADDR_ERROR; BEGIN ERROR1(ADDRESS_ERROR); PUT1(PUSHCONST2,0) END; PROCEDURE ADDRESS; BEGIN WITH T@ DO IF CLASS=VALUE THEN BEGIN CASE STATE OF UT2(COMPSTRCT2,OP,T@.LENGTH); ACTIVE_KIND,QUEUE_KIND,GENERIC_KIND,UNDEF_KIND, SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); PASSIVE_KIND,ACTIVE_KIND,POINTER_KIND,QUEUE_KIND,GEN DIRECT: BEGIN IF MODE=SCONST_MODE THEN ADDR_ERROR ELSE PUT2(PUSHADDR2,MODE,DISP); IF KIND=SYSCOMP_KIND THEN PUT1(FIELD2,LENGTH) "OFFSET" END; INDIRECT: PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); ADDR: ; EXPRESSION: ADDR_ERROR END; STATE:=ADDR END ELSE ADDR_ERROR END; PROCEDURE TYPE_; BEGIN WITH T@ DO BEGIN READ_IFL(KIND); READ_IFL(NOUN); READ_IFL(LENGTH) END END; PROCEDURE RESULT; BERIC_KIND, UNDEF_KIND,SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE STRICT_INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); SET_KIND,POINTER_KIND,PASSIVE_KIND,ACTIVE_KIND,QUEUE_KIND, SYSCOMP_KIND,ROUTINE_KIND,UNDEF_KIND: ERROR2(TYPE_EEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(DISP); PUT2(PUSHADDR2,MODE,DISP); CONTEXT:=FUNC_RESULT; STATE:=ADDR; "RESULT" TYPE_ END END; PROCEDURE VALUE_; BEGIN WITH T@ DO BEGIN IF KIND IN SMALLS THEN BEGIN "LOAD VALUE" CASE STATE OF DIRECT: IF MODE=SCONST_MODE THEN PUT1(PUSHCONST2,DISP) ELSE PUT3(PUSHVAR2,TTYP,MODE,DISP); INDIRECT: BEGIN PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); PUT1(PUSHIND2,TTRROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INCLUSION; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=SET_KIND) AND (S@.KIND IN INDEXS) AND (S@.NOUN=T@.NOUN) THEN PUT2(COMPARE2,INSET,SET_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=BOOL_EXPR END; PROCEDURE UMINUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN PUT1(NEG2,TTYP) ELSE ERROR1(TYPE_ERROR) END; PROCEDURE UPLUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN "OK" ELSE ERROR1(TYP) END; ADDR: PUT1(PUSHIND2,TTYP); EXPRESSION: END; IF LENGTH=BYTELENGTH THEN LENGTH:=WORDLENGTH; STATE:=EXPRESSION END ELSE IF KIND IN INDIRECTS THEN ADDRESS ELSE "ERROR" PUT1(PUSHCONST2,0); CONTEXT:=EXPR END END; PROCEDURE STORE(POPVAR:BOOLEAN); VAR TYP:INTEGER; SIMILAR:BOOLEAN; BEGIN "EXPRESSION" VALUE_; SIMILAR:=COMPATIBLE; POP "EXPRESSION"; IF SIMILAR THEN WITH T@ DO IF CONTEXT IN ASSIGNS THEN BEYPE_ERROR) END; PROCEDURE PLUS_MINUS_STAR(OP:INTEGER); VAR TNOUN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=INT_KIND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=INT_EXPR END ELSE IF T@.KIND=REAL_KIND THEN BEGIN PUT1(OP,REAL_TYP); POP; T@:=REAL_EXPR END ELSE IF (T@.KIND=SET_KIND) AND (OP=SUB2) AND COMPATIBLE THEN BEGIN PUT1(SUB2,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN (.PROC_MODE,PE_MODE,CE_MODE,ME_MODE.); UNIVERSAL:=(.UNIV_VAR,UNIV_CONST.); ASSIGNS:=(.FUNC_RESULT,VARIABLE,VAR_PARM,UNIV_VAR, WITH_VAR.); VAR_PARMS:=(.VAR_PARM,UNIV_VAR.); CNST_PARMS:=(.CONST_PARM,UNIV_CONST.); PARMS:= VAR_PARMS OR CNST_PARMS; S:=NIL; T:=NIL; NEW(EMPTY_STACK); TOP_STACK:=EMPTY_STACK; WITH EMPTY_STACK@ DO BEGIN NEXT_ENTRY:=NIL; OPND:=NIL; MARK(RESET_POINT) END; WITH INT_EXPR DO BEGIN KIND:=INT_KIND; NOUN:=XINTEGER; LENGTH:=WORDLENGTH; MODGIN TYP:=TTYP; IF TYP=STRUCT_TYP THEN PUT1(COPY2,LENGTH) ELSE PUT1(ASSIGN2,TYP) END ELSE ERROR1(ASSIGN_ERROR); IF POPVAR THEN POP "VARIABLE" END; "##########" "STATEMENTS" "##########" PROCEDURE VAR_REF; BEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(MODE); READ_IFL(DISP); READ_IFL(CONTEXT) END END; PROCEDURE VAR_; BEGIN PUSH; VAR_REF; "VAR" TYPE_; WITH T@ DO IF(CONTEXT IN VAR_PARMS) OR (CONTEXT IN CNST_PARMS) AND (KINE:=UNDEF_MODE; CLASS:=VALUE; CONTEXT:=EXPR; STATE:=EXPRESSION END; REAL_EXPR:=INT_EXPR; WITH REAL_EXPR DO BEGIN KIND:=REAL_KIND; NOUN:=XREAL; LENGTH:=REALLENGTH END; BOOL_EXPR:=INT_EXPR; WITH BOOL_EXPR DO BEGIN KIND:=BOOL_KIND; NOUN:=XBOOLEAN END; SET_EXPR:=INT_EXPR; WITH SET_EXPR DO BEGIN KIND:=SET_KIND; NOUN:=XUNDEF; LENGTH:=SETLENGTH END; UNDEF_EXPR:=INT_EXPR; WITH UNDEF_EXPR DO BEGIN KIND:=UNDEF_KIND; NOUN:=XUNDEF D IN LARGES) THEN STATE:=INDIRECT ELSE STATE:=DIRECT END; PROCEDURE CALL_PROC; BEGIN WITH T@ DO IF CLASS=ROUTINE THEN IF MODE=STD_MODE THEN PUT1(PROCEDURE2,DISP) ELSE PUT3(CALL2,MODE,DISP,PARM_SIZE); POP END; PROCEDURE CONSTPARM(GENERIC: BOOLEAN); BEGIN "PARAMETER" VAR_; IF COMPATIBLE THEN IF T@.CONTEXT = UNIV_CONST THEN S@.KIND:= T@.KIND; POP "PARAMETER"; "ARGUMENT" VALUE_; IF GENERIC THEN S@ "FUNCTION RESULT" := T@ "ACTUAL ARGUMEND; PUT1(JUMP2,1) "JUMP TO BLOCK LABEL 1, THE INITIAL PROCESS" END; "######" "ERRORS" "######" PROCEDURE ERROR1(ERROR: INTEGER); BEGIN WITH T@ DO IF KIND=UNDEF_KIND THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); T@:=UNDEF_EXPR END; PROCEDURE ERROR2(ERROR:INTEGER); BEGIN IF (T@.KIND=UNDEF_KIND) OR (S@.KIND=UNDEF_KIND) THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); S@:=UNDEF_EXPR END; PROCEDURE ERROR2P(ERROR:INTEGER); BEGINENT"; POP "ARGUMENT" END; PROCEDURE VARPARM; BEGIN "ARGUMENT" ADDRESS; "PARAMETER" VAR_; IF COMPATIBLE THEN IF NOT (S@.CONTEXT IN ASSIGNS) THEN ERROR2(ASSIGN_ERROR); POP "PARAMETER"; POP "ARGUMENT" END; PROCEDURE FALSE_JUMP; VAR L:DISPLACEMENT; BEGIN "BOOLEAN" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); READ_IFL(L); PUT1(FALSEJUMP2,L); POP END; PROCEDURE CASE_JUMP; VAR L: DISPLACEMENT; BEGIN "SELECTOR" VALUE_; READ_IFL ERROR2(ERROR); POP END; PROCEDURE EOM; VAR VAR_LENGTH:DISPLACEMENT; BEGIN WITH INTER_PASS_PTR@ DO RELEASE(RESETPOINT); READ_IFL(VAR_LENGTH); PUT1(EOM2,VAR_LENGTH); DONE:=TRUE END; PROCEDURE ABORT; BEGIN PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR); EOM END; "#############" "TYPE CHECKING" "#############" FUNCTION TTYP:INTEGER "TYPE CODE"; BEGIN WITH T@ DO CASE KIND OF INT_KIND,BOOL_KIND,ENUM_KIND,POINTER_KIND, QUEUE_KIND,UNDEF_KIND:(L); PUT1(JUMP2,L) END; PROCEDURE DEF_LABEL; VAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(DEFLABEL2,L) END; PROCEDURE JUMP; VAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(JUMP2,L) END; PROCEDURE JUMP_DEF; BEGIN JUMP; DEF_LABEL END; PROCEDURE CHK_TYPE; BEGIN PUSH; T@:=INT_EXPR; TYPE_; IF COMPATIBLE THEN "OK"; POP END; PROCEDURE CASE_LIST; VAR I,MIN,MAX:INTEGER; L:DISPLACEMENT; BEGIN POP "SELECTOR"; DEF_LABEL; READ_IFL(MIN); READ_IFL(MAX TTYP:=WORD_TYP; REAL_KIND: TTYP:=REAL_TYP; CHAR_KIND: IF LENGTH=WORDLENGTH THEN TTYP:=WORD_TYP ELSE TTYP:=BYTE_TYP; SET_KIND: TTYP:=SET_TYP; STRING_KIND,PASSIVE_KIND: TTYP:=STRUCT_TYP; ACTIVE_KIND,GENERIC_KIND,SYSCOMP_KIND,ROUTINE_KIND: BEGIN ERROR1(TYPE_ERROR); TTYP:=WORD_TYP END END END; FUNCTION COMPATIBLE:BOOLEAN; VAR RESULT:BOOLEAN; BEGIN IF (T@.CLASS <> VALUE) OR (S@.CLASS <> VALUE) THEN RESULT:= FALSE ELSE IF T@.CONTE); PUT2(CASEJUMP2,MIN,MAX); FOR I:=MIN TO MAX DO BEGIN READ_IFL(L); PUT_ARG(L) END; DEF_LABEL END; PROCEDURE POP_TEMP; BEGIN POP; PUT1(POP2,WORDLENGTH) END; PROCEDURE FOR_STORE; CONST LEAVE_FOR_VAR=FALSE; BEGIN "INITIAL" VALUE_; STORE(LEAVE_FOR_VAR); T@.STATE:=DIRECT END; PROCEDURE FOR_LIM; VAR OP:INTEGER; LIMIT_DISP:DISPLACEMENT; LABEL:DISPLACEMENT; BEGIN "FINAL" VALUE_; DEF_LABEL; POP "LIMIT"; "CONTROL VAR" VALUE_; T@.STATE:=DIRECT; REXT IN UNIVERSAL THEN RESULT:=(S@.KIND IN PASSIVES) AND (T@.LENGTH=S@.LENGTH) ELSE IF T@.KIND=S@.KIND THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND, QUEUE_KIND: RESULT:=TRUE; ENUM_KIND,PASSIVE_KIND, ACTIVE_KIND,SYSCOMP_KIND: RESULT:=T@.NOUN=S@.NOUN; STRING_KIND: RESULT:=(T@.LENGTH=S@.LENGTH) OR (T@.CONTEXT IN CNST_PARMS); SET_KIND,POINTER_KIND: RESULT:=(T@.NOUN=S@.NOUN) OR (T@.NOUN=XUNDEF) AD_IFL(LIMIT_DISP); PUT3(PUSHVAR2,WORD_TYP,TEMP_MODE,LIMIT_DISP); READ_IFL("COMPARISON"OP); PUT2(COMPARE2,OP,WORD_TYP); READ_IFL(LABEL); PUT1(FALSEJUMP2,LABEL) END; PROCEDURE FOR_LOOP(OP:INTEGER); BEGIN "CONTROL VAR" ADDRESS; PUT0(OP); JUMP_DEF; POP_TEMP END; PROCEDURE INIT_; BEGIN WITH T@ DO IF CLASS=ROUTINE THEN PUT4(INIT2,MODE,DISP,PARM_SIZE,VAR_SIZE) ELSE PUT4(INIT2,PROCESS_MODE,0,0,0); POP END; PROCEDURE INTF_LBL; VAR L:DISPLA OR (S@.NOUN=XUNDEF); UNDEF_KIND,ROUTINE_KIND: RESULT:=FALSE END ELSE IF T@.KIND=GENERIC_KIND THEN CASE T@.NOUN OF ZARITHMETIC: RESULT:=S@.KIND IN ARITHMETIC; ZINDEX: RESULT:=S@.KIND IN INDEXS; ZPASSIVE: RESULT:=S@.KIND IN PASSIVES END ELSE RESULT:=FALSE; IF NOT RESULT THEN ERROR2(TYPE_ERROR); COMPATIBLE:=RESULT END; "######" "IGNORE" "######" PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LEIFL(VAR_SIZE); READ_IFL(STACK_SIZE) END END; PROCEDURE BODY; BEGIN ROUTINE_; WITH T@ DO BEGIN PUT5(ENTER2,MODE,DISP,PARM_SIZE,VAR_SIZE,STACK_SIZE); CURRENT_MODE:=MODE END END; PROCEDURE BODY_END; BEGIN PUT1(RETURN2,CURRENT_MODE); POP END; "#######" "LOADING" "#######" PROCEDURE ADDR_ERROR; BEGIN ERROR1(ADDRESS_ERROR); PUT1(PUSHCONST2,0) END; PROCEDURE ADDRESS; BEGIN WITH T@ DO IF CLASS=VALUE THEN BEGIN CASE STATE OF INITABLE:= TRUE; "SYSCOMP" ADDRESS; POP; "ENTRY" ROUTINE_; IF T@.MODE IN INIT_MODES THEN IF NOT INITABLE THEN ERROR1(INIT_ERROR) END; PROCEDURE SUB; VAR MIN,MAX,SIZE: INTEGER; BEGIN "SUBSCRIPT" VALUE_; READ_IFL(MIN); READ_IFL(MAX); READ_IFL(SIZE); PUT3(INDEX2,MIN,MAX,SIZE); PUSH; T@:=UNDEF_EXPR; "INDEX" TYPE_; IF COMPATIBLE THEN "OK"; POP; POP; "ELEMENT" TYPE_; WITH T@ DO IF KIND=SYSCOMP_KIND THEN PUT1(FIELD2,LENGTH) "OFFSET" END; PR) END END; PROCEDURE PUT5(OP,ARG1,ARG2,ARG3,ARG4,ARG5:INTEGER); BEGIN WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2); WRITE_IFL(ARG3); WRITE_IFL(ARG4); WRITE_IFL(ARG5); IF DEBUG THEN BEGIN PRINTOP(OP); PRINTARG(ARG1); PRINTARG(ARG2); PRINTARG(ARG3); PRINTARG(ARG4); PRINTARG(ARG5) END END; "NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START WITH PRINTFF" "##########################" "OPERAND STACK MANIPULATION" "##########################" PROCEDURE POP; BEGINOCEDURE ARROW; VAR SAVE_CONTEXT:CONTEXT_KIND; BEGIN WITH T@ DO IF KIND=POINTER_KIND THEN BEGIN SAVE_CONTEXT:=CONTEXT; "POINTER" VALUE_; CONTEXT:=SAVE_CONTEXT; STATE:=ADDR END ELSE ERROR1(TYPE_ERROR); "OBJECT" TYPE_ END; "#########" "MAIN LOOP" "#########" BEGIN "MAIN PROGRAM" INITIALIZE; REPEAT "MAIN LOOP" READ_IFL(SY); CASE SY OF ADDRESS1: ADDRESS; AND1: OR_AND(AND2); ARROW1: ARROW; BODY_END1: BODY_END; BODY1: BODY; CALL_FUNC1: CALL_FUNC; CALL_G T:=S; TOP_STACK:=TOP_STACK@.NEXT_ENTRY; RELEASE(TOP_STACK@.RESET_POINT); IF TOP_STACK=EMPTY_STACK THEN S:=NIL ELSE S:=TOP_STACK@.NEXT_ENTRY@.OPND; END; PROCEDURE PUSH; BEGIN S:=T; NEW(THIS_STACK); WITH THIS_STACK@ DO BEGIN NEW(OPND); T:=OPND; NEXT_ENTRY:=TOP_STACK; MARK(RESET_POINT) END; TOP_STACK:=THIS_STACK END; "##########" "INITIALIZE" "##########" PROCEDURE INITIALIZE; BEGIN DONE:=FALSE; INIT_PASS(INTER_PASS_PTR); WITH INTER_PASS_PTR@ EN1: CALL_GEN; CALL_PROC1: CALL_PROC; CASE_JUMP1: CASE_JUMP; CASE_LIST1: CASE_LIST; CHK_TYPE1: CHK_TYPE; CONSTPARM1: CONSTPARM(FALSE); DEF_LABEL1: DEF_LABEL; DIV1: DIV_MOD(DIV2); EMPTY_SET1: EMPTY_SET; EOM1: EOM; EQ1: EQUALITY(EQUAL); FALSEJUMP1: FALSE_JUMP; FOR_DOWN1: FOR_LOOP(DECREMENT2); FOR_LIM1: FOR_LIM; FOR_STORE1: FOR_STORE; FOR_UP1: FOR_LOOP(INCREMENT2); FUNCTION1: FUNCTION_; GE1: INEQUALITY(NOTLESS); GT1: STRICT_INEQUALITY(GREATER); INCLUDE1: INCLUDE; INIT1: INIT_; INTF_LBL1: IDO BEGIN DEBUG:=TESTOPTION IN OPTIONS; IF DEBUG THEN PRINTFF END; ARITHMETIC:=(.INT_KIND,REAL_KIND.); INDEXS:=(.INT_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND.); SMALLS:=INDEXS OR (.REAL_KIND,SET_KIND,QUEUE_KIND,POINTER_KIND.); PASSIVES:=INDEXS OR (.REAL_KIND,SET_KIND,POINTER_KIND,STRING_KIND, PASSIVE_KIND.); LARGES:=(.STRING_KIND,PASSIVE_KIND,ACTIVE_KIND,SYSCOMP_KIND.); INDIRECTS:=LARGES; INIT_MODES:= (.CLASS_MODE, MONITOR_MODE, PROCESS_MODE.); ROUTINE_MODES:= NTF_LBL; IN1: INCLUSION; JUMP_DEF1: JUMP_DEF; JUMP1: JUMP; LCONST1: LCONST; LE1: INEQUALITY(NOTGREATER); LT1: STRICT_INEQUALITY(LESS); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: PLUS_MINUS_STAR(SUB2); MOD1: DIV_MOD(MOD2); NEW_LINE1: IGNORE1(NEWLINE2); NE1: EQUALITY(NOTEQUAL); NOT1: NOT_; OR1: OR_AND(OR2); PLUS1: PLUS_MINUS_STAR(ADD2); PROG_CALL1: PROG_CALL; RANGE1: IGNORE2(RANGE2); RCOMP1: RCOMP; RESULT1: RESULT; ROUTINE1: ROUTINE_; SAVEPARM1: CONSTPARM(TRUE); SLASH1: SLASH; STAR1: PLUS_MINU(.PROC_MODE,PE_MODE,CE_MODE,ME_MODE.); UNIVERSAL:=(.UNIV_VAR,UNIV_CONST.); ASSIGNS:=(.FUNC_RESULT,VARIABLE,VAR_PARM,UNIV_VAR, WITH_VAR.); VAR_PARMS:=(.VAR_PARM,UNIV_VAR.); CNST_PARMS:=(.CONST_PARM,UNIV_CONST.); PARMS:= VAR_PARMS OR CNST_PARMS; S:=NIL; T:=NIL; NEW(EMPTY_STACK); TOP_STACK:=EMPTY_STACK; WITH EMPTY_STACK@ DO BEGIN NEXT_ENTRY:=NIL; OPND:=NIL; MARK(RESET_POINT) END; WITH INT_EXPR DO BEGIN KIND:=INT_KIND; NOUN:=XINTEGER; LENGTH:=WORDLENGTH; MODS_STAR(MUL2); STORE1: STORE(TRUE); SUB1: SUB; UMINUS1: UMINUS; UNDEF1: UNDEF; UPLUS1: UPLUS; VALUE1: VALUE_; VARPARM1: VARPARM; VAR1: VAR_; VCOMP1: VCOMP; WITH1: POP_TEMP END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END. E:=UNDEF_MODE; CLASS:=VALUE; CONTEXT:=EXPR; STATE:=EXPRESSION END; REAL_EXPR:=INT_EXPR; WITH REAL_EXPR DO BEGIN KIND:=REAL_KIND; NOUN:=XREAL; LENGTH:=REALLENGTH END; BOOL_EXPR:=INT_EXPR; WITH BOOL_EXPR DO BEGIN KIND:=BOOL_KIND; NOUN:=XBOOLEAN END; SET_EXPR:=INT_EXPR; WITH SET_EXPR DO BEGIN KIND:=SET_KIND; NOUN:=XUNDEF; LENGTH:=SETLENGTH END; UNDEF_EXPR:=INT_EXPR; WITH UNDEF_EXPR DO BEGIN KIND:=UNDEF_KIND; NOUN:=XUNDEF DIRECT: BEGIN IF MODE=SCONST_MODE THEN ADDR_ERROR ELSE PUT2(PUSHADDR2,MODE,DISP); IF KIND=SYSCOMP_KIND THEN PUT1(FIELD2,LENGTH) "OFFSET" END; INDIRECT: PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); ADDR: ; EXPRESSION: ADDR_ERROR END; STATE:=ADDR END ELSE ADDR_ERROR END; PROCEDURE TYPE_; BEGIN WITH T@ DO BEGIN READ_IFL(KIND); READ_IFL(NOUN); READ_IFL(LENGTH) END END; PROCEDURE RESULT; BEND; PUT1(JUMP2,1) "JUMP TO BLOCK LABEL 1, THE INITIAL PROCESS" END; "######" "ERRORS" "######" PROCEDURE ERROR1(ERROR: INTEGER); BEGIN WITH T@ DO IF KIND=UNDEF_KIND THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); T@:=UNDEF_EXPR END; PROCEDURE ERROR2(ERROR:INTEGER); BEGIN IF (T@.KIND=UNDEF_KIND) OR (S@.KIND=UNDEF_KIND) THEN "SUPPRESS MESSAGE" ELSE PUT2(MESSAGE2,THIS_PASS,ERROR); S@:=UNDEF_EXPR END; PROCEDURE ERROR2P(ERROR:INTEGER); BEGINEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(DISP); PUT2(PUSHADDR2,MODE,DISP); CONTEXT:=FUNC_RESULT; STATE:=ADDR; "RESULT" TYPE_ END END; PROCEDURE VALUE_; BEGIN WITH T@ DO BEGIN IF KIND IN SMALLS THEN BEGIN "LOAD VALUE" CASE STATE OF DIRECT: IF MODE=SCONST_MODE THEN PUT1(PUSHCONST2,DISP) ELSE PUT3(PUSHVAR2,TTYP,MODE,DISP); INDIRECT: BEGIN PUT3(PUSHVAR2,WORD_TYP,MODE,DISP); PUT1(PUSHIND2,TT ERROR2(ERROR); POP END; PROCEDURE EOM; VAR VAR_LENGTH:DISPLACEMENT; BEGIN WITH INTER_PASS_PTR@ DO RELEASE(RESETPOINT); READ_IFL(VAR_LENGTH); PUT1(EOM2,VAR_LENGTH); DONE:=TRUE END; PROCEDURE ABORT; BEGIN PUT2(MESSAGE2,THIS_PASS,COMPILER_ERROR); EOM END; "#############" "TYPE CHECKING" "#############" FUNCTION TTYP:INTEGER "TYPE CODE"; BEGIN WITH T@ DO CASE KIND OF INT_KIND,BOOL_KIND,ENUM_KIND,POINTER_KIND, QUEUE_KIND,UNDEF_KIND: END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE SLASH; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=REAL_KIND) AND (S@.KIND=REAL_KIND) THEN PUT1(DIV2,REAL_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=REAL_EXPR END; PROCEDURE DIV_MOD(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=INT_KIND) AND (S@.KIND=INT_KIND) THEN PUT1(OP,WORD_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=INT_EXPR END; PROCEDURE OR_AND(OP:INTEGER); VAR TNOU TTYP:=WORD_TYP; REAL_KIND: TTYP:=REAL_TYP; CHAR_KIND: IF LENGTH=WORDLENGTH THEN TTYP:=WORD_TYP ELSE TTYP:=BYTE_TYP; SET_KIND: TTYP:=SET_TYP; STRING_KIND,PASSIVE_KIND: TTYP:=STRUCT_TYP; ACTIVE_KIND,GENERIC_KIND,SYSCOMP_KIND,ROUTINE_KIND: BEGIN ERROR1(TYPE_ERROR); TTYP:=WORD_TYP END END END; FUNCTION COMPATIBLE:BOOLEAN; VAR RESULT:BOOLEAN; BEGIN IF (T@.CLASS <> VALUE) OR (S@.CLASS <> VALUE) THEN RESULT:= FALSE ELSE IF T@.CONTEN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=BOOL_KIND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=BOOL_EXPR END ELSE IF (T@.KIND=SET_KIND) AND COMPATIBLE THEN BEGIN PUT1(OP,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE NOT_; BEGIN "OPERAND" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); T@:=BOOL_EXPR; XT IN UNIVERSAL THEN RESULT:=(S@.KIND IN PASSIVES) AND (T@.LENGTH=S@.LENGTH) ELSE IF T@.KIND=S@.KIND THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND, QUEUE_KIND: RESULT:=TRUE; ENUM_KIND,PASSIVE_KIND, ACTIVE_KIND,SYSCOMP_KIND: RESULT:=T@.NOUN=S@.NOUN; STRING_KIND: RESULT:=(T@.LENGTH=S@.LENGTH) OR (T@.CONTEXT IN CNST_PARMS); SET_KIND,POINTER_KIND: RESULT:=(T@.NOUN=S@.NOUN) OR (T@.NOUN=XUNDEF) PUT0(NOT2) END; PROCEDURE EMPTY_SET; BEGIN PUSH; T@:=SET_EXPR; PUT3(PUSHVAR2,SET_TYP,LCONST_MODE,0) END; PROCEDURE INCLUDE; BEGIN "SET MEMBER" VALUE_; IF T@.KIND IN INDEXS THEN BEGIN IF S@.NOUN=XUNDEF THEN S@.NOUN:=T@.NOUN ELSE IF S@.NOUN<>T@.NOUN THEN ERROR2(TYPE_ERROR); PUT0(BUILDSET2) END ELSE ERROR2(TYPE_ERROR); POP END; PROCEDURE FUNCTION_; BEGIN PUSH; T@:= UNDEF_EXPR; T@.CONTEXT:= FUNC_RESULT; "FUNC" TYPE_; WITH S@ DO OR (S@.NOUN=XUNDEF); UNDEF_KIND,ROUTINE_KIND: RESULT:=FALSE END ELSE IF T@.KIND=GENERIC_KIND THEN CASE T@.NOUN OF ZARITHMETIC: RESULT:=S@.KIND IN ARITHMETIC; ZINDEX: RESULT:=S@.KIND IN INDEXS; ZPASSIVE: RESULT:=S@.KIND IN PASSIVES END ELSE RESULT:=FALSE; IF NOT RESULT THEN ERROR2(TYPE_ERROR); COMPATIBLE:=RESULT END; "######" "IGNORE" "######" PROCEDURE LCONST; VAR LENGTH,I,ARG:INTEGER; BEGIN READ_IFL(LENGTH); PUT1(LCONST2,LE IF (CLASS = ROUTINE) AND (MODE <> STD_MODE) THEN PUT2(FUNCVALUE2, MODE, TTYP) END; PROCEDURE CALL_FUNC; BEGIN WITH S@ DO IF CLASS = ROUTINE THEN IF MODE=STD_MODE THEN PUT2(FUNCTION2, DISP, TTYP) ELSE PUT3(CALL2, MODE, DISP, PARM_SIZE); S@:=T@; POP END; PROCEDURE CALL_GEN; BEGIN WITH S@ DO PUT2(FUNCTION2,DISP,TTYP); T@.CONTEXT:= FUNC_RESULT; S@:= T@; POP "ARG" END; "########" "VARIABLE" "########" PROCEDURE UNDEF; BEGIN PUSH; T@:=UNDENGTH); FOR I:=1 TO LENGTH DIV WORDLENGTH DO BEGIN READ_IFL(ARG); PUT_ARG(ARG) END END; PROCEDURE IGNORE1(OP:INTEGER); VAR ARG:INTEGER; BEGIN READ_IFL(ARG); PUT1(OP,ARG) END; PROCEDURE IGNORE2(OP:INTEGER); VAR ARG1,ARG2:INTEGER; BEGIN READ_IFL(ARG1); READ_IFL(ARG2); PUT2(OP,ARG1,ARG2) END; "####" "BODY" "####" PROCEDURE ROUTINE_; BEGIN PUSH; WITH T@ DO BEGIN READ_IFL(MODE); READ_IFL(DISP); CLASS:=ROUTINE; READ_IFL(PARM_SIZE); READ_F_EXPR; PUT1(PUSHCONST2,0) END; PROCEDURE VCOMP; VAR SAVE_CONTEXT:INTEGER; BEGIN "RECORD OR CLASS" ADDRESS; SAVE_CONTEXT:=T@.CONTEXT; VAR_REF; TYPE_; WITH T@ DO BEGIN PUT1(FIELD2,DISP); STATE:=ADDR; IF CONTEXT=VARIABLE THEN CONTEXT:=ENTRY_VAR ELSE CONTEXT:=SAVE_CONTEXT; END END; PROCEDURE RCOMP; VAR INITABLE: BOOLEAN; BEGIN WITH T@ DO IF CLASS = VALUE THEN IF CONTEXT IN PARMS THEN INITABLE:= FALSE ELSE INITABLE:= TRUE ELSEENT"; POP "ARGUMENT" END; PROCEDURE VARPARM; BEGIN "ARGUMENT" ADDRESS; "PARAMETER" VAR_; IF COMPATIBLE THEN IF NOT (S@.CONTEXT IN ASSIGNS) THEN ERROR2(ASSIGN_ERROR); POP "PARAMETER"; POP "ARGUMENT" END; PROCEDURE FALSE_JUMP; VAR L:DISPLACEMENT; BEGIN "BOOLEAN" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); READ_IFL(L); PUT1(FALSEJUMP2,L); POP END; PROCEDURE CASE_JUMP; VAR L: DISPLACEMENT; BEGIN "SELECTOR" VALUE_; READ_IFL IF (CLASS = ROUTINE) AND (MODE <> STD_MODE) THEN PUT2(FUNCVALUE2, MODE, TTYP) END; PROCEDURE CALL_FUNC; BEGIN WITH S@ DO IF CLASS = ROUTINE THEN IF MODE=STD_MODE THEN PUT2(FUNCTION2, DISP, TTYP) ELSE PUT3(CALL2, MODE, DISP, PARM_SIZE); S@:=T@; POP END; PROCEDURE CALL_GEN; BEGIN WITH S@ DO PUT2(FUNCTION2,DISP,TTYP); T@.CONTEXT:= FUNC_RESULT; S@:= T@; POP "ARG" END; "########" "VARIABLE" "########" PROCEDURE UNDEF; BEGIN PUSH; T@:=UNDE(L); PUT1(JUMP2,L) END; PROCEDURE DEF_LABEL; VAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(DEFLABEL2,L) END; PROCEDURE JUMP; VAR L:DISPLACEMENT; BEGIN READ_IFL(L); PUT1(JUMP2,L) END; PROCEDURE JUMP_DEF; BEGIN JUMP; DEF_LABEL END; PROCEDURE CHK_TYPE; BEGIN PUSH; T@:=INT_EXPR; TYPE_; IF COMPATIBLE THEN "OK"; POP END; PROCEDURE CASE_LIST; VAR I,MIN,MAX:INTEGER; L:DISPLACEMENT; BEGIN POP "SELECTOR"; DEF_LABEL; READ_IFL(MIN); READ_IFL(MAXF_EXPR; PUT1(PUSHCONST2,0) END; PROCEDURE VCOMP; VAR SAVE_CONTEXT:INTEGER; BEGIN "RECORD OR CLASS" ADDRESS; SAVE_CONTEXT:=T@.CONTEXT; VAR_REF; TYPE_; WITH T@ DO BEGIN PUT1(FIELD2,DISP); STATE:=ADDR; IF CONTEXT=VARIABLE THEN CONTEXT:=ENTRY_VAR ELSE CONTEXT:=SAVE_CONTEXT; IF KIND = SYSCOMP_KIND THEN PUT1(FIELD2, LENGTH); END; END; PROCEDURE RCOMP; VAR INITABLE: BOOLEAN; BEGIN WITH T@ DO IF CLASS = VALUE THEN IF CONTEXT IN PA); PUT2(CASEJUMP2,MIN,MAX); FOR I:=MIN TO MAX DO BEGIN READ_IFL(L); PUT_ARG(L) END; DEF_LABEL END; PROCEDURE POP_TEMP; BEGIN POP; PUT1(POP2,WORDLENGTH) END; PROCEDURE FOR_STORE; CONST LEAVE_FOR_VAR=FALSE; BEGIN "INITIAL" VALUE_; STORE(LEAVE_FOR_VAR); T@.STATE:=DIRECT END; PROCEDURE FOR_LIM; VAR OP:INTEGER; LIMIT_DISP:DISPLACEMENT; LABEL:DISPLACEMENT; BEGIN "FINAL" VALUE_; DEF_LABEL; POP "LIMIT"; "CONTROL VAR" VALUE_; T@.STATE:=DIRECT; RERMS THEN INITABLE:= FALSE ELSE INITABLE:= TRUE ELSE INITABLE:= TRUE; "SYSCOMP" ADDRESS; POP; "ENTRY" ROUTINE_; IF T@.MODE IN INIT_MODES THEN IF NOT INITABLE THEN ERROR1(INIT_ERROR) END; PROCEDURE SUB; VAR MIN,MAX,SIZE: INTEGER; BEGIN "SUBSCRIPT" VALUE_; READ_IFL(MIN); READ_IFL(MAX); READ_IFL(SIZE); PUT3(INDEX2,MIN,MAX,SIZE); PUSH; T@:=UNDEF_EXPR; "INDEX" TYPE_; IF COMPATIBLE THEN "OK"; POP; POP; "ELEMENT" TYPE_; WITH T@ DO IF KIND=SYAD_IFL(LIMIT_DISP); PUT3(PUSHVAR2,WORD_TYP,TEMP_MODE,LIMIT_DISP); READ_IFL("COMPARISON"OP); PUT2(COMPARE2,OP,WORD_TYP); READ_IFL(LABEL); PUT1(FALSEJUMP2,LABEL) END; PROCEDURE FOR_LOOP(OP:INTEGER); BEGIN "CONTROL VAR" ADDRESS; PUT0(OP); JUMP_DEF; POP_TEMP END; PROCEDURE INIT_; BEGIN WITH T@ DO IF CLASS=ROUTINE THEN PUT4(INIT2,MODE,DISP,PARM_SIZE,VAR_SIZE) ELSE PUT4(INIT2,PROCESS_MODE,0,0,0); POP END; PROCEDURE INTF_LBL; VAR L:DISPLASCOMP_KIND THEN PUT1(FIELD2,LENGTH) "OFFSET" END; PROCEDURE ARROW; VAR SAVE_CONTEXT:CONTEXT_KIND; BEGIN WITH T@ DO IF KIND=POINTER_KIND THEN BEGIN SAVE_CONTEXT:=CONTEXT; "POINTER" VALUE_; CONTEXT:=SAVE_CONTEXT; STATE:=ADDR END ELSE ERROR1(TYPE_ERROR); "OBJECT" TYPE_ END; "#########" "MAIN LOOP" "#########" BEGIN "MAIN PROGRAM" INITIALIZE; REPEAT "MAIN LOOP" READ_IFL(SY); CASE SY OF ADDRESS1: ADDRESS; AND1: OR_AND(AND2); ARROW1: ARROW; BODY_END1CEMENT; BEGIN READ_IFL(L); PUT1(PUSHLABEL2,L) END; PROCEDURE PROG_CALL; VAR INTF_LENGTH:INTEGER; BEGIN READ_IFL(INTF_LENGTH); PUT0(CALLPROG2); PUT1(POP2,INTF_LENGTH); POP END; "##########" "EXPRESSION" "##########" PROCEDURE EQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF CHAR_KIND,INT_KIND,BOOL_KIND, ENUM_KIND,POINTER_KIND, REAL_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND,PASSIVE_KIND: P: BODY_END; BODY1: BODY; CALL_FUNC1: CALL_FUNC; CALL_GEN1: CALL_GEN; CALL_PROC1: CALL_PROC; CASE_JUMP1: CASE_JUMP; CASE_LIST1: CASE_LIST; CHK_TYPE1: CHK_TYPE; CONSTPARM1: CONSTPARM(FALSE); DEF_LABEL1: DEF_LABEL; DIV1: DIV_MOD(DIV2); EMPTY_SET1: EMPTY_SET; EOM1: EOM; EQ1: EQUALITY(EQUAL); FALSEJUMP1: FALSE_JUMP; FOR_DOWN1: FOR_LOOP(DECREMENT2); FOR_LIM1: FOR_LIM; FOR_STORE1: FOR_STORE; FOR_UP1: FOR_LOOP(INCREMENT2); FUNCTION1: FUNCTION_; GE1: INEQUALITY(NOTLESS); GT1: STRICT_INEQUALITY(GUT2(COMPSTRCT2,OP,T@.LENGTH); ACTIVE_KIND,QUEUE_KIND,GENERIC_KIND,UNDEF_KIND, SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,CHAR_KIND,BOOL_KIND,ENUM_KIND,SET_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); PASSIVE_KIND,ACTIVE_KIND,POINTER_KIND,QUEUE_KIND,GENREATER); INCLUDE1: INCLUDE; INIT1: INIT_; INTF_LBL1: INTF_LBL; IN1: INCLUSION; JUMP_DEF1: JUMP_DEF; JUMP1: JUMP; LCONST1: LCONST; LE1: INEQUALITY(NOTGREATER); LT1: STRICT_INEQUALITY(LESS); MESSAGE1: IGNORE2(MESSAGE2); MINUS1: PLUS_MINUS_STAR(SUB2); MOD1: DIV_MOD(MOD2); NEW_LINE1: IGNORE1(NEWLINE2); NE1: EQUALITY(NOTEQUAL); NOT1: NOT_; OR1: OR_AND(OR2); PLUS1: PLUS_MINUS_STAR(ADD2); PROG_CALL1: PROG_CALL; RANGE1: IGNORE2(RANGE2); RCOMP1: RCOMP; RESULT1: RESULT; ROUTINE1: ROUTINE_; SAVEERIC_KIND, UNDEF_KIND,SYSCOMP_KIND,ROUTINE_KIND: ERROR2(TYPE_ERROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE STRICT_INEQUALITY(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF COMPATIBLE THEN CASE T@.KIND OF INT_KIND,REAL_KIND,BOOL_KIND,CHAR_KIND,ENUM_KIND: PUT2(COMPARE2,OP,TTYP); STRING_KIND: PUT2(COMPSTRCT2,OP,T@.LENGTH); SET_KIND,POINTER_KIND,PASSIVE_KIND,ACTIVE_KIND,QUEUE_KIND, SYSCOMP_KIND,ROUTINE_KIND,UNDEF_KIND: ERROR2(TYPE_EPARM1: CONSTPARM(TRUE); SLASH1: SLASH; STAR1: PLUS_MINUS_STAR(MUL2); STORE1: STORE(TRUE); SUB1: SUB; UMINUS1: UMINUS; UNDEF1: UNDEF; UPLUS1: UPLUS; VALUE1: VALUE_; VARPARM1: VARPARM; VAR1: VAR_; VCOMP1: VCOMP; WITH1: POP_TEMP END UNTIL DONE; NEXT_PASS(INTER_PASS_PTR) END. RROR) END; POP; T@:=BOOL_EXPR END; PROCEDURE INCLUSION; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=SET_KIND) AND (S@.KIND IN INDEXS) AND (S@.NOUN=T@.NOUN) THEN PUT2(COMPARE2,INSET,SET_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=BOOL_EXPR END; PROCEDURE UMINUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN PUT1(NEG2,TTYP) ELSE ERROR1(TYPE_ERROR) END; PROCEDURE UPLUS; BEGIN "OPERAND" VALUE_; IF T@.KIND IN ARITHMETIC THEN "OK" ELSE ERROR1(T********************************* SOLO FILES 24 OCT 75 PROJECT MAC - 519 545 TECHNOLOGY SQUARE CAMBRIDGE MASSACHUSETTS 02139 DR. GEORGE MARSAGLIA, DIRECTOR SOLO MANUALS 15 MAR 76 SCHOOL OF COMPUTER SCIENCE SOLO COPY 15 MAR 76 MCGILL UNIVERSITY ***************** P.O. BOX 6070, STATION A MONTREAL QUEBEC H3C 3G1 CANADA DR. N. SOLNTSEFF SOLO MANUALS 30 JAN 76 APPLIED MATHEMATICS SOLO COPY YPE_ERROR) END; PROCEDURE PLUS_MINUS_STAR(OP:INTEGER); VAR TNOUN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=INT_KIND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=INT_EXPR END ELSE IF T@.KIND=REAL_KIND THEN BEGIN PUT1(OP,REAL_TYP); POP; T@:=REAL_EXPR END ELSE IF (T@.KIND=SET_KIND) AND (OP=SUB2) AND COMPATIBLE THEN BEGIN PUT1(SUB2,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN 30 JAN 76 MCMASTER UNIVERSITY SOLO FILES 30 JAN 76 ******************* REAL-TIME MANUAL 10 MAY 76 HAMILTON JOB-STREAM MANUAL 10 MAY 76 ONTARIO L8S 4K1 MACHINE MANUAL 10 MAY 76 CANADA NOTES 10 MAY 76 MR. CHARLES B. SHIPMAN, JR. SOLO MANUALS 28 JUN 76 MEDIA REACTIONS INC. SOLO FILES 28 JYP) END; ADDR: PUT1(PUSHIND2,TTYP); EXPRESSION: END; IF LENGTH=BYTELENGTH THEN LENGTH:=WORDLENGTH; STATE:=EXPRESSION END ELSE IF KIND IN INDIRECTS THEN ADDRESS ELSE "ERROR" PUT1(PUSHCONST2,0); CONTEXT:=EXPR END END; PROCEDURE STORE(POPVAR:BOOLEAN); VAR TYP:INTEGER; SIMILAR:BOOLEAN; BEGIN "EXPRESSION" VALUE_; SIMILAR:=COMPATIBLE; POP "EXPRESSION"; IF SIMILAR THEN WITH T@ DO IF CONTEXT IN ASSIGNS THEN BE END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE SLASH; BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=REAL_KIND) AND (S@.KIND=REAL_KIND) THEN PUT1(DIV2,REAL_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=REAL_EXPR END; PROCEDURE DIV_MOD(OP:INTEGER); BEGIN "RIGHT OPERAND" VALUE_; IF (T@.KIND=INT_KIND) AND (S@.KIND=INT_KIND) THEN PUT1(OP,WORD_TYP) ELSE ERROR2(TYPE_ERROR); POP; T@:=INT_EXPR END; PROCEDURE OR_AND(OP:INTEGER); VAR TNOUGIN TYP:=TTYP; IF TYP=STRUCT_TYP THEN PUT1(COPY2,LENGTH) ELSE PUT1(ASSIGN2,TYP) END ELSE ERROR1(ASSIGN_ERROR); IF POPVAR THEN POP "VARIABLE" END; "##########" "STATEMENTS" "##########" PROCEDURE VAR_REF; BEGIN WITH T@ DO BEGIN CLASS:=VALUE; READ_IFL(MODE); READ_IFL(DISP); READ_IFL(CONTEXT) END END; PROCEDURE VAR_; BEGIN PUSH; VAR_REF; "VAR" TYPE_; WITH T@ DO IF(CONTEXT IN VAR_PARMS) OR (CONTEXT IN CNST_PARMS) AND (KINN:INTEGER; BEGIN "RIGHT OPERAND" VALUE_; IF T@.KIND=S@.KIND THEN IF T@.KIND=BOOL_KIND THEN BEGIN PUT1(OP,WORD_TYP); POP; T@:=BOOL_EXPR END ELSE IF (T@.KIND=SET_KIND) AND COMPATIBLE THEN BEGIN PUT1(OP,SET_TYP); TNOUN:=T@.NOUN; POP; T@:=SET_EXPR; T@.NOUN:=TNOUN END ELSE ERROR2P(TYPE_ERROR) ELSE ERROR2P(TYPE_ERROR) END; PROCEDURE NOT_; BEGIN "OPERAND" VALUE_; IF T@.KIND<>BOOL_KIND THEN ERROR1(TYPE_ERROR); T@:=BOOL_EXPR; D IN LARGES) THEN STATE:=INDIRECT ELSE STATE:=DIRECT END; PROCEDURE CALL_PROC; BEGIN WITH T@ DO IF CLASS=ROUTINE THEN IF MODE=STD_MODE THEN PUT1(PROCEDURE2,DISP) ELSE PUT3(CALL2,MODE,DISP,PARM_SIZE); POP END; PROCEDURE CONSTPARM(GENERIC: BOOLEAN); BEGIN "PARAMETER" VAR_; IF COMPATIBLE THEN IF T@.CONTEXT = UNIV_CONST THEN S@.KIND:= T@.KIND; POP "PARAMETER"; "ARGUMENT" VALUE_; IF GENERIC THEN S@ "FUNCTION RESULT" := T@ "ACTUAL ARGUM PUT0(NOT2) END; PROCEDURE EMPTY_SET; BEGIN PUSH; T@:=SET_EXPR; PUT3(PUSHVAR2,SET_TYP,LCONST_MODE,0) END; PROCEDURE INCLUDE; BEGIN "SET MEMBER" VALUE_; IF T@.KIND IN INDEXS THEN BEGIN IF S@.NOUN=XUNDEF THEN S@.NOUN:=T@.NOUN ELSE IF S@.NOUN<>T@.NOUN THEN ERROR2(TYPE_ERROR); PUT0(BUILDSET2) END ELSE ERROR2(TYPE_ERROR); POP END; PROCEDURE FUNCTION_; BEGIN PUSH; T@:= UNDEF_EXPR; T@.CONTEXT:= FUNC_RESULT; "FUNC" TYPE_; WITH S@ DO SOLO MANUALS 9 APR 76 BEREICH DATENVERARBEITUNG SOLO FILES 9 APR 76 SIEMENS AG MACHINE MANUAL 9 APR 76 ********** SOLO FILES 7 JUL 76 POSTFACH 70 00 78 D-8000 MUNICH 70 GERMANY DR. MANFRED SOMMER SOLO MANUALS 20 MAY 76 SIEMENS AG REAL-TIME MANUAL 20 MAY 76 ********** JOB-STREAM MANUAL N TRACY SOLO MANUALS 22 JUN 76 NOAA PACIFIC MARINE SOLO COPY 22 JUN 76 ENVIRONMENTAL LABORATORY SOLO FILES 22 JUN 76 ************************ REAL-TIME MANUAL 22 JUN 76 NSA BUILDING 68 JOB-STREAM MANUAL 22 JUN 76 7500 SAND POINT WAY N.E. MACHINE MANUAL 22 JUN 76 SEATTLE NOTES 22 JUN 76 WASHINGTON 981TRONICS SOLO COPY 10 NOV 75 ******************** SOLO FILES 10 NOV 75 P. O. BOX 7065 5801 LEE HIGHWAY ARLINGTON VIRGINIA 22207 DR. JAMES C. WRIGHT SOLO MANUALS 7 MAY 76 RESEARCH TRIANGLE INSTITUTE SOLO FILES 7 MAY 76 *************************** REAL-TIME MANUAL 7 MAY 76 P.O. BOX 12194 JOB-STREAM MANUAL 7 MAY 76 RESEARCH TRIANGLE PARK 15 MR. ERIK LILLEVOLD SOLO MANUALS 20 OCT 75 NORWEGIAN DEFENSE RESEARCH ESTABLISHMENT **************************************** P. O. BOX 25 SOLO FILES 20 OCT 75 N-2007 KJELLER NORWAY MR. DAVID N. SAMSKY SOLO MANUALS 10 NOV 75 MANAGER, SOFTWARE DEVELOPMENT NUCLEAR DATA INC. ***************** GOLF & MEACHAM ROADS SCHAUMBURG ILLINOIS 60172 MR. ALESSANDRO OSNAGI SOLO MANUALS 11 MA MACHINE MANUAL 7 MAY 76 NORTH CAROLINA 27709 NOTES 7 MAY 76 DR. CLIFFORD E. RHOADES, JR. SOLO MANUALS 31 MAR 76 1101 MADEIRA DRIVE, S.E. SOLO FILES 31 MAR 76 # 109 REAL-TIME MANUAL 20 APR 76 ALBUQUERQUE JOB-STREAM MANUAL 20 APR 76 NEW MEXICO 87108 MACHINE MANUAL 20 APR 76 R 76 ING. C. OLIVETTI S.P.A. SOLO FILES 11 MAR 76 *********************** REAL-TIME MANUAL 11 MAR 76 VIA JERVIS 13 JOB-STREAM MANUAL 11 MAR 76 10015 IVREA MACHINE MANUAL 11 MAR 76 ITALY NOTES 11 MAR 76 DR. RUSTY WHITNEY SOLO MANUALS 2 OCT 75 OREGON MUSEUM OF SCIENCE AND INDUSTRY SOLO COPY 2 OCT 75 NOTES 20 APR 76 DR. EDDIE R. NORTON SOLO MANUALS 23 APR 76 CLINICAL COMPUTER LABORATORY 3MR SOLO COPY 23 APR 76 MICHAEL REESE HOSPITAL SOLO FILES 23 APR 76 ********************** REAL-TIME MANUAL 23 APR 76 2900 SOUTH ELLIS AVENUE JOB-STREAM MANUAL 23 APR 76 CHICAGO MACHINE MANUAL 23 APR 76 ILLINOIS 60616 N ************************************* SOLO FILES 2 OCT 75 4015 SOUTH WEST CANYON ROAD PORTLAND OREGON 97221 DIPL.ING. KONRAD MAYER SOLO MANUALS 12 APR 76 OESTERREICHISCHE STUDIENGESELLSCHAFT SOLO COPY 12 APR 76 FUER ATOMENERGIE REAL-TIME MANUAL 12 APR 76 ************************************ JOB-STREAM MANUAL 12 APR 76 LENAUGASSE 10 MACHINE MANUAL 12 APR 76 A-1082 VIENNA OTES 23 APR 76 MR. B.R. ANSCOMBE SOLO MANUALS 8 JUL 76 TECHNICAL INFORMATION GROUP SOLO FILES 8 JUL 76 REUTERS LTD. REAL-TIME MANUAL 8 JUL 76 ************ JOB-STREAM MANUAL 8 JUL 76 85 FLEET STREET MACHINE MANUAL 8 JUL 76 LONDON E.C. 4 NOTES 8 JUL 76 ENGLAND PROFESSOR DAVE R. ELAND NOTES 12 APR 76 AUSTRIA MR. O. VOJNOVIC SOLO MANUALS 8 APR 76 PHILIPS CTI REAL-TIME MANUAL 8 APR 76 *********** MACHINE MANUAL 8 APR 76 4 - 16 AV. GAL. LECLERC NOTES 8 APR 76 92260 FONTENAY-AUX-ROSES FRANCE MR. DIETER KOENIG SOLO MANUALS 21 OCT 75 PHILIPS - GMBH ************** WERK FUER BASISCOMPUTERSYSTE SOLO MANUALS 9 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 9 APR 76 ORAL ROBERTS UNIVERSITY REAL-TIME MANUAL 9 APR 76 *********************** JOB-STREAM MANUAL 9 APR 76 7777 SOUTH LEWIS MACHINE MANUAL 9 APR 76 TULSA NOTES 9 APR 76 OKLAHOMA 74105 MS. WANDA FOX SOLO MANUALS 25 JUN 76 COLLINS RADIO GROUP ME UND INFORMATIONSTECHNIK POSTFACH 17 BAHNHOFSTRASSE 5904 EISERFELD GERMANY MR. DEAN PITTMAN SOLO MANUALS 26 MAY 76 50 EAST EMERSON CHULA VISTA CALIFORNIA 92011 MR. THOMAS PITTMAN SOLO MANUALS 10 MAY 76 P.O. BOX 23189 SOLO FILES 10 MAY 76 SAN JOSE MACHINE MANUAL 10 MAY 76 CALIFORNIA 95153 NOTES 10 MAY 76 DR. CHRISTIAN JAH REAL-TIME MANUAL 25 JUN 76 ROCKWELL INTERNATIONAL MACHINE MANUAL 25 JUN 76 ********************** NOTES 25 JUN 76 M/S 407-120 DALLAS TEXAS 75207 MR. ROLF MOLICH SOLO MANUALS 23 MAR 76 CHRISTIAN ROVSING A/S SOLO FILES 23 MAR 76 ********************* REAL-TIME MANUAL 23 MAR 76 MARIELUNDVEJ 46 B JOB-STREAM MANUAL 23 MAR 76L SOLO MANUALS 23 SEP 75 MAX PLANCK INSTITUT FUER BIOCHEMIE SOLO FILES 23 SEP 75 ********************************** 8033 MARTINSRIED GERMANY DR. ALBERTO SANGIOVANNI-VINCENTELLI SOLO MANUALS 2 DEC 75 INSTITUTO DI ELETTROTECNICA SOLO FILES 2 DEC 75 ED ELETTRONICA POLITECNICO DI MILANO ********************* PIAZZA L. DA VINCI 32 20133 MILANO ITALY MR. J. ERIC POLLACK SOLO MANUALS 12 FEB 76 P. 2730 HERLEV MACHINE MANUAL 23 MAR 76 DENMARK NOTES 23 MAR 76 DR. LARS-ERIK THORELLI SOLO MANUALS 10 DEC 75 TELECOMMUNICATION AND SOLO COPY 10 DEC 75 COMPUTER SYSTEMS REAL-TIME MANUAL 12 MAY 76 ROYAL INSTITUTE OF TECHNOLOGY JOB-STREAM MANUAL 12 MAY 76 ***************************** MACHINE MANUAL 12 MAY 76 S-1 O. BOX 5052 MACHINE MANUAL 2 MAR 76 SEATTLE NOTES 2 MAR 76 WASHINGTON 98105 PROFESSOR BRUCE ARDEN SOLO MANUAL * 17 NOV 75 COMPUTER SCIENCE DEPARTMENT ENGINEERING QUADRANGLE ROOM B212 PRINCETON UNIVERSITY ******************** PRINCETON NEW JERSEY 08540 MR. M. VAN DORSSER-WILLEMS SOLO MANUALS 20 JAN 76 PSYCHOLOGISCH LABORATORIUM ************************** BIBLIOTEK ERASMUS00 44 STOCKHOLM 70 NOTES 12 MAY 76 SWEDEN THE DIRECTOR SOLO MANUALS 13 FEB 76 ROYAL RADAR ESTABLISHMENT ************************* MINISTRY OF DEFENSE LEIGH SINTON ROAD MALVERN WORCS ENGLAND MR. PAUL WERKOWSKI SOLO MANUALS 3 AUG 76 SANDERS ASSOCIATES SOLO FILES 3 AUG 76 ****************** REAL-TIME MANUAL 3 AUG 76 24 SIMON STREET LAAN 16 NIJMEGEN THE NETHERLANDS ACQUISITION DEPARTMENT SOLO MANUALS 7 JUN 76 PURDUE UNIVERSITY LIBRARIES MACHINE MANUAL 7 JUN 76 *************************** NOTES 7 JUN 76 WEST LAFAYETTE INDIANA 47907 DR. JAMES J. BESEMER SOLO MANUALS 14 JUL 76 ELECTRICAL ENGINEERING SOLO COPY 14 JUL 76 ROOM 172 REAL-TIME MANUAL 14 JUL 76 PURDUE UNI JOB-STREAM MANUAL 3 AUG 76 NASHUA MACHINE MANUAL 3 AUG 76 NEW HAMPSHIRE 03060 NOTES 3 AUG 76 DR. DONALD S. KLETT SOLO MANUALS 20 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 20 MAY 76 SANGAMON STATE UNIVERSITY REAL-TIME MANUAL 20 MAY 76 ************************* JOB-STREAM MANUAL 20 MAY 76 SPRINGFIELD VERSITY JOB-STREAM MANUAL 14 JUL 76 ***************** MACHINE MANUAL 14 JUL 76 WEST LAFAYETTE NOTES 14 JUL 76 INDIANA 47907 PROFESSOR C. A. R. HOARE SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT MACHINE MANUAL * 25 NOV 75 QUEEN'S UNIVERSITY SOLO FILES 6 FEB 76 ****************** BELFAST BT7 1NN NORTHERN IRELAND PROFESSOR G. H. M MACHINE MANUAL 20 MAY 76 ILLINOIS 62708 NOTES 20 MAY 76 DR. HIROSHI WADA SOLO MANUALS 20 FEB 76 SEIKEI UNIVERSITY SOLO FILES 20 FEB 76 ***************** REAL-TIME MANUAL 20 FEB 76 KICHIJOJI KITAMACHI 3 JOB-STREAM MANUAL 20 FEB 76 MUSASHINO-SHI MACHINE MANUAL 20 FEB 76 TOKYO 180 ACEWEN SOLO MANUALS SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY SEP 75 QUEEN'S UNIVERSITY MACHINE MANUAL 1 JUN 76 ****************** NOTES 1 JUN 76 KINGSTON ONTARIO CANADA MR. CHARLES RATTRAY SOLO MANUALS 10 NOV 75 4 DIDCOT ROAD SOLO FILES 10 NOV 75 WOODHOUSE PARK REAL-TIME MANUAL FEB 7 NOTES 20 FEB 76 JAPAN MR. DIETER HESSE SOLO MANUALS 3 AUG 76 SIEMENS AG SOLO FILES 3 AUG 76 ********** REAL-TIME MANUAL 3 AUG 76 ZFA FTE 3 JOB-STREAM MANUAL 3 AUG 76 SCHERTLINSTRASSE 8 MACHINE MANUAL 3 AUG 76 8 MUNICH 70 NOTES 3 AUG 76 GERMANY DR. KARL MAERZ 6 WYTHENSHAWE JOB-STREAM MANUAL FEB 76 MANCHESTER MACHINE MANUAL FEB 76 ENGLAND NOTES FEB 76 MR. EINAR MOSSIN SOLO MANUALS 7 OCT 75 REGNECENTRALEN SOLO FILES 7 OCT 75 ************** FALKONER ALLE 1 2000 COPENHAGEN F DENMARK MRS. MARY DOWNEY, LIBRARIAN SOLO MANUALS 10 NOV 75 REPUBLIC ELEC********************* 304 WYNN DRIVE N.W. HUNTSVILLE ALABAMA 35806 MR. GERALD G. MAXWELL SOLO MANUALS 11 JUN 76 EQUIPMENT GROUP SOLO FILES 11 JUN 76 TEXAS INSTRUMENTS INC. REAL-TIME MANUAL 11 JUN 76 ********************** JOB-STREAM MANUAL 11 JUN 76 P.O. BOX 6015 MACHINE MANUAL 11 JUN 76 DALLAS NOTES 11 JUN 76 TEXAS 752TREAM MANUAL 1 JUN 76 MACHINE MANUAL 1 JUN 76 NOTES 1 JUN 76 MR. VIC STENNING SOLO MANUALS 10 NOV 75 SYSTEMS DESIGNERS LTD. SOLO COPY 10 NOV 75 ********************** SOLO FILES 10 NOV 75 SYSTEMS HOUSE REAL-TIME MANUAL 4 FEB 76 57 - 61 HIGH STREET JOB-22 MR. GARY D. THOMAS SOLO FILES 18 FEB 76 8236 RESEARCH BOULEVARD #166 AUSTIN TEXAS 78758 PROFESSOR J. G. BYRNE SOLO MANUALS 3 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 3 DEC 75 TRINITY COLLEGE JOB-STREAM MANUAL 17 FEB 76 *************** MACHINE MANUAL 17 FEB 76 DUBLIN 2 NOTES 17 FEB 76 IRELAND MR. DENNSTREAM MANUAL 4 FEB 76 FRIMLEY MACHINE MANUAL 4 FEB 76 SURREY GU16 5HJ NOTES 4 FEB 76 UNITED KINGDOM DR. FRANS VERVERS SOLO MANUALS 10 NOV 75 DEPARTMENT OF MATHEMATICS SOLO COPY 10 NOV 75 TECHNICAL UNIVERSITY OF DELFT SOLO FILES 10 NOV 75 ***************************** JULIANALAAN 132 DELFT THE NETHERLANDS MRS. PETRA DALGAARD IS HEIMBIGNER SOLO MANUALS 10 NOV 75 TRW SYSTEMS GROUP SOLO FILES 10 NOV 75 ***************** REAL-TIME MANUAL 3 FEB 76 MAIL STATION R3/1072 JOB-STREAM MANUAL 3 FEB 76 1 SPACE PARK MACHINE MANUAL 3 FEB 76 REDONDO BEACH NOTES 3 FEB 76 CALIFORNIA 90278 MR. E. J. HOLDER SOLO MANUALS 15 DEC 20 MAY 76 ABT. ZB VUE MACHINE MANUAL 20 MAY 76 BOSCHETSRIEDERSTRASSE 41 NOTES 20 MAY 76 8000 MUNICH 70 GERMANY MR. RICHARD M. SMITH SOLO MANUALS 29 DEC 75 P. O. BOX 5882 SOLO FILES 15 JAN 76 RALEIGH REAL-TIME MANUAL 3 FEB 76 NORTH CAROLINA 27607 JOB-STREAM MANUAL 3 FEB 76 MAC SOLO MANUALS 9 MAR 76 LIBRARIAN REAL-TIME MANUAL 9 MAR 76 INSTITUTE OF DATALOGY MACHINE MANUAL 9 MAR 76 TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 344 2800 LYNGBY DENMARK PROFESSOR CHRISTIAN GRAM SOLO MANUALS * SEP 75 INSTITUTE OF DATALOGY TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 344 2800 LYNGBY DENMARK MR. THOMAS JACOBSEN HINE MANUAL 3 FEB 76 NOTES 3 FEB 76 MR. PETER SCHNUPP SOLO MANUALS 29 MAR 76 SOFTLAB ******* MOZARTSTRASSE 17 8 MUNICH 2 GERMANY MR. D. T. ROSS SOLO MANUALS * SEP 75 SOFTECH INC. ************ 460 TOTTEN POND ROAD WALTHAM MASSACHUSETTS 02154 MR. F.E. FALLA SOLO MANUALS 26 JUL 76 SOFTWARE SCIENCES LTD. REAL-TIME MANUAL SOLO MANUALS 24 NOV 75 NEUCC TECHNICAL UNIVERSITY OF DENMARK ******************************* BUILDING 305 2800 LYNGBY DENMARK MR. MOGENS THORSEN SOLO MANUALS 26 NOV 75 POLYTEKNISK BOGHANDEL TECHNICAL UNIVERSITY OF DENMARK ******************************* ANKER ENGELUNDSVEJ 1 2800 LYNGBY DENMARK MR. B. TER BRAAKE SOLO MANUALS 9 JAN 76 LIBRARY ADMINISTRATION SOLO COPY 9 JAN 76 TECHNICAL UNIVERSITY OF EIN 26 JUL 76 ********************** MACHINE MANUAL 26 JUL 76 LONDON & MANCHESTER HOUSE PARK STREET MACCLESFIELD CHESHIRE ENGLAND SK11 6SR MR. FRANK TEPLITZKY SOLO MANUALS 2 DEC 75 SOUTHWEST REGIONAL LABORATORY ***************************** 4665 RAMPSON AVENUE LOS ALAMITOS CALIFORNIA 90720 MS. PHYLLIS TADLOCK SOLO MANUALS 26 APR 76 LIBRARY C11-1 MACHINE MANUAL 26 APR 76 SPERRY UNIVAC DHOVEN SOLO FILES 9 JAN 76 ********************************* P. O. BOX 513 EINDHOVEN THE NETHERLANDS IR. J.J. VAN AMSTEL SOLO MANUALS 9 JUL 76 COMPUTING CENTER TECHNICAL UNIVERSITY OF EINDHOVEN ********************************* P.O. BOX 513 EINDHOVEN THE NETHERLANDS DR. R. RECKERS SOLO MANUALS 2 AUG 76 TECHNISCHE HOGESCHOOL TWENTE **************************** POSTBUS 217 DRIENERLO ENSCHEDE THE NETHERLANDS JR. W. A. V NOTES 26 APR 76 ************* 322 NORTH 22ND WEST SALT LAKE CITY UTAH 84116 MR. ROBERT D. VAVRA SOLO MANUALS 16 FEB 76 SPERRY UNIVAC ************* M. S. 4993 2276 HIGHCREST DRIVE ROSEVILLE MINNESOTA 55113 DR. P. J. BLACK SOLO MANUALS 1 APR 76 E. R. SQUIBB & SONS INC. ************************ P.O. BOX 4000 PRINCETON NEW JERSEY 08540 MRS. LUCILLE STEELMAN SOLO MANUALS 21ERVOORT SOLO MANUALS 20 OCT 75 TECHNISCHE HOGESCHOOL TWENTE SOLO COPY 20 OCT 75 **************************** REAL-TIME MANUAL 13 FEB 76 POSTBUS 217 JOB-STREAM MANUAL 13 FEB 76 DRIENERLO MACHINE MANUAL 13 FEB 76 ENSCHEDE NOTES 13 FEB 76 THE NETHERLANDS DR. DAVID GRIES SOLO MANUALS * SEP 75 NOV 75 LIBRARIAN STANFORD RESEARCH INSTITUTE *************************** MENLO PARK CALIFORNIA 94025 DR. THOMAS H. BREDT SOLO MANUALS 21 OCT 75 DIGITAL SYSTEMS LABORATORY SOLO COPY 21 OCT 75 ERL 233 C SOLO FILES 21 OCT 75 STANFORD UNIVERSITY SOLO MANUALS 24 FEB 76 ******************* 2 REAL-TIME MANUALS 24 FEB 76 STANFORD 3 JOB-MATHEMATISCHES INSTITUT DER TECHNISCHEN HOCHSCHULE ********************** ARCISSTRASSE 21 D - 8 MUNICH 2 GERMANY DR. K.-P. LOEHR SOLO MANUALS 24 OCT 75 FORSCHUNGSGRUPPE BETRIEBSSYSTEME SOLO COPY 24 OCT 75 TECHNISCHE UNIVERSITAET BERLIN SOLO FILES 24 OCT 75 ****************************** REAL-TIME MANUAL 3 FEB 76 ROOM 1905 JOB-STREAM MANUAL 3 FEB 76 ERNST REUTER PLATZ 7 STREAM MANUALS 24 FEB 76 CALIFORNIA 94305 2 MACHINE MANUALS 24 FEB 76 3 NOTES 24 FEB 76 DR. ROGER L. COTTRELL SOLO MANUALS 26 SEP 75 STANFORD LINEAR ACCELERATOR CENTER SOLO FILES 10 NOV 75 STANFORD UNIVERSITY ******************* P. O. BOX 4349 STANFORD CALIFORNIA 94305 PROFESSOR R. W. FLOYD SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT STANFORD UNI MACHINE MANUAL 3 FEB 76 1 BERLIN 10 NOTES 3 FEB 76 GERMANY DR. W. BARTH SOLO MANUALS 9 DEC 75 INSTITUT FUER INFORMATIONSSYSTEME SOLO FILES 9 DEC 75 TECHNISCHE UNIVERSITAET WIEN REAL-TIME MANUAL 8 APR 76 **************************** JOB-STREAM MANUAL 8 APR 76 ARGENTIENERSTRASSE 8 MACHINE MANUAL 8 APR 76 A-1040 VIENNA VERSITY ******************* STANFORD CALIFORNIA 94305 PROFESSOR DONALD E. KNUTH SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT STANFORD UNIVERSITY ******************* STANFORD CALIFORNIA 94304 DR. DAVID LUCKHAM SOLO MANUALS 13 OCT 75 ARTIFICIAL INTELLIGENCE LABORATORY SOLO COPY 13 OCT 75 STANFORD UNIVERSITY SOLO MANUALS 24 MAY 76 ******************* REAL-TIME MANUAL 24 MAY NOTES 8 APR 76 AUSTRIA MR. DANIEL S. MARCUS SOLO MANUALS 27 MAY 76 TECHNOLOGY MARKETING INC. SOLO COPY 27 MAY 76 ************************* SOLO FILES 27 MAY 76 3170 RED HILL AVENUE REAL-TIME MANUAL 27 MAY 76 COSTA MESA JOB-STREAM MANUAL 27 MAY 76 CALIFORNIA 92626 MACHINE MANUAL 27 MAY 76 76 STANFORD JOB-STREAM MANUAL 24 MAY 76 CALIFORNIA 94305 MACHINE MANUAL 24 MAY 76 NOTES 24 MAY 76 DR. JOHN C. REYNOLDS SOLO MANUALS * SEP 75 SYSTEMS AND INFORMATION SCIENCE SYRACUSE UNIVERSITY ******************* 313 LINK HALL SYRACUSE NEW YORK 13210 MR. R. E. WARD SOLO MANUALS 20 OCT 75 SYSTEMS AND INFORMATION SCIENCE NOTES 27 MAY 76 MR. TERRY HAMM SOLO MANUALS 10 NOV 75 TEKTRONIX INC. SOLO COPY 10 NOV 75 ************** SOLO FILES 10 NOV 75 P. O. BOX 500 BEAVERTON OREGON 97077 DR. RAFAEL M. BONET SOLO MANUALS 11 DEC 75 TELESINCRO S. A. SOLO COPY 11 DEC 75 **************** SOLO FILES 11 DE SOLO COPY 20 OCT 75 SYRACUSE UNIVERSITY SOLO FILES 20 OCT 75 ******************* REAL-TIME MANUAL 8 MAR 76 313 LINK HALL JOB-STREAM MANUAL 8 MAR 76 SYRACUSE MACHINE MANUAL 8 MAR 76 NEW YORK 13210 NOTES 8 MAR 76 MR. ERWIN BOOK SOLO MANUALS 29 APR 76 SYSTEM DEVELOPMENT CORPORATION C 75 INVESTIGACION Y DESSAROLLO 3 SOLO MANUALS 26 JAN 76 ROCAFORT 100 REAL-TIME MANUAL 3 FEB 76 BARCELONA JOB-STREAM MANUAL 3 FEB 76 SPAIN MACHINE MANUAL 3 FEB 76 NOTES 3 FEB 76 MR. EDWARD E. FERGUSON SOLO MANUALS 20 NOV 75 TEXAS INSTRUMENTS INC. SOLO FILES 20 NOV 75 * SOLO COPY 29 APR 76 ****************************** SOLO FILES 29 APR 76 MAIL DROP 5238 REAL-TIME MANUAL 29 APR 76 2500 COLORADO AVENUE JOB-STREAM MANUAL 29 APR 76 SANTA MONICA MACHINE MANUAL 29 APR 76 CALIFORNIA 90406 NOTES 29 APR 76 REAL-TIME MANUAL 1 JUN 76 JOB-S NOTES 27 MAY 76 DR. H. KEISTNER SOLO MANUALS 24 MAY 76 INFORMATIK III SOLO FILES 24 MAY 76 UNIVERSITY OF DORTMUND ********************** POSTFACH 50 05 00 46 DORTMUND 50 GERMANY DR. R. M. BURSTALL SOLO MANUALS * SEP 75 DEPARTMENT OF MACHINE INTELLIGENCE UNIVERSITY OF EDINBURGH *********************** HOPE PARK SQUARE MEADOW LANE EDINBURGH EH8 9NW UNITED KINGDOM DR. GILBERT J. HAN 5 FEB 76 NY MUNKEGADE 8000 AARHUS C DENMARK THE LIBRARY SOLO MANUALS 26 SEP 75 RECAU UNIVERSITY OF AARHUS ******************** NY MUNKEGADE 8000 AARHUS C DENMARK DR. W. P. BEAUMONT SOLO MANUALS 10 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY 10 DEC 75 UNIVERSITY OF ADELAIDE SOLO FILES 10 DEC 75 ********************** ADELAIDE SOUTH AUSTRALIA 5001 DR. ROGER HART SEN SOLO MANUALS 12 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 12 MAR 76 UNIVERSITY OF FLORIDA REAL-TIME MANUAL 12 MAR 76 ********************* JOB-STREAM MANUAL 12 MAR 76 512 WEIL HALL MACHINE MANUAL 12 MAR 76 GAINESVILLE NOTES 12 MAR 76 FLORIDA 32611 DR. WILLIAM FINDLAY SOLO MANUALS 17 DEC 75 COMPUTER SOLO MANUALS 17 JUN 76 COMPUTER SCIENCE DEPARTMENT REAL-TIME MANUAL 17 JUN 76 UNIVERSITY OF ALBERTA MACHINE MANUAL 17 JUN 76 ********************* NOTES 17 JUN 76 EDMONTON ALBERTA CANADA T6G 2E2 DR. T.A. MARSLAND SOLO COPY 27 JUL 76 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF ALBERTA ********************* EDMONTON ALBERTA CANADA T6G 2H1 DR. THEODORUS J. DEKKER SCIENCE DEPARTMENT SOLO COPY 17 DEC 75 UNIVERSITY OF GLASGOW REAL-TIME MANUAL 8 APR 76 ********************* JOB-STREAM MANUAL 8 APR 76 GLASGOW G12 8QQ MACHINE MANUAL 8 APR 76 SCOTLAND NOTES 8 APR 76 UNITED KINGDOM MS. E. CRIEGEE, LIBRARIAN REAL-TIME MANUAL 1 JUN 76 INFORMATION SCIENCE MACHINE MANUAL 1 JUN 76 SOLO MANUALS 6 JUL 76 UNIVERSITY OF AMSTERDAM *********************** ROETERSSTRAAT 15 AMSTERDAM THE NETHERLANDS MR. PATRICK G. PECORARO SOLO MANUALS 14 JUN 76 ASSISTANT DIRECTOR REAL-TIME MANUAL 14 JUN 76 UNIVERSITY COMPUTER CENTER JOB-STREAM MANUAL 14 JUN 76 UNIVERSITY OF ARIZONA MACHINE MANUAL 14 JUN 76 ********************* NOTES 14 JUN 76 TUCSON ARIZONA UNIVERSITY OF HAMBURG NOTES 1 JUN 76 ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY DR. HARTMUT FICHTEL SOLO MANUALS 23 SEP 75 INFORMATION SCIENCE SOLO FILES 23 SEP 75 UNIVERSITY OF HAMBURG ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY DR. D.L. EPLEY SOLO MANUALS 7 JUN 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 7 85721 PROFESSOR HANS ZIMA REAL-TIME MANUAL 20 JUL 76 INSTITUT FUER INFORMATIK MACHINE MANUAL 20 JUL 76 ABT. III UNIVERSITY OF BONN ****************** KURFUERSTENSTRASSE 74 5300 BONN GERMANY DR. GRAHAM BIRTWISTLE SOLO MANUALS 25 JUN 76 COMPUTING LABORATORY SOLO FILES 25 JUN 76 UNIVERSITY OF BRADFORD REAL-TIME MANUAL 25 JUN 76 ********************** JOB-STREAM MANJUN 76 UNIVERSITY OF IOWA REAL-TIME MANUAL 7 JUN 76 ****************** JOB-STREAM MANUAL 7 JUN 76 IOWA CITY MACHINE MANUAL 7 JUN 76 IOWA 52333 NOTES 7 JUN 76 PROFESSOR GERHARD GOOS SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF KARLSRUHE *********************** POSTFACH 6380 75 KARLSRUHE 1 D-75 GERMANY DR. V. HAASE 75 TRW SYSTEMS GROUP SOLO COPY 15 DEC 75 ***************** SOLO FILES 15 DEC 75 ONE SPACE PARK REDONDO BEACH CALIFORNIA 90278 MR. GARY KANG REAL-TIME MANUAL 19 JUL 76 TRW SYSTEMS GROUP JOB-STREAM MANUAL 19 JUL 76 ***************** MACHINE MANUAL 19 JUL 76 BLDG. 90, RM. 2824 NOTES 19 JUL 76 ONE SPACE PARK REDONDO BEAUAL 25 JUN 76 BRADFORD MACHINE MANUAL 25 JUN 76 ENGLAND NOTES 25 JUN 76 PROFESSOR J.E.L. PECK SOLO MANUALS 20 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO COPY 20 APR 76 UNIVERSITY OF BRITISH COLUMBIA SOLO FILES 20 APR 76 ****************************** REAL-TIME MANUAL 20 APR 76 VANCOUVER JOB-STREAM MANUAL CH CALIFORNIA 90278 MR. LARRY MICHELS SOLO MANUALS 22 JUL 76 ADVANCED PRODUCTS LABORATORY MACHINE MANUAL 22 JUL 76 TRW NOTES 22 JUL 76 *** P.O. BOX 2921 TORRANCE CALIFORNIA 90510 MR. M. VERGES TRIAS SOLO MANUALS 11 DEC 75 CENTRO DE CALCULO DE LA SOLO COPY 11 DEC 75 UNIVERSIDAD POLITECNICA SOLO FILES 11 DEC 75 ********** 20 APR 76 BRITISH COLUMBIA V6T 1W5 MACHINE MANUAL 20 APR 76 CANADA NOTES 20 APR 76 DR. JAY EARLEY SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF CALIFORNIA, BERKELEY ********************************** BERKELEY CALIFORNIA 94720 PROFESSOR ROBERT FABRY SOLO MANUAL * 17 NOV 75 COMPUTER SCIENCE DEPARTMENT 573 EWANS HALL UNIVERSITY OF CALIFORNIA, BERKELEY ************** REAL-TIME MANUAL 3 FEB 76 AVDA. DR. GREGORIO MARANON JOB-STREAM MANUAL 3 FEB 76 BARCELONA 14 MACHINE MANUAL 3 FEB 76 SPAIN NOTES 3 FEB 76 MR. HERNAN SUAREZ-FLAMERICH 3 SOLO MANUALS 24 JUN 76 EXECUTIVE DIRECTOR SOLO COPY 24 JUN 76 CENTRO DE INFORMACION Y COMPUTACION SOLO FILES 24 JUN 76 UNIVERSIDAD SIM********************************* BERKELEY CALIFORNIA 94720 DR. ERIC OLSEN REAL-TIME MANUAL 13 JUL 76 ICS DEPARTMENT JOB-STREAM MANUAL 13 JUL 76 UNIVERSITY OF CALIFORNIA, IRVINE MACHINE MANUAL 13 JUL 76 ******************************** NOTES 13 JUL 76 IRVINE CALIFORNIA 92717 DR. MARK OVERGAARD REAL-TIME MANUAL 24 MAY 76 UNIVERSITY OF CALIFORNIA, SAN DIEGO MACHINE MANUAL ON BOLIVAR 3 REAL-TIME MANUALS 24 JUN 76 ************************* 3 JOB-STREAM MANUALS 24 JUN 76 APARTADO POSTAL 80659 3 MACHINE MANUALS 24 JUN 76 CARACAS 3 NOTES 24 JUN 76 VENEZUELA PROFESSOR E. MILGROM SOLO MANUALS 20 OCT 75 UNITE D'INFORMATIQUE SOLO COPY 20 OCT 75 UNIVERSITE CATHOLIQUE DE LOUVAIN SOLO FILES 20 OCT 75 *********** 24 MAY 76 *********************************** NOTES 24 MAY 76 APIS (C-014) LA JOLLA CALIFORNIA 92093 PROFESSOR K.J. MACGREGOR SOLO MANUALS 16 APR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 16 APR 76 UNIVERSITY OF CAPE TOWN REAL-TIME MANUAL 21 MAY 76 *********************** JOB-STREAM MANUAL 21 MAY 76 PRIVATE BAG MACHINE MANUAL 21 MAY 76 RONDEBOSCH 7700 ********************* CHEMIN DU CYCLOTRON 2 B-1348 LOUVAIN-LA-NEUVE BELGIUM DR. G. V. BOCHMANN SOLO MANUALS 8 OCT 75 DEPT. D'INFORMATIQUE SOLO COPY 8 OCT 75 UNIVERSITE DE MONTREAL MACHINE MANUAL 17 NOV 75 ********************** REAL-TIME MANUAL 3 FEB 76 CASE POSTALE 6128 JOB-STREAM MANUAL 3 FEB 76 MONTREAL 101 PQ NOTES 3 FEB 76 Q NOTES 21 MAY 76 SOUTH AFRICA PROFESSOR WILLIAM M. WAITE MACHINE MANUAL * 30 SEP 75 ELECTRICAL ENGINEERING UNIVERSITY OF COLORADO ********************** BOULDER COLORADO 80302 MR. DAVID WOOD SOLO MANUALS 7 JUL 76 COMPUTING CENTER SOLO FILES 7 JUL 76 UNIVERSITY OF COLORADO NOTES 7 JUL 76 ********************** 3645 MARINE STREET BOULDER COLORADO 80309 UEBEC CANADA DR. PIERRE DESJARDINS JOB-STREAM MANUAL 3 FEB 76 DEPT. D'INFORMATIQUE NOTES 3 FEB 76 UNIVERSITE DE MONTREAL ********************** CASE POSTALE 6128 MONTREAL 101 PQ QUEBEC CANADA DR. GUY LOUCHARD SOLO MANUALS 19 JUL 76 LAB. INF. THEORIQUE REAL-TIME MANUAL 19 JUL 76 UNIVERSITE LIBRE DE BRUXELLES JOB-STREAM MANUAL 19 JUL 76 ***************************** C.P. 212 CA MR. OLE CAPRANI SOLO MANUALS 24 OCT 75 DATALOGISK INSTITUT SOLO COPY 24 OCT 75 UNIVERSITY OF COPENHAGEN REAL-TIME MANUAL 20 FEB 76 ************************ JOB-STREAM MANUAL 20 FEB 76 SIGURDSGADE 41 MACHINE MANUAL 20 FEB 76 2200 COPENHAGEN NOTES 20 FEB 76 DENMARK PROFESSOR PETER NAUR SOLO MANUALS * SEMPUS DE LA PLAINE ULB BOULEVARD DU TRIOMPHE 1050 BRUSSELS BELGIUM PROFESSOR C. GIRAULT SOLO MANUALS 10 NOV 75 INSTITUT DE PROGRAMMATION SOLO FILES 10 NOV 75 UNIVERSITE PARIS 6, T55 **************** 4 PLACE JUSSIEU 75230 PARIS CEDEX OS FRANCE DR. P. VANDEGINSTE MACHINE MANUAL 3 FEB 76 INSTITUT DE PROGRAMMATION NOTES 3 FEB 76 UNIVERSITE PARIS **************** TOUR 55 - 65 11 QUAI SAINT BERNARD P 75 DATALOGISK INSTITUT UNIVERSITY OF COPENHAGEN ************************ SIGURDSGADE 41 2200 COPENHAGEN DENMARK DR. T. KIMURA SOLO MANUALS 27 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO COPY 27 MAY 76 UNIVERSITY OF DELAWARE REAL-TIME MANUAL 27 MAY 76 ********************** JOB-STREAM MANUAL 27 MAY 76 NEWARK MACHINE MANUAL 27 MAY 76 DELAWARE 19711 75005 PARIS FRANCE DR. R. B. LAKE SOLO MANUALS 10 DEC 75 BIOMETRY SOLO COPY 10 DEC 75 WEARN BUILDING UNIVERSITY HOSPITALS ********************* CLEVELAND OHIO 44106 THE LIBRARY SOLO MANUALS SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES SEP 75 UNIVERSITY OF AARHUS MACHINE MANUAL 5 FEB 76 ******************** NOTES SOLO COPY 20 FEB 76 JAPAN COMPILER THESIS 14 MAY 76 DR. ALLAN CHAN SOLO MANUALS SEP 75 COMPUTER SYSTEMS RESEARCH GROUP SOLO COPY SEP 75 UNIVERSITY OF TORONTO ********************* SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 PROFESSOR RICHARD C. HOLT REAL-TIME MANUAL 22 MAR 76 COMPUTER SYSTEMS RESEARCH GROUP JOBSITY OF MINNESOTA REAL-TIME MANUAL 19 APR 76 *********************** JOB-STREAM MANUAL 19 APR 76 MINNEAPOLIS MACHINE MANUAL 19 APR 76 MINNESOTA 55455 DR. EARL D. JENSEN SOLO MANUALS 8 APR 76 COMPUTER SCIENCE DEPARTMENT 114 LIND HALL UNIVERSITY OF MINNESOTA *********************** MINNEAPOLIS MINNESOTA 55455 DR. G. MICHAEL SCNEIDER NOTES 16 APR 76 COMPUTER SCIENCE D-STREAM MANUAL 22 MAR 76 UNIVERSITY OF TORONTO MACHINE MANUAL 22 MAR 76 ********************* NOTES 22 MAR 76 SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 PROFESSOR J. J. HORNING SOLO MANUALS * SEP 75 COMPUTER SYSTEMS RESEARCH GROUP UNIVERSITY OF TORONTO ********************* SANDFORD FLEMING BUILDING 10 KING'S COLLEGE ROAD TORONTO ONTARIO CANADA M5S 1A4 MR. JOHN DALSENG EPARTMENT 114 LIND HALL UNIVERSITY OF MINNESOTA *********************** MINNEAPOLIS MINNESOTA 55455 PROFESSOR BRIAN RANDELL SOLO MANUALS * SEP 75 UNIVERSITY COMPUTING LABORATORY UNIVERSITY OF NEWCASTLE UPON TYNE ********************************* CLAREMONT TOWER CLAREMONT ROAD NEWCASTLE UPON TYNE NE1 7RU ENGLAND DR. C. R. SNOW SOLO MANUALS 20 OCT 75 UNIVERSITY COMPUTING LABORATORY SOLO COPY 20 OCT 75 UNIVERSITY OF NEWCASTLE SOLO MANUALS 26 NOV 75 DATAFAGSEKSJONEN SOLO FILES 26 NOV 75 UNIVERSITY OF TROMSOE ********************* STORGATAN 25 N-9000 TROMSOE NORWAY MR. RANDI MIDTSAND REAL-TIME MANUAL 12 MAY 76 COMPUTING CENTER MACHINE MANUAL 12 MAY 76 UNIVERSITY OF TRONDHEIM *********************** 7034 TRONDHEIM - NTH NORWAY PROFESSOR ELLIOTT ORGANICK SOLO MANUALS * 18 SEP 75 COMPUTER SCIENCE DEUPON TYNE SOLO FILES 20 OCT 75 ********************************* REAL-TIME MANUAL 8 MAR 76 CLAREMONT TOWER JOB-STREAM MANUAL 8 MAR 76 CLAREMONT ROAD MACHINE MANUAL 8 MAR 76 NEWCASTLE UPON TYNE NOTES 8 MAR 76 NE1 7RU ENGLAND DR. JOHN LIONS SOLO MANUALS 26 FEB 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 26 FEB 76 UNIVERSITY OF PARTMENT SOLO COPY * 18 SEP 75 UNIVERSITY OF UTAH MACHINE MANUAL * 30 OCT 75 ****************** REAL-TIME MANUAL 12 FEB 76 SALT LAKE CITY JOB-STREAM MANUAL 12 FEB 76 UTAH 84112 MACHINE MANUAL 12 FEB 76 NOTES 12 FEB 76 DR. D.M.R. PARK SOLO MANUALS 10 JUN 76 COMPUTER SCIENCE DEPARTMNEW SOUTH WALES ***************************** KENSINGTON AUSTRALIA 2033 PROFESSOR F. P. BROOKS SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF NORTH CAROLINA **************************** NEW WEST HALL CHAPEL HILL NORTH CAROLINA 27514 MS. HELEN R. MILLER SOLO MANUALS 2 AUG 76 WILSON LIBRARY 024 A REAL-TIME MANUAL 2 AUG 76 UNIVERSITY OF NORTH CAROLINA JOB-STREAM MANUAL 2 AUG 76 ***************ENT REAL-TIME MANUAL 10 JUN 76 UNIVERSITY OF WARWICK JOB-STREAM MANUAL 10 JUN 76 ********************* MACHINE MANUAL 10 JUN 76 COVENTRY CV4 7AL ENGLAND MR. DANIEL E. LIPKIE SOLO MANUALS 10 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 10 MAR 76 UNIVERSITY OF WASHINGTON MACHINE MANUAL 10 MAR 76 ************************ NOTES 10 MAR 76 M.S************* MACHINE MANUAL 2 AUG 76 CHAPEL HILL NOTES 2 AUG 76 NORTH CAROLINA 27514 PROFESSOR OLE-JOHAN DAHL SOLO MANUALS * SEP 75 INSTITUTE OF MATHEMATICS UNIVERSITY OF OSLO ****************** OSLO - BLINDERN 3 NORWAY DR. ROBERT N. KAVANAGH SOLO MANUALS 11 MAY 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 11 MAY 76 UNIVERSITY OF SASKATCHEWAN REAL-TIME MA. FR-35 SEATTLE WASHINGTON 98195 PROFESSOR A. C. SHAW SOLO MANUALS * SEP 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WASHINGTON ************************ SEATTLE WASHINGTON 98195 PROFESSOR D. D. COWAN SOLO MANUAL * 18 NOV 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WATERLOO ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. J. PULLIN SOLO MANUALS 19 MAY 76 ELECTRICAL ENGINEERING REALNUAL 11 MAY 76 ************************** JOB-STREAM MANUAL 11 MAY 76 SASKATOON MACHINE MANUAL 11 MAY 76 SASKATCHEWAN NOTES 11 MAY 76 CANADA S7N 0W0 DR. BRUCE MITCHELL SOLO MANUALS 9 MAR 76 COMPUTING LABORATORY SOLO COPY 9 MAR 76 UNIVERSITY OF ST. ANDREWS SOLO FILES 9 MAR 76 ************************* RE-TIME MANUAL 19 MAY 76 UNIVERSITY OF WATERLOO MACHINE MANUAL 19 MAY 76 ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. RAUL J. RAMIREZ SOLO MANUALS 31 MAR 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 31 MAR 76 UNIVERSITY OF WATERLOO REAL-TIME MANUAL 31 MAR 76 ********************** JOB-STREAM MANUAL 31 MAR 76 WATERLOO MACHINE MANUAL 31 M SOLO MANUALS 13 MAY 76 COMPUTER SCIENCE DEPARTMENT REAL-TIME MANUAL 13 MAY 76 UNIVERSITY OF KARLSRUHE MACHINE MANUAL 13 MAY 76 *********************** KAISERSTRASSE 12 7500 KARLSRUHE GERMANY DR. P. KAMMERER SOLO MANUALS 13 OCT 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 13 OCT 75 UNIVERSITY OF KARLSRUHE REAL-TIME MANUAL 25 MAR 76 *********************** AL-TIME MANUAL 9 MAR 76 NORTH HAUGH JOB-STREAM MANUAL 9 MAR 76 ST. ANDREWS MACHINE MANUAL 9 MAR 76 SCOTLAND NOTES 9 MAR 76 PROFESSOR KLAUS LAGALLY SOLO MANUALS 30 JUL 76 INSTITUT FUER INFORMATIK SOLO FILES 30 JUL 76 UNIVERSITY OF STUTTGART REAL-TIME MANUAL 30 JUL 76 *********************** JOB-STR JOB-STREAM MANUAL 25 MAR 76 KAISERSTRASSE 12 MACHINE MANUAL 25 MAR 76 7500 KARLSRUHE NOTES 25 MAR 76 GERMANY COMPILER THESIS 7 JUL 76 MR. H.-D. PATOCK SOLO MANUALS 14 NOV 75 FACHBEREICH INFORMATIK SOLO COPY 14 NOV 75 UNIVERSITY OF KAISERSLAUTERN SOLO FILES 14 NOV 75 **************************** EAM MANUAL 30 JUL 76 AZENBERGSTRASSE 12 MACHINE MANUAL 30 JUL 76 D-7000 STUTTGART 1 NOTES 30 JUL 76 GERMANY DR. IAN JACKSON SOLO MANUALS 13 JAN 76 COMPUTER SCIENCE DEPARTMENT SOLO FILES 13 JAN 76 UNIVERSITY OF SYDNEY ******************** SYDNEY 2006 AUSTRALIA DR. JUHA HEINANEN SOLO MANUALS 20 MAY 76 MATHEMATICAL SCIENCES SOLO FIL REAL-TIME MANUAL 5 MAR 76 PFAFFENBERGSTRASSE 95 JOB-STREAM MANUAL 5 MAR 76 675 KAISERSLAUTERN MACHINE MANUAL 5 MAR 76 GERMANY NOTES 5 MAR 76 DR. HANS LANGMAACK SOLO MANUALS 8 DEC 75 INSTITUT FUER INFORMATIK UNIVERSITY OF KIEL ****************** OLSHAUSENSTRASSE 40 - 60 23 KIEL 14 GERMANY DR. HOWARD J. FERCH SOLO MANUALS 27 MAY 76 COMPUES 20 MAY 76 UNIVERSITY OF TAMPERE REAL-TIME MANUAL 20 MAY 76 ********************* JOB-STREAM MANUAL 20 MAY 76 PL 607, SF-33101 MACHINE MANUAL 20 MAY 76 TAMPERE 10 NOTES 20 MAY 76 FINLAND PROFESSOR A.H.J. SALE SOLO MANUALS 24 MAY 76 INFORMATION SCIENCE REAL-TIME MANUAL 24 MAY 76 UNIVERSITY OF TASMANIA JOB-STER SCIENCE DEPARTMENT SOLO FILES 27 MAY 76 UNIVERSITY OF MANITOBA REAL-TIME MANUAL 27 MAY 76 ********************** JOB-STREAM MANUAL 27 MAY 76 WINNIPEG MACHINE MANUAL 27 MAY 76 MANITOBA NOTES 27 MAY 76 CANADA R3T 2N2 PROFESSOR VICTOR R. BASILI SOLO MANUALS 10 NOV 75 COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF MARYLAND ****************TREAM MANUAL 24 MAY 76 ********************** MACHINE MANUAL 24 MAY 76 GPO BOX 252 C HOBART AUSTRALIA 7008 MR. CHARLES H. WARLICK, DIRECTOR SOLO MANUALS 28 APR 76 COMPUTATION CENTER SOLO FILES 28 APR 76 UNIVERSITY OF TEXAS, AUSTIN REAL-TIME MANUAL 28 APR 76 *************************** JOB-STREAM MANUAL 28 APR 76 AUSTIN MACHINE MANUAL 28 APR 76 TEXAS 78712 ****** BUILDING MM, ROOM 4105 COLLEGE PARK MARYLAND 20742 DR. JAMES W. CONKLIN SOLO MANUALS 9 JAN 76 SCHOOL OF DENTISTRY SOLO FILES 9 JAN 76 UNIVERSITY OF MICHIGAN MACHINE MANUAL 2 FEB 76 ********************** NOTES 2 FEB 76 ANN ARBOR MICHIGAN 48104 DR. PAUL PICKELMANN SOLO MANUALS 13 APR 76 UNIVERSITY OF MICHIGAN MACHINE MANUAL NOTES 28 APR 76 DR. MASARU WATANABE SOLO MANUALS 3 FEB 76 INSTITUTE OF INDUSTRIAL RESEARCH SOLO FILES 3 FEB 76 UNIVERSITY OF TOKYO REAL-TIME MANUAL 3 FEB 76 ******************* JOB-STREAM MANUAL 3 FEB 76 22-1 ROPPONGI MACHINE MANUAL 3 FEB 76 7 CHOME, MINATO-KU NOTES 3 FEB 76 TOKYO 106 13 APR 76 ********************** NOTES 13 APR 76 424 NORTH STATE STREET ANN ARBOR MICHIGAN 48104 DR. SCOTT BERTILSON SOLO FILES 13 MAY 76 UNIVERSITY OF MINNESOTA *********************** R.R. # 2 SPICER MINNESOTA 56288 DR. JONATHAN GROSS SOLO MANUALS 2 FEB 76 SOCIAL SCIENCE RESEARCH CENTER NOTES 2 FEB 76 25 BLEGEN HALL SOLO FILES 19 APR 76 UNIVER 76 NOTES 2 FEB 76 ###################################### # CONCURRENT PASCAL IMPLEMENTATION # # 3 AUG 76 # ###################################### MR. LEE M. SCHWANKE BOEING AEROSPACE COMPANY ************************ P.O. BOX 3707 SEATTLE, WASHINGTON 98124 PDP 11/40 48 K WORDS (16 BITS) DISK (RK11, 1.2 M WORDS) CLOCK (KW11-P) TELETYPE CARD READER (CR11) LINE PRINTER (LP11-K) PAPER TAPE READER COMPILER DEVELOPMENT U1 PROFESSOR ANDREI P. ERSHOV SOLO MANUALS * 9 SEP 75 COMPUTING CENTER SIBERIAN DIVISION OF THE U.S.S.R ACADEMY OF SCIENCES *************************** NOVOSIBIRSK 630090 U. S. S. R. MR. DAVID D. DETERMAN SOLO MANUALS 10 JUN 76 VARATEK COMPUTER SYSTEMS INC. SOLO COPY 10 JUN 76 ***************************** SOLO FILES 10 JUN 76 2 ELM SQUARE REAL-TIME MANUAL 10 JUN 76 ANDOVER SED LOCALLY PROFESSOR J. W. ATWOOD COMPUTER SCIENCE DEPARTMENT CONCORDIA UNIVERSITY ******************** 1455 DE MAISONNEUVE BLRD. WEST MONTREAL, QUEBEC H3G 1M8 CANADA TEXAS INSTRUMENTS 980B 64 K WORDS (16 BITS) DISK (1.2 M WORDS) CARD READER LINE PRINTER MAGNETIC TAPES MODEMS OPERATING SYSTEM RESEARCH AND TEACHING INCOMPLETE DR. SIMON WADDELL ECOLE POLYTECHNIQUE FEDERALE **************************** AVENUE DE COUR 67 CH-1007 LAUSANNE SWITZERLAND PDP 11/40 32 K WORDS (16 BITS) DISK (1.2 M WORDS) CA JOB-STREAM MANUAL 10 JUN 76 MASSACHUSETTS 01810 MACHINE MANUAL 10 JUN 76 NOTES 10 JUN 76 MR. ROBERT A. STILLMAN SOLO MANUALS 12 MAR 76 INSTRUMENT DIVISION SOLO FILES 12 MAR 76 VARIAN ASSOCIATES REAL-TIME MANUAL 12 MAR 76 ***************** JOB-STREAM MANUAL 12 MAR 76 611 HANSEN WAY RD READER LINE PRINTER CASETTE TAPE PAPER TAPE PROCESSOR BUFFER (PDP 11/10) EDUCATION INCOMPLETE PROFESSOR ASHOK N. ULLALL FACHHOCHSCHULE REUTLINGEN ************************* KAISERSTRASSE 99 D-7410 REUTLINGEN GERMANY IBM 1130 16 K WORDS (16 BITS) DISK (2 * 0.5 M WORDS) CARD READER CARD PUNCH LINE PRINTER PLOTTER PAPER TAPE READER PAPER TAPE PUNCH INCOMPLETE DIETZ 621 48 - 96 K WORDS (8 BITS) DISK (10 M WORDS) CARD READER LINE PRINTER COMMUNICATION LINES INCOMPLETE MR. LELAND E. VANDERGRIFF FISHE MACHINE MANUAL 12 MAR 76 PALO ALTO NOTES 12 MAR 76 CALIFORNIA 94303 MR. ALAN FRITCHOFF SOLO MANUALS 15 APR 76 VARIAN DATA MACHINES SOLO FILES 15 APR 76 ******************** 2722 MICHELSON DRIVE IRVINE CALIFORNIA 92664 MR. JOHN ROMEY SOLO MANUALS 26 JUL 76 VARIAN DATA MACHINES REAL-TIME MANUAL 26 JUL 76 *********R CONTROLS COMPANY *********************** R. A. ENGEL TECHNICAL CENTER MARSHALLTOWN, IOWA 50158 INTERDATA 70 (DOUBLE ADDRESS SPACE) 65 K WORDS (16 BITS) DISK (2.4 M WORDS) DISPLAY LINE PRINTER PAPER TAPE READER PAPER TAPE WRITER PROGRAM DEVELOPMENT OPERATING SYSTEM DEVELOPMENT INCOMPLETE MR. ALDEN J. CARLSON JOHN FLUKE MANUFACTURING COMPANY ******************************** P.O. BOX 7428 SEATTLE, WASHINGTON 98113 PDP 11 28 K WORDS (16 BITS) DISK LINE PRINTER PAPER TAPE DISPLAY PROGRAM DEVELOPMENT PLA*********** JOB-STREAM MANUAL 26 JUL 76 2722 MICHELSON DRIVE MACHINE MANUAL 26 JUL 76 IRVINE NOTES 26 JUL 76 CALIFORNIA 92715 DR. ANDREW S. TANENBAUM SOLO MANUALS 25 MAR 76 WISKUNDIG SEMINARIUM SOLO COPY 25 MAR 76 VRIJE UNIVERSITEIT SOLO FILES 25 MAR 76 ****************** REAL-TIME MANUAL 25 MARNNED, BUT NOT STARTED MR. HERBERT W. SILVERMAN MANAGER, SOFTWARE DEVELOPMENT GENERAL AUTOMATION INC. *********************** 1055 SOUTH EAST STREET ANAHEIM, CALIFORNIA 92805 GENERAL AUTOMATION 16/440 64 K WORDS (16 BITS) DISK (2.5 M WORDS) TELETYPE LINE PRINTER CARD READER MAGNETIC TAPE SOFTWARE DEVELOPMENT INCOMPLETE MR. MICHAEL GREEN 11483 HESSLER ROAD, # 11 CLEVELAND, OHIO 44106 DATAPOINT 5500 55 K WORDS (8 BITS) DISKS (2 * 2.5 M WORDS) LINE PRINTER COMMUNICATIONS INTERFACE OPERATING SYSTEM EXP 76 BOX 7161 JOB-STREAM MANUAL 25 MAR 76 AMSTERDAM MACHINE MANUAL 25 MAR 76 THE NETHERLANDS NOTES 25 MAR 76 MR. RALPH S. GOODELL SOLO MANUALS 4 MAY 76 WANG LABORATORIES SOLO FILES 4 MAY 76 ***************** MACHINE MANUAL 4 MAY 76 HILLCREST DRIVE NOTES 4 MAY 76 HERIMENTS SYSTEM PROGRAMMING INCOMPLETE MR. MALCOLM F. WELCH MANAGER OF SOFTWARE GRI COMPUTER CORPORATION ************************ 320 NEEDHAM STREET NEWTON, MASSACHUSETTS 02164 GRI 99/50 8 - 32 K WORDS (16 BITS) DISK (10.6 - 42.4 M WORDS) LINE PRINTER CARD READER CARD PUNCH MAGNETIC TAPE PAPER TAPE READER PAPER TAPE PUNCH VIDEO DISPLAY FLOPPY DISK COMMUNICATIONS EQUIPMENT COMPILER WRITING INCOMPLETE DR. SAM GEBALA HEWLETT PACKARD CORPORATION *************************** 3500 DEER CREEK ROAD PALO ALTOARVARD MASSACHUSETTS 01451 DR. JOHN P. LEE MACHINE MANUAL 16 MAR 76 WASHINGTON STATE UNIVERSITY NOTES 16 MAR 76 *************************** 103 NORTH CAMPUS HEIGHTS PULLMAN WASHINGTON 99163 MISS ANDREA MELIUS SOLO MANUALS 20 OCT 75 DIVISION OF PURCHASING SOLO FILES 20 OCT 75 WASHINGTON STATE UNIVERSITY *************************** PULLMAN WASHINGTON 99163 DR. GERALD C. JOHNS CALIFORNIA 94304 HEWLETT PACKARD 21MX 48 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER MAGNETIC TAPE (1600 BPI) CONSOLE OPERATING SYSTEM RESEARCH PROGRAMMING LANGUAGE RESEARCH INCOMPLETE MR. ERIC SCHNELLMAN HONEYWELL MARINE SYSTEMS ************************ 5303 SHILSHOLE AVENUE SEATTLE, WASHINGTON 98107 HONEYWELL H516 32 K WORDS (16 BITS) DISK (3 - 12 M WORDS) LINE PRINTER CARD READER MAGNETIC TAPE (7 & 9 TRACK) PAPER TAPE READER PAPER TAPE PUNCH DISPLAY (TEKTRONIX, HAZELTINE 2000) REAL-TIME PRO SOLO MANUALS 27 MAY 76 COMPUTER SYSTEMS LABORATORY SOLO FILES 27 MAY 76 WASHINGTON UNIVERSITY REAL-TIME MANUAL 27 MAY 76 ********************* JOB-STREAM MANUAL 27 MAY 76 724 SOUTH EUCLID MACHINE MANUAL 27 MAY 76 ST. LOUIS NOTES 27 MAY 76 MISSOURI 63110 DR. FRANK M. STEPEZYK REAL-TIME MANUAL 20 FEB 76 WEST COAST UNIVEGRAMMING INCOMPLETE MR. ROBERT A. STRYK HONEYWELL RESEARCH CENTER ************************* 10701 LYNDALE AVENUE SOUTH BLOOMINGTON MINNESOTA 55420 HONEYWELL H316 24 K WORDS (16 BITS) DISK (1.2 M WORDS) TERMINAL (ASR 33) LINE PRINTER 2 MAGNETIC TAPES (7 TRACK) PAPER TAPE READER PAPER TAPE PUNCH LINE CONTROLLERS (SYNCHRONOUS & ASYNCHRONOUS) REAL-TIME INTERFACE (ANALOG AND DIGITAL) DEMONSTRATION AND EVALUATION INCOMPLETE DR. MASAAKI SHIMASAKI INFORMATION SCIENCE DEPARTMENT KYOTO UNIVERSITY ************RSITY JOB-STREAM MANUAL 20 FEB 76 ********************* MACHINE MANUAL 20 FEB 76 440 SHATTO PLACE NOTES 20 FEB 76 LOS ANGELES CALIFORNIA 90020 DR. FRED M. IVES SOLO MANUALS 14 OCT 75 COMPUTER SCIENCE DEPARTMENT WESTERN WASHINGTON STATE COLLEGE ******************************** BELLINGHAM WASHINGTON 98225 MR. RAINER F. MCCOWN SOLO MANUALS 18 MAR 76 WESTINGHO**** SAKYO-KU, KYOTO 606 JAPAN HITAC 8350 64 K WORDS (32 BITS) DISK (7.25 M WORDS) CARD READER LINEPRINTER INCOMPLETE DR. N. SOLNTSEFF APPLIED MATHEMATICS MCMASTER UNIVERSITY ******************* HAMILTON ONTARIO L8S 4K1 CANADA HEWLETT PACKARD HP2100 16 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD RADER LINE PRINTER PAPER TAPE READER PAPER TAPE PUNCH OPERATING SYSTEM TEACHING AND RESEARCH INCOMPLETE CONTROL DATA CORPORATION CDC 6400 64 K WORDS (60 BITS) DISK CARD READER LINE PRINTER MAGNETIC TAPE PAPER AR 76 ONTARIO NOTES 31 MAR 76 CANADA N2L 3G1 DR. GARY R. SAGER SOLO MANUALS 31 DEC 75 COMPUTER SCIENCE DEPARTMENT SOLO COPY 31 DEC 75 UNIVERSITY OF WATERLOO SOLO FILES 31 DEC 75 ********************** WATERLOO ONTARIO CANADA N2L 3G1 DR. E. J. DESAUTELS SOLO MANUALS 8 OCT 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 8 OCT 7USE ELECTRIC CORPORATION SOLO FILES 18 MAR 76 ********************************* REAL-TIME MANUAL 18 MAR 76 9537 LONGLOOK LANE JOB-STREAM MANUAL 18 MAR 76 COLUMBIA MACHINE MANUAL 18 MAR 76 MARYLAND 21045 NOTES 18 MAR 76 DR. PAUL B. BROWN SOLO MANUALS 1 APR 76 PHYSIOLOGY & BIOPHYSICS DEPARTMENT REAL-TIME MANUAL 1 APR 76 WEST VIRGINIA5 UNIVERSITY OF WISCONSIN SOLO COPY 10 MAR 76 *********************** REAL-TIME MANUAL 10 MAR 76 1210 WEST DAYTON JOB-STREAM MANUAL 10 MAR 76 MADISON MACHINE MANUAL 10 MAR 76 WISCONSIN 53706 NOTES 10 MAR 76 DR. HENRY R. BAUER III SOLO MANUALS 23 SEP 75 COMPUTER SCIENCE DEPARTMENT SOLO FILES 23 SEP 75 UNI MEDICAL CENTER MACHINE MANUAL 1 APR 76 WEST VIRGINIA UNIVERSITY ************************ 450 MEDICAL CENTER DRIVE B-302 MORGENTOWN WEST VIRGINIA 26505 MR. BUTLER W. LAMPSON SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 DR. J. H. MORRIS SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 DR. BEN WVERSITY OF WYOMING REAL-TIME MANUAL 12 FEB 76 ********************* JOB-STREAM MANUAL 12 FEB 76 P. O. BOX 3682 MACHINE MANUAL 12 FEB 76 LARAMIE NOTES 12 FEB 76 WYOMING 82071 MR. RAY MCFARLAND SOLO MANUALS 30 MAR 76 MARYLAND PROCUREMENT OFFICE SOLO FILES 30 MAR 76 U.S. ARMY ********* 9800 SAVAGE ROAD FT. GEORGE G. MEADE MARYLAND EGBREIT SOLO MANUALS * SEP 75 XEROX RESEARCH CENTER ********************* 3180 PORTER DRIVE PALO ALTO CALIFORNIA 94304 MR. KENNETH YOUNG SOLO MANUALS 10 NOV 75 3311 WEST 3RD STREET SOLO FILES 8 DEC 75 APARTMENT 1-319 REAL-TIME MANUAL 2 FEB 76 LOS ANGELES JOB-STREAM MANUAL 2 FEB 76 CALIFORNIA 90020 MACHINE MANUAL 2 FEB20755 MR. WAYNE SCHMIDT, CHIEF SOLO MANUALS 8 JUN 76 COMPUTER SERVICES SOLO COPY 8 JUN 76 U.S. ARMY CONSTRUCTION ENGINEERING SOLO FILES 8 JUN 76 RESEARCH LABORATORY ********************************** P.O. BOX 4005 CHAMPAIGN ILLINOIS 61820 DR. RALPH LONDON SOLO MANUALS * SEP 75 USC INFORMATION SCIENCES INSTITUTE ********************************** 4676 ADMIRALTY WAY MARINA DEL REY CALIFORNIA 9029LAY (TEKTRONIX 4006-1) TEXAS INSTRUMENTS TI 735 SELF-STUDY INCOMPLETE  SYSTEM INCOMPLETE MR. RICHARD M. SMITH P.O. BOX 5882 RALEIGH, NORTH CAROLINA 27607 PDP 11 (LSI) 20 K WORDS (16 BITS) DISK (300 K WORDS) IMP-16 MICROPROCESSOR 32 K WORDS (16 BITS) DISK (300 K WORDS) DISPLAY LINE PRINTER HOBBY COMPUTING INCOMPLETE DR. ROGER L. COTTRELL STANFORD LINEAR ACCELERATOR CENTER STANFORD UNIVERSITY ******************* P.O. BOX 4349 STANFORD, CALIFORNIA 94305 PDP 11 (LSI) 16 K WORDS (16 BITS) CAMAC INTERFACE IBM 370/168 LINK REAL-TIME DATA ANALYSIS INCOMPLETE MR. VIC ST "$)+-/13579;=?*,.02468:<>(EGIKMOQSUWACFHJLNPRTV@BDacegikmoY[]_bdfhjlnXZ\^`}qsuwy{~prtvxz|     )+-/ENNING SYSTEMS DESIGNERS LTD. ********************** SYSTEMS HOUSE 57 - 61 HIGH STREET FRIMLEY, SURREY GU16 5HJ ENGLAND PRIME 300 40 K WORDS (16 BITS) DISK (7 M WORDS) LINE PRINTER PAPER TAPE TELETYPE PROCESS CONTROL DATA COMMUNICATIONS PLANNED BUT NOT STARTED DR. K.-P. LOEHR FORSCHUNGSGRUPPE BETRIEBSSYSTEME TECHNISCHE UNIVERSITAET BERLIN ****************************** ROOM 1905 ERNST REUTER PLATZ 7 1 BERLIN 10, GERMANY PDP 11/40 48 K WORDS (16 BITS) DISK (90 M WORDS) CARD READER (CR 11) LINE PRINTER (LP 11) CONSOLE (LA 36) DECTAPE 6 TERMINALS USED LOCALLY IBM 370/158 VIRTUAL STORE (32 BITS) VIRTUAL PERIPHERALS OPERATING SYSTEM EDUCATION INCOMPLETE DR. RAFAEL M. BONET TELESINCRO S.A. *************** INVESTIGACION Y DESARROLLO ROCAFORT 100 BARCELONA, SPAIN DATA GENERAL NOVA 840 80 K WORDS (16 BITS) DISK (2 * 1.2 M WORDS) LINE PRINTER CARD READER MAGNETIC TAPE TELETYPE 4 DISPLAYS BOOTSTRAP SYSTEM FOR THE TELESINCRO FACTOR F2 INCOMPLETE MR. GARY D. THOMAS 8236 RESEARCH BOULEVARD # 166 AUSTIN, TEXAS 78758 TEXAS INSTRUMENTS 990/10 32 K WORDS (16 BITS) DISK (1.2 M WORDS) LINE PRINTER (CENTRONICS) CARD READER DATA TERMINAL (SILENT 700 ASR) OPERATING SYSTEM EXPERIMENTS PASCAL PROGRAMMING INCOMPLETE MR. DENNIS HEIMBIGNER TRW SYSTEMS GROUP ***************** MAIL STATION R3/1072 1 SPACE PARK REDONDO BEACH CALIFORNIA 90278 NANODATA QM-1 10 K WORDS MICRO STORE (18 BITS) 60 K WORDS MAIN STORE (18 BITS) DISK (55 M BYTES) MAGNETIC TAPE (9 TRACK, 800 & 1600 BPI) PRINTER PLOTTER EXPERIMENTAL EVALUATION USED LOCALLY READY FOR DISTRIBUTION MR. M. VERGES TRIAS CENTRO DE CALCULO DE LA UNIVERSIDAD POLITECNICA *********************** AVDA. DR. GREGORIO MARANON BARCELONA 14, SPAIN FACOM 230/25 64 K WORDS (16 BITS) DISK (2.8 M WORDS) CARD READER LINE PRINTER TERMINAL MAGNETIC TAPE EDUCATIONAL INCOMPLETE DR. HARTMUT FICHTEL INFORMATION SCIENCE UNIVERSITY OF HAMBURG ********************* SCHLUETERSTRASSE 70 D-2 HAMBURG 13 GERMANY INTERDATA M85 32 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD READER LINE PRINTER TELETYPE PAPER TAPE READER PAPER TAPE PUNCH USED LOCALLY MR. H.D. PATOCK FACHBEREICH INFORMATIK UNIVERSITY OF KAISERSLAUTERN **************************** PFAFFENBERGSTRASSE 95 675 KAISERSLAUTERN GERMANY INTERDATA 7/32 40 K WORDS (32 BITS) DISK (2 * 2.5 M WORDS) INTERTAPE (M46-400) PAPER TAPE READER (M46-241) PRINTER (M46-205) DISPLAY (HP 2640 A) TELETYPE (ASR 33) INCOMPLETE DR. P. KAMMERER COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF KARLSRUHE *********************** KAISERSTRASSE 12 7500 KARLSRUHE GERMANY BURROUGHS B1726 128 K BYTES DISK (2 * 4.6 M BYTES) CARD READER PRINTER TAPE TELETYPE RESEARCH INCOMPLETE DR. JAMES W. CONKLIN SCHOOL OF DENTISTRY UNIVERSITY OF MICHIGAN ********************** ANN ARBOR, MICHIGAN 48104 PRIME 300 56 K WORDS (16 BITS) DISK (6 M WORDS) 4 TERMINALS LINE PRINTER MAGNETIC TAPE PASCAL PROGRAMMING READY FOR DISTRIBUTION PRIME 400 96 K WORDS (16 BITS) DISK (12 M WORDS) 28 TERMINALS PASCAL PROGRAMMING INCOMPLETE DR. JONATHAN GROSS SOCIAL SCIENCE RESEARCH CENTER UNIVERSITY OF MINNESOTA *********************** 25 BLEGEN HALL MINNEAPOLIS, MINNESOTA 55455 PDP 8E 32 K WORDS (12 BITS) DISK (3 M WORDS) CARD READER MAGNETIC TAPE (9 TRACK) PAPER TAPE READER PAPER TAPE PUNCH DISPLAY (TEKTRONIX 4015) PLOTTER (CALCOMP 563) DIGITIZING TABLE MODEMS (SYNCHRONOUS & ASYNCHRONOUS) EDUCATION INCOMPLETE DR. IAN JACKSON COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF SYDNEY ******************** SYDNEY 2006 AUSTRALIA CYBER 72 (VIRTUAL MACHINE) 24 K WORDS (60 BITS) DISK (ENOUGH) TERMINAL STUDENT PROJECT INCOMPLETE DR. MASARU WATANABE INSTITUTE OF INDUSTRIAL RESEARCH UNIVERSITY OF TOKYO ******************* 22-1 ROPPONGI, 7 CHOME MINATO-KU TOKYO 106, JAPAN FACOM U-200 32 K WORDS (16 BITS) DISK (2.5 M WORDS) CARD READER LINE PRINTER OPERATING SYSTEM STUDIES INCOMPLETE DR. HENRY R. BAUER, III COMPUTER SCIENCE DEPARTMENT UNIVERSITY OF WYOMING ********************* P.O. BOX 3682 LARAMIE, WYOMING 82071 TEXAS INSTRUMENTS 980A 16 K WORDS (16 BITS) DISK (2 FLOPPY AED DRIVES) DISPLAY (SILENT 700) CASETTE DRIVES EDUCATIONAL PROJECTS INCOMPLETE MR. ROBERT A. STILLMAN INSTRUMENT DIVISION VARIAN ASSOCIATES ***************** 611 HANSEN WAY PALO ALTO, CALIFORNIA 94303 VARIAN DATA MACHINES V73 32 K WORDS (16 BITS) DISK (5 M WORDS) LINE PRINTERS MAGNETIC TAPES PAPER TAPE PLOTTER REAL-TIME OPERATING SYSTEM INCOMPLETE (USED LOCALLY) DR. ANDREW S. TANENBAUM WISKUNDIG SEMINARIUM VRIJE UNIVERSITEIT ****************** BOX 7161 AMSTERDAM, THE NETHERLANDS PDP 11/45 108 K WORDS (16 BITS) DISK (40 M WORDTAPE READER CROSS COMPILER FOR THE HP 2100 INCOMPLETE MR. MICHAEL S. BALL CODE 2522 NAVAL UNDERSEA CENTER ********************* SAN DIEGO, CALIFORNIA 92132 INTERDATA 7/16 32 K WORDS (16 BITS) DISK (10 M WORDS) MAGNETIC TAPES DISPLAY SIGNAL PROCESSING EXECUTIVE INCOMPLETE MR. CHARLES RATTRAY 4 DIDCOT ROAD WOODHOUSE PARK WYTHENSHAWE MANCHESTER, ENGLAND PDP 11/40 48 K WORDS (16 BITS) DISK (10 M WORDS) LINE PRINTER MAGNETIC TAPE SOFTWARE CONSTRUCTION SYSTEM INCOMPLETE PROFESSOR DAVE R. ELAND COMPUS) CLOCK (KW11P) LINE PRINTER DECTAPE PAPER TAPE 30 TERMINALS INCOMPLETE MR. RAINER F. MCCOWN WESTINGHOUSE ELECTRIC CORPORATION ********************************* 9537 LONGLOOK LANE COLUMBIA MARYLAND 21045 DATA GENERAL NOVA 1200 32 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER DISPLAY MANETIC TAPE PAPER TAPE READER SYSTEM IMPLEMENTATION LANGUAGE INCOMPLETE MR. KENNETH YOUNG 3311 WEST 3RD STREET AAPARTMENT 1-319 LOS ANGELES CALIFORNIA 90020 IBM 370/140 128 K WORDS (32 BITS) DISK (3 M WORDS) DISPTER SCIENCE DEPARTMENT ORAL ROBERTS UNIVERSITY *********************** 7777 SOUTH LEWIS TULSA, OKLAHOMA 74105 DATA GENERAL NOVA 840 48 K WORDS (16 BITS) DISK (5 M WORDS) CARD READER LINE PRINTER MAGNETIC TAPE DISPLAY TELETYPE PAPER TAPE READER PAPER TAPE PUNCH COMPUTER SCIENCE COURSES INCOMPLETE DR. HIROSHI WADA SEIKEI UNIVERSITY ***************** KICHIJOJI KITAMACHI 3 MUSASHINO-SHI TOKYO 180, JAPAN FACOM 230/25 64 K WORDS (16 BITS) DISK (2.5 M WORDS) LINE PRINTER MAGNETIC TAPE DRUM TELETYPE TERMINALegikmoZ\^`bdfhjlnXuwy{}qsvxz|~prt     !#%')+-/"$&(*,. =?ACEG13579;>@BDF02468:<Y[]_IKMOQSUWZ\^HJLNPR2gikmoZ\^`bdfhjlnXuwy{}qsvxz|~prt     !#%')+-/"$&(*,. =?ACEG13579;>@BDF02468:<Y[]_IKMOQSUWZ\^HJLNPRT     !#%')+-/"$&(*,. =?ACEG13579;>@BDF02468:<Y[]_IKMOQSUWZ\^HJLNPRTVXuwacegikmoqsv`bdfhjlnprty{}z|~x      !#%')+-/"$&(*,. =?ACEG13579;>@BDF02468:<Y[]_IKMOQSUWZ\^HJLNPRTVXuwacegikmoqsv`bdfhjlnprty{}z|~x     /!#%')+- "$&(*,.3579;=?ACEG1468:<>@BDF02OQSUWY[]_IKMPRTVXZ\^HJLNkmoqsuwacegilnprtv`bdfhjy{}xz|~     !#%')+-/"$&(*,. =?ACEG13579;>@BDF02468:<Y[]_IKMOQSUWZ\^HJLNPRTVXuwacegikmoqsv`bdfhjlnprty{}z|~x     /!#%')+- "$&(*,.3579;=?ACEG1468:<>@BDF02OQSUWY[]_IKMPRTVXZ\^HJLNkmoqsuwacegilnprtv`bdfhjy{}xz|~