1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-01-31 05:42:03 +00:00
Files
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/fe/fe.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2909 lines
85 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
SUBTTL 3-NOV-75
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976,1977,1986,1988.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION
;OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER COPIES THEREOF
;MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO
;TITLE TO OR OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
VWHO==0
VFE==2
VMINOR==0
VEDIT==50
IFNDEF .PSECT,<
.DIRECT .XTABM>
SALL
SEARCH MACSYM
SYN IFE,IF ;SO THAT "IF TOPS-10" WORKS
;
; PARAMETERS
;
IFNDEF FTDB,<FTDB== 0> ;1: ENABLE CODE TO SUPPORT RP04 (DB) REQUESTS
IFNDEF TOPS,<TOPS== 10> ;10: TOPS-10 SUPPORT; 20: TOPS-20 SUPPORT
IFNDEF FIDNUM,<FIDNUM== ^D4> ;ALLOW 4 OPEN FILE-ID'S
IFNDEF PDLEN,<PDLEN== ^D50> ;STACK LENGTH
IF TOPS-20,<
TITLE FE -- FE DEVICE INTERFACE FOR TOPS-20
SEARCH MONSYM
.REQUIRE SYS:MACREL
FTDTE.==0 ;NO DTE. UUO'S!!!
>; END IF TOPS-20
IF TOPS-10,<
TITLE FE -- FE DEVICE INTERFACE FOR TOPS-10
SEARCH UUOSYM
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976,1988. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
IFNDEF UICNUM,<UICNUM== ^D10> ;ALLOW 10. UIC TABLE ENTRIES
IFNDEF FTPATH,<FTPATH== 1> ;ALLOW PATH SPECS IN UIC TABLE
IFNDEF FTDTE.,<FTDTE.== 1> ;0: USE FE DEVICE JSYS'ES 1: USE DTE. UUO'S
IFN FTDB,<PRINTX DB REQUEST CODE NOT SUPPORTED ON TOPS-10>
IFE FTDTE.,<
SEARCH MONSYM
.REQUIRE SYS:MACREL
>; END IFE FTDTE.
>; END IF TOPS-10
;
; REGISTERS
;
F= 0 ;FLAGS
T1= 1 ;GENERAL USE, T1-T4 MUST BE 1-4
T2= 2 ; . .
T3= 3 ; . .
T4= 4 ; . .
P1= 5 ;NOT-SO-GENERAL USE
P2= 6 ; . .
P3= 7 ; . .
P4= 10 ; . .
;
HDR= 11 ;ADDRESS OF CURRENT HEADER AREA
FID= 12 ;ADDRESS OF CURRENT FILE-ID BLOCK
C= 13 ;RANDOM CHARACTERS
;
P= 17 ;STACK POINTER
;
; FLAGS -- IN REGISTER F
;
F.PROC==1B0 ;PROCCESSING A REQUEST-- DON'T ALLOW IPCF
F.WRIT==1B1 ;WRITE REQUEST
;
; MACROS
;
IF TOPS-10,<
DEFINE TMSG(MSG),<
OUTSTR [ASCIZ\MSG\]
>
>; END IF TOPS-10
DEFINE WARN(MSG,GOTO,IL),<
IFB <IL>,<JRST [>
TMSG <% MSG
>
IFNB <GOTO>,<JRST GOTO>
IFB <IL>,<
IFB <GOTO>,<JRST .+1>
]>
>
;
DEFINE RETERR(ERR,IL),<
IFB <IL>,<CALL [>
MOVEI T1,<ERR>
IFNB <IL>,<CALL RETXXX>
IFB <IL>,<JRST RETXXX]>
>
;
OPDEF CALL [PUSHJ P,]
OPDEF CALLR [JRST]
OPDEF RETURN [POPJ P,]
DEFINE RETSKP,<JRST CRET1>
DEFINE CALLRX (WHERE),<IF2,<IFN <.-WHERE>,<PRINTX CALLRX WHERE NOT VALID>>>
;
; TOPS-20 HOM BLOCK DEFINITIONS
;
HOMNAM==0 ;ALWAYS CONTAINS SIXBIT/HOM/
HOMSNM==3 ;NAME OF STRUCTURE IN SIXBIT
HOMLUN==4 ;LH: TOTAL # UNITS IN STR, RH: CURRENT UNIT #
HOMSIZ==13 ;SIZE OF THIS UNIT IN BLOCKS
HOMFE0==61 ;SECTOR ADDRESS OF F-E-F-S, BIT 2 SET IF EXISTS
HOMFE1==62 ;SIZE OF F-E-F-S IN SECTORS
;
; -11 STYLE BITS
;
DEFINE ..BIT(IT),<BIT'IT==1B<35-IT>>
RADIX 10
$$$BIT==-1
REPEAT 16,<..BIT(\<$$$BIT==$$$BIT+1>)>
RADIX 8
SUBTTL DATA DEFINITIONS
;
; MACROS TO DO DEFINITIONS OF -11 DATA STRUCTURES
;
DEFINE .BYT (NAME,LOC,OFF),<
$$$BIT==^D17
IFN <<OFF>&BIT1>,<$$$BIT==$$$BIT+^D18>
IFN <<OFF>&BIT0>,<$$$BIT==$$$BIT-^D8>
DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,$$$BIT,^D8)
>
DEFINE .WRD (NAME,LOC,OFF),<
$$$BIT==^D17
IFN <<OFF>&BIT1>,<$$$BIT==$$$BIT+^D18>
IFN <<OFF>&BIT0>,<PRINTX ? WORD NAME HAS BAD OFFSET OFF>
DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,$$$BIT,^D18)
>
DEFINE .DWRD (NAME,LOC,OFF),<
IFN <<OFF>&<BIT1!BIT0>>,<PRINTX ? DOUBLE-WORD NAME HAS BAD OFFSET OFF>
DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,^D35,^D36)
>
DEFINE PNTR (STR,Y),<..STR0 (..PNTR,AC,STR,Y)>
DEFINE ..PNTR (AC,LOC,MASK),<POINTR (<LOC>,<MASK>)>
;
DEFINE .RAD50 (X),<IRP X,<
$$$R50==0
IRPC X,<
$$$CHR==0
IFGE <"X"-"0">,<$$$CHR=="X"-"0"+36>
IFGE <"X"-"A">,<$$$CHR=="X"-"A"+1>
$$$R50==<$$$R50*50>+$$$CHR
>
XWD $$$R50_-^D16,$$$R50&177777
>>
;
; GENERAL BYTE AND WORD DEFINITIONS
;
.BYT (BYTE0,,0)
.BYT (BYTE1,,1)
.BYT (BYTE2,,2)
.BYT (BYTE3,,3)
.WRD (WORD0,,0)
.WRD (WORD1,,2)
;
; HEADER FROM -11
;
.WRD (HDRFN,0(HDR),0) ;FUNCTION CODE
.WRD (HDRDV,0(HDR),2) ;DEVICE NAME IN 8-BIT ASCII
.BYT (HDRUN,0(HDR),4) ;UNIT NUMBER OF DEVICE
.WRD (HDRP1,0(HDR),6) ;PARAMETER #1
.WRD (HDRP2,0(HDR),10) ;PARAMETER #2
.WRD (HDRSZ,0(HDR),12) ;SIZE OF FOLLOWING DATA BLOCK
HDRLEN==14 ;SIZE OF HEADER IN BYTES
;
; FILE CONTROL PRIMITIVES DATA
;
.DWRD (FILID,SCRBUF,0) ;FILE-NAME BLOCK IS ALWAYS FIRST
.WRD (FILP1,SCRBUF,4) ;FILE PARAMETER #1 (ACCESS OR EXTEND)
.WRD (FILP2,SCRBUF,6) ;FILE PARAMETER #2 (EXTEND)
.WRD (FILAT0,SCRBUF,10-2) ;ATTRIBUTE CONTROL BLOCK (PRE-POINTER FOR ILDB)
.WRD (FILACB,SCRBUF,10) ;ATTRIBUTE CONTROL BLOCK
;
; READ/WRITE VIRTUAL BLOCK DATA
;
.WRD (RWVBH,SCRBUF,4) ;HIGH PART VBN
.WRD (RWVBL,SCRBUF,6) ;LOW PART VBN
.WRD (RWVSZ,SCRBUF,10) ;TRANSFER SIZE IN BYTES
.WRD (RWVDW0,SCRBUF,12-2) ;PRE-POINTER TO FIRST DATA WORD
.BYT (RWVDB,SCRBUF,12) ;FIRST BYTE OF DATA
;
; FILE-NAME BLOCK
;
.DWRD (N.FID,SCRBUF,0) ;FILE-ID
.WRD (N.FNM0,SCRBUF,6-2) ;FILE-NAME (POINTER FOR ILDB/IDPB)
.WRD (N.FNAM,SCRBUF,6) ;FILE NAME (3 WORDS)
.WRD (N.FTYP,SCRBUF,14) ;FILE TYPE
.WRD (N.FVER,SCRBUF,16) ;FILE VERSION #
.WRD (N.STAT,SCRBUF,20) ;STATUS BITS:
NB.SVR==BIT3 ;WILD VERSION
NB.STP==BIT4 ;WILD FILE TYPE
NB.SNM==BIT5 ;WILD FILE NAME
.WRD (N.NEXT,SCRBUF,22) ;CONTEXT SAVE FOR WILD OPERATIONS
.DWRD (N.DID,SCRBUF,24) ;DIRECTORY ID
.WRD (N.DOW,SCRBUF,30) ;DIRECTORY OWNER
S.DRFN==32 ;SIZE FOR DIRECTORY FUNCTIONS
;
; FILE HEADER
;
.WRD (H.IDOF,FILHDR,0) ;ID/MAP AREA OFFSETS
.WRD (H.FNUM,FILHDR,2) ;FILE NUMBER
.WRD (H.FSEQ,FILHDR,4) ;FILE SEQUENCE #
.WRD (H.FLEV,FILHDR,6) ;FILE SYSTEM LEVEL
.WRD (H.FOWN,FILHDR,10) ;FILE OWNER (UIC)
.WRD (H.FPRO,FILHDR,12) ;FILE PROTECTION CODE
.WRD (H.CHAR,FILHDR,14) ;FILE CHARACTERISTICS
.WRD (H.UFAT,FILHDR,16) ;USER FILE ATTRIBUTES (16. WORDS)
.BYT (H.RTYP,FILHDR,16+0) ;RECORD TYPE
.BYT (H.RATT,FILHDR,16+1) ;RECORD ATTRIBUTES
.WRD (H.RSIZ,FILHDR,16+2) ;RECORD SIZE
.WRD (H.HHBK,FILHDR,16+4) ;HIGHEST VBN IN USE (HIGH PART)
.WRD (H.LHBK,FILHDR,16+6) ; . . . (LOW PART)
.WRD (H.HEFB,FILHDR,16+10) ;END-OF-FILE BLOCK # (HIGH PART)
.WRD (H.LEFB,FILHDR,16+12) ; . . . (LOW PART)
.WRD (H.FFBY,FILHDR,16+14) ;FIRST FREE BYTE IN END-OF-FILE BLOCK
.WRD (I.FNM0,FILHDR,56-2) ;FILENAME RAD50
.WRD (I.FNAM,FILHDR,56) ;FILENAME RAD50
.WRD (I.FTYP,FILHDR,64) ;FILE TYPE
.WRD (I.FVER,FILHDR,66) ;FILE VERSION #
.WRD (I.RVNO,FILHDR,70) ;REVISION #
.BYT (I.RVDT,FILHDR,72) ;REVISION DATE (7 BYTES)
.BYT (I.RVTI,FILHDR,101) ;REVISION TIME (6 BYTES)
.BYT (I.CRDT,FILHDR,107) ;CREATION DATE (7 BYTES)
.BYT (I.CRTI,FILHDR,116) ;CREATION TIME (6 BYTES)
.WRD (I.EDTW,FILHDR,124) ;EXPIRATION DATE
.BYT (I.EXDT,FILHDR,124) ;EXPIRATION DATE (7 BYTES)
SUBTTL QUEUE I/O DEFINITIONS
;
; I/O FUNCTIONS
;
DEFINE IO(XXX,FUNC,SUB),< IO.'XXX== <FUNC+0>B<35-8>+<SUB+0>B<35-0> >
;
IO WLB,1 ;WRITE LOGICAL BLOCK
IO RLB,2 ;READ LOGICAL BLOCK
IO LOV,2,10 ;LOAD OVERLAY
IO ATT,3 ;ATTACH DEVICE
IO FCP,3,1 ;FILE CONTROL PRIMITIVE
IO DET,4 ;DETACH DEVICE
;
IO CLN,7 ;CLOSE OUT LUN
;
IO FNA,11 ;FIND NAME IN DIRECTORY
IO RNA,13 ;REMOVE NAME FROM DIRECTORY
IO ENA,14 ;ENTER NAME IN DIRECTORY
;
IO ACR,15 ;ACCESS FOR READ
IO ACW,16 ;ACCESS FOR READ, WRITE
IO ACE,17 ;ACCESS FOR READ, WRITE, EXTEND
IO DAC,20 ;DE-ACCESS FILE
IO RVB,21 ;READ VIRTUAL BLOCK
IO WVB,22 ;WRITE VIRTUAL BLOCK
IO EXT,23 ;EXTEND FILE
IO CRE,24 ;CREATE FILE
IO DEL,25 ;MARK FILE FOR DELETE
IO RAT,26 ;READ FILE ATTRIBUTES
IO WAT,27 ;WRITE FILE ATTRIBUTES
IO APC,30 ;ACP CONTROL
IO APV,30,10 ;PRIVILEDGED ACP CONTROL
;
; STATUS RETURN CODES
;
RADIX 10 ;** NOTE RADIX 10 **
IS.SUC==+1 ;SUCCESSFULL COMPLETION
;
IE.BAD==-1 ;BAD PARAMETERS
IE.IFC==-2 ;ILLEGAL FUNCTION CODE
IE.DNR==-3 ;DEVICE NOT READY
IE.VER==-4 ;PARITY OR DEVICE ERROR
IE.ONP==-5 ;HARDWARE OPTION NOT PRESENT
IE.SPC==-6 ;ILLEGAL USER BUFFER
IE.EOF==-10 ;END OF FILE
IE.EOV==-11 ;END OF VOLUME
IE.WLK==-12 ;WRITE LOCKED DEVICE
IE.DAO==-13 ;DATA OVERRUN
IE.SRE==-14 ;SEND/RECEIVE FAILURE
IE.ABO==-15 ;OPERATION ABORTED
IE.PRI==-16 ;PRIVILEDGE VIOLATION
IE.RSU==-17 ;SHARABLE RESOURCE IN USE
IE.OVR==-18 ;ILLEGAL OVERLAY REQUEST
IE.BYT==-19 ;BYTE-ALIGNED BUFFER
IE.BLK==-20 ;LOGICAL BLOCK # TOO LARGE
;
IE.NOD==-23 ;LACK OF NODE SPACE
IE.DFU==-24 ;DEVICE FULL
IE.IFU==-25 ;INDEX FILE FULL
IE.NSF==-26 ;NO SUCH FILE
IE.LCK==-27 ;LOCKED FROM WRITE ACCESS
IE.HFU==-28 ;FILE HEADER FULL
IE.WAC==-29 ;ACCESSED FOR WRITE
IE.CKS==-30 ;FILE HEADER CHECKSUM ERROR
IE.WAT==-31 ;ATTRIBUTE CONTROL LIST FORMAT ERROR
IE.RER==-32 ;FCP DEVICE READ ERROR
IE.WER==-33 ;FCP DEVICE WRITE ERROR
IE.ALN==-34 ;FILE ALREADY ACCESSED ON LUN
IE.SNC==-35 ;FILE ID, FILE NUMBER CHECK
IE.SQC==-36 ;FILE ID, SEQUENCE NUMBER CHECK
IE.NLN==-37 ;NO FILE ACCESSED ON LUN
IE.CLO==-38 ;FILE NOT PROPERLY CLOSED
IE.DUP==-57 ;ENTER - DUPLICATE NAME IN DIRECTORY
IE.BVR==-63 ;BAD VERSION NUMBER
IE.BHD==-64 ;BAD FILE HEADER
;
IE.IDU==-92 ;INVALID DEVICE OR UNIT NUMBER
;
RADIX 8 ;** END OF RADIX 10 **
SUBTTL IMPURE DATA
;
; BUFFERS FOR HEADERS TO AND FROM THE -11
;
HEADER: BLOCK <HDRLEN+3>/4 ;MESSAGE HEADER FROM -11
FNCHDR: BLOCK <HDRLEN+3>/4 ;MESSAGE TO -11
;
; STACK
;
PDL: BLOCK PDLEN ;STACK
;
; VARIABLES
;
INICLR==. ;START OF AREA TO CLEAR ON STARTUP
IFN FTDB,<
FSJFN: BLOCK 1 ;JFN OF FRONT-END-FILE-SYSTEM FILE
DSKOFS: BLOCK 1 ;OFFSET IN BLOCKS TO UNIT WITH F-E-F-S ON IT
FEADDR: BLOCK 1 ;SECTOR ADDRESS OF F-E-F-S
FESIZE: BLOCK 1 ;SIZE (IN SECTORS) OF F-E-F-S
CFSPAG: BLOCK 1 ;CURRENT F-E-F-S PAGE #
CFSSIZ: BLOCK 1 ;CURRENT F-E-F-S AREA SIZE MAPPED IN PAGES
> ;END IFN FTDB
;
IF TOPS-20,<
FEJFN: BLOCK 1 ;JFN OF FE DEVICE
CHN1PC: BLOCK 1 ;PC AT CHANNEL 1 PSI
FNMBLK: BLOCK 10+10+10+3 ;FILE NAME STRING BUFFER
FILFDB: BLOCK .FBLEN ;WHOLE FDB
>; END IF TOPS-20
IF TOPS-10,<
CHNMSK: BLOCK 1 ;MASK OF ACTIVE CHANNELS
TMPFIL: BLOCK 1 ;CURRENT NUMBER FOR TEMP FILES
IFN FTDTE.,<
FEDNUM: BLOCK 1 ;FE DEVICE #
DTEFNC: BLOCK 1 ;CURRENT DTE. FUNCTION CODE
>; END IFN FTDTE.
IFE FTDTE.,<
FEJFN: BLOCK 1 ;JFN OF FE DEVICE
>; END IFE FTDTE.
>; END OF IF TOPS-10
;
BLKSIZ: BLOCK 1 ;SIZE OF CURRENT INPUT BLOCK IN BYTES FROM FE
USECNT: BLOCK 1 ;USE COUNT OF FILE-ID'S
DATBUF: BLOCK 5 ;SCRATCH FOR DATE TEXT
;
ATTRCB: BLOCK 10 ;SCRATCH ATTRIBUTE CONTROL BLOCK
FILHDR: BLOCK 1000/4 ;SIMULATED FILE HEADER FOR FCP
STSBLK: BLOCK 3 ; . . STATISTICS BLOCK
FILHDE: ;END OF FILE HEADER DATA
;
FIDTAB: ;FILE-ID CORRESPONDENCE BLOCK:
REPEAT FIDNUM,<
PHASE 0
FIDFID==.
BLOCK 1 ;FILE-ID OF FILE (LH= INDEX INTO FIDTAB
; RH= SEQUENCE #
FIDJFN==.
BLOCK 1 ;JFN OF FILE
FJ.WLN==1B0 ;WILD NAME
FJ.WLT==1B1 ;WILD TYPE
FJ.WLG==1B2 ;WILD GENERATION #
FJ.WLD==FJ.WLN!FJ.WLT!FJ.WLG ;WILD ARGS TO GETNAM
FJ.ALL==1B3 ;STRUCTURE NAME IS ALL STRUCTURES
FJ.DSK==1B4 ;STRUCTURE NAME IS DISK SEARCH LIST
FIDFLG==.
BLOCK 1 ;FLAGS WORD
FI.ACC==1B0 ;FILE IS ACCESSED
FI.WRT==1B1 ;FILE IS ACCESSED FOR WRITE
FI.TMP==1B2 ;FILE IS TEMP FILE (I.E. NO NAME YET)
FI.ASC==1B3 ;FILE IS 7-BIT ASCII
FIDNAM==.
BLOCK 1 ;LH= FILENAME (1) RH= FILENAME (2)
FIDTYP==.
BLOCK 1 ;LH= FILENAME (3) RH= FILE TYPE
FIDVER==.
BLOCK 1 ;LH= FILE VERSION #
FIDUIC==.
BLOCK 1 ;RH= UIC OF FILE OWNER
FIDUCT==.
BLOCK 1 ;USE COUNT
FIDFBP==.
BLOCK 1 ;CURRENT FILE BYTE POINTER
IF TOPS-10,<
FIDSTR==.
BLOCK 1 ;CURRENT STRUCTURE NAME FOR WILD LOOKUPS
FIDDIX==.
BLOCK 1 ;DIRECTORY INDEX FOR CURRENT WILD FILE
FIDLEB==.
BLOCK .RBALC+1 ;EXTENDED LOOKUP/ENTER BLOCK
>; END IF TOPS-10
;
FIDSIZ==. ;SIZE OF EACH BLOCK
DEPHASE
>; END REPEAT FIDNUM
FIDTBE:
;
CLREND==.-1
;
; UIC-DIRECTORY CORRESPONDENCE TABLE
;
UICSIZ==0 ;SIZE OF ENTRY
UICUIC==1 ;CORRESPONDING UIC
IF TOPS-20,<
UICNAM==2 ;START OF NAME IN ASCIZ
>; END IF TOPS-20
IF TOPS-10,<
UICSTR==2 ;STRUCTURE NAME IN SIXBIT, OR 0 (ALL) OR 1 (DSK)
UICPTH==2 ;PATH BLOCK STARTS HERE: JUNK
UICSCS==3 ;SCAN SWITCH= 0
UICPPN==4 ;P,PN
UICSFD==5 ;FIRST WORD OF SFD SPECS
>; END IF TOPS-10
IF TOPS-20,<
DEFINE .UIC(PJ,PG,NAME,%END),<
EXP %END-. ;LENGTH OF ENTRY
BYTE (36-16)0 (8)PJ (8)PG ;UIC= [PJ,PG]
ASCIZ /NAME/ ;DIRECTORY <NAME>
%END==. ;END OF THE ENTRY
>
>; END IF TOPS-20
IF TOPS-10,<
DEFINE .UIC(PJ,PG,STR,PROJ,PROG,%END),<
EXP %END-. ;LENGTH OF ENTRY
BYTE (36-16)0 (8)PJ (8)PG ;UIC= [PJ,PG]
EXP STR
EXP 0
XWD PROJ,PROG
EXP 0
%END==. ;END OF THE ENTRY
>
;
IFN 0,<
.UIC 1,1,0,1,1
.UIC 1,4,0,1,4
.UIC 5,5,0,10,3606
.UIC 5,6,0,10,757
EXP 0
>; END IFN 0
UICTAB:
BLOCK 10*UICNUM
BLOCK 1
UICTBL==.-UICTAB
>; END IF TOPS-10
;
; MISC. DATA BUFFER
;
IF TOPS-20,<
LOC 100K ;ALSO MORE RANDOM
>; END IF TOPS-20
SCRBUF: ;THIS IS BUFFER SPACE
IF TOPS-10,<
BLOCK 2K
>; END IF TOPS-10
;
; BUFFER FOR DUMP I/O
;
IF TOPS-20,<
LOC 200K ;ALSO MORE RANDOM
>; END IF TOPS-20
DMPBUF:
IF TOPS-10,<
BLOCK 2K
>; END IF TOPS-10
;
IFN FTDB,<
;
; PAGE BUFFER FOR I/O TO AND FROM THE -11 FILE SYSTEM
;
LOC 300K ;RANDOM PLACE
;
FEFBUF: ;HERE ON IS BUFFER SPACE
>; END IFN FTDB
IF TOPS-20,<
RELOC
>; END IF TOPS-20
SUBTTL PURE DATA
;
; ENTRY VECTORS
;
ENTVEC: JRST START ;START
IF TOPS-20,<
JRST FEWAIT ;REENTER
>; END IF TOPS-20
IF TOPS-10,<
LOC 137
>; END IF TOPS-10
BYTE (3)VWHO (9)VFE (6)VMINOR (18)VEDIT
IF TOPS-10,<
RELOC
>; END IF TOPS-10
IF TOPS-20,<
;
; PSI TABLES
;
LEVTAB: EXP CHN1PC,0,0
CHNTAB: EXP 0,0,0,0,0,0,0,0,0 ;00-08: UNUSED
XWD 1,ILLTRP ;09: PDL OV
EXP 0 ;10: UNUSED
XWD 1,IOERR ;11: FILE DATA ERROR
EXP 0,0,0 ;12-14: UNUSED
XWD 1,ILLTRP ;15: ILLEGAL INSTRUCTION
XWD 1,ILLTRP ;16: ILLEGAL MEMORY READ
XWD 1,ILLTRP ;17: ILLEGAL MEMORY WRITE
XWD 1,ILLTRP ;18: ILLEGAL MEMORY EXECUTE
EXP 0 ;19: UNUSED
XWD 1,ILLTRP ;20: MACHINE SIZE EXCEEDED
EXP 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;21-35: UNUSED
;
; UIC-DIRECTORY TABLE
;
UICTAB:
.UIC 1,1,SYSTEM
.UIC 1,2,OPERATOR
.UIC 1,4,SUBSYS
.UIC 5,5,FRONT-END
EXP 0 ;END OF TABLE
>; END OF IF TOPS-20
IF TOPS-10,<
;
; DUMP I/O LIST
;
DMPLST:
IOWD 200,DMPBUF
EXP 0
>;END IF TOPS-10
SUBTTL INITIALIZATION
IF TOPS-20,<
;
; HERE ON PANIC CHANNEL PSUEDO-INTERRUPT
;
ILLTRP: WARN <PANIC CHANNEL INTERRUPT -- RESTARTING>,,X
>; END IF TOPS-20
;
; INITIALIZE
;
START: RESET ;RESET I/O STATE
MOVE P,[IOWD PDLEN,PDL] ;INITIALIZE STACK POINTER
SETZB F,INICLR ;CLEAR FLAGS, AND FIRST WORD OF STORAGE
MOVE T1,[XWD INICLR,INICLR+1] ;SET TO CLEAR
BLT T1,CLREND ; ALL OF VARIABLES
;
; INITIALIZE FE DEVICE
;
IFE FTDTE.,<
;
; ASSIGN A JFN TO DEVICE 'FE' AND OPEN IT
;
MOVEI P1,0 ;START WITH FE #0
;
GETFE: HRROI T1,SCRBUF ;POINT TO NAME AREA
HRROI T2,[ASCIZ/FE/] ;GET FIRST PART OF NAME
SETZ T3, ;IN ASCIZZ
SOUT ;PUT IT IN SCRBUF
MOVE T2,P1 ;GET THE # OF FE WE WANT THIS TIME
MOVX T3,^D8 ; IN OCTAL
NOUT ;STORE IN GTJFN STRING
JSHLT ;OOPS
MOVEI T2,":" ;FINISH IT OFF
IDPB T2,T1 ; . .
MOVEI T2,0 ; . .
IDPB T2,T1 ; . .
;
MOVX T1,GJ%OLD!GJ%SHT ;1/ OLD FILE, SHORT GTJFN CALL
HRROI T2,SCRBUF ;2/ ASCIZ FILE STRING
GTJFN ;ASSIGN A JFN TO FE
JRST [CAIE 1,GJFX29 ;IS DEVICE NOT AVAILABLE?
JSHLT ;YES-- GIVE UP
AOJA P1,GETFE] ;NO-- TRY AGAIN
MOVEM T1,FEJFN ;SAVE THE JFN FOR FE0
;
MOVX T2,<^D16>B5!OF%RD!OF%WR ;2/ OPEN FOR READ, WRITE, 16 BIT BYTES
OPENF ;OPEN FE0
JRST [CAIE T1,OPNX7 ;DEVICE NOT AVAILABLE?
JSHLT ;NO-- GIVE UP
HRRZ T1,FEJFN ;YES-- GET THE JFN
RLJFN ; AND RELEASE IT
JFCL ;OOPS
AOJA P1,GETFE] ;AND TRY AGAIN
MOVX T2,.MODTE ;2/ FUNCTION: GET A DTE
MOVX T3,0 ;3/ DTE #0
MTOPR ;GET A DTE
ERJMP JSHLT0 ;OOOOOPS
;
MOVE T1,FEJFN ;1/ JFN OF FE DEVICE
MOVX T2,.MOEOF ;2/ PERFORM AN END-OF-FILE
MOVX T3,0 ;3/ REALLY SEND THE EOF
MTOPR ;TELL -11 WE HAVE JUST RESTARTED
;
>; END IFE FTDTE.
IFN FTDTE.,<
GETFE:
MOVEI T1,.DTEGF ;FUNCTION= GET FE DEVICE
CALL DTESET ;SET UP REGISTERS
DTE. T4, ;ATTEMPT TO GET AN FE
JRST [ CAIN T4,DTENF% ;NON-EX FE DEVICE?
WARN <FE DEVICE NOT AVAILABLE>,[EXIT]
CAIE T4,DTEFB% ;BUSY WITH ANOTHER JOB?
CALL DTEERR ;NO-- OTHER FATAL ERROR
AOS FEDNUM ;YES-- GET NEXT FED #
JRST GETFE] ;AND TRY AGAIN
MOVEI T1,.DTEFS ;SET FE DEVICE STATUS
MOVX T3,DT.EOF ; TO END-OF-FILE
CALL DTEUUO ; . . .
>; END IFN FTDTE.
;
; MORE INITIALIZATION . . .
;
IF TOPS-20,<
MOVX T1,.FHSLF ;1/ OUR FORK
MOVE T2,[XWD LEVTAB,CHNTAB] ;2/ TABLE ADDRESSES
SIR ;SET INTERRUPT TABLE ADDRESSES
MOVX T2,1B9+1B11+1B15+1B16+1B17+1B18+1B20 ;2/ PANIC CHANNELS
AIC ;ENABLE PANIC CHANNELS
EIR ;ENABLE THE PSUEDO-INTERRUPT SYSTEM
>; END IF TOPS-20
IF TOPS-10,<
MOVX T1,-1B15&<^-<1B0>> ;GET BITS 1-15
MOVEM T1,CHNMSK ;SET CHANNELS 1-15 AVAILABLE
;
TIMER T1, ;GET A RANDOM NUMBER
MOVEM T1,TMPFIL ;INIT TEMP FILE NUMBER
;
; READ FEUIC.TXT INTO UICTAB
;
; EACH LINE IN FEUIC.TXT IS FORMATTED AS FOLLOWS:
;
; [GRP,USR]=STR:[P,PN,SFD,SFD,...]
;
; WHERE:
; [GRP,USR] IS THE UIC TO BE DEFINED.
; STR: IS A FILE STRUCTURE NAME,
; IF "DSK:" THEN DSK SEARCH LIST IS USED,
; IF BLANK THEN ALL SYSTEM STRUCTURES ARE SEARCHED.
; [P,PN,SFD,SFD,...] IS THE DIRECTORY FOR THIS UIC.
;
; THE NUMBER OF UIC'S ALLOWED IS GOVERNED BY THE PARAMETER "UICNUM".
;
; SFD'S MAY BE SPECIFIED ONLY IF FTPATH IS ENABLED (NOT COMPLETELY CODED).
;
; COMMENTS MAY BE ENTERED IN THE FILE BY USING EITHER ";" OR "!".
;
REDUIC:
PUSH P,.JBFF ;SAVE .JBFF FOR NOW
MOVNI P4,2 ;INIT LOOP FLAG
MOVE P3,[IOWD UICTBL,UICTAB] ;POINT TO DIRECTORY TABLE
REDIRT:
AOJG P4,[WARN (<SYS:FEUIC.TXT FILE NOT AVAILABLE>,REDIRX,X)]
MOVSI T2,'SYS' ;GET FIRST DEVICE
SKIPL P4 ;FIRST TIME THROUGH?
MOVSI T2,'DSK' ;NO-- TRY DISK
MOVX T1,.IOASL ;ASCII, LINE MODE
MOVX T3,<XWD 0,SCRBUF> ;POINT TO INPUT BEFFER HEADER ADDRESS
OPEN T1 ;OPEN SYS OR DSK
JRST REDIRT ;TRY THE OTHER DEVICE
DMOVE T1,[SIXBIT /FEUIC/
SIXBIT /TXT/]
SETZB T3,T4 ;SET TO LOOKUP FEUIC.TXT
LOOKUP T1 ;FIND FILE
JRST REDIRT ;TRY AGAIN
REDIR3:
MOVE P2,P3 ;SAVE THIS ADDRESS
CALL REDCHR ;GET FIRST CHAR ON LINE
JUMPL C,REDIRX ;EOF-- ALL DONE
CAIN C,12 ;END-OF-LINE?
JRST REDIR3 ;YES-- IGNORE BLANK LINES
CAIE C,"[" ;LEGAL START DELIMITER?
JRST REDERR ;NO
PUSH P3,[EXP 0] ;STORE A ZERO TO BE FIXED LATER
CALL REDOCT ;GET OCTAL USER GROUP CODE
SKIPG P1,T1 ;SAVE THAT NUMBER
JRST REDERR ;ZERO OR -VE IS NO GOOD
CAIG T1,377 ;TOO BIG?
CAIE C,"," ;RIGHT SEPERATOR?
JRST REDERR ;NO
CALL REDOCT ;GET USER NUMBER
JUMPLE T1,REDERR ;0, -VE N.G.
CAIG T1,377 ;SMALL ENOUGH?
CAIE C,"]" ;RIGHT SEPERATOR?
JRST REDERR ;NO
LSH P1,^D8 ;SHIFT GROUP TO HIGH BYTE
IOR T1,P1 ;MUSH IT ALL TOGETHER
PUSH P3,T1 ;STORE THE UIC
;
CALL REDCHR ;GET NEXT CHAR
CAIE C,"=" ;PROPER SEP?
JRST REDERR ;NO
CALL REDSIX ;GET SIXBIT STR NAME
CAMN T1,[SIXBIT/DSK/] ;IS IT "DSK"?
MOVEI T1,1 ;YES-- SPECIAL FLAG
PUSH P3,T1 ;SAVE THE STR NAME
JUMPE T1,REDIR4 ;IF NO STR NAME, THEN USE ALL:
CAIE C,":" ;PROPER DEVICE TERMINATOR?
JRST REDERR ;NO
CALL REDCHR ;GET NEXT CHAR
REDIR4:
CAIE C,"[" ;PROPER START?
JRST REDERR ;NO
PUSH P3,[EXP 0] ;SCAN SWITCH= 0
CALL REDOCT ;GET PROJECT #
SKIPG P1,T1 ;SAVE IT
JRST REDERR ; . . .
CAIG P1,777777 ;SIZE OK?
CAIE C,"," ;SEPARATOR OK?
JRST REDERR ;NO
CALL REDOCT ;GET PROG #
JUMPLE T1,REDERR ;OOPS
CAILE P1,777777 ;OK?
JRST REDERR ;NO
HRL T1,P1 ;MUSH IN PROJ #
PUSH P3,T1 ;SAVE P,PN
REDIR5:
IFE FTPATH,<
CAIE C,"]" ;END-OF-LINE?
JRST REDERR ;NO DICE . . .
>; END IFE FTPATH
IFN FTPATH,<
CAIN C,"]" ;END-OF-LINE?
JRST REDNXT ;YES-- GET NEXT LINE
CAIE C,"," ;GOOD SEPERATOR?
JRST REDERR ;NO
CALL REDSIX ;GET SFD NAME
JUMPE T1,REDERR ;NO NAME IS NO GOOD
PUSH P3,T1 ;SAVE THE NAME
JRST REDIR5 ;BACK FOR MORE
>; END IFN FTPATH
;
REDNXT:
CALL REDCHR ;GET NEXT CHARACTER
CAIE C,12 ;MUST BE END-OF-LINE
JRST REDERR ;NO DICE
PUSH P3,[EXP 0] ;TERMINATE THE LIST
MOVE T1,P2 ;GET INITIAL ADDRESS
SUBM P3,T1 ;FIND LENGTH OF THIS ENTRY
HRRZM T1,1(P2) ;STORE LENGTH BACK AT START OF ENTRY
JRST REDIR3 ;GO BACK FOR ANOTHER LINE
;
REDERR:
WARN <SYNTAX ERROR IN FE UIC-DIRECTORY CORRESPONDENCE FILE FEUIC.TXT>,,X
MOVE P3,P2 ;RESTORE ADDRESS POINTER
REDER1:
CALL REDEAT ;EAT THIS LINE
JRST REDIR3 ;TRY FOR NEXT LINE
;
REDOCT:
MOVX T1,0 ;START OUT EMPTY
REDOC1:
CALL REDCHR ;GET CHARACTER
CAIL C,"0" ;OC-
CAILE C,"7" ; TAL?
RETURN ;NO-- ALL DONE
ASH T1,^D3 ;MULTIPLY BY ^O10
ADDI T1,-"0"(C) ;ADD IN CURRENT DIGIT
JRST REDOC1 ;BACK FOR MORE
;
REDSIX:
SETZ T1, ;RESET THE VALUE
MOVE T2,[POINT 6,T1] ;POINT TO INPUT
REDSX1:
CALL REDCHR ;GET A CHARACTER
CAIL C,"A" ;ALPHA-
CAILE C,"Z" ; BETIC?
JRST [ CAIL C,"0" ;NO-- NUM-
CAILE C,"9" ; ERIC?
RETURN ;NO-- GIVE UP
JRST .+1] ;YES-- USE NUMBER
SUBI C," "-' ' ;CONVERT TO SIXBIT
TRNN T1,77 ;LAST CHARACTER IN ALREADY?
IDPB C,T2 ;NO-- STORE THIS ONE
JRST REDSX1 ;BACK FOR SOME MORE SX
;
REDCHR:
SOSGE SCRBUF+2 ;DECREMENT BYTE COUNT
JRST [ IN ;EXHAUSTED-- GET ANOTHER BUFFER
JRST REDCHR ;OK-- TRY AGAIN
MOVX C,-1 ;EOF OR ERROR-- MARK EOF
RETURN] ;AND BACK TO CALLER
ILDB C,SCRBUF+1 ;GET NEXT CHARACTER
CAIE C,0 ;NULL?
CAIN C,15 ;<CR>?
JRST REDCHR ;YES-- IGNORE
CAIE C," " ;IGNORE SPACES
CAIN C," " ; AND TABS
JRST REDCHR ; . . .
CAIE C,"!" ;COMMENT?
CAIN C,";" ; ??
CALLR REDEAT ;YES-- EAT IT
CAIL C,"@"+40 ;LOWER CASE?
SUBI C,40 ;YES-- CONVERT TO UPPER
RETURN ;AND DONE WITH REDCHR
;
REDEAT:
CALL REDCHR ;GET ANOTHER CHARACTER
CAIL C,0 ;EOF??
CAIN C,12 ;<LF>?
RETURN ;YES-- RETURN NOW
JRST REDEAT ;NO-- KEEP ON EATING
;
REDIRX:
PUSH P3,[EXP 0] ;TERMINATE THE TABLE
RELEASE ;FINISH OFF I/O CHANNEL 0
POP P,.JBFF ;RESTORE .JBFF
>; END IF TOPS-10
;
IFN FTDB,<
;
; SEE IF THERE IS REALLY A FILES-11 AREA ON THIS SYSTEM, AND WHERE IT IS
;
REDHM1: MOVEI T1,1 ;START WITH BLOCK #1
REDHM2: MOVEI T2,1K ;A BLOCK'S WORTH OF BYTES
MOVE T4,T1 ;SAVE THAT BLOCK
CALL DSKIN ;READ THE HOM BLOCK
JRST REDHM5 ;OOPS-- LET'S TRY AANOTHER ONE
MOVE T1,SCRBUF+HOMNAM ;GET THE NAME OF THIS BLOCK
CAME T1,[SIXBIT/HOM/] ;MATCH A HOM BLOCK'S NAME?
JRST REDHM5 ;NO, SORRY
MOVE T1,SCRBUF+HOMSNM ;GET THE STRUCTURE NAME
CAME T1,[SIXBIT/PS/] ;IS THIS THE PUBLIC STRUCTURE?
JRST REDHM7 ;NO-- CAN'T HAVE THE F-E-F-S
HLRZ P1,SCRBUF+HOMFE0 ;GET FIRST -11 WORD OF FE INFO (HIGH ADDR)
TXZN P1,BIT15 ;THIS THE RIGHT PLACE?
JRST REDHM6 ;NO-- LOOK FOR ANOTHER PACK
LSH P1,^D16 ;YES-- SHIFT TO HIGH WORD
HRRZ T1,SCRBUF+HOMFE0 ;GET THE LOW ADDR
IOR P1,T1 ;MUSH TOGETHER AS WHOLE DISK ADDRESS
HLRZ P2,SCRBUF+HOMFE1 ;NOW GET THE SIZE, HIGH PART
LSH P2,^D16 ;SHIFT IT UP TO THE RIGHT AREA
HRRZ T1,SCRBUF+HOMFE1 ;LOW PART, TOO
IOR P2,T1 ;BOTH TOGETHER, SIZE OF AREA IN P2
JRST FNFEFS ;NOW TO FIND THE FILE ITSELF
;
REDHM5: WARN <BAD HOM BLOCK>,,X
MOVEI T1,^D10 ;TRY NEXT HOM BLOCK, IF THAT ONE BAD
SOJE T4,REDHM2 ; AND IF THAT WAS HOM BLOCK 1
JRST FEWAIT ;ELSE WE HAVE NO F-E-F-S
;
REDHM6: MOVE T1,SCRBUF+HOMLUN ;GET THE LUN WITHIN PS OF THIS UNIT
HLRZ T2,T1 ; AND THE TOTAL UNITS IN THIS STRUCTURE
CAIG T2,(T1) ;THIS LAST (OR WORSE) UNIT IN PS?
WARN <NO FRONT END FILE SYSTEM>,FEWAIT
;
REDHM7: MOVE T1,SCRBUF+HOMSIZ ;ON TO NEXT UNIT-- GET THE SIZE OF THIS UNIT
ADDM T1,DSKOFS ; AND BUMP THE OVERALL DISK ADDRESS
JUMPG T1,REDHM1 ;OK-- BACK TO READ NEXT UNIT
WARN <ZERO LENGTH UNIT FOUND WHILE LOOKING FOR FRONT END FILE SYSTEM>,FEWAIT,X
;
; ALSO GET A JFN FOR THE FRONT-END-FILE-SYSTEM
;
FNFEFS: MOVX T1,GJ%OLD!GJ%SHT ;1/ OLD FILE, SHORT GTJFN
HRROI T2,[ASCIZ/<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN/]
GTJFN ;ASSIGN JFN TO THE FILE SYSTEM
JRST [JSERR
WARN (<<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN NOT AVAILABLE>,FEWAIT,X)]
MOVEM T1,FSJFN ;SAVE THE JFN
;
MOVX T2,OF%RD!OF%WR ;2/ READ, WRITE ACCESS
OPENF ;OPEN THE FILE-SYSTEM
JRST [JSERR
WARN (<<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN NOT AVAILABLE>,FEWAIT,X)]
MOVEM P1,FEADDR ;SAVE THE FOUND ADDRESS OF THE AREA
MOVEM P2,FESIZE ;SAVE THE SIZE OF THE AREA
;
>; END IFN FTDB
SUBTTL WAIT FOR SOMETHING FROM THE -11 TO DO
;
; HERE WHEN WE ARE DONE WITH A REQUEST
;
; WAIT FOR A REQUEST FROM THE -11, OR AN IPCF INTERRUPT FROM THE -20
;
FEWAIT: MOVE P,[IOWD PDLEN,PDL] ;RESET STACK
SETZ F, ;RESET ALL FLAGS
MOVEI HDR,HEADER ;POINT TO THE INPUT BUFFER FOR THE NEXT HEADER
MOVE T2,HDR ; ALSO FOR FEIN
MOVEI T3,HDRLEN ;READ 12 BYTES OF HEADER
CALL FEIN ;WAIT FOR IT
;
; WE HAVE AN -11 REQUEST-- PROCESS IT
;
TXO F,F.PROC ;WE HAVE GOT SOMETHING-- NO IPCF NOW
LOAD T1,HDRSZ; ;GET WORDS TO READ
MOVNM T1,BLKSIZ ;SAVE THAT, IN CASE OF FAILURE OF FUNCTION
LOAD T1,HDRFN; ;GET THE FUNCTION
TXNE T1,BIT15 ;-VE FUNCTION (RESPONSE)?
JRST FEPRSP ;YES-- PROCESS THAT
MOVN T2,T1 ;NO-- MAKE THIS FUNCTION
STOR T2,HDRFN; ; INTO A RESPONSE
;
LOAD T2,HDRDV; ;GET THE DEVICE CODE
IFN FTDB,<
CAIN T2,<BYTE (36-16)0(8)"B","D"> ;IS THIS DB (RP04)?
JRST DBPROC ;YES-- PROCESS REQUEST
>; END IFN FTDB
CAIN T2,<BYTE (36-16)0(8)"E","F"> ;IS THIS FE (TOPS-20 FILE REWUEST)?
JRST FEPROC ;YES-- CHECK IT OUT
WARN <ILLEGAL DEVICE NAME FROM -11 -- RESTARTING>,START,X
;
IF TOPS-20,<
;
; HERE ON I/O ERROR PSI
;
IOERR: TXZN F,F.PROC ;DOING A REQUEST?
JRST ILLTRP ;NO-- WE ARE SICK
MOVEI T1,RETXXX ;YES-- SEND IT BACK
MOVEM T1,CHN1PC ; . .
MOVEI T1,IE.ABO ; WITH OUR LOVE, OF COURSE
DEBRK ;RETURN THE ERROR
>; END IF TOPS-20
SUBTTL PROCESS FUNCTION RESPONSE FROM -11
;
; HERE WITH RESPONSE FUNCTION CODE FOR A FUNCTION WE REQUESTED
;
FEPRSP: WARN <RESPONSE CODE RECIEVED WITHOUT REQUEST -- RESTARTING>,START,X
SUBTTL PROCESS REQUEST FOR "DB" -- RP04
;
IFN FTDB,<
;
; REQUESTS FOR PR04 ARE TAKEN HERE
;
; FUNCTIONS ACCEPTED:
; IO.RLB
; IO.WLB
;
DBPROC: LSH T1,-^D8 ;GET HIGH FUNCTION CODE
CAIN T1,IO.RLB_-^D8 ;THIS READ LOGICAL?
JRST DBPRLB ;YES-- DO READ
CAIE T1,IO.WLB_-^D8 ;WRITE LOGICAL?
RETERR IE.IFC
TXO F,F.WRIT ;YES-- SAY TO WRITE
;
DBPRLB: LOAD T1,HDRP1; ;GET PARAMETER 1
LSH T1,^D16 ;MOVE TO HIGH PART OF BLOCK #
LOAD T2,HDRP2; ;GET LOW PART FROM SECOND PARAMETER
IORB T1,T2 ;GET BLOCK # TO BOTH T1 AND T2
SUB T1,FEADDR ;COMPUTE RELATIVE BLOCK IN F-E-F-S FILE
JUMPL T1,DBPRL1 ;BELOW START-- SEE IF HOM BLOCKS
LOAD T3,HDRSZ; ;GET SIZE OF REQUESTED READ/WRITE
ADDI T3,1K-1 ;ROUND UP
ASH T3,-^D9 ; TO NEXT BLOCK (OF BYTES)
ADD T3,T1 ;ADD CURRENT LENGTH IN BLOCKS
CAML T1,FESIZE ;WITHIN RANGE?
RETERR IE.BLK
IDIVI T1,4 ;CONVERT RELATIVE BLOCK TO PAGE IN FILE
MOVE T4,T2 ;SAVE THE OFFSET WITHIN THE PAGE
ADDI T3,4-1 ;ROUND UP LAST BLOCK
ASH T3,-2 ; TO NEXT PAGE
SUB T3,T1 ;COMPUTE LENGTH OF AREA TO BE TRANSFERRED IN PAGES
CAMN T1,CFSPAG ;IS THIS PAGE SAME AS LAST ONE?
CAMLE T3,CFSSIZ ; AND WITHIN LAST RANGE?
SKIPA ;NO-- MUST DO ANOTHER PMAP
JRST DBPRW1 ;YES-- PMAP ALREADY DONE
MOVEM T1,CFSPAG ;SAVE THIS PAGE
MOVEM T3,CFSSIZ ; AND LENGTH IN PAGES
HRL T1,FSJFN ;MAKE HANDLE TO THE F-E-F-S FILE
MOVE T2,[XWD .FHSLF,FEFBUF/1K] ;MAKE DEST. HANDLE TO OUR BUFFER
TXO T3,PM%RD!PM%WT!PM%CNT ;READ, WRITE, ITERATION COUNT OF PAGES IN B17-35
PMAP ;MAP THE CURRENT SEGMENT OF THE F-E-F-S FILE TO BUFFER
;
; THE DESIRED SEGMENT OF THE FILE HAS BEEN MAPPED TO FEFBUF
;
DBPRW1: MOVE T2,T4 ;COPY THE OFFSET IN BLOCKS FROM THE BEGGINGING OF THE PAGE
ASH T2,^D7 ;CONVERT IN TO A WORD (-20) ADDRESS
ADDI T2,FEFBUF ; WITHIN THE BUFFER
LOAD T3,HDRSZ; ;GET # BYTES TO BE TRANSFERRED
TXNN F,F.WRIT ;IS THIS A WRITE REQUEST?
JRST DBPRL2 ;NO-- GO DO A READ
;
; WRITE REQUEST
;
CALL FEIN ;INPUT ALL THE DATA TO BE WRITTEN
MOVE T1,CFSPAG ;GET CURRENT PAGE #
HRL T1,FSJFN ; IN F-E-F-S FILE
MOVE T2,CFSSIZ ;AND SIZE OF MAPPED AREA
UFPGS ;UPDATE FILE PAGES
RETERR IE.VER
JRST DBPRL4 ;FINISH WRITE REQUEST
;
; READ BLOCK NOT IN FILE SYSTEM-- MUST BE LESS THAN 10. (HOM BLOCKS)
;
DBPRL1: SKIPN FESIZE ;IS THERE A FILE SYSTEM???
RETERR IE.BLK ;NO-- SORRY, CAN'T READ THAT BLOCK
TXNE F,F.WRIT ;WRITING??
JRST DBPRL3 ;YES-- ONLY BLOCK 0 (BOOT)
MOVE T1,T2 ;GET THE BLOCK #
LOAD T2,HDRSZ; ; AND LENGTH TO TRANSFER
CALL DSKIN ;READ THE BLOCK
RETERR IE.VER ;OOPS
LOAD T3,HDRSZ; ;GET THE SIZE BACK TO TRANSFER
MOVEI T2,SCRBUF ;WHERE THE BLOCK IS AT
;
; READ DATA BACK TO THE FE DEVICE
;
DBPRL2: HRLZ T1,T3 ;WITH PROPER # BYTES TRANSFERRED
JRST DBPRL5 ;FINISH REQUEST
;
; WRITE REQUEST OUT OF -11 AREA-- ONLY BOOT BLOCK 0 ALLOWED
;
DBPRL3: LOAD T3,HDRSZ; ;GET THE SIZE OF REQUESTED TRANSFER
CAIN T2,0 ;THIS TO BLOCK 0?
CAILE T3,1K ; AND LESS THAN ONE BLOCK?
RETERR IE.VER
MOVEI T2,SCRBUF ;POINT TO DISK BUFFER
CALL FEIN ;READ IT IN
SETZ T1, ;SET TO BLOCK 0 ONLY
LOAD T2,HDRSZ; ; AND THE TRANSFER SIZE
CALL DSKOUT ;WRITE THAT BLOCK (0)
RETERR IE.VER
;
; FINISH WRITE REQUEST
;
DBPRL4: LOAD T1,HDRSZ; ;GET REQUESTED SIZE, IN BYTES
MOVS T1,T1 ;SET AS PARAMETER #2
SETZ T3, ;NO BYTES
;
; FINISH REQUEST
;
DBPRL5: HRRI T1,IS.SUC ;SAY SUCCESS AS PARAMETER #1
CALL FEHDR ;SEND THAT HEADER
JRST FEWAIT ;BACK FOR ANOTHER
;
>; END IFN FTDB
SUBTTL PROCESS REQUEST FOR FILE CONTROL
;
; DEVICE REQUESTED IS FE-- PERFORM SPECIFIED FUNCTION
;
FEPROC: CAIN T1,IO.FCP ;IS THIS FILE CONTROL FUNCTION?
JRST T20FCP ;YES-- DO THE FILE-CONTROL PRIMITIVES
RETERR IE.IFC,X ;NO-- ILLEGAL FUNCTION
SUBTTL FE DEVICE I/O ROUTINES
;
; FEIN -- READ A BUFFER FROM THE FE DEVICE
; T2 -- ADDRESS OF BUFFER TO STORE DATA
; T3 -- LENGTH OF BUFFER IN 8 BIT BYTES
;
; T1,T2,T3,T4 USED
;
FEIN: ADDM T3,BLKSIZ ;DECREMENT COUNT OF BYTES LEFT IN THIS PACKET
IFE FTDTE.,<
MOVE T1,FEJFN ;1/ JFN OF FE DEVICE
HRLI T2,(POINT 18,) ;2/ INPUT STRING POINTER
ADDI T3,1 ;3/ LENGTH OF STRING
ASH T3,-1 ; IN 18 BIT BYTES
MOVN T3,T3 ; -VE COUNT
SIN ;READ THE BLOCK FROM THE FE DEVICE
GTSTS ;CHECK OUT THE STATUS
TXNN T2,GS%EOF ;END-OF-FILE?
>; END IFE FTDTE.
IFN FTDTE.,<
ADDI T3,1 ;ROUND UP
ASH T3,^D<18-1> ; TO WORDS IN LH
HRR T3,T2 ;GET BUFFER ADDRESS
MOVEI T1,.DTEIF ;INPUT FROM FE
CALL DTEUUO ; . . .
MOVEI T1,.DTEFG ;GET FE DEVICE STATUS
CALL DTEUUO ; . . .
TXNN T4,DT.EOF ;END-OF-FILE??
>; END IFN FTDTE.
RETURN ;RETURN OK
WARN <EOF ON FE DEVICE -- RESTARTING>,START,X
;
; RETOK -- RETURN IS.SUC (SUCCESS) AND BACK TO WAITING
;
RETOK: MOVEI T1,IS.SUC ;SUCCESS
;
; RETXXX -- RETURN ERROR CODE IN STATUS
; T1 -- ERROR CODE
;
RETXXX: MOVN T3,BLKSIZ ;GET BYTES LEFT IN PACKET
JUMPLE T3,RETXX1 ;OK IF ALL READ
PUSH P,T1 ;SAVE THE CODE
MOVEI T2,SCRBUF ;POINT TO RANDOM BUFFER
CALL FEIN ;READ THE TRASH
POP P,T1 ;RESTORE ERROR CODE
;
RETXX1: SETZ T3, ;NO BUFFER
CALL FEHDR ;OUTPUT THE HEADER
JRST FEWAIT ;BACK TO WAITING
;
; FEHDR -- OUTPUT A BLOCK TO THE FE DEVICE, WHITH HEADER
; T1 -- RH: PARAMETER #1, LH: PARAMETER #2
; T2 -- ADDRESS OF BUFFER
; T3 -- SIZE OF BUFFER IN 8 BIT BYTES
; HDR -- ADDRESS OF CURRENT HEADER
;
; T1,T2,T3,T4 USED
;
FEHDR: PUSH P,T2 ;SAVE ADDR
PUSH P,T3 ; AND SIZE
STOR T1,HDRP1; ;STORE THE STATUS
MOVS T1,T1 ;GET SECOND PARAM
STOR T1,HDRP2; ; . . .
STOR T3,HDRSZ; ;AND THE SIZE OF THE TRANSFER BLOCK
MOVEI T2,HEADER ;POINT TO HEADER
MOVEI T3,HDRLEN ;SET TO HEADER SIZE
CALL FEOUT ;SEND IT
POP P,T3 ;RESTORE
POP P,T2 ; . . .
JUMPE T3,CRET ;THAT'S IT IF NO DATA
CALLRX FEOUT ;ELSE OUTPUT THE DATA BLOCK
;
; FEOUT -- OUTPUT A BLOCK TO THE FE DEVICE
; T2 -- ADDRESS OF BLOCVK
; T3 -- SIZE OF BLOCK IN 8 BIT BYTES
;
; USES T4,T2,T3,T1
;
FEOUT:
IFE FTDTE.,<
MOVE T1,FEJFN ;1/ JFN OF FE DEVICE
HRLI T2,(POINT 18,) ;2/ 18-BIT BYTE POINTER TO SOURCE STRING
ADDI T3,1 ;3/ SIZE OF STRING
ASH T3,-1 ; IN 16 BIT BYTES
MOVN T3,T3 ; -VE COUNT
SOUT ;SEND TO FE DEVICE
MOVX T2,.MOEOF ;PERFORM AN EOF FUNCTION
MOVX T3,-1 ; BUT DON'T SEND EOF
MTOPR ;SO AS TO FORCE OUT THE BUFFER
RETURN ;RETURN FROM FEOUT
>; END IFE FTDTE.
IFN FTDTE.,<
ADDI T3,1 ;ROUND UP
ASH T3,^D<18-1> ; TO WORDS IN LH
HRR T3,T2 ;GET BUFFER ADDRESS
MOVEI T1,.DTEOF ;OUTPUT TO FE DEVICE
CALLRX DTEUUO ;OUTPUT TO FE DEVICE AND RETURN FROM FEOUT
;
; DTEUUO -- PERFORM DTE. UUO FUNCTION
; T1 -- FUNCTION CODE
; T3 -- ADDITIONAL DATA
; RETURNS +1:
; T4 -- DATA FROM DTE. UUO
;
DTEUUO:
CALL DTESET ;SET UP REGISTERS
DTE. T4, ;DO A DTE UUO
CALLR DTEERR ;ERROR-- TYPE IT OUT
RETURN ;OK-- RETURN FROM DTEUUO
;
; DTESET -- SET UP REGISTERS FOR DTE. UUO
; T1 -- DTE FUNCTION CODE
; RETURNS +1:
; T1 -- XWD 0,-1 ;CPU 0, PRIV DTE-20
; T2 -- FE DEVICE #
; T4 -- XWD FUNC,T1
;
DTESET:
MOVEM T1,DTEFNC ;SAVE THE FUNCTION CODE FOR ERROR TYPEOUT
MOVS T4,T1 ;COPY FUNCTION CODE TO LH
HRRI T4,T1 ;SET ADDRESS OF DTE FUNCTION BLOCK
MOVX T1,<XWD 0,-1> ;CPU #, DTE #
MOVE T2,FEDNUM ;GET FE DEVICE #
RETURN ;FROM DTESET
;
; DTEERR -- REPORT DTE. UUO FAILURE
;
DTEERR:
OUTSTR [ASCIZ/% DTE. UUO FAILURE /]
MOVE T1,T4 ;GET ERROR CODE
CALL TYPOCT ;TYPE IT
OUTSTR [ASCIZ/ FOR FUNCTION /]
MOVE T1,DTEFNC ;GET SAVED CODE
CALL TYPOCT ;TYPE IT
EXIT 1, ;GIVE UP
RETURN ;CONTINUE WILL GO ON . . .
>; END IFN FTDTE.
;
IFN FTDB,<
;
; DSKIN/DSKOUT -- READ/WRITE A PHYSICAL DISK BLOCK TO/FROM SCRBUF
; T1 -- BLOCK #
; T2 -- SIZE OF DATA IN 8 BIT BYTES
;
; USED T1,T3,T2
;
DSKOUT: ADDI T2,3 ;2/ SIZE OF BUFFER
ASH T2,-2 ; IN WORDS
TXO T2,DOP%WR ;DO A WRITE
JRST DSKIO ;DO IT...
;
DSKIN: ADDI T2,3 ;2/ SIZE OF BUFFER
ASH T2,-2 ; IN WORDS
;
DSKIO: TXO T1,DOP%SA ;1/ SOFTWARE DISK ADDRESS
ADD T1,DSKOFS ;ADD IN OFFSET FOR THIS UNIT
ADDI T2,200-1 ;2/ BUFFER SIZE IN WORDS
TXZ T2,200-1 ; ROUNDED UP TO 200 WORDS
MOVEI T3,SCRBUF ;3/ ADDRESS OF DATA BUFFER
DSKOP ;PERFORM READ
JUMPN T1,CRET ;ERROR-- RETURN +1
CALLRX CRET1 ;OK-- RETURN +2
;
>; END IFN FTDB
;
CRET1: AOS (P) ;OK-- RETURN +2
CRET: RETURN ;RETURN FROM DSKIN
SUBTTL TOPS-20 FILE CONTROL REQUEST
;
; HERE WITH REQUEST FOR FE DEVICE, FUNCTION IO.FCT (FILE CONTROL)
;
T20FCP: LOAD T3,HDRSZ; ;GET THE REQUESTED SIZE OF DATA TO COME HERE
MOVEI T2,SCRBUF ;POINT TO SCRACTH BUFFER
CALL FEIN ;READ THEM BYTES
LOAD T1,HDRP1; ;GET THE I/O FUNCTION CODE OF THE PRIMITIVE
LSH T1,-^D8 ; BUT JUST THE MAJOR CODE
CAIL T1,LOWFNC ;WITHIN RANGE?
CAILE T1,HGHFNC ; FOR A FILE-CONTROL FUNCTION?
ILLFNC: RETERR IE.IFC
CALL @FCPDSP-LOWFNC(T1) ;CALL THE REQUESTED FUNCTION CODE
;
; HERE ON COMPLETION OF A FUNCTION
; T1 -- (LH) SECOND I/O STATUS WORD (RH) BYTE COUNT TO RETURN TO -11
;
FCPXIT: HRRZ T3,T1 ;COPY LENGTH OF RETURN BLOCK
HRRI T1,IS.SUC ;SAY SUCCESS NOW
MOVEI T2,SCRBUF ;RETURN DATA IN SCRBUF, ALSO
CALL FEHDR ;SEND THE SUCCESS INFO TO THE -11
JRST FEWAIT ;THAT'S ALL FOLKS
;
; DISPATCH TABLE FOR FILE PRIMITIVES
;
LOWFNC==11 ;LOWEST FUNCTION ALLOWED
FCPDSP:
EXP FCPFNA ;(11) FNA: FIND FILENAME IN DIRECTORY
EXP ILLFNC ;(12) UNUSED
EXP FCPRNA ;(13) RNA: REMOVE NAME FROM DIRECTORY
EXP FCPENA ;(14) ENA: ENTER NAME IN DIRECTORY
EXP FCPACR ;(15) ACR: ACCESS FOR READ
EXP FCPACW ;(16) ACW: ACCESS FOR READ, WRITE
EXP FCPACE ;(17) ACE: ACCESS FOR READ, WRITE, EXTEND
EXP FCPDAC ;(20) DAC: DEACCESS FILE
EXP FCPRVB ;(21) RVB: READ VIRTUAL BLOCK
EXP FCPWVB ;(22) WVB: WRITE VIRTUAL BLOCK
EXP FCPEXT ;(23) EXT: EXTEND FILE
EXP FCPCRE ;(24) CRE: CREATE FILE
EXP FCPDEL ;(25) DEL: DELETE FILE
EXP FCPRAT ;(26) RAT: READ ATTRIBUTES
EXP FCPWAT ;(27) WAT: WRITE ATTRIBUTES
EXP FCPAPC ;(30) APC: ACP CONTROL
HGHFNC==30
;
; HERE TO RETURN NOTHING TO THE -11
;
FCPZX: TDZA T1,T1 ;SAY NOTHING
;
; HERE TO RETURN BYTE COUNT FROM P4
;
FCPP4X: HRRZ T1,P4 ;COPY BYTE COUNT
RETURN ;RETURN SUCCESS
SUBTTL FNA -- FIND FILE-NAME IN DIRECTORY
;
;
FCPFNA: LOAD T2,N.DID; ;GET DIRECTORY ID
CAME T2,[XWD 177777,177777] ;ID OF MFD?
JRST FCPFNF ;NO-- LOOK FOR A FILE
;
; FIND DIRECTORY NAME
;
MOVEI P4,UICTAB ;POINT TO TABLE OF DIRECTORIES
;
LOAD T2,N.DOW; ;GET DIRECTORY OWNER
LOAD T1,N.STAT; ;GET FLAGS FOR THIS FILE
TXNE T1,NB.SNM ;WILD NAME?
LOAD T2,N.NEXT; ;YES-- START LOOKING AT "NEXT" DIRECTORY
IF TOPS-20,<
CAIGE T2,340B<35-8> ;THIS UIC GREATER THAN [340,0]?
JRST FCPFD1 ;NO-- SCAN THE TABLE
MOVE T4,T2 ;COPY DIRECTORY UIC
SUBI T2,340B<35-8> ;YES-- GET DIRECTORY NUMBER
HRROI T1,FNMBLK ;SCRATCH AREA TO STORE NAME
DIRST ;GET DIRECTORY NAME
RETERR IE.NSF ;NO SUCH DIRECTORY
JRST FCPFD3 ;STORE THE NAME
>; END IF TOPS-20
;
FCPFD1: SKIPN T3,UICSIZ(P4) ;GET SIZE OF THIS BLOCK
RETERR IE.NSF ;END OF LIST-- NOT FOUND
CAMG T2,UICUIC(P4) ;UIC MATCH?
JRST FCPFD2 ;YES-- GOT IT
ADD P4,T3 ;NO-- BUMP TO NEXT ENTRY IN DIRECTORY TABLE
JRST FCPFD1 ;LOOP FOR ALL UIC'S IN TABLE
;
FCPFD2: MOVE T4,UICUIC(P4) ;GET DIRECTORY WE FOUND
TXNE T1,NB.SNM ;WILD?
JRST FCPFD3 ;YES-- OK
CAME T2,T4 ;NO-- EXACT MATCH?
RETERR IE.NSF ;NO-- NOT FOUND
;
; CONVERT DIRECTORY NAME TO RAD50 AS FILE NAME
;
FCPFD3:
IF TOPS-20,<
MOVE T1,[POINT 7,FNMBLK] ;POINT TO SCRATCH TEXT AREA
MOVX T3,NO%LFL!NO%ZRO+3B17+^D8B35 ;OCTAL, 3 COLUMNS
LDB T2,[POINT 8,T4,35-8] ;GET HIGH BYTE
NOUT ;MAKE IT TEXT
RETERR IE.RER
LDB T2,[POINT 8,T4,35-0] ;THEN LOW BYTE
NOUT ;TEXT, ALSO
RETERR IE.RER
HRROI T2,[ASCIZ/.DIR.0/] ;MAKE IT A DIRECTORY
SETZ T3, ;ASCIZ
SOUT ;PUT IN STRING
>; END IF TOPS-20
IF TOPS-10,<
MOVEI FID,DMPBUF ;POINT TO SCRATCH AREA
CALL CLRFNM ;RESET FILE-NAME BLOCK
LDB T2,[POINT 8,T4,35-8] ;GET HIGH BYTE
CALL OCTSIX ;CONVERT OCTAL TO SIXBIT
HLLZM T3,FIDLEB+.RBNAM(FID) ;STORE AS FIRST THREE CHARS OF NAME
LDB T2,[POINT 8,T4,35-0] ;THEN LOW BYTE
CALL OCTSIX ;YOU TOO
HLRM T3,FIDLEB+.RBNAM(FID) ; . .
MOVX T1,<SIXBIT/DIR/> ;DIRECTORY FILE TYPE
MOVEM T1,FIDLEB+.RBEXT(FID) ; . .
>; END IF TOPS-10
CALL PUTNAM ;PUT THE FOUND NAME IN THE FNB
RETERR IE.RER
;
MOVEI T1,1(T4) ;GET NEXT POSSIBLE DIRECTORY NUMBER
STOR T1,N.NEXT; ;STORE THE DIRECTORY NUMBER FOR WILD
HRLI T4,BIT15 ;MAKE IT A DIRECTORY FID
STOR T4,N.FID; ;STORE IT IN THE FNB
JRST FCPDRX ;RETURN THE NEW FNB
;
; FIND FILENAME
;
FCPFNF: LOAD T1,N.NEXT; ;GET CONTEXT FOR WILD LOOKUP, IF ANY
JUMPN T1,FCPFNW ;N.NEXT SPECIFIED-- DO A WILD
CALL ALCFID ;GET A FILE-ID
CALL GETNAM ;CONVERT RAD50 NAME TO TEXT STRING
IF TOPS-20,<
MOVX T1,GJ%OLD!GJ%SHT!GJ%IFG ;SET SHORT JFN, FILE MUST EXIST, INPUT FILE GROUP
GTJFN ;GET THE JFN FOR THE FILE
>; END IF TOPS-20
IF TOPS-10,<
CALL LOOK ;LOOKUP WILD(?) FILE
>; END IF TOPS-10
RETERR IE.NSF
MOVEM T1,FIDJFN(FID) ;STORE JFN BACK IN FILE-ID BLOCK
LOAD T1,N.DID; ;GET DIRECTORY ID
MOVEM T1,FIDUIC(FID) ;STORE THE UIC FOR LATER
JRST FCPFNN ;GET THE NAME
;
; WILD NAME FROM LAST TIME-- CHECK IT OUT
;
FCPFNW: MOVE FID,T1 ;COPY THE SPECIFIED N.NEXT AS FILE-ID
IMULI FID,FIDSIZ ;MAKE IT AN OFFSET
ADDI FID,FIDTAB-FIDSIZ ; INTO FIDTAB
CAIL FID,FIDTBE ;BEYOND END?
RETERR IE.SNC ;YES-- BAD FILE-ID
;
FCPFWN: MOVE T2,FIDFLG(FID) ;GET THE FLAGS
TXNN T2,FI.ACC ;ACCESSED?????
SKIPN T1,FIDJFN(FID) ;GET THE JFN
RETERR IE.RER
SETZM FIDFLG(FID) ;RESET THE FLAGS FOR THE NEW FILE
AOS FIDFID(FID) ;GET NEW SEQUENCE #
IF TOPS-20,<
GNJFN ;GET NEXT FILE
>; END IF TOPS-20
IF TOPS-10,<
CALL WLOOKN ;LOOKUP NEXT FILE
>; END IF TOPS-10
JRST [SETZM FIDJFN(FID) ;FAILED-- NO LONGER JFN'ED
RETERR (IE.NSF,X)] ;SAY NO SUCH FILE
CALL SETUCT ;NOTE THAT THIS FILE-ID HAS BEEN USED
;
FCPFNN:
IF TOPS-20,<
HRRZ T2,FIDJFN(FID) ;GET THE JFN, ONLY
HRROI T1,FNMBLK ;STRING POINTER TO THE NAME
MOVX T3,1B8+1B11+1B14+1B35 ;FILE.EXT.VER
JFNS ;CONVERT WHAT JFN WE HAVE TO A STRING
>; END IF TOPS-20
CALL PUTNAM ;STORE THE FILE-NAME
JRST FCPFWN ;TOO LONG-- LOOK AGAIN
;
MOVE T1,FIDFID(FID) ;GET THE FILE-ID OF THIS FILE
STOR T1,N.FID; ;STORE THE DOUBLE-WORD IN FNB
HLRZ T1,T1 ;GET THE FILE-ID NUMBER
STOR T1,N.NEXT; ; AND SAVE FOR NEXT FNA
;
MOVE T1,[PNTR (N.FNM0)] ;POINT TO THE FNB TO STORE
MOVE T2,[POINT 18,FIDNAM(FID)] ;ALSO TO BEFORE NAME TO SAVE IT
CALL MOVNAM ;MOVE THE FILE-NAME
;
MOVX P1,FI.ASC ;GET ASCII FILE BIT
IF TOPS-20,<
CALL GETFDB ;GET THE FDB FOR THIS FILE
LDB T1,[POINT 6,FILFDB+.FBBYV,11] ;GET THE FILE'S BYTE SIZE
CAIN T1,^D18 ;BINARY FILE FOR SURE?
JRST FCPDRX ;YES-- ALL DONE
CAIE T1,^D7 ;ASCII FILE FOR SURE?
>; END IF TOPS-20
IF TOPS-10,<
LDB T1,[POINT 4,FIDLEB+.RBPRV(FID),12] ;GET FILE MODE
CAIN T1,.IOIMG ;IMAGE BINARY?
JRST FCPDRX ;YES-- FILE IS BINARY FOR SURE
CAILE T1,.IOASL ;MODE= 0 OR 1 (ASCII)?
>; END IF TOPS-10
CALL CHKTYP ;NO-- SEE IF BINARY FILE TYPE
IORM P1,FIDFLG(FID) ;NOT BINARY-- SET ASCII FLAG
JRST FCPDRX ;RETURN FILE-NAME BLOCK TO -11
SUBTTL RNA, ENA -- REMOVE/ENTER NAME IN DIRECTORY
;
;
FCPRNA: CALL FCPFNF ;FIND THE FILE TO REMOVE
IF TOPS-10,<
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
CALL XCTUUP ;LOOKUP CURRENT FILE
LOOKUP FIDLEB(FID) ; . . .
RETERR IE.RER
PUSH P,FID ;SAVE CURRENT FILE-ID
MOVEI FID,DMPBUF ;POINT TO SCRATCH AREA
>; END IF TOPS-10
CALL GETTMP ;GET A TEMP FILE TO RENAME THIS ONE TO
JRST FCPERN ;DO THE RENAME
;
;
FCPENA: CALL GETFID ;GET THE FILE-ID OF THE FILE BEING ENTERED
MOVE T4,FIDFLG(FID) ;GET THE FLAGS FOR THIS FILE
TXNE T4,FI.TMP ;THIS A TEMP FILE (MUST BE)?
TXNE T4,FI.ACC ;FILE ACCESSED?
RETERR IE.ALN
IF TOPS-10,<
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
CALL XCTUUP ;LOOKUP TEMP FILE
LOOKUP FIDLEB(FID) ; . . .
RETERR IE.RER
PUSH P,FID ;SAVE CURRENT FILE-ID
MOVEI FID,DMPBUF ;POINT TO SCRATCH AREA
>; END IF TOPS-10
CALL GETNAM ;GET THE NAME HE WANTS TO ENTER IT AS
TXNE T1,FJ.WLD ;WILD *'S SEEN?
RETERR IE.BAD
IF TOPS-20,<
MOVX T1,GJ%FOU!GJ%SHT!GJ%NEW ;NEXT VERSION, MUST BE NEW FILE, SHORT CALL
GTJFN ;GET A JFN FOR IT IN T1
RETERR IE.DUP
>; END IF TOPS-20
;
; T1 = FILE-NAME TO BE, FID POINTS TO FILE-ID BLOCK OF EXISTING FILE
;
FCPERN:
IF TOPS-20,<
HRRZ T2,T1 ;COPY FINAL JFN
HRRZ T1,FIDJFN(FID) ;GET THE EXISTING JFN
RNAMF ;RENAME THE FILE
RETERR IE.RER
HRRZM T2,FIDJFN(FID) ;STORE THE NEW JFN
>; END IF TOPS-20
IF TOPS-10,<
POP P,T2 ;GET FID FOR EXISTING FILE
EXCH T2,FID ;T2= FID AREA FOR NEW FILE, FID= OLD FILE
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
CALL XCTUUP
RENAME FIDLEB(T2) ;RENAME TO/FROM TEMP FILE
RETERR IE.DUP
HRLZI T1,FIDLEB(T2) ;SUCCESS-- SET NEW FILE-NAME
HRRI T1,FIDLEB(FID) ; INTO OLD FID BLOCK
BLT T1,FIDLEB+.RBALC(FID) ; . . .
>; END IF TOPS-10
MOVX T1,FI.TMP ;GET TEMP FILE BIT
XORM T1,FIDFLG(FID) ;SET/CLEAR IT
SETZRO N.NEXT; ;NO WILD CARDS ALLOWED
; JRST FCPDRX ;RETURN THE NEW FILE-NAME BLOCK
;
; ALL DONE. RETURN FILE-NAME BLOCK
;
FCPDRX: MOVEI T1,S.DRFN ;RETURN WHOLE BLOCK
RETURN ;FROM DIRECTORY OPERATION
SUBTTL ACR, ACW, ACE -- ACCESS FILE
;
;
FCPACE:
FCPACW: TXO F,F.WRIT ;NOTE WRITE ACCESS
FCPACR: CALL FCPRAT ;READ THE ATTRIBUTES, IF ANY
;
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
MOVE T4,FIDFLG(FID) ;GET THE FLAGS
TXNE T4,FI.ACC ;ALREADY ACCESSED?
RETERR IE.ALN
TXO T4,FI.ACC!FI.WRT ;ASSUME SUCCESS FLAGS
IF TOPS-20,<
MOVX T2,OF%RD+^D7B5 ;ASSUME READ, ASCII
TXNN T4,FI.ASC ;ASCII FILE?
MOVX T2,OF%RD+^D18B5 ;NO-- USE 18 BIT BYTES, -11 STYLE
TXNE F,F.WRIT ;WRITE ACCESS?
TXOA T2,OF%WR ;YES-- SAY SO
TXZ T4,FI.WRT ;NO-- MARK NOT WRITE ACCESS
OPENF ;OPEN THE FILE
RETERR IE.RER ;OOPS
>; END IF TOPS-20
IF TOPS-10,<
CALL XCTUUP ;LOOKUP FILE . .
LOOKUP FIDLEB(FID) ; . . .
RETERR IE.RER
TXNN F,F.WRIT ;WRITE ACCESS REQUESTED?
JRST FCPAC1 ;NO-- DON'T ALLOW IT
CALL XCTUUP ;IN UPDATE MODE,
ENTER FIDLEB(FID) ;ATTEMPT TO ENTER THE FILE
RETERR IE.WER
JRST FCPAC2
;
FCPAC1:
TXZ T4,FI.WRT ;NO-- DON'T ALLOW IT
FCPAC2:
>; END IF TOPS-10
SETZM FIDFBP(FID) ;RESET FILE BYTE POINTER
MOVEM T4,FIDFLG(FID) ;SET THE NEW ACCESS BITS
JRST FCPP4X ;RETURN THE ATTRIBUTE BLOCK FROM ACCESS
SUBTTL DAC -- DEACCESS FILE
;
;
FCPDAC: CALL FCPWAT ;WRITE THE FILE ATTRIBUTES
MOVE P1,FIDFLG(FID) ;GET THE FLAGS FOR THIS FILE
TXNN P1,FI.ACC ;FILE ACCESSED?
RETERR IE.NLN ;NO-- CAN'T DEACCESS IT
MOVX T1,FI.WRT!FI.ACC ;CLEAR THE OPEN BITS
ANDCAM T1,FIDFLG(FID) ; FOR THIS FILE
IF TOPS-20,<
HRRZ T1,FIDJFN(FID) ;GET THE JFN FOR THE FILE
TXO T1,1B0 ;DON'T RELEASE THE JFN
CLOSF ;CLOSE THE FILE
RETERR IE.WER ;OOPS
>; END IF TOPS-20
TXNN P1,FI.WRT ;ACCESSED FOR WRITE?
JRST FCPDA9 ;NO-- DON'T SET EOF
;
; ACCESSED FOR WRITE-- MUST UPDATE EOF IF SPECIFIED
;
LOAD T1,H.HEFB; ;GET HIGH PART EOF BLOCK #
LSH T1,^D16 ;INTO HIGH WORD
LOAD T2,H.LEFB; ;ALSO LOW PART
IOR T2,T1 ;GET EOF BLOCK # INTO T2
SOJL T2,FCPZX ;START VBN'S AT 1-- SKIP IF NO EOF SPECIFIED
ASH T2,^D9 ;CONVERT VBN TO BYTES
LOAD T3,H.FFBY; ;GET FIRST FREE BYTE IN THAT LAST BLOCK
ADDB T3,T2 ;EOF BYTE NOW IN T3 AND T2
HRRZ T1,FIDJFN(FID) ;GET JFN OF THE FILE
IF TOPS-20,<
TXNE P1,FI.ASC ;ASCII FILE?
JRST FCPDA3 ;YES-- BYTE COUNT IS OK
ADDI T3,1 ;NO-- ROUND UP
ASH T3,-1 ; TO WORDS
;
FCPDA3: HRLI T1,.FBSIZ ;SET TO CHANGE SIZE IN BYTES
MOVX T2,-1 ;WHOLE WORD TO CHANGE
CHFDB ;CHANGE THE EOF BYTE POINTER
>; END IF TOPS-20
IF TOPS-10,<
MOVEI T4,^D4 ;ASSUME BINARY
TXNE P1,FI.ASC ;ASCII FILE?
MOVEI T4,^D5 ;YES-- FIVE BYTES/WORDS
ADDI T2,-1(T4) ;ROUND UP
IDIV T2,T4 ; TO WORDS
IDIVI T2,200 ;FULL BLOCKS TO T2, EXTRA WORDS TO T3
JUMPE T3,FCPDA3 ;SKIP INPUT IF NO EXTRA WORDS
MOVN T3,T3 ;GET -VE WORDS EXTRA
HRLZ T3,T3 ;FORM
HRRI T3,DMPBUF-1 ; IOWD TO DMPBUF
MOVX T4,0 ;END I/O LIST
CALL XCTUUO
USETI 1(T2) ;SET TO INPUT LAST PARTIAL BLOCK
CALL XCTUUO
IN T3 ;INPUT LAST BLOCK
SKIPA ;OK-- GO ON
RETERR IE.RER
FCPDA3:
ADDI T2,2 ;COUNT THE RIBS
MOVEM T2,FIDLEB+.RBALC(FID) ;STORE # FULL BLOCKS TO TRUNCATE TO
SUBI T2,2 ;BACK TO REAL SIZE
CALL XCTUUP
RENAME FIDLEB(FID) ;TRUNCATE AND CLOSE FILE
RETERR IE.WER
JUMPLE T2,FCPDA4 ;WRITING FROM BEGINNING OF FILE-- SUPERCEDE
JUMPE T3,FCPZX ;ALL DONE IF NO EXTRA WORDS
CALL XCTUUP
LOOKUP FIDLEB(FID) ;RE-LOOKUP FILE
RETERR IE.RER
FCPDA4:
CALL XCTUUP
ENTER FIDLEB(FID) ;RE-ENABLE UPDATE MODE
RETERR IE.WER
JUMPE T3,FCPDA9 ;DONE IF NO WORDS TO WRITE
CALL XCTUUO
USETO 1(T2) ;SET OUTPUT TO LAST BLOCK (NOW NON-EX)
CALL XCTUUO
OUT T3 ;OUTPUT EXTRA WORDS IN LAST BLOCK
SKIPA
RETERR IE.WER
>; END IF TOPS-10
FCPDA9:
IF TOPS-10,<
CALL CLOSEF ;CLOSE FILE
RETERR IE.WER ;OOPS
>; END IF TOPS-10
JRST FCPZX ;DONE WITH DAC
SUBTTL EXT, CRE, DEL -- EXTEND/CREATE/DELETE FILE
;
;
FCPEXT: CALL GETFID ;CHECK OUT THE FILE-ID
MOVSI T1,4 ;SET EXTEND SIZE TO 4 BLOCKS (I/O STATUS WORD 2)
RETURN ;FROM FCPEXT
;
;
FCPCRE: CALL ALCFID ;ALLOCATE A FILE-ID FOR THE FILE
CALL GETTMP ;GET A TEMPORARY JFN
IF TOPS-10,<
CALL GETCHN ;GET A FREE CHANNEL
RETERR IE.NOD
MOVX T2,.IODMP ;DUMP MODE
MOVX T3,<SIXBIT/DSK/> ; FOR DEVICE DSK:
MOVX T4,0 ;NO BUFFERS
CALL XCTUUO
OPEN T2 ;OPEN DEVICE NOW
JRST FCPCRF ;OOPS!!
>; END IF TOPS-10
MOVEM T1,FIDJFN(FID) ;STORE THE TEMP JFN
MOVE T1,FIDFID(FID) ;GET THE FILE-ID
STOR T1,FILID; ;SAVE TO RETURN TO THE -11
CALL FCPWAT ;WRITE ATTRIBUTES, IF ANY TO SET UP HEADER
MOVE T1,[PNTR (I.FNM0)] ;POINT TO FILE-NAME FROM HEADER
MOVE T2,[POINT 18,FIDNAM(FID)] ;POINT TO FILE-ID BLOCK TOO
CALL MOVNAM ;MOVE THE NAME, 5 WORDS
MOVX P1,FI.TMP ;GET TEMP FILE BIT FOR NOW
LOAD T1,H.RTYP; ;GET RECORD TYPE BYTE
TXNE T1,2 ;VARIABLE RECORD LENGTH (I.E. FORMATTED FILE)?
JRST FCPCR1 ;YES-- MUST BE BINARY FILE
CALL CHKTYP ;SEE IF BINARY FILE TYPE
TXO P1,FI.ASC ;NO-- MUST BE AN ASCII FILE
FCPCR1:
IORM P1,FIDFLG(FID) ;SET THE FLAGS
HRRZ T1,FIDJFN(FID) ;GET THE JFN TO OPEN
IF TOPS-20,<
MOVX T2,OF%RD!OF%WR ;OPEN FOR READ/WRITE
OPENF ;OPEN THE FILE
JRST FCPCRF ;FAILED-- RELEASE AND COMPLAIN
TXO T1,1B0 ;DON'T RELEASE THE CLOSED JFN
CLOSF ;CLOSE THE FILE TO CREATE IT
>; END IF TOPS-20
IF TOPS-10,<
CALL XCTUUP
ENTER FIDLEB(FID) ;ATTEMPT TO WRITE SUCH FILE
JRST FCPCRF
CALL CLOSEF ;CLOSE FILE
>; END IF TOPS-10
JRST FCPCRF ;FAILED-- RELEASE JFN
MOVEI T1,4 ;OK-- SET TO RETURN THE FILE-ID
RETURN ;RETURN THE FILE-ID FROM CREATE
;
FCPCRF: HRRZ T1,FIDJFN(FID) ;GET THE JFN BACK
SETZM FIDJFN(FID) ;NO LONGER A VALID FILE-ID
IF TOPS-20,<
RLJFN ;RELEASE THE JFN
JFCL ;OOPS
>; END IF TOPS-20
IF TOPS-10,<
CALL RELCHN ;RELEASE CHANNEL
>; END IF TOPS-10
RETERR IE.IFU,X
;
;
FCPDEL: CALL GETFID ;GET THE FILE-ID OF THE THING HE WANTS US TO DELETE
LOAD T1,FILP1; ;GET EXTEND WORD
TXNE T1,BIT15 ;ENABLED (FOR TRUNCATE)?
JRST FCPZX ;YES-- DO NOTHING FOR TRUNCATE
HRRZ T1,FIDJFN(FID) ;GET THE JFN OF THE FILE TO DELETE
IF TOPS-20,<
DELF ;DELETE THE FILE
>; END IF TOPS-20
IF TOPS-10,<
CALL XCTUUP
LOOKUP FIDLEB(FID) ;LOOKUP THE FILE
RETERR IE.RER
SETZB T2,T3 ;RENAME TO ZERO= DELETE
CALL XCTUUO
RENAME T2 ;ZAP!!
>; END IF TOPS-10
RETERR IE.WER ;OOPS!
SETZM FIDJFN(FID) ;NO LONGER JFN'D
IF TOPS-10,<
CALL RELCHN ;RELEASE CHANNEL
>; END IF TOPS-10
JRST FCPZX ;RETURN HAPPY FROM DELETE
SUBTTL RVB, WVB -- READ/WRITE VIRTUAL BLOCK
;
;
FCPWVB: TXO F,F.WRIT ;NOTE WRITING
FCPRVB: CALL GETFID ;GET THE SPECIFIED FILE-ID
MOVE T4,FIDFLG(FID) ;GET THE FLAGS FOR THE FILE
TXNN T4,FI.ACC ;FILE OPEN?
RETERR IE.NLN
TXNN F,F.WRIT ;WRITING?
JRST FCPRW1 ;NO-- GO ON
TXNN T4,FI.WRT ;ACCESSED FOR WRITE?
RETERR IE.WAC
;
FCPRW1: HRRZ T1,FIDJFN(FID) ;GET THE JFN
LOAD P2,RWVBH; ;GET THE HIGH VBN
LSH P2,^D16 ;SHIFT TO HIGH WORD
LOAD T3,RWVBL; ;GET LOW VBN
IOR P2,T3 ;MUSH IT TOGETHER
SOJGE P2,FCPRW2 ;VIRTUAL BLOCKS START AT 1
RETERR IE.BLK,X
;
FCPRW2:
;
IF TOPS-20,<
ASH P2,^D9 ;CONVERT IT TO A BYTE OFFSET
TXNN T4,FI.ASC ;THIS 7-BIT ASCII?
ASH P2,-1 ;NO-- MAKE IT A WORD OFFSET
CAMN P2,FIDFBP(FID) ;ARE WE SET TO THE RIGHT POINT IN THE FILE?
JRST FCPRW3 ;YES-- GO ON
SFPTR ;NO-- SET THE POINTER
RETERR IE.RER
;
FCPRW3: LOAD P4,RWVSZ; ;GET THE BYTE SIZE REQUESTED
MOVE T3,P4 ;COPY THE COUNT
TXNE T4,FI.ASC ;7-BIT ASCII?
JRST FCPRWA ;YES-- PROCESS THAT
;
ADDI T3,1 ;ROUND UP
ASH T3,-1 ; SIZE TO WORDS
ADD P2,T3 ;COMPUTE WHERE POINTER WILL BE
MOVEM P2,FIDFBP(FID) ;SAVE THAT AS CURRENT POINTER
MOVN T3,T3 ;-VE BYTE COUNT: NOT ZERO TERMINATED STRING
TXNE F,F.WRIT ;THIS WRITE?
JRST FCPRW5 ;YES-- DO THAT
;
MOVE T2,[POINT 18,SCRBUF] ;NO-- POINT TO READ DATA AREA
CALL SINCLR ;INPUT THE DATA REQUESTED
JRST FCPP4X ;RETURN, BYTE COUNT IN P4
;
FCPRW5: MOVE T2,[PNTR (RWVDW0)] ;POINT TO DATA WORDS
SOUT ;WRITE THEM WORDS
JRST FCPZX ;RETURN NOTHING FROM FCPWVB
;
FCPRWA: ADD P2,T3 ;UPDATTE BYTE POINTER
MOVEM P2,FIDFBP(FID) ; AS CURRENT FILE BYTE POINTER
TXNE F,F.WRIT ;THIS WRITE?
JRST FCPWTA ;YES-- DO IT
;
MOVN T3,P4 ;GET -VE BYTE COUNT
MOVE T2,[POINT 7,DMPBUF] ;POINT TO DISTANT SCRATCH AREA
CALL SINCLR ;INPUT THE DATA REQUESTED
MOVE T1,[POINT 7,DMPBUF] ;GET POINTER TO FRESH DATA
MOVE T2,[PNTR (BYTE0,SCRBUF)] ;ALSO POINTER TO DATA TO STORE
MOVE T3,P4 ;GET BYTE COUNT TO CONVERT
CALL ASCBYT ;CONVERT 7-BIT TO 8-BIT ASCII
JRST FCPP4X ;RETURN, BYTE COUNT IN P4
;
FCPWTA: MOVE T1,[POINT 7,DMPBUF] ;POINT TO REMOTE SCRATCH
MOVE T2,[PNTR (RWVDB)] ;ALSO TO WHERE THE DATA IS
CALL BYTASC ;CONVERT THE 8-BITS TO 7-BITS
HRRZ T1,FIDJFN(FID) ;GET THE JFN BACK
MOVE T2,[POINT 7,DMPBUF] ;POINT TO FRASH DATA
MOVN T3,P4 ;GET -VE BYTE COUNT
SOUT ;WRITE THEM BYTES INTO THE FILE
JRST FCPZX ;RETURN NOTHING FROM FCPWVB
>; END IF TOPS-20
;
IF TOPS-10,<
MOVX P3,0 ;ASSUME BYTE OFFSET IS ZERO (I.E. BINARY FILE)
MOVX T2,^D4 ; WITH 4 BYTES/WORD
TXNN T4,FI.ASC ;ASCII FILE?
JRST FCPRW3 ;NO-- GO ON WITH BIANRY FILE
ASH P2,^D9 ;YES-- GET BYTES UP TO THIS VBN
IDIVI P2,200*^D5 ;GET # 1000 BYTE BLOCKS TO THIS VBN IN P2, BYTE OFFSET TO P3
MOVX T2,^D5 ;ASCII IS 5 BYTES/WORD
FCPRW3:
CAMN P2,FIDFBP(FID) ;ARE WE AT THE REQUESTED BLOCK?
JRST FCPRW4 ;YES-- NO NEED TO USET
CALL XCTUUO
USETI 1(P2) ;NO-- SET TO CURRENT BLOCK
FCPRW4:
LOAD P1,RWVSZ; ;GET TRANSFER SIZE IN BYTES
PUSH P,P1 ;SAVE THAT SIZE FOR LATER . . .
ADD P1,P3 ;ADD BYTE OFFSET TO DATA IN BLOCK
ADDI P1,-1(T2) ;ROUND UP
PUSH P,P2 ;SAVE BLOCK #
IDIV P1,T2 ; TO WORDS TO READ
POP P,P2 ;RESTORE BLOCK #
EXCH P1,P3 ;BYTE OFFSET TO P1, LENGTH IN WORDS TO P3
ADDI P3,200-1 ;ROUND UP
ASH P3,-^D7 ; TO NEXT BLOCK
MOVE T2,P2 ;GET CURRENT BLOCK #
ADD T2,P3 ;COMPUTE END BLOCK
MOVEM T2,FIDFBP(FID) ;STORE THE NEW BLOCK #
ASH P3,^D<7+18> ;GET # WORDS TO TRANSFER IN LH
MOVN P3,P3 ;-VE # WORDS
HRRI P3,DMPBUF-1 ; AND DATA ADDRESS-1 FORM IOWD
MOVX P4,0 ;END I/O LIST
;
TXNE T4,FI.ASC ;ASCII FILE?
JRST FCPRWA ;YES-- GO DO IT
TXNN F,F.WRIT ;WRITING FILE?
JRST FCPRDB ;NO-- READ BINARY FILE
;
; WRITE BINARY
;
POP P,T3 ;RESTORE BYTE COUNT
ADDI T3,1 ;ROUND UP
ASH T3,-1 ;CONVERT BYTES TO WORDS
MOVE T1,[PNTR (RWVDW0)] ;GET POINTER TO DATA TO BE WRITTEN
MOVE T2,[POINT 18,DMPBUF] ;ALSO WHERE TO MOVE IT TO
CALL MOVSTR ;MOVE IT
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
JRST FCPWTB ;FINISH WRITE
;
; READ BINARY
;
FCPRDB:
HRRI P3,SCRBUF-1 ;MAKE IOWD POINT TO SCRBUF
CALL XCTUUO
IN P3 ;INPUT REQUESTED DATA
SKIPA ;OK-- GO ON
RETERR IE.RER
JRST FCPRDX ;RETURN DATA TO FE
;
; READ/WRITE ASCII
;
FCPRWA:
TXNE F,F.WRIT ;WRITE FILE?
JRST FCPWTA ;YES-- DO IT
;
; READ ASCII
;
CALL INEOF ;INPUT DATA, IGNORE EOF
MOVE T3,(P) ;ALSO GET BYTE COUNT SAVED ON STACK
MOVE T1,P1 ;GET # BYTES IN BUFFER BEFORE ACTUAL DATA
ADJBP T1,[POINT 7,DMPBUF] ;MAKE POINTER TO ACTUAL USER DATA
MOVE T2,[PNTR (BYTE0,SCRBUF)] ;GET POINTER TO OUTPUT DATA BACK TO FE
CALL ASCBYT ;CONVERT 7-BIT ASCII TO 8-BIT HALFWORD FORMAT
FCPRDX:
POP P,P4 ;RESTORE BYTE COUNT
JRST FCPP4X ;RETURN DATA TO FE
;
; WRITE ASCII
;
FCPWTA:
CALL INEOF ;INPUT DATA, IGNORE EOF
POP P,T3 ;RESTORE BYTE COUNT
MOVE T1,P1 ;GET # BYTES IN BUFFER BEFORE ACTUAL DATA
ADJBP T1,[POINT 7,DMPBUF] ;MAKE POINTER TO ACTUAL USER DATA
MOVE T2,[PNTR (RWVDB)] ;GET POINTER TO INPUT DATA IN 8-BIT FORMAT
CALL BYTASC ;CONVERT 8-BIT TO 7-BIT ASCII
HRRZ T1,FIDJFN(FID) ;GET CHANNEL #
CALL XCTUUO
USETO 1(P2) ;SET OUTPUT BLOCK #
FCPWTB:
CALL XCTUUO
OUT P3 ;WRITE OLD AND NEW DATA BACK
SKIPA ;OK-- GO ON
RETERR IE.WER
JRST FCPZX ;RETURN COMPLETE TO -11 FROM FCPWVB
;
>; END IF TOPS-10
SUBTTL RAT -- READ FILE ATTRIBUTES
;
; NOTE THIS IS ALSO CALLED FROM ACCESS, BYTE COUNT PRESERVED IN P4
;
FCPRAT: CALL GETFID ;VERIFY THE USER'S FILE-ID
CALL MAKHDR ;MAKE A FAKE HEADER BLOCK
MOVE P1,[PNTR (FILAT0)] ;POINT TO ATTRIBUTE CONTROL BLOCK
MOVE P2,[POINT 18,ATTRCB] ;ALSO POINT TO SCRATCH AREA
FCPRA0: ILDB T1,P1 ;GET A WORD
IDPB T1,P2 ;SAVE IT
TXNE T1,BIT7 ;DONE?
JRST FCPRA0 ;NO-- SAVE SOME MORE
;
MOVE P1,[POINT 18,ATTRCB] ;POINT TO START
MOVE P2,[POINT 18,SCRBUF] ;ALSO POINT TO OUTPUT BUFFER
SETZ P4, ;START BYTE COUNT AT ZERO
;
FCPRA1: ILDB T1,P1 ;GET A CONTROL WORD
IDPB T1,P2 ;STORE IN OUTPUT, ALSO
ADDI P4,2 ;BUMP BYTE COUNT
SETZ T2, ;START WITH ZERO SIZE
ROTC T1,^D<36-8> ;GET THE SIZE FROM HIGH BYTE INTO T2
ASH T1,^D<8-36> ; AND SIGN-EXTEND FUNCTION INTO T1
JUMPGE T1,FCPP4X ;ALL DONE IF ZERO (NO +VE FUNCTIONS FOR READ)
MOVN T1,T1 ;MAKE +VE FUNCTION
CAILE T1,ATRMAX ;TOO BIG??
RETERR IE.RER
MOVE T1,ATRPTR-1(T1) ;GET BYTE POINTER TO REQUESTED ATTRIBUTES
SKIPN T2 ;SIZE= 0?
MOVEI T2,1K ;YES-- IMPLIES WHOLE BLOCK
ADDI T2,1 ;ROUND
ASH T2,-1 ; UP TO WORDS
;
FCPRA4: LDB C,T1 ;GET A WORD
IBP T1 ;NOW BUMP THE POINTER
IDPB C,P2 ;SEND TO OUTPUT
ADDI P4,2 ;BUMP BYTE COUNT
SOJG T2,FCPRA4 ;LOOP FOR ALL SUCH ATTRIBUTES
JRST FCPRA1 ;BACK FOR ANOTHER ATTRIBUTE
SUBTTL WAT -- WRITE ATTRIBUTES
;
;
FCPWAT: CALL GETFID ;CHECK OUT THE FILE-ID
CALL CLRHDR ;START WITH A CLEAR HEAD
MOVE P1,[PNTR (FILAT0)] ;POINT TO ATTRIBUTE CONTROL LIST
;
FCPWA1: ILDB T1,P1 ;GET AN ATTRIBUTE WORD
SETZ T2, ;CLEAR SIZE WORD
ROTC T1,^D<36-8> ;SHIFT SIZE INTO T2
ASH T1,^D<8-36> ;SIGN-EXTEND FUNCTION BYTE IN T1
JUMPLE T1,FCPZX ;DONE IF ZERO (-VE FUNCTIONS ONLY FOR READ)
CAILE T1,ATRMAX ;TO BIG?
RETERR IE.RER
MOVE T1,ATRPTR-1(T1) ;GET POINTER TO DATA IN HEADER
SKIPN T2 ;SIZE= 0?
MOVEI T2,1K ;YES-- IMPLIES WHOLE BLOCK
ADDI T2,1 ;ROUND
ASH T2,-1 ; UP TO WORDS
;
FCPWA4: ILDB C,P1 ;GET AN INPUT BYTE
DPB C,T1 ;STORE IN HEADER
IBP T1 ; THEN BUMP THE POINTER
SOJG T2,FCPWA4 ;LOOP FOR ALL THE WORDS
JRST FCPWA1 ;NOW BACK FOR ANOTHER ATTRIBUTE
;
; ATTRIBUTE CONTROL POINTERS
;
ATRPTR: PNTR (H.FOWN) ;(1) FILE OWNER
PNTR (H.FPRO) ;(2) FILE PROTECTION
PNTR (H.CHAR) ;(3) FILE CHARACTERISTICS
PNTR (H.UFAT) ;(4) USER'S FILE ATTRIBUTES
PNTR (I.FNAM) ;(5) FILE NAME
PNTR (I.FTYP) ;(6) FILE TYPE
PNTR (I.FVER) ;(7) FILE VERSION NUMBER
PNTR (I.EDTW) ;(8) EXPIRATION DATE
POINT 18,STSBLK,17 ;(9) STATISTICS BLOCK
POINT 18,FILHDR,17 ;(10) ENTIRE FILE HEADER
ATRMAX==^D10 ;MAX
SUBTTL APC -- ACP CONTROL FUNCTIONS
;
; FUNCTIONS MOUNT, DISMOUNT: BOTH MERELY CLEAN UP FILE DATA BASE
;
FCPAPC: MOVEI FID,FIDTAB ;POINT TO FID TABLE
;
FCPAP1: SKIPN T1,FIDJFN(FID) ;THIS FILE GOT A JFN?
JRST FCPAP3 ;NO-- JUST CLEAN UP
HRRZ T1,T1 ;JUST THE JFN
IF TOPS-20,<
CLOSF ;CLOSE ANY OPEN FILE
JFCL
>; END IF TOPS-20
IF TOPS-10,<
CALL RELCHN ;RELEASE CHANNEL
>; END IF TOPS-10
;
FCPAP3: SETZM FIDUCT(FID) ;CLEAR
SETZM FIDFLG(FID) ; IMPORTANT
SETZM FIDJFN(FID) ; WORDS
ADDI FID,FIDSIZ ;BUMP TO NEXT FILE-ID
CAIGE FID,FIDTBE ;BEYOND END?
JRST FCPAP1 ;NO-- BACK FOR ANOTHER
;
SETZB T1,USECNT ;RESET GLOBAL USE COUNT
RETURN ;RETURN FROM APC, NO DATA
SUBTTL FILE HEADER SUBROUTINES
;
; MAKHDR -- MAKE A FILE HEADER AND STATISTICS BLOCK
;
MAKHDR: CALL CLRHDR ;START WITH A CLEAR HEAD
IF TOPS-20,<
CALL GETFDB ;GET THE FDB FOR THIS FILE
>; END IF TOPS-20
MOVEI T1,27027 ;MAGIC
STOR T1,H.IDOF; ; . .
HLRZ T1,FIDFID(FID) ;GET FILE NUMBER
STOR T1,H.FNUM; ; . .
HRRZ T1,FIDFID(FID) ;AND SEQ #
STOR T1,H.FSEQ; ; . .
MOVE T1,FIDUIC(FID) ;ALSO GET UIC
STOR T1,H.FOWN; ;
;
SETZ T1, ;START WITH ALL ACCESS
IF TOPS-20,<
MOVE T3,[POINT 6,FILFDB+.FBPRT,17] ;POINT TO PROTECTION FIELDS
>; END IF TOPS-20
IF TOPS-10,<
MOVE T3,[POINT 3,FIDLEB+.RBPRV(FID)] ;POINT TO PROTECTION FIELDS
>; END IF TOPS-10
MOVEI T4,3 ;THREE OF THEM
MAKHD1: ILDB T2,T3 ;GET A CODE
IF TOPS-20,<
LSH T2,-2 ;ONLY FOUR HIGH BITS
>; END IF TOPS-20
MOVE T2,PROTAB(T2) ;CONVERT THE PROTECTION
ROTC T1,-4 ;SHIFT THE BITS INTO HIGH PART OF T1
SOJG T4,MAKHD1 ;LOOP FOR ALL THE BITS
;
LSH T1,^D<16-36> ;SHIFT DOWN INTO LOW BITS
STOR T1,H.FPRO; ;STORE THE PROTECTION
;
MOVE T1,[POINT 18,FIDNAM(FID)] ;POINT TO START OF FILE NAME
MOVE T2,[PNTR (I.FNM0)] ;AND TO WHERE TO PUT IT
CALL MOVNAM ;MOVE THE WHOLE FILE-NAME NOW
;
IF TOPS-20,<
HLRZ T1,FILFDB+.FBCNT ;GET # WRITES
STOR T1,I.RVNO; ;# REVISIONS
>; END IF TOPS-20
;
MOVE T2,[PNTR (I.RVDT)] ;POINT TO REVISION DATE,TIME, CREATION DATE,TIME
IF TOPS-20,<
MOVE T1,FILFDB+.FBWRT ;GET DATE/TIME OF LAST WRITE (REVISION)
>; END IF TOPS-20
IF TOPS-10,<
LDB T1,[POINT 15,FIDLEB+.RBEXT(FID),35] ;GET LAST ACCESS DATE
>; END IF TOPS-10
CALL BYTDTM ;STORE THE STRING IN THE HEADER
IF TOPS-20,<
MOVE T1,FILFDB+.FBCRV ;GET DATE/TIME OF CREATION
>; END IF TOPS-20
IF TOPS-10,<
LDB T1,[POINT 12,FIDLEB+.RBPRV(FID),35] ;GET LOW ORDER 12 BITS OF CREATION DATE
LDB T3,[POINT 3,FIDLEB+.RBEXT(FID),20] ;GET HIGH ORDER THREE BITS . . .
DPB T3,[POINT 3,T1,35-12] ;STORE THEM . . .
LDB T3,[POINT 11,FIDLEB+.RBPRV(FID),23] ;GET CREATION TIME
HRL T1,T3 ;PUT TIME IN LH, DATE IN RH
>; END IF TOPS-10
CALL BYTDTM ;CONVERT TO 8-BIT ASCII
;
MOVE T3,FIDFLG(FID) ;GET THE FILE FLAGS
MOVE T4,[PNTR (H.UFAT)] ;POINT TO USER ATTRIBUTES
MOVEI T1,1002 ;RECORD TYPE: VARIABLE
TXNE T3,FI.ASC ;ASCII (IMAGE ASCII) FILE?
MOVEI T1,1 ;YES-- RECORDS ARE FIXED LENGTH (UNFORMATTED)
DPB T1,T4 ; . .
MOVEI T1,1000 ;RECORD SIZE: 1000
IDPB T1,T4 ; . .
;
IF TOPS-20,<
HRRZ T1,FILFDB+.FBBYV ;# PAGES
ASH T1,2 ;CONVERT TO BLOCKS
>; END IF TOPS-20
IF TOPS-10,<
MOVE T1,FIDLEB+.RBALC(FID)
SUBI T1,2 ;MINUS THE PRIME AND SPARE
>; END IF TOPS-10
MOVEI T2,4 ;ASSUME BINARY (4 BYTES/WORD)
TXNN T3,FI.ASC ;ASCII FILE?
JRST MAKHD5 ;NO-- OK
MOVEI T2,5 ;YES-- 5 BYTES/WORD
IMULI T1,5 ;COMPUTE
ASH T1,-2 ; BLOCKS IN ASCII
MAKHD5: ROT T1,-^D16 ;GET THE HIGH PART OF BLOCK SIZE FIRST
IDPB T1,T4 ;SAVE IN USER ATTRIBUTES
HRLZM T1,STSBLK+1 ;ALSO IN STATISTICS BLOCK
ROT T1,^D16 ;RESTORE THE LOW ORDER BITS
IDPB T1,T4 ;SAVE . .
HRRM T1,STSBLK+1 ; BOTH WAYS
;
IF TOPS-20,<
MOVE T1,FILFDB+.FBSIZ ;GET FILE SIZE IN BYTES TO EOF
IMUL T1,T2 ;*BYTES/WORD = SIZE*(BYTES/WORD)
LDB T3,[POINT 6,FILFDB+.FBBYV,11] ;BYTE SIZE
MOVEI T2,^D36 ;COMPUTE
IDIV T2,T3 ; BYTES/WORD
ADDI T1,-1(T2) ;ROUND UP
IDIV T1,T2 ; TO 4/5 BYTES/WORD
>; END IF TOPS-20
IF TOPS-10,<
MOVE T1,FIDLEB+.RBSIZ(FID) ;GET SIZE IN WORDS
IMUL T1,T2 ;CONVERT TO BYTES
>; END IF TOPS-10
IDIVI T1,1000 ;GET LAST BLOCK NUMBER
ADDI T1,1 ;VBN'S ALWAYS START WITH ONE
ROT T1,-^D16 ;GET HIGH PART FIRST
IDPB T1,T4 ;SAVE IN ATTRIBUTES
ROT T1,^D16 ;BACK TO LOW PART
IDPB T1,T4 ;STORE THAT TOO....
IDPB T2,T4 ;ALSO SAVE WHICH BYTE IN LAST BLOCK IS EOF
RETURN ;FROM MAKHDR
;
; PROTAB -- PROTECTION CORRESPONDENCE TABLE
; BITS ARE IN THE ORDER DELETE, EXTEND, WRITE, READ:
; A "1" MEANS THAT SUCH ACCESS IS DENIED;
; A "0" MEANS THAT SUCH ACCESS IS ALLOWED.
; TABLE IS INDEXED BY TOPS-10/TOPS-20 PROTECTION CODE
;
PROTAB:
IF TOPS-20,<
RADIX 2
EXP 1111,1011,0111,0011,1101,1001,0101,0001
EXP 1110,1010,0110,0010,1100,1000,0100,0000
RADIX 8
>; END IF TOPS-20
IF TOPS-10,<
RADIX 2
EXP 0000,0000,1000,1000,1010,1110,1111,1111
RADIX 8
>; END IF TOPS-10
;
; CLRHDR -- CLEAN THE FILE HEADER FOR NEW DATA
;
CLRHDR: SETZM FILHDR+0 ;CLEAR FIRST WORD
MOVE T1,[XWD FILHDR+0,FILHDR+1] ;BLT POINTER TO CLEAR
BLT T1,FILHDE-1 ;DOWN TO THE END
RETURN ;WASHED UP FROM CLRHDR
SUBTTL FILE-ID SUBROUTINES
;
; ALCFID -- ALLOCATE A FILE-ID BLOCK
; T1 -- JFN WORD OF FILE NEEDING AN ID
;
ALCFID: MOVEI T3,FIDTAB ;POINT TO TABLE OF FILE-ID'S
SETZ FID, ;FLAG NO FREE ONE FOUND
HRLOI T4,377777 ;START WITH USE COUNT OF INFINITY
;
ALCFI1: SKIPE FIDJFN(T3) ;THIS FILE-ID IN USE?
JRST ALCFI2 ;YES-- SEE IF ACCESSED
MOVE FID,T3 ;NO-- THIS IS THE ONE
JRST ALCFI4 ;SO USE IT
;
ALCFI2: MOVE T2,FIDFLG(T3) ;GET FLAGS WORD
TXNN T2,FI.ACC ;ACCESSED?
CAMG T4,FIDUCT(T3) ; OR NOT LOWEST USE COUNT?
JRST ALCFI3 ;YES-- SKIP IT
MOVE T4,FIDUCT(T3) ;LOWEST USE COUNT SO FAR-- GET IT
MOVE FID,T3 ;SAVE THIS FILE-ID
;
ALCFI3: ADDI T3,FIDSIZ ;BUMP TO NEXT FILE-ID
CAIGE T3,FIDTBE ;PAST END YET?
JRST ALCFI1 ;NO-- LOOK AT ANOTHER
;
JUMPN FID,ALCFI4 ;GOT FID-- GO ON
RETERR IE.NOD,X
;
ALCFI4: MOVX T1,0 ;RESET JFN
EXCH T1,FIDJFN(FID) ;STORE THE JFN, GET OLD ONE
JUMPE T1,ALCFI5 ;NO PREVIOUS JFN-- GO ON
HRRZ T1,T1 ;GET JUST THE JFN
IF TOPS-20,<
RLJFN ;RELEASE IT
JFCL ;SO SORRY
>; END IF TOPS-20
IF TOPS-10,<
CALL RELCHN ;RELEASE CHANNEL
>; END IF TOPS-10
;
ALCFI5: MOVE T1,FID ;COPY FID BLOCK ADDR
SUBI T1,FIDTAB-FIDSIZ ;MAKE IT
IDIVI T1,FIDSIZ ; A NUMBER OF A FILE-ID
AOS FIDFID(FID) ;BUMP THE SEQUENCE #
HRLM T1,FIDFID(FID) ;STORE THE FILE-ID
SETZM FIDFLG(FID) ;RESET THE FLAG WORD
CALLR SETUCT ;SET USE COUNT AND RETURN FROM ALCFID
;
; GETFID -- GET AN EXISTING FILE-ID AND VERIFY IT
;
GETFID: LOAD T1,FILID; ;GET THE USER-SPECIFIED FILE-ID
HLRZ FID,T1 ;GET THE FILE-ID NUMBER
IMULI FID,FIDSIZ ;MAKE IT AN OFFSET
ADDI FID,FIDTAB-FIDSIZ ; INTO FILE-ID TABLE
CAIGE FID,FIDTBE ;BEYOND END?
CAME T1,FIDFID(FID) ;NO-- NO MATCH?
RETERR IE.SQC ;THAT'S-A-NO-GOOD
SKIPN FIDJFN(FID) ;GET THE JFN IF ANY
RETERR IE.RER ;BROKEN
CALLRX SETUCT ;SET USE COUNT AND RETURN FROM GETFID
;
; SETUCT -- UPDATE USE COUNT FOR CURRENT FILE-ID
;
SETUCT: AOS T1,USECNT ;UPDATE GLOBAL USE COUNT
MOVEM T1,FIDUCT(FID) ;SET IT
RETURN ;FROM SETUCT
SUBTTL FILE-NAME SUBROUTINES
;
; GETNAM -- GET ASCIZ FILENAME IN FNMBLK FROM RAD50 FILENAME IN FNB
;
GETNAM:
IF TOPS-10,<
CALL CLRFNM ;RESET FILE-NAME BLOCK
>; END IF TOPS-10
MOVX P3,0 ;START WITH NO WILDS
LOAD T2,N.DID; ;GET THE DIRECTORY ID
TLZN T2,BIT15 ;IS THIS REALLY A DIRECTORY?
RETERR IE.SNC ;SORRY-- YOU CAN'T REMEMBER WHAT I TOLD YOU
MOVEI P4,UICTAB ;POINT TO TABLE OF DIRECTORIES
IF TOPS-20,<
MOVE T1,[POINT 7,FNMBLK] ;POINT TO FILE-NAME BLOCK
MOVEI C,74 ;START DIRECTORY OFF RIGHT
IDPB C,T1 ; . .
CAIGE T2,340B<35-8> ;THIS UIC GREATER THAN [340,0]?
JRST GETNM2 ;NO-- SCAN THE TABLE
SUBI T2,340B<35-8> ;YES-- CONVERT IT TO A DIRECTORY NUMBER
DIRST ;GET THE STRING
RETERR IE.RER ;ALREADY CHECKED OUT-- OOPS
JRST GETN35 ;OK-- STORE THE WIDGET
>; END IF TOPS-20
;
GETNM2: SKIPN T3,UICSIZ(P4) ;GET A DIRECTORY TABLE ENTRY
RETERR IE.SQC ;SORRY NO SUCH DIRECTORY
CAMN T2,UICUIC(P4) ;MATCH?
JRST GETNM3 ;YES-- GOT IT
ADD P4,T3 ;BUMP TO NEXT ENTRY
JRST GETNM2 ;BACK FOR ANOTHER
;
GETNM3:
IF TOPS-20,<
HRROI T2,UICNAM(P4) ;GET ADDRESS OF STRING
SETZ T3, ;STRING IS ASCIZ
SOUT ;PUT THE STRING AWAY
;
GETN35: MOVEI C,76 ;GET THE CLOSING WIDGET
IDPB C,T1 ;STORE IN FILE-NAME
>; END IF TOPS-20
IF TOPS-10,<
MOVE T1,UICSTR(P4) ;GET STR NAME FOR THIS UIC
CAIN T1,0 ;ALL: ?
TXO P3,FJ.ALL ;YES-- NOTE THAT
CAIN T1,1 ;DSK: ?
TXO P3,FJ.DSK ;YES-- NOTE THAT
MOVEM T1,FIDSTR(FID) ;SET STR NAME
MOVE T1,UICPPN(P4) ;GET P,PN OF DIRECTORY
IFN FTPATH,<
SKIPE UICSFD(P4) ;IS THERE ANY PATHS SPEC?
MOVEI T1,UICPTH(P4) ;YES-- GET PATH BLOCK ADDRESS INSTEAD
>; END IFN FTPATH
MOVEM T1,FIDLEB+.RBPPN(FID) ;STORE DIRECTORY POINTER
MOVE T1,[POINT 6,FIDLEB+.RBNAM(FID)] ;POINT TO FILE NAME IN SIXBIT
>; END IF TOPS-10
;
MOVE P2,[PNTR (N.FNM0)] ;GET POINTER TO START OF RAD50 FILE-NAME
MOVEI P1,3 ;THREE WORDS
LOAD P4,N.STAT; ;GET FILE FLAGS
TXNE P4,NB.SNM ;WILD NAME?
JRST GETNM5 ;YES-- GET IT
;
GETNM4: ILDB T2,P2 ;NO-- GET A RAD50 WORD
IF TOPS-10,<
CAIE P1,1 ;IGNORE LAST THREE CHARS
>; END IF TOPS-10
CALL R50ASC ;CONVERT IT TO ASCII
SOJG P1,GETNM4 ;DO THREE WORDS
JRST GETNM6 ;ON TO FILE TYPE
;
GETNM5:
IF TOPS-20,<
MOVEI C,"*" ;GET A STAR
IDPB C,T1 ;STORE IT
>; END IF TOPS-20
TXO P3,FJ.WLN ;NOTE WILD NAME
GETN51: IBP P2 ;SKIP OVER
SOJG P1,GETN51 ; FILE-NAME
;
GETNM6:
IF TOPS-20,<
MOVEI C,"." ;DO A
IDPB C,T1 ; . BETWEEN FILE AND TYPE
>; END IF TOPS-20
IF TOPS-10,<
MOVE T1,[POINT 6,FIDLEB+.RBEXT(FID)]
>; END IF TOPS-10
ILDB T2,P2 ;GET THE TYPE
TXNE P4,NB.STP ;WILD TYPE?
JRST GETNM7 ;YES-- DO IT
CALL R50ASC ; INTO ASCII
JRST GETNM8 ;ON TO VERSION
;
GETNM7:
IF TOPS-20,<
MOVEI C,"*" ;GET A STAR
IDPB C,T1 ;STORE IT
>; END IF TOPS-20
TXO P3,FJ.WLT ;NOTE WILD TYPE
;
GETNM8:
IF TOPS-20,<
ILDB T2,P2 ;GET THE VERSION
TXNN P4,NB.SVR ;WILD VERSION?
JUMPE T2,GETNMX ;VERSION ZERO-- DON'T PUT ANYTHING IN STRING
MOVEI C,"." ;PUNTUATE
IDPB C,T1 ; THE VERSION
TXNE P4,NB.SVR ;WILD VERSION?
JRST GETNM9 ;YES-- DO IT
TXNN T2,BIT15!BIT14 ;THIS A FUNNY (-VE) VERSION?
TXZN T2,BIT13 ;NO-- IS IT A TEMP VERSION (20000+N)?
JRST GETN82 ;NO-- GO ON
ADDI T2,^D100000 ;YES-- MAKE IT A TEMP VERSION
JRST GETN83 ;AND DON'T SIGN-EXTEND IT
;
GETN82: LSH T2,^D<36-16> ;SIGN
ASH T2,^D<16-36> ; EXTEND THE NUMBER
;
GETN83: MOVX T3,^D10 ;VERSION IS IN DECIMAL
NOUT ;MAKE A NUMBER
RETERR IE.BVR
JRST GETNMX ;JUST ABOUT DONE
;
GETNM9: MOVEI C,"*" ;GET A STAR
IDPB C,T1 ;STORE IT
TXO P3,FJ.WLG ;NOTE WILD GENERATION
;
GETNMX: MOVEI C,0 ;MAKE THE STRING
IDPB C,T1 ; ASCIZ
HRROI T2,FNMBLK ;POINT TO THE NAME STRING
>; END IF TOPS-20
MOVE T1,P3 ;GET THE WILD FLAGS BACK
RETURN ;FROM GETNAM
;
; PUTNAM -- PUT FILENAME FROM FNMBLK (IN ASCIZ) INTO FNB FOR RETURN
; RETURNS +1 IF BAD (TOO LONG) NAME,
; +2 IF OK
;
PUTNAM: MOVE P2,[PNTR (N.FNM0)] ;POINT TO FILE-NAME
IF TOPS-20,<
MOVE T1,[POINT 7,FNMBLK] ;ALSO TO WHERE TO GET IT FROM
>; END IF TOPS-20
IF TOPS-10,<
MOVE T1,[POINT 6,FIDLEB+.RBNAM(FID)]
>; END IF TOPS-10
MOVEI P1,3 ;DO THREE WORDS OF FILE-NAME
;
PUTNM2: CALL ASCR50 ;CONVERT THREE CHARS TO RAD50
IF TOPS-10,<
RETURN ;BAD CHAR IN NAME
CAIG P1,2 ;END OF NAME?
>; END IF TOPS-10
JRST PUTNM3 ;END OF NAME-- ON TO EXTENSION
IDPB T2,P2 ;STORE THE NAME WORD
SOJG P1,PUTNM2 ;LOOP FOR THREE CHARS
IF TOPS-20,<
ILDB C,T1 ;GET THE TERMINATING CHARACTER
>; END IF TOPS-20
JRST PUTNM4 ;ON TO GET EXT
;
PUTNM3: IDPB T2,P2 ;STORE LAST PARTIAL WORD
SETZ T2, ;NOW CLEAR REMAINING WORDS
SOJG P1,PUTNM3 ;LOOP FOR ALL THEM EXTRA WORDS
;
PUTNM4:
IF TOPS-20,<
CAIE C,"." ;IS THIS END OF FILE-NAME?
RETURN ;NO-- SORRY, IT SHOULD BE
>; END IF TOPS-20
CALL ASCR50 ;YES-- CONVERT THE FILE TYPE
SKIPA ;SHORT-- GOT TERMINATOR
IF TOPS-20,<
ILDB C,T1 ;GET TERMINATOR
CAIE C,"." ;START OF VERSION?
RETURN ;NO-- ERROR
>; END IF TOPS-20
IDPB T2,P2 ;STORE THE FILE TYPE
IF TOPS-20,<
MOVEI T3,^D10 ;VERSION IS IN DECIMAL
NIN ;GET THE VERSION #
RETURN ;BAD VERSION #
CAIGE T2,BIT13 ;TOO BIG FOR -11 TO HANDLE?
JRST PUTNM5 ;NO-- STORE IT
CAIGE T2,^D100000 ;TEMP VERSION #?
RETURN ;NO-- VERSION TOO BIG
SUBI T2,^D100000 ;YES-- GET THE JOB #
TXO T2,BIT13 ;MARK AS A TEMP VERSION #
>; END IF TOPS-20
IF TOPS-10,<
SETZ T2, ;ALWAYS ZERO
>; END IF TOPS-10
;
PUTNM5: IDPB T2,P2 ;STORE THE VERSION #
RETSKP ;YES-- ALL OK
;
; GETTMP -- GET A TEMP FILE JFN
; RETURNS JFN IN T1
;
GETTMP:
IF TOPS-20,<
MOVX T1,GJ%SHT!GJ%NEW!GJ%FOU!GJ%TMP+.GJNHG
HRROI T2,[ASCIZ/FRONT-END-TEMP-FILE.TMP/]
GTJFN ;GET THE JFN OF THE TEMP FILE
RETERR IE.IFU
>; END IF TOPS-20
IF TOPS-10,<
CALL CLRFNM ;CLEAR FILENAME BLOCK
AOS T2,TMPFIL ;GET CURRENT TEMP FILE NUMBER
CALL OCTSIX ;CONVERT TO SIXBIT
HRRI T3,'FE ' ;MAKE 000FE.TMP NAME
MOVEM T3,FIDLEB+.RBNAM(FID) ;STORE NAME
MOVSI T1,'TMP' ;MAKE TEMP FILE
MOVEM T1,FIDLEB+.RBEXT(FID) ;AND TYPE
>; END IF TOPS-10
RETURN ;FROM GETTMP
;
IF TOPS-10,<
;
; CLRFNM -- CLEAR LOOKUP/ENTER BLOCK AREA OF FID BLOCK
;
CLRFNM:
MOVSI T1,FIDLEB(FID) ;GET START OF BLOCK
HRRI T1,FIDLEB+1(FID) ; AND NEXT WORD . . .
SETZM FIDLEB(FID)
BLT T1,FIDLEB+.RBALC(FID)
MOVEI T1,.RBALC ;ALL PARAMETERS UP TO .RBALC
MOVEM T1,FIDLEB+.RBCNT(FID) ;SAVE THAT
RETURN ;FROM CLRFNM
;
>; END IF TOPS-10
;
; CHKTYP -- SEE IF FILE TYPE (FROM FILE-ID BLOCK) IS BINARY FILE
; RETURNS +1 IF NOT BINARY FILE TYPE
; +2 IF BINARY FILE TYPE, I.E. ONE OF:
; ABS, BIN, LDA, OBJ, OLB, SML, STB, SYS, TSK
;
CHKTYP: HRRZ T1,FIDTYP(FID) ;GET FILE TYPE, IN RAD50
MOVSI T2,-BINLEN ;AOBJN POINTER TO BINTAB
CHKTY1:
CAMN T1,BINTAB(T2) ;THIS MATCH BINARY FILE TYPE?
RETSKP ;YES-- RETURN +2
AOBJN T2,CHKTY1 ;NO-- LOOK FOR ALL BINARY FILE TYPES
RETURN ;NOT BINARY-- RETURN +1
;
; TABLE OF RAD50 BINARY FILE TYPES
;
BINTAB:
.RAD50 <ABS,BIN,LDA,OBJ,OLB,SML,STB,SYS,TSK,EXB>
BINLEN==.-BINTAB
;
; MOVNAM -- MOVE FILENAME, TYPE AND VERSION
; T1 -- SOURCE POINTER
; T2 -- DESTINATION POIINTER
;
MOVNAM: MOVEI T3,5 ;FILENAME (3) TYPE (1) VER (1)
CALLRX MOVSTR ;MOVE THE STRING
;
; MOVSTR -- MOVE A STRING
; T1 -- SOURCE POINTER
; T2 -- DESTINATION POINTER
; T3 -- BYTE COUNT
;
MOVSTR: ILDB C,T1 ;GET A CHARACTER
IDPB C,T2 ;STORE IT
SOJG T3,MOVSTR ;LOOP FOR ALL OF THEM
RETURN ;FROM MOVSTR
SUBTTL CONVERSION SUBROUTINES
;
; BYTDTM -- CONVERT A DATE/TIME WORD TO 8-BIT ASCII BYTE STRING (13 BYTES)
; T1 -- DATE/TIME TO BE CONVERTED
; T2 -- 8-BIT BYTE POINTER TO WHERE TO STORE THE DATA
; RETURNS T2 UPDATED
;
BYTDTM: PUSH P,T2 ;SAVE THE POINTER TO STORE
MOVE T2,T1 ;COPY THE DATE/TIME
MOVE T1,[POINT 7,DATBUF] ;POINT TO SCRATCH AREA
IF TOPS-20,<
MOVX T3,0 ;COLUMNATTED FLAVOR
ODTIM ;CONVERT TO STRING
MOVE T1,[POINT 7,DATBUF] ;BACK TO BEGINNING
MOVE T2,T1 ;ALSO FOR OUTPUT, REMOVING THE TRASH
MOVE T3,[POINT 3,[BYTE (3) 2,3,2,2,2,2,0]] ;POINTER TO FIELD SIZES
;
BYTDT1: ILDB T4,T3 ;GET SIZE OF NEXT FIELD
JUMPE T4,BYTDT3 ;DONE-- CONVERT TO 8-BIT
BYTDT2: ILDB C,T1 ;GET A CHARACTER FROM ORIGINAL STRING
IDPB C,T2 ;STORE IN OUTPUT STRING
SOJG T4,BYTDT2 ;LOOP FOR ENTIRE FIELD SIZE
IBP T1 ;END OF FIELD-- SKIP SEPERATOR
JRST BYTDT1 ;GET NEXT FIELD, IF ANY
>; END IF TOPS-20
IF TOPS-10,<
CALL ASCDAT ;CONVERT DAT TO ASCII
>; END IF TOPS-10
;
BYTDT3: MOVE T1,[POINT 7,DATBUF] ;BACK TO THE START OF THE STRING
POP P,T2 ;RESTORE THE POINTER TO THE 8-BIT STRING
MOVEI T3,^D13 ;13 BYTES OF DATE/TIME
CALLRX ASCBYT ;CONVERT THE 7-BIT STRING TO 8-BIT
;
; ASCBYT -- CONVERT 7-BIT ASCII STRING TO 8-BIT BYTE -11 STYLE STRING
; BYTASC -- CONVERT STRING FROM -11 STYLE 8-BIT BYTES TO 7-BIT ASCII
; T1 -- BYTE POINTER TO 7-BIT ASCII STRING
; T2 -- BYTE POINTER TO 8-BIT DATA (POINTS TO FIRST DATA BYTE)
; T3 -- BYTE COUNT
; UPDATES EVERYTHING, USES T1-T4, P1, C
;
ASCBYT: TDZA P1,P1 ;POINT TO ASCII-BYTE CONVERSIONS
BYTASC: MOVEI P1,2 ;POINT TO BYTE-ASCII CONVERSIONS
MOVE T4,T2 ;COPY 8-BIT POINTER
LSH T4,^D<3-36> ;DOWN TO HIGH THREE BITS
TXC T4,1 ;MAKE BYTES 3,2,1,0 IN WORD
;
ASCBY1: SOJL T3,ASCBYX ;DONE IF BYTE COUNT DOWN
XCT BYTINS+0(P1) ;EXECUTE THE LDB/ILDB
XCT BYTINS+1(P1) ;EXECUTE THE IDPB/DPB
SOJGE T4,ASCBY1 ;BUMP POINTER INTO POINTERS
MOVEI T4,3 ;DOWN TO NEXT WORD-- RESET THE COUNT
AOJA T2,ASCBY1 ; AND INCREMENT THE ADDRESS
;
ASCBYX: HLL T2,BYTPTR(T4) ;SET NEW BYTE POINTER BITS IN UPDATED POINTER
TXZ T2,17B17 ;ZERO THE INDEX FIELD
RETURN ;THAT'S IT FOR BYTASC/ASCBYT
;
BYTINS: ILDB C,T1 ;(ASCBYT) GET 7-BIT BYTE
DPB C,BYTPTR(T4) ;(ASCBYT) STORE 8-BIT BYTE
LDB C,BYTPTR(T4) ;(BYTASC) GET 8-BIT BYTE
IDPB C,T1 ;(BYTASC) STORE 7-BIT BYTE
;
BYTPTR: PNTR BYTE3,0(T2)
PNTR BYTE2,0(T2)
PNTR BYTE1,0(T2)
PNTR BYTE0,0(T2)
;
; R50ASC -- CONVERT THREE CHARACTERS FROM RAD50 TO ASCII
; T1 -- POINTER TO ASCIZ OUTPUT STRING
; T2 -- RAD50 WORD (16 BITS) TO CONVERT
; RETURNS +1, T1 UPDATED
;
R50ASC: JUMPE T2,CRET ;IF NULL-- GIVE UP NOW!
IDIVI T2,50 ;TRIM OFF LOW CHARACTER
HRLM T3,(P) ;SAVE IT ON STACK
SKIPE T2 ;END OF TEXT?
CALL R50ASC ;NO-- TRY AGAIN FOR ANOTHER CHAR
;
HLRZ T2,(P) ;GET A CHARACTER BACK
SETZ T3, ;START OUT TABLE PONTER
;
R50AS2: CAMGE T2,R50TB1(T3) ;DOWN TO MATCH YET?
AOJA T3,R50AS2 ;NO-- LOOK SOME MORE
ADD T2,R50TB2(T3) ;YES-- CONVERT
IF TOPS-10,<
SUBI T2," "-' ' ;CONVERT TO SIXBIT
>; END IF TOPS-10
IDPB T2,T1 ;NO-- STORE THE CHARACTER
RETURN ;FROM R50ASC
;
R50TB1: EXP 36,35,34,33,1,0
R50TB2: EXP "0"-36,"%"-35,0-34,"-"-33,"A"-1," "-0
;
; ASCR50 -- CONVERT THREE CHARACTERS FROM ASCII TO RAD50
; T1 -- POINTER TO ASCIZ STRING
; RETURNS +1 IF UNRECOGNIZED CHARACTER (IN C) PARTIAL RESULT IN T2
; +2 SUCCESS
; T1 -- UPDATED POINTER TO NEXT CHARACTER
; T2 -- RAD50 TEXT
;
ASCR50: SETZ T2, ;CLEAR ANSWER
MOVEI T3,3 ;SET THE COUNT TO THREE AT MOST
;
ASCR51: ILDB C,T1 ;GET A CHARACTER FROM THE STRING
IF TOPS-10,<
JUMPE C,ASCR56 ;SPACES ARE SPACES . . .
ADDI C," "-' ' ;CONVERT SIXBIT TO ASCII
>; END IF TOPS-10
CAIL C,"A" ;ALPHA
CAILE C,"Z" ; BETIC?
JRST ASCR52 ;NO-- TRY SOMETHING ELSE
SUBI C,"A"-1 ;YES-- CONVERT THE CHARACTER
JRST ASCR56 ;PUT IT AWAY
;
ASCR52: CAIL C,"0" ;NUM
CAILE C,"9" ; ERIC?
JRST ASCR53 ;NO-- TRY HARDER
SUBI C,"0"-36 ;YES-- CONVERT IT
JRST ASCR56 ;PUT IT AWAY
;
ASCR53: CAIE C,"-" ;HOW 'BOUT - (WILL BE A $)?
JRST ASCR54 ;NO-- LOOK AGAIN
MOVEI C,33 ;YES-- MAKE IT A $
JRST ASCR56 ;GOT IT
;
ASCR54: IMULI T2,50 ;NO LUCK-- JUST FIX UP RESULT
SOJG T3,ASCR54 ;TILL 3 CHARS
RETURN ;FAILURE TO PICK THREE CHARACTERS
;
ASCR56: IMULI T2,50 ;SHIFT THE RESULT A CHARACTER
ADDI T2,(C) ;ADD IN CURRENT CHARATCER
SOJG T3,ASCR51 ;PUT AWAY NEXT CHARACTER
RETSKP ;SUCCESS-- THREE CHARS FOR ASCR50
;
IF TOPS-10,<
;
; OCTSIX -- CONVERT BINARY TO OCTAL SIXBIT
; T2 -- BINARY NUMBER 0-777
; RETURNS +1:
; T1 -- SIXBIT VALUE BITS 0-17
;
OCTSIX:
MOVX T3,0 ;START OUT EMPTY
OCTSX1:
LSHC T2,-3 ;SHIFT A DIGIT INTO T3
LSH T3,-3 ;ALLOCATE SIX BITS
TXO T3,'0'B5 ;MAKE SIXBIT
TLNN T3,77 ;A FULL 3 CHARS YET?
JRST OCTSX1 ;NO-- WORK HARDER
RETURN ;YES-- RETURN NOW
;
; ASCDAT -- CONVERT DATE TO ASCII
; T1 -- POINTER TO 7-BIT OUTPUT STRING
; T2 -- DATE/TIME TO BE CONVERTED (LH= MINUTES SINCE MIDNIGHT, RH= 15-BIT DATE)
;
ASCDAT:
PUSH P,T2 ;SAVE THE TIME
HRRZ T2,T2 ;GET JUST THE DATE
IDIVI T2,^D31 ;GET DAY OF MONTH TO T3
ADDI T3,1 ;START DAYS AT ONE
CALL ASC2DC ;PUT IT
IDIVI T2,^D12 ;MONTH TO T3, YEAR TO T2
ADD T3,[POINT 7,MONTAB] ;MAKE IT A POINTER TO MONTH TEXT
ASCDT2:
ILDB C,T3 ;GET A DATE CHARACTER
JUMPE C,ASCDT3 ;ASCIZ...
IDPB C,T1 ;STORE CHARACTER
JRST ASCDT2 ;BACK FOR MORE
;
ASCDT3:
MOVEI T3,^D64(T2) ;GET YEAR
CALL ASC2DC ;PUT IT AWAY
;
POP P,T2 ;RESTORE TIME
HLRZ T2,T2 ; TO RH
IDIVI T2,^D60 ;HOURS TO T2, MINS TO T3
EXCH T3,T2 ;COPY HRS
CALL ASC2DC ;PUT OUT HRS
MOVE T3,T2 ;GET MINS
CALL ASC2DC ;PUT THEM TOO
MOVX T3,0 ;SEC= 0 ALWAYS
CALLRX ASC2DC ;PUT THEM IN AND RETURN FROM ASCDAT
;
; ASC2DC -- PUT TWO DECIMAL DIGITS FROM T3 IN ASCII IN STRING (T1)
;
ASC2DC:
IDIVI T3,^D10 ;HIGH DIGIT TO T3, LOW TO T4
MOVEI C,"0"(T3) ;GET HIGH DIGIT IN ASCII
IDPB C,T1 ;STORE . . .
MOVEI C,"0"(T4) ;ALSO LOW DIGIT
IDPB C,T1 ; . . .
RETURN ;FROM ASC2DC
;
; MONTAB -- TABLE OF MONTHS
;
DEFINE MONTH(X),<IRP X,<ASCIZ\X\>>
MONTAB:
MONTH <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
;
; TYPOCT -- TYPE OCTAL # FROM T1 ON TTY
;
TYPOCT:
IDIVI T1,^D8 ;GET A LOW DIGIT
HRLM T2,(P) ;SAVE ON STACK
SKIPE T1 ;ALL DONE?
CALL TYPOCT ;NO-- FETCH SOME MORE DIGITS
HLRZ C,(P) ;YES-- GET DIGIT BACK
ADDI C,"0" ;MAKE IT ASCII
OUTCHR C ;TYPE THE CHARACTER
RETURN ;FROM TYPOCT
;
>; END IF TOPS-10
SUBTTL FILE I/O SUBROUTINES
;
IF TOPS-20,<
;
; GETFDB -- GET THE FDB FOR THE FILE (FID) INTO FILFDB
;
GETFDB:
HRRZ T1,FIDJFN(FID) ;GET THE JFN
MOVSI T2,.FBLEN ;READ ENTIRE FDB
MOVEI T3,FILFDB ; INTO FILFDB
GTFDB ;GET IT
RETURN ;FROM GETFDB
;
; SINCLR -- DO A SIN AND CLEAR REST OF BUFFER IF NOT ALL BYTES TRANSFERED
;
SINCLR: SIN ;DO THE SIN
JUMPGE T3,CRET ;OK-- JUST RETURN
SETZ C, ;NOT FINISHED-- CLEAR A CHARACTER
SINCL1: IDPB C,T2 ;STORE A ZERO BYTE
AOJL T3,SINCL1 ;LOOP FOR ALL MISSING BYTES
RETURN ;RETURN ALL DONE
;
>; END IF TOPS-20
;
IF TOPS-10,<
;
; LOOK -- DO (POSSIBLY) WILD LOOKUP ON FILE IN FIDLEB FOR FID
; T1 -- WILD FLAGS (FROM GETNAM)
; RETURNS +1: FAILED TO FIND FILE
; +2: SUCCESS, T1= CHANNEL #
;
LOOK:
MOVE P1,T1 ;COPY FLAGS
CALL GETCHN ;GET A FREE CHANNEL
RETERR IE.NOD
HLL T1,P1 ;RESTORE FLAGS
TXNN T1,FJ.ALL!FJ.DSK ;IS THIS A SEARCH-TYPE STRUCTURE?
JRST WLOOK1 ;NO-- USE THE SUPPLIED NAME
SETZM FIDSTR(FID) ;YES-- RESET TO START OF SEARCH LIST
TXNN T1,FJ.ALL ;WAS THIS ALL?
SETOM FIDSTR(FID) ;NO-- DSK-- SET START TO -1
;
; WLOOK -- DO WILD CARD LOOKUP
; WLOOKN -- CONTINUE PREVIOUS WILD CARD LOOKUP
;
WLOOK:
MOVX T3,0 ;ASSUME RESET NON-SEARCH STR
TXNN T1,FJ.ALL!FJ.DSK ;SEARCH LIST?
JRST WLOOKA ;NO-- DONE WITH STR-- GIVE UP
MOVE T3,FIDSTR(FID) ;GET CURRENT STRUCTURE NAME
TXNN T1,FJ.ALL ;ALL?
JRST WLOOKD ;NO-- USE DSK:
SYSSTR T3, ;GET NEXT STRUCTURE NAME
WARN <SYSSTR UUO FAILURE>,[EXIT]
JRST WLOOKA ;CONTINUE . . .
;
WLOOKD:
MOVX T2,<XWD 1,T3> ;POINT TO JOBSTR ARG BLOCK
JOBSTR T2, ;GET NEXT STR IN JOB SEARCH LIST
WARN <JOBSTR UUO FAILURE>,[EXIT]
WLOOKA:
MOVEM T3,FIDSTR(FID) ;STORE THIS NEW STRUCTURE NAME
WLOOK1:
SETZM FIDDIX(FID) ;RESET DIRECTORY INDEX
CALLRX WLOOKN ;NOW DO DIRECTORY SCAN
;
WLOOKN:
SKIPE T3,FIDSTR(FID) ;GET CURRENT STRUCTURE NAME
CAMN T3,[EXP -1] ;LAST STR?
CALLR RELCHN ;NO MORE STRS-- GIVE UP
MOVX T2,.IODMP ;DUMP MODE
MOVX T4,0 ;NO BUFFERS
CALL XCTUUO
OPEN T2
JRST WLOOK ;OOPS-- TRY NEXT STR
MOVE T2,FIDLEB+.RBPPN(FID) ;GET PATH BLOCK POINTER
MOVX T3,<SIXBIT/UFD/> ;ASSUME A UFD
IFN <P1-<T4+1>>,<PRINTX P1 MUST BE T4+1>
MOVX P1,<XWD 1,1> ; IN THE MFD
IFN FTPATH,<
TLNE T2,-1 ;THIS A PATH BLOCK SPEC?
JRST WLOOK2 ;NO-- JUST GO ON WITH UFD
SKIPN 3(T2) ;JUST A P,PN?
JRST WLKPT2 ;YES-- USE [1,1]P,PN.UFD
MOVE T4,DMPLST ;POINT TO SCRATCH AREA
PUSH T4,[EXP 0] ;SET JUNK WORD= 0
WLKPT1:
PUSH T4,1(T2) ;SAVE LAST ENTRY IN PATH BLOCK TO SCRATCH AREA
SKIPE 3(T2) ;END OF LIST COMING UP AFTER THIS ENTRY?
AOJA T2,WLKPT1 ;NO-- LOOP FOR ALL BUT LAST ENTRY IN PATH BLOCK
PUSH T4,[EXP 0] ;MARK END OF LIST
MOVX T3,<SIXBIT/SFD/> ;SET TYPE= SUB-FILE-DIRECTORY
MOVEI P1,DMPBUF ;POINT PATH BLOCK ADDRESS TO SCRATCH AREA
WLKPT2:
MOVE T2,2(T2) ;GET LAST NAME FOUND IN LIST AS FILENAME OF DIRECTORY
WLOOK2:
>; END IFN FTPATH
CALL XCTUUO
LOOKUP T2 ;FIND THE DIRECTORY
JRST WLOOK ;NO SUCH LUCK-- TRY FOR ANOTHER STR
HLLZS FIDLEB+.RBEXT(FID) ;MAKE SURE EXT IS 3 CHARS
MOVE T3,FIDDIX(FID) ;GET CURRENT DIRECTORY INDEX
IDIVI T3,200 ;FIND CURRENT BLOCK # IN DIRECTORY FILE
CALL XCTUUO
USETI 1(T3) ;SET TO CURRENT BLOCK #
WLOOK3:
CALL XCTUUO
IN DMPLST ;INPUT NEXT 200 WORDS
JRST WLOOK4 ;OK-- LOOK AT THE BLOCK
JRST WLOOK ;ERROR OR EOF-- TRY NEXT STRUCTURE NOW
;
WLOOK4:
TRZE T4,200 ;WHOLE BLOCK YET?
JRST WLOOK3 ;YES-- READ NEXT ONE
ADDI T4,2 ;BUMP DIRECTORY INDEX
MOVEI T2,2 ;ALSO
ADDM T2,FIDDIX(FID) ; DIRECTORY INDEX IN FILE-ID BLOCK
MOVE T2,DMPBUF-2(T4) ;GET FILE-NAME FROM DIRECTORY BLOCK
TXNN T1,FJ.WLN ;WILD NAME?
CAMN T2,FIDLEB+.RBNAM(FID) ;NO-- NAME MATCH?
JRST WLOOK5 ;YES-- TRY FILE TYPE
JRST WLOOK4 ;NO-- TRY NEXT ENTRY
;
WLOOK5:
HLLZ T3,DMPBUF-1(T4) ;GET FILE TYPE
TXNN T1,FJ.WLT ;WILD TYPE?
CAMN T3,FIDLEB+.RBEXT(FID) ;NO-- TYPE MATCH?
JRST WLOOK7 ;YES-- WE HAVE A MATCH
JRST WLOOK4 ;NO-- TRY NEXT ENTRY
;
WLOOK7:
MOVEM T2,FIDLEB+.RBNAM(FID) ;STORE WILD NAME FOUND
MOVEM T3,FIDLEB+.RBEXT(FID) ; ALSO WILD TYPE
CALL XCTUUP
LOOKUP FIDLEB(FID) ;LOOKUP SPECIFIED FILE
JRST WLOOKN ;FAILED-- TRY ALL OVER AGAIN
CALL XCTUUO
IN DMPLST ;READ FIRST BLOCK
SKIPA ;OK-- GO ON
JRST WLOOK8 ;OOPS-- GIVE UP
MOVEI T2,.IODMP ;ASSUME UNKOWN MODE
MOVE T3,DMPBUF+0 ;GET FIRST WORD
TXNN T3,-1B6 ;BINARY FILE?
MOVEI T2,.IOIMG ;YES-- MAKE SURE OF IT
DPB T2,[POINT 4,FIDLEB+.RBPRV(FID),12] ;SET FILE MODE
WLOOK8:
CALLRX CLOSEF ;CLOSE FILE AND RETURN +2 FROM WLOOK
;
; CLOSEF -- CLOSE FILE
; T1 -- CHANNEL #
; RETURNS +2 ALWAYS
;
CLOSEF:
CALL XCTUUO
CLOSE
RETSKP ;ALWAYS RETURN +2 FROM CLOSEF
;
; INEOF -- INPUT AND IGNORE EOF
; T1 -- I/O CHANNEL
; P3, P4 -- I/O LIST
;
INEOF:
CALL XCTUUO
IN P3 ;ATTEMPT INPUT
RETURN ;OK-- RETURN FROM INEOF
CALL XCTUUO
STATZ IO.EOF ;END-OF-FILE?
RETURN ;YES-- RETURN FROM INEOF
RETERR IE.RER,X
;
; GETCHN -- GET A FREE CHANNEL
; RETURNS +1: NO FREE CHANNELS
; +2: SUCCESS, T1= CHANNEL #
;
GETCHN:
MOVE T1,CHNMSK ;GET FREE CHANNEL MASK
JFFO T1,GETCH1 ;FIND A FREE CHANNEL
RETURN ;NONE FREE
;
GETCH1:
MOVE T1,T2 ;GET FIRST FREE BIT
MOVN T2,T2 ;GET -VE CHANNEL #
MOVX T3,1B0 ;START WITH BIT 0
LSH T3,(T2) ;GET BIT FOR CHANNEL
ANDCAM T3,CHNMSK ;MARK (CLEAR) CHANNEL IN USE
RETSKP ;ALL DONE, CHANNEL # IN T1
;
; RELCHN -- RELEASE CHANNEL
; T1 -- CHANNEL #
;
RELCHN:
CALL XCTUUO ;FOR GOOD LUCK . . .
RELEASE
MOVN T2,T1 ;GET -VE CHANNEL #
MOVX T3,1B0 ;START WITH CHANNEL 0
LSH T3,(T2) ;GET BIT FOR CHANNEL
IORM T3,CHNMSK ;MARK (SET) CHANNEL FREE
RETURN
;
; XCTUUO -- XCT I/O UUO ON CHANNEL (T1)
; T1 -- CHANNEL #
; CALL XCTUUO
; <UUO>
; <RETURN +1 FROM UUO>
; <RETURN +2 FROM UUO>
;
XCTUUO:
PUSH P,@(P) ;STACK THE UUO
AOS -1(P) ;SKIP THE UUO
DPB T1,[POINT 4,(P),12] ;PUT CHANNEL # INTO AC FIELD
XCT (P) ;EXECUTE THE UUO
SKIPA ;RETURN +1 FROM UUO
AOS -1(P) ;RETURN +2 FROM UUO
POP P,(P) ;REMOVE UUO FROM STACK
RETURN ;RETURN AFTER UUO FROM XCTUUO
;
; XCTUUP -- SAME AS XCTUUO, EXCEPT PRESERVE FIDLEB+.RBPPN(FID)
; THIS WORD IS DESTROYED ON LOOKUP/ENTER/RENAME
;
XCTUUP:
PUSH P,FIDLEB+.RBPPN(FID) ;SAVE PPN/PATH BLOCK POINTER
PUSH P,@-1(P) ;STACK THE UUO
AOS -2(P) ;SKIP THE UUO
DPB T1,[POINT 4,(P),12] ;PUT CHANNEL # INTO AC FIELD
XCT (P) ;EXECUTE THE UUO
SKIPA ;RETURN +1 FROM UUO
AOS -2(P) ;RETURN +2 FROM UUO
POP P,(P) ;REMOVE UUO FROM STACK
POP P,FIDLEB+.RBPPN(FID) ;RESTORE PPN/PATH BLOCK POINTER
RETURN ;RETURN AFTER UUO FROM XCTUUP
;
>; END IF TOPS-10
SUBTTL END STATEMENT
;
;
END XWD 3,ENTVEC