1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 17:09:15 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1137 lines
26 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;
;
;
; 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