;BLKALC.LIT
;
;
;4/25/84 STEVEN G. MCNAUGHTON & RICH EAKIN
; QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
;
; ***********************************************************************
; * *
; * FORMAT FOR USE IS BLKALC <DEVn:> BLOCK</P:[nnn,nn]> *
; * *
; * If device is left off the user's default device is used. *
; * *
; * Block number is the octal (or Hex) block to be searched for. *
; * If job type is SET HEX all numbers begining with a character *
; * A - F must be proceeded with a zero (0). *
; * *
; * /P:[nnn,nn] option confines search to a specific account. *
; * The brackets are optional. *
; * *
; ***********************************************************************
; ***********************************************************************
; * *
; * NOTE- THE MFD STORAGE AREA WILL HOLD UP TO 6 "COMPRESSED" MFD BLKS *
; * (EACH MFD IS STORED AS THE PPN AND POINTER, THE PASSWORD *
; * IS NOT STORED. THUS THE "COMPRESSED" TITLE.) *
; * *
; ***********************************************************************
; ***********************************************************************
; * *
; * EDIT AND DEVELOPMENT HISTORY *
; * *
; ***********************************************************************
; * *
; * 100. - BASIC SCAN PROGRAM [SGM] *
; * 101. - INPUT TO PROGRAM ONLY ON COMMAND LINE [SGM] *
; * 102. - OUTPUT PPN AS OCTAL NUMBER REGARDLESS OF JOBTYP [SGM] *
; * 103. - ADDED PPN SWITCH OPTION [SGM] *
; * 104. - CORRECTED BLOCK NUMBER IN BOUNDS CHECK FOR DEVICES WITH *
; * OVER 32K BYTES PER DISK. [SGM] 5/18/84 *
; * *
; ***********************************************************************
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV
OFINI
OFDEF DDB,D.DDB ;DUMMY FILE DDB
OFSIZ IMPSIZ
VMAJOR=1. ;VERSION NUBMER
VMINOR=1.
VSUB=1.
VEDIT=104.
HEADER:
PHDR -1,PV$RSM!PV$WSM,PH$REE!PH$REU
TOP:
GETIMP IMPSIZ,A5,EXIT ;GET SOME IMPURE SPACE
JOBIDX A3
MOVW 2(A3),D1
LEA A1,STATUS ;STORE THE JOBTYP
MOVW D1,(A1)
ANDW #20,D1 ;IS J.HEX SET?
BEQ RESPRG ;NOPE IN OCTAL
MOVW #1,D5 ;QUICK STORAGE FOR J.HEX SET
RESPRG: MOV A2,D2
LEA A3,ASCBUF ;A3 POINTS TO ASCII BUFFER SPACE
BYP ;BYPASS ANY BLANKS ON COMMAND LINE
LIN ;END OF LINE?
JEQ CERROR
NUMCHK:
NUM ;IS THE FIRST CHAR NUMERIC?
JEQ INPBLK ;YES ! GET THE BLOCK NUMBER
INLINE: ;NO ! GET THE DEVICE AND DRIVE INFO NOW
MOVB (A2)+,(A3)+ ;FIRST BYTE ON COMMAND LINE TO ASCII BUFFER
MOVB (A2)+,(A3)+ ;SECOND BYTE ON COMMAND LINE
MOVB (A2)+,(A3) ;THIRD BYTE ON COMMAND LINE
LEA A3,INDRV ;LOAD THE DRIVE STORAGE AREA
MOVB (A2)+,(A3)+ ;FOURTH BYTE ON COMMAND LINE TO DRIVE
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ CERROR ;*ERROR* WHERE'S THE COLON?
MOVB (A2),D1 ;CHECK THE COMMAND LINE FOR A COLON
CMPB D1,#': ;IS IT A COLON (END OF DEV AND DRV)
JEQ PCKIT ;YES ! GO PACK THE DEVICE NAME
MOVB (A2)+,(A3) ;GET FINAL CHARACTER OF DRIVE #
MOVB (A2),D1 ;TEST THE NEXT BYTE ON THE COMMAND LINE
CMPB D1,#': ;IS IT A COLON?
JEQ PCKIT ;YES - GO PACK THE DEV AND DRV
;*ERROR* DEV AND DRV MUST END IN COLON
SUB #2,A2
JMP CERROR
PCKIT:
ADD #1,A2 ;MOVE TO NEXT BYTE ON COMMAND LINE
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ CERROR
NUM2:
NUM ;IS THIS CHARACTER NUMERIC?
JNE CERROR ;*ERROR* - THIS MUST BE A NUMBER!
CLR D1 ;CLEAR OUT ANY JUNK
GTOCT ;GET AN OCTAL NUMBER FROM THE COMMAND LINE
LEA A3,BLOCK ;STORE THAT OCTAL NUMBER IN THE BLOCK
MOVW D1,(A3) ; TO BE SEARCHED AREA
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ GOPCK
SWTCHK: CMPB (A2),#'/ ;IS IT A SLASH
JNE CERROR
ADD #1,A2
CMPB (A2),#'P ;IS IT A "P"
JNE CERROR
ADD #1,A2
CMPB (A2),#': ;IS IT A COLON
JNE CERROR
ADD #1,A2
CMPB (A2),#'[ ;IS THERE A [
BNE PPNALC
ADD #1,A2
PPNALC:
TSTW D5
BEQ OCTPPN
HEXPPN:
LEA A3,STATUS
MOVW (A3),D1
JOBIDX A3
LEA A0,2(A3)
ANDW #2757,D1 ;MASK OFF J.HEX BIT
MOVW D1,(A0)
OCTPPN:
LEA A3,PPN1
CLR D3
MOVW #3,D3 ;P1 TALLY (MAX 3 CHARS)
PPNLP: BYP
NUM
JNE CERROR
MOVB (A2)+,(A3)+
BYP
CLRW D1
MOVB (A2),D1
CMPB D1,#', ;GOT A COMMA YET?
BNE TALCHK
ADD #1,A2
BR CVRTP1
TALCHK:
SUBW #1,D3
TSTW D3
BNE PPNLP
ADD #1,A2
CVRTP1: MOVB #'X,(A3)
PPNAL2:
LEA A3,PPN2
MOVW #2,D1 ;P2 TALLY (MAX 2 CHARS)
PPNLP2:
CLRW D1
CLR D3
BYP
NUM
JNE CERROR
MOVB (A2)+,(A3)+
BYP
LIN
BEQ CVRTP2
MOVB (A2),D3
CMPB D3,#']
BEQ CVRTP2
SUBW #1,D1
TSTW D1 ;TWO CHARS YET?
BNE PPNLP2
CVRTP2:
MOVB #'X,(A3)
CLR D1
CLR D2
LEA A3,SPPN
LEA A2,PPN1
GTOCT
MOVB D1,D3
LSLW D3,#10
LEA A2,PPN2
GTOCT
MOVB D1,D3
MOVW D3,(A3) ;STORE THE SEARCH PPN NUMBER
LEA A3,PPNFLG
MOVW #1,(A3)
RESTYP:
TSTW D5
BEQ GOPCK
LEA A3,STATUS
CLR D1
MOVW (A3),D1
JOBIDX A3
LEA A2,2(A3)
MOVW D1,(A2)
LEA A3,DEFFLG
MOVW (A3),D1
CMPW D1,#1
JEQ INITDB
GOPCK:
CLR D1 ;CLEAR OUT ANY JUNK
LEA A2,ASCBUF ;A2 MUST POINT TO ASCII CHARACTERS
LEA A1,INDEV ;PACK AND STORE THE DEVICE NAME
PACK ;
LEA A2,INDRV ;GET THE INPUTED DRIVE NUMBER
GTDEC ;MAKE SURE ITS DECIMAL
LEA A2,INDRV ;PUT IT BACK INTO DRIVE # STORAGE
MOVW D1,(A2)
JMP INITDB ;
INPBLK:
CLR D1 ;GET THE BLOCK - DSK MUST HAVE BEEN
GTOCT ;DEFAULTED TO GET HERE!
LEA A3,BLOCK ;STORE THE BLOCK NUMBER
MOVW D1,(A3)
DEFAUL:
LEA A3,DEFFLG
MOVW #1,(A3)
LEA A3,INDEV ;DEVICE DEFAULT AREA
MOVW #0,(A3) ;MOVE A ZERO FOR DEVICE NAME (FOR IDDB)
LEA A3,INDRV ;MOVE A -1 FOR DRIVE NUMBER (FOR IDDB)
MOVW #-1,(A3)
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JNE SWTCHK
INITDB: ;SET UP AND INIT A DUMMY DDB
MOVW #177400,D1 ;CLEAR THE SCREEN
TCRT
CLR D1
LEA A2,SCRAT ;LOAD A DUMMY FILESPEC IN
MOV A2,D0
MOVW #377,(A2)+
MOVW #377,(A2)+
MOVW #377,(A2)
MOV D0,A2
FSPEC (A5) ;PROCESS THE FILESPEC (POINTED BY A2)
LEA A3,D.DEV(A5) ;PUT THE PROPER DEVICE NAME IN
LEA A2,INDEV
MOVW (A2),(A3)
LEA A3,D.DRV(A5) ;PUT THE PROPER DRIVE NUMBER IN
LEA A2,INDRV
MOVW (A2),(A3)
INIT (A5) ;INITIALIZE THE DDB
CTRLC EXIT
CLR D1
TYPESP <Block allocation search has been initiated on:>
LEA A3,D.DEV(A5) ;GET THE DDB'S DEVICE NAME
MOVW (A3),D1 ;MOVE THE PACKED WORD TO D1
TST D1 ;IS IT A ZERO?
BNE UNPCK ;NOPE - GO UNPACK THE WORD
JOBIDX A3 ;DEFAULT DEVICE - DETERMINE LOG IN
LEA A2,JBDEV ; STATUS AND TYPE IT OUT
CLR D1
MOVW JOBDEV(A3),D1 ;GET THE PACKED DEVICE NAME
LEA A1,SCRAT ; AND UNPACK IT
MOVW D1,(A1)
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
TTYL (A2) ;PRINT THE DEFAULT DEVICE NAME
CLR D1
MOVW JOBDRV(A3),D1 ;GET THE DEFAULT DRIVE NUMBER
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CRLF
CLR D1
JMP PUTBLK
UNPCK:
LEA A1,INDEV ;GET AND UNPACK THE DEVICE NAME
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
MOVB (A2)+,D1 ;PRINT THE DEVICE NAME
TTY
MOVB (A2)+,D1
TTY
MOVB (A2)+,D1
TTY
LEA A2,INDRV ;GET THE DRIVE NUMBER
CLR D1
MOVB (A2),D1
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CRLF
CLR D1
PUTBLK:
TYPESP <Block number to be searched:>
CLR D1
LEA A1,BLOCK ;GET THE BLOCK NUMBER
MOVW (A1),D1
OCVT 0,OT$TRM ;CONVERT TO OCTAL AND TYPE IT
CRLF
CTRLC EXIT
GETMFD:
CLR D1
MOV DDB+D.DVR(A5),A3 ;GET THE DISK DRIVER ADDRESS
MOV 24(A3),D2 ;GET THE TOTAL NUMBER OF BLOCKS/DISK
SUB #1,D2 ;SUB 1 - BECAUSE ZERO IS BLOCK #1
LEA A3,BLOCK ;GET THE INPUTED BLOCK NUMBER
MOVW (A3),D1
; TSTW D1 [104]
; BMI NEGERR [104]
CMP D1,D2 ;IS THE INPUTED BLOCK LESS THAN BLOCK [104]
BLOS BITNUM ; PER DISK? [104]
BIGERR: TYPECR <?Block number specified is too large for this device>
JMP EXIT
; NEGERR: TYPECR <?Block number specified is a negative octal number> [104]
; JMP EXIT [104]
BITNUM: DIV D2,#4096. ;DIVIDE BY NUMBER OF BITS PER BLOCK
CLR D0
MOVW D2,D0 ;MOVE THE QUOTIENT TO D0
ROR D2,#10
ROR D2,#10
CMPW D2,#0 ;DO WE HAVE A PARTIAL BLOCK?
BEQ ZCHK ;NO - START BLOCK CHECKING
ADDW #1,D0 ;YES - ADD 1 TO BITMAP BLOCK AREA
ZCHK:
TST D1
BNE OCHK
TYPECR <Block zero is the device label block>
JMP EXIT
OCHK:
CMPW D1,#1 ;IS IT BLOCK ONE?
BNE TCHK ;NOPE - GO ON
TYPECR <Block one is always the first MFD block>
JMP EXIT
TCHK:
CMPW D1,#2 ;IS IT BLOCK TWO?
BNE BITCHK ;NOPE - CHECK THE BITMAP NOW
TYPECR <Block two is always the first BITMAP block>
JMP EXIT
BITCHK:
ADDW #1,D0
CMPW D1,D0 ;IS IT IN RANGE OF BITMAP?
BHI GOMFD ;NOPE - IT IS A VALID BLOCK NUMBER [104]
TYPECR <Block specified is contained in the BITMAP>
JMP EXIT
GOMFD:
LEA A3,PPNFLG
CLR D2
MOVW (A3),D2
TSTW D2
JEQ NORPTH
SWTAGN:
MOV #1,D1
SWTPTH:
LEA A3,SPPN
MOVW (A3),D2
LEA A1,D.REC(A5) ;LOAD BLOCK #1(MFD)
MOV D1,(A1)
CLR D1
READ @A5 ;READ THE BLOCK
MOV D.BUF(A5),A1 ;ADDRESS THE READ BUFFER AREA
CTRLC EXIT
SWTMOV:
MOVW (A1),D1 ;TEST WORD TO SEE IF DONE WITH THIS
TSTW D1 ; MFD BLOCK, (ZERO PPN HOLE)
BEQ SWTDUN
MOVW (A1)+,D1 ;GET THE PPN
CMPW D1,D2 ;IS IT THE TARGET PPN
BEQ SWTHIT
ADD #6,A1
CTRLC EXIT
BR SWTMOV ;LOOP AND GET THE NEXT ENTRY IN THE MFD
SWTDUN:
MOV D.BUF(A5),A1
MOVW 772(A1),D1
TSTW D1
BEQ NFIMFD
JMP SWTPTH
NFIMFD:
CRLF
TYPECR <? PPN specified does not exist.>
JMP EXIT
SWTHIT:
MOVW (A1),D3 ;D3 HOLDS UFD BLOCK#
LEA A3,BLOCK
MOVW (A3),D2 ;D2 HOLDS TARGET BLOCK#
LEA A3,SPPN
MOVW (A3),D4 ;D4 HOLDS PPN#
TYPECR <PPN option has been specified for account:>
JMP CHKUFD
NORPTH: LEA A1,D.REC(A5) ;LOAD BLOCK #1(MFD)
MOV #1,(A1)
READ @A5 ;READ THE BLOCK
LEA A3,MFD ;ADDRESS THE MFD STORAGE AREA
MOV D.BUF(A5),A1 ;ADDRESS THE READ BUFFER AREA
CTRLC EXIT
MFDMOV:
MOVW (A1),D1 ;TEST WORD TO SEE IF DONE WITH THIS
TST D1 ; MFD BLOCK, (ZERO PPN HOLE)
BEQ MFDPGE
MOVW (A1)+,(A3)+ ;MOVE THE PPN INTO STORAGE
MOVW (A1)+,(A3)+ ;MOVE THE BLOCK POINTER
MOVW (A1)+,D1 ;CYCLE PAST THE PASSWORD (TO SAVE SPACE)
MOVW (A1)+,D1 ;CYCLE PAST THE PASSWORD
CLR D1 ;CLEAR OUT ANY JUNK
CTRLC EXIT
BR MFDMOV ;LOOP AND GET THE NEXT ENTRY IN THE MFD
MFDPGE:
MOV D.BUF(A5),A1
MOVW 772(A1),D1 ;CHECK IF MORE PAGES IN MFD
TST D1
BEQ MFDDUN ;NO MORE PAGES- GOT ALL THE MFD
CLR D2
LEA A0,BLOCK ;GET THE TARGET BLOCK
MOVW (A0),D2
CMPW D2,D1 ;IS THE NEXT MFD BLOCK THE TARGET?
CTRLC EXIT
JEQ MFDBLK ;YES! - GO TO FOUND IN MFD MESSAGE
LEA A1,D.REC(A5) ;NOT TARGET - MORE PAGES READ THE NEXT MFD BLOCK
MOV D1,(A1) ;LOAD THE NEXT BLOCK NUMBER
READ (A5) ;READ IT
MOV D.BUF(A5),A1 ;RESET I/O BUFFER POINTER - A1 POINTS TO MFD STORAGE
CTRLC EXIT
JMP MFDMOV ;LOOP UP AND STORE IT
MFDDUN:
LEA A1,MFD ;A1 POINTS THE MFD STORAGE
MFDLOP: CTRLC EXIT
CLR D1
CLR D2
CLR D3
CLR D4
MOVW (A1),D1 ;HAVE WE RUN EVERY MFD?
TST D1
JEQ NOTALC ;YES! - BLOCK MUST NOT HAVE BEEN ALLOCATED!
MOVW (A1)+,D4 ;D4 NOW HOLDS THE UFD PPN FOR EACH UFD SEARCH
MOVW (A1)+,D3 ;D3 NOW HOLDS THE UFD BLOCK NUMBER
LEA A3,CURMFD ;CURMFD NOW HOLDS THE NEXT UFD POINTER
MOV A1,(A3)
LEA A3,BLOCK ;GET THE INPUT BLOCK NUMBER
MOVW (A3),D2 ;D2 NOW HOLDS THE TARGET BLOCK
CMPW D3,D2 ;IS THIS THE BLOCK WE'RE SEARCHING FOR?
JEQ UFDBLK ;YES-PRINT THE FOUND IN MFD MESSAGE
TST D3
JNE CHKUFD ;IS THE BLOCK POINTER A ZERO?
LEA A3,CURMFD ;YES! - LOAD THE THE NEXT MFD ENTRY AND LOOP UP
MOV (A3),A1
JMP MFDLOP ;LOOP UP TO MFD CHECKS AGAIN
;NO - GET THE UFD AND CHECK IT
CHKUFD:
LEA A3,PPNSTO
MOVW (A3),D0
TSTW D0
BEQ PPNOUT
CMPW D4,D0
JEQ CHKCON
CTRLC EXIT
PPNOUT: TSTW D5
BEQ OCTUIT
HEXUIT:
LEA A3,STATUS
MOVW (A3),D1
JOBIDX A3
LEA A2,2(A3)
ANDW #2757,D1 ;MASK OFF J.HEX BIT
MOVW D1,(A2)
OCTUIT:
SAVE D2,D3,D4
TYPE <[>
CLR D2
CLR D0
CLR D1
MOVB D4,D0
ROR D4,#10
MOVB D4,D2
MOVB D2,D1
OCVT 0,OT$TRM
TYPE <,>
MOVB D0,D1
OCVT 0,OT$TRM
TYPECR <]>
CLR D1
CLR D2
CLR D0
JOBIDX A3
LEA A2,STATUS ;RESTORE JOBTYP
MOVW (A2),D1
LEA A2,2(A3)
MOVW D1,(A2)
REST D2,D3,D4
CHKCON:
LEA A3,PPNSTO
MOVW D4,(A3)
LEA A3,D.REC(A5) ;GET THE READ BLOCK HOLE
MOV D3,(A3) ;MOVE THE UFD POINTER IN
READ (A5) ;READ THE UFD BLOCK
MOV D.BUF(A5),A1 ;REPOSITION THE I/O BUFFER
LEA A3,UFD ;LOAD THE UFD STORAGE BUFFER
MOV #256.,D0 ;TALLY
LOOPER: MOVW (A1)+,(A3)+
SUB #1,D0
TST D0
BNE LOOPER
CLR D1
LEA A1,UFD
MOVW (A1),D1 ;MOVE THE LINK POINTER TO D1
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOV (A3),D2
CMP D1,D2 ;COMPARE THE LINK POINTER WITH THE TARGET
;THIS IS A TIME SAVER
JEQ UFDBLK ;IT'S THE TARGET ! GO TO FOUND IN UFD
;MESSAGE
TST D1 ;NOT THE TARGET - IS IT ZERO (NO LINK)
BNE UFDPGE ;
LEA A3,UFDLNK ;NO MORE BLOCKS IN UFD - MAKE SURE
;IT'S CLEAR
MOVW #0,(A3) ;CLEAR IT
CTRLC EXIT
BR UFDSCN ;IT'S CLEARED SO DO THE UFD SCAN
UFDPGE: LEA A3,UFDLNK ;STORE THE LINK TO THE NEXT BLOCK IN
;THE CURRENT UFD
MOVW (A1),(A3) ;SAVE THE LINK POINTER TO THE NEXT BLOCK
UFDSCN:
LEA A1,UFD
ADD #2,A1 ;GET PAST THE LINK POINTER
UFDLOP:
CTRLC EXIT
CLR D1
MOVW (A1),D1 ;TEST TO SEE IF WE ARE DONE WITH THIS
TST D1 ;UFD BLOCK
JNE UFDCON ;NO - CONTINUE WITH THIS UFD BLOCK
MOVW 2(A1),D1 ;TEST THE SECOND RAD 50 TRIPLET
TST D1 ;FILE NAME MAY ONLY BE 1 WORD LONG
JNE UFDCON
UFDTST:
LEA A3,UFDLNK ;GET THE UFDLNK
CLR D3
MOVW (A3),D3 ;PUT THE UFD LINK INTO D3
TST D3 ;ANYTHING THERE?
JNE CHKUFD ;YES - GO READ THE NEXT BLOCK AND CHECK IT
UFDDUN:
LEA A3,PPNFLG
CLR D1
MOVW (A3),D1
TSTW D1
BEQ CONNOR
NFIUFD:
CRLF
TYPECR <? Block number is not contained in the specified PPN.>
JMP EXIT
CONNOR:
; CRLF
LEA A3,CURMFD ;NOPE - LOAD THE THE NEXT MFD ENTRY AND LOOP UP
MOV (A3),A1
JMP MFDLOP ;LOOP UP TO MFD CHECKS AGAIN
UFDCON:
; TYPE <.>
CTRLC EXIT
LEA A3,CURUFD ;SAVE THE CURRENT LOCATION IN THE UFD
MOV A1,(A3)
CLR D1
MOVW (A1),D1
CMPW D1,#-1 ;IS THIS A :80 FILE? (FREE RECORD)
JEQ FILDUN ;YES ! - GO TO THE NEXT FILE
MOVW 2(A1),D1 ;BETTER CHECK THE SECOND HALF OF THE FILE NAME
CMPW D1,#-1
JEQ FILDUN
LEA A3,CURFIL ;STORE THE CURRENT FILE NAME(RAD 50)
MOVW (A1)+,(A3)+ ;STORE THE FIRST RAD CHAR
MOVW (A1)+,(A3)+ ;STORE THE SECOND RAD CHAR
MOVW (A1)+,(A3)+ ;STORE THE THIRD RAD CHAR
;A1 NOW POINTS TO THE SIZE OF THE FILE
SIZCHK: MOVW (A1)+,D3 ;MOVE THE FILSIZ TO D3
CMPW D3,#1 ;IS IT ONLY ONE BLOCK LONG?
JEQ FILCHK ;YES CHECK THE FILE POINTER ONLY
ACTCHK: ;A1 NOW POINTS TO THE ACTIVE STATUS WORD
MOVW (A1)+,D3 ;MOVE THE ACTIVE STATUS TO D3
CMPW D3,#-1 ;IS IT -1 (RANDOM FILE)
JEQ RNDCHK ;YES CHECK THE POINTER AND OFFSET ONLY
GETFIL:
CLR D2
CLR D1
CTRLC EXIT ;FILE IS MORE THAN ONE BLOCK LONG OR
;NOT A RANDOM FILE SO WE MUST TRACE IT
;A1 IS NOW POINTING TO THE LINK POINTER
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D2
MOVW (A1),D1 ;MOVE THE LINK POINTER TO D1
;THIS IS ANOTHER TIME SAVER
CMP D1,D2 ;IS THE POINTER THE TARGET BLOCK?
JEQ FILBLK ;YES ! - GO PRINT THE FOUND IN FILE
;MESSAGE
LEA A3,D.REC(A5) ;MOVE THE LINK POINTER TO THE READ BLOCK
MOV D1,(A3) ;FIRST BLOCK IS IN READ BLOCK AREA
FILRED:
READ (A5) ;READ THE FIRST BLOCK
FILSCN:
CLR D1
CLR D2
CTRLC EXIT
MOV D.BUF(A5),A3
MOVW (A3),D1 ;GET THE NEXT LINK POINTER
TST D1 ;ARE THERE MORE BLOCKS?
BEQ FILDUN ;NO MORE BLOCKS IN THIS FILE
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D2
CMPW D2,D1 ;IS THE LINK POINTER THE TARGET?
JEQ FILBLK ;YES ! - GO TO FOUND IN FILE MESSAGE
LEA A3,D.REC(A5) ;LOAD THE LINK INTO THE READ BUFFER
MOV D1,(A3)
JMP FILRED ;GO READ THE NEXT FILE BLOCK
FILDUN:
LEA A3,CURUFD
MOV (A3),A1
ADD #14,A1 ;NO MORE BLOCKS IN THIS FILE -
;UPDATE A1 TO THE NEXT UFD ENTRY AND LOOP
CTRLC EXIT
JM
P UFDLOP
FILCHK:
CTRLC EXIT ;CHECK HERE IF FILE ONLY ONE BLOCK LONG
;AT THIS POINT A1 POINTS AT ACTIVE STATUS
ADD #2,A1 ;UPDATE A1 TO THE LINK POINTER
LEA A3,BLOCK ;GET THE TARGET BLOCK
CLR D1
CLR D2
MOVW (A3),D1
MOVW (A1),D2 ;GET THE LINK POINTER
CMPW D1,D2 ;IS THE LINK AND TARGET THE SAME?
JEQ FILBLK ;YES ! - GO TO THE FOUND IN FILE
;MESSAGE
;NO- UPDATE A1 TO NEXT ENTRY IN UFD
LEA A3,CURUFD
MOV (A3),A1
ADD #14,A1
CTRLC EXIT
JMP UFDLOP ;
RNDCHK:
CTRLC EXIT ;CHECK HERE IF FILE IS A RANDOM
;A1 IS POINTING AT THE LINK POINTER
CLR D3
CLR D2
CLR D1
MOVW (A1),D1 ;GET THE LINK POINTER
MOVW -(A1),D2 ;BACK UP PAST THE ACTIVE WORD
MOVW -(A1),D2 ;D2 NOW HOLDS THE FILE SIZE
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D3
CMPW D3,D1 ;IS THE TARGET BLOCK HIGHER THAN THE LINK POINTER?
JEQ FILBLK ;THEY ARE THE SAME - GO TO FOUND IN
;FILE MESSAGE
JLO NOTHER ;TARGET BLOCK IS LESS THAN POINTER SO IT [104]
;CAN'T BE FROM THIS FILE
ADDW D2,D1 ;TARGET IS HIGHER - ADD SIZE TO LINK POINTER
;TO DETERMINE FILE WINDOW
CMPW D3,D1 ;IS THE TARGET BLOCK LESS THAN THE EOF?
JLOS FILBLK ;THEY ARE THE SAME -OR TARGET IS LESS [104]
;THAN EOF SO IT'S IN THIS FILE - GO TO
;FOUND IN FILE MESSAGE
NOTHER:
CTRLC EXIT ;BLOCK DOESN'T BELONG HERE SO UPDATE A1
;TO NEXT UFD ENTRY AND GO ON
LEA A3,CURUFD
MOV (A3),A1
ADD #14,A1 ;A1 NOW POINTS TO NEXT UFD ENTRY
JMP UFDLOP
MFDBLK:
CRLF
CTRLC EXIT ;COME HERE IF TARGET IS FOUND IN MFD
TYPESP <Block #>
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D1
OCVT 0,OT$TRM
TYPESP < >
TYPECR <has been found in the Master File Directory>
JMP EXIT
UFDBLK:
CRLF
CTRLC EXIT ;COME HERE IF TARGET IS FOUND IN UFD
TYPESP <Block #>
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D1
OCVT 0,OT$TRM
TYPESP < >
TYPESP <has been found in the User File Directory >
LEA A1,INDEV
CLR D1
MOVW (A1),D1
TST D1
BNE TYPDEV
JOBDEF: JOBIDX A3 ;DEFAULT DEVICE - DETERMINE LOG IN
LEA A2,JBDEV ; STATUS AND TYPE IT OUT
CLR D1
MOVW JOBDEV(A3),D1 ;GET THE PACKED DEVICE NAME
LEA A1,SCRAT ; AND UNPACK IT
MOVW D1,(A1)
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
TTYL (A2) ;PRINT THE DEFAULT DEVICE NAME
CLR D1
MOVW JOBDRV(A3),D1 ;GET THE DEFAULT DRIVE NUMBER
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CLR D1
BR TYPCON
TYPDEV: LEA A2,ASCBUF ;COME HERE AND UNPACK DEVICE NAME IF NOT
UNPACK ; RUNNING ON DEFAULT DEVICE
LEA A2,ASCBUF
MOVB (A2)+,D1
TTY
MOVB (A2)+,D1
TTY
MOVB (A2)+,D1
TTY
LEA A2,INDRV ;OUTPUT THE DRIVE NUMBER (NOT DEFAULT)
CLR D1
MOVW (A2),D1
DCVT 0,OT$TRM
CLRW D1
TYPCON:
TSTW D5
BEQ OCTSET
HEXSET:
LEA A3,STATUS
MOVW (A3),D1
JOBIDX A3
LEA A2,2(A3)
ANDW #2757,D1 ;MASK OFF J.HEX BIT
MOVW D1,(A2)
OCTSET:
MOVB #':,D1
TTY
MOVB #'[,D1
TTY
CLR D2
CLR D3
CLR D1
MOVB D4,D3 ;CONVERT AND OUTPUT THE PPN
ROR D4,#10
MOVB D4,D2
MOVB D2,D1
OCVT 0,OT$TRM
TYPE <,>
MOVB D3,D1
OCVT 0,OT$TRM
TYPECR <]>
JMP EXIT
FILBLK:
CRLF
CTRLC EXIT ;COME HERE IF TARGET IS FOUND IN A FILE
TYPESP <Block #>
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D1
OCVT 0,OT$TRM
TYPESP < >
TYPESP <has been found in File:>
LEA A1,INDEV ;GET DEVICE NAME
CLR D1
MOVW (A1),D1
TST D1 ;IS IT DEFAULT?
BNE TYPFIL
JOBIDX A3 ;DEFAULT DEVICE - DETERMINE LOG IN
LEA A2,JBDEV ; STATUS AND TYPE IT OUT
CLR D1
MOVW JOBDEV(A3),D1 ;GET THE PACKED DEVICE NAME
LEA A1,SCRAT ; AND UNPACK IT
MOVW D1,(A1)
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
TTYL (A2) ;PRINT THE DEFAULT DEVICE NAME
CLR D1
MOVW JOBDRV(A3),D1 ;GET THE DEFAULT DRIVE NUMBER
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CLR D1
MOVB #':,D1
TTY
TYPFIL: LEA A3,CURFIL
LEA A1,D.FIL(A5)
MOVW (A3)+,(A1)+ ;MOVE THE FIRST TRIPLET INTO THE DDB
MOVW (A3)+,(A1)+ ;MOVE THE SECOND TRIPLET INTO THE DDB
MOVW (A3),(A1)+ ;MOVE THE THIRD TRIPLET INTO THE DDB
PFILE (A5) ;PRINT THE FILE SPEC
CLR D1
TSTW D5
BEQ OCTFST
HEXFST:
LEA A3,STATUS
MOVW (A3),D1
JOBIDX A3
LEA A2,2(A3)
ANDW #2757,D1 ;MASK OFF J.HEX BIT
MOVW D1,(A2)
OCTFST:
TYPE <[>
CLR D2
CLR D3
CLR D1
MOVB D4,D3
ROR D4,#10
MOVB D4,D2
MOVB D2,D1
OCVT 0,OT$TRM
TYPE <,>
MOVB D3,D1
OCVT 0,OT$TRM
TYPECR <]>
CRLF
JMP EXIT
NOTALC:
CRLF
CTRLC EXIT ;COME HERE IF TARGET IS NOT FOUND
TYPESP <Block #>
LEA A3,BLOCK ;GET THE TARGET BLOCK
MOVW (A3),D1
OCVT 0,OT$TRM
TYPESP < >
TYPECR <has not been allocated!>
JMP EXIT
MFD: BLKB 1536. ;COMPRESSED MFD STORAGE
UFD: BLKB 512. ;CURRENT UFD STORAGE
CURMFD: BLKB 4 ;STORAGE FOR WHERE WE ARE AT IN THE MFD
CURUFD: BLKB 4 ;STORAGE FOR WHERE WE ARE AT IN THE UFD
UFDLNK: BLKB 2 ;STORAGE FOR THE LINK POINTER WITHIN AN UFD
CURFIL: BLKB 6 ;STORAGE FOR THE CURRENT FILE NAME
BLOCK: BLKB 2 ;STORAGE FOR THE INPUT BLOCK NUMBER
SCRAT: BLKB 6 ;SCRATCH AREA
JBDEV: BLKB 2 ;JOB DEVICE STORAGE
JBDRV: BLKB 2 ;JOB DRIVE STORAGE
ASCBUF: BLKB 4 ;ASCII BUFFER
INDEV: BLKB 6
INDRV: BLKB 2
SPPN: BLKB 2 ;SPECIAL PPN SEARCH PPN NUMBER
PPN1: BLKB 4 ;PPN INPUT CONVERSION STORAGE
PPN2: BLKB 4 ;PPN INPUT CONVERSION STORAGE
PPNFLG: BLKB 2 ;SPECIAL PPN SEARCH FLAG
STATUS: BLKB 2 ;STORAGE FOR JOBTYP
PPNSTO: BLKB 2 ;STORES CURRENT PPN ON DISPLAY
DEFFLG: BLKB 2 ;DEFAUL DEVICE FLAG
CERROR:
CLR D1
MOV A2,D1
SUB D2,D1
MOV D1,D2
ADD #10,D2
CLR D1
ELOOP:
TST D2
BEQ PERROR
MOVB #40,D1
TTY
CTRLC EXIT
SUB #1,D2
BR ELOOP
PERROR:
CLR D1
MOVB #'^,D1
TTY
TYPECR <Specification error>
EXIT:
CLR D1
JOBIDX A3
LEA A2,STATUS ;RESTORE JOBTYP
MOVW (A2),D1
LEA A2,2(A3)
MOVW D1,(A2)
EXIT
END
