Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/mcbda/mcbda.mac
There are no other files named mcbda.mac in the archive.
;
;
;
; COPYRIGHT (C) 1983 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;++
; FACILITY: MDA - MCB Dump Analyzer
;
; ABSTRACT:
;
;
; This module contains routines to do system dependant I/O.
;
;
; ENVIRONMENT: TOPS10
;
; AUTHOR: ALAN D. PECKHAM, CREATION DATE: 5-SEP-78
;
; MODIFIED BY:
;
; Vicki L. Gary, 2-Feb-83 : VERSION 4
; 00 -Modify to use GLXLIB routines
;
;--
SUBTTL MCB Dump Analyzer
;
; TABLE OF CONTENTS:
SEARCH GLXMAC
SEARCH ORNMAC
; SEARCH MACSYM,MONSYM
;MCBDA EXTERNAL VERSION NUMBER
%%MCBDA==:<BYTE (3)XWHO(9)XMAJOR(6)XMINOR(18)XEDIT>
LOC 137
%%MCBDA
RELOC 0
XWHO==0 ; DEC = 0
XMAJOR==4 ;MAJOR VERSION
XMINOR==0 ;MINOR VERSION
XEDIT==1 ;EDIT NUMBER
PROLOGUE (MCBDA) ; Init GLXLIB assembly options
INTERNAL VRSION,VMAJOR,VMINOR,VEDIT
;
; VERSION NUMBER
;
VMAJOR==MDAVER ;MAJOR VERSION
VMINOR==MDAMIN ;MINOR VERSION
VEDIT==MDAEDT ;EDIT NUMBER
VRSION==BYTE (9) VMAJOR (6) VMINOR (18) VEDIT ;VERSION NUMBER
; Version !!!
XP MDAVER, 4 ; Major version number
XP MDAMIN, 0 ; Minor version number
XP MDAWHO, 0 ; Who did editing last(0=DEC)
XP MDAEDT, 1 ; Edit number
XP MDAEDI, MDAEDT ; Copy of edit number
; Global externals
PARSET ; Define parser semantic externals
EXTERNAL PARSER ; Syntactic parser
EXTERNAL P$NPRO ; Flag "No processing" in $ACTION
EXTERNAL $CAT5 ; DEFINE RAD50 CONVERTION ROUTINE
EXT <DMPBLK,LSTBLK,TSKBLK,TSKCNT,TSKLST,PRCCNT,PRCLST,DMPCNT>
EXT <DMPLST,DMPOFF,STBBLK,FLAGS,XSTART>
GLOB <DMPBLK,LSTBLK,TSKBLK,TSKCNT,TSKLST,PRCCNT,PRCLST,DMPCNT>
GLOB <DMPLST,DMPOFF,STBBLK,FLAGS,XSTART>
;
; Constants
;
XP PDLSIZ, 2000 ; Size of the stack
SUBTTL Command Symbols
XP .DMY, 0
XP .ALL, 1
XP .ANAL, 2
XP .CEX, 3
XP .DUMP, 4
XP .EXIT, 5
XP .HELP, 6
XP .LIST, 7
; XP .PROC, 10
XP .RSX, 11
XP .STAN, 12
; XP .STBS, 13
XP .TASK, 14
XP .VERS, 15
XP .WIDE, 16
XP TOPMAX, 17 ;SIZE OF TOP LEVEL TABLE
XP .RALL, 40
XP .ATL, 11
XP .CLOCK, 17
XP .RCTXT, 6
XP .DEV, 16
XP .RDMP, 21
XP .FXD, 12
XP .HDR, 14
XP .PARS, 7
XP .PCBS, 10
XP .RPL, 20
XP .RSTA, 41
XP .STD, 13
XP .CALL, 32
XP .BUFS, 24
XP .CCTXT, 22
XP .CDMP, 31
XP .FREE, 27
; XP .INTRP, 0
XP .PDVS, 25
XP .CPL, 23
XP .SLTS, 26
XP .CSTA, 32
;
; OTHER EQUATED SYMBOLS
;
MHLP=4 ; HELP BIT
FP=15 ; FRAME POINTER
WRT=100000 ; WRITE FLAG
PARSIZ==4 ;Parser Data blk
PDLL==2000 ;PUSH-DOWN LIST LENGTH
ATOMX==60 ;Maximum atom length.
INMAX==200 ;Maximum command length.
SWTMIN==0
SWTMAX==11
MAXDMP==7
MAXPRC==7
MAXTSK==7
MAXFIL==20
MALL=754700
MSTAND=211300
SUBTTL GLXLIB initialization blocks
;
IB:: $BUILD IB.SZ ; Size of initialization block
$SET (IB.PRG,,'MCBDA') ; Program name
$SET (IB.FLG,,1b0) ; Open terminal
$EOB
;
;
PRGPRM: ; Program prompt
ASCIZ /MCBDA>/
SUBTTL MACROS
DEFINE $GETARG (NUMARG)
< PUSH P,FP
HRRZ FP,P
SUBI FP,NUMARG+2 >
;END *** DON'T FORGET TO POP P,FP AFTER THIS MACRO!!
DEFINE $SETBIT (BIT)
< MOVEI T1,1
LSH T1,BIT
IORM T1,FLAGS >
SUBTTL Startup and initialization
VERX: VRSN. (MDA) ; Set value of edit level/version
RETRY: EXP -1 ; Retry count
INIT: MOVX S1,IB.SZ ; Size of initialization block
MOVEI S2,IB ; Addrs of initialization block
$CALL I%INIT ; Initialize GLXLIB
$TEXT ,<TOPS-10^A>
$TEXT ,< MCB dump Analyzer^A>
$TEXT ,<, Version ^V/VERX/>
$TEXT ,<>
SETZM DMPBLK ; Zero dmp file pointer
SETZM STBBLK ; " sym file pointer
SETZM LSTBLK ; " lst " "
SETZM DFLG ; dump flag
MOVEI T1,MAXFIL
CMD.1: SETZM FILIFN+(T1) ; clean up file IFN's
SOJG T1,CMD.1
JRST COMMAND
CMD:: SETZM FLAGS ; zero command to be done flag
SETZM CFLG ; zero random flags
SETZM RFLG
SETZM LSTBLK
AOSG RETRY ; reentry ?
JRST INIT ; reinit
COMMAND:$SAVE <TF,T4> ; save trashed regs
MOVE T2,[POINT 7,STEMP] ; set up for
SETZ T3, ; rescan
SKIPN XSTART ; if we do one
$CALL RESCN ; yes resan
CMD.0: MOVX S1,PAR.SZ ; Size of the parser arg block
MOVEI S2,PARBLK ; Address of parser arg block
$CALL PARSER ; Parse a command
JUMPT CMMD.1 ; Success in parsing a command
MOVE T1,PRT.CF(S2) ; Get COMND flags
TXNE T1,CM%ESC ; Escape last character?
$TEXT ,<> ; Yes .. move to new line
$TEXT ,<?^T/@PRT.EM(S2)/> ; Output error message
JRST COMMAND ; Go get a good command
CMMD.1: MOVE S1,PRT.CM(S2) ; Get address of command page
MOVEM S1,PPAGE ; Save page address for releasing
MOVE T1,PRT.FL(S2) ; Get flags from PARSER
MOVE S2,COM.PB(S1) ; Get offset to parser blocks
ADD S1,S2 ; Make address to start of blocks
$CALL P$SETUP ; Start semantic parsing
CMMD.2: $CALL P$IFIL
JUMPT FILE ; Is this a file-name?
$CALL P$SWIT ; Get Keyword
SKIPF ; The End...
JRST @CMDVEC(S1) ; Vector to processing routine
CMMD.3: MOVE S1,PPAGE ; Get page address of command
$CALL M%RPAG ; Return it to memory manager
MOVE S1,LSTBLK ; LSTBLK Index
JUMPE S1,CMMD.4 ; LIST FILE?
$SETBIT 4 ; LIST TO FILE-WIDE
CMMD.4: MOVE S1,DFLG ; SET WEATHER DUMP FILE
POPJ P, ; WAS FOUND
;
;Top level command dispatch table
CMDVEC: $BUILD (TOPMAX)
$SET (.ALL,,<JRST ALL>)
$SET (.ANAL,,<JRST ANALYZ>)
$SET (.CEX,,<JRST CEX>)
$SET (.DUMP,,<JRST XDUMP>)
$SET (.EXIT,,<JRST EXIT>)
$SET (.HELP,,<JRST HELP>)
$SET (.LIST,,<JRST LIST>)
; $SET (.PROC,,<JRST PROC>)
$SET (.RSX,,<JRST RSX>)
$SET (.STAN,,<JRST STAND>)
; $SET (.STBS,,<JRST STBS>)
$SET (.TASK,,<JRST TSK>)
$SET (.VERS,,<JRST VERS>)
$SET (.WIDE,,<JRST WIDE>)
$EOB
;
FILE: PUSH P,S1
MOVE S1,DMPBLK
SKIPE S1
$CALL ICLOSE ; only ONE dumpfile
POP P,S1
MOVEI T1,DMPFD ; ADDRESS OF DMPFD
MOVEM T1,DMPFOB ; TO DMPFOB FOR OPEN
MOVEI T1,^D18 ; Set byte size
MOVEM T1,DMPFOB+1 ; ...
MOVE S2,DEXT
MOVE T1,(S1) ; GET FD HEADER
HLRZ T2,T1 ; MOVE SIZE FOR TRANSFER
HRRI T1,0 ; SET ZERO IN RIGHT HALF
MOVEM T1,DMPFD ; MOVE TO DMPFD
MOVE T1,3+(S1) ; CHECK FOR EXT
SKIPN T1 ; DON'T WIPE OUT
MOVEM S2,3+(S1) ; DEFAULT EXT
SETZ S2,
FIL.1: AOS S1 ; TRANSFER FD
AOS S2 ; to premenant
MOVE T1,(S1) ; storage
MOVEM T1,DMPFD+(S2) ; in DMPFD
SOJG T2,FIL.1
MOVEI S1,2 ; size of FOB
MOVEI S2,DMPFOB ; Address of FOB
$CALL F%IOPN## ; Open Dump file
JUMPT FILE.1 ; Open OK
$TEXT (,<Cannot open dump file - ^E/S1/>)
SETZM DMPBLK ; No dump file
SETZM DFLG
JRST CMMD.3
FILE.1: $CALL PUTIFN ; Save IFN (S1)
MOVEM S1,DMPBLK ; Index to Dump IFN
MOVEI T1,1
MOVEM T1,DFLG ; Dumpfile found
MOVE S2,XSYS ; GET SYS (SIXBIT)
MOVE T2,DMPFOB ; ADDRESS OF FD
ADDI T2,3 ; .FDEXT-EXTENTION (FD+3)
MOVEI T1,1 ; DMPOFF=1
CAMN S2,T2 ; EXT EQL 'SYS'
MOVEI T1,3 ; DMPOFF=3
MOVEM T1,DMPOFF
JRST CMMD.2 ; End this command if OK
ALL: MOVE T1,FLAGS ; Set flag bits
TXO T1,MALL ; to indicate
MOVEM T1,FLAGS ; ALL
JRST CMMD.2
ANALYZ: $SETBIT 0
JRST CMMD.2
CEX: $CALL P$KEYW## ; get a key word
JUMPF CX1 ; CEX processing done?
CAIL S1,32 ; Is it standard or all?
JRST CMMD.2 ; Yes, do nothing
MOVEI T1,1 ; Set the apporpreate
LSH T1,(S1) ; bit
IORM T1,FLAGS ; in the flag word
JRST CEX ; more?
CX1: $CALL P$TOK ; parse the comma
JUMPT CEX ; and get the next command
JRST CMMD.2 ; if there is one
RSX: $CALL P$KEYW## ; get a key word
JUMPF RX1 ; done, jump if so
CAIL S1,32 ; standard or all?
JRST RX2 ; yes, set bits
MOVEI T1,1 ; Set the apporpreate
LSH T1,(S1) ; bit
IORM T1,FLAGS ; in the flags word
JRST RSX ; more?
RX1: $CALL P$TOK ; parse the comma
JUMPT CEX ; if ther is one
JRST CMMD.2 ; all done here
RX2: MOVE T1,FLAGS ;ALL RSX
CAIN S1,40 ; set the
TXO T1,MALL ; ALL
CAIN S1,41 ; bits
TXO T1,MSTAND ; STANDARD RSX
MOVEM T1,FLAGS
JRST CMMD.2 ; done here
XDUMP: MOVE T1,DMPCNT ; How many dumps
CAIL T1,MAXDMP
JRST [$TEXT ,<? too many dumps>
POPJ P, ]
IMULI T1,4 ; correct to offset
$CALL P$NUM ; get first number
MOVE T2,S1 ; save it
TXNE S1,LHMASK ; check address
JRST [$TEXT ,<? invaild physical address>
POPJ P, ]
MOVE S2,S1
LSH S1,-20 ; BITS 18-19 IN S1
TXZ S2,600000 ; BITS 20-35 IN S2
DMOVEM S1,DMPLST+(T1) ; store it away
ADDI T1,2 ; set for next address pair
$CALL P$TOK ; PARSE A TOKEN
$CALL P$NUM ; get the next address
CAMG S1,T2 ; check range
JRST [$TEXT ,<? invaild range>
POPJ P, ]
TLNE S1,LHMASK ; check this address
JRST [$TEXT ,<? invaild physical address>
POPJ P, ]
MOVE S2,S1
LSH S1,-20 ; BITS 18-19 IN S1
TXZ S2,600000 ; BITS 20-35 IN S2
DMOVEM S1,DMPLST+(T1) ; store it away
AOS DMPCNT ; increment number of dump ranges
JRST CMMD.2 ; done
EXIT: $SETBIT 3
JRST CMMD.2
HELP: $SETBIT 2
JRST CMMD.2
; Routine - LIST
;
; Function - This routine establishes listing to the specified file.
;
; Parameters -
;
LIST: MOVE S1,LSTBLK
SKIPE S1
$CALL ICLOSE ; Only one list file
$CALL P$OFILE## ; Get output file spec
MOVEI T1,LSTFD ; ADDRESS OF LSTFD
MOVEM T1,LSTFOB ; TO LSTFOB FOR OPEN
MOVEI T1,7 ; Set byte size
MOVEM T1,LSTFOB+1 ; ...
DMOVE T1,(S1) ; LSTFOB(ADDR OF FD)
DMOVEM T1,LSTFD ; COPIES THE CONTENTS
DMOVE T1,2+(S1) ;
MOVEM T1,2+LSTFD ; OF THE FD TO LSTFD
SKIPE T2 ; NEED TO TEST EXT
MOVEM T2,3+LSTFD ; TO SEE IF PRESENT
MOVE T1,4+(S1)
MOVEM T1,4+LSTFD
MOVE S2,LEXT
MOVE T1,(S1) ; GET FD HEADER
HLRZ T2,T1 ; MOVE SIZE FOR TRANSFER
HRRI T1,0 ; SET ZERO IN RIGHT HALF
MOVEM T1,LSTFD ; MOVE TO LSTFD
MOVE T1,3+(S1) ; CHECK FOR EXT
SKIPN T1 ; DON'T WIPE OUT
MOVEM S2,3+(S1) ; DEFAULT EXT
SETZ S2,
LST.1: AOS S1 ; TRANSFER FD
AOS S2
MOVE T1,(S1)
MOVEM T1,LSTFD+(S2)
SOJG T2,LST.1
MOVEI S1,2 ; SIZE
MOVEI S2,LSTFOB ; Address of FOB
$CALL F%OOPN## ; Open the output file
JUMPT LIST.1 ; Good open?
;TOPS20 <$ERET (<Cannot open list file>)>
$TEXT (,<Cannot open list file - ^E/S1/> )
JRST CMMD.3
LIST.1: $CALL PUTIFN ; Save the file IFN
MOVEM S1,LSTBLK ; Save index to list IFN
JRST CMMD.2
STAND: MOVE T1,FLAGS ; Set bits
TXO T1,MSTAND ; for standard
MOVEM T1,FLAGS ; operation
JRST CMMD.2 ; done
TSK: MOVE T1,TSKCNT ; number of tasks
CAIL T1,MAXTSK ; how many?
JRST [$TEXT ,<? too many tasks>
POPJ P, ]
IMULI T4,2 ; ADJUST FOR 2 WORDS
$CALL P$QSTR ; GET STRING
AOS S1 ; SKIP OVER "
MOVE T2,S1 ; GET ADDRESS
HLL T2,[POINT 7,0] ; MAKE INTO A BYTE POINTER
PUSH P,T2 ; STORE BYTE POINTER ON STACK
MOVEI T2,0(P) ; GET ADDRESS OF THE BYTE POINTER
PUSH P,T2 ;PUSH ARGUMENTS FOR CALL
PUSH P,[1]
$CALL $CAT5 ; CONVERT TO RAD50
MOVEI S2,TSKLST(T4) ;
DPB S1,[POINT 16,(S2),35] ; DEPOSIT RESULT
; PUSH P,T2 ;PUSH ARGUMENT FOR CALL
; PUSH P,[1] ; (STILL ON STACK)
$CALL $CAT5 ; WIPES AC0-AC5
ADJSP P,-3 ; CLEAN STACK
MOVEI S2,TSKLST(T4) ; RESTORE ADDRESS
AOS S2 ; ADDRESS+1
DPB S1,[POINT 16,(S2),35] ; PUT BYTE IN TSKLST
AOS TSKCNT ; INCR TASK COUNT
JRST CMMD.2
VERS: $SETBIT 1 ;VERSION
JRST CMMD.2
WIDE: $SETBIT 4 ;WIDE
JRST CMMD.2
ASSOCI::$GETARG 3
MOVEM TF,SAV0 ; SAVE REG ZERO
SETZM TFLG ; TMP FLAG = 0
MOVE S1,2+(FP) ; filename pointer
MOVE T1,S1 ; TMP BYTE POINTER
MOVEI S2,5 ; NUMBER OF CHARS TO SEARCH
ASS.0: ILDB T2,T1 ; GET A BYTE
CAIN T2,":" ; IS THIS A STRUCTURE NAME?
SETOM TFLG ; YES
SOJG S2,ASS.0 ;
SKIPN TFLG ; device found
MOVE S2,XDSK ; default to dsk:
SKIPE TFLG ;
$CALL S%SIXB ; ascii to sixbit
MOVEM S2,STBFD+1 ; STRUCTURE NAME
$CALL S%SIXB
MOVEM S2,STBFD+2 ; FILE NAME
MOVE T1,FLAGS
TXNE T1,MHLP ; help switch set?
JRST ASS.1 ; yes extention follows
MOVE S1,3+(FP) ; ext pointer
JUMPE S1,ASS.2
ASS.1: $CALL S%SIXB
MOVEM S2,STBFD+3 ; EXT
ASS.2: MOVEI T1,6 ; LENGHT
HRLZM T1,STBFD+0
MOVEI T1,STBFD ;
MOVEM T1,STBFOB+0 ; SET ADDR OF FD
MOVEI T1,^D18 ; BYTE SIZE
CAMN S2,HEXT ; HELP FILE?
MOVEI T1,7 ; BYTE SIZE OF HELP FILE
MOVEM T1,STBFOB+1
MOVEI S2,STBFOB ; ADDR OF FOB
MOVEI S1,2 ; SIZE OF FOB
$CALL F%IOPN ; OPEN FILE FOR INPUT
SKIPT
JRST [SETZ S1,
MOVE TF,SAV0 ; RESTORE AC0
$TEXT ,<$Error cannot open symbol file >
POP P,FP ; RESTORE FRAME POINTER
POPJ P, ] ; ERROR
$CALL PUTIFN ; SAVE IFN
MOVE T1,1+(FP) ; INDEX
HRRM S1,(T1) ; RETURN INDEX
MOVEI S1,1 ; SET SUCCESS
MOVE TF,SAV0 ; RESTORE AC0
POP P,FP ; RESTORE FRAME POINTER
POPJ P,
OPEN:: $GETARG 3
MOVE S2,2+(FP) ; ACCESS MODE
MOVE S1,1+(FP) ; INDEX
MOVE S1,(S1)
SKIPN S1
JRST TTYOUT
POP P,FP ; RESTORE FRAME POINTER
CAMN S1,DMPBLK ; DUMPFILE ?
JRST OPN.1 ; OPEN DUMP
MOVEI S1,1 ; SET UP RETURN TRUE
POPJ P,
TTYOUT: CAIE S2,1
JRST TTY.1
SKIPE FILIFN
JRST TTY.1 ;
SETOM S1 ; NEG. IFN MEANS TTY
MOVEM S1,FILIFN ; SET -1 TERMINAL IO
AOS ENDPNT ;
TTY.1: MOVEI S1,1 ; SET UP RETURN TRUE
POP P,FP ; RESTORE FRAME POINTER
POPJ P, ; OPEN DONE
OPN.1: MOVE T1,S1 ; SAVE INDEX
MOVEI S1,2 ; SIZE
MOVEI S2,DMPFOB ; Address of FOB
MOVEM TF,SAV0
$CALL F%IOPN## ; Open Dump file
SKIPT
JRST [$TEXT ,<?Cannot open dumpfile>
SETZ S1,
MOVE TF,SAV0
POPJ P, ]
MOVEM S1,FILIFN(T1) ; STORE IFN
MOVE TF,SAV0
POPJ P,
CLOSE:: $GETARG 1
MOVEM TF,SAV0 ; SAVE AC0
MOVE S1,1+(FP) ; GET INDEX
MOVE S1,(S1)
POP P,FP ; RESTORE FP
ICLOSE: SKIPN S1 ; SKIP IF FILE
POPJ P, ; NOT OPEN
MOVE T1,S1 ; SAVE INDEX
$CALL GETIFN ; GET IFN
SKIPE S1
$CALL F%REL ; CLOSE
SETZM CURBYT+(T1) ; ZERO BYTE COUNT
SETZM FILIFN+(T1) ; ZERO
MOVE TF,SAV0
POPJ P, ; LEAVE
GETFIL::$GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE T3,2+(FP) ; POINTER
MOVE S1,1+(FP) ; INDEX
MOVE S1,(S1) ;
MOVE T1,S1
$CALL GETIFN ; GET IFN
SKIPN S1
JRST [$TEXT ,<?Bad IFN> ; ERROR GETTING IFN
SETZ S1,
MOVE TF,SAV0
POP P,FP ; RESTORE FP
POPJ P, ]
SETZ T2,
GET.1: $CALL F%IBYT ; GET A BYTE
JUMPF FILERR ; EOF?
IDPB S2,T3
AOS T2
CAME T2,3+(FP) ; DONE YET?
JRST GET.1
GET.2: ADDM T2,CURBYT+(T1) ; ADD IN LENTH
MOVE S1,T2 ; RET LENGTH
MOVE TF,SAV0
POP P,FP
POPJ P,
FILERR: CAIN S1,EREOF$ ; END OF FILE?
MOVE S1,T2
MOVE TF,SAV0
POP P,FP
POPJ P,
POSFIL::$GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE T1,3+(FP) ; OFFSET
MOVE T2,2+(FP) ; FBLOCK
MOVE S1,1+(FP) ; INDEX
POP P,FP ; RESETORE FP
MOVE S1,(S1) ;
MOVE T3,S1 ; SAVE INDEX
$CALL GETIFN ; GET IFN
SKIPN S1
JRST [$TEXT ,<?Bad IFN> ; ERROR GETTING IFN
MOVE TF,SAV0
SETZ S1,
POPJ P, ]
MOVE S2,T2 ; MOVE FOR CALL
SOS S2 ; FBLOCK-1
IMULI S2,^D512 ; *BLOCKSIZE
ADD S2,T1 ; ADD OFFSET
ASH S2,-1 ; DIV BY 2
MOVE T2,S2 ; SAVE POS
$CALL F%POS ; POSTION FILE
SKIPF
MOVEM T2,CURBYT(T3) ; SAVE POSTION
MOVE TF,SAV0 ; restore AC0
POPJ P,
FILPOS::$GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE S1,1+(FP) ; INDEX
MOVE S1,(S1)
MOVE S2,CURBYT+(S1) ; GET POS
LSH S2,1 ; MUL BY 2
MOVE T2,S2
MOVE T1,^D512 ; *BLOCKSIZE
IDIV T2,T1
AOS T2 ; FBLOCK+1
MOVE T1,2+(FP)
MOVEM T2,(T1) ; RET FBLOCK
MOVE T2,S2 ; RESTORE POS
IDIV T2,T1
MOVE T1,3+(FP) ;
MOVEM T2,(T1) ; RET OFFSET
MOVEI S1,1 ; SET STATUS
MOVE TF,SAV0 ; SAVE AC0
POP P,FP ; RESTORE FP
POPJ P,
PUTFIL::$GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE T3,3+(FP) ; LENGTH
MOVE T2,2+(FP) ; POINTER
MOVE S1,1+(FP) ; INDEX
POP P,FP ; RESTORE FP
MOVE S1,(S1) ;
MOVE TF,T3
ADDM T3,CURBYT(S1) ; SAVE POSTION
MOVE T1,[POINT 7,STEMP] ; DEST BYTE POINTER
PUT.1: ILDB S2,T2 ; GET A BYTE
IDPB S2,T1 ; PUT IT IN TEMP BUFFER
SOJG T3,PUT.1 ; DONE?
$CALL GETIFN ; GET IFN IN S1
SKIPN S1
JRST [$TEXT ,<?Bad IFN> ; ERROR GETTING IFN
MOVE TF,SAV0
SETZ S1,
POPJ P, ]
CAMN S1,[-1] ; TTY?
JRST PUTTTY
MOVEI S2,STEMP
HRL S2,TF
$CALL F%OBUF ; PUT A BYTE
SKIPT
JRST [$TEXT ,<?Error out putting a byte>
SETZ S1,
MOVE TF,SAV0 ; SAVE AC0
POPJ P, ]
MOVE TF,SAV0 ; SAVE AC0
POPJ P,
PUTTTY: MOVEI S2,0 ; SET NULL
IDPB S2,T1 ; TERMINATING NULL
MOVE S1,[POINT 7,STEMP]
PUSHJ P,K%SOUT ; OUTPUT STRING TO TTY
MOVE TF,SAV0 ; SAVE AC0
POPJ P,
FILNM:: $GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE T1,3+(FP) ; GET INDEX
MOVE T2,(T1)
MOVE S1,(T2) ; PRM_LIST
MOVE S1,(S1) ; INDEX IN S1
AOS T2 ; PRM_LIST+1
MOVEM T2,(T1) ; PRM_LST_ADR_ADR
$CALL GETIFN ; get IFN
SKIPN S1
JRST [$TEXT ,<?Bad IFN> ; ERROR GETTING IFN
MOVE TF,SAV0
SETZ S1,
POP P,FP ; RESTORE FP
POPJ P, ]
SETOM S2
$CALL F%FD
MOVE T1,1+(FP) ; GET POINTER
MOVE T1,(T1) ; DEST POINTER
$TEXT (<-1,,STEMP>,<^F/(S1)/>)
MOVE S2,[POINT 7,STEMP] ; SRC POINTER
SETZ S1, ; ZERO S1
NAM.1: ILDB T2,S2 ; MOVE BYTES
IDPB T2,T1 ; FROM TEMP STORAGE
AOS S1
CAIE T2,"." ; EXT?
JRST NAM.1
MOVEI T3,3
NAM.2: ILDB T2,S2 ; THIS ASSUMES
IDPB T2,T1 ; A THREE CHAR EXT.
AOS S1
SOJG T3,NAM.2
MOVE T2,1+(FP)
MOVEM T1,(T2)
SETZM STEMP ; ZERO
SETZM STEMP+1 ; TEMP STORAGE
SETZM STEMP+2
MOVE TF,SAV0 ; SAVE AC0
POP P,FP ; RESTORE FP
POPJ P,
FILDT:: $GETARG 3
MOVEM TF,SAV0 ; SAVE AC0
MOVE T1,3+(FP) ; GET INDEX
MOVE T2,(T1)
MOVE S1,(T2) ; PUT IDX IN S1
MOVE S1,(S1) ; INDEX IN S1
AOS T2
MOVEM T2,(T1) ; PRM_LIST+1
$CALL GETIFN ; RETURNS IFN IN S1
SKIPN S1
$TEXT ,<?Bad IFN> ; ERROR GETTING IFN
MOVEI S2,FI.CRE
$CALL F%INFO
MOVE T1,1+(FP) ; GET POINTER
MOVE T1,(T1) ; DEST POINTER
$TEXT (<-1,,STEMP>,<^H/S1/>)
MOVE S2,[POINT 7,STEMP] ; SRC POINTER
SETZ S1, ; LENGTH OF STRING
DAT.1: ILDB T2,S2 ; MOVE BYTES
CAIN T2,15 ; END OF STRING?
JRST DAT.2
IDPB T2,T1 ; FROM TEMP STORAGE
AOS S1
JRST DAT.1
DAT.2: MOVEI S2,6
DAT.3: SETZM STEMP+(S2) ; ZERO
SOJGE S2,DAT.3 ; TEMP STORAGE
MOVE T2,1+(FP)
MOVEM T1,(T2)
MOVE TF,SAV0 ; SAVE AC0
POP P,FP ; RESTORE FP
POPJ P,
GETTIM::$GETARG 1
MOVE T1,1+(FP) ; SET PARAMETER
POP P,FP ; RESTORE FP
PUSH P,TF ; SAVE REG
MOVEI S1,6 ; SIZE OF TIME BLOCK
TIM.1: SETZM TIMBLK+(S1) ; ZERO TIME BLOCK
SOJGE S1,TIM.1
SETZM TFLG ; ZERO FLAGS
SETZM HFLG ; TO USE
SETOM S1 ; GET CURRENT DATE
MOVE T3,[POINT 7,TIMBLK+1] ; INIT BYTE POINTER
MOVEM T3,TIMBLK+6 ; SAVE FOR LATER
$TEXT (CVTIME,<^H/S1/>) ;
MOVE T3,TIMBLK+1 ; MONTH
SETZM TIMBLK+6
SETOM T2
TIM.2: AOS T2
CAME T3,MONTH1(T2)
JRST TIM.2
AOS T2
MOVEM T2,TIMBLK+1
DMOVE T2,TIMBLK
DMOVEM T2,(T1)
DMOVE T2,TIMBLK+2
DMOVEM T2,2+(T1)
DMOVE T2,TIMBLK+4
DMOVEM T2,4+(T1)
POP P,TF
POPJ P, ; OK
CVTIME: CAIN S1,"-" ; HYPEN?
JRST CVT.1 ; SET FLAG
CAIN S1," " ; SPACE?
POPJ P, ; DISCARD SPACE
CAIN S1,":" ; COLON?
POPJ P, ; DISCARD COLON
CAIG S1,15 ; CR
POPJ P, ; DISCARD CRLF
CAIL S1,"0" ; A NUMBER?
CAILE S1,"9"
JRST CVT.3 ; NO-MUST BE MONTH
SUBI S1,"0" ; CONVERT TO INTEGER
SKIPN HFLG ;
JRST CVT.4 ; DATE
SKIPE TFLG
JRST CVT.5
SKIPE TIMBLK ; CONVERT THE YEAR
JRST [ADDM S1,TIMBLK
MOVEI S1,3
MOVEM S1,TFLG ; POSTION FLAG
POPJ P, ]
IMULI S1,12 ; MULL BY 10
MOVEM S1,TIMBLK ; ADD TO ONES
POPJ P,
CVT.1: SETOM HFLG
POPJ P, ; HYPEN SEEN
CVT.3: TRNE S1,100 ;MAKE UPPER-CASE
TRZ S1,40 ;IF NECESSARY
CAIL S1,"A" ; CONVERT MONTH
CAILE S1,"Z"
JRST [$TEXT ,<? Error converting time>
SETZ S1,
POPJ P, ]
MOVE T2,TIMBLK+6 ; RESTORE SAVED POINTER
IDPB S1,T2 ; MOVE TO TIMBLK+1
MOVEM T2,TIMBLK+6 ; SAVE POINTER
POPJ P,
CVT.4: MOVE S2,TIMBLK+2
IMULI S2,12
MOVEM S2,TIMBLK+2
ADDM S1,TIMBLK+2
POPJ P,
CVT.5: MOVE T2,TFLG
SKIPE TIMBLK+(T2) ; THIS CONVERTS
JRST [ADDM S1,TIMBLK+(T2) ; TIME
AOS TFLG
POPJ P, ]
IMULI S1,12 ; MULL BY 10
MOVEM S1,TIMBLK+(T2) ; SAVE
POPJ P,
PUTIFN: MOVE T1,ENDPNT ; END OF TABLE
MOVEM S1,FILIFN+(T1) ; SAVE IFN
MOVE S1,ENDPNT ; INDEX IN S1
AOS T1 ; UPDATE END
MOVEM T1,ENDPNT
POPJ P,
GETIFN: CAML S1,ENDPNT ; BAD INDEX?
JRST [$TEXT ,<?Bad Index>
POPJ P, ] ; YES
MOVE S2,FILIFN+(S1) ; GET IFN
MOVE S1,S2 ; IFN IN S1
POPJ P,
SETFGC: SETOM CFLG
POPJ P,
SETFGR: SETOM RFLG
POPJ P,
SUBTTL Rescan for command line
;THIS ROUTINE WILL SETUP THE CHARACTERS FROM THE RESCAN FOR PARSING
;
;RETURN S1/ COUNT OF CHARACTERS
X:
RESCN:
AOS XSTART ;Reset retry count
TOPS20 <
MOVEI S1,.RSINI ;Make characters available
RSCAN
ERJMP [$FATAL <Rescan JSYS failed, ^E/[-2]/>]
MOVEI S1,.RSCNT ;Get the number of characters available
RSCAN
ERJMP [$FATAL <Rescan JSYS failed, ^E/[-2]/>]
MOVE T1,S1 ;Put count in T1
MOVE T3,T1 ;ALSO SAVE IT IN T3
RESCN1: SOJL T1,RESCN2 ;Exit when count exhausted
$CALL K%BIN ;Read a byte
IDPB S1,T2 ;Store in rescan buffer
JRST RESCN1 ;Back to get the rest
> ;End TOPS20 conditional
TOPS10 <
RESCAN [1]
SETZ S1,
$CALL K%BIN ;YES, get it
TRNE S1,100 ;MAKE UPPER-CASE
TRZ S1,40 ;IF NECESSARY
CAIE S1,"M"
JRST RS.3
RS.1: $CALL K%BIN ; GO TILL
CAILE S1," " ; 1ST Space
JRST RS.1
CAIL S1," "
JRST RS.4
RS.3: SKPINC
JRST RS.4
$CALL K%BIN
JRST RS.3
RS.4:
> ;End TOPS10 conditional
RESCN2:
MOVX S1,IB.SZ ; Size of initialization block
MOVEI S2,IB ; Addrs of initialization block
$CALL I%INIT ; Re-initialize GLXLIB TTY
MOVE S1,DMPBLK
SKIPE S1
SETZM FILIFN(S1)
$RETT
;---Parser Data structures
PARBLK: $BUILD PARSIZ
$SET PAR.PM,,PRGPRM ; Program Prompt
$SET PAR.TB,,TOPPDB ; First PDB in command syntax
$EOB
TOPPDB: $INIT (TOP.1) ; Top level initialization
; (Note this must be in alpha order)
TOP.1: $IFILE (EOFPDB,<<Dump File name>>,$ALTERNATE(TOP.2))
TOP.2: $SWIDSP (SW0PDB)
SW0PDB: $STAB
DSPTAB (CFMPDB,.ALL,<ALL>)
DSPTAB (CFMPDB,.ANAL,<ANALYZE>)
DSPTAB (SW2PDB,.CEX,<CEX:>)
DSPTAB (SW3PDB,.DUMP,<DUMP:>)
DSPTAB (CFMPDB,.EXIT,<EXIT>)
DSPTAB (CFMPDB,.HELP,<HELP>)
DSPTAB (SW4PDB,.LIST,<LISTING:>)
; DSPTAB (SW5PDB,.PROC,<PROCESS>)
DSPTAB (SW6PDB,.RSX,<RSX:>)
DSPTAB (CFMPDB,.STAN,<STANDARD>)
; DSPTAB (SW7PDB,.STBS,<SYMBOLS>)
DSPTAB (SW8PDB,.TASK,<TASK:>)
DSPTAB (CFMPDB,.VERS,<VERSION>)
DSPTAB (CFMPDB,.WIDE,<WIDE>)
$ETAB
SW6PDB: $TOKEN (RX3PDB,<(>,$ALTERNATE(RX1PDB))
RX1PDB: $KEYDSP (RX2PDB)
RX2PDB: $STAB
DSPTAB (CFMPDB,.RALL,<ALL>)
DSPTAB (CFMPDB,.ATL,<ATL>)
DSPTAB (CFMPDB,.CLOCK,<CLOCK-QUEUE>)
DSPTAB (CFMPDB,.RCTXT,<CONTEXT>)
DSPTAB (CFMPDB,.DEV,<DEVICES>)
DSPTAB (CFMPDB,.RDMP,<DUMP>)
DSPTAB (CFMPDB,.FXD,<FXD>)
DSPTAB (CFMPDB,.HDR,<HEADERS>)
DSPTAB (CFMPDB,.PARS,<PARTITIONS>)
DSPTAB (CFMPDB,.PCBS,<PCBS>)
DSPTAB (CFMPDB,.RPL,<POOL>)
DSPTAB (CFMPDB,.RSTA,<STANDARD>)
DSPTAB (CFMPDB,.STD,<STD>)
$ETAB
RX3PDB: $KEYDSP (RX4PDB,$ALTERNATE(CX6PDB))
RX4PDB: $STAB
DSPTAB (RX5PDB,.RALL,<ALL>)
DSPTAB (RX5PDB,.ATL,<ATL>)
DSPTAB (RX5PDB,.CLOCK,<CLOCK-QUEUE>)
DSPTAB (RX5PDB,.RCTXT,<CONTEXT>)
DSPTAB (RX5PDB,.DEV,<DEVICES>)
DSPTAB (RX5PDB,.RDMP,<DUMP>)
DSPTAB (RX5PDB,.FXD,<FXD>)
DSPTAB (RX5PDB,.HDR,<HEADERS>)
DSPTAB (RX5PDB,.PARS,<PARTITIONS>)
DSPTAB (RX5PDB,.PCBS,<PCBS>)
DSPTAB (RX5PDB,.RPL,<POOL>)
DSPTAB (RX5PDB,.RSTA,<STANDARD>)
DSPTAB (RX5PDB,.STD,<STD>)
$ETAB
SW2PDB: $TOKEN (CX3PDB,<(>,$ALTERNATE(CX1PDB))
CX1PDB: $KEYDSP (CX2PDB)
CX2PDB: $STAB
DSPTAB (CFMPDB,.CALL,<ALL>)
DSPTAB (CFMPDB,.BUFS,<BUFFERS>)
DSPTAB (CFMPDB,.CCTXT,<CONTEXT>)
DSPTAB (CFMPDB,.CDMP,<DUMP>)
DSPTAB (CFMPDB,.FREE,<FREE>)
; DSPTAB (CFMPDB,.INTRP,<INTERPRET>)
DSPTAB (CFMPDB,.PDVS,<PDVS>)
DSPTAB (CFMPDB,.CPL,<POOL>)
DSPTAB (CFMPDB,.SLTS,<SLTS>)
DSPTAB (CFMPDB,.CSTA,<STANDARD>)
$ETAB
CX3PDB: $KEYDSP (CX4PDB,$ALTERNATE(CX6PDB))
CX4PDB: $STAB
DSPTAB (CX5PDB,.CALL,<ALL>)
DSPTAB (CX5PDB,.BUFS,<BUFFERS>)
DSPTAB (CX5PDB,.CCTXT,<CONTEXT>)
DSPTAB (CX5PDB,.CDMP,<DUMP>)
DSPTAB (CX5PDB,.FREE,<FREE>)
; DSPTAB (CX5PDB,.INTRP,<INTERPRET>)
DSPTAB (CX5PDB,.PDVS,<PDVS>)
DSPTAB (CX5PDB,.CPL,<POOL>)
DSPTAB (CX5PDB,.SLTS,<SLTS>)
DSPTAB (CX5PDB,.CSTA,<STANDARD>)
$ETAB
RX5PDB: $TOKEN (RX3PDB,<,>,$ALTERNATE(CX6PDB))
CX5PDB: $TOKEN (CX3PDB,<,>,$ALTERNATE(CX6PDB))
CX6PDB: $TOKEN (CFMPDB,<)>)
SW3PDB: $NUMBER (TOKPDB,^D8,<<'lower physical address limit'>>)
TOKPDB: $TOKEN (SW9PDB,<:>)
SW9PDB: $NUMBER (CFMPDB,^D8,<<'upper physical address limit'>>)
SW4PDB: $OFILE (CFMPDB,<<'Listing File name'>>) ; List file
SW8PDB: $QUOTE (CFMPDB,<<'task name'>>); Task Name
CFMPDB: $CRLF (<$ALTERNATE(TOP.1)>)
EOFPDB: $CRLF (<$ALTERNATE(TOP.2)>)
;---Random Data structures
SAV0: BLOCK 1
CFLG: BLOCK 1
RFLG: BLOCK 1
TFLG: BLOCK 1
HFLG: BLOCK 1
DMPFOB: BLOCK 2
LSTFOB: BLOCK 2
STBFOB: BLOCK 2
STBFD: BLOCK 6
FILIFN: BLOCK MAXFIL ; IFN TABLE
CURBYT: BLOCK MAXFIL ; POSTION TABLE
ENDPNT: BLOCK 1 ; END OF IFN TABLE
STEMP: BLOCK 100
PPAGE: BLOCK 1
DFLG: BLOCK 1
DNAM: BLOCK 1
DMPEXT: ASCIZ /.DMP/
TOPS10 <
XSYS: SIXBIT /SYS/
HEXT: SIXBIT /HLP/
XDSK: SIXBIT /DSK/ ; .FDSTR - STRUCTURE CONTAINING THE FILE
DMPFD: XWD BLKLEN,0 ; .FDLEN - LENGTH WORD
SIXBIT /DSK/ ; .FDSTR - STRUCTURE CONTAINING THE FILE
DMPNAM: SIXBIT /XDMP/ ; .FDNAM - FILE NAME
DEXT: SIXBIT /DMP/ ; .FDEXT - FILE EXTENSION
BLOCK 1 ; .FDPPN - OWNER OF THE FILE
BLOCK 5 ; . - SUB DIRECT PATH
BLKLEN=.-DMPFD
LSTFD: XWD LSTLEN,0 ; .FDLEN - LENGTH WORD
SIXBIT /DSK/ ; .FDSTR - STRUCTURE CONTAINING THE FILE
LSTNAM: SIXBIT /DMPLST/ ; .FDNAM - FILE NAME
LEXT: SIXBIT /LST/ ; .FDEXT - FILE EXTENSION
BLOCK 1 ; .FDPPN - OWNER OF THE FILE
BLOCK 5 ; . - SUB DIRECT PATH
LSTLEN=.-LSTFD
TIMBLK: BLOCK 7 ;
MONTH1: ASCIZ /JAN/
ASCIZ /FEB/
ASCIZ /MAR/
ASCIZ /APR/
ASCIZ /MAY/
ASCIZ /JUN/
ASCIZ /JUL/
ASCIZ /AUG/
ASCIZ /SEP/
ASCIZ /OCT/
ASCIZ /NOV/
ASCIZ /DEC/
END CMD