Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/iotmp.mac
There are 6 other files named iotmp.mac in the archive. Click here to see a list.
; UPD ID= 1508 on 1/23/84 at 12:39 PM by JBLAU
TITLE IOTMP - TEMP FILE I/O PACKAGE
SUBTTL D. WRIGHT Latest update Jan, 1981
SEARCH COPYRT
SALL
;Routines to be used by performance-conscious programs
; to deal with sequential files. The interface for
; TOPS10 and TOPS20 programs is identical in all common cases.
COPYRIGHT (C) 1981, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; These routines are native mode on TOPS20.
;On both TOPS10 and TOPS20, these routines
;optimize performance on the latest model cpu.
; This package will also work if run in
;a non-zero section.
SEARCH IOTMPU ;Search IOTMP's universal file
; This picks up TOPS20 definition
SEARCH MMANGU ;Memory manager universal file
IFNDEF DEBUG,<DEBUG==0> ;NO DEBUGGER IF NOT DEFINED
IFN TOPS20,<SEARCH MONSYM,MACSYM>
IFE TOPS20,<SEARCH UUOSYM,MACTEN>
IFE TOPS20,<
TWOSEG 400K ;Two segment program, start at 400K
>;END IFE TOPS20
.COPYRIGHT ;Put standard copyright statement in REL file
SALL ;SUPPRESS MACRO EXPANSIONS
;Entry points in IOTMP:
ENTRY $ITINI ;Initialize
ENTRY $ITOPO ;LOGICAL OPEN OUTPUT
ENTRY $ITOPI ;LOGICAL OPEN INPUT
ENTRY $ITINB ;GET A BYTE FROM INPUT FILE
ENTRY $ITOUB ;PUT A BYTE INTO OUTPUT FILE
ENTRY $ITISB ;Input a string of bytes
ENTRY $ITOSB ;Output a string of bytes
ENTRY $ITPSF ;Position file
ENTRY $ITCLS ;Logical close of file
ENTRY $ITRNF ;Rename file
ENTRY $ITRMU ;RETURN MEMORY USAGE *NYI*
ENTRY $ITCBM ;CUT BACK ON MEMORY USAGE *NYI*
ENTRY $ITDEB ;ENTER DEBUGGER *NYI*
; EDIT HISTORY
;JEH 7 09-DEC-83 Restore path block address to
; lookup and rename blocks in
; routine $ITRNF
;
;AC definitions
T1=1 ;5 TEMPS STARTING AT AC 1
T2=2
T3=3
T4=4
T5=5
P1=6 ;3 PERMS STARTING AT AC6
P2=7
P3=10
P=17 ;PUSHDOWN STACK PTR
;Random parameters
.TMTMX==5 ;Number of tries before we decide that the
;"Simultaneous update error" on open is not
;just a race condition, but something that's
; taking too long to go away and we'll stop
; trying again.
IFN TOPS20,<
.NTTYB==^D200 ;Number of bytes available to store a TTY: input line
>;END IFN TOPS20
IFE TOPS20,<
.MXRBC==.RBACT+10 ;Max. number of args in extended LOOKUP/RENAME blocks
>;END IFE TOPS20
SUBTTL MACROS
DEFINE TYPE (ADDR),<
IFN TOPS20,<
HRROI 1,ADDR
PSOUT%
>;END DEFINE TYPE
>;END IFN TOPS20
IFE TOPS20,<
DEFINE TYPE (ADDR),<
OUTSTR ADDR
>;END DEFINE TYPE
>;END IFE TOPS20
DEFINE $TEXT(STRING),<
XLIST
ASCIZ |STRING|
LIST
>;END DEFINE $TEXT
DEFINE $FERR (ABBR,TEXT),<
MOVE T1,[''ABBR'',,[ASCIZ |TEXT|]]
PUSHJ P,ITFERR
>
DEFINE $WERR (ABBR,TEXT),<
MOVE T1,[''ABBR'',,[ASCIZ |TEXT|]]
PUSHJ P,ITWERR
>
OPDEF PJRST [JRST] ;Nobody else defines it!
SUBTTL Interface to memory management module
;These routines only work if there is also a memory management
; module present with the following entry points.
EXTERN INITMU ;Initialize mem manager for a user
EXTERN FINFRE ;Routine to find a clump of free pages
EXTERN RETRN ;Return pages to memory manager
;See MMANGU.MAC for more details
SUBTTL $ITINI--Initialize
;Call:
; 1/ Flags (IT%UES)
; 2/ Default buffer size,,max IFN value
; 3/ (RH) = 3-letter sixbit program abbreviation
;Returns:
; 1/ Status 0=ok, 1=problem
$ITINI: PUSH P,T1 ;SAVE AC
SETZM STTLC ;Clear data area..
MOVE T1,[STTLC,,STTLC+1]
BLT T1,ENDLC ;. .
POP P,T1 ;Restore ac1
HLRZM T2,DEFBFS ;SAVE DEFAULT BUFFER SIZE
HRRZM T2,MXIFNR ;SAVE MAX IFN USER REQUESTED
HRLZM T3,PRGABR ;Save 3-letter program abbreviation
IFN TOPS20,<
TXNE T1,IT%UES ;USE EXTENDED SECTIONS?
JRST [XMOVEI T2,. ;Yes, is this a non-zero section?
TLNE T2,-1
SETOM USEXEX ;Yes, set flag
JRST .+1] ;Else don't set flag
>;END IFN TOPS20
MOVE T1,DEFBFS ;GET DEFAULT BUFFER SIZE
CAILE T1,^D512 ;BIGGER THAN 1 SECTION?
JRST ITINI0 ;YES, COMPLAIN
MOVE T1,MXIFNR ;GET MAX IFN USER REQUESTED
CAILE T1,MAXIFN ;TOO BIG?
JRST ITINI1 ;YES, COMPLAIN
;Call memory manager initialize routine
DMOVEM T3,USR34 ;SAVE USER'S 3 AND 4
MOVX T1,MM%CRM ;We can cut back memory if necessary
IFN TOPS20,<
SKIPN USEXEX ;SHOULD WE USE EXTENDED ADDRESSING?
TXO T1,MM%UXS ;YES, USE EXTENDED SECTIONS
XMOVEI T3,$ITRMU ;Addr of routine to "return mem usage"
XMOVEI T4,$ITCBM ;Addr of routine to "cut back memory"
>;END IFN TOPS20
IFE TOPS20,<
MOVEI T3,$ITRMU ;Addr of routine to "return mem usage"
MOVEI T4,$ITCBM ;Addr of routine to "cut back memory"
>;end IFE TOPS20
MOVE T2,[SIXBIT/IOTMP/] ;This module's name
PUSHJ P,INITMU ;CALL ROUTINE
JUMPN T1,RT1R34 ;RETURN STATUS 1 IF MEM MANAGER DID
JRST RT0R34 ;ALL OK, RETURN STATUS 0
;$ITINI errors
;These are calling errors and so types "?IOTMP.."
ITINI0: TYPE INIEH ;TYPE ERROR HEADER
TYPE [ASCIZ/ Default buffer size requested larger than 512. pages
/]
JRST RETST1 ;RETURN STATUS 1
ITINI1: TYPE INIEH ;TYPE HEADER
TYPE [ASCIZ/ Max IFN requested larger than MAXIFN
/]
JRST RETST1 ;RETURN STATUS 1
;HEADER FOR ITINI ERRORS
INIEH: $TEXT <?IOTMP routine $ITINI cannot proceed:
>
SUBTTL $ITOPO--Open output
;CALL:
; 1/ PTR TO ARG BLOCK
;ARG BLOCK:
; +0/ FLAGS,,IFN ;Flags: IT%OEF
; +1/ BYTE SIZE,,NUMBER PAGES TO KEEP IN CORE
; +2/ IF IT%OEF SET, TOPS20= JFN, TOPS10= PTR TO FILOP. BLOCK
; +3/ (18-bit) Address of ASCIZ generic name of file
;RETURNS:
; .+1
; 1/ STATUS 0=OK, 1= PROBLEM
$ITOPO: DMOVEM T1,USR12 ;SAVE SOME ACS
DMOVEM T3,USR34 ;. .
HRRZ T4,0(T1) ;GET IFN
IMULI T4,IT.SIZ ;GET PTR TO ENTRY
HLLZ T2,0(T1) ;Get user's input flags
TXNN T2,IT%OEF ;Open external file?
JRST [SETZM OPFEXT ;No, clear flag
JRST .+2]
SETOM OPFEXT ;"OPENING AN EXTERNAL FILE" FLAG
PUSHJ P,GETGNN ;Get generic name of file
;Make a couple error checks
MOVE T3,IFNSTR+IT.FLG(T4)
TXNE T3,IT%OPI!IT%OPO ;File already open?
JRST FILALO ;Yes, complain
HLRZ T2,1(T1) ;Get byte size
CAIL T2,1 ;Must be between 1 and ^D36
CAILE T2,^D36
JRST BYTSZB ;Not, complain
MOVEM T2,SVBYTS ;SAVE BYTE SIZE FOR LATER
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),11]
SETZM IFNSTR+IT.NPD(T4) ;Clear # pages written
SETZM IFNSTR+IT.FSZ(T4) ;Set file size to 0
SKIPN OPFEXT ;Is this an external file?
JRST ITOPO2 ;No, skip some code
IFN TOPS20,<
HRRZ T2,2(T1) ;JFN must be supplied
JUMPE T2,JFN0O ;JFN supplied is 0
MOVEM T2,IFNSTR+IT.JFN(T4)
>
IFE TOPS20,<
MOVE T2,2(T1) ;FILOP. address must be supplied
MOVEM T2,IFNSTR+IT.FBA(T4)
>
HLLZ T2,0(T1) ;Get user's flags again
MOVX T3,IT%EXF ;"External file" flag
IFE TOPS20,<
PUSHJ P,DVCHRR ;Always get dev. char on TOPS-10
JRST RT1R34 ;Problem, return status 1
; JRST ITOPO0 ;Return with bits set in T3
>;END IFE TOPS20
IFN TOPS20,<
TXNN T2,IT%DSK!IT%TTY!IT%NUL ;Did user say whether this is a
; disk or tty file?
JRST [PUSHJ P,DVCHRR ;No, find out
JRST RT1R34 ;Problem, return status 1
JRST ITOPO0] ;Return with bits set in T3
TXNE T2,IT%DSK ;File a disk file?
TXO T3,IT%FDS ;Yes
TXNE T2,IT%TTY ;File a TTY file?
TXO T3,IT%FTY ;Yes
TXNE T2,IT%NUL ;File on NUL:?
TXO T3,IT%FNL ;Yes
>;END IFN TOPS20
ITOPO0: IORM T3,IFNSTR+IT.FLG(T4) ;Set flags
TXNE T3,IT%FDS ;Skip if not DISK file
JRST ITOPO2 ;Go get memory for it
SETZM IFNSTR+IT.CCT(T4) ;Set char count to 0
TXNE T3,IT%FNL ;If NUL:
JRST ITOPO9 ;Finish
PUSHJ P,ITOEXO ;Open file for output
JRST RT1R34 ;Error, return status 1
JRST ITOPO9 ;Finish
;Temp file or external file that requires memory
;Try to get some memory for it
ITOPO2: HRRZ T2,1(T1) ;Get # pages requested
CAIN T2,0 ;0 (use default?)
MOVE T2,DEFBFS ;Yes, get default #
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;Remember in file block
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),35] ;# pages "in use"
SETZ T1, ;No flags
SKIPN USEXEX ;Should we use extended addressing?
TXO T1,MM%GSS ;No, tell memory manager to use same section
PUSHJ P,FINFRE ;Try to get the memory
JUMPN T1,NMEMO ;Not enough memory to open file
MOVEM T2,SVMADR ;Save memory address we got
;Setup byte pointers to the memory
IFN TOPS20,<
SKIPN USEXEX ;Use extended addressing?
JRST ITOPO3 ;No, non-extended
SETZB T1,T2 ;Create starting bp in T1, t2
HRLI T1,440040 ;Start of global byte ptr
MOVE T3,SVBYTS ;Saved byte size
DPB T3,[POINT 6,T1,11] ; in first word
MOVE T2,SVMADR ;Saved global address in 2nd word
DMOVEM T1,IFNSTR+IT.CBP(T4) ;Store Current bp.
DMOVEM T1,IFNSTR+IT.SBP(T4) ;Save starting B.P.
JRST ITOPO4 ;SKIP single-word BP calc
>;END IFN TOPS20
;Setup local byte pointers
ITOPO3: SETZB T1,T2 ;Create bp's in t1, t2
HRLI T1,440000 ;byte ptr stuff
MOVE T3,SVBYTS ;GET SAVED BYTE SIZE
DPB T3,[POINT 6,T1,11]
HRR T1,SVMADR ;GET MEMORY ADDRESS
MOVEM T1,IFNSTR+IT.CBP(T4) ;Current BP at start
MOVEM T1,IFNSTR+IT.SBP(T4) ;Starting B.P.
ITOPO4: PUSHJ P,SETTCT ;Setup IT.TCT
MOVEM T1,IFNSTR+IT.CCT(T4) ;Store current character count
SKIPN OPFEXT ;Skip if opening an external file
JRST ITOPO9 ;No, skip this
PUSHJ P,ITOEXO ;Do the OPEN..
JRST RT1R34 ;Failed.. return status 1
;Logical OPEN OUTPUT is successful
ITOPO9: MOVX T3,IT%OPO ;Set "File is open for output" bit
IORM T3,IFNSTR+IT.FLG(T4)
JRST RT0R34 ;Restore user's 3&4, return status 0
;Errors
FILALO: $FERR (FAO,<Can't open ^8 because:
File is already open>)
JRST RT1R34 ;Return status 1
BYTSZB: $FERR (BSE,<Can't open ^8 because:
Byte size not between 1 and 36>)
JRST RT1R34 ;Return status 1
;Memory manager returned a non-zero status
;Status is in T1
NMEMO: CAIN T1,2 ;User error?
JRST RT1R34 ;Restore 3&4 and return status 1
$FERR (NEM,<Not enough memory for buffers;
can't open ^8 for output>)
JRST RT1R34 ;Return status 1
IFN TOPS20,<
JFN0O: $FERR (JS0,<Can't open ^8 because:
JFN supplied is 0>)
JRST RT1R34 ;Return status 1
>
;DVCHRR - Routine to find out device characteristics
;Call:
; T4/ ptr to file block
; IT.JFN/ JFN
;-or- IT.FBA/ FILOP. block address
;Call:
; PUSHJ P,DVCHRR
; <return here if can't get device characteristics, or unsupported device>
; <return here if OK>
;If routine skips, it returns:
; T3/ OR'd bits IT%FTY or IT%FDS
;Preserves T1
;Uses T2
DVCHRR: PUSH P,T1 ;Preserve T1
IFN TOPS20,<
MOVE T1,IFNSTR+IT.JFN(T4) ;Get JFN
PUSH P,T3 ;Save T3
DVCHR% ;Get characteristics of device
ERJMP DVCHRF ;Problem with DVCHR
POP P,T3 ;Restore T3
LDB T2,[POINTR T2,DV%TYP] ;Get device type
CAIN T2,.DVDSK ;Is it a disk?
JRST [IORX T3,IT%FDS ;Yes, set flag
JRST DVCHR1]
CAIN T2,.DVTTY ;Terminal?
JRST [IORX T3,IT%FTY ;Yes, set flag
JRST DVCHR1]
CAIN T2,.DVNUL ;NUL:?
JRST [IORX T3,IT%FNL ;Yes, set flag
JRST DVCHR1]
JRST UNSDEV ;?Unsupported device
;DVCHR JSYS failed
DVCHRF: POP P,T3 ;restore T3
$FERR (JSE,<Can't open ^8 because:
DVCHR% JSYS failed: ^1>)
JRST DVCHRB
>;END IFN TOPS20
IFE TOPS20,<
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. addr
MOVE T1,.FODEV(T1) ;Get device name
MOVEM T1,SIXBW1 ;Save incase errors
DEVCHR T1, ;Get characteristics
JUMPE T1,DVCHRF ;Failed
MOVEM T1,IFNSTR+IT.DVC(T4) ;Save device characteristics
TXC T1,DV.DSK!DV.MTA ;Is device NUL:?
TXCN T1,DV.DSK!DV.MTA
JRST [IORX T3,IT%FNL ;Yes, set flag
JRST DVCHR1] ;Return
TXNE T1,DV.DSK ;Is device a disk?
JRST [IORX T3,IT%FDS ;Yes, set flag
JRST DVCHR1] ;Return
TXNE T1,DV.TTY ;Is device a TTY:?
JRST [IORX T3,IT%FTY ;Yes, set flag
JRST DVCHR1] ;Return
JRST UNSDEV ;?Unsupported device
DVCHRF: $FERR (NSD,<No such device: ^6>)
JRST DVCHRB ;"Bad return"
>;end IFE TOPS20
;Unsupported device
UNSDEV: $FERR (DNS,<Can't open ^8:
Specified device is not supported>)
JRST DVCHRB ;. .
;Good return from DVCHRR
DVCHR1: POP P,T1 ;Restore T1
AOS (P) ;Skip return
POPJ P, ;. .
;Bad return from DVCHRR
DVCHRB: POP P,T1 ;RESTORE T1
POPJ P, ;"Bad" return
;ITOEXO: Routine to OPEN external file for output
;Call:
; T4 points to file block
; PUSHJ P,ITOEXO
; <here if errors, message typed>
; <here if ok>
;Uses T1, t2
IFN TOPS20,<
ITOEXO: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FDS ;Is device a disk?
JRST [MOVX T2,<OF%WR> ;Just set write bit
JRST ITOEO2]
TXNE T1,IT%FTY ;Device a tty:
JRST [MOVX T2,<<7B5>+OF%WR> ;Write, 7-bit bytes
JRST ITOEO2]
; ** code here if more devices are supported **
ITOEO2: MOVE T1,IFNSTR+IT.JFN(T4) ;Get JFN
OPENF% ;** OPEN the device **
ERJMP ITOEE3 ;? Problem, go see
JRST CPOPJ1 ;Good return
;Errors opening external file for output
;OPENF error code is in T1
ITOEE3: CAIE T1,OPNX10 ;Entire file structure full?
CAIN T1,OPNX23 ;Disk quota exceeded?
JRST ITOEOQ ;Yes
$FERR (COF,<Can't open ^8 because:
OPENF% JSYS failed: ^1>)
POPJ P, ;Single return
;Disk quota problems, allow him to fix it and continue
ITOEOQ: $FERR (QEX,<^1
(Type "CONTINUE" when the problem has been fixed)>)
HALTF%
JRST ITOEO2 ;Go do OPENF again, T2 is still OK
>;END IFN TOPS20
;And now, repeating for TOPS10:
;Call:
; T4 points to file block
; PUSHJ P,ITOEXO
; <here if errors, message typed>
; <here if OK>
;Uses t1, t2
IFE TOPS20,<
ITOEXO: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FDS ;Is device a disk?
MOVEI T2,.IODMP ;Yes, use dump mode
TXNE T1,IT%FTY ;Is device a TTY:?
MOVEI T2,.IOASC ;Yes, use ASCIZ mode
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
MOVEM T2,.FOIOS(T1) ;Store open mode
MOVEI T2,.FOWRT ;Function code (Write the file)
HRRM T2,.FOFNC(T1) ;Store function code
HRLI T1,.FOPAT+1 ;Length of arg list
FILOP. T1, ;** OPEN the file for create **
JRST ITOXE1 ;?Error return
JRST CPOPJ1 ;OK return
;FILOP. failed
ITOXE1: MOVEM T1,FLPERR ;Store FILOP. error
$FERR (CEF,<Can't enter ^8 because:
FILOP. UUO failed: (^A) -- ^B>)
POPJ P, ;Single (error) return
>;END IFE TOPS20
;SETTCT - Routine to setup IT.TCT
;Also returns the number in T1
;Uses t1,t2,T3
;Inputs:
; t4/ pointer to file block
; IT%NPB byte/ # pages in buffer
; SVBYTS/ byte size (bits)
;Call:
; PUSHJ P,SETTCT
; <return here always>
SETTCT: LDB T1,[POINT 6,IFNSTR+IT.FLG(T4),5] ;Get # pages used
LSH T1,^D9 ;Get # words used
MOVEI T2,^D36 ;BITS/WORD
IDIV T2,SVBYTS ; BITS/WORD / BITS/BYTE = BYTES/WORD
IMUL T1,T2 ;GET bytes/buffer
MOVEM T1,IFNSTR+IT.TCT(T4) ;Store total character count
POPJ P, ;Return with count in T1
SUBTTL $ITOPI - Open input
;Call:
; 1/ ptr to arg block
;Arg block:
; +0/ Flags,,IFN
; +1/ Byte size,,number pages to keep in core
; +2/ If IT%OEF set, TOPS20 = JFN, TOPS10= Ptr to FILOP. block
; +3/ 18-bit address of generic name of file
;Returns:
; .+1
; 1/ Status 0=OK, 1= problem (message typed)
$ITOPI: DMOVEM T1,USR12 ;SAVE SOME ACS
DMOVEM T3,USR34 ;. .
HRRZ T4,0(T1) ;GET IFN
IMULI T4,IT.SIZ ;GET PTR TO ENTRY
HLLZ T2,0(T1) ;Get user flags
TXNN T2,IT%OEF ;Opening external file?
JRST [SETZM OPFEXT ;No, clear flag
JRST .+2]
SETOM OPFEXT ;Yes, set flag
PUSHJ P,GETGNN ;Go get generic name of file
;Make a couple error checks
MOVE T3,IFNSTR+IT.FLG(T4)
TXNE T3,IT%OPI!IT%OPO ;File already open?
JRST FILALI ;Yes, complain
HLRZ T2,1(T1) ;Get byte size
CAIL T2,1 ;Check limits
CAILE T2,^D36
JRST BYTSZI ;No good, complain
MOVEM T2,SVBYTS ;Save byte size for later
SKIPE OPFEXT ;Opening an external file?
JRST ITOPIE ;Yes, go open it
TXNN T3,IT%WRT ;Is file logically written?
JRST FILNWR ;No, complain
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;GET BYTE SIZE
CAME T2,SVBYTS ;MUST BE SAME AS OLD BYTE SIZE
JRST NOTSMB ;?No, complain
SKIPE IFNSTR+IT.NPD(T4) ;Any pages written to disk?
JRST ITOPI2 ;Yes, same actions as an external file
MOVE T1,IFNSTR+IT.FSZ(T4) ;File size is limit
MOVEM T1,IFNSTR+IT.CCT(T4) ;= char count in this buffer
DMOVE T1,IFNSTR+IT.SBP(T4) ;Set current byte ptr
DMOVEM T1,IFNSTR+IT.CBP(T4) ; To starting byte ptr
JRST ITPI2A ;Skip some code for disk case
;Some pages had been written to disk
;That means that the whole file is written to disk
ITOPI2: DMOVE T1,IFNSTR+IT.SBP(T4) ;Set current byte ptr
DMOVEM T1,IFNSTR+IT.CBP(T4) ; To starting byte ptr
HLLZS IFNSTR+IT.NPD(T4) ;Set #pages read so far= 0
SETZM IFNSTR+IT.CCT(T4) ;Set char count to 0, so first input
; will read the pages in
IFE TOPS20,<
PUSHJ P,USTTI1 ;USETI file to block 1
JRST RT1R34 ;?Error, return status 1
>;END IFE TOPS20
ITPI2A: PUSHJ P,SETTCT ;Setup total char count
;Finished setting up file block
ITOPI3: MOVX T1,IT%OPI ;Set "File is open for input"
IORM T1,IFNSTR+IT.FLG(T4)
JRST RT0R34 ;Restore acs, return status 0
IFE TOPS20,<
;USTTI1 - USETI file to block 1
;Called when a temp file has been written to disk and
; now we want to read it back in.
;Call:
; PUSHJ P,USTTI1
; <here if errors, message typed>
; <here if OK>
;Uses T1-T3
USTTI1: MOVEI T1,1 ;Get block number to position to
MOVEM T1,FLP1AG+1 ;Store in FILOP. arg block
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get ptr to FILOP. block
LDB T1,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZM T1,FLP1AG ;Store channel number
MOVEI T1,.FOUSI ;Perform "USETI" call
HRRM T1,FLP1AG
MOVE T1,[2,,FLP1AG]
FILOP. T1, ;** Position file **
JRST USTT1E ;?Error
JRST CPOPJ1 ;OK return
;FILOP. failed
USTT1E: MOVEM T1,FLPERR ;Store error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get filename to type
MOVEM T1,EFNPTR ;Store for error message printer
$FERR (EPF,<Error positioning ^8:
FILOP. UUO (USETI) failed, error (^A) -- ^B>)
POPJ P, ;Error return
>;END IFE TOPS20
;Here to open external file for input
;T4 points to file block
;T1 points to user input block
ITOPIE:
IFN TOPS20,<
HRRZ T2,2(T1) ;JFN must be supplied
JUMPE T2,JFN0I ;JFN supplied is 0
MOVEM T2,IFNSTR+IT.JFN(T4)
>
IFE TOPS20,<
MOVE T2,2(T1) ;FILOP. address must be supplied
MOVEM T2,IFNSTR+IT.FBA(T4)
>
HLLZ T2,0(T1) ;Reget input flags
MOVX T3,IT%EXF ;"External file" flag
IFE TOPS20,<
PUSHJ P,DVCHRR ;Always get dev. char on TOPS-10
JRST RT1R34 ;Problems, return status 1
; JRST ITOPI4 ;Return with bits set in T3
>;END IFE TOPS20
IFN TOPS20,<
TXNN T2,IT%DSK!IT%TTY!IT%NUL ;Did user say whether this is a
; disk or tty file?
JRST [PUSHJ P,DVCHRR ;No, find out
JRST RT1R34 ;Problem, return status 1
JRST ITOPI4] ;Return with bits set in T3
TXNE T2,IT%DSK ;File a disk file?
TXO T3,IT%FDS ;Yes
TXNE T2,IT%TTY ;File a TTY file?
TXO T3,IT%FTY ;Yes
TXNE T2,IT%NUL ;File on NUL:?
TXO T3,IT%FNL ;Yes
>;END IFN TOPS20
ITOPI4: IORM T3,IFNSTR+IT.FLG(T4) ;Set flags
MOVE T2,SVBYTS ;Get saved byte size
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;Save in entry
TXNE T3,IT%FDS ;Is file a DSK: file?
JRST GMEXTI ;Yes, go get memory for it
SETZM IFNSTR+IT.CCT(T4) ;Set char count to 0
TXNE T3,IT%FNL ;Is file on NUL:?
JRST ITOPI3 ;Yes, return now
SKIPE ITTFOP ;Make sure another TTY: file is not opened
JRST ANOTFO ;Can't do it
PUSHJ P,ITOEXI ;** OPEN file**
JRST RT1R34 ;Error, return status 1
SETOM ITTFOP ;Set flag saying TTY: file is open for input
JRST ITOPI3 ;Set bit saying file is open, return
;Get memory for it
GMEXTI: HRRZ T2,1(T1) ;Get # pages requested
CAIN T2,0 ;0 (Use default) ?
MOVE T2,DEFBFS ;Yes, get default #
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;Remember in file block
SETZ T1, ;No flags
SKIPN USEXEX ;Extended addressing?
TXO T1,MM%GSS ;No, tell memory manager to use same section
PUSHJ P,FINFRE ;Try to get the memory
JUMPN T1,NMEMI ;Not enough memory to open file
MOVEM T2,SVMADR ;Save memory address we got
PUSHJ P,ITOEXI ;** Physical open file for input**
JRST [PUSHJ P,RMEMSV ;?Failed, release the memory
JRST RT1R34] ; and go return status 1
PUSHJ P,SETTCT ;Setup total char count (per buffer)
;Setup starting byte pointer
IFN TOPS20,<
SKIPN USEXEX ;Extended addressing?
JRST ITOPI5 ;No
SETZB T1,T2 ;Create starting bp in T1, t2
HRLI T1,440040 ;Start of global byte ptr
MOVE T3,SVBYTS ;Saved byte size
DPB T3,[POINT 6,T1,11] ; in first word
MOVE T2,SVMADR ;Saved global address in 2nd word
DMOVEM T1,IFNSTR+IT.SBP(T4) ;Save starting byte ptr
JRST ITOPI6 ;Skip single-word BP calc.
>;END IFN TOPS20
;Setup starting byte pointer (a local pointer)
ITOPI5: HRLZI T1,440000 ;Create bp in T1
MOVE T3,SVBYTS ;Get saved byte size
DPB T3,[POINT 6,T1,11]
HRR T1,SVMADR ;Get memory address
MOVEM T1,IFNSTR+IT.SBP(T4) ;Save starting byte ptr
;Read in first buffer, set character count
ITOPI6: SETOM IFNSTR+IT.NPD(T4) ;Set # pages written to -1
HLLZS IFNSTR+IT.NPD(T4) ;Set # pages read so far to 0
PUSHJ P,RDNBUF ;Read next buffer..
JRST [CAIN T1,2 ;EOF?
JRST ITOPI3 ;Yes, return OK
JRST RT1R34] ;Can't
JRST ITOPI3 ;OK, Set bit saying file is open, return
;Error routines for $ITOPI
FILALI: $FERR (FAO,<Can't open ^8 because:
File is already open>)
JRST RT1R34 ;Return status 1, restore user's acs
BYTSZI: $FERR (BSE,<Can't open ^8 because:
Byte size not between 1 and 36>)
JRST RT1R34 ;Return status 1
FILNWR: $FERR (RBW,<Can't open ^8 because:
Attempt to read temp file before writing it>)
JRST RT1R34 ;Return status 1
NOTSMB: $FERR (BSD,<Can't open ^8 because:
Input byte size differs from output byte size>)
JRST RT1R34 ;Return status 1
ANOTFO: $FERR (TFO,<Can't open ^8 because:
Can't open more than one TTY: file for input at the same time>)
JRST RT1R34 ;Return status 1
IFN TOPS20,<
JFN0I: $FERR (JS0,<Can't open ^8 because:
JFN supplied is 0>)
JRST RT1R34 ;Return status 1
>;END IFN TOPS20
;FINFRE returned a non-zero status
NMEMI: CAIN T1,2 ;User error?
JRST RT1R34 ;Message already typed
$FERR (NEM,<Can't open ^8 because:
Not enough memory for buffers>)
JRST RT1R34
;Release memory because file open failed.
;Address is in SVMADR, # pages is in file block.
;Uses T1, T2
RMEMSV: PUSH P,T3 ;Save T3
SETZ T1, ;No flags
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;Get # pages
MOVE T3,SVMADR ;Get address
PUSHJ P,RETRN ;** Return the memory **
POP P,T3 ;Restore T3
POPJ P, ;Return
;ITOEXI: Routine to OPEN external file for input
;Call:
; T4 points to file block
; PUSHJ P,ITOEXI
; <here if errors, message typed>
; <here if ok, IT.FSZ word setup>
;Uses T1, t2
IFN TOPS20,<
ITOEXI: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FDS ;Is device a disk?
JRST [MOVX T2,<OF%RD> ;Just set read bit
JRST ITOEI2]
TXNE T1,IT%FTY ;Device a tty:
JRST [MOVX T2,<<7B5>+OF%RD> ;Read, 7-bit bytes
JRST ITOEI2]
; ** code here if more devices are supported **
ITOEI2: MOVE T1,IFNSTR+IT.JFN(T4) ;Get JFN
OPENF% ;** OPEN the device **
ERJMP ITIEE3 ;? Problem, go see
MOVE T1,IFNSTR+IT.FLG(T4) ;GET FLAGS
TXNE T1,IT%FTY ;Is device a TTY:?
JRST CPOPJ1 ;Yes, just take good return
;Setup the IT.FSZ word
MOVE T1,IFNSTR+IT.JFN(T4) ;Find file's size
SIZEF% ;Get # of bytes written
ERJMP ITIEE4 ;?Problem
MOVEM T2,ITOSSZ ;Save file's size
PUSH P,T3 ;Save T3
MOVE T1,IFNSTR+IT.JFN(T4) ;Find byte size
MOVE T2,[1,,.FBBYV]
MOVEI T3,BYVWRD ;Store word here
GTFDB% ;Get bits/byte
ERJMP ITIEE5 ;?problem
POP P,T3 ;Restore T3
LDB T2,[POINT 6,BYVWRD,11] ;Get bits/byte written
CAMN T2,SVBYTS ;Just what we want to read?
JRST [MOVE T1,ITOSSZ ;Yes, just use size given
MOVEM T1,IFNSTR+IT.FSZ(T4)
JRST CPOPJ1] ;Go give good return
;Find # 36-bit words in the file
;T2= Bits/byte written
MOVEI T1,^D36 ;Bits/word
IDIV T1,T2 ;Get bytes/word
MOVE T2,ITOSSZ ;# bytes written
EXCH T1,T2
IDIV T1,T2 ;Get # words
SKIPE T2
ADDI T1,1 ;Round up to nearest word
MOVEM T1,ITOSSZ ;Save # words
;Find # bytes of new size that will be used
MOVEI T1,^D36 ;Bits/word
IDIV T1,SVBYTS ;Bytes/word
IMUL T1,ITOSSZ ; * # words = # BYTES
MOVEM T1,IFNSTR+IT.FSZ(T4) ;Save file size
JRST CPOPJ1 ;Good return
;TOPS20 Errors trying to open external file for input
ITIEE3: $FERR (JSE,<Can't open ^8 because:
OPENF% JSYS failed: ^1>)
POPJ P, ;Single return
ITIEE4: $FERR (JSE,<Can't open ^8 because:
SIZEF% JSYS failed: ^1>)
POPJ P, ;Single return
ITIEE5: POP P,T3 ;Restore T3
$FERR (JSE,<Can't open ^8 because:
GTFDB% JSYS failed: ^1>)
POPJ P, ;Single return
>;END IFN TOPS20
;Repeating the documentation for TOPS10:
;Call:
; T4 points to file block
; PUSHJ P,ITOEXI
; <here if errors, message typed>
; <here if OK, IT.FSZ word setup>
;Uses T1, T2
IFE TOPS20,<
;If supplied LOOKUP block is an extended block, he has to
; give TOPS-10 room to store .RBSIZ word.
ITOEXI: MOVE T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
HRRZ T1,.FOLEB(T1) ;Get addr of LOOKUP block
MOVE T1,(T1) ;Get first word
TLNE T1,-1 ;Extended block?
JRST ITOEX0 ;No, ok
ANDI T1,77777 ;Get size of block
CAIGE T1,.RBSIZ+1 ;Big enough?
JRST ITIXE0 ;?no, complain
ITOEX0: MOVE T1,IFNSTR+IT.FLG(T4) ;get flags
TXNE T1,IT%FDS ;Is device a disk?
MOVEI T2,.IODMP ;Yes, use dump mode
TXNE T1,IT%FTY ;Is device TTY:?
MOVEI T2,.IOASC ;yes, use Ascii mode
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
MOVEM T2,.FOIOS(T1) ;Save open mode
MOVEI T2,.FORED ;Function code (Read the file)
HRRM T2,.FOFNC(T1) ;Store function code
HRLI T1,.FOPAT+1 ;Length of arg list
FILOP. T1, ;** OPEN FILE FOR INPUT **
JRST ITIXE1 ;Error return
MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FTY ;TTY: file?
JRST CPOPJ1 ;Yes, just take good return
;setup IT.FSZ word
MOVE T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
HRRZ T1,.FOLEB(T1) ;Get addr of LOOKUP block
MOVE T2,0(T1) ;Get first word
TLNN T2,-1 ;Extended block?
JRST [MOVE T1,.RBSIZ(T1) ;Yes, get # words
JRST SZFNWD]
HLRE T1,3(T1) ;No, get size returned
JUMPL T1,[MOVN T1,T1 ;Get # words
JRST SZFNWD] ;Go store 'em
IMULI T1,^D128 ;Get # words
SZFNWD: MOVEM T1,ITOSSZ ;Save size of file
MOVEI T2,^D36 ;# bits/byte written
CAMN T2,SVBYTS ;Just what we want to read?
JRST [MOVEM T1,IFNSTR+IT.FSZ(T4) ;Yes, save size
JRST CPOPJ1] ;Give good return
;Find # bytes of new size that will be used
MOVEI T1,^D36 ;Bits/word
IDIV T1,SVBYTS ;Bytes/word
IMUL T1,ITOSSZ ; * # words = # bytes
MOVEM T1,IFNSTR+IT.FSZ(T4) ;Save file size
JRST CPOPJ1 ;Good return
;Extended LOOKUP block is too small
ITIXE0: $FERR (CRF,<Can't read from ^8 because:
Supplied extended LOOKUP block is too small - must have room for .RBSIZ word>)
POPJ P, ;Error return
;FILOP. error
ITIXE1: MOVEM T1,FLPERR ;Save FILOP. error code
$FERR (CRF,<Can't read from ^8 because:
FILOP. UUO failed: (^A) -- ^B>)
POPJ P,
>;END IFE TOPS20
SUBTTL GETGNN - Get generic filename and store byte ptr to it
;Call:
; T1/ pointer to arg list for $ITOPI or $ITOPO
; 3(T1) / address of ASCIZ generic name of file
; T4/ pointer to file block
; OPFEXT flag has been set to -1 if file is an external file
; PUSHJ P,GETGNN
; <return here always>
;Uses T2,T3 only
GETGNN: SKIPN T2,3(T1) ;Get address of ASCIZ name
JRST GETGN1 ;None supplied
IFN TOPS20,<
TLNE T2,-1 ;Is this an extended address?
JRST GETGN2 ;Yes, go make it a 2-word byte ptr
;It's a local address in the section of the caller
HLRZ T3,T1 ;Get section number of the arg list
XMOVEI T2,. ;Get my section number
HLRZ T2,T2 ;Put in RH(t2)
CAME T2,T3 ;Same section?
JRST [MOVE T2,3(T1) ;No, get address again
HLL T2,T1 ;Make a global address
JRST GETGN2] ;Go make a 2-word byte ptr
MOVE T2,3(T1) ;get address again
>;END IFN TOPS20
;Create a 1-word byte ptr to the address
GETGN3: HRLI T2,(POINT 7,)
MOVEM T2,IFNSTR+IT.GNP(T4) ;Store byte ptr in generic name pointer
MOVEM T2,EFNPTR ;Store here incase errors on OPEN, too
POPJ P, ;And return
;Here if no name supplied
GETGN1: MOVEI T2,[ASCIZ/file/] ;Get a generic name
SKIPN OPFEXT ;Is this a temp file?
MOVEI T2,[ASCIZ/temp file/] ;Yes, will say that
JRST GETGN3 ;Go store it with a 1-word bp
IFN TOPS20,<
;Here to create a 2-word byte ptr to the item and store it
GETGN2: MOVE T3,T2 ;Get address in 2nd word of byte ptr
MOVX T2,<^D36B5>+<7B11>+1B12 ;First word of 2-word bp.
DMOVEM T2,IFNSTR+IT.GNP(T4) ;Store byte ptr to generic file name
DMOVEM T2,EFNPTR ;Store incase errors on OPEN, too
POPJ P, ;Done, return
>;END IFN TOPS20
SUBTTL $ITOUB - Output 1 byte
;Call:
; 1/ IFN
; 2/ character
;Returns:
; 1/ Status 0= ok, 1= problem
$ITOUB: IMULI T1,IT.SIZ ;Get ptr to entry
ITOUB0: SOSGE IFNSTR+IT.CCT(T1) ;Still room in buffer?
JRST ITOUB1 ;No--see what to do
IDPB T2,IFNSTR+IT.CBP(T1) ;Store char
SETZ T1, ;Return status 0
POPJ P, ;. .
;# chars in buffer ran out
ITOUB1: SETZM IFNSTR+IT.CCT(T1) ;Clear char count
MOVEM T2,SVOUTB ;Save byte to output
MOVE T2,IFNSTR+IT.FLG(T1) ;Get flags
TXNE T2,IT%FTY!IT%FNL ;TTY or NUL: file?
JRST ITOUBT ;Yes
;Buffer ran out for disk file
PUSH P,T3 ;Save acs
PUSH P,T4
MOVE T4,T1 ;Set t4=ptr to file block
PUSHJ P,WRTBUF ;** Write out buffer **
SKIPA T2,[1] ;?Problems, set status to 1
SETZ T2, ;OK, set status to 0
MOVE T1,T4 ;Get t1=pointer to block
POP P,T4 ;Restore saved acs
POP P,T3
JUMPN T2,RETST1 ;If no good, return status 1
MOVE T2,SVOUTB ;Get saved output byte
JRST ITOUB0 ;Go output it (finally)
;File is TTY: or NUL:
ITOUBT: TXNE T2,IT%FNL ;NUL:?
JRST RETST0 ;Yes, return status 0 (OK)
;Here to write character to TTY: file
IFN TOPS20,<
PUSH P,T4 ;Save t4
MOVE T4,T1 ;Copy File block ptr
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
MOVE T2,SVOUTB ;Get byte
BOUT% ;Output the byte
ERJMP ITNBTE ;BOUT failed!
POP P,T4 ;Ok, restore T4
>
IFE TOPS20,<
OUTCHR SVOUTB ;Output the byte
>
JRST RETST0 ;Return status 0
IFN TOPS20,<
;Here if "BOUT" fails
ITNBTE: PUSH P,T3 ;Save T3
DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Error writing ^8:
BOUT% JSYS failed: ^1>)
POP P,T3 ;Restore T3
POP P,T4 ;Restore T4
JRST RETST1 ;Return status 1
>;END IFN TOPS20
;WRTBUF - Write out buffer for disk file
;Called when the buffer has filled up or you want to write out
; whatever is in buffer.
;If the file is currently not open, it is opened
;Inputs:
; t4/ ptr to file block
; IT.CCT/ # chars that can be still put in buffer
; IT.TCT/ total # chars that can be stored in full buffer
;Call:
; PUSHJ P,WRTBUF
; <return here if problem, message typed>
; <Return here if OK>
;Outputs:
; IT.CBP set to IT.SBP
; IT.CCT set to IT.TCT
;Uses:
;T1-T3
WRTBUF: DMOVE T1,IFNSTR+IT.CBP(T4) ;Save current BP
DMOVEM T1,SVBPWB ; Incase needed to store nulls
DMOVE T1,IFNSTR+IT.SBP(T4) ;Make BP be starting BP
DMOVEM T1,IFNSTR+IT.CBP(T4) ;. .
MOVE T1,IFNSTR+IT.TCT(T4) ;Get total # bytes that fit
MOVE T2,T1 ;Copy to T2
SUB T1,IFNSTR+IT.CCT(T4) ;Get # bytes written into buffer
JUMPE T1,CPOPJ1 ;Skip return if nothing to do
MOVEM T1,WTBUFC ;Save # chars written to buffer
ADDM T1,IFNSTR+IT.FSZ(T4) ;Update file size
MOVEM T2,IFNSTR+IT.CCT(T4) ;Restore char count remaining to max.
HLRZ T1,IFNSTR+IT.NPD(T4) ;Get #pages written so far
JUMPE T1,WRTBF1 ;Zero, might have to open file first
WRTBF0: CAMN T2,WTBUFC ;Writing max # chars?
JRST WRTBF2 ;Yes, use simple page IO
MOVEI T1,^D36 ;Bits/word
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;Bits/byte
IDIV T1,T2 ;Bytes/word
MOVE T2,WTBUFC ;Get # bytes to write
IDIV T2,T1 ;# words to write
JUMPE T3,LSTWOK ;Round up to nearest word
; Jump if we used the whole last word
ADDI T2,1 ;T2= # words to write
;T1= # bytes per word, T3= # bytes used in this word.
;We must make sure the rest of the word is zero (since we weren't
; being careful about making sure it started out null, for performance).
PUSH P,T2 ;Save T2
SUB T1,T3 ;T1= # bytes left to write
SETZ T2, ;Get a zero byte
IDPB T2,SVBPWB ;Put in this word
SOJG T1,.-1 ; Make rest of word null
POP P,T2 ;Restore T2
;Get here when last word of buffer is ok to write out
; i.e. the unused parts are null.
LSTWOK:
IFN TOPS20,<
;PMAP all the pages that contain something
TRZE T2,777 ;Round up to # pages
ADDI T2,1000
LSH T2,-^D9 ;T2= # pages to write
;Here to PMAP (T2) pages
WT2BF1: MOVE T3,T2 ;Get # pages
SKIPN T1,IFNSTR+IT.SBP+1(T4) ;Get starting process page #
HRRZ T1,IFNSTR+IT.SBP(T4) ; . .
LSH T1,-^D9 ; . .
HRLI T1,.FHSLF ;This process
HRLZ T2,IFNSTR+IT.JFN(T4) ;JFN of file in LH
HLR T2,IFNSTR+IT.NPD(T4) ;Page # in file in RH
TXO T3,PM%CNT!PM%RD!PM%WR ;Give page read and write access
;Acs T1-T3 set for PMAP now
WT2PMP: PMAP% ;** Write the file pages **
ERJMP WT2PMF ;?PMAP failed
HRRZ T3,T3 ;Get # pages written just then
HLRZ T2,IFNSTR+IT.NPD(T4) ;Update # pages written
ADD T2,T3
HRLM T2,IFNSTR+IT.NPD(T4) ; . .
JRST CPOPJ1 ;Give good return
;Output PMAP failed, possibly quota exceeded
WT2PMF: PUSH P,T1 ;Save acs
PUSH P,T2
PUSH P,T3
MOVEI T1,.FHSLF ;Get error code
GETER%
CAME T2,[.FHSLF,,PMAPX6] ;Disk quota exceeded?
CAMN T2,[.FHSLF,,IOX11] ;Quota exceeded or disk full?
JRST WT2PFQ ;Yes, allow him to fix the problem
DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Error writing ^8:
PMAP% JSYS failed: ^1>)
POP P,T3 ;Restore saved acs
POP P,T2
POP P,T1
POPJ P, ;Give popj return
WT2PFQ: $FERR (QEX,<^1
(Type "CONTINUE" when the problem has been fixed)>)
HALTF%
POP P,T3 ;Restore acs for PMAP
POP P,T2
POP P,T1
JRST WT2PMP ;Go try again
>;END IFN TOPS20
IFE TOPS20,<
;WRITE exactly (T2) words
WT1BF1: MOVN T2,T2 ;Get -n
HRLE T2,T2 ;GET -n,,-1
HRR T2,IFNSTR+IT.SBP(T4) ;Get -n,,addr
SUBI T2,1 ;Get IOWD n,addr
MOVEM T2,FLPDL ;Store 1st word of dump list
SETZM FLPDL+1 ;Clear 2nd word of dump list
MOVEI T1,FLPDL ;Point to FILOP. dump list
MOVEM T1,FLP1AG+1
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get ptr to FILOP. list
LDB T1,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZM T1,FLP1AG ;Store channel number
HRRI T1,.FOOUT ;Perform "OUT"
HRRM T1,FLP1AG ;Store function code
MOVE T1,[2,,FLP1AG] ;Point to arg list
FILOP. T1, ;Do FILOP.
JRST WTFLPE ;Error
;Update # pages written
HLRE T1,FLPDL ;Get word from dump list
MOVN T1,T1 ;T1= # words written
TRNE T1,777 ;Round up to nearest page
ADDI T1,1000
LSH T1,-^D9 ;# pages written
HLRZ T2,IFNSTR+IT.NPD(T4) ;# written up till now
ADD T2,T1
HRLM T2,IFNSTR+IT.NPD(T4) ;Update it
JRST CPOPJ1 ;Give good return
;FILOP. error on write
WTFLPE: MOVEM T1,FLPERR ;Store error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (EWF,<Error writing ^8:
FILOP. UUO error (^A) -- ^B>)
POPJ P, ;Give bad return
>;END IFE TOPS20
;Here if we are writing the max # pages
WRTBF2:
IFN TOPS20,<
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages in buffer
JRST WT2BF1 ;Go PMAP that # of pages
>;END IFN TOPS20
IFE TOPS20,<
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages in buffer
LSH T2,^D9 ;# words in buffer
JRST WT1BF1 ;Go write that many words
>;END IFE TOPS20
;Here if # pages written so far is 0
WRTBF1: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%EXF ;Is file an external file?
JRST WRTBF0 ;Yes, it's already open anyway.
PUSHJ P,OPNTMO ;Go open temp file for output
POPJ P, ;?Error, return .+1
MOVE T2,IFNSTR+IT.TCT(T4) ;Get total # bytes that fit
JRST WRTBF0 ;Go rejoin code
SUBTTL OPNTMO - OPEN temp file for output
;This is only necessary if we run out of space in the buffer
; we allocated to it. This routine is called from "WRTBUF" only.
;Inputs:
; t4/ points to file block
;Call:
; PUSHJ P,OPNTMO
; <return here if error, message typed>
; <return here if OK, file open>
;Uses T1-T3
IFN TOPS20,< ;TOPS20 "OPNTMO" routine
;A temp file is given the name "XXX.TMP.-1;T" and made invisible
OPNTMO: MOVE T2,[POINT 7,[ASCIZ/XXX.TMP.-1;T/]]
SETZM TMOTRY ;Number of tries so far = 0
OPNTX0: MOVX T1,GJ%SHT!GJ%FOU ;Next generation number, please
GTJFN% ;Get handle on a temp file
ERJMP OTME01 ;Can't
MOVEM T1,OTMJFN ;Save it
;Open file for I/O so it can remain open until we are done with it.
; This is necessary because we are going to set the deleted bit and
; don't want someone to "EXPUNGE" when it is closed but we are not done.
OPNTXX: MOVE T2,[<^D36>B5+OF%RD!OF%WR] ;OPEN for I-O
OPENF% ;So file can stay open
ERJMP OTME02 ;Can't
;Set the "deleted" bit in the FDB. This is done so if the user types
; CTRL/C, "RESET", the file will not be left around in the directory. The
; pages will still be allocated, but there isn't anything practical
; that we can do about that.
MOVX T1,<<.FBCTL>B17> ;Change this word in the FDB
HRR T1,OTMJFN ;For this file
MOVX T2,FB%DEL ;"File is deleted" bit
MOVX T3,FB%DEL ;Turn it on
CHFDB% ;Change the FDB word..
ERJMP OTME03 ;Can't
;Do an "Update file pages" JSYS so the file will exist. This must
; be done in order to avoid the "simultaneous access" error if more
; than one of these temp files is open at once.
UFPGXX: HRLZ T1,OTMJFN ;Update file pages to make the file appear
SETZ T2,
UFPGS%
ERJMP OTME04 ;Can't
;All ok!
MOVE T1,OTMJFN ;Copy JFN to block
MOVEM T1,IFNSTR+IT.JFN(T4) ; . .
JRST CPOPJ1 ;Give good return
;Errors for TOPS20 OPNTMO routine
OTME01: $FERR (JSE,<Can't open ^8 because:
GTJFN% JSYS failed: ^1>)
POPJ P,
OTME02: CAIE T1,OPNX10 ;Entire file structure full?
CAIN T1,OPNX23 ;Disk quota exceeded?
JRST OTME2Q ;Yes, go let him fix it and continue
CAIN T1,OPNX9 ;Invalid simultaneous access?
JRST OTME2S ;Yes, got into the race condition,
; go try another filename
OTME2E: $FERR (JSE,<Can't open ^8 because:
OPENF% JSYS failed: ^1>)
POPJ P,
;OPENF% failed because of quota exceeded
OTME2Q: $FERR (QEX,<Can't open ^8 - ^1
(Type "CONTINUE" when the problem has been fixed)>)
HALTF%
MOVE T1,OTMJFN ;Get back JFN
JRST OPNTXX ;Go try OPENF again
;OPENF% failed because of invalid simultaneous access
;Note that this should only happen if there are two users on the system
; and one has opened a file with the same name as this user but has not
; done an "UPFGS" JSYS yet. We will simply pick another name, try that,
; and if it continues to fail the same way we'll just give the error.
OTME2S: AOS T1,TMOTRY ;Increment number of tries
CAILE T1,.TMTMX ;Tried too many times?
JRST OTME2E ;Yes, go give an error (don't get caught
; in infinite loop!)
MOVE T1,OTMJFN ;Release JFN we got before
RLJFN%
ERJMP .+1 ;This should not happen
MOVEI T1,^D100 ;Sleep for a fraction of a second
DISMS%
GTAD% ;Return current date and time
ANDI T1,3 ;Get random number 0 to 3
MOVE T2,OTMFNS(T1) ;Get a random filename
JRST OPNTX0 ;Go try again
OTMFNS: POINT 7,[ASCIZ/YXX.TMP.-1;T/]
POINT 7,[ASCIZ/ZXX.TMP.-1;T/]
POINT 7,[ASCIZ/WXX.TMP.-1;T/]
POINT 7,[ASCIZ/UXX.TMP.-1;T/]
OTME03: $FERR (JSE,<Can't open ^8 because:
CHFDB% JSYS failed: ^1>)
POPJ P,
OTME04: CAIN T1,IOX11 ;Quota exceeded?
JRST OTME4Q ;Yes, give him a chance to fix it
$FERR (JSE,<Can't open ^8 because:
UFPGS% failed: ^1>)
POPJ P,
OTME4Q: $FERR (QEX,<Can't open ^8: ^1
(Type "CONTINUE" when the problem has been fixed)>)
HALTF%
JRST UFPGXX ;Go do the JSYS again
>;END IFN TOPS20
IFE TOPS20,< ;TOPS10 "OPNTMO" routine
;This is only necessary if we run out of space in the buffer
; we allocated to it. This routine is called from "WRTBUF" only.
;Inputs:
; t4/ points to file block
;Call:
; PUSHJ P,OPNTMO
; <return here if error, message typed>
; <return here if OK, file open>
;Uses T1-T3
OPNTMO: SETZM TMOTRY ;# tries so far = 0
OPNT00: PUSHJ P,SETFLB ;Setup temp FILOP. block
PUSHJ P,GTMPNM ;Get temp name and put in FILOP. block
OPNTM0: MOVEI T1,.FOSAU ;"Update file, single-access mode"
HRRM T1,IFNSTR+IT.SFB+.FOFNC(T4)
MOVEI T1,.IODMP ;Dump-mode IO
MOVEM T1,IFNSTR+IT.SFB+.FOIOS(T4)
HRLI T1,.FOPAT+1 ;Length of arg block
HRRI T1,IFNSTR+IT.SFB(T4) ;Addr of arg block
FILOP. T1, ;** OPEN FILE FOR UPDATE **
JRST OTM0FE ;Error
JRST CPOPJ1 ;Return OK
;FILOP. UUO failed
OTM0FE: CAIN T1,ERAEF% ;Tried to supersede?
JRST OTMNSE ;Yes, oh dear
;Dreadful error.
OTMDRD: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (UER,<Can't open ^8 because:
FILOP. UUO to open file for single-access update failed:
(^A) -- ^B>)
POPJ P,
;FILOP. UUO failed because of non-superseding error
;Get another filename and try again. If we already tried
; too many times with the same error, there must be something
; dreadfully wrong, so quit.
OTMNSE: AOS T2,TMOTRY ;Count # tries
CAIN T2,.TMTMX ;Too many?
JRST OTMDRD ;yes, just give FILOP. error
JRST OPNT00 ;Go try again
;Setup temp FILOP. block
;Inputs:
; T4/ file block address
;Call:
; PUSHJ P,SETFLB
; <return here always>
;USES T1-T3
SETFLB: MOVEI T1,IFNSTR+IT.SFB(T4) ;Get address of start of FILOP. block
MOVEM T1,IFNSTR+IT.FBA(T4) ;Store it
SETZM (T1) ;Clear it out
HRL T2,T1
HRRI T2,1(T1)
BLT T2,IFNSTR+IT.FBA+IT.FSZ-1(T4) ;Clear out whole FILOP. block
MOVSI T2,'DSK' ;Device name
MOVEM T2,IFNSTR+IT.SFB+.FODEV(T4) ;Store in FILOP. block
HRLI T2,IFNSTR+IT.SRB(T4) ;Start of rename block
HRRI T2,IFNSTR+IT.SLB(T4) ;,,Start of LOOKUP block
MOVEM T2,.FOLEB(T1) ;Store in FILOP. block
MOVEI T2,IFNSTR+IT.SPB(T4) ;Addr of returned PATH. block
MOVEM T2,.FOPAT(T1) ;Store in FILOP. block
HRLI T2,IFNSTR+IT.OBH(T4) ;Addr of output buffer header
HRRI T2,IFNSTR+IT.IBH(T4) ;,,addr of input buffer header
MOVEM T2,.FOBRH(T1) ;Store in FILOP. block
MOVX T2,FO.ASC+FO.PRV ;"Get extended channel"
;Also set FO.PRV to be consistant with
; TOPS20 when a user "ENABLE's".
MOVEM T2,.FOFNC(T1) ;Store in FILOP. block
MOVEI T2,IFNSTR+IT.SLP(T4) ;Start of LOOKUP path block
MOVEM T2,IFNSTR+IT.SLB+.RBPPN(T4) ;Store in LOOKUP block
MOVEI T2,.RBPRV+1 ;Size of LOOKUP/ENTER blocks needed
MOVEM T2,IFNSTR+IT.SRB+.RBCNT(T4) ;Store in RENAME block count word
TXO T2,RB.NSE ;Set "Non-supersede" ENTER
MOVEM T2,IFNSTR+IT.SLB+.RBCNT(T4) ;Store count word and flags
POPJ P, ;Done, return
;Get temp name and put in FILOP. block
;Inputs:
; T4/ file block address
;Uses t1-t3
;Call:
; PUSHJ P,GTMPNM
; <return here always>
GTMPNM: SKIPE SEED ;Already have a random seed?
JRST GTMPN1 ;Yes
MSTIME T1, ;Get time of day in milliseconds
HRRM T1,SEED ;Save RN seed
HRLM T1,SEED ; . .
GTMPN1: PUSHJ P,GTMWRD ;Get sixbit word in T1
MOVEM T1,IFNSTR+IT.SLB+.RBNAM(T4)
MOVSI T1,'TMP' ;.TMP
HLLZM T1,IFNSTR+IT.SLB+.RBEXT(T4)
POPJ P, ;Return
;Routine to get random sixbit word in T1
GTMWRD: SETZ T1, ;Start with nothing
PUSH P,T4 ;Save T4
MOVEI T4,6 ;# chars
GTMWR1: PUSHJ P,GTMCHR ;Get random char
LSH T1,6 ;Shift left six
ADDI T1,(T2) ;Add in char
SOJG T4,GTMWR1 ;Loop
POP P,T4 ;Restore T4
POPJ P, ;And return
;Routine to get random char in T2
;Uses T3
GTMCHR: MOVE T3,SEED ;Get current seed
ANDI T3,17 ;Just save last 4 bits
MOVEI T2,'A'(T3) ;Get letter
MOVE T3,SEED ;Get current seed
ROT T3,7 ;Rotate
ADD T3,T2 ;Add in value of letter
MOVEM T3,SEED ;Store new seed
POPJ P, ;Return
>;END IFE TOPS20
SUBTTL $ITINB - Input 1 byte
;Call:
; 1/ IFN
;Returns:
; 1/ Status 0= ok, 1= problem, 2=EOF
; 2/ character
$ITINB: IMULI T1,IT.SIZ ;Get ptr to entry
ITINB0: SOSGE IFNSTR+IT.CCT(T1) ;Still bytes in buffer?
JRST ITINB1 ;No--see what to do
ILDB T2,IFNSTR+IT.CBP(T1) ;Fetch byte
SETZ T1, ;Return status 0
POPJ P, ;. .
ITINB1: MOVE T2,IFNSTR+IT.FLG(T1) ;Get flags
TXNE T2,IT%FTY!IT%FNL ;Is file a TTY: or NUL: file?
JRST ITINBT ;Yes
;Buffer ran out for disk file
SKIPN IFNSTR+IT.NPD(T1) ;Any pages on disk?
JRST RETEOF ;No, return "EOF"
PUSH P,T3 ;Save T3
PUSH P,T4 ;Save T4
;Read another buffer from disk
PUSH P,T1 ;Save T1
MOVE T4,T1 ;Ptr to file block in T4
PUSHJ P,RDNBUF ; . .
JRST INBRE1 ;Failed..go see if EOF or other error
POP P,T1 ;restore T1
POP P,T4 ;Restore acs
POP P,T3
JRST ITINB0 ;Go read the byte now
;RDNBUF failed - EOF or fatal error
INBRE1: POP P,(P) ;Throw away AC1
POP P,T4 ;Restore acs
POP P,T3
;Status in T1 is exactly what I want to return now.
; i.e. 1= problem, 2= EOF
POPJ P, ;** Return, status is in T1 **
;Here to read character from NUL: or TTY: file
;Note: No acs saved so far
ITINBT: SETZM IFNSTR+IT.CCT(T1) ;Set # bytes in buffer again
TXNE T2,IT%FNL ;Is file NUL:?
JRST RETEOF ;Yes, return EOF
;TTY: file
IFN TOPS20,<
ITINT2: SOSGE TTYLCT ;Any more chars in line?
JRST TTYFGL ;No, read in a line
ILDB T2,TTYLBP ;Read a character
JRST ITINGT ;Got TTY: character
;Read in another line from TTY:
; (let him use CTRL/U and RUBOUT to edit the line)
TTYFGL: PUSH P,T4 ;SAVE T4
PUSH P,T3 ;Save T3
MOVE T4,T1 ;Save T1 incase errors
MOVE T2,[POINT 7,TLINE] ;Buffer pointer
MOVEM T2,TTYLBP ;Save BP to start of line
MOVE T1,[TXTILT,,TXTIBL] ;Copy virgin TEXTI block
BLT T1,TXTIBE ;Copy it
MOVEI T1,TXTIBL ;Use TEXTI% to read line
TEXTI% ;Do TEXTI%
ERJMP ITNBER ;? Error reading from TTY:
MOVE T2,TXTIBL+.RDDBC ;Get number of bytes in string (returned)
MOVEM T2,TTYLCT ;Save count
MOVE T1,T4 ;Get back file ptr
POP P,T3 ;Restore T3
POP P,T4 ;Restore T4
JRST ITINT2 ;Go back to get character
ITINGT:
>;END IFN TOPS20
IFE TOPS20,<
INCHWL T2 ;Read character to T2
>;END IFE TOPS20
CAIN T2,32 ;If character was Control-Z
JRST RETEOF ; Return EOF status
JRST RETST0 ;Character in T2, Return status 0
IFN TOPS20,<
ITNBER: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Error reading ^8:
TEXTI% JSYS failed: ^1>)
POP P,T3 ;Restore T3
POP P,T4 ;Restore T4
JRST RETST1 ;Return status 1
>;END IFN TOPS20
;RDNBUF - Read next buffer
;Inputs:
; T4/ points to file block
; RH(IT.NPD)/ number of pages read so far
; IT.FSZ/ File size
;Call:
; PUSHJ P,RDNBUF
; <return here if problems, message typed, or EOF (T1=2)>
; <return here if OK>
;Outputs:
; T1= status on POPJ return (1=problem, 2=EOF (no chars read))
; IT.CCT - character count
; IT.CBP - set to IT.SBP
; IT.NPD - updated
;Uses acs: T1, T2, T3
RDNBUF: DMOVE T1,IFNSTR+IT.SBP(T4)
DMOVEM T1,IFNSTR+IT.CBP(T4) ;setup current input byte ptr
MOVEI T1,^D36 ;Bits/word
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;bits/byte
IDIV T1,T2 ;Bytes/word
LSH T1,^D9 ;Bytes/page
MOVE T3,T1 ;Save this number
HRRZ T2,IFNSTR+IT.NPD(T4) ;# pages read so far
IMUL T1,T2 ;Bytes read so far
CAML T1,IFNSTR+IT.FSZ(T4) ;Greater or equal to total size of file?
JRST RDNBEF ;Yes, return "EOF"
;Setup IT.CCT
MOVE T2,IFNSTR+IT.FSZ(T4) ;Get total file size (bytes)
SUB T2,T1 ;Get # bytes left to read
CAMLE T2,IFNSTR+IT.TCT(T4) ;More than total # chars in buffer?
MOVE T2,IFNSTR+IT.TCT(T4) ;Yes, set byte count to this
MOVEM T2,IFNSTR+IT.CCT(T4) ;. .
;Read 'em in
;T2= # bytes to read in
;T3= # bytes/page
IFN TOPS20,<
IDIV T2,T3 ;Get total # pages to read in
SKIPE T3
ADDI T2,1 ;Round up
MOVE T3,T2 ;Save in T3
;Do PMAP% to read in pages
HRLZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
HRR T1,IFNSTR+IT.NPD(T4) ;# pages read so far = file page to read
SKIPN T2,IFNSTR+IT.SBP+1(T4) ;Get starting address of buffer
HRRZ T2,IFNSTR+IT.SBP(T4) ;(Non-extended byte ptr)
LSH T2,-^D9 ;Get page number in process
HRLI T2,.FHSLF ;Process handle in LH
TXO T3,PM%CNT+PM%RD ;Set bits
PMAP% ;Map the pages..
ERJMP RDBPER ;?Error
HRRZ T3,T3 ; Get # pages we read in
DPB T3,[POINT 6,IFNSTR+IT.FLG(T4),35] ;Set # pages "in use"
ADDM T3,IFNSTR+IT.NPD(T4) ;Update # pages read in
JRST CPOPJ1 ;Good return
RDBPER: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Error reading ^8:
PMAP% JSYS failed: ^1>)
MOVEI T1,1 ;Status 1
POPJ P, ;Return
>
IFE TOPS20,<
;T2= # bytes to read in
;T3= bytes/page
DMOVEM T2,RDNINF ;Save for a sec..
LSH T3,-^D9 ;Bytes/word
IDIV T2,T3 ;Get # words to read in
; (Should not have to round up)
MOVN T2,T2 ;Get -# words
HRLE T2,T2 ;Get -n,,-1
HRR T2,IFNSTR+IT.SBP(T4) ;Get -n,,addr
SUBI T2,1 ;Get IOWD N,addr
MOVEM T2,FLPDL ;Store 1st word in dump list
SETZM FLPDL+1 ;Clear 2nd word in dump list
MOVEI T1,FLPDL ;Point to FILOP. dump list
MOVEM T1,FLP1AG+1
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get ptr to FILOP. list
LDB T1,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZM T1,FLP1AG ;Store channel number
HRRI T1,.FOINP ;Perform "IN"
HRRM T1,FLP1AG ;Store function code
MOVE T1,[2,,FLP1AG] ;# args,,addr of arg list
FILOP. T1, ;Do FILOP.
JRST RDFLPE ;Error
;Update # pages read
DMOVE T2,RDNINF ;Get saved info
;T2= # bytes we read in
;T3= bytes/page
IDIV T2,T3 ;Total # pages
SKIPE T3 ;Round up
ADDI T2,1
DPB T2,[POINT 6,IFNSTR+IT.FLG(T4),35] ;# pages "in use"
ADDM T2,IFNSTR+IT.NPD(T4) ;Add to total read so far
JRST CPOPJ1 ;Good return
RDFLPE: MOVEM T1,FLPERR ;Store error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (ERF,<Error reading ^8:
FILOP. UUO error (^A) -- ^B>)
MOVEI T1,1 ;Set status to "bad error"
POPJ P, ;Error return
>;END IFE TOPS20
;Return "EOF"
RDNBEF: SETZM IFNSTR+IT.CCT(T4) ;Set char count to 0
MOVEI T1,2 ;EOF status
POPJ P, ;Single return
SUBTTL $ITOSB - Output string of bytes
;Call:
; 1/ IFN
; 2/ Number of bytes, or -1 to terminate at 0 byte
; 3/ byte ptr to bytes
; 4/ 2nd word of 2-word BP (if needed)
;Returns:
; 1/ status 0=ok, 1=problem
; 3 & 4/ preserved
$ITOSB: DMOVEM T3,USR34 ;Preserve ACs.
DMOVEM T3,STRNBP ;Save string byte-ptr
IMULI T1,IT.SIZ ;Get offset to file block info
MOVEM T1,ITOSFP ;Save ptr offset
JUMPL T2,ITOSB1 ;Jump if he wants to terminate at 0 byte
;Output a certain number of bytes
MOVEM T2,ITNBYT ;Save # of bytes
ITOSB0: SOSGE ITNBYT ;Bytes left to do?
JRST RT0R34 ;No, return status 0
MOVE T1,ITOSFP ;Call "output a char" routine
ILDB T2,STRNBP ; . .
PUSHJ P,ITOUB0 ; . .
JUMPE T1,ITOSB0 ;Loop if good status
JRST RT1R34 ;Else return status 1
;Output bytes until 0 byte
ITOSB1: ILDB T2,STRNBP ;Get another byte
JUMPE T2,RT0R34 ;Return status 0 when 0 byte gotten
MOVE T1,ITOSFP ;Call "output a char" routine
PUSHJ P,ITOUB0
JUMPE T1,ITOSB1 ;Loop if good status
JRST RT1R34 ;Else return status 1
SUBTTL $ITISB - Input string of bytes
;Call:
; 1/ IFN
; 2/ Number of bytes
; 3/ byte ptr to bytes
; 4/ 2nd word of byte pointer if needed
;Returns:
; 1/ status 0=ok, 1=problem, 2=EOF
; 2/ number of bytes requested that were not input
; 3 & 4/ preserved
$ITISB: DMOVEM T3,USR34 ;Save acs
DMOVEM T3,STRNBP ;Save string byte ptr
IMULI T1,IT.SIZ ;Get offset to file block
MOVEM T1,ITOSFP ;Save ptr offset
;Input (T2) bytes
MOVEM T2,ITNBYT ;Save # of bytes
ITISB0: SOSGE ITNBYT ;Bytes left to read?
JRST RT0R34 ;No, return status 0
MOVE T1,ITOSFP ;Call "Get a character" routine
PUSHJ P,ITINB0 ;. .
JUMPN T1,ITISB1 ;Non-zero status, go see why
IDPB T2,STRNBP ;Store the byte
JRST ITISB0 ;Loop for them all
;Non-zero status on input
ITISB1: MOVE T2,ITNBYT ;# bytes we didn't read
ADDI T2,1 ;. .
DMOVE T3,USR34 ;Restore acs 3,4
POPJ P, ;Return with same status
SUBTTL $ITPSF - Position file
;Call:
; 1/ IFN
; 2/ byte # to start at (0 = start of file)
;Returns:
; 1/ Status 0=ok, 1=problem, 2=file not that big
; 2/ smashed
$ITPSF: MOVEM T2,PSFBNM ;Save byte number
IMULI T1,IT.SIZ ;Point to block
MOVE T2,IFNSTR+IT.FLG(T1) ;Get flags
TXNN T2,IT%OPI ;Is file opened for input?
JRST ITPFE1 ;No, give error
TXNE T2,IT%FTY ;Is file a TTY: file?
JRST ITPFE2 ;Yes, complain
TXNE T2,IT%FNL ;Is file NUL:?
JRST [SKIPN PSFBNM ;Yes, do we want byte 0?
JRST RETST0 ;Yes, return status 0
JRST RETST2] ;No, return "Not within bounds"
;Position disk file opened for input
MOVE T2,IFNSTR+IT.FSZ(T1) ;Within bounds?
CAMGE T2,PSFBNM ; . .
JRST RETST2 ;No, return status 2
;Figure out which page contains this byte #.
; If it is in core, we don't have to do any physical I/O.
DMOVEM T3,USR34 ;Save acs 3, 4
MOVE T4,T1 ;T4= ptr to file block
;Get bytes/page
MOVEI T1,^D36 ;Bits/word
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;Get bits/byte
IDIV T1,T2 ;Bytes/word
MOVEM T1,PSFBPW ;Save bytes/word
LSH T1,^D9 ;Bytes/page
MOVEM T1,PSFBPP ;Save bytes/page
;What page number is this byte on?
MOVE T2,PSFBNM ;Get byte number
IDIV T2,T1 ;Get page number
MOVEM T2,PSFPNM ;Save page number
MOVEM T3,PSFBOF ;Save byte offset on page
;Is page in core?
HRRZ T1,IFNSTR+IT.NPD(T4) ;Get # pages read in so far
PUSH P,T1 ;Save this a sec.
LDB T3,[POINT 6,IFNSTR+IT.FLG(T4),35] ;Total # pages in core
SUB T1,T3 ;Get T1=First page # in core
SKIPGE T1
MOVEI T1,0 ;Min. is 0
POP P,T3 ;Get last page +1
SUBI T3,1 ;T3=Last page in core
CAML T2,T1 ;In core?
CAMLE T2,T3 ;. .
JRST ITPFNI ;No, have to do physical I/O
;Just position buffer
PUSHJ P,PSFBUF ;Position buffer pointers
JRST RT0R34 ;Return status 0, restore acs
;Must physically position file
ITPFNI: PUSHJ P,PSFPAG ;Position to proper page, read it in
JRST RT1R34 ;?Can't, return status 1
PUSHJ P,PSFBUF ;Position buffer pointers
JRST RT0R34 ;Return status 0, restore acs
;ITPSF errors
ITPFE1: DMOVEM T3,USR34 ;Save acs
DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (FNO,<Can't position ^8: File not opened for input>)
JRST RT1R34 ;Return status 1
ITPFE2: DMOVEM T3,USR34 ;Save acs
DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (FMD,<Can't position ^8: File must be a disk file>)
JRST RT1R34 ;Return status 1
;PSFBUF - Position buffer for $ITPSF
;Inputs:
; T4/ pointer to file block
; PSFPNM/ Page number (must be in core)
; PSFBOF/ Byte offset in page
; PSFBPP/ Bytes per page
; PSFBPW/ Bytes per word
;Call:
; PUSHJ P,PSFBUF
; <return here always>
;Outputs:
; IT.CCT
; IT.CBP
;Uses t1-t3
PSFBUF: HRRZ T1,IFNSTR+IT.NPD(T4) ;Get # pages read so far
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),35] ;# pages in buffer
SUB T1,T2 ;Get starting page number
SKIPGE T1 ;If less than 0,
MOVEI T1,0 ;Make starting page #0
MOVE T2,PSFPNM ;Get page number desired
SUB T2,T1 ;Get # pages to skip
LSH T2,^D9 ;# words to skip
MOVE T1,T2 ;Put in T1
MOVE T2,PSFBOF ;Get # bytes to skip in page
IDIV T2,PSFBPW ;# WORDS, t3 is remaining # bytes
ADD T1,T2 ;t1= total # words to skip
PUSH P,T3 ;Save # of extra bytes to skip
DMOVE T2,IFNSTR+IT.SBP(T4) ;Get starting byte ptr
IFN TOPS20,<
SKIPN T3 ;Extended byte ptr?
JRST PSFBF1 ;No
ADD T3,T1 ;Add words to address part
JRST PSFBF2
PSFBF1:
>;END IFN TOPS20
ADD T2,T1 ;Add words to address part
PSFBF2: SOSGE 0(P) ;Any more extra bytes?
JRST PSFBF3 ;No
IBP T2 ;Increment byte ptr
JRST PSFBF2 ;Loop
PSFBF3: DMOVEM T2,IFNSTR+IT.CBP(T4) ;Store new current byte ptr
POP P,(P) ;Fix stack
;PSFBUF - Cont'd
;Compute new IT.CCT = IT.TCT - byte offset in buffer
HRRZ T1,IFNSTR+IT.NPD(T4) ;Get # pages read so far
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages allocated for buffer
SUB T1,T2 ;Get starting page number
SKIPGE T1 ;If less than 0,
MOVEI T1,0 ;Make starting page #0
MOVE T2,PSFPNM ;Get page number desired
SUB T2,T1 ;Get # pages to skip
IMUL T2,PSFBPP ;Get byte offset
ADD T2,PSFBOF ; . .
MOVE T1,IFNSTR+IT.TCT(T4) ;Compute new IT.CCT
SUB T1,T2 ; . .
MOVEM T1,IFNSTR+IT.CCT(T4) ;Store new one
POPJ P, ;Return
;ITPSF routines
;PSFPAG - Position file to desired page
;Inputs:
; T4/ pointer to file block
; PSFPNM/ page number
; PSFBPW/ bytes per word
; IT.FSZ/ file size
;Call:
; PUSHJ P,PSFPAG
; <return here if error, message typed>
; <return here if OK>
;Outputs:
; IT.NPD set to next page # to read
;Uses t1-t3
PSFPAG:
IFN TOPS20,<
PUSHJ P,UNMAPP ;Unmap pages there now
POPJ P, ;Error, single return
;Read in pages starting at desired one with PMAP
MOVE T2,IFNSTR+IT.FSZ(T4) ;Total file size (bytes)
IDIV T2,PSFBPP ;Total # pages in the file
SKIPE T3
ADDI T2,1 ;Round up
HRRZ T1,IFNSTR+IT.NPD(T4) ;How many more pages in file?
SUB T2,T1 ;# pages to PMAP (in order to get total #)
LDB T1,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages in buffer
CAMGE T1,T2 ;Get smaller
MOVE T2,T1 ;In T2
;PMAP (T2) pages
MOVE T3,T2 ;# pages in T3
HRLZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
HRR T1,PSFPNM ;Starting at this page number
SKIPN T2,IFNSTR+IT.SBP+1(T4) ;Get starting address of buffer
HRRZ T2,IFNSTR+IT.SBP(T4) ;(Non-extended byte ptr)
LSH T2,-^D9 ;Get page number in process
HRLI T2,.FHSLF ;Process handle in LH
TXO T3,PM%CNT+PM%RD ;Set bits
PMAP% ;Map the pages..
ERJMP PSFPME ;?Can't
HRRZ T3,T3 ;Update IT.NPD
DPB T3,[POINT 6,IFNSTR+IT.FLG(T4),35] ;# pages "in use"
ADD T3,PSFPNM
HRRM T3,IFNSTR+IT.NPD(T4) ; . .
JRST CPOPJ1 ;Skip return
; Still in TOPS20
; Still in TOPS20
;PMAP% failed trying to read pages
PSFPME: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't position file because:
PMAP% JSYS failed: ^1>)
POPJ P, ;Error return
>;END IFN TOPS20
;PSFPAG routine--TOPS10
;Uses t1-t3
IFE TOPS20,<
MOVE T1,PSFPNM ;Get page number to position to
LSH T1,2 ;Get block number
ADDI T1,1 ; . .
MOVEM T1,FLP1AG+1 ;Store in FILOP. arg block
HRRZ T1,IFNSTR+IT.FBA(T4) ;Get ptr to FILOP. block
LDB T1,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZM T1,FLP1AG ;Store channel number
MOVEI T1,.FOUSI ;Perform "USETI" call
HRRM T1,FLP1AG
MOVE T1,[2,,FLP1AG]
FILOP. T1, ;** Position file **
JRST USFLPE ;?Error
;Try to read to end of file, if end is too far, read exactly
; that number of pages.
MOVE T2,IFNSTR+IT.FSZ(T4) ;Total file size (bytes)
IDIV T2,PSFBPW ;T2:= # words in file (total)
LDB T1,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages in buffer
LSH T1,^D9 ;# words in buffer
MOVE T3,PSFPNM ;Get page number
LSH T3,^D9 ;First word to get read in
SUB T2,T3 ;t2=# words left to read in
CAMLE T1,T2 ;If less than a buffer size
MOVE T1,T2 ;Only read in that many
;Read in (t1) words.
MOVN T1,T1 ;For IOWD ptr
HRLE T2,T1
HRR T2,IFNSTR+IT.SBP(T4) ;Get -n,,addr
SUBI T2,1 ;Make IOWD
MOVEM T2,FLPDL
SETZM FLPDL+1 ;Set end of dump list
MOVEI T1,FLPDL ;Store ptr in FILOP. block
MOVEM T1,FLP1AG+1
MOVEI T1,.FOINP ;Perform "IN"
HRRM T1,FLP1AG ;Store function code
MOVE T1,[2,,FLP1AG]
FILOP. T1, ;** Read in words **
JRST PSFFF2 ;?Can't read in words
;Update IT.NPD
HLRE T1,FLPDL ;Get -n words read in
MOVN T1,T1 ;Get n
IDIVI T1,1000 ;# pages
SKIPE T2
ADDI T1,1 ;Round up
DPB T1,[POINT 6,IFNSTR+IT.FLG(T4),35] ;# pages "in use"
ADD T1,PSFPNM ;+ # we started at
HRRM T1,IFNSTR+IT.NPD(T4) ;Save next page number to read
JRST CPOPJ1 ;Success return
;FILOP. failed trying to position file
USFLPE: MOVEM T1,FLPERR ;Store error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get filename to type
MOVEM T1,EFNPTR ;Store for error message printer
$FERR (EPF,<Error positioning ^8:
FILOP. UUO (USETI) failed, error (^A) -- ^B>)
POPJ P, ;Error return
PSFFF2: MOVEM T1,FLPERR ;Store error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get filename to type
MOVEM T1,EFNPTR ;Store for error mess printer
$FERR (EPF,<Error positioning ^8:
FILOP. UUO (IN) failed, error (^A) -- ^B>)
POPJ P, ;Error return
>;END IFE TOPS20
SUBTTL $ITCLS - Close file
;Call:
; 1/ IFN
; 2/ flags (IT%NRF, IT%NRJ)
;Returns:
; 1/ Status 0=ok, 1=problem
;Note:
; If the file is an external file, the JFN is released unless
; the flag IT%NRJ is set.
$ITCLS: IMULI T1,IT.SIZ ;Point to the file block
DMOVEM T1,USR12 ;Save acs
DMOVEM T3,USR34 ;Save acs
MOVE T4,T1 ;T4:= offset
MOVE T3,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T3,IT%OPI ;Closing a file open for input?
JRST ITCLS1 ;Yes
TXNN T3,IT%OPO ;No, how about open for output?
JRST CLSNTO ;? File was not open
;Close file open for output
;T3= file block flags, t2= user flags
ITCLS0: TXNE T3,IT%EXF ;External file?
JRST CLSOEX ;Yes, go close external file
;Close temp file that had been opened for output
TXNE T2,IT%NRF ;Don't retain file?
JRST ITCLO5 ;Yes, get rid of it
HLRZ T1,IFNSTR+IT.NPD(T4) ;Get # pages written
JUMPE T1,CLSTD1 ;None written, file was not open
PUSHJ P,WRTBUF ;Write out remainder of current buffer
JRST RT1R34 ;Error, return status 1
JRST ITCLS3 ;End-code, then exit
;Here if temp file was not physically open.
;Compute total file size
CLSTD1: MOVE T1,IFNSTR+IT.TCT(T4) ;Get total char count
SUB T1,IFNSTR+IT.CCT(T4) ;- Current count
ADDM T1,IFNSTR+IT.FSZ(T4) ;Add to file size word
;Here when everything is set but the flags.
; Set flags so file can be opened for input and read.
ITCLS3: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXZ T1,IT%OPO ;Clear flags that says file is open for output
TXO T1,IT%WRT ;Set flag: File has been written
MOVEM T1,IFNSTR+IT.FLG(T4) ;Store updated flags
JRST RT0R34 ;return status 0
;Close temp file opened for output and get rid of it.
ITCLO5: PUSHJ P,RDTFLO ;Call system-specific routine
JRST RT1R34 ;?Failed, return status 1
PUSHJ P,CLSRMM ;Release memory
JUMPN T1,RT1R34 ;If error, return status 1
SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
JRST RT0R34 ;Return status 0
;Here to close external file open for output
;T2 contains users input flags
CLSOEX: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FTY ;Is file a tty: file?
JRST CLSOXT ;Yes
TXNE T1,IT%FNL ;NUL:?
JRST CLSOXY ;Yes
;Close external disk file opened for output
TXNE T2,IT%NRF ;Don't retain file?
JRST CLSOXK ;Yes
PUSHJ P,WRTBUF ;Write out current buffer
JRST RT1R34 ;Error, return status 1
PUSHJ P,PYCLSO ;Physically close file
JRST RT1R34 ;Error, return status 1
CLSOXX: PUSHJ P,CLSRMM ;Return memory used to memory manager
JUMPN T1,RT1R34 ;If problems, return status 1
CLSOXY: SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
; (includes: File is open for output)
JRST RT0R34 ;Return status 0
;Close external disk file, and get rid of it
CLSOXK: PUSHJ P,RDTFLO ;Call system-specific routine
JRST RT1R34 ;?Can't do it
JRST CLSOXX ;Go rejoin code above
;Close external TTY: file opened for output
CLSOXT: PUSHJ P,PYCLSO ;Physically close file
JRST RT1R34 ;Errors, return status 1
SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
JRST RT0R34 ;Return status 0
;$ITCLS - continued
;Close file open for input
;T3= file block flags, t2= user flags
ITCLS1: TXNE T3,IT%EXF ;Is file an External file?
JRST CLSEXI ;Yes, go close external file for input
;Close temp disk file opened for input
HLRZ T1,IFNSTR+IT.NPD(T4) ;Were any pages written?
JUMPE T1,CLSTIN ;No, no physical file
IFN TOPS20,<
PUSHJ P,UNMAPP ;Unmap any pages in core
JRST RT1R34 ;?errors, return status 1
>;END IFN TOPS20
PUSHJ P,RDTMOI ;Rid ourselves of the file
JRST RT1R34 ;Errors, return status 1
CLSTIN: PUSHJ P,CLSRMM ;Return memory used
JUMPN T1,RT1R34 ;?Error
SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
JRST RT0R34 ;Return status 0
;Close external file open for input
CLSEXI: TXNE T3,IT%FTY ;Is file a TTY: file?
JRST CLSETI ;Yes
TXNE T3,IT%FNL ;NUL:?
JRST CLSETN ;Yes
;Close external disk file open for input
IFN TOPS20,<
PUSHJ P,UNMAPP ;Unmapped pages still mapped
JRST RT1R34 ;Errors, return status 1
>;END IFN TOPS20
PUSHJ P,PYCLSI ;Physically close file
JRST RT1R34 ;Errors, return status 1
PUSHJ P,CLSRMM ;Return memory used
JUMPN T1,RT1R34 ;Error, return status 1
SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
JRST RT0R34 ;return status 0
;Close external TTY: file open for input
CLSETI: PUSHJ P,PYCLSI ;Physically close file
JRST RT1R34 ;Errors, return status 1
SETZM ITTFOP ;Clear "TTY file open for input" flag
CLSETN: SETZM IFNSTR+IT.FLG(T4) ;Clear all flags
JRST RT0R34 ;Return status 0
;Routine to physically close a file open for output
; This routine is called to close the following types of files:
;External TTY:
;External DSK:
; This routine only handles files which are not aborted.
;i.e. they will exist after the "CLOSE" is done.
;Inputs:
; T4/ pointer to file block
; IT.SIZ - size of file in bytes
; USR12+1/ user input flags (for CLOSE)
;Call:
; PUSHJ P,PYCLSO
; <return here if errors, message typed>
; <return here if OK>
;Uses t1,t2,t3
IFN TOPS20,<
PYCLSO: MOVE T1,IFNSTR+IT.FLG(T4) ;GET FLAGS
TXNE T1,IT%FNL ;NUL:?
JRST PYCLS9 ;Go release JFN (maybe)
TXNE T1,IT%FTY ;A TTY: file?
JRST PYCLS1 ;Yes
;Set end pointer on file
MOVE T2,IFNSTR+IT.FSZ(T4) ;Get byte count to set
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
SFPTR% ;Set the end pointer
ERJMP PYCLSF ;?Failed
HRLI T1,.FBSIZ ;Set EOF ptr in file (CLOSF does not when
MOVE T3,T2 ;no sequential output has been done)
SETO T2,
CHFDB%
ERJMP PYCLCF ;?Failed
;Set byte size of file
; (CLOSF does not set it when no seq output has been done)
HRLI T1,.FBBYV
SETZ T3,
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),11] ;Get byte size to set
DPB T2,[POINTR T3,FB%BSZ] ;Set in TOPS20 word
HRLZI T2,<77B11>B53
CHFDB% ;Change the FDB word
ERJMP PYCLCF ;?Failed
;Fall thru if disk file
;Come here directly if TTY: file
;Actually close the file
PYCLS1: HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
MOVE T3,USR12+1 ;Get user input flags
TXNE T3,IT%NRJ ;Don't release JFN?
TXO T1,CO%NRJ ;Yes, set flag
;Here when AC1 is set for CLOSF%
CLZFXX: PUSH P,T1 ;Save AC1
CLOSF% ;. .
ERJMP PYCLZF ;?failed
POP P,T1 ;Fix stack
JRST CPOPJ1 ;Give good return
;Here for NUL:
PYCLS9: MOVE T3,USR12+1 ;Get user input flags
TXNE T3,IT%NRJ ;Don't release JFN?
JRST CPOPJ1 ;Right, just return now
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
RLJFN% ;Release it
ERJMP PYCRJF ;?Can't release JFN
JRST CPOPJ1 ;Did it, skip return
;Some TOPS20 errors
;SFPTR failed
PYCLSF: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
SFPTR% JSYS failed: ^1>)
POPJ P,
;CHFDB failed
PYCLCF: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
CHFDB% JSYS failed: ^1>)
POPJ P,
;CLOSF failed
PYCLZF: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
CAIN T1,IOX11 ;Quota exceeded?
JRST PYCZFQ ;Yes
POP P,T1 ;Fix stack
$FERR (JSE,<Can't close ^8 because:
CLOSF% JSYS failed: ^1>)
POPJ P,
;CLOSF failed because quota was exceeded
PYCZFQ: $FERR (QEX,<Can't close ^8: ^1
(Type "CONTINUE" when the problem has been fixed)>)
HALTF%
POP P,T1 ;Get T1 back for CLOSF%
JRST CLZFXX ;Go try CLOSF again
;RLJFN failed
PYCRJF: $FERR (JSE,<Can't close ^8 because:
RLJFN% JSYS failed: ^1>)
POPJ P,
>;END IFN TOPS20
IFE TOPS20,<
;Inputs:
; T4/ pointer to file block
; IT.SIZ - size of file in bytes
; USR12+1/ user input flags (for CLOSE)
;Call:
; PUSHJ P,PYCLSO
; <return here if errors, message typed>
; <return here if OK>
;Uses t1,t2,t3
PYCLSO: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FNL ;Null?
JRST CPOPJ1 ;Yes, just return ok
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address
MOVEI T2,.FOCLS ;Perform CLOSE
HRRM T2,.FOFNC(T1) ; Stick function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ; ** DO CLOSE **
JRST PYCFE1 ;Error
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address again
MOVEI T2,.FOREL ;Perform RELEASE
HRRM T2,.FOFNC(T1) ; Stick function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ; ** DO RELEASE **
JRST PYCFE2 ;Error
JRST CPOPJ1 ;Return OK
;CLOSE FILOP. failed
PYCFE1: MOVEM T1,FLPERR ;Save error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (UOE,<Can't close ^8 because:
CLOSE function of FILOP. UUO failed: (^A) -- ^B>)
POPJ P, ;Error return
PYCFE2: MOVEM T1,FLPERR ;Save error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (UOE,<Can't close ^8 because:
RELEAS function of FILOP. UUO failed: (^A)--^B>)
POPJ P, ;Error return
>;END IFE TOPS20
;Routine to physically close file open for input
;Inputs:
; T4/ pointer to file block
; USR12+1 / Users input flags
;Call:
; PUSHJ P,PYCLSI
; <return here if errors, message typed>
; <return here if OK>
;Uses t1,t2,t3
IFN TOPS20,<
PYCLSI: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FNL ;Is this the NUL: file?
JRST PYCLI1 ;Yes
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
MOVE T3,USR12+1 ;Get user's flags
TXNE T3,IT%NRJ ;Don't release JFN
TXO T1,CO%NRJ ;Yes
CLOSF% ;** CLOSE FILE **
ERJMP PYCZYE ;?Can't, complain
JRST CPOPJ1 ;Ok return
;Here for NUL:
PYCLI1: MOVE T3,USR12+1 ;Get user's flags
TXNE T3,IT%NRJ ;Don't release JFN?
JRST CPOPJ1 ;Right, just return
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
RLJFN% ;Release JFN
ERJMP PYCRJE ;Error
JRST CPOPJ1 ;Ok return
PYCZYE: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
CLOSF% JSYS failed: ^1>)
POPJ P,
PYCRJE: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
RLJFN% JSYS failed: ^1>)
POPJ P,
>;END IFN TOPS20
IFE TOPS20,<
;Inputs:
; T4/ pointer to file block
; USR12+1 / Users input flags
;Call:
; PUSHJ P,PYCLSI
; <return here if errors, message typed>
; <return here if OK>
;Uses t1,t2,t3
PYCLSI: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%FNL ;Is this the NUL: file?
JRST CPOPJ1 ;Yes, just return ok
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address
MOVEI T2,.FOCLS ;Perform CLOSE
HRRM T2,.FOFNC(T1) ; Stick function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ; ** DO CLOSE **
JRST PYCFE1 ;Error
MOVE T3,USR12+1 ;Get user's flags
TXNE T3,IT%NRJ ;Don't release channel?
JRST CPOPJ1 ;Right, just return
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address again
MOVEI T2,.FOREL ;Perform RELEASE
HRRM T2,.FOFNC(T1) ; Stick function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ; ** DO RELEASE **
JRST PYCFE2 ;Error
JRST CPOPJ1 ;Return OK
>;END IFE TOPS20
;Routine to return memory to the memory manager when file is closed.
;;Call:
;t4/ pointer to file block
;Return:
; t1/ status (0=ok, 1=problem, message has been typed out)
;Uses t1 thru t4
CLSRMM: SETZ T1, ;No flags
LDB T2,[POINT 6,IFNSTR+IT.FLG(T4),5] ;# pages in buffer
IFN TOPS20,<
SKIPN T3,IFNSTR+IT.SBP+1(T4) ;Possibly address in 2nd word of B.P.
>
HRRZ T3,IFNSTR+IT.SBP(T4) ;Address from RH of B.P. word
PUSHJ P,RETRN ;Return memory
POPJ P, ;Return
CLSNTO: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (CCF,<Can't close ^8: File was not open>)
JRST RT1R34 ;Return status 1, restore acs
;Routine to get rid of a file open for output
;Inputs:
; T4/ ptr to file block
; USR12+1/ User's input flags (IT%NRJ)
;Call:
; For temp file or external file,
; PUSHJ P,RDTFLO
; <return here if errors, message typed>
; <return here if OK>
RDTFLO: MOVE T1,IFNSTR+IT.FLG(T4) ;Get flags
TXNE T1,IT%EXF ;Is file an external file?
JRST RDTFLE ;Yes
;Temp file, maybe it was not actually physically opened at all.
HLRZ T1,IFNSTR+IT.NPD(T4) ;Get # pages written
JUMPE T1,CPOPJ1 ;None written, file was not physically open
;Temp file was actually opened for output
IFN TOPS20,<
;On TOPS20 we have to do a CLOSF% with the ABORT flag,
; then a DELF% to actually get the file expunged. (CLOSF%
; with abort flag set does not actually expunge the file,
; so we are left with deleted pages on disk).
RDTFL1: HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
TXO T1,CZ%ABT!CO%NRJ ;Abort file- will close and expunge
CLOSF%
ERJMP RDTCFF ;?Failed
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN again
TXO T1,DF%EXP ;Expunge contents of file
DELF%
ERJMP RDTDFF ;?Failed
JRST CPOPJ1 ;Success, return
RDTCFF: $FERR (JSE,<Can't close ^8 because:
CLOSF% JSYS failed: ^1>)
POPJ P, ;Failure return
RDTDFF: $FERR (JSE,<Can't close ^8 because:
DELF% JSYS failed: ^1>)
POPJ P, ;Failure return
>;END IFN TOPS20
IFE TOPS20,<
;Temp file was actually opened.
; Close it then delete it
JRST RDTFLE ;Same as TOPS10 "get rid of external file"
>;END IFE TOPS20
;External file was opened for output
RDTFLE:
IFN TOPS20,<
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
TXO T1,CZ%ABT ;Abort file- will close and expunge
MOVE T2,USR12+1 ;Get user's input flags
TXNE T2,IT%NRJ ; Does he want to retain JFN?
TXO T1,CO%NRJ ;Yes, keep it even tho file is aborted
CLOSF% ;** Close the file **
ERJMP RDTCFF ;?Failed
JRST CPOPJ1 ;Success
>;END IFN TOPS20
IFE TOPS20,<
;Get rid of external file opened for output
; (or temp disk file opened for output).
;Close it and delete it.
MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address
MOVEI T2,.FOCLS ;Perform CLOSE
HRRM T2,.FOFNC(T1) ; Stick function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ;Do close
JRST RDTCCF ;?Can't close
;Delete.
MOVE T1,IFNSTR+IT.FBA(T4) ;Reget FILOP. address
MOVEI T2,.FODLT ;Perform "DELETE"
HRRM T2,.FOFNC(T1) ;Put function in FILOP. block
HRLI T1,.FOPAT+1 ;Length
FILOP. T1, ;** Do DELETE **
JRST RDTCDF ;?Can't delete
;Release channel unless user said not to.
MOVE T1,IFNSTR+IT.FLG(T4) ;Get file flags
TXNN T1,IT%EXF ;Is file an external file?
JRST RDTDRC ;No, definitely release the channel
; (No matter what the input flags say.)
MOVE T1,USR12+1 ;Get user's input flags
TXNE T1,IT%NRJ ;Don't release channel?
JRST CPOPJ1 ;Right, just return "success"
;Release the channel
RDTDRC: MOVE T1,IFNSTR+IT.FBA(T4) ;FILOP. address
LDB T2,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZ T2,T2 ;Chann #,,0
HRRI T2,.FOREL ;Chann,, function code
MOVE T1,[1,,T2] ;1-word arg block in T2
FILOP. T1, ;** RELEASE channel **
JRST RDTCRC ;?Can't release
JRST CPOPJ1 ;Success
;Can't CLOSE
RDTCCF: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4)
MOVEM T1,EFNPTR
$FERR (UOE,<Can't get rid of ^8:
FILOP. CLOSE UUO failed: (^A) -- ^B>)
POPJ P, ;Error return
;Can't delete
RDTCDF: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4)
MOVEM T1,EFNPTR
$FERR (UOE,<Can't get rid of ^8:
FILOP. DELETE UUO failed: (^A) -- ^B>)
POPJ P, ;Error return
;Can't release
RDTCRC: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4)
MOVEM T1,EFNPTR
$FERR (UOE,<Can't get rid of ^8:
FILOP. RELEASE UUO failed: (^A) -- ^B>)
POPJ P, ;Error return
>;END IFE TOPS20
;TOPS20 routine to unmap pages of input file still mapped
;Called before a CLOSF is done for a disk file
; either external disk file or temp file that had been written
;Input:
; T4/ pointer to file block
;Call:
; PUSHJ P,UNMAPP
; <here if errors>
; <here if OK>
;Uses t1-t3
IFN TOPS20,<
UNMAPP: SKIPN T2,IFNSTR+IT.SBP+1(T4) ;Get starting page #
HRRZ T2,IFNSTR+IT.SBP(T4) ;In process
LSH T2,-^D9 ;In RH(t2)
HRLI T2,.FHSLF ;My process
LDB T3,[POINT 6,IFNSTR+IT.FLG(T4),5] ;Get # pages used
TXO T3,PM%CNT ;Set repeat count
SETO T1, ;Tell PMAP we are unmapping pages
PMAP% ;Do it
ERJMP UNMPE1 ;?ERROR
JRST CPOPJ1 ;Give good return
UNMPE1: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<PMAP% JSYS failed: ^1,
couldn't unmap pages of ^8>)
POPJ P, ;Give bad return
>;END IFN TOPS20
;Routine to get of temp disk file opened for input
; When it got written to disk
;Inputs:
; T4/ ptr to file block
;Call:
; PUSHJ P,RDTMOI
; <return here if errors, message typed>
; <return here if OK>
;USES T1-T3
;The file is still open when this routine is called.
IFN TOPS20,<
RDTMOI: HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
TXO T1,CO%NRJ ;Don't release JFN
CLOSF% ;CLOSE the file
ERJMP RDTME1 ;?Error
HRRZ T1,IFNSTR+IT.JFN(T4) ;Get JFN
TXO T1,DF%EXP ;Expunge contents of file
DELF% ;This also releases the JFN
ERJMP RDTME2 ;?Error
AOS (P) ;Skip return
POPJ P, ;. .
RDTME1: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
CLOSF% JSYS failed: ^1>)
POPJ P, ;Error return
RDTME2: DMOVE T2,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T2,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't close ^8 because:
DELF% JSYS failed: ^1>)
POPJ P, ;Error return
>;END IFN TOPS20
IFE TOPS20,<
;Repeating for TOPS-10:
;Routine to get of temp disk file opened for input
; When it got written to disk
;Inputs:
; T4/ ptr to file block
;Call:
; PUSHJ P,RDTMOI
; <return here if errors, message typed>
; <return here if OK>
;USES T1-T3
;The file is still open when this routine is called.
RDTMOI: MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address
MOVEI T2,.FOCLS ;Perform "Close"
HRRM T2,.FOFNC(T1) ;Put function in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ; ** DO CLOSE **
JRST RDTME1 ;?Can't
;Delete the file
MOVE T1,IFNSTR+IT.FBA(T4) ;Re-get FILOP. address
MOVEI T2,.FODLT ;Perform "DELETE"
HRRM T2,.FOFNC(T1) ;Put function in FILOP. block
HRLI T1,.FOPAT+1 ;Length
FILOP. T1, ; ** Do DELETE **
JRST RDTME2 ;?Can't
;Release channel
MOVE T1,IFNSTR+IT.FBA(T4) ;Get ptr to FILOP. block
LDB T2,[POINT 9,.FOFNC(T1),17] ;Get channel number
HRLZ T2,T2 ;Chann #,,0
HRRI T2,.FOREL ;Chann #,,function code
MOVE T1,[1,,T2] ;1-word arg block in T2
FILOP. T1, ;** RELEASE channel **
JRST RDTME3 ;?Can't
JRST CPOPJ1 ;OK, return
;CLOSE failed
RDTME1: MOVEM T1,FLPERR ;Save FILOP. error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get ptr to generic filename
MOVEM T1,EFNPTR ;Store for error message printer
$FERR (UOE,<Can't get rid of ^8:
FILOP. CLOSE UUO failed (^A) -- ^B>)
POPJ P, ;Error return
;DELETE failed
RDTME2: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4)
MOVEM T1,EFNPTR
$FERR (UOE,<Can't get rid of ^8:
FILOP. DELETE UUO failed (^A) -- ^B>)
POPJ P,
;RELEASE failed
RDTME3: MOVEM T1,FLPERR
MOVE T1,IFNSTR+IT.GNP(T4)
MOVEM T1,EFNPTR
$FERR (UOE,<Can't get rid of ^8:
FILOP. RELEASE UUO failed (^A) -- ^B>)
POPJ P,
>;END IFE TOPS20
SUBTTL $ITRNF - Rename file
; This routine should be called after $ITCLS is called for a file,
;$ITCLS must have been called with the IT%NRJ bit set.
;Inputs:
; T1/ IFN
; T2/ Flags [+ JFN (T20 only)]
;Call:
; PUSHJ P,$ITRNF
; <return here always>
;Outputs:
; T1/ status (0=OK, 1=error)
;Uses T1,T2
$ITRNF: IMULI T1,IT.SIZ ;Get ptr to entry
PUSH P,T4 ;Save T4
PUSH P,T2 ;Save T2
MOVE T4,T1 ;Copy ptr
IFN TOPS20,<
MOVE T1,IFNSTR+IT.JFN(T4) ;Get JFN of old file
HRRZ T2,T2 ;Just save JFN
RNAMF% ;Rename file
ERJMP ITRNFE ;?Error
POP P,T2 ;Restore flags
TXNN T2,IT%RLS ;Release file?
JRST ITRNFR ;No, return
MOVE T1,T2 ;Get JFN to release
RLJFN% ;Release it
ERJMP ITRNRE ;?Error
ITRNFR: POP P,T4 ;Restore T4
JRST RETST0 ;Return status 0
;RNANF% failed
ITRNFE: DMOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T1,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't RENAME ^8, reason:
RNAMF% JSYS failed: ^1>)
POP P,T2 ;Restore T2
POP P,T4 ;Restore T4
JRST RETST1 ;Return status 1
;RLJFN failed
ITRNRE: DMOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
DMOVEM T1,EFNPTR ;And store for error message printer
$FERR (JSE,<Can't RENAME ^8, reason:
RLJFN% JSYS failed: ^1>)
POP P,T4 ;Restore T4
JRST RETST1 ;return status 1
>;END IFN TOPS20
IFE TOPS20,<
;T2, T4 on stack
SETZM RTRYNM ;Didn't try RENAME FILOP. yet
ITRNF0: MOVE T1,IFNSTR+IT.FBA(T4) ;Get FILOP. address
;Save away RENAME block stuff incase the FILOP. fails
MOVEI T2,4 ;Assume short RENAME block
MOVEM T2,SVRNLN ;Save length away
SETZM EXRNBL ;Clear flag "Extended RENAME block"
HLRZ T2,.FOLEB(T1) ;Get addr of rename block
MOVE T2,0(T2) ;Get first word
JUMPE T2,ITRNSB ;Short block if zero
TLNE T2,-1 ;Stuff in LH?
JRST ITRNSB ;Yes, short block
ANDI T2,77777 ;Just save size
CAILE T2,.MXRBC ;Too high?
JRST ITFMXE ;Yes, complain
SETOM EXRNBL ;Set "Extended RENAME block"
MOVEM T2,SVRNLN ;Save length of block
;Copy extended RENAME block
HLLZ T2,.FOLEB(T1) ;Get addr of RENAME block
HRRI T2,SVRNBL
PUSH P,T3 ;Save T3 a sec.
MOVE T3,SVRNLN ;Get length
BLT T2,SVRNBL-1(T3) ;Copy whole block
POP P,T3 ;Restore T3
SKIPN T2,SVRNBL+.RBPPN ;Any PPN or PATH?
JRST ITRND1 ;No, done copying
JRST CKITRP ;Check path
;Copy short RENAME block
ITRNSB: HLLZ T2,.FOLEB(T1) ;Get addr of RENAME block
HRRI T2,SVRNBL ;Save here
BLT T2,SVRNBL+3
SKIPN T2,SVRNBL+3 ;Any PPN or PATH?
JRST ITRNF1 ;No
;Here with T2= PPN or PATH pointer from RENAME block.
;If PATH pointer, copy the PATH block also.
CKITRP: TLNE T2,-1 ;PPN?
JRST ITRNF1 ;Yes, no PATH block to copy
HRLZ T2,T2 ;From
HRRI T2,SVRNPB ;To
BLT T2,SVRNPB+.PTMAX ; Copy whole block
;Here with T1 pointing to users FILOP. block
ITRNF1: MOVEI T2,.FORNM ;RENAME function
HRRM T2,.FOFNC(T1) ;Store in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ;** RENAME file **
JRST ITRNFE ;FILOP. failed to rename file
POP P,T2 ;Restore user's flags
TXNN T2,IT%RLS ;Release file?
JRST ITRNFR ;No, return
MOVE T1,IFNSTR+IT.FBA(T4) ;Reget FILOP. address
MOVEI T2,.FOREL ;RELEASE function
HRRM T2,.FOFNC(T1) ;Store in FILOP. block
HRLI T1,.FOPAT+1 ;Length of arg block
FILOP. T1, ;* RELEASE the file *
JRST ITRNRE ;?Failed
ITRNFR: POP P,T4 ;Restore T4
JRST RETST0 ;Return status 0
;RENAME FILOP. failed
ITRNFE: CAIN T1,ERAEF% ;File already exists?
JRST ITRNFD ;Yes, delete old one first.
MOVEM T1,FLPERR ;Save FILOP. error for message
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (CRF,<Can't RENAME ^8:
FILOP. UUO failed (^A) -- ^B>)
POP P,T2 ;Restore acs
POP P,T4
JRST RETST1 ;Return status 1
;Specified file already exists. Delete the old copy and
; go back to try again.
ITRNFD: SKIPE RTRYNM ;Have we been here before?
JRST ITRDE1 ;Yes, bomb out
SETOM RTRYNM ;Set to -1
;The FILOP. that failed has now totally screwed up the RENAME block,
; so first we'll copy it all back.
MOVE T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
SKIPN EXRNBL ;Extended RENAME block?
JRST ITRND0 ;No
;Copy extended RENAME block back
HLRZ T2,.FOLEB(T1) ;T2= addr of RENAME block
PUSH P,T3 ;Save T3 a sec.
MOVE T3,SVRNLN ;Get saved length of RENAME block
ADDI T3,-1(T2) ;Get last loc to BLT to
HRLI T2,SVRNBL ;Copy from here
BLT T2,(T3) ;Copy whole block back
POP P,T3 ;Restore T3
SKIPN T2,SVRNBL+.RBPPN ;PPN or PATH pointer?
JRST ITRND1 ;No
JRST CBPPNP ;Copy back PATH if necessary
;Copy short RENAME block back
ITRND0: HLRZ T2,.FOLEB(T1) ;Write to RENAME block
MOVEI T1,3(T2) ;Last location to BLT to
HRLI T2,SVRNBL ; From saved RENAME block
BLT T2,(T1) ;Copy it
PUSH P,(T1) ;[7] push PPN/Path block address
SKIPN T2,SVRNBL+3 ;PPN or PATH pointer?
JRST ITRND1 ;No
;Here with T2= PPN or ptr to PATH block from original RENAME block
CBPPNP: TLNE T2,-1 ;PPN?
JRST ITRND1 ;Yes, don't copy path block too
MOVEI T1,.PTMAX(T2) ;Last location to BLT to
HRLI T2,SVRNPB ;From saved path block
BLT T2,(T1) ;Copy it
ITRND1: MOVE T1,IFNSTR+IT.FBA(T4) ;reget FILOP. address
HRRZ T2,.FOLEB(T1) ;[7] Get address of Loockup block
POP P,3(T2) ;[7] Restore PPN/path block address
MOVE T2,.FOLEB(T1) ;Get RENAME,,LOOKUP block ptrs
MOVEM T2,SVLKRP ;Save 'em
HLRM T2,.FOLEB(T1) ;Make LOOKUP ptr be RENAME ptr
MOVEI T2,.FODLT ;Delete function
HRRM T2,.FOFNC(T1) ;Store in FILOP. block
HRLI T1,.FOPAT+1 ;Length of block
FILOP. T1, ;** DELETE old file **
JRST ITFDE2 ;?Failed
;[7] REPEAT 0,<
;Again, restore saved RENAME and PATH block
MOVE T1,IFNSTR+IT.FBA(T4) ;Get addr of FILOP. block
MOVE T2,SVLKRP ;Restore ptrs
MOVEM T2,.FOLEB(T1)
HLRZ T2,T2 ;Write to RENAME block
MOVEI T1,3(T2) ;Last location to BLT to
HRLI T2,SVRNBL ; From saved RENAME block
BLT T2,(T1) ;Copy it
SKIPN T2,SVRNBL+3 ;PPN or PATH pointer?
JRST ITRND2 ;No
TLNE T2,-1 ;PPN?
JRST ITRND2 ;Yes, don't copy path block too
MOVEI T1,.PTMAX(T2) ;Last location to BLT to
HRLI T2,SVRNPB ;From saved path block
BLT T2,(T1) ;Copy it
;[7] >;END REPEAT 0
ITRND2: MOVE T1,IFNSTR+IT.FBA(T4) ;Reget t1= addr of FILOP. block
JRST ITRNF1 ;Go back and try again
ITFMXE: MOVE T1,IFNSTR+IT.GNP(T4) ;Get filename to print
MOVEM T1,EFNPTR
$FERR (MXE,<Can't RENAME ^8:
Size of EXTENDED ENTER block supplied is too large>)
POP P,T2
POP P,T4
JRST RETST1 ;Return status 1
ITRDE1: MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (CRF,<Can't RENAME ^8:
FILOP. UUO seems to be broken at ITRNFD in IOTMP module>)
POP P,T2
POP P,T4
JRST RETST1
ITFDE2: MOVEM T1,FLPERR ;Store error code for message print
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (CDF,<Can't RENAME ^8:
FILOP. UUO failed trying to delete old file:
(^A) -- ^B>)
POP P,T2
POP P,T4
JRST RETST1
;RELEASE FILOP. failed
ITRNRE: MOVEM T1,FLPERR ;Save FILOP. error code
MOVE T1,IFNSTR+IT.GNP(T4) ;Get byte ptr to generic filename
MOVEM T1,EFNPTR ;And store for error message printer
$FERR (CRF,<Can't RELEASE ^8:
FILOP. UUO failed (^A) -- ^B>)
POP P,T4 ;Restore T4
JRST RETST1 ;Return status 1
>;END IFE TOPS20
IFN TOPS20,<
;ROUTINE TO TYPE OUT LAST ERROR IN THIS FORK
;CALL:
; PUSHJ P,LSTLEF
; <Return here always>
;No acs destroyed
LSTLEF: PUSH P,T1 ;SAVE ACS
PUSH P,T2
PUSH P,T3
MOVEI T1,.PRIOU ;OUTPUT TO TERMINAL
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
SETZ T3, ;ALL OF THE TEXT
ERSTR%
JFCL
JFCL
POP P,T3 ;restore acs
POP P,T2
POP P,T1
POPJ P, ;Return
>;END IFN TOPS20
SUBTTL $ITRMU - Return memory usage
;Call:
; 1/ IFN (-1 for all files plus overhead)
;Returns:
; 1/ number of pages used (TOTAL)
; 2/ number of pages that can be released
$ITRMU:
POPJ P, ;RETURN
SUBTTL $ITCBM - Cut back on memory
;Call:
; 1/ IFN (-1 to get rid of memory everywhere possible)
; 2/ number of pages to release
;Returns:
; 1/ Status 0= ok, 1= problem
$ITCBM:
POPJ P, ;RETURN
SUBTTL $ITDEB - Enter debugger
;Call:
; -no acs used-
;Returns:
; -no acs used-
$ITDEB:
POPJ P, ;RETURN
SUBTTL Error message printer
;Called by $FERR and $WERR macros
;T1/ (lh) = 3-letter sixbit abbrev for error message
;t1/ (rh) = local address of error message
; The error message can contain the following symbols:
;^^ - Insert one up-arrow
;^1 - Insert last JSYS error message
;^2 - Insert ASCIZ string whose address is in ASCS1
;^3 - Insert ASCIZ string whose address is in ASCS2
;^4 - Insert octal number from ENUMBR
;^5 - Insert decimal number from ENUMBR
;^6 - Insert SIXBIT word from SIXBW1
;^7 - If column is greater than 72, skip to a new line
;^8 - Insert generic file name string (BP in EFNPTR)
;^9 - Stop message here and don't append a CRLF
;^A - (TOPS-10) Type octal number from FLPERR
;^B - (TOPS-10) Type ASCII FILOP. error code text using FLPERR
;Only AC1 is used
ITWERR: HLLZM T1,LOCABR ;Save abbrev for error
HRLI T1,(POINT 7,) ;Get byte ptr to message
MOVEM T1,LOCMSP ;Save message ptr
MOVEI T1,"%" ;Warnings start with "%"
JRST ITER1 ;Go join common code
ITFERR: HLLZM T1,LOCABR ;Save abbrev for error
HRLI T1,(POINT 7,) ;Get byte ptr to message
MOVEM T1,LOCMSP ;Save message ptr
MOVEI T1,"?" ;Fatal error starts with "?"
ITER1: PUSH P,T2 ;Save ac T2
PUSH P,T3 ;Save T3
MOVE T2,[POINT 7,ERTXTB] ;Byte ptr to error text buffer
MOVEM T2,ERTXTP ;Save it
MOVEI T2,1 ;Start at column 1
MOVEM T2,NCOLM ;. .
PUSHJ P,ITECHR ;Store first character of message
MOVE T1,PRGABR ;3-letter program abbrev
PUSHJ P,ITERSB ;Store sixbit word
MOVE T1,LOCABR ;3-letter abbrev for specific message
PUSHJ P,ITERSB ;Store sixbit word
MOVEI T1," " ;Space
PUSHJ P,ITECHR ;Store it
;Put characters in the output buffer
ITER2: ILDB T1,LOCMSP ;Get next character of message
JUMPE T1,ITEEND ;Null means end of string
CAIN T1,"^" ;Up-arrow could be a "MACRO"
JRST ITER3
ITER2A: CAIN T1,.CHCRT ;Carriage-return
SETZM NCOLM ; sends column back to 0
PUSHJ P,ITECHR ;Just a regular character, store
JRST ITER2 ;Continue
;Up-arrow seen, possibly a MACRO
ITER3: ILDB T1,LOCMSP ;Get next character of message
CAIN T1,"^" ;Another uparrow, means go insert an uparrow
JRST ITER2A
CAIN T1,"2" ;^2
JRST ITER32 ;Insert ASCIZ string
CAIN T1,"3" ;^3
JRST ITER33 ;Insert ASCIZ string
CAIN T1,"4"
JRST ITER34 ;Insert OCTAL number
CAIN T1,"5"
JRST ITER35 ;Insert DECIMAL number
CAIN T1,"6"
JRST ITER36 ;Insert SIXBIT word
CAIN T1,"7"
JRST ITER37 ;Skip to new line if column > 72
CAIN T1,"8" ;^8
JRST ITER38 ;Insert generic filename
IFN TOPS20,<
CAIN T1,"1" ;^1
JRST ITER31 ;Insert last JSYS error
>
IFE TOPS20,<
CAIN T1,"A" ;^A
JRST ITER3A ;Insert octal number from FLPERR
CAIN T1,"B" ;^B
JRST ITER3B ;insert FILOP. error code
>;END IFE TOPS20
CAIN T1,"9" ;^9
JRST ITENNC ;Stop message here and don't insert a CRLF
;Nothing special, insert up-arrow and the character
MOVEI T2,"^" ;Up-arrow
IDPB T2,ERTXTP ;Store it
JRST ITER2A ;Go store character and continue
; Here are routines to do the special actions
;for specific characters following up-arrow
;
; When the action is completed, the code will usually branch
;back to "ITER2" to continue copying characters from the input
;string to the output string.
IFN TOPS20,<
;^1 - Insert last JSYS error message
ITER31: MOVE T1,ERTXTP ;Get error text pointer
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
SETZ T3, ;ALL OF THE TEXT
ERSTR%
JFCL
JFCL
EXCH T1,ERTXTP ;Store updated error pointer
SETZ T2, ;T2= # of columns used
ITERUC: CAMN T1,ERTXTP ;Did we update column all the way yet?
JRST ITEUC1 ;Yes
IBP T1 ;Account for each byte
AOJA T2,ITERUC ;Back to loop
ITEUC1: ADDM T2,NCOLM ;Update column number
JRST ITER2 ;Go back for more characters
>;END IFN TOPS20
;^2 - Insert ASCIZ string whose (18-bit) address is in ASCS1
ITER32: SKIPA T2,ASCS1 ;Get address and skip
;^3 - Insert ASCIZ string whose (18-bit) address is in ASCS2
ITER33: HRRZ T2,ASCS2 ;Get address
HRLI T2,(POINT 7,)
ITEASC: ILDB T1,T2 ;Get character
JUMPE T1,ITER2 ;When done, go back for another character
CAIN T1,.CHCRT ;Carriage-return
SETZM NCOLM ; sends column back to 0
PUSHJ P,ITECHR ;Insert character
JRST ITEASC ;Loop
IFE TOPS20,<
;^A - Insert octal number from FLPERR
ITER3A: SKIPA T2,FLPERR ;Get number
>;END IFE TOPS20
;^4 - Insert octal number from ENUMBR
ITER34: MOVE T2,ENUMBR ;Get number
MOVEI T3,^D8 ;Get base
PUSHJ P,ITENBR ;Insert number into error text
JRST ITER2 ;Go back for more characters
;^5 - Insert decimal number from ENUMBR
ITER35: MOVE T2,ENUMBR ;Get number
MOVEI T3,^D10 ;Base in T3
PUSHJ P,ITENBR ;Insert number into error text
JRST ITER2 ;Go back for more characters
;^6 - Insert SIXBIT word from SIXBW1
ITER36: MOVE T1,SIXBW1 ;Get sixbit word
PUSHJ P,ITERSB ;Call routine to insert it
JRST ITER2 ;Go back for more message text
;^7 - If column is greater than 72, skip to a new line
ITER37: MOVE T1,NCOLM ;Get column
CAIGE T1,^D72 ;More than 72?
JRST ITER2 ;No, do nothing
MOVEI T1,.CHCRT ;Insert CR
PUSHJ P,ITECHR
SETZM NCOLM ;After LF, column will be 1
MOVEI T1,.CHLFD ;Insert LF
PUSHJ P,ITECHR
JRST ITER2 ;Go back for another character
;^8 - Insert generic filename string from EFNPTR
ITER38: DMOVE T1,EFNPTR ;Get ptr
DMOVEM T1,IT8PTR ;Save here
ITE381: ILDB T1,IT8PTR ;Get character
JUMPE T1,ITER2 ;All done, return
PUSHJ P,ITECHR ;Type a character
JRST ITE381 ;Loop
IFE TOPS20,<
;^B - Insert ASCII FILOP. error from number in FLPERR
ITER3B: MOVE T1,FLPERR ;Get error number
CAILE T1,.FESZ ;Too big?
JRST ITE3B1 ;Yes, get default message
HRRZ T2,FLPEMS(T1) ;Get error message
HRLI T2,(POINT 7,) ;BP to it
TRNE T2,-1 ;Any message?
JRST ITEASC ;Yes, Go insert message
HRRI T2,[ASCIZ/** Error pertains to RUN, GETSEG, or MERGE. **/]
JRST ITEASC ;Go tell him that
ITE3B1: MOVE T2,[POINT 7,[ASCIZ/** Unknown FILOP. error **/]]
JRST ITEASC ;Go insert message
;LIST of FILOP. errors
FLPEMS: [ASCIZ/File not found/]
[ASCIZ/UFD does not exist/]
[ASCIZ/Protection failure/]
[ASCIZ/File being modified/]
[ASCIZ/Specified file already exists/]
[ASCIZ/Illegal sequence of UUOs/]
[ASCIZ/Device or data error/]
0 ;Not a save file
0 ;Not enough core
0 ;Device not available
0 ;No such device
[ASCIZ/Illegal monitor call for FILOP./]
[ASCIZ/No room or quota exceeded/]
[ASCIZ/Write-lock error/]
[ASCIZ/Not enough monitor table space available/]
[ASCIZ/Partial allocation only/]
[ASCIZ/Block not free on allocated position/]
[ASCIZ/Cannot supersede a directory/]
[ASCIZ/Cannot delete non-empty directory/]
[ASCIZ/SFD not found/]
[ASCIZ/Search list is empty/]
[ASCIZ/SFD level too deep/]
[ASCIZ/No DSK: available to create a file on/]
0 ;GETSEG error
[ASCIZ/Cannot update file/]
0 ;GETSET/MERGE. error
0 ;User not logged in
[ASCIZ/File still has outstanding locks set/]
0 ;Bad EXE file directory
0 ;Bad extension for EXE file
0 ;EXE directory too big
[ASCIZ/Network capacity exceeded, no space for connect message/]
[ASCIZ/Task was not available/]
[ASCIZ/Unknown network node/]
[ASCIZ/SFD is inuse by another job/] ;RENAME error
[ASCIZ/File has an NDR lock/] ;DELETE
[ASCIZ/Too many readers/]
[ASCIZ/SFD to lower level/] ;RENAME
[ASCIZ/Channel not open/] ;46 - FILOP.
[ASCIZ/Device down and ususeable/] ;47
[ASCIZ/Device is restricted/] ;50
[ASCIZ/Device is controlled by the MDA/]
[ASCIZ/Device belongs to another job/]
[ASCIZ/Illegal data mode/]
[ASCIZ \Undefined/unknown open bits set\]
[ASCIZ/Device in use on MPX channel/]
[ASCIZ \Not enough per process space for extended I/O channel table\]
[ASCIZ/No free channels available/]
[ASCIZ/Unknown FILOP. function/]
[ASCIZ/Channel number too big/] ;61
[ASCIZ/Channel illegal for operation/]
.FESZ==.-FLPEMS-1 ;Last known FILOP. error
>;END IFE TOPS20
;The message has now been built in ERTXTB
;Insert a CRLF to end the message
ITEEND: MOVEI T1,.CHCRT ;CR
IDPB T1,ERTXTP
MOVEI T1,.CHLFD ;LF
IDPB T1,ERTXTP
;Enter here to stop message without appending a CRLF
ITENNC: SETZ T1, ;Null to end message
IDPB T1,ERTXTP
TYPE ERTXTB ;Type the error message
POP P,T3 ;Restore T3
POP P,T2 ;Restore T2
POPJ P, ;Done, return
;Little subroutines for error message printer
;ITERSB - routine to append sixbit word in T1 to error message
;Uses T1, T2
ITERSB: MOVE T2,T1 ;Copy word to T2
ITRSB1: JUMPE T2,CPOPJ ;Return when done
SETZ T1, ;Clear T1
LSHC T1,6 ;Shift another byte
ADDI T1,"0"-'0' ;Make ASCII
PUSHJ P,ITECHR ;Go insert character
JRST ITRSB1 ;Loop for more characters
;ITENBR - Routine to put a number into the error text
;Call:
; T2/ Number
; T3/ Base
; PUSHJ P,ITENBR
; <Returns here always>
;Uses t1-t3
ITENBR: MOVEM T3,NBASE ;Store base
JUMPGE T2,ITENB1 ;Jump if number is not negative
MOVEI T1,"-" ;It is, print "-"
PUSHJ P,ITECHR
MOVM T2,T2 ;And get the ABS
ITENB1: IDIV T2,NBASE ;Divide by base
PUSH P,T3 ;Store remainder
SKIPE T2 ;Number all done?
PUSHJ P,ITENB1 ;No, recurse
POP P,T1 ;Get digit
ADDI T1,"0" ;Make ASCII
PJRST ITECHR ;Print character and unwind
;ITECHR - Routine to insert one character in error text
ITECHR: IDPB T1,ERTXTP ;Append to error text
AOS NCOLM ;Increment column
POPJ P, ;Return
SUBTTL Return status routines
RT1R34: DMOVE T3,USR34 ;Restore user's 3 & 4
JRST RETST1 ;Return status 1
RT0R34: DMOVE T3,USR34 ;Restore user's 3 and 4
JRST RETST0 ;Return status 0
RETST2:
RETEOF: MOVEI T1,2 ;Set status = 2
POPJ P, ;Return
RETST0: TDZA T1,T1 ;STATUS 0
RETST1: MOVEI T1,1 ;STATUS 1
POPJ P, ;RETURN
CPOPJ1: AOS (P) ;Give skip return
CPOPJ: POPJ P, ;. .
;Address of a CRLF
CRLF: ASCIZ/
/
SUBTTL DATA SECTION
IFE TOPS20,<
RELOC 0 ;Relocate to low-seg for impure data
>;END IFE TOPS20
;Literals
IFN TOPS20,< ;TOPS20 literals
TXTILT: .RDRTY ;Last word given
RD%JFN!RD%BEL!RD%BRK ;Flags--Break on end of TTY: line or CTRL/Z
.PRIIN,,.PRIOU ;Input,,output JFNs
POINT 7,TLINE ;Destination ptr
.NTTYB ;Number of bytes available
0 ;Use start of buffer as above
0 ;Control-R text
>;END IFN TOPS20
STTLC==. ;Starting location to clear
PRGABR: BLOCK 1 ;3-letter sixbit abbreviation for main program
; (used for error message typeout).
USR12: BLOCK 2 ;USER'S ACS 1 AND 2
USR34: BLOCK 2 ;USER'S ACS 3 AND 4
DEFBFS: BLOCK 1 ;DEFAULT BUFFER SIZE (PAGES)
MXIFNR: BLOCK 1 ;MAX IFN USER REQUESTED
IFNSTR: BLOCK IT.SIZ * MAXIFN ;SPACE FOR ALL FILE STORAGE
USEXEX: BLOCK 1 ;-1 IF WE SHOULD USE EXTENDED ADDRESSING
USDPGS: BLOCK 1 ;# of used pages (Total)
RBLPGS: BLOCK 1 ;# of returnable pages
OPFEXT: BLOCK 1 ;Opening an external file if -1
SVBYTS: BLOCK 1 ;Saved byte size for a file
SVMADR: BLOCK 1 ;Saved memory address we got back
ITOSSZ: BLOCK 1 ;Size of file (used by ITOEXI)
BYVWRD: BLOCK 1 ;Bits/byte written
SVOUTB: BLOCK 1 ;Saved byte to output (ITOUB)
WTBUFC: BLOCK 1 ;# chars written to buffer (WRTBUF)
OTMJFN: BLOCK 1 ;JFN used by OPNTMP
ITOSFP: BLOCK 1 ;Offset saved by ITOSB
STRNBP: BLOCK 2 ;String byte pointer (used by ITOSB and ITISB)
ITNBYT: BLOCK 1 ;# bytes to read/write
PSFBNM: BLOCK 1 ;Byte number for ITPSF
PSFBPW: BLOCK 1 ;bytes/word
PSFBPP: BLOCK 1 ;Bytes/page for ITPSF
PSFPNM: BLOCK 1 ;Page number desired
PSFBOF: BLOCK 1 ;byte offset on the page
LOCABR: BLOCK 1 ;LH = 3-letter abbrev for error printing
LOCMSP: BLOCK 1 ;Local message ptr
ERTXTB: BLOCK ^D50 ;Block for error text
ERTXTP: BLOCK 1 ;Byte ptr to block
NCOLM: BLOCK 1 ;Column number we are at
NBASE: BLOCK 1 ;For ITENBR
ASCS1: BLOCK 1 ;Address of an ASCIZ string for error routine
ASCS2: BLOCK 1 ;Another address for ASCIZ string (if two are needed)
SIXBW1: BLOCK 1 ;Sixbit string input for error routine
ENUMBR: BLOCK 1 ;Number stored for error printing routine
EFNPTR: BLOCK 2 ;Byte ptr to ASCIZ generic file name string on errors
IT8PTR: BLOCK 2 ;Saved Bp to EFNPTR
TMOTRY: BLOCK 1 ;Number of times we tried to loop back with
;another name after we got the "simultaneous access
; error".
ITTFOP: BLOCK 1 ;-1 if a TTY: file is open for input
SVBPWB: BLOCK 2 ;Saved BP to buffer in WRTBUF
IFN TOPS20,< ;TOPS-20 only data
TXTIBL: BLOCK .RDRTY+1 ;TEXTI block
TXTIBE==.-1 ;End location of TEXTI block
TLINE: BLOCK <.NTTYB/5>+1 ;For holding a TTY: line
TTYLCT: BLOCK 1 ;Number of bytes still in TLINE
TTYLBP: BLOCK 1 ;Current bp to TLINE
>;END IFN TOPS20
IFE TOPS20,< ;TOPS-10 only data
FLPERR: BLOCK 1 ;FILOP. error code
FLP1AG: BLOCK 2 ;For IN and OUT FILOP. calls
FLPDL: BLOCK 2 ;Dump mode list
RDNINF: BLOCK 2 ;Saved info for RDNBUF
RTRYNM: BLOCK 1 ;Flag for ITRNF
SVRNBL: BLOCK .MXRBC ;Saved RENAME block for FILOP.
; Used by $ITRNF
SVRNPB: BLOCK .PTMAX+1 ;Saved PATH block for FILOP. (if needed)
EXRNBL: BLOCK 1 ;Flag- 0= not extended RENAME block, -1= yes
SVRNLN: BLOCK 1 ;Saved RENAME block length copied.
SVLKRP: BLOCK 1 ;Saved .FOLEB during FILOP. delete
SEED: BLOCK 1 ;Random number seed
>;END IFE TOPS20
ENDLC==.-1 ;Ending location to clear
END