Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-BM
-
language-sources/lnkfio.mac
There are 48 other files named lnkfio.mac in the archive. Click here to see a list.
TITLE LNKFIO - SUBROUTINES TO DO ALL FILE I/O FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JBC/JNG/PAH/DZN 24-Aug-79
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL
ENTRY LNKFIO
EXTERN .TYOCH,LNKCOR,LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;DEC EDIT VERSION
SEGMENT
LNKFIO:
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;65 TENEX SPEEDUPS
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;136 FIX I.ALC BUG ON DELETE
;170 CHANGE IODATA MACRO FOR PLOT SWITCH
;221 DELETE DVREN. USE DVRNF. INSTEAD
;222 (12773) DO UPDATE MODE ENTER RIGHT FOR DEFAULT PATH
;START OF VERSION 2B
;240 FIX I/O TO UNASSIGNED CHAN IF /SAVE AND HIGH FILE ALREADY EXISTS
;245 REWORK DVLKP. & LKPERR ROUTINES TO BE MORE GENERAL
; ADD DVCEM. & DVSUP. (ROUTINE TO CHECK FOR SUPERSEDE)
;356 LABEL EDIT 240
;370 FIX LNKINS ERROR DETECT
;400 Support SFD's on output files.
;START OF VERSION 2C
;501 Support SFD's on symbol input and overlay files.
;537 Don't destroy I.PPN in DVRNF. for /SAVE
;557 Clean up listing for release.
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;604 Handle device NUL: correctly
;610 Handle output defaulting of ersatz devices correctly.
;610 Don't let libraries confuse DVSUP.
;731 SEARCH MACTEN,UUOSYM
;740 Add code to get F.VER SCAN block field into I/O blocks
; and ( if input file ) to set version number of all output files.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF VERSION 4A
;1105 Fix edit 740 to not destroy the path to the file if it includes SFDs.
;1122 Remove edit 740.
;1123 Use HRLI instead of HRL to load ENTER error flag.
;1174 Label and clean up all error messages.
;1202 Make LNKNED message be potentially editable after 1174.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
SUBTTL HERE TO SETUP POINTER TO I/O DATA BLOCK
;CALLED BY
; PUSHJ P,DVCHN.
;RETURN
; T1 = POINTER
;EXPECTS I/O CHAN# IN IO.CHN
DVCHN.::MOVE T1,IO.CHN ;GET CHAN#
SKIPE T1,IO.PTR(T1) ;GET I/O BLOCK
POPJ P,
E$$INS::.ERR. (MS,0,V%L,L%F,S%F,INS,<I/O data block not set up>) ;[1174]
;HERE TO DO DEVCHR FOR DEVICE
;CALLED BY
; PUSHJ P,DVCHK.##
;USES T1-T2
;EXPECTS I/O CHAN# IN IO.CHN
;SETS IO.CHR WITH DEVCHR OF I/O DEVICE
DVCHK.::PUSHJ P,DVCHN. ;GET ADDRESS IN T1
MOVE T2,I.DEV(T1) ;GET DEVICE
DEVCHR T2, ;SEE WHAT IT IS
MOVEM T2,IO.CHR ;SAVE FOR POSTERITY
JUMPE T2,E01NED ;[1174] NO SUCH DEVICE
MOVEI T2,DV.M0 ;MODE BIT
SKIPGE I.MOD(T1) ;TEST FOR SPECIAL CASE
POPJ P, ;WILL SET READ MODE LATER
LSH T2,@I.MOD(T1) ;MODE WE WANT
AND T2,IO.CHR ;SEE IF WE CAN USE IT
JUMPN T2,CPOPJ ;OK RETURN
E$$IDM::PUSH P,IO.CHN ;[1174] SAVE CHAN
.ERR. (I,0,V%L,L%F,S%F,IDM,<Illegal data mode for device >)
SUBTTL HERE TO DO OPEN FOR NEW DEVICE
;CALLED BY
; PUSHJ P,DVOPN.##
;USES T1-T2
;EXPECTS CHAN # IN IO.CHN
;OPENS DEVICE AND SETS UP BUFFERS IF REQUIRED
DVOPN.::PUSHJ P,DVCHN. ;GET I/O BLOCK
MOVEI T2,I.MOD(T1) ;ADDRESS OF OPEN BLOCK
HRLI T2,(OPEN) ;FORM INST
IOR T2,I.CHN(T1) ;PUT IN CHAN
XCT T2 ;DO OPEN
JRST E01OFD ;[1174] FAILED
;HERE TO ALLOCATE SPACE FOR BUFFERS
HRRZI T2,I.MOD(T1) ;POINT TO DATA BLOCK FOR OPEN
DEVSIZ T2, ;GET BUFFER SIZE
IFE TOPS20,<HALT ;CAN NOT HAPPEN!!!>
IFN TOPS20,<MOVE T2,[2,,203] ;FAKE IT FOR TOPS20>
JUMPE T2,DVRET1 ;DUMP MODE HAS NO BUFFERS
;HERE TO FAKE IT IF NUMBER OF BUFFERS IS TOO SMALL
MOVE T3,IO.CHN ;GET CHAN NUMBER
IFE TOPS20,<
CAIE T3,DC ;INPUT ONLY
JRST DVNDC ;NO
HLRZ T3,T2 ;GET NUMBER OF BUFFERS
CAIGE T3,.IBR ;ENOUGH ALREADY
HRLI T2,.IBR ;[1174] NO, USE TOPS-10 LINK DEFAULT
DVNDC:>;END IFE TOPS20
CAMN T2,I.DVZ(T1) ;SEE IF SAME
JRST DVBUF1 ;SET UP BUFFERS
EXCH T2,I.DVZ(T1) ;SWAP NEW FOR OLD
JUMPE T2,DVVRG1 ;NOTHING TO GIVE BACK
PUSHJ P,DVRET2 ;RETURN OLD BUFFER SPACE
JRST DVVRG. ;AND GET NEW
;HERE TO RETURN ALL SPACE USED BY CHAN I/O DATA BLOCK
;CALLED BY
; PUSHJ P,DVZAP.
;USES T1, T2, T3
;EXPECTS CHAN# IN IO.CHN
DVZAP.::PUSHJ P,DVRET. ;REMOVE BUFFERS
MOVE T3,IO.CHN ;GET CHAN#
HRRZ T1,IO.PTR(T3) ;GET PTR
SETZM IO.PTR(T3) ;CLEAR IT
MOVEI T2,LN.IO ;LENGTH
PJRST DY.RET## ;RETURN
;HERE TO RETURN OLD BUFFER SPACE
;CALLED BY
; PUSHJ P,DVRET.
;USES T1, T2, T3
;EXPECTS CHAN# IN IO.CHN
DVRET.::PUSHJ P,DVCHN. ;GET POINTER TO I/O BLOCK
DVRET1: MOVE T2,I.DVZ(T1) ;GET BUFSIZ WORD
DVRET2: JUMPLE T2,CPOPJ ;DUMP OR UNKNOWN
HLRZ T3,T2
HRRZ T2,T2
IMULI T2,(T3) ;CALCULATE HOW MUCH
MOVE T1,I.RNG(T1) ;FROM WHERE
PJRST DY.RET## ;GIVE IT ALL BACK
;HERE TO GET VIRGIN SPACE
;CALLED BY
; PUSHJ P,DVVRG.
;USES T1, T2
;EXPECTS CHAN# IN I/O CHAN
DVVRG.::PUSHJ P,DVCHN. ;GET I/O BLOCK
DVVRG1: MOVE T2,IO.CHR ;GET DEVCHR BITS
TXC T2,DV.TTA!DV.TTY;[1174] MUST BE CONTROLLING TTY: (NUL: ISN'T)
TXCN T2,DV.TTA!DV.TTY;[1174] ..
JRST DVTTY ;[1174] YES
MOVE T2,I.DVZ(T1) ;GET BACK DEVSIZ INFO
HLRZ T1,T2 ;NUMBER OF BUFFERS
HRRZ T2,T2 ;SIZE OF EACH
IMULI T2,(T1) ;TOTAL SIZE REQUIRED
PUSHJ P,DY.GET## ;FIND THE SPACE
MOVE T2,T1 ;TEMP STORE
MOVE T1,IO.CHN ;GET CHAN
MOVE T1,IO.PTR(T1) ;GET DATA BLOCK
MOVEM T2,I.RNG(T1) ;STORE START OF BUFFER
JRST DVBUF1 ;ALLOCATE THE BUFFERS
;HERE TO SET UP BUFFERS
;CALLED BY
; PUSHJ P,DVBUF.
;USES T1, T2
;EXPECTS CHAN# IN IO.CHN
DVBUF.::PUSHJ P,DVCHN. ;GET I/O DATA BLOCK
DVBUF1: MOVE T2,I.RNG(T1) ;GET START OF AREA
MOVEM T2,.JBFF ;SET FREE SPACE POINTER TO POINT TO IT
HLRZ T2,I.DVZ(T1) ;GET NUMBER OF BUFFERS
HLL T2,I.BUF(T1) ;GET OUTPUT BUFFER HEADER
TLZE T2,-1 ;OUTPUT DEVICE?
TLOA T2,(OUTBUF) ;YES, FORM OUTBUF UUO
HRLI T2,(INBUF) ;FORM INBUF UUO
IOR T2,I.CHN(T1) ;PUT IN CHAN#
XCT T2 ;SETUP BUFFERS
MOVE T2,.JBREL ;INCASE /HELP
MOVEM T2,.JBFF
POPJ P,
DVTTY: SETZM I.RNG(T1) ;CLEAR BITS JUST INCASE
SETZM I.DVZ(T1)
POPJ P, ;WILL USE TTCALLS
;HERE TO READ FILE SPEC AND BUILD LOOKUP BLOCK
;CALLED BY
; PUSHJ P,DVINP.##
;USES T1-T3
DVINP.::MOVE P1,F.INZR ;MAKE SURE P1 IS SETUP
MOVEI T2,LN.RIB-1 ;LENGTH OF LOOKUP BLOCK DATA
MOVEM T2,RIBLEN ;INCASE NOT SET UP
MOVE T2,F.MOD(P1) ;PRESERVE SCAN MODE BITS
MOVEM T2,MDSCN
MOVE T2,F.NAME(P1) ;NAME
MOVEM T2,FNAM
MOVE T2,F.EXT(P1) ;EXTENSION
HLLZM T2,FEXT
MOVE T2,F.DIR(P1) ;DIRECTORY
MOVEM T2,UFDPPN
IFN LN.DRB,< ;IF ALLOWED FOR SFD'S
SKIPN F.DIR+2(P1) ;DO WE HAVE ANY?
POPJ P, ;NO
MOVEM T2,SFDDIR ;STORE PPN
MOVEI T1,SFDARG ;GET PNTR
MOVEM T1,UFDPPN ;AS PPN
MOVE T1,[-LN.DRB,,SFDDIR+1]
MOVEI T2,F.DIR+2(P1) ;ADDRESS OF DIRECTORY
DVSFD: MOVE T3,(T2) ;GET NEXT SFD
MOVEM T3,(T1) ;STORE EVEN IF ZERO
JUMPE T3,CPOPJ ;EXIT WHEN ZERO FOUND
ADDI T2,2 ;SCAN COUNTS IN 2'S
AOBJN T1,DVSFD ;KEEP GOING
>
POPJ P,
;ROUTINE TO A LOOKUP
;CALLED BY
; PUSHJ P,DVLKP.
; ERROR RETURN
; NORMAL RETURN
;
;EXPECTS
; IO.CHN TO CONTAIN I/O CHANNEL (AND CHANNEL IS OPEN)
; IO.CHR TO CONTAIN THE DEVCHR UUO WORD
;
;RETURNS WITH THE LOOKUP DONE ACCORDING TO DEVICE TYPE
DVLKP.::PUSHJ P,DVCHN. ;SET POINTER TO I/O BLOCK
MOVE T2,I.CHN(T1) ;GCHAN # JUSTIFIED TO AC
TLO T2,(LOOKUP) ;MAKE AN I/O INSTRUCTION
MOVE T3,IO.CHR ;SEE WHAT IT WAS
TXNN T3,DV.DSK ;SEE IF A F/S
JRST NFSLKP ;NO
HRRI T2,I.RIB(T1) ;GET ADDR OF LOOKUP BLOCK
XCT T2 ;EXTENDED LOOKUP
POPJ P, ;FAILURE, ERROR RETURN
MOVE T2,IO.CHN ;NOW FIND WHERE FILE IS USING
MOVEM T2,I.ARG(T1) ;PATH. UUO, SINCE MONITOR LIES
MOVEI T2,I.PTH(T1) ;IF FILE IS IN AN SFD...
MOVEM T2,I.PPN(T1) ;ALWAYS MAKE I.PPN POINT TO PATH
HRLI T2,.PTMAX ;LENGTH OF PATH BLOCK
PATH. T2, ;FIND IT
SETZM I.PPN(T1) ;CAN'T, ASSUME DEFAULT PATH
PJRST CPOPJ1 ;SUCCESS, NORMAL RETURN
;HERE FOR NON-FILE STRUCTURE LOOKUP
NFSLKP: HRRI T2,I.NAM(T1) ;ADDR OF SHORT BLOCK
XCT T2 ;SHORT LOOKUP
POPJ P, ;ERROR RETURN
PJRST CPOPJ1 ;NORMAL RETURN
;HERE TO HANDLE OUTPUT FILE SPECS
;CALLED BY
;PUSHJ P,DVOUT.##
;XWD CHAN#, MODE
;DVOUT. CHECKS FOR DEVICE ALREADY OPEN ON THIS CHAN
;SETS UP DATA BLOCK AND RETURNS
;OPEN AND ENTER WILL BE DONE LATER
DVOUT.::HLRZ T1,@(P) ;PICKUP CHAN NUMBER
MOVEM T1,IO.CHN ;SAVE FOR DEFERED SWITCHES
MOVEI T2,LN.IO ;LENGTH REQUIRED
SKIPN T1,IO.PTR(T1) ;ALREADY SETUP?
PUSHJ P,DY.GET## ;NO, GET SPACE
MOVE T2,IO.CHN ;GET CHAN AGAIN
HRROM T1,IO.PTR(T2) ;POINT TO DATA AREA
;-1 IN LEFT SIGNALS OPEN NOT YET DONE
MOVE T3,T1 ;SAFER PLACE FOR POINTER
HRRE T1,@(P) ;GET MODE
MOVEM T1,I.MOD(T3) ;STORE MODE IN OPEN BLOCK
AOS (P) ;PASS OVER IT
MOVE T1,OBFTBL(T2) ;GET BUFFER HEADER
HRLZM T1,I.BUF(T3) ;INTO OPEN BLOCK
HLLZM T1,I.CHN(T3) ;CHAN# IN AC FIELD
MOVE T1,F.MOD(P1) ;PRESERVE SCAN MOD WORD
MOVEM T1,I.SCN(T3)
MOVEI T1,LN.RIB-1 ;LENGTH OF EXTENDED ENTER
MOVEM T1,I.RIB(T3)
SKIPN T1,F.NAME(P1) ;FILE NAME
MOVE T1,O.NAM
MOVEM T1,I.NAM(T3)
SKIPN T1,F.EXT(P1) ;EXTENSION
MOVE T1,O.EXT ;DEFAULT MUST BE SETUP PRIOR TO THIS
HLLZM T1,I.EXT(T3)
SKIPN T1,F.PROT(P1) ;PROTECTION CODE
MOVE T1,O.PROT
DPB T1,[POINT 9,I.PRV(T3),8] ;STORE LOWER 9 BITS
;CONTINUED ON NEXT PAGE
;FALL IN FROM ABOVE TO DEFAULT OUTPUT PATH AND OUTPUT DEVICE.
;MUST REMEMBER THAT AN EXPLICIT ERSATZ DEVICE IS EXPLICITLY
;SPECIFYING BOTH A DEVICE AND A PATH, SO THE DEFAULT PATH
;(FROM [PATH]/DEFAULT:OUTPUT) SHOULD NOT BE APPLIED EVEN IF NO
;EXPLICIT PATH WAS GIVEN. SIMILARLY, A DEFAULT ERSATZ DEVICE
;(REL:/DEFAULT:OUTPUT) CAN ONLY BE APPLIED IF NEITHER DEVICE
;NOR PATH WERE EXPLICITLY GIVEN.
MOVSI T2,(FX.DIR) ;SET UP FOR TEST
TDNN T2,F.MOD(P1) ;WAS DIRECTORY SPECIFIED?
JRST DVOUT1 ;MAYBE NOT. GO SEE.
MOVE T4,F.DIR(P1) ;ONE WAS. GET IT.
TLNN T4,-1 ;PROJECT SPECIFIED?
HLL T4,MYPPN ;NO, ASSUME DEFAULT
TRNN T4,-1 ;PROGRAMMER GIVEN?
HRR T4,MYPPN ;NO, DEFAULT
MOVEI T1,F.DIR(P1) ;POINT TO DIRECTORY WE'RE USING
JRST DVOUT4 ;[610] AND GO CHECK SFD'S
;HERE WHEN FX.DIR IS OFF. EITHER NONE SPECIFIED OR IT'S [-].
DVOUT1: TDNE T2,F.MODM(P1) ;[610] WHICH IS IT?
JRST DVOUT3 ;[610] IT'S [-]. DON'T USE DEFAULT.
MOVE T1,[3,,T2] ;[610] NO PATH GIVEN EXPLICITLY, SEE IF
MOVE T2,F.MOD(P1) ;[610] ONE GIVEN VIA AN ERSATZ DEVICE
TXNN T2,FX.NDV ;[610] FIRST, SEE IF THERE WAS A DEVICE
SKIPN T2,F.DEV(P1) ;[610] SHOULD BE, MAKE SURE
JRST DVOUT2 ;[610] NO DEVICE!
PATH. T1, ;[610] SEE IF EXPLICIT DEVICE IS ERSATZ
SETZ T3, ;[610] PROBABLY NOT
TXNN T3,PT.IPP ;[610] DEVICE ERSATZ?
DVOUT2: SKIPA T1,[O.DIR] ;[610] NO, COPY PATH FROM DEFAULT
DVOUT3: MOVEI T1,F.DIR(P1) ;[610] YES, USE EXPLICIT PATH GIVEN
MOVE T4,(T1) ;GET UFD FOR OUTPUT
DVOUT4: MOVE T3,IO.CHN ;[610] RESTORE POINTER TO I.XXX
HRRZ T3,IO.PTR(T3) ;[610] POSSIBLY DESTROYED BY PATH UUO
SKIPN 2(T1) ;[610] ANY SFD'S???
JRST [MOVEM T4,I.PPN(T3) ;NO, STORE PPN
JRST DVOUT6] ;[610] AND GO DEFAULT DEVICE
MOVEM T4,I.UFD(T3) ;THERE ARE..UFD GOES IN I.UFD
MOVEI T2,I.PTH(T3) ;GET POINTER TO PATH BLOCK
MOVEM T2,I.PPN(T3) ;AND PUT IT IN ENTER BLOCK
DVOUT5: ADDI T1,2 ;[610] POINT TO NEXT SFD FROM SCAN
SKIPN T2,(T1) ;IS THIS THE END?
JRST DVOUT6 ;[610] YES, GO DEFAULT DEVICE
;NOTE THAT THIS IS THE ONLY
; EXIT FROM THIS LOOP, BECAUSE
; THERE WILL ALWAYS BE A ZERO
; AFTER THE LAST SFD.
MOVEM T2,I.SFD(T3) ;NOT LAST SFD. STORE IT.
AOJA T3,DVOUT5 ;[610] CHECK FOR MORE
;*** NOTE T3 MODIFIED HERE ***
;CONTINUED ON NEXT PAGE
;NOW TO DEFAULT THE DEVICE. IF THE DEFAULT DEVICE IS ERSATZ,
;WE CAN ONLY USE IT IF EXPLICIT SPEC CONTAINED NEITHER DEVICE
;NOR PATH. NOTE THAT DEVICE DEFAULTING MUST TAKE PLACE AFTER PATH
;DEFAULTING TO AVOID CONFUSING THE DEFAULT AND EXPLICIT DEVICES
;IN PATH DEFAULTING CODE.
DVOUT6: MOVE T2,F.MOD(P1) ;[610] SEE IF USER GAVE EXPLICIT DEVICE
TXNN T2,FX.NDV ;[610] ..
SKIPN T2,F.DEV(P1) ;[610] BITS SAY SO, MAKE SURE
CAIA ;[610] NO DEVICE, DO DEFAULTING
JRST DVOUT9 ;[610] EXPLICIT DEVICE--GO USE IT
SKIPN T2,O.DEV ;[610] IS THERE A DEFAULT DEVICE?
JRST DVOUT8 ;[610] NO, JUST GO USE DSK:
MOVE T1,[3,,T2] ;[610] SEE IF THE DEFAULT DEVICE IS
PATH. T1, ;[610] ERSATZ VIA A PATH UUO
SETZ T3, ;[610] PROBABLY NOT
TXNN T3,PT.IPP ;[610] IS IT ERSATZ?
JRST DVOUT7 ;[610] NO, OK TO USE IT
MOVE T2,F.MODM(P1) ;[610] DEFAULT DEVICE IS ERSATZ. WE CAN
TXNN T2,FX.DIR ;[610] ONLY USE IT IF NO EXPLICIT PATH
DVOUT7: SKIPN T2,O.DEV ;[610] OK TO USE THE DEFAULT DEVICE
DVOUT8: MOVSI T2,'DSK' ;[610] CAN'T USE DEFAULT, JUST USE DSK:
DVOUT9: MOVE T3,IO.CHN ;[610] RESTORE POINTER TO I.XXX BLOCK
HRRZ T3,IO.PTR(T3) ;[610] (LOST TO DVOUT5)
MOVEM T2,I.DEV(T3) ;[610] STORE FINAL DEVICE
JRST DVCHK. ;[610] AND GO CHECK DATA MODE
;HERE TO DO ENTER FOR OUTPUT SPEC
;CALLED BY
; PUSHJ P,DVENT.##
;EXPECTS CHAN# IN IO.CHN
;ALSO DOES SWITCHES BEFORE FILE NAME
DVENT.::PUSHJ P,DVCHK. ;GET DEVCHR, POINT TO I/O DATA BLOCK
HLRZ T2,I.SWT(T1) ;ANY SWITCHES TO DO
JUMPE T2,DVENTR ;BEFORE WE DO ENTER
HRRZS I.SWT(T1) ;CLEAR SWITCHES
DVENT1: MOVE T3,1(T2) ;GET UUO
TLZ T3,(Z 17,) ;CLEAR CHAN#
OR T3,I.CHN(T1) ;USE CORRECT ONE
MOVE T1,T2 ;PRESERVE ADDRESS OF BLOCK TO DELETE
MOVE T2,2(T1) ;GET REPEAT COUNT
XCT T3 ;DO UUO
SOJG T2,.-1 ;REPEAT?
MOVEI T2,3
SKIPN 0(T1) ;MORE?
JRST DVENT2 ;NO
PUSH P,0(T1) ;YES
PUSHJ P,DY.RET##
PUSHJ P,DVCHN. ;RESET T1
POP P,T2 ;AND POINTER
JRST DVENT1 ;AND LOOP
;HERE FOR LAST TIME
DVENT2: PUSHJ P,DY.RET##
PUSHJ P,DVCHN. ;GET DATA BLOCK
DVENTR: SETZM I.ALC(T1) ;MAKE SURE ALLOCATION IS CLEAR
MOVEI T2,I.RIB(T1) ;POINT TO LOOKUP/ENTER BLOCK
HRLI T2,(ENTER)
IOR T2,I.CHN(T1) ;BUILT INST
MOVE T3,IO.CHR ;GET DEVCHR WORD
TXNN T3,DV.DSK ;ONLY DSK CAN DO EXTENDED ENTERS
ADDI T2,2 ;DO NORMAL 4 WORD ENTER
PUSH P,I.PPN(T1) ;SAVE PATH FROM DESTRUCTION
XCT T2 ;DO ENTER
PUSHJ P,ENTERR ;FAILED
POP P,I.PPN(T1) ;RESTORE PATH (MONITOR LIES)
MOVE T1,IO.CHN ;GET CHAN#
HRRZS IO.PTR(T1) ;SIGNAL DONE
POPJ P,
DEFINE XXX (CH,NUM,MODE)<
IFN CH-%%,<
REPEAT CH-%%,<
0
>>
IFGE MODE,<
IFIDN <MODE><.IODPR>,<
NUM,0
>
IFDIF <MODE><.IODPR>,<
NUM,CH'BUF
>>
IFL MODE,<
NUM,0
>
%%==CH+1
>
SYN XXX,XXXX
%%==0
XALL
OBFTBL: IODATA
SALL
PURGE %%,XXX,XXXX
;HERE TO DO SWITCH ACTION JUST PRIOR TO RELEASE
;AND TO DO RELEASE
;EXPECTS CHAN # IN IO.CHN
DVRLS.::PUSHJ P,DVCLS. ;CLOSE FILE IF OPEN, GET DATA BLOCK
JUMPE T1,CPOPJ ;GIVE UP IF NO ACTIVE I/O
HRRZ T2,I.SWT(T1) ;ANY SWITCHES TO DO
JUMPE T2,DVRLSZ ;NO, JUST RELEASE
SETZM I.SWT(T1) ;CLEAR SWITCHES
DVRLS1: MOVSI T3,(MTWAT.) ;INCASE TAPE STILL MOVING (DTA?)
IOR T3,I.CHN(T1)
XCT T3
MOVE T3,1(T2) ;GET UUO
TLZ T3,(Z 17,) ;CLEAR CHAN#
OR T3,I.CHN(T1) ;USE CORRECT ONE
MOVE T1,T2 ;ADDRESS OF BLOCK TO DELETE
MOVE T2,2(T1) ;REPEAT COUNT
XCT T3 ;DO UUO
SOJG T2,.-1 ;REPEAT IT?
MOVEI T2,3
SKIPN 0(T1) ;MORE?
JRST DVRLS2 ;NO
PUSH P,0(T1) ;YES
PUSHJ P,DY.RET##
PUSHJ P,DVCHN. ;RESET T1
POP P,T2 ;AND POINTER
JRST DVRLS1 ;AND LOOP
DVRLS2: PUSHJ P,DY.RET## ;RETURN SWITCH BLOCK
PUSHJ P,DVCHN. ;SETUP T1 AGAIN
DVRLSZ: MOVSI T2,(RELEASE)
IOR T2,I.CHN(T1) ;BUILD INST
XCT T2
POPJ P,
;HERE TO DO CLOSE
;CALLED BY
; PUSHJ P,DVCLS.
;EXPECTS CHAN# IN IO.CHN
DVCLS.::PUSHJ P,DVCHN. ;POINT TO I/O DATA BLOCK
MOVSI T2,(CLOSE)
IOR T2,I.CHN(T1) ;COMPLETE INST.
XCT T2
POPJ P,
;HERE TO SET DEFAULT FILE NAME IF ZERO
;CALLED BY
; PUSHJ P,DVNAM.
;EXPECTS CHAN# IN IO.CHN
DVNAM.::PUSHJ P,DVCHN. ;POINT TO I/O DATA BLOCK
SKIPE T2,I.NAM(T1) ;GET USER SUPPLIED NAME
POPJ P, ;YES, JUST RET
SKIPE T2,LODNAM ;NOT SUPPLIED USE MAIN PROG NAME
JRST .+3 ;HOWEVER IF STILL ZERO
HLLZ T2,JOBNUM ;GET SIXBIT JOBNUMBER
HRRI T2,'LNK' ;000LNK BY DEFAULT
MOVEM T2,I.NAM(T1)
POPJ P,
;HERE TO GET INTO UPDATE MODE FOR OVERFLOW FILES
;CALLED BY
; MOVEI T1,CHAN#
; PUSHJ P,DVUPD.
;RETURNS
;+1 FAILED (LOOKUP OR ENTER)
;+2 SUCCESS
;USES T1, T2, T3
DVUPD.::HRLZ T2,T1 ;CHAN # IN LEFT
LSH T2,5 ;THENCE TO AC FIELD
MOVE T1,IO.PTR(T1) ;POINT TO DATA CHAN
MOVEM T2,I.CHN(T1) ;STORE INCASE NEEDED
HRRI T2,I.MOD(T1) ;ADDRESS OF OPEN BLOCK
TLO T2,(OPEN)
XCT T2
JRST E01OFD ;[1174] SHOULD NEVER HAPPEN FOR DSK
HRRI T2,I.RIB(T1) ;POINT TO LOOKUP/ENTER BLOCK
TLC T2,027000 ;OPEN .XOR. ENTER
MOVE T3,I.PPN(T1) ;SAVE PPN INCASE DEFAULT PATH
XCT T2 ;ENTER FILE
POPJ P, ;FAILED
MOVEM T3,I.PPN(T1) ;RESTORE DIRECTORY
TLZ T2,007000 ;CONVERT TO CLOSE
HRRI T2,CL.DLL ;BUT DON'T DEALLOCATE
XCT T2
HRRI T2,I.RIB(T1) ;PUT LOOKUP ADDRESS BACK
TLO T2,006000 ;LOOKUP
XCT T2
POPJ P, ;FAILED
MOVEM T3,I.PPN(T1) ;RESTORE DIRECTORY
TLO T2,001000 ;ENTER
XCT T2
POPJ P, ;FAILED
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
;HERE TO DELETE A FILE & RELEASE CHAN#
;CALLED BY
; MOVEI T1,CHAN#
; PUSHJ P,DVDEL.
;USES T1, T2
;RETURNS
;+1 FAILED
;+2 SUCCESS
DVDEL.::PUSHJ P,DVDLF. ;DELETE FILE
POPJ P, ;NON-SKIP RETURNS (FAILURE)?
TLC T2,024000 ;RELEASE_RENAME
HLLZ T2,T2 ;CLEAR RHS INCASE CLOSE BITS EVER WORK
XCT T2
JRST CPOPJ1 ;OK RETURN
;HERE TO JUST DELETE A FILE
;CALLED BY
; PUSHJ P,DVDLF.
;ARGS AS ABOVE
DVDLF.::HRLZ T2,T1 ;CHAN# IN LEFT
LSH T2,5 ;THENCE TO AC FIELD
MOVE T1,IO.PTR(T1) ;GET PTR TO DATA
DVDLFC: ;ENTER HERE WITH T2 =CHAN # IN AC FIELD
;AND T1 POINTING TO DATA BLOCK
;NOW COPY FILE SPEC TO SAFE PLACE
;OTHERWISE STRANGE ERRORS OCCUR ON FUTURE RENAMES
HRLZ T3,T1 ;FROM
HRRZ T1,IO.EMG ;A SAFE PLACE
HRR T3,T1 ;TO
BLT T3,LN.IO-1(T1) ;T1 POINTS TO NEW BLOCK
TLO T2,(CLOSE) ;CLOSE FILE INCASE STILL OPEN
XCT T2
HRRI T2,I.RIB(T1) ;POINT TO LOOKUP BLOCK
TLO T2,006000 ;CONVERT CLOSE TO LOOKUP
PUSH P,I.PPN(T1) ;SAVE PATH OVER LOOKUP
XCT T2
JRST DVDLF1 ;TOO BAD
SETZM I.NAM(T1) ;CLEAR NAME
TLC T2,023000 ;RENAME _ LOOKUP
XCT T2 ;DELETE FILE
JRST DVDLF1 ;TOO BAD
AOS -1(P) ;OK RETURN
DVDLF1: POP P,I.PPN(T1) ;RESTORE PATH FROM ENTRY
; PJRST DVCEM. ;CLEAR IO.EMG AND RETURN
;ROUTINE TO CLEAR IO.EMG, THE EMERGENCY FREE I/O DATA BLOCK
;CALLED BY
; PUSHJ P,DVCEM.
;
;USES T1,T3
;*** WARNING *** MUST LEAVE T2 UNCHANGED
DVCEM.::MOVE T1,IO.EMG ;GET POINTER TO I/O BLOCK
HRLZ T3,T1 ;BLT TO CLEAR IO.EMG
HRRI T3,1(T1) ;SO ITS FREE FOR NEXT TIME
SETZM (T1)
BLT T3,LN.IO-1(T1)
POPJ P,
;HERE TO RENAME A FILE
;CALLED BY
; MOVE T1,IO.CHN+CHAN# OF NEW FILE
; MOVE IO.CHN CHAN# OF OLD FILE
; PUSHJ P,DVRNF.
;USES T1, T2, T3, T4
;RETURNS
;+1 FAILED
;+2 SUCCESS
DVRNF.::PUSH P,T1 ;SAVE T1
PUSHJ P,DVCLS. ;CLOSE OUT OLD FILE
POP P,T2 ;RECOVER NEW NAME
MOVEI T3,I.RIB(T1) ;ADDRESS
TLO T3,(LOOKUP)
IOR T3,I.CHN(T1) ;PLUS CHAN#
PUSH P,I.PPN(T1) ;SAVE PPN IN CASE DEFAULT PATH
XCT T3 ;LOOKUP
JRST [POP P,0(P) ;ERROR - RESTORE STACK
POPJ P,] ;AND GIVE ERROR RETURN TO CALLER
POP P,I.PPN(T1) ;DON'T BELIEVE FALSE MONITOR VALUE
TLC T3,023000 ;RENAME_LOOKUP
HRRI T3,I.RIB(T2) ;POINT TO NEW NAME
LDB T4,[POINT 9,I.PRV(T2),8] ;GET USER SPECIFIED PROTECTION
SKIPE T4 ;UNLESS NOT SPECIFIED
DPB T4,[POINT 9,I.PRV(T1),8] ;STORE IN OLD SO WE COPY IT
MOVE T4,I.PRV(T1) ;GET DATE TIME ETC
MOVEM T4,I.PRV(T2) ;SINCE SAME FILE
HRRZ T4,I.EXT(T1) ;GET HIGH ORDER PART
HRRM T4,I.EXT(T2) ; ALSO
PUSH P,I.PPN(T2) ;SAVE PATH, SINCE MONITOR WIPES IT
XCT T3
JRST DVRNFE ;TEST ERROR CONDITION
POP P,I.PPN(T2) ;RESTORE TO BEFORE (MONITOR LIES)
JRST CPOPJ1 ;OK RETURN
DVRNFE: POP P,I.PPN(T2) ;RESTORE REAL PPN OF FILE
HRRZ T4,I.EXT(T2) ;GET RENAME ERROR CODE
CAIE T4,ERAEF% ;ALREADY EXISTS
POPJ P, ;NO, JUST IGNORE THIS ERROR?
PUSH P,I.NAM(T2) ;SAVE NAME
PUSH P,T2 ;SAVE P2
EXCH T1,T2 ;GET POINTER TO 2ND FILE
MOVE T2,I.CHN(T2) ;GET CHAN# TO 1ST FILE
PUSHJ P,DVDLFC
JRST [SUB P,[2,,2] ;BACKUP STACK
POPJ P,] ;AND GIVE UP
POP P,T1 ;RESTORE POINTER
POP P,I.NAM(T1) ;AND NAME
JRST DVRNF. ;TRY AGAIN
;ROUTINE TO OPEN DSK FILE, CHECK IF WILL EVENTUALLY SUPERSEDE
; EXISTING FILE, AND IF SO SET THE DEV NAME TO STRUCTURE.
;CALLED BY
; PUSHJ P,DVSUP.
; ERROR RETURN ;DEV IS NOT A DSK
; NORMAL RETURN
;
;EXPECTS
; IO.CHN TO CONTIAN I/O CHANNEL NUMBER
;
;RETURNS WITH THE DEVICE NAME IN THE I/O DATA BLOCK INITIALIZED
DVSUP.::PUSHJ P,DVCHK. ;GET THE DEVCHR WORD
MOVE T2,IO.CHR
TLC T2,-1-<(DV.TTA)> ;[604] NUL: ISN'T A DISK
TLCE T2,-1-<(DV.TTA)> ;[604]
TXNN T2,DV.DSK ;IS IT A DSK?
POPJ P, ;WE HAVE A PROBLEM
AOS (P) ;MAKE IT A SKIP RETURN
MOVE T2,IO.CHN ;GET THE CHAN #
MOVE T1,IO.PTR(T2) ;GET THE I/O BLOCK PNTR
LSH T2,^D23 ;ALLIGN TO THE AC FIELD
MOVEM T2,I.CHN(T1) ;STORE FOR I/O BUILD
PUSHJ P,DVOPN. ;OPEN THE DEV
PUSHJ P,DVCHN. ;POINT TO THE I/O BLOCK
SKIPN T2,IO.EMG ;[604] ANY CORE LEFT? (IF FROM LNKCOR)
PUSHJ P,E$$MEF## ;[1174] NO, ERROR
HRL T2,T1 ;[604] YES, FORM BLT PTR TO IO.EMG AREA
MOVEI T3,(T2) ; TO SAVE ORIG ENTER BLOCK
BLT T2,LN.IO-1(T3) ;IO.EMG POINTS TO TMP
PUSHJ P,DVENT. ;[656] SEE WHERE FILE WILL GO
MOVE T3,IO.CHN ;ENTRY IN IO.PTR TO SWAP
RESDV. T3, ;[656] DELETE FILE WE JUST ENTERED
MOVE T3,IO.CHN ;[656] IGNORE ERROR
HRRZ T1,IO.PTR(T3) ;[604] TRADE I/O DATA BLOCKS
MOVE T2,T1 ; WITH IO.EMG
EXCH T1,IO.EMG ; TMP AREA
HRROM T1,IO.PTR(T3) ;[656] ...
MOVE T4,I.LDV(T2) ;GET STRUCTURE NAME
MOVEM T4,I.DEV(T1) ;REPLACE GENERIC NAME
PJRST DVCEM. ;CLEAR IO.EMG AND RETURN
SUBTTL TOPS-20 JSYS ROUTINES
IFN TOPS20,<
;HERE TO CONVERT SCAN BLOCK INTO TEXT STRING
;CALLED BY
; MOVE IO.CHN CHAN #
; PUSHJ P,DVTXT.
DVTXT.::MOVEI T2,F.LEN ;GET SPACE TO STORE STRING
PUSHJ P,DY.GET##
MOVE T4,T1 ;SAFER PLACE
HRLI T4,(POINT 7) ;MAKE INTO BYTE PTR
PUSHJ P,DVCHN. ;GET DATA BLOCK IN T1
SKIPN T3,I.DEV(T1) ;GET DEVICE
JRST DVTXT1 ;NO DEVICE
PUSHJ P,DVDPB. ;STORE
MOVEI T2,":"
IDPB T2,T4
DVTXT1: SKIPN T3,I.PPN(T1) ;SEE IF DIRECTORY
JRST DVTXT2 ;NO
MOVEI T2,"<" ;OPEN IT
IDPB T2,T4
PUSHJ P,DVDPB. ;STORE NAME
MOVEI T2,">"
IDPB T2,T4 ;CLOSE IT
DVTXT2: MOVE T3,I.NAM(T4)
PUSHJ P,DVDPB.
SKIPN T3,I.EXT(T4)
JRST DVTXT3 ;NO EXTENSION
MOVEI T2,"."
IDPB T2,T4
PUSHJ P,DVDPB.
DVTXT3:
MOVE T2,IO.CHN
MOVEM T4,IO.PTR(T2) ;STORE TEXT STRING PTR
MOVEI T2,F.LEN
PJRST DY.RET## ;GIVE BACK SCAN BLOCK
;HERE TO STORE BYTE IN STRING
;CALLED BY
; T3 = SIXBIT WORD
; T4 = BYTE PTR
; PUSHJ P,DVDPB.
;USES T2
DVDPB.: SETZ T2,
LSHC T2,6 ;GET NEXT CHAR
ADDI T2," " ;TO ASCII
IDPB T2,T4
JUMPN T3,DVDPB. ;MORE TO DO
POPJ P, ;NO, RETURN
;DVGFO. - ROUTINE TO DO GTJFN FOR OUTPUT FILE
;EXPECTS TEXT STRING IN IO.PTR(IO.CHN)
;STORES JFN THERE ON COMPLETION
DVGFO.::MOVE T4,IO.CHN ;GET CHAN#
MOVSI 1,(1B0+1B17) ;OUTPUT SO VERSION# STUFF WORKS RIGHT
HRRO 2,IO.PTR(T4) ;POINT TO TEXT STRING
GTJFN
HALT
EXCH T1,IO.PTR(T4) ;STORE JFN
MOVEI T2,F.LEN
PJRST DY.RET## ;REMOVE TEXT STRING
>;END OF IFN TOPS20
SUBTTL ERROR MESSAGES
E01OFD::PUSH P,IO.CHN ;[1174] PUT CHANNEL ON STACK
.ERR. (I,0,V%L,L%F,S%F,OFD) ;[1174]
E01NED::PUSH P,IO.CHN ;[1174] PUT CHANNEL ON STACK FOR LNKLOG
.ERR. (I,0,V%L,L%F,S%E,NED)
POPJ P, ;[1174] RETURNS IF CHAN WAS DC; TRY NOW
ENTERR: MOVE T1,IO.CHN
HRLI T1,(%ENT) ;[1123] SIGNAL ENTER
MOVE T2,IO.CHR ;GET DEVCHR WORD
TXNE T2,DV.DTA ;DTA MIGHT BE SPECIAL
JRST [MOVE T2,IO.PTR(T1) ;[1174] GET DATA BLOCK POINTER
HRRZ T3,I.EXT(T2) ;[1174] IF ERROR WAS ERPRT%
CAXN T3,ERPRT% ;[1174] AS IT MEANS DIRECTORY FULL
HLLOS I.EXT(T2) ;[1174] SIGNAL BY -1
JRST .+1]
E01FEE::PUSH P,T1 ;[1174] SAVE CHANNEL FOR LNKLOG
.ERR. (LRE,,V%L,S%D,L%D,FEE) ;[1174]
POPJ P,
E01FLE::PUSH P,IO.CHN ;[1174] REMEMBER WHAT # FAILED
.ERR. (LRE,,V%L,S%D,L%D,FLE) ;[1174]
POPJ P,
SUBTTL THE END
FIOLIT: END