IMD 1.18: 5/11/2012 20:00:15 pascal mt+ tv 2 of 3                 AMD9511 CMD AMD9511XCMDAMDIO SRC APUSUB MAC ATWNB SRCdBCDREALSERLINDEXER PAS4IOCHK BLD\IOERR SRCZLIBMT COMzOPQRSTUVMTERRS TXT&LMNOVLMGR MACMefghiPINI SRC PPEXTS PASkTRAN9511SRC TRANCENDERLUTILMOD ERLUTILMOD SRC7WNC SRCXBDOS SRC[XREF COM)*+,-./0XREF COMI12345͢`a*@ V+%Ͱ. 6€9 +X!vB9X 6\,>osW40habX, pmʼz `l0 ͻ@w1@D U abX, po]@eR`æ@'0KXtB9X9ffICu|\6mL;ٵD#f`%REb2DuNb3sIF^d##+:'1F9LVH P`]n3#9L 0J²TVV6+%q\VKp\.H\.K@%p p@0\ . K%@ q\H.&K% rP,\.N_"*g ")G{@":*v #)G@"Iɬd`$PIɪ$tCALC SRC?@CHN MAC CPMRD SRCCWT MAC_DBUGHELPTXTADEBUGGERERLX89:;<=DIS8080 COMBCDEFGHIDIS8080 COMJKPPGLBLS PASjPPINIT PASBqrstuPPMOD1 PAS#vwxPPMOD2 PAS{|PPMOD3 PAS,nopPPTYPES PASlmPRETTY PASyzPUT SRCaXREF DOC6XREF SRCe"#$%&'([Et@6@6 ͩ`"XuD PK peKmY<REb[Et@@~+^a\@@VmN@m.m.Y<|fmKm˭!'rpOnc}@m.ٴ<F#j V͠Gv`L,@j,f԰!ACt Rmٴ<BY0+fD &"Gt"bv` '"FD*yɪd 'G{b u ) Gjb"t )&GybrRANDOMIOERL !REALIO ERLRNB SRCbcRNC SRCRST MAC]^STRIP CMDSTRIP SRC}~TRAN9511ERLDU(9J@GTRԠDtU(1J@RMLQ D%4(IZ@RNGPE5%HQIU9ROUND DYBp B3k(fPRf n@`#*+ٴ<|f( `+?3iͧ@ m.@QfH͡ ͧ 6 odRfh`l0 #U"(rͥͥ 6D PKmf԰K_ 52^n$j0W p:W#/2i#efVVVI#/2!5^b1xFVjeaYydDb2²TdZ-W+Ub\'mk>3o:͡rf԰!,\pO|f@1uC/ͩ`"rf԰i0uX@ˬBB2 ;!`Y'J@00>0 8DX@VhiY06riBP9Y4pFZ u{B 9YҰ"lflf&ܬJ+6i 2 :*ƀQ6r@ euT @'іi0VmMx   9D  êblf܀rkegXE d,/:ϣ-:`!ښiX!ֈ Q fpJqX^j@+6ZTCb2`'6V`+6qWGZ L7Y[D%s@D7@#+5D5\#+:#@d#+5Y CW2"]b2gіaprpX60P60P6( 1BaaV2rn@(9Y<B+9YXvAD%xD ~@ٵ"!cH H(QPxy jQ hR *hQhohi`hv Jqj8*~O?TRUNC WRTREA*ј@h jh)1x4 i185)ј8! ȪQHQp H(X Iy8grkxFVuOiSy8g``Vqf!@ a  3k 9EXH#+:n*@Q^Ҡ"a@[#9@!"1xFVjF^mTzNnɘ3nXE",DͺD[#9 COK29B2ĀH&Ϣ{U 2TB9Y}QWHU 2TU 2h@$PL@"fiB9D8,/5Z.["@ f-$*@1i XI!V 樇9YL i'x}P5#+:Z0B9Y4P7+6ihPa2FS X *" i74߰'(F:'1ɇUw(Ulfؐ e,;& JI 4p9Y9Y`uer@V*rP`fӰ"f0S4f ڒf0"VmW3h( 612Y"p6063l @+6ťkD eA F @ ;ʹ ,ͤ ` @ r@(!~fS6`a f`0f>,ç@< l͵`|Ͷ` l͠`X!3m |TrvxGc1*Ȁy/3ܬۨͽ@,ͼ`|͠@ |͡ "f:f@>f@@3n61!YUڄ@Vm'f@6VmJ3n@ť`X͡bdf`1f6mFji8(T EZV"ū* }EXͿ*@QVFr@ D2fPfm@Vmd (#9YEY! d`:diE",ͱ̘ͩbVmxH0%9D/n-+ !Y(jA0Cfif``Lf0 n9^oܢ8*3F#/ζe!Y-+V!,Hù"DbuNb39EX#+:29L::Ā`2,&n6DXMD8͠`h +60 8)1p()ё08.葓8 @( h((Jj`M H1(@iq( jj(mh誑:4 Q  Iq`ꪊ ԕPS Du$EP034fxFVuE#rlp6@mamamVhiQ !" :>; 4͠` b( eg[D2#ama`f C6f D2f0Fm@Vmf @>f@>fۀFm3j 6ٷXʹdfڰAfFm@Vm@QVDr\"+TE.ͯB-L*ǀ1<j`XS* *@Vmc +6F+6z0D@->Ҫ⬔@Vmx8dmdJrrCuPA0C+6rU1*ј@h jh)1x4 i185)ј8! ȪQHQp H(X IUPT%Bx9^@DSPQSPU`dd<PT` a 00` a 0b",X#+5D @8DXU-**@QV/Q`@TzN![#92f Jam,Y! 2TU'3Yťh 0(ef4OiSb&!@%Y!i] 1 j/β@Vmux!9D8!U 2TB9Y, Һ@bt"t^b,t*@QV:2d d BrqB9YCv2E eX!d:`/7O0J灊UڒiS1V>cV>/α>a1}c   `V>/QV:rl ťZ@X*@Ypg&c(eg[sX*@Ypg!V:2TUb2hDYC|b7(ЁeY*Ȁ TzNn*@QVDrh a6dru :*QSPUf"N#efHrh0ePrh(0#81р 1f  f`(E9D n6E7,#+:ZU9B9Y0U/7O0J F^b-*ЀQV~ri#ťKZEZ#+:Z`AZ*(D9D rEZ(*@Vm h(B:Y7w+6tUͨ¬@ ͇yY11fPW:8DYА DU(9J@GTRԠDtU(1J@RADРD$IZ@RNGPDQIU9ROUND Du$IMP@RSET05%#(IIa%RRRVALIU S$e*cGfuLF lR!4u X~ 3wVŬ*Xd#, /Ux6+`@;6΀4&#`& G:ٴ^2@3k r7?3s §`L: :ʀіTa^@GYP 8' `V`FX {o `p8x-BA+ +NJ$~ XVh| mP#U hjف?M2`G86+XX6tҶ`AB3k rgnæsp80s CiRAV`rF^mȋ0 C~ 2F#/VhiUPA 2/α#+:YC*,*7Ltl ")LG"hfVfr@+6ZV\D9͠`^b,!,!Qlr@@+6s@C͵`2@@Vm g 0}'}CEaEY*΀Qxri< >ң$*QVtrsH@YL7EVmVhgVtrI-+ *΀,*@VmpE іxavmg`(:9D9ͤ g0}n&3 #2 A12 TRc=9&3 TUc$q9V3 c"1MV3 Uc;UXͳ * !x ^@b6h b o 8)C8i'qn0XlZ° KU< g  u]lmb0+ 8Z,+CaFa\ ͷ@H AX-8lWlJ:ڮ2CGpج ¿ |e00$# pmsb eT8S\0'!`m!bb 0m['nx,FXF~ V :i['0<#ոV 'egnæ842ʠ5y<2`G'6aV0$Y V eY07p+vU nµ@c6` Aqa0=hYT$j8ò`c >,(Cw@`d#+:7YF#/QVfr@J@ 90`(5`5egX50 69EY9Bf[#9 pFf`[#9l F`Q#+5EYuNb359D }-* !QVnuNb39D sdH"π~p6 B9Yҵ@ Frg(uNl; !VmQZ2tSQ#)@YMeM563Fє#: I22 Q#.5=Y1p іxavmg`(:9D9ͤ g0}n&3 #2 A12 TRc=9&3 TUc$q9V3 c"1MV3 Uc;U8XTI@GXPmV@$'pNwXUh#hXUF8s< 8]O' %n /a[!`H+alVa[ yݢ!ƀ`H+alVa\R 01^w `VX|e@&#@msa8(,YD &5ui)?*j@R`Jj R+8%da 9|E(b@@fH@`x gK2A@m, dD/gbA@m, d@ˬB_ 6(fH `e`,3m8 B8$ 3i`H+:@f+@ˬC 6A@" N!{?/ X!{?/Z X*" ,"," |[    >^o 2 ͺWXfF . : 6p8j2 e@"s@2\",!. X!/mce(2:\",!' f0: v]fff fs6m lX(,ݐ*y/7Y`0=hI`%hCNk84ͮ0k A@U,W),H@ @ apL& /;D ldDYT 2r anZB _"p6у݅x U@"* @3m8@-Whx"-ʹ`e^ q[;DZhZnʼ@a]vp6уݕvY Iq@x JFQհR JhQ`av Jh1Ќgw k*i)`h *ȑ8h誑`ZjJFQހ JK *@Z8i 1x+QQ0 Q00 ɑޠx H(Qhl Hh{TION OF THE 9511 *) (*----------------------------------------------------------*) PROCEDURE @O95D; (* OUTPUT A-REG TO 9511 DATA PORT *) BEGIN INLINE("OUT / $88) (* CHANGE TO YOUR 9511 DATA PORT NUMBER *) END; PROCEDURE @O95C; (* OUTPUT A-REG T`y<jJH2h@` WL,!.(ͥ"Pre`H ofrö`3IE #+@ˬ 3i`HEYX,/g XH `e`9upHf(9/rsa$U.Vfאfmȫ+:\",ͯ zé VfאfmaԐg+3k36ȀH0n¼@;hmh*݅vwj0P']U "FP fʲf  V!GEU "OmU V!:i[І(A ;*P/Vhòa ¹rO.G_U ;ܢ|fܠUpaݰ(GARfije^X@ýAMODULE AMDIOROUTINE; (*----------------------------------------------------------*) (* THIS MODULE CONTAINS TWO "ASSEMBLY" LANGUAGE SUBROUTINES *) (* WHICH ARE CALLED FROM THE FPRTNS MODULE AND IF LOADED *) (* THE TRAN9511 MODULE. *) (* O 9511 CONTROL PORT *) BEGIN INLINE("OUT / $89) (* CHANGE TO YOUR 9511 CTRL PORT NUMBER *) END; PROCEDURE @I95D; (* INPUT A-REG FROM 9511 DATA PORT *) BEGIN INLINE("IN / $88) (* CHANGE TO YOUR 9511 DATA PORT (SAME AS @O95D) *) END; PROCEDUR dDu\",h,y?Vd|fpl< $03¹۞wa]fm  ; ;6灄L9?-TOt T9#_!P6A G43j4JA6qg?T^Y-aT p! uʪq]A*:πk j0$ ulp%b@Iv>.2 p \.K%`p q@\j.6K%Ƞ` rL\.U+K%@@ s0\.}?K% 0 u]Lzi 1x+QQ0 Q00 ɑޠx H(Qhl Hh{ *) (* THESE ROUTINES ARE SPECIFIC TO PASCAL/MT+ AND PASS *) (* PARAMETERS BACK AND FORTH THROUGH REGISTERS *) (* *) (* THE USER SHOULD CHANGE THE PORT NUMBERS AS NECESSARY *) (* FOR THEIR PARTICULAR HARDWARE IMPLEMENTAE @I95C; (* INPUT A-REG FROM 9511 CONTROL PORT *) BEGIN INLINE("IN / $89) (* CHANGE TO YOUR 9511 CTRL PORT (SAME AS @O95C) *) END; MODEND.    ԑPQPeE8II2*a 0LA8!"3@fm Vm'fҠh! 2"8BTB9YťZ4#+:, e!.Qp5P#+:, e!!`y}c k/ΰ γc0+4f>+!`Y!@Y%Y6uFZ yD8!Vm@Vm1Vmf@mfp`hEnVE4\"7+UEZ(Ub-$|Z(:Z(2f0&mpEB"hf CA@ܬͥaB 9L&`r< &s :f C~pg&ù@Bh`+6ĀO-ɘ d< () XQ*@Vm3o3@hcV(r@V(r@c˕3@ DfTb+6Xͧ` Dͨ` h$ ͪ` D!ڮfPmab dA"p6063l @+6ťkD eA F @ ;ʹ ,ͤ ` @ r@(RB9Y ͳ/fذ03l3@BaӠFmc`mf0f>f`06f0E Y;`L۪͹@`|ͻ@` |ͼa#1d@|nVmfޠmf`0f>f @>fЀ@@3@J3hp 3h H\ HUb,*@VmBJ +6ip @+6 Ұ d`VVjE#rYEXF"ǀP+jՕgX;ࢬdfQd (#9Yrh(36J +6 U"@Vmhp02c]I2b ͧnHpP6Ƃ2`6@BY ҽ ¬Vmx0dmdJrrCuu08DX(h8xFVu4 P60`9D ; 4͠` b( eg[D2#ama`f C6*!,xï"2ǀx&n6O,ͨ#&ϣ,HͿ fٰfTb@0fJm*3mH X`=Mͷ hͻ ̨͡0@ 6262@62@63`m 62B9Y4Ҹ"hVhf`qr@ͮ`"^a2>@D (@rjh ťbZ L7D i^-*h!`y!iS!6u@˔CVpuXCڰ!Vm_h0f֐mlVmp"f܀ ^/ΰu@X^ 0P4f` f > @ P@ \hiW "Vh*Vhͦ ->Ү#`Haڰ"VmQ`+63j3k}QVUb,ï"tBL"*p`6@ (9Z.[" f-D*1.jD+6iHrj3i @+6 ҽB f!VrmZrmP6ցJ +6 ͼ,ۈ @@(9Y$Uۦ*VmVmf@! Dfް!V/QrB@3mrpEU 2TB9Yť[X#+:X]@ P E YUc +6 #{Av-˕AAY BQ9Y<T@[@VYͻ (mf Pf>aQV2rj (9Y,BE9Y|XD%ZAEY!i_ QV2rl(9YB-9YjD%lEY/7q!009Y U۞ !۬ ͻ ͼͿ lf\ &"F $e ))Fbbjdd )"+Fl eT ,'F^Ae &! TJed !![DdX ('F]dd)*!ӕ%AV` a 001(; >rpH &x ;bTkqC$Pqz 8ꑲ86TKxkd@"z (\rmťJw\ D@ͥ`@!YC'і$b@0fJ PB9YүLfVjrh63k 310`rk!`au{B0Ҧpf bf@ S6″n 6305YC'і$a`&mf`memem 2f# ͻ@mf   $ Q f'Jx68O,H!Yu{B+9YťLٴ0}b@Qb@0@Vmx>`68O,H:Ā`͡g`(r@$ {JI;D2"Vmx&g`m pFXT@Y! ںi[1Vvrh63`灳mH6߁3`g ,'F{"jz,ԕDU(9J@GTRԠDtU(1J@RMLQ D%4(IZ@RNGPE5%HQIU9ROUND%Xg3l }Z0X8DXa-ѕZu" hVeVsp68Z'ջʵ0E>U\",Ͱn` FUsQVt@ n|Y2ťK'Y}K,VåDҠ-Un{A>Ox8 d,9BË62Aw5_@*\!ŀ ::ŀ 6Gcmd1{ ,f7PޢfVdaV.>MZ_[0n@Gj0(ڽL+zJ`*W< ^?za>g>E >o|*=,lhEVmf0m 8\/,iPQj"#E*QV,r,?ٶlz?dwdZ'1t@@6\.4X= * ͮì Ͱrͽ l TU, 9|B59ZVhf(l(d#+:6@[ Ahx51|XcIF^63`61А 1 f`8DXcEXx,/5D -+!XB9YX ͠L!,X!,T͡ orE`+6ZU,CHE@ BAbXL7D"L-*͡ $͸l* v,u{DTP`acB9YTa`aڠa@Fa 6mf0mdm63n%ot,|ʹLۦh\",Xb8DXtX"\b+(ͯ~w ;zh¡/V0fFxP 0 6Ɓ$X"`~`Xrb^`@"Xͷ /C ԀUhyU06VTB\{ (10W9 g6mVd@ (r@<1,aӠ5 e-,\!v, h@,bbB Uͩo D|dqhxVVށ9^bpzuŕv</ug!Fqdw@ W0+w n~z5<9jd#F#/QX+/5XIF^dBk#+:b2²UpeY+e pZVdL,6"@4X!~?/m`@(9EXi02DuNb3sIF^d##+:'1F9LVH P`]n3#9L 0J²TVV6+%q\VKp\.L\.-+:ŀ`}r| nAw, tAC@Vhͻ@ \ͽ f@FhiQQ}a@іa@0tZjdgl ()Fyb$e\ "}r*Lf  #$Ub:*Lf &"@b*f '"F`" $e ))Fu"jdf )"+FA"r<XU4  J$Bì3.8 ްeWmO+%*ڀ\\y vsքw`C3#9j#%<-ߗGàِdXF^ˎ=^"pxvI>G<\/Y4 ͫo*=AޠV }aP` hޠsYU|b-+*UFFFJ+s Ǐ~ʧq8FV<++ <^d*` |/g {8OxbWFåD<l:.*,X*@,\qG0 8!v~ `id& aW@FHkfKbX:ܬbp)fQpEb,dr@ q,,\ͽ ,!?DXB+p6c,v*ŀ,h*K% qH\V.,K% q\f.4K% q\v.<K#EJ3(TJ:D 1J:nԣ05Y2:"TI ;Q#@IZ;S#I9;Уa=B: TS#MEIR:z USJ:D 1J:nԣ0AMDIO FPRTNS REALIO TRAN9511 AMDIO SRC FPREALS ERL< AMD9511 $$$   RNED.} FUNCTION SIN(ARG:REAL):REAL; {SINE FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($02,ARG,STATUS); SIN:=ARG; END; FUNCTION COS(ARG:REAL):REAL; {COSINE FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($03,ARG,STATUS); COS:=ARG; END; FUNCTI; ARCTAN:=ARG; END; MODEND.  LN:=ARG; END; FUNCTION ARCTAN(ARG:REAL):REAL; {INVERSE TANGENT FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($07,ARG,STATUS) ;---------------------------------------------------------------; ; ; ; 9511 SUBROUTINES FOR TRAN9511 ; ; ; ;---------------------------------------------------------------; PUBLIC @AMD EXTRN @I95D ;DATA PORT INPUT EXTRN @O95TURN STATUS IN A-REG MOV M,A ;STORE APU STATUS INX H MVI M,0 ;ZERO HIGH BYTE LHLD RETADR PCHL ;---------------------------------------------------------------; ; ; ; 9511 UTILITY ROUTINES ; ; NOTE THESE CALL @IN95 AND @OUT95 IMODULE TRAN9511; EXTERNAL PROCEDURE @ERR(AN_ERROR:BOOLEAN; ERRNUM:INTEGER); EXTERNAL PROCEDURE @AMD(FUNC:INTEGER;VAR ARG:REAL;VAR STATUS:INTEGER); {THE PROCEDURE @AMD,INTERFACES TO THE AMD9511 ARITHMETIC PROCESSING UNIT (APU). THE FIRST ARGUMENT ON EXP(ARG:REAL):REAL; {E TO THE X FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($0A,ARG,STATUS); IF (STATUS & $1E) = $18 THEN BEGIN @ERR(TRUE,7); (* TRANCENDENTAL OUT OF RANGE *) END; EXP:=ARG; END; FUNCTION LN(ARG:REAL):REAL; {NATURAL LOGARID ;DATA PORT OUTPUT EXTRN @I95C ;CTRL PORT INPUT EXTRN @O95C ;CTRL PORT OUTPUT ; PROCEDURE @AMD(FUNC:INTEGER; VAR R:REAL; VAR STAT:INTEGER); @AMD: POP H ;RET ADR SHLD RETADR POP H ;ADDR OF APU STAT POP D ;ADDR OF REAL POP B ;FUNCTION N AMDIO ; ; ; ;---------------------------------------------------------------; PSHD: INX D INX D INX D MVI B,4 PSD10: LDAX D CALL APUWS DCX D DCR B JNZ PSD10 INX D RET APULOOP: PUSH PSW APUX2A: CALL @I95IS THE FUNCTION CODE (AND IS STRAIGHT FROM THE AM9511 LITERATURE). THE SECOND IS THE ADDRESS OF ARG, A REAL VARIABLE, THE FUNTION ARGUMENT IS IN ARG, AND THE RESULT IS RETURNED IN ARG. THE THIRD ARGUMENT IS THE ADDRESS WHERE THE APU STATUS IS RETUTHM FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($09,ARG,STATUS); IF (STATUS & $1E) = $8 THEN BEGIN @ERR(TRUE,7); END; LN:=ARG; END; FUNCTION ARCTAN(ARG:REAL):REAL; {INVERSE TANGENT FUNCTION} VAR STATUS:INTEGER; BEGIN @AMD($07,ARG,STATUS) ; ROUTINE FOR FLOATING POINT DERIVED FUNCTIONS ; ENTER WITH: ; BC = COMMAND ; M(DE) = FUNCTION( M(DE) ) ; M(HL) = APU STAT PUSH B CALL PSHD ;PUSH ARGUMENT POP B MOV A,C ;ISSUE COMMAND CALL APUCS CALL POPSTAT ;GET DATA AND REC ORA A JM APUX2A POP PSW RET APURS: CALL APULOOP CALL @I95D RET APUCS: CALL APULOOP CALL @O95C RET APUWS: CALL APULOOP CALL @O95D RET POPSTAT: PUSH D MVI B,4 PPS10: CALL APURS STAX D INX D DCR B JNZ PP   S10 POP D RDSTAT: CALL @I95C ORA A JM RDSTAT RET DSEG RETADR: DS 2 END  APUWS: CALL APULOOP CALL @O95D RET POPSTAT: PUSH D MVI B,4 PPS10: CALL APURS STAX D INX D DCR B JNZ PP (&"Ff"r*Lf ))Fd@*"ze8&"I2 J:tTURNS NAME FROM AN FILE *) (* FUNCTION KEYPRESSED : BOOLEAN; TRUE IF KEY P"@"tA:*¢ C@"-m`mm@(k9D%2c -eAINb!ͫ 'іm0tZ"eDI@|"ͣ` 63jPF6 & mC XT&z@(r@V @(9D N!pC"@"tA:*¢ C@"-m`mm@(k9D%2c -eAINb!ͫ 'іm0tZ"e3m33m3nQ Imwf܀f>f$(!9Y<Ub7Fw(rm ťBD B9YtCAD@FBxARCTAN3nh62p6@('9D9Hͼ L | Ȁ ڈȀ ڔdHbd (&"F~"*Le@ ,'FB@b*d NTTP   AMDIO FPRTNS P OF RECURSION STACK *) @EFL : ^INTEGER; (* USED BY FULLHEAP *) @FRL : RECORD LINK : ^INTEGER; SIZE : INTEGER END; (* USED ALSO BY FULLHEAP *) INPUT, OUTPUT: FIB; (* DEFAULT CONSOLE FILES *) @TFN: STRING[2]; (* FSYSMEM) + 2; (* SO SYSMEM POINTS TO FREE AREA *) @SFP := GETSP - HW_STACK_SIZE; @TFN := '00'; WITH INPUT DO BEGIN IOSIZE := 1; BUFLEN := 1; OPTION := FCONIO; FTEXT := TRUE; FBUFFER[0] := ' '; FBUFADROR TEMP. FILE NAMES *) @SYSIN, @SYSOU: INTEGER; (* I/O VECTORS *) @RNC, @WNC: EXTERNAL INTEGER; (* REALLY SUBROUTINES BUT JUST *) (* NEED THESE TO GET THEIR ADDRESSES *) (*$E-*) (* HIDE GETSP *) FUNCTION GETSP:INTEGER; VAR := WRD(ADDR(INPUT.FBUFFER)) END; WITH OUTPUT DO BEGIN IOSIZE := 1; BUFLEN := 1; OPTION := FCONIO; FTEXT := TRUE; FBUFFER[0] := ' '; FBUFADR := WRD(ADDR(OUTPUT.FBUFFER)) END; @SYSIN := ADDRMODULE CPMREADCONSOLE; (*$M @CPMRD*) (*$M **) TYPE IOBUF = RECORD MAXLEN : BYTE; RETLEN : BYTE; IOBUF : ARRAY [0..254] OF CHAR END; EXTERNAL FUNCTION @BDOS(FUNC,PARM:INTEGER):INTEGER; PROCEDURE @CPMRD(VAR BUF:IOBUF); VMODULE INITIALIZE; CONST HW_STACK_SIZE = 128; (* NUMBER OF BYTES RESERVED FOR HARDWARE STACK *) (* CHANGE IS HEAVY RECURSION IS USED *) (*$I FIBDEF.LIB*) VAR SYSMEM : EXTERNAL INTEGER; (* TOP OF HEAP *) @SFP : EXTERNAL INTEGER; (* TO TEMPINT: INTEGER; (* FOR CAPTURING STACK POINTER *) BEGIN INLINE("LXI H / 0 / 0 / "DAD SP / "SHLD / TEMPINT); GETSP := TEMPINT END; (*$E+*) PROCEDURE @INI; BEGIN @FRL.LINK := NIL; @FRL.SIZE := 0; @EFL := NIL; SYSMEM := ADDR((@RNC); @SYSOU := ADDR(@WNC) END; MODEND. CONIO; FTEXT := TRUE; FBUFFER[0] := ' '; FBUFADR := WRD(ADDR(OUTPUT.FBUFFER)) END; @SYSIN := ADDRAR RESULT : INTEGER; BEGIN RESULT := @BDOS(10,ADDR(BUF)) END; MODEND.  : ARRAY [0..254] OF CHAR END; EXTERNAL FUNCTION @BDOS(FUNC,PARM:INTEGER):INTEGER; PROCEDURE @CPMRD(VAR BUF:IOBUF); V   MODULE HALTMODULE; (* AN EQUIVALENT MODULE TO THE @HLT IN PASLIB *) (* USEFUL FOR ROM-BASED APPLICATIONS IN WHICH PROGRAM TERMINATION IS *) (* USED *) PROCEDURE @HLT; BEGIN INLINE("JMP / 0 / 0) END; MODEND.  (* IF CONSOLE/TERMINAL FILE *) BEGIN GET(@LFB^,@LFB^.BUFLEN); @RNC := @LFB^.FBUFFER[0] END ELSE BEGIN @RNC := @LFB^.FBUFFER[0]; (* @RNC := F^ *) GET(@LFB^,@LFB^.BUFLEN); (* GET(F) *)  END END; MODEND.  BEGIN @RNC := @LFB^.FBUFFER[0]; (* @RNC := F^ *) GET(@LFB^,@LFB^.BUFLEN); (* GET(F) *) MODULE RDNXCH; (*$M @RNC*) (*$M **) (*$I FIBDEF.LIB*) VAR @LFB: EXTERNAL ^FIB; EXTERNAL PROCEDURE GET(VAR F:FIB; SZ:INTEGER); FUNCTION @RNC:CHAR; BEGIN IF @LFB^.OPTION > FRANDOM THEN (* DON'T GIVE BUFFER, BUT READ DIRECTLY *)     WORD; (* POINTER TO FBUFFER *) FSECINX: 0..128; (* INDEX INTO FSECTOR +1 FOR OVERFLOW *) FTEXT : BOOLEAN; (* TRUE IF THIS IS A TEXT FILE! *) NOSECTRS:BOOLEAN; (* TRUE IF NO MORE DISK DATA AVAILABLE *) FSECTOR: PACKED ARRAY [0..127] OF CHAR; (* 1MODULE WRNXCH; (*$M @WNC*) (*$M **) (*$I FIBDEF.LIB*) VAR @LFB: EXTERNAL ^FIB; EXTERNAL PROCEDURE PUT(VAR F:FIB; SZ:INTEGER); PROCEDURE @WNC(CH:CHAR); BEGIN @LFB^.FBUFFER[0] := CH; (* F^ := CH *) PUT(@LFB^,@LFB^.BUFLEN) (* PUT( (* FIB LAYOUT *) TYPE OPTTYPE = (NOTOPEN,FWRITE,FRDWR,FRANDOM,FCONIO,FTRMIO,FLSTOUT); FIB=RECORD FNAME : STRING[16]; (* d:filename.ext *) FCB : PACKED ARRAY [0..34] OF CHAR; (* CP/M FILE CONTROL BLOCK *) BUFLEN : INTEGER; (* SI SECTOR BUFFER FOR CP/M *) FBUFFER: PACKED ARRAY [0..0 ] OF CHAR; END;  IS A TEXT FILE! *) NOSECTRS:BOOLEAN; (* TRUE IF NO MORE DISK DATA AVAILABLE *) FSECTOR: PACKED ARRAY [0..127] OF CHAR; (* 1F) *) END; MODEND. ; SZ:INTEGER); PROCEDURE @WNC(CH:CHAR); BEGIN @LFB^.FBUFFER[0] := CH; (* F^ := CH *) PUT(@LFB^,@LFB^.BUFLEN) (* PUT(ZE OF FBUFFER *) BUFIDX : INTEGER; (* CURRENT INDEX INTO FBUFFER *) OPTION : OPTTYPE; IOSIZE : INTEGER; (* SIZE OF NEXT TRANSFER *) FEOLN : BOOLEAN; (* TRUE IF TEXT FILE AT END-OF-LINE *) FEOF : BOOLEAN; (* TRUE IF AT END-OF-FILE *) FBUFADR:   E IS ACTUALLY EXECUTED AT 80H+SYSBASE ; THIS ALLOWS THIS ROUTINE TO RESIDE ANYWHERE AND ; BE MOVED TO 80H+SYSBASE JUST BEFORE EXECUTION THIS ROUTINE ALSO ; NOW USES THE DEFAULT FILE CONTROL BLOCK. ; INCLUDE BCONFIG.LIB IF TRS80 SYSBASE SET 420; NOTE: THIS CODE ACTUALLY IS MOVED TO 80H+SYSBASE ; PRIOR TO EXECUTION ; RTPCHN1: POP D ;GET ADDR OF I/O BUFFER PUSH D ;SAVE IT AGAIN MVI C,26 ;SETDMA CALL TO BDOS CALL BDOS ; POP H ;NOW BUMP IT BY 128 LXI D,128 ; DAD D ; 7]; RWFILE = (RESETT,REWRITTE); FYLE = FILE; SUM_TYPE = (SHORT,LONG); VAR FIN : TEXT; FOUT : TEXT; NAME : FILENAME; STR : STRING; I : INTEGER; CPMCMDBUF : ABSOLUTE[$80] PACKED ARRAY [0..CPMLINESZ] OF CHAR; CPMSTR : STRING[CPM } { Inputs: File,whether to reset or rewrite, and name of file. } { Outputs: File open for reading or writing. True if successful,} { false if not successful. } { Last Mod: 0H ELSE SYSBASE SET 0 ENDIF @CHN:: RTPCHAIN: POP H POP D ;GET FCB ADDRESS LXI B,33 LXI H,5CH+SYSBASE PUSH H PUSH D PUSH B CALL @MVL## ;MOVE FCB TO DEFAULT AREA IF TRS80 LXI SP,4300H ELSE LXI SP,100H ENDIF LPUSH H ;SAVE IT AGAIN LXI D,5CH+SYSBASE ;GET FCB ADDRESS MVI C,20 ;REQUEST A READ CALL BDOS ; CPI 1 ;END OF FILE? JNZ 80H+SYSBASE ;(RTPCHN1) RELOCATED POP H ;WHEN DONE FLUSH THE STACK JMP 100H+SYSBASE ;AND OFF TO THE NEWLY LOADED PROGRPROGRAM INDEXIT; {-------------------------------------------------------} {Purpose : Find procedure and function declarations and} { output them in alphabetical order to a file } {Inputs : File to be indexed. } {OLINESZ]; PROGFLG : BOOLEAN; SUMMARY : SUM_TYPE; EXTERNAL FUNCTION KEYPRESSED:BOOLEAN; EXTERNAL PROCEDURE @HLT; PROCEDURE ABORT; BEGIN WRITELN; WRITELN('Pascal/MT+ Program Index utility aborted from console'); @HLT END; FUNCTION } {---------------------------------------------------------------} BEGIN ASSIGN(F,NAME); IF RW = RESETT THEN RESET(F) ELSE REWRITE(F); IF IORESULT = 255 THEN DOFILE := FALSE ELSE DOFILE := TRUE; END; ;----------------------------------------------------------------; ; ; ; MODULE - @CHN ; ; LAST UPDATE: AUG 15, 1980 ; ; ; ;----------------------------------------------------------------; ; ; NOTE: THE BODY OF THIS ROUTINXI H,100H+SYSBASE PUSH H ;SAVE READ-IN LOCATION (ON THE NEW STACK) ; ; NOW MOVE THE REAL WORKHORSE ROUTINE TO 80H ; LXI D,RTPCHN1 LXI H,80H LXI B,RTNLEN PUSH H PUSH D PUSH B CALL @MVL## JMP 80H+SYSBASE ;AND GO FINISH IT OFF ; AM RTNLEN EQU $-RTPCHN1 END JNZ 80H+SYSBASE ;(RTPCHN1) RELOCATED POP H ;WHEN DONE FLUSH THE STACK JMP 100H+SYSBASE ;AND OFF TO THE NEWLY LOADED PROGRutputs : File of procedures and functions } {CREATED : Jan 31, 1981 NJL } {-------------------------------------------------------} CONST CPMLINESZ = 127; TYPE STRNG=STRING[20]; FILENAME = STRING[12 DOFILE(VAR F : TEXT;RW : RWFILE; NAME : FILENAME) : BOOLEAN; {---------------------------------------------------------------} { Purpose: Attempt to reset or rewrite the given file. Check } { IORESULT.  PROCEDURE GETNAME(VAR OUTSTR : FILENAME); {---------------------------------------------------------------} { Purpose: Read a name from the keyboard, return in STR. } { Inputs: CPMCMDBUF. } { Outputs   : STR contains name of file if it was given to start. } { Last Mod: 11/23/80 } {---------------------------------------------------------------} BEGIN OUTSTR := ''; WHILE (LENGTH(STR) <> 0) AND (STR[1] <----------------------------------------} { Purpose: Return true if the string KEYWORD } { the first string on the input line STR. If it is } { not first or is not present return false. } { Inputs: K PROCEDURE TRANSFER(VAR STR : STRING); {---------------------------------------------------------------} { Purpose: Transfer lines from FIN to FOUT until the next proc/ } { func or begin is encountered. } { Inputs: STR (FOUT,TSTRING); IF SUMMARY = LONG THEN REPEAT READLN(FIN,TSTRING); WRITE('.'); IF KEYPRESSED THEN ABORT; SHORTSTR := TSTRING; IF (PRESENT('BEGIN',SHORTSTR)) THEN DONE := TRUE ELSE BEGIN I WHILE NOT EOF(FIN) DO BEGIN IF PRESENT('PROCEDURE',STR) THEN TRANSFER(STR) ELSE IF PRESENT('FUNCTION',STR) THEN TRANSFER(STR); READLN(FIN,STR); WRITE('.'); IF KEYPRESSED THEN E); IF DOFILE(FOUT,REWRITTE,NAME) THEN BEGIN GETNAME(NAME); WRITELN('Summary form: ',NAME); IF NAME[1] IN ['L','l'] THEN SUMMARY := LONG ELSE SUMMARY := SHORT; READLN(FI> ' ') DO BEGIN OUTSTR := CONCAT(OUTSTR,STR[1]); DELETE(STR,1,1) END; IF LENGTH(STR) <> 0 THEN DELETE(STR,1,1); (* DELETE NEXT BLANK *) END; FUNCTION STRIPBLNKS(S : STRING):INTEGER; VAR I : INTEGER; BEGEYWORD,STR. } { Outputs: Function return value of true or false. n} { Last Mod: 11/23/80 } {---------------------------------------------------------------} contains the line with the PROC, FUNC or PROG def} { FIN provides the text. } { Outputs: STR contains the line containing a PROC, FUNC def or } { a begin. FOUT contains new text. } { LF (PRESENT('FUNCTION',SHORTSTR)) OR (PRESENT('PROCEDURE',SHORTSTR)) THEN BEGIN WRITELN(FOUT); WRITELN(FOUT); END; WRITELN(FOUT,TSTRING) END UNTIL ( EOF(FIN)) OR (DONE); IF S ABORT; END; END; BEGIN MOVE(CPMCMDBUF,STR,CPMLINESZ + 1); (* COPY COMMAND TAIL *) IF LENGTH(STR) <> 0 THEN DELETE(STR,1,1); (* STRIP CP/M'S LEADING BLANK *) WRITELN('Pascal/MT+ Program Index UtiliN,STR); WRITE('.'); TRANSFER(STR); DOINDEX; CLOSE(FOUT,I); WRITELN('Pascal/MT+ Program Index utility processing complete'); END ELSE WRITELN('Cannot create ',NAME) END ELSE WRIN STRIPBLNKS := 0; I := 1; WHILE (S[I] = ' ') AND (I <= LENGTH(S)) DO I := I + 1; IF I > LENGTH(S) THEN STRIPBLNKS := 0 ELSE STRIPBLNKS := I; END; FUNCTION PRESENT(KEYWORD,STR : STRING):BOOLEAN; {-----------------------VAR FIRSTCH : INTEGER; BEGIN FIRSTCH := STRIPBLNKS(STR); IF FIRSTCH <> 0 THEN BEGIN IF POS(KEYWORD,STR) = FIRSTCH THEN PRESENT := TRUE ELSE PRESENT := FALSE END ELSE PRESENT := FALSE; END; ast Mod: 11/23/80 } {---------------------------------------------------------------} VAR SHORTSTR : STRING[25]; DONE : BOOLEAN; TSTRING : STRING; BEGIN DONE := FALSE; TSTRING := STR; WRITELNUMMARY = SHORT THEN BEGIN READLN(FIN,TSTRING); WRITE('.') END; IF KEYPRESSED THEN ABORT; STR := TSTRING; WRITELN(FOUT); WRITELN(FOUT); END; PROCEDURE DOINDEX; VAR I : INTEGER; STR : STRING; BEGIN ty -- Release 5.2'); WRITELN('Copyright (c) 1981 by MT MicroSYSTEMS'); WRITELN; GETNAME(NAME); WRITELN('Reading text from: ',NAME); IF DOFILE(FIN,RESETT,NAME) THEN BEGIN GETNAME(NAME); WRITELN('Output directed to: ',NAMITELN('Cannot open ',NAME); END. EEEAM NE{sbn0N>2 [ŊG   TSeE&`3@ff À ,f 8 F<.m)bm fn@m:bm7fP^}3j6163jIXXW$}mPLͮ @ͮ` $OFm~fؠ fpm  63l3l6ԀQiB9YͷD$H@@RSBD$ΰ @RDVD$x@XOPVӑSA06` 3@3@f f ( : Āͤ`m-bV>-U^g>1,b(r@JՀ `B9Yť^61@9D 8DX]@bͲH*ŀQf(U@%k*@Vmf ffְ f  fАmUfp faЀ6m`m 4f'J3l3l68DXHi(Uhfm`m 9Yr8v8x(B@\ yBٷ$H\֌  d]be (&"Fi@"*Le@ '"@*f0Prj! Y ȄrjH!HY60pj@ +6ұ,@ ͯ ü, @ͱ mBxVfp(fff fۀ&b͡ | 4͸#P\jf8f@m 4f8fm #s63o3o6 DBGR͢,8 2ͤ!#f@m0cm-fӰ~3i 616@ +60WAX@Z@BEXP3n6t #)Fp $eL ))F`jdg )"+Fjr 9@ͥ 8ͤ` h7.&hͧ 8ͧ@ ڐz46mEffm\ C63k(3k6ʥR[@B9YͰ " ͳʹ ʹFLt LA4k@(E o Ҡ,ې@ ۦAm`m 4f fh;ç 6̀,{dB9Yͫ ,` ;Ͷ! $@Vm`m3m 63i@ 60p60p6򀄀,{ehp 606i(HK@xJY (Ɏ$ 6̀3jp33m6,@ Am`m 63@mfC63l60P60P6,{es-*ͨ`! $f  fmfՠfaPmf`mo Y 6jX ťfYaAm@Y@$dL2@ h͠ ʹ Ͷ Ͷ!FLt$BoAn$ZLۚ@    ͺ m$f0m1ff.@Vmbm3kro3h8)iYC@EG@ @PSTH @GTRD$H@RSBD$ @RDVր$x@XOP$TI9 rA+E+rDXZھ"̀p#cVd jʲ`B`c+4xUbd~u0Ga7Y֎;nwі&Q hEnV4\"7+UgDYUb,l*f>-YV@Cbl γq`U.Q,ud,/5D 8]n z(UiSy8gd@VDr*bú¬eTzNY`U, e*@()H@˔Uf *@QV`rh0EYp!HiWv/f(PQe CM-ISEEKWRJ` a 00READRAN3@8DX0C@(H@˕(uNbxc(%9D9͡ dXEnQ fdE # PUdFjh4 `EYV"ū*`UҬ|d+68DY U-**^rrB@Yx*ʀVP ܢ͵ ndE - UfFjnh5 EYV"@ū* Ui^aVRr@",*ˀQf߀AV\r@ +68Z'*ˀQfg Dx3 VT=MEY`*Vm.x0()X@ˬU.QVRLd\" '"b:Lep &)A2Jte )!Fib"$f +)K:*bLf $&*F}@*"zg *)!$Fw@Bdd)!$F[Arzg&"mbJ     *) (* *) (* LAST UPDATE: 09-MAR-81 by Mike Lehman *) (* *) (* NOTE: THIS PROGRAM WAS ORIGINALLY WRITTEN BY  *) (* THIS PROGRAM PRODUCES A CROSS-REFERENCE LISTING FOR ANY *) (* PASCAL PROGRAM. OCCURENCES ONLY ARE LISTED. NO DISTINCTION IS *) (* MADE BETWEEN DEFINITIONS AND REF^ITEM; WORD = RECORD KEY: ALFA; FIRST, LAST: ITEMPTR; FOL: INDEX END ; NUMREFS = 1..REFSPERITEM; REFTYPE = (COUNT, PTR); ITEM = RECORD REF : ARRAY[NUMREF RESERVED KEYWORD TABLE *) ERROR, (* ERROR FLAG *) LISTING: BOOLEAN; (* LISTING OPTION *) INFILE: TEXT; LST : TEXT; LSTFILENAME : STRING; INPUT_LINE : STRING; PROCEDURE INITIALIZEALF; BEGIN KEY[17] := 'GOTO '; KEY[18] := 'IF '; KEY[19] := 'IN '; KEY[20] := 'INPUT '; KEY[21] := 'INTEGER '; KEY[22] := 'MOD '; KEY[23] := 'NIL '; KEY[24] := 'NOT '; KEY[25] := 'OF '; N. WIRTH AND *) (* ADAPTED FOR UCSD PASCAL (I.4 - THE PUBLIC DOMAIN VERSION) *) (* BY SHAWN FANNING (IN 1978) AND SUBSEQUENTLY ADAPTED FOR *) (* PASCAL/MT+ BY MIKE LEHMAN (IN 1981) AND IS A PUBLIC DOMAIN *) (* PROGRAM. IF YOU MAKE REVERENCES. *) (*====================================================================*) PROGRAM XREF; (*CROSS REFERENCE GENERATOR FOR PASCAL PROGRAMS. N.WIRTH, 7.5.74*) (*'QUADRATIC QUOTIENT' HASH METHOD*) CONST S] OF INTEGER; CASE REFTYPE OF COUNT: (REFNUM: NUMREFS); PTR: (NEXT: ITEMPTR) END ; BUFFER = PACKED ARRAY[0..131] OF CHAR; VAR TOP: INDEX; (*TOP OF CHAIN LINKING ALL EN; VAR I : INTEGER; PROCEDURE FIRSTHALF; BEGIN KEY[ 1] := 'AND '; KEY[ 2] := 'ARRAY '; KEY[ 3] := 'BEGIN '; KEY[ 4] := 'BOOLEAN '; KEY[ 5] := 'CASE '; KEY[ 6] := 'CHAR '; KEY[ 7] := 'CONST '; KEY[ 8] : KEY[26] := 'OR '; KEY[27] := 'OUTPUT '; KEY[28] := 'PACKED '; KEY[29] := 'PROCEDUR'; KEY[30] := 'PROGRAM '; KEY[31] := 'REAL '; KEY[32] := 'RECORD '; KEY[33] := 'REPEAT '; KEY[34] := 'SET '; KEY[35] :=(*====================================================================*) (* PROGRAM TITLE: PASCAL CROSS-REFERENCING PROGRAM *) (* *) (* PROGRAM FILE: XREF.SRC ISIONS, ETC. PLEASE LEAVE THE AUTHOR *) (* AND MODIFIERS NAME IN THE SOURCE FILE. THANK YOU. *) (* *) (* PROGRAM SUMMARY: *) (* P = 749; (*SIZE OF HASHTABLE*) NK = 45; (*NO. OF KEYWORDS*) ALFALEN = 8; REFSPERLINE = 15; REFSPERITEM = 5; TYPE ALFA = PACKED ARRAY[1..ALFALEN] OF CHAR; INDEX = 0..P; ITEMPTR = TRIES IN T*) I,LINECOUNT,BUFCURSOR: INTEGER; (*CURRENT LINE NUMBER*) FF,CH: CHAR; (*CURRENT CHAR SCANNED *) BUF,BUF1,BUF2: ^BUFFER; T: ARRAY [INDEX] OF WORD; (*HASH TABLE*) KEY: ARRAY [1..NK] OF ALFA; (*= 'DIV '; KEY[ 9] := 'DOWNTO '; KEY[10] := 'DO '; KEY[11] := 'ELSE '; KEY[12] := 'END '; KEY[13] := 'EXIT '; KEY[14] := 'FILE '; KEY[15] := 'FOR '; KEY[16] := 'FUNCTION'; END; PROCEDURE SECONDH 'STRING '; KEY[36] := 'TEXT '; KEY[37] := 'THEN '; KEY[38] := 'TO '; KEY[39] := 'TYPE '; KEY[40] := 'UNTIL '; KEY[41] := 'VAR '; KEY[42] := 'WHILE '; KEY[43] := 'WITH '; KEY[44] := 'WRITE ';      KEY[45] := 'WRITELN '; END; BEGIN (* INITIALIZE *) WRITELN; WRITELN('Pascal/MT+ Program Xref Utility -- Release 5.2'); WRITELN('This program is public domain'); WRITELN; FF:=CHR(12); NEW(BUF1); NEW(BUF2); BUF:=BUF1; SSIGN(INFILE, FILENAME ); RESET(INFILE) END; OPENERRNUM := IORESULT; OPENOK := ( OPENERRNUM <> 255 ); IF NOT OPENOK THEN WRITELN( '*** INPUT OPEN ERROR #', OPENERRNUM ); UNTIL OPENOK; WRITE('Output file nam LINECOUNT:=LINECOUNT+1; IF (LINECOUNT MOD 60) = 0 THEN PAGE(LST); END; PROCEDURE PUTALFA(S:ALFA); BEGIN MOVELEFT(S[1],BUF^[BUFCURSOR],8); BUFCURSOR:=BUFCURSOR+8; END; PROCEDURE PUTNUMBER(NUM: INTEGER); VAR I,IPOT:INTEGER; A: IF LENGTH(INPUT_LINE) = 0 THEN READLN(INFILE,INPUT_LINE); IF LENGTH(INPUT_LINE) = 0 THEN CH := ' ' ELSE BEGIN CH:=INPUT_LINE[1]; DELETE(INPUT_LINE,1,1) END; IF EOF(INFILE) THEN ERROR:=TRUE ELSE PUTNUMBER(LINECOUNT); END ELSE BEGIN BUFCURSOR:=0; WRITE('.') END; IF (LINECOUNT MOD 60) = 0 THEN BEGIN IF LISTING THEN PAGE(LST);  F := TRUE; IF T[H].LAST^.REFNUM = REFSPERITEM THEN BEGIN NEW(X); X^.REFNUM := 1; X^.REF[1] := LINECOUNT;  ERROR := FALSE; FOR I := 0 TO P DO T[I].KEY := ' '; FIRSTHALF; SECONDHALF; LINECOUNT:= 0; BUFCURSOR:= 0; TOP := P; CH := ' ' END; (* INITIALIZE *) PROCEDURE OPENFILES; VAR NUMBLOCKS: INTEGER; e? '); READLN(LSTFILENAME); ASSIGN(LST,LSTFILENAME); REWRITE(LST); WRITE( 'Do you want a listing ? ' ); READ( LISTOPTION ); LISTING := NOT(LISTOPTION = 'N'); IF LISTING THEN PUTNUMBER(0); READLN(INFILE,INPUT_LINE); WRIALFA; CH: CHAR; ZAP:BOOLEAN; BEGIN ZAP:=TRUE; IPOT:=10000; A[1]:=' '; FOR I:= 2 TO 6 DO BEGIN CH:=CHR(NUM DIV IPOT + ORD('0')); IF I <> 6 THEN IF ZAP THEN IF CH = '0' THEN C BEGIN BUF^[BUFCURSOR]:=CH; BUFCURSOR:=BUFCURSOR+1; IF LENGTH(INPUT_LINE) = 0 THEN BEGIN BUF^[BUFCURSOR]:=CHR(13); BUFCURSOR:=BUFCURSOR+1; LINECOUNT:= LINECOUNT +1;  WRITELN(OUTPUT,'< ',LINECOUNT:4,',',MEMAVAIL:5,' >'); END; END; END; END; (* GETNEXTCHAR *) PROCEDURE SEARCH( ID: ALFA ); (*MODULO P HASH SEARCH*) (*GLOBAL: T, TOP*) VAR I,J,H,D : INTEGER;  T[H].LAST^.NEXT:= X; T[H].LAST := X; END ELSE WITH T[H].LAST^ DO BEGIN REFNUM := REFNUM +  OPENOK: BOOLEAN; OPENERRNUM : INTEGER; LISTOPTION: CHAR; FILENAME: STRING; BEGIN (* OPEN *) REPEAT WRITELN; WRITE( 'Input file ? ' ); READLN( FILENAME ); IF LENGTH(FILENAME) >0 THEN BEGIN ATELN; END; (* OPEN *) PROCEDURE LPWRITELN; VAR I : INTEGER; BEGIN BUF^[BUFCURSOR]:=CHR(13); BUFCURSOR:=BUFCURSOR+1; FOR I := 0 TO BUFCURSOR-1 DO WRITE(LST,BUF^[I]); IF BUF = BUF1 THEN BUF:=BUF2 ELSE BUF:=BUF1; BUFCURSOR:=0; H:=' ' ELSE ZAP:=FALSE; A[I]:=CH; NUM:=NUM MOD IPOT; IPOT:=IPOT DIV 10; END; A[7]:=' '; MOVELEFT(A,BUF^[BUFCURSOR],7); BUFCURSOR:=BUFCURSOR+7; END; PROCEDURE GETNEXTCHAR; VAR I : INTEGER; BEGIN  IF LISTING THEN BEGIN IF LSTFILENAME <> 'CON:' THEN WRITE('.'); FOR I := 0 TO BUFCURSOR-1 DO WRITE(LST,BUF^[I]); IF BUF = BUF2 THEN BUF:=BUF1 ELSE BUF:=BUF2; BUFCURSOR:=0; X : ITEMPTR; F : BOOLEAN; BEGIN J:=0; FOR I:= 1 TO ALFALEN DO J:= J*10+ORD(ID[I]); H := ABS(J) MOD P; F := FALSE; D := 1; REPEAT IF T[H].KEY = ID THEN BEGIN (*FOUND*) 1; REF[REFNUM] := LINECOUNT END END ELSE IF T[H].KEY = ' ' THEN BEGIN (*NEW ENTRY*) F := TRUE;      NEW(X); X^.REFNUM := 1; X^.REF[1] := LINECOUNT; T[H].KEY := ID; T[H].FIRST := X; T[H].LAST := X; T[H].FOL  END ; END UNTIL F OR ERROR END (*SEARCH*) ; PROCEDURE PRINTWORD(W: WORD); VAR L: INTEGER; X: ITEMPTR; NEXTREF : INTEGER; THISREF: NUMREFS; BEGIN PUTALFA(W.KEY); X := W.FIRST; L := 0;  (*PRINTWORD*) ; PROCEDURE PRINTTABLE; VAR I,J,M: INDEX; BEGIN I := TOP; WHILE I <> P DO BEGIN (*FIND MINIMAL WORD*) M := I; J := T[I].FOL; WHILE J <> P DO BEGIN IF REPEAT IF I < ALFALEN THEN BEGIN I := I+1; IF ('a' <= CH) AND (CH <= 'z') THEN ID[I] := CHR( ORD(CH) - ORD('a') + ORD('A') ) ELSEF *) INITIALIZE; OPENFILES; WHILE (NOT(EOF(INFILE))) AND (NOT( ERROR)) DO BEGIN IF ((CH>='A') AND (CH<='Z')) THEN GETIDENTIFIER ELSE IF (CH = '''') THEN BEGIN REPEAT  GETNEXTCHAR; END; GETNEXTCHAR; END; END ELSE GETNEXTCHAR; END; (* WHILE *) PAGE(LST); LINECOUNT := 0; BUFCURSOR := 0:= TOP; TOP := H END ELSE BEGIN (*COLLISION*) H := H+D; D := D+2; IF H >= P THEN  REPEAT IF L = REFSPERLINE THEN BEGIN L := 0; LPWRITELN; PUTALFA(' '); END ; L := L+1; THISREF := (L-1) MOD REFSPERITEM + 1; NEXTREF := X T[J].KEY < T[M].KEY THEN M := J; J := T[J].FOL END ; PRINTWORD(T[M]); IF M <> I THEN BEGIN T[M].KEY:=T[I].KEY; T[M].FIRST:=T ID[I] := CH END; GETNEXTCHAR UNTIL ( NOT(((CH>='A') AND (CH<='Z')) OR ((CH>='a') AND (CH<='z')) OR ((CH>='0') AND (CH<='9')))) OR (ERROR); I := 1; J := NK; REPEAT K := (I+J) GETNEXTCHAR; UNTIL (CH = '''') OR (ERROR); GETNEXTCHAR; END ELSE IF CH = '(' THEN BEGIN GETNEXTCHAR; IF CH = '*' THEN ; PRINTTABLE; PAGE(LST); CLOSE(LST,I); IF I = 255 THEN WRITELN('Error closing output file') END. ND ELSE GETNEXTCHAR; END; (* WHILE *) PAGE(LST); LINECOUNT := 0; BUFCURSOR := 0 H := H - P; IF D = P THEN BEGIN WRITELN(OUTPUT,'TBLE OVFLW'); ERROR := TRUE ^.REF[ THISREF ]; IF THISREF = X^.REFNUM THEN X := NIL ELSE IF THISREF = REFSPERITEM THEN X := X^.NEXT; PUTNUMBER(NEXTREF); UNTIL X = NIL; LPWRITELN; END[I].FIRST; T[M].LAST:=T[I].LAST; END; I := T[I].FOL END END (*PRINTTABLE*) ; PROCEDURE GETIDENTIFIER; VAR J,K,I: INTEGER; ID: ALFA; BEGIN (* GETIDENTIFIER *) I := 0; ID := ' '; DIV 2; (*BINARY SEARCH*) IF KEY[K] <= ID THEN I := K+1; IF KEY[K] >= ID THEN J := K-1; UNTIL I > J; IF KEY[K] <> ID THEN SEARCH(ID); END; (* GETIDENTIFIER *) BEGIN (* CROSSRE BEGIN GETNEXTCHAR; WHILE (CH <> ')') AND (NOT(ERROR)) DO BEGIN WHILE (CH <> '*') AND (NOT(ERROR)) DO GETNEXTCHAR;     ͂d!@! +!e%END #!͂d!@! +!eOEXIT #!͂d!@!+!eyFILE #!͂d!@!+!eͣFOR #!͂d!@!+!eFUNCTION#!͂d!@!+!eGOTO #!+!ePROGRAM #!͂d!@!+!eDREAL #!͂d!@! +!enRECORD #!͂d!@!!+!e͘REPEAT #!͂d!@!"+!eSET #!͂d!@!#+!eSTRING #!͂d!@!$+!s public domainͯb,c}^!Fͩb}^! }2!!`G!!`G*"!}2SB!!+"D#ͬ[" !%!TBͩb!2D!P͠_͊^!Fͩb}^**! s*#"!*++"D#ͬ[">E*D#"D*>E+">E|ʿ !Cͩb**D^ͯbdÐ **&b *" *"!"*#"*!<^d!&b s*#"*#":RB&ҷ!C&CON:[>!Fͩb!.ͯbd!*++"D#ͬ["BE*D#"D*BE+"BE|ʉ!Cͩb**D^ͯbdZ**&bҡ*"ç*"!"*%!"!Fͩb!.ͯbd*!<^d!&bA:RB&!C!͐N!Fͩb    < ͯb,c*!!;^!,ͯbdfG!!;^8 >ͯb,c}^Q\!D!͂dW\!" E!!+" E#ͬ["DE* E#" E*DE+"DE|ʩ* E! e!D* E+^" Eu* E|/g}/o#!^d"E!}2E!"E!*E!e!D^!}2E!*E!!&b1!Fͩb! TBLE OVFLWͯb,c}^!}2SB:E&o:SB&o}Q\!E!͂dW\!E"*E""E!" E* E!&bҕ!" E͏ #"* E#" E* E+!^d#}2&E*"E:&E&o+)^#V"$E:&E&o*"E ^&b!""E:&E&o!&b*"E ^#:&o!a{ozg!As/!4E*.E+:&os(:&o!A=b:&o!Zͅb}o:&o!a=b:&o!zͅb}o}o:&o!0=b:&o!9ͅb}o}o}/o:SB&o}һ!".E!-"2E*.E*2E!Td"0E!@*0E+!e!4Ed^*0E#".E!@*0E+e^#V ^!&bҚ!E! `G*E !s*E!+)*s#r!*E!e^#V *Es#r!*E!e*Es#r!*E!e^#V"FE*FE *FE ^#s*FE*FE ^+)*s#r1!*E!eV""E*$E%*"E!&bk*",E*,E!nbҚ*,E"(E!*,E!e ^#V"*E**E!nbҼ!**E!e!*(E!eJ^Ҝ**E"(E!**E!e ^#V"*EW!*(E!e.*(E*,Enbz!*(E!e!*,E!!e!4E[^ *0E+"2E*.E*2EYbҼ!@*0E+!e!4E'^W!4E+*HE!TB!Q}/o:SB&o}/o}c:&o!A=b:&o!Zͅb}ү4`:&o!'&b(:&o!'&b:SB&o}(`:&o!(&b](:&o  #^!}2E!E! `G*E !s*E!+)*s#r!*E!e!D!͂d!*E!e *Es#r!*E!e*Es#r!*E!e *s#r*E"1*E*E"E*E##"E*E!=b*E"E*Ee!͂d!*(E!e !*,E!e ^#Vs#r!*(E!e!*,E!e^#Vs#r!*,E!e ^#V",E%!".E!4Eͱ #!͂d*.E!͎b/*.E#".E!a:&oͅb:&o!zͅb}!4E*.E+!*&bZ(:&o!)nb:SB&o}/o}W:&o!*nb:SB&o}/o}Q(-((`(e!C!͐N!"!"1!C!͐N!C!! M*!&b!FͩbError closing output fileͯb,c}^N\            !YG6#6#6#6!WG6#6!0e##"0e!9"*e"$e"&e>2TG!00"UG!E6# x„E!"F"E"F"F>2F2F>2 F2F> 2F!F"F!OG"F!MS"PG!R"RGHQ\"J"JW\͵a*J^!&bH*J@H@:PASTMP00.$$$!b!TG!*J! !{d!TG!!TG!^#s!TG!^!9YbҸH!TG!!0s!TG!!TG!^#s*J*J*JN*J! !!ͺd*J!&b I*J@!s*J}!ͺd*M8!s*M!&bDK*M}/o|/g#"M*M@!sRK*M@!s*M<!s*M;!s*M! !s![*Ms#r*M?!s*MA!s*M8!s*M9*Ms#r*M4*Ms#r*M=*Ms#r*M^!&b*MtUrN*N!s#r*N8!s͵aQ\"N"N"NW\*N8^!YbMN~N*N*N S![!s#r*N!s#r*N8!sÓNQ\"N"NW\*N!&bN!!Fͩbͯbd!*ͯbd!ͯbdN*Nͩb! ͯbd*Nͩb}^OVQ*Q!͎b*Q*Q^ͅb}QQ!Q*Q+*Q*Q^Ns*Q#"Q*Q#"QQ*Q!!ͺd*Q!:Q&o!@{ozgs!Q*Q!!{d!Q*Q! !{d*Q8!sQQ\"DR"FRW[*Ts#r*T<~(T*T;!sTV*T@~T*T<*T!^!&bs*T!^! &b}2DU:DU&o*T<^}ҝT*T;!s:DU&o*T8^!&b}TV*T<^*T;^}T*T!! s/o|/g#"JI*J@!s*J<!s*J;!s*J8!s![*Js#r*J6!s#r*J9*Js#r*J=*Js#r*J4*Js#r*J?!s*JtU}/ҿI![!s#rJ*JqUIJ*J*J S![!*JͲas#r![^#V!nb}/o}L![!s#rDL*MqU+LLDL![!*MͲas#r![^#V!nbL![!s#r*M<!s*M;!s*M4*Ms#r*M!nbL*M6!s#r*M@~L![^#V![^#V4^#VSLVL*M<!s*M;!sOQ\}2QW\:Q&o!a=b:Q&o!zͅb}DO:Q&o!}o|g}2Q:Q&o}2Q:Q&oQ\"Q"Q"QW\![!s#r*Q^!nb*Q!^! &b}үO*Q!!KRtO*Q*Q!b*Q^!nbQ!@}2Q!QO #!͂d!QO #!\*DR!}/o|/g#&b)R!E<^}2@R8R*FR<^}2@R:@R&oNRQ\"R"R"RW\*R*R*R*R*R*R^*R*R!{ozg{ozg{d*R!*R^*R{ozgsRQ\}2SW\![^#V!:S&os![^#V![^#V4^#VLUQ\"jU"lUW\![*lUs#rKYwU!VQ\"VW\!}2V*V͔UCON:[ҳU*V8!s!}2VV*VͿULST:[U*V8!s!}2VV*VUKBD:[*VUTRM:[}iGGGQ\"G"GW\!0e^#V!0e&bҝG!0e!0e^#V####s#r*G!0e^#Vs#r!0e!0e^#V*Gs#rQ\"G"GW\!*e^#V!0e^#V{ozg"G*GJ![!s#r"JQ\"M"MW\͵a*M8^!&bJ*M*M!M M*M!&bJ!Fͩb}^!Fͩb͛JUnable to automatically close: ͯb,c*Mͯb,c͸J in RESETͯb,c}^!Fͩb}^!FͩbJProgram abortedͯb,c}^N\*M! !M"NQ\"N"N"NW\͵a![*Ns#r*N8^!&bґM*N9*N6^#Vs#rKY*N*N4^#V!ͺd*N9!s#rKYM*N8^!YbM*N9*N6^#Vs#rKY!N*N8^!nbN![!*NͲas#r*N͖[s#͂d*Q!^!:&b:P!"Q*Q!^N}2Q@P!"Q*Q"Q!"Q*Q*Q^!.ʹ\!:ʹ\͕]J]}/o*Q*Q͎b}o*Q*Q^ͅb}P!Q*Q+*Q*Q^Ns*Q#"Q*Q#"QPP*Q*Q^!.&b*Q*Q^ͅb}QQ*Q#"Q!"IUSQ\"FS"HSW\͵a![!*HSͲas#r![!s#rPS![^#V8^!YbҞS![^#V![^#V4^#VS![^#V!^}2SS![^#V!^}2S![^#V![^#V4^#VS:S&oSQ\"T"TW\*T;!s!V*V8!s!}2V:V&oQ\"VW\!}2V!V! !~\u\*V^!Yb*V^!͎b}kVV!*V^+"V#ͬ["V*V#"V*V+"V|ʻV*V*V^!V^\J]}/ҸVVÅV!}2V:V&oW    ![^#V=!;Y!{d![^#V8^!&bҞW*;Y!!Ͳas*;Y^! &bhW!! Ͳa"=YØW*;Y^!&bҘW!! Ͳa"=Y!!Ͳa"=Y:YW![^#V8^!&bW*;Y!!Ͳas*;Y^!nbҸW:Y![^#VA~X![^#V<!#V=![!{d![^#V8^!Yb.[![^#V"[!*[9^#V+"[#ͬ["[*[#"[*[+"[|+[*[^}2[:[&o! &bҌZ|[*[8^!&bZ!:[&oͲa"[:[&o! &bZ!! Ͳa"[![!:[&oͲa"[*[8^!&b![]"^"]!9ͪ\*]|\"]*^|\}\C]\*]#"]*^{z.]\*]"]!9DM! 9^#V"]|]}_F:]_!\~ʏ]!"9*]Å]"]!9! 9 w#¤]! 9*]"]!9! 9 /w#]! 9*]"]!9! 9 w#]! 9*]*[;6> *a!`>2`*[; ~_!.`*PG:`C`T`#:`<2`*[; ~%`_y c`q:a<2a6 :`<2`:a<2a`#c`!`#5d*c:c=w*c6#s>2cc!(c*PG"Oc"Qc"Sc#+n&*Sc*QcUc*Oc|mc}o|gmcd{Nd#ztc:zd!2zdyœccx/Gy/O>=­cc)c)Ҹc, cåc33åc)c, åc!>2zdɯ2zdcHdHdxdc͌c{/s:Y!![^#V9^#V+"?Y#ͬ["AY*?Y#"?Y*AY+"AY|#Y![^#V"CY*CY?^!&bX*CY?!s*CYA^}/X!*CYBͲa"=Y![!*CYͲas#r![^#V!&bX*CYA!s*CYA~X*;Y!sY*;Y*CYB*CY?^^:[&o! &b![!! Ͳa"[*[#"[YZ{[!![^#V9^#V+"[#ͬ["[*[#"[*[+"[|{[*[^HY*[#"[T[![Ù[*["[*["[Yb[{ozg##*[!*["L\)\[[!*L\![[[[^# y^!yMD!`iO>^}o^y>^D^!!^y>^D^>^^D^9^^D^R^"{^ cq*{^ d d*[;~ڝ^ cÊ^6*[8~ c*[~ cAQ_z^-9_{/_z/Wz_'c,_c,_dÑaQ\"aW\! *aͲa"aøaaQ\"a"aW\*aM*ao&"b*b"a*a!!Ͳa"boz/g#͌c{/_z/WɯO>Gz6d#d6d͌c{/_z/W}o|g#ɯo>g͌co>g>2zd!cc͌c͌cÇdxʖd~# xŒdädxʸd + +~+ x®d{q#{ddYd}- d-d*RGyHs*CY?*CY?^#s*;Y#";Y+X![^#V6!s#r͵aNYYQ\}2[W\![^#V"[*[?^!&bҹY![!*[BͲas#r![!*[Ͳas#r*[?!s*[B*[?^:[&os*[?*[?^#s![!s#r![^[[[[[[[[[[[[[[N2K\G9\AyF\#=\:K\"\\*\\"\!9 ͂d*\"\! 9^#V!9Ö\"\!9^#V!9 ͂d!"9*\ 6#¬\"]"]!9ͪ\*]|\\*]:]_!9:]_!\~Gw @"c,_ c,_,_!'_!ͯbUc32768>0_0J_!dG_x9_xzt_l_{l_xGÂ_z/W{/_ czt_x_ʞ_ !dÙ_Â_ɯ2a"a}2`2`*[8~`!`͎a:`_:`_*[<6!`!b*[8~ ` !d~##bkbVbʋb:bÂb͔b}3b|{b!`i͔bzOb}|{b3b{b3b͔bzOb{z{b3b͔b}{b|3b!`i͔b@b͔b\b&}o&}o"["PG"RG!MS"PG!R"RGɯ2c"c"cYPz cbb>2c} 2. XREF asks: Input file? 3. XREF asks: Output file name? or CON: or LST: 4. XREF asks: Do you want a listing? (N means No, anything else means YES) And that's it! MODULE UTILITIES; (* USE AS FOLLOWS: FUNCTION RENAME(F,NEWNAME); MUST BE PRECEEDED BY ASSIGN PROCEDURE EXTRACT(F,NAME); RETURNS NAME FROM AN FILE FUNCTION KEYPRESSED : BOOLEAN; TRUE IF KEY PRESSED *) (*$I FIBDEF.LIB*) EXTERNAL FUNCTION DOS(23,ADDR(TEMPFILE.FIBB.FCB)); RENAME := RESULT END; PROCEDURE EXTRACT(VAR F:FIB; VAR OUTNAME : STRING); BEGIN OUTNAME := F.FNAME END; FUNCTION KEYPRESSED:BOOLEAN; BEGIN KEYPRESSED := (@BDOS(11,0) <> 0) END; MODEND. t#kV!jʺ ;hDZ\QVru B9YB9EXHpܭQhDnV6݀ ^ZUb-|Z YLuDJ@+4f0Ii:MqЁ3@rA+6@h-*@"1(eܢ@-ˬC@ 4l(r@ D8E[(   VVmvpC. >`DYLYxADSqr46j8XD yYTVY|ҥBf0m FS o4c4Lͼ,ͱ_YXuy^iTP&aؐ! rh06 'An2| HZͫ LI@XXV",Vh!n%8O-6 ͷ Lڸ\ v[xL7XwCTڨͰ@c2#(@ͫüfFmo7mf`FG+63n ,n:LS@ 3m#6҂0(Ղ9Ywd3Aa1 !pAxD7(͹ !)  ͼ`; ! VmfPYHa6@`x@V0 m2 &mf܀fmaPq rn36Dn:NL ͽ ê f߰fm8 c @p7MC)@p0&)rfаvmfvUf P @Q`z+6Q(J%\"6f0 eG[L7#&ϣ-:@"`(GxFVjB+4( r@m7x8aBD R@",8:@"`ø"EXwd$B 섈@XaݐVV/αXaݐ",;ͨ clM !6`&DŽڠnvBEXp m@(/αVm@$ Qf* ,:@"`!ڼiRp}e Y m@4/αXe 0Vm xPmA X^uD{B09Y,uD{B99Y->>ҰA&ܢͤbt@Vm pO0J EX *@Be:ʀ"`9i@2ʀ,;@і'+63i/`9D8h!8!,Fé!TQr@*rB+4fmA<rjťE[p" BTB9YHEXw8uD{B9Yl5ҽ6fmO)i7 9OC9!,0ͥ*orD+6ʇorF+6orG +68Z'}YVPҵLV9D8,/5YťB!eXtl C]b γ*orD+4e@0@VmpO0Jo>hB9D8,/5Z fFmaQ rh`+6G@ 6i+i8+JYlW7@ PXwCQ\ڔ ͯ@i7@ͫھ ü f֐Vm·#u9Dm{fV@W+6m(,n5sp@ 3l+6΂+4@ b-P%PZ `m-dpl #Ch\N !r > ト@ zoqYCnQ f vmMіfӠ ^i_Pv@іfp ^oro>>Ҧ ziS0upfwJ@ 08 oqGYPL7D%M@-*!,$ͥ*@>  t",`ͻE @FYHU d,/5Xv-P-+:@"`!ڈ:@"`!hVa e`(+D {w@(CEܬ6͸An7CIl0DCA :NVm9fvm?a VVrr B9Y|(B 6*J*.QVr@@+60X҅9Y)R3 o1ҹᣬ&ܢ͡a fҀ eE[p"B2ȀBxf*rB(9Y0C͹\!,:B`/7Y}'}bD8 ͨD&ܣ&ܬhTf#0`h# >ҹx`+6A+6o+6܆y@p9NfSqћiY0-S eu$9DÇXf mLfPVVd!VHqY-"ˀN^f۰V^f !e'+E+rDY Z"#f!V!jʩbgіdf@!0Vmf@!0Vm pO0J orj@{Sٵ=09Y@B.9YAJYF"@L;fڐ eҺ@bm˔uD{BTfpu !@-*Q Vh*@2 U e!n*H2 U e!nkA˔B:'1U e" fVm 'M6m(lAX^j@`(rk0YQd9Ng1Ѐ@͢. !Qm@(/Qf!`yͦ  f@fm3I:3j836 D ef r_+6 D k3^A LgCͱ ͻL:!@VmfޠorH +6orK@+6Z'}uYPL7_/ˬB0Ҧp"ƀL:.:ʀ"`!H:ʀ"`!dhTa e@03@ o>*|*@NQV0rm04C",dͥ*iYV2b`!V&qGYPL7D"@U-*ͥ*B+68DXp : a<I@t< ې͹aLۜöAlچiVVVrr B9Y,B @@Xe`(+D Zٵ ҳb`(rl0[nHVpU] dkCE Uۚ@ pܢ@ͻEYPL7D$xYPL7D%|-e@0Vm pO3{uL7D Q-*&!!Vm f0 n7΂t2 pl7&m fm іaԐ<rokyD A5NCBq 3Φ#63h8s6@ 2GYPL7D"^^-*ýì&ܢXͪfҀ eEYXͨdEXw8uD{B-9Y9ҷP>+Y=MjiMDAO9x:B`!3yDghBU^Aͩjp`6 `xFVurPZ,pܭVmnAVnpp [eQAVp γ9ork9Y@B 9Y`AfYF"L; *̀NQVpuNb3%g",e@&me '(roťQD$)0؈)9D!   8DY`Uͧ/{e '( u*o=' ȋ) - Lrk* Vmaߡ+63mt fQme@'( rk ʈYdEpD@@ʹB,J"*ʀA2Vm^1+6ۈk@x)^ȋ) B9Y=Ұ",m"p2Nxf rn؋6H&C!s9 ۄ"͸"$`7|Mͼbl&*NQr@ +6䉊C&nVm'( YMeٶ\M|vPCG@(ͥ"&ܢ`;b/YfҀ eY"΀Bg@'+606p`T\N ց;x'zpd@ Ei@ @@)ب> @)ب > @)ب>P>*(riа*(rmx}YVXBFZ N'x}pw\C!Vm ( rh6@Oo>*.!nVmOi10}ܬn>>Ҥ,f ewYMZx L7EFiVAqrj賕XE ]ř9Vq 83)ͨb,ͯ͵ d0Ͷ }a@m(pFYPuD{BR9YaҪ"EuleQ",,*QfQJ @ di@2ʀ,ڤ:`/Xʍor@@+6ҺBB$@Q~ QfӁ& g!0ۡ'+6 3kؓ6op@=IU7hI!&ܢ͹B A)ب> A@)ب>P9YQFCSr t4i0Qp2i6 3ik@[aK0)z/@R ^K)h/@R ZK)z/@PR PoqYұڰe`+**.QR QVXrk862D7Q;T* c;.:@`2bTQrnx9D!vM'x}pٴҷD&ܣ@&ܬڈ(:@b`}YV]Mv,]:@"`/X Y]) 7΂ i6LF(i: Sy6b6Yd]Wٵ|]m: !J0 "E&BQ^: !ܬ ./U-+ U@ͬ.fi]apr !2h\r4@ p @A-*4!.QVD IƜ-˔C@ͺl;*4!.Vmf@b9L&n:aa2D3)ћqFY erY,P> 6o>+`4ôbE[F"lA[B9YPi 8h3jЫ`9D+6ÎlBBTB.9Yq>+6ііf",8fѡm B8ͺcbq+6J+63k06pX^j@+6 ͳcfBm f $f&maAVxrtU&$:@B`!bnVmf&h͢Bl;(*NQrI٠BipLٴM3i؛ Cf1ր Q VrjЛ6k6ɉ聛aٷHC_ܢ:B`!&!BnVmf16g'(>9EY ͮb`&@QV|r@@+6։n`mٶM2#)tͣ"8*ͣP>*(rn sť|D6DUͲ*$ S9 1ͦ ͵b\*Ͷ":,ͧ@>Ҡ:,!@Q@+6qPB9Y5K}UYO@-*,:``!B$iT1fm4afH>6I+6㊼ZVXCs\ۤ*ͮIa6Lm0*ͽb*ø0!ԀnQf>үHf!qjrJ+4fw+6 3h63h009Yak$BTH" ` 7΂y@d2'Sa@d9NVmtfqmzdi@2׀x&ܢX͵bx&ܢh͹fi_ּ Qfݡ eXtdC`0ͤ!Xr Dq 0 0S CƜ->ҶBlA[B9Y,i 8h3nťYF8h!#NVmmVmfavm/FSie23h6 3lЇ8E[VVmpC.VmX@ 8DnQ f1(Y\lB9YmHFٶpl< 7΂1n2 &e0I :LF+6i6 Y`"#0&ϢJ퍈kPەfA~?f1mfa$fҀ f֡׋J@q+6m ~?l(6lXHb@ g0 6Jb@ g0 6<ԐzA0;Pi ԐzRAH=I $zԁ۞;I$ԐzA+8:؀`h!XHB9D f @і\e0>ҿ>fmN NfQg4Cxt0g9M@͢$ (@ͱ*orH+6ZV|CJ\@Ͳ !LpoΆ@p9# SHUHYPL7D%@Z-*R@ͳ:2V#9R:D!1R2!U/C5U22#S#1"q]%:27#$ !   ^3##!bQA13:Aԓ#* ]R3VATRc+9&2;c21M&3.3Rc$1&3;#*%:3r=U#!qE2Aѐ2]2t=Sc'q]I 34AԔ,q]I22'#7MQJ3jA#*#IMR3F96D >2&9ԒUR#;IMR2AUU#&I!29SՑc;c%=IMV2?RUb,|Z` 9D!pU!`y͠dEuC`+4dl@E",Pb3l9EX9B\f`b2arA!ȄR3FVh*Qf V&r@ +6ހ8Z'՘}H@t CV D8*0! [s(C.Q.r@LSU#5R3S#)C =3?TQӧVStD%5E$xI!WRITEH#MJ`À0`@ e (r@$ Q fFiT$ |}Qϊ#9eXL7D#r@[D2( Q@f0' D2n U; (C.Q>r@@+6܀@ (9D dZ.[" fDb EVU)( !f :ɏtD%5E$xREADHEIndexer inputs a Pascal source file and outputs one of two forms of index file. The first is the short form: only the procedure or function declarations are extracted from the source. The second is the long form: everything between the keyword 'procrsX0!ڶ*Qffi\@,0!V Y9pU!`y!U->Ң"0+aa Dv +*@2 ͿAfݠ e8!.QVna`hEnV 4\"7+U X`eu$DTH@DIVDTx@MODހ5H΀ @PLDDUɘ @NEIDuDȠ@LSIDtTɈ@LEIDd @MVLd( @RNCt8MOVEQS 4t@h;!O*@GO GOMOD VP4-edure' or 'function' and the keyword 'begin' is extracted. Invoke indexer with the following command line: INDEXER [SHORT | LONG]    (* AS OF 10/21/79 *) (*$C3*) PROGRAM CALCULATE; CONST RCONST = -2.5; RCONST1= 65535.5; VAR R1,R2,TEMP:REAL; X : ARRAY [1..2] OF REAL; CH1,OP:CHAR; FUNCTION SUBREAL(R1,R2:REAL) : REAL; BEGIN SUBREAL := R1 - R2 END; ); '/': WRITELN(R1 / R2); 'M': WRITELN(-R1); '=': TF(R1 = R2); 'N': TF(R1 <> R2); '$': WRITELN(SQRT(R1):10:3,SQRT(R2):10:3); '<': TF(R1 < R2); '>': TF(R1 > R2); 'Z': TF(R1 <= R2); 'G': TF(R1 >= '); WRITELN('$:SQRT '); WRITELN('+, -, *, / ARITHMETIC OPERATORS'); WRITELN('M:NEGATE'); WRITE('= : EQUAL '); WRITELN('N : NOT EQUAL'); WRITE('<:LESS THAN '); WRITELN('>:GREATER THAN '); WRITEO STOP'); READ(CH1); UNTIL CH1 = CHR(27) END.  WRITELN('ENTER OPERATOR:'); MENU; WRITE('? '); READ(OP); WRITELN; CALC; WRITELN('TYPE T PROCEDURE ADDREAL(VAR R1:REAL; R2:REAL); BEGIN R1 := R1 + R2 END; PROCEDURE TF(B:BOOLEAN); BEGIN IF B THEN WRITELN('TRUE') ELSE WRITELN('FALSE') END; PROCEDURE CALC; BEGIN CASE OP OF 'S': WRITELN(SIN(R1)); R2); '1': WRITELN(SQR(R1),' ',SQR(R2)); '2': WRITELN(R1 + 1); '3': WRITELN(1+R1); '4': WRITELN(TRUNC(R1)); '5': WRITELN(ROUND(R1)); '6': WRITELN(RCONST); '7': WRITELN(RCONST1); '8': BEGIN R1 := -2.234LN('Z:LESS THAN OR EQUAL TO'); WRITELN('G:GREATER THAN OR EQUAL TO'); WRITE('4:TRUNC '); WRITELN('5:ROUND'); END; BEGIN (* MAIN PROGRAM *) REPEAT WRITE('ENTER FIRST OPERAND? '); READ(R1); X[1] := R1; WRITEL = ( or ) +/- = or $ = or : Display commands: D? where ? is as follows I - INTEGER C - CHAR L - BOOLEAN R - REAL B - BYTE W - WORD S - STRI 'C': WRITELN(COS(R1)); 'A': WRITELN(ARCTAN(R1)); 'L': WRITELN(LN(R1)); 'E': WRITELN(EXP(R1)); '+': BEGIN ADDREAL(X[1],X[2]); WRITELN(X[1]:10:3) END; '-': WRITELN(SUBREAL(X[1],X[2]):10:2); '*': WRITELN(R1 * R2; X[1] := 3.456; WRITELN(R1,' ',X[1]); END; END; END; (* CALCULATOR *) PROCEDURE MENU; BEGIN WRITE('S:SIN '); WRITE('C:COS '); WRITE('A:ARCTAN '); WRITE('L:LN '); WRITE('E:EXP '); WRITE('1:SQRN('R1=',R1); WRITELN; WRITE('ENTER SECOND OPERAND? '); READ(R2); X[2] := R2; WRITELN('R2=',R2); WRITELN; WRITELN('ENTER OPERATOR:'); MENU; WRITE('? '); READ(OP); WRITELN; CALC; WRITELN('TYPE TNG X - EXTENDED V - var by name PN - display procnames VN - display all var names associated with this proc SB - Set breakpoint RB - Remove breakpoint E+ Entry/Exit display on E- Entry/Exit display off BE     Begin exec at start of user prog GO Continue exec from breakpont TR Exec one Pascal statement and return T Exec Pascal statements and return mRZrKÙEYwØ,Ùy}Áû _ä!}2!4!]?}2:&o;@"@*"!!^}2!!!!^s!!:&os*"*;@" @* &!͇H}2* &!͑H}2! 012"`*R#"R*`+"`|+!Ԃ*R+%s.1:&H!}2!bFlExternal reference chain FeG!Ԃ!F͈G͈--> FeG*҂+.1!"V!bFͷ FeG*Ђ!eF !Ԃ*V+^! ͭF !bF!Ԃ*V+^FHF!>FeG!}2("Z*Z!eF3Iã*Zl&!eF*܂+!bFa FeG*Z;!}2*܂#"܂ã!F͚error in comrel FeGͩC:&o:&o}*܂+!bF DB FeG%!}2!"e*ނ#"ނ *ނ^!ͭF*ނ^! ͭF}o*ނ^!,ͭF}n !4C!BC*ނ^͈C/C!G*ނ#"ނ *ނ^}2*ނ#"ނ:&o! eF:&o!,eF}o*ނ^!LeF}Ҩ *ނ#"ނ*ނ^!=ͭF !F *L=nnn format required for page size 3456789ABCDEF#!ʹH!bF! :&o^FH! :&o^FH*ʂ!eFh}2Ȃ!"ʂ:Ȃ&o!.F":Ȃ&o!F}2Ȃ*ʂ+"ʂ*!"2!!+"4#@"\*4#"4*\+"\|*2!F"2ú*2"(*(!"@!!+*V#"V"!bF!Ԃ!F͈G*Ђ!eFE!bF!:FHu*Ђ!eFu!bFh EQU FeG*҂+...!FͩC!FͧEnd of programFeG!"܂!}2΂*܂+!bF DW FeG(+!bF!'*#"*!eFN!"*܂+!bFE DB FeG_!bF!,FH%*܂#"܂*7*!F͠!Pascal/MT+ --Disassembler-- 5.5FeGͩC!FͩC!FCP/M-80 versionFeGͩC!FͩC!5"!5"!}2!}2!"ނoptionFeGͩC*ނ#"ނ!"*ނ^!0!9gAͳAc *! EI*ނ^!}o|g"*ނ#"ނ !F̀ Page size set to: FeG*!!CͩC*"*"!.!5!eF !"4C!BC .ERLBC/C!G!F Object code file: "B#@"^*B#"B*^+"^|:*@!F"@*@"6*6%%"D*D;@"N@*Nl&*N&"P*P*P"Ђ("҂!F!F"T!Ԃ #!ʹH*T!eF!"T!*T+"R#@FH*܂##"܂*܂+!bF9 DW FeG(+!bF!"FH*܂##"܂!kCON:f@҃!F!.FH!}2Ƃ:&o}/Ҝ!xF!>!DͶC!>!^! eF!xF!>!DͶC!>!^!0!9gAͳA!b! !G*ނ^! eF+ *ނ#"ނ *ނ^!ͭF*ނ^! ͭF}o*ނ^!,ͭF}ҏ !4C!BC*ނ^͈C/C!G*ނ#"ނ+ !͛ CON:!G*ނ^! eF*ނ^!,eF}n *ނ^!,eF *ނ#"ނ! !G*ނ^! eF FeG!"FeGͩC!4!!"!̂**̂!eFn !FX Unable to open .ERL file: FeG!"FeGͩC!.!5!eFҧ !"4C!BC͚ .PRNBC/C!G!F Listing file : FeG!"FeGͩC!x!!"B2!x!̓-@!eF: !   F$ Unable to open .PRN file: FeG!"FeGͩC!FW Output file : FeG!FeGͩC!FͩC!"!}2!}2Ȃ!"ʂ!}2Ƃ!}2΂!"܂"̂*̂!eF Or"̂*̂*̂"̂*̂aCrFrLr""̂*̂!bFQFPascal/MT+ Release 5.5 Copyright (c) 1981 by MT MicroSYSTEMS Page #FeG!^#V!!CͩC!bF͇Disassembly of: FeG!FeGͩC!bFͩC!bFͩC!bFͩC!bF5Stmt Nest Source Statement / Symbolic Object CodeFeGͩ"2*4#"4Ô_!FD)*** error *** progrel or datrel exptectedFeGͩC_B!*4+"2#@"2*2#"2*2+"2|ʓIzF;@"6!8!QG@!bF FeG!8FeG*6!;@!!QG@4CLXI BC!C!,͈C:܅&o͈C/C! ^#V ;@}2!!QG@4C!BCK BC:&o͈C/C! ^#V ;@!4!QG@!4̀R@Ҡ͓JMP !^#V 4C!J͈C!4BCͺ BC/C!^#V ;@!!QG@!R@CALL !^#V|!D |!D#|!D&|!E|!E|!E|FRAR! ^#V |B !+5?|*.Hq!Hq͝SHLD !^#V q!Hq!Hq!Hq!HqDAA! ^#V qq!H qLHLD !!C!D)!C!E)!C!H)!C!L)!C!M)!C!A)Bv,:H*.g!D!B)Ð!D!C)Ð!D!D)Ð!D!E)Ð!D!H)Ð!D!L)Ð!D!M)Ð!D!A)Ð!E!B71^.1^.^4^7^:^=^@^B  %+1^rB r:΂&Ҩ !͇CON:f@!͖LST:f@}!FͩC!b!!̂_0*̂!eF!FError closing :FeG!FeGͩCͻ@nC!bFͩC!!s#r!!^#V#s#rF!bFͩC!!^#V#s#r!b!!B2!b!t+@!eFң!F͍Unable to REWRITE: FeG!FeGͩCͻ@!",!܂!܂^#V#s#r!eF%%%".*,#",+!*,BC!,͈C/C!^#V ;@}2܄@4C5STAX BC:܄&o͈C/C! ^#V ;@!ބ!QG@4CqINX BC!ބBC/C! ^#V ;@}20@4CͣINR BC:0&o͈C/C! ^#V ;@}22@4CDCR BC:2&o͈C/C! ^#V ;@}24@4 /4C!C͈C!BC BC/C!^#V ;@!؆!QG@!؆JR@j]RET ! ^#V È4C!R͈C!؆BC/C! ^#V ;@}2*@4CͣRST BC:*&o͈C/C! ^#V *.|NOP! ^#V å!Bå!Bå!Bå!Bå^#V q!H&q!Lq!Lq!Lq;CMA! ^#V qB  *4q*.En͂SPn͔STA !^#V nͧSPn!Mn!Mn!MnSTC! ^#V nnSP nLDA !^#V)Ð!E!C)Ð!E!D)Ð!E!E)Ð!E!H)Ð!E!L)Ð!E!M)Ð!E!A)ÐB!/=KY*.x!H!B)á!H!C)á!H!D)á!H!E)á!H!H)á!H!L)á!H!M)á!H!AGä.רPÉþ/hÝ!f0ÉÅ)þæ}roÀÑâù ;"|#ý$%&P(! !E!ͭF!*!4F͛C:*&o!eF!FͩC!FDisassembly aborted with ^CFeGͩCͻ@!^#V!^#V|F+!b!1+"0#@"0*0#"0*0+"0|*Iû!"4!܂!܂^#V##s#r!eFҰ%"2!eF}*2%+í!Fͤ*** error *** no second byteFeGͩC_!EIP(+!bF' FeG_(+!bF" FeG_(C MVI BC:4&o͈C!,͈C/C!^#V ;@!6!QG@4CPDAD BC!6BC/C! ^#V ;@}2@4C͂LDAX BC:&o͈C/C! ^#V ;@!!QG@4C;DCX BC!BC/C! ^#V ;@}2܅}2ޅ@4CMOV BC:ޅ&o!Bå!BåRLC! ^#V åå!B å!B#å!B&å!Cå!Cå!CåoRRC! ^#V åB ),6@JT^h*.S|!D|!D|!D|!D|!D|!D|RAL! ^#V | n SP&n!An!An!An8CMC! ^#V nBy|'1n*.V!B!B)!B!C)!B!D)!B!E)!B!H)!B!L)!B!M)!B!A)!C!B)!C!C))á!L!B)á!L!C)á!L!D)á!L!E)á!L!H)á!L!L)á!L!M)á!L!A)áB$2@N\j*.Ï!M!B)ø!M!C)ø!M!D)ø!M!E)ø!M!H)ø!M!L)ø   HLT! ^#V ø!M!A)ø!A!B)ø!A!C)ø!A!D)ø!A!E)ø!A!H)ø!A!L)ø!A!M)ø!A!A)øB-;IWes*. ADD!B, ADD!C, ADD!D, ADD!E,"SBB!A,:"B!!#!4!E!V!g!x!!!!!!!!":"*.R#I"ANA!B,{#Z"ANA!C,{#k"ANA!D,{#|"ANA!E,{#͍"ANA!H,{#͞"ANA!L,{#ͯ"ANA!M,{#"ANA!A,{#"XRA!B,{#"XRA!C,{#"XRA!D,{##%NZ2%% PUSH B! ^#V %2%ADI !^#V %!08%O%Z 5%Y%5%e%Z /%%t%Z 2%~%2%͐%ACI !^#V %!18%B$$$$% %&%?%I%U%_%k%n%z%%%%*.&%NC5&% POP D! ^#V &O((XRI !^#V O(!58O(B'')'5'J'V'p''''''''((O(*.[)](P 5Ä)r( POP PSW! ^#V Ä)ͅ(P /Ä)͑(DI! ^#V Ä)ͤ(P 2Ä)͹( PUSH PSW! ^#V Ä)(ORI !^#V Ä)!68Ä)(M 5Ä)(SPHL! B2*ш*ψ̓-*ˈ@s#r;@"ӈ"Ո"׈"و"ۈ@*ۈ*و*׈B2*ۈ! *ӈs*ۈ*و̓-*Ո@s#rw+;@""@E*^!eF7,*Ͱ+@:PASTMP00.$$$!G!!*! !ͭH!!!!^#s!!^!9͘F(,FeG*FeG. in RESETFeGͩC!FͩC!FI.Program abortedFeGͩCͻ@*! !!H*8!s*!eFҨ.*}/o|/g#"*@!sö.*@!s*<!s*;!s*! !s!g*s#r*?!s* ADD!H,  ADD!L, - ADD!M, > ADD!A, O ADC!B, ` ADC!C, q ADC!D, ͂ ADC!E, ͓ ADC!H, ͤ ADC!L, ͵ ADC!M, ADC!A, B  & 7 H Y j { *.XRA!E,{##XRA!H,{#&#XRA!L,{#7#XRA!M,{#H#XRA!A,{#BB"S"d"u"""""""""##0#A#{#*.Ó$͊#ORA!B,ü$͛#ORA!C,ü$ͬ#ORA!D,ü$ͽ#ORA!E,ü$#ORA!H,ü$#ORA!L,ü$#ORA!M,ü$$OR&NC/&&OUT !^#V &)&NC2&<& PUSH D! ^#V &U&SUI !^#V &!28&r&C 5&&́&C /&͓&IN !^#V &ͦ&C 2&&ͻ&SBI !^#V &!38&B%%% &#&/&I&b&l&x&{&&&&&&&*.^#V Ä))M /Ä))EI! ^#V Ä)/)M 2Ä)Ä)D)CPI !^#V Ä)!78Ä)BW(c((((((((( ))))5)8)Q));@",@*,!}o|g".*,!.F *>6*A6*D6*G6*J6*M6*P6*S6*V6*Y6*\6*_6*b6*e6!!!0s!!!!^#s***B2*! !!H*!eF|,*@!s*}/o|/g#"Ê,*@!s*<!s*;!s*8!s!g*s#r*6!s#r*9*s#r*=*s#r*4*A!s*8!s*9*s#r*4*s#r*=*s#r*^!eF*e9}/o}~/!e!s#rè/*b9ҏ/[0è/!e!*Es#r!e^#V!ͭF?0!e!s#r*<!s*;!s*4*s#r*!ͭF<"!SUB!B,:"!SUB!C,:"*!SUB!D,:";!SUB!E,:"L!SUB!H,:"]!SUB!L,:"n!SUB!M,:"!SUB!A,:"͐!SBB!B,:"͡!SBB!C,:"Ͳ!SBB!D,:"!SBB!E,:"!SBB!H,:"!SBB!L,:"!SBB!M,:"A!A,ü$$CMP!B,ü$#$CMP!C,ü$4$CMP!D,ü$E$CMP!E,ü$V$CMP!H,ü$g$CMP!L,ü$x$CMP!M,ü$͉$CMP!A,ü$B######## $$-$>$O$`$q$$$*.ç%$NZ5%$ POP B! ^#V %$NZ/%$/%&( 'PO5O(' POP H! ^#V O(/'PO/O(='XTHL! ^#V O(P'PO2O(c' PUSH H! ^#V O(|'ANI !^#V O(!48O(͙'PE5O(ͧ'PCHL! ^#V O(ͺ'PE/O('XCHG! ^#V O('PE2O('**Z80** SBC HL,DE! ^#V *h6*k6*B))))))))))))))**6**}R*^#V#{N*A*!È6#6#6#6!6#6!ƌ##"ƌ!9"">2!00"!46# x*!"m"h"0"+>2l2/>2t27> 2!"q!"4!7"!5"*+;@"ˈ"͈"ψ"ш@*ш*ψ*͈s#r*?!s*e9}//-!e!s#r-*b9=--**_7!e!*Es#r!e^#V!ͭF-!e!s#rÆ-;@""@E*8^!eFU.**!_0*!eFU.!FͩC!F-Unable to automatically close: 0*6!s#r*@~90!g^#V!g^#V4^#V)8<0;:[0*<!s*;!se0x1;@"""@E!g*s#r*8^!eF0*9*6^#Vs#r&=**4^#V!H*9!s#r&=1*8^!͘F1*   9*6^#Vs#r&=w1*8^!ͭFZ1!e!*Es#r*@s#rf1*!s#r*8!sE;@"""@*8^!͘Fң11**_7!e!s#r*!s#r*8!s1;@""@*!eF 2!!#"+*-#"-Ô3**-^!.eF*-*^F}ҕ4*-#"-!"+*+!F*-*^F}ҕ4!%*++**-^?2s*+#"+*-#"-E4*!!H*!:&o!@{ozgs!*!!ͭH!%*! !ͭH* 7*=:&o!?!5}2:&o!}2Û6:&Q7:&o!{ozg"9W7!"9*9b7;@""@E!e!*Es#r!e!s#rß7!g^#V8^!͘F7!g^#V!g^#V4^#V)8!g^#V!^}28!g^#V!^s!}2:&o;@"@!}2 !! !~gA@*^!͘F*^!F}\:ó:!*^+"#@"5*#"*5+"5|ʬ:**^!@ͳA}/ҩ:ó:v:!}2 : &o:!g^#V=!7!ͭH!g^#V8^!eF_;*7!!#"7;!g^#V6!s#rE)==;@}2A@!g^#V"M*M?^!eFҔ=!e!*MBEs#r!e!*MEs#r*M?!s*MB*M?^:A&os*M?*M?^#s!e!s#r!g^#V=!E!ͭH!g^#V8^!}2U:U&o@*e"i*i"m͘F?@{ozg##*m!*m"pÙ@J@`@!*p![@J@X@`@J@`@`@X@J@X@`@J@`@X@J@X@X@`@N2oGک@Ayʶ@#­@:o"r*r"t!9 ʹH*t"t! 9^#V!9A"t!9^#V!FFH!*FH!FH;2*F! FH*FͩCE2Ú2;@}2@:&o!a|F:&o!zF}҈2:&o!}o|g}2:&o}2 : &o;@"""@!e!s#r*^!ͭF*!^! eF}2*!!5ø2**!8!s5;@"/"1"3@*3*1*/*3*1*3^*1*/!{ozg{ozgͭH*3!*3^*/{ozgsÃ5;@}27@!g^#V!:7&os!g^#V!g^#V4^#V>9Q65;@""@!}2!:&o+"#@"*#"}2!g^#V!g^#V4^#V)8:&o,8;@""@*;!s!g*s#r*<~q8*;!s:9;:*@~:9*<*!^!eFs*!^! eF}2:&o*<^}8*;!s:&o*8^!eFEs*7^! eF);!! E"9Y;*7^!eFY;!! E"9!!E"9=á;!g^#V8^!eFҡ;*7!!Es*7^!ͭFy;=!g^#VA~;!g^#V<!s=!!g^#V9^#V+";#@"=*;#";*=+"=|=!͘F ?!g^#V"O!*O9^#V+"K#@"Q*K#"K*Q+"Q|?*E^}2G:G&o! eFg>W?*O8^!eFҳ>!:G&oE"I:G&o! eFҰ>!! E"I>!:G&oE"I*O8^!eF>:G&o! eF>!! E"I*E#9 ʹH!"9*t 6#A"v"x!9A*x|8AV?!!g^#V9^#V+"K#@"S*K#"K*S+"S|V?*E^#=*E#"E/?>`?;@"_"a@!g*as#r*a"c*c6^#V*c4^#VeFҰ?;:*c6!s#r*c<^}/?*c*c6^#V^}2U*c6*c6^#V!s#r@!v!9! 9 w# B! 9*v"v!9! 9 /w#.B! 9*v"v!9! 9 w#PB! 9*vuB# ycB!yMD!`iO>bB}obByʝBڣB!!bByʝBڣBÝBbBʣBØBbBʣBñB"^#V#"^#V#""**F C***   ͘F C**{_zW*^#V*#)*^#V!!"22"xC2O:|C*ʹH:G:2_!"*>O>2WCy2>2!BC"YGq* I I*g;~CYGöC6*g8~YG*g~ YGA}Dz D-eD*!!E"}+F-7?{_zWF}+F-7?zW{_2F~#bFʪFʕFFyFFF}rF|ʺF!`iFzF}|FrFFrFFzF{zںFrFF}ºF|rF!`iFFFÛF&}o&}o"g"" IY"I}- "I-I*yH8I)1Iy.I)IMD)I!HHͿGͿGùHxH~# x¾HHxH + +~+ xH{q#{Hn type 11 '[' expected 12 ']' expected 13 'END' expected 14 ';' expected (possibly on line above) 15 Integer expected 16 '=' expected 17 'BEGIN' expected 18 Error in declaration part 19 error in 20 '.' expected {/_z/WzDD'HXDHXDdHXD HXDXD!SD!F͈G32768>0_0vD!HsDxeDxzD˜D{˜DxGîDz/W{/_ Hz DxDD !HDîDɯ2"}22*g8~;E!ͶE: E: E!7"!5"ɯ2""YPzLG5G5G>2}2@G!aG*"""#+n&**͈G*|ʠG}o|gG I{NI#z§G:!2yGHx/Gy/O>=GH)G)G, GG33G)H21 '*' expected 50 Error in constant 51 ':=' expected 52 'THEN' expected 53 'UNTIL' expected 54 'DO' expected 55 'TO' or 'DOWNTO' expected in FOR statement 56 'IF' expected 57 'FILE' expected 58 Error in (bad expression*g<6!!G*g8~5E !H*g;6> *!>2*g; ~ E!ZE*:oÈE#:<2*g; ~QE Ey ʏEq:<26 :<2:<2ʫE#ÏE!#5ùE;@"@! *E"EF;@""@*M*o&"*", G!>2ɯ2#H{H{HxCH1HͿG{/oz/g#ͿG{/_z/WɯO>GziHVHiHͿG{/_z/W}o|g#ɯo>gͿGo>g>2!HHͿGͿGùHxH~# x¾HHxH + +~+ xH{q#{H 1 Error in simple type 2 Identifier expected 3 'PROGRAM' expected 4 ')' expected 5 ':' expected 6 Illegal symbol (possibly missing ';' on line above) 7 Error in parameter list 8 'OF' expected 9 '(' expected 10 Error i) 59 Error in variable 99 MODEND expected 101 Identifier declared twice 102 Low bound exceeds high bound 103 Identifier is not of the appropriate class 104 Undeclared identifier 105 sign not allowed 106 Number expected 107 Incompatible    subrange types 108 File not allowed here 109 Type must not be real 110 type must be scalar or subrange 111 Incompatible with part 112 Index type must not be real 113 Index type must be a scalar or a subrange 114 Base typ Error in type of standard procedure parameter 126 Number of parameters does not agree with declaration 127 Illegal parameter substitution 128 Result type does not agree with declaration 129 Type conflict of operands 130 Expression is not of set of expression 145 Type conflict 146 Assignment of files not allowed 147 Label type incompatible with selecting expression 148 Subrange bounds must be scalar 149 Index type must be integer 150 Assignment to standard function is not allowed 151 n of standard proc/func not allowed 165 Multidefined label 166 Multideclared label 167 Undeclared label 168 Undefined label 169 Error in base set 170 Value parameter expected 171 Standard file was re-declared 172 Undeclared external file 1dure too long 256 Too many external references 257 Too many externals 258 Too many local files 259 Expression too complicated 398 Implementation restriction 399 Implementation restriction 400 Illegal character in text 401 Unexpected end of e must not be real 115 Base type must be a scalar or a subrange 116 Error in type of standard procedure parameter 117 Unsatisified forward reference 118 Forward reference type identifier in variable declaration 119 Re-specified params not OK for type 131 Tests on equality allowed only 133 File comparison not allowed 134 Illegal type of operand(s) 135 Type of operand must be boolean 136 Set element type must be scalar or subrange 137 Set element types must be compatible 138 Type of va Assignment to formal function is not allowed 152 No such field in this record 153 Type error in read 154 Actual parameter must be a variable 155 Control variable cannot be formal or non-local 156 Multidefined case label 157 Too many cases in c74 Pascal function or procedure expected 183 External declaration not allowed at this nesting level 187 Attempt to open library unsuccessful 191 No private files 193 Not enough room for this operation 194 Comment must appear at top of program 2input 402 Error in writing code file, not enough room 403 Error in reading include file 404 Error in writing list file, not enough room 405 Call not allowed in separate procedure 406 Include file not legal 407 *** HEAP OVERFLOW *** 496 Invalia forward declared procedure 120 Function result type must be scalar, subrange or pointer 121 File value parameter not allowed 122 A forward declared function's result type can't be re-specified 123 Missing result type in function declaration 125 riable is not array 139 Index type is not compatible with the declaration 140 Type of variable is not record 141 Type of variable must be file or pointer 142 Illegal parameter solution 143 Illegal type of loop control variable 144 Illegal type ase statement 158 No such variant in this record 159 Real or string tagfields not allowed 160 Previous declaration was not forward 161 Again forward declared 162 Parameter size must be constant 163 Missing variant in declaration 164 Substitio01 Error in real number - digit expected 202 String constant must not exceed source line 203 Integer constant exceeds range 206 Illegal real number 250 Too many scopes of nested identifiers 251 Too many nested procedures or functions 253 Proced argument to INLINE pseudo procedure 497 Error in closing code file. 500 Non-ISO extension being used! 599 Implementation Restriction    !"P#!?"P#6 #*C*P!:*C*P!:^*P}o|g*P*P!}o|g*P!}o|g9s!A!ͻ3}2P:P&o5}2P"5!B=^#V:P&os!B!͜-5"P"5*P&!m<}2 Q*P&!w<}2 Q!P 0123=+:A&҃!)R:T6Cannot to convert a 8086 object file to L80 compatible:K;͏7!)R:wLib/MT+ aborted:K;͏75(*CͲ="C*C*C!(Q! =*C*C{ozg++"*Q!*Q*C*C! =*(Q*C<4!)R:!bad backchain, currentloc, :K;͏7!)R:#Lib/MT+ aborted:K;͏75(:P&ң*P!b:!)R:sExternal+offset table overflow:K;͏75!P*P+))*CͲ=s#r!}2P!P*P+))##*CͲ=s#r!}2P*P#"P(*CͲ="C(*C!K:*CͲ="C(*"\Q| *BQ*DQ+^ !! !Ca!*P++"HQ#|4"^Q*HQ#"HQ*^Q+"^Q|ʭ !C*HQ! ͤ=^!ͳ:Ҫ !! !C*HQ! ͤ=aN *C!͓:Ϳ ERL R86Ͱ4}o:A&o}/o} !! !*C&*C+))##^#Vl&w d ERL'R86Ͱ41j!"8Q*8Q*Cͳ:*8Q!ͳ*C*8Q^*8Q#"8Q*8Q!K:Ҍ!Ó!*C*8Q^*8Q#"8Q*C*8Q^*8Q#"8Q6Ppp7g!! *C!^!͓:*C!456789ABCDEF#!=!P: Q&o^!)R::[=!P: Q&o^:[=Ͳ="Q*Q5"Q"5*Q&*Ql&-"Q*Q*Q-"C""C-!9-!9-"Q!C #!=:A&o}/o*Q!K:}!"Q!*Qchain=:K;*CͲ=%!)R:!/:[=*(QͲ=%5*(Q"C*(Q!K:ґ!)R:iCommon not supported:K;͏7!)R:͌Lib/MT+ aborted:K;͏75(+!".Q(+ͲERL͹R86Ͱ4*C*CͲ=+^!͓:!"C*C!K:!C!*CCͲ="C*C*C!0Q! =!C*C*C! =!*C*0Q*C<ҥ !)R:w !bad backchain, currentloc, chain=:K;*CͲ=%!)R:!/:[=*0QͲ=%5*0Q"C*0Q!K: (*CͲ="C*C*C!ͤ=ͻ<` !)R: This module is too bigl&!! !*C&*Cl&!*P++"JQ#|4"`Q*JQ#"JQ*`Q+"`Q|Z !C*JQ! ͤ="bQ*bQ^F !! *bQ^!K:Ұ !÷ !*bQ ^#V&*bQ ^#Vl&*bQaW !! *bQ^!^!͓:}o*C!^!K:}o:A&o}A!H!!!*C!͓:o!ͳV!"P*C*C!ͤ=!K=*C*C!K=!C! !K=!"C!"C!"C!}2C"Ͳ="NQ!NQ*C*C! =!*C*C##"C"Ͳ="PQÛ|ÃÛJYwØT JßXöû a Î  0 [ ü(n5"P"5*C*P!:^*P!}o|g*P!}o|g:!}o|g"P*P5"P"P"5*P!}o|g!"P#!"P#+"Q#|4"XQ*Q#"Q*XQ+"XQ|9!C*Q+s:A&S!C!+! s5" Q}2"Q"$Q"5*P!+ͪ:!C*P! ͤ="ZQ*ZQ*$Q!=*ZQ:"Q&os*ZQ * Qs#r*P#"P!)R:Symbol table full:K;͏7+++!C!C!=.!C!*CͲ=.(+*C!K:E!C!*CͲ=.W!C!*CͲ=.!)R:̀External-offset not supported:K;͏7!)R:ͣLib/MT+ aborted:K;͏75(+ͽERLR864/!)R:*External + offset not supported by LIB/MT+, max=:K;!)R!*C!ͤ=!!)R:!H:[=͏7!)R:T Lib/MT+ aborted:K;͏75(*C!͓:} -"2Qd ^!"P!}2P5"BQ"5:A&Ҫ !"FQð !"FQ*BQ*FQ+^! K: *FQ+"FQð *FQ!*FQ+"DQ#|4"\Q*DQ#"DQ*\Q+K: ! !*bQ ^#V&*bQ ^#Vl&*bQaW 6 W L !*P++"LQ#|4"dQ*LQ#"LQ*dQ+"dQ|!! !!P*LQ+))^#V&!P*LQ+))^#Vl&!! !!P*LQ+))##^#V&!P*LQ!PQ*C*C! =!*C*C##"C"Ͳ="RQ*C##"C!)R:dcomrel detected, possible error:K;͏7!*C}2VQ*C*C:VQ&os*C#"C*͇!}2A!)R:ͻLib/MT+:K;͏7!)R: Release 5.5:K;͏7!)R: (c) 1981, MT Micro   SYSTEMS, Inc.:K;͏7!!A! =!@!(7!A67!.|7EBLD67#7!C *C!K:!)R:|Unable to find .:K;͉BLD:K;͘ file:K;͏7!)R:ͻLib/MT+ aborted:K;͏7ð!)R!.!!)R:H total bytes availablR:Lib/MT+ aborted:K;͏7ð*@#"@!"P*C*C!ͤ=!K=*C*C!K=!C! !K=!"C!"C!"P!}2P!"C!}2C!}2C!"C!}2C!"C!)R:͸Reading::K;!@:K;...:K;͏7-"C*C!K:y-"C*C*yOͶͶMyOMyOͶ :CEy2C>2C:C2C!C5o&:Coy2C>2C:C2C!C5G:C–y2C>2C:C2C!C5o&:Cy2C>2C:C2C!C5G:Cy2C>2C:C2C!C5G:C5o&:Cy2C>2C:C2C!C5G:CFy2C>2C:C2C!C5G:Cny2C>2C:C2C!C5G:C–y2C>2C:C2C!C5G:C¾y2C>2C:C2C!C5G:Cy2C>2C:C2C!C5G:C2Q2iR> 2(R!(R"Q!R"fR!+"R!x+"R1ËÚ5"R"R"5!V^#V!VK:e!V!V^#V####s#r*R!V^#Vs#r!V!V^#V*Rs#r5"R"R"5!V^#V!V^#V{ozg"S*S>s5}2/S"5:/S&o!ab::/S&o!zͪ:}:/S&o!}o|IS!+!9S*3Sl&!w<^s!IS!+!9S*3S&!m<^s!IS!+!9S*3S&!w<^s*1S!K:җ !IS!+!IS! =!*1S!ͤ=+"3S#|4"OS*3S#"3S*OS+"OS| !IS*3S+^x+ù (!5"US"WS"YS"[S"5e:K;͏7.!̀<"C!)R:@Largest module can be: :K;!)R!*C!ͤ=!!)R:rH bytes:K;͏7!C*C!ͤ=(!C*C(!@:!@!PͲ8͜7!@͸L80Ͱ4!@l80Ͱ4}o}2A:A&!@:!@!PͲ8͜7!B!!@'!C-"C*Cpsv#"C*CÔ1ý4ý7ý:ý=ý@ýCýFýIýLýOýRýUýXý[ýmý64:@FLRX^djpv|6& :C&!A!!Ck&!)R:End of :Ky2C>2C:C2C!C5o&:C;y2C>2C:C2C!C5G:Cby2C>2C:C2C!C5G:CŠy2C>2C:C2C!C5G:C²y2C>2C:C2C!C5o&:Cy2C>2C:C2C!C5G:Cy2C>y2C>2C:C2C!C5G:C6y2C>2C:C2C!C5o:C^y2C>2C:C2C!C5G:C…y2C>2C:C2C!C5G:C­y2C>2C:C2C!C5G:Cy2C>2C:C2C!C5G:Cy2C>2C:Cg}2/S:/S&o!9~:&:/S&o}2/S:/S&o!}o|g"%S*%S5" S" S"S"S"5!T*Ss#r* S!~:* S!ͳ:}ҁr!"#S!S*#S+s!S*#S^!K:*#S!͓:}*#S+"#S*#S#"#S*S;~҇*S8^!͓:+}2S!S!*[S*YS*WS'*[S*YS͏#*USn4s#r5"]S"_S"aS"cS"eS"5*eS*cS*aS'*eS! *]Ss*eS*cS͏#*_Sn4s#rÃ!5"oS"qS"5Ϳ9*qS^!K:C"*qSͼ!@:PASTMP00.$$$!:!R!*qS! ! =!R!!R!^#s!R!^B!̀!n4!K:n!)R:5Unable to create: :K;!@:K;͏7!)R:bLib/MT+ aborted:K;͏7ð!"@!}2C!"C!@!ͳ*}/#!@:!@!PͲ8͜7!A!!@'!A!͏#n4!K:$!)R:Unable to open: :K;!@:K;͏7!);!@:K; reached:K;͏7Á!! *C!͓:J!ͳ1!!!B!!Ck&!)R:͉Lib/MT+ 5.5 completed, :K;*@:7ͧ processed:K;͏75M:C:C&o2C2C<2C:CGy2CMyOͶͶMyOͶ2C:C2C!C5G:C,y2C>2C:C2C!C5G:CTy2C>2C:C2C!C5G:C|y2C>2C:C2C!C5G:C¤y2C>2C:C2C!C5G:Cy2C>2C:C2C!C5G:Cy2C>2C:C2C!C2C!C5G:C%y2C>2C:C2C!C5G:CMy2C>2C:C2C!C5G:Cuy2C>2C:C2C!C5g*}ʢ^#V#{ʞ‘!R6#6#6#6!R6#6!V##"V!9"V"V>2R!00"R!fQ6# x!"Q"Q"bR"]R>2Q2aR>*#S++s!"!S!!S^+"#S#|4"MS*#S#"#S*MS+"MS|c*!S!ͤ=!S*#S^ͽ"!S-!!S* S* S =5"1S"3S"5S"7S"5!T*7Ss#r!9Sͭ0123456789ABCDEF#!=*1S!~:*1S!ͳ:} !IS!+!9S*3Sl&!m<^s!!9~:4"!R!!0s!R!!R!^#s*qS*oS*qS'*qS! !!K=*oS!K:҈"*qS@!s*oS}/o|/g#"oSÖ"*qS@!s*qS<!s*qS;!s*qS8!s!T*qSs#r*qS6!s#r*qS9*oSs#r*qS=*qSs#r   *qS4*oSs#r*qS?!s*qS-}/;#!T!s#rË#*qS-I#Ë#*qS*oSͽ+!T!*qSͼ9s#r!T^#V!͓:ҋ#!T!s#rÒ#5"{S"}S"5Ϳ9*}S8^!K:a$*}S*{S!Sk&*S!K:a$!)R:͏7!)R: $Unable to automaticaS!͓:H&*}S6!s#r*}S@~E&!T^#V!T^#V4^#V͇,H&/g&*}S<!s*}S;!sq&Ä'5"S"S"S"5Ϳ9!T*Ss#r*S8^!K:&*S9*S6^#Vs#r̈́1*S*S4^#V!K=*S9!s#r̈́1''*S8^!K:#)!"S*S!^'}2S))!"S*S"S!"S*S*S^!.{5!:{5\66}/o*S*Sͳ:}o*S*S^ͪ:}Ҵ)!S*S+*S*S^'s*S#"S*S#"S9)*S*S^!.K:*S*S^ͪ:}:**S#"S!"S*S!ͳ:*S*S^^#V8^!~:K,!T^#V!T^#V4^#V͇,!T^#V!^}2S|,!T^#V!^}2S!T^#V!T^#V4^#V͇,:S&oÊ,5"S"S"5*S;!s!T*Ss#r*S<~,*S;!sØ-/*S@~Ҙ-*S<*S!^!K://.!}2/T:/T&o/!T^#V=!YT! =!T^#V8^!K:ҽ/*YT!!ͼ9s*YT^! K:҇/!! ͼ9"[T÷/*YT^!K:ҷ/!! ͼ9"[T!!ͼ9"[T}1/!T^#V8^!K:/*YT!!ͼ9s*YT^!͓:/}1!^:cT&os*oT?*oT?^#s!T!s#r!T^#V=!gT! =!T^#V8^!~:g3!T^#V"qT!*qT9^#V+"mT#|4"sT*mT#"mT*sT+"sT|d3*gT^}2iT:iT&o! K:2õ3*qT8^!K:3!:iT&oͼ9"kT:iT&o! K:3!lly close: :K;*}S:K;($ in RESET:K;͏7!)R:͏7!)R:U$Program aborted:K;͏75*}S! !!K=*}S8!s*{S!K:Ҵ$*{S}/o|/g#"{S*}S@!s$*}S@!s*}S<!s*}S;!s*}S! !s!T*}Ss#r*}S~:''*S9*S6^#Vs#r̈́1Ã'*S8^!͓:f'!T!*Sͼ9s#r*Sn4s#rr'*S!s#r*S8!sͿ95"S"S"S"5*S8^!~:ү''*S*Sͽ+!T!s#r*S!s#r*S8!s'?(5}2S"5:S&o!aͪ:}:*!S*S+*S*S^'s*S#"S*S#"S)*S!!K=*S!:S&o!@{ozgs!S*S!! =!S*S! ! =*S8!sö*5"S"S"5*S!}/o|/g#K:*!fQ<^}2S**S<^}2S:S&s*S!^! K:}2#T:#T&o*S<^}D-*S;!s:#T&o*S8^!K:}h-/*S<^*S;^}Ҙ-*S!! sß-5"%T"'T"5!T*'Ts#r̈́1-p.5"-T"5!}2)T*-T-CON:Ͱ4.*-T8!s!}2)TT^#VA~$0!T^#V<!s}1!!T^#V9^#V+"]T#|4"_T*]T#"]T*_T+"_T|f1!T^#V"aT*aT?^!K:0*aT?!s*aTA^}/0!*aTBͼ9"[T!T!*aTͼ9s#r!T^#V!͓:0*aTA!s*aTA~%1*YT!s*a! ͼ9"kTZ3!:iT&oͼ9"kT*qT8^!K:Z3:iT&o! K:Z3!! ͼ9"kT*gT#"gTÒ2ô3!!T^#V9^#V+"mT#|4"uT*mT#"mT*uT+"uT|ʴ3*gT^́1*gT#"gTÍ3Z3þ35"T"T"5!T*Ts#r*T"T*T6^#V*T4^#VK:4/*?!s*}SA!s*}S8!s*}S9*{Ss#r*}S4*{Ss#r*}S=*}Ss#r*}S^!K:*}S-}/o}Ҋ%!T!s#rô%*}S-қ%g&ô%!T!*}Sͼ9s#r!T^#V!͓:K&!T!s#r*}S<!s*}S;!s*}S4*{Ss#r*{b::S&o!zͪ:}-(:S&o!}o|g}2S:S&o}2S:S&o5"S"S"S"5!T!s#r*S^!͓:*S!^! K:}Ҙ(*S!!+](*S*S!:*S^!͓:ү*!@}2S!S( #!=!S( #!=*S!^!:o +5"S"S"S"5*S*S*S*S*S*S^*S*S!{ozg{ozg =*S!*S^*S{ozgs{+5}2S"5!T^#V!:S&os!T^#V!T^#V4^#V͜-+5"S"S"5Ϳ9!T!*Sͼ9s#r!T!s#r+!Th.*-T.LST:Ͱ4-.*-T8!s!}2)Th.*-T9.KBD:Ͱ4*-TH.TRM:Ͱ4}h.*-T8!s!}2)T:)T&o5"3T"5!}2/T!7T! !~5>5*3T^!~:*3T^!ͳ:}Һ./!*3T^+"5T#|4"WT*5T#"5T*WT+"WT| /*3T*5T^!7T'56}/T<!s*aT6!s#rͿ9}1E1*YT*aTB*aT?^^s*aT?*aT?^#s*YT#"YTJ0!T^#V6!s#rͿ9Ç1)25}2cT"5!T^#V"oT*oT?^!K:1!T!*oTBͼ9s#r!T!*oTͼ9s#r*oT?!s*oTB*oT?T6!s#r*T<^}/\4*T*T6^#V^}2wT*T6*T6^#V!s#rc4!}2wT:wT&oq4*T"T*T"T~:ڝ4{ozg##*T!*T"T4ͨ4¾4!*T!ù4ͨ4¶4þ4ͨ4ھ4ʾ4ö4ͨ4ڶ4þ4ͨ4ھ4ö4ͨ4ڶ4ʶ4þ4N2T   G5Ay5# 5:T"T*T"T!9 =*T"T! 9^#V!9_5"T!9^#V!9 =!"9*T 6#s5"T"T!9q5*T|–5͚5*T:T_!9:T_!5~Gw @"T"T"T!9q5*T|–5"T*T|–5}ږ5 6͚5*T#"T;>8d;>8 ;>8>8!98!:n;32768>0_0\8![=Y8xK8xz8~8{~8xGÔ8z/W{/_ ;z†8x8ʰ8 ![=ë8Ô8ɯ2V"V}2U2U*T8~!9!U͜9:U8:U8*T<6!U!:*T8"VYPz2;;;>2V}2V&;!G;*R"V"V"V#+n&*V*Vn;*V|ʆ;}o|g;l={Nb=#z;:V!2Vyµ;;x/Gy/O>=;;););, ;þ;33þ;);, þ;!>2Vɯ2V <; 5.5 ;----------------------------------------------------------------; ; ; ; MODULES - @DIV, @MOD AND ENTRY POINT @XDIVD ; ; LAST UPDATED: NOV 14, 1981 ; ; ; ;----------------------------------------------------------------;******************** ;*************************************************** ;SUBR :DHLDEBYBC ;PURP :DIVIDE HLDE BY BC ;ENTRY :HL=DIVIDEND HIGH WORD,DE=DIVIDEND LOW WORD ; :BC=DIVISOR ;EXIT :HL=QUOTIENT,DE=REMAINDER ; :IF BC=0 THEN ERROR=ZERODIVISOR *T{z5͚5*T"T!9DM! 9^#V"T|V6}_F:T_!5~V6!"9*TL6"T!9! 9 w#k6! 9*T"T!9! 9 /w#Œ6! 9*T"T!9! 9 w#®6! 9*T"T^#V#"T^#V#"T"T*T*Tͳ:7*T*T*T~:7*T~9 ![=*T;6> *V!U>2U*T; ~8!@9*R:UU9f9#:U<2U*T; ~798y u9q:V<2V6 :U<2U:V<2Vʑ9#u9!U#5ß95"V"5! *Vͼ9"V995"V"V"5*VM*Vo&"V*V"V*V!!ͼ9"VaGzO<<gͥ;o>g>2V!;;ͥ;ͥ;!!}|͝<ʓ<Ø<͝<“<Ø<<ژ<ʘ<Ó<<Ҙ<ʘ<Ó<<ғ<ʓ<Ø<<ړ<ʓ<Ø<} =| PUBLIC @DIV ;SIGNED DIV PUBLIC @MOD ;SIGNED MOD PUBLIC @UDV ;UNSIGNED DIV PUBLIC @UMD ;UNSIGNED MOD PUBLIC @XDIVD ;USED BY WRITE INTEGER PUBLIC @GZF ;GET DIVIDE BY ZERO BOOLEAN FLAG ROUTINE EXTRN @HLT DSEG DIVZFLAG: DS 1 ;=; :NOTE THE QUOTIENT MUST BE BETWEEN 0,65535 ; : EXAMPLE: 70000/1 IS ILLEGAL BUT 70000/2 IS LEGAL ;USED :ALL ;CALLS :@DHLDEBYBC ;MACROS:NEGBC ;********************************************************** ; ; @DHLDEBYBC: XRA A STA DIVZFLAG ;INITI*T{_zW*T^#V*T#)*T^#V!T!T"U2T2V"Ul72UO:Tp7*U=:TG:U2T_!T"U*U>O>2VK7y2U>2U!U67 b= b=*T;~گ7?;Ü76*T8~?;*T~ ?;Ac8z7-K8{/_z/Wz*8';>8}:-7?{_zW:}:-7?zW{_:~#H:ʐ:{:ʰ:_:ç:͹:}X:|ʠ:!`i͹:zt:}|:X::X:͹:zt:{zڠ:X:͹:} :|X:!`i͹:e:͹:Á:&}o&}o"T"R"R!+"R!x+"Rɯ2V"V=7|=x'=~# x=5=xI= + +~+ x?={q#{R=l=Ý=}- ́=-u=*RyHҗ=)=y=È=MD͈=}lg 1 IF PREV DIVIDE WAS DIVIDE BY 0 CSEG @GZF: POP H LDA DIVZFLAG ;PUT INTO CARRY RAR ;AND PUSH IT (CARRY IS LOW ORDER BIT OF PSW) PUSH PSW ;PUT FLAG ON STACK PCHL ;AND EXIT DIVPOS: XCHG LXI H,0 ;*******************************ALLY NO ERRORS MOV A,C ORA B JNZ CONT0 ;JIF NOT ZERO ;ELSE ERROR EXIT JMP ZDIV1 ; CONT0: ;DIVISOR<>0 MOV A,B CMA MOV B,A MOV A,C CMA MOV C,A INX B ;TAKE NEGATIVE OF BC SO DAD B WILL ;SET HL=HL-BC MVI A,17 ;16 BITS    + 1 NEXTBIT: DCR A JNZ CONT1 ;JIF NOT DONE ;ELSE EXIT XCHG ;HL=QOUTIENT,DE=REMAINDER JMP DIVXIT ; ;NOT DONE ;SHIFT HL LEFT CY=BIT 15 CONT1: DAD H JC DIV2 ;JIF BIT 15=1 ; ;SHIFT DE LEFT AND INTO HL (HL BIT0=DE BIT 15) XCHG DAD H  DIV3 ;JIF BIT 15=0 INR L ;ELSE SET BIT0 OF HL=1 ; ;NOW HL=HL-ABS(BC) AND E=E+1 DIV3: DAD B INR E JMP NEXTBIT ;CONTINUE ON ; ; DIVXIT: XCHG RET ZDIV1: MVI C,9 LXI D,DIV0MSG CALL 5 CALL @HLT DIV0MSG: DB 13,10,'DIV 0',13,,A MOV A,D CMA MOV H,A INX H ;TAKE TWOS COMPLEMENT OF NUMERATOR CALL DIVPOS MOV A,E CMA MOV E,A MOV A,D CMA MOV D,A INX D ;TAKE TWOS COMP OF QUOTIENT RET ISMOD: LXI H,0FFFFH ;SIGN EXTEND CALL @D,A CALL DIVPOS XRA A SUB L MOV L,A MVI A,00H SBB H MOV H,A RET Y99: JMP ZDIV1 MVI A,1 STA DIVZFLAG LXI D,0FFFFH LXI H,0 RET @DIV: POP H POP B POP D PUSH  XCHG ;DE SHIFTED CY=DE BIT 15 JNC DIV0 ;JIF BIT15=0 (HL BIT0=0 ALREADY) INR L ;ELSE SET IT TO 1 ; ;IF ABS(BC)>=HL THEN HL=HL-ABS(BC) AND E=E+1 ;?? DIV0: PUSH H ;SAVE HL DAD B JC DIV1 ;JIF ABS(BC) >= HL ; ELSE GOTO NEXTBIT POP H ;DIS10,'$' RET @XDIVD: XRA A STA DIVZFLAG ORA C JNZ Y10 ;CHECK FIRST BYTE, IF NOT ZERO BRANCH ORA B JZ Y99 ;IF NEXT BYTE 0 THEN DIVIDE BY 0 XRI 80H JZ Y99 ;MAKE SURE ITS NOT 32768 Y10: MOV A,B ANA A JM Y50 ;BR IF DENOHLDEBYBC ;GO DO THE DIVIDE RET ;AND EXIT Y50: XRA A SUB C MOV C,A MVI A,00H SBB B MOV B,A MOV A,D ANA A JM Y80 JNZ Y60 ORA E JZ Y80 Y60: XCHG CALL DIVPOS MOV A,E CMA H MVI L,0 ;SIGNAL NOT MOD CALL @XDIVD POP H PUSH D PCHL @MOD: POP H POP B POP D PUSH H MVI L,1 ;SIGNAL MOD CALL @XDIVD XTHL PCHL @UDV: ;UNSIGNED DIVIDE POP D ;RET ADR POP B ;DIVIDEND POP H ;DIVISOR PUSCARD SUBSTRACTION JMP NEXTBIT ; ; WELL ABS(BC) < HL SO INR E AND SET HL=HL-ABS(BC) ; DIV1: INR E INX SP INX SP ;DROP THE SAVED HL FROM THE STACK JMP NEXTBIT ; ; ;ARRIVE HERE IF NEXTBIT=1 DIV2: XCHG DAD H XCHG ;SHIFT DE LEFT JNCMINATOR NEGATIVE, ILLEGAL Y20: ORA D JM Y40 ;BR IF NUMERATOR NEGATIVE Y30: XCHG CALL DIVPOS RET Y40: ;COME HERE WHEN NUMERATOR IS NEGATIVE MOV A,L CPI 1 ;IF WE ARE ENTERED VIA MOD BRANCH JZ ISMOD MOV A,E CMA MOV L MOV E,A MOV A,D CMA MOV D,A INX D Y70: MOV A,L SUB C MOV L,A MOV A,H SBB B MOV H,A INX H RET Y80: XRA A SUB E MOV L,A MVI A,00H SBB D MOV HH D CALL DIVPOS XCHG XTHL PCHL @UMD: ;UNSIGNED MOD POP D POP B POP H PUSH D CALL DIVPOS XTHL PCHL END    (* 5.5 *) MODULE IOERROR; (*$I 80rtp/fibdef.lib*) (*$M @IOERR*) (*$M **) VAR @LFB : EXTERNAL ^FIB; @TMP : ^FIB; (* FOR SAVING @LFB *) PROCEDURE @IOERR(CPMFUNC:INTEGER); BEGIN @TMP := @LFB; CASE CPMFUNC OF 15 : WRITELN('UnablFUNC / "MOV C,L / "LHLD / PARM / "XCHG / "CALL / CPMENTRYPOINT / "MOV L,A / "MVI H / 0 / "SHLD / RESULT ); @BDOS := RESULT; IF FUNC < 15 THEN EXIT; IF FUNC = 26 THEN EXIT; IF (FUNC=15) OR (FUNC=16)e to open: ',@TMP^.FNAME); 16 : WRITELN('Unable to close: ',@TMP^.FNAME); 21 : WRITELN('Error writing to: ',@TMP^.FNAME); 22 : WRITELN('Unable to create: ',@TMP^.FNAME) END; (* CASE *) @LFB := @TMP END; MODEND.  OR (FUNC=22) THEN BEGIN IF RESULT = 255 THEN @IOERR(FUNC) END ELSE IF (FUNC = 21) THEN IF RESULT <> 0 THEN @IOERR(FUNC); END; PROCEDURE @DFLT; VAR I : INTEGER; BEGIN I := @BDOS(26,WRD($80)); (IOCHK.ERL IOERR.ERL XBDOS.ERL IOERR SRCZXBDOS SRC[IOCHK $$$(* 5.5 *) MODULE BDOSFUNC; (*$M @BDOS*) (*$M @DFLT*) (*$M **) EXTERNAL PROCEDURE @IOERR(CPMFUNCNUM:INTEGER); FUNCTION @BDOS(FUNC:INTEGER; PARM:WORD):INTEGER; CONST CPMENTRYPOINT = 5; VAR RESULT : INTEGER; BEGIN INLINE( "LHLD / * DEFAULT DMA ADDRESS *) END; MODEND.  IF RESULT <> 0 THEN @IOERR(FUNC); END; PROCEDURE @DFLT; VAR I : INTEGER; BEGIN I := @BDOS(26,WRD($80)); (   ;----------------------------------------------------------------; ; ; ; MODULE @RST ; ; READ STRING CONSOLE ; ; LAST UPDATED: MARCH 8, 1981 ; ; TO ADD TAB EXPANSION ; ; ; ;-----EG @RST: XRA A STA COLCTR POP H SHLD RETADR POP H ;GET MAX DEFINED LENGTH MOV A,L STA STRBUF XRA A STA STRBUF+1 LHLD @LFB LXI D,OPTION DAD D MOV A,M CPI FCONIO JNZ NONCONSOLE ;BR IF NOT A CONSOLE FILE FOR INPUT ;OV A,M CPI FCONIO ;IF @LFB^.OPTION <> FCONIO THEN BRANCH JNZ RSTXIT MVI C,0DH ;IF A CONSOLE FILE THEN ECHO CRLF PUSH B LXI H,-1 PUSH H PUSH H CALL @CHW LHLD @LFB LXI D,FEOLN DAD D MVI M,1 ;SET @LFB^.EOLN := TRUE RSTXIT: MVR POINTER LDA STRBUF+1 CPI 0FFH ;STRING OVERFLOW? JZ NOSTORE ;IF SO THEN DONT STORE IT CALL STORE$WITH$TAB$EXPANSION INX H ;BUMP POINTER LDA STRBUF+1 INR A STA STRBUF+1 NOSTORE: XCHG LHLD @LFB ;GET FIB POINTER LXI B,FEOLN ;R-----------------------------------------------------------; PUBLIC @RST EXTRN @STR EXTRN @CHW EXTRN @SYSIN EXTRN @LFB EXTRN @CPMRD ;CP/M READ STRING CALLER ;PROCEDURE @CPMRD(VAR BUF:RDBUF); ;RDBUF = BYTE,BYTE,ARRAY[1..255] OF  ; IF IT IS A CONSOLE FILE THEN USE CP/M READ CONSOLE BUFFER ; LXI H,STRBUF PUSH H CALL @CPMRD ;GO READ CONSOLE BUFFER FROM CP/M LDA STRBUF+1 ORA A JZ ENDOFINPUT ;NO CTRL/Z FOUND LDA STRBUF+2 CPI 1AH ;CTRL/Z ON INPUT (EOF)? JNZ ENI A,0DH ;SO READLN WILL WORK LHLD RETADR PCHL ; ; COME HERE IF NON-CONSOLE READ ; JUST CALL INDIRECT TO @SYSIN UNTIL A CR IS FOUND ; NONCONSOLE: LXI H,STRBUF+2 ;POINT TO INPUT BUFFER AREA MVI A,0 STA STRBUF+1 ;SET LENGTH PUSH H LHLDEAD CHARS UNTIL EOLN DAD B MOV A,M RAR XCHG JNC NEXTCH ;LOOP UNTIL EOLN JMP ENDOFINPUT ;AND WE ARE DONE STORE$WITH$TAB$EXPANSION: MOV A,C CPI 09H ;TAB CHARACTER? JZ TAB$EXPAND MOV M,C LDA COLCTR INR A STA COLCTR RET TAB$CHAR; OPTION EQU 56 ;(FREAD,FWRITE,...FLSTOUT) FCONIO EQU 4 ;USED BY THIS MODULE FEOLN EQU 59 ;BOOLEAN; FEOF EQU 60 ;BOOLEAN; DSEG STRBUF: DS 1 DS 1 DS 255 ;FOR USING CP/M INPUT RETADR: DS 2 COLCTR: DS 1 ;FOR TAB EXPANSION CSDOFINPUT LHLD @LFB ;GET POINTER TO FIB LXI D,FEOF DAD D ;POINT TO END OF FILE BOOLEAN MVI M,1 ENDOFINPUT: ;SHARED CODE LXI H,STRBUF+1 PUSH H LXI H,255 PUSH H CALL @STR ;STORE THE STRING LHLD @LFB LXI D,OPTION DAD D M @LFB ;GET FIB POINTER LXI B,FEOLN ;READ CHARS UNTIL EOLN DAD B MOV A,M POP H RAR JC ENDOFINPUT NEXTCH: PUSH H LXI H,RETURN PUSH H LHLD @SYSIN PCHL ;GO CALL THE INPUT ROUTIN RETURN: POP B ;GET CHAR POP H ;GET BUFFEEXPAND: MVI M,' ' ;STORE AT LEAST ONE BLANK LDA STRBUF+1 INR A STA STRBUF+1 LDA COLCTR INR A STA COLCTR CPI 0FFH ;STRING OVERFLOW? RZ ;IF SO THEN EXIT ANI 7 ;ON BOUNDARY? JZ DONE$TABBING ;RETURN IF YES INX H JMP TAB   $EXPAND DONE$TABBING: PUSH H LXI H,STRBUF INX H DCR M POP H RET END PI 0FFH ;STRING OVERFLOW? RZ ;IF SO THEN EXIT ANI 7 ;ON BOUNDARY? JZ DONE$TABBING ;RETURN IF YES INX H JMP TABTHING WAS A CR CALL @GETCHR POP B JMP @CWT ITSEOLN: MVI M,0 ;TURN EOLN OFF LHLD @LFB LXI D,OPTION DAD D MOV A,M CPI FCONIO RNC ;IF CONSOLE THEN WE ARE DONE CALL @GETCHR ;GOBBLE BLANK AND PUT LF IN BUFFER POP B LHLMODULE GETREC; (*$M GET*) (*$M **) (*$I 80rtp/fibdef.lib*) VAR @LFB: EXTERNAL ^FIB; EXTERNAL PROCEDURE @RNB; PROCEDURE GET(VAR F:FIB; SZ:INTEGER); VAR IS_EOLN : BOOLEAN; BEGIN F.FEOLN := FALSE; (* DEFAULT IS THAT WE RESET IT *)  END END; MODEND.  IF (IS_EOLN) AND (F.OPTION = FRDWR) THEN (* GOBBLE LF *) @RNB; IF F.FEOF OR F.FEOLN THEN F.FBUFFER[0] := ' '; ;----------------------------------------------------------------; ; ; ; MODULE @CWT ; ; LAST UPDATED: SEPT 6 1980 ; ; ; ;----------------------------------------------------------------; PUBLIC @CWT ;WAIT FOR CR EXD @LFB LXI D,FBUFFER DAD D MOV A,M CPI 0AH ;LF TO GOBBLE? RNZ ;RETURN IF DONE CALL @GETCHR ;GOBBLE LF AND PUT NEXT CHAR IN BUFFER POP B RET END  @LFB := ADDR(F); IF F.FEOF THEN BEGIN F.FEOLN := TRUE; EXIT END; @RNB; (* GO READ FROM THE FILE/CONSOLE *) IF F.FTEXT THEN (* TEXT FILE, EOLN/EOF MUST BE SET *) BEGIN F.FEOF := (F.FBUFFER[0] = CHR($1ATRN @GETCHR EXTRN @LFB FEOLN EQU 59 ;BOOLEAN; FBUFFER EQU 194 ;ARRAY [0..0] OF BYTE OPTION EQU 56 ;(FREAD,FWRITE,...FLSTOUT) FCONIO EQU 4 ;USED BY THIS MODULE @CWT: LHLD @LFB LXI D,FEOLN DAD D MOV A,M RAR JC ITSEOLN ;BR IF LAST )) OR (F.FEOF); IS_EOLN := (F.FBUFFER[0] = CHR($0D)); IF (IS_EOLN) OR (F.FEOF) THEN F.FEOLN := TRUE; IF (IS_EOLN) AND (F.OPTION = FRDWR) THEN (* GOBBLE LF *) @RNB; IF F.FEOF OR F.FEOLN THEN F.FBUFFER[0] := ' ';    .OPTION = FCONIO THEN (* CON:, DO AN ECHOING READ *) BEGIN DSTPTR^ := CHR(@BDOS(1,WRD(0))); (* GO READ A CHAR WITH ECHO *) IF DSTPTR^ = $0D THEN (* ECHO CR WITH CRLF *) I := @BDOS(2,WRD($0A)) ELSE IF DSTPTR^ = $08 THENHEN BEGIN @LFB^.FEOF := TRUE; EXIT END; FOR N := 1 TO @LFB^.IOSIZE DO BEGIN WITH @LFB^ DO BEGIN IF FSECINX = 128 THEN (* TIME TO READ MORE *) BEGIN FSECINX := 0; IF NMODULE RNBMODULE; (*$M @RNB*) (*$M **) (*$I 80rtp/fibdef.lib*) VAR @LFB : EXTERNAL ^FIB; RESULTIO: EXTERNAL INTEGER; EXTERNAL FUNCTION @BDOS(FUNC:INTEGER; PARM:WORD):INTEGER; EXTERNAL PROCEDURE @DFLT; (* PURPOSE: READ n BYTES FROM A (* ECHO BS WITH SP/BS *) BEGIN I := @BDOS(2,WRD(' ')); I := @BDOS(2,WRD($08)) END; EXIT END ELSE IF @LFB^.OPTION = FTRMIO THEN (* KBD: DO A NON-ECHO READ *) BEGIN REPEAT DSTPTR^ := CHR(@BDOS(6,WRD($FF))); OT NOSECTRS THEN BEGIN I := @BDOS(26,WRD(ADDR(FSECTOR))); RESULTIO := @BDOS(20,WRD(ADDR(FCB))); IF RESULTIO <> 0 THEN NOSECTRS := TRUE END END; IF NOSECTRSMODULE PUTREC; (*$M PUT*) (*$M **) (*$I 80rtp/fibdef.lib*) VAR @LFB: EXTERNAL ^FIB; EXTERNAL PROCEDURE @WNB; PROCEDURE PUT(VAR F:FIB; SZ:INTEGER); BEGIN @LFB := ADDR(F); @WNB (* GO WRITE BUFFER OUT *) END; MODEND.  FILE POINTED TO BY @LFB *) (* n IS SPECIFIED BY @LFB^.IOSIZE *) (* LAST UPDATE: SEPTEMBER 17, 1980 *) PROCEDURE @RNB; VAR DSTPTR: ^BYTE; N,I : INTEGER; BEGIN MOVE(@LFB^.FBUFADR,DSTPTR,2); (* SET DEST POINTER *) IF @LFB^(* GO READ A CHAR WITH NO ECHO *) UNTIL DSTPTR^ <> 0; EXIT END ELSE (* check for rdr: *) IF @LFB^.OPTION = FAUXIO THEN (* RDR: *) BEGIN DSTPTR^ := CHR(@BDOS(3,WRD(0))); (* GO READ RDR *) END; IF @LFB^.NOSECTRS T THEN BEGIN DSTPTR^ := CHR($FF); FEOF := TRUE; BUFIDX := 0; @DFLT; EXIT END ELSE DSTPTR^ := FSECTOR[FSECINX]; FSECINX := FSECINX + 1 END; (* WITH *) DSTPTR := D   STPTR + 1 END; @LFB^.BUFIDX := 0; (* SO GNB WORKS *) @DFLT; (* TO PROTECT USER DATA FROM I/O CLOBBER *) END; MODEND. PROCEUDRE @DFLT; (*$E-*) PROCEDURE WRITEBYTE(CH:CHAR); VAR I : INTEGER; BEGIN WITH @LFB^ DO BEGIN IF FSECINX = 128 THEN (* TIME TO WRITE *) BEGIN RESULTIO := @BDOS(26,WRD(ADDR(FSECTOR))); RESULTIO := @BDOS(21,WRD(ADDR(Fr (option=fauxio)) then goto 1; IF OPTION = FLSTOUT THEN BEGIN I := @BDOS(5,WRD(CH)); (* WRITE IT TO THE PRINTER *) IF CH = CHR($0D) THEN (* WE MUST ECHO LF *) I := @BDOS(5,WRD($0A)) END  SRCADR := SRCADR + 1 END; @DFLT; END; MODEND. D; (* WE GET HERE ONLY IF NON-CONSOLE I/O *) FOR N := 1 TO @LFB^.IOSIZE DO BEGIN WRITEBYTE(SRCADR^); CB))); FSECINX := 0 END; FSECTOR[FSECINX] := CH; FSECINX := FSECINX + 1 END (* WITH *) END; (* WRITEBYTE *) (*$E+*) PROCEDURE @WNB; LABEL 1; VAR SRCADR : ^CHAR; CH : CHAR; N,I : INTEGER; BEGIN RESULTIO := 0; ( ELSE BEGIN if option = fconio then i := @bdos(2,wrd(ch)) else if option = ftrmio then i := @bdos(6,wrd(ch)) else (* must be fauxio *) i := @bdos(4,wrd(ch)); IF OPTION = FCONIO THEN IF CH=CHR($0D) THEN (* W; VERSION 0018 AUTOMATICALLY UPDATED BY MODIFIED WORDMASTER ;---------------------------------------------------------------; ; ; ; Overlay Management Module for Pascal/MT+ 5.5 ; ; ; ; Created: March 18, 1981 ; ; Updated: Nov(* 5.5 version *) MODULE WRITEBYTES; (* last update: 10/21/81 *) (*$M @WNB*) (*$M **) (*$I 80rtp/fibdef.lib*) VAR @LFB : EXTERNAL ^FIB; RESULTIO: EXTERNAL INTEGER; EXTERNAL FUNCTION @BDOS(FUNC:INTEGER; PARM:WORD):INTEGER; EXTERNAL * DEFAULT *) MOVE(@LFB^.FBUFADR,SRCADR,2); IF @LFB^.OPTION > FRANDOM THEN (* CONSOLE/TERM I/O *) BEGIN WITH @LFB^ DO FOR N := 1 TO IOSIZE DO BEGIN CH := SRCADR^; if (ch = chr($0a) and not ((option=ftrmio) oE MUST ECHO CR/LF FOR CR *) I := @BDOS(2,WRD($0A)) END; 1: SRCADR := SRCADR + 1 END; EXIT END; (* WE GET HERE ONLY IF NON-CONSOLE I/O *) FOR N := 1 TO @LFB^.IOSIZE DO BEGIN WRITEBYTE(SRCADR^); ember 16, 1981 ; ; ; ; Note: to properly operate this version of the OVLMGR ; ; module requires a @INI routine of Release >= 5.25.1 ; ;---------------------------------------------------------------; ;++++++++++++++++++++++++++++++++++   +++++++++++++++++++++++++++++; ; equates for pertinant information ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++; ovlbase equ 0105h ;base prefix for file name namelen equ 010Dh ;length of names (6 or 7 characters) TRUE EQU -1  ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++; EXTRN @XXXX1 ;address of overlay area table ;set up by LINKMT >= 5.25.1 PUBLIC @OVL ;OVERLAY LOADER PUBLIC @OVS ;OVERLAY DISK SET - (FOR OTHER THAN DEFAULT DISK) ;###,M STA OVLGNUM INX H MVI B,8 LXI D,PROCNAME OVL1: MOV A,M INX H STAX D INX D DCR B JNZ OVL1 CALL PSH$USR$RET ;SAVE USER'S RETURN ADDRESSES CALL LOAD$OVLY ;GO LOAD IT (IF NECESSARY) CALL FIND$PROC ;GO SEARCH FOR AND FINDCK : OVLNUM,DRIVE ; ; OVLNUM : 1..50 ; ; DRIVE : '@'..'O' ; ; ; ; PASCAL DEFINITION: ; ; ; ; EXTERNAL PROCEDURE @OVS(OVNUM:INTEGER; DRNUM:CHAR); ; ; ; ;######################################################## MVI D,0 LHLD @XXXX1 ;GET ADDR OF OVERLAY AREA TABLE DAD D ;POINT TO TABLE ENTRY MOV E,M INX H MOV D,M XCHG ;HL NOW POINTS TO OVERLAY AREA SHLD OVLAREA ;SAVE IT FOR LATER RET ;==================================================HLD USR$SP RET ;===============================================================; ; SUBROUTINE: POP$USR$RET ; ; PURPOSE : POP RET ADDR, OVERLAY AREA ADDR AND NUMBER ; ; IF RELOAD IS SET TO TRUE THEN THIS ROUTINE ; ; WILL CALL LOAD$ FALSE EQU 0 ;FOR CONDITIONAL ASSEMBLY RELOAD EQU FALSE ;NON-RELOADING OVERLAY CALLING ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++; ; MACRO DEFINITIONS ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++; ############################################################; ; ; ; MAIN ROUTINE - @OVL ; ; PURPOSE - LOAD OVERLAY AND CALL PROCEDURE ; ;---------------------------------------------------------------; ; ON ENTRY TO @OVL, RETURN ADDRE PROCNAME ;DOES NOT RETURN IF PROC NOT FOUND LXI H,OUR$RET ;PUSH OUR RETURN ADDRESS ON THE STACK PUSH H LHLD PROCADR ;GET ADDRESS OF PROC WITHIN OVERLAY AREA PCHL ;AND OFF TO USER ROUTINE OUR$RET: CALL POP$USR$RET ;MAY RELOAD OLD#######; @OVS: POP H ;RET ADR POP B ;DRIVE NUMBER POP D ;OVERLAY NUMBER PUSH H MOV A,C SUI '@' ;MAKE 0..19 LXI H,DRIVE$TAB DAD D MOV M,A RET ;===============================================================; ; SUBROUTINE: CA=============; ; SUBROUTINE: PSH$USR$RET ; ; PURPOSE : SAVE CONTENTS OF HL, OVERLAY AREA ADDR ; ; AND OVERLAY GROUP NUMBER ON USR$RET STACK ; ;===============================================================; PUBLIC PSH$USR$RET PSH$USR$ROVLY TO RE-LOAD PREVIOUS ; ; OVERLAY IF NECESSARY ; ;===============================================================; PUBLIC POP$USR$RET POP$USR$RET: LHLD USR$SP MOV A,M STA OVLGNUM ;SAVE OVERLAY GROUP NUMBER INX H MOV E,M INX MOVE MACRO SRC,DST,LEN LOCAL L1 LXI H,SRC LXI D,DST LXI B,LEN L1: MOV A,M INX H STAX D INX D DCX B MOV A,B ORA C JNZ L1 ENDM ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++; ; PUBLIC AND EXTRN SYMBOLS SS POINTS TO OVERLAY CALL ; ; DATA BLOCK: ; ; ; ; +0 : OVERLAY GROUP NUMBER --- 1 BYTE ; ; +1 : OVERLAY PROCEDURE NAME-- 8 BYTES ; ; ; ;###############################################################; @OVL: POP H MOV A OVERLAY GROUP PCHL ;AND BACK TO THE USER (SIMPLE CASE) ;###############################################################; ; ; ; MAIN ROUTINE - @OVS ; ; PURPOSE - SET DRIVE NUMBER FOR A SPECIFIC OVERLAY ; ; INPUT - ON STALC$ADDR ; ; PURPOSE : CALC OVERLAY AREA ADDRESS BASED ON OVLGNUM ; ;===============================================================; CALC$ADDR: LDA OVLGNUM ;GET REQUESTED GROUP NUMBER DCR A RAR RAR RAR ;DIVIDE BY 8 ANI 1EH MOV E,AET: PUSH H CALL CALC$ADDR MOV B,H MOV C,L POP D LHLD USR$SP ;GET STACK POINTER DCX H MOV M,D ;STORE RET ADDR DCX H MOV M,E DCX H MOV M,B ;STORE OVERLAY AREA ADDR DCX H MOV M,C DCX H LDAX B ;GET OVERLAY NUMBER MOV M,A S H MOV D,M INX H ;DE NOW CONTAINS OVERLAY AREA ADDRESS XCHG SHLD OVLAREA XCHG MOV E,M INX H MOV D,M ;DE NOW CONTAINS CALLERS RETURN ADDRESS INX H SHLD USR$SP XCHG ;PUT REAL ADDR INTO HL ;---------------------------------------------   ------------------- IF RELOAD ; THEN RELOAD OLD OVERLAY IF NECESSARY PUSH H LDA OVLGNUM ORA A CNZ LOAD$OVLY ;ELSE GO LOAD IT IN AGAIN (IF NECESSARY) POP H ;GET RET ADDR BACK AGAIN ENDIF ;--------------------------------------------------- MOVE OVLBASE,MYFCB+1,8 LDA OVLGNUM DCR A MOV E,A MVI D,0 LXI H,DRIVE$TAB DAD D MOV A,M ;GET DRIVE NUMBER FROM TABLE STA MYFCB ;FOR NOW DEFAULT DRIVE ONLY MVI A,'0' STA MYFCB+9 LDA OVLGNUM RAR RAR RAR RAR CALL CV2HX ;SET DMA LHLD DMAPTR LXI D,128 DAD D SHLD DMAPTR LXI D,MYFCB MVI C,20 ;SEQUENTIAL READ CALL 5 ORA A JZ LO3 ;IF MORE TO DO THEN GO-ON RET ;ELSE ALL DONE, EXIT ; ; INTERNAL ROUTINE - CV2HX ; LOW ORDER 4-BITS OF A-REG COD,M ;POINT TO TABLE XCHG FP1: MOV A,M ORA A JZ NO$PROC LXI D,PROCNAME LDA NAMELEN MOV B,A PUSH H ;SAVE ADDR OF TABLE ENTRY FP2: LDAX D CMP M JNZ FP3 ;BR IF NO MATCH INX H INX D DCR B JNZ FP2 ;BR IF MORE TO COMPARN EXTENSION LDA MYFCB ADI '@' STA NFMSG1 LXI D,NFMSG CPI '@' JNZ WMSG LXI H,' ' SHLD NFMSG1 ;CHANGE "@:" TO " " WMSG: MVI C,9 ;PRINT STRING CALL 5 MVI C,0 ;INITIALIZE CALL 5 NFMSG: DB 13,10,'Unable to open overlay file:  ; ; DATA AREA FOR OVERLAY MANAGER ; ; ; ;***************************************************************; ; ; NOTE THIS TABLE MUST BE IN THE CSEG AREA BECAUSE IS MUST ; BE INITIALIZED VIA DB AND LINKMT WILL NOT SUPPORT INITIALIZED ------------- RET ;BACK TO MAIN @OVL ROUTINE ;===============================================================; ; SUBROUTINE: LOAD$OVLY ; ; PURPOSE : USING OVLADDR AND OVLBASE LOAD THE OVERLAY ; ;============================================ ;CONVERT HIGH NIBBLE STA MYFCB+10 LDA OVLGNUM CALL CV2HX ;CONVERT LOW NIBBLE STA MYFCB+11 LXI H,MYFCB+12 MVI B,23 ;NUMBER OF EXTRA BYTES LO2: MVI M,0 INX H DCR B JNZ LO2 LXI D,80H ;SET DEFAULT DMA ADDRESS MVI C,26 CALL 5 NTAIN BINARY NUMBER ; RETURN ASCII CHAR IN A-REG ; CV2HX: ANI 0FH ADI '0' CPI 03AH RC ;RETURN IF A VAILD DIGIT ADI 7 RET ;===============================================================; ; SUBROUTINE: FIND$PROC ; ; PURPOSE : E ; ; WE FOUND IT...... ; POP H ;GET BASE ADDR OF TABLE ENTRY LXI D,8 ;BYPASS NAME DAD D MOV E,M INX H MOV D,M XCHG SHLD PROCADR RET ;AND EXIT FP3: POP H LXI D,10 DAD D JMP FP1 ;=====================================' NFMSG1: DB '@: . ',13,10,'$' NO$PROC: ;***PROCEDURE NAME NOT FOUND*** MOVE MYFCB+1,NPMSG2+2,8 ;MOVE IN NAME MOVE MYFCB+9,NPMSG2+11,3 ;MOVE IN EXTENSION LDA MYFCB ADI '@' STA NPMSG2 CPI '@' JNZ NP1 LXI H,' ' SHLD NPM ; DATA IN THE DSEG ; DRIVE$TAB: ;DRIVE TABLES FOR 50 OVERLAYS REPT 50 DB 0 ENDM USR$SP: DW USR$RET ;USR$RET STACK POINTER ;THIS MUST ALSO BE IN CODE SEG DSEG DMAPTR: DS 2 ;DMA ADDRESS FOR INPUT XFER PROCNAME: DS 8 ;NAME ===================; LOAD$OVLY: CALL CALC$ADDR ;SETS OVLAREA AND HL-REG LDA OVLGNUM ;GET GROUP NUMBER BACK AGAIN CMP M ;IS REQUESTED OVERLAY IN THE AREA? RZ ;RETURN IF ALREADY LOADED ; ; IF NOT LOADED THEN CONSTRUCT NAME AND LOAD IT ;  LXI D,MYFCB MVI C,15 ;FILE OPEN CALL 5 ;GO OPEN THE FILE CPI 255 JZ NO$FILE ;BR IF FILE NOT FOUND ; ; OK, NOW LOAD IT UNTIL EOF ; LHLD OVLAREA ;GET OVERLAY AREA ADDRESS SHLD DMAPTR LO3: LHLD DMAPTR XCHG MVI C,26 CALL 5  GIVEN PROCEDURE NAME IN PROCNAME ; ; RETURN ADDRESS OF THIS PROCEDURE IN ; ; PROCADR ; ;===============================================================; FIND$PROC: LHLD OVLAREA ;GET ADDR OF OVERLAY AREA INX H MOV E,M INX H MOV ==========================; ; ERROR MESSAGE PRINTING ROUTINES ; ;===============================================================; NO$FILE: ;***OVERLAY FILE NOT FOUND*** MOVE MYFCB+1,NFMSG1+2,8 ;MOVE IN NAME MOVE MYFCB+9,NFMSG1+11,3 ;MOVE ISG2 NP1: MOVE PROCNAME,NPMSG1,8 LXI D,NPMSG JMP WMSG NPMSG: DB 13,10,'Procedure: "' NPMSG1: DB ' " not found in overlay: ' NPMSG2: DB '@: . ',13,10,'$' ;***************************************************************; ; OF PROCEDURE WHICH WE ARE CALLING OVLGNUM: DS 1 ;OVERLAY NUMBER PROCADR: DS 2 ;PROCEDURE ADDRESS MYFCB: DS 36 ;FCB FOR FILE OPENING ; ; USR$RET STACK CONTAINS RETURN ADDRESS AND ; SAVED OVERLAY AREA ADDRESS ; AND OVERLAY GROUP NUMBER ;(MAX NES   TING 25 DS 129 ;SAVED RETURN ADDRESSES USR$RET: OVLAREA: DS 2 ;LOC OF MOST RECENT OVL AREA END FILE OPENING ; ; USR$RET STACK CONTAINS RETURN ADDRESS AND ; SAVED OVERLAY AREA ADDRESS ; AND OVERLAY GROUP NUMBER ;(MAX NES (* SET IF CURSORS COLLIDED *) RECORDSEEN, EXTSEEN, COLONSEEN: BOOLEAN; CUR, NXT: CHARINFO; CURRSYM, NEXTSYM: SYMBOLINFO; CRPENDING : BOOLEAN; PPOPTION : OPTIONTABLE; KEYWORD : KEYWORDTABLE; KEYWORD : EXTERNAL KEYWORDTABLE; DBLCHARS: EXTERNAL DBLCHRSET; DBLCHR : EXTERNAL DBLCTABLE; SGLCHAR : EXTERNAL SGLCHARTABLE; STACK : EXTERNAL SYMBOLSTACK; TOP : EXTERNAL INTEGER; CURLINEDBLCHARS: DBLCHRSET; DBLCHR : DBLCTABLE; SGLCHAR : SGLCHARTABLE; STACK : SYMBOLSTACK; TOP : INTEGER; CURLINEPOS, CURRMARGIN: INTEGER; (* VERSION 0009 *) (* PRETTY PRINTER EXTERNAL GLOBALS *) VAR CURSOR, DSTCURSOR : EXTERNAL INTEGER; ENDFILE, BUFSZ, LASTLINE : EXTERNAL INTEGER; GBL_OOPS: EXTERNAL BOOLEAN; BUF : ABSOLUTE [$A000] ARRAY[0..0] OF CHAR; POS, CURRMARGIN: EXTERNAL INTEGER; HAR : EXTERNAL SGLCHARTABLE; STACK : EXTERNAL SYMBOLSTACK; TOP : EXTERNAL INTEGER; CURLINE(* VERSION 0015 *) (* PRETTY PRINTER GLOBALS *) VAR ENDFILE, CBP, BUFSZ, LASTLINE: EXTERNAL INTEGER; (* FROM SOFTBUS GLOBALS *) CURSOR, DSTCURSOR: INTEGER; BUF : ABSOLUTE [$A000] ARRAY[0..0] OF CHAR; GBL_OOPS: BOOLEAN; RECORDSEEN, EXTSEEN, COLONSEEN : EXTERNAL BOOLEAN; CUR, NXT: EXTERNAL CHARINFO; CURRSYM, NEXTSYM: EXTERNAL SYMBOLINFO; CRPENDING : EXTERNAL BOOLEAN; PPOPTION : EXTERNAL OPTIONTABLE;     CONST CR = $0D; MAXSYMSIZE = 200; (* MAX SIZE OF A SYMBOL *) MAXSTKSIZE = 100; (* MAX # OF SYMBOLS CAUSING INDENTATION *) MAXKEYLEN = 10; (* MAX LENGTH OF A RESERVED WORD *) MAXLINSIZE = 72; (* MAX SIZE OF AN OUTPUT LINEEVARSY, OFSY, FORSY, WHILESY, WITHSY, DOSY, IFSY, THENSY, ELSESY, ENDSY, UNTILSY,  GOBBLESYMBOLS, INDENTBYTAB, INDENTTOCLP, CRAFTER); OPTIONSET = SET OF OPTION; KEYSYMSET = SET OF KEYSYMBOL; TABLEENTRY = RECORD OPT : OPTIONSET; ARRAY [1..MAXSYMSIZE] OF CHAR; SYMBOL = RECORD NAME : KEYSYMBOL; VALUE : STRING; LENGTH : INTEGER; SPACESBEFORE: INTEGER; CRSBEFORE :   PREVMARGIN : INTEGER END; SYMBOLSTACK = ARRAY [1..MAXSTKSIZE] OF STACKENTRY; *) SLFAIL1 = 48; (* USE TWO BLANKS AS TAB BEFORE THIS COL *) SLFAIL2 = 60; (* USE ONE BLANK AS TAB BETWEEN SF1 AND HERE *) INDENT1 = 2; INDENT2 = 1; SPACE = ' '; TYPE KEYSYMBOL = (PROGSY, EXTSY,  BECOMES, OPENCOMMENT, CLOSECOMMENT, SEMICOLON, COLON, EQUALS, OPENPAREN, CLOSEPAREN, PERIOD, END_OF_FILE,  DINDENTSYMBOLS : KEYSYMSET; GOBBLETERMINATORS: KEYSYMSET END; OPTIONTABLE = ARRAY [KEYSYMBOL] OF TABLEENTRY; KEY = PACKED ARRAY [1..MAXKEYLEN] OF CHAR; KEYWORDTABLE = ARRAY [PROGSYINTEGER END; SYMBOLINFO = {^}SYMBOL; CHARNAME = (LETTER, DIGIT, BLANK, QUOTE, END_OF_LINE, FILEMARK, OTHERCHAR); CHARINFO = RECORD NAME : CHARNAME; MODULE PPMOD3; (* CREATED 3/26/81 NJL *) (*$I PPTYPES *) (*$I PPEXTS *) EXTERNAL PROCEDURE GETSYMBOL(VAR NEXTSYM,CURRSYM : SYMBOLINFO); FUNCTION COLLIDE:BOOLEAN; BEGIN GBL_OOPS := DSTCURSOR + 80 >= CURSOR; COLLIDE := GBL_OOPS; END;  FUNCSY, PROCSY, LABELSY, CONSTSY, TYPESY, VARSY, BEGINSY, REPEATSY, RECORDSY, CASESY, CAS ANOTHERSY, OTHERSY); OPTION = (CRSUPPRESS, CRBEFORE, BLANKLINEBEFORE, DINDENTONKEYS, DINDENT, SPACEBEFORE, SPACEAFTER, ..UNTILSY] OF KEY; SPECIALCHAR = PACKED ARRAY [1..2] OF CHAR; DBLCHRSET = SET OF BECOMES..OPENCOMMENT; DBLCTABLE = ARRAY [BECOMES..OPENCOMMENT] OF SPECIALCHAR; SGLCHARTABLE = ARRAY [OPENCOMMENT..PERIOD] OF CHAR; STRING =  VALUE : CHAR END; STACKENTRY = RECORD INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER END; SYMBOLSTACK = ARRAY [1..MAXSTKSIZE] OF STACKENTRY;PROCEDURE PUTCH(CH:CHAR); BEGIN IF NOT COLLIDE THEN BEGIN BUF[DSTCURSOR] := CH; DSTCURSOR := DSTCURSOR + 1 END END; PROCEDURE PUTLN; BEGIN PUTCH(CHR(13)); PUTCH(CHR(10)); LASTLINE := LASTLINE + 1 END; FUNCTIO   N STACKEMPTY : BOOLEAN; BEGIN IF TOP = 0 THEN STACKEMPTY := TRUE ELSE STACKEMPTY := FALSE END; FUNCTION STACKFULL : BOOLEAN; BEGIN IF TOP = MAXSTKSIZE THEN STACKFULL := TRUE ELSE STACKFULL := FALSE END; (* STACKFULL * BEGIN TOP := TOP + 1; STACK[TOP].INDENTSYMBOL := INDENTSYMBOL; STACK[TOP].PREVMARGIN := PREVMARGIN END; (* PUSHSTACK *) PROCEDURE WRITECRS( NUMBEROFCRS : INTEGER; VAR CURLINEPOS : INTEGER); VAR I : INTEGER; BEGIN IF NUMBEROFCRS LINEPOS = 0 THEN WRITECRS(ONCE,CURLINEPOS) ELSE WRITECRS(TWICE, CURLINEPOS); CURRSYM{^}.SPACESBEFORE := 0 END ELSE IF CURRSYM{^}.CRSBEFORE = 1 THEN IF CURLINEPOS > 0 THEN WRITECRS(ONCE, CURLINEPOHIFTON *) PROCEDURE LSHIFT; VAR INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER; BEGIN IF NOT STACKEMPTY THEN BEGIN POPSTACK(INDENTSYMBOL,PREVMARGIN); CURRMARGIN := PREVMARGIN END END; (*LSHIFT*) PROCEDURE INSERTSS *) PROCEDURE PRINTSYMBOL(VAR CURRSYM : SYMBOLINFO; VAR CURLINEPOS : INTEGER); VAR I : INTEGER; BEGIN WITH CURRSYM{^} DO BEGIN FOR I := 1 TO LENGTH DO PUTCH(VALUE[I]); CURLINEPOS := CURLINEPOS + LENGTH END (CRS(ONCE,CURLINEPOS); IF CURRMARGIN + LENGTH <= MAXLINSIZE THEN NEWLINEPOS := CURRMARGIN ELSE IF LENGTH < MAXLINSIZE THEN NEWLINEPOS := MAXLINSIZE - LENGTH ELSE NEWL) PROCEDURE POPSTACK( VAR INDENTSYMBOL : KEYSYMBOL; VAR PREVMARGIN : INTEGER); BEGIN IF NOT STACKEMPTY THEN BEGIN INDENTSYMBOL := STACK[TOP].INDENTSYMBOL; PREVMARGIN := STACK[TOP].PREVMA> 0 THEN BEGIN FOR I := 1 TO NUMBEROFCRS DO PUTLN; CURLINEPOS := 0 END END; (* WRITECRS *) PROCEDURE INSERTCR( VAR CURRSYM : SYMBOLINFO); CONST ONCE = 1; BEGIN IF CURRSYM{^}.CRSBEFORE = 0 THEN BEGIN S) END; (* INSERTBLANKLINE *) PROCEDURE LSHIFTON(DINDENTSYMBOLS : KEYSYMSET); VAR INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER; BEGIN IF NOT STACKEMPTY THEN BEGIN REPEAT POPSTACK(INDENTSYMBOL,PREVMARGIN); IF PACE(VAR SYMBOL : SYMBOLINFO); BEGIN IF CURLINEPOS < MAXLINSIZE THEN BEGIN PUTCH(SPACE); CURLINEPOS := CURLINEPOS + 1; WITH SYMBOL{^} DO IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0) THEN SPACESBEFORE := SPACES* WITH *) END; (* PRINTSYMBOL *) PROCEDURE PPSYMBOL(VAR CURRSYM : SYMBOLINFO); CONST ONCE = 1; VAR NEWLINEPOS : INTEGER; BEGIN WITH CURRSYM{^} DO BEGIN WRITECRS( CRSBEFORE, CURLINEPOS); IF (CURLINEPOS + SPACESBEFOREINEPOS := 0 END; MOVELINEPOS(NEWLINEPOS, CURLINEPOS); PRINTSYMBOL(CURRSYM,CURLINEPOS) END; (* WITH *) END; (*PPSYMBOL*) PROCEDURE GOBBLE(TERMINATORS : KEYSYMSET; VAR CURRSYM,NEXTSYM : SYMBOLINFO); BEGIN RSHIFTTOCLP(CURRSRGIN; TOP := TOP - 1; END ELSE BEGIN INDENTSYMBOL := OTHERSY; PREVMARGIN := 0 END END; (* POPSTACK *) PROCEDURE PUSHSTACK( INDENTSYMBOL : KEYSYMBOL; PREVMARGIN : INTEGER);  WRITECRS(ONCE, CURLINEPOS); CURRSYM{^}.SPACESBEFORE := 0 END END; (* INSERTCR*) PROCEDURE INSERTBLANKLINE(VAR CURRSYM : SYMBOLINFO); CONST ONCE = 1; TWICE = 2; BEGIN IF CURRSYM{^}.CRSBEFORE = 0 THEN BEGIN IF CURINDENTSYMBOL IN DINDENTSYMBOLS THEN CURRMARGIN := PREVMARGIN UNTIL NOT (INDENTSYMBOL IN DINDENTSYMBOLS) OR (STACKEMPTY); IF NOT (INDENTSYMBOL IN DINDENTSYMBOLS) THEN PUSHSTACK(INDENTSYMBOL, PREVMARGIN) END END; (* LSBEFORE -1 END END; (* INSERTSPACE *) PROCEDURE MOVELINEPOS( NEWLINEPOS : INTEGER; VAR CURLINEPOS : INTEGER); VAR I : INTEGER; BEGIN FOR I := CURLINEPOS + 1 TO NEWLINEPOS DO PUTCH(SPACE); CURLINEPOS := NEWLINEPOS END; (* MOVELINEPO > CURRMARGIN) OR ( NAME IN [OPENCOMMENT, CLOSECOMMENT]) THEN NEWLINEPOS := CURLINEPOS + SPACESBEFORE ELSE NEWLINEPOS := CURRMARGIN; IF NEWLINEPOS + LENGTH > MAXLINSIZE THEN BEGIN WRITEYM{^}.NAME); WHILE NOT (NEXTSYM{^}.NAME IN (TERMINATORS + [ENDOFFILE])) DO BEGIN GETSYMBOL(NEXTSYM,CURRSYM); PPSYMBOL(CURRSYM); END; LSHIFT END; (* GOBBLE *) PROCEDURE RSHIFT(CURRSYM : KEYSYMBOL); BEGIN IF NOT STACKF   ULL THEN PUSHSTACK(CURRSYM, CURRMARGIN); IF CURRMARGIN < SLFAIL1 THEN CURRMARGIN := CURRMARGIN + INDENT1 ELSE IF CURRMARGIN < SLFAIL2 THEN CURRMARGIN := CURRMARGIN + INDENT2 END; (*RSHIFT*) PROCEDURE RSHIFTTOCLP( := 'TYPE ' ; KEYWORD[VARSY ] := 'VAR ' ; KEYWORD[BEGINSY ] := 'BEGIN ' ; KEYWORD[REPEATSY] := 'REPEAT ' ; KEYWORD[RECORDSY] := 'RECORD ' ; KEYWORD[CASESY ] := 'CASE ' ; KEYWORD[CASEVARSY]:= 'CASE ' ; ='; DBLCHR[OPENCOMMENT] := '(*'; SGLCHAR[OPENCOMMENT] := '{'; SGLCHAR[CLOSECOMMENT] := '}'; SGLCHAR[SEMICOLON ] := ';'; SGLCHAR[COLON ] := ':'; SGLCHAR[EQUALS ] := '='; SGLCHAR[OPENPAREN ] := '('; SGLCHAR[CLOSEPAREN] := ' WITH PPOPTION[ EXTSY ] DO BEGIN OPT := [BLANKLINEBEFORE, SPACEAFTER]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION[FUNCSY] DO BEGIN OPT := [BLANKLINEBEFORE,DINDENTONKEYS,SPACEAFTER]; GIN OPT := [ CRBEFORE, DINDENTONKEYS, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := [ LABELSY ] ; GOBBLETERMINATORS := [] END; WITH PPOPTION [ TYPESY ] DO BEGIN OPT := [ CRBEFORE, DINDENTONKEYS, SPACEAFTER, INDCURRSYM : KEYSYMBOL); BEGIN IF NOT STACKFULL THEN PUSHSTACK(CURRSYM,CURRMARGIN); CURRMARGIN := CURLINEPOS END; MODEND. (* VERSION 0026 *) (* 5.5 STARTS WITH VERSION 26 *) MODULE PPINIT; (*$I PPTYPES*) (*$I PPEXTS*) EXTERNAL PROCEDURE GETCHAR; EXTERNAL PROCEDURE GETSYMBOL(VAR NEXTSYM,CURRSYM : SYMBOLINFO); PROCEDURE INITIALIZE; PROCEDURE IDINIT; BEGIKEYWORD[OFSY ] := 'OF ' ; KEYWORD[FORSY ] := 'FOR ' ; KEYWORD[WHILESY ] := 'WHILE ' ; KEYWORD[WITHSY ] := 'WITH ' ; KEYWORD[DOSY ] := 'DO ' ; KEYWORD[IFSY ] := 'IF ' ; KEYWORD[THENSY ] := ')'; SGLCHAR[PERIOD ] := '.'; RECORDSEEN := FALSE; COLONSEEN := FALSE; FILLCHAR(CUR,SIZEOF(CHARINFO),CHR(0)); NXT := CUR; GETCHAR; {----------------- NEW(CURRSYM); NEW(NEXTSYM); ------------------} GETSYMBOL(N DINDENTSYMBOLS := [LABELSY,CONSTSY,TYPESY]; GOBBLETERMINATORS := [] END; WITH PPOPTION[PROCSY] DO BEGIN OPT := [BLANKLINEBEFORE, DINDENTONKEYS, SPACEAFTER]; DINDENTSYMBOLS := [ LABELSY, CONSTSY, TYPESY, VARSY ]; ENTTOCLP ]; DINDENTSYMBOLS := [ LABELSY, CONSTSY ] ; GOBBLETERMINATORS := [] END; WITH PPOPTION [ VARSY ] DO BEGIN OPT := [CRBEFORE, DINDENTONKEYS, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := [LABELSY, CONSTSN KEYWORD[PROGSY ] := 'PROGRAM ' ; KEYWORD[EXTSY ] := 'EXTERNAL ' ; KEYWORD[FUNCSY ] := 'FUNCTION ' ; KEYWORD[PROCSY ] := 'PROCEDURE ' ; KEYWORD[LABELSY ] := 'LABEL ' ; KEYWORD[CONSTSY ] := 'CONST ' ; KEYWORD[TYPESY ]THEN ' ; KEYWORD[ELSESY ] := 'ELSE ' ; KEYWORD[ENDSY ] := 'END ' ; KEYWORD[UNTILSY ] := 'UNTIL ' ; TOP := 0; CURLINEPOS := 0; CURRMARGIN := 0; DBLCHARS := [BECOMES,OPENCOMMENT]; DBLCHR[BECOMES ] := ':EXTSYM,CURRSYM); END; (* IDINIT *) PROCEDURE PPOPTINIT; PROCEDURE PP1; BEGIN WITH PPOPTION[PROGSY] DO BEGIN OPT := [BLANKLINEBEFORE, SPACEAFTER]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := []; END;  GOBBLETERMINATORS := [] END; WITH PPOPTION [ LABELSY ] DO BEGIN OPT := [CRBEFORE, SPACEAFTER, INDENTTOCLP ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ CONSTSY ] DO BEY, TYPESY ]; GOBBLETERMINATORS := []; END; WITH PPOPTION [ BEGINSY ] DO BEGIN OPT := [DINDENTONKEYS, INDENTBYTAB, CRAFTER]; DINDENTSYMBOLS := [LABELSY, CONSTSY, TYPESY, VARSY ] ; GOBBLETERMINATORS := [] E   ND; WITH PPOPTION[ REPEATSY ] DO BEGIN OPT := [INDENTBYTAB, CRAFTER ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ RECORDSY ] DO BEGIN OPT := [INDENTBYTAB, CRAFTER]; S, SPACEBEFORE ] ; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [ OFSY ] END; WITH PPOPTION [ FORSY ] DO BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS, CRAFTER]; DINDENTSYMBOLS := []; GOBBLETERMINABOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ IFSY ] DO BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [THENSY] END; END; (* PP1 *) TSYMBOLS := [IFSY,THENSY,ELSESY,FORSY, WHILESY, WITHSY, CASEVARSY,COLON, EQUALS]; END; WITH PPOPTION [ UNTILSY ] DO BEGIN OPT := [ CRBEFORE, DINDENTONKEYS, DINDENT, SPACEAFTER, GOBBLESYMBOLS, NDENTSYMBOLS := []; GOBBLETERMINATORS := []; END; WITH PPOPTION [ SEMICOLON ] DO BEGIN OPT := [CRSUPPRESS, DINDENTONKEYS, CRAFTER]; DINDENTSYMBOLS := [IFSY, THENSY, ELSESY, FORSY, WHILESY, W; GOBBLETERMINATORS := [CLOSEPAREN] END; WITH PPOPTION [ CLOSEPAREN ] DO BEGIN OPT := []; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ PERIOD ] DO BEGIN OPT := [ DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ CASESY ] DO BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS, CRAFTER]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [OFSY] END; TORS := [DOSY] END; WITH PPOPTION [ WHILESY ] DO BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS, CRAFTER ] ; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [DOSY]; END; WITH PPOPTION [ WITHSY ] DO  PROCEDURE PP2; BEGIN WITH PPOPTION [ THENSY] DO BEGIN OPT := [SPACEBEFORE, CRAFTER ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ ELSESY ] DO BEGIN OPT := [CRBEF CRAFTER]; DINDENTSYMBOLS := [ IFSY, THENSY, ELSESY, FORSY, WHILESY, WITHSY, COLON, EQUALS ] ; GOBBLETERMINATORS := [ ENDSY, UNTILSY, ELSESY, SEMICOLON ] END; WITH PPOPTION [ BECOMES ] DO BEGINITHSY, COLON, EQUALS ] ; GOBBLETERMINATORS := [] END; WITH PPOPTION [ COLON ] DO BEGIN OPT := [SPACEAFTER, INDENTTOCLP ] ; DINDENTSYMBOLS := []; GOBBLETERMINATORS := []; END; WITH PPOPTION [ EQUACRSUPPRESS]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ END_OF_FILE ] DO BEGIN OPT := []; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ ANOTHER WITH PPOPTION [ CASEVARSY ] DO BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS, CRAFTER ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [OFSY] END; WITH PPOPTION [ OFSY ] DO BEGIN OPT := [CRSUPPRES BEGIN OPT := [SPACEAFTER, INDENTBYTAB, GOBBLESYMBOLS, CRAFTER ]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [ DOSY ]; END; WITH PPOPTION [ DOSY ] DO BEGIN OPT := [CRSUPPRESS, SPACEBEFORE ]; DINDENTSYMORE, DINDENTONKEYS, {DINDENT,} INDENTBYTAB, CRAFTER ]; DINDENTSYMBOLS := [IFSY,ELSESY]; GOBBLETERMINATORS := [] END; WITH PPOPTION [ ENDSY ] DO BEGIN OPT := [CRBEFORE, DINDENTONKEYS, DINDENT, CRAFTER ]; DINDEN OPT := [ SPACEBEFORE, SPACEAFTER, GOBBLESYMBOLS ] ; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [ ENDSY, UNTILSY, ELSESY, SEMICOLON ] END; WITH PPOPTION [ CLOSECOMMENT ] DO BEGIN OPT := [CRSUPPRESS]; DILS ] DO BEGIN OPT := [SPACEBEFORE, SPACEAFTER, INDENTTOCLP ] ; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ OPENPAREN ] DO BEGIN OPT := [GOBBLESYMBOLS ] ; DINDENTSYMBOLS := []SY ] DO BEGIN OPT := [SPACEAFTER]; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; WITH PPOPTION [ OTHERSY ] DO BEGIN OPT := []; DINDENTSYMBOLS := []; GOBBLETERMINATORS := [] END; E   ND; (* PP2 *) BEGIN (* PPOPTINIT *) PP1; PP2; END; (* PPOPTINIT *) BEGIN (* INITIALIZE *) IDINIT; PPOPTINIT; END; (* INITIALIZE *) MODEND. N CH := BUF[CURSOR] ELSE CH := ' '; WITH NXT DO BEGIN IF CURSOR > ENDFILE THEN NAME := FILEMARK ELSE IF CH = CHR(CR) THEN BEGIN CURSOR := CURSOR + 2; WRITE('.'); NAME := LETTER ELSE IF ((CH >= '0') AND (CH <= '9')) THEN NAME := DIGIT ELSE IF CH = '''' THEN NAME := QUOTE ELSE IF CH = SPACE THEN NAME := BLANK ELSE NAME := OTHERCHAR;  END; (*$P*) PROCEDURE SKIPSPACES(VAR SPACESBEFORE,CRSBEFORE : INTEGER); BEGIN SPACESBEFORE := 0; CRSBEFORE := 0; WHILE (NXT.NAME = BLANK) OR (NXT.NAME = ENDOFLINE) DO BEGIN GETCHAR; CASE CUR.NAME O EOLCURSOR := CURSOR; NAME := END_OF_LINE; (* CURSOR NOW POINTS TO CHAR AFTER LF *) WHILE BUF[CURSOR] = ' ' DO CURSOR := CURSOR + 1; MOVE(BUF[CURSOR],CH2,2); {IF ( IF (NAME=FILEMARK) OR (NAME=END_OF_LINE) THEN VALUE := SPACE ELSE VALUE := CH; {no longer convert to uppercase as of 5.5 } IF NAME <> FILEMARK THEN CURSOR := CURSOR + 1 END EF BLANK : SPACESBEFORE := SPACESBEFORE + 1; ENDOFLINE : BEGIN CRSBEFORE := CRSBEFORE + 1; SPACESBEFORE := 0 END END END END; (*$P*) PROCEDURE GETCOMMENT(V(* VERSION 0032 *) (* 5.5 STARTS WITH VERSION 32 *) MODULE PPMOD1; (*$I PPTYPES*) (*$I PPEXTS*) PROCEDURE GETCHAR; VAR CH : CHAR; EOLCURSOR : INTEGER; CH2 : ARRAY [1..2] OF CHAR; BEGIN CUR := NXT; IF CURSOR <= BUFSZ THECH2= '(*') OR (BUF[CURSOR]='{') THEN CURSOR := EOLCURSOR;} CURSOR := CURSOR - 1 END ELSE IF ((CH >='@') AND (CH <='Z')) OR ((CH >='a') AND (CH <='z')) OR ( CH = '_') THEN ND; (*$P*) PROCEDURE STORENXT(VAR LENGTH:INTEGER; VAR VALUE : STRING); BEGIN GETCHAR; IF LENGTH < MAXSYMSIZE THEN BEGIN LENGTH := LENGTH + 1; VALUE[LENGTH] := CUR.VALUE END AR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER; BRACE : BOOLEAN); BEGIN BRACE := NEXTSYM.VALUE[1] = '{'; NAME := OPENCOMMENT; IF NOT BRACE THEN WHILE NOT   (((CUR.VALUE = '*') AND (NXT.VALUE=')')) OR (NXT.NAME = ENDOFLINE) OR (NXT.NAME = FILEMARK)) DO STORENXT(LENGTH,VALUE) ELSE WHILE NOT((NXT.VALUE='}') OR (NXT.NAME = ENDOFLINE) OR (NXT.NAME = N FOR I := 1 TO LENGTH DO KEYVALUE[I] := CHR(VALUE[I] & $DF); FOR I := LENGTH+1 TO MAXKEYLENGTH DO KEYVALUE[I] := SPACE; THISKEY := PROGSY; HIT := FALSE; WHILE NOT(HIT OR (PRED(THISKEY) = UNTILSYOF RECORDSY : RECORDSEEN := TRUE; EXTSY : IF COLONSEEN THEN NAME := ANOTHERSY ELSE EXTSEEN := TRUE; PROCSY, FUNCSY : IF EXTSEEN THEN NAME := ANOTHERSY; CASESY : IF RECORDSEEN THEN  CURRSYM : SYMBOLINFO); EXTERNAL PROCEDURE INSERTBLANKLINE( VAR CURRSYM : SYMBOLINFO); EXTERNAL PROCEDURE LSHIFTON(DINDENTSYMBOLS : KEYSYMSET); EXTERNAL PROCEDURE LSHIFT; EXTERNAL PROCEDURE INSERTSPACE(VAR SYMBOL : SYMBOLINFO); EXTERNAL PROCEDURE PPSYFILEMARK)) DO STORENXT(LENGTH,VALUE); IF (CUR.VALUE = '*') AND (NXT.VALUE = ')') THEN BEGIN STORENXT(LENGTH,VALUE); NAME := CLOSECOMMENT END ELSE IF (NXT.VALUE = '}') THEN NAME := CLOSECOMMENT END; ()) DO IF KEYVALUE = KEYWORD[THISKEY] THEN HIT := TRUE ELSE THISKEY := SUCC(THISKEY); IF HIT THEN IDTYPE := THISKEY END END; (*$P*) PROCEDURE GETIDENTIFIER(VAR NAME : KEYSYMBOL; NAME := CASEVARSY; ENDSY : RECORDSEEN := FALSE END END; MODEND. ; PROCSY, FUNCSY : IF EXTSEEN THEN NAME := ANOTHERSY; CASESY : IF RECORDSEEN THEN MBOL(CURRSYM : SYMBOLINFO); EXTERNAL PROCEDURE GOBBLE (TERMINATORS : KEYSYMSET; VAR CURRSYM, NEXTSYM : SYMBOLINFO); EXTERNAL PROCEDURE INITIALIZE; EXTERNAL PROCEDURE RSHIFT(CURRSYYM : KEYSYMBOL); EXTERNAL PROCEDURE RSHIFTTOC*$P*) FUNCTION IDTYPE(VALUE:STRING; LENGTH:INTEGER):KEYSYMBOL; VAR I : INTEGER; KEYVALUE : KEY; HIT : BOOLEAN; THISKEY : KEYSYMBOL; BEGIN IDTYPE := OTHERSY; IF LENGTH <= MAXKEYLEN THEN BEGI VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN WHILE (NXT.NAME = LETTER) OR (NXT.NAME = DIGIT) DO STORENXT(LENGTH,VALUE); NAME := IDTYPE(VALUE,LENGTH); CASE NAME (* VERSION 0044 *) (* 5.5 STARTS WITH VERSION 44 *) MODULE PRETTYPRINT; (*$I PPTYPES*) (*$I PPGLBLS*) (*$E-*) VAR CH : CHAR; (*$E+*) EXTERNAL PROCEDURE GETSYMBOL(VAR NEXTSYM, CURRSYM : SYMBOLINFO); EXTERNAL PROCEDURE INSERTCR ( VARLP(CURRSYM : KEYSYMBOL); EXTERNAL PROCEDURE PUTLN; PROCEDURE PRETTY; (* FOR NOW *) VAR I : INTEGER; BEGIN (* MAIN PROGRAM *) FOR I := 1 TO 24 DO WRITELN; (* POOR MAN'S CLEAR SCREEN *) WRITELN('Pascal/MT+ 5.5'); WRITELN('Prog   ram reformatting utility'); WRITELN('Available memory for expansion = ',BUFSZ-ENDFILE+1,' bytes'); IF BUFSZ-ENDFILE+1 < 512 THEN BEGIN REPEAT WRITELN('You do not have much expansion space, Type E now if you'); WRITELN('sz+4; DSTCURSOR := 2; (* WHERE TO WRITE TO *) LASTLINE := 0; INITIALIZE; CRPENDING := FALSE; WHILE NEXTSYM{^}.NAME <> ENDOFFILE DO BEGIN IF GBL_OOPS THEN BEGIN WRITELN; WRITELN('I warne END; IF BLANKLINEBEFORE IN OPT THEN BEGIN INSERTBLANKLINE(CURRSYM); CRPENDING := FALSE END; IF DINDENTONKEYS IN OPT THEN LSHIFTON(DINDENTSYMBOLS);  THEN CRPENDING := TRUE END END; IF CRPENDING THEN PUTLN; PUTLN; ENDFILE := DSTCURSOR-1; (* THE END! *) IF BUF[ENDFILE-1] <> CHR(13) (* linefeed *) THEN BEGIN BUF[ENDFILE] := CHR(13); (* VERSION 0023 *) (* 5.5 STARTS WITH VERSION 23 *) MODULE PPMOD2; (*$I PPTYPES*) (*$I PPEXTS*) VAR LAST_CHAR : CHAR; EXTERNAL PROCEDURE STORENXT(VAR LEN : INTEGER; VAR VALUE : STRING); EXTERNAL PROCEDURE GETIDENTIFIER( VAR NAMBER(VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN WHILE NXT.NAME = DIGIT DO STORENXT(LENGTH,VALUE); NAME := OTHERSY END; (*$P*) PROCEDURE GETCHLITEhave not saved (updated) your file recently and you wish'); WRITELN('to do so before you possibly lose it! E)xit or C)ontinue:'); READLN(CH) UNTIL CH IN ['E','e','C','c']; IF CH IN ['E','e'] THEN EXIT END; Wd you, the new and old data has collided'); WRITELN('and the source text in the buffer has been lost'); WRITELN('Type to return to the supervisor'); READLN; EXIT END; GETSYMBOL(NEXTSYM,CURIF DINDENT IN OPT THEN LSHIFT; IF SPACEBEFORE IN OPT THEN INSERTSPACE(CURRSYM); PPSYMBOL(CURRSYM); IF SPACEAFTER IN OPT THEN INSERTSPACE(NEXTSYM); IF INDENTBYTAB IN OP BUF[ENDFILE+1] := CHR(10); ENDFILE := ENDFILE + 1 END; CBP := ENDFILE + 1; (* NO MORE COPY BUFFER *) LASTLINE := LASTLINE - 1; (* FUDGE IT APPROPRIATELY *) END; MODEND. ME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); EXTERNAL PROCEDURE GETCOMMENT( VAR NAME : KEYSYMBOL; VAR VALUE : STRING; RAL(VAR NAME : KEYSYMBOL; VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN WHILE NXT.NAME = QUOTE DO BEGIN STORENXT(LENGTH,VALUE); WHILE NOT (NXT.NAME IN RITE('Formatting'); GBL_OOPS := FALSE; DSTCURSOR := 2+(BUFSZ-ENDFILE); MOVERIGHT(BUF[2],BUF[DSTCURSOR],ENDFILE-1); (* SHIFT ENTIRE BUFFER UP TO HIGH AREA OF BUFFER *) CURSOR := DSTCURSOR; (* WHERE TO READ FROM *) ENDFILE := bufRSYM); WITH PPOPTION[CURRSYM{^}.NAME] DO BEGIN IF (CRPENDING AND NOT(CRSUPPRESS IN OPT)) OR (CRBEFORE IN OPT) THEN BEGIN INSERTCR(CURRSYM); CRPENDING := FALSE T THEN RSHIFT(CURRSYM{^}.NAME); IF INDENTTOCLP IN OPT THEN RSHIFTTOCLP(CURRSYM{^}.NAME); IF GOBBLESYMBOLS IN OPT THEN GOBBLE(GOBBLETERMINATORS,CURRSYM,NEXTSYM); IF CRAFTER IN OPT VAR LENGTH : INTEGER; BRACE : BOOLEAN); EXTERNAL PROCEDURE SKIPSPACES(VAR SPACESBEFORE,CRSBEFORE : INTEGER); PROCEDURE GETNU[QUOTE,ENDOFLINE,FILEMARK]) DO STORENXT(LENGTH,VALUE); IF NXT.NAME = QUOTE THEN STORENXT(LENGTH,VALUE) END; NAME := OTHERSY END; (*$P*) FUNCTION CHARTYPE:KEYSYMBOL; VAR NEXT_TWO_CHARS : SPECIALCHAR; HIT : BO   OLEAN; THISCHAR : KEYSYMBOL; BEGIN LAST_CHAR := CUR.VALUE; NEXTTWOCHARS[1] := CUR.VALUE; NEXTTWOCHARS[2] := NXT.VALUE; THISCHAR := BECOMES; HIT := FALSE; WHILE NOT(HIT OR (THISCHAR = CLOSECOMMENT)) DO IF NEXTTW VAR VALUE : STRING; VAR LENGTH : INTEGER); BEGIN STORENXT(LENGTH,VALUE); NAME := CHARTYPE; IF NAME IN DBLCHARS THEN STORENXT(LENGTH,VALUE); CASE NAME OF COLON : COLONTSPECIALCHAR(NAME,VALUE,LENGTH); IF NAME = OPENCOMMENT THEN GETCOMMENT(NAME,VALUE,LENGTH,NEXTSYM.VALUE[1]='{') END; FILEMARK: NAME := ENDOFFILE END END; (* GETNEXTSYMBOL *) (*OUNT : INTEGER; INLINE : STRING; DONE : BOOLEAN; NEWSIZE : INTEGER; PROCEDURE KRUNCH(I:INTEGER); VAR J : INTEGER; BEGIN REPEAT NAMELIST^[I] := NAMELIST^[I+1]; I := I + 1; UNTIL ORD(NAMELIST^[I].NAME[1]) = 0 END; BEGIN NE DO BEGIN WRITE(NAMELIST^[I].NAME,'?'); READLN(INLINE); IF (length(inline) <> 0) and (INLINE[1] IN ['N','n']) THEN KRUNCH(I) ELSE I := I + 1; DONE := (NAMELIST^[I].NAME[1]=CHR(0)) OR (INLINE[1] = OCHARS = DBLCHR[THISCHAR] THEN HIT := TRUE ELSE THISCHAR := SUCC(THISCHAR); IF NOT HIT THEN BEGIN THISCHAR := OPENCOMMENT; WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO IF CUR.VALUE = SGLCHAR[THISCHAR]SEEN := TRUE; SEMICOLON : BEGIN COLONSEEN := FALSE; EXTSEEN := FALSE END END END; (*$P*) PROCEDURE GETNEXTSYMBOL(VAR NAME : KEYSYMBOL; VAR VALUE: STRING; VAR LENGTH:INTEGER); $P*) PROCEDURE GETSYMBOL(VAR NEXTSYM,CURRSYM:SYMBOLINFO); VAR DUMMY : SYMBOLINFO; BEGIN DUMMY := CURRSYM; CURRSYM := NEXTSYM; NEXTSYM := DUMMY; WITH NEXTSYM{^} DO BEGIN SKIPSPACES(SPACESBEFORE,CRSBEFORE); LEPROGRAM STRIPIT; (* PROGRAM TO STRIP ENTRY POINT NAMES FROM AN OVERLAY *) TYPE ALPHA = PACKED ARRAY [1..8] OF CHAR; NAMEREC = RECORD NAME : ALPHA; ADDR : INTEGER END; NAMEARR = ARRAY [0..0] OF NA WRITE('File name? '); READLN(TITLE); ASSIGN(INFILE,TITLE); RESET(INFILE); COUNT := 0; WHILE IORESULT <> 1 DO BEGIN COUNT := COUNT + 1; BUF[COUNT-1] := INFILE^; SEEKREAD(INFILE,COUNT); END; WRITELN(Count,' '.') END; (* Now write it out *) I := 0; REPEAT WRITELN(NAMELIST^[I].NAME); I := I + 1 UNTIL (NAMELIST^[I].NAME[1] = CHR(0)); WRITELN(i,' symbols remain'); NEWSIZE := (ORD(ADDR(NAMELIST^[I].NAME))-ORD(ADDR(BUF)));  THEN HIT := TRUE ELSE THISCHAR := SUCC(THISCHAR); END; IF HIT THEN CHARTYPE := THISCHAR ELSE CHARTYPE := OTHERSY END; (*$P*) PROCEDURE GETSPECIALCHAR(VAR NAME : KEYSYMBOL;  BEGIN CASE NXT.NAME OF LETTER : GETIDENTIFIER(NAME,VALUE,LENGTH); DIGIT : GETNUMBER(NAME,VALUE,LENGTH); QUOTE : GETCHLITERAL(NAME,VALUE,LENGTH); OTHERCHAR:BEGIN GENGTH := 0; IF CURRSYM{^}.NAME = OPENCOMMENT THEN GETCOMMENT(NAME,VALUE,LENGTH,NEXTSYM.VALUE[1]='{') ELSE GETNEXTSYMBOL(NAME,VALUE,LENGTH) END END; (* GETSYMBOL *) MODEND. MEREC; SECTOR = ARRAY [0..127] OF BYTE; VAR NAMELIST : ^NAMEARR; I : INTEGER; BASE : INTEGER; TITLE : STRING; INFILE : FILE OF SECTOR; OUTFILE : FILE OF SECTOR; BUF : ARRAY [0..192] OF SECTOR; (* OVERLAY LOADING AREA *) Csectors'); WRITE('Base addr? '); READHEX(INPUT,BASE,2); MOVE(BUF[0,1],I,2); WRITE('Table starts at Offset = '); WRITEHEX(OUTPUT,I-BASE,2); WRITELN; NAMELIST := ORD(ADDR(BUF)) + (I-BASE); DONE := FALSE; I := 0; WHILE NOT DO IF (NEWSIZE MOD 128) <> 0 THEN NEWSIZE := NEWSIZE + 128; WRITELN('New size is ',NEWSIZE DIV 128,' sectors'); COUNT := NEWSIZE DIV 128; WRITE('Writeit? '); READLN(INLINE); IF INLINE <> 'YESDOIT' THEN EXIT; ASSIGN(OUTFIL   E,TITLE); REWRITE(OUTFILE); FOR I := 0 TO COUNT-1 DO BEGIN OUTFILE^ := BUF[I]; SEEKWRITE(OUTFILE,I) END; CLOSE(OUTFILE,I) END. STRIP,RANDOMIO,PASLIB/S/D:4000 i.!g> >کÝ!p+q*DM͡:͆ ͆:_2:`!!:*& N͆!4!6J                 !   !   "   "   #   #   $   $   %   %   &   &   '   '