;*; Updated on 09-Sep-93 at 3:18 PM by James A. Jarboe I V; edit time: 0:36:10
;*************************** AMUS Program Label ******************************
; Filename: DIRHS2.M68 Date: 9/02/93
; Category: SBR Hash Code: 777-565-150-036 Version: 2.0(104)
; Initials: GR/AM Name: James A. Jarboe IV
; Company: Educational Video Network, Inc. Telephone #: 4092955767
; Related Files: AMOS 2.X SYSLIB FOR LNKLIT, DIRHSH.BAS
; Min. Op. Sys.: AMOSL 2.x Expertise Level: BEG
; Special: Must LNKLIT DIRHSH with AMOS 2.x SYSLIB for $HSHFL library call.
; Description: Returns an array filled with selected files (wildcard accepted)
; similar to AMOS command DIR/V/H/D, but in a BASIC program. See DIRHSH.BAS
; for example on usage. DOES work with 2.x extended directories.
;*****************************************************************************
;* *
;* DIRHS2.M68 *
;* *
;* Written By: James A. Jarboe IV *
;* 1401 19th Street *
;* Huntsville, TX 77340 *
;* 409-295-5767 *
;* *
;* 01-Sep-93 *
;* GR/AM *
;***************************************************************************
;
; -NOTICE- This BASIC XCALL is compatible with AMOS 2.x extended
; directory structure and traditional directory structures on
; versions of AMOS 2.x and greater.
;
; This version is a quick fix to the original DIRHSH.SBR which
; was only compatible with traditional directory structures.
; This version (DIRHS2.M68) must be assembled with the AMOS 2.x
; library as it uses AMOS 2.x Directory calls.
;
; Description: A basic subroutine which will return device spec, filename,
; extension, PPN, version number, and hash total of
; requested files in an array in the same format as the AMOS
; command DIR/V/H/D. This subroutine WILL accept wildcard
; filename and file extensions. This subroutine will NOT
; accept wildcard Device and/or PPN specifications. This
; subroutine will also return a success flag of 0 or an
; unsuccessful flag if an error occurs as listed in this
; program. The fifth argument is optional. If used, it allows
; the user to set characteristics of how the ARRAY will be
; handled as defined in OPTIONS below.
;
;
; Usage: XCALL DIRHSH, DEVICE'SPEC, FILE'SPEC, ARRAY, FLAG, OPTION
;
; Where: DEVICE'SPEC = A valid Device/PPN specification, ERSATZ
; device. If DEVICE'SPEC is an empty string
; then DIRHSH will default to the current logged
; in device and PPN.
;
; FILE'SPEC = A filename.extension of the file to find. This
; can also be a valid AMOS wildcard specification
; using "*" and "?" as wildcard characters. If this
; is an empty field the default will be a "*.*"
; wildcard search.
;
; ARRAY = Found file specifications will be returned in
; this argument. Minimum size must be equal to
; or greater than the L..STR constant (74 bytes in
; this version). When doing a wildcard match there
; is no way to assume how many files will be found.
; Make sure this array is large enough to hold the
; number of expected files you are looking for to
; hash. Multiply the number of files you expect
; by the value in L..STR to get the correct size
; of this variable. If more files are found than
; this array can hold an error flag of 1 will be
; returned.
;
; FLAG = A one byte binary number that will return the value
; of any errors found while processing.
; 0 = Everything OK.
; 1 = Did not allocate enough arg space.
; 2 = Device does not exist.
; 3 = PPN does not exist.
; 4 = Control C interrupt.
; 255 = Subroutine ERROR. (255 in BASIC)
;
; OPTION = An optional flag consisting of a one byte binary
; number that will set the following options
; to the output of the array:
; 0 = Leave array as is, and overwrite existing
; data if user failed to preclear the array
; from the basic program.
; NOTE: In version 102 it was assumed that
; the BASIC program would preclear the
; ARRAY if multiple calls were made.
; Now the user has options.
; 1 = Prelcear ARRAY to nulls.
; 2 = Append the output of this call to the
; existing data in the ARRAY.
;
; Notes:
;
; Argument 1 - String - Device, PPN specification.
; Argument 2 - String - File, extension specification.
; Argument 3 - String - File results are returned.
; Argument 4 - Binary - Returned error flags.
; Argument 5 - Binary - (optional) Set array output characteristics.
;
; Expanded version of DIR.M68 subroutine by: DALE A. EICHBAUER.
;
; Edit History:
;
;
; 2.0 09-Sep-93
;[104] 09-Sep-93 Made compatible with Extended directories. [JAJ]
;
;[103] 27-Feb-90 Added optional 5th argument - Sets the
; characteristics of ARRAY output, (rewrite over,
; preclear or append) as suggested by Dave Drake. [JAJ]
;[102] 24-Feb-90 Minor cleanup, Donated to AMUS. [JAJ]
;[101] 19-Feb-90 Correct fourth argument error language.
; Add check for 4th argument size.
; Fix address error pre-clearing 4th argument. [JAJ]
;[100] 13-Feb-90 Extremely modified DIR.M68 [JAJ]
;
;**************************************************************************
; *
; S T A N D A R D U N I V E R S A L S *
; *
;**************************************************************************
;
SEARCH SYS ; Standard AMOS.
SEARCH SYSSYM ; Standard AMOS.
EXTERN $HSHFL ; Define externals.
ASMMSG "( )"
ASMMSG "( DIRHS2.M68 )"
ASMMSG "( by )"
ASMMSG "( James A. Jarboe IV )"
ASMMSG "( )"
ASMMSG "( Must LNKLIT to create DIRHS2.SBR )"
ASMMSG "( Must LNKLIT with 2.x SYSLIB.LIB )"
ASMMSG "( To get $HSHFL library call. )"
ASMMSG "( )"
OBJNAM DIRHS2.SBR ; Assembled file name.
;**************************************************************************
; *
; C U R R E N T V E R S I O N *
; *
;**************************************************************************
;
VMAJOR = 2. ; 02-Sep-93 by James A. Jarboe IV
VMINOR = 0.
VSUB = 0.
VEDIT = 104. ; 09-Sep-93 Current edit. [JAJ]
VWHO = 0.
;**************************************************************************
; *
; P R O G R A M M A C R O S *
; *
;**************************************************************************
;
;
; Cursor Position and TCRT Macro.
;
DEFINE PRTTAB ROW, COL
MOVW #<ROW_8. + COL>, D1
TCRT
ENDM
;**************************************************************************
; *
; P R O G R A M C O N S T A N T S *
; *
;**************************************************************************
;
; L..STR can be modified to desired length of the passed string.
; L..VER can be modified for the starting position of version number
; within the passed string.
; L..HSH can be modified for the starting position of hash total
; within the passed string.
L..STR = 74. ; Size of output string array.
L..VER = 39. ; Location of Version output.
L..HSH = 57. ; Location of Hash output.
L..HSV = 15. ; Length of returned hash value.
N..ARG = 5. ; Number of Xcall arguments
S..PTN = 10. ; Size of pattern to match.
S..DVS = 6. ; Maximum size of device spec.
S..PPS = 9. ; Maximum size of ppn spec.
S..FNM = 6. ; Maximum size of filename.
S..EXT = 3. ; Maximum size of extension.
S..BUF = 512. ; Size of I/O buffer.
S..MFE = 63. ; Number of MFD entries per block.
S..UFE = 42. ; Number of UFD entries per block.
; Define characters.
;
$SPACE = 32. ; The " " character.
$STAR = 42. ; The "*" wildcard character.
$DOT = 46. ; The "." character.
$COMMA = 44. ; The "," character.
$QUEST = 63. ; The "?" wildcard character.
$LBRAK = 91. ; The "[" character.
$RBRAK = 93. ; The "]" character.
; XCALL Argument values.
;
XC$UNF = 0 ; XCALL unformatted flag.
XC$STR = 2 ; XCALL string flag.
XC$FLT = 4 ; XCALL floating point flag.
XC$BIN = 6 ; XCALL binary flag.
; Returned error codes in ADDR.4
;
DH$ARY = 1. ; Did not allocate enough arg space.
DH$DEV = 2. ; Device does not exist.
DH$PPN = 3. ; PPN does not exist.
DH$CTC = 4. ; Control C interrupt.
DH$SBR = -1 ; Subroutine ERROR. (255 in BASIC)
; Option flags.
;
OP$NON = 0 ; No fifth option/leave array alone.
OP$CLR = 1 ; Prelclear ARRAY to nulls.
OP$APN = 2 ; Append new files to existing array.
;**************************************************************************
; *
; X C A L L O F F S E T S *
; *
;**************************************************************************
;
OFINI
OFDEF PARMS, 2 ; Number of arguments
OFDEF TYPE.1, 2 ; Argument 1, type.
OFDEF ADDR.1, 4 ; Argument 1, address.
OFDEF SIZE.1, 4 ; Argument 1, size.
OFDEF TYPE.2, 2 ; Argument 2, type.
OFDEF ADDR.2, 4 ; Argument 2, address.
OFDEF SIZE.2, 4 ; Argument 2, size.
OFDEF TYPE.3, 2 ; Argument 3, type.
OFDEF ADDR.3, 4 ; Argument 3, address.
OFDEF SIZE.3, 4 ; Argument 3, size.
OFDEF TYPE.4, 2 ; Argument 4, type.
OFDEF ADDR.4, 4 ; Argument 4, address.
OFDEF SIZE.4, 4 ; Argument 4, size.
OFDEF TYPE.5, 2 ; Argument 5, type.
OFDEF ADDR.5, 4 ; Argument 5, address.
OFDEF SIZE.5, 4 ; Argument 5, size.
OFSIZ XC..SZ ; Size of Xcall arguments.
;**************************************************************************
; *
; I M P U R E A R E A O F F S E T S *
; *
;**************************************************************************
;
OFINI
OFDEF DH.PTN, S..PTN ; Pattern to Match.
OFDEF DH.MCH, S..PTN ; UFD file name (ASCII)
OFDEF MD.DDB, D.DDB ; MFD DDB.
OFDEF MD.BUF, S..BUF ; MFD buffer.
OFDEF IN.DDB, D.DDB ; File DDB.
OFDEF IN.BUF, S..BUF ; File Buffer.
OFDEF DH.AVL, 4 ; Number of possible files in array.
OFDEF DH.CNT, 4 ; Current found file count.
OFDEF DH.TYP, 2 ; JOBTYP storage.
OFDEF TRMCAP, TC.SIZ ; Terminal characteristics.
OFDEF DH.OPT, 1 ; Array characteristic option flag.
OFSIZ EX..SZ ; Size of offsets.
; UFD offsets.
;
OFINI
OFDEF UF.FNM, 4 ; UFD filename (RAD50)
OFDEF UF.EXT, 2 ; UFD file extension (RAD50)
OFDEF UF.BLK, 2 ; UFD data blocks in file.
OFDEF UF.ACT, 2 ; UFD active data in last block.
OFDEF UF.BNM, 2 ; UFD first block number of file.
OFSIZ UF.SIZ ; Size of UFD.
; UFD first word link.
;
OFINI 2
OFDEF UF.LNK, 2 ; UFD link word.
PAGE
;**************************************************************************
; *
; S T A R T O F S U B R O U T I N E *
; *
;**************************************************************************
;****************
; DIRHSH *
;****************
; Description:
;
; Basic subroutine to return version and hash of indicated files.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
; A5 => End of free memory.
;
; Reentrant, Reusable, Read Physical disk.
;
; Returned/Side effects:
;
; Returns an array filled with selected file information.
;
; D0, D1, D6, D7 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
DIRHSH: PHDR -1,PV$RPD,PH$REE!PH$REU ; Set header.
; Check available memory left.
;
MOV A5, D0 ; Get end of free memory area.
MOV A4, D1 ; Get start of free memory area.
SUB D1, D0 ; Subtract start from end.
CMP D0, #EX..SZ ; Is there enough free memory?
BHI 10$ ; Yes..process subroutine.
CALL ERORIN ; Set up error reporting.
TYPE <Insufficient memory> ; Output error.
JMP INDIR ; Sleep and Return to BASIC.
; Check for correct number of arguments.
;
10$: CMPW PARMS(A3), #N..ARG-1 ; Are there enough arguments?
BGE 20$ ; Yes..check types.
CALL ERORIN ; Set up error reporting.
TYPE <Insufficient number of arguments>
JMP INDIR ; Sleep and Return to BASIC.
; Check type of first argument.
;
20$: CMPW TYPE.1(A3), #XC$STR ; Is first argument a string?
BLE 30$ ; Yes..check next one.
CALL ERORIN ; Set up error reporting.
TYPE <First > ; Report error.
JMP BADSTR ; Report string, exit to BASIC.
; Check type of second argument.
;
30$: CMPW TYPE.2(A3), #XC$STR ; Is second argument a string?
BLE 40$ ; Yes..check size.
CALL ERORIN ; Set up error reporting
TYPE <Second > ; Report error.
JMP BADSTR ; Report string, exit to BASIC.
; Check type of third argument.
;
40$: CMPW TYPE.3(A3), #XC$STR ; Is third argument a string?
BLE 50$ ; Yes..check size.
CALL ERORIN ; Set up error reporting.
TYPE <Third > ; Report error.
JMP BADSTR ; Report string, exit to BASIC.
; Check size of third argument.
;
50$: CMP SIZE.3(A3), #L..STR ; Is third arg at least this size?
BGE 60$ ; Yes..check next argument.
CALL ERORIN ; Set up error reporting.
TYPE <Third argument must be at least >
MOV #L..STR, D1 ; Get minimum length of string.
DCVT 0,<OT$TRM!OT$TSP> ; Output number.
TYPE <bytes> ;
JMP INDIR ; Sleep and return to BASIC.
; Check type of fourth argument.
;
60$: CMPW TYPE.4(A3), #XC$BIN ; Is fourth argument binary?
BE
Q 70$ ; Yes..check size.
CALL ERORIN ; Set up error reporting.
TYPE <Fourth argument must be binary>
JMP INDIR ; Sleep and return to basic.
; Check size of fourth argument.
;
70$: CMP SIZE.4(A3), #1 ; Is fourth argument 1 byte?
;;; BEQ CLRIMP ; Yes..process subroutine.
BEQ 80$ ; Yes..check for fifth argument.
CALL ERORIN ; Set up error reporting.
TYPE <Fourth argument must be one byte>
JMP INDIR ; Sleep and return to BASIC.
; Check for fifth argument
;
80$: CMPW PARMS(A3), #N..ARG ; Are the 5 arguments?
BNE CLRIMP ; No..then don't check it.
CMPW TYPE.5(A3), #XC$BIN ; Is it binary?
BEQ 90$ ; Yes.. check it's size.
CALL ERORIN ; Set up error reporting.
TYPE <Fifth argument must be binary>
JMP INDIR ; Sleep and return to BASIC.
; Check size of fifth argument.
;
90$: CMP SIZE.5(A3), #1 ; Is it 1 byte?
BEQ CLRIMP ; Yes..process this subroutine.
CALL ERORIN ; No..set up error reporting.
TYPE <Fifth argument must be 1 byte>
JMP INDIR ; Sleep and return to BASIC.
PAGE
;****************
; CLRIMP *
;****************
; Description:
;
; Preclears impure memory area for this subroutine to use.
; Inits Device DDB.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D0, D6, D7, A0, A2 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
CLRIMP: CLEAR DH.PTN(A4), EX..SZ ; Preclear free memory we use.
; Set up maximum number of files we may process as output.
;
MOV SIZE.3(A3), D0 ; Get size of array string.
DIV D0, #L..STR ; Divide by individual size.
MOV D0, DH.AVL(A4) ; Store possible number of entries.
; Check status of fifth option.
MOV ADDR.5(A3), A1 ; Get address of argument.
MOVB @A1, DH.OPT(A4) ; Store value into option.
BEQ 10$ ; Bypass if value is 0.
CALL DOOPT ; Process if value is not 0.
; Save JOBTYP and set OCTAL for PPN output.
;
10$: JOBIDX ; Index this job.
MOVW JOBTYP(A6), DH.TYP(A4) ; Store JOBSTS.
ANDW #^C<J.HEX>, JOBTYP(A6) ; Set OCTAL.
; Preclear error flag in case subroutine is called multiple times in BASIC
; program.
;
MOV ADDR.4(A3), A6 ; Index error flag. [101]
MOVB #0, @A6 ; Preclear error flag.
; Set up disk DDB to read MFD's and UFD's.
;
LEA A0, MD.DDB(A4) ; Index disk DDB.
LEA A2, MD.BUF(A4) ; Index DDB I/O buffer.
MOV A2, D.BUF(A0) ; Set DDB buffer address.
CLR D6 ; Preclear extension.
MOVB #<D$INI!D$BYP!D$ERC>, D.FLG(A0) ; No error report, init.
MOV ADDR.1(A3), A2 ; Get disk Filespec address.
FSPEC @A0 ; Set up disk DDB.
; If no disk,drive, or PPN specification was made, we will use
; default disk, drive and PPN for processing.
;
JOBIDX ; Index this job.
CMPW D.DEV(A0), #0 ; Is Device set?
BNE 20$ ; Yes..check PPN.
MOVW JOBDEV(A6), D.DEV(A0) ; Set default device.
MOVW JOBDRV(A6), D.DRV(A0) ; Set default drive.
; Check for PPN.
;
20$: CMPW D.PPN(A0), #0 ; Is PPN set?
BNE 30$ ; Yes..set up reset of DDB.
MOVW JOBUSR(A6), D.PPN(A0) ; Set default PPN.
; Set up DDB for MFD read.
;
30$: LOOKUP @A0 ; Find device spec.
MOVB D.ERR(A0), D6 ; Set up error flag.
NEGB D6 ; Negate flag to get value.
CMPB D6, #D$EDNX ; Does device exist?
BNE SETPTN ; Yes..set up pattern to fine.
MOVB #DH$DEV, D6 ; No..set subroutine error.
JMP SETERR ; Set error flag, return to BASIC.
PAGE
;****************
; SETPTN *
;****************
; Description:
;
; Sets Pattern buffer to match with files found in UFD.
;
; Passed/dependencies:
;
; A0 => UFD DDB
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D0, D1, D6, D7, A1, A2, and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
SETPTN: MOV ADDR.2(A3), A1 ; Index filename specification.
MOV #S..FNM, D0 ; Set size of file name.
LEA A2, DH.PTN(A4) ; Index files to search for buffer.
CLR D1 ; Preclear counter.
; Check to see if filename was set on FSPEC.
; - NOTE - DIRHSH does have the capability of using DEVICE'SPEC to
; process a correct full file specification. What this means
; is that, if DEVICE'SPEC contains a full valid file
; specification (I.E. DSK0:FILE.EXT[100,100]) then DIRHSH
; will bypass looking to FILE'SPEC for the file to look for.
; This will speed up the operation for those that want to
; hash one file at a time and not use wildcarding.
;
CMPW D.FIL(A0), #0 ; Is filename set?
BEQ 10$ ; No..setup wildcard name to match.
PUSH A1 ; Save command line pointer.
LEA A1, D.FIL(A0) ; Index DDB filename.
UNPACK ; Setup ascii filename.
UNPACK ; Setup ascii filename.
POP A1 ; Restore command line pointer.
; Check to see if file extension was set on FSPEC. If not then it must
; have been a wildcard spec.
;
CMPW D.EXT(A0), #0 ; Is file extension set?
BEQ 50$ ; No..setup wildcard to match with.
PUSH A1 ; Save command line pointer.
LEA A1, D.EXT(A0) ; Index filename extension.
UNPACK ; Setup ascii file extension.
POP A1 ; Restore command line pointer.
JMP MFD.READ ; Read MFD.
; Set up FILE'SPEC to look for. Be it full or be it wildcard.
;
10$: TSTB @A1 ; End of string?
BEQ 20$ ; Yes..fill out file name length.
CMPB @A1, #$DOT ; Short file name?
BEQ 20$ ; Yes..fill out file name length.
MOVB (A1)+, D1 ; No...set up character.
UCS ; Upper case character.
MOVB D1, (A2)+ ; Store in match buffer.
SOB D0, 10$ ; Do another character.
BR 30$ ; Process file extension.
; File name was less than 6 characters so the match buffer will be
; filled with spaces to a length of 6 spaces.
;
20$: MOVB #$SPACE, (A2)+ ; Set space into match buffer.
SOB D0, 20$ ; Do until end of file name length.
; Do file extension.
;
30$: MOV #S..EXT, D0 ; Set size of file extension.
TSTB @A1 ; Is there a file extension?
BNE 40$ ; Yes..check for valid file ext.
MOVB #$STAR, (A2)+ ; No..but must be wildcard.
BR 70$ ; Fill out extension.
; At this point there must be a valid extension seperator, the "."
;
40$: CMPB (A1)+, #$DOT ; Is this a dot?
JNE BASIC ; No..must be bad file extension.
50$: MOV #S..EXT, D0 ; Set size of file extension.
60$: TSTB @A1 ; End of file extension?
BEQ 70$ ; Yes...fill with spaces.
MOVB (A1)+, D1 ; Set up character.
UCS ; Upper case character.
MOVB D1, (A2)+ ; Store character into match buffer.
SOB D0, 60$ ; Do entire file extension length.
70$: TST D0 ; Should we fill area with spaces?
BEQ MFD.READ ; No..process.
80$: MOVB #$SPACE, (A2)+ ; Fill match buffer with space.
SOB D0, 80$ ; Do entire length of file ext.
PAGE
;****************
; MFD.READ *
;****************
; Description:
;
; Finds the device MFD as indicated in device DDB.
; Uses AMOS library call $FNPPN.
;
; Passed/dependencies:
;
; D1 := PPN to look for
; A2 => UFD DDB.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; A2 => Found PPN
; D0 =: $FNPPN results - 0 all OK
;
; D0, D6, A1, A2 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
MFD.READ:
DIRACC MD.DDB(A4), #DA$INI ; Get access to directory.
MOVW D.PPN(A0), MD.DDB+D.FIL(A4) ; Set PPN to Find.
DIRSCH MD.DDB(A4), #DS$DIR!DS$CMP ; Search directory.
TSTW D6 ; Yes..set up UFD.
BPL 10$
MOVB #DH$PPN, D6 ; Set no PPN error.
JMP SETERR ; Set error, return to BASIC.
; Correct MFD was found. Check for any UFD's.
;
10$: DIRACC MD.DDB(A4), #DA$NEW!DA$LVL ; Drop to next level.
MOV ADDR.3(A3), A2 ; Index XCALL return array.
; Init INput DDB.
;
LEA A6, IN.BUF(A4) ; Index file I/O buffer.
MOV A6, D.BUF+IN.DDB(A4) ; Set buffer into DDB.
; Manually init the DDB, bypass errors, no error reporting.
;
MOVB #<D$INI!D$BYP!D$ERC>, D.FLG+IN.DDB(A4) ; No report error.
MOVW MD.DDB+D.DEV(A4),IN.DDB+D.DEV(A4) ; Set Disk.
MOVW MD.DDB+D.DRV(A4),IN.DDB+D.DRV(A4) ; Set drive number.
MOVW MD.DDB+D.PPN(A4),IN.DDB+D.PPN(A4) ; Set PPN.
PAGE
;****************
; UFD.READ *
;****************
; Description:
;
; Reads the UFD block that was previously set up.
;
; Passed/dependencies:
;
; D0 =: Block number to READ.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; Aborts on ^C.
;
; D0 =: Number of UFD's per block. (must preserve).
; A1 => Buffer of UFD's past UFD link word.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
UFD.READ:
PAGE
;****************
; UFD.LOOP *
;****************
; Description:
;
; Loops through the UFD storing the ASCII filename and extension
; of valid files in a buffer to compare with the requested filename
; and extension later. Also sets up the Input DDB with filename
; and extension to process the AMOS $HSHFL to hash the file later
; on.
;
; Passed/dependencies:
;
; A1 => Indexes current UFD filename.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; Aborts on ^C.
;
; D1 =: Number of characters in file name.
; A0 => Indexes Pattern to Match.
; A1 => Indexes next UFD. (must preserve)
; A2 => Indexes UFD ASCII filename extension.
;
; D6 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
UFD.LOOP:
CTRLC ABORT ; Abort on ^C.
DIRSCH MD.DDB(A4), #DS$DAT ; Get next filename.
TSTW D6 ; End of directory?
JMI BASIC ; Yes..return to BASIC
; Set up DDB with filename and extension from the UFD.
;
MOVW MD.DDB+D.DEV(A4), IN.DDB+D.DEV(A4)
MOVW MD.DDB+D.DRV(A4), IN.DDB+D.DRV(A4)
MOV MD.DDB+D.FIL(A4), IN.DDB+D.FIL(A4)
MOVW MD.DDB+D.EXT(A4), IN.DDB+D.EXT(A4)
MOVW MD.DDB+D.PPN(A4), IN.DDB+D.PPN(A4)
PUSH A2 ; Save Array address.
PUSH A1 ; Save next UFD entry.
; Output RAD50 filename to ASCII filename to match with pattern.
;
LEA A1, IN.DDB+D.FIL(A4) ; Index input filename.
LEA A2, DH.MCH(A4) ; Index new file name buffer.
; Unpack here rather than use OFILE as to properly space filename to
; match with selection.
;
UNPACK ; First 3 ascii characters.
UNPACK ; Second 3 ascii characters.
UNPACK ; File extension.
POP A1 ; Restore next UFD address.
CMPB DH.PTN(A4), #$SPACE ; Is pattern empty?
BEQ OK ; Yes..default is match all.
LEA A2, DH.MCH(A4) ; Index new filename.
LEA A0, DH.PTN(A4) ; Index string to match with.
MOV #S..FNM, D1 ; Set up size of file name.
PAGE
;****************
; F.LOOP *
;****************
; Description:
;
; Compares the requested files to find, with the filename,
; extension in the ASCII buffer of what was in the UFD.
;
; Passed/dependencies:
;
; D1 =: Number of characters in File Name.
; A0 => Command line pattern to match.
; A2 => ASCII buffer of UFD filename and extension.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D1, A0 and A2 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
F.LOOP:
CMPB @A0, #$QUEST ; Is pattern a wildcard?
BEQ 10$ ; Yes..must match, bump to next.
CMPB @A0, #$STAR ; Is pattern a global wildcard?
BEQ 20$ ; Yes..matches all, do extension.
CMMB @A2, @A0 ; Do characters match?
JNE BLANKS ; No..does not match, do next.
; A character match was found, bump to next character and check it.
;
10$: INC A2 ; Bump to next character.
INC A0 ; Bump to next pattern character.
SOB D1, F.LOOP ; Process entire file name.
; File name matches. Set up to check extension.
;
20$: ADD D1, A2 ; Bump to extension on global match.
ADD D1, A0 ; Bump to pattern extension.
MOV #S..EXT, D1 ; Set size of file extension.
; Check file extension for match.
;
30$: CMPB @A0, #$QUEST ; Is pattern a wildcard character?
BEQ 40$ ; Yes..always matches, get next.
CMPB @A0, #$STAR ; Is pattern a global wildcard?
BEQ OK ; Yes..matches all, absolute match.
CMMB @A2, @A0 ; Do characters match?
JNE BLANKS ; No..process next file in UFD.
; Characters match. Bump to next character.
;
40$: INC A2 ; Yes..bump to next character.
INC A0 ; Bump to next pattern character.
SOB D1, 30$ ; Process entire file extension.
PAGE
;****************
; OK *
;****************
; Description:
;
; Finds file on Disk, outputs Device, drive, file name, extension,
; PPN, Version number if there is one, and file Hash total, using
; AMOS $HSHFL library call.
;
; Passed/dependencies:
;
; D0 =: Current UFD count. (must preserve)
; A1 => Indexes current UFD location in buffer.(must preserve)
; A2 => Indexes current buffer location to output Filespec.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; A2 => Location for next filename output.
;
; D1, D6 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
OK: CLR D.DVR+IN.DDB(A4) ; PreClear driver address.
POP A2 ; Restore array index.
CMM DH.AVL(A4), DH.CNT(A4) ; Is available array used up?
BNE 10$ ; No..set this file.
MOVB #DH$ARY, D6 ; Yes.. preset error.
JMP SETERR ; Set error flag.
10$: PUSH A2 ; Save array index.
MOV #L..STR, D1 ; Set length of array string.
; Output buffer string is precleared to space so that output is
; consistant.
;
20$: MOVB #$SPACE, (A2)+ ; Set space into string.
SOB D1, 20$ ; Do entire length of string.
POP A2 ; Restore string index.
PUSH A2 ; Save current array index.
; Find the file that we requested.
;
CLR D.DVR+IN.DDB(A4) ; Preclear driver address.
LOOKUP IN.DDB(A4) ; Is file there?
JNE BLANKS ; No..get next file.
; If file is random don't bother to hash.
;
TSTW IN.DDB+D.LSZ+2(A4) ; Is this a random file.
JMI 50$ ; Yes..don't find version.
; Here we read the first block of the file, offset the sequential file
; link by one word and check to see if the data there is compatible to
; a PHDR value.
;
READ IN.DDB(A4) ; Read first block of file.
PUSH A1 ; Save pointer.
MOV D.BUF+IN.DDB(A4), A1 ; Index buffer.
CMPW 2+PH.FLG(A1), #-1 ; Is this a valid header?
JEQ 30$ ; Yes..then get version.
CMPW 2+PH.FLG(A1), #-2 ; Is this a valid header?
JNE 40$ ; No..then don't look for version.
; Set location of version output.
;
30$: ADD #L..VER-1, A2 ; Set version output location.
VCVT 2+PH.VER(A1), OT$MEM ; Output version number.
40$: POP A1 ; Restore pointer.
; Output filespec to Array buffer.
;
50$: POP A2 ; Restore pointer
PUSH A2 ; Save pointer.
; Use OFILE to output device, drive, filename, and extension. Manually
; set PPN as OFILE does not appear to output PPN if it is the defaul
t
; PPN. Thus we will output the PPN manually.
;
OFILE IN.DDB(A4),OT$MEM!OT$OFD!OT$OFN ; Output filespec.
MOVB #$LBRAK, (A2)+ ; Output bracket.
MOVB D.PPN+IN.DDB+1(A4), D1 ; Set up project number.
OCVT 0,OT$MEM ; Output project number.
MOVB #$COMMA, (A2)+ ; Output seperator.
MOVB D.PPN+IN.DDB(A4), D1 ; Set up programmer number.
OCVT 0,OT$MEM ; Output programmer number.
MOVB #$RBRAK, (A2)+ ; Output bracket.
POP A2 ; Restore array current index.
PUSH A2 ; Save array current index.
; Hash output is directed to a memory location by setting D6 flag.
;
ADD #L..HSH-1, A2 ; Offset hash output location.
MOV A2, A6 ; Index location to output hash.
LEA A2, IN.DDB(A4) ; Index to DDB to Hash.
PUSH D0 ; Save UFD file count.
MOV #OT$MEM,D6 ; Set up flags.
CALL $HSHFL ; Do hash AMOS style.
MOV D0,D6 ; Save results.
POP D0 ; Restore UFD file count.
POP A2 ; Restore array pointer.
ADD #L..STR, A2 ; Bump to next possible entry.
ADD #1, DH.CNT(A4) ; Bump found file count.
BR UFD.END ; Do another.
PAGE
;****************
; BLANKS *
;****************
; Description:
;
; Restores output buffer pointer, in case error was found
; during output of current file information.
;
; Passed/dependencies:
;
; None.
;
; Returned/Side effects:
;
; A2 restored to top of previous entry.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
BLANKS:
POP A2 ; Restore array current index.
BR UFD.END ; Process next file in UFD.
PAGE
;****************
; UFD.SKIP *
;****************
; Description:
;
; Skips current UFD entry.
;
; Passed/dependencies:
;
; A1 => Current UFD entry.
;
; Returned/Side effects:
;
; A1 => Next UFD entry.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
UFD.SKIP:
ADD #UF.SIZ, A1 ; Skip entire UFD entry.
PAGE
;****************
; UFD.END *
;****************
; Description:
;
; Checks for end of UFD. Sets up next UFD if not at end or if
; there are not any more.
;
; Passed/dependencies:
;
; D0 =: Current UFD count in this block.
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D0 is decremented if not at end of UFD.
; D0 contains next UFD link if through with this UFD block.
; A1 indexes beginning of UFD buffer to find next UFD link
; if through with this UFD block.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
UFD.END:
JMP UFD.READ ; Process next UFD.
PAGE
;****************
; ERORIN *
;****************
; Description:
;
; Sets up terminal's last row, reports error with program name,
; and returns to caller.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D1 and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
ERORIN: TRMCHR TRMCAP(A4),0 ; Get terminal characteristics.
MOVW TRMCAP+TC.ROW(A4), D1 ; Get last row.
LSLW D1, #8. ; Set up last row.
MOVB #1, D1 ; Set up first column.
TCRT ; Set cursor position.
PRTTAB -1, 9. ; Clear line.
PRTTAB -1, 11. ; Dim.
TYPE <%Error in > ;
PRTTAB -1, 12. ; Bright.
TYPE <DIRHSH.SBR > ;
PRTTAB -1, 11. ; Dim.
TYPE <- > ;
PRTTAB -1, 12. ; Bright for error.
RTN ; Return
PAGE
;****************
; ABORT *
;****************
; Description:
;
; Sets control C error flag into D6.
;
; Passed/dependencies:
;
; None
;
; Returned/Side effects:
;
; D6 is destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
ABORT: MOVB #DH$CTC, D6 ; Set control C error.
PAGE
;****************
; SETERR *
;****************
; Description:
;
; Sets error flag into 4th argument. (binary)
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; A6 is destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
SETERR: MOV ADDR.4(A3), A6 ; Index xcall error flag.
MOVB D6, @A6 ; Set error code.
JMP BASIC ; Return to BASIC.
PAGE
;****************
; BADSTR *
;****************
; Description:
;
; Report argument must be a string.
;
; Passed/dependencies:
;
; None
;
; Returned/Side effects:
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
BADSTR: TYPE <argument must be a string>
BR INDIR
PAGE
;****************
; BADIO *
;****************
; Description:
;
; A read error has happened during processing.
; Set miscellaneous error and return to BASIC.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; Reports error on terminal
;
BADIO:
CALL ERORIN
TYPE <MFD or UFD >
PAGE
;****************
; INDIR *
;****************
; Description:
;
; Output subroutine name to terminal, ring bell, and sleep,
; while user sees reported error, sets error flag to DH$SBR
; which is a subroutine error flag.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; D1, D7, and A6 are destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
INDIR: PRTTAB -1, 11. ; Dim.
TYPE <.> ;
PRTTAB -1, 12. ; Bright.
TTYI ; Ring bell.
BYTE 7,0 ;
EVEN ; Even up assembly.
SLEEP #30000. ; Wait 3 seconds.
MOV ADDR.4(A3), A6 ; Index xcall error flag.
MOVB #DH$SBR, @A6 ; Set error code.
RTN ; Return to BASIC.
PAGE
;****************
; DOOPT *
;****************
; Description:
;
; Processes the ARRAY characteristics option. This routine will
; do nothing if DH.OPT is not valid, Preclear ARRAY to nulls if
; DH.OPT is set to DH$CLR, or set up new address of ADDR.3 if
; DH.OPT is set to DH$APN which is append new data.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
DOOPT: SAVE D1, A0 ; Save registers.
MOV ADDR.3(A3), A0 ; Get address of array.
MOV SIZE.3(A3), D1 ; Get size of array
CMPB DH.OPT(A4), #OP$CLR ; Is this "clear array" option?
BEQ 50$ ; Yes..clear the array.
CMPB DH.OPT(A4), #OP$APN ; Is this "append array" option?
BNE 99$ ; No..must be bad option,return.
CLR D1 ; Yes..preclear counter.
; Here we check array for append mode. Since array output is standard,
; we check for a valid end of previous or first call by checking for
; a space character or null at the top of each valid entry location.
; That being the starting address of the array + L..STR, which will
; index the next possible entry location.
;
10$: CMPB @A0, #$SPACE ; Do we have a space?
BEQ 30$ ; Yes..must be empty entry.
CMPB @A0, #0 ; Do we have a null?
BEQ 30$ ; Yes..must be empty entry.
ADD #1, D1 ; No..bump entry count.
CMM DH.AVL(A4), D1 ; End of available entries?
BEQ 30$ ; Yes..set accordingly.
ADD #L..STR, A0 ; No..bump address to next entry.
BR 10$ ; Try next entry.
; Here we set the new address of the next empty entry location so that
; the subroutine may process the same if there are any new entry locations
; or not. DH.CNT is set up to reflect those entries already used.
;
30$: MOV A0, ADDR.3(A3) ; Set new address of empty entry.
MOV D1, DH.CNT(A4) ; Set used count.
BR 99$ ; Return correctly.
; This routine will preclear the entire ARRAY to nulls as requested
; by the OP$CLR option that has been recognized.
;
50$: MOVB #0, (A0)+ ; Clear character.
SOB D1, 50$ ; For all characters.
99$: REST D1, A0 ; Restore registers.
RTN ; Return to caller.
PAGE
;****************
; BASIC *
;****************
; Description:
;
; Reset JOBTYP, Preclear any pending ^C's, and return back
; to BASIC program.
;
; Passed/dependencies:
;
; A3 => XCALL parameter list.
; A4 => Base of free memory.
;
; Returned/Side effects:
;
; Exit subroutine, return to BASIC.
; JOBSTS is reset.
;
; A6 is destroyed.
;
; All other standard (A0-A5,D0-D5) registers are preserved.
;
BASIC: JOBIDX ; Index this job.
ANDW #^C<J.CCC>, JOBSTS(A6) ; Clear any pending ^C's
MOVW DH.TYP(A4), JOBTYP(A6) ; Reset original JOBTYP.
RTN ; Return to BASIC.
EVEN ; Even up assembly.
END ; End of program.
