Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0132/dumpr.mac
There are 2 other files named dumpr.mac in the archive. Click here to see a list.
SUBTTL B. SCHREIBER - UI HIGH ENERGY PHYSICS GROUP
SEARCH JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC .XTABM
SALL
;DUMPR VERSION INFORMATION
DMPVER==5 ;VERSION
DMPEDT==26 ;EDIT
DMPMIN==0 ;MINOR VERSION
DMPWHO==0 ;WHO
DEFINE CTITLE (TEXT,MAJVER,VEREDT)
<TITLE 'TEXT'MAJVER(VEREDT)>
CTITLE (<DUMPR - UTILITY FILE DUMPER %>,\DMPVER,\DMPEDT)
LOC .JBVER
%%DUMP==:VRSN. (DMP) ;FOR LINK-EDIT MAP
EXP %%DUMP
;SHOW UNIVERSAL VERSION
%%JOBD==:%%JOBD ;JOBDAT
%%UUOS==:%%UUOS ;UUOSYM
%%MACT==:%%MACT ;MACTEN
%%SCNM==:%%SCNM ;SCNMAC
;REQUEST REST OF LOADING NOW
IF2,< ;ONLY NEED TO REQUEST LOADING IN PASS 2
IFE FT$SEG,< ;IF LOADING RUNNING PART IN LOWSEG
.REQUE REL:HELPER
IFN FT$WLD,<.REQUE REL:WLD7A>
.TEXT \REL:ALCOR/SEG:LOW/SEARCH\
.TEXT \REL:SCN7B/SEG:LOW/SEARCH/EXCLUD:(.SCAN),REL:SCN7B/SEARCH\
>;END IFE FT$SEG
IFN FT$SEG,< ;IF LOADING IT ALL IN HIGH SEGMENT
.REQUE REL:ALCOR
.REQUE REL:SCN7B
IFN FT$WLD,<.REQUE REL:WLD7A>
.REQUE REL:HELPER
>;END IFN FT$SEG
>;END IF2
SUBTTL REVISION HISTORY
COMMENT \
1(1) 11/1/76 BIRTH
1(2) 11/2/76 RECOVER FROM BLOCK TOO LARGE WITH /FORTRA OR
/IREAD(ON DSK).
1(3) 11/4/76 MAKE DISK IREAD MUCH FASTER. WORD COUNTS FOR
NOT /LINRDX:DEC WILL START AT ZERO, RATHER
THAN ONE.
2(4) 11/4/76 IMPLEMENT /MODE:BYTE:N DUMP. ADD CODE FOR
SKIPPING FORTRAN BINARY ON MAGTAPE.
2(5) 11/5/76 IMPLEMENT /MTBUF AND /ERROR
2(6) 11/7/76 MAKE /MODE:ASCII WORK IF NOT /OMIT.
2(7) 11/10/76 MAKE CONTROL CHARACTERS VISIBLE IF/MODE:ASCII/OMIT.
CORRECT BYTE WIDTH COMPUTATION IF /RADIX ALSO.
2(10) 11/11/76 MAKE /DUMP:F:R WORK IF /SUM. CHANGE JRST DUMP$G
TO JRST DUMP.2 AT DUMP$G+7.
2(11) 11/14/76 MISC. CLEANUPS. IMPLEMENT "I" OPTION FOR IFTYP.
2(12) 11/15/76 SKIPE T3 IS REALLY SKIPE T2 AT GMBWID+6. THIS
FIXES PROBLEM WITH /MODE:BYTE DUMPS
2(13) 12/10/76 READ TTY WIDTH IF TTY DUMP AND NO /WIDTH GIVEN.
FEATURE TEST IREAD STUFF WITH FT$PHX. MISC. CODE
CLEANUPS.
3(14) 12/27/76 ADD WILDCARDING UNDER FT$WLD CONDITIONAL
3(15) 1/2/77 FINISH WILDCARDING (SINGLE INPUT SPEC ONLY). IF SPOOLED
OUTPUT AND WILDCARDS, THEN CLOSE AND REOPEN OUTPUT AFTER
EACH FILE. FIX UP EIGHT-BIT ASCII PRINTOUT TO MAKE
ALL CHARACTERS VISIBLE.
3(16) 1/2/77 FIX BUG AT DUMPEF (NO HISEG PRESENT IF FT$WLD=1)
3(17) 1/3/77 MAKE EBCDIC DUMP WORK. ADD /BLOCK TO SPECIFY
# CHARACTERS IN AN EBCDIC RECORD
4(20) 1/5/77 ADD /POSITION SWITCH.
4(21) 1/6/77 MISC. CLEANUPS
4(22) 1/27/77 ADD [DMPIPT INITIAL POSITION OF TAPE IS FILE N REC M]
TO SHOW WHERE THE TAPE IS INITIALLY
4(23) 1/27/77 SHOW FILE/RECORD POSITION ON INPUT ERRORS. DO A
WAIT WHEN ERROR HAPPENS TO MAKE SURE I/O IS OVER
4(24) 2/3/77 MTWAT BEFORE THE TAPOP. IN DMPINI WILL PROBABLY
CURE SOME OF THE PROBLEMS WITH FUNNY FILE AND
RECORD COUNTS.
4(25) 2/13/77 SEE IF DEVICE IS ALSO TTY IF MTA (IE NULL) AND
ZAP DV.MTA IF SO
5(26) 2/18/77 IMPLEMENT /MODE:HALF AND /MODE:SYMBOL
\;END OF HISTORY
SUBTTL ASSEMBLY / ACCUMULATOR DEFINITIONS
;ASSEMBLY DEFINES
ND LN$PDL,^D200 ;PDL SIZE
ND MY$NAM,'DUMPR ' ;MY NAME
ND MY$PFX,'DMP' ;MESSAGE PREFIX
ND LN$ACT,^D50 ;SIZE OF ACTION LIST
ND LN$CMD,^D20 ;SIZE OF BUFFER TO REMEMBER COMMANDS IN
MX$CMD==<LN$CMD*5>-1 ;MAX # CHARS IN COMMAND (LEAVE NULL ON END)
ND LN$TTL,^D30 ;LENGTH OF TITLE BLOCK (.NMUL IN SCAN IS THIS LONG)
ND DF$BFZ,^D1024 ;DEFAULT BUFFERSIZE IF NONE GIVEN
ND FT$SEG,0 ;1 = ALL EXECUTABLE CODE GOES IN HIGH SEGMENT
;0 = ONLY PUT SCAN IN HIGH SEGMENT AND THROW
; IT AWAY WHEN RUNNING
ND FT$OPT,1 ;1 = SCAN SWITCH.INI FOR SWITCHES ALSO
ND FT$PHX,1 ;1 = INCLUDE /IREAD SWITCH (FOR UI PHYSICS)
ND FT$WLD,1 ;1 = ALLOW INPUT WILDCARDING
ND FT$ISD,1 ;1 = INCLUDE INSTRUCTION SET DUMP
TWOSEG
IFN FT$SEG,<RELOC 400000>
IFE FT$SEG,<RELOC 0>
;DEFINE THE ACCUMULATORS
DEFINE AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>
ZZ==0
AC$ (F) ;FLAGS
AC$ (T1) ;T1-4 ARE TEMPORARY
AC$ (T2)
AC$ (T3)
AC$ (T4)
AC$ (P1) ;P1-4 ARE PERMANENT AND MUST BE PRESERVED
AC$ (P2)
AC$ (P3)
AC$ (P4)
AC$ (A) ;ACTION LIST POINTER
AC$ (DC) ;LH=DEVCHR LH FOR INPUT DEVICE
;RH=DEVCHR LH FOR OUTPUT DEVICE
AC$ (W) ;AOBJN PTR TO DATA DURING DUMP
AC$ (M) ;CURRENT DUMP MODE INDEX
AC$ (L) ;# WORDS/LINE IN CURRENT DUMP MODE
AC$ (Q) ;# CHARACTER POSITIONS/WORD IN CURRENT DUMP MODE
P=17 ;PUSHDOWN LIST POINTER
C=P4 ;CHARACTER FROM SCAN
N=P3 ;NUMBER OR WORD FROM SCAN
E1=P3 ;USED IN FLOATING POINT OUTPUT
E2=P4 ;DITTO
E3=A ;MORE
E4=DC ;AND MORE
E5=W ;AND THE LAST
SUBTTL FLAG DEFINITIONS
;FLAGS IN LH OF F
DEFINE FLAG$ (FLG)
<FL$'FLG==ZZ
ZZ==ZZ_-1
FL$'FLG==FL$'FLG>
ZZ==(1B0)
FLAG$ (FOR) ;1 = DO FORTRAN INPUT
$FLFOR==(FL$FOR) ;LEFT HANDED VALUE
IFN FT$PHX,<
FLAG$ (PHY) ;1 = DO IREAD (PHYSIX) INPUT
$FLPHY==(FL$PHY) ;LEFT HANDED VALUE
>;END IFN FT$PHX
IFE FT$PHX,<FL$PHY==0> ;DUMMY DEFINITION IF FEATURE TURNED OFF
FLAG$ (SUM) ;1 = /SUMMARY
$FLSUM==(FL$SUM) ;LEFT HANDED VALUE
FLAG$ (TOT) ;1 = /TOTALS
$FLTOT==(FL$TOT) ;LEFT HANDED VALUE
FLAG$ (OMI) ;1 = OMIT LINE NUMBERS (UNFORMATTED DUMP FOR ASCII)
$FLOMI==(FL$OMI) ;LEFT HANDED VALUE
FLAG$ (ITY) ;1 = /IFTYP
$FLITY==(FL$ITY) ;LEFT HANDED VALUE
FLAG$ (IND) ;1 = /INDUSTRY
$FLIND==(FL$IND) ;LEFT HANDED VALUE
FLAG$ (OUT) ;1 = OUTPUT SPEC HAS BEEN ALLOCATED
FLAG$ (NEG) ;1 = CURRENT # IS NEGATIVE IN INTFMT, FLTFMT
FLAG$ (TMP) ;GENERAL TEMPORARY FLAG (NOT SAVED OVER CALLS)
FLAG$ (MNP) ;1 = DOING FILE POSITIONING IN FORTRA/IREAD MODE
FLAG$ (EOT) ;END-OF-TAPE FLAG (2 EOFS IN A ROW)
FLAG$ (OLY) ;1 = THERE IS A /ONLY IN EFFECT
FLAG$ (FL2) ;TEMPORARY FLAG
FLAG$ (OPN) ;1 = OUTPUT FILE IS OPEN
FLAG$ (RDX) ;1 = A /RADIX WAS GIVEN
FLAG$ (IOF) ;FLAG FOR USE IN XCTIO AND BELOW
FLAG$ (ODN) ;OUTPUT HAS BEEN DONE
FL$SCN==FL$FOR!FL$PHY!FL$SUM!FL$TOT!FL$OMI!FL$IND ;FLAGS TO CLEAR AT CLRANS
FL$SCN==FL$SCN!FL$OUT!FL$ITY!FL$RDX
ZZ==1B18 ;OVER TO THE RIGHT HALF
FLAG$ (POS) ;1 = /POSITION SWITCH
;I/O CHANNELS
;0 USED BY HELPER
INPC==1 ;INPUT CHANNEL
OUTC==2 ;OUTPUT CHANNEL
ATSIGN==(1B13) ;I/O SWITCH FLAG FOR OPENIO
;MISCELLANEOUS BITS AND STUFF
$OKDVI==DV.MTA!DV.DIR ;INPUT CAN BE MTA OR DIRECTORY DEVICE
$OKDVO==DV.MTA!DV.DIR!DV.TTY!DV.LPT ;OUTPUT CAN BE ONE OF THESE
CW$ANY==3000 ;FORTRAN BINARY ANY LSCW PATTERN
CW$1O3==1000 ;FORTRAN BINARY LSCW TYPE 1 OR 3 PATTERN
CW$TY3==2000 ;FORTRAN BINARY LSCW TYPE 3 PATTERN
;FLAGS AND BITS FOR SWTCHS MACRO
FS$XXX==FS.NFS!FS.LRG!FS.NUE!FS.VRQ!FS.OBV!FS.NOS!FS.NCM ;BITS USED BY SCAN
;SEE SCNMAC.MAC FOR DESCRIPTION OF ABOVE BITS
FS$XTR==1B17 ;THIS SWITCH CAN TAKE EXTRA ARGUMENTS (/BACKSP:F:R)
FS$NVL==1B16 ;THIS SWITCH NEVER TAKES A VALUE
FS$INP==1B15 ;THIS SWITCH IS INPUT ONLY
FS$OUT==1B14 ;THIS SWITCH IS OUTPUT ONLY
;DEFINE THE FUNCTIONS
FN$END==-2 ;END OF ALL FUNCTIONS -- TERMINATE DUMP
FN$INP==-1 ;ALL FUNCTIONS FOLLOWING THIS ARE INPUT ONLY
DEFINE FUNCTS
<X (<MOD,ONL,DMP,BSP,SKP,REW,RIB>)>
DEFINE X(A)
<IRP A,<FN$'A==ZZ
ZZ==ZZ+1>>
ZZ==1 ;FUNCTIONS GO FROM 1-HIGHEST
FUNCTS ;DEFINE THE FUNCTIONS
;ALL POSITIONING FUNCTIONS MUST BE BETWEEN BSP AND REW
FN$TP1==FN$BSP ;FIRST LEGAL POSITIONING FUNCTION
FN$TPX==FN$REW ;LAST LEGAL POSITIONING FUNCTION
;OPDEFINES
OPDEF CALL [PUSHJ P,] ;SUBROUTINE CALL
SUBTTL ERROR MACRO DEFINITIONS
;ERROR. ($FLGS,$PFX,$MSG)
;
;$FLGS IS THE COMBINITATION OF THE FOLLOWING BITS:
EF$ERR==0 ;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
EF$FTL==400 ;FATAL ERROR--ABORT AND RESTART
EF$WRN==200 ;WARNING MESSAGE--CONTINUE
EF$INF==100 ;INFORMATIVE MESSAGE--CONTINUE
EF$NCR==40 ;NO FREE CRLF AFTER MESSAGE
DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>
ZZ==0 ;TYPE CODES ARE FROM 1-37
ETYP (DEC) ;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT) ;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX) ;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN) ;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR) ;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL) ;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
EF$MAX==ZZ ;MAX ERROR TYPE
IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>
;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF
NOOP== (CAI) ;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP
DEFINE ERROR. ($FLGS,$PFX,$MSG)
<CALL EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>
;WARN. FLGS,PFX,MSG
DEFINE WARN. ($FLGS,$PFX,$MSG)
<ERROR. EF$WRN!$FLGS,$PFX,$MSG>
;INFO. FLGS,PFX,MSG
DEFINE INFO. ($FLGS,$PFX,$MSG)
<ERROR. EF$INF!$FLGS,$PFX,$MSG>
;SAVE$ SAVES DATA ON THE STACK
DEFINE SAVE$ (X)
<XLIST
IRP X,<PUSH P,X>
LIST>
;RESTR$ RESTORES DATA FROM THE STACK
DEFINE RESTR$ (X)
<XLIST
IRP X,<POP P,X>
LIST>
;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE
DEFINE U ($NAME,$WORDS<1>)
<$NAME: BLOCK $WORDS>
;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG
DEFINE STRNG$ (S)
<MOVEI T1,[ASCIZ \S\]
CALL .TSTRG##>
;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY
DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>
;HIGH$ SWITCHES TO HIGH SEGMENT IF FT$SEG==0
DEFINE HIGH$
<IFE FT$SEG,<IFE CSEG$,<HILOC$==.
CSEG$==-1
RELOC LOLOC$>>
>
;LOW$ SWITCHES TO LOW SEGMENT IF FT$SEG==0
DEFINE LOW$
<IFE FT$SEG,<IFN CSEG$,<LOLOC$==.
CSEG$==0
RELOC HILOC$>>
>
;RELOC$ SETS UP LOLOC$ AND CSEG$ INITIALLY
DEFINE RELOC$
<IFE FT$SEG,<LOLOC$==400000 ;;POINT LOLOC$ AT HIGH SEGMENT
CSEG$== 0>> ;START OUT IN THE LOW SEGMENT (CSEG$=0)
;LIT$ FORCES OUT LITERALS IN CURRENT SEGMENT
DEFINE LIT$
<XLIST
LIT
LIST>
SUBTTL MAIN PROGRAM
RELOC$
;PROGRAM ENTRY POINT
DUMPR: TDZA T1,T1 ;NOT CCL
MOVEI T1,1 ;CCL
MOVEM T1,OFFSET ;SAVE FOR SCAN
IFE FT$SEG,< ;NEED TO SAVE THIS STUFF
SKIPE SAVRUN ;SAVED UUO ARGS?
JRST RUNSVD ;YES
MOVEM .SGNAM,SGNAM
MOVEM .SGPPN,SGPPN
MOVEM .SGDEV,SGDEV
MOVEM .SGLOW,SGLOW
SETOM SAVRUN
RUNSVD:>;END IFE FT$SEG
RESTRT: STORE 17,0,16,0 ;CLEAR ACS
STORE 17,FW$ZER,LW$ZER,0 ;AND STORAGE
RESET ;STOP ALL I/O
SKIPA P,.+1 ;SETUP PDP
INIPDP: IOWD LN$PDL,PDLIST
CALL .RECOR## ;RESET CORE
IFE FT$SEG,<CALL UPSCN> ;MAKE SURE HISEG IS THERE
MOVE T1,ISCNBL ;BLOCK FOR .ISCAN
CALL .ISCAN## ;INIT THE SCANNER
MOVEM T1,ISCNVL ;SAVE FOR LATER
SKIPN OFFSET ;CCL ENTRY?
SKIPE TLDVER ;TOLD WHO I AM?
JRST FILD.0 ;YES
STRNG$ <DUMPR %>
MOVE T1,.JBVER
CALL .TVERW##
CALL .TCRLF##
SETOM TLDVER
FILD.0: CALL SCNCMD ;SCAN A COMMAND
TRZE F,FL$POS ;WAS /POSITION GIVEN?
JRST MTAPOS ;YES--GO DO IT
SETO P1, ;FLAG OUTPUT NOT OPEN YET
FILD.2: CALL OPNINP ;OPEN INPUT FILE
IFN FT$WLD,<JRST FILD.9> ;WILD SAYS ALL DONE
AOSN P1 ;ONLY OPEN OUTPUT FILE FIRST TIME THRU
CALL OPNOUT ;AND OUTPUT FILE
IFE FT$SEG,<CALL DWNSCN> ;RELEASE HISEG WHILE RUNNING
CALL PROCMD ;PROCESS THE COMMAND
IFE FT$SEG,<CALL UPSCN> ;REGET HISEG IF WE LOST IT
CALL INPCLS ;CLOSE INPUT FILE
IFN FT$WLD,<
SKIPG LKWLFL ;ARE WILD FILES POSSIBLE (DTA/DSK)?
SKIPN .WLDFL## ;YES--AND ARE THERE ANY WILD FILES?
JRST FILD.9 ;NO--GO FINISH UP
MOVE T1,ODVNAM ;YES--GET OUTPUT DEVICE NAME
DEVTYP T1, ;SEE IF IT IS SPOOLED
JRST FILD.2 ;ASSUME NOT
TXNN T1,TY.SPL ;IS IT SPOOLED?
JRST FILD.2 ;NO--JUST GO AHEAD
CALL OUTCLS ;YES--MAKE A NEW FILE
CALL OPNOUT ; ...
JRST FILD.2 ;GO TO IT
>;END IFN FT$WLD
FILD.9: CALL OUTCLS ;CLOSE OUTPUT FILE
FILD.X: CALL .RUNCM## ;HANDLE /RUN IF SPECIFIED
SKIPE OFFSET ;EXIT 1, IF CCL ENTRY
CALL .MONRT## ;
JRST RESTRT ;AND RESTART
IFE FT$SEG,<LIT$> ;FORCE OUT LOW SEGMENT LITERALS
SUBTTL SCAN A COMMAND FROM THE USER
HIGH$ ;TO HIGH SEGMENT IF FT$SEG=0
SCNCMD: MOVE T1,TSCNBL ;FOR .TSCAN
CALL .TSCAN## ;SCAN THE COMMAND
IFN FT$OPT,<
MOVE T1,OSCNBL ;GET OSCAN ARG BLOCK
CALL .OSCAN## ;SCAN SWITCH.INI FOR SOME SWITCHES
>;END IFN FT$OPT
IFN FT$WLD,<
MOVEI T1,INPSPC ;SETUP PTR FOR WILD
MOVEM T1,WLDFIR ;...
>;END IFN FT$WLD
TRNN F,FL$POS ;/POSITION?
PJRST CHKCMD ;CHECK COMMAND FOR GOODNESS
POPJ P, ;YES--WILL CHECK GOODNESS LATER
;ARG BLOCK FOR .ISCAN
ISCNBL: XWD 5, .+1
IOWD N$CMDS,CMDLST
XWD OFFSET,MY$PFX
XWD TTINPT,0 ;MY INPUT SO WE CAN REMEMBER CMD
EXP 0
XWD DOPRMP,0
;ARG BLOCK FOR .TSCAN
TSCNBL: XWD 11, .+1
IOWD SWTL,SWTN
XWD SWTD,SWTM
XWD 0,SWTP
EXP -1
XWD CLRANS,CLRFIL
XWD AIN,AOUT
EXP 0
EXP 0
EXP STOSWT
IFN FT$OPT,<
OSCNBL: XWD 4, .+1
IOWD OPSWL,OPSWN
XWD OPSWD,OPSWM
EXP OPSWP
EXP -1
EXP 0
>;END IFN FT$OPT
;SCAN CALLS HERE TO PROMPT WITH T1 NEGATIVE IF CONTINUATION PROMPT
DOPRMP: SKIPL T1 ;FIRST OR CONT?
SKIPA T1,PRMPTM ;FIRST
MOVSI T1,'# ' ;CONTINUATION
PJRST .TSIXN## ;TYPE IT
PRMPTM: XWD MY$PFX,'> ' ;FIRST MSG
CMDLST: EXP MY$NAM ;MY NAME
N$CMDS==.-CMDLST
;SCAN CALLS HERE TO GET COMMAND CHARACTERS FROM TTY
TTINPT: INCHWL C ;GET A CHARACTER
SOSL SCMDCT ;ROOM TO STORE IT?
IDPB C,SCMDBP ;YES
POPJ P, ;RETURN WITH CHARACTER IN C
SUBTTL CHECK COMMAND FOR GOODNESS
CHKCMD: CALL OUTDFL ;DEFAULT OUTPUT SIDE
CALL INPDFL ;AND INPUT SIDE
SKIPG T1,USERDX ;/RADIX SPECIFIED
SKIPA T1,[EXP ^D8] ;NO--USE BASE 8
TLO F,FL$RDX ;REMEMBER /RADIX WAS SEEN FOR "OCTAL" DUMPING
MOVEM T1,USERDX ;...
TLNN F,FL$RDX ;SPECIFY /RADIX/
JRST CHKC.0 ;NO
CAIL T1,2 ;YES--CHECK LEGALITY
CAILE T1,^D16 ;...
ERROR. EF$ERR!EF$DEC,IAR,<ILLEGAL ARG FOR /RADIX - >
LSH T1,-2 ;DIVIDE BY 4
MOVE T1,WRDRDX(T1) ;GET A WIDTH FOR THE WORD
MOVEM T1,USRWID ;SAVE FOR DUMPING
CHKC.0: SKIPG T1,LINRDX ;WAS A LINE # RADIX SPECIFIED?
MOVEI T1,LRXDEC ;NO--DEFAULT
MOVEM T1,LINRDX ;SET IT IN
MOVE T1,IDVNAM ;GET INPUT REAL NAME
TLNE DC,(DV.MTA) ;MTA?
CAME T1,ODVNAM ;SAME DEVICE?
JRST CHKC.1 ;NO--ONWARD
ERROR. EF$SIX!EF$FTL,CUS,<CAN'T USE SAME MTA FOR INPUT AND OUTPUT - >
CHKC.1:
IFN FT$PHX,<
TLC F,FL$FOR!FL$PHY ;CAN'T HAVE /IREAD AND /FORTRAN
TLCN F,FL$FOR!FL$PHY ;SO MAKE SURE NOW
ERROR. EF$FTL,MSE,<MODE SPECIFICATION ERROR - /IREAD + /FORTRAN>
>;END IFN FT$PHX
TLC F,FL$SUM!FL$TOT ;CAN'T HAVE /SUMMARY AND /TOTALS
TLCN F,FL$SUM!FL$TOT
ERROR. EF$FTL,SWE,<SWITCH ERROR - /SUMMARY + /TOTALS>
POPJ P, ;COMMAND IS SANCTIFIED
WRDRDX: EXP ^D37 ;BASE 2
EXP ^D19 ;BASE 4
EXP ^D13 ;BASE 8
EXP ^D13 ;DUMMY
EXP ^D10 ;BASE 16
;DEFAULT INPUT SPECS
INPDFL: SKIPN T1,INPSPC+.FXDEV;DEFAULT DEVICE
MOVSI T1,'DSK' ;IS DSK
MOVEM T1,INPSPC+.FXDEV
DEVNAM T1, ;SEE WHO IT IS
JRST ILLIDV
MOVEM T1,IDVNAM
DEVCHR T1, ;GET BITS
TLNN T1,($OKDVI) ;CAN I USE IT?
JRST ILLIDV ;NO
HLL DC,T1 ;YES--SAVE DEVCHR BITS
TLNE DC,(DV.MTA) ;IS DEVICE A MAGTAPE?
JRST INPD.1 ;YES--CLEAR FILENAME AND EXTENSION
TLZE F,FL$IND ;NO--CLEAR /INDUSTRY IF GIVEN
WARN. 0,IND,</INDUSTRY NO-OP ON NON-MTA DEVICE>
MOVE T1,[SIXBIT /DUMPIT/] ;DEFAULT NAME
SETO T2,
SKIPN INPSPC+.FXNAM
MOVEM T2,INPSPC+.FXNMM
SKIPN INPSPC+.FXNAM
MOVEM T1,INPSPC+.FXNAM
HRLOI T1,'DAT' ;AND EXTENSION
MOVX T2,FX.NUL ;GET NULL EXTENSION BIT
TDNE T2,INPSPC+.FXMOD;WAS ANYTHING SET FOR EXTENSION?
MOVEM T1,INPSPC+.FXEXT;NO--USE A DEFAULT
POPJ P,
;HERE IF DEVICE SEEMS TO BE A MAGTAPE
INPD.1: TLNE DC,(DV.TTY) ;SEE IF IT IS ALSO A TTY (IE NUL:)
TLZ DC,(DV.MTA) ;YES--MAKE SURE WE DON'T TO MAGTAPE OPS
SETZM INPSPC+.FXNAM ;CLEAR NAME
SETZM INPSPC+.FXNMM ;AND MASK
SETZM INPSPC+.FXEXT ;AND EXTENSION
SETZM INPSPC+.FXDIR ;AND DIRECTORY
POPJ P, ;DONE
ILLODV: SKIPA T1,[EXP OUTSPC] ;ILLEGAL OUTPUT DEVICE
ILLIDV: MOVEI T1,INPSPC ;ILLEGAL INPUT DEVICE
ERROR. EF$FTL!EF$FIL,IDV,<ILLEGAL DEVICE >
;HERE TO DEFAULT OUTPUT SPECIFICATION
OUTDFL: MOVX T2,FX.NDV ;NULL DEVICE FLAG
TDNN T2,OUTSPC+.FXMOD;WAS IT REALLY A NULL DEVICE?
SKIPN T1,OUTSPC+.FXDEV;NO--PICK UP DEVICE IF GIVEN
MOVSI T1,'LPT' ;YES--USE DEFAULT
MOVEM T1,OUTSPC+.FXDEV
DEVNAM T1, ;SEE WHO IT REALLY IS
JRST ILLODV ;NOT ONE I KNOW
MOVEM T1,ODVNAM ;SAVE REAL NAME
DEVCHR T1, ;SEE WHAT SORT OF DEVICE IT IS
TLNN T1,($OKDVO) ;A DEVICE I LIKE?
JRST ILLODV ;NO
HLR DC,T1 ;SAVE DEVICE CHARACTERISTICS
MOVE T1,[SIXBIT /DUMPED/] ;DEFAULT FILENAME
SETO T2, ;AND MASK
SKIPN OUTSPC+.FXNAM ;NAME GIVEN?
MOVEM T2,OUTSPC+.FXNMM;NO--USE MY DEFAULT
SKIPN OUTSPC+.FXNAM
MOVEM T1,OUTSPC+.FXNAM
HRLOI T1,'LPT' ;FINALLY THE EXTENSION
SKIPN OUTSPC+.FXEXT
MOVEM T1,OUTSPC+.FXEXT
POPJ P,
SUBTTL SWITCH TABLE
DEFINE SWTCHS,<
SP *BACKSP,FN$BSP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SP BLOCK,S.BLKF,.SWDEC##,BKF,FS.NUE
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SP *DUMP,FN$DMP,.SWDEC##,MTN,FS$XTR!FS$INP!FS.VRQ
SL *ERROR,FLERR,ERR,ERRCON,FS.NUE
SS *FORTRA,<POINTR(F,$FLFOR)>,1,FS.NUE
SS IFTYP,<POINTR(F,$FLITY)>,1,FS.NUE
SS INDUST,<POINTR(F,$FLIND)>,1,FS$INP!FS.NUE
IFN FT$PHX,<SS *IREAD,<POINTR(F,$FLPHY)>,1,FS$INP!FS.NUE>
SL LINRDX,LINRDX,LRX,LRXDEC,FS.NUE
SL *MODE,FN$MOD,MOD,MODOCT,FS$XTR!FS$OUT
SP MTBUF,NMTBUF,.SWDEC##,MBF,FS.NUE
SS *NORETR,FLNTRY,1,FS$INP!FS.NUE
SS OMIT,<POINTR(F,$FLOMI)>,1,FS$OUT!FS.NUE
SP *ONLY,FN$ONL,.SWDEC##,ONL,FS$XTR!FS$INP
SS *POSIT,<POINTR(F,FL$POS)>,1,FS.NUE
SP RADIX,USERDX,.SWDEC##,RDX,FS$OUT!FS.NUE
SS *REWIND,FN$REW,FN$REW,FS$NVL
SS RIB,FN$RIB,FN$RIB,FS$NVL
SP *SKIP,FN$SKP,.SWDEC##,MTN,FS$XTR!FS.VRQ
SS SUMMAR,<POINTR(F,$FLSUM)>,1,FS$OUT!FS.NUE
SP TITLE,<POINT ^D65-LN$TTL,TITLEB>,.SWASQ##,,FS.NUE
SS *TOTALS,<POINTR(F,$FLTOT)>,1,FS$OUT!FS.NUE
SP *WIDTH,FLWIDT,.SWDEC##,WID,FS$OUT!FS.NUE
>
DM (BFZ,^D4096,^D2048,^D1024)
DM (BKF,177777,^D80,^D80)
DM (MBF,^D10,^D3,^D3)
DM (MTN,177777,177777,177777)
DM (ONL,177777,0,0)
DM (RDX,^D16,^D8,^D8)
DM (WID,^D132,^D80,^D80)
KEYS (ERR,<CONTIN,IGNORE,QUERY>)
KEYS (MOD,<ASCII,BYTE,EBCDIC,FLOAT,HALF,HEX,INTEGE,OCTAL,SIXBIT,SYMBOL>)
KEYS (LRX,<DECIMA,HEX,OCTAL>)
;NOW EXPAND THE SWITCH TABLE
DOSCAN (SWT)
SUBTTL SWITCH TABLE FOR OPTION SCAN
IFN FT$OPT,<
DEFINE SWTCHS,<
SP BUFSIZ,BUFSIZ,.SWDEC##,BFZ,FS.NUE
SL ERROR,FLERR,ERR,ERRCON,FS.NUE
SS IFTYP,<POINTR(F,$FLITY)>,1,FS.NUE
SL LINRDX,LINRDX,LRX,LRXDEC,FS.NUE
SP MTBUF,NMTBUF,.SWDEC##,MBF,FS.NUE
SP WIDTH,FLWIDT,.SWDEC##,WID,FS.NUE
>
DOSCAN (OPSW)
>;END IFN FT$OPT
SUBTTL COMMAND SCANNING SUBROUTINES
AIN:
SKIPE INPSPC+.FXDEV ;ALREADY BEEN HERE?
ERROR. EF$FTL,MIS,<MULTIPLE INPUT SPECIFICATIONS ILLEGAL>
SKIPN DUMPFL ;SEEN A /DUMP?
CALL HOLDMP ;NO--SET TO DUMP ENTIRE WHATEVER
HRROI T1,FN$END ;SEND END OF LIST
CALL PUTACT ;...
MOVEI T1,INPSPC ;GET ADDRESS
ALEN: MOVEI T2,.FXLEN ;AND SIZE
POPJ P,
AOUT:
SKIPE OUTSPC+.FXDEV ;BEEN HERE?
ERROR. EF$FTL,MOF,<MULTIPLE OUTPUT FILES ILLEGAL>
HRROI T1,FN$INP ;SET END OF OUTPUT FUNCTIONS
CALL PUTACT ;SEND TO LIST
TLO F,FL$OUT ;SET OUTPUT SPEC ALLOCATED
MOVEI T1,OUTSPC
PJRST ALEN
;SCAN CALLS HERE TO CLEAR ALL ANSWERS
CLRANS: SKIPA A,.+1 ;LOAD UP ACTION PTR
INIACT: IOWD LN$ACT,ACTLST
TLZ F,FL$SCN ;CLEAR SCAN FLAGS IN F
STORE T1,SCN$FZ,SCN$LZ,0 ;CLEAR WHAT SHOULD BE ZERO
STORE T1,SCN$FO,SCN$LO,-1 ;MINUS 1 WHAT SHOULD BE MINUS 1
MOVE T1,[POINT 7,CMDBFR] ;INIT PTR TO STORE COMMAND
MOVEM T1,SCMDBP ;...
MOVEI T1,MX$CMD ;AND COUNTER
MOVEM T1,SCMDCT ;...
POPJ P,
;SCAN CALLS HERE TO CLEAR FILE ANSWERS
CLRFIL:
POPJ P,
;CALL TO DUMP WHOLE TAPE
HOLDMP: MOVEI T1,FN$DMP ;FUNCTION
HRLOI T2,777777 ;A RIDICULOUSLY LARGE FILE/RECORD COUNT
;(USE NEG. # SO IF DSK INPUT WE KNOW
; NO /DUMP AND THEN DUMP WHOLE FILE)
PJRST PUTACT ;STOW AWAY AND RETURN
SUBTTL STORE SWITCHES
;SCAN CALLS HERE TO STORE SOME SWITCHES
;N=VALUE, T2=PTR (FN$XXX), T3=FLAGS (FS$XXX), P1=SWITCH INDEX
STOSWT: TLNN T3,(FS$OUT) ;OUTPUT ONLY?
JRST STOSWA ;NO
TLNE F,FL$OUT ;YES--OUTPUT ALLOCATED?
JRST E$$OSI ;NO--BOMB
STOSWA: TLNN T3,(FS$INP) ;INPUT ONLY?
JRST STOSWB ;NO
TLNN F,FL$OUT ;YES--OUTPUT ALLOCATED?
JRST E$$ISO ;NO--BOMB
STOSWB: TLNE T3,(FS$NVL) ;NEVER TAKE A VALUE?
JRST SWTST0 ;YES--THATS CORRECT
CAIN T2,FN$MOD ;THIS /MODE?
JRST STOMOD ;YES--DO DIFFERENTLY
TLNE T3,(FS$XTR) ;TAKE EXTRA ARGS?
CAIE C,":" ;YES--ARE THEY THERE?
JRST SWTST0 ;NO--JUST STORE
SAVE$ <N,T2> ;YES--SAVE VALUE, AND FUNCTION
CALL .DECNW## ;READ SECOND VALUE
RESTR$ <T1,T2> ;GET FUNCTION AND VALUE IN RIGHT ACS
MOVSS T2 ;POSITION FILE COUNT IN LH
HRR T2,N ;AND RECORD COUNT IN RH
PJRST PUTACT ;PUT ON ACTION LIST AND RETURN
SWTS0A: MOVEI N,1 ;NEVER TAKES A VALUE,MAKE SURE IT GETS DONE 1 X
SWTST0: MOVE T1,T2 ;POSITION FUNCTION
HRRZ T2,N ;AND VALUE
; PJRST PUTACT ;STORE PARAMS AND RETURN
;PUTACT -- STORE PARAMETERS IN ACTION LIST
;CALL: MOVE T1,<FUNCTION>
; MOVE T2,<VALUE>
; CALL PUTACT
PUTACT: PUSH A,T1 ;STORE FUNCTION
PUSH A,T2 ;AND VALUE
CAIN T1,FN$DMP ;THIS THE /DUMP?
SETOM DUMPFL ;YES--SAY WE HAVE ONE
POPJ P,
STOMOD: CAIE N,MODBYT ;/MODE:BYTE?
JRST SWTST0 ;NO--DO NORMALLY
CAIE C,":" ;MUST HAVE A VALUE
ERROR. EF$FTL,BRB,</BYTE REQUIRES BYTESIZE>
SAVE$ <N,T2> ;SAVE MODBYT, FN$MOD
CALL .DECNW## ;READ BYTESIZE
RESTR$ <T1,T2> ;FN$MOD IN T1, MODBYT IN T2
CAILE N,0 ;CAN'T VERY WELL HAVE NEGATIVE BYTE SIZES
CAILE N,^D36 ;OR GREATR THAN ONE WORD
JRST E$$IBS ;SO TELL HIM ITS ILLEGAL AND QUIT
HRL T2,N ;PUT BYTESIZE IN LH
PJRST PUTACT ;SET ON ACTION LIST AND RETURN
E$$IBS: MOVE T1,N ;POSITION TO TELL USER WHAT IS ILLEGAL
ERROR. EF$FTL!EF$DEC,IBS,<ILLEGAL BYTE SIZE - >
E$$OSI: MOVE T1,SWTN(P1) ;OUTPUT SWITCH ON INPUT SIDE
ERROR. EF$FTL!EF$SIX,OSI,<OUTPUT SWITCH ILLEGAL ON INPUT - >
E$$ISO: MOVE T1,SWTN(P1) ;INPUT SWITCH ON OUTPUT SIDE
ERROR. EF$FTL!EF$SIX,ISO,<INPUT SWITCH ILLEGAL ON OUTPUT - >
SUBTTL DO /POSITION SWITCH
MTAPOS: CALL CKPOSC ;CHECK FOR ILLEGAL FUNCTIONS, NEVER RETURN IFSO
MOVE T1,INPSPC+.FXDEV;GET INPUT NAME
DEVCHR T1, ;SEE WHAT IT IS
TXNN T1,DV.MTA ;IS IT A MAGTAPE?
JRST ILLIDV ;NO--GO QUIT NOW
CALL INWLDO ;OPEN THE UNIT
JRST RESTRT ;SNH
CALL MNPXCI ;DO MTA MANIPULATIONS
CALL INPCLS ;CLOSE INPUT
JRST FILD.X ;GO DO RUN COMMAND, EXIT 1, OR RESTRT
;ROUTINE TO CHECK FUNCTION LIST FOR BADDIES
CKPOSC: MOVEI T1,ACTLST ;POINT AT THE LIST
CKPS.1: HRRZ T2,(T1) ;GET A FUNC
ADDI T1,2 ;MOVE TO NEXT FUNCTION
CAIN T2,FN$END ;IS THIS THE END?
POPJ P, ;YES
MOVSI T3,-N$MTAF ;SETUP AOBJN
CAME T2,LGLMTF(T3) ;IS THIS IT?
AOBJN T3,.-1 ;NO--CHECK ALL
JUMPL T3,CKPS.1 ;GO CHECK NEXT IF THIS ONE OK
ERROR. EF$FTL,IPF,<ILLEGAL POSITIONING FUNCTION>
;TABLE OF LEGAL POSITIONING FUNCTIONS
LGLMTF: EXP FN$BSP,FN$SKP,FN$REW,FN$DMP ;FN$DMP IS IGNORED LATER
N$MTAF==.-LGLMTF
;ROUTINE TO WHIP THROUGH ACTLST AND EXECUTE MTA FILE POSITIONING ONLY
;THE LIST MUST CONTAIN ONLY FILE POSITIONING COMMANDS AND FN$END
MNPXCI: CALL .SAVE4## ;PRESERVE 4 REGISTERS
MOVEI P1,(Z INPC,) ;SETUP THE CHANNEL
MOVEI P2,ACTLST ;POINT AT THE LIST
MNPX.2: HRRZ T1,(P2) ;GET NEXT THING
CAIN T1,FN$END ;IS THIS THE END?
POPJ P, ;YES--ALL DONE
HLRZ P3,1(P2) ;GET POSSIBLE FILE COUNT
HRRZ P4,1(P2) ;AND POSSIBLE RECORD COUNT
ADDI P2,2 ;MOVE TO NEXT THING
JRST @MNPDSP-FN$BSP(T1) ;DISPATCH
EXP MNPX.2 ;IGNORE /DUMP
MNPDSP: EXP MNP.BS
EXP MNP.SK
EXP MNP.RW
MNP.RW: MOVE T1,[MTREW.] ;SETUP FUNCTION TO EXECUTE
SETZ T3, ;CLEAR COUNT
MNPXDG: CALL MNP.XX ;DO THE REWIND
JRST MNPX.2 ;GO GET NEXT THING
;GET HERE WITH T1 HAVING MTAPE TO DO (MINUS CHAN), AND T3=# TIMES TO DO IT
MNP.XX: TLO T1,(P1) ;SETUP THE CHANNEL
XCT T1 ;DO IT ONE TIME
SOJG T3,.-1 ;DO IT ALL WE NEED TO
POPJ P,
MNP.SK:
MNP.BS: SKIPLE P4 ;ANY RECORDS TO DO?
PUSH P,[EXP <MTBSR.>,<MTSKR.>]-FN$BSP(T1) ;YES--SETUP FOR IT
SKIPLE P3 ;ANY FILES TO DO?
PUSH P,[EXP <MTBSF.>,<MTSKF.>]-FN$BSP(T1) ;YES--
MNP.BF: SKIPG T3,P3 ;CHECK/PICKUP FILE ACTION
JRST MNP.B1 ;NO--CHECK RECORD ACTION
POP P,T1 ;YES--GET MTAPE
CALL MNP.XX ;DO IT
MNP.B1: SKIPG T3,P4 ;CHECK/PICKUP RECORD ACTION
JRST MNPX.2 ;NO--GET NEXT THING
POP P,T1 ;YES--GET MTAPE
JRST MNPXDG ;GO DO IT AND LOOP FOR MORE ACTION
SUBTTL WILD CARD HANDLING FOR INPUT FILE
IFN FT$WLD,<
;ROUTINE TO CALL .LKWLD AND OPEN/LOOKUP THE FILE PRESENTED
;CPOPJ IF NO FILE FOUND
;CPOPJ1 IF OPENED OK
INWLDO: MOVE T1,[XWD SVINOB,OPNBLK] ;RESET OPNBLK IN CASE NOT FIRST TIME
BLT T1,OPNBLK+.OPBUF
INWL.1: MOVE T1,LKWLDB ;GET THE ARG BLOCK
CALL .LKWLD## ;FIND A FILE TO DO
POPJ P, ;CAN'T FIND ANYTHING
MOVEM T2,LKWLFL ;SAVE FLAG FOR LATER (IN CASE MTA)
MOVEI T1,.IOBIN ;USE BINARY MODE
HRRM T1,OPNBLK+.OPMOD
MOVEI T1,IBHR ;SETUP MY BUFFER HEADER ADDRESS
MOVEM T1,OPNBLK+.OPBUF
OPEN INPC,OPNBLK ;OPEN THE DEVICE
JRST [CALL E.DFO## ;REPORT OPEN ERROR
JRST INWL.1] ;KEEP GOING TILL .LKWLD SAYS DONE
SKIPLE LKWLFL ;DO WE NEED TO DO A LOOKUP?
JRST $POPJ1 ;NO--THEN WHY BOTHER (NOT DIR DEVICE)
LOOKUP INPC,LKPBLK ;FIND THE FILE
JRST [CALL E.DFL## ;REPORT ERROR
JRST INWL.1] ;AND KEEP LOOKING
SKIPG INPSPC+.FXFLM ;ENSURE .FXFLM IS RIGHT
SETOM INPSPC+.FXFLM ;SO .CHKTM WILL WORK WRIGHT
CALL .CHKTM## ;CHECK DATE/TIME CONSTRAINTS
JRST INWL.1 ;FAILED--GET NEXT FILE
JRST $POPJ1 ;OK--SKIP BACK WITH THE FILE
LKWLDB: XWD 5,.+1
XWD WLDFIR,0
XWD OPNBLK,LKPBLK
XWD .FXLEN,.RBTIM+1
EXP 1B0+WLDPTR
EXP 0
>;END IFN FT$WLD
IFE FT$SEG,<LIT$>
LOW$ ;TO LOW SEGMENT IF FT$SEG=0
SUBTTL HIGH SEGMENT HANDLERS
IFE FT$SEG,< ;NOT NECESSARY IF LOAD ALL IN HIGH SEGMENT
;CALL DWNSCN TO REMOVE HIGH SEGMENT
DWNSCN: SKIPN .JBHRL ;SEG AROUND?
POPJ P, ;NO--DON'T DO CORE UUO NOW
SAVE$ T1 ;PRESERVE T1
MOVSI T1,1 ;YES--GET RID OF IT
CORE T1, ;BYE/!
JFCL ;SNH
JRST TPOPJ ;RESTORE T1 AND RETURN
;CALL UPSCN TO REGET THE HIGH SEGMENT
UPSCN: SKIPE .JBHRL ;SCAN AROUND?
POPJ P, ;YES--SKIP COSTLY GETSEG
MOVEM 17,SAVAC+17 ;GETSEG DESTROYS ACS
MOVEI 17,SAVAC
BLT 17,SAVAC+16 ;SAVE ALL
SEGAGN: MOVE T1,SGDEV ;SETUP FOR GETSEG
MOVE T2,SGNAM
MOVE T3,SGLOW
SETZB T4,P2
MOVE P1,SGPPN
MOVEI P3,T1 ;POINT AT THE BLOCK
GETSEG P3,
SKIPA T1,P3 ;FAILED!--GET ERROR CODE IN T1
JRST [MOVSI 17,SAVAC
BLT 17,17
POPJ P,]
MOVE P,INIPDP ;RESET PDP (WILL GET RESTORED IF WE GET SEG)
ERROR. EF$OCT!EF$ERR,CGH,<CAN'T GET HIGH SEGMENT, CODE = >
EXIT 1,
JRST SEGAGN ;MAYBE IT WAS JUST LOST?
>;END IFE FT$SEG
SUBTTL OPEN FILES
;CALL HERE TO OPEN INPUT FILE
;ALWAYS RETURN CPOPJ IF FT$WLD=0
;IF FT$WLD=1, IF NO FILE FOUND RETURN CPOPJ, ELSE RETURN CPOPJ1 WITH GOODIES
OPNINP:
IFE FT$WLD,<
MOVEI T1,INPSPC ;POINT AT THE SPEC
CALL OPENIO ;OPEN THE DEVICE (LOOKUP FILE IF NEEDED)
CAI INPC,IBHR(.IOBIN) ;
>;END IFE FT$WLD
IFN FT$WLD,<
CALL INWLDO ;OPEN INPUT FILE
POPJ P, ;CAN'T FIND ANY--ALL DONE
AOS (P) ;SETUP TO SKIP BACK--WE HAVE A FILE
>;END IFN FT$WLD
MOVS T1,[XWD SVINOB,OPNBLK] ;SETUP TO SAVE OPEN/LOOKUP BLOCK
BLT T1,SVINLK+.RBTIM;COPY IT OVER
MOVE T1,LKPBLK+.RBSIZ;GET SIZE OF FILE IN WORDS
LSH T1,-7 ;CVT TO BLOCKS
AOJ T1, ;...
MOVEM T1,IFILSZ ;SAVE FOR LATER (POSITIONING)
OPNI.A: TLNN DC,(DV.MTA) ;INPUT MTA?
JRST OPNI.1 ;NO
CALL .SAVE3## ;YES--SAVE REGISTERS
MOVEI P1,INPSPC ;POINT AT SPEC
MOVEI P2,INPC ;AND CHANNEL
MOVEI P3,INPC ;FOR MTCHR
MTCHR. P3,
SETZ P3, ;SNH
CALL SETCHR ;SET /DENSITY AND /PARITY
TLNE F,FL$IND ;/INDUSTRY?
MTIND. INPC, ;YES--SETUP FOR IT
SKIPLE FLNTRY ;/NORETRY?
JRST [GETSTS INPC,T1 ;YES--GET STATUS
SETSTS INPC,IO.NRC(T1) ;SET NO RETRY
JRST .+1]
OPNI.1: SKIPG T1,BUFSIZ ;/BUFSIZ GIVEN?
MOVEI T1,DF$BFZ ;NO--USE A K
MOVEM T1,BUFSIZ ;SET IN CASE WE DEFAULTED
;NOTE THAT .ALCBF WILL ADJUST BUFFER
;TO 128. FOR DSK OR 127. FOR DTA
HRLI T1,6 ;ASSUME DISK INPUT
TLNN DC,(DV.MTA) ;BUT SEE IF MAGTAPE
JRST OPNI.2 ;NO--SIX IS RIGHT
SKIPG T2,NMTBUF ;DID USER SPECIFY /MTBUF?
MOVEI T2,2 ;NO--USE 2
HRLI T1,(T2) ;SET CORRECT BUFFER COUNT
OPNI.2: SKIPA T2,.+1 ;OTHER ALCBUF ARGWORD
XWD OPNBLK,IBHR
CALL .ALCBF## ;SETUP BUFFERS
TLNN DC,(DV.MTA) ;DSK OR DTA INPUT?
TLNN F,FL$FOR!FL$PHY ;AND /IREAD OR /FORTRAN?
TLNE F,FL$FOR ;BUT IF /FORTRAN ON TAPE
SKIPA T1,BUFSIZ ;YES--NEED TO ALLOCATE FORBUF
POPJ P, ;NO--WE ARE DONE
CALL .ALCOR## ;ALLOCATE FORTRA/IREAD BUFFER
MOVEM T1,FORADR ;SAVE FOR LATER USAGE
POPJ P,
;COME HERE TO CLOSE INPUT DEVICE
INPCLS: CLOSE INPC,
RELEASE INPC,
SKIPE T1,FORADR ;WAS THERE A FORTRA/IREAD ARRAY?
CALL .DECOR## ;YES--MAKE IT GO AWAY
SETZM FORADR ;CLEAR IN CASE
MOVEI T1,IBHR
; PJRST TSTBHR ;FREE UP BUFFERS
;HERE TO FREE BUFFERS IF THEY WERE ALLOCATED
TSTBHR: SKIPN .BFADR(T1) ;USED?
POPJ P, ;NO--QUIT NOW
SAVE$ T1 ;SAVE ADDRESS
CALL .FREBF## ;FREE BUFFERS
RESTR$ T1 ;RESTORE ADDRESS
SETZM .BFADR(T1)
SETZM .BFPTR(T1)
SETZM .BFCTR(T1)
POPJ P,
;HERE TO CLOSE OUTPUT FILE
OUTCLS: TLZE F,FL$ODN ;WAS ANY OUTPUT DONE?
TDZA T1,T1 ;YES--PRESERVE THE FILE
MOVEI T1,CL.RST ;NO--MAKE FILE DISSAPPEAR
CLOSE OUTC,(T1) ;FINISH WRITING THE FILE
RELEASE OUTC,
TLZ F,FL$OPN ;NOT OPEN NOW
MOVEI T1,OBHR
PJRST TSTBHR
;HERE TO OPEN OUTPUT FILE
OPNOUT: MOVEI T1,OUTSPC ;SETUP
CALL OPENIO ;DO IT
CAI OUTC,@OBHR(.IOASC)
TRNE DC,(DV.MTA) ;IS OUTPUT DEVICE MTA?
JRST OPNO.1 ;NO
CALL .SAVE3## ;YES--SAVE P1-3
MOVEI P1,OUTSPC
MOVEI P2,OUTC
MOVEI P3,OUTC
MTCHR. P3,
SETZ P3, ;...SNH
CALL SETCHR ;SET /DENSITY AND /PARITY
OPNO.1: MOVSI T1,6 ;USE 6 BUFFERS
TRNE DC,(DV.MTA) ;UNLESS MTA
MOVSI T1,2 ;IN WHICH CASE USE 2
SKIPA T2,.+1 ;
XWD OPNBLK,OBHR
CALL .ALCBF##
OUTPUT OUTC, ;DO DUMMY OUTPUT
TLO F,FL$OPN ;OUTPUT FILE IS OPEN FOR BUSINESS
TLZ F,FL$ODN ;NO OUTPUT DONE YET, THO
POPJ P,
SUBTTL SET MAGTAPE CHARACTERISTICS
;SETCHR -- SET TAPE CHARACTERISTICS
;CALL: MOVEI P1,<SPEC ADDR>
; MOVEI P2,<CHANNEL>
; MOVE P3,<AC RESULT OF MTCHR. UUO>
; CALL SETCHR
; *RETURN*
SETCHR: LDB T1,[POINTR (.FXMOD(P1),FX.DEN)] ;GET /DENSITY: VALUE
JUMPE T1,SETC.1 ;JUMP IF NONE
XCT SETDEN(T1) ;SET THE DENSITY
MOVE T1,[XWD 3,T2] ;TAPOP. ARG
MOVEI T2,.TFDEN+.TFSET;FUNCTION
MOVE T3,P2 ;CHANNEL
CALL DOTPOP ;DO TAPOP.
SETC.1: LDB T1,[POINTR(.FXMOD(P2),FX.PAR)] ;/PARITY: VALUE
XCT SETPAR(T1) ;SET THE PARITY
POPJ P,
SETDEN: JFCL ;SNH
CALL DEN200 ;200 BPI
CALL DEN556 ;556 BPI
MOVEI T4,.TFD80 ;800 BPI
CALL DEN160 ;1600 BPI
CALL DEN625 ;6250 BPI
MOVE T4,T1 ;(6)
MOVE T4,T1 ;(7)
DEN556:
DEN200: TRNN P3,MT.7TR ;MUST BE 7 TRACK
E$$ID9: ERROR. EF$FTL,ID9,<ILLEGAL DENSITY FOR 9-TRACK>
MOVE T4,T1 ;SETUP DENSITY
POPJ P,
DEN625:
DEN160: TRNE P3,MT.7TR ;CAN'T BE 7 TRACK
E$$ID7: ERROR. EF$FTL,ID7,<ILLEGAL DENSITY FOR 7-TRACK>
MOVE T4,T1
POPJ P,
SETPAR: JFCL ;ODD IS THE DEFAULT
CALL EVNPAR ;SET EVEN
EVNPAR: MOVE T1,[XWD 3,T2] ;ARGWORD
MOVEI T2,.TFPAR+.TFSET;FUNCTION
MOVE T3,P2 ;CHANNEL
MOVEI T4,1 ;EVEN PARITY
; PJRST DOTPOP ;DO AND RETURN
;FALL THROUGH TO DOTPOP
;DOTPOP -- DO A TAPOP WITH ERROR REPORTING
;CALL: MOVE T1,[ARGBLOCK]
; MOVEI T2,<FUNCTION>
; MOVE T3,<TAPNAM,IOCHAN, OR SOMETHING JUST AS GOOD>
; MOVE T4,<ARG>
; CALL DOTPOP
; *RETURN*
DOTPOP: TAPOP. T1, ;DO IT
CAIA ;FAILED--REPORT ERROR
POPJ P, ;OK
ETAPOP: SAVE$ <T4,T3,T2,T1> ;SAVE ON PDL
WARN. EF$OCT!EF$NCR,TUF,<TAPOP. UUO FAILURE--CODE = >
STRNG$ < - FN=>
MOVE T1,-1(P) ;GET FN (WAS IN T2)
CALL .TOCTW##
CALL .TCRLF##
RESTR$ <T1,T2,T3,T4>
POPJ P,
SUBTTL PROCESS THE COMMAND LIST
;THIS IS THE HEART OF THE DUMPR PROGRAM. IT GETS THE FUNCTIONS OFF
;OF THE ACTION (COMMAND) LIST AND PROCESSES THEM.
PROCMD: CALL .SAVE4## ;SAVE P1-4
CALL DMPINI ;INITIALIZE
MOVEI A,ACTLST ;SETUP A TO POINT TO ACTION LIST
TLZA F,FL$OUT ;FLAG WE ARE ON OUTPUT SIDE OF THINGS
DMPINP: TLO F,FL$OUT ;FLAG WE ARE ON INPUT SIDE OF THINGS
DMPLUP: MOVE T1,(A) ;GET A COMMAND
HLRE P1,1(A) ;GET LH OF ARG WORD (USUALLY FILE COUNT)
HRRZ P2,1(A) ;GET RH OF ARG WORD (USUALLY RECORD COUNT)
ADDI A,2 ;MOVE TO NEXT ACTION
JRST @DMPDSP(T1) ;GO TO IT
EXP DMPEND ;(-2) END IT ALL
EXP DMPINP ;(-1) ALL POSITIONING SWITCHES FOLLOWING
; ARE FOR INPUT SIDE
DMPDSP: HALT . ;(0) SHOULD NOT HAPPEN
DEFINE X(A) ;MACRO TO GENERATE REST OF TABLE
<IRP A,<EXP D$'A>>
FUNCTS ;GENERATE REST OF TABLE
;INITIALIZE FOR THE COMMAND PROCESSING
DMPINI: STORE T1,RUN$FZ,RUN$LZ,0 ;CLEAR SOME THINGS
TLNE DC,(DV.MTA) ;IS INPUT MAGTAPE?
TLNE F,FL$FOR ;AND NOT /FORTRAN?
JRST DMPI.1 ;NOT MTA OR MTA AND /FORTRAN
MOVEI T1,.TFSTA ;ATTEMPT TO DIVINE THE TAPE'S LOCATION
MOVEM T1,TAPOBL-3 ;WITH A TAPOP.
MOVEI T1,INPC ;HOPE TAPUUO LIKES CHANNEL ARGS TODAY
MOVEM T1,TAPOBL-2 ;...
MOVE T1,[XWD 5,TAPOBL-3] ;ARGWORD
MTWAT. INPC, ;FIRST MAKE SURE THE TAPE HAS STOPPED MOVING!
TAPOP. T1, ;ASK MONITOR WHERE THE TAPE IS
JFCL ;(IGNORE ERROR)
DMPI.1: SETZB M,W ;DEFAULT IS OCTAL MODE
CALL D$MSET ;SET UP L AND Q
TLZ F,FL$EOT!FL$OLY!FL$MNP ;CERTAINLY NOT END OF TAPE
CALL INIHDR ;OUTPUT INITIAL HEADER MESSAGE
SKIPG T1,S.BLKF ;GET BLOCKING FACTOR IN CASE EBCDIC
MOVEI T1,AD.BKF ;NOT SPECIFIED--GET DEFAULT
MOVEM T1,S.BLKF ;SET IN CASE NEEDED
MOVEM T1,EBCKNT ;AND THE COUNTER ALSO
POPJ P, ;DONE
;DISPATCH TABLE FOR DUMPING WORDS
DMPWRD: EXP FMTOCT ; 0--RADIX 8
EXP O$ASCW ; 1--ASCII
EXP O$BYTW ; 2--BYTE
EXP E$$EIW ; 3--EBCDIC
EXP FMTFLO ; 4--FLOAT
EXP [HALT] ; 6--HALF (SNH)
EXP O$HEXW ; 5--HEX
EXP FMTINT ; 6--INTEGER
EXP FMTOCT ; 7--OCTAL
EXP O$SIXN ;10--SIXBIT
EXP O$SYMW ;11--SYMBOL
E$$EIW: ERROR. EF$FTL,EIW,<EBCDIC ILLEGAL WITHOUT /INDUSTRY>
SUBTTL MAJOR DUMP LOOP
DUMPIT: SOJGE L,DUMP.1 ;ROOM LEFT ON LINE?
CALL D$NEWL ;NO--MAKE NEW LINE
SOJ L, ;DON'T FORGET TO COUNT WORD WE DUMP NOW
DUMP.1: MOVE T1,(W) ;GET A WORD
CALL D$WORD ;DUMP IN PROPER MODE
AOBJN W,DUMPIT ;DO ALL WORDS IN RECORD
DUMP.2: SKIPG P1 ;FILES LEFT?
SOJLE P2,DMPEND ;YES--ANY RECORDS LEFT?
DUMP$G: CALL GETBUF ;NEW BUFFER FULL
JRST DUMPEF ;END OF FILE
TLZ F,FL$EOT ;CLEAR EOT FLAG--WE SAW SOME DATA
CALL CHKTTY ;ATTEND TO TTY IF /IFTYP
JRST DMPEND ;SAID TO KILL IT OFF
CALL RECHDR ;OUTPUT RECORD (BLOCK) HEADER
TLNE F,FL$SUM!FL$TOT ;/SUMMARY OR /TOTAL
JRST DUMP.2 ;YES--DONE WITH THIS RECORD
TLNN F,FL$OLY ;IS THERE A /ONLY IN EFFECT?
JRST DUMPIT ;CONTINUE DUMPING
OLYDMP: MOVE P3,ONLYLO ;GET LOW LIMIT
MOVEI T1,-1(P3) ;ADJUST WRDCNT
ADDM T1,WRDCNT ;TO REFLECT THE WORDS WE SKIPPED
SOJLE P3,OLYD.1 ;JUMP IF WE HAVE SKIPPED ENOUGH
AOBJN W,.-1 ;NO--SKIP MORE, BUT WATCH FOR END OF RECORD
JRST DUMP$G ;RAN OUT OF RECORD BEFORE LOW LIMIT REACHED
OLYD.1: MOVE P3,ONLYHI ;GET UPPER LIMIT
SUB P3,ONLYLO ;COMPUTE # WORDS TO DUMP
SETO L, ;FORCE A NEW LINE FIRST TIME THROUGH
OLYD.2: SOJGE L,OLYD.3 ;TIME FOR NEW LINE?
CALL D$NEWL ;YES
SUBI L,1 ;COUNT WHAT WE DO NOW
OLYD.3: MOVE T1,(W) ;GET A WORD
CALL D$WORD ;DUMP IN PROPER FORMAT
SOJL P3,DUMP.2 ;JUMP IF DUMPED ENOUGH
AOBJN W,OLYD.2 ;JUMP IF MORE WORDS IN RECORD
JRST DUMP.2 ;END OF RECORD
;HERE TO START THE DUMP
D$DMP: TLNE DC,(DV.DIR) ;INPUT A DIRECTORY DEVICE?
JUMPG P1,E$$CDM ;NO FILES ALLOWED ON DIRECTORY DEVICE
TLNN DC,(DV.MTA) ;CHECK FOR MTA INPUT
JRST D$DMP1 ;NO--SKIP MESSAGE
MOVEI T1,[ASCIZ/[DMPIPT INITIAL POSITION OF TAPE IS FILE /]
CALL O$STRG ;SEND IT
MOVE T1,FILE ;GET FILE COUNT
CALL O$DECW ;SEND IIT
MOVEI T1,RECMS2 ;<SP>RECORD<SP>
CALL O$STRG
MOVE T1,RECORD
CALL O$DECW
CALL RBRKNL ;CLOSE INFO
CALL FRCTYO ;MAKE IT SHOW IF TTY OUTPUT....KEEP USER HAPPY
D$DMP1: JUMPGE P1,DUMP$G ;JUMP IF FILE COUNT IS OK
TLNN DC,(DV.MTA) ;NO--SEE IF MTA
TDZA P1,P1 ;NO--MAKE SURE FILE COUNT IS ZERO
HRLOI P1,377777 ;YES--DO WHOLE TAPE (SEE HOLDMP)
JRST DUMP$G ;BEGIN TO DUMP
E$$CDM: ERROR. EF$FTL,CDM,<CANT DUMP MULTIPLE FILES ON DIRECTORY DEVICE>
SUBTTL DUMP WORD ROUTINE
D$WORD: TLNN F,FL$IND ;IN /INDUSTRY MODE?
PJRST @DMPWRD(M) ;NO--JUST GO DUMP THE SUCKER
PJRST @DMPINW(M) ;YES--DO IT THAT WAY
;HERE TO CONVERT IBM 360/370 FLOATING POINT WORD TO PDP10
INDFLO: JUMPE T1,FMTFLO ;ALL DONE IF ZERO
SKIPL T1 ;SET NEGATIVE FLAG IF NEEDED
TDZA T3,T3 ;NO--FLAG POSITIVE
SETO T3, ;YES--REMEMBER THAT
SETZ T2, ;CLEAR T2
ROTC T1,^D8 ;SEPARATE EXPONENT AND MANTISSA
SUBI T2,^D64 ;COMPUTE ACTUAL FRACTION
ASH T2,2 ;MAKE PDP-10 EXPONENT BASE 2
CAMGE T2,[EXP -^D128] ;WAS IT TOO SMALL?
JRST TOOSML ;YES--MAKE IT SMALLEST PDP-10 WORD
CAILE T2,^D127 ;TOO BIG?
JRST TOOBIG ;YES
ADDI T2,^D128 ;ADD PDP EXPONENT BIAS
FLTROT: ROTC T1,-^D9 ;REMAKE THE NUMBER
FADRI T1,(0.0) ;NORMALIZE IT
JUMPE T3,FMTFLO ;ALL DONE IF POSITIVE
EXCH T2,T1 ;NEED TO NEGATE IT
SETZ T1, ;SO SUBTRACT IT FROM ZERO
FSBR T1,T2 ;..
JRST FMTFLO ;DUMP PDP10 FLOATING PT NUMBER
TOOSML: SETZ T1, ;DO ZERO IF TOO SMALL
JRST FMTFLO ;OUTPUT A ZERO
TOOBIG: MOVEI T1,377 ;MAKE LARGEST DEC10 NUMBER
SETO T2, ;...
JRST FLTROT
DMPINW: EXP FMTRDX ;OCTAL
EXP O$IASC ;EIGHT BIT ASCII
EXP O$BYTW ;BYTE
EXP O$EBCW ;EBCDIC
EXP INDFLO ;FLOATING POINT
EXP [HALT] ;HALFWORD (SNH)
EXP O$HEXI ;HEX
EXP [ASH T1,-4 ;INTEGER--POSITION NUMBER
JRST FMTINT] ;AND DO IT
EXP FMTRDX ;OCTAL
EXP E$$SWI ;SIXBIT
EXP E$$SWI ;SYMBOL
E$$SWI: ERROR. EF$FTL,SWI,<SIXBIT/SYMBOL WITH /INDUSTRY ILLEGAL>
;HERE AT END OF FILE
DUMPEF: TLNN DC,(DV.DIR) ;DIRECTORY DEVICE?
TLOE F,FL$EOT ;MTA--SET/CHEK EOT FLAG
JRST DMPEND ;DIRECTORY DEVICE OR EOT
CALL FILEND ;OUTPUT END OF FILE MESSAGE
CALL INPCLS ;CLOSE INPUT FILE
IFN FT$WLD,<
MOVE T1,[XWD SVINOB,OPNBLK] ;RESET OPEN BLOCK
BLT T1,LKPBLK+.RBTIM;(COPY LKPBLK ALSO IN CASE CAN'T REOPEN)
OPEN INPC,OPNBLK ;GET THE DEVICE AGAIN
JRST [IFE FT$SEG,<CALL UPSCN> ;CAN'T--GET HISEG IF NEEDED
CALL E.DFO## ;CAN'T--REPORT ERROR
JRST DMPE.1] ;AND GO FINISH UP
CALL OPNI.A ;SETUP BUFFERS , ETC.
>;END IFN FT$WLD
IFE FT$WLD,<
CALL OPNINP ;REOPEN INPUT FILE
>;END IFE FT$WLD
SOJG P1,DUMP$G ;JUMP IF MORE FILES
JUMPG P2,DUMP$G ;OR MORE RECORDS
JRST DMPE.1 ;END OF DUMP
;HERE AT END OF DUMP
DMPEND:
TLNE F,FL$EOT ;GET HERE WITH END OF TAPE?
JRST DMPE.1 ;YES--DON'T OUTPUT END OF FILE MESSAGE
HRROI T1,FN$END ;GET END FUNCTION
CAME T1,(A) ;IS IT NEXT ON THE LIST
JRST [CALL O$CRLF ;NO--NEW LINE
JRST DMPE.1] ;AND SKIP
CALL FILEND ;YES--OUTPUT END MESSAGE
DMPE.1: MOVEI T1,ENDMS1 ;FIRST PART OF MESSAGE
CALL O$STRG ;SEND IT
MOVE T1,TOTFIL ;GET # FILES DUMPED
JUMPE T1,DMPE.2 ;JUMP IF NONE
CALL O$DECW ;SEND FILES
MOVEI T1,ENDMS2 ;GET MESAGE
CALL O$STRG ;SEND IT
DMPE.2: MOVE T1,TOTREC ;AND RECORDS
CALL O$DECW ;OUTPUT THEM
TLNN DC,(DV.MTA) ;MTA INPUT?
TLNE F,FL$FOR!FL$PHY ;NO--/FORTRA OR /IREAD?
SKIPA T1,[EXP ENDMS3] ;MTA OR /FORTRA OR /IREAD
MOVEI T1,ENDMS4 ;MUST BE STRAIGHT DISK INPUT
CALL O$STRG ;SEND IT
MOVEI T1,ENDMS5 ;FINAL MESSAGE
CALL O$STRG ;SEND IT
CALL FRCTYO ;IF TTY, FORCE OUTPUT OUT TO KEEP USER HAPPY
HRROI T1,FN$END ;GET END FUNCTION
CAME T1,0(A) ;IS IT COMING UP?
JRST DMPLUP ;NO--BACK FOR MORE
MOVEI T1,ENDMSG ;YES--GET END MESSAGE
CALL O$STRG ;END THE WORLD
PJRST FRCTYO ;RETURN, FORCING OUTPUT IF TTY
ENDMS1: ASCIZ$ <[DMPTOT TOTAL OF >
ENDMS2: ASCIZ$ < FILES AND >
ENDMS3: ASCIZ$ < RECORDS>
ENDMS4: ASCIZ$ < BLOCKS>
ENDMS5: ASCIZ$ < IN DUMP]
>
ENDMSG: ASCIZ$ <[DMPERD END OF REQUESTED DUMP]
>
SUBTTL OUTPUT INITIAL HEADER
INIHDR: CALL .SAVE1## ;MIGHT AS WELL
SKIPN TITLEB ;WAS THERE A /TITLE?
JRST INIH.1 ;NO
MOVEI T1,TITLEB ;YES--GET ADDRESS
CALL O$STRG ;SEND IT
CALL O$CRLF ;NEW LINE
INIH.1: CALL O$CRLF ;AND ANOTHER
MOVEI T1,IMES1 ;FIRST PART OF MESSAGE
CALL O$STRG ;PLEASE EXCUSE THE COMMENTS
MOVEI T1,O$CHAR ;BUT THIS CODE IS VERY SELF-EXPLANATORY
CALL .TYOCH## ;SETUP MY OUTPUT ROUTINE WITH SCAN
SAVE$ T1 ;REMEMBER OLD WON
CALL TINSPC ;TYPE OUT THE INPUT FILE SPEC
TLNN DC,(DV.MTA) ;IS INPUT A MAGTAPE?
JRST INIH.4 ;NO
SKIPN REELID ;YES--WAS THERE A REELID ON THE TAPE?
JRST INIH.3 ;NO
MOVEI T1,IMES5 ;GET THE MESSAGE
CALL O$STRG ;SEND IT
MOVE T1,REELID ;GET THE REELID
CALL O$SIXW ;SEND IT
INIH.3: CALL O$SPAC ;SPACE OVER
MOVEI P1,INPC ;GET CHANNEL
MTCHR. P1, ;GET CHARACTERISTICS
SETZ P1, ;SNH
TRNE P1,MT.7TR ;IS IT SEVEN TRACK?
SKIPA T1,[EXP "7"] ;YES--SETUP
MOVEI T1,"9" ;NO--MUST BE 9
CALL O$CHAR ;SEND IT
MOVEI T1,IMES6 ;GET "<SP>TRACK"
CALL O$STRG ;SEND IT
LDB T1,[POINT 3,P1,35] ;GET DENSITY
MOVE T1,DENTBL(T1) ;GET STRING ADDRESS
CALL O$STRG ;TELL DENSITY
MOVEI T1,BPIMES ;TELL WHAT WE JUST TOLD
CALL O$STRG ;TELL IT
INIH.4: MOVEI T1,IMES2
CALL O$STRG
CALL .TDATN## ;ADD THE DATE
MOVEI T1,IMES3
CALL O$STRG
CALL .TTIMN## ;AND THE TIME
CALL RBRKNL ;NEXT LINE
MOVEI T1,IMES4
CALL O$STRG
CALL CMDOUT ;DUMP THE COMMAND
CALL RBRKNL
CALL FRCTYO ;FORCE OUT TO TTY IF IT IS TTY
RESTR$ T1
PJRST .TYOCH## ;GIVE SCAN BACK ITS OUTPUT RTN
IMES1: ASCIZ$ <[DUMP OF >
IMES2: ASCIZ$ < ON >
IMES3: ASCIZ$ < AT >
IMES4: ASCIZ$ <[DMPCMD COMMAND: >
IMES5: ASCIZ$ < - REELID=>
IMES6: ASCIZ$ < TRACK/>
BPIMES: ASCIZ$ < BPI>
DENTBL: [ASCIZ /(DEFAULT)/]
[ASCIZ /200/]
[ASCIZ /556/]
[ASCIZ /800/]
[ASCIZ /1600/]
[ASCIZ /6250/]
[ASCIZ /(6)/]
[ASCIZ /(7)/]
RBRKNL: PJSP T1,O$STRG
ASCIZ .]
.
TINSPC: MOVEI T1,SVINOB ;POINT TO OPEN BLOCK
MOVEI T2,SVINLK ;AND LOOKUP BLOCK
PJRST .TOLEB## ;TYPE INPUT SPEC AND RETURN
SUBTTL DUMP THE COMMAND TO THE DUMP FILE
CMDOUT: MOVE T2,[POINT 7,CMDBFR] ;INIT THE POINTER
SETZ T3, ;CLEAR THE HYPHEN FLAG (CONTINUED COMMANDS)
CMDO.1: ILDB T1,T2 ;GET A CHARACTER
CMDO.3: JUMPE T1,$POPJ ;?? GOT TO END ??
CAIE T1,"-" ;IS THIS A HYPHEN/
JRST CMDO.2 ;NO--CHECK FURTHER
MOVE T1,T2 ;YES--GET NEXT CHARACTER
ILDB T1,T1 ;...
CAIGE T1," " ;.GE. A SPACE (ROUGH APPROX OF EOL)
;THIS WOULD BE LIKE IN A DATE
SOJA T3,CMDO.1 ;PROBABLY EOL--FLAG AND GO
MOVEI T1,"-" ;PROBABLY NOT EOL--RESET HYPHEN
JRST CMDO.4 ;AND GO SEND IT
CMDO.2: CAIE T1,.CHTAB ;IS IT A TAB?
CAIL T1," " ;OR GE SPACE
JRST CMDO.4 ;YES--GO SEND TO DUMP
JUMPE T3,$POPJ ;IF WE HAVEN'T SEEN A "-" THEN THIS IS THE END
SETZ T3, ;CLEAR HYPHEN FLAG AT EOL
CAIE T1,.CHCRT ;IS IT A CARRIAGE RETURN?
JRST CMDO.1 ;NO--MUST BE ALTMODE OR SOME SUCH EOL
ILDB T1,T2 ;YES--GET (POSSIBLE LINEFEED)
CAIN T1,.CHLFD ;IS IT?
JRST CMDO.1 ;YES--GET NEXT CHARACTER
JRST CMDO.3 ;NO--GO PROCESS THIS ONE
CMDO.4: CALL O$CHAR ;OUTPUT CHARACTER
JRST CMDO.1 ;DO MORE
SUBTTL OUTPUT RECORD (BLOCK) HEADER
RECHDR: AOS RECORD ;COUNT THE RECORD
AOS TOTREC ;AND TOTAL RECORDS
TLNE F,FL$TOT ;TOTALS ONLY?
POPJ P, ;YES--DONE
MOVEI T1,1 ;RESET WRDCNT
MOVE T2,LINRDX ;GET /LINRDX: VALUE
CAIE T2,LRXDEC ;IS IT /LINRDX:DEC?
MOVEI T1,0 ;NO--WORDS START AT ZERO
MOVEM T1,WRDCNT ;SO LINE #'S WILL BE RIGHT(IF NOT /OMIT)
TLNN F,FL$SUM ;/SUMMARY?
CALL O$CRLF ;NEW LINE FOR NEW RECORD
CALL O$CRLF ;AND ANOTHER
RECH.1: TLNN DC,(DV.DIR) ;DIRECTORY DEVICE?
JRST RECMTA ;NO--MTA
MOVEI T1,BLKMS1 ;YES--GET MESSAGE
TLNE F,FL$FOR!FL$PHY ;/FORTRA OR /IREAD?
MOVEI T1,BLKMS3 ;YES--DIFFERENT MESSAGE
CALL O$STRG
MOVE T1,RECORD ;GET RECORD #
CALL O$DECW
MOVEI T1,":"
CALL O$CHAR
HLRE T1,W ;GET WORD COUNT
MOVNS T1 ;MAKE POSITIVE
CALL O$DECW
JRST RECH.2 ;REJOIN COD
BLKMS1: ASCIZ$ <[BLOCK >
BLKMS2: ASCIZ$ < WORDS>
BLKMS3: ASCIZ$ <[RECORD >
RECMS1: ASCIZ$ <[FILE >
RECMS2: ASCIZ$ < RECORD >
RECMS3: ASCIZ$ < CHARACTERS>
RECMTA: MOVEI T1,RECMS1
CALL O$STRG
MOVE T1,FILE ;FILE COUNT
CALL O$DECW
MOVEI T1,RECMS2
CALL O$STRG
MOVE T1,RECORD
CALL O$DECW
MOVEI T1,":"
CALL O$CHAR
HLRE T1,W ;WORD COUNT
MOVNS T1
CALL O$DECW
RECH.2: MOVEI T1,BLKMS2
CALL O$STRG ;SEND IT
CAIE M,MODASC ;/MODE:ASCII?
JRST RECH.3 ;NO
CALL O$SPAC ;SPACE ONE
HLRE T1,W ;YES--GET WORDS AGAIN
MOVNS T1
IMULI T1,5 ;CVT TO CHARACTERS
CALL O$DECW ;OUTPUT IT
MOVEI T1,RECMS3 ;MESSAGE
CALL O$STRG
RECH.3: MOVEI T1,"]" ;CLOSE INFO
CALL O$CHAR ;...
TLNE F,FL$OLY!FL$SUM ;ONLY IN EFFECT? (OR /SUMMARY)
PJRST FRCTYO ;YES--NEW LINE STUFF DONE LATER
CAIE M,MODEBC ;MODE EBCDIC?
CAIN M,MODASC ;MODE ASCII?
TLNN F,FL$OMI ;ASCII OR EBCDIC--AND /OMIT?
JRST D$NEWL ;NO--DO NEW LINE THING
PJRST O$CRLF ;YES--NEW LINE AND RETURN
;HERE TO DO WRDCNT AT BEGINNING OF LINE
D$NEWL: CAIE M,MODASC ;IF /MODE:ASCII
CAIN M,MODEBC ;OR /MODE:EBCDIC
TLNN F,FL$OMI ;RIGHT--AND /OMIT?
CALL O$CRLF ;NO--NEW LINE
TLNE F,FL$OMI ;/OMIT?
JRST D$NEW2 ;YES--SKIP A LITTLE
MOVE T1,WRDCNT ;GET THE WORD COUNT
MOVE T3,LINRDX ;GET SPECIFIED LINE # RADIX
MOVE Q,LNOWID-1(T3) ;SETUP Q TO THE WIDTH
MOVE T4,LNORDX-1(T3) ;AND THE RADIX
CALL @LNODSP-1(T3) ;DO LINE NO IN SPECIFIED RADIX
MOVEI T1,"/" ;END THE LINE #
CALL O$CHAR ;(EACH FORMAT DOES A SPACE FIRST)
;(SO WE DON'T NEED ONE AFTER THE SLASH)
D$NEW2: CALL D$MSET ;RESET L AND Q
ADDM L,WRDCNT ;UPDATE WRDCNT FOR NEXT LINE
POPJ P,
;TABLE OF LINE # (WORD COUNT) RADICES
LNORDX: EXP ^D10 ;
EXP ^D16
EXP ^D8
;WIDTHS OF LINE #S IN SPECIFIED RADIX
LNOWID: EXP ^D6
EXP ^D7
EXP ^D8
LNODSP: EXP FMTINT ;INTEGER
EXP FMTR.1 ;HEX
EXP FMTR.1 ;OCTAL
SUBTTL OUTPUT END OF FILE MESSAGE
FILEND:
TLNN F,FL$TOT ;UNLESS /TOTAL
CALL O$CRLF ;NEED NEW LINE
TLNN DC,(DV.MTA) ;IS IT MAGTAPE?
TLNE F,FL$FOR!FL$PHY ;DSK--FORTRAN OR PHYSICS?
SKIPA T1,[FILMS1] ;MTA OR FORTRAN/IREAD
MOVEI T1,FILMS3 ;JUST STRAIGHT DISK INPUT
CALL O$STRG
MOVE T1,RECORD ;RECORDS
CALL O$DECW ;...
TLNN DC,(DV.MTA) ;MTA INPUT?
TLNE F,FL$FOR!FL$PHY ;DSK--IS IT FORTRAN OR IREAD?
SKIPA T1,[FILMS2] ;MTA OR RECORD-ORIENDTED DISK INPUT
MOVEI T1,FILMS4 ;DISK BLOCK ORIENTED
CALL O$STRG
MOVE T1,FILE
CALL O$DECW
MOVEI T1,IMES2 ;"<SP>ON<SP>"
CALL O$STRG
MOVEI T1,O$CHAR
CALL .TYOCH##
SAVE$ T1
CALL TINSPC ;TYPE OUT THE INPUT FILE SPEC.
RESTR$ T1
CALL .TYOCH##
CALL RBRKNL
SETZM RECORD ;MOVING ALONG
TLNN DC,(DV.MTA) ;ONLY MTA HAS MULTIPLE FILES
PJRST FRCTYO ;SO DON'T MESS UP THE TOTALS NOW
AOS FILE
AOS TOTFIL
PJRST FRCTYO ;FORCE OUTPUT IF TTY OUTPUT
FILMS1: ASCIZ$ <[DMPRIF >
FILMS2: ASCIZ$ < RECORDS IN FILE >
FILMS3: ASCIZ$ <[DMPBIF >
FILMS4: ASCIZ$ < BLOCKS IN FILE >
SUBTTL /MODE -- SETUP CHARS/WORD AND WORDS/LINE
D$MOD: MOVE M,P2 ;SET M TO THE MODE
CAIN M,MODBYT ;IS THIS /MODE:BYTE?
JRST D$MBYT ;YES--SET IT UP
CAIN M,MODHAL ;SEE IF /MODE:HALF
JRST D$MHLF ;YES--SETUP
CALL D$MSET ;SETUP L AND Q
JRST DMPLUP ;CONTINUE
;HERE TO SET MODE--CALLED AT END OF LINE TO RESET L AND Q
D$MSET: CAIN M,MODBYT ;/MODE:BYTE?
JRST MSETBY ;YES--DO IT
CALL GETWID ;GET THE WIDTH REQUIRED FOR THE DUMP
TLNE F,FL$IND ;/INDUSTRY?
SKIPA Q,MODTBI(M) ;YES--GET RIGHT SIZE FOR THAT
MOVE Q,MODTBL(M) ;GET WIDTH OF ONE WORDS' WORTH
TLNE F,FL$RDX ;/RADIX IN EFFECT?
MOVE Q,USRWID ;YES--GET COMPUTED WORD WIDTH
IDIVI T1,(Q) ;COMPUTE WORDS/LINE
SKIPN T2 ;IF A ZERO REMAINDER
SUBI T1,1 ;MUST SUBTRACT ONE--80 CPL DOES A FREE CRLF
HRRZ L,T1 ;PUT IN L FOR COUNTING
POPJ P,
MSETBY: MOVE L,BYTBPL ;GET BYTES/LINE
MOVE Q,BYTDPB ;AND DIGITS/BYTE
POPJ P,
GETWID: TRNN DC,(DV.TTY) ;IS DUMP TO THE TTY?
JRST GETW.1 ;NO--
SKIPLE T1,FLWIDT ;WAS /WIDTH GIVEN (OR IS THIS 1ST TIME?)
JRST GETW.2 ;GOT IT--GO AHEAD
MOVE T1,[XWD 2,T2] ;SETUP TO DO A TRMOP
MOVEI T2,.TOWID ;GET THE WIDTH FUNCTION
PJOB T3, ;FIND MY JOB #
TRMNO. T3, ;TO FIND TTY UDX
SKIPA ;CAN'T--JUST USE DEFAULT AD.WID
TRMOP. T1, ;READ TTY WIDTH SETTING
MOVEI T1,AD.WID ;CAN'T FOR SOME REASON--USE A GOOD DEFAULT
MOVEM T1,FLWIDT ;SET FOR LATER USE
JRST GETW.2 ;JUMP IN TO COMMON CODE
GETW.1: SKIPG T1,FLWIDT ;NOT TTY--WAS /WIDTH GIVEN/
MOVEI T1,MX.WID ;NO--USE ^D132
GETW.2: TLNE F,FL$OMI ;OMITTING LINE NUMBERS?
POPJ P, ;YES--DONE
MOVE T2,LINRDX ;NO--GET LINE RADIX
SUB T1,LNOWID-1(T2) ;UNCOUNT WHAT WE WILL EAT FOR WORD COUNT
POPJ P, ;RETURN
MODTBL: EXP ^D13 ;OCTAL
EXP ^D6 ;ASCII
EXP -1 ;BYTYE
EXP ^D5 ;EBCDIC
EXP ^D15 ;FLOAT
EXP -1 ;HALF
EXP ^D10 ;HEX
EXP ^D14 ;INTEGER
EXP ^D13 ;OCTAL
EXP ^D7 ;SIXBIT
EXP ^D24 ;SYMBOL
MODTBI: EXP ^D12 ;OCTAL
EXP ^D5 ;ASCII
EXP -1 ;BYTE
EXP ^D5 ;EBCDIC
EXP ^D15 ;FLOATING POINT
EXP -1 ;HALF
EXP ^D9 ;HEX
EXP ^D12 ;INTEGER
EXP ^D12 ;INTEGER
EXP -1 ;SIXBIT
EXP -1 ;SYMBOL
SUBTTL /MODE -- SETUP FOR /MODE:BYTE
D$MBYT: MOVSI T2,(POINT) ;BEGIN TO FORM BYTE PTR
HRRI T2,P1 ;WILL LOAD FROM P1
DPB P1,[POINT 6,T2,11] ;SET SIZE IN
MOVEM T2,BYTPTR ;SAVE FOR LATER
TLNE F,FL$IND ;/INDUSTRY?
SKIPA T1,[EXP ^D32] ;YES
MOVEI T1,^D36 ;NO--FULL WORD
IDIVI T1,(P1) ;GET BYTES/WORD
MOVEM T1,BYTBPW ;...
MOVEM T2,BYTREM ;SAVE REMAINDER BYTES ALSO
MOVE T1,P1 ;COPY SIZE
CALL GMBWID ;GET THE WIDTH FOR A BYTE
MOVEM T1,BYTDPB ;SAVE FOR LATER
MOVE T1,BYTBPW ;GET BYTES/WORD
IMUL T1,BYTDPB ;TIMES DIGITS/BYTE
ADD T1,BYTBPW ;+ SLASHES AND SPACE
MOVEM T1,BYTWID ;= WIDTH OF WORD OF BYTES
SKIPN T1,BYTREM ;WAS THERE A REMAINDER?
JRST D$MBY1 ;NO
CALL GMBWID ;GET WIDTH OF THAT
AOJ T1, ;COUNT THE COMMA TOO
ADDM T1,BYTWID ;ADD INTO WIDTH
MOVEM T1,BYTRDB ;SAVE FOR LATER USE
D$MBY1: CALL GETWID ;GET THE WIDTH TO USE FOR OUTPUT
IDIV T1,BYTWID ;TO GET WORDS/LINE
MOVEM T1,BYTBPL ;SAVE BYTES/LINE
MOVE L,T1 ;COPY
AOS BYTDPB ;+1 SO FMTRDX WORKS
JRST DMPLUP ;CONTINUE
;HERE WITH T1=BYTE SIZE
;RETURN T1=DIGITS REQUIRED TO DISPLAY IT. USES T2,T3
GMBWID: MOVE T3,USERDX ;GET /RADIX:N OR 8
SETZ T2, ;ZERO POWER OF TWO COUNT
LSH T3,-1 ;DIVIDE BY TWO
SKIPE T3 ;DONE?
AOJA T2,.-2 ;NO--LOOP AROUND
IDIVI T1,(T2) ;YES--COMPUTE DIGITS REQUIRED
JUMPE T2,$POPJ ;JUMP IF ALL IS WELL
AOJA T1,$POPJ ;NO--NEED ONE MORE DIGIT--SO DO IT
;HERE FOR /MODE:HALF SETUP
D$MHLF: MOVEI P1,^D18 ;SETUP THE BYTE SIZE
TLNE F,FL$IND ;SEE IF /INDUSTRY
MOVEI P1,^D16 ;YES--DIFFERENT SIZE
MOVEI M,MODBYT ;SETUP M TO BYTE MODE
JRST D$MBYT ;DO BYTE SETUP
SUBTTL DUMP FILE OUTPUT ROUTINES
;O$CRLF -- OUTPUT CRLF TO DUMP FILE
O$CRLF: MOVEI T1,.CHCRT ;CARRIAGE RETURN
CALL O$CHAR ;DUMP IT
MOVEI T1,.CHLFD ;LINED FEED
;FALL INTO O$CHAR TO SEND LINEFEED
;O$CHAR -- OUTPUT CHARACTER IN T1 TO DUMP FILE
O$CHAR: SOSG OBHR+.BFCTR ;ROOM IN THE BUFFER?
JRST O$BUFR ;NO--MAKE SOME
O$CHR1: IDPB T1,OBHR+.BFPTR ;STORE CHARACTER
TLO F,FL$ODN ;WE HAVE DONE SOME OUTPUT
AOS CHRKNT ;COUNT FOR PEOPLE WHO NEED IT
POPJ P,
O$BUFR: CALL .PSH4T## ;PRESERVE T1-4 (XCTIO USES T2 AT LEAST)
CALL XCTIO ;WRITE A BUFFER
OUT OUTC, ;XCT'D
SKIPA ;?? DEVICE IS FULL OR EOT ??
JRST [PUSHJ P,.POP4T## ;RESTORE REGS
JRST O$CHR1] ;AND CONTINUE
ERROR. EF$ERR,ODF,<OUTPUT DEVICE IS FULL>
CALL OUTCLS ;TRY TO PRESERVE WHAT WE CAN
PJRST ERRFTL ;GO DIE
;O$STRG -- OUTPUTS ASCIZ STRING POINTED TO BY T1 TO DUMP FILE
O$STRG: HRLI T1,(POINT 7) ;FORM PTR
PUSH P,T1 ;SAVE ON PDL
O$STR1: ILDB T1,(P) ;GET CHAR
JUMPE T1,TPOPJ ;JUMP IS END OF STRING
CALL O$CHAR ;WRITE THE CHARACTER
JRST O$STR1 ;LOOP
;O$SPEC -- OUTPUT SPACE IF NOT /OMIT
;O$SPAC -- OUTPUT A SPACE
;O$DOT -- OUTPUT A DOT
;O$SLSH -- OUTPUT A SLASH
;O$TABC -- OUTPUT A TAB
;O$COMA -- OUTPUT A COMMA
O$SPEC: TLNE F,FL$OMI ;/OMIT?
POPJ P, ;YES
O$SPAC: SKIPA T1,[EXP " "] ;DO A SPACE
O$DOT: MOVEI T1,"." ;DO A DOT
PJRST O$CHAR
O$TABC: SKIPA T1,[EXP " "] ;GET A TAB
O$SLSH: MOVEI T1,"/" ;GET ONE
PJRST O$CHAR ;AND SEND IT
O$COMA: MOVEI T1,"," ;GET A COMMA
PJRST O$CHAR ;SEND IT
;O$HEXW --OUTPUT 36 BIT HEX WORD
;O$HEXI -- OUTPUT 32 BIT HEX WORD (INDUSTRY)
O$HEXI: SKIPA T3,[DEC 8] ;8 HEX CHARS
O$HEXW: MOVEI T3,^D9 ;9 HEX CHARS
MOVE T2,T1 ;POSITION NUMBER
CALL O$SPAC ;SPACE OVER A CHARACTER
O$HEX1: SETZ T1, ;CLEAR RESULT
LSHC T1,4 ;GET A HEX DIGIT
CALL O$DIGT ;OUTPUT IT
SOJG T3,O$HEX1 ;DO 8 OR 9
POPJ P,
SUBTTL SYMBOLIC OUTPUT
;HERE TO OUTPUT WORD IN T1 IN SYMBOLIC FORMAT
O$SYMW:
IFE FT$ISD,<
ERROR. EF$FTL,SNI,<SYMBOLIC DUMP NOT IMPLEMENTED>
>;END IFE FT$ISD
IFN FT$ISD,<
CALL .SAVE1## ;SAVE P1
MOVE P1,T1 ;COPY WORD
CALL O$SPAC ;SPACE OVER
SETZM CHRKNT ;CLEAR COUNTER
LDB T1,[POINT 9,P1,8];GET OP CODE
CAIL T1,700 ;SEE IF DIRECT I/O INSTR
JRST DIOIOW ;YES--GO DO IT
CAIGE T1,40 ;SEE IF LUUO
JRST UUOIOW ;YES--GO DO THAT
MOVE T1,MNETBL-40(T1);NO--GET OPCODE
CALL O$SIXW ;SHOW IT
OSYM.2: CALL O$SPAC ;GET A SPACE
CALL O$SPAC ;AND ONE MORE
LDB T1,[POINT 4,P1,12] ;GET AC FIELD
OSYM2A: JUMPE T1,OSYM.4 ;JUMP IF 0
CALL O$OCTW ;SHOW IT
CALL O$COMA ;AND A COMMA
OSYM.4: MOVEI T1,"@" ;IN CASE INDIRECTION NEEDED
TLNE P1,(1B13) ;CHECK IF SO
CALL O$CHAR ;SEND THE INDIRECT BIT
HRRZ T1,P1 ;GET RH 18 BITS
CALL O$OCTW ;SEND IT
LDB T1,[POINT 4,P1,17] ;SEE IF INDEX FIELD
JUMPE T1,OSYM.6 ;JUMP IF NO INDEX
PUSH P,T1 ;SAVE INDEX
MOVEI T1,"(" ;START INDEX FIELD
CALL O$CHAR ;SEND IT
POP P,T1 ;GET INDEX FIELD
CALL O$OCTW ;SEND IT
MOVEI T1,")" ;CLOSE INDEX
CALL O$CHAR ;SEND IT
OSYM.6: MOVE T1,CHRKNT ;GET COUNT TO HERE
SUBI T1,^D23 ;THIS MANY CHARS IN FULL INSTR
JUMPGE T1,$POPJ ;JUMP IF NO PADDING NEEDED
PUSH P,T1 ;NO--SAVE AMT NEEDED
CALL O$SPAC ;SEND ONE
AOSGE (P) ;SEE IF DONE
JRST .-2 ;NO--DO MORE
JRST TPOPJ ;CLEAR PDL AND RETURN
;HERE IF UUO IS 0-40
UUOIOW: JUMPE T1,UUO000 ;JUMP IF ILL UUO
MOVEI T1,[ASCIZ/UUO/]
CALL O$STRG ;SEND UUO
LDB T2,[POINT 9,P1,8] ;GET OP CODE
MOVSS T2 ;MOVE TO LH
LSH T2,^D9 ;PUT TO HIGH 9 BITS
MOVEI T3,3 ;TYPE 3 OCTAL DIGITS
CALL FMTO.1 ;TYPE THEM
JRST OSYM.2 ;CONTINUE
UUO000: MOVSI T1,'Z ' ;GET A SIXBIT "Z"
CALL O$SIXW ;SEND SIXBIT (WILL SEND NULLS AS BLANKS)
PJRST OSYM.2 ;CONTINUE
;HERE FOR DIRECT I/O INSTRS
DIOIOW: LDB T1,[POINT 3,P1,12] ;GET 3 BITS THAT TELL THE TALE
MOVE T1,IOINTB(T1) ;GET THE SIXBIT FOR IT
CALL O$SIXW ;TYPE IT OUT
CALL O$SPAC ;AND THEN TWO SPACES
CALL O$SPAC ;...
LDB T1,[POINT 7,P1,9] ;GET DEVICE CODE
JRST OSYM2A ;GO JUMP INTO THE PROCESSING
SYMXWD: HLRZ T1,P1 ;GET LH
CALL O$OCTW ;SHOW LH
MOVEI T1,[ASCIZ/,,/] ;SOME COMMAS
CALL O$STRG
HRRZ T1,P1 ;GET RH
CALL O$OCTW ;SHOW RH
JRST OSYM.6 ;GO FINISH UP
IOINTB: SIXBIT /BLKI/
SIXBIT /DATAI/
SIXBIT /BLKO/
SIXBIT /DATAO/
SIXBIT /CONO/
SIXBIT /CONI/
SIXBIT /CONSZ/
SIXBIT /CONSO/
;SIXBIT TABLE OF INSTR MNENOMICS
DEFINE X(A)<IRP A,<SIXBIT/A/>>
MNETBL:
X (<CALL ,INIT ,UUO042,UUO043,UUO044,UUO045,UUO046,CALLI ,OPEN ,TTCALL>)
X (<UUO052,UUO053,UUO054,RENAME,IN ,OUT ,SETSTS,STATO ,GETSTS,STATZ >)
X (<INBUF ,OUTBUF,INPUT ,OUTPUT,CLOSE ,RELEAS,MTAPE ,UGETF ,USETI ,USETO >)
X (<LOOKUP,ENTER ,UJEN ,UUO101,UUO102,UUO103,UUO104,UUO105,UUO106,UUO107>)
X (<DFAD ,DFSB ,DFMP ,DFDV ,UUO114,UUO115,UUO116,UUO117,DMOVE ,DMOVN >)
X (<FIX ,UUO123,DMOVEM,DMOVNM,FIXR ,FLTR ,UFA ,DFN ,FSC ,IBP >)
X (<ILDB ,LDB ,IDPB ,DPB ,FAD ,FADL ,FADM ,FADB ,FADR ,FADRI ,FADRM >)
X (<FADRB ,FSB ,FSBL ,FSBM ,FSBB ,FSBR ,FSBRI ,FSBRM ,FSBRB ,FMP >)
X (<FMPL ,FMPM ,FMPB ,FMPR ,FMPRI ,FMPRM ,FMPRB ,FDV ,FDVL ,FDVM >)
X (<FDVB ,FDVR ,FDVRI ,FDVRM ,FDVRB ,MOVE ,MOVEI ,MOVEM ,MOVES ,MOVS >)
X (<MOVSI ,MOVSM ,MOVSS ,MOVN ,MOVNI ,MOVNM ,MOVNS ,MOVM ,MOVMI ,MOVMM >)
X (<MOVMS ,IMUL ,IMULI ,IMULM ,IMULB ,MUL ,MULI ,MULM ,MULB ,IDIV >)
X (<IDIVI ,IDIVM ,IDIVB ,DIV ,DIVI ,DIVM ,DIVB ,ASH ,ROT ,LSH >)
X (<JFFO ,ASHC ,ROTC ,LSHC ,UUO247,EXCH ,BLT ,AOBJP ,AOBJN ,JRST >)
X (<JFCL ,XCT ,MAP ,PUSHJ ,PUSH ,POP ,POPJ ,JSR ,JSP ,JSA >)
X (<JRA ,ADD ,ADDI ,ADDM ,ADDB ,SUB ,SUBI ,SUBM ,SUBB ,CAI >)
X (<CAIL ,CAIE ,CAILE ,CAIA ,CAIGE ,CAIN ,CAIG ,CAM ,CAML ,CAME >)
X (<CAMLE ,CAMA ,CAMGE ,CAMN ,CAMG ,JUMP ,JUMPL ,JUMPE ,JUMPLE,JUMPA >)
X (<JUMPGE,JUMPN ,JUMPG ,SKIP ,SKIPL ,SKIPE ,SKIPLE,SKIPA ,SKIPGE,SKIPN >)
X (<SKIPG ,AOJ ,AOJL ,AOJE ,AOJLE ,AOJA ,AOJGE ,AOJN ,AOJG ,AOS >)
X (<AOSL ,AOSE ,AOSLE ,AOSA ,AOSGE ,AOSN ,AOSG ,SOJ ,SOJL ,SOJE >)
X (<SOJLE ,SOJA ,SOJGE ,SOJN ,SOJG ,SOS ,SOSL ,SOSE ,SOSLE ,SOSA >)
X (<SOSGE ,SOSN ,SOSG ,SETZ ,SETZI ,SETZM ,SETZB ,AND ,ANDI ,ANDM >)
X (<ANDB ,ANDCA ,ANDCAI,ANDCAM,ANDCAB,SETM ,SETMI ,SETMM ,SETMB ,ANDCM >)
X (<ANDCMI,ANDCMM,ANDCMB,SETA ,SETAI ,SETAM ,SETAB ,XOR ,XORI ,XORM >)
X (<XORB ,IOR ,IORI ,IORM ,IORB ,ANDCB ,ANDCBI,ANDCBM,ANDCBB,EQV >)
X (<EQVI ,EQVM ,EQVB ,SETCA ,SETCAI,SETCAM,SETCAB,ORCA ,ORCAI ,ORCAM >)
X (<ORCAB ,SETCM ,SETCMI,SETCMM,SETCMB,ORCM ,ORCMI ,ORCMM ,ORCMB ,ORCB >)
X (<ORCBI ,ORCBM ,ORCBB ,SETO ,SETOI ,SETOM ,SETOB ,HLL ,HLLI ,HLLM >)
X (<HLLS ,HRL ,HRLI ,HRLM ,HRLS ,HLLZ ,HLLZI ,HLLZM ,HLLZS ,HRLZ >)
X (<HRLZI ,HRLZM ,HRLZS ,HLLO ,HLLOI ,HLLOM ,HLLOS ,HRLO ,HRLOI ,HRLOM >)
X (<HRLOS ,HLLE ,HLLEI ,HLLEM ,HLLES ,HRLE ,HRLEI ,HRLEM ,HRLES ,HRR >)
X (<HRRI ,HRRM ,HRRS ,HLR ,HLRI ,HLRM ,HLRS ,HRRZ ,HRRZI ,HRRZM >)
X (<HRRZS ,HLRZ ,HLRZI ,HLRZM ,HLRZS ,HRRO ,HRROI ,HRROM ,HRROS ,HLRO >)
X (<HLROI ,HLROM ,HLROS ,HRRE ,HRREI ,HRREM ,HRRES ,HLRE ,HLREI ,HLREM >)
X (<HLRES ,TRN ,TLN ,TRNE ,TLNE ,TRNA ,TLNA ,TRNN ,TLNN ,TDN >)
X (<TSN ,TDNE ,TSNE ,TDNA ,TSNA ,TDNN ,TSNN ,TRZ ,TLZ ,TRZE >)
X (<TLZE ,TRZA ,TLZA ,TRZN ,TLZN ,TDZ ,TSZ ,TDZE ,TSZE ,TDZA >)
X (<TSZA ,TDZN ,TSZN ,TRC ,TLC ,TRCE ,TLCE ,TRCA ,TLCA ,TRCN >)
X (<TLCN ,TDC ,TSC ,TDCE ,TSCE ,TDCA ,TSCA ,TDCN ,TSCN ,TRO >)
X (<TLO ,TROE ,TLOE ,TROA ,TLOA ,TRON ,TLON ,TDO ,TSO ,TDOE >)
X (<TSOE ,TDOA ,TSOA ,TDON ,TSON >)
>;END IFN FT$ISD
;O$SIXN -- OUTPUT SIXBIT WORD IN T1 TO DUMP FILE
;O$SIXW -- DITTO EXCEPT NO SPACE BEFORE WORD
O$SIXW: MOVE T2,T1 ;POSITION
JRST O$SIX0 ;SKIP THE SPACE
O$SIXN: MOVE T2,T1 ;POSITION
CALL O$SPAC ;SPACE ONE
O$SIX0: MOVEI T3,6 ;LOOP COUNT
O$SIX1: SETZ T1, ;CLEAR
ROTC T1,6 ;PEEL OFF A CHARACTER
ADDI T1," " ;ASCIIIZE IT
CALL O$CHAR ;DUMP IT
SOJG T3,O$SIX1 ;DO ALL
POPJ P,
;O$DECW -- OUTPUT DECIMAL WORD IN T1 TO DUMP FILE
;O$OCTW -- OUTPUT OCTAL WORD IN T1 TO DUMP FILE
;O$RDXW -- OUTPUT WORD IN T1 TO DUMP FILE IN RADIX IN T3
;***THESE ARE UNFORMATTED DUMP ROUTINES
O$OCTW: SKIPA T3,[^D8] ;OCTAL
O$DECW: MOVEI T3,^D10 ;DECIMAL
O$RDXW: JUMPGE T1,ORDXW1 ;JUMP IF POSITIVE
MOVE T2,T1 ;NO--SAVE NUMBER
MOVEI T1,"-"
CALL O$CHAR
MOVE T1,T2
ORDXW1: IDIV T1,T3 ;DIVIDE BY RADIX
MOVMS T2 ;GT MAGNITUDE
HRLM T2,(P) ;SAVE ON PIDDLE LIST
SKIPE T1 ;CHECK DONENESS
CALL ORDXW1 ;RECURSE
HLRZ T1,(P) ;GET DIGIT
O$DIGT: ADDI T1,"0" ;ASCIIIZE IT
CAILE T1,"9" ;SEE IF OVERFLOW INTO ALPHAS
ADDI T1,"A"-"9"-1 ;YES--PUT IT THERE
PJRST O$CHAR ;RECURSE OR RETURN
;O$ASCW -- DUMP WORD IN T1 IN ASCII
O$ASCW: MOVE T2,T1 ;POSITION
CALL O$SPEC ;SPACE IF NOT /OMIT
MOVEI T3,5 ;5 CHARS/WORD
O$ASC1: SETZ T1, ;CLEAR
ROTC T1,7 ;GRAB A CHARACTER
CALL O$ASCC ;DUMP THE CHARACTER
SOJG T3,O$ASC1 ;DO ALL 5
POPJ P, ;DONE
O$ASCC: CAIL T1,.CHTAB ;BETWEEN TAB AND CR?
CAILE T1,.CHCRT ;...
CAIN T1,.CHBEL ;IS IT A BELL?
PJRST O$CHAR ;TAB/LF/VT/FF/CR/BELL--GO PRINT IT
TLNE F,FL$OMI ;/OMIT?
JRST O$ASC5 ;YES--HANDLE SLIGHTLY DIFFERENT
CAIL T1," " ;LT A SPACE?
CAILE T1,"Z"+40 ;AND LE A LOWER CASE Z?
O$AQST: MOVEI T1,"?" ;NO--MAKE IT A QUESTION MARK
O$ASC4: PJRST O$CHAR ;OUTPUT IT AND RETURN
;HERE TO SEE IF CONTROL CHARACTER (1-37, EXCEPT A FEW SPECIAL ONES)
O$ASC5: CAIL T1," " ;MAKE A GROSS CHECK
PJRST O$CHAR ;TO ELIMINATE A LARGE PART OF THE ASCII SET
SAVE$ T1 ;ITS A REAL CONTROL CHARACTER--SAVE IT
MOVEI T1,"^" ;GET AN ARROW
CALL O$CHAR ;ZIP IT OUT
RESTR$ T1 ;GET CHARACTER BACK
MOVEI T1,100(T1) ;BY MAJIK IT BECOMES VISIBLE
PJRST O$CHAR ;GO PRINT IT
;O$IASC -- OUTPUT WORD IN T1 AS EIGHT-BIT ASCII
O$IASC: MOVE T2,T1 ;SEE COMMENTS FOR O$ASCW
CALL O$SPEC
MOVEI T3,4 ;ONLY 4 CHARS WORD
O$IAS1: SETZ T1,
ROTC T1,^D8
ANDI T1,177 ;TRIM TO SEVEN BITS
CALL O$ASCC ;OUTPUT THE CHARACTER
SOJG T3,O$IAS1
POPJ P,
;O$BYTW -- OUTPUT WORD IN BYTE FORMAT
O$BYTW: CALL .SAVE3## ;GET A FEW
MOVE P1,T1 ;POSITION WORD
MOVE P2,BYTPTR ;PTR TO LOAD BYTES
MOVE P3,BYTBPW ;GET # BYTES / WORD
CALL O$SPAC ;SPACE OUT
O$BYT1: ILDB T1,P2 ;GET A BYTE
CALL FMTRDX ;OUTPUT IT
SOJLE P3,O$BYT2 ;DONE?
CALL O$SLSH ;NO--SLASH ONE
JRST O$BYT1 ;DO ANOTHER
O$BYT2: SKIPN T2,BYTREM ;WAS THERE A REMAINDER?
POPJ P, ;NO--DONE
CALL O$SLSH ;DO SLASH
DPB T2,[POINT 6,P2,11] ;SET IN THE SIZE
ILDB T1,P2 ;GET THE BYTE
MOVE Q,BYTRDB ;GET WIDTH OF REMAINDER
CALL FMTRDX ;OUTPUT #
MOVE Q,BYTDPB ;RESET Q
POPJ P,
SUBTTL PRINT EBCDIC WORD
;O$EBCW -- OUTPUT EBCDIC WORD IN T1
O$EBCW: MOVE T2,T1 ;COPY WORD
CALL O$SPEC ;SPACE IF NEEDED
MOVEI T3,4 ;4 CPW
O$EBC1: SETZ T1, ;CLEAR RESULT
ROTC T1,^D8 ;PEEL OFF A CHAR
JUMPE T1,O$EBC3 ;IGNORE NULL CHARACTERS
CALL XLTEBC ;XLATE TO ASCII
CALL O$CHAR ;SEND IT
SOSLE EBCKNT ;HAVE WE DONE A LINE?
JRST O$EBC3 ;NO--SEE IF DONE WITH WORD
MOVE T1,S.BLKF ;RESET BLOCK FACTOR
MOVEM T1,EBCKNT ;...
CALL O$CRLF ;NEW LINE PLEASE
O$EBC3: SOJG T3,O$EBC1 ;JUMP IF MORE CHARS THIS WORD
POPJ P,
XLTEBC: CAIL T1,.CHVTB ;LT A VERT TAB?
JRST XLTE.1 ;NO
CAIN T1,5 ;IS IT A 5 (HORIZ. TAB)?
SKIPA T1,[EXP .CHTAB] ;YES--MAKE IT ONE
XLTQST: MOVEI T1,"?" ;FLAG WE DON'T KNOW IT
POPJ P,
XLTE.1: CAIG T1,.CHCRT ;GT A CR?
POPJ P, ;VERT TAB TO CR
CAIL T1,^D129 ;LT LOWER CASE A?
JRST XLTE.4 ;NO--HANDLE ALPHA NUMERICS
PUSH P,T1 ;YES--SAVE CHARACTER
MOVSI T4,-N$ECHR ;SET LOOP
XLTE.2: HLRZ T1,EBCTAB(T4) ;GET EBCDIC FROM TABLE
CAME T1,(P) ;THIS IT?
AOBJN T4,XLTE.2 ;NO--LOOP TO END OR FIND ONE
POP P,T1 ;CLEAR STACK
JUMPGE T4,XLTQST ;JUMP IF WE DON'T KNOW IT
HRRZ T1,EBCTAB(T4) ;YES--GET ASCII EQUIVALENT
POPJ P,
XLTE.4: PUSH P,T1 ;SAVE CHARACTER ON PDL
MOVSI T4,-N$ECH2 ;GET A LOOPER
XLTE.5: HLRZ T1,EBCTB1(T4) ;GET LOWER LIMIT
CAMLE T1,(P) ;IN RANGE?
JRST XLTE.6 ;NO
HRRZ T1,EBCTB1(T4) ;HIGH LIMIT
CAMGE T1,(P) ;IN RANGE?
XLTE.6: AOBJN T4,XLTE.5 ;NO--LOOP
POP P,T1 ;GET CHARACTER BACK
JUMPGE T4,XLTQST ;NOT IN A GOOD RANGE
ADD T1,EBCTB2(T4) ;CONVERT TO ASCII
POPJ P,
EBCTAB: XWD ^D5,.CHTAB ;5 BECOMES A TAB
XWD ^D64," "
XWD ^D74,"]"
XWD ^D75,"."
XWD ^D76,"<"
XWD ^D77,"("
XWD ^D78,"+"
XWD ^D79,"^"
XWD ^D80,"&"
XWD ^D90,"!"
XWD ^D91,"$"
XWD ^D92,"*"
XWD ^D93,")"
XWD ^D94,";"
XWD ^D95,"["
XWD ^D96,"-"
XWD ^D97,"/"
XWD ^D107,","
XWD ^D108,"%"
XWD ^D109,"_"
XWD ^D110,">"
XWD ^D111,"?"
XWD ^D122,":"
XWD ^D123,"#"
XWD ^D124,"@"
XWD ^D125,"'"
XWD ^D126,"="
XWD ^D127,""""
XWD ^D192,"?"
XWD ^D208,":"
XWD ^D255,"_"
N$ECHR==.-EBCTAB
EBCTB1: XWD ^D129,^D137 ;RANGES FOR ALPHA NUMERICS
XWD ^D145,^D153
XWD ^D162,^D169
XWD ^D193,^D201
XWD ^D209,^D217
XWD ^D226,^D233
XWD ^D240,^D249
N$ECH2==.-EBCTB1
EBCTB2: EXP -^D129+"A"-40 ;LOWER CASE
EXP -^D145+"J"-40
EXP -^D162+"S"-40
EXP -^D193+"A"
EXP -^D209+"J"
EXP -^D226+"S"
EXP -^D240+"0"
SUBTTL FORMATTED INTEGER I/O
FMTINT: CALL .SAVE2## ;PRESERVE P1-2
MOVEI P1,-1(Q) ;CHARACTERS/WORD (-1 SO WE DON'T COUNT SPACE)
SETZ P2, ;CLEAR COUNT OF WHAT WE SEND
MOVE T3,T1 ;COPY NUMBER
SKIPGE T3 ;CHECK NEGATIVE
TLOA F,FL$NEG ;YES--SET FLAG
TLZA F,FL$NEG ;NO--CLEAR IT
MOVNS T3 ;IT WAS NEGATIVE--MAKE IT POSITIVE
FMTI.1: IDIVI T3,^D10 ;GET A DIGIT
ADDI T4,"0" ;MAKES IT ASCII
PUSH P,T4 ;SAVE ON PDL
AOJ P2, ;COUNT THE CHARACTER
JUMPN T3,FMTI.1 ;JUMP IF MORE
SUB P1,P2 ;GET THE DIFFERENCE
MOVEI T1," " ;SET IN CASE WE NEED TO PAD
SOJE P1,FMTSGN ;JUMP IF WE FIT OK
CALL O$CHAR
SOJG P1,.-1 ;PAD THEM ALL
FMTSGN: TLZE F,FL$NEG ;SEE IF NEGATIVE?
MOVEI T1,"-" ;YES--GET ONE (ELSE USE THE SPACE)
CALL O$CHAR ;SEND SPACE OR MINUS SIGN
JUMPLE P2,$POPJ ;JUMP IF WE SENT NO DIGITS?
POP P,T1 ;GET ONE BACK
CALL O$CHAR ;SEND IT
SOJG P2,.-2 ;DO ALL WE LEFT ON PDL
POPJ P, ;DONE
;HERE TO DO (PROBABLY) OCTAL DUMP
;UNLESS /RADIX WAS SEEN THEN USE FMTRDX
FMTOCT: TLNE F,FL$RDX ;SEEN /RADIX?
JRST FMTRDX ;YES--DO IT THE SLOW WAY
MOVEI T3,^D12 ;NO--12 OCTAL DIGITS COMING UP
MOVE T2,T1 ;WORD TO T2
CALL O$SPAC ;SPACE OVER ONE
FMTO.1: SETZ T1, ;CLEAR RESULT
LSHC T1,3 ;PEEL OFF A DIGIT
CALL O$DIGT ;OUTPUT IT
SOJG T3,FMTO.1 ;DO 12
POPJ P,
SUBTTL RADIX FORMATTED OUTPUT
;FMTRDX -- DUMP NUMBER IN T1 IN CURRENT RADIX (UNSIGNED)
;FMTR.1 -- DUMP NUMBER IN T1 IN RADIX IN T4
;THANKS TO ROGER UPHOFF FOR IDEA FROM DUMPER
FMTRDX: MOVE T4,USERDX ;CURRENT RADIX
FMTR.1: CALL .SAVE2## ;THESE MUST BE SACRED
MOVEI P1,-1(Q) ;COPY Q
MOVEI P2,-1(Q) ;A COUPLE OF TIMES
RDXLUP: JUMPL T1,RDXADJ ;SPECIAL IF NEGATIVE
JUMPE T1,RADXZR ;WATCH FOR END
IDIV T1,T4 ;PEEL OFF A DIGIT
RDXCON: ADDI T2,"0" ;MAKE IT ASCII
CAILE T2,"9" ;IS IT A DIGIT?
ADDI T2,"A"-"9"-1 ;NO--MOVE UP TO ALPHABETICS
PUSH P,T2 ;SAVE ON PDL
SOJG P1,RDXLUP ;GO FOR MORE
RADXZR: SUB P2,P1 ;GET # OF GOOD DIGITS
MOVEI T1," " ;SPACE OVER ONE
CAIE M,MODBYT ;UNLESS /MODE:BYTE
CALL O$CHAR
JUMPLE P1,RDXNZR ;DO WE NEED ANY LEADING ZEROES?
MOVEI T1,"0" ;YES--GET ONE
CALL O$CHAR ;SEND IT
SOJG P1,.-1 ;DO ALL NEEDED
RDXNZR: JUMPE P2,$POPJ ;JUMP IF NO CHARS ON PDL (# WAS 0)
POP P,T1 ;GET CHAR OFF PDL
CALL O$CHAR ;SEND IT
SOJG P2,.-2
POPJ P,
;HERE IF NUMBER IS NEGATIVE
RDXADJ: TLZ F,FL$TMP ;CLEAR TEMP FLAG
LSHC T1,-1 ;DIVIDE BY TWO
TLNE T2,(1B0) ;WAS LOW ORDER BIT ON?
TLO F,FL$TMP ;YES--REMEMBER THAT
IDIV T1,T4 ;DIVIDE BY RADIX
LSH T1,1 ;MULTIPLY QUOTIENT BY 2
LSH T2,1 ;SAME FOR REMAINDER
TLZE F,FL$TMP ;DID WE SHIFT OUT A ONE?
AOJ T2, ;INCRMEMENT REMAINDER BY ONE
IDIV T2,T4 ;DIVIDE REMAINDER BY RADIX
SKIPE T2 ;IS THERE A QUOTIENT AGAIN?
AOJ T1, ;YES--ADJUST ORIGINAL QUOTIENT
MOVE T2,T3 ;POSITION REMAINDER
JRST RDXCON ;AND CONTINUE
SUBTTL FORMATTED FLOATING POINT OUTPUT
;THANKS TO ROGER UPHOFF FOR ALGORITHM FROM DUMPER
FMTFLO: CALL SAVACS ;SAVE ACS
TLZ F,FL$TMP!FL$NEG!FL$FL2 ;CLEAR FLAGS
SETZB T4,T2 ;CLEAR EXPONENT
JUMPGE T1,EFMT1 ;NUMBER NEGATIVE?
MOVN T1,T1 ;YES,NEGATE IT
TLOA F,FL$NEG ;SET NEGATIVE FLAG
EFMT1: JUMPE T1,EFMT7 ;ESCAPE IF ZERO
HLRZ E1,T1 ;EXTRACT EXPONENT
LSH E1,-9 ;
TLZ T1,777000 ; GET RID OF EXPONENT
ASH T1,^D8 ;PUT BIN POINT BETWEEN BITS 0 AND 1
EFMT2: HRREI E2,-200+2(E1) ;GET RID OF EXCESS 200
IMULI E2,232 ;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
ASH E2,-^D9 ;GET RID OF 3 OCTAL FRACTION DIGITS
MOVM E3,E2 ;GET MAGNITUDE OF 10 SCALAR
CAIGE E3,PTLEN ;IS THE POWER OF 10 TABLE LARGE ENOUGH
JRST EFMT3 ;YES
JUMPL E2,.+2 ;NO, SCALE F BY LARGEST ENTRY
SKIPA E2,[PTLEN] ;GET ADDRESS OF LARGST POSITIVE POWER
MOVNI E2,PTLEN ;GET ADDR OF LARGEST NEGATIVE POWER
CALL BINEXP ;GET CORRESPONDING BINARY POWER OF TWO
CALL FLODIV ;SCALE BY A LARGE POWER OF TEN
JRST EFMT2 ;DO SECOND SCALING
BINEXP: MOVE E3,E2 ;COPY DECIMAL POWER
LSHC E3,-2 ;DIVIDE BY 4-- EXP10 HAS 4 ENTRIES/WORD
TLNE E4,(1B0) ;WHICH HALF WORD?
SKIPA E3,EXP10(E3) ;RIGHT HALF
HLRZ E3,EXP10(E3) ;LEFT HALF
TLNN E4,(1B1) ;WHICH QUADRANT?
LSH E3,-^D9 ;1ST OR 3RD
ANDI E3,777 ;MASK TO SIZE
POPJ P, ;DONE
;SCALE SINGLE FRACTION BY A POWER OF TEN
FLODIV: JUMPE E2,$POPJ ;IF EXP IS ZERO RETURN
ADD T4,E2 ;PUT SCALE FACTOR IN T4
SUBI E1,-200-1(E3) ;SUB BIN POWER OF 10 EXP FROM BIN
; FRACTION EXP,REMOVE EXCESS 200;
; -1 ALLOWS FOR ASHC,LH OF E1 IS GARBGE
MOVEI T2,0 ;CLEAR LOW WORD
CAMGE T1,HITEN(E2) ;WILL DIVIDE CAUSE A DIVIDE CHECK?
SOJA E1,.+2 ;NO, ALLOW FOR NOT DOING ASHC
ASHC T1,-1 ;YES, SCALE FRACTION
DIV T1,HITEN(E2) ;SCALE BY A POWER OF TEN
POPJ P, ;RETURN
EFMT3: CALL BINEXP ; GET BIN EXP THAT MATCHES DEC EXP
CAILE E3,(E1) ;IS THIS POWER OF TEN .GT. FRACTION?
JRST EFMT4 ;YES, IN THE EXPONENT
CAIN E3,(E1) ;MAYBE.
CAML T1,HITEN(E2) ;EXPONENTS ARE THE SAME COMPARE FRACT
AOJA E2,EFMT3 ;POWER OF TEN IS ONE TOO SMALL
EFMT4: CALL FLODIV ;POWER OF TEN O.K., DO SCALING
ASH T1,-200(E1) ;SCALE FRACTION RIGHT
EFMT7: PUSH P,T1 ;PRESERVE T1
CALL O$SPAC ;OUTPUT A SPACE
POP P,T1 ;GRAB IT BACK
MOVEI P1,^D14 ;LOAD FIELD WIDTH
MOVEI P2,^D8 ;NO. OF DECIMAL PLACES
MOVE E2,P2 ;
MOVE E1,P ;MARK BOTTOM OF STACK
PUSH P,[0] ;ALLOW FOR POSSIBLE OVERFLOW
SKIPGE E3,E2 ;GET NUMBER OF DIGITS
MOVEI E3,0 ;IF NEGATIVE ADD .5 TO FRACTION
ADD T1,RNDHGH(E3) ;ROUND TO CORRECT NUMBER OF DIGITS
ADDI T1,1 ;ROUND A LITTLE MORE
TLZN T1,(1B0) ;DID CARRY PROPAGATE TO BIT 0
AOS (P) ;YES, PROPAGATE CARRY TO LEADING 0
EFMT11: MULI T1,^D10 ;MULTIPLY BY 10
PUSH P,T1 ;STORE DIGIT ON STACK
MOVE T1,T2 ;SET UP NEW FRACTION
SOJG E3,EFMT11 ;
MOVEI E3,2(E1) ;GET BASE OF STACKED DIGITS
MOVE E4,1(E1) ;
JUMPE E4,EFMT14 ;DID OVERFLOW OCCUR?
SUBI E3,1 ;YES, MOVE BACK BASE POINTER
ADDI T4,1 ;NO, INCREMENT EXPONENT
EFMT14: MOVE E5,P1 ;GET WIDTH
SUBI E5,2(P2) ;SIGN,POINT,AND CHARS FOLLOWING
SUBI E5,4 ;ALLOW FOR E+00
FIT: CAIG E5,1 ;SPACE FOR LEADING BLANKS?
JRST GO2ERF ;NO LEADING BLANKS
CALL O$SPAC ;OUTPUT ONE
SOJA E5,FIT ;UNTIL ENOUGH
GO2ERF: JUMPN E2,.+2 ;CHECK FOR NO SIGNIFICANT DIGITS
TLO F,FL$FL2 ;ENSURE ZEROS WILL BE PRINTED
CALL SIGN ;OUTPUT SIGN
JUMPLE E5,EFORM2 ;NO SPACE LEFT FOR "0"
CALL ZERO ;OUTPUT ZERO
EFORM2: CALL O$DOT ;AND DECIMAL POINT
CALL DIGIT ;OUTPUT FRACTIONAL DIGIT
SOJN E2,.+2 ;TOTAL COUNT EXPIRED?
TLO F,FL$FL2 ;YES, FLAG DIGITS EXHAUSTED
SOJG P2,.-3 ;RETURN IF MORE DIGITS
MOVEI T1,"E" ;
CALL O$CHAR ;OUTPUT E
JUMPGE T4,EFORM5 ;ALWAYS + IF ZERO
TLO F,FL$NEG ;TRANSFER EXPONENT SIGN
EFORM5: CALL PLUS ;PRINT SIGN
MOVEI E5,2 ;AND SET DIGIT COUNT
MOVE P,E1 ;RESTORE STACK POINTER
MOVM T1,T4 ;GET EXPONENT
JRST OUTP1 ;
;OUTPUT
ZERO: MOVEI T1,"0" ;GET A ZERO
PJRST O$CHAR ;PRINT IT
PLUS: SKIPA T1,[EXP "+"] ;LOAD UP A PLUS SIGN
SIGN: MOVEI T1," " ;
SIGN1: TLZE F,FL$NEG ;IS SIGN NEGATIVE?
MOVEI T1,"-" ;YES, SET IT
PJRST O$CHAR ;PRINT IT
DIGIT: MOVEI T1,"0" ;SET DIGIT TO ZERO
TLNE F,FL$FL2 ;DO WE NEED TO PRINT A ZERO?
PJRST O$CHAR ;YES--PRINT IT
MOVE T1,(E3) ;GET A DIGIT
ADDI T1,"0" ;SET TO ASCII
AOJA E3,O$CHAR ;PRINT IT
OUTP1: MOVEI T4,1 ;INITIALIZE DIGIT COUNT
OUTP2: IDIVI T1,^D10 ; DIVIDE FRACTION BY TEN
PUSH P,T2 ;SAVE DIGIT
JUMPE T1,OUTP3 ;IS FRACTION ZERO YET?
AOJA T4,OUTP2 ;NO, DO ALL DIGITS
OUTP3: CAML T4,E5 ;YES, ANY LEADING SPACES?
JRST OUTP4 ;NO
CALL ZERO ;YES, PRINT ONE
SOJA E5,OUTP3 ;FINISH THEM
OUTP4: POP P,T1 ;GET A DIGIT
ADDI T1,"0" ;SET TO ASCII
CALL O$CHAR ;PRINT IT
SOJN T4,OUTP4 ;DO ALL OF THEM
CALL RESACS ;RESTORE ACS
POPJ P, ;DONE
SUBTTL FLOATING POINT OUTPUT TABLES
RNDHGH: 600000,,000000
414631,,463146
401217,,270243
400101,,422335
400006,,433342
400000,,517426
400000,,041433
400000,,003265
400000,,000253
400000,,000021
400000,,000001
400000,,000000
400000,,000000
400000,,000000
400000,,000000
400000,,000000
400000,,000000
400000,,000000
400000,,000000
PTLEN=24
274712,,041444
354074,,451755
223445,,672164
270357,,250621
346453,,122766
220072,,763671
264111,,560650
341134,,115022
214571,,460113
257727,,774136
333715,,773165
211340,,575011
253630,,734214
326577,,123257
206157,,364055
247613,,261070
321556,,135307
203044,,672274
243656,,135307
314631,,463146
HITEN: 200000,,000000
240000,,000000
310000,,000000
372000,,000000
234200,,000000
303240,,000000
364110,,000000
230455,,000000
276570,,200000
356326,,240000
225005,,744000
272207,,355000
350651,,224200
221411,,634520
265714,,203644
343277,,244615
216067,,446770
261505,,360566
336026,,654723
212616,,214044
255361,,657055
076101,,105110
113117,,122125
131134,,137143
146151,,155160
163167,,172175
EXP10: 201204,,207212
216221,,224230
233236,,242245
250254,,257262
266271,,274300
303000,,000000
SUBTTL FILE READING ROUTINES
;CALL GETBUF TO GET NEXT BUFFER
;GETBUF HANDLES THE DIFFERENT MODES AND SETS UP W AS AN AOBJN WORD TO THE
;DATA
GETBUF: TLNE F,FL$FOR ;FORTRAN BINARY?
JRST RDFORT ;YES--GO TO IT
IFN FT$PHX,<
TLNN DC,(DV.MTA) ;MTA INPUT?
TLNN F,FL$PHY ;NO--/IREAD?
CAIA ;MTA OR DIR AND NOT /IREAD
JRST RDPHYX ;DIR DEV AND /IREAD
>;END IFN FT$PHX
CALL XCTIO ;GET A BUFFER FULL
IN INPC, ;
POPJ P, ;END OF FILE
HRRZ W,IBHR+.BFPTR ;START THE AOBJ WORD
MOVEI W,1(W) ;POINT AT DATA
MOVN T1,IBHR+.BFCTR ;GET WORD COUNT
HRL W,T1 ;FINISH W
JRST $POPJ1 ;RETURN
IFN FT$PHX,<
RDPHYX: CALL .SAVE2## ;NEED A COUPLE OF REGISTERS
PHYX.0: CALL INPWRD ;GET IREAD WORD COUNT
POPJ P, ;EOF
JUMPE T1,PHYX.0 ;NO SUCH THING AS ZERO WORD COUNT
TLNE T1,-1 ;OR MORE THAN 2**18 WORDS/RECORD
JRST E$$IFU ;**IREAD FILE IS MESSED UP
CAMLE T1,BUFSIZ ;MUST BE LESS THAN THIS
JRST PHXLRG ;NO--TELL ABOUT LARGE RECORD AND FINISH UP
PHYX.4: MOVNS T1 ;NEGATE IT
HRLZ T2,T1 ;FORM AOBJ WORD
HRR T2,FORADR ;POINT TO THE BUFFER
MOVE W,T2 ;W IS SETUP NOW
MOVN P1,T1 ;GET WORD COUNT AS POSITIVE
HRRZ P2,T2 ;GET BUFFER ADDRESS
PHYX.2: SKIPLE T4,IBHR+.BFCTR ;GET WORD COUNT--ARE ANY WORDS LEFT?
JRST PHYX.3 ;YES--GO USE THEM
CALL XCTIO ;NO--NEED A BUFFER
IN INPC, ;XCT'D
SKIPA ;EOF ALREADY?
JRST PHYX.2 ;PICK UP THE WORD COUNT
ERROR. EF$FTL,EBE,<EOF BEFORE END OF IREAD RECORD>
PHYX.3: CAMLE T4,P1 ;ARE THERE MORE THAN WHAT WE NEED?
MOVE T4,P1 ;YES--ONLY USE WHAT WE NEED
MOVS T1,IBHR+.BFPTR ;BEGIN THE BLT CTL WORD
HRRI T1,-1(P2) ;FORM OTHER HALF (-1 FOR NEXT INSTR)
AOBJP T1,.+1 ;EVERYTHING IS OFF BY ONE
ADDM T4,IBHR+.BFPTR ;INCREMENT PTR TO NEXT FREE WORD
ADDM T4,P2 ;ALSO ADJUST FORADR PTR
MOVNS T4 ;MAKE COUNT NEGATIVE
ADDM T4,P1 ;DECREMENT WORD REQUIRED
ADDM T4,IBHR+.BFCTR ;DECREMENT BUFFER TOTAL
BLT T1,-1(P2) ;XFR THE WORDS
JUMPG P1,PHYX.2 ;JUMP IF NOT FINISHED WITH RECORD
JRST $POPJ1 ;DONE
E$$IFU: ERROR. EF$FTL,IFU,<IREAD FILE MESSED UP>
;HERE WHEN RECORD TOO LARGE READING DISK IREAD FILE
PHXLRG: CALL LRGERR ;TELL USER AND DUMP FILE ABOUT IT
MOVN T2,BUFSIZ ;GET - MAX BUFFER SIZE
ADD T2,T1 ;COMPUTE # WORDS EXTRA IN RECORD
SAVE$ T2 ;SAVE WHILE WE COPY REST OF RECORD
MOVE T1,BUFSIZ ;SETUP T1 TO MAX RECORD SIZE
CALL PHYX.4 ;COPY FIRST PART (FILL FORBUF)
JRST E$$IFU ;SNH
RESTR$ T2 ;COMPUTE # WORDS WE MUST SKIP
PHXL.2: CALL INPWRD ;GET ONE
JRST E$$IFU ;SNH
SOJG T2,PHXL.2 ;EAT THEM ALL
JRST $POPJ1 ;RETURN WITH ALL THAT WE COULD EAT
>;END IFN FT$PHX
;CALL HERE TO REPORT RECORD TOO LARGE TO TTY AND DUMP FILE
;T1 CONTAINS SIZE OF RECORD THAT WAS TOO LARGE
LRGERR: CALL FRCTYO ;FORCE TTY OUTPUT (SO CRLF IS CORRECT)
CALL .TCRLF## ;NEW LINE TO TTY (.TCRLF PRESERVES T1!)
CALL RTLERR ;REPORT RECORD IN ERROR TO TTY
TRNE DC,(DV.TTY) ;IF TTY OUTPUT FILE
POPJ P, ;DON'T TELL HIM (HER) TWICE
SAVE$ T1 ;SAVE RECORD SIZE
CALL O$CRLF ;FIRST SET TO NEW LINE
CALL O$CRLF ;AND SKIP ONE SO MESSAGE STANDS OUT
MOVEI T1,O$CHAR ;SET MY OUTPUT ROUTINE
CALL .TYOCH## ;WITH .TOUTS
EXCH T1,(P) ;SAVE OLD ROUTINE, RESTORE SIZE
SETOM ERRTYX ;FLAG EHNDLR NOT TO SWITCH OUTPUTS
CALL RTLERR ;REPORT LARGE RECORD TO DUMP FILE
XCHTYO: EXCH T1,(P) ;...
CALL .TYOCH## ;RESTORE SCANS OUTPUT
JRST TPOPJ ;RESTORE T1 AND RETURN
RTLERR: WARN. EF$DEC!EF$NCR,RTL,<RECORD TOO LARGE - >
CALL TYFREC ;TYPE FILE AND RECORD LOCATION
PJRST .TCRLF## ;NEW LINE AND EXIT
TYFREC: SAVE$ T1 ;SAVE SIZE
STRNG$ < - FILE >
MOVE T1,FILE
CALL .TDECW##
STRNG$ < RECORD >
MOVE T1,RECORD
AOJ T1, ;REALLY C(RECORD)+1
CALL .TDECW##
PJRST TPOPJ ;RESTORE SIZE AND RETURN
;CALL HERE TO GET ONE WORD FROM INPUT FILE
;CPOPJ1 WITH WORD IN T1 OR CPOPJ IF EOF
INPWRD: SOSGE IBHR+.BFCTR ;ANY WORDS AT ALL?
JRST INPW.1 ;NO--GET SOME
ILDB T1,IBHR+.BFPTR ;YES--GET IT
JRST $POPJ1
INPW.1: CALL XCTIO ;GET A BUFFER
IN INPC,
POPJ P, ;EOF
JRST INPWRD ;GET A WORD NOW
;CALL HERE TO FORCE OUTPUT TO TTY IF OUTPUT OPEN AND TTY IS OUTPUT FILE
FRCTYO: TLNN F,FL$OPN ;OUTPUT FILE OPEN?
POPJ P, ;NO--DONT GET UNASSIGNED CHANNEL IO
TRNE DC,(DV.TTY) ;TTY DUMP?
OUTPUT OUTC, ;YES--MAKE MESSAGE APPEAR IN RIGHT PLACE
POPJ P,
SUBTTL READ FORTRAN BINARY RECORDS
RDFORT: CALL .SAVE1## ;NEED A REGISTER
SETZ W, ;CLEAR WORD COUNT
MOVE P1,FORADR ;POINT AT THE ARRAY
TLZ F,FL$TMP!FL$FL2 ;FL$TMP IS THE "SAW TYPE 1 LSCW" FLAG
;FL$FL2 IS THE "RECORD TOO LARGE" FLAG
RFOR.1: CALL INPWRD ;GET A WORD
POPJ P, ;END OF FILE
RFOR.3: TLNN T1,CW$ANY ;IS IT AN LSCW
JRST FORSRC ;NO--GO FIND ONE
TLNN T1,CW$1O3 ;TYPE 1 OR 3?
JRST FORCW2 ;NO--TYPE 2
TLNE T1,CW$TY3 ;TYPE 3?
JRST FORCW3 ;YES
;HERE TO DO FORTRAN TYPE 1 LSCW
FORCW1: TLO F,FL$TMP ;FLAG WE SAW ONE
FORCON: MOVE T2,T1 ;COPY LSCW
MOVEI T1,-1(T1) ;GET DATA WORD COUNT
ADD W,T1 ;UPDATE WORD COUNT
TLNE F,FL$FL2 ;ARE WE IN A LARGE RECORD?
JRST RFOR.5 ;YES--SKIP AHEAD
CAMLE W,BUFSIZ ;ROOM IN BUFFER?
JRST FORLRG ;NO--GO FIXUP
HRL T1,IBHR+.BFPTR ;GET LH OF BLT
HRRI T1,-1(P1) ;RH--(-1 SO WE CAN AOBJN)
AOBJN T1,.+1 ;MAKE IT RIGHT
ADD P1,T2 ;COMPUTE END OF BLT
RFOR.4: BLT T1,-1(P1) ;MOVE WORDS
RFOR.5: MOVEI T1,-1(T2) ;COUNT DATA WORDS EATEN
ADDM T1,IBHR+.BFPTR
MOVNI T1,-1(T2) ;...
ADDM T1,IBHR+.BFCTR
JRST RFOR.1 ;CONTINUE
FORCW2: TLNN F,FL$TMP ;SEEN A TYPE 1?
JRST FORSRC ;NO--GO FIND ONE
JRST FORCON ;YES--CONTINUE COPYING RECORD
FORCW3: TLZN F,FL$FL2 ;WAS RECORD TOO LARGE?
JRST FOR3.X ;NO--EXIT GRACEFULLY
MOVE T1,W ;YES--GET RECORD SIZE
CALL LRGERR ;REPORT LARGE RECORD
HRRZ W,BUFSIZ ;SET TO RETURN ONLY MAX
FOR3.X: MOVN W,W ;BEGIN TO COMPUTE AOBJN TO FORADR
HRLZS W
HRR W,FORADR ;NOW WE ARE DONE
JRST $POPJ1 ;SKIP BACK
FORSRC: CALL INPWRD ;GET A WORD
ERROR. EF$FTL,IFF,<INCORRECTLY FORMATTED FORTRAN FILE>
TLNN T1,776000 ;ANY LS?
TLNN T1,1000 ;TYPE 1?
JRST FORSRC ;NOPE
MOVE T2,BUFSIZ ;YES--GET /BUFSIZ
CAIGE T2,(T1) ;CAN IT BE?
JRST FORSRC ;NOPE
HRRZ T2,IBHR+.BFCTR ;GET WHAT IS LEFT IN BUFFER
CAIE T2,-1(T1) ;THE SAME?
JRST FORSRC ;NO
HRRZ T2,IBHR+.BFPTR ;GET PTR
ADDI T2,(T1) ;COMPUTE WHERE NEXT LSCW IS
MOVE T2,@T2 ;GET IT
TLNN T2,774000 ;IS IT AN LSCW?
TLNN T2,CW$ANY ;IS IT ANY LSCW?
JRST FORSRC ;NOT YET
JRST RFOR.3 ;YES--GO PROCESS IT
;HERE WHEN WE SEE THAT THE RECORD IS TOO LARGE
FORLRG: TLO F,FL$FL2 ;FLAG FOR FORCW3 THAT RECORD IS TOO LARGE
HRL T1,IBHR+.BFPTR ;GET SET TO MOVE WHAT WE CAN FROM THIS RECORD
HRRI T1,-1(P1) ;...
AOBJN T1,.+1 ;FIX PTR
HRRZ P1,FORADR ;COMPUTE END OF BUFFER
ADD P1,BUFSIZ ;...
JRST RFOR.4 ;GO MOVE WHAT WE CAN AND SKIP REST
SUBTTL POSITIONING FUNCTIONS
D$SKP: TLNE F,FL$OUT ;WHICH SIDE?
TLNN DC,(DV.DIR) ;INPUT--IS THIS DIRECTORY?
TRNE DC,(DV.DIR) ;OUTPUT--IS THIS DIRECTORY?
JRST SKPDIR ;DIRECTORY--GO SKIP IT
TLNE F,FL$FOR ;MTA--IS IT FORTRAN SKIP?
JRST SKMFOR ;YES--DO IT
ADDM P1,FILE ;INCREMENT FILE COUNT
ADDM P2,RECORD ;AND RECORD COUNT
MOVE T1,[MTSKF.] ;GET FILE MTAPE
MOVE T2,[MTSKR.] ;AND RECORD MTAPE
DSKP.G: CALL SETIOC ;SET I/O CHANNELS IN
CALL SKPFLR ;DO THEM
JRST DMPLUP ;CONTINUE
;HERE TO SKIP FORTRAN BINARY ON MTA
SKMFOR: MOVE T1,[MTSKF.] ;SKIP FILES
CALL SETIOC ;SETUP FOR IT
SKMF.1: XCT T1 ;SKIP ONE FILE
XCT T3 ;WAIT FOR IT
AOS FILE ;COUNT THE FILE
SOJG P1,SKMF.1 ;DO ALL NEEDED
JRST SKDFOR ;GO SKIP RECORDS AND FINISH UP
SETIOC: TLNE F,FL$OUT ;INPUT OR OUTPUT?
JRST SETI.1 ;INPUT
TLO T1,(Z OUTC,) ;SET IN CHANNEL
TLO T2,(Z OUTC,) ;...
MOVE T3,[MTWAT. OUTC,] ;SET INSTR TO WAIT ON I/O
POPJ P,
SETI.1: TLO T1,(Z INPC,) ;INPUT CHANNEL
TLO T2,(Z INPC,)
MOVE T3,[MTWAT. INPC,] ;INSTR TO WAIT ON I/O
POPJ P,
SKPFLR: JUMPLE P1,SKPL.1 ;JUMP IF NO FILE ACTION
SKPL.0: XCT T1 ;DO IT
XCT T3 ;WAIT FOR OP TO FINISH
SOJG P1,SKPL.0 ;ALL REQUESTED TIMES
SKPL.1: JUMPLE P2,$POPJ ;JUMP IF NO RECORDS
SKPL.2: XCT T2
XCT T3 ;WAIT FOR I/O
SOJG P2,SKPL.2
POPJ P,
SKPDIR: JUMPG P1,E$$SFI ;SKIPPING FILES IS HIGHLY ILLEGAL
TLNE F,FL$FOR!FL$PHY ;FORTRAN OR PHYSICS?
JRST SKDFOR ;YES
SKIPN T1,RECORD ;WHERE ARE WE NOW?
MOVEI T1,1 ;MUST BE AT THE BEGINNING
ADDI T1,-1(P2) ;COMPUTE NEW RECORD
CAMLE T1,IFILSZ ;DON'T USETI PAST EOF
MOVE T1,IFILSZ ;...
MOVEM T1,RECORD ;...
USETI INPC,1(T1) ;SET TO READ IT
CALL CLRUSE ;CLEAR USE BITS FOR FRESH READ
JRST DMPLUP ;CONTINUE EXECUTING FNS
SKDFOR: TLO F,FL$MNP ;FLAG MANIPULATING
SKDF.1: CALL GETBUF ;READ A RECORD
JRST DMPEND ;END IT ALL
AOS RECORD ;COUNT THE RECORD
SOJG P2,SKDF.1 ;DO ALL REQUESTED
TLZ F,FL$MNP ;NOT MANIPULATING ANY MORE
JRST DMPLUP ;CONTINUE
E$$SFI: ERROR. EF$FTL,SFI,<SKIP/BACKSPACE FILES ILLEGAL ON DIRECTORY DEVICE>
D$BSP:
TLNE F,FL$OUT ;INPUT OR OUTPUT?
TLNN DC,(DV.DIR) ;INPUT--IS IT A DIR DEV?
TRNE DC,(DV.DIR) ;OUTPUT--IS IT A DIR DEV?
JRST BSPDIR ;DIR DEV--GO DO IT
TLNE F,FL$FOR ;IS IT /FORTRAN?
JRST E$$SFM ;CANT
MOVN T1,P1 ;UPDATE FILE AND RECORD
ADDM T1,FILE ;COUNTS
MOVN T1,P2 ;...
ADDM T1,RECORD
MOVE T1,[MTBSF.] ;SETUP OPS
MOVE T2,[MTBSR.]
JRST DSKP.G ;GO DO IT AND RETURN
E$$SFM: ERROR. EF$FTL,SFM,<CANT BACKSPACE MTA WITH /FORTRA>
BSPDIR: JUMPG P1,E$$SFI ;CAN'T SKIP MULTIPLE FILES ON DIR DEV
TLNN F,FL$OUT ;NOR ON OUPTUT DEVICE
JRST E$$BSO ;GO DIE
SKIPN T1,RECORD ;WHERE ARE WE?
MOVEI T1,1 ;DON'T KNOW--MUST BE AT START OF FILE
SUB T1,P2 ;COMPUTE NEW POSITION
SKIPG T1 ;PAST BEGINNING OF FILE?
MOVEI T1,1 ;YES--SET FOR FIRST RECORD
TLNE F,FL$FOR!FL$PHY ;FORTRAN OR PHYSICS?
JRST BSPFOR ;YES--GO HANDLE IT
USETI INPC,(T1) ;POSITION MYSELF THERE
SOS T1 ;ONE LESS TO STORE IN RECORD
MOVEM T1,RECORD ;WILL GET UPDATE AT RECHDR
CALL CLRUSE ;CLEAR USE BITS
JRST DMPLUP
E$$BSO: ERROR. EF$FTL,BSO,<CANT BACKSPACE DISK OUTPUT>
BSPFOR: MOVE P2,T1 ;POSITION # RECS TO SKIP
USETI INPC,1 ;POSITION TO FILE START
CALL CLRUSE ;CLEAR USE BITS
SETZM RECORD ;RESET
SOJLE P2,DMPLUP ;JUMP IF WE ARE IN PROPER POSITION
JRST SKDFOR ;NO--GO SKIP SOME RECORDS
;HERE TO PROCESS /REWIND
D$REW: TLNN F,FL$OUT ;OUTPUT SIDE?
TRNE DC,(DV.MTA) ;YES--IS IT A MAGTAPE
CAIA ;INPUT DEVICE OR OUTPUT IS MTA
ERROR. EF$FTL,CRD,<CANNOT REWIND DISK OUTPUT>
SETZM FILE ;CLEAR FILE AND RECORD
SETZM RECORD ;...
TLNE F,FL$OUT ;INPUT SIDE?
TLNN DC,(DV.DIR) ;A DIRECTORY DEVICE?
JRST REWMTA ;OUTPUT OR INPUT NOT DIRECTORY
USETI INPC,1 ;SET TO READ FIRST BLOCK
CALL CLRUSE ;CLEAR THE USE BITS IN THE RING
JRST DMPLUP ;DO NEXT COMMAND
REWMTA: MOVE T1,[MTREW.] ;SET UP FUNCTION
TLNE F,FL$OUT ;INPUT OR OUTPUT?
TLOA T1,(Z INPC,) ;INPUT SIDE
TLO T1,(Z OUTC,) ;OUTPUT SIDE
XCT T1 ;REWIND THE DEVICE
JRST DMPLUP ;NEXT COMMAND
D$RIB: TLNE F,FL$OUT ;MUST BE INPUT SIDE
TLNN DC,(DV.DSK) ;AND ON THE DSK
ERROR. EF$FTL,RIB,</RIB ILLEGAL ON OUTPUT OR ILLEGAL DEVICE FOR /RIB>
USETI INPC,0 ;POSITION TO READ THE RIB
CALL CLRUSE ;CLEAR THE USE BITS
JRST DMPLUP ;BACK FOR MORE
D$ONL: JUMPL P1,E$$ONL ;CHECK FOR BAD NUMBERS
JUMPL P2,E$$ONL ;..
MOVE T1,P1 ;NOW SEE IF /ONLY WITH NO ARGS
TSO T1,P2 ;WHICH MEANS TO TURN OFF THE MODE
JUMPE T1,D$ONLF ;SO GO DO THAT
CAMGE P2,P1 ;END MUST BE AT LEAST AS BIG AS BEGINNING
JRST E$$ONL ;LOOSE
SKIPN P1 ;MAKE SURE WE HAVE AT LEAST ONE
MOVEI P1,1 ;...
MOVEM P1,ONLYLO ;SAVE LOW LIMIT
MOVEM P2,ONLYHI ;AND HIGH LIMIT
TLOA F,FL$OLY ;TELL DUMPIT WE ARE ONLY DUMPING PARTIAL REC
D$ONLF: TLZ F,FL$OLY ;HERE WE TURN OFF IF /ONLY OR /ONLY:0
JRST DMPLUP ;CONTINUE FUNCTIONS
E$$ONL: ERROR. EF$FTL,OIS,</ONLY INCORRECTLY SPECIFIED>
CLRUSE: WAIT INPC, ;WAIT FOR THINGS TO SETTLE OUT
HRRZ T1,IBHR+.BFADR ;START AT THE BEGINNING
HRRZ T2,T1 ;COPY TO MOVE AROUND
MOVSI T3,(BF.IOU) ;BIT TO CLEAR
CLRU.1: ANDCAM T3,(T2) ;CLEAR THE USE BIT
HRRZ T2,(T2) ;MOVE TO NEXT
CAMN T2,T1 ;DONE?
JRST CLRU.1 ;NO
MOVSI T3,(BF.VBR) ;YES--NOW FIX BUFFER HEADER
IORM T3,IBHR+.BFADR
POPJ P, ;ALL DONE
SUBTTL ATTEND TO TTY INPUT WHILE RUNNING
;CHKTTY -- SEE IF A COMMAND TYPED WHILE RUNNING
;CALL: CALL CHKTTY
; *SAID TO KILL*
; *KEEP GOING*
CHKTTY: TLNE F,FL$ITY ;/IFTYP
INCHRS T1 ;YES--GET CHAR IF THERE
JRST $POPJ1 ;NO /IFTYP OR NO CHAR
CLRBFI ;EAT WHAT MIGHT BE LEFT
MOVSI T2,-N$IFTC ;AOBJN COUNTER
CAME T1,IFTCMD(T2) ;THIS IT?
AOBJN T2,.-1
JUMPL T2,@IFTDSP(T2) ;JUMP IF FOUND A GOOD ONE
MOVEI T1,.CHBEL ;NO--GET A BELL
AOS (P) ;SET TO SKIP BACK
PJRST .TCHAR## ;TYPE BELL AND CONTINUE
IFTCMD: EXP "I" ;IGNORE IFTYP
EXP "K" ;KILL COMMAND
EXP "P" ;PAUSE COMMAND
N$IFTC==.-IFTCMD
IFTDSP: EXP IFTIGN ;IGNORE
EXP $POPJ ;KILL
EXP CHKT.P ;PAUSE
IFTIGN: TLZ F,FL$ITY ;CLEAR /IFTYP
PJRST $POPJ1 ;SKIP BACK
CHKT.P: CALL .TCRLF## ;NEW LINE
INFO. 0,PTC,<PAUSING--TYPE ANY CHARACTER TO CONTINUE>
AOS (P) ;SKIP BACK
GCHNWL: CLRBFI ;CLEAR INPUT
INCHRW T1 ;GET A CHARACTER
CLRBFI ;EAT REAST
OUTSTR [ASCIZ/
/]
POPJ P, ;RETURN
SUBTTL OPEN I/O CHANNELS
;OPENIO
;CALL: MOVEI T1,<FDB ADDR>
; CALL OPENIO
; CAI CHANNEL,BUFADR ;@ IF OUTPUT, (MODE)
; *ALL IS WELL RETURN* ;ABORT IF FAIL
OPENIO: HRL T1,0(P) ;REMEMBER CALLER
AOS 0(P) ;SKIP ARGS ON RETURN
CALL .SAVE3## ;PRESERVE REGISTERS
MOVS P1,T1 ;COPY ARGUMENTS
MOVE P2,(P1) ;GET REST OF THEM
STORE T1,OPNBLK,LKPBLK+.RBTIM,0 ;CLEAR ANY RESIDUE IN BLOCK
MOVSI T1,.FXLEN ;SETUP FOR .STOPB
HLR T1,P1 ;...
MOVEI T2,OPNBLK ;
SKIPA T3,.+1
.RBTIM+1,,LKPBLK
MOVEI T4,PTHBLK
CALL .STOPB## ;CONVERT TO OPEN/LOOKUP BLOCKS
JRST WLDERR ;NO WILDCARDING!
MOVEI T1,.RBTIM ;SETUP COUNT
MOVEM T1,LKPBLK+.RBCNT
LDB T1,[POINT 4,P2,17] ;GET MODE
MOVEM T1,OPNBLK ;STORE IN OPEN BLOCK
HRRZ T1,P2 ;BUFFER HEADER ADDRESS
TLNE P2,ATSIGN ;READ OR WRITE?
MOVSS T1 ;WRITING, POSITON FOR IT
MOVEM T1,OPNBLK+.OPBUF;STORE
LDB P3,[POINT 4,P2,12] ;GET I/O CHANNEL
LSH P3,5 ;POSITION
MOVSS P3 ;IN CHANNEL POSITION
MOVE T1,[OPEN OPNBLK];FORM INSTR
OR T1,P3 ;FINISH
XCT T1 ;TRY TO OPEN DEVICE
JRST OPENER ;CAN'T--BOMB OUT
MOVE T1,P3 ;REGET I/O CHANNEL
TLNE P2,ATSIGN ;READ/WRITE?
TLOA T1,(ENTER) ;WRITE
TLO T1,(LOOKUP) ;READ
HRRI T1,LKPBLK ;COMPLETE INSTR
XCT T1 ;FIND/WRITE THE FILE
JRST LKENER ;CAN'T
POPJ P, ;DONE
;OPENIO ERRORS
OPENER: HLRZ T1,P1 ;COPY FDB ADDR
ERROR. EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >
WLDERR: HLRZ T1,P1 ;GET FDB
ERROR. EF$FTL!EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >
LKENER: HRRZ T1,LKPBLK+.RBEXT;GET FAIL CODE
ERROR. EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
STRNG$ <) FILE >
HLRZ T1,P1
CALL .TFBLK## ;TYPE SCAN BLOCK
CALL .TCRLF## ;NEW LINE
JRST ERRFTL ;GO DIE
SUBTTL XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING
;XCTIO
;CALL: CALL XCTIO
; <INSTR TO XCT> ;IN/OUT UUO
; *EOF/EOT RETURN*
; *NORMAL RETURN*
XCTIO: XCT @0(P) ;DO THE INSTR
JRST $POPJ2 ;OK--SKIP 2 AND RETURN
SAVE$ T1 ;OOPS--SAVE T1
MOVE T1,@-1(P) ;GET INSTR WE FAILED ON
AOS -1(P) ;SKIP INSTR ON WAY BACK
XCTIOE: AND T1,[17B12] ;ERROR--GET THE CHANNEL
PUSH P,T3 ;SAVE T3 A SECOND
MOVE T3,T1 ;GET CHANNEL
OR T3,[WAIT] ;WAIT FOR I/O TO CEASE
XCT T3 ;DO IT NOW
POP P,T3 ;GET T3 BACK
OR T1,[GETSTS T2] ;GET ERRROR BITS
XCT T1
TRNE T2,IO.EOF!IO.EOT;END OF SOMETHING?
JRST TPOPJ ;YES
EXCH T1,T2 ;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
HRR T2,T1 ;PUT BITS IN THE INSTR
TRZ T2,IO.ERR ;CLEAR ERROR BITS
TLZ T2,002000 ;BY MAJIK, A GETSTS BECOMES A SETSTS
XCT T2 ;CLEAR THE ERROR BITS
LDB T2,[POINT 4,T2,12] ;GET IO CHANNEL
SAVE$ T2 ;SAVE CHAN ON PDL
CAIE T2,INPC ;INPUT?
JRST XCTI.1 ;NO--ALWAYS MESSAGE THEM
TLNN F,FL$MNP ;READING TO SKIP?
SKIPLE FLNTRY ;OR NOT /NORETRY
JRST ETPJ1 ;ONE OR THE OTHER GETS NO MESSAGE
MOVE T2,FLERR ;GET /ERROR VALUE
CAIN T2,ERRIGN ;IS IT /ERROR:IGNORE?
JRST ETPJ1 ;YES--DON'T GRIPE
XCTI.1: RESTR$ T2 ;GET CHAN BACK
CALL TELIOE ;TELL OF THE ERROR
SKIPLE T1,FLERR ;GET /ERROR:ARG FLAG
CAIE T1,ERRQUE ;WAS IT /ERROR:QUERY?
JRST XIOCON ;NO--TELL CONTINUING AND EXIT THIS CALL
JRST GEROPT ;YES--SEE WHAT HE (SHE) WANTS TO DO
TELIOE: CALL FRCTYO ;FORCE TTY OUTPUT
CALL .TCRLF## ;NEW LINE
CALL TELIO1 ;TELL TO USERS TTY
CAIN T2,INPC ;IF NOT INPUT CHANNEL OR,
TRNE DC,(DV.TTY) ;IF OUTPUT IS ALSO TO TTY
POPJ P, ;THEN WE ARE DONE
SAVE$ T1 ;NO--SAVE T1
CALL O$CRLF ;NEW LINE
CALL O$CRLF ;AND ANOTHER
MOVEI T1,O$CHAR ;SETUP ROUTINE
CALL .TYOCH## ;WITH SCAN
EXCH T1,(P) ;REMEMBER OLD ONE
SETOM ERRTYX ;TELL EHNDLR TO NOT SWITCH THEM NOW
CALL TELIO1 ;TELL ERROR TO LISTING
PJRST XCHTYO ;FIXUP OUTPUT AND RETURN
TELIO1: WARN. EF$NCR!EF$OCT,IOE,<I/O ERROR - STATUS=>
CALL TELPRB ;DECODE BITS FOR USER
SAVE$ T1 ;SAVE STATUS
STRNG$ <, FILE >
MOVEI T1,OUTSPC ;ASSUME OUTPUT ERROR
SAVE$ T2 ;SAVE CHAN
CALL @[EXP TINSPC,.TFBLK##]-1(T2) ;TYPE THE FILE SPEC
CALL TYFREC ;TYPE FEET AND RECORDS
RESTR$ T2 ;GET CHANN BACK
CALL .TCRLF## ;NEW LINE
JRST TPOPJ ;RESTORE T1 AND RETURN
$POPJ2: AOS (P) ;SKIP 2
$POPJ1: AOS (P) ;SKIP 1
$POPJ: POPJ P, ;SKIP 0
;HERE WITH ERROR BITS IN T1--DECODE THEM
;USES NO ACS
TELPRB: CALL .PSH4T## ;PRESERVE ACS
MOVE T4,T1 ;COPY BITS
ANDI T4,IO.IMP!IO.DER!IO.DTE!IO.BKT ;GET ONLY ERROR BITS
JUMPE T4,PRBDUN ;JUMP IF NOT A PROBLEM
LSH T4,-<ALIGN. (IO.BKT)> ;LINE UP
MOVEI T1,[ASCIZ/ (/] ;START
CALL .TSTRG##
TLZ F,FL$IOF ;CLEAR A FLAG
MOVE T3,[POINT 18,PRBNAM] ;INIT A PTR
PRBLUP: ILDB T2,T3 ;GET A NAME
TRNN T4,1 ;IS THIS A PROBLEM?
JRST PRBNXT ;NO
TLOE F,FL$IOF ;YES--IS IT FIRST?
CALL TYSLSH ;NO--TYPE A SLASH
MOVSI T1,(T2) ;POSITION CODE
CALL .TSIXN## ;SEND IT
PRBNXT: LSH T4,-1 ;MOVE OVER
JUMPN T4,PRBLUP ;JUMP IF MORE PROBLEMS
MOVEI T1,")" ;NO--FINISH
CALL .TCHAR##
PRBDUN:
POP4J: CALL .POP4T## ;RESTORE REGS
POPJ P, ;AND RETURN
PRBNAM: 'BKTPAR' ;BLOCK TOO LARGE/PARITY ERROR
'DERIMP' ;DEVICE ERROR/WRITE LOCKED
EXP 0 ;SNH
GEROPT: STRNG$ <
OPTION (H FOR HELP): >
CALL GCHNWL ;GET HIS ANSWER IN T1
MOVSI T2,-N$EOPT ;GET LOOP COUNT
CAME T1,ERROPT(T2) ;IS THIS IT?
AOBJN T2,.-1 ;NO--CHECK ALL
JUMPL T2,@ERRDSP(T2) ;JUMP IF FOUND A MATCH
JRST GEROPT ;ELSE ASK AGAIN
ERROPT: EXP "C" ;CONTINUE
EXP "H" ;GIVE SOME HELP
EXP "I" ;IGNORE FROM NOW ON
EXP "Q" ;QUIT (FAKE AN EOF)
EXP "S" ;SKIP THIS RECORD
N$EOPT==.-ERROPT
ERRDSP: EXP XIOCON ;CONTINUE
EXP GVEHLP ;GIVE HELP
EXP ERIGNR ;IGNORE ERRORS FROM NOW ON
EXP ERQUIT ;QUIT
EXP ERSKIP ;SKIP THIS RECORD
;HERE TO SET /ERROR:IGNORE
ERIGNR: MOVEI T1,ERRIGN ;GET VALUE
MOVEM T1,FLERR ;
XIOCON:
TPOPJ1: RESTR$ T1 ;GET T1 AGAIN
AOSA (P)
TPOPJ: RESTR$ T1
POPJ P,
ETPJ1: POP P,(P) ;CLEAR CRUD ON PDL
JRST TPOPJ1 ;AND RESTORE T1 AND RETURN
;HERE TO GIVE SOME HELP
GVEHLP:
IFE FT$SEG,<CALL UPSCN> ;MAKE HISEG ADDRESSABLE
OUTSTR ERRHLM ;GIVE THE HELP
IFE FT$SEG,<CALL DWNSCN> ;REMOVE CORE ONCE MORE
JRST GEROPT
IFE FT$SEG,<HIGH$> ;PUT MESSAGE IN SHARABLE HISEG
ERRHLM: ASCIZ$ <TYPE ONE OF:
C - CONTINUE (DUMP THIS RECORD)
H - TYPE THIS
I - CONTINUE AND MAKE IT /ERROR:IGNORE
Q - QUIT NOW
S - SKIP THIS RECORD (DO NOT DUMP IT)
>
IFE FT$SEG,<LOW$> ;BACK TO LOWSEG
;HERE TO QUIT
ERQUIT: SETZB P1,P2 ;FORCE AND END TO IT ALL
JRST TPOPJ ;RETURN EOF
;HERE TO SKIP THIS RECORD
ERSKIP: AOS RECORD ;COUNT RECORD WE SKIPPED
MOVE T1,-1(P) ;GET ADDRESS +1
MOVE T1,-1(T1) ;GET INSTR
XCT T1 ;CLANK IT AGAIN
JRST TPOPJ1 ;OK--RETURN
JRST XCTIOE ;JUST CAN'T WIN...
SUBTTL ERROR HANDLER
;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERROR. MACRO
EHNDLR: CALL SAVACS ;SAVE THE ACS
TLNE F,FL$OPN ;OUTPUT FILE OPEN?
TRNN DC,(DV.TTY) ;IS THIS TTY OUTPUT?
CAIA ;OUTPUT NOT OPEN OR NOT TTY OUTPUT
CALL O$CRLF ;YES--MAKE NEW LINE SO MESSAGE IS SEEN
CALL FRCTYO ;FORCE OUTPUT IF TTY
MOVE P1,@0(P) ;GET FLAGS AND ADDRESSES
AOSE ERRTYX ;CLEAR/CHECK FLAG
SKIPN @.TYOCH## ;IS SCAN TTCALLING?
JRST [SETZM ERRTYX ;YES--CLEAR FLAG
JRST EHND.0] ;AND SKIP ON
SETZ T1, ;NO--SO MAKE IT
CALL .TYOCH## ;TELL SCAN
MOVEM T1,ERRTYX ;REMEMBER/SET FLAG
EHND.0: MOVEI T1,"?" ;ASSUME AN ERROR
TLNE P1,EF$WRN ;CHECK WARNING
MOVEI T1,"%" ;YES
TLNE P1,EF$INF ;IF BOTH OFF NOW THEN INFO
MOVEI T1,"[" ;GOOD THING WE CHECKED
CALL .TCHAR## ;OUTPUT THE START OF MESSAGE
MOVSI T1,MY$PFX ;SET UP MY PREFIX
HLR T1,(P1) ;GET MESSAGE PREFIX
CALL .TSIXN## ;OUTPUT THE PREFIXES
CALL .TSPAC## ;AND A SPACE
HRRZ T1,(P1) ;GET STRING ADDRESS
CALL .TSTRG## ;SEND IT
MOVE T1,SAVAC+T1 ;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
LDB T2,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
CAILE T2,EF$MAX ;CHECK LEGAL
MOVEI T2,0 ;NOOOP
CALL @ERRTAB(T2) ;CALL THE ROUTINE
TLNE P1,EF$NCR ;IF NO CRLF THEN DON'T CLOSE INFO
JRST EHND.1 ;NO--DON'T CHECK
MOVEI T1,"]" ;PREPARE TO CLOSE INFO
TLNE P1,EF$INF ;CHECK FOR INFO
CALL .TCHAR## ;SEND INFO CLOSE
TLNN P1,EF$NCR ;NO CARRIAGE RETURN?
CALL .TCRLF## ;YES--SEND ONE
EHND.1: SKIPN T1,ERRTYX ;DID WE RESET SCAN?
JRST EHND.2 ;NO
CALL .TYOCH## ;AND RESTORE IT
SETZM ERRTYX ;CLEAR FLAG
EHND.2: TLNE P1,EF$FTL ;NOW CHECK FATAL
JRST ERRFTL ;YES--GO DIE
;FALL INTO RESACS
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
; CALL RESACS
; *ACS RESTORED FROM SAVAC*
RESACS: MOVEM 17,SAVAC+17
MOVSI 17,SAVAC
BLT 17,17 ;REGISTERS ARE RESTORED
POPJ P, ;RETURN
ERRTAB: $POPJ ;CODE 0 -- NO ACTION
.TDECW## ;CODE 1 -- TYPE T1 IN DECIMAL
.TOCTW## ;CODE 2 -- TYPE T1 IN OCTAL
.TSIXN## ;CODE 3 -- TYPE T1 IN SIXBIT
.TPPNW## ;CODE 4 -- TYPE T1 AS PPN
.TSTRG## ;CODE 5 -- T1 POINTS TO ASCIZ STRING
.TFBLK## ;CODE 6 -- T1 POINTS AT FDB
;HERE TO DIE--
ERRFTL: RESET ;KILL ALL FILES
MOVE P,INIPDP ;RESET PDL
IFE FT$SEG,<CALL UPSCN> ;NEED HISEG
CALL .CLRBF## ;CLEAR REST OF LINE OR WHATEVER
SKIPN OFFSET ;CCL ENTRY
SKIPL ISCNVL ;OR MIXLOD MONITOR COMMAND?
CALL .MONRT## ;YES--EXIT 1,
JRST RESTRT ;AND RESTART ON CONTINUE
;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
; *ACS SAVED IN SAVAC* BEWARE!!
SAVACS: MOVEM 17,SAVAC+17 ;SAVE ONE
MOVEI 17,SAVAC
BLT 17,SAVAC+16
MOVE 17,SAVAC+17
POPJ P, ;ACS ARE SAVED
;TYSLSH -- TYPE A SLASH THROUGH .TCHAR
TYSLSH: MOVEI T1,"/"
PJRST .TCHAR## ;DONE
SUBTTL STORAGE
IFN FT$SEG,<RELOC 0> ;STORAGE GOES IN LOW SEGMENT
;STORAGE THAT REMAINS BETWEEN RUNS
U (ISCNVL) ;VALUE FROM .ISCAN
U (TLDVER) ;-1 WHEN TYPED VERSION TO TTY
IFE FT$SEG,< ;NEED TO STORE RUN ARGS
U (SAVRUN) ;-1 WHEN HAVE SAVED RUN ARGS
U (SGDEV) ;RUN UUO ARGUMENTS ARE SG???
U (SGNAM)
U (SGLOW)
U (SGPPN)
>;END IFE FT$SEG
U (OFFSET) ;STARTING OFFSET
FW$ZER==. ;FIRST WORD ZEROED
U (PDLIST,LN$PDL) ;PUSHDOWN LIST
U (SAVAC,20) ;SAVE ACS HERE
U (OPNBLK,3) ;OPEN BLOCK
U (LKPBLK,.RBTIM+1) ;LOOKUP/ENTER BLOCK
U (PTHBLK,^D9) ;PATH BLOCK
U (SVINOB,3) ;PLACE TO SAVE OPEN BLOCK FOR INPUT FILE
U (SVINLK,.RBTIM+1) ;PLACE TO SAVE LOOKUP BLOCK FOR INPUT FILE
U (CHRKNT) ;COUNTER FOR CHARACTERS OUTPUT
U (ERRTYX) ;FLAG FOR EHNDLR
U (ACTLST,LN$ACT) ;ACTION LIST
U (SCMDBP) ;BYTE PTR TO STORE IN CMDBFR
U (SCMDCT) ;BYTE CTR TO STORE IN CMDBFR
IFN FT$WLD,< ;WILD STORAGE
U (WLDFIR) ;ADDRESS OF SCAN BLOCK FOR .LKWLD
U (WLDPTR) ;WILD STORES SCAN BLOCK ADDR HERE
U (LKWLFL) ;-1/0/1 == DISK/DECTAPE/OTHER OR NULL
>;END IFN FT$WLD
U (EBCKNT) ;COUNT-DOWN FOR EBCDIC PRETTY PRINTING
U (IFILSZ) ;SIZE OF INPUT FILE IN BLOCKS
U (IDVNAM) ;INPUT REAL DEVICE NAME
U (ODVNAM) ;OUTPUT REAL DEVICE NAME
U (IBHR,3) ;INPUT BUFFER HEADER
U (OBHR,3) ;OUTPUT BUFFER HEADER
U (FORADR) ;ADDRESS OF BUFFER FOR FORTRAN/IREAD INPUT
U (BYTPTR) ;PTR FOR /MODE:BYTE
U (BYTBPW) ;# BYTES/WORD
U (BYTREM) ;# BITS LEFT OVER
U (BYTDPB) ;# DIGITS/BYTE
U (BYTWID) ;BYTE WIDTH FOR A WORD
U (BYTBPL) ;# BYTES/LINE
U (BYTRDB) ;REMAINDER DIGITS/BYTE
RUN$FZ==. ;FIRST WORD ZEROED AT COMMAND PROCESS START
BLOCK 3 ;***FOR TAPOP. UUO
REELID==.-1 ;REELID IS TAPOPBL-1
TAPOBL: ;FOR TAPOP.
U (FILE) ;FILE NUMBER
U (RECORD) ;RECORD NUMBER
U (TOTFIL) ;TOTAL FILES DUMPED
U (TOTREC) ;TOTAL RECORDS DUMPED
U (WRDCNT) ;ACCUMULATED RECORD WORD COUNT
U (ONLYLO) ;LOWEST WORD # IN RECORD TO DUMP
U (ONLYHI) ;HIGHEST WORD # IN RECORD TO DUMP
RUN$LZ==.-1 ;LAST WORD ZEROED AS RUN STARTS (DUMPING)
SCN$FZ==. ;FIRST WORD ZEROED AT CLRANS
U (CMDBFR,LN$CMD) ;SAVE COMMAND HERE SO WE CAN PUT ON DUMP
U (INPSPC,.FXLEN) ;INPUT SPECIFICATION
U (OUTSPC,.FXLEN) ;OUTPUT SPECIFICATION
U (DUMPFL) ;-1 WHEN /DUMP SEEN
U (TITLEB,LN$TTL) ;BLOCK FOR /TITLE
TITLEE==.-1 ;FOR END OF BLT
U (TTLZER) ;ENSURE A ZERO ON THE END
SCN$LZ==.-1 ;LAST WORD ZEROED AT CLRANS
SCN$FO==. ;FIRST WORD MINUS ONNED AT CLRANS
U (S.BLKF) ;/BLOCK:N
U (BUFSIZ) ;/BUFSIZ
U (FLERR) ;/ERROR:ARG
U (LINRDX) ;/LINRDX
U (NMTBUF) ;/MTBUF
U (FLNTRY) ;/NORETRY
U (FLOMIT) ;/OMIT
U (USERDX) ;/RADIX
U (USRWID) ;WIDTH OF WORD IF /RADIX USED
U (FLWIDT) ;/WIDTH
SCN$LO==.-1 ;LAST WORD ONNED AT CLRANS
LW$ZER==.-1 ;LAST WORD ZEROED AT STARTUP
IFN FT$SEG,< ;FORCE LITERALS OUT IN HIGH SEGMENT
RELOC
>;END IFN FT$SEG
XLIST ;JUST LITERALS FOLLOWING
LIT
LIST ;LITERALS PRECEDE
ENDUMP::END DUMPR