`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^ơCODE  $CAT.INTRO.TEXT DISKDUMP.TEXT  DISKDUMP.CODE  DOSCAT.TEXT â DOSCAT.CODE â COPYONE.TEXT DISASM.DOC.TEXTAASM.SAMPLE.TEXT! DISASM.TEXT !"DISASM.pz READER.TEXT עz DISKDISP.TEXT  DISKDISP.CODE YFILEDEMO7.TEXT FILEBURP.TEXT LDOSPASCAL.TEXTA CLEAN.TEXT  CLEAN2.TEXT FILEMAKER.TEXT HOWTO.TEXTSYDRIVEMINIFILER.TEXT$ MENU.TEXT ۠$. MENUDOC.TEXT ˡ.>DIR.TEXT >F DIRDOC.TEXT ˡFX MASTERCA.TEXT aXb NEWDIR.TEXT qbh DISKDATE.TEXT hpFILEPATCH.TEXT&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&PROGRAM filer;  CONST maxentries=78;  fourblocks=2048; &startcatalog=2;   TYPE bytesize=0..255; %filetype=(volid,bad,code,text,info,data,graf,foto); % %volheader=RECORD 0volname:STRING[7]; 0blocks_per_vol:INTEGER; 0stats:PACKED ARRAY[0..6ex-gap,0); # index:=index+1; %END; $IF bytecount>0 %THEN BEGIN +unitread(unitnumber,buffer,bytecount, 4startblock+blocksinbuffer*index,0); # unitwrite(unitnumber,buffer,bytecount, 5startblock+blocksinbuffer*index-gap); # END; $starinbuffer; $bytecount:=(nextstart-startblock) MOD buffsize; # index:=0; $WHILE index'); $read(key); $writ END;  PROCEDURE zero;  CONST onerecord=26;  VAR name:STRING;  BEGIN !REPEAT "page(output); "gotoxy(0,3);  writeln('Zero the directory of'); "write('which unit, 4 or 5?'); "readln(unitnumber); !UNTIL unitnumber IN [4,5];  !unitread(unitnuwrite('data'); %graf:write('graf'); %foto:write('foto'); %END; $writeln(nextstart-startblock:3); # oldstart:=nextstart; $blocksleft:=blocksleft-(nextstart-startblock); # linecount:=linecount+1; #END;  writeln('',blocksleft:10,' left'); . ',name,' ':16-length(name), *date[0] MOD 16:2,'-', *(date[0] DIV 16)+16*(date[1] MOD 2):2,'-', *date[1] DIV 2:2,' '); $CASE kind OF %volid:write('volid'); %bad:write('bad '); %code:write('code'); %text:write('text'); %info:write('info'); %data:atalog[entrynumber],entry DO #BEGIN $IF (linecount MOD 21)=0 THEN readln; $IF startblock<>oldstart %THEN BEGIN +writeln('',startblock-oldstart:10,' blocks'); $ blocksleft:=blocksleft-(startblock-oldstart); *END; $write(entrynumber:2,'!WITH catalog[0],master DO #BEGIN $numoffiles:=stats[0]; $writeln(volname,' contains ',numoffiles,' files.'); ! END; ! !linecount:=1; !oldstart:=startuserfiles; !blocksleft:=maxblocks-startuserfiles; !FOR entrynumber:=1 TO numoffiles DO "WITH cldstart,blocksleft:INTEGER;  BEGIN !REPEAT "page(output); "gotoxy(0,3); "writeln('List contents of'); "write('which unit, 4 or 5?'); "readln(unitnumber); !UNTIL unitnumber IN [4,5]; !unitread(unitnumber,catalog[0],fourblocks,startcatalog,0); ! er:volheader); 4FALSE:(entry:fileheader); 4END; 2  VAR catalog:PACKED ARRAY[0..maxentries] OF catalogentry; $entrynumber,numoffiles,unitnumber:INTEGER; $key:CHAR; $  PROCEDURE list;  CONST startuserfiles=6;  maxblocks=280;  VAR linecount,o] OF bytesize; /END; % %fileheader=RECORD 1name:STRING[15]; 1notyetknown:INTEGER; 1date:PACKED ARRAY[0..1] OF bytesize; 1END; % %catalogentry=RECORD 3nextstart,startblock:INTEGER;  kind:filetype; 3CASE BOOLEAN OF 4TRUE:(masttblock:=startblock-gap; $nextstart:=nextstart-gap; #END; !END; !  BEGIN !REPEAT "page(output); "gotoxy(0,3); "writeln('Krunch contents of'); "write('which unit, 4 or 5?'); "readln(unitnumber); !UNTIL unitnumber IN [4,5];  !unitread(unitnumber,catalog[0],fourblocks,startcatalog,0); !numoffiles:=catalog[0].master.stats[0]; !entrynumber:=0; !WHILE entrynumber0 THEN unitwrite(unitnumber,catalog[0],fourblocks,startcatalog,0); !writeln; !writeln(catalog[0].master.volname,' crunched.');  END;   BEGIN !page(output); !REPEAT "gotoxy(0,0); "write('L)ist,Z)eID; (* NAME OF DISK VOLUME *) 2DEOVBLK: INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); 0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNE;  S := 0;  (* CHECK FOR A SPECIAL 'SYSTEM.' NAME *)  REPEAT "S := S + 1; "IF FILES[INDEX].NAME = SYSTEMS[S].NAME $THEN &SYSNAME := TRUE;  UNTIL SYSNAME OR (S = MAXSYSTEM);  IF SYSNAME "THEN $(* SYSTEM NAMES HAVE THEIR OWN SPECIAL SELECTION INDEX);  BEGIN  WITH FILES[INDEX].DATE DO "DISPLAYDATE(DAY,MONTH,YEAR);  END;   PROCEDURE FILELINE(INDEX:FILEINDEX); FORWARD;   PROCEDURE FILECTD(INDEX:FILEINDEX);  VAR (S:INTEGER;  SL:CHAR; (SYSNAME:BOOLEAN;  BEGIN  SYSNAME := FALS"4: WRITE('Apr'); "5: WRITE('May'); "6: WRITE('Jun'); "7: WRITE('Jul'); "8: WRITE('Aug'); "9: WRITE('Sep'); !10: WRITE('Oct'); !11: WRITE('Nov'); !12: WRITE('Dec');  END; (* OF CASE *)  WRITE('-',YEAR);  END;   PROCEDURE FILEDATE(INDEX:FILEEX].NAME) < TIDLENG "THEN $WRITE(' ':(TIDLENG-LENGTH(FILES[INDEX].NAME)));  END;   PROCEDURE DISPLAYDATE(DAY,MONTH,YEAR:INTEGER);  BEGIN  WRITE(DAY:3,'-');  CASE MONTH OF "1: WRITE('Jan'); "2: WRITE('Feb'); "3: WRITE('Mar'); [CURDIR] DO .BEGIN 0VOLUME := UNITNUM; . NAME := DTID; 0DATE := DACCESS; .END; *END; "END;  END;   PROCEDURE FILENAME(INDEX:FILEINDEX);  BEGIN  WRITE(FILES[INDEX].NAME);  (* ADD SPACES AFTER NAME TO LINE UP LISTING *)  IF LENGTH(FILES[INDD DIRECTORY OF DISKETTE *) $UNITREAD(UNITNUM,DIR,SIZEOF(DIR),DIRBLK); $FOR CURDIR:=1 TO DIR[0].DNUMFILES DO &(* LOOKING FOR ONLY CODE FILES *) &IF DIR[CURDIR].DFKIND = CODEFILE (THEN *BEGIN ,NAMECOUNT := NAMECOUNT + 1; ,WITH FILES[NAMECOUNT],DIR SELECT := SELECT - ['C','A','L','E','F','R','D','U','H','I'];  END;   SEGMENT PROCEDURE GETFILES;  VAR (DIR:DIRECTORY;  CURDIR,UNITNUM:INTEGER;  BEGIN  NAMECOUNT := 0;  FOR UNITNUM:=4 TO 5 DO (* ASSUMES TWO DRIVES *) "BEGIN $(* REAECT := 'R';  (* REMOVE SPECIAL SELECTION CHARACTERS FROM AVAILABLE SET *)  (* SOME SPECIAL CHARACTERS REMOVED ARE FOR PROGRAMS *)  (* NOT DISPLAYED SUCH AS DEBUGGER, USER RESTART, *)  (* HALT AND INITIALIZE *) CT := 'A';  SYSTEMS[3].NAME := 'SYSTEM.LINKER'; SYSTEMS[3].SELECT := 'L';  SYSTEMS[4].NAME := 'SYSTEM.EDITOR'; SYSTEMS[4].SELECT := 'E';  SYSTEMS[5].NAME := 'SYSTEM.FILER'; SYSTEMS[5].SELECT := 'F';  SYSTEMS[6].NAME := 'SYSTEM.WRK.CODE'; SYSTEMS[6].SEL['A'..'Z','1'..'9']; (* INITIAL SET OF SELECTION CHARACTERS *)  (* SET UP STANDARD NAMES AND THEIR SPECIAL SELECTION CHARACTERS *)  SYSTEMS[1].NAME := 'SYSTEM.COMPILER';  SYSTEMS[1].SELECT := 'C';  SYSTEMS[2].NAME := 'SYSTEM.ASSMBLER'; SYSTEMS[2].SELE FILES: PACKED ARRAY[1..MAXNAMES] OF NAMETYPE; (SYSTEMS: PACKED ARRAY[1..MAXSYSTEM] OF SYSTEMTYPE; (SELECT:SET OF CHAR; (NAMECOUNT:0..MAXNAMES;  ANS:CHAR;  FOUND:BOOLEAN;   SEGMENT PROCEDURE INITIALIZE;  BEGIN  SELECT := 5VOLUME: INTEGER; 5NAME: TID; 5DATE: DATEREC; 3 SELECT: CHAR; 3 SYSFILE: BOOLEAN; 3END; (SYSTEMTYPE = PACKED RECORD 7NAME: TID; 7SELECT: CHAR; 5END;   VAR (CURNAME:INTEGER;  I:INTEGER; (DAY,MONTH,YEAR:INTEGER; ODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); , *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; (  (*------------------------------------*) (  FILEINDEX = 1..MAXDIR; (NAMETYPE = PACKED RECORD WARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CCHARACTER *) $SL := SYSTEMS[S].SELECT "ELSE $BEGIN &(* NOT SPECIAL SO FIND NEXT AVAILABLE SELECTION CHARACTER *) &SL := 'A'; &WHILE NOT(SL IN SELECT) DO (IF SL = 'Z' *THEN ,SL := '1' *ELSE ,SL := SUCC(SL); &SELECT := SELECT - [SL]; $END;  FILES[INDEX].SELECT := SL;  FILES[INDEX].SYSFILE := SYSNAME;  WRITE(' [',SL,'] ');  END;   PROCEDURE FILELINE;  BEGIN  FILECTD(INDEX);  FILENAME(INDEX);  FILEDATE(INDEX);  WRITELN;  END;   (* TWO EXTERNAL PROCEDURES IN FILE 'BIOSSTUFF' *OPRIATE PROGRAM AND THE PROGRAM  INSERTS THE CHARACTERS INTO THE TYPE-AHEAD BUFFER THAT WILL CAUSE THE  PROGRAM TO BE EXECUTED AFTER MENU EXITS. THIS ESSENTIALLY CHAINS THE PROGRAM  FROM THE MENU PROGRAM.  %THE SELECTION LETTERS PRESENTED ARE THE STAPT TO RECOMPILE MENU WITHOUT HAVING THESE PROCEDURES  AVAILABLE. %THE MENU PROGRAM READS THE DIRECTORIES ON UNITS 4 AND 5 (IT ASSUMES  THESE TWO DRIVES) AND PRESENTS A MENU OF THE CODE FILES AVAILABLE. THE USE  SELECTS THE LETTER REPRESENTING THE APPR9PROGRAM AUTHOR: DAVID NEUMANN 8  8********** WARNING ***********  THE MENU PROGRAM REQUIRES TWO EXTERNAL PROCEDURES NAMED STUFF AND STUFFS THAT  INSERT CHARACTERS INTO THE TYPE-AHEAD BUFFER. THEY ARE AVAILABLE IN THE FILE  BIOSSTUFF. DO NOT ATTEMN^ˡˡION *) .(* EXECUTE DOESN'T WANT '.CODE' AS PART OF NAME *) .DELETE(NAME,POS('.CODE',NAME),LENGTH('.CODE')); .STUFFS(NAME); (* STORE FILE NAME *) .STUFF(CHR(RETURN)); (* END WITH CARRIAGE RETURN *) ,END;  UNTIL FOUND;  END. *THEN ,(* ONLY NEED ONE CHARACTER TO EXECUTE SYSTEM FILES *) ,STUFF(SELECT) *ELSE ,BEGIN .STUFFS('X#'); (* X = EXECUTE, # FOR VOLUME NUMBER *) .(* ADD VOLUME NUMBER *) .STUFF(CHR( ORD('0') + VOLUME)); .STUFF(':'); (* END OF VOLUME SPECIFICATIF EOLN THEN EXIT(NEWMENU); "CURNAME := 0; "FOUND := FALSE; "REPEAT $CURNAME := CURNAME + 1; $IF (ANS = FILES[CURNAME].SELECT) &THEN FOUND := TRUE; "UNTIL (CURNAME = NAMECOUNT) OR FOUND; "IF FOUND  THEN &WITH FILES[CURNAME] DO (IF SYSFILE FF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;   BEGIN (* NEWMENU *)  INITIALIZE;  GETFILES;  FOR CURNAME:=1 TO NAMECOUNT DO "FILELINE(CURNAME);  REPEAT "GOTOXY(0,0); "WRITE('HIT RETURN TO EXIT. EXECUTE WHICH? '); "READ(ANS); ")  (* THEY STORE A CHARACTER OR STRING INTO THE TYPE AHEAD BUFFER. *)  (* STUFF STORES ONE CHARACTER *)  (* STUFFS STORES A STRING *)  (* BOTH ARE NEEDED BECAUSE STRINGS CAN'T CONTAIN $SPECIAL CHARACTERS LIKE CARRIAGE RETURN *)  PROCEDURE STUNDARD CHARACTERS FOR SYSTEM  FILES ( SUCH AS C FOR SYSTEM.COMPILER) AND THE NEXT AVAILABLE LETTER FOR NON-  SYSTEM PROGRAMS. THE DATE OF CREATION IS ALSO SUPPLIED WITH EACH CODE FILE.  %THE DISK DIRECTORY IS READ USING THE DIRECTORY DECLARATIONS SUPPLIED BY  APPLE. THE DIR PROGRAM ALSO USES THESE DECLARATIONS TO DUPLICATE THE EXTENDED  DIRECTORY OPTION OF THE FILER. ANY EXTRA CONST OR TYPE STATEMENTS THAT WERE  NEEDED BY THE PROGRAM FB B E PB PE   N^END (* CASE DFKIND; DIRENTRY *); , *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; ( 2DTID: TID; (* TITLE OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) , 0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) LK: INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *);K FOLLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVB(FILEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOC: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * ERS IN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS *)   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) ,DAYARE AFTER THE DASHED COMMENT LINE. %THE DECLARATIONS AND COMMENTS SUPPLIED BY APPLE ARE:  CONST (MAXDIR = 77; (* MAXIMUM NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACT(*************************************)  (* PROGRAM TO DUPLICATE THE *)  (* EXTENDED DIRECTORY LISTING *)  (* OF THE FILER. *)  (*************************************)  (* AUTHOR: DAVID NEUMANN *)  (***3,'-');  CASE MONTH OF "1: WRITE('Jan'); "2: WRITE('Feb'); "3: WRITE('Mar'); "4: WRITE('Apr'); "5: WRITE('May'); "6: WRITE('Jun'); "7: WRITE('Jul'); "8: WRITE('Aug'); "9: WRITE('Sep'); !10: WRITE('Oct'); !11: WRITE('Nov'); !12: WRITE('Dec');  PROCEDURE FILESIZE;  VAR SIZE:INTEGER;  BEGIN  IF FREESPACE "THEN $SIZE := FREEBLOCKS  ELSE  SIZE := BLOCKS(CURDIR,LAST) - BLOCKS(CURDIR,FIRST);  WRITE(SIZE:3);  END;   PROCEDURE DISPLAYDATE(DAY,MONTH,YEAR:INTEGER);  BEGIN  WRITE(DAY: WRITE(DIREC[VOLUMEENTRY].DVID);  WRITELN(':');  END;   PROCEDURE FILENAME;  BEGIN  IF FREESPACE "THEN $WRITE('< UNUSED > ') "ELSE  BEGIN &WRITE(DIREC[CURDIR].DTID); &WRITE(' ':(17-LENGTH(DIREC[CURDIR].DTID)));  END;  END;  FREEBLOCKS:INTEGER; (UNUSED,LARGEST:INTEGER;   FUNCTION BLOCKS(INDEX,OFFSET:INTEGER):INTEGER;  BEGIN  IF OFFSET = FIRST "THEN $BLOCKS := DIREC[INDEX].DFIRSTBLK "ELSE $BLOCKS := DIREC[INDEX].DLASTBLK;  END;   PROCEDURE VOLUME;  BEGIN *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; (  VAR  DIREC: DIRECTORY; (UNITNUM:INTEGER; (I,CURDIR:INTEGER;  ENDPREVIOUS,STARTCURRENT:INTEGER;  NUMOFILES:INTEGER;  STARTBLOCK:INTEGER; (FREESPACE:BOOLEAN;  OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); ,0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); LLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVBLK: LEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOCK FO,DAY: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * (FI*) (  (*------------------------------------*) ( (FIRST = 1; (LAST = 2; (LASTBLOCK = 280; (VOLUMEENTRY = 0;   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACTERS IN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS **********************************)  (* THIS IS THE NEW FORMAT, USING*)  (* THE DIRECTORY DECLARATIONS *)  (* SUPPLIED BY APPLE. *)  (*************************************)   PROGRAM DIR;  CONST (MAXDIR = 77; (* MAXIMUM END; (* OF CASE *)  WRITE('-',YEAR);  END;   PROCEDURE FILEDATE;  BEGIN  IF FREESPACE "THEN $WRITE(' ':10) "ELSE $BEGIN  WITH DIREC[CURDIR].DACCESS DO (DISPLAYDATE(DAY,MONTH,YEAR); $END;  END;   PROCEDURE DATEOFVOLUME;  BEGIN  WITH DIREC[VOLUMEENTRY].DLASTBOOT DO "DISPLAYDATE(DAY,MONTH,YEAR);  END;   PROCEDURE FILESTART;  BEGIN  WRITE(' ');  WRITE(STARTBLOCK:3);  END;   PROCEDURE FILECTD;  BEGIN  IF FREESPACE "THEN $WRITELN(' ':5) "ELSE $BEGIN &WRITE(' '); N^ˡ(END; $IF FREESPACE &THEN (ENDPREVIOUS := STARTCURRENT &ELSE (BEGIN *ENDPREVIOUS := BLOCKS(CURDIR,LAST); *CURDIR := CURDIR + 1; (END; "END;  SUMMARY;  END. := STARTCURRENT - ENDPREVIOUS; *UNUSED := UNUSED + FREEBLOCKS; *IF FREEBLOCKS > LARGEST THEN LARGEST := FREEBLOCKS; *STARTBLOCK := ENDPREVIOUS; *FILELINE (END &ELSE (BEGIN *FREESPACE := FALSE; *STARTBLOCK := BLOCKS(CURDIR,FIRST); *FILELINE; DATEOFVOLUME;  WRITELN;  FOR I:=1 TO 2000 DO;  PAGE(OUTPUT);  VOLUME;  CURDIR := 1;  WHILE CURDIR <= NUMOFILES DO "BEGIN $STARTCURRENT := BLOCKS(CURDIR,FIRST); $IF (STARTCURRENT - ENDPREVIOUS) <> 0 &THEN (BEGIN *FREESPACE := TRUE; *FREEBLOCKSREAD(UNITNUM,DIREC,SIZEOF(DIREC),DIRBLK);  ENDPREVIOUS := BLOCKS(VOLUMEENTRY,LAST);  NUMOFILES := DIREC[VOLUMEENTRY].DNUMFILES;  UNUSED := 0;  LARGEST := 0;  IF UNITNUM = 4 "THEN $WRITE('The current date = ')  ELSE $WRITE('Date on volume = ');  WRITE(NUMOFILES,'/',NUMOFILES,' files,');  WRITE(' ',UNUSED,' unused,');  WRITE(' ',LARGEST,' in largest');  WRITELN;  END;   BEGIN  WRITE('WHAT UNIT? 4 OR 5? ');  READLN(UNITNUM);  IF NOT ((UNITNUM = 4) OR (UNITNUM = 5)) THEN EXIT(DIR);  UNITNDPREVIOUS) <> 0 "THEN $BEGIN &FREESPACE := TRUE; &FREEBLOCKS := LASTBLOCK - ENDPREVIOUS; &UNUSED := UNUSED + FREEBLOCKS; &IF FREEBLOCKS > LARGEST THEN LARGEST := FREEBLOCKS; $ STARTBLOCK := ENDPREVIOUS; &FILELINE; $END; (FOTOFILE: WRITELN('Foto'); (SECUREDIR: WRITELN(' '); &END; (* OF CASE *)  END;  END;   PROCEDURE FILELINE;  BEGIN  FILENAME;  FILESIZE;  FILEDATE;  FILESTART;  FILECTD;  END;   PROCEDURE SUMMARY;  BEGIN  IF (LASTBLOCK - E&CASE DIREC[CURDIR].DFKIND OF (UNTYPEDFILE: WRITELN(' '); (XDSKFILE: WRITELN('Bad '); (CODEFILE: WRITELN('Code'); (TEXTFILE: WRITELN('Text'); (INFOFILE: WRITELN('Info'); (DATAFILE: WRITELN('Data'); & GRAFFILE: WRITELN('Graf');9PROGRAM AUTHOR: DAVID NEUMANN % %THIS PROGRAM ILLUSTRATES THE USE OF THE FOLLOWING DIRECTORY  DECLARATIONS. IT WILL DUPLICATE THE EXTENDED DIRECTORY OPTION OF THE FILER.  THE DECLARATIONS AND COMMENTS ON THEM ARE THOSE SUPPLIED BY APPLE. ANY EX/^)a *DIRECTORY = ,ARRAY[DIRRANGE] OF DIRENTRY; ( OF FILE *) 2DLASTBYTE: 1..FBLKSIZE; (* NUMBER OF BYTES IN LAST BLK *) 2DACCESS: DATEREC (* DATE OF LAST MODIFICATION *) 0) (* END CASE XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, >DATAFILE, GRAFFILE, FOTOFILE *) ,END (* CASE DFKIND; DIRENTRY *); ,0 .XDSKFILE, CODEFILE, TEXTFILE, INFOFILE, .DATAFILE, GRAFFILE, FOTOFILE: .(* REGULAR FILE INFO *) 0( FILLER2: 0..1024; (* WASTE 12 BITS FOR DOWNWARD COMP *) 2STATUS: BOOLEAN; (* FOR FILER WILDCARDS *) 2DTID: TID; (* TITLE INTEGER; (* LAST BLK OF VOLUME *) 2DNUMFILES: DIRRANGE; (* NUMBER OF FILES IN DIRECTORY *) 2DLOADTIME: INTEGER; (* TIME OF LAST ACCESS *) 2DLASTBOOT: DATEREC (* MOST RECENT DATE SETTING *) 0) (* END CASE SECUREDIR, UNTYPEDFILE *); LLOWING LAST USED BLOCK *) ,CASE DFKIND: FILEKIND OF .SECUREDIR, .UNTYPEDFILE: .(* ONLY IN DIR[0] - THIS IS VOLUME INFO *) 0( FILLER1: 0..2048; (* WASTE 13 BITS FOR DOWNWARD COMP *) 2DVID: VID; (* NAME OF DISK VOLUME *) 2DEOVBLK: LEKIND = *(UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,INFOFILE,DATAFILE, +GRAFFILE,FOTOFILE,SECUREDIR); + ((* DIRECTORY LAYOUT *) (DIRENTRY = *PACKED RECORD ,DFIRSTBLK: INTEGER; (* 1ST PHYSICAL DISK ADDRESS *) ,DLASTBLK: INTEGER; (* POINTS AT BLOCK FO,DAY: 0..31; (* DAY OF THE MONTH *) ,YEAR: 0..100; (* 100 IMPLIES THE DATED VOLUME IS TEMPORARY *) *END (* DATEREC *); * ((* VOLUME ID *) (VID = *STRING[VIDLENG]; * (DIRRANGE = *0..MAXDIR; * ((* TITLE ID *) (TID = *STRING[TIDLENG]; * (FIN TITLE ID *) (FBLKSIZE = 512; (* STANDARD DISK BLOCK LENGTH *) (DIRBLK = 2; (* DIRECTORY STARTS AT THIS DISK-BLOCK ADDRESS *)   TYPE ((* VOLUME/FILE DATE MARK *) (DATEREC = *PACKED RECORD ,MONTH: 0..12; (* 0 IMPLIES MEANINGLESS DATA *) IS THE CURRENT DATE AS SET IN THE FILER. %THE APPLE SUPPLIED DECLARATIONS ARE:   CONST (MAXDIR = 77; (* MAXIMUM NUMBER OF ENTRIES IN DIRECTORY *) (VIDLENG = 7; (* NUMBER OF CHARACTERS IN VOLUME ID *) (TIDLENG = 15; (* NUMBER OF CHARACTERS ITRA  CONST AND TYPE USED BY THE PROGRAM ARE BELOW THE DASHED COMMENT LINE. %THE PROGRAM ASSUMES TWO DISK DRIVES #4 AND #5. THE DATE ON THE NON-BOOT  VOLUME IS THE DATE SET BY THE FORMAT PROGRAM WHEN THE DISK WAS FORMATTED.  THE DATE ON THE BOOT VOLUME (* The comment block following this comment  block must be written into a file called  "CAT.INTRO.TEXT". The easiest way to do that  is with the editor. If you don't want to look  at that silly message every time the program  runs, then delete tDURE ListFile(TextFile : STRING);   VAR F : TEXT; $I : INTEGER; $Line : STRING[80]; $  BEGIN  RESET(F,CONCAT(TextFile,'.TEXT')); "REPEAT "PAGE(OUTPUT); "FOR I := 1 TO 20 $DO BEGIN $READLN(F,Line); $WRITELN(Line); $END; "WRITELN; "WRITE('pr the disk *) "END;    VAR (* VARIABLE DECLARATIONS *)   Directory : RECORD "Disk : DiskInfo; "Files : ARRAY[1..77] OF FileInfo; "END;   CH : CHAR;  FileName : STRING[15];  F : TEXT;  I,J,K,L : INTEGER;  Quit : BOOLEAN;    PROCE$(* name the next 15 bytes contain *) $(* the ascii REPRESENTATION OF *) " (* THE NAME *) "UNKNOWN : INTEGER; $(* your guess is as good as mine *) "FileDate : DATE; $(* this is the date the file was *) $(* last written to,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO *) "FileName : STRING[15]; $(* the file name pyhsicaly *) $(* occupies 16 bytes in the *) $(* directory. the first byte *) $(* indicates the length of the *) e : DATE; " (* date diskette was formatted *) "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; $(* the block the file starts in *) "Ending : INTEGER; $(* block after the end of the file *) "FileType : 0..7; $(* NILING[7]; " (* this field is 8 bytes long *) $(* the first byte contains the *) $(* length of the name, the next 7 *) $(* contain the name of the disk *) "B : INTEGER; "Files : INTEGER; " (* files on the diskette *) "C : INTEGER; "DiskDat"Year : 1..99; "END;   DiskInfo = RECORD "(* many of these fields have an *) "(* unknown function. the ones that *) "(* have a single letter for their *) "(* name are unknown *) "A : ARRAY[0..2] OF INTEGER; "DiskName : STR by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PACKED RECORD "Month : 1..12; "Day : 1..31; ****************************)   (**************************************)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *)  (* distribution to and non-commercial *)  (* usel Rights Reserved *)  (*$C No part of this program mat be *)  (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* *)  (********** THE DISK, AN OPTIONAL ALIAS NAME IS REQUESTED  FOR EACH DISKETTE.  *)   PROGRAM MasterCatalog;   (**************************************)  (* *)  (*$C Copyright (c) 1980 Stephen Lloyd *)  (*$C AlS ON THE DISKETTE  DIRECTORY ARE WRITTEN ONTO THE MASTER CATALOG  FILE FOLLOWING THE VOLUME NAME OF THE  DISKETTE.  %SINCE THE DISKETTES CAN BE PHYSICALLY  CALLED BY A NAME OTHER THAN THE NAME STORED ON LE IS WRITTEN ON THE DISKETTE IN DRIVE TWO  AND CAN BE GIVEN ANY FILE NAME. IF THAT FILE  EXISTS, THE THE MASTER CATALOG IS APPENDED TO  THE END. THE DISKETTES TO BE CATALOGED ARE  INSERTED INTO DRIVE ONE IN RESPONSE TO THE  PROMPTS. ALL ACTIVE FILEhe procedure called  "ListFile " in the main program. I've marked  it with a big sign to help you locate it. *)  %(* THIS PROGRAM CREATES A MASTER CATALOG  OF AS MANY DISKETTE DIRECTORIES AS CAN BE  WRITTEN INTO THE CATALOG FILE. THE CATALOG  FIess "RETURN" to continue : '); "READLN; "UNTIL EOF(F);  CLOSE(F);  END;    PROCEDURE OpenMaster;   VAR GoodFile : BOOLEAN;  Line : STRING[132];   (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  BEGIN  GoodFile := FALSE;  REPEAT  WRITE('master catalog file name : ');  READLN(FileName);  IF LENGTH(FileName)>0 "THEN BEGIN "IF (POS('.TEXT',FileName)=0) OR " (POS('.text',FileName)=0) $THEN FileName := CONCAT(FileName, $ '.TEXT'); "FileName := CONCAT('ND. (* MASTER CATALOG *)   FALSE;  OpenMaster;  (* OPEN MASTER CATALOG FILE ON DRIVE 2 *)  WHILE NOT Quit "DO BEGIN "Prompt; "WHILE (CH<>'Q') AND (CH<>'q') $DO BEGIN $Catalog; $Prompt; (* FOR NEXT DISKETTE *) $END; "PAGE(OUTPUT); "Reminder;  END;  CLOSE(F,LOCK);  E (* rid of if you don't *)  (* want to be introduced *)  (* to the program every *)  (* time it runs *) !(* *) #(*******************)  ListFile('#5:CAT.INTRO');  (*******************) #  PAGE(OUTPUT);  Quit := E THE FILER TO TRANSFER IT TO');  WRITELN  ('THE PRINTER.');  END; (* REMINDER *)    BEGIN (* MASTER CATALOG *)  #(*******************) !(* *)  (* This is it, this is *)  (* what you want to get *)   PROCEDURE Reminder;   BEGIN (* REMINDER *)  WRITELN;  WRITELN;  WRITELN;  WRITELN  ('THE MASTER CATALOG FILE HAS BEEN');  WRITELN  ('PLACED ON DRIVE 2.');  WRITELN;  WRITELN  ('USE THE EDITOR TO REVIEW ITS CONTENTS');  WRITELN  ('OR USETTE TO BE INCLUDED IN');  WRITELN  ('MASTER CATALOG IN DRIVE 1.');  WRITELN  ('PRESS "RETURN" TO CONTINUE,');  WRITE  ('"Q" TO TERMINATE : ');  READ(CH);  IF (CH='Q') OR (CH='q') "THEN Quit := TRUE  ELSE Quit := FALSE;  END; (* PROMPT *)  "END; (* FILES *)    BEGIN (* CATALOG *)   (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(4,Directory,2048,2);   Header;  Alias;  Files;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT *)  WRITELN;  WRITELN  ('INSERT DISK 2)=1 (THEN BEGIN (WRITE ((F,Directory.Files[I].FileName); (FOR J := 20 DOWNTO (LENGTH(Directory.Files[I].FileName) *DO WRITE(F,' '); (END *ELSE WRITELN *(F,Directory.Files[I].FileName); &WRITE('.'); &END; $END; "WRITELN(F);  WRITELN(F); F,'-'); $WRITELN(F); $END; "END; (* ALIAS *)    PROCEDURE Files;   BEGIN (* FILES *) "(* WRITE FILE NAMES ONTO %MASTER CATALOG FILE *) "IF Directory.Disk.Files>0 $THEN BEGIN $FOR I := 1 TO $Directory.Disk.Files &DO BEGIN &IF (I MODTTE NAME : '); "READLN(AliasName); "(* WRITE DISKETTE NAME %ONTO MASTER CATALOG FILE *) "IF LENGTH(AliasName)>0 $THEN BEGIN $WRITELN $(F,'DISKETTE NAME : ',AliasName); $WRITE $(F,'------------- '); $FOR I := 1 TO (LENGTH(AliasName) (DO WRITE("IF LENGTH(Directory.Disk.DiskName)>0 $THEN BEGIN $WRITELN(F,'DISK NAME : ', $ Directory.Disk.DiskName); $WRITELN(F); $END;  END; (* HEADER *) "   PROCEDURE Alias; " "VAR AliasName : STRING[32]; " "BEGIN (* ALIAS *) "WRITE('DISKEE(OUTPUT); "WRITELN('ERROR IN OPENING FILE'); "WRITELN('PROGRAM TERMINATED'); "END;  END;    PROCEDURE Catalog;   PROCEDURE Header; " "BEGIN (* HEADER *) "(* WRITE DISK HEADER ONTO " MASTER CATALOG FILE *) FileName);  IF IORESULT<>0 "THEN BEGIN "REWRITE(F,FileName); "END  ELSE BEGIN $WRITE('FILE EXISTS..APPENDING'); $REPEAT $READLN(F,Line); $WRITE('.'); $UNTIL EOF(F);  END;  (*$I+*)   IF IORESULT<>0 "THEN BEGIN "Quit := TRUE;  PAG#5:',FileName); "IF LENGTH(FileName)<19 $THEN GoodFile := TRUE &ELSE BEGIN &GoodFile := FALSE; &WRITE &('File name must be less than '); &WRITELN &('10 characters !'); &END; "END $ELSE GoodFile := FALSE;  UNTIL GoodFile;   (*$I-*)  RESET(F,/^)qate the file was *) $(* last written to the disk *) "END;    VAR (* VARIABLE DECLARATIONS *)   Directory : RECORD "Disk : DiskInfo; "Files : ARRAY[1..77] OF FileInfo; "END;   CH : CHAR;  I,J,K,  DRIVE : INTEGER;    PROCEDURE Ca $(* indicates the length of the *) $(* name the next 15 bytes contain *) $(* the ascii REPRESENTATION OF *) " (* THE NAME *) "UNKNOWN : INTEGER; $(* your guess is as good as mine *) "FileDate : DATE; $(* this is the d$(* block after the end of the file *) "FileType : 0..7; $(* NIL,BAD,CODE,TEXT,  INFO,DATA,GRAF,FOTO *) "FileName : STRING[15]; $(* the file name pyhsicaly *) $(* occupies 16 bytes in the *) $(* directory. the first byte *) on the diskette *) "C : INTEGER; "DiskDate : DATE; " (* date diskette was formatted *) "D : INTEGER; "E : INTEGER; "END;   FileInfo = RECORD "Starting : INTEGER; $(* the block the file starts in *) "Ending : INTEGER; A : ARRAY[0..2] OF INTEGER; "DiskName : STRING[7]; " (* this field is 8 bytes long *) $(* the first byte contains the *) $(* length of the name, the next 7 *) $(* contain the name of the disk *) "B : INTEGER; "Files : INTEGER; " (* filesCKED RECORD "Month : 1..12; "Day : 1..31; "Year : 1..99; "END;   DiskInfo = RECORD "(* many of these fields have an *) "(* unknown function. the ones that *) "(* have a single letter for their *) "(* name are unknown *) " (* distribution to and non-commercial *)  (* use by its members and affiliates *)  (* *)  (**************************************)   TYPE (* DECLARATIONS *)   Date = "(* MONTH, DAY AND YEAR IN 16 BITS *) "PA *)  (**************************************)   (**************************************)  (* *)  (* This program has been provided to *)  (* the San Francisco APPLE Core for *) t (c) 1980 Stephen Lloyd *)  (*$C All Rights Reserved *)  (*$C No part of this program mat be *)  (*$C translated, reproduced or stored *)  (*$C in any form without the prior *)  (*$C written consent of Stephen Lloyd *)  (* THE MASTER *)  (* CATALOG PROGRAM. *)  (* *)  (**************************************)    (**************************************)  (* *)  (*$C Copyrigh PROGRAM DIR;   (**************************************)  (* *)  (* THIS PROGRAM WAS WRITTEN BY STEVE *)  (* LLOYD. IT IS BASED ON A PROGRAM *)  (* DEMONSTRATED BY GEORGE GOLDEN AND *)  (* IS AN OFFSHOOT OF talog;   BEGIN (* CATALOG *)  (* READ DIRECTORY FROM DRIVE 1 *)  UNITREAD(DRIVE,Directory,2048,2);  WRITELN;  IF Directory.Disk.Files>0 "THEN BEGIN "FOR I := 1 TO "Directory.Disk.Files $DO BEGIN $IF (I MOD 2)=1 &THEN BEGIN &WRITE &(Directory.Files[I].FileName); &FOR J := 20 DOWNTO &LENGTH(Directory.Files[I].FileName) (DO WRITE(' '); &END (ELSE WRITELN ((Directory.Files[I].FileName); $END; "END;  WRITELN;  END; (* CATALOG *)    PROCEDURE Prompt;   BEGIN (* PROMPT T ONLINE') $END $ELSE WRITELN('UNIT NOT BLK-DEVICE');  END.  *WRITE('ENTER MONTH (1..12) --> '); *READLN(TEMP); *DATE.MONTH:=TEMP; *WRITE('ENTER YEAR (00..99) --> '); *READLN(TEMP); *DATE.YEAR:=TEMP; *FOR I:=1 TO 77 DO DIRX[I].DACCESS:=DATE; ( UNITWRITE(UNITNUM,DIRX[0],2048,2); (END (ELSE WRITELN('UNIT NO$PAGE(OUTPUT); $WRITE('ENTER UNIT --> '); $READLN(UNITNUM); $IF UNITNUM IN [4,5,9..12] $THEN BEGIN $ UNITREAD(UNITNUM,DIRX[0],2048,2); $ IF IORESULT=0 (THEN BEGIN $ WRITE('ENTER DAY (1..31) --> '); *READLN(TEMP); *DATE.DAY:=TEMP; RAF,FOTO: *(DTID:TID; *DLASTBYTE:1..512; *DACCESS:DATEREC) (END; (  DIRP=^DIRECTORY;  DIRECTORY=ARRAY[DIRRANGE] OF DIRENTRY;    VAR I,UNITNUM,TEMP:INTEGER; $BUFR:PACKED ARRAY[0..2048] OF CHAR; $DIRX:DIRECTORY;  DATE:DATEREC;   BEGIN TEXT, *INFO,DATA,GRAF,FOTO,SECUREDIR); *  DIRENTRY=RECORD (DFIRSTBLK:INTEGER; (DLASTBLK:INTEGER; (CASE DFKIND:FILEKIND OF )SECUREDIR,UNTYPED: )(DVID:VID; *DEOVBLK:INTEGER; *DLOADTIME:INTEGER; *DLASTBOOT:DATEREC); (XDISK,CODE,TEXT,INFO,DATA, (G PROGRAM DISKDATE;   (* DISK DIRECTORY ROUTINE *)  (* BY ROGER L. SOLES *)   TYPE   DATEREC=PACKED RECORD (MONTH:0..12; (DAY:0..31; (YEAR:0..100 &END; &  DIRRANGE=0..77;   VID=STRING[7];  TID=STRING[15];  FILEKIND=(UNTYPED,XDISK,CODE,N^" MASTER CATALOG *)   *)  WRITELN;  WRITE('DIRECTORY FOR WHICH UNIT ? ');  READ(CH); "CASE CH OF "'1' : DRIVE := 11; "'4' : DRIVE := 4; "'5' : DRIVE := 5; "END;  END; (* PROMPT *)    BEGIN (* DIR *)  "PAGE(OUTPUT); "PROMPT; "PAGE(OUTPUT); "Catalog;  END. (*N^CK'); # #CLOSE(FIL); "UNTIL NOT YORN('ANOTHER FILE?'); !END.  %UNTIL CH IN ['Y','N',' ']; % %IF CH IN ['Y',' '] &THEN BEGIN ,WRITE('CHANGE TO (HEX): '); ,READLN(STR); ,BUF[DISP]:=HEXV(STR); +END; % %WRITELN; $UNTIL NOT YORN('ANOTHER BYTE'); $ $I:=BLOCKWRITE(FIL,BUF,1,BLOCK); #UNTIL NOT YORN('ANOTHER BLOE('BYTE DISP (HEX): '); %READLN(STR); %IF LENGTH(STR)=0 &THEN DISP:=DISP+1 &ELSE DISP:=HEXV(STR); %WRITE('BYTE IS '); %PRX(BUF[DISP]); %WRITELN; % %REPEAT (* GET Y OR N *) &WRITE('O.K. TO CHANGE? (Y/N) '); &READ(CH); &WRITELN; &UNITCLEAR(1); N(CHR(7)); #WRITE('FILENAME: '); #READLN(FN); #RESET(FIL,FN); # #REPEAT (* MODIFYING A BLOCK *) $WRITELN(CHR(7)); $WRITE('BLOCK (DECIMAL): '); $READLN(BLOCK); $I:=BLOCKREAD(FIL,BUF,1,BLOCK); $ $REPEAT (* MODIFY BYTES *) %WRITELN(CHR(7)); %WRITS[I] THEN V:=16*V+J; "HEXV:=V; !END; ! !PROCEDURE PRX(I:INTEGER); !BEGIN "IF I<16 " THEN WRITE(HEXD[I]) #ELSE BEGIN )PRX(I DIV 16); )WRITE(HEXD[I MOD 16]); (END; !END;  !BEGIN "HEXD:='0123456789ABCDEF'; "REPEAT (* PER FILE NAME *) #WRITEL#WRITE(M,' (Y/N)? '); #READ(CH); #WRITELN; #UNITCLEAR(1); "UNTIL CH IN ['Y','N',' ']; "YORN:=CH IN ['Y',' ']; !END; ! !FUNCTION HEXV(S:STRING):INTEGER; !VAR V,I:INTEGER; !BEGIN "V:=0; "FOR I:=1 TO LENGTH(S) DO #FOR J:=0 TO 15 DO $IF HEXD[J]=********)   VAR BUF:PACKED ARRAY[0..511] OF 0..255; $FN,STR:STRING; $FIL:FILE; $BLOCK,DISP,VAL,I,J:INTEGER; $HEXD:PACKED ARRAY[0..15] OF CHAR; $CH:CHAR; $ !FUNCTION YORN(M:STRING):BOOLEAN; !VAR CH:CHAR; !BEGIN "REPEAT #WRITELN(CHR(7)); *)  (* 92670 *)  (* *)  (* TRANSCRIBED BY TOM WOTEKI,WASH- *)  (* INGTON APPLE-PI *)  (* *)  (*****************************NE AND PUB- *)  (* LISHED IN ISSUE #5, JAN 1980 OF: *)  (* *)  (* THE APPLE SHOPPE *)  (* *)  (* P.O. BOX 701 *)  (* PLACENTIA, CA. PROGRAM FILEPATCH;   (*************************************)  (* *)  (* A PROGRAM TO MODIFY ANY BYTE IN *)  (* ANY PASCAL FILE. *)  (* *)  (* WRITTEN BY PHIL WAYN^ע 1 (END #END; (*LINELIMIT*) #  BEGIN (*READFILE*) #LINECOUNTER := 1; (*INITIALIZE COUNTER*) #COPYCOUNTER := 0; # #RESET (INT,S); (*OPEN PRINTER OR SCREEN*) # #REPEAT '(*$I-*) (*AUTO IO CHECKING OFF*) &RESET (F, FILENAME); (*OPENS OLD TEXT BFGER); #BEGIN &LINECOUNTER := LINECOUNTER + 1; (*COUNTS LINES*) &IF (LINECOUNTER>X) THEN (BEGIN +BLANKLINES (BOTMARGIN); +ALARM; +WRITELN  ('PAUSE FOR SHEET CHANGE. FOR NEXT'); +READLN (CH); (*PAUSE*) +BLANKLINES (TOPMARGIN); +LINECOUNTER := PROCEDURE BLANKLINES (X:INTEGER);  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO X DO &BEGIN )WRITELN (INT); &END (*FOR I*)  END; (*BLANKLINES*)   PROCEDURE READFILE;  VAR #I, J : INTEGER; #STR, ERROR : STRING; # #PROCEDURE LINELIMIT (X:INTEMARGIN <0..10)?'); #NUMOFCOPIES := 'FORMATDATA('HOW MANY COPIES?')  END; (*SELECT*)   PROCEDURE ALARM;  VAR #I : INTEGER;  BEGIN #FOR I := 1 TO TOPMARGIN + 6 DO %WRITELN (CHR(7)) (*BELL ALERT*)  END; (*ALARM*)  &ELSE ,S := 'CONSOLE:' #UNTIL (CH IN ['P','S']); #WRITELN; #LINES := 'FORMATDATA('OUTPUT LINES PER PAGE?'); #TOPMARGIN := 'FORMATDATA('BLANK LINES TOP PAGE?'); #BOTMARGIN := 'FORMATDATA('BLANKS BOTTOM OF PAGE?'); #LEFTMARGIN:= 'FORMATDATA('LEFT N (FILENAME); #IF POS ('.TEXT',FILENAME) = 0 THEN $FILENAME := CONCAT (FILENAME,'.TEXT');  END; (*START*)   PROCEDURE SELECT;  BEGIN #WRITELN; #REPEAT &WRITELN ('OUTPUT TO P/S?':27); &READ (KEYBOARD, CH); &IF (CH = 'P') THEN ,S := 'PRINTER:'  (' TO ENABLE A CHANGE OF SHEET PAPER,'); #WRITELN  ('PROGRAM WILL PAUSE FOR AT END OF'); #WRITELN  ('EACH DESIGNATED PAGE LENGTH.'); #WRITELN;WRITELN  (' ENTER-VOL:FILENAME-OF THE FILE TO BE'); #WRITELN ('READ.'); #WRITE (' ':15); #READLITE (S:30,' >>> '); #READLN (I); #FORMATDATA := I  END; (*FORMATDATA*) % .(*HEADER*)  PROCEDURE START;  BEGIN #WRITELN;WRITELN  (' WRITES TEXT FILES TO EITHER SCREEN OR'); #WRITELN ('PRINTER.'); #WRITELN;WRITELN %INT : INTERACTIVE; %S : STRING[8]; %LINES, (*PER PAGE*) %TOPMARGIN, BOTMARGIN, LEFTMARGIN, %LINECOUNTER, NUMOFCOPIES, %FINISHPAGE, COPYCOUNTER : INTEGER; %  FUNCTION FORMATDATA(S:STRING):INTEGER;  VAR #I : INTEGER;  BEGIN #WRER PAGE,NUMBER OF COPIES,  LEFT MARGIN,AND A PAUSE AT PAGE BOTTOM  FOR CHANGE OF PAPER FOR SINGLE PAGE USERS.*) ((*BY MAX J.NAREFF,5/81*)   CONST %NORMPAGELEN = 66;   VAR F : TEXT; (*INT.FILE DESIGNATION*) %CH : CHAR; %FILENAME : STRING[30]; PROGRAM READER;   (*A DEMO OF DISK I/O OPERATIONS INVOLVING  LINES OF TEXT.WRITES TEXT FILES TO EITHER  SCREEN OR PRINTER.PREPARED AS ONE OF A  SERIES OF FILE DEMONSTRATIONS. *)   (*OPTIONS INCLUDE TOP AND BOTTOM MARGINS,  NUMBER OF LINES PILE*)  (*ERROR DISPLAY ADAPTED FROM "UNIT FORMATSTUFF"*)  (*BY RONALD KENNEDY OF "SUNCOAST TAMPA APPLE GROUPIES*) &I := IORESULT; &IF (I <> 0) THEN (BEGIN *ERROR := 'ERROR IN FILENAME OR DISK DRIVE'; *CASE I OF ,2,5,9 : ERROR := 'DISK DRIVE NOT ON LINE'; ,7 : ERROR := 'ILLEGAL FILE NAME'; ,10 : ERROR := 'FILE NOT ON DISK'; *END; (*CASE*) *WRITELN (CHR(7)); *WRITELN #('I/O ERROR CODE # ':20,I,' RESTART PROGRAM'); *WRITELN (ERROR:30); *EXIT (PROGRAM END; "DSKBLK := 8 * TRUNC(USRBLK/8); " "UNIT0 := 0; "WHILE (UNIT0<>4) AND (UNIT0<>5) DO $BEGIN $WRITE('WHICH DRIVE <1..2> '); $READLN(UNIT0); $IF UNIT0=1 THEN UNIT0 := 4; $IF UNIT0=2 THEN UNIT0 := 5; " END; " "UNITREAD(UNIT0,BUFFER,4096,DSKBH); $IF (INPCH='Y') OR (INPCH='y') THEN &FLAG := TRUE ELSE (FLAG := FALSE; $WRITELN; $END;  END;   IF FLAG THEN "BEGIN "USRBLK := -1; "WHILE (USRBLK<0) OR (USRBLK>279) DO $BEGIN $WRITE('ENTER BEGINING BLOCK <0..279> '); $READLN(USRBLK); " WRITELN;  END;    PROCEDURE GETBUF;   BEGIN   IF NOT(FIRST) THEN "BEGIN "INPCH := ' '; "WHILE (INPCH<>'Y') AND (INPCH<>'y') AND (INPCH<>'N') AND (INPCH<>'n') DO $BEGIN $WRITE('DO YOU WISH TO LOOK AT ANOTHER BLOCK ? '); $READ(INPCN('The output will begin with the specified block and continue');  WRITELN('to the end of the disk. You may terminate the listing at the ');  WRITELN('end of a screen simply by pressing ESC. To continue listing ');  WRITELN('press the SPACE BAR.'); both ASCII and HEX format.');  WRITELN('The ASCII format displays only the printable chaRacters, con-');  WRITELN('verting all others to a "!". The HEX format converts every ');  WRITELN('byte to its equivalent hexidecimal form.');  WRITELN;  WRITELOLEAN; $OFFSET,INDEX : INTEGER; $INPCH,CH : CHAR; $  PROCEDURE PROMPT;   VAR INPCH : CHAR;   BEGIN  PAGE(OUTPUT);  WRITELN('This program allows access to any block on either of the disks.');  WRITELN;  WRITELN('It displays the information in PROGRAM DISC;  "(* STEVE LLOYD *) "(* CONTRIBUTED TO THE S.F. APPLE CORE *) "   VAR BUFFER : PACKED ARRAY[0..4095] OF CHAR; $UNIT0,DRIVE,BLOCK0,BLOCK1 : INTEGER; $USRBLK,DSKBLK,BUFBLK : INTEGER; $I,J,K,L,M,N : INTEGER; $QUIT,FIRST,FLAG : BO1 &N^PAGE); 'LINECOUNTER := 1; 'COPYCOUNTER := COPYCOUNTER + 1 ' #UNTIL (COPYCOUNTER=NUMOFCOPIES); ' #CLOSE (INT); #CLOSE (F)  END; (*READFILE*) )  BEGIN (*MAIN*) #PAGE (OUTPUT); #START; #SELECT; #READFILE; #WRITELN ('THE END':23)  END.  ROM DISK*) 'REPEAT *FOR J := 1 TO LEFTMARGIN DO -WRITE (INT,' '); *READLN (F, STR); *WRITELN (INT, STR); *LINELIMIT (LINES) 'UNTIL EOF(F); ' 'CLOSE (F); ' )(*PREPARE FOR >1 COPY*) # FINISHPAGE := NORMPAGELEN-LINECOUNTER; 'BLANKLINES (FINISH) (END; (*IF*) '(*$I+*) (*IO ON*) % 'BLANKLINES (TOPMARGIN); 4(*NOTE-SOME PRINTERS*) #(*COUNT THE COMMAND LINE AS A LINE.IF TOP *) #(*MARGIN NOT SATISFACTORY,TRY *) #(*BLANKLINES(TOPMARGIN-1) *) # ((*READ TEXT FILE FLK); "IF IORESULT<>0 THEN QUIT := TRUE; "END;   END; (* GETBUF *)    PROCEDURE HEX(N : INTEGER);  (* DISPLAY N AS A HEX STRING *)   VAR A,B : INTEGER; $CHS : STRING[16]; $  BEGIN  CHS := '0123456789ABCDEF';  A := TRUNC(N/16);  B := N-A*16;  IF (A>=0) AND (A<=15) THEN "WRITE(CHS[A+1]) ELSE $WRITE('?');  IF (B>=0) AND (B<=15) THEN "WRITE(CHS[B+1]) ELSE $WRITE('?');  WRITE(' ');  END; (* HEX *)    PROCEDURE SHOWBUF;   BEGIN  PAGE(OUTPUT);   (* DISPLAY SCREEN  ?This program allows access to any block on either of the disks.צ9It displays the information in both ASCII and HEX format.=The ASCII format displays only the printable chatacters, con-" DISC "WRITELN('PLEASE CHECK DISK. ERROR IN READING DISK.'); "WRITELN; "WRITELN('Press RETURN to return to system.'); "READLN; "END;  END. (* DISC *)  " BEGIN  FIRST := TRUE;  FLAG := TRUE;  QUIT := FALSE;  PROMPT;  GETBUF;  FIRST := FALSE;  WHILE FLAG AND NOT(QUIT) DO "BEGIN "SHOW; "PROMPT; "GETBUF; "END;  IF QUIT THEN "BEGIN "PAGE(OUTPUT); 0; $ USRBLK := 0; &END; $UNITREAD(UNIT0,BUFFER,4096,DSKBLK); $WHILE IORESULT<>0 DO &BEGIN &PAGE(OUTPUT); &WRITELN('PLEASE CHECK DISK. ERROR IN READING DISK.'); &UNITREAD(UNIT0,BUFFER,4096,DSKBLK); " END; $END; "END;  END; (* SHOW *) "  ; &WRITELN('PRESS: SPACE BAR to continue ESC to terminate'); &READ(INPCH); &END; $END;  "USRBLK := USRBLK + 1; "BUFBLK := BUFBLK + 1; "IF BUFBLK=8 THEN $BEGIN $BUFBLK := 0; $DSKBLK := DSKBLK + 8; $IF DSKBLK=280 THEN &BEGIN $ DSKBLK := VAR ESCAPE : CHAR;   BEGIN  ESCAPE := CHR(27);  INPCH := ' ';  BUFBLK := (USRBLK - DSKBLK);  WHILE INPCH<>ESCAPE DO "BEGIN $(* 2 SCREENS 256 BYTES PER SCREEN *) $FOR K := 0 TO 1 DO $BEGIN $IF INPCH<>ESCAPE THEN &BEGIN &SHOWBUF; &WRITELN); " "(* ASCII DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $M := ORD(BUFFER[N]); $IF M>127 THEN M := M - 128; $IF (M>31) AND (M<127) THEN &WRITE(CHR(M)) ELSE (WRITE('!'); $END; "WRITELN; "END;  END;    PROCEDURE SHOW;  60,3); WRITELN('==========');   FOR I := 0 TO 15 DO "BEGIN "INDEX := K*256 + I*16; "WRITE(INDEX:4,' : '); "OFFSET := BUFBLK*512 + INDEX; " "(* HEX DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $HEX(ORD(BUFFER[N])); $END; "WRITE(' 'HEADER *)  WRITELN('UNIT = ',UNIT0,' BLOCK = ',USRBLK);  WRITELN;  GOTOXY(0,2); WRITE('INDEX');  GOTOXY(23,2); WRITE('HEX DUMP');  GOTOXY(60,2); WRITE('ASCII DUMP');  GOTOXY(0,3); WRITE('====');  GOTOXY(23,3); WRITE('========');  GOTOXY(צ=verting all others to a "!". The HEX format converts every (byte to its equivalent hexidecimal form.to the end of the disk. You may terminate the listing at the =end of a screen simply by pressing ESC. To continue listing צpress the SPACE BAR.E Y˩y˄N˄n˄fצ.DO YOU WISH TO IZE*)   TYPE ALFA = (PACKED ARRAY[1..X,1..X] OF CHAR;  TEXT = FILE OF CHAR;   VAR WORD, TEMP : ALFA;  CH : CHAR; &I, J : INTEGER; (*LOOP INDICES*) &F : TEXT; (*FILE DESIGNATOR*) &FILENAME : STRING[15]; &  PROCEDURE INTRODU'BEGINNER'S GUIDE...-1980-MCGRAW-HILL*)  (*CHIRILIAN,P-'PASCAL'-1980-MATRIX PUB.INC.*)  (*GROGONO,P-'PROGRAMMING IN PASCAL'-1980*)  (* ADDISON-WESLEY*)  (*ZAKS,R-'INTRO.TO PASCAL'-1981-SYBEX *)   CONST X = 5; (*LOOP AND ARRAY SPROGRAM FILEDEMO7;  (*A DEMO OF DISK I/O OPERATIONS INVOLVING  A PACKED TWO-DIMENSIONAL ARRAY OF CHAR  (STRING).PREPARED IN CONJUNCTION WITH  PRECEDING FILEDEMO PROGRAMS. 2BY MAX J.NAREFF,3/81*)  (*REFERENCES- *)  (*BOWLES,K-N^\צ3PRESS: SPACE BAR to continue ESC to terminate   áá "ˡY *PLEASE CHECK DISK. ERROR IN READING DISK.+ j#J צ*PLEASE CHECK DISK. ERROR IN READING DISK.צ!Press RETURN to return to system.( (. ˡ\צ3PRESS: SPACE BAR to continue ESC to terminate   áá "ˡY *PLEASE CHECK DISK. ERROR IN READING DISK.ȡ!  צ ȡX   š ǀ ũ Ʉ  ! x  ˡ  ȡmˡOCK =  צINDEXצHEX DUMP< ASCII DUMPצ============<צ ==========ȡ  צ : á"ˡeudvצ0123456789ABCDEFȄ ?Ȅ ?  UNIT =  צ BLLOOK AT ANOTHER BLOCK ? YéyÍ ɩ ō?ENTER BEGINING BLOCK <0..279>   ˩˄JWHICH DRIVE <1..2>  áCTION; #BEGIN &WRITELN  ('A DISK I/O DEMO INVOLVING STRINGS':37); &WRITELN;WRITELN  (' THIS PROGRAM SENDS STRINGS TO A DISK'); &WRITELN  ('FILE CREATED BY THE USER.IT THEN READS'); &WRITELN  ('THE FILE,FOLLOWED BY A SORT,REFILING OF'); &WRITELN  ('THE NEW LIST OF STRINGS AND THEN A FINAL'); &WRITELN  ('DEMONSTRATIVE READ.'); &WRITELN;WRITELN  (' ENTER-VOL:FILENAME-OF THE FILE TO BE'); &WRITELN ('CREATED.'); &READLN (FILENAME); &IF POS ('.TEXT',FILENAME) = 0 THEN (FILENAME := CN^LL; #SORTER ; #WRITEFILE; #WRITELN; #READFILE  END.  )FOR J := (I + 1) TO X DO ,IF (WORD[J] < WORD[L]) THEN /L := J; )TEMP[I] := WORD[I]; )WORD[I] := WORD[L]; )WORD[L] := TEMP[I]; &END (*FOR I*)  END; (*SORTER*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #INTRODUCTION; #MAKEARRAY; #WRITEFILE; #READFILEND; (*EOF*) #CLOSE (F)  END; (*READFILE*) #  PROCEDURE SORTER ;  VAR #L : INTEGER; (*SWAP VAR*)  BEGIN #WRITELN ('NOW SORTING STRINGS':30); #FOR I := 1 TO 250 DO BEGIN END;(*PAUSE*) # #FOR I := 1 TO (X - 1) DO &BEGIN )L := I; RAM); %END; % #WHILE NOT EOF (F) DO  (*COULD HAVE USED'FOR LOOP'HERE INSTEAD*) &BEGIN )WHILE NOT EOLN(F) DO  (*COULD HAVE USED'FOR LOOP'HERE ALSO*) ,BEGIN /READ (F, CH); /WRITE (CH); ,END; (*EOLN*) )READLN (F); (*ON TO NEXT LINE*) )WRITELN &EWRITEFILE*)   PROCEDURE READFILE;  BEGIN #WRITELN;WRITELN .('NOW READING FILE':28); '(*REOPEN FILE FOR READING*) '  (*$I-*) #RESET (F, FILENAME);  (*$I+*)  #IF (IORESULT<>0) THEN %BEGIN (WRITELN (('I/O ERROR-RESTART PROGRAM'); (EXIT (PROG AS INDIVIDUAL CHARS WHICH WOULD REQUIRE  ANOTHER LOOP.READING CHAR ARRAYS CAN  ONLY BE DONE ONE CHAR AT A TIME*) # #FOR I := 1 TO X DO &WRITELN (F,WORD[I]); & #CLOSE (F, LOCK); (*SAVES NEW FILE ON DISK*) #FOR I := 1 TO 250 DO (*DELAY*)  END; (*IO CHECKING ON*)  #IF (IORESULT<>0) THEN &BEGIN )WRITELN +('I/O ERROR-RESTART PROGRAM'); )EXIT (PROGRAM) &END; & #WRITELN ('WRITING TO FILE':27); #  (*NOTE-PACKED ARRAY OF CHAR CAN BE WRITEN  TO SCREEN AS SINGLE STRINGS RATHER THAN D[I,J] := CH; -END; (*J LOOP*) +READLN (END (*I LOOP*)  END; (*MAKEARRAY*)   PROCEDURE WRITEFILE;  BEGIN #(*OPENS NEW FILE.REMOVES 2OLD FILE,IF SAME NAME*) 2  (*$I-*) (*TURNS OFF IO CHECKING*) #REWRITE (F, FILENAME);  (*$I+*) (*ONCAT (FILENAME,'.TEXT'); #END; (*INTRO*) & &(*FILL ARRAY WITH NAMES*)  PROCEDURE MAKEARRAY ;  BEGIN #WRITELN )('ENTER FIVE 5-CHAR WORDS':32);  FOR I := 1 TO X DO (*FIVE WORDS*) (BEGIN +FOR J := 1 TO X DO (*5-CHARS*) -BEGIN 0READ (CH); 0WOR(*$L PRINTER: *)  PROGRAM FILEBURP; !(* BY ROGER CURTIS, MAY 18,1980 $CALL-APPLE, SEPTEMBER 1980 *) $  USES APPLESTUFF;   VAR ASCII:BOOLEAN; &BUF:PACKED ARRAY[0..511] OF 0..255; $FNAME:STRING; (F:FILE; # VLN:CHAR; (*VERTICLE LINE*) #BLOCK, N^AA(* LINE IS DONE *)  BEGIN .WRITELN(P); .J:=1; (*RESET*) ,END; (END; &WRITELN(P); $UNTIL NOT YES('ANOTHER BLOCK'); $CLOSE(F);CLOSE(P); "UNTIL NOT YES('ANOTHER FILE');  END.  *IF J<=16 THEN (* PRINT A BYTE*) ,BEGIN (*AS CHARACTER*) .IF (ASCII) AND (BUF[K] > 32) AND 0(BUF[K] < 127) THEN 0WRITE(P,' "',CHR(BUF[K]),'"') .ELSE 0BEGIN (* OR AS HEX*) 2DECTAHEX(BUF[K]); 2WRITE(P,HEXI:4); 0END; .J:=J+1 ,END; *IF J>16 THEN TO 511 DO (BEGIN *IF J=1 THEN (* DO Y- AXIS *) ,BEGIN .IF K MOD 64=0 THEN 0BEGIN (* SKIP 4TH LINE *) 2WRITELN(P,VERT[I],VLN:4); 2I:=I+1 0END; .DECTAHEX(K DIV 16); .WRITE(P,VERT[I],' ',HEXI,VLN); .I:=I+1; ,END; E WRITELN(P,'HEXADECIMAL INTERPRETED'); &WRITELN(P,'LO NIBBLE':40); &WRITE(P,' ':7); &FOR I:=0 TO 15 DO (* X-AXIS *) (WRITE(P,HEX[I],' ':3); &WRITELN(P); &FOR I:=1TO 70 DO WRITE(P,'-'); &WRITELN(P); &J:=1;I:=1;(* RESET COLUMN & LINE # *) &FOR K:=0HARACTERS '); &NOTE(50,10); &WRITE('BLOCK (DECIMAL: )'); &READLN(BLOCK); &I:=BLOCKREAD(F,BUF,1,BLOCK); &WRITELN(P,' ':32,'FILEBURP'); &WRITELN(P,'FILE - ',FNAME); &WRITELN(P,'BLOCK - ',BLOCK); &IF ASCII THEN WRITELN(P,'ASCII/HEX INTERPRETED') (ELS"' HI NIBBLE '; "VLN:=CHR(124); "REPEAT (*FOR EACH FILE*) $NOTE(50,10); $WRITE('FILE NAME: '); $READLN(FNAME); $RESET(F,FNAME); $REWRITE(P,'PRINTER:'); $REPEAT (* FOR EACH BLOCK PRINTED *) &ASCII:=YES('INTERPRET AS CE &BEGIN (DOIT(I MOD 16); (HEXI[L]:=HEX[I DIV 16]; &END; "END; (* DOIT *)  BEGIN "L:=1; "HEXI:='00'; "DOIT(I);  END; (* DECTAHEX *)   BEGIN (* MAIN PROGRAM *) "HEX:='0123456789ABCDEF'; "VERT:=(*NOTE THE SPACES*) ); $WRITELN; $UNITCLEAR(1); "UNTIL CH IN ['Y','N',' ']; "YES:=CH IN ['Y',' '];  END; (* YES *)   PROCEDURE DECTAHEX(I:INTEGER);  VAR L:INTEGER;  PROCEDURE DOIT(I:INTEGER); "BEGIN $IF I<16 THEN &BEGIN (HEXI[L]:=HEX[I]; (L:=L-1; &END $ELS$I,J,K:INTEGER; &HEX:PACKED ARRAY[0..15] OF CHAR; %HEXI:PACKED ARRAY[0..1] OF CHAR; %VERT:PACKED ARRAY[0..40] OF CHAR; (P:INTERACTIVE; (  FUNCTION YES(M:STRING):BOOLEAN;  VAR CH:CHAR;  BEGIN "REPEAT $NOTE(50,10); $WRITE (M,' (Y/N)? '); $READ(CH  (* DOS 3.3 --> PASCAL TRANSFER PROGRAM #ORIGINAL PROGRAM BY TOM COLE FOR %USE WITH CORVUS DRIVE DRIVE. #MODIFIED FOR DISK ][ DRIVES BY %GENE JACKSON.  *)   PROGRAM TRANSFER;   TYPE "SECTORBUFFER = PACKED ARRAY[0..255] OF CHAR; "BLOCKBU SECTOR: ',SNUM:3,' '); #READSECTOR (SECTOR,UNUMB,TNUM,SNUM); #IF (TSPTR DIV 2) MOD 2 = 0 $THEN J := 0 $ELSE J := 256; #TSPTR := TSPTR + 2; #FOR I := 0 TO 255 $DO BLOCK[I+J] := SECTOR[I]; #IF J = 256 $THEN BEGIN *K := BLOCKWRITE (DISK,BLOCK,N BEGIN *IF J=0 +THEN BEGIN 1FOR I := 256 TO 511 2DO BLOCK[I] := CHR(0); 1J := BLOCKWRITE(DISK,BLOCK,1,BNUM); 1GOTOXY (0,15); 1WRITE ('BLOCK: ',BNUM:3) 0END; *CLOSE (DISK,LOCK); *EXIT (TRANSFER) )END; #GOTOXY (0,13); #WRITE('TRACK: ',TNUM:3,' !SNUM := ORD(SECTOR[I*35 - 23]); !READSECTOR (TSLIST,UNUMB,TNUM,SNUM); !REPEAT "TLINK := ORD(TSLIST[1]); "SLINK := ORD(TSLIST[2]); "TSPTR := 12; "REPEAT #TNUM := ORD(TSLIST[TSPTR]); #SNUM := ORD(TSLIST[TSPTR + 1]); #IF (TNUM=0) AND (SNUM=0) $THE0,11); !IF CH = 'Y' "THEN WRITE('7 BIT DATA ') "ELSE WRITE('8 BIT DATA '); !CLOSE (TEMP,LOCK); !RESET (DISK,NAME); !IF POS('.TEXT',NAME) <> 0 ! THEN BNUM := 2 "ELSE BNUM := 0; !TNUM := ORD(SECTOR[I*35 - 24]); "IF LENGTH(NAME)=0 #THEN EXIT(TRANSFER); "(*$I-*) "RESET (TEMP,NAME); "IF IORESULT = 0 #THEN CLOSE (TEMP,PURGE); "REWRITE(TEMP,NAME); "(*$I+*) !UNTIL IORESULT = 0; !GOTOXY (0,11); !WRITE ('STRIP PARITY ? (Y/N) '); !READ (KEYBOARD,CH); !GOTOXY(M=0); #WRITELN; #WRITELN('FILE NOT FOUND.',CHR(7)) "UNTIL FALSE; !END;   BEGIN (*MAIN*) !INIT; !REPEAT "GOTOXY (0,9); "WRITE ('PASCAL FILE NAME ..................'); "GOTOXY (0,9); "WRITE ('PASCAL FILE NAME '); "READLN(NAME); #SNUM := 15; #GOTOXY (0,5); #WRITE ('FILE TO TRANSFER ? '); #READLN(NAME); #IF LENGTH(NAME) = 0 $THEN EXIT(TRANSFER); #REPEAT $READSECTOR(SECTOR,UNUMB,TNUM,SNUM); $FOR I := 1 TO 7 %DO IF MATCH(I) )THEN EXIT(INIT); $SNUM := SNUM - 1 #UNTIL (SNU "GOTOXY (0,20); "WRITELN(' '); "GOTOXY (0,20); "WRITELN(S); "IF S = NAME #THEN MATCH := TRUE #ELSE MATCH := FALSE; !END; !  PROCEDURE INIT;  !BEGIN "CH := ' '; "INITVOL; "REPEAT #TNUM := 17; 2) < 32 (THEN C2 := ' '; 'IF ORD(C2) > 127 (THEN C2 := CHR( ORD(C2) MOD 128); 'IF ORD(C2) > 95 (THEN C2 := CHR( ORD(C2) - 48); 'C:= ' '; 'C[1] := C2; 'S := CONCAT(S,C) &END; "REPEAT #DELETE (S,LENGTH(S),1) "UNTIL ( COPY(S,LENGTH(S),1) <> ' ' );O VOLUME #5'); "UNUMB := 5; !END; !  FUNCTION MATCH (ITEM:INTEGER):BOOLEAN;  !VAR #A,B :INTEGER; #C :STRING; #C1,C2:CHAR; #S :STRING; # !BEGIN "S := ''; "B := ITEM*35 - 22; "FOR A := 1 TO 28 #DO BEGIN 'C2 := SECTOR[B+A]; 'IF ORD(C'IF CH <> 'Y' (THEN SCTR[LOOP] := BUFF[LOOP+PTR] (ELSE SCTR[LOOP] := CHR( ORD( BUFF[LOOP+PTR]) MOD 128) &END !END; !  PROCEDURE INITVOL;  !BEGIN "WRITE(CHR(12),'DOS 3.3 --> PASCAL TEXTFILE TRANSFER'); "WRITELN; "WRITELN('PLACE DOS 3.3 DISK INT:INTEGER; # !BEGIN "IF SECTOR = 15 #THEN #ELSE IF SECTOR = 0 )THEN )ELSE SECTOR := 15 - SECTOR; "BLK := (TRACK*16 + SECTOR) DIV 2; "UNITREAD (UNUM,BUFF,512,BLK); "PTR := 256*((TRACK*16 + SECTOR) MOD 2); "FOR LOOP := 0 TO 255 #DO BEGIN GER; "SLINK :INTEGER; "I,J,K :INTEGER; "UNUMB :INTEGER; "NAME :STRING; "CH :CHAR; "  PROCEDURE READSECTOR (VAR SCTR:SECTORBUFFER; :UNUM,TRACK,SECTOR:INTEGER); !VAR #BLK :INTEGER; #BUFF :BLOCKBUFFER; #PTR :INTEGER; #LOOP :INTEGER; #REL FFER = PACKED ARRAY[0..511] OF CHAR; "  VAR "DISK :FILE; "TEMP :INTERACTIVE; "BLOCK :BLOCKBUFFER; "SECTOR:SECTORBUFFER; "TSLIST:SECTORBUFFER; "TSPTR :INTEGER; "DVOL :INTEGER; "BNUM :INTEGER; "TNUM :INTEGER; "SNUM :INTEGER; "TLINK :INTE1,BNUM); *GOTOXY (0,15); *WRITE('BLOCK: ',BNUM:3); *BNUM := BNUM + 1 )END "UNTIL TSPTR > 255; "READSECTOR (TSLIST,UNUMB,TLINK,SLINK) !UNTIL FALSE; !WRITELN  END. ! 1 2 N^1 2 ??N^DISK(11); "CLEANDISK(5); "CLEANDISK(4); "WRITEFILE  END. ND(* CLEANDISK *);   PROCEDURE WRITEFILE;  BEGIN "WRITELN('PUT ''APPLE1:'''); "WAIT; " "RESET(F,'APPLE1:CLEAN-BLOCK'); "SEEK(F,0); "F^:=BLOCKNUM; "PUT(F); "CLOSE(F,LOCK)  END(* WRITEFILE *);    BEGIN(* MAIN *) "READFILE; "CHECK; "CLEANIMES LIFE.'); =234 THEN IF BLOCKNUM>=276 THEN BEGIN PRESET(F,'APPLE1:CLEAN-BLOCK'); PSEEK(F,0); EGIN "WRITE(CHR(7))  END;   PROCEDURE ALARM;  BEGIN "WRITE(CHR(7)); "WRITE(CHR(7))  END;   PROCEDURE WAIT;  VAR CH:CHAR;  BEGIN "WRITE('PRESS '' SPACE BAR'' TO CONTINUE '); BELL; "REPEAT $READ(KEYBOARD,CH) "UNTIL CH=' '; "WRITELN; "WRITE FILE'. *) "  VAR F:FILE OF INTEGER; (* APPLE1: CLEAN-BLOCK*) $BUFFER:PACKED ARRAY [0..255] OF CHAR; (* USE FOR 'UNITREAD' *) $BLOCKNUM:INTEGER; (* // *) $  PROCEDURE BELL;  BPROGRAM CLEAN;  (*---------------------------------------------------------------------- "BY SHIN'ICHIROU SUGOU " " "THIS PROGRAM IS FOR USING 'CLEANING DISKETT'. " "IT CONSISTS OF 'BELL', 'ALARM', 'WAIT', 'READ FILE', 'CHECK', "'CLEANDISK', 'WRITPROGRAM CLEAN2;   (* FOR TWO DRIVE SYSTEM *)  "  VAR F:FILE OF INTEGER; (* APPLE1: CLEAN-BLOCK*) $BUFFER:PACKED ARRAY [0..255] OF CHAR; (* USE FOR 'UNITREAD' *) $BLOCKNUM:INTEGER; (* //PROGRAM FILEMAKER;   VAR F:FILE OF INTEGER;   BEGIN "REWRITE(F,'APPLE1:CLEAN-BLOCK'); "F^:=0; "PUT(F); "CLOSE(F,LOCK)  END. N^ BEGIN(* MAIN *) "READFILE; "CHECK; "CLEANDISK(5); "CLEANDISK(4); "WRITEFILE  END. BLOCKNUM); $BLOCKNUM:=BLOCKNUM+1  END  END(* CLEANDISK *);   PROCEDURE WRITEFILE;  BEGIN "WRITELN('PUT ''APPLE1:'''); "WAIT; " "RESET(F,'APPLE1:CLEAN-BLOCK'); "SEEK(F,0); "F^:=BLOCKNUM; "PUT(F); "CLOSE(F,LOCK)  END(* WRITEFILE *);   =234 THEN IF BLOCKNUM>=280 THEN BEGIN PRESET(F *) $  PROCEDURE BELL;  BEGIN "WRITE(CHR(7))  END;   PROCEDURE ALARM;  BEGIN "WRITE(CHR(7)); "WRITE(CHR(7))  END;   PROCEDURE WAIT;  VAR CH:CHAR;  BEGIN "WRITE('PRESS '' SPACE BAR'' TO CONTINUE '); BELL; "REPEAT $READ(KEYBOAR(^$O^.  "P.S. 'CLEAN2' IS A MODIFIED PROGRAM  FOR TWO DISKS SYSTEM. KS IS USED PER A "DISK. "   PROC. WRITEFILE " "LASTLY, REWRITES NEW 'BLOCK NUMBER' "TO 'APPLE1:CLEAN-BLOCK'. "  --------------------------------------- "TO USE THIS PROGRAM, RUN 'FILEMAKER'  FIRST TO CREATE A FILE 'CLEAN-BLOCK' ON  'APPLE1:'"'BLOCK NUMBER' IS LARGER THAN 279, "THEN COMPUTER REJECTS THIS CLEANING "DISKETTE AND REWRITES STARTING 'BLOCK "NUMBER' TO 0 FOR BEING USE A NEW "CLEANING DISKETTE. "   PROC. CLEANDISK " "THIS PROCEDURE DO THE TASK USING "'UNITREAD'. TWO BLOCOU "KNOW, IN PASCAL, THERE IS 280 BLOCK "ON ONE DISKETTE. (FROM 0 TO 279) "   PROC. CHECK " "THEN, CHCKS 'BLOCK NUMBER'. IF 'BLOCK "NUMBER' IS LARGER THAN 234 THEN "COMPUTER DISPLAYS THE MESSAGE 'HOW "LONG THIS DISKETTE CAN BE USED'. IF O FIT ANY SYSTEM, THAT IS, ONE  DISK SYSTEM, TWO DISK DISKS SYSTEM, AND  SO ON.  "EXPLANATION OF THIS PROGRAM  "  ---------------------------------------  PROC. READFILE " "FIRST, THIS PROGRAM READS STARTING "'BLOCK NUMBER' FROM 'APPLE1:'. Y OF THIS CLEANING DISK  BECOMES DIRTY, MOVE THE DISK HEAD TO  CLEAR PORTION, AND USE. "IT IS VERY DIFFICULT TO DO WHAT 3) IS  SAYING. SO, I MADE THIS PROGRAM.  "THIS PROGRAM IS WRITTEN FOR THREE  DISKS SYSTEM. BUT IT WILL BE EASY TO  CHANGE T  SHIN'ICHIROU SUGOU "THE INSTRUCTIONS FOR A COMMERCIALLY  AVAILABLE "CLEANING DISK" STATE:  1) 5-10 SECONDS CLEANING IS ENOUGH.  2) IT IS MORE EFFECTIVE TO USE IT  BEFORE SARTING DISK OR AFTER HAVING  FINISHED TO USE DISK.  3) IF THE SURFACE(* Introduction to Master Catalog Program *)   (* This program creates a master catalog of as many  diskette directories as can be written into the  catalog file. The catalog file is written on the  diskette in drive two and can be given any file  dln(track); )write('Sector #');readln(sector) &end &else begin )write('blocknumber');readln(blocknum) &end; & #write('Output to printer ? '); read(ch); #writeln; #if (ch = 'Y') or (ch = 'y') &then out_name := 'PRINTER:' &else out_name := 'CONSOnitnumber (0 exits) '); #repeat &readln(unitnum) #until unitnum in [0, 4,5, 9..12]; #if unitnum = 0 then exit(program); # #write('DOS format ?'); read(ch); #writeln; #dos := (ch = 'Y') or (ch = 'y'); # #if dos &then begin )write('Track # ');rea#i: integer; #ch: char; #dos: boolean; {how do we map t/s --> blocks?} #digit: array[0..15] of char; {used to store hex digits}  & &  Procedure Get_Parameters;  begin #page(output); #write('u }   Const escape = 27; { }   Var #buffer: packed array [0..511] of char; {one block} #sysout: interactive; #out_name: string[8]; {'PRINTER:' or 'CONSOLE:'} #blocknum,unitnum, #track,sector: integer; ectors in DESCENDING order. }  {After each sector is dumped the program waits for you to press a key. }  {If is pressed, the options are shown again, otherwise the next }  {sector is displayed. The ASCII display on the right is modulo 128. Pascal disk, you are asked for the starting block number, and are}  {then shown successive halves of the blocks (in ascending order). }  {If a DOS disk, you are asked for the starting track and sector numbers}  { (decimal), and are then shown the s Program Diskdump;   {This program dumps any kind of 16 sector disks, one sector at at time,}  {on an 80-column display or printer. When started it will ask for the }  {unit number (4,5,9..12) and if it is a DOS disk. }  {If a O^wing  the volume name of the diskette.   Since the diskettes can be physically called by a  name other than the name stored on the disk, an  optional alias name is requested for each diskette. *)  name. If that file exists, the master catalog is  appended to the end. The diskettes to be cataloged  are inserted into drive one in response to the  prompts. All active files on the diskette directory  are written onto the master catalog file folloLE:'; #reset(sysout,out_name)  end; {get_parameters} #    Procedure List_Sector(secnum: integer);  {secnum = 0,1 and determines which half of the buffer to list}  var #i,j,index : integer; #temp : char;  begin #for i:=0 to 15 do begin &for j:=0 to 15 do begin )index:=256*secnum+16*i+j; )if (index mod 8)=0 then write(sysout,' '); )write(sysout,digit[ord(buffer[index]) div 16], 6digit[ord(buffer[index]) mod 16],' '); &end; &write(sysout,' '); &for j:=0 to 15 do begin )index: unitnumber (0 exits) 7 717áצ DOS format ?::Yé:yÍ;;PצTrack # 6 Sector #5 *צ blocknumber8BDISKDUMP ,then dump_dos ,else dump_pascal &until ord(ch) = escape; &close(sysout) #until false  end. ; &if track < 0 then track := 0 #end; #read(ch)  end; {dump_dos} # #   begin {Main} #for i:=0 to 9 do digit[i]:=chr(i+48); #for i:=10 to 15 do digit[i]:=chr(i+55); #repeat {until false} &get_parameters; &repeat {until esc} & if dos ,sector); #writeln(sysout,'Block-number = ',blocknum, 5' Track = ' ,track:3, 5' Sector = ',sector); #list_sector(dos_to_pos(sector) mod 2); #sector := sector - 1; {walk DOWN disk} #if sector < 0 then begin §or := 15; &track := track - 1dos_to_pos} # # #Procedure Get_Sector(t,s: integer); #begin &blocknum := t * 8 + dos_to_pos(s) div 2; &unitread(unitnum,buffer,512,blocknum) #end; {get_sector} #   begin {dump_dos} #if out_name = 'CONSOLE:' then page(sysout); #get_sector(track end; {dump_pascal}  #   Procedure Dump_Dos;  #Function Dos_to_Pos(s: integer): integer; &{maps DOS sectors to POS sectors} &{see Beneath Apple DOS, p 3-23 } #begin &if s in [0,15] )then dos_to_pos := s )else dos_to_pos := 15 - s " end; {out); &writeln(sysout,'Block-number = ',blocknum, 5' Track = ' ,(blocknum*2) div 16, 5' Sector = ',(blocknum*2) mod 16 + i); &list_sector(i); &read(ch); &if ord(ch) = escape then exit(dump_pascal) #end; #blocknum:=blocknum+1 in &writeln; &write(' to quit, any key to continue:') #end  end; {list_sector}     Procedure Dump_Pascal;  var i: integer;  begin #unitread(unitnum,buffer,512,blocknum); #for i:=0 to 1 do begin &if (out_name = 'CONSOLE:') then page(sys=256*secnum+16*i+j; )if (index mod 8)=0 then write(sysout,' '); )temp := chr(ord(buffer[index]) mod 128); )if ord(temp) in [32..127] +then write(sysout,temp) +else write(sysout,'.'); &end; &writeln(sysout) #end; #if out_name = 'CONSOLE:' then beg צOutput to printer ? ::Yé:yÍ0צPRINTER:0צCONSOLE:0Qȡȡm؏ۏڂá << צ ȡf؏ۏڂáצ ǀܳ  .0CONSOLE:ׯ7# to quit, any key to continue:L\U n7'; )for k := 0 TO 29 DO fname [j] [k+1] := -CHR(bytearray[off + 11 +(j-1)*35 + 3 + k]); - 'END; { for j := 1 to 7 } #END; { getcat } '  PROCEDURE getbmap(i:integer);   VAR j: RECORD .CASE b: BOOLEAN OF 3true: (jint: 0..255); 3false: (jboo*35 + 1];  locked [j] := ((bytearray[off + 11 + (j-1)*35 + 2] DIV 128) = 1);  ftype [j] := bytearray[off + 11 + (j-1)*35 + 2] MOD 128; )flen [j] := bytearray[off + 11 + (j-1)*35 + 33]; )fname [j] := '012345678901234567890123456789#BEGIN { move the byte array into the catalog information } %off := 256*i; %t := bytearray [off+1]; %s := bytearray [off+2]; %FOR j := 1 TO 7 DO 'BEGIN )tst[j] := bytearray[off + 11 + (j-1)*35 + 0]; )tss[j] := bytearray[off + 11 + (j-1):INTEGER):INTEGER; # #BEGIN { calculate block from track, sector } %IF s=0 THEN s := 15 ELSE IF s=15 THEN s := 0; %cblk := ((t*8+(15-s) DIV 2)*2 + ((15-s) MOD 2)); #END; &  PROCEDURE getcat(i:INTEGER);  #VAR off,j,k: INTEGER; # en : ARRAY [1..7] OF 0..255; $locked : ARRAY [1..7] OF BOOLEAN; $ftype : ARRAY [1..7] OF 0..127; $fname : ARRAY [1..7] OF STRING [30]; # $bitmap : ARRAY [0..34] OF ARRAY [0..15] OF BOOLEAN; #  FUNCTION cblk(t:INTEGER;s,N, $CATUNIT : INTEGER; (* COUNTERS *) $ANS,QUES : STRING[80]; $CHARARRAY : PACKED ARRAY [0..512] OF CHAR; $bytearray : PACKED ARRAY [0..512] OF 0..255; $endcat : BOOLEAN; $types : STRING[8]; $ $t,s,vol : 0..255; $tst,tss,fl  PROGRAM readcat; # #(*$C COPYRIGHT (C) 1980 BY LEE MEADOR *) #(* ONLY COMMERCIAL RIGHTS RESERVED *) # #(* PROGRAM TO SHOW CATALOG OF DOS 3.3 DISK ON THE SCREEN *) #(* By Lee Meador - 21 Dec 1980 *) #  VAR I,J,K,L,MN^Ǡâ6:ץ/9 L9Lȡ<99099 9L9Lȡ<99799;:á**R@88  ڕ878&0CONSOLE:ׯ  65Block-number = 8 צ Track = 6  Sector = 5 5555ɡ5666ɡ8ȡ0CONSOLE:ׯ  Block-number = 8 צ Track = 8  Sector = 8؂ ::á88  ڕl:PACKED ARRAY [0..7] OF BOOLEAN); 'END; {j record} ' 'l,k,off: INTEGER;  "BEGIN " off := i*256; (FOR l := 0 TO 34 DO WITH j DO BEGIN ,jint := bytearray[off + 56 + l*4 + 0]; ,FOR k := 0 to 7 DO 0bitmap[l] [k] := jbool [7-k]; ,jint := bytearray[off + 56 + l*4 + 1]; ,FOR k := 0 TO 7 DO 0bitmap[l] [k+8] := jbool [7-k]; ,END; { for l := 0 to 34 do with j } , "END; " PROCEDURE SHOW_BITMAP;   VAR I,J: INTEGER;   BEGIN #FOR i := 15 DOWNTO 0 DO &BEGIN &WRITE(I:2,' ! 'ááڕڕ.؏]f]eȡu] #n] #|] #ǀÚ] #ǀB!COPYRIGHT (C) 1980 BY LEE MEADOR AD(catunit,bytearray,512,i DIV 2); "getbmap(iREADCAT ); "  SHOW_BITMAP; " "WRITELN('Push button to continue'); "READLN(ans); "  END. Print out the number of free sectors } " "k := 0; "FOR i := 0 TO 34 DO FOR j := 0 TO 15 DO IF bitmap [I] [J] THEN &k := k + 1; & "WRITELN; "WRITELN(' ',k:4,' Free Sectors'); "WRITELN; " "WRITELN('Push button to continue'); "READLN(ans=l := succ(l); =j := j DIV 2; =END; 7WRITELN(types[l],FLEN[K]:4, ?' ',fname[k],TST[K]:4,TSS[K]:4) 7END { then } 2ELSE endcat := true 2 -ELSE WRITELN('.............'); $ $END; { for k := 1 to 7 } "END; { while not endcat }  "{ Calculate and } " ${ Read in the next sector of the DOS 3.3 catalog } $ $FOR k := 1 TO 7 DO BEGIN -IF tst[k] < 127 -THEN 2IF tst[k] <> 0 2THEN BEGIN 7IF locked[k] THEN WRITE('*') DELSE WRITE(' '); 7l := 1; 7j := ftype[k]; 7while j <> 0 do =BEGIN "WRITELN; $ "{ Print out the contents of the catalog } " "endcat := false; $ "WHILE NOT endcat DO BEGIN $ $i := cblk(t,s); { Track, Sector } $UNITREAD(catunit,bytearray,512,i DIV 2); $getcat(i MOD 2); { get catalog data from bytearray t := bytearray[(i MOD 2)*256+1]; { track of 1st catalog sector } "s := bytearray[(i MOD 2)*256+2]; { sector of 1st catalog sector } " "{ Print out the volume number, etc } " "WRITELN('CATALOG'); "WRITELN; "WRITELN('Disk Volume ',vol); " "{ Read in the VTOC of the DOS 3.3 catalog } " "t := 17; "s := 00; "i := cblk(t,s); { Track, Sector } "UNITREAD(catunit,bytearray,512,i DIV 2); "getbmap(i MOD 2); "vol := bytearray[(i MOD 2)*256+6]; { Volume num from VTOC } "BRS??';  END; "  BEGIN " "initypes; "WRITELN('DOS 3.3 CATALOG'); "WRITELN; "REPEAT %WRITELN('What unit # for diskette? '); %READLN(catunit); "UNTIL CATUNIT IN [4,5,11..14]; " "WRITELN; "WRITELN('Put disk in #' ,catunit ); "READLN(ans); ELSE WRITE(i DIV 10:2); "WRITELN; " "WRITE(' ':5); "FOR i := 0 TO 34 DO WRITE(i MOD 10:2); "WRITELN;  END; (* SHOW_BITMAP *)   PROCEDURE initypes;  "BEGIN { set up the various types a DOS file can be } $types := 'TIA); &FOR j := 0 TO 34 DO IF bitmap [J] [I] THEN WRITE(' ':2) MELSE WRITE('*':2); &WRITELN; &END; & "WRITE(' ':5); "FOR i := 0 TO 34 DO WRITE('--'); "WRITELN; " "WRITE(' ':5); "FOR i := 0 TO 34 DO IF i DIV 10 = 0 THEN WRITE(' ':2) " g] #!012345678901234567890123456789תȡ-] #ق3@  r"ȡ]8ȡ#"ܕ]8ȡ%"ܕ8ġb צ ! "ȡ/"   * "ȡ--&END; "END; "  PROCEDURE BOOTWAIT; "BEGIN $PAGEG; $WRITELN('INSERT BOOT DISK IN #4, PRESS RETURN'); $READ(CH); " PAGE(OUTPUT); "END; "  BEGIN (*MAIN PROGRAM*) "EOJ:=FALSE; (*SET INCOMPLETE*) "REPEAT $BEGIN $ FOR I:=0 TO 3 DO &BEGIN (REAEAD(CH); $WRITELN('WRITING'); $FOR J:=0 TO GROUPSIZ DO &BEGIN (CALCK; (WRITEOK:=FALSE; (REPEAT *BEGIN ,UNITWRITE(4,BUFFER[J],512,K); & UNITREAD(4,VBUFFER,512,K); ,IF VBUFFER=BUFFER[J] THEN .WRITEOK:=TRUE; *END; (UNTIL WRITEOK=TRUE; RITELN('INSERT MASTER DISK, PRESS RETURN'); $READ(CH); $WRITELN('READING'); $FOR J:=0 TO GROUPSIZ DO &BEGIN (CALCK; (UNITREAD(4,BUFFER[J],512,K); &END; "END; "  PROCEDURE WRITEG; "BEGIN " PAGEG; $WRITELN('INSERT COPY DISK, PRESS RETURN'); $R PROCEDURE PAGEG; "BEGIN " PAGE(OUTPUT); $WRITELN('PASCAL SINGLE DISK COPY'); " WRITELN; "END; "  PROCEDURE CALCK; "BEGIN $GOTOXY(0,6); $K:=I*(GROUPSIZ+1)+J; $WRITELN('BLOCK ',K,' '); "END; "  PROCEDURE READG; "BEGIN " PAGEG; $WPROGRAM COPY;   CONST GROUPSIZ=69; (*STARTING WITH ZERO*)   TYPE BLOCK = PACKED ARRAY [0..511] OF CHAR; %GROUP = PACKED ARRAY [0..69] OF BLOCK;   VAR BUFFER:GROUP;  VBUFFER:BLOCK; %WRITEOK,EOJ:BOOLEAN;  I,J,K:INTEGER; %CH:CHAR;  N^צ Push button to continue3P Push button to continue3P $e*=V^R 6`   _훾g  u n ^! ............. "**ȡ3+海+ȡ"    Free SectorsצDisk Volume d ^^詂fe ꥁ]**ȡ쥂uɡuˡ| *  ˡ _훾g  0xצ Put disk in # 3Pfefe ꥁ]]d]f]eCATALOG "ȡ& á      "ȡ  "g$_TIABRS??תDOS 3.3 CATALOGצWhat unit # for diskette? DG; (WRITEG; &END; &PAGEG; &REPEAT (BEGIN ( WRITELN('MORE DISKS TO COPY? (Y OR N)'); *READ(CH); (END; " UNTIL CH IN ['Y','y','N','n']; &IF CH IN ['N','n'] THEN (EOJ:=TRUE; $END; "UNTIL EOJ=TRUE; "BOOTWAIT;  END.   found out if the manufacturer had  answered the original questions. For  example I expect this would be a good  tool to figure out how APPLE makes  certain areas of disk non-copyable on  some of their software products.  "Happy hunting!!!!! not answering simple  questions that are reasonable at least  to the one asking the questions. The  one asking the questions gets around  the problem and finds out many things  along the way that he would never have  SYSTEM.APPLE must be supplied by the  user.  "DISASM may be easily modified to dis-  assemble the files on the BASICS disk  or the data on the first two blocks of  a formatted diskette.  "I guess this is a classic case of a  manufacturerOSB:BIOS9.TEXT' and continues  through BIOS16. The entire process  nearly fills two diskette surfaces and  takes about an hour. I thought about  supplying SYSTEM.APPLE already  processed but I figured I would run  into legal problems. This way, bytes are dis-assembled, DISASM closes  'BIOSA:BIOS1.TEXT' and starts writing  to 'BIOSA:BIOS2.TEXT.' This continues  every 1024 bytes through BIOS8. Then  DISASM stops and asks you to insert  BIOSB. After you hit any key, it picks  up at 'BI named 'BIOSB' must be previously  formatted by the Pascal formatter and  changed from 'BLANK' by the FILER.  After you insert 'BIOSA' DISASM starts  writing out the dis-assembled code  onto 'BIOSA:BIOS1.TEXT'. After 1024 lied assembler.  "The text file for the dis-assembler  is supplied so that modifications may  be easily made. Currently, DISASM  reads in '#4:SYSTEM.APPLE' and asks  for you to insert a diskette named  'BIOSA'. This diskette and another one al 1.0.  "So, I wrote a dis-assembler.  "This dis-assembler is written in  Pascal and dis-assembles SYSTEM.APPLE  into 16 separate files on diskette.  The format of the generated text is  such that they may be re-assembled by  the APPLE supp"Recently, I was looking for a way to  add some functions to the updated  Pascal System (1.1). It became  apparent that a BIOS listing for  Pascal 1.1 was not forthcoming and I  really wanted to make the same  modifications that I had made in  Pasc'^AA  PROGRAM DISASM;   TYPE OPTYP=STRING[3];   VAR DISDATA: PACKED ARRAY[0..16386] OF 0..255;  I: INTEGER;  L:INTEGER; $B:INTEGER[8]; $OP: INTEGER;  CH:CHAR; $F:TEXT;   FUNCTION PEEK (PTR:INTEGER):INTEGER; !  TYPE TRIXARRAY=PACKEDN^*! .ABSOLUTE %.PROC BIOS %.ORG 0D000 %.INCLUDE BIOSA:BIOS1.TEXT  .INCLUDE BIOSA:BIOS2.TEXT %.INCLUDE BIOSA:BIOS3.TEXT %.INCLUDE BIOSA:BIOS4.TEXT %.END  N^!! ARRAY[0..1] OF 0..255; !  VAR TRIX:RECORD CASE BOOLEAN OF *FALSE:(ADDRESS:INTEGER); *TRUE:(POINTER:^TRIXARRAY); )END;(*RECORD TRIX*) )  BEGIN  TRIX.ADDRESS:=PTR;(*SET POINTER TO DATA*)  PEEK:=TRIX.POINTER^[0];(*PEEK THE DATA*)  END;(*POKE*)   PROCEDURE POKE (PTR,DATA:INTEGER); !  TYPE TRIXARRAY=PACKED ARRAY[0..1] OF 0..255; !  VAR TRIX:RECORD CASE BOOLEAN OF *FALSE:(ADDRESS:INTEGER); *TRUE:(POINTER:^TRIXARRAY); )END;(*RECORD TRIX*) )  BEGIN  TRIX.ADDRESS:=PTR;(*SET POINTER TO DATA*)  LAST(2);  END;    PROCEDURE PRINDY(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('(0');  OUT3(ORD(DISDATA[I+1]));  OUT1('),Y');  LAST(2);  END;    PROCEDURE PRZPGX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1); ;  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+2]));  OUT3(ORD(DISDATA[I+1]));  OUT1(',Y');  LAST(3);  END;    PROCEDURE PRINDX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('(0');  OUT3(ORD(DISDATA[I+1]));  OUT1(',X)');  END;    PROCEDURE PRABSX(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+2]));  OUT3(ORD(DISDATA[I+1]));  OUT1(',X');  LAST(3);  END;    PROCEDURE PRABSY(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4) BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('0');  OUT3(ORD(DISDATA[I+1]));  BLANKS(4);  LAST(2);  END;    PROCEDURE PRIMME(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('#0');  OUT3(ORD(DISDATA[I+1]));  BLANKS(3);  LAST(2);"BEGIN (*BAD DECODE*) #PRASCI; #PRASCI; #PRASCI; "END  ELSE "BEGIN $OUT2(OPTYPE,4); $BLANKS(1); $OUT1('0'); $OUT3(ORD(DISDATA[I+2])); $OUT3(ORD(DISDATA[I+1])); $BLANKS(2); $LAST(3);  END;  END;    PROCEDURE PRZPAG(OPTYPE:OPTYP);  T2(OPTYPE,4);  BLANKS(8);  LAST(1);  END;    PROCEDURE PRACCU(OPTYPE:OPTYP);   BEGIN  OUT2(OPTYPE,4);  BLANKS(1);  OUT1('A');  BLANKS(6);  LAST(1);  END;    PROCEDURE PRABSO(OPTYPE:OPTYP);   BEGIN  IF ORD(DISDATA[I+2])=0 THEN ]);  PASA:=' ';  PASA[1]:=CHR(ORD(DISDATA[I]));  IF PASC<128 THEN #IF PASC>31 THEN %OUT1(PASA) #ELSE %OUT1(' ')  ELSE #IF PASC>159 THEN %OUT1(PASA) #ELSE %OUT1(' ');  NL;  I:=I+1;  END;    PROCEDURE PRIMPL(OPTYPE:OPTYP);   BEGIN  OUT(2); "END  ELSE "BEGIN "OUT1(' .BYTE 0 '); "LAST(1); "END;  END;   PROCEDURE PRASCI;   VAR PASC:INTEGER;  PASA:STRING[1];   BEGIN  OUT1(' .BYTE 0');  OUT3(ORD(DISDATA[I]));  BLANKS(2);  LASTA;  BLANKS(1);  PASC:=ORD(DISDATA[I BEGIN  LASTA;  IF INCR>1 THEN #OUT3(ORD(DISDATA[I+1]));  IF INCR>2 THEN #OUT3(ORD(DISDATA[I+2]));  NL;  I:=I+INCR;(*LENGTH OF INSTRUCTION*)  END;   PROCEDURE PRBRK;   BEGIN  IF ORD(DISDATA[I+1])=0 THEN "BEGIN "OUT1(' .WORD 0 '); "LASR[8];  BEGIN  BLANKS(1);  OUT1(';');  X:=B+I;(*CALCULATE ADDRESS*)  Y:=X DIV 256;(*CALCULATE FIRST BYTE*)  OUT3(TRUNC(Y));  OUT3(TRUNC(X-(Y*256)));  OUT1(':');  OUT3(ORD(DISDATA[I]));  END; (*LASTA*)   PROCEDURE LAST(INCR:INTEGER);  T1('A'); !11:OUT1('B'); !12:OUT1('C'); !13:OUT1('D'); !14:OUT1('E'); !15:OUT1('F');  END;(*CASES*)  END;   PROCEDURE OUT3(X:INTEGER);  BEGIN  OUT3A(X DIV 16);  OUT3A(X MOD 16);  END;   PROCEDURE LASTA;   VAR X:INTEGER[8];  Y:INTEGE;CT:INTEGER);  BEGIN  WRITE(F,S:CT);  END;   PROCEDURE OUT3A(X:INTEGER);  BEGIN  CASE X OF !0:OUT1('0'); !1:OUT1('1'); !2:OUT1('2'); !3:OUT1('3'); !4:OUT1('4'); !5:OUT1('5'); !6:OUT1('6'); !7:OUT1('7'); !8:OUT1('8'); !9:OUT1('9'); !10:OU PROCEDURE OUT1(S:STRING);  BEGIN  WRITE(F,S);  END (*OUT1*);   PROCEDURE NL;  BEGIN  WRITELN(F);  END (*NL*);   PROCEDURE BLANKS(CT:INTEGER);  VAR A:STRING[1];  BEGIN  A:='';(*SET NULL*)  WRITE(F,A:CT);  END;   PROCEDURE OUT2(S:STRING TRIX.POINTER^[0]:=DATA;(*POKE THE DATA*)  END;(*POKE*)   PROCEDURE GETDATA;   VAR F:FILE;  BLKSREAD:INTEGER;   BEGIN  RESET (F,'#4:SYSTEM.APPLE');  BLKSREAD:=BLOCKREAD(F,DISDATA,32);  CLOSE (F,LOCK);  END; (