;3/9/84    STEVEN G. MCNAUGHTON  &  RICH EAKIN
; QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
; *                                                                     *
; *                                                                     *
; *                                                                     *


SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV

OFINI
OFDEF   DDB,D.DDB                       ;FILE DDB
OFDEF   ODDB,D.DDB                      ;OUTPUT DDB
OFSIZ   IMPSIZ


VMAJOR=1.
VMINOR=1.
VSUB=1.
VEDIT=101.

HEADER:
       PHDR    -1,PV$RSM!PV$WSM,PH$REE!PH$REU


TOP:
       GETIMP  IMPSIZ,A5,EXIT
       MOV     A2,D3
       CLR     D2                      ;COLUMN PER PAGE TALLY

       BYP                             ;BYPASS BLANKS ON COMMAND LINE
       LIN
       JEQ     DEFAUL
       BYP
       MOVB    (A2),D1
       CMPB    D1,#'/                  ;IS IT A SLASH?
       BEQ     DCHK
       JMP     COMLP

DCHK:
       MOVB    (A2)+,D1
       MOVB    (A2),D1
       CMPB    D1,#'P                  ;IS IT A P FOR PRINT?
       JNE     CERROR                  ;NO ! COMMAND ERROR
       LEA     A2,INDEV
       MOVW    #0,(A2)
       LEA     A2,INDRV
       MOVW    #-1,(A2)
       LEA     A2,DEFLG
       MOVW    #1,(A2)                 ;SET THE DEFAULT FLAG
       CLR     D1
       MOVW    #177400,D1
       TCRT
       CLR     D1
       JMP     OUTDB

COMLP:
       CLR     D4
       CLR     D2
       CLR     D1
       LEA     A1,INDEV
       MOVB    (A2)+,(A1)+
       MOVB    (A2)+,(A1)+
       MOVB    (A2)+,(A1)+
       LEA     A1,INDRV
       MOVB    (A2)+,(A1)+
       BYP
       LIN
       JEQ     CERROR
       CLR     D1
       MOVB    (A2),D1
       CMPB    D1,#':
       JEQ     ADDONE
       MOVB    (A2),(A1)
       BYP
       LIN                             ;ANY MORE NUMBERS
       JEQ     CERROR
       MOVB    (A2)+,D1
       MOVB    (A2),D1
       CMPB    D1,#':
       JNE     CERROR
ADDONE:
       MOVB    (A2)+,D1
SLCHK:
       BYP
       LIN
       JEQ     CONNUM
       MOVB    (A2)+,D1
       CMPB    D1,#'/                  ;IS IT A SLASH?
       BEQ     PCHK
       JMP     CERROR


PCHK:   MOVB    (A2),D1
       CMPB    D1,#'P                  ;IS IT A P FOR PRINT?
       JNE     CERROR                  ;NO ! COMMAND ERROR
       CLR     D4
       MOVW    #1,D4                   ;SET A FLAG (PRINT FLAG)

CONNUM:
       LEA     A2,INDRV
       GTDEC
NUMDUN: LEA     A2,INDRV
       MOVW    D1,(A2)
       CLR     D1
       MOVW    #177400,D1              ;CLEAR THE SCREEN
       TCRT
       CLR     D1
       CLR     D3
       TST     D4
       JEQ     INITDB
       JMP     OUTDB

DEFAUL:
       LEA     A2,INDEV
       MOVW    #0,(A2)
       LEA     A2,INDRV
       MOVW    #-1,(A2)
       LEA     A2,DEFLG
       MOVW    #1,(A2)
       CLR     D1
       MOVW    #177400,D1
       TCRT
       JMP     INITDB

OUTDB:
       CLR     D1
       LEA     A2,DEFLG
       MOVW    (A2),D1
       TST     D1
       JEQ     IDDBO

       JOBIDX  A3
       LEA     A2,SCRAT
       MOVW    JOBDEV(A3),(A2)+
       CLR     D1
       MOVW    JOBDRV(A3),D1
       LEA     A1,PACBUF
       SAVE    D3
       MOV     A2,D3
       LEA     A2,ASCBUF
       DCVT    0,OT$MEM
       MOVB    #40,(A2)
       LEA     A2,ASCBUF
       PACK
       MOV     D3,A2
       LEA     A1,PACBUF
       MOVW    (A1),(A2)
       CLR     D1
       REST    D3
       BR      LDDBO

