.
. SEARCH / LOCATE COMMAND ACTIVITY
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
PURE CODE
.
LOCATE* LA,U A10,1 SET LOCATE MODE
J CIRCE ENTER SEARCH HANDLER
.
SEARCH* LA,U A10 CLEAR LOCATE MODE
CIRCE LA,U A7 MARK NO HIT QUEUE ALLOCATED
LR,U R8 CLEAR ANY FINDS MADE
LX X5,CDBPC,X8 LOAD POINTER TO FILE FDT
LA A1,PBVAL,X5 LOAD FDT POINTER
LMJ A2,IOGET BUILD FCT FOR READ FILE
LX,U X10,,A0 SAVE INPUT FCT ADDRESS IN X10
LX X5,PBLINK,X5 CHAIN TO NEXT PARAMETER
LA A0,PBTYPE,X5 LOAD TYPE OF THIS PARAMETER
LA,U A3,0377777 LOAD ASSUMED COUNT
TNE,U A0,DATA WAS NUMBER PARAMETER OMITTED ?
J NEGIP YES. USE ASSUMED COUNT
LA A3,PBVAL,X5 LOAD SUPPLIED CONT
LX X5,PBLINK,X5 CHAIN TO NEXT PARAMETER
NEGIP SA A3,IOCOUNT,X10 PUT I/O COUNT IN PACKET
LA A6,PBVAL,X5 LOAD LENGTH OF KEY
LMJ A2,INPUT CREATE INPUT PROCESS
LA,U A8,,X5 SAVE ADDRESS OF KEY DATA BUFFER
.
. SEARCH COMPARISON ROUTINE
.
SRLOOK GET IOBB,X10 REMOVE A BLOCK FROM THE BOUNDED BUFFER
SA A1,R7 SAVE ADDRESS OF BLOCK
LA,U A9 CLEAR FIND COUNT IN THIS BLOCK
LXI,U X7,1 SET UP INCREMENTS
SX X7,X3 FOR VARIOUS POINTERS
SX X3,X6 WE'LL USE LATER ON
LA A0,IBSTAT,A1 LOAD STATUS ENCOUNTERED ON READ
JNZ A0,IBABNS IF ABNORMAL, GO INTERPRET IT
STCOK LX X5,A8 RESTORE DATA BUFFER POINTER
LXM,U X6,IBDATA,A1 LOAD BLOCK POINTER
LX X2,CDMASK,X8 LOAD MASK ADDRESS
TNZ,U 0,X2 ANY MASK SPECIFIED ?
LX,U X2,CPMZER NO. USE IMPLIED -0 MASK
LA A5,IBLEN,A1 LOAD LENGTH OF BLOCK READ
ANA A5,A6 SUBTRACT LENGTH OF KEY
JN A5,FAILED CANNOT SUCCEED OF BLOCK < KEY
AA,U A5,1 BUMP LENGTH FOR SEARCH
LR R1,A5 LOAD REPEAT COUNT FOR SEARCH
SRST LA A0,PBSS,X5 LOAD FIRST WORD TO LOOK FOR
LR R2,PBSS,X2 LOAD FIRST WORD OF MASK
MSE A0,,*X6 SEARCH FOR FIRST WORD OF KEY
J FAILED DIDN'T LOCATE FIRST WORD
.
. FOUND FIRST WORD. VERIFY REST MATCHES
.
LR R3,PBVAL,X5 LOAD LENGTH OF KEY
LXM,U X7,PBSS+1,X5 POINT TO SECOND KEY WORD
LA A4,PBVAL,X2 LOAD LENGTH OF MASK BUFFER
ANA,U A4,1 ACCOUNT FOR FIRST WORD USED ALREADY
LXM,U X3,PBSS+1,X2 SET UP MASK DATA POINTER
LX X1,X6 LOAD TEMPORARY BLOCK POINTER
JGD R3,QUEEG LOOP FOR KEY LENGTH - 1
IERR . AIN'T NO WAY ZERO LENGTH KEY
.
SKLEEX LA A11,,*X1 LOAD A WORD OF DATA
TZ A4 NEED TO RECYCLE MASK ?
J GEEXL NO. PERFORM TEST
LA A4,PBVAL,X2 RELOAD LENGTH OF MASK
LXM,U X3,PBSS,X2 SET POINTER TO START OF MASK
GEEXL ANA,U A4,1 DECREMENT MASK LENGTH USED
XOR A11,,*X7 XOR DATA AND KEY
AND A12,,*X3 AND RESULT WITH MASK
JNZ A13,SRST START FIRST WORD SEARCH IF FAILS
QUEEG JGD R3,SKLEEX LOOP FOR ALL WORDS OF KEY
.
. WE'VE MADE A 'HIT'. RECORD IT, AND SET UP TO PROCESS BLOCK
.
JNZ A7,NOTFRS HIT BUFFER ALLOCATED YET ?
BGET QL NO. ALLOCATE ONE
LA,U A7,,A0 SAVE ADDRESS OF HIT QUEUE
INITQ . INITIALISE HIT QUEUE
SX X10,R9 SAVE X10 FOR A WHILE
LA A1,IOFDT,X10 LOAD FDT WE'RE WORKING ON
LR R10,R1 SAVE VOLATILE SEARCH COUNT
LMJ A2,IOGET MAKE AN I/O FCT TO DRIVE THE PRINTER
LR R1,R10 RESTORE SEARCH COUNT
LX,U X10,,A0 LOAD ADDRESS OF I/O FCT
LA,U A0,1 GET CONCURRENCY LIMIT OF ONE
SA A0,IOBB+QL+QPL+QN,X10 SET COUNT IN NOT FULL QUEUE
BGET QPL*2 ALLOCATE COMPLETION QUEUES
LR,U R11,,A0 SAVE COMPLETION QUEUE ADDRESS
LX,U X9,QPL,A0 LOAD COMPLETION QUEUE ADDRESS
LXI,U X9,,A0 LOAD BLOCK COMPLETION QUEUE ADDRESS
INITQ . INITIALISE THE BLOCK COMPLETION QUEUE
INITQ QPL,A0 INITIALISE THE COMPLETION QUEUE
LMJ A2,PRINT CREATE PRINTER ACTIVITY
LX,U X9,,X10 LOAD PRINTER CONTROL FCT ADDRESS
LX X10,R9 RESTORE INPUT FCT ADDRESS
LA A1,R7 RESTORE BUFFER ADDRESS
NOTFRS BGET SFL ALLOCATE A FIND BUFFER
LA,U A2,,X6 LOAD FIND LOCATION
ANA,U A2,IBDATA+1,A1 SUBTRACT BLOCK START + 1
SA A2,SFFINDW,A0 PUT FIND ADDRESS IN BUFFER
LA,U A1,,A0 LOAD ADDRESS OF DATA ITEM
LA A0,A7 LOAD QUEUE ADDRESS
SX X5,R9 SAVE X5
INSERT . PLACE FIND ITEM ON HIT QUEUE
LX X5,R9 RELOAD X5
AA,U A9,1 INCREMENT FINDS IN THIS BLOCK
LR,U R8,1 SET A FIND WAS MADE FLAG
LA A1,R7 RESTORE DATA BLOCK ADDRESS
J SRST KEEP ON LOOKING
.
. DIDN'T FIND IT IN THE BLOCK. LOOK AT NEXT ONE
.
FAILED JZ A9,FLAY ANY FINDS IN BLOCK ?
P PRINTER YES. LOCK THE PRINTER
R$DIT . START EDITING
E$MSG KFI EDIT 'KEY FOUND IN '
LA A0,IOFDT,X10 LOAD FDT ADDRESS
LMJ X11,FIST EDIT FILE AND STATEMENT, PRINT
LMJ X7,FINDLE EDIT FIND LOCATIONS
LA A1,R7 RELOAD BLOCK BUFFER ADDRESS
LA A5,IBMSAD,A1 LOAD SEARCH FIND MASS STORAGE ADDRESS
LA A2,IBLAST,A1 L0AD LAST BLOCK FLAG
SZ IBLAST,A1 CLEAR LAST FLAG FOR DUMPER
PUT IOBB,X9 PASS TO PRINT ACTIVITY
P R11,,W WAIT FOR COMPLETION
V PRINTER RELEASE THE PRINTER LOCK
JZ A10,FLOG KEEP ON LOOKING IF 'SEARCH'
.
. POSITION TO FIND LOCATION FOR TAPE OR FILE
.
LA,U A8,1 LOAD COUNT OF BLOCKS TO MOVE BACK
SNONZ CDCEASE,X8 SET CEASE FLAG
IBLCK JNZ A2,MBSTRT IS THIS THE LAST BLOCK ?
GET IOBB,X10 NO. GET NEXT BLOCK
LA A0,IBSTAT,A1 LOAD READ STATUS
JZ A0,MSOK NORMAL MEANS IT MOVED
JE A0,1,MSOK EOF MEANS IT MOVED
JE A0,4,MSOK ABNORMAL FRAME COUNT IS OK ALSO
J MSNOK OTHER STATUS. WIPED OUT OR NOT TAPE
MSOK AA,U A8,1 INCREMENT COUNT TO BACK OVER
MSNOK LA A2,IBLAST,A1 LOAD LAST FLAG
BRELP A1 RELEASE THE BLOCK BUFFER
J IBLCK CHECK LAST FLAG, CONTINUE
MBSTRT TZ IOMASS,X10 MASS STORAGE FILE ?
J MSASET YES. SET FIND ADDRESS
LA,U A0,MB$ NO. LOAD MOVE BACKWARD FUNCTION
SA A0,IOFUNC,X10 PUT FUNCTION IN PACKET
SZ IOACW,X10 PROTECT AGAINST ACW CHECK
J MBAKO START BACKING UP
MESEL IOW$ IOPKT,X10 BACK UP ONE BLOCK
LA A0,IOSTATUS,X10 LOAD OPERATION STATUS
JZ A0,MBAKO O.K. IF NORMAL
JE A0,1,MBAKO ...OR EOF
JE A0,4,MBAKO ...OR AFC
LA,U A0,IOPKT,X10 OOPS! LOAD PACKET ADDRESS
LMJ X11,IOSEDT EDIT BAD STATUS
ZAP . ROADBLOCK THE FILE
J TNORM ENTER NORMAL CLOSEOUT
MBAKO JGD A8,MESEL LOOP FOR BACK UP COUNT
J TNORM WIND UP THIS COMMAND
.
MSASET LA A0,IOFDT,X10 LOAD FDT ADDRESS
SA A5,FDMSAD,A0 PUT MASS STORAGE ADDRESS IN PACKET
J TNORM WIND UP
FLAY LA A1,R7 RELOAD BLOCK ADDRESS
LA A2,IBLAST,A1 LOAD LAST BLOCK FLAG
BRELP A1 RELEASE THE BLOCK BUFFER
FLOG JZ A2,SRLOOK GET NEXT BLOCK IF NOT LAST ONE
TZ R8 ANY FINDS MADE ?
J TNORM YES. DON'T SAY NO FIND
.
. OUTPUT NO FIND DIAGNOSTIC. FILE WILL BE ROADBLOCKED IF
. THE OPERATION WAS A 'LOCATE', SINCE NO FIND INDICATES
. THAT SUBSEQUENT OPERATIONS MAY BE INVALID. THIS IS
. OVERRIDDEN BY THE 'C' OPTION ON LOCATE.
.
R$DIT . GET A PACKET AND LINE
E$MSG KNEF EDIT NO FIND MESSAGE
LA A0,IOFDT,X10 LOAD FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT
JZ A10,TNORM ALLOW NO FIND ON SEARCH OPERATION
ZAP . BUT NOT ON LOCATE
TNORM BRELP X10 RELEASE I/O FCT
JZ A7,NOFH ANY HIT BUFFER TO RELEASE ?
BRELP A7 RELEASE THE HIT BUFFER
BGET IBDATA ALLOCATE A DATA BUFFER
SNONZ IBLAST,A0 MARK AS LAST BLOCK
LA,U A1,STERM LOAD TERMINATION STATUS
SA A1,IBSTAT,A0 PUT IN STATUS
LA,U A1,,A0 LOAD DATA ITEM ADDRESS
PUT IOBB,X9 SUBMIT PACKET TO STOP DUMPER
P R11,,W WAIT FOR DUMPER TO STOP
P QL,A0 WAIT FOR PROCESS COMPLETION
BRELP X9 RELEASE DUMP FCT
BRELP R11 RELEASE THE COMPLETION QUEUE
NOFH COMPLETE . COMPLETE THE OPERATION
.
IBABNS JE A0,4,STCOK ALLOW ABNORMAL FRAME COUNT
JE A0,5,STCOK ...AND INCOMPLETE MASS STORAGE BLOCK
J FAILED BUT THAT'S ALL
.
. EDIT FIND ADDRESSES
.
FINDLE* R$DIT . GET EDITING
LA A0,('WORDS ') LOAD WORDS INDICATOR
TNE,U A9,1 ONLY ONE FIND ?
LA A0,('WORD ') YES. USE SINGULAR FORM
E$FD3 . EDIT FIND LOCATIONS PREFIX
LR,U R4,128 LOAD LINE LENGTH
JNDEM EPIXY USE 20 PER LINE FOR BATCH...
LR,U R4,60 SHORTER LINE FOR DEMAND
EPIXY LA A0,A7 LOAD HIT QUEUE ADDRESS
REMOVE . REMOVE AN ITEM FROM IT
TNE A1,A7 END OF THE QUEUE ?
J IXLY YES. WIND UP THIS ROUTINE
LA A2,SFFINDW,A1 LOAD FIND ADDRESS
BRELP A1 RELEASE THE HIT BUFFER
E$OCTV A2 EDIT THE FIND ADDRESS
E$CHAR ',' EDIT SEPARATOR
E$SKIP 1 SKIP A SPACE
E$COLN . GET COLUMN NUMBER
TLE A0,R4 PAST EDITING LIMIT ?
J EPIXY NO. KEEP ON EDITING
R$PRT 1 PRINT AND KEEP ON EDITING
E$SKIP 6 TAB TO COLUMN 6
J EPIXY KEEP ON GOING
.
IXLY E$SKIP -2 BACK UP TO TRAILING COMMA
E$CHAR ' ' OVERLAY IT WITH A SPACE
R$PRTX 1 PRINT AND TERMINATE EDITING
J 0,X7 RETURN
PURE DATA
.
. CANNED MASK BUFFER FOR OMITTED MASK
.
CPMZER * MBUFR,0
* 0,0
* 1
* -0
.
KNEF 'KEY NOT FOUND IN !'
KFI 'KEY FOUND IN !'
END