IMD 1.16: 7/09/2007 11:21:02 ADAP ORIENTER STARTUP 2-6-1  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ O^" STARTUP 2 SYSTEM.STARTUP{ EDITDEMO.TEXT`{\  COMPDEMO.TEXT`{\ #NAMEFILE`{#& SCDEMO.CODE`{&*COPYSCUNIT.CODEB*2 UPDATE.TEXT`{26 UPDATE.CODE`{6: READ.ME.TEXT`{   CONST (PAGETOP=511; {top of page buffer} (  TYPE (ORIENTATION=(DISORIENTED,PCD_ORIENTED,SGRF_ORIENTED,LI_ORIENTB:FSCREENOPS.CODE{ѣFjSCR.TEST.TEXT`{ED); (  VAR (CUR_DCT_BLK, {current block of PCODEFILE in SEG_DCT} (CUR_BLK, {current block of PCODEFILE in PAG STARTUP 2 SYSTEM.STARTUP{ EDITDEMO.TEXT`{\  COMPDEMO.TEXT`{\ #NAMEFILE`{#& SCDEMO.CODE`{&*COPYSCUNIT.CODEB*2 UPDATE.TEXT`{26 UPDATE.CODE`{6: READ.ME.TEXT`{ DCT_RANGE; VAR SEG_DCT:DCT_REC):INTEGER};  {  0 Gets the dictionary page corresponding to DCT_INDEX into SEG_DCT  0 re7E##uuy$i#h!! ՛ ! Ո((s"turning the local (0..15) dictionary index if all went smoothly,  0 -1 otherwise.  }  VAR DCT:INTEGER; " u !+$#$#s+uu"ʭ$ʈ#ʭ ʊ"PROCEDURE DCTFLIP; "{ "1 Byte flips all word quantities in segment dictionary. Assumes "1 SEG_DCT and ALT_PAGE both ontainssh ?  ʚ u ȭ((s uh ɦ ɦsB:FSCREENOPS.CODE{ѣFjSCR.TEST.TEXT`{ unflipped version of segment "1 dictionary. "} "VAR I,J:INTEGER; " A_PAGE:ARRAY[BYTERANGE] OF INTEGER; "BEGIN RIENTATION; {oriented in procedure for GETPCODE?} ( (FLIP_SEG:BOOLEAN; {is current segment byte-flipped?}  (DCT_BLK:   PASCALSYORIENTER  {block numbers of all dictionary pages} 0ARRAY[0..MAX_DCT_PAGE] OF INTEGER; 0 (ALT_PAGE: {scratch page of PCODEFIL E used by GETWORD, etc.} ( ARRAY[BYTERANGE] OF INTEGER; DPASCALSY(PAGE: {current page of PCODEFILE used for GETPROC, GETPCODE} ( PACKED ARRAY[0..PAGETOP] OF BYTERANGE; (SE,e,hSCREEN28`m0Z/`,:^@3G_DCT:DCT_REC; {current page of segment dictionary}    {---------------------- private procedures ------------------- ORIENTER2st tt t t 2st $t,u%t------}    FUNCTION BYTEFLIP(WORD:INTEGER):INTEGER;  {  0 Returns the byte-flipped value of WORD.  }  VAR SWAt ji!"17!skh #$!% u h!iʭsst sGih !P1,SWAP2:PACKED RECORD CASE BOOLEAN OF 0TRUE:(INT:INTEGER); 0FALSE:(MOSTSIG,LEASTSIG:BYTERANGE) .END;  BEGIN  SWAP1.INT:=! j""" hih ! s4t hsih ! s t hih !# (WORD; "SWAP2.MOSTSIG:=SWAP1.LEASTSIG; "SWAP2.LEASTSIG:=SWAP1.MOSTSIG; "BYTEFLIP:=SWAP2.INT; {some simple trickiness here}   (s u hحsIWesEND;     {-------------------- public procedures -------------------------}    FUNCTION GET_DCT{(DCT_INDEX:      )  s^u,s)st st st s`Pt t `Program has following commands::B(ack - backs up cursor,,! unsaves most recent commandC(lear - wipes maze clean# sPv)*s3t sYt sbt s`Pt t s`** *o you can start over again  `u*v* )syt st st s`Pt t s u`vK ROWs^u,s) Tat !n!0(⼃V!0(⼃>!0! ROW YOUR BOAT4Data: I(nsert D(elete P(os R(ight L(eft C(lear Q(uittJEnter string to be inserted: "!!!wT sih ! t h u CURSX::, CURSY:: Then press RETURN,Note: Use BACKSPACE (BS) to erase characterssJType an X for each character to be deleted abov MAZE[]: =Maze: U(p D(own R(ight L(eft B(ack H(elp X(ecute C(lear Q(uit( @@@@e Then press RETURN,Note: Use BACKSPACE (BS) to erase characterssIEnter string to be located:  h li!$Օmj"%5!(!(snk#&#ksnk#&#k"jƈ!ɦR R 1@@@@@@@@@@@@@@@@@@@@@@@@@ @ @ @@@ @@@@@@@@@ @ @ @@@@@@@@@ @@@ @ @ @ @ @@@ @ @ @@@@@ @@@@@ @ L L U U D D !ietSt tft twt ttt @@@@@ @@@ @ @ @ @ @ @ @ @ @@@ @@@ @ @ @@@ @ @@@ @ @ @@@@@ @ @ @ @ @ @@@ @@@@@ @ @@@@@@@@@@@@@ @@@@@ @ tt tt ttt ttt tt ttt ts@ @ @ @@@ @@@@@ @ @ @@@@@@@@@ @ @ @@@ @ @ @ @ @ @ @@@ @@@@@ @@@@@ @@@@@ @ @ @@@@@ @ @ @ @ @ @ t ttt t(t t9t tFt tat !  bt k"0) @@@ @@@ @@@@@ @ @@@@@@@ @@@ @@@ @ @ @ @ @@@@@ @@@@@ @ @ @ @@@@@@@ @ @@@ @ @ @ @ @@@@@@@@@@@ @@X"! "0(⼃` ! R "0(⼃h ! L "0'⼃o ! U v"0'⼃w@@@@@@@@@@@@@@@@%D(own - moves the cursor one box down! (if no wall in the way)%L(eft - moves the cursor one box LEFT$Q ! D Z"~t E" 7" )"Ost ! s" k"0)⼃(uit - terminates the maze program,," returns to Pascal Systemm'R(ight - moves the cursor one box RIGHT!U(p - moves thes,t Bst st s^u^P,Ps u  cursor one box up X(ecute - simulates execution off your "program" of movess# PRESS SPACEBAR TO RETURN TO MAZE$Maze  PROGRAM EDITDEMO;   PROCEDURE REPEAT1;  VAR S,SG:STRING; $L,N:INTEGER;  BEGIN "WRITELN( $'TYPE ANY STRING FOLLOWED BY ' )); "READLN(S); "N:=1; "L:=LENGTH(S); "REPEAT $SG:=COPY(S,1,N); $WRITELN(SG); $N:=N+1; "UNTIL N>L  END (*REPEAT1*);   PROCEDURE REPEAT2;  VAR S:STRING;   PROCEDURE REVERSE; "(*REVERSE THE ORDER OF CHARACTERS &IN S*)  VAR NB,NE:INTEGER; $(*BEGIN AND END POINTERS*) $SAVE:CHAR;  BEGIN "NB:=1; "NE:=LENGTH(S); "REPEAT $(*EXCHANGE CHAR'S NB & NE, &SHIFT NB & NE *) $SAVE:=S[NE]; $S[NE]:=S[NB]; $S[NB]:=SAVE; $NB:=NB+1; $NE:=NE-1; "UNTIL NB>=NE;  END (*REVERSE*);   BEGIN (*O^REPEAT2*) "WRITELN( $'TYPE ANY STRING FOLLOWED BY ' )); "READLN(S); "WHILE LENGTH(S)>0 DO "BEGIN $REVERSE; $WRITELN\(S); $WRITELN; $WRITELN('TYPE ANOTHER STRING'); $READLN(S); "END;  END (*REPEAT2*);   BEGIN (*MAIN PROGRAM*) "WRITELN('START EDITDEMO'); "WRITELN; "REPEAT1; "WRITELN; "REPEAT2;  END.   Then press RETURN,Note: Use BACKSPACE (BS) to erase characterssK_`se  \S); "WHILE LENGTH(S)>0 DO "BEGIN $REVERSE; $WRITELN(S); $WRITELN; $WRITELN('TYPE ANOTHER STRING'); $READLN(S); "END;  END (*REPEAT2*);   FUNCTION BLOWUP(X,Y:INTEGER):BOOLEAN;  VAR "I,LB,UB:INTEGER; "CH:CHAR; "A:ARRAY[1..10] OF INTEGER;  BEGIN  LB:=X; "UB:=Y; "FOR I:=LB TO UB DO $BEGIN &A[I]:=I*I; &WRITELN(I,': ',A[I] ; $END; "BLOWUP:=UB > 10;  END (*BLOWUP*); "  BEGIN (*MAIN PROGRAM*) "WRITELN('START EDITDEMO'); "WRITELN; "REPEAT1; "WRITELN; "REPEAT2; "WRITELN; "IF BLOWUP(5,15) THEN $WRITE('Upper Bound too large');  END.   PROGRAM EDITDEMO;  VAR G1, "G2, "G3,G4:INTEGER; "B1,B2,B3:BOOLEAN;   PROCEDURE REPEAT1;  VAR S,SG:STRING; $L,N:INTEGER;  BEGIN "WRITELN( $'TYPE ANY STRING FOLLOWED BY ' )); "READLN(S); "N:=1; "L:=LENGTH(S); "REPEAT $SG:=COPY(S,1,N); $WRITELN(SG); $N:=N+1; "UNTIL N>L  END (*REPEAT1*);   PROCEDURE REPEAT2;  VAR S:STRING;   PROCEDURE REVERSE; "(*REVERSE THE ORDER OF CHARACTERS &IN S*)  VAR NB,NE:INTEGER; $(*BEGIN AND END POINTERS*) $SAVE:CHAR;  BEGIN "NB:=1; "NE:=LENLawn's Nursery Inc. Lawn, Moe D.APDISK(7123 Shady LaneDE[*](Escondido, CA 92025V0z743-5GTH(S); "REPEAT $(*EXCHANGE CHAR'S NB & NE, &SHIFT NB & NE *) $SAVE:=S[NE]; $S[NE]:=S[NB]; $S[NB]:=SAVE; $NB:=NB+1; $NE:555f San Diego Zooy Inc. Bare, Ted E.APDISK(7Park BoulevardDE[*](San Diego, CA 92101V0zO^=NE-1; "UNTIL NB>=NE;  END (*REVERSE*);   BEGIN (*REPEAT2*) "WRITELN( $'TYPE ANY STRING FOLLOWED BY ' )); "READLN(  55297-5432fAce Veterinary Clinic Ritus, ArthurPDISK(7453 Ocean Avenue[*](Del Mar, CA 9203601V0hORIENT28P0Z/P,:^@3z755-1735fRamona Stock Farminic Bull, TerryurPDISK(7 Box 48 RFD #2nue[*](Ramona, CA 92065601  TYPE $SCCHSET = SET OF CHAR; $SCKEYCOMMAND = (BACKSPACEKEY,ETXKEY,UPKEY,DOWNKEY, @LEFTKEY,RIGHTKEY,NOTLEGAL); $  VAR  V0z789-1573fVista Antiques Storec Teek, AnnryurPDISK(727 Santa Fe Ave.[*](Vista, CA 920 SCCH:CHAR;   PROCEDURE SCINITIALIZE;  PROCEDURE SCLEFT;  PROCEDURE SCRIGHT;  PROCEDURE SCUP;  PROCEDURE SCDOWN;  PROCED835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(727 Santa Fe Ave.[*](Vista, URE SCGETCCH(VAR CH:CHAR; RETURNONMATCH:SCCHSET);  FUNCTION SCMAPCRTCOMMAND(KCH: CHAR): SCKEYCOMMAND;   IMPLEMENTATION CA 920835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(727 Santa Fe Ave.[*](V ista, CA 920835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(727 Santa Fe Ave.[SCDEMO ih !   h%i!ʆ!ʆ!ʆ!ʆ!ʆ+*](Vista, CA 920835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(727 Santa Feʖ ii!# !r$r!!jh " r h" ! Ave.[*](Vista, CA 920835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(727 Sa ! % rIs s ćx`PMF|s PASCALIOEXTRAIO  nta Fe Ave.[*](Vista, CA 920835601V0z724-3176fVista Antiques StorecTeek, AnnryurPDISK(7 27 Santa Fe Ave.[*](Vista, CA 920835601V0z724-3176fTESTSCUNSCDEMO SCDEMO   SCDEMO ih !   h%i!ʆ!ʆ!ʆ!ʆ!ʆ+&TEL:STRING[10] $END;  VAR "RECNUM:INTEGER; "BUF:STRUCTURE; "TITLE:STRING; "FID:FILE OF STRUCTURE;   PROCEDURE ZEROREC(ʖ ii!# !r$r!!jh " r h" !VAR REC:STRUCTURE);  BEGIN "WITH REC DO $BEGIN &NAME:=''; &COMPANY:=''; &STREET:=''; &CITYSTATE:=''; &TEL:=''; $END;   ! % rIs s ćx`PMF|s PASCALIOEXTRAIO  END (*ZEROREC*);   PROCEDURE SHOWREC(REC:STRUCTURE);  BEGIN "WRITELN; "WITH REC DO $BEGIN &WRITELN('NAME: ',NAME) ; &WRITELN('COMPANY: ',COMPANY); &WRITELN('STREET: ',STREET); &WRITELN('CITY&STATE: ',CITYSTATE); &WRITELN('TEO^LEPHONE: ',TEL); $END;  END (*SHOWREC*);   PROCEDURE GETREC(VAR REC:STRUCTURE);  LABEL 1;  VAR S:STRING; " "FUNCTIONTESTSCUNa#sp` ?- %r sprrrr rրr t ptp$t pr11r 1sp0ݖ'Arrow keys move cursor; ETX terminates; BS erases visible charss 2PASCALIOEXTRAIO SCDEMO    TYPE $SCCHSET = SET OF CHAR; $SCKEYCOMMAND = (BACKSPACEKEY,ETXKEY,UPKEY,DOWNKEY, @LEFTKEY,RIGHTKEY,NOTLEGAL); $  VAR   SCCH:CHAR;   PROCEDURE SCINITIALIZE;  PROCEDURE SCLEFT;  PROCEDURE SCRIGHT;  PROCEDURE SCUP;  PROCEDURE SCDOWN;  PROCEDURE SCGETCCH(VAR CH:CHAR; RETURNONMATCH:SCCHSET);  FUNCTION SCMAPCRTCOMMAND(KCH: CHAR): SCKEYCOMMAND;   IMPLEMENTATION  (*$G+*)  PROGRAM UPDATE;  TYPE "STRUCTURE= $RECORD &NAME,COMPANY:STRING[32]; &STREET:STRING[20]; &CITYSTATE:STRING[30];   $END;  1:  END (*GETREC*);   BEGIN (*main program*) "WRITE('File title:'); "READLN(TITLE);  (*$I-*) "RESET(FID,TITLE)UPDATE ; "IF IORESULT<>0 THEN REWRITE(FID,TITLE);  (*$I+*)  RECNUM:=0; "WHILE RECNUM>=0 DO $BEGIN &WRITELN; &WRITE('Record num ber:'); &READLN(RECNUM); &IF RECNUM>=0 THEN (BEGIN *SEEK(FID,RECNUM); *GET(FID); *IF EOF(FID) THEN ,BEGIN .WRITELN('Enter new Record:'); .ZEROREC(FID^); .GETREC(FID^); .SEEK(FID,RECNUM); .PUT(FID); ,END *ELSE ,BEGIN .WRITELN('Old Record:');,hSTANLEY28~0Z/~,:^@3 .SHOWREC(FID^); .WRITELN; .WRITELN('Enter Changes:'); .GETREC(FID^); .SEEK(FID,RECNUM); .PUT(FID); ,END; (END; UPDATE oG!h   " - = C`DCrpr pr prp END (*WHILE*); "CLOSE(FID,LOCK);  END. ( r p`r prpr p#r prpr p.r prp#r p>r prpD2Pr pr pii P**r prprp+*Jr p*^Pr p*HVr p*"0\r p*-br p*=+nCshr pEPr pr pnE READIT(VAR T:STRING):BOOLEAN; "BEGIN $READLN(S); $READIT:=FALSE; $IF LENGTH(S)>0 THEN &IF S[LENGTH(S)]=CHR(27(*ESC*)) THEN READIT:=TRUE &ELSE (T:=S; "END (*READIT*);   BEGIN "WRITELN('RETURN skips item with no change; ESC+RETURN skips whole Record'); "WRITELN; "WITH REC DO $BEGIN &WRITE('NAME:  '); IF READIT(NAME) THEN GOTO 1; &WRITE('COMPANY: '); IF READIT(COMPANY) THEN GOTO 1; &WRITE('STREET: '); IF READIT(STREET) THEN GOTO 1; &WRITE('CITY&STATE:'); IF READIT(CITYSTATE) THEN GOTO 1; &WRITE('TELEPHONE: '); IF READIT(TEL) THEN GOTO 1;  NY: STREET: CITY&STATE: TELEPHONE: ?RETURN skips item with no change; ESC+RETURN skips whole Record NAME: COMPANY: STREET: CITY&STATE: TELEPHONE: File title:Record number::Enter new Record: Old Record:Enter Changes::}& "The quizzes mentioned in the BEGINNER'S MANUAL by Dr. Bowles are  not yet available. We will notify you when they become avaiFILEOPS PASCALIO lable  for sale. " "Dr. Bowles's book was written to describe the II.0 version of the  UCSD Pascal (tm) system. The IV.0 version of the UCSD p-System (tm)  differs with respect to units which are described in Chapter 9. The  UCSD Pascal Users Manual - Version IV.0 describes units correctly. E^BBYSCREENOPSEGSCINI  sp nEs0ղrpnr prpr p0Յn0spnrpnrp+vr prpnnn0spnrpDr prpnrpr prpnn0spnrpHnspns NAME: COMPA  dure sc_use_port(do_what:sc_choice; var t_port:sc_tx_port); "procedure sc_erase_to_eol(x,line:integer); "procedure sc_left; "#l$$$$$$$$ #%l$ $$ $SCREENOPprocedure sc_right; "procedure sc_up; "procedure sc_down; "procedure sc_getc_ch(var ch:char; return_on_match:sc_chset); "pro(h4.0v>3>ƞ++ƞN( </ cedure sc_clr_screen; "procedure sc_clr_line (y:integer); "procedure sc_home; "procedure sc_eras_eos (x,line:integer); "proc  const $sc_fill_len = 11; $sc_eol = 13;   type $sc_chset = set of char; $sc_misc_rec = packed record 8heiedure sc_goto_xy(x, line:integer); "procedure sc_clr_cur_line; "function sc_find_x:integer; "function sc_find_y:integer; "ght, width : 0..255; 8can_break, slow, xy_crt, lc_crt, 8can_upscroll, can_downscroll : boolean; 6end; $sc_date_rec = pacfunction sc_scrn_has(what:sc_scrn_command):boolean; "function sc_has_key(what:sc_key_command):boolean; "function sc_map_crtked record 8month : 0..12; 8day : 0..31; 8year : 0..99; 6end; $sc_info_type = packed record 8sc_version : string; 8_command(var k_ch:char):sc_key_command; "function sc_prompt(line :sc_long_string; x_cursor,y_cursor,x_pos, sc_date : sc_date_rec; 8spec_char : sc_chset; {Characters not to echo} 8misc_info : sc_misc_rec; 6end; $sc_long_string = st7where:integer; return_on_match:sc_chset; 7no_char_back:boolean; break_char:char):char; "function sc_check_char(var buf:sc_wring[255]; $sc_scrn_command = (sc_whome, sc_eras_s, sc_erase_eol, sc_clear_lne, 7sc_clear_scn, sc_up_cursor, sc_down_cursor, indow; var buf_index,bytes_left:integer) 9:boolean; "function space_wait(flush:boolean):boolean; "procedure sc_init; $  imp7sc_left_cursor, sc_right_cursor); $sc_key_command = (sc_backspace_key, sc_dc1_key, sc_eof_key, sc_etx_key, 7sc_escape_key, slementation c_del_key, sc_up_key, sc_down_key, 7sc_left_key, sc_right_key, sc_not_legal); $sc_choice = (sc_get, sc_give); $sc_window = packed array [0..0] of char; $sc_tx_port = record SEGSCINI=J f*f*J UJ "ȆJ !ʖl"$!  Q f8row, col, { screen relative} 8height, width, { size of txport (zero based)} 8cur_x, cur_y : integer; E{*f*Q " ʆQ "ȆQ !ʖ"/!   ap!klh $   hQ#-ĆJ#cursor positions relative to the txport } 6end; 4 "procedure sc_use_info(do_what:sc_choice; var t_info:sc_info_type); "proceĆf)D#lf:m%#%%#&%%%$%$%$%ʆf*#-#    p"!   Zh  Ė#"%f;#""O^Z{ih ! h#"Pu u ćx x ćx`Ζq`p`Ț`u ! i!i!j "f: sm%%[%pl  $$s sj%o*k Zz%"k*u'i#nc$'n& 'p &(n'(o&#h ## '#pn& '$' 'po!'nn& $ $$$$ QJlG$G$xȊGȆG$$Gmԝ%% t'&'&$  u $"'&o!!    )? )$#'&xh jeGseseG sef*f* YȆA pA#"ȆA A Ȇ`k###f:#f:##ĆZ`Jk \f;ɠu u1&xli!$'! Gu !i &xj S ɁE &x:q   ]M8-! hj _t t'&x  tj&&x"%%x"Ė !p"9Ěu  u `u ,⼃#u j&:]? > to continueeD5XSCREENOPr6"x!"!Ċ "x " ĖeJh ! xt !tAu `Z !h ! zqlPvsdH<`RGOTOXY PASCALIOEXTRAIO STRINGOP  j!"h`Z # lfh"!f<f!<! ZZ ZyhZxhZhb za {f; |" }!vu " !Ė#if;mZj!$#"z"|f:ɰJd"zc"{Y"z$ #"}f:ɰ! Y"z$ ȚYu !u$#Zh y  yĖZh y z  yĖZh x xĖZh x { xĖJ i'Q isQj#x"x"x i#u i#xh !" ɡ!" 塠 h l   rrectly with the screen and keyboard, *)  (* 2. The control information is correct for the screen, and *)  (* Program'); "writeln('Copyright (c) 1981, SofTech Microsystems Inc.'); "writeln('Answer all verification questions with a ''Y'' 3. The Screen Editor will have no trouble interfacing to the *)  (* screen or keyboard.  (''y'') or ', F'''N'' (''n'').'); "writeln; "{ Get information from screen control unit }  sc_use_info(sc_get,sc_info); *)  (* *)  (* Richard Kaufmann  "with sc_info.miscinfo do $begin &screenheight:=height; &screenwidth :=width; &lower:=lc_crt $end;  end;   procedure  *) open_log_file;  { Open the error logging file }  begin "repeat $write('What file should errors be logged in? ( for none (* This program is proprietary information of Softech Microsystems Inc. *)  (* Copyright (c) 1979 Softech Microsystems Inc.) '); $readln(error_fn); $rewrite(error_file,error_fn); "until (ioresult=0) or (length(error_fn)=0); "error_count:=0; "log_ All rights reserved. *)  (* *)  (*******************errors:=length(error_fn)<>0;  end;   procedure close_log_file;  { Say goodbye and then close the error logging file }  beg******************************************************)   { --- Modified 20-Sep-79 RSK to use Screen Control Unit --- }  { -in "sc_clr_screen; "writeln; "writeln('Done with Screen Control Diagnostics'); "if log_errors then $begin -- Modified 21-Dec-79 DLB to use II.0 Screen Control Unit --- }  { --- Modified 17-Feb-81 SGS to use IV.0 Screen Control Unit ---}   Program Screen_Diagnostic;   Uses {$U Screenops.code} screen_ops;   const  DLE=16;   type "prompt_string=s {$I-}   (*************************************************************************)  (* tring[255];  var "screenheight, screenwidth: 0..255; "lower,log_errors: boolean; "error_count: integer; "error_fn: string; *)  (* Screen Diagnostic Program 15-July-79 *)  (* ----- "testline: packed array [0..255] of char; { line of percent signs } "sc_info: sc_info_type; "s: prompt_string;  error- ---------- ------- *)  (* _file: text;    procedure initialize;  { inits testline and prints welcome message }  begin  *)  (* This program provides a confidence test that shows: *)  (* 1. The BIOS is working co"sc_init; {Initialize Screen Control Unit} "fillchar(testline,sizeof(testline),'%'); " "writeln('Screen Control Diagnostic  rror_count+1; &writeln(error_file,error_count:5,' ',s); $end  end;   procedure ok(s:string);  { read a character. if it ,end *else ,i:=next+1 & end $end;  end;   procedure test_basic;  begin  writeln('* Is this sentence surroundis a N(o then, using log, write the string "to the error logging file }  var ch: char;  begin "repeat read(keyboard,ch) unted by two asterisks (stars). *'); "ok('test_basic: not all characters being written out');  end;   procedure test_gotoxy; il ch in ['Y','y','N','n']; "if ch in ['N','n'] then log(s)  end;   procedure message(prompt:prompt_string);  { clears scr { Try some border cases (0,0) and lower right corners. Also draws a "box. Not a complete test. Just a confidence test }  een, prints message. Imbedded into message can be an arbitrary "number of |x y| strings. Instead of these strings being displ  var "i,x,y: integer; "  procedure exhaustive_gotoxy_check; "{ checks all possible locations on the screen. } "var x,y:ayed, a "sc_goto_xy(x,y) is performed }   var "i,l,next,x,y: integer; "  integer; & $procedure line_out; $begin &for x:=screenwidth - ord(y=screenheight) downto 0 do (begin *sc_goto_xy(x,y); *"function read_integer(var index: integer; term_ch: char): integer; "{ parse integer in string, return value, term_ch tells whwrite(chr( ord('A') + x mod 27 ) ) (end; " end; " "begin $sc_clr_screen; ${ write out line the standard way to check sc_gat character $terminates input }  var ch: char; n: integer; "begin $n:=0; $repeat &ch:=prompt[index]; &if ch in ['0'..'oto_xy patterns against } $sc_goto_xy(0,2); $for x:=0 to screenwidth do write(chr( ord('A') + x mod 27 )); ${ now write out r9'] then (begin *n:=n*10+ord(ch)-ord('0'); *if n>255 then ,begin .writeln('integer overflow in message procedure', 6'. inest of screen backwards } $for y:=screenheight downto 3 do lineout; dex=',index); .exit(program) ,end; *index:=index+1 (end &else (if ch<>term_ch then *begin ,writeln('illegal character in" message('|0 0|Are all of the below lines the same (except for a'); $message('|0 1|missing char in the lower right) ?'); $o message procedure. ch=',ch); ,exit(program) *end; $until ch=term_ch; $index:=index+1; $read_integer:=n "end; $  begin k('exhaustive_gotoxy_check: first pass not ok'); " ${ now check the first two lines } $y:=0; lineout; { fill in the top two &writeln(error_file); &writeln(error_file, ('***** End Diagnostic; ',error_count,' errors encountered.'); &close(error_file,"i:=1; "l:=length(prompt); "while i<=l do $begin &next:=scan(l-i+1,='|',prompt[i])+i; { next sc_goto_xy } &if next>l then lock); &writeln('Error File "',error_fn,'" closed with ',error_count,' errors.'); $end;  end;   procedure log(s:prompt_str(begin unitwrite(1,prompt[i],l-i+1); i:=l+1 end &else (begin *unitwrite(1,prompt[i],next-i); *if prompt[next]='|' then ,being);  { write string to error logging file. keep track of error count }  begin "if log_errors then $begin &error_count:=egin { parse x and y, perform sc_goto_xy } .i:=next+1; .x:=read_integer(i,' '); .y:=read_integer(i,'|'); .sc_goto_xy(x,y)  lines } $y:=1; lineout; $sc_goto_xy(0,screenheight); $write(' ':screenwidth); $sc_goto_xy(0,screenheight); $message('Are al0,y); $write(testline:screenwidth+1); $sc_goto_xy(x,y); $sc_clr_line(y); l of the above lines the same?'); $ok('exhaustive_gotoxy_check: top line error'); "end; " "procedure it; begin sc_goto_xy(x,$message('|0 0|Is this the only thing on the screen?'); $ok(concat('test_clr_line: didn''t clear enough - ',s));  end; " y); write('*') end; "  begin  sc_clr_screen; "message('|0 0|Does this message also start at the upper-left corner?'); "ok begin "try(45,12,'(45,12)'); "try(0,10,'(0,10)'); "try(screenwidth,3,'(0,Screenwidth)'); "sc_clr_screen; "sc_goto_xy(0,1);('test_gotoxy: sc_goto_xy(0,0) did not go home'); "sc_clr_screen; "for i:=1 to screenheight do writeln; "for i:=1 to screenwi "for y:=1 to screenheight-1 do $begin &write(testline:screenwidth+1); &sc_goto_xy(0,y+1); $end; "sc_goto_xy(10,10); sc_cldth-2 do write(' '); "write('>'); "sc_goto_xy(screenwidth-1,screenheight); "message('*|0 0|Is there a ''>'' immed. followed br_line(10); "message('|0 0|Are there two blocks of "%"s (no gaps or missing chars) ?'); "ok('test_clr_line: Clearing one line y a ''*'' in the lower'); "message('|0 1|right corner?'); "ok('test_gotoxy: sc_goto_xy(screenwidth-1,screenheight) not ok'); affected another');  end;   procedure test_clr_cur_line;  begin  { Is there any use for this????? }  end;   procedur"sc_clr_screen; "sc_goto_xy(0,0); "for y:=0 to 8 do writeln; "message('-------->|9 9|');  y:=9; for x:=9 to 18 do it; "xe test_erase_eol;  { display full line then erase most of it }  var i: integer;  begin  sc_clr_screen; "sc_goto_xy(0,8); :=9; for y:=9 to 18 do it; "y:=18; for x:=9 to 18 do it; "x:=18; for y:=9 to 18 do it; "message('|5 0|Does the box have 10 st"for i:=1 to 20 do write('*'); "write('>'); "for i:=22 to screenwidth do write('$');  sc_goto_xy(21,8); sc_erase_to_eol(21ars per side and start at the arrow?'); "ok('test_gotoxy: box not correctly drawn'); "exhaustive_gotoxy_check;  end;   pro,8); "message('|0 0|Is the line below a series of stars immed. followed by'); "message( ' a right-arrow (''>'')?'); cedure test_clr_screen;  begin  sc_clr_screen; "message('|0 10|Is the screen blank (except for this sentence'); "message(' ok('test_erase_eol: sc_erase_to_eol didn''t work');  end;   procedure test_etoeos;  { Draw a block of characters on the|0 11|and (maybe) the lower-right hand character) ?'); "ok('test_clr_screen: screen not cleared');  sc_clr_screen; "message screen and erase most of them }  var i,y: integer;  begin "sc_clr_screen; "sc_goto_xy(0,4); "for y:=4 to screenheight do ('Does this message start at the upper-left corner?'); "ok('test_clr_screen: cursor not left at (0,0) afterwards');  end;  $begin &{ if last line write out one less star (could force scroll) } &write(testline:screenwidth - ord(y=screenheight) + 1);  procedure test_clr_line;  var i,y: integer;  "procedure try(x,y:integer;s:string); "begin $sc_clr_screen; $sc_goto_xy(&if ysc_not_legal) or ( (key=sc_not_legal) and (ch=compare_ch) ) ); "ok('test_scroll: sc_down at bottom line didn''t scroll');  end;   procedure test_DLE_expansion;  { make sure that DLE fol&if not okch then (begin *message('|0 5|Key typed is not correct.'); *message('|0 6|Do you wish to try typing this key again?nes of ''%''s followed by a line'); "message('|0 1| with just five ''%''s (and maybe a stray character in'); "message('|0 2| lowed by n+32 (where n is the number of blanks), "when sent to the terminal expands properly }  var i,j,start: integer;   the extreme lower-right corner)?'); "ok('test_etoeos: sc_eras_eos didn''t work');  end;   procedure test_home;  begin  dashes,plus: packed array [0..255] of char;  begin "fillchar(dashes,sizeof(dashes),'-'); "fillchar(plus,sizeof(plus),'+'); " sc_clr_screen; "message('|0 0|Is the cursor at the upper-left corner (over the ''I'')?'); "sc_home; "ok('test_home: cursor di:=0; "while i<=screenwidth do $begin &sc_clr_screen; &start:=i; &while (i<=start+9) and (i<=screenwidth) do (begin *{ wridn''t go home');  end;   procedure test_single_vectors; { up, left, right, down }  begin  sc_clr_screen; ite line to be partially blanked } *sc_goto_xy(0,i-start+1); *if i>0 then write(plus:i); *if i+1<=screenwidth then write('<')"message('|15 15|*|0 0|Is the cursor to the right of the star?'); "sc_goto_xy(15,15); sc_right; "ok('test_single_vectors: sc_; *j:=screenwidth-i; *if j>0 then write(dashes:j); ( i:=i+1; (end; &sc_goto_xy(0,1); &{ now blank out all of the '+'s } right didn''t work'); "message('|0 0|Is the cursor to the left of the star?'); "sc_goto_xy(15,15); sc_left; "ok('test_single&for j:=start to i do writeln(chr(DLE),chr(j+32)); &message('|0 0|Are all the lines below a ''<'' followed by ''-''s?'); &ok('_vectors: sc_left didn''t work'); "sc_goto_xy(0,0); sc_clr_line(0); "message('|0 0|Is the cursor just below the star?'); "sc_test_DLE_expansion: expansion not happening properly'); $end;  end;   procedure test_special_keys; goto_xy(15,15); sc_down; "ok('test_single_vectors: sc_down didn''t work'); "message('|0 0|Is the cursor just above the star?') { prompt user to type all of the "interesting keys" }  var ch: char;  "procedure test(s:string; key:sc_key_command; compar; "sc_goto_xy(15,15); sc_up; "ok('test_single_vectors: sc_up didn''t work');  end;   procedure test_scroll;  { ensures the_ch: char); "{ s is the name of the key; key is what should be returned. $If key is sc_not_legal then the character is checkeat a line feed on the bottom line of the screen causes "the screen to scroll up one line }  begin "sc_clr_screen; "write(ted against $ch. } "var okch,bailout: boolean; &returned:sc_key_command; "begin $repeat &sc_clr_screen; &message(concat('P  sc_not_legal, chr(13)); "test('tab', sc_not_legal, chr(9) ); "test('line feed', sc_not_le=low_ch to high_ch do write(ch); $sc_goto_xy(4,5); $ch:=low_ch; $repeat &read(keyboard,input_ch); &if sc_map_crt_command(ingal, chr(10));  end;   procedure test_normal_keys;  { checks that all of the keys can be typed. needs to understand wput_ch)<>sc_not_legal then (error(',|4 8|which is interpreted as a special key.') &else (if ch=input_ch then *begin write(chhether "this is an upper-case keyboard }   var "bad: prompt_string; { contains all non-typeable characters }  ); ch:=succ(ch) end (else *error('') $until ch>high_ch; "end;   begin { check_normal_keys } "bad:=''; "range(' ','O'); "procedure range(low_ch,high_ch: char); "{ tests characters in the range [low_ch..high_ch] } "var $ch,input_ch,gch: char; ""if not lower then $begin range('P','`'); range('{','~') end "else $range('P','~'); "{ whenever a key can't be typed it is  s: string[1]; { place holder for ch -> string conversion } ( $procedure error(s: string); ${ handles incorrectly typed charconcatted to BAD } "if length(bad)>0 then $log(concat('check_normal_keys: Can''t type these: ',bad));  end;    begin { Sacters } $begin &message('|4 7|Bad character. You typed a '''); &if input_ch in [' '..'~'] then (write(input_ch) &else (wcreen_Diagnostic } "initialize; { print welcome message, initialize testline to '%'s } "open_log_file; "test_basic; '); *repeat read(keyboard,ch) until ch in ['Y','y','N','n']; *bailout:=(ch in ['N','n']); *if bailout then ,log(concat('testrite('chr(',ord(input_ch),')'); &message(concat('''',s)); &message('|4 9|Do you wish to try this character again?'); &repeat _keyboard: ',s,' key not correct')); (end; " until bailout or okch; "end; read(keyboard,gch) until gch in ['Y','y','N','n']; &if gch in ['N','n'] then (begin *{ must move character to string variable" { 0 -> never used }  begin  test('up-arrow', sc_up_key, c to match types ,with concat } *s:=' '; s[1]:=ch; bad:=concat(bad,s); *ch:=succ(ch) (end; &{ erase the two lines of error mhr(0) ); "test('down-arrow', sc_down_key, chr(0) ); "test('left-arrow', sc_left_key, chr(0) ); essage } &sc_goto_xy(0,7); sc_erase_to_eol(0,7); &sc_goto_xy(0,8); sc_erase_to_eol(0,8); $ sc_goto_xy(0,9); sc_erase_to_eol("test('right-arrow', sc_right_key, chr(0) ); "test('editor accept (etx)', sc_etx_key, chr(0) ); "test('lin0,9); $ { ... and then go back to the next character to be input } &sc_goto_xy(4+ord(ch)-ord(low_ch),5); $end; " "begin e del', sc_del_key, chr(0) ); "test('DC1', sc_dc1_key, chr(0) ); "test('backspace', $sc_clr_screen; $message('Please type in the following characters|2 1|in the EXACT'); $message(' order shown:|4 4|'); ${ mar sc_backspace_key, chr(0) ); "test('escape', sc_escape_key, chr(0) );  test('return', k the fact that there is a } $if low_ch=' ' then &message('|2 2|Note: The first character is a space|4 4|'); $for ch: MES[1]:='KERNEL '; $DCT_INDEX:=GET_DCT(DCT,SEG_DCT); $WITH SEG_DCT DO $BEGIN &IF (SEG_MISC[DCT_INDEX].SEG_TYPE IN [PROG_SEG,UNIT_SEG]) THEN (PARENT:=SEG_NAME[DCT_INDEX] &ELSE PARENT:=SEG_FAMLY[DCT_INDEX].PROG_NAME; &J:=0; &WHILE GET_DCT(J,SEG_DCT)>=0 DO &BEGIN & FOR I:=0 TO 15 DO *BEGIN ,IF SEG_FAMLY[I].PROG_NAME=PARENT THEN .SEG_NAMES[SEG_INFO[I].SEG_NUM]:=SEG_NAME[I]; ,IF SEG_NAME[I]=PARENT THEN .BEGIN /IF ALIGN_SG_REF THEN 0REPEAT {pickup list} 2GET_SEG_REF(SEG_REF); 2SEG_NAMES[SEG_RM_6502 :WRITEOUT('M_6502 '); . M_6800 :WRITEOUT('M_6800 '); . M_9900 :WRITEOUT('M_9900 '); .END; .WRITE(OUT,SEG_NUM:EF.SEG_NUM]:=SEG_REF.SEG_NAME; 0UNTIL SEG_REF.SEG_NAME=' '; 0SEG_NAMES[SEG_INFO[I].SEG_NUM]:=PARENT; .END; 4); * END; ,WITH SEG_MISC[DCT_INDEX] DO ,BEGIN .WRITEOUT(' '); .CASE SEG_TYPE OF . NO_SEG :WRITEOUT('NO_SEG '); . P& END; (J:=J+16; &END; $END; $IF ((J-1) DIV 16)<>(DCT DIV 16) THEN DCT_INDEX:=GET_DCT(DCT,SEG_DCT); "END; # #  BEGINROG_SEG :WRITEOUT('PROG_SEG'); . UNIT_SEG :WRITEOUT('UNIT_SEG'); . PROC_SEG :WRITEOUT('PROC_SEG'); . SEPRT_SEG:WRITEOUT('S {SEGMTGUIDE} "REPEAT $WRITELN; $WRITE('Segment Guide: A(ll), #(dct index), D(ictionary), Q(uit)'); $READ(CH); $CASE CH OF EPRT_SG'); .END; .WRITEOUT(' '); .IF RELOCATABLE THEN WRITEOUT('R') ELSE WRITEOUT(' '); .IF HAS_LINK_INFO THEN WRITEOUT('L')&'A','a':BEGIN {disassemble all possible segments} 0FOR DCT:=0 TO MAX_DCT_ENTRY DO 2IF ALIGN_SEG(DCT)>=0 THEN 3IF (GETPROCLI ELSE WRITEOUT(' '); .WRITEOUT(' '); .IF (SEG_TYPE IN [PROG_SEG,UNIT_SEG]) THEN 0WITH SEG_FAMLY[DCT_INDEX] DO 2WRITE(OUT,DATST(PROCLIST)>0) THEN 5BEGIN 7GET_SEG_LIST; 7SIZE:=GETWORD(0,VALID,TRUE); 7DUMPDATAPOOL; 7FOR I:=1 TO PROCLIST[0] DO 9BEGIN"test_clr_screen; "test_gotoxy; "test_clr_line; "test_clr_cur_line; "test_erase_eol; "test_etoeos; "test_home; "test_sinA_SIZE:6,SEG_REFS:5,HI_SEG_NUM:4,TEXT_SIZE:3) .ELSE WRITE(OUT,'''',SEG_FAMLY[DCT_INDEX].PROG_NAME,''''); * END *END gle_vectors; { up, left, right, down }  test_scroll; { make sure LF at bottom line scrolls screen } "test_DLE_expansion; "t(ELSE WRITE(OUT,' ':46,'NO_SEG'); (WRITELN(OUT); &END; $WRITELN(OUT,'(C):',SEG_DCT.COPY_NOTE); $LIST_SEX; "END;    est_special_keys; { test arrows, etx etc. } "test_normal_keys; { test ' '..'~' } "close_log_file;  end.  PROCEDURE GET_SEG_LIST; "{ "2 Pickup segment reference list for parent segment, if in dictionary. "} "VAR J,I:INTEGER; (SEG_REF:SEG_REF_REC; " PARENT:NAMETYPE; "BEGIN $FILLCHAR(SEG_NAMES,SIZEOF(SEG_NAMES),' '); {clear out segnames} $SEG_NA  0WHILE (CH=' ') AND (GET_DCT(DCT,SEG_DCT)>=0) DO 0BEGIN 2LIST_DIRECTORY(LISTFILE); 2DCT:=DCT+DCT_SIZE; 2IF (SEG_DCT.NEXT_PTFILE,LOCK); {$I+}  END. AGE<>0) THEN 4BEGIN 5WRITE('Type space for next page, anything else to Quit'); 5READ(CH); WRITELN; 4END 2ELSE CH:=CHR(0); 0END; 0CH:=CHR(0); .END; 4 &'0','1','2','3','4','5','6','7','8','9': {variety is the spice of life} .BEGIN 0DCT:=ORD(CH) - ORD('0'); 0READ(CH); WRITELN; 0IF CH IN ['0'..'9'] THEN 2DCT:=DCT*10 + ORD(CH) - ORD('0'); 0DCT_INDEX:=ALIGN_SEG(DCT); 0IF DCT_INDEX>=0 THEN PROCCOUNT:=GETPROCLIST(PROCLIST) 2ELSE PROCCOUNT:=0; 0IF PROCCOUNT>0 THEN 0 BEGIN 4GET_SEG_LIST; 4SIZE:=GETWORD(0,VALID,TRUE); 3 PROCGUIDE; 2END 0ELSE 2BEGIN 2 WRITELN; 4WRITELN('dictionary entry',DCT:3,' is empty'); 2 PROMPT; 2END; 0CH:=CHR(0); .END; &END; {case} "UNTIL (CH IN ['Q','q']);  END;    BEGIN {main program} IVDCODE "INIT; "REPEAT $REPEAT {reset input file} &WRITE('input file: '); &IF SAVENAME<>'' THEN WRITE('[',SAVENAME,'] '); &READLN (LISTNAME); &IF LISTNAME='' THEN LISTNAME:=SAVENAME; $UNTIL (PCODERESET(LISTNAME)=0) OR (LISTNAME=''); $SAVENAME:=LISTNAME;  $IF LISTNAME<>'' THEN &BEGIN (REPEAT {rewrite output file} *WRITE('listing file [CONSOLE:] '); *READLN(LISTNAME); *IF LISThIT<<GG8FrGG1z=NAME='' THEN LISTNAME:='CONSOLE:'; *{$I-} CLOSE(LISTFILE,LOCK); REWRITE(LISTFILE,LISTNAME); {$I+} (UNTIL IORESULT=0; IVDCODE  ?BU P s t ptpptpt p`t p tp$h#ji!"(CONSOLE:=(LISTNAME='CONSOLE:') OR (LISTNAME='#1:'); (IF LISTNAME<>'' THEN SEGMTGUIDE; & WRITELN; WRITE(' Continue? '); RE݆U`!˧up!iޖke pj"/ձ"`ri#:݀ upet ptpke p"tp݂, ;PROCMAX(I,MAX_OFFSET); ;DUMPPROC(PROCLIST[I],MAX_OFFSET); 9END; 5END; 0PROMPT; .END; &'D','d':BEGIN 0DCT:=0; CH:=' ';AD(CH); WRITELN; &END $ELSE CH:='N'; "UNTIL (CH='N') OR (CH='n');  IF (LISTNAME<>'') AND NOT CONSOLE THEN {$I-} CLOSE(LIS `r %"Ċ%Ċ%Ė)`*P`t p+tptpzxi!jՆtpT 'kpu zփ!ɊQKB90' ݆*t ptp{h!! i!9b!upbt pbt ptp!itpoփ#!tpji!Ɋ-' փ݂! ! t p!݀ up!lddɀ~ e#dȊe#ˀ-ddɀ~ e#dȊ e#ˀ-#k"jI#j݀ "upt ptp tptpr gtp| ݆*t ptpm`r `)$tp݂t p`t ptet ptptperier]˧j xhtp݂.t p݆*t ptp݂<t ppm%Ŋt ptp f tptpr tp ݆*t ptp`r `t p$  tp݂@t ptp tp݂St p !tp݂Wt p!tp݂_t p!!tptp!"t p%tp݂t p%tp݂t p&tp~݂t p%tp݂t p&tpO$$ tpb݂ft ptpO݂vt ptp9ݭtp݂t ptp݂t ptpր݂t   ց݂t p%tp݂t p&tp݂ t p'   $$   p݆*t p݂t pݭtp݂t ptp1Kt p*t pt ptp # ւ(. %3 6 9 ւ;@ &tp$݂Dt p'tp& `xtp&t ptpadrh ո1Kt p*t pt ptpt ptptp݂ ) *+.(tp `r ( `*xtp* ͊ւItp$Wt ptp tptpft p݆*t p݂ t p݇tptp݂t p(tp݂t p'tp݂t p&&tpt ptpkt p*t ptpwt ptpt p`t p ]˧kj"#" ]"tp݂$t p%tp݂*t p$tptp݂0t p݀ up݂6t ptp r$݂;t ptp˧"j  0i`t p $! 0i`t p  ! 0ihtp!!&j"]݇tp݀(up݂Bt p݄ t pɋ݀ upɀ⼀ۀҀռۀ݇tp݀ up]"˧!"j" !ւ յtp )`*P`t p+  h `˧ ɀ⼀ۃE ݆ t p݇tp݇tp݇tp݀ upVɀ ݆ t p݇tpt ptptp#tp#tp&#Et p#tp# number of procs in segmentIO error on fileesegment procedure0 not available in P-Code form NO_SEG PROG_SEGGUNIT_SEGGPROC_SEGGSEPRT_SGG R L  NO_SEGG(C)::KERNEL 8Segment Guide:  for disassembly....segment procedure0 not available in P-Code form for disassembly.... Disassembling segment procedureA(ll), #(dct index), D(ictionary), Q(uit))/Type space for next page, anything else to Quitdictionary entryy is empty0!-j#"xtp#"ytp#"ztp#"{tp!#'up#t p#'up# .up#  .... Segment: Procedure::Block:: Block offset: Seg offset: Data size:: Exit IC:: OffsetHex codee exit codet p#tp#t p#t p#tp  p Oˆ rjg*::): RInterface text for segment trouble reading interfaceno interface text to list#Segment rgi!Oˆ rՒ h +Հ g! * * g9r br &beference list for segment : )no segment reference list in this segmentLinker information for segment  EOFMARKK CONSb冃 g hz!i^!Oˆ r 1 tpt pgt p'1O i!(J!TDEF PUBLDEF baseoffset== pubdataseg== GLOBDEF homeproc== icoffset== EXTPROCC EXTFUNCC SEPPROCC SEPFUNCC srOr9]r0frj]˧ l$)$` ]$˧ $l!ii o' !Oˆ r1ݐ!it pcproc= nparams= koolbit=TRUEEFALSE GLOBREFF PUBLREFF PRIVREFF CONSTREF format==WORDDBYTEEBIG gt ptpoo'0igt ptp'. ! '0i!Ork#]rmm% frj 3tp2t pnrefs= nwords== 0****S:no linker information to list There are procedures in segment 7Procedure Guide: A(!tp;t ptpoք@'wա u݆ vt p"[upt pt pll), #(of procedure), L(inker info),@ C(onstant pool), S(egment references), I(nterface text), Q(uit))0s{{{,Pt pt p,,P,r,ԑ,P,Ռt p,Pt pt p,,Pv݆{{{{{{{9lgvq9lgv  { }  {================================================ IVMDCODE ========================}   CONST MAX_DCT_PAGE = 4; {maximum dictionary pages} (MAX_DCT_ENTRY = 79; {maximum dic tionary entries} (DCT_SIZE = 16; {dictionary entries per page}  TYPE (BYTERANGE=0..255; {range of byte values}7  (PROCRANGE=0..255; {range of valid procedure numbers} (DCT_PAGE_RANGE=0..15; {range of possible segment dictionary enhIT<$<GG8F*rGG1z=tries} (DCT_RANGE=0..MAX_DCT_ENTRY; {range of dictionary entries} ( (NAMETYPE=PACKED ARRAY[0..7] OF CHAR; {identifier name  {========================================================================}  { } ( ({pcode types - describing operand format} ,PCODETYPE=(INVALID,NO_OPERANDS,ONE_OPERAND,TWO_OPERANDS, 8THREE_OPERANDS);  }  { I V . 0 D E C O D E R M O D U L E }  { ( ({pmachine versions} ,VERSION_TYPE=(UNKNOWN,II_0,II_1,III_0,IV_0,V,VI,VII); , ({machine types} ,M_TYPES=(M_PSUEDO,M_6809, }  { Author: Bill Franks M_PDP_11,M_8080,M_Z80,M_GA_440, 6M_6502,M_6800,M_9900); 6 ({segment types} duuuuuuuuuu&& inp}  { Version: IV.0 [a.3] Date: Feb. 18, 1981 }  { ut file: ] listing file [CONSOLE:] CONSOLE::CONSOLE::#1: Continue? Y_T53BQ:#  }  { This module is an attempt at providing a USEable, flexible }  { interface to FILEOPS EXTRAIO PASCALIOGOTOXY IVMDCODE compiled P-CODE files and the ease of their }  { dissection.  }  { }  { copyright (c) 1980 SofTech Microsystems }  k} 8END; , SEG_NAME: ARRAY[DCT_PAGE_RANGE] OF NAME_TYPE; {segment names} , SEG_MISC: ARRAY[DCT_PAGE_RANGE] OF PACKED RECORDnds, if valid} 0END_OF_PROC :BOOLEAN; {does this pcode end procedure?} 0BYTE_ARRY {the literal pcode sequence}  8 SEG_TYPE:SEG_TYPES; {segment type} :FILLER:0..31; {reserved for future use} :HAS_LINK_INFO:BOOLEAN; {need to be linked?} <:PACKED ARRAY [0..7] OF BYTERANGE; 0NUM_BYTES, {number of bytes parsed} 0PROC_OFFSET, {proc offset o:RELOCATABLE:BOOLEAN; {segment relocatable?} 8END; .SEG_TEXT: ARRAY[DCT_PAGE_RANGE] OF INTEGER; {start blk of text} .SEG_INFf pcode in bytes} 0SEG_OFFSET, {seg offset of pcode in bytes} 0OPERAND1, {operands to pcode as needeO: ARRAY[DCT_PAGE_RANGE] OF PACKED RECORD 8 SEG_NUM:0..255; {local segment number} :M_TYPE:M_TYPES; {machine type} :FILLER:0d} 0OPERAND2, 0OPERAND3 :INTEGER; .END;  (SEG_REF_REC=RECORD 0SEG_NAME:NAMETYPE; 0SEG_NUM:INTEGER; .END; . (LITYPE..1; {reserved for future use} :MAJOR_VERSION:VERSION_TYPE; {pmachine version} 8END; .SEG_FAMLY:ARRAY[DCT_PAGE_RANGE] OF S=(EOFMARK,GLOBREF,PUBLREF,PRIVREF,CONSTREF,GLOBDEF,PUBLDEF, 0CONSTDEF,EXTPROC,EXTFUNC,SEPPROC,SEPFUNC); 0 (LIENTRY=RECORD CA:RECORD CASE SEG_TYPES OF (TEXT_SIZE, {size in blocks of interface text} SE BOOLEAN OF 0TRUE:(WRDS:ARRAY[0..7] OF INTEGER); 0FALSE:(NAME:PACKED ARRAY[0..7] OF CHAR; 7CASE LITYPE:LITYPES OF 9GLOBREF>HI_SEG_NUM, {number of segments in file} >SEG_REFS, {segment reference list size} >DATA_SIZE:INTEGER); {data size} (PROG_NAME:NAME_TYPE); {parent segment's name} :END; .NEXT_PAGE:INTEGER; {next page of dictionary} .FILLER: SRCPROC:INTEGER;  zć{!i~k"h3 xJ3 x)83 xrp3 x)8!p!"kBցF lptx|j+10!!Oˆ8+!++)0+j`2jV.WPs.spjb.PtbUtbs3wlaVK@5* ppJih8 r+3! Ć8 8Бh8h!ih !ԺpY0+1)X +8` +gm%gh' p l$ % $$Ȅ $%$g$ljik" l$ / $x!{qg]S I?5+! k#y%%Y%i#x%h%m$ )8 rp )$Ć8%xj! b˧n b˧nEj+O8`+ IND INC EQSTR LESTR GESTR ASTR CSTR INCI DECI SCIP1 SCIP2 TJP LDCRL LDRL STRL CNTRL ;8+i!yh ,1!x /8/rpj1" p"ą1x8," p, ,,?// EXPRL &1 zć{!i~k"h3 xJ3 x)83 xrp3 x)8!p!"kBցF lptx|j+10!!Oˆ8+!++)0+j`2jV.WPs.spjb.PtbUtbs3wlaVK@5* ppJih8 r+3! Ć8 8Бh8h!ih !ԺpY0+1)X +8` +gm%gh' p l$ % $$Ȅ $%$g$ljik" l$ / $x!{qg]S I?5+! $x $xi$k$l#Q# "˧B #˧n #ˇ "˧Ȅ # "xć "&"j#"  $ (ւ, ! !Ʋ 6h,0//8/rp   1p,8,7 4@ "v+C7*** STRINGOPFI] " |& p +8`+ոdk#dh$ա'' Ց&m#'dj""#v"-8+LEOPS EXTRAIO  x-/-,.%/%,%"%"d%x""%""%"d8/rp 1      IVMDCODEIVDCODE tl a VK@5*!%) - 159=AEIMQUY]7  {aqegi]mSqIu?y5}+! րwlaVK@5* !p! !ċ!ɀ/!t! !ċ!ɀ?!x! !ɀ/ċ!ɀg!|! !ɀ_Ċd!ɀo LSL LDE LAE NOP LPR BPT BNOT LOR LAND ADI  #.9DOZ!! !ɀgĊC!ɀw$!!! !ɀo! Ċ!! !ɀxĊ!ʋF!ɋ:!! !ep{SBI STL SRO STR LDB NATIVE NAT-INFOINVALID CAP CSP SLOD1 SLOD2 INɀ⼀ҀԼۀ"! ! .! Ċ ! .! ċ!! ċ!! ! ċ!! ! ċ!VALID EQUI NEQI LEQI GEQI LEUSW GEUSW EQPWR LEPWR GEPWR EQBYTE LEBYTE GEBYTE SRS SWAP TRUNC RO! ! ! ċ!! ! ! Ċt!! !ɀ⼀ ! .! ĊH!! ! ! UND ADR SBR MPR DVR STO MOV DUP2 ~ #.9DOZep{Ċ*!! ! jh " !  hւ! !ɀ! 1Q#ą+z8`+f8+i!y$$ADJ STB LDP STP CHK FLT EQREAL LEREAL GEREAL LDM SPR EFJ NFJ FJP FJPL P!x$h$l# )8 rp )#"28$xm 8$xm$ą+Յ8`+q8+ XJP IXA IXP STE INN UNI INT DIF SIGNAL WAIT ABI NGI DUP1 ABR NGR LNOT k#y%%Y%i#x%h%m$ )8 rp )$Ć8%xj! b˧n b˧nEj+O8`+ IND INC EQSTR LESTR GESTR ASTR CSTR INCI DECI SCIP1 SCIP2 TJP LDCRL LDRL STRL CNTRL ;8+i!yh ,1!x /8/rpj1" p"ą1x8," p, ,,?// EXPRL &1 number of procs in segmentIO error on fileesegment procedure0 not available in P-Code formփ#!tpji!Ɋ-' փ݂! !  for disassembly....segment procedure0 not available in P-Code form for disassembly.... Disassembling segment procedure!-j#"xtp#"ytp#"ztp#"{tp!#'up#t p#'up# .up#  .... Segment: Procedure::Block:: Block offset: Seg offset: Data size:: Exit IC:: OffsetHex codee exit codet p#tp#t p#t p#tp  p Oˆ rjg*::): RInterface text for segment trouble reading interfaceno interface text to list#Segment rgi!Oˆ rՒ h +Հ g! * * g9r br &beference list for segment : )no segment reference list in this segmentLinker information for segment  EOFMARKK CONSb冃 g hz!i^!Oˆ r 1 tpt pgt p'1O i!(J!TDEF PUBLDEF baseoffset== pubdataseg== GLOBDEF homeproc== icoffset== EXTPROCC EXTFUNCC SEPPROCC SEPFUNCC srOr9]r0frj]˧ l$)$` ]$˧ $l!ii o' !Oˆ r1ݐ!it pcproc= nparams= koolbit=TRUEEFALSE GLOBREFF PUBLREFF PRIVREFF CONSTREF format==WORDDBYTEEBIG gt ptpoo'0igt ptp'. ! '0i!Ork#]rmm% frj 3tp2t pnrefs= nwords== 0****S:no linker information to list There are procedures in segment 7Procedure Guide: A( d} 0OPERAND2, 0OPERAND3 :INTEGER; .END;  (SEG_REF_REC=RECORD 0SEG_NAME:NAMETYPE; 0SEG_NUM:INTEGER; .END; . (LITYPES=(EOFMARK,GLOBREF,PUBLREF,PRIVREF,CONSTREF,GLOBDEF,PUBLDEF, 0CONSTDEF,EXTPROC,EXTFUNC,SEPPROC,SEPFUNC); 0 (LIENTRY=RECORD CASE BOOLEAN OF 0TRUE:(WRDS:ARRAY[0..7] OF INTEGER); 0FALSE:(NAME:PACKED ARRAY[0..7] OF CHAR; 7CASE LITYPE:LITYPES OF 9GLOBREF>HI_SEG_NUM, {number of segments in file} >SEG_REFS, {segment reference list size} >DATA_SIZE:INTEGER); {data size} (PROG_NAME:NAME_TYPE); {parent segment's name} :END; .NEXT_PAGE:INTEGER; {next page of dictionary} .FILLER: SRCPROC:INTEGER; (TEXT_SIZE, {size in blocks of interface text}  (PROCRANGE=0..255; {range of valid procedure numbers} (DCT_PAGE_RANGE=0..15; {range of possible segment dictionary en>HI_SEG_NUM, {number of segments in file} >SEG_REFS, {segment reference list size} >DATA_SIZE:INTEGER); {data size} (PROG_NAME:NAME_TYPE); {parent segment's name} :END; .NEXT_PAGE:INTEGER; {next page of dictionary} .FILLER: } ( ({pcode types - describing operand format} ,PCODETYPE=(INVALID,NO_OPERANDS,ONE_OPERAND,TWO_OPERANDS, 8THREE_OPERANDS);  ARRAY[0..6] OF INTEGER; {reserved for future use} .COPY_NOTE:STRING[77]; {copyright notice} .SEX: INTEGER; {file sex} ,( ({pmachine versions} ,VERSION_TYPE=(UNKNOWN,II_0,II_1,III_0,IV_0,V,VI,VII); , ({machine types} ,M_TYPES=(M_PSUEDO,M_6809,END; ( ({procedure descriptor record} ,PROCREC=RECORD 0BLOCK, {block number and} 0BLK_OFFSET, {byte offset oM_PDP_11,M_8080,M_Z80,M_GA_440, 6M_6502,M_6800,M_9900); 6 ({segment types} f first pcode in procedure} 0SEG_OFFSET, {word offset in segment of first pcode} 0DATA_SEG_SIZE, {data segment size} 0,SEG_TYPES=(NO_SEG,PROG_SEG,UNIT_SEG,PROC_SEG,SEPRT_SEG); , ({block zero of file - the segment dictionary} ,DCT_REC=RECORD EXIT_IC:INTEGER; {byte offset in segment of exit pcode(s)} .END; . ({pcode descriptor record} ,PCODEREC=PACKED RECORD 0NAME.DISK_INFO:ARRAY[DCT_PAGE_RANGE] OF RECORD :CODE_LENG, {number of words in segment} :CODE_ADDR:INTEGER; {segment starting bloc :NAMETYPE; {pcode name} 0PCODE :BYTERANGE; {byte value of pcode} 0OPTYPE :PCODETYPE; {describes # of operak} 8END; , SEG_NAME: ARRAY[DCT_PAGE_RANGE] OF NAME_TYPE; {segment names} , SEG_MISC: ARRAY[DCT_PAGE_RANGE] OF PACKED RECORDnds, if valid} 0END_OF_PROC :BOOLEAN; {does this pcode end procedure?} 0BYTE_ARRY {the literal pcode sequence}  }  { }  { copyright (c) 1980 SofTech Microsystem 8 SEG_TYPE:SEG_TYPES; {segment type} :FILLER:0..31; {reserved for future use} :HAS_LINK_INFO:BOOLEAN; {need to be linked?}  OC(PROCNUM:PROCRANGE; VAR PROC:PROCREC):INTEGER;  PROCEDURE GETPCODE(VAR OP:PCODEREC);  FUNCTION GETWORD(SEG_WORD_OFFSET:INTEx-/-,.%/%,%"%"d%x""%""%"d8/rp 1     GER; 2VAR VALID:BOOLEAN; SEX_SENSITIVE:BOOLEAN):INTEGER;  FUNCTION GETBYTE(SEG_BYTE_OFFSET:INTEGER;  Ċ*!! ! jh " !  hւ! !ɀ! 1Q#ą+z8`+f8+i!y$$BցF lptx|P!x$h$l# )8 rp )#"28$xm 8$xm$ą+Յ8`+q8+wlaVK@5*k#y%%Y%i#x%h%m$ )8 rp )$Ć8%xj! b˧n b˧nEj+O8`+ ;8+i!yh ,1!x /8/rpj1" p"ą1x8," p, ,,?//"  XJP IXA IXP STE INN UNI INT DIF SIGNAL WAIT ABI NGI DUP1 ABR NGR LNOT zć{!i~k"h3 xJ3 x)83 xrp3 x)8!p!"k IND INC EQSTR LESTR GESTR ASTR CSTR INCI DECI SCIP1 SCIP2 TJP LDCRL LDRL STRL CNTRL j+10!!Oˆ8+!++)0+j`2jV.WPs.spjb.PtbUtbs3 EXPRL &1 Ċ*!! ! jh " !  hւ! !ɀ! 1Q#ą+z8`+f8+i!y$$BցF lptx|P!x$h$l# )8 rp )#"28$xm 8$xm$ą+Յ8`+q8+wlaVK@5*k#y%%Y%i#x%h%m$ )8 rp )$Ć8%xj! b˧n b˧nEj+O8`+ ;8+i!yh ,1!x /8/rpj1" p"ą1x8," p, ,,?//{qg]S I?5+!8/rp1 p,,,8" ,,p,"i!|h!`˧"1?j+[8`+J8+h $ (ւ, ! !Ʋ 6h,0//8/rp   1p,8,8瀐+i x y!y/,18/rpj1* #p1ն,"//8/rp1 p,8˧i  ˆ8,˧  ą,,.. ch a a!j j ``,#p,,#i2!jh "! ! x h*)jh "! ! x h**!!|!|!~*!~* i #p13#i! .! -.!!ɀ !!!ɀ⼀ۀۃ^!!d!!|1*-s0+1)us.CODELDCB LDCI LCO LDC LLA LDO LAO LDL LDA ⼀ۀۀۀۀۀۀۀۀļۀۀȀϼۀۀڀۀۀۃh!ɀ!!ɀ  LOD UJP UJPL MPI DVI STM MODI CPL CPG CPI CXL CXG CXI RPU CPF LDCN159=AEIMQUY]!p! !ċ!ɀ/!t! !ċ!ɀ?!x! !ɀ/ċ!ɀg!|! !ɀ_Ċd!ɀo{aqegi]mSqIu?y5}+! ր!! !ɀgĊC!ɀw$!!! !ɀo! Ċ!! !ɀxĊ!ʋF!ɋ:!! !$ IVDCODE  ?BU P s t ptpptpt p`t p tp$h#ji!"`r %"Ċ%Ċ%Ė)`*P`t p+tptpzxi!jՆtpT  LSL LDE LAE NOP LPR BPT BNOT LOR LAND ADI  #.9DOZ݆U`!˧up!iޖke pj"/ձ"`ri#:݀ upet ptpke p"tp݂,ep{SBI STL SRO STR LDB NATIVE NAT-INFOINVALID CAP CSP SLOD1 SLOD2 INt p!݀ up!lddɀ~ e#dȊe#ˀ-ddɀ~ e#dȊ e#ˀ-#k"jI#j݀ "upVALID EQUI NEQI LEQI GEQI LEUSW GEUSW EQPWR LEPWR GEPWR EQBYTE LEBYTE GEBYTE SRS SWAP TRUNC ROet ptptperier]˧j xhtp݂.t p݆*t ptp݂<t pUND ADR SBR MPR DVR STO MOV DUP2 ~ #.9DOZep{ tp݂@t ptp tp݂St p !tp݂Wt p!tp݂_t p!!tptp!"ADJ STB LDP STP CHK FLT EQREAL LEREAL GEREAL LDM SPR EFJ NFJ FJP FJPL tpb݂ft ptpO݂vt ptp9ݭtp݂t ptp݂t ptpր݂t XJP IXA IXP STE INN UNI INT DIF SIGNAL WAIT ABI NGI DUP1 ABR NGR LNOT  p݆*t p݂t pݭtp݂t ptp1Kt p*t pt ptp IND INC EQSTR LESTR GESTR ASTR CSTR INCI DECI SCIP1 SCIP2 TJP LDCRL LDRL STRL CNTRL t ptpadrh ո1Kt p*t pt ptpt ptptp݂ EXPRL &1 number of procs in segmentIO error on fileesegment procedure0 not available in P-Code form݆*t ptp{h!! i!9b!upbt pbt ptp!itpoփ#!tpji!Ɋ-' փ݂! ! t ptp tptpr gtp| ݆*t ptpm`r `)$tp݂t p`t pt!-j#"xtp#"ytp#"ztp#"{tp!#'up#t p#'up# .up#pm%Ŋt ptp f tptpr tp ݆*t ptp`r `t p$ t p#tp#t p#t p#tp  p Oˆ rjg*t p%tp݂t p%tp݂t p&tp~݂t p%tp݂t p&tpO$$ gi!Oˆ rՒ h +Հ g! * * g9r br &b   ց݂t p%tp݂t p&tp݂ t p'   $$  b冃 g hz!i^!Oˆ r 1 tpt pgt p'1O i!(J! # ւ(. %3 6 9 ւ;@ &tp$݂Dt p'tp& `xtp&Or9]r0frj]˧ l$)$` ]$˧ $l!ii o' !Oˆ r1ݐ!it p ) *+.(tp `r ( `*xtp* ͊ւItp$Wt ptp tptpfgt ptpoo'0igt ptp'. ! '0i!Ork#]rmm% frj 3tp2t pt ptpkt p*t ptpwt ptpt p`t p ]˧kj"#" ]"!tp;t ptpoք@'wա u݆ vt p"[upt pt p˧"j  0i`t p $! 0i`t p  ! 0ihtp!!&j"],Pt pt p,,P,r,ԑ,P,Ռt p,Pt pt p,,Pv݆& nrefs= nwords== 0****S:no linker information to list There are procedures in segment 7Procedure Guide: A(ll), #(of procedure), L(inker info),@ C(onstant pool), S(egment references), I(nterface text), Q(uit))0s{{{{{{{{{{9lgvq9lgvqSEX: LEASTMOSTT$ significant byte first NEXT PAGE:: ? @ A B C D E F G H I J K L