.
. FILE MODE SET AND DUMP ROUTINES
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
PURE CODE
.
. LENGTH COMMAND
.
LENGTH* LX X5,CDBPC,X8 GET LINK TO FIRST PARAMETER
LX X10,PBVAL,X5 LOAD FDT ADDRESS FOR FILE
LX X5,PBLINK,X5 LINK TO SECOND PARAMETER
LA A5,PBVAL,X5 LOAD NUMERIC SPECIFICATION
JZ A5,IBLX IGNORE IDIOTIC ZERO LENGTH BLOCK
JN A5,IBLX AND HUMORIST'S NEGATIVE LENGTH BLOCK
TG A5,(1,0) ..AS WELL AS ABSURDLY LONG BLOCK
J IBLX INTO THE ASHCAN
LA A0,FDTYPE,X10 LOAD FILE TYPE
JTAPE A0,TASEL ALLOW ANY LENGTH FOR TAPE
JE A0,FWAD,TASEL AND FOR WORD ADDRESSABLE DRUM
DSL A5,36 RIGHT JUSTIFY SPECIFIED WORD LENGTH
DI,U A5,28 DIVIDE BY SECTOR LENGTH
JZ A6,EMUL28 EVEN NUMBER OF SECTORS ?
AA,U A5,1 NO. ROUND UP
R$DIT . ESTABLISH EDITING MODE
E$MSG LRUX GET EDITING MESSAGE
LA A0,A5 LOAD NUMBER OF SECTORS
MSI,U A0,28 CHANGE TO WORDS
E$DECV . EDIT BLOCK LENGTH USED
E$MSGR . COPY SOME MORE
E$DECV A5 EDIT NUMBER OF SECTORS
E$MSGR . COPY 'SECTOR'
TLE,U A5,2 MORE THAN ONE ?
J NOPLUR NO. DON'T USE PLURAL FORM
E$CHAR 'S' PLURALISE 'SECTOR'
NOPLUR E$MSGR . COPY REST OF MESSAGE
LA,U A0,,X10 LOAD FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT NUMBER
EMUL28 MSI,U A5,28 CONVERT TO WORD LENGTH
TASEL SA A5,FDBLEN,X10 PUT BLOCK LENGTH IN FDT
COMPLETE . COMPLETE THIS OPERATION
.
IBLX R$DIT . ENTER EDITING MODE
E$MSG IBLM EDIT MESSAGE
E$DECV A5 EDIT BAD LENGTH SPECIFICATION
E$MSGR . COPY REST OF MESSAGE
LA,U A0,,X10 LOAD FDT ADDRESS
LMJ X11,FIST EDIT FILE AND STATEMENT
ZAP . ROADBLOCK THE FILE
COMPLETE . COMPLETE THIS OPERATION
/.
.
. STATUS COMMAND
.
STATD* LR,U R4 LOAD LIST ALL MODE
LA A14,CWOPTION LOAD OPTION BITS
TEP A14,(OPTION('D')) IS THE 'D' OPTION ON ?
LR,U R4,1 YES. SET LIST DISABLES ONLY
LR,U R5 CLEAR ANY DISABLES FOUND
R$DIT . SET UP EDITOR
REMOVE PARQUE GET A PARAMETER
TE,U A1,PARQUE NULL PARAMETER QUEUE ?
J SPECFL NO. GO LIST INFORMATION FOR SPECIFIED F
P FISTAT LOCK FACILITY STATUS
P PRINTER OBTAIN THE PRINTER
LX,H2 X5,FDCHAIN GET FDT CHAIN LINK
TNZ X5 ANY FILES ACQUIRED ?
J ENOFL NO. PRINT SPECIAL MESSAGE
EDNXS LMJ X7,STATED EDIT FILE STATUS
LX X5,FDLINK,X5 CHAIN TO NEXT FILE
TZ X5 ALL DONE ?
J EDNXS NO. EDIT NEXT STATUS
TNZ R4 LIST DISABLES ?
J COMPB NO. SKIP CHECK
TZ R5 ANY DISABLES FOUND ?
J COMPB YES. NO NEED FOR MESSAGE
E$MSG NODFM EDIT 'NO DISABLED FILES'
R$PRT 1 PRINT THE MESSAGE
COMPB R$DITX . TERMINATE EDITOR
COMPD V PRINTER RELEASE PRINTER
V FISTAT RELEASE FACILITY LOCK
J ICOUT END OF COMMAND
.
ENOFL E$MSG NOFEM EDIT NO FILES MESSAGE
R$PRTX 1 PRINT THE MESSAGE
J COMPD COMPLETE THE PROCESSING
.
. SPECIFIC FILE DUMP ROUTINE
.
SPECFL P FISTAT LOCK FACILITY STATUS
SPL LX X5,PBVAL,A1 LOAD FDT ADDRESS FOR FILE
BRELP A1 RELEASE PARAMETER BUFFER
LMJ X7,STATED EDIT STATUS OF FILE
REMOVE PARQUE GET NEXT PARAMETER
TE,U A1,PARQUE IS THIS THE END ?
J SPL NO. KEEP ON DUMPING FILES
R$DITX . RELEASE THE BUFFER
V FISTAT RELEASE FACILTIES LOCK
J ICOUT ALL DONE
.
. STATUS EDITOR SUBROUTINE X5 = FDT
.
STATED TNZ R4 LIST DISABLES ?
J STED1 NO. LIST ALL FILES
LA A0,FDLOCK,X5 LOAD FILE STATUS
TE,U A0,2 DISABLED ?
J 0,X7 NO. RETURN
LR,U R5,1 MARK FILES FOUND
sted1 LMJ X6,EFILE EDIT FILE NAME
E$CHAR ',' EDIT COMMA
LA A0,FDEQT,X5 LOAD EQUIPMENT TYPE
LA A0,EQTTAB+EPTNAME,A0 LOAD EQUIPMENT NAME
SSL A0,12 GET RID OF PROPERTY BITS
E$FD1 . EDIT NAME OF EQUIPMENT
E$SKIP 2 SKIP AFTER EQUIPMENT TYPE
LA A0,FDPROP,X5 LOAD FILE PROPERTY BITS
TEP,U A0,EPCOMM COMMUNICATIONS EQUIPMENT ?
J STEDCT1 YES. SKIP EDITING OF BLOCK LENGTH
E$FD4 ('LENGTH = ') EDIT BLOCK LENGTH INDICATOR
E$DECV FDBLEN,X5 EDIT BLOCK LENGTH
E$SKIP 2 SKIP A SPACE
STEDCT1 LA A0,FDLOCK,X5 LOAD FILE LOCK MODE
LSSL A0,1 MULTIPLY BY TWO
E$FD4 MODTAB,A0 EDIT FILE MODE
E$SKIP 2 SKIP SOME MORE
LA A0,FDPROP,X5 LOAD FILE PROPERTY BITS
TEP,U A0,EPCOMM COMMUNICATIONS FILE ?
J STEDCT2 YES. GO EDIT ITS STATUS
LA A1,FDTYPE,X5 LOAD TYPE OF FDT
JTAPE A1,TABLED EDIT BLOCK NUMBER FOR TAPE
LA A0,('SECTOR') LOAD SECTOR TEXT
TNE,U A1,FWAD IS IT A WAD FILE ?
LA A0,('WORD') YES. PRINT 'WORD'
E$FD1 . EDIT TEXT
E$CHAR ':' EDIT A COLON
E$SKIP 1 SKIP A SPACE
LA A1,FDLOCK,X5 LOAD THE FILE STATUS
LA A0,FDMSAD,X5 LOAD THE OFFICIAL ADDRESS
TNE,U A1,1 IN PROGRESS ?
LA A0,FDIPLC,X5 YES. LOAD IN-PROGRESS ADDRESS
E$DECV . EDIT THE POSITION
J PRINST PRINT STATUS
.
. EDIT STATUS OF COMMUNICATIONS FILE
.
STEDCT2 E$DECV FDBITPC,X5 EDIT BITS PER CHARACTER
E$FD3 (' BIT ') LABEL BITS PER CHARACTER
LA A0,FDCTMSPD,X5 LOAD CTM SPEED FROM FDT
LSSL A0,1 FORM INDEX TO SPEED TABLE
E$FD4 CTMSPD,A0 EDIT CTM SPEED
TNZ FDLT,X5 IS LINE CONNECTED ?
J PRINST NO. CANNOT PRINT MORE
E$FD4 (' CONNECTED') LABEL LINE AS CONNECTED
J PRINST GO PRINT STATUS
.
tabled E$FD3 ('FILE: ') LABEL FILES EXTENDED COUNT
lmj x6,uptpos update tape position
e$decv fdfext,x5 edit count of files extended
E$SKIP 1 SKIP AFTER FILE COUNT
E$FD3 ('BLOCK:') LABEL BLOCK COUNT
E$SKIP 1 SKIP A SPACE
LMA a0,fdbext,x5 LOAD ABSOLUTE BLOCK OFFSET
E$DECV . EDIT BLOCK OFFSET WITHIN FILE
tn fdbext,x5 is it relative to end of file ?
j prinst no. say from start of file
E$MSG1 FRMEOF OFFSET FROM END. SAY SO
PRINST R$PRT 1 PRINT THE FILE STATUS
J 0,X7 RETURN
.
. Update tape position
.
. LX,U X5,<fdt>
. LMJ X6,UPTPOS
. <return> X6, X11, A0, A1 destroyed
.
inf form 12,6,18 info$ form
.
uptpos* bget 10 obtain buffer to request position
lxi,u a0,6 load length for info$ request
la a1,fdin,x5 load first part of internal name
sa a1,6,a0 store into INFO$ packet
la a1,fdin+1,x5 load rest of internal name
sa a1,7,a0 store into the INFILE$ area
la a1,(inf infile$,0,0) load file name function
sa a1,,a0 set into packet
la a1,(inf ffilex$,0,0) load filex extended function
sa a1,2,a0 set into packet
la a1,(inf fblksx$,0,0) load blocks extended function
sa a1,4,a0 place in packet for info$
la,u a1,,a0 load address of work buffer
aa a1,(2,6) form access word for infile$
sa a1,1,a0 place in packet
ah a1,(-1,2) compute access word for ffilex$
sa a1,3,a0 set into packet
aa,u a1,1 advance to word for blocks extended
sa a1,5,a0 store access word into item
info$ . request information from system
la a1,8,a0 load the files extended
sa a1,fdfext,x5 store files extended count
la a1,9,a0 load blocks extended count
sa a1,fdbext,x5 save blocks extended count
brelp a0 release the work buffer
j 0,x6 return to caller
.
.
PURE DATA
FRMEOF ' FROM END OF FILE!'
LRUX 'LENGTH ROUNDED TO ! WORDS (! SECTOR!) FOR FASTRAND FORMAT !'
IBLM 'IMPROPER BLOCK LENGTH OF ! IGNORED FOR !'
MODTAB .
+ 'AVAILABLE'
+ 'IN USE@@@'
+ 'DISABLED'
.
. CTM SPEED MNEMONICS
.
CTMSPD + 'LOW SPEED'
+ 'MEDIUM SPEED'
+ 'SYNCHRONOUS'
+ 'TELPAK (R)'
* 'PARALLEL'R
.
P PROC 2,1
EQUIP* NAME 0
E FORM 24,12
I DO P(2) ,A(0) EQU A(0)++P(2,I)
A(1) EQU ((LJSF$1 P(1,1))**0777777770000)*/-12
E A(1),A(0)
END
.
. EQUIPMENT TYPE PROPERTY TABLE
.
EQTTAB* .
.
EQUIP 'DMY'
EQUIP '8C' EPTAPE
EQUIP '6C' EPTAPE
EQUIP '8CB' EPTAPE
EQUIP '6CB' EPTAPE
EQUIP '8C9' EPTAPE,EP9TRK
EQUIP '6C9' EPTAPE,EP9TRK
EQUIP '4C' EPTAPE
.
EQUIP '4CB' EPTAPE
EQUIP '12' EPTAPE,EPMSA
EQUIP '16' EPTAPE,EPMSA
EQUIP '12N' EPTAPE,EP9TRK,EPMSA
EQUIP '16N' EPTAPE,EP9TRK,EPMSA
EQUIP '20N' EPTAPE,EP9TRK,EPMSA
EQUIP '3A' EPTAPE
EQUIP '2A' EPTAPE
.
EQUIP 'D4' EPMASS,EPWAD
EQUIP 'D8' EPMASS,EPWAD
EQUIP 'D17' EPMASS,EPWAD
EQUIP 'D14' EPMASS,EPWAD,EPMSA
EQUIP 'D40' EPMASS,EPWAD,EPMSA
EQUIP 'DCS' EPMASS,EPWAD
EQUIP '026'
EQUIP '027'
.
EQUIP 'F2' EPMASS
EQUIP '031'
EQUIP 'F4' EPMASS
EQUIP 'F8' EPMASS
EQUIP 'F17' EPMASS
EQUIP 'F14' EPMASS,EPMSA
EQUIP 'F40' EPMASS,EPMSA
EQUIP 'FCS' EPMASS
.
EQUIP 'CRD'
EQUIP '041'
EQUIP 'PTP'
EQUIP '043'
EQUIP 'HSP'
EQUIP 'MHSP'
EQUIP '046'
EQUIP '9300'
.
EQUIP '1004'
I DO 7 , EQUIP '050'+I
.
EQUIP 'CONS'
I DO 7 , EQUIP '060'+I
.
EQUIP 'CTS'
EQUIP 'WTS'
EQUIP 'CTMC' EPCOMM
EQUIP 'C/SP' EPCOMM
EQUIP '074'
EQUIP '075'
EQUIP '076'
EQUIP 'ARB'
NOFEM 'NO FILES KNOWN TO FANG.!'
NODFM 'NO DISABLED FILES.!'
END