TYPES15 PAS2TYPES15 CMD4`TYPES15 DOCCMDPARMSPAS * CMD % PROGRAM ByTypes; CONST HiValue = 127; NumAcross = 6; TYPE FieldType = (Names,Types); NameType = PACKED ARRAY[1..8] OF CHAR; TypeType = PACKED ARRAY[1..3] OF CHAR; EntryType = PACKED RECORD CASE BOOLEAN OF TRUE : (FName : NameType; FType : TypeType); FALSE : (FullEntry : PACKED ARRAY[1..11] OF CHAR); END; NodePtr = ^NodeType; NodeType = PACKED RECORD Info : EntryType; Junk : PACKED ARRAY[0..0] OF BYTE; { get a word boundary } Next : NodePtr; END; PTR = ^BYTE; STR16 = STRING[16]; VAR Count : INTEGER; Drive : BYTE; FileSpec : STR16; ListHead : NodePtr; HiName : NameType; HiExt : TypeType; OutFile : TEXT; Result : INTEGER; EXTERNAL PROCEDURE CmdTail; EXTERNAL FUNCTION Argc : INTEGER; EXTERNAL PROCEDURE CmdTokn(Num : INTEGER; VAR S : STR16); EXTERNAL FUNCTION @BDOS86(Func : INTEGER; address : PTR) : INTEGER; PROCEDURE GetParms; VAR Temp : STR16; BEGIN { GetParms } CmdTail; Drive := 0; FileSpec := 'CON:'; CmdTokn(1,Temp); CASE Argc OF 1 : BEGIN IF Temp[1] = '>' THEN FileSpec := COPY(Temp,2,LENGTH(Temp)-1) ELSE Drive := ORD(Temp[1]) - $40; END; 2 : BEGIN Drive := ORD(Temp[1]) - $40; CmdTokn(2,Temp); IF Temp[1] = '>' THEN DELETE(Temp,1,1); FileSpec := Temp; END; END; { Case } END; { GetParms } FUNCTION ReadDir : NodePtr; CONST FcbSize = 35; GetFirst = 17; GetNext = 18; SetDMA = 26; TYPE DirEntry = RECORD User : BYTE; Item : EntryType; Filler : PACKED ARRAY[1..20] OF BYTE; END; FcbType = PACKED ARRAY [0..FcbSize] OF BYTE; VAR Buffer : PACKED ARRAY[0..3] OF DirEntry; Fcb : FcbType; I,X : INTEGER; T : NodePtr; PROCEDURE InitFcb; BEGIN FILLCHAR(Fcb,SIZEOF(Fcb),CHR(0)); FILLCHAR(Fcb[1],11,'?'); END; BEGIN { ReadDir } InitFcb; Fcb[0] := Drive; T := ListHead; I := @BDOS86(SetDMA,ADDR(Buffer)); I := @BDOS86(GetFirst,ADDR(Fcb)); WHILE I <> 255 DO BEGIN Count := Count + 1; NEW(T^.Next); T := T^.Next; FOR X := 1 TO SIZEOF(EntryType) DO T^.Info.FullEntry[X] := CHR(ORD(Buffer[I].Item.FullEntry[X]) & $7F); I := @BDOS86(GetNext,ADDR(Fcb)); END; T^.Next := ListHead; ReadDir := ListHead^.Next; ListHead^.Next := ListHead; END; { ReadDir } FUNCTION Merge(a,b : NodePtr; Field : FieldType) : NodePtr; VAR C : NodePtr; BEGIN { Merge } C := ListHead; IF Field = Names THEN REPEAT IF A^.Info.FName <= b^.Info.FName THEN BEGIN C^.Next := a; c := a; a := a^.Next; END ELSE BEGIN C^.Next := b; C := b; B := B^.Next; END; UNTIL C^.Info.FName = HiName ELSE REPEAT IF A^.Info.FType <= b^.Info.FType THEN BEGIN C^.Next := a; c := a; a := a^.Next; END ELSE BEGIN C^.Next := b; C := b; B := B^.Next; END; UNTIL C^.Info.FType = HiExt; Merge := ListHead^.Next; ListHead^.Next := ListHead; END; { Merge } FUNCTION MergeSort( C : NodePtr; Field : FieldType) : NodePtr; VAR A,B,Head,Todo,T : NodePtr; I,N : INTEGER; BEGIN { MergeSort } N := 1; NEW(Head); Head^.Next := C; REPEAT Todo := Head^.Next; C := Head; REPEAT T := Todo; A := T; FOR I := 1 TO N-1 DO T := T^.Next; B := T^.Next; T^.Next := ListHead; T := B; FOR I := 1 TO N-1 DO T := T^.Next; Todo := T^.Next; T^.Next := ListHead; C^.Next := Merge(a,b,Field); FOR I := 1 TO N+N DO C := C^.Next; UNTIL Todo = ListHead; N := N + N; UNTIL A = Head^.Next; MergeSort := Head^.Next; END; { MergeSort } PROCEDURE PrintEm(P : NodePtr); CONST Space = ' '; VAR Bord1 : PACKED ARRAY[1..39] OF CHAR; Bord2 : PACKED ARRAY[1..35] OF CHAR; Bottom : PACKED ARRAY[1..79] OF CHAR; LastOne : TypeType; NumPrinted : INTEGER; PROCEDURE DoBorder(VAR Exts : TypeType); BEGIN IF NumPrinted <> 0 THEN WRITELN(OutFile); WRITE(OutFile,Bord1); WRITE(OutFile,'[',Exts,']'); WRITELN(OutFile,Bord2); END; BEGIN NumPrinted := 0; FILLCHAR(LastOne,SIZEOF(LastOne),CHR(HiValue)); FILLCHAR(Bord1,SIZEOF(Bord1),'-'); FILLCHAR(Bord2,SIZEOF(Bord2),'-'); FILLCHAR(Bottom,SIZEOF(Bottom),'='); WHILE P <> ListHead DO BEGIN WITH P^.Info DO BEGIN IF FType <> LastOne THEN BEGIN DoBorder(FType); LastOne := FType; NumPrinted := 0; END; WRITE(OutFile,Space:5,FName); NumPrinted := NumPrinted + 1; IF NumPrinted = NumAcross THEN BEGIN WRITELN(OutFile); NumPrinted := 0; END; END; P := P^.Next; END; WRITELN(OutFile); WRITELN(OutFile,Bottom); END; { PrintEm } BEGIN { Main } GetParms; ASSIGN(OutFile,FileSpec); REWRITE(OutFile); IF IORESULT = 255 THEN BEGIN WRITELN('Can''t open ',FileSpec); EXIT; END; FILLCHAR(HiName,SIZEOF(NameType),CHR(HiValue)); FILLCHAR(HiExt,SIZEOF(TypeType),CHR(HiValue)); Count := 0; NEW(ListHead); WITH ListHead^.Info DO BEGIN FName := HiName; FType := HiExt; END; ListHead^.Next := NIL; PrintEm(MergeSort(MergeSort(ReadDir,Names),Types)); WRITE(OutFile,Count:5,' File(s) listed'); WRITELN(OutFile,' [by_Types v1.5]'); CLOSE(OutFile,Result); END. Ћ&DEwUUs PCON:PC PFPP S PF&2=>t*PFPPF&2HPSPP F&2-@gF&2-@PFPF&2=>tFPPPPFPP *F]UvU^PP$PP+^PP P?P+]UUP&PHXJPtPZ+LPPPI+LLu@ľH WP ľH W-XHXJdžNdžF NF}?ľHWNH[PtPL [@PNH[×&2䓸#_&봸PPP*L\ľH WPP,> W~,XFXF> WPP,FF]UUPFXFF2u@r~ W~WP&r7~ WF PF P ,F PF FXF~ W+XF XF 4~ WFPFP+FPFFXF~ W+XFXF~WPP%re~ W~WP &r7~ WF PF P|+F PF FXF~ WC+XF XF 4~ WFPFPE+FPFFXF~ W +XFXF~W"PP1%r\> W*XFXF> WPP*FF] UU*FFPPA~ WFPFP*~ W}*XFXFFPFFXFFPFFXFFPFFXFPFH[FܓN+@FFN}~ W*XFXF~ W *XFXF~ WPP*FPFFXFPFH[FܓN+@FFN}~ W)XFXF~ W)XFXF~ WPP)~ WvvvvF2PSP)PFޓF[FܓN+@FFN}~ W/)XFXFFPFPPP'rFޓFÉFދFPFP~ W(k'rZ~ W(XFXFFF]UvU^6`=u &P Q&P ^P'PPPz!&P [PPP`!~WPPPO!]PPP=!&PE ^P#PPP !]UUdž`bPPP.&FP'P-P&FP#P-P&ePOP=P%FPFPPPL&r~WX\X^ľ\WbPP!r(ľ\WbPľ\WPI#dž`&P^ PPP? ľ\WPPP- `@``t&P dž`~ W&XFXF+&P&PePOPPP~]MMU&PPP$&PP=t9P Can't open PP8PPP(PPP{$"PPPk$PP>WXX>WPP!>W"PP!> WPP%SPPSPPSP&PPPP File(s) listedPPW&P [by_Types v1.5]PP.&PPhPE# UU&SFXFP~WPPPP=#FFP&2[FN+@FFN}PF2H[ÉFXFPF2[×&2= DFu~W~&2@_&"~F&~&2@FFu F2@FFe]UU~@PFP2[;ظ~@[ r FF-PFH[×&FPFH[@&F~WPF2PF2PSPQPV]UU2P~WS~&2= 2@]UU 2FF]' Z[)ã_& &utÀ áZ۸UU^ X #(#,&* P2X4P6X8>&WHPPFHPF.X0>.W.P">.W:P">.WPP{">*W>.WPGP:X<PBXDHPF>X@.XP00P; ãX  ã"X$PPCON: PPPPCON:PP]Ì؎& 3Ȏ &&];t&5&GGUN~v=t2;~F] ƪUU=FP~W9P~t~WvFPFP~W9P~tPP Can't close: PPqFPPPa in RESETPPH/P}Program abortedPPFF~t FFFFF~WXJXLFFFFF~8WXFXFFPPF~uxNFFFFF~WFP9P~uA~t~8WX& ?Fu>JW>J(&PFF~WFP9P8]UU~ WXJXL~ &&<u~ &&<t>~ *&=u~ ,W~ *&_&~ 6&PPB~ 6&P~ &&2PPPnPdPyZPN~&~&~ &&] UU~ &&<#~ WvN~&~ &&] 69u"o-P n UUF~ ~KPPF[×&2r"FFPPF[×&CF@FFPFCB Table Exhausted!PPCF]UUPPF[×&]UUPPPF[(PNPPPF[@PN]UU FPPPF[(PNPPPF[@PN>NuFF2]UU F~WCON:r~&&F~WLST:r~&&Fy~WKBD:P~WTRM:x[ r~&&F;~WRDR:LP~WPUN::[ r~&&FF2]UU0FFP P~P#~&2=~@P~&2=}@[ rVP~&2[FN+@FFN},~WF[×&2PFP+rFF2]UU F2a|@PF2z@[#rF2䓸#ÈFFFF2]UU~&2=t@P~WX&2= u@[#r~WPP ~&2=uF@FP  X@PPFP X@PP~WX&2=:tF~WX&2PFFFFF~WF[×&2P.P~:PwXPF쓋F;ظ}@[#PFP~&2[;ظ@[#r9FPFH[P~WF[×&2P,_&F@FF@Fk~WF[×&2=.u@PFP~&2[;ظ@[#roF@FF~}@PFP~&2[;ظ@[#r8FPFH[P~WF[×&2P_&F@FF@F~W%-PP~WXPF2䓸@+ؓ_&FP~WXPP2FP~WX PP]UUPPPP2]UUFFF~uPPF[@P$PPPPF[@P~W~WrFNvj~Whr)NPPF[@&v2qPPPF[@P0N>NtFv3PPF[&&PPF[&NF]UUFFF~uPPF[@P$PPPPF[@P~Wr~WdrFNv>~WNt FvPPF[&&NF]UU ~6&=t~6W~WPz_&~6&=uG~&&2=~"PPP~6&[@P4NF~6&PF]UUF2PPPF[@&2=t@[#rPPF[&&=ujPPF[&&=uDPPF[ÉFXF~(W~&&[PP~&&[+SPv7PPPF[@P5Nv]UUFPFJXL]UUPPF[ÉFXF~&&=}~Wv_&~&&~(W~&&[×&F~&W~&&@_&F2]UUPPF[ÉFXF~&&=}v2~&&~(W~&&[×F&~&W~&&@_&]UU N>J&&2=tPFPFF2u@rP PPP!F2 u@r P P>J8WXF&>J.WF2u@_&/>J&&2=t@PPP,FF2t@r>J8WXF&>J&&2=t'PFPF>J8WXF&>J6&F>J.&FFFP>J(&[;ظ@PF2[#r7>JWXFXF~8WFH[PvFP\_&F@F>J.F&>J,WFH_&]UU N>J&&2=tP>J8WX&2P>J&&2=tP>J8WX&2P>J&&2=tP>J8WX&2P>J&&2=tP>J8WX&2Pon>J6&FP>J(&[FN+@FFN}->JWXFXF~8WFH[×&2Pv>J*&]UUPP~6&[@Px]UU ~F~WF[P Pvr  F& FXFFF]UU P P]UU~WFF[P~WF[P~&2PFFH[+S ~WXP~&2PF[+ؓ_&]UU~/&~WXJXL~.&u ~/&~4&u~.W~8WX&<u@P~.&2[ _&~8WX&< u@FF2P~.&2[ r ~/&F2P~&&<u@[#r~.&2P~/&2[ r~8WX& ]UU~WN]UU NFF]ËV3U]ZR[ÀSuF\U]<uZZ[ʱ3U]^\!&|Ɏپ!/3SSPUUS~&<tFP@:PASTMP00.$$$PP[PF PPP&2@_&&<9)&0P&2@_&~WvFP ~t~4&F ~4&~.&~/&~&&~WXJXL~*&~,F&~0W~8W ~(F&~WX&<:u@P~WX&J8WXF&>JW>J(&P ]UU~WXJXL]ZY_^t3ZY_^uZY_^ZY_^|ZY_^}ZY_^~ $;|UU  FXFFF]UU  ]UU> |+  F P &2@_& @ ]UUPFPFPPU&2䉆 =P[+ؓP  PPj P &2P[_& P[ã ]܃"66 X PUN~v] UN~v] UN~OvN] UN~OvN] Z[X PSRUEEю3F;Fȋظ CF][YXS[YXS[ЎU~ ]$S[^ ю SZ[ ю3ˁ6R[X.;| ..O;.+.@X.G@.@XUUSFPF PF PQP3~WF[P~WFPF&2[[P~&2PF[+ؓ@PFP~WF[PF&2P3~WXP~&2PF&2[_&] 3PPP[ZYtSU]2SRQ¹3U]YZU][ZYSU][XY_QYtSUU~ W9PP~ W~W%P'] _ZY[X;u ;u3_ZY[X;u;t^8 x t^( x^ t x^ t x_YZX[+UF UFF 3FFF tVV FV FtVVFV F FuFFFFVV VVQvvvvKYs"QvvvvVYF^VV VVFuF^Ft ]F^]_X[SPZ_&2PZ_&PZ_&EP&PZX_&ZX_&ZX[_&&].." TYPES.PAS A Pascal MT+86 program to list the CP/M 86 File Directory sorted by file extensions and by names. Output can go to CON:, the default, to LST:, or to a named disk file. by Charlie Godet-Ceraolo 2610 Glenwood Road Brooklyn, NY 11210 MergeSort Algorithms from "Algorithms" by Sedgewick CmdParms from Cortesi & Cherry "Personal Pascal" Command line: bytypes [sourcedrive] [>destination] sourcedrive is optional, if missing, default drive will be listed destination is optional, if given, it must be preceded by '>' with NO intervening space. destination can be LST: or a named disk file [dr:fname.ftype] if no destination is given, output will be to the console. MODULE CMDPARMS; {$E- variables are private} TYPE Token = RECORD Len : 0..128; Inx : 0..128; END; PTRSTR = ^STRING; VAR Tail : STRING[128]; TokList : ARRAY[1..64] OF Token; TokCnt : 0..64; TokNxt : 1..64; {$E+ procedures are public} EXTERNAL FUNCTION @CMD : PTRSTR; PROCEDURE CmdTail; VAR P : PTRSTR; J : 1..64; { index over TokList } C : 1..128; { index over Tail } InTok : BOOLEAN; BEGIN { CmdTail } P := @CMD; { get address of tail } Tail := P^; { copy its text } FILLCHAR(TokList,SIZEOF(TokList),CHR(0)); J := 1; InTok := FALSE; FOR C := 1 TO LENGTH(Tail) DO WITH TokList[J] DO BEGIN IF Tail[C] > ' ' THEN IF InTok THEN Len := Len + 1 ELSE BEGIN { starting new token } Inx := C; Len := 1; TokCnt := TokCnt + 1; InTok := TRUE; END ELSE IF InTok THEN BEGIN { it has ended } J := J + 1; InTok := FALSE; END; END; TokNxt := 1; { set to return first token } END; { CmdTail } PROCEDURE CmdTokn( TokNum : INTEGER; VAR TokStr : STRING ); VAR C : 1..128; L : 1..128; BEGIN { CmdTokn } IF (TokNum <= 0) OR (TokNum > TokCnt) THEN BEGIN { sorry } L := 0; C := 1; END ELSE BEGIN { yeah, we got one } L := TokList[TokNum].Len; C := TokList[TokNum].Inx; END; TokStr := COPY(Tail,C,L); { return desired substring } END; { CmdTokn } PROCEDURE CmdNxTk( VAR TokStr : STRING ); BEGIN CmdTokn(TokNxt,TokStr); IF LENGTH(TokStr) > 0 THEN TokNxt := TokNxt + 1; END; { CmdNxTk } FUNCTION ArgC : INTEGER; BEGIN { argc } Argc := TokCnt; END; { argc } MODEND.