IDDBO:
       LEA     A2,INDEV
       LEA     A1,PACBUF
       PACK
       LEA     A2,SCRAT
       LEA     A1,PACBUF
       MOVW    (A1),(A2)+
       SAVE    D3
       MOV     A2,D3
       LEA     A2,ASCBUF
       LEA     A1,INDRV
       CLR     D1
       MOVW    (A1),D1
       DCVT    0,OT$MEM
       LEA     A1,PACBUF
       MOVB    #40,(A2)
       LEA     A2,ASCBUF
       PACK
       CLR     D1
       MOV     D3,A2
       LEA     A1,PACBUF
       MOVW    (A1),(A2)
       REST    D3

LDDBO:  LEA     A2,JUNK                 ;LOAD A OUTPUT FILESPEC IN
       MOVW    #377,(A2)+
       MOVW    #377,(A2)+
       MOVW    #377,(A2)+
       LEA     A2,JUNK
       FSPEC   ODDB(A5),UFD
       LEA     A2,SCRAT
       LEA     A1,D.FIL+ODDB(A5)               ;YES - LOAD THE OUTPUT DDB FSPEC
       MOVW    (A2)+,(A1)+
       MOVW    (A2)+,(A1)+
       MOVW    #[UFD],(A1)
       INIT    ODDB(A5)                ;INIT IT
       TYPESP  <Print option has been initiated - output to:>
       PFILE   ODDB(A5)
       CRLF

       LOOKUP  ODDB(A5)                ;DOES IT ALREADY EXIST?
       BNE     OPNIT                   ;NO OPEN IT FOR OUTPUT
       DSKDEL  ODDB(A5)                ;YES - DELETE THE OLD ONE
OPNIT:
       OPENO   ODDB(A5)                ;OPEN THE OUTPUT FILE
       LEA     A3,FLAG                 ;SET THE PRINT FLAG
       MOVW    #1,(A3)                 ;#1 MEANS PRINT COMMAND IS SPECIFIED


       LEA     A2,ODDB(A5)
       OUTSP   OT$DDB,<Possible UFD blocks on:>
       EVEN
       CLR     D1
       LEA     A2,INDEV                ;GET THE DEVICE TO SEARCHED
       MOVB    (A2),D1                 ;GET THE FIRST BYTE
       TST     D1                      ;IS IT A ZERO (DEFAULT DEVICE)?
       BEQ     PDFLT                   ;YES - GET THE DEFAULT AND PRINT IT
       MOVB    (A2)+,D1                ;GET THE FIRST BYTE
       FILOTB  ODDB(A5)                ;NO - PRINT THE FIRST CHARACTER
       MOVB    (A2)+,D1
       FILOTB  ODDB(A5)
       MOVB    (A2),D1
       FILOTB  ODDB(A5)
       LEA     A2,INDRV
       CLR     D1
       MOVW    (A2),D1
       LEA     A2,ODDB(A5)
       DCVT    0,OT$DDB
       CLR     D1
       MOVB    #15,D1
       FILOTB  ODDB(A5)
       MOVB    #12,D1
       FILOTB  ODDB(A5)
       JMP     INITDB
PDFLT:

       JOBIDX  A3
       CLR     D1
       MOVW    JOBDEV(A3),D1
       LEA     A1,PACBUF
       MOVW    D1,(A1)
       LEA     A2,ASCBUF
       UNPACK
       LEA     A2,ASCBUF
       MOVB    (A2)+,D1
       FILOTB  ODDB(A5)
       MOVB    (A2)+,D1
       FILOTB  ODDB(A5)
       MOVB    (A2)+,D1
       FILOTB  ODDB(A5)
       CLR     D1
       MOVW    JOBDRV(A3),D1
       LEA     A2,ODDB(A5)
       DCVT    0,OT$DDB
       CLR     D1
       MOVB    #15,D1                  ;OUTPUT A CARRIAGE RETURN
       FILOTB  ODDB(A5)
       MOVB    #12,D1                  ;OUTPUT A LINE FEED
       FILOTB  ODDB(A5)

INITDB:
       LEA     A2,SCRAT                ;LOAD A DUMMY FILESPEC IN
       MOVW    #377,(A2)+
       MOVW    #377,(A2)+
       MOVW    #377,(A2)+
       LEA     A2,SCRAT
       FSPEC   DDB(A5)
       LEA     A1,PACBUF               ;LOAD THE RAD 50 BUFFER
       LEA     A2,INDEV                ;LOAD THE ASCII DEVICE NAME
       PACK                            ;PACK WILL CONVERT 3 BYTES AND LEAVE A2
                                       ;POINTING AT THE NEXT BYTE!
       LEA     A1,PACBUF
       LEA     A3,D.DEV+DDB(A5)        ;GET THE DEVICE TO BE SEARCHED
       MOVW    (A1),(A3)               ;LOAD THE DEVICE NAME
       CLR     D1
       LEA     A2,INDRV
       MOVW    (A2),D1
       LEA     A3,D.DRV+DDB(A5)
       MOVW    D1,(A3)

       TYPESP  <UFD search commencing on:>
       CLR     D1
       LEA     A3,DEFLG
       MOVW    (A3),D1
       TST     D1
       JNE     DEFLOG
       CLR     D1
       LEA     A3,INDEV
       MOVB    (A3)+,D1
       TTY
       MOVB    (A3)+,D1
       TTY
       MOVB    (A3)+,D1
       TTY
       LEA     A3,INDRV
       MOVW    (A3)+,D1
       DCVT    0,OT$TRM
       CRLF
       JMP     TYPTWO
DEFLOG:
       JOBIDX  A3
       CLR     D1
       MOVW    JOBDEV(A3),D1
       LEA     A1,PACBUF
       MOVW    D1,(A1)
       LEA     A2,ASCBUF
       UNPACK
       LEA     A2,ASCBUF
       MOVB    (A2)+,D1
       TTY
       MOVB    (A2)+,D1
       TTY
       MOVB    (A2)+,D1
       TTY
       CLR     D1
       MOVW    JOBDRV(A3),D1
       DCVT    0,OT$TRM
       CRLF
TYPTWO:
       INIT    DDB(A5)                 ;INITIALIZE THE DDB
       CTRLC   EXIT


       MOV     D.DVR+DDB(A5),A3                ;GET THE DEVICE DRIVER ADDRESS
       MOV     24(A3),D1
       LEA     A2,BLOCKS
       MOV     D1,(A2)
       TYPESP  <This device contains a total block count of:>
       DCVT    0,OT$TRM
       CLR     D1
       CRLF
       TYPECR  <The following blocks appear to be User File Directories:>
       CRLF

STLOOP:
       MOV     #1,D0                   ;D0 TALLY FOR BLOCK NUMBER

SCNBLK:
       CTRLC   EXIT
       CLR     D1
       LEA     A1,DDB+D.REC(A5)                ;LOAD BLOCK # INTO DDB
       MOV     D0,(A1)
       READ    DDB(A5)                 ;READ THE BLOCK
       MOV     DDB+D.BUF(A5),A1                ;ADDRESS THE READ BUFFER AREA
       ADD     #6,A1
       MOVW    (A1),D1                 ;MOVE THE SIXTH WORD IN
                                       ;THIS WILL BE THE FIRST EXTENSION
       MOV     #21.,D3
EXTCHK: CTRLC   EXIT

       CMPW    D1,#[REN]
       JEQ     FOUND
       CMPW    D1,#[OLD]
       JEQ     FOUND
       CMPW    D1,#[BAS]
       JEQ     FOUND
       CMPW    D1,#[M68]
       JEQ     FOUND
       CMPW    D1,#[RUN]
       JEQ     FOUND

       CMPW    D1,#[LIT]
       JEQ     FOUND
       CMPW    D1,#[SYS]
       JEQ     FOUND
       CMPW    D1,#[BAK]
       JEQ     FOUND
       CMPW    D1,#[IDX]
       JEQ     FOUND
       CMPW    D1,#[IDA]
       JEQ     FOUND

       CMPW    D1,#[SEQ]
       JEQ     FOUND
       CMPW    D1,#[LST]
       JEQ     FOUND
       CMPW    D1,#[DAT]
       JEQ     FOUND
       CMPW    D1,#[TXT]
       JEQ     FOUND
       CMPW    D1,#[BV]
       JEQ     FOUND

       CMPW    D1,#[DBD]
       JEQ     FOUND
       CMPW    D1,#[DBK]
       JEQ     FOUND
       CMPW    D1,#[CPY]
       JEQ     FOUND
       CMPW    D1,#[S]
       JEQ     FOUND
       CMPW    D1,#[R]
       JEQ     FOUND

       CMPW    D1,#[RPT]
       JEQ     FOUND
       CMPW    D1,#[SAV]
       JEQ     FOUND
       CMPW    D1,#[OBJ]
       JEQ     FOUND
       CMPW    D1,#[SYM]
       JEQ     FOUND
       CMPW    D1,#[INI]
       JEQ     FOUND

       CMPW    D1,#[MNU]
       JEQ     FOUND
       CMPW    D1,#[CMN]
       JEQ     FOUND
       CMPW    D1,#[HLP]
       JEQ     FOUND
       CMPW    D1,#[HLV]
       JEQ     FOUND
       CMPW    D1,#[QRY]
       JEQ     FOUND

       CMPW    D1,#[CMD]
       JEQ     FOUND
       CMPW    D1,#[DO]
       JEQ     FOUND
       CMPW    D1,#[SV]
       JEQ     FOUND
       CMPW    D1,#[LSP]
       JEQ     FOUND

       CMPW    D1,#[VUE]
       JEQ     FOUND
       CMPW    D1,#[SBR]
       JEQ     FOUND
       CMPW    D1,#[UNV]
       JEQ     FOUND
       CMPW    D1,#[LIB]
       JEQ     FOUND



       SUB     #1,D3
       TST     D3
       BEQ     ADDBLK
       ADD     #14,A1
       MOVW    (A1),D1
       JMP     EXTCHK

ADDBLK:
       SAVE    D1,A2
       LEA     A2,BLOCKS
       MOV     (A2),D1
       CMP     D0,D1
       JEQ     EXPRP
       REST    D1,A2
       ADD     #1,D0
       JMP     SCNBLK

EXPRP:
       REST    D1,A2
       JMP     EXIT


FOUND:
       SAVE    D1

       CLR     D4
       CMP     D2,#10.                 ;OUTPUT IN 10(DEC) COLUMNS
       BNE     PRNTIT
       LEA     A3,FLAG
       MOVW    (A3),D4
       CMPW    D4,#1
       BNE     SCRIT
       MOVB    #15,D1
       FILOTB  ODDB(A5)
       MOVB    #12,D1
       FILOTB  ODDB(A5)
       REST    D1
SCRIT:  CRLF
       MOV     #0,D2
PRNTIT:
       LEA     A3,FLAG
       MOVW    (A3),D4
       MOV     D0,D1
       OCVT    0,OT$TRM
       TAB
       CMPW    D4,#1
       BNE     JUMP
       LEA     A2,ODDB(A5)
       OCVT    0,OT$DDB
       CLR     D1
       MOVB    #11,D1                  ;PRINT A TAB
       FILOTB  ODDB(A5)
JUMP:   ADD     #1,D2
       JMP     ADDBLK

JUNK:   BLKB    6
SCRAT:  BLKB    6                       ;SCRATCH AREA
INDEV:  BLKB    4
INDRV:  BLKB    2
FLAG:   BLKB    2
DEFLG:  BLKB    2
PACBUF: BLKB    4
ASCBUF: BLKB    4
DRIVE:  BLKB    6
BLOCKS: BLKB    4


CERROR:
       CLR     D1
       MOV     A2,D1
       SUB     D3,D1
       MOV     D1,D3
       ADD     #10,D3
       CLR     D1
ELOOP:
       TST     D3
       BEQ     PERROR
       MOVB    #40,D1
       TTY
       SUB     #1,D3
       BR      ELOOP


PERROR:
       CLR     D1
       MOVB    #'^,D1
       TTY
       TYPECR  <Specification error>


EXIT:
       CLR     D1
       LEA     A3,FLAG
       MOVW    (A3),D1
       CMPW    D1,#1
       BNE     FALOUT
       CLR     D1
       MOVB    #15,D1                  ;OUTPUT A CARRIAGE RETURN
       FILOTB  ODDB(A5)
       MOVB    #12,D1                  ;OUTPUT A LINE FEED
       FILOTB  ODDB(A5)
       CLOSE   ODDB(A5)
FALOUT: CRLF
       EXIT
END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.