Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/newsrc/tecfil.mac
There are 3 other files named tecfil.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1126 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(FIL,<TECO File system interface>) ; Generate the TITLE and other stuff
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECFIL - File system interface
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Macro definitions
; 4.1. $RETE . . . . . . . . . . . . . . . . . . . . 4
; 5. Misc definitions for TECFIL. . . . . . . . . . . . . . 5
; 6. F$INIT - File system initialization. . . . . . . . . . 6
; 7. F$SETI - Set the input routine to be the standard. . . 7
; 8. Default switch table . . . . . . . . . . . . . . . . . 8
; 9. F$PARS - Parse a file specificaton . . . . . . . . . . 9
; 10. Switch processing
; 10.3. F$SXBT - Get a sixbit item. . . . . . . . . . 18
; 10.4. F$PROT - Input a file protection. . . . . . . 19
; 10.5. F$KEY - Input a keyword . . . . . . . . . . . 19
; 10.6. F$CORE - Input an amount of core. . . . . . . 20
; 10.7. F$VERS - Input a version number . . . . . . . 21
; 11. F$DFLT - Default a FDB from another. . . . . . . . . . 26
; 12. F$EB - Do Edit backup function . . . . . . . . . . . . 27
; 13. EB subroutines
; 13.1. EBFAIL. . . . . . . . . . . . . . . . . . . . 30
; 14. F$ENQ - ENQ a file . . . . . . . . . . . . . . . . . . 31
; 15. F$DEQ - DEQ a file . . . . . . . . . . . . . . . . . . 32
; 16. ENQ/DEQ Subroutines
; 16.1. WRTCHR - Write a character. . . . . . . . . . 33
; 17. F$OPEN - Open a file . . . . . . . . . . . . . . . . . 34
; 18. Byte mode routines
; 18.1. F$WRIT - Output a byte. . . . . . . . . . . . 42
; 18.2. F$READ - Read a byte. . . . . . . . . . . . . 43
; 18.3. Sixbit input/output . . . . . . . . . . . . . 44
; 18.4. ASCII mode input/output . . . . . . . . . . . 46
; 18.5. LSA input/output. . . . . . . . . . . . . . . 47
; 19. F$IBYT - Input a byte. . . . . . . . . . . . . . . . . 49
; 20. F$OBYT - Write a byte to a file. . . . . . . . . . . . 50
; 21. F$COPY - Copy from one file to another . . . . . . . . 51
; 22. F$COPY
; 22.1. Subroutines
; 22.1.1. DBFGEN - General dump buffer routine 52
; 22.1.2. DBFASC - ASCII dump buffer routine . 53
; 22.1.3. FIXBRH - Fix a buffer header . . . . 54
; 22.1.4. CPYOUT - Output a buffer . . . . . . 55
; 22.1.5. CPYGEN - General copy routine. . . . 56
; 22.1.6. CPYGEN - General copy routine. . . . 57
; 23. F$CLOS - This routine will close a file. . . . . . . . 58
; 24. F$RSET - This routine will reset an I/O channel. . . . 59
; 25. F$USET - Do a USETI/USETO FILOP. . . . . . . . . . . . 60
; 26. F$RENM - Rename a file . . . . . . . . . . . . . . . . 61
; 27. FIXDEV - Routine to fix up a device name and path. . . 62
; 28. Subroutines
; 28.1. RENSUB. . . . . . . . . . . . . . . . . . . . 63
; 29. F$ERR - Error processing for the file errors . . . . . 64
; 30. CHKFFI - Check if file is found in a different area. . 65
; 31. Low segment for TECFIL . . . . . . . . . . . . . . . . 66
; 32. End of TECFIL. . . . . . . . . . . . . . . . . . . . . 67
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1001 By: Nick Bush On: 15-July-1980
Fix table entry to allow EH commands without an argument.
Avoid %TECSUP messages when doing an EB/INPLACE.
Modules: TECTBL,TECFIL
1014 By: Nick Bush On: 11-August-1980
1) Don't do the AUTO-BUFFER command if we had a error on the last command.
This avoids losing info for the error messages.
2) Make an EB/ER/EX sequence end up renaming the correct files, not
trying to rename the ER'ed file to the EB'ed file.BAK, ...
3) Make TEC file=file work the way it is supposed to.
Modules: TECPRS,TECFIL,TECECM,TECINI
1023 By: Robert McQueen On: 16-August-1980
Cause the path to be printed for the E< commands if the file that is edited
is in the default path.
Modules: TECFIL
1027 By: Nick Bush On: 21-August-1980
Shorten FILOP. block to not include the PPN word. This avoids random
protection failures.
Modules: TECFIL
1030 By: Robert McQueen On: 21-August-1980
- Clean up defaulting routines
- Prevent EB files from always seeming to be /INPLACE.
Modules: TECFIL,TECECM
1031 By: Robert McQueen On: 22-August-1980
Attempt to speed up reading characters by not saving T2 to T4 in F$READ and
rearrange the checks in the routine so they are faster.
Modules: TECFIL,TECUUO
1033 By: Nick Bush On: 22-August-1980
Fix F$ENQ to turn on the bypass level numbers bit for the ENQ.,
and to not allow the file to be edited if it gets the ENQDR% error.
Modules: TECFIL
1035 By: Nick Bush On: 25-August-1980
Fix CHKFFI to handle ersatz devices correctly. Use the path
returned by the monitor as the assumed path where the file
should exist. If it didn't exist there, give the FFI message
correctly. Under either case, if it is not the default path,
do the correct thing with EB'ed files.
Modules: TECFIL
1036 By: Nick Bush On: 26-August-1980
Restore .JBFF before calling CHKFFI in POSREA and POSAPP. This
avoids problems with memory management if the FFI message is to
be given.
Modules: TECFIL
1037 By: Robert McQueen On: 26-August-1980
Fix edit 1030 for defaulting.
Modules: TECUNV,TECFIL
1043 By: Robert McQueen On: 1-October-1980
?Illegal memory reference at PC .... (M$XPND+some). Stuffing the
warning message into the QRG which expands, but .JBFF is wrong.
Modules: TECFIL
1054 By: Nick Bush On: 13-November-1980
Fix yet another case of .JBFF being screwed up while a warning message
is being given.
Modules: TECFIL
1055 By: Robert McQueen On: 18-November-1980
Add two new :^T commands to put the terminal into packed image mode and to
take it out again.
:-3^T - Put into packed image mode
:-4^T - Take it out of packed image mode
Modules: TECUNV,TECFIL,TECCMD,TECMVM
1071 By: Nick Bush On: 10-January-1981
Add F$RBUF and F$WBUF routines to improve I/O performance.
Also add /MODE:DUMP for all file commands.
Modules: TECUNV,TECFIL,TECCMD,TECECM
1072 By: Robert McQueen On: 15-January-1981
Random errors from TECIOE to Ill mem refs. Clear LASFDB in F$WBUF before
returning to the caller.
Modules: TECFIL
1075 By: Robert McQueen On: 28-January-1981
Files that were edited with /MODE:DUMP had the habit of having junk at the
end of the file or the last few characters trashed. Fix the code that
clears the characters after the end of the editing buffer to do it
right.
Modules: TECFIL
1076 By: Nick Bush On: 30-January-1981
Add a default mode to be mode type 0. This will allow /MODE:ASCII
to really be such with LSA files. Also make /MODE: properly default
from ER/EW to EB and vice versa.
Modules: TECUNV,TECCMD,TECFIL,TECECM
1101 By: Robert McQueen On: 13-Febuary-1981
If the file was 'magic' in size don't blow it away. (Last editing buffer
fit in the last disk buffer, so LASFDB was never cleared, because no
output was done.)
Modules: TECFIL
1105 By: Robert McQueen On: 18-March-1981
Null files did not work with dump mode input.
Modules: TECFIL
1114 By: Robert McQueen On: 17-July-1981
Fix a defaulting problem with sub-file directories.
Modules: TECFIL
1121 By: Nick Bush On: 17-August-1981
Control-U's in three line command buffers did not work. More
checks were needed in DISPLY.
Fix defaulting of file spec paths to work correctly. A previous edit
had broken it.
Modules: TECVID,TECFIL
Start of Version 200A(1126)
|
SUBTTL Macro definitions -- $RETE
;+
;.HL1 $RETE
;This is a helper macro to return the error code to the caller
;.literal
;
; Usage:
; $RETE (XXX)
;.end literal
;-
DEFINE $RETE(XXX),<
JRST [MOVX T1,$FE'XXX
PJRST EATALT]
>; End of $RETE macro definition
SUBTTL Misc definitions for TECFIL
; The following are misc definitions for the I/O blocks
.FOLEN==.FOPAT+1 ; Length of a FILOP. block
.RBLEN==.RBALC ; Length of a LOOKUP block
SUBTTL F$INIT - File system initialization
$CODE ; Start of the code
;+
;.HL1 F$INIT
;This routine will initialize the file system interface module.
;This routine should be called once during the initialization of this
;editor.
;.literal
;
; Usage:
; PUSHJ P,F$INIT ; Initialize the file system
; (Return) ; Always return
;.end literal
;-
F$INIT: STORE T1,F$BZER,F$EZER,0 ; Clear the low segment
MOVX T1,.PTFRD ; Read the default path
MOVEM T1,MYPATH+.PTFCN ; Store in the function word
MOVE T2,[XWD .PTMAX,MYPATH] ; Set up to read the default path
MOVE T1,MYPPN ; Get the default for the path
PATH. T2, ; Get the default path from the operating system
MOVEM T1,MYPATH+.PTPPN ; Failed - Use the PPN
MOVEI T3,.GTLOC ; Get the location of job 0
GETTAB T3, ; from the monitor
JRST F$IN.0 ; Assuem default
MOVE T1,[XWD .NDRNN,T2] ; Get the argument pointer
MOVEI T2,2 ; Two arguments
NODE. T1, ; Get the node name
F$IN.0: MOVX T1,<SIXBIT /LOCAL/> ; Assume this
MOVEM T1,MYNODE ; Save this
MOVX T1,F%FDAE&LH.ALF!.GTFET ; See if FILDAE is there
GETTAB T1, ; Get it from the monitor
SETZ T1, ; Assume not
SETZM FDAEM ; Ditto
TXNN T1,F%FDAE&RH.ALF ; Well?
POPJ P, ; Return
SETOM FDAEM ; Yes
MOVX T1,%SIFDA ; See if FILDAE is running
GETTAB T1, ; . . .
SETZ T1, ; Assume not there
JUMPE T1,.POPJ ; Have one?
SETOM FDAEM ; No, not running
POPJ P, ; Return to the caller
SUBTTL F$SETI - Set the input routine to be the standard
;+
;.HL1 F$SETI
;This routine will set the input routine for the F$PARS and the F$SXBT and
;other routines to be the normal input routines.
;.literal
;
; Usage:
; MOVEI T1,Error.address
; PUSHJ P,F$SETI
; (Return)
;.end literal
;-
F$SETI: MOVEM T1,ERRRTN ; Store the error return
MOVEI T1,CMDCHR ; Get the input routine address
MOVEM T1,RTN ; Store the routine address
POPJ P, ; Return to the caller
; The following is the input routine for the input of a character
; It is set up by the call to F$SETI
BITMSK(IGNCHR,.CH,<CRT,FFD,LFD,VTB>) ; Characters to ignore
CMDCHR: $SAVE <T1> ; Save T1
CMDC.0: PUSHJ P,SKRCH ; Get the next character
JRST @ERRRTN ; Failed
MOVX T1,IGNCHR ; Get the mask of characters to ignore
LSH T1,(CH) ; Shift it
JUMPL T1,CMDC.0 ; If we don't want it, get the next
CAXN CH,.CHESC ; Is this an escape ?
SETZ CH, ; No - Return
POPJ P, ; Return to the caller
SUBTTL Default switch table
; The following are the switches that are always applied to a file specification
DEFINE DEFSWT,<
SW DEFAULT,<POINTR(<.FDFLG(P1)>,FD.DEF)>,,1,
SW MODE,<POINTR(<.FDMOD(P1)>,FD.MOD)>,F$KEY,MODPTR,SW.VRQ!SW.KEY
SW NODEFAULT,<POINTR(<.FDFLG(P1)>,FD.NDF)>,,1,
SW PROTECTION,<POINTR(<.FDPRO(P1)>,FD.PRO)>,F$PROT,,SW.VRQ
SW VERSION,<POINTR(<.FDVER(P1)>,FD.VER)>,F$VERS,,SW.VRQ
> ; End of DEFSWT macro definition
DOSWTCH(DEF,DEFSWT) ; Expand the table
; Expand the switch pointer macro
DEFPTR: SWTPTR (DEF) ; Make the argument block
SUBTTL F$PARS - Parse a file specificaton
;+
;.HL1 F$PARS
;This routine will parse a file specificaion, and store the results into
;an FD block. It will also parse any file switches that are present on
;this file specification
;.literal
;
; Usage:
; MOVEI T1,FDB.address
; MOVE T2,Switch.block.pointer
; PUSHJ P,F$PARS
; (Failed)
; (File spec parsed)
;.end literal
;-
F$PARS: $SAVE <P1,P2,P3> ; Save a few registers
MOVEM P,PRSSTK ; Store the pointer
DMOVE P1,T1 ; Copy the FDB and switch block addresses
MOVEM P1,LASFDB ; Store the last FDB
HRLI T1,1(T1) ; Clear the FDB
MOVSS T1 ; with a BLT
SETZM -1(T1) ; Clear the first word
BLT T1,.FDLEN-1(P1) ; . . .
MOVEI T1,[ERROR E.UFS] ; Get the error return
PUSHJ P,F$SETI ; Setup the input routine
; The following is the main loop for inputting items in the file specification
PARS.1: PUSHJ P,F$SXBT ; Get a sixbit item
CAXE CH,":" ; Delimiter a colon ?
JRST PARS.2 ; No - Try for the others
PUSHJ P,@RTN ; Get the next character
CAXE CH,":" ; Is this also a colon ?
JRST PARS.0 ; No - Must have a device name
CFXE. T2,FDBNOD,(P1),0 ; Have a node name already ?
$RETE (DNN) ; ++ Double node name illegal
STOR. T1,FDBNOD,(P1) ; Store the node name
JRST PARS.1 ; Get the next item
; Here to store a device name
PARS.0: PUSHJ P,F$REAT ; Reeat the character
CFXE. T2,FDBDEV,(P1),0 ; Have a node name already ?
$RETE (DDN) ; ++ Double device name illegal
STOR. T1,FDBDEV,(P1) ; Store the device name
JRST PARS.1 ; Loop
; Here if we have something as a delimiter besides a colon
PARS.2: CAXE CH,"." ; Extension coming next ?
JRST PARS.4 ; No - Check for path specification or switch
JSP T2,PARS.N ; Store the file name if present
PUSHJ P,F$SXBT ; Get the extension
TXNE T1,RH.ALF ; Make sure it is not too long
$RETE (ELS) ; ++ Extension longer than six characters
MOVX T2,FD.HEX ; Get the extension flag
TDNE T2,.FDFLG(P1) ; Make sure we don't have one already
$RETE (DEI) ; ++ Double extension not allowed
IORM T2,.FDFLG(P1) ; Light the flag
STORS. T1,FDBEXT,(P1) ; And store the extension
PUSHJ P,F$REAT ; Reeat the character
JRST PARS.1 ; And continue
; Here to check to see if we have a path specification
PARS.4: CAXE CH,"[" ; Start of the path specification ?
JRST PARS.S ; No - Try for a switch
JSP T2,PARS.N ; Store the file name if we have one
PUSHJ P,.IOCTW ; Get an octal number
JUMPN T1,[CAXE CH,"," ; Make sure a comma delimits
$RETE (IPS) ; ++ Illegal path specification
JRST PARS.6] ; Continue processint
CAXE CH,"-" ; Was the delimiter a dash ?
JRST PARS.5 ; No - Try for [,
PUSHJ P,@RTN ; Get the next character
JUMPE CH,PARS.3 ; Allow [-$
CAXE CH,"]" ; Is it the closing bracket ?
$RETE (IPS) ; ++ Illegal path specification
JRST PARS.3 ; Finish up
; Here to see if the delimiter for the null project number was a comma
PARS.5: CAXE CH,"," ; Is this corrrect
JRST [PUSHJ P,F$REAT ; Reeat the character
PUSHJ P,F$SXBT ; Try for a sixbit PPN
JUMPN T1,PARS.7 ; If we have one jump
$RETE (IPS)] ; ++ Illegal path specification
HLRZ T1,MYPPN ; Get the default project number
PARS.6: TXNE T1,LH.ALF ; Make sure the number is good
$RETE (IPS) ; ++ Illegal path specification
HRLM T1,.FDPPN(P1) ; Store in the PPN word
PUSHJ P,.IOCTW ; Get the second half
SKIPN T1 ; Something input ?
HRRZ T1,MYPPN ; No - Use the default
TXNE T1,LH.ALF ; Check for a right half value only
$RETE (IPS) ; ++ Illegal path specification
HRRM T1,.FDPPN(P1) ; Store the programmer number
SKIPA ; Skip and enter the SFD scanning
PARS.7: STOR. T1,FDBPPN,(P1) ; Store the PPN
MOVSI T3,-<.PTMAX-.PTSFD> ; Get minus the length
HRRI T3,.FDSFD(P1) ; Get the address
PARS.8: CAXE CH,"," ; Is this the delimiter ?
JRST PARS.9 ; No - Check for a ']'
PUSHJ P,F$SXBT ; Get the sixbit SFD
MOVEM T1,(T3) ; Store the SFD
JUMPE T1,[$RETE (NSS)] ; ++ Null SFD specified
AOBJN T3,PARS.8 ; Loop for all possible SFDs
$RETE (SNT) ; ++ SFDs nested too deeply
PARS.9: JUMPE CH,PARS.3 ; If done - just exit
CAXE CH,"]" ; Is this the end of the path spec ?
$RETE (IPS) ; ++ Illegal path specification
PARS.3: BITON T1,FD.PTH,.FDFLG(P1) ; Flag we have a path specified
SETZ T1, ; Flag we have no token
JUMPE CH,PARS.A ; If we got an altmode all is done
JRST PARS.1 ; Yes - Continue
; Here to process a switch
PARS.S: CAXE CH,"/" ; Is this a switch delimiter ?
JRST PARS.A ; Yes - Continue
JSP T2,PARS.N ; Store any file name
MOVE T2,(P2) ; Get the pointer
MOVEM T2,LASSWP ; Save the switch pointer
PUSHJ P,F$SXBT ; Get a sixbit token
JUMPE P2,PARS.C ; If no switch table skip this
PUSHJ P,PAR.SW ; Parse the switch
JRST [JUMPE T2,PARS.C ; Continue if unknown
$RETE (AMS)] ; ++ Ambig
JRST PARS.B ; Continue
PARS.C: PUSH P,P2 ; Save P2
MOVEI P2,DEFPTR ; Get the pointer to the default switches
PUSHJ P,PAR.SW ; Parse the switch again
JRST [POP P,P2 ; Restore P2
SKIPE T2 ; If unknown skip
$RETE (AMS) ; Return the error
$RETE (UNS)] ; Unknown switch
POP P,P2 ; Restore the old pointer
PARS.B: PUSHJ P,F$REAT ; Reat the delimiter
JRST PARS.1 ; Continue processing
; Here to do the main line processing of the switch
PAR.SW: MOVEM T1,LASSWT ; Save the last switch in case of error
LOAD. T2,SPBNAM,(P2) ; Get the pointer to the names
PUSHJ P,LOKNAM ; Look for the name in the table
POPJ P, ; Return to the caller
LOAD. T1,SPBNAM,(P2) ; Get the pointer again
SUBI T2,(T1) ; Make this an index
MOVE P3,T2 ; Copy it to a safe place
LOAD. T2,SPBRTN,(P2) ; Get the routine to call
ADDI T2,(P3) ; Point to the correct item
MOVE T2,(T2) ; Get the value
TXNE T2,SW.VRQ ; A value required ?
JRST [CAXN CH,":" ; Delimiter a colon ?
JRST PARS.T ; Yes - Attempt to get the value
MOVE P,PRSSTK ; Restore the stack pointer
$RETE (SRV)] ; Issue the error
CAXN CH,":" ; Is this a value delimiter ?
TXNN T2,LH.ALF ; Is there a routine address ?
JRST PARS.V ; No value presetn -- keep on trucking
PARS.T: MOVS T2,T2 ; Put the routine address in the correct half
PUSHJ P,(T2) ; Call the rotine
JRST PARS.U ; Continue
PARS.V: LOAD. T2,SPBVAL,(P2) ; Get the value to store
ADDI T2,(P3) ; Add in the offset
MOVE T1,(T2) ; Get the value to store
PARS.U: LOAD. T2,SPBPTR,(P2) ; Get the address f the pointer
ADDI T2,(P3) ; Point the correct word
MOVE T2,(T2) ; Get the byte pointer
TXNN T2,LH.ALF ; Does this half a left half ?
JRST [MOVEM T1,(T2) ; Store the value
JRST F$GRET] ; Give a good return
DPB T1,T2 ; Store the byte
F$GRET: SETZM LASFDB ; Clear the last FDB address since no errors
JRST .POPJ1 ; And give a skip return
; Here to store a file name
PARS.N: JUMPE T1,(T2) ; Return if zero
CFXE. ,FDBNAM,(P1),0 ; Have a name already ?
$RETE (DFN) ; ++ Double file name illegal
STOR. T1,FDBNAM,(P1) ; Store the file name
JRST (T2) ; Return
; Here to check for the end of the file specification
PARS.A: SKIPE CH ; End with an altmode ?
$RETE (IVC) ; No - Invalid character
JUMPE T1,.+2 ; Have a file name to store?
JSP T2,PARS.N ; Yes, store it first
STORE T1,PTH,PTH+.PTMAX,0 ; Clear the PATH block
LOAD. T1,FDBDEV,(P1) ; Get the device
JUMPE T1,F$GRET ; Return if no device
MOVEM T1,PTH+.PTSTR ; Store in the PATH block
MOVEI T1,PTH ; Get the address of the block
PATH. T1, ; Get the path for the device
JRST F$GRET ; Probably not a disk device
LOAD T1,PTH+.PTSWT,PT.IPP ; Implied PPN ?
JMPF T1,F$GRET ; Jump if false
MOVX T1,FD.PTH ; Have a path already ?
TDNE T1,.FDFLG(P1) ; Have it ?
$RETE (DIP) ; ++ Device implies a PATH, but one was given
PJRST F$GRET ; All is okay, return
SUBTTL Switch processing -- F$SXBT - Get a sixbit item
;+
;.HL2 F$SXBT
;This routine will input a sixbit token.
;-
F$SXBT: $SAVE <T2,T3> ; Save T2 and T3
SETZ T1, ; Clear the accumulated number
; Input a sixbit thingy
MOVE T2,[POINT 6,T1] ; Set up the byte pointer
PUSHJ P,GNBCHR ; Get the first non-blank character
SKIPA ; And enter the routine
F$SX.0: PUSHJ P,@RTN ; Input an item
MOVE T3,CHRFLG(CH) ; Get the character flags
TXNE T3,CF.LC ; Is this lower case ?
ANDI CH,137 ; Yes - Convert to upper case
TXNN T3,CF.NUM!CF.ALP ; Alphabetic or numeric?
JRST F$SX.1 ; No - Clean up and return to the caller
SUBI CH," "-' ' ; Convert to SIXBIT
TXNN T1,77 ; Have the word filled ?
IDPB CH,T2 ; No - Store the character
JRST F$SX.0 ; And loop for the next character
; Here to store the last sixbit item so that error processing will work
F$SX.1: MOVEM T1,LASSXB ; Store this as the last sixbit item
POPJ P, ; Return to the caller
SUBTTL Switch processing -- F$PROT - Input a file protection
;+
;.HL2 F$PROT
;This routine will input a file protection.
;-
F$PROT: PUSHJ P,.IOCTW ; Get the octal protection
BITON T2,FD.HPR,.FDFLG(P1) ; Light the flag
CAIGE T1,^O1000 ; Is this too big ?
POPJ P, ; No - Give a good return
MOVE P,PRSSTK ; Get the stack pointer
$RETE (PRO) ; Protection is bad
SUBTTL Switch processing -- F$KEY - Input a keyword
F$KEY: PUSHJ P,F$SXBT ; Get the sixbit item
LOAD. T2,SPBVAL,(P2) ; Get the pointer to the values
ADDI T2,(P3) ; Point to the correct entry
MOVE T2,(T2) ; Get the entry
PUSH P,T2 ; Save the pointer
PUSHJ P,LOKNAM ; Look for the keyword
JRST [MOVE P,PRSSTK ; Get the stack to pointer
SKIPE T2 ; Unknown ?
$RETE (AKW) ; Ambig keyword
$RETE (UKW)] ; Unknown keyword
MOVEI T1,(T2) ; Get the address it found the keyword at
POP P,T2 ; Restore the pointer
SUBI T1,(T2) ; Make this an index
POPJ P, ; Return to the caller
SUBTTL Switch processing -- F$CORE - Input an amount of core
;+
;.HL2 F$CORE
; This routine will input an amount of core. The valid formats for
;the input are nP, where n is the number of pages, nK, where n is the
;number of kilo-words, nW where n is the number of words, nB, where
;n is the number of blocks, or n, where n is the number of K.
;-
F$CORE: PUSHJ P,.IDECW ; Get a decimal number
MOVEI T2,^D10 ; Get the default amount to shift
CAIL CH,"a" ; Check for lower case
CAILE CH,"z" ; . . .
SKIPA ; Upper case - skip
SUBI CH,"a"-"A" ; Convert to upper
CAIN CH,"P" ; Did he give a P?
MOVEI T2,^D9 ; Yes, shift by correct amount
CAIN CH,"W" ; Give number of words?
SETZ T2, ; Yes, don't shift at all
CAIN CH,"B" ; Or was it the number of blocks
MOVEI T2,^D7 ; Yes, get the amount
LSH T1,(T2) ; Multiply by correct amount
JUMPN T2,@RTN ; Input the next character and return
POPJ P, ; And return the value
SUBTTL Switch processing -- F$VERS - Input a version number
;+
;.HL2 F$VERS
;This routine will input a version number.
;-
F$VERS: STORE T1,VERBEG,VEREND,0 ; Clear the storage
PUSHJ P,.IOCTW ; Input the first part of the version number
CAXLE T1,777 ; Is this within range ?
JRST VERS.0 ; No - Error
MOVEM T1,VERMAJ ; Save it
VERS.2: CAIN CH,"(" ; Have a minor version ?
JRST VERS.1 ; No - or done with it
MOVEI T1,^D26 ; get the number of multiply by
IMULM T1,VERMIN ; . . .
MOVE T1,CHRFLG(CH) ; Get the flags
TXNE T1,CF.LC ; Is this lower case ?
ANDI CH,137 ; Convert to just upper case
CAIG CH,"Z" ; Is this a valid character
CAIGE CH,"A" ; . . .
JRST VERS.0 ; No - Give an error return
SUBI CH,"A"-1 ; Convert to an octal number
ADDB CH,VERMIN ; Update the version number
CAXLE CH,77 ; Within reange still ?
JRST VERS.0 ; No - Give an error return
PUSHJ P,@RTN ; Get the next character
JRST VERS.2 ; Try again for the minor version number
; Here for the edit level
VERS.1: PUSHJ P,.IOCTW ; Input the edit level
TXNN T1,LH.ALF ; Is this small enough ?
CAIE CH,")" ; Proper delimiter ?
JRST VERS.0 ; No - ERrror
MOVEM T1,VEREDT ; Save the edit level
PUSHJ P,@RTN ; Get the next character
CAXE CH,"-" ; Is this the start of a minor version ?
JRST VERS.3 ; No - Clean up
PUSHJ P,.IOCTW ; Input the who
CAXLE T1,7 ; Better be less than
JRST VERS.0 ; Error
MOVEM T1,VERWHO ; Store it
VERS.3: MOVE T1,VERMAJ ; Get the major version number
LSH T1,<ALIGN. (VR.VER)> ; Align it
MOVE T2,VERMIN ; Get the minor version number
STOR T2,T1,VR.MIN ; Store the minor version number
MOVE T2,VEREDT ; Get the edit level
STOR T2,T1,VR.EDT ; Store the edit level
MOVE T2,VERWHO ; Get who last dited
STOR T2,T1,VR.WHO ; Store it
POPJ P, ; Return to the caller
; Here incase there was an error
VERS.0: MOVE P,PRSSTK ; Get the stack pointer
$RETE (IVN) ; ++ Invalid version number
; Helper routines
; Routine to eat to an altmode
EATALT: $SAVE <CH> ; Save CH
EATA.0: JUMPE CH,.POPJ ; Return if zero
PUSHJ P,@RTN ; Get the next character
JRST EATA.0 ; Loop
; Routine to input a non-blank character
GNBCHR: PUSHJ P,@RTN ; Get a character
CAXE CH," " ; Is this a space
CAXN CH,.CHTAB ; or a tab ?
JRST GNBCHR ; Loop to get the next
POPJ P, ; Return
; Here to F$REAT the last character input
F$REAT: $SAVE <T1> ; Save T1
MOVEI T1,RSTRTN ; Get the next routine
EXCH T1,RTN ; Exchange
MOVEM T1,SAVRTN ; Save the old one
POPJ P, ; Return
RSTRTN: $SAVE <T1> ; Save T1
MOVE T1,SAVRTN ; Get the old routine address
MOVEM T1,RTN ; Restore it
POPJ P, ; Return to the caller
SUBTTL F$DFLT - Default a FDB from another
;+
;.HL1 F$DFLT
; This routine will default the items from one FDB to another.
;The updated FDBs are returned in the calling registers.
;.literal
;
; Usage:
; MOVEI T1,FDB.given
; MOVEI T2,FDB.to.default.from
; PUSHJ P,F$DFLT
; (Return)
;.end literal
;-
DEFINE DEFFDB(XXX,YYY),<
LOAD. T4,FDB'XXX',(T1) ;; Get the given value
LSTOF. X ;; Turn the listing off
SKIPN T4 ;; Zero value
LOAD. T4,FDB'XXX',(T2) ;; Get the default value
IFNB <YYY>,<TXNN T3,FD.'YYY> ;; If we should not store
STOR. T4,FDB'XXX',(T1) ;; Store the default value
STOR. T4,FDB'XXX',(T2) ;; Store the new default value
IFNB <YYY>,<
MOVX T4,FD.'YYY ;; Get the bit to store
TDNE T4,.FDFLG(T2) ;; Is this on ?
IORM T4,.FDFLG(T1) ;; Light the flag
TXNE T3,FD.'YYY ;; Was it on already?
IORM T4,.FDFLG(T2) ;; Yes, turn on in default block
>;; End of IFNB <YYY>
LSTON. ;; Turn the listing back on
> ; End of DEFFDB macro definition
F$EBDF: TXO F,F.EB ; Flag doing an EB default
F$DFLT: MOVSI T4,(T3) ; Yes, set up the BLT pointer
HRRI T4,(T2) ; . . .
LOAD. T3,FDBFLG,(T1) ; Get the flags for the routine
TXNE T3,FD.DEF ; /DEFAULT given?
BLT T4,.FDLEN-1(T2) ; Yes, copy the permanent defaults
TXNE T3,FD.NDF ; No storing of defaults ?
POPJ P, ; Yes, Just return
DEFFDB NOD ; Default the node name
DEFFDB DEV ; Default the device nmae
DEFFDB NAM ; Default the file name
DEFFDB EXT,HEX ; Default the extension
DEFFDB PRO,HPR ; Default the protection
DEFFDB MOD ; Default the mode
DEFFDB VER ; Default the version number
TXZE F,F.EB ; Doing EB default ?
POPJ P, ; Yes, return now
CFXN. ,FDBDEV,(T1),0 ; Have a device ?
JRST F$DF.1 ; No, skip this
STORE T4,PTH,PTH+.PTMAX-1,0 ; Clear the path block
LOAD. T4,FDBDEV,(T1) ; Get the device name again
MOVEM T4,PTH+.PTSTR ; Store into the PATH block
MOVE T4,[XWD .PTMAX,PTH] ; Get the argument block pointer
PATH. T4, ; Do it
JRST F$DF.1 ; Failed, ignore it
LOAD T4,PTH+.PTSWT,PT.IPP ; Get the implied PPN
JMPT T4,.POPJ ; Return if true
F$DF.1: MOVX T3,FD.PTH ; Get the bit to check
TDNN T3,.FDFLG(T1) ; Specified for the file?
JRST F$DF.2 ; No, Check the default
IORM T3,.FDFLG(T2) ; Flag we now have a default
DEFINE CPYFLD(LIST,FROM,TO)<
IRP <LIST><
LOAD. T3,FDB'LIST',('FROM') ;; Get the item
STOR. T3,FDB'LIST',('TO') ;; Move it
>;; End of IRP <LIST>
>; End of macro definition CPYFLD
CPYFLD (<PPN,SFD,SF2,SF3,SF4,SF5>,T1,T2)
POPJ P, ; Return to the caller with the FDBs updated
; Here to determine if the path was specified in the default, if so copy it
; to the file.
F$DF.2: TDNN T3,.FDFLG(T2) ; Specified in the default?
POPJ P, ; No, Just return
IORM T3,.FDFLG(T1) ; Flag we have a directory
CPYFLD (<PPN,SFD,SF2,SF3,SF4,SF5>,T2,T1)
POPJ P, ; Return after the items are updated
SUBTTL F$EB - Do Edit backup function
;+
;.HL1 F$EB
;This routine will do the edit backup functions for the file processing.
;.literal
;
; Usage:
; MOVEI T1,FDB.address
; PUSHJ P,F$OPEN
; (failed)
; (Won)
; Returns:
; T1 - Temporary FDB (.TMP file)
; T2 - Rename FDB
;.end literal
;-
F$EB: $SAVE <P1,P2,P3> ; Save a few registers
MOVE P1,T1 ; Copy the FDB
MOVEM P1,LASFDB ; Store this
LOAD. T1,FDBEXT,(P1) ; Get the extension
CAIN T1,'BAK' ; Is this a BAK file ?
ERROR E.EBF ; ++ Can not edit a backup file
LOAD. T1,FDBDEV,(P1) ; Get the device
DEVCHR T1, ; Get the device characteristics
TXNN T1,DV.DSK ; Is this a disk ?
JRST [MOVX T1,$FENAD ; Get the error code
POPJ P,] ; Return to the caller
; Here to open the input file
MOVX T1,$IOREA ; Get the function
MOVE T2,P1 ; Get the FDB
PUSHJ P,F$OPEN ; Open the file for reading
POPJ P, ; Failed ?
MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$ZBLK ; Allocate a zero'ed block
MOVE P2,T1 ; Copy the address
MOVE T2,P1 ; Default from the source file
PUSHJ P,F$EBDF ; . . .
SETZ P3, ; Clear for rename FDB
SKIPGE T1,SWTOMD ; Get the output mode
LOAD. T1,FDBMOD,(P1) ; None given, use the same as input
STOR. T1,FDBMOD,(P2) ; Store the mode
MOVE T1,.FDFLG(P1) ; Check if /INP
TXNE T1,FD.INP ; . . .
JRST F$EB.I ; /INPLACE given, go handle it
TXNN T1,FD.NDP ; In default path?
JRST F$EB.2 ; Yes, go handle it
ZERO. ,FDBPPN,(P2) ; Clear the PPN
ZERO. ,FDBSFD,(P2) ; And the first SFD
STORI. <SIXBIT |DSK|>,T1,FDBDEV,(P2) ; Write into default search list
ZERO. ,FDBNOD,(P2) ; On current node
JRST F$EB.0 ; Go continue on
; Here for /INPLACE. Copy all the information from the input file for the
;output file.
DEFINE CPYFLD(NAME)<
IRP NAME,< LOAD. T1,FDB'NAME,(P1) ;; Get the field
STOR. T1,FDB'NAME,(P2) ;; Store it>>
F$EB.I: CPYFLD(<NOD,DEV,NAM,EXT,PRO,VER,PPN,SFD,SF2,SF3,SF4,SF5>)
BITON T1,FD.PTH!FD.HEX,+.FDFLG(P2) ; Flag that we have a path and an extension
SKIPA T1,[EXP $IOWRI] ; Get the write, don't care if supercede function
FALL F$EB.0 ; And continue on
; Here if the output is to be the same file name and extension as the input.
;For this case we do not need a rename FDB, nor do we need to flag this as
;an EB command opened file.
F$EB.0: MOVX T1,$IOWRS ; Get the write/no supercede
MOVE T2,P2 ; And the FDB address
PUSHJ P,F$OPEN ; And open for output
JRST EBFAIL ; Can't, give up
MOVE T1,P1 ; Get the FDB address to lock up
PUSHJ P,F$ENQ ; ENQ. the file name
JRST F$EB.9 ; Couldn't, go give the error
DMOVE T1,P2 ; Get the FDB address and the zero
PJRST F$GRET ; And return
F$EB.9: MOVE T1,P1 ; Get the input file FDB
PUSHJ P,F$RSET ; And reset it
MOVE T1,P1 ; Get it again
PUSHJ P,M$RBLK ; Return the block
MOVEM P2,LASFDB ; Save the block address
MOVX T1,$FEFAE ; Get the file already being edited code
POPJ P, ; And give the error return
F$EB.2: MOVX T1,.FDLEN ; Get the length
MOVX T2,.BTFDB ; And the block type
PUSHJ P,M$ZBLK ; Allocate a zero'ed block
MOVE P3,P2 ; Save the other one
MOVE P2,T1 ; And get the address of the new one
LOAD. T1,FDBMOD,(P3) ; Get the output mode
STOR. T1,FDBMOD,(P2) ; Save it for the .TMP file
LOAD. T1,FDBDEV,(P1) ; Get the device the file came from
STOR. T1,FDBDEV,(P2) ; And save it
STORI. <'TMP'>,T1,FDBEXT,(P2) ; With .TMP extension
BITON T1,FD.HEX,.FDFLG(P2) ; Flag that we have an extension
LOAD. T1,FDBCHN,(P1) ; Get the channel number
LSHC T1,-5 ; Insert a bit in the middle
LSH T1,1 ; . . .
LSHC T1,5 ; . . .
TXO T1,'TAA' ; Make it readable
HLL T1,SIXJOB ; Get the sixbit job number
STOR. T1,FDBNAM,(P2) ; Save it
MOVX T1,$IOWRI ; Get the write function
MOVE T2,P2 ; And the FDB address
PUSHJ P,F$OPEN ; And set up the output file
PJRST EBFAIL ; Couldn't
MOVE T1,P3 ; And check that we can handle the source file
MOVE T2,P3 ; by renaming it to itself
PUSHJ P,F$RENM ; . . .
PJRST EBFAIL ; Couldn't
STORI. <'BAK'>,T1,FDBEXT,(P3) ; Change for .BAK file
MOVE T1,P3 ; And check if we can rename that
MOVE T2,P3 ; . . .
PUSHJ P,F$RENM ; . . .
JRST [CAXE T1,ERFNF% ; File not found?
JRST EBFAIL ; No, give up
JRST .+1] ; Yes, all is okay
LOAD. T1,FDBEXT,(P1) ; Get the extension back
STOR. T1,FDBEXT,(P3) ; And reset the rename FDB
MOVX T1,FD.EB ; Get the flag to turn on
IORM T1,.FDFLG(P1) ; Flag it here
IORM T1,.FDFLG(P2) ; And here
IORM T1,.FDFLG(P3) ; And here that this FDB is for an EB'ed file
MOVE T1,P1 ; Get the FDB address
PUSHJ P,F$ENQ ; And ENQ. it
JRST [MOVX T1,$FEFAE ; Get the error code
PJRST EBFAIL] ; And reset the world
DMOVE T1,P2 ; Get the FDB addresses
JRST F$GRET ; And return happy
; Here if the open of the output file failed. See if superceeding
SUBTTL EB subroutines -- EBFAIL
;+
;.HL2 EBFAIL
; Here if the EB function has failed. This routine will clean up the random
;files that have been opened and return the blocks for all except the EB FDB.
;-
EBFAIL: $SAVE <T1> ; Save the error code
MOVE T1,LASFDB ; Get the last FDB
LOAD. T1,FDBERR,(T1) ; And get the error code from it
STOR. T1,FDBERR,(P1) ; Save it for later
MOVEM P1,LASFDB ; And reset the last FDB
MOVE T1,P1 ; Reset the input file
PUSHJ P,F$RSET ; . . .
SKIPE T1,P3 ; Copy this one
PUSHJ P,F$RSET ; Kill off this channel
SKIPE T1,P3 ; Get the block to return
PUSHJ P,M$RBLK ; Return this block
MOVE T1,P2 ; Get the other block to return
PUSHJ P,F$RSET ; Reset this channel if any
MOVE T1,P2 ; Get it again
PJRST M$RBLK ; Return it if we can
SUBTTL F$ENQ - ENQ a file
;+
;.HL1 F$ENQ
; This routine will set the ENQ./DEQ. lock for the resource which is a file
;name. The lock is set for the string which is the complete file specification.
;It takes as arguments the addresses of the open block and of the lookup/enter
;block.
;This routine has two returns. The error (non-skip) return is taken if
;the lock cannot currently be granted. The normal return is taken if the lock
;has been granted.
;.literal
;
; Usage:
; MOVE T1,FDB
; PUSHJ P,F$ENQ ; ENQ the file
; (Failed)
; (Good return)
;.end literal
;-
F$ENQ: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the address of the FDB
STORE T1,ENQBEG,ENQEND,0 ; Clear the blocks
MOVX T1,<INSVL.(1,EQ.LNL)+INSVL.(.ENQPS+.ENQRI+2,EQ.LLB)>
MOVEM T1,.ENQLL+ENQHDR ; Save the lengths word
LOAD. T1,FDBCHN,(P1) ; Get the channel number
MOVEM T1,.ENQRI+ENQHDR ; Also save as the request ID
TXO T1,EQ.FBL ; Bypass level numbers
MOVEM T1,.ENQFL+ENQBLK ; Save it
MOVE T1,[POINT 7,STRING] ; Get the byte pointer
MOVEM T1,.ENQBP+ENQBLK ; Save it
LOADS. T4,FDBEXT,(P1) ; Get the extension for later
MOVEI T3,.FDPPN-.PTPPN(P1) ; Get the address of the path block
MOVEI T1,[$STRING(<^X/WRTCHR/^W/.FDDEV(P1)/:^W/.FDNAM(P1)/.^W/T4/^P/T3/^0>)]
PUSHJ P,T$TYPE ; Make the string to lock
MOVE T1,[POINT 7,STRING] ; Get the byte pointer back
MOVEM T1,.ENQBP+ENQBLK ; And save it for the monitor
MOVE T1,[XWD .ENQAA,ENQHDR] ; Get the pointer
ENQ. T1, ; And try for the lock
JRST ENQFAI ; ENQ. failed - see why
BITON T1,FD.ENQ,.FDFLG(P1) ; Light the flag
JRST .POPJ1 ; Give a good return
; Here if the ENQ. failed
ENQFAI:
IFN FTDEBUG,WARN E.EQF ; ENQ. failed
CAXE T1,ENQRU% ; Is it currently locked ?
CAXN T1,ENQDR% ; Duplicate request? (we must be already editing it)
POPJ P, ; Give an FAE message
PJRST .POPJ1 ; Some other error, ignore it
SUBTTL F$DEQ - DEQ a file
;+
;.hl1 F$DEQ
; This routine will release all current locks.
;-
F$DEQ: LOAD. T2,FDBCHN,(T1) ; Get the channel number
HRLI T2,.DEQID ; Get the function
DEQ. T2, ; And DEQ. the file
JFCL ; Can't do much
BITOFF T2,FD.ENQ,.FDFLG(T1) ; Turn off the bit
POPJ P, ; Return
SUBTTL ENQ/DEQ Subroutines -- WRTCHR - Write a character
WRTCHR: IDPB CH,.ENQBP+ENQBLK ; Store the character
POPJ P, ; And return
SUBTTL F$OPEN - Open a file
;+
;.HL1 F$OPEN
;This routine will open a file for I/O. It is called with the function
;in T1.
;.literal
;
; Usage:
; MOVEI T1,I/O function
; MOVEI T2,FD.block ; File descriptor
; PUSHJ P,F$OPEN ; Open the file
; (Failed)
; (Won)
;
; Returns:
; On error: T1 contains the file system error code
; Good return: T1 contains the address of a file access block
;.end literal
;-
F$OPEN: $SAVE <P1,P2,P3> ; Save P1 and P2
MOVEM T2,LASFDB ; Store the last FDB
DMOVE P1,T1 ; Copy the arguments
OPEN.0: STORE T1,OPNBEG,OPNEND,0 ; Clear the OPEN area
LOAD. T2,FDBDEV,(P2) ; Get the device name
JUMPE T2,[MOVX T1,$FENXD ; Get the error code to return
POPJ P,] ; And return it
LOAD. T1,FDBNOD,(P2) ; Get the node name
JUMPE T1,OPEN.A ; Have the name?
CAMN T1,MYNODE ; Are we here?
JRST OPEN.A ; All is okay
MOVX T1,$FENNS ; no network support yet
POPJ P, ; Return the error
OPEN.A: LOAD. T1,FDBMOD,(P2) ; Get the mode
CAXE T2,<SIXBIT |TTY|> ; Is this the terminal?
JRST OPEN.D ; No, skip this
CAXE T1,$FMTRM ; Terminal mode?
CAXN T1,$FMPIM ; Packed image mode ?
SKIPA ; Yes keep going
JRST OPEN.D ; No, skip this
MOVE T3,T2 ; Yes, get the name
DEVCHR T3, ; And get the DEVCHR bits
MOVX T4,.FALSE ; Get false
TXNN T3,DV.TTA ; Is this terminal controlling a job?
MOVX T4,.TRUE ; No, get the value to store in the flag
STOR T4,.FDFLG(P2),FD.NTT ; Flag this isn't the controlling terminal
MOVE T1,IOMTBL(T1) ; Get the correct I/O mode
JMPNS OPEN.F ; Screen mode?
TXOA T1,IO.SUP ; Yes, flag we want echoing suppressed
OPEN.D: MOVE T1,IOMTBL(T1) ; Get the monitor I/O mode
OPEN.F: DEVCHR T2, ; Get the device characteristics
JUMPE T2,OPEN.G ; Does it exist?
LOAD T3,T1,IO.MOD ; Get the mode
MOVX T4,DV.M0 ; Get the mode 0 bit
LSH T4,(T3) ; And shift to correct place
TDNN T2,T4 ; Is this mode legal?
JRST [MOVX T1,$FEIMD ; No, get the error
POPJ P,] ; And return
CAXLE T3,.IOBIN ; Is this a binary mode?
TXNE T2,DV.DSK ; Yes, must be a DSK device or we can't hack it
JRST .+2 ; Allow it
JRST [MOVX T1,$FEIMD ; No, get the error
POPJ P,] ; And return
MOVEI T3,T1 ; Get the address of the argument block
LOAD. T2,FDBDEV,(P2) ; Get the device name back
DEVSIZ T3, ; Determine the size of the buffers
JRST .+2 ; Skip if an error occured
JUMPGE T3,OPEN.1 ; If this was not an error - Jump
CAXE T3,DVSNX% ; No such device?
STOPCD (UDE,<Unknown DEVSIZ error>)
OPEN.G: LOAD. T2,FDBDEV,(P2) ; Get the device name back
CAXE T2,<SIXBIT /TMP/> ; Is this the temp device ?
JRST [MOVX T1,$FENXD ; Get the error code
POPJ P,] ; Give an error return
CFXE. T1,FDBEXT,(P2),0 ; Make sure this is a good TMP: file spec
JRST [MOVX T1,$FEITS ; ++ Illegal TMP: file specification
POPJ P,] ; Return
LOAD. T1,FDBNAM,(P2) ; Get the file name
TXNE T1,RH.ALF ; Check to make sure only left half
JRST [MOVX T1,$FEITS ; ++ Illegal TMP: file specification
POPJ P,] ; Return
SETZ T2, ; Clear the next word
JRST @TMPTBL(P1) ; Jump and do the function
; The following is the dispatch table for the TMP: functions
TABDEF TMP,$IO,TMPILL ; Generate the table
TABENT DEL,TMPDEL ; Delete a file
TABENT WRI,TMPWRI ; Write a file
TABENT WRS,TMPWRS ; Write and no-super
TABENT REA,TMPREA ; Read a file
TABEND ; End of the dispatch table
; Here for an illegal TMP: function
TMPILL: MOVX T1,$FEITF ; ++ Illegal TMP: function
POPJ P, ; Give an error return
; Here to do a delete of a TMP: file
TMPDEL: MOVE T3,[XWD .TCRDF,T1] ; Set up the argument pointer
TMPCOR T3, ; Do it
JRST TMPDSK ; Failed - Try disk
JRST F$GRET ; Give a good return
; Here to write with no super
TMPWRI:
TMPWRS: MOVE T3,[XWD .TCRRF,T1] ; Get the function argument pointer
TMPCOR T3, ; Is this file there ?
JRST TMPW.1 ; No, continue on
CAXN P1,$IOWRS ; Do we need the message?
WARN E.SUP ; Superceeding existing file
MOVX T2,<XWD .TCRFS,0> ; Get the amount left free
TMPCOR T2, ; . . .
SETZ T2, ; Assume none
ADD T3,T2 ; Get the total length
TMPW.1: JUMPN T3,TMPW.2 ; Have any to write into?
LOADS. T1,FDBNAM,(P2) ; No, get the file name
HLL T1,SIXJOB ; And make the nnnFOO
STOR. T1,FDBNAM,(P2) ; Store the name
MOVX T1,'TMP' ; Get the extension
STOR. T1,FDBEXT,(P2) ; Store it
MOVX T1,<SIXBIT |DSK|> ; Get the device
STOR. T1,FDBDEV,(P2) ; Store it
BITON T1,FD.TMD!FD.HEX,.FDFLG(P2) ; Flag this is a TMP file on disk
JRST OPEN.0 ; And go try to write on disk
TMPW.2: MOVE T1,T3 ; Get the number of words we can use
MOVX T2,.BTBUF ; Make it a buffer
PUSH P,T3 ; Save the size
PUSHJ P,M$ZBLK ; Get a block
POP P,T3 ; Get the size back
STOR. T1,FDBBUF,(P2) ; Store the buffer address
HRLI T1,(POINT 7,) ; Get the byte pointer
MOVEM T1,.FDBRH+.BFPTR(P2) ; Store it
MOVN T2,T3 ; Get the number of words
HRLI T1,(T2) ; Make an IOWD
SOJ T1, ; . . .
MOVEM T1,.FDBRH+.BFADR(P2) ; Store for later
IMULI T3,5 ; Make the number of chars we can fit
MOVEM T3,.FDBRH+.BFCTR(P2) ; Store it
BITON T1,FD.TMP!FD.OPN!FD.OUT,.FDFLG(P2) ; Flag this is to go to TMPCOR
PJRST F$GRET ; Give the good return
; Here to read a TMP: file
TMPREA: MOVE T3,[XWD .TCRRF,T1] ; Make sure the file is around
TMPCOR T3, ; . . .
JRST TMPDSK ; Failed - Try disk
PUSH P,T3 ; Save the number of words
MOVE T1,(P) ; Get the number of words back again
MOVX T2,.BTBUF ; Allocate a buffer
PUSHJ P,M$GBLK ; From memory management
STOR. T1,FDBBUF,(P2) ; Store this
HRLI T1,(POINT 7) ; Build a byte pointer
STOR. T1,FDBPTR,(P2) ; Store in the buffer header
POP P,T2 ; Get the number of words back again
MOVEI T3,5 ; Get the number of characters per word
IMUL T3,T2 ; Comput the character count
STOR. T3,FDBCTR,(P2) ; Store in the file access block
STOR. T3,FDBSIZ,(P2) ; Store as the file size too
LOAD. T4,FDBMOD,(P2) ; Get the mode of the file
CAXN T4,$FMDMP ; /MODE:DUMP?
STOR. T2,FDBSIZ,(P2) ; For DUMP mode we need the word count
MOVN T2,T2 ; Build the IOWD for reading TMP:
HRLZ T2,T2 ; . . .
HRRI T2,-1(T1) ; . . .
LOAD. T1,FDBNAM,(P2) ; Get the name back again
MOVE T3,[XWD .TCRRF,T1] ; Get the function and argument pointer
TMPCOR T3, ; Get the file
STOPCD (TFD,<TMP: file disappeared>)
BITON T1,FD.OPN!FD.TMP!FD.IN,.FDFLG(P2) ; Light a few flags
MOVE T1,P2 ; Return the FDB
JRST F$GRET ; Return to the caller
; Here to try the disk for a TMP: file
TMPDSK: MOVX T1,<SIXBIT /DSK/> ; Get the device name
STOR. T1,FDBDEV,(P2) ; Store in the FDB
LOADS. T1,FDBNAM,(P2) ; Get the file name again
HLL T1,SIXJOB ; Get the sixbit job number
STOR. T1,FDBNAM,(P2) ; Store it back
MOVX T1,'TMP' ; Get the extension
STOR. T1,FDBEXT,(P2) ; Store it
BITON T1,FD.HEX,.FDFLG(P2) ; Flag we have an extension
JRST OPEN.0 ; Try again from the top
; Here for disk or other type files
OPEN.1: MOVEM T1,FLP+.FOIOS ; Save the I/O status
MOVEM T2,FLP+.FODEV ; Save the device name
PUSH P,T3 ; Save T3
MOVE T1,FLPTBL(P1) ; Get the FILOP. function
MOVEM T1,FLP+.FOFNC ; Store it
EXCH P1,P2 ; Put this in the correct place
MOVEI T3,ELB ; Get the LOOKUP/ENTER block address
MOVEI T4,PTH ; Get the path block address
PUSHJ P,RENSUB ; Call the subroutine to move things
EXCH P1,P2 ; Put the things back into the correct places
MOVEI T1,ELB ; Get the LOOKUP/ENTER block address
MOVEM T1,FLP+.FOLEB ; And store item
MOVX T1,<XWD .PTMAX,FPTH> ; Get the pointer to the found path area
MOVEM T1,FLP+.FOPAT ; Store it
POP P,T3 ; Restore the buffer size and number
PUSHJ P,@PRETBL(P1) ; Do the preprocessing
OPEN.2: MOVE T1,[XWD .FOLEN,FLP] ; Get the argument block pointer
MOVE T2,ELB+.RBPPN ; Get the PPN incase of ERAEF% and $IOWRS
FILOP. T1, ; Do the FILOP.
JRST OPENER ; Failed - See why
PUSHJ P,@POSTBL(P1) ; Do the post processing
JRST F$GRET ; Return to the caller
; Here if the FILOP. failed
OPENER: CAXE T1,ERAEF% ; Already existing file error?
JRST OPNE.1 ; No, go handle it
CAXE P1,$IOWRS ; Yes, write/no super function?
JRST OPNE.1 ; No, give up
MOVX T1,.FOWRT ; Yes, get the other function
STOR T1,FLP+.FOFNC,FO.FNC ; Store it in
BITON T1,FO.PRV,FLP+.FOFNC ; Flag we want to use any privs we have
MOVEM T2,ELB+.RBPPN ; Store the PPN
MOVE T1,OJBFF ; Get the old .JBFF
MOVEM T1,.JBFF ; And reset it over the warning
WARN E.SUP ; Give superceding existing file message
LOAD. T1,FDBBUF,(P2) ; Get the buffer address
JUMPE T1,OPEN.2 ; Have a real buffer?
MOVEM T1,.JBFF ; And reset for the monitor
JRST OPEN.2 ; And go write it
OPNE.1: PUSH P,T1 ; Save T1
PUSHJ P,@ERRTBL(P1) ; Do any error processing
JRST .T1PJ ; Restore T1 and return
; Routines to do preprocessing be for a FILOP.
; PREREA - Before a READ function
PREREA: TDZA T1,T1 ; Flag reading a file
; PREAPP - Before an APPEND function
; PREWRI - Write a file
; PREWRS - Write a file (Create a new file)
PREAPP: ; Same as PREWRI
PREWRS: ; Same as PREWRI
PREWRI: SETO T1, ; Flag writing
; The following routine will allocate buffers for the files, it will
; allocate and store the FDB and buffer headeres
PUSH P,T1 ; Save the flag
JUMPE T3,[MOVE T1,.JBFF ; If dump mode, just get .JBFF
ZERO. T2,FDBBUF,(P2) ; Clear the buffer address
JRST PRER.1] ; And go remember it
HLRZ T1,T3 ; Get the number of buffers
MOVE T2,FLP+.FODEV ; Get the device name
DEVCHR T2, ; Get the device characteristics
CAXGE T1,D.NBUF ; Default number larger?
TXNN T2,DV.DSK ; Is this a disk ?
JRST .+2 ; Skip
MOVX T1,D.NBUF ; Yes, use the default number of buffers
CFXN. T2,FDBMOD,(P2),$FMERR ; Is this error mode?
MOVEI T1,1 ; Yes, use only one buffer
SKIPE (P) ; Reading or writing
MOVSS T1 ; Output - Move the number into the other half
MOVEM T1,FLP+.FONBF ; Store the number of buffers
IMULI T1,(T3) ; Calculate the number of words for the buffers
SKIPE (P) ; Is this output ?
MOVSS T1 ; Yes - Move to the other half
MOVE T3,T1 ; Move into a safer place
MOVEI T2,.FDBRH(P2) ; Get the address of the buffer header
SKIPE (P) ; Output?
MOVS T2,T2 ; Yes, switch halves
MOVEM T2,FLP+.FOBRH ; Store in the FILOP. block
MOVE T1,T3 ; Get the number of words for the buffers
MOVX T2,.BTBUF ; Flag getting buffers
PUSHJ P,M$GBLK ; Get a block from memory management
STOR. T1,FDBBUF,(P2) ; Store the buffer address
EXCH T1,.JBFF ; Make .JBFF point to it
PRER.1: MOVEM T1,OJBFF ; Save so we can restore .JBFF
MOVX T2,FD.IN ; Flag that this is input or output
SKIPE (P) ; Output ?
MOVX T2,FD.OUT ; Yes - Get the other flag
IORM T2,.FDFLG(P2) ; Light the flag
POP P,(P) ; Pop off the flag
POPJ P, ; Return to the caller
; PREDEL - Preprocessing for a DELETE
PREDEL: MOVEI T1,REN ; Get the address of the rename block
HRLM T1,FLP+.FOLEB ; Store it
MOVX T1,.RBLEN ; Get the lenth of a RIB block
MOVEM T1,REN+.RBCNT ; Store it
POPJ P, ; Return to the caller
; Here to do the post processing
; POSREA - After doing a read function
; POSAPP - After doing an append function
; POSWRI - After doing a write
; POSWRS - After doing a non-super write
;
; All these routines are the same. They just flag that the channel is open
; and then store the channel allocated in the FDB and restore .JBFF
POSREA:
MOVE T1,OJBFF ; Restore .JBFF
MOVEM T1,.JBFF ; Must be done before CHKFFI is called
SETZM OJBFF ; Clear so we don't smash it later
PUSHJ P,CHKFFI ; Check if we need file found in message
LOAD. T1,FDBMOD,(P2) ; Get the mode
SKIPN T2,.RBSIZ+ELB ; Get the file size
SKIPE .RBALC+ELB ; No file size, is this really something we have it with?
JRST .+2 ; Yes, all is well
MOVX T2,.INFIN ; No, assume very big file
JFCL 17,.+1 ; Clear the flags
MOVX T3,^D36 ; Get the size of a word
IDIV T3,BYTPTBL(T1) ; Get the number of bytes/word
IMUL T2,T3 ; Get the total number of bytes
JOV [MOVX T2,.INFIN ; If it overflows, use the max
JRST .+1] ; And continue
STOR. T2,FDBSIZ,(P2) ; Remember the size
CAXE T1,$FMDFT ; Ascii mode ?
JRST POSA.0 ; No, continue
LOAD T1,FLP+.FOFNC,FO.CHN ; Get the channel number
STOR. T1,FDBCHN,(P2) ; Store in the FDB block
MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$IBUF ; Input the first buffer
POPJ P, ; Couldn't, return the error
LOAD. T1,FDBBRH,(P2) ; Get the address of the buffers
MOVE T1,.BFCNT-1+1(T1) ; Get the first word of data
; -1 because the symbols are defined silly
; +1 because the data is the first word after
; the count
TXNN T1,1B35 ; Is this an LSA file ?
JRST POSA.0 ; No, skip this
MOVX T1,$FMLSA ; Turn this into an LSA file
STOR. T1,FDBMOD,(P2) ; Store it back into the FDB
POSA.0:
; Here to do the post processing for write and write/no superceeding
POSAPP:
POSWRI:
POSWRS:
LOAD. T1,FDBMOD,(P2) ; Get the file mode
MOVE T2,BYTPTBL(T1) ; And get the correct byte pointer
STOR T2,.FDBRH+.BFPTR(P2),BP.SFL ; Store the byte size
CAXE T1,$FMLSA ; LSA file?
TDZA T1,T1 ; Clear the ac
MOVX T1,<ASCII |00000|>+1 ; Get the initial LSN
STOR. T1,FDBLSN,(P2) ; Store it
LOAD T1,FLP+.FOFNC,FO.CHN ; Get the channel number
STOR. T1,FDBCHN,(P2) ; Store in the FDB block
BITON T1,FD.NLS!FD.OPN,.FDFLG(P2) ; Flag that the channel is open
MOVE T1,ELB+.RBVER ; Get the version number of the file
CFXN. ,FDBVER,(P2),0 ; Is this zero ?
STOR. T1,FDBVER,(P2) ; Yes - Store the new version number
LOAD T1,ELB+.RBPRV,RB.PRV ; Get the priv word
CFXN. T2,FDBPRO,(P2),0 ; Do we have one already ?
STOR. T1,FDBPRO,(P2) ; No - Store the new version
SKIPE T1,OJBFF ; Restore .JBFF
MOVEM T1,.JBFF ; . . .
POPJ P, ; Return
; POSDEL - After delete processing
POSDEL: LOAD T1,FLP+.FOFNC,FO.CHN ; Get the channel number
RESDV. T1, ; And get rid of the channel
JFCL ; Ignore the error
POPJ P, ; Return
; Here to do the error post processing
; ERRREA - After doing a read function
; ERRAPP - After doing an append function
; ERRWRI - After doing a write function
; ERRWRS - After doing a create new file function
; All of these routines are the same. They restore .JBFF, call memory managment
; to dealocate the buffer and the FDB
ERRREA:ERRAPP:ERRWRI:ERRWRS:
MOVE T2,OJBFF ; Get the old value for .JBFF
MOVEM T2,.JBFF ; Restore it
LOAD. T1,FDBBUF,(P2) ; Get the address of the buffer
JUMPE T1,.+2 ; Have something to return?
PUSHJ P,M$RBLK ; Return the block to free core
ZERO. ,FDBBUF,(P2) ; Clear the buffer address
FALL ERRDEL ; And join delete processing
; ERRDEL - Error processing for delete function
ERRDEL: LOAD T1,FLP+.FOFNC,FO.CHN ; Get the channel
STOR. T1,FDBCHN,(P2) ; And store it in case it is still open
POPJ P, ; Return
TABDEF PRE,$IO,0 ; Table for the preprocessing
TABENT DEL,PREDEL ; Delete preprocessing
TABENT REA,PREREA ; Read preprocessing
TABENT WRI,PREWRI ; Write preprocessing
TABENT WRS,PREWRS ; Write no-super preprocessing
TABENT APP,PREAPP ; Append preprocessing
TABEND
; Post processing table
TABDEF POS,$IO,0
TABENT DEL,POSDEL ; Delete post processing
TABENT REA,POSREA ; Read post processing
TABENT WRI,POSWRI ; Write post processing
TABENT WRS,POSWRS ; Write no-super post processing
TABENT APP,POSAPP ; Append post processing
TABEND
; I/O mode table
TABDEF IOM,$FM,0
TABENT TRM,.IOASC!IO.LEM ; Terminal
TABENT PIM,.IOPIM ; Packed image mode
TABENT LSA,.IOASC ; LSA mode ==> ascii
TABENT ASC,.IOASC ; Ascii mode ==> ascii
TABENT DFT,.IOASC ; Default is ascii
TABENT SXB,.IOBIN ; Sixbit mode ==> binary
TABENT BIN,.IOBIN ; Binary mode ==> binary
TABENT ERR,.IOASC ; Error file mode ==> ASCII
TABENT DMP,.IODMP ; Dump mode ==> dump
TABEND
; Table of byte pointers
DEFINE FK(A,B,SIZ)<EXP SIZ>
BYTPTBL:
FM$KEY ; Generate the table entries
; Error processing table
TABDEF ERR,$IO,0
TABENT DEL,ERRDEL ; Delete error processing
TABENT APP,ERRAPP ; Append error processing
TABENT REA,ERRREA ; Read error processing
TABENT WRI,ERRWRI ; Write error processing
TABENT WRS,ERRWRS ; Write no-super error processing
TABEND
; Table of FILOP. functons to do
TABDEF FLP,$IO,0
TABENT APP,.FOAPP!FO.ASC!FO.PRV ; Append to a file
TABENT REA,.FORED!FO.ASC!FO.PRV ; Read a file
TABENT WRI,.FOWRT!FO.ASC!FO.PRV ; Write a file
TABENT WRS,.FOCRE!FO.ASC!FO.PRV ; Create a new file
TABENT DEL,.FODLT!FO.ASC!FO.PRV ; Delete a file
TABEND
SUBTTL Byte mode routines -- F$WRIT - Output a byte
;+
;.HL1 F$WRIT
; This routine is called to output a byte to a file. This routine will
;the routine that must be called. It will then call the mode dependent routine
;to do the output.
;.literal
;
; Usage:
; MOVEI T1,FDB
; MOVEI CH,Byte
; PUSHJ P,F$WRITE
; (Failed)
; (Good return)
;.end literal
;-
F$WRIT: MOVEM T1,LASFDB ; Store the last FDB
$SAVE <T2,T3,T4> ; Save a few registers
LOAD. T2,FDBMOD,(T1) ; Get the mode
PUSHJ P,@OBYTBL(T2) ; Call the routine to output the byte
POPJ P, ; Return the error
PJRST F$GRET ; Give the good return
; Dispatch table
TABDEF OBY,$FM,WRTERR
TABENT PIM,F$OBYT ; Packed image mode
TABENT BIN,F$OBYT ; Binary mode
TABENT TRM,F$OBYT ; Terminal
TABENT ASC,F$OBYT ; ASCII mode
TABENT DFT,F$OBYT ; ASCII mode
TABENT SXB,O$SXBT ; SIXBIT mode
TABENT LSA,O$LSA ; LSA mode
TABENT DMP,DMPERR ; DUMP mode
TABEND
WRTERR: STOPCD WRT,<Illegal F$WRIT mode>
DMPERR: MOVX T1,$FEIOD ; Get the error code
POPJ P, ; And return
SUBTTL Byte mode routines -- F$READ - Read a byte
;+
;.HL1 F$READ
; This routine is called to read a byte from the input file. This routine will
;call the mode dependent routine to input the byte.
;.literal
;
; Usage:
; MOVEI T1,FDB ; FDB to use
; PUSHJ P,F$READ ; Input a byte
; (Failed)
; (Good return CH contains the character)
;.end literal
;-
F$READ: MOVEM T1,LASFDB ; Store the last FDB
LOAD T2,.FDFLG(T1),FD.EOF ; Check if already at EOF
JMPT T2,[MOVX T1,$FEEOF ; Yes, get the error code
PJRST F$RE.1] ; And exit
F$RE.0: LOAD. T2,FDBMOD,(T1) ; Get the mode
PUSHJ P,@IBYTBL(T2) ; Call the routine that does the work
JRST F$RE.1 ; Check if end of file
JUMPE CH,F$RE.2 ; If null check further
CAXN CH,.CHFFD ; Is this a form
INCR. ,FDBFFC,(T1) ; Increment the form feed count
JRST F$GRET ; Give a good return to the caller
F$RE.1: CAXN T1,$FEEOF ; End of file?
SETZM LASFDB ; Yes, clear the loc so channel stays open
POPJ P, ; And give the error return
F$RE.2: LOAD. T2,FDBMOD,(T1) ; Get the mode again
CAXN T2,$FMERR ; Skip this if the error file
JRST F$GRET ; Give a good return
JRST F$RE.0 ; Get the next byte
; Dispatch table
TABDEF IBY,$FM
TABENT DMP,DMPERR ; Dump mode
TABENT PIM,F$IBYT ; Packed image mode
TABENT ERR,F$IBYT ; Error file
TABENT TRM,F$IBYT ; Terminal mode
TABENT ASC,F$IBYT ; ASCII mode
TABENT DFT,F$IBYT ; ASCII mode
TABENT SXB,I$SXBT ; SIXBIT mode
TABENT LSA,I$LSA ; LSA mode
TABEND
SUBTTL Byte mode routines -- Sixbit input/output
; The following are used for the conversion of bytes from sixbit to ascii
I$SXBT: SOSL T2,.FDRCN(T1) ; COunt down the number of chars in this record
JRST ISXB.1 ; Still more to go
MOVX T3,FD.NLS ; Get the intial call flag
TDNE T3,.FDFLG(T1) ; Is this the first call
JRST [ANDCAM T3,.FDFLG(T1) ; Yes, clear the flag
JRST ISXB.0] ; And get the first record count
CAXN T2,-1 ; This the first time the count ran out?
MOVX CH,.CHCRT ; Yes, get a carriage return
CAXN T2,-2 ; Or is this the second time?
MOVX CH,.CHLFD ; Yes, this should be a line feed
CAXLE T2,-3 ; Time to get the next record?
PJRST .POPJ1 ; No, return the character
ISXB.0: SKIPN T2,.FDBRH+.BFCTR(T1) ; Get the byte count left
JRST ISXB.2 ; None left in buffer, go get a new buffer full
IDIVI T2,6 ; And get the byte/word count
JUMPE T3,ISXB.3 ; If on a word boundary already, go get the new count
JUMPE T2,ISXB.2 ; If no full words left, get next buffer
MOVN T3,T3 ; Otherwise fix up the byte count
ADDM T3,.FDBRH+.BFCTR(T1) ; . . .
MOVX T2,(POINT 6,,0) ; Fix the byte pointer
HLLM T2,.FDBRH+.BFPTR(T1) ; . . .
JRST ISXB.3 ; And go get the word
ISXB.2: PUSHJ P,F$IBUF ; Get a buffer full
POPJ P, ; Couldn't, return now
ISXB.3: AOS T2,.FDBRH+.BFPTR(T1) ; Get the byte pointer
LOAD T3,T2,BP.PFL ; Get the position field
CAXL T3,^D36 ; Before the start of the word?
SOJ T2, ; Yes, back up one
MOVE T2,(T2) ; Get the record count
MOVEM T2,.FDRCN(T1) ; Save the record count
MOVX T2,-6 ; Get the amount to fix the pointer
ADDM T2,.FDBRH+.BFCTR(T1) ; And fix the counter
JRST I$SXBT ; And go get a byte
; Here to get a character from the file and convert it to ascii
ISXB.1: PUSHJ P,F$IBYT ; Input a byte
POPJ P, ; Pass errors on
MOVEI CH,"0"-'0'(CH) ; Convert to ascii
PJRST .POPJ1 ; Give a skip return
O$SXBT: SKIPE T2,.FDRCN(T1) ; Have the text buffer for building the record yet?
JRST OSXB.1 ; Yes, go store the character
PUSHJ P,CKEOL ; Check for EOL
JRST OSXB.0 ; Not an EOL, output the character
PJRST OSXBCN ; Output the record count
OSXB.0: PUSH P,T1 ; Save T1
MOVEI T1,5 ; Get 5 chars
PUSHJ P,M$GTXT ; Get a text buffer
MOVE T2,(P) ; Get the FDB address
MOVEI T2,.FDRCN(T2) ; Get the pointer address
PUSHJ P,M$USEB ; Set up the pointer
MOVE T2,T1 ; Get the buffer address
POP P,T1 ; Get the restore the FDB address
JRST OSXB.2 ; Skip the EOL check
OSXB.1: PUSHJ P,CKEOL ; Check if this is an EOL
JRST OSXB.2 ; No, write the character
$SAVE <P1,P2> ; Save P1 and P2
MOVE P1,T1 ; Get the FDB address
MOVE P2,T2 ; And get the buffer address
LOAD. T2,BLKEND,(P2) ; Get the number of characters to write
PUSHJ P,OSXBCN ; Write out the count
POPJ P, ; Couldn't
SETZ T2, ; Start from the start of the buffer
MOVE T1,P2 ; Get the buffer address
PUSHJ P,SETINC ; Set up for GETINC
JRST OSXB.4 ; None, all done
OSXB.3: MOVE T1,P2 ; Get the buffer address
PUSHJ P,GETINC ; Get a character
JRST OSXB.4 ; All done
MOVEI CH,'0'-"0"(CH) ; Convert to sixbit
MOVE T1,P1 ; Get the FDB address
PUSHJ P,F$OBYT ; Write a character
POPJ P, ; Give up
JRST OSXB.3 ; Go for the next
OSXB.4: MOVEI T1,.FDRCN(P1) ; Get the pointer address
PUSHJ P,M$RELB ; Release the block
PJRST .POPJ1 ; And return
; Here to write a character into the buffer to count it for later
OSXB.2: CAXGE CH," " ; Control character?
PJRST .POPJ1 ; Yes, ignore it
CAXL CH,"`" ; Lower case range?
MOVEI CH,"a"-"A"(CH) ; Yes, convert to upper
PUSH P,T1 ; Save T1
LOAD. T3,TPTADR,+.FDRCN(T1) ; Get the buffer address
MOVX T1,<POINTR(CH,^O<177_7>)> ; Get the byte pointer
MOVEI T2,1 ; And the number of chars
SETZ T4, ; Clear the pointer address
PUSHJ P,M$INSS ; Insert the string
MOVE T2,(P) ; Get the FDB address
LOAD. T2,TPTADR,+.FDRCN(T2) ; Get the address of the buffer
STOR. T1,BLKPT,(T2) ; Store the new pointer
PJRST .T1PJ1 ; Restore T1 and return
; Here to write the record count into the file. First advance to the
;next full word.
OSXBCN: PUSH P,T2 ; Save the count
SKIPN T2,.FDBRH+.BFCTR(T1) ; Any room left here?
JRST OSXB.5 ; No, output the buffer
IDIVI T2,6 ; Find out how many extra bytes
JUMPE T3,OSXB.6 ; Are we at a word boundary?
MOVN T3,T3 ; Get the amount we are skipping
ADDM T3,.FDBRH+.BFCTR(T1) ; And fix it
MOVX T2,<POINT 6,,0> ; Get the byte pointer to put in
HLLM T2,.FDBRH+.BFPTR(T1) ; Fix up the byte pointer
JRST OSXB.6 ; And continue on
; Here to dump the buffer to make room for the count
OSXB.5: PUSHJ P,F$OBUF ; Dump it
PJRST .T2PJ ; Restore T2 and return
OSXB.6: AOS T2,.FDBRH+.BFPTR(T1) ; Fix the byte pointer
LOAD T3,T2,BP.PFL ; Get the position
CAXL T3,^D36 ; Pointing before the word?
SOJ T2, ; Yes, back up one word then
POP P,(T2) ; Stuff in the record count
PJRST .POPJ1 ; And return
SUBTTL Byte mode routines -- ASCII mode input/output
; The following are used for the output and input of ascii bytes
I$ASCI==F$IBYT ; Input a byte
O$ASCI==F$OBYT ; Write a byte
SUBTTL Byte mode routines -- LSA input/output
; The following are the routines used to input and output LSA bytes
O$LSA: $SAVE <T2,T3,T4> ; Save a few registers
CAXN CH,.CHFFD ; Form feed?
PJRST WRTPAG ; Yes, write a page mark
LOAD T2,.FDFLG(T1),FD.NLS ; Check if we need a line number
JMPF T2,O$LS.1 ; No, skip this
LOAD. T2,FDBLSN,(T1) ; Yes, get the last number
ADDX T2,<BYTE(7)0,0,1,0,0> ; Bump to next number
TXNE T2,<BYTE(7)0,0,<"8"&^-"0">,0,0> ; Is this over 8?
TXNN T2,<BYTE(7)0,0,1,0,0> ; Yes, is this over 9?
JRST O$LS.2 ; Value is still ok
TXZ T2,<BYTE(7)0,0,^-"0",0,0> ; Clear the digit
ADDX T2,<BYTE(7)0,1,0,0,0> ; And bump the next
TXNE T2,<BYTE(7)0,<"8"&^-"0">,0,0,0> ; Did it overflow?
TXNN T2,<BYTE(7)0,1,0,0,0> ; Maybe, check the other bit
JRST O$LS.2 ; No, use this value
TXZ T2,<BYTE(7)0,^-"0",0,0,0> ; Clear except the zero
ADDX T2,<BYTE(7)1,0,0,0,0> ; Bump the next digit
TXNE T2,<BYTE(7)<"8"&^-"0">,0,0,0,0> ; Check if it overflowed
TXNN T2,<BYTE(7)1,0,0,0,0> ; . . .
JRST O$LS.2 ; No, go use this value
PUSHJ P,WRTPAG ; Write a page mark
POPJ P, ; Pass on the error return
MOVX T2,<ASCII |00100|>+1 ; Get the LSN
O$LS.2: STOR. T2,FDBLSN,(T1) ; Store the LSN
PUSHJ P,WRTWRD ; Write a word
POPJ P, ; Couldn't
PUSH P,CH ; Save CH
MOVX CH,.CHTAB ; Get a tab
PUSHJ P,F$OBYT ; Write it
JRST [POP P,CH ; Restore the character
POPJ P,] ; And return
POP P,CH ; Get the character back
O$LS.1: MOVX T2,FD.NLS ; Get the bit to turn on (or off)
ANDCAM T2,.FDFLG(T1) ; Assume it should be off
CAXN CH,.CHLFD ; Is this a line feed?
IORM T2,.FDFLG(T1) ; Yes, flag we will need the LSN
PJRST F$OBYT ; And write it
WRTPAG: MOVX T2,<ASCII | |>+1 ; Get the second word
PUSHJ P,WRTWRD ; Write the word
POPJ P, ; Pass on the error
MOVX T2,<BYTE(7).CHCRT,.CHFFD,0,0,0(1)1> ; Get the page mark
PUSHJ P,WRTWRD ; Write it
POPJ P, ; Pass on the error
MOVX T2,<ASCII |00000|>+1 ; Get the initial LSN
STOR. T2,FDBLSN,(T1) ; Store the LSN
BITON T2,FD.NLS,.FDFLG(T1) ; And flag we need an LSN
PJRST .POPJ1 ; Give a good return
WRTWRD: $SAVE <CH,P1> ; Save CH
MOVE P1,T2 ; Get the word to write
MOVE T2,.FDBRH+.BFCTR(T1) ; Get the buffer counter
IDIVI T2,5 ; And see if we need to skip to the end of a word
JUMPE T3,WRTW.0 ; If not just go write the word
SETZ CH, ; Pad with nulls
WRTW.1: PUSHJ P,F$OBYT ; Write the byte
POPJ P, ; Give up
SOJG T3,WRTW.1 ; loop until at a word boundary
WRTW.0: MOVE T2,.FDBRH+.BFCTR(T1) ; Get the counter again
JUMPN T2,WRTW.2 ; Any room left?
PUSHJ P,F$OBUF ; No, output the buffer
POPJ P, ; Pass on the error
WRTW.2: MOVX T2,-5 ; Get the number of chars we will write
ADDM T2,.FDBRH+.BFCTR(T1) ; . . .
AOS T2,.FDBRH+.BFPTR(T1) ; Get the byte pointer
IBP T2 ; Bump the pointer so it in the correct place
MOVEM P1,-1(T2) ; Store the word
PJRST .POPJ1 ; Give the good return
; Here to input an LSA file
I$LSA: $SAVE <T2,T3,T4> ; Input a byte from the LSA files
LOAD T2,.FDFLG(T1),FD.NLS ; Looking for an LSA?
JMPF T2,I$LS.1 ; If not skip the check
MOVE T2,.FDBRH+.BFCTR(T1) ; Get the counter
IDIVI T2,5 ; Check if at a word boundary
JUMPN T3,F$IBYT ; If not, just get a byte
JUMPN T2,I$LS.0 ; Have anything left to check?
PUSHJ P,F$IBUF ; No, input a buffer
POPJ P, ; Couldn't, return
I$LS.0: MOVE T2,.FDBRH+.BFPTR(T1) ; Get the buffer pointer
IBP T2 ; Make sure it is at the correct word
MOVE T3,(T2) ; Get the word to check
TXNN T3,1 ; Is the LSN bit on?
JRST F$IBYT ; No, just get the next char
CAXE T3,<ASCII | |>+1 ; Is this a prefix to a page mark?
JRST I$LS.2 ; No, just store the LSN
MOVX T3,-5 ; Yes, count the characters
ADDB T3,.FDBRH+.BFCTR(T1) ; . . .
JUMPN T3,I$LS.3 ; Is there still another word left?
PUSHJ P,F$IBUF ; No, get a buffer
POPJ P, ; Couldn't
SKIPA T2,.FDBRH+.BFPTR(T1) ; Get the byte pointer
I$LS.3: AOS T2,.FDBRH+.BFPTR(T1) ; Advance the byte pointer
IBP T2 ; Make sure we are at the correct word
MOVE T3,(T2) ; Get the next word
TXZ T3,1 ; Clear the LSN bit (in case it was on)
CAXE T3,<BYTE(7).CHCRT,.CHFFD,0,0,0(1)0> ; Is this a page mark?
PJRST F$IBYT ; No, just return a character
AOS (P) ; Give the good return
MOVX CH,.CHFFD ; Of a form feed
I$LS.4: AOS .FDBRH+.BFPTR(T1) ; Bump the pointer past the page mark
MOVX T2,-5 ; And fix the counter
ADDM T2,.FDBRH+.BFCTR(T1) ; . . .
POPJ P, ; Return
I$LS.2: STOR. T3,FDBLSN,(T1) ; Store the LSN
BITOFF T2,FD.NLS,.FDFLG(T1) ; Flag we don't need an LSN anymore
PUSHJ P,I$LS.4 ; Fix the buffer header
PUSHJ P,F$IBYT ; Get the next character
POPJ P, ; Pass on the error
CAXE CH,.CHTAB ; Is it a tab?
JRST I$LS.5 ; No, check if a line feed
I$LS.1: PUSHJ P,F$IBYT ; Get a byte
POPJ P, ; Couldn't
I$LS.5: CAXE CH,.CHLFD ; Is it a line feed?
PJRST .POPJ1 ; No, just return
BITON T2,FD.NLS,.FDFLG(T1) ; Yes, remember we need an LSN
PJRST .POPJ1 ; And return
SUBTTL F$IBYT - Input a byte
;+
;.HL1 F$IBYT
;This routine will input a byte from the file if possible. If the file is
;not open for reading it will give an error.
;.literal
;
; Usage:
; MOVE T1,FDB ; File access block
; PUSHJ P,F$IBYT ; Input the byte
; (Error return) ; Failed -- Message already given
; (Normal return)
;
; Error return:
; T1 - Error reason
;
; Normal return:
; CH - Byte input
;.end literal
;-
F$IBYT: SOSGE .FDBRH+.BFCNT(T1) ; Decrement the buffer count
JRST F$IB.1 ; Get the next buffer
ILDB CH,.FDBRH+.BFPTR(T1) ; Get the character
JRST .POPJ1 ; Return to the caller
F$IB.1: PUSHJ P,F$IBUF ; Get the next buffer
POPJ P, ; Couldn't
JRST F$IBYT ; And try again
F$IBUF: MOVEM T1,LASFDB ; Store this FDB incase of error
MOVX T2,FD.TMP ; Check if the file is a TMPCOR
TDNE T2,.FDFLG(T1) ; . . .
JRST F$IB.3 ; Yes, go flag EOF
MOVX T3,.FOINP ; Get the function
LOAD. T2,FDBCHN,(T1) ; Get the channel
STOR T2,T3+.FOFNC,FO.CHN ; Store the channel number
MOVE T2,[XWD 1,T3] ; Get the argument block pointer
FILOP. T2, ; Get the next buffer
JRST F$IB.2 ; Process the errors
STOR. T2,FDBIOS,(T1) ; Update the I/O status
INCR. ,FDBBLK,(T1) ; Bump the block number
PJRST .POPJ1 ; Give the good return
F$IB.2: STOR. T2,FDBIOS,(T1) ; Store the I/O status
TXNN T2,IO.EOF ; End of file ?
JRST [MOVX T1,$FEMON ; ++ Monitor error
POPJ P,] ; Return to the caller
F$IB.3: BITON T2,FD.EOF,.FDFLG(T1) ; Store the end of file flag
MOVX T2,FD.EB ; Check if this file is EB'ed
TDNE T2,.FDFLG(T1) ; . . .
JRST F$IB.4 ; Yes, just return eof
PUSHJ P,F$CLOS ; Close the input file
POPJ P, ; Pass the error on
F$IB.4: MOVX T1,$FEEOF ; Return the end of file
POPJ P, ; Return to the caller
SUBTTL F$OBYT - Write a byte to a file
;+
;.Hl1 F$OBYT
;This routine will write a byte to an output file. It will give an error
;if the write fails.
;.literal
;
; Usage:
; MOVE T1,FDB
; MOVEI CH,Byte to write
; PUSHJ P,F$OBYT
; (Error return)
; (Normal return)
;
; Error return:
; T1 - Error reason
;
; Normal return:
; Returns nothing.
;.end literal
;-
F$OBYT: SOSGE .FDBRH+.BFCTR(T1) ; Decrement the buffer count
JRST F$OB.0 ; Output the next buffer
IDPB CH,.FDBRH+.BFPTR(T1) ; Store te byte
JRST .POPJ1 ; Give a good return
F$OB.0: PUSHJ P,F$OBUF ; Output the buffer
POPJ P, ; Can't
JRST F$OBYT ; And go try the character again
F$OBUF: MOVEM T1,LASFDB ; Store the FDB incase of an error
LOAD T2,.FDFLG(T1),FD.TMP ; Check if going to TMPCOR
JMPT T2,F$OB.T ; If so, we must now convert to using disk
MOVX T3,.FOOUT ; Get the FILOP function
LOAD. T2,FDBCHN,(T1) ; Get the channel
STOR T2,T3+.FOFNC,FO.CHN ; Store the channel in the block
MOVE T2,[XWD 1,T3] ; Get the arugment block address
FILOP. T2, ; Do the FILOP
JRST [STOR. T2,FDBIOS,(T1) ; Store the I/O status
MOVX T1,$FEMON ; Flag the monitor is form the monitor
POPJ P,] ; Return
STOR. T2,FDBIOS,(T1) ; Store the I/O status
INCR. ,FDBBLK,(T1) ; Bump the block number
JRST .POPJ1 ; Loop
; Here if TMP: file will not fit in TMPCOR. We must now open the file
;on disk and write out the data we have so far.
F$OB.T: $SAVE <T1,P1,P2,P3,P4,CH> ; Save some room
MOVE P1,T1 ; Get the FDB address
MOVE P2,.FDBRH+.BFADR(P1) ; And get the IOWD
LOAD. P4,FDBBUF,(P1) ; Get the buffer address
ZERO. T1,FDBBUF,(P1) ; Clear the buffer address
LOADS. T1,FDBNAM,(P1) ; Get the name into the other half
HLL T1,SIXJOB ; And make the nnnFOO file
STOR. T1,FDBNAM,(P1) ; Store the new name
MOVX T1,'TMP' ; Get the extension
STOR. T1,FDBEXT,(P1) ; Store it
BITON T1,FD.HEX!FD.TMD,.FDFLG(P1) ; Flag we have the extension
MOVX T1,<SIXBIT |DSK|> ; Get the device
STOR. T1,FDBDEV,(P1) ; Store it
MOVX T1,$IOWRI ; Get the function
MOVE T2,P1 ; And the FDB address
PUSHJ P,F$OPEN ; And open the file
PJRST F$ERR ; Couldn't, give up
BITOFF T1,FD.TMP,.FDFLG(P1) ; Flag not going to TMPCOR
JUMPE P4,.POPJ1 ; If no buffer, skip this
HLRE T1,P2 ; Get the number of words
MOVN T1,T1 ; Make positive
IMULI T1,5 ; Make it the number of characters
MOVE P3,T1 ; And put in a safe place
MOVEI P2,1(P2) ; Get the address of the buffer
HRLI P2,(POINT 7,) ; Make it a byte pointer
F$OT.1: ILDB CH,P2 ; Get a character
MOVE T1,P1 ; And the FDB address
PUSHJ P,F$OBYT ; Output the character
PJRST F$ERR ; Couldn't
SOJG P3,F$OT.1 ; Loop for all the characters
MOVE T1,P4 ; Get the buffer address
PUSHJ P,M$RBLK ; And return it
PJRST .POPJ1 ; And return
SUBTTL F$RBUF - Read into a text buffer
;+
;.HL1 F$RBUF
; This routine will read data from an input file into the text buffer.
;.b.literal
; Usage:
; MOVEI T1,TPT address
; MOVE T2,Number of line feeds to allow
; MOVE T3,Number of characters to allow
; MOVE T4,Number of form feeds to allow
; PUSHJ P,F$RBUF
;-
F$RBUF: $SAVE <P1,P2,P3,P4> ; Save some ac's
MOVE P4,T1 ; Get the TPT addrees
MOVEM T2,LFCNT ; Save the line feed count
MOVEM T3,CHRCNT ; And the character count
MOVEM T4,FFCNT ; And the form feed count
LOAD. T1,TPTADR,(P4) ; Get the text buffer address
PUSHJ P,GETFDI ; And find the FDB
ERROR E.NFI ; No file for input
MOVE P1,T1 ; Get the address of the FDB
CFXN. T2,FDBMOD,(P1),$FMDMP ; Is this dump mode?
JRST FRDUMP ; Yes, go read it
CFXE. T2,FDBFFC,(P1),0 ; Is this the first read?
JRST FRBU.7 ; No, skip this
INCR. T2,FDBFFC,(P1) ; Bump the counter
FRBU.7: MOVX T1,FD.EOF ; Check if file is at end of file
TDNE T1,.FDFLG(P1) ; . . .
POPJ P, ; Yes, don't bother doing anything
LOAD. P3,TPTADR,(P4) ; Get text buffer address back
LOAD. T2,BLKEND,(P3) ; Get the end point
IDIVI T2,5 ; Get the word and character index
ADDI T2,.BKTLN(P3) ; . . .
HLL T2,BTAB-1(T3) ; And make the byte pointer
STOR. T2,BLKPTR,(P3) ; Store it
LOAD. T1,FDBSIZ,(P1) ; Get the size
CAMGE T1,CHRCNT ; More chars requested that are in the file?
MOVEM T1,CHRCNT ; Save the number of chars from file
MOVEI T1,(P3) ; Get the address of the buffer
MOVE T2,CHRCNT ; And the amount to expand
LOAD. T3,BLKEND,(T1) ; And where to do it
MOVE P3,T3 ; Remember it
PUSHJ P,M$XPND ; Expand the buffer
LOAD. T2,BLKEND,(T1) ; Get the new end
STOR. P3,BLKEND,(T1) ; And reset the end
SUB T2,P3 ; Get the extra free
ADDM T2,.BKFRE(T1) ; Update the amount free
MOVE P3,T1 ; And reset P3
MOVE T1,CHRCNT ; Get the number of characters
MOVEM T1,ENDYNK ; Save as ending point
IMULI T1,3 ; Get the two-thirds point
LSH T1,-1 ; Divide by 2
MOVEM T1,STPYNK ; Save the end point
FRAME. <XCTCHR> ; Make room for a get a character instruction
LOAD. T1,FDBMOD,(P1) ; Get the mode
MOVE T1,IBYTBL(T1) ; Get the address of the routine to fetch chars
HRLI T1,(PUSHJ P,) ; And get the instruction
MOVEM T1,XCTCHR ; Save it
; Loop reading into the buffer until an ending condition is met
FRBU.1: SOS STPYNK ; Count for ultimate stop
SOSLE ENDYNK ; Hit the two-thirds point yet?
JRST FRBU.2 ; No, keep getting chars
SKIPL STPYNK ; Are we almost full?
CAXN CH,.CHLFD ; No, was the last char a line feed?
JRST FRBU.4 ; Last char a line feed or almost full, stop reading
FRBU.2: MOVE T1,P1 ; Get the FDB address
XCT XCTCHR ; Get a character
JRST FRBU.5 ; Go check for end of file
JUMPE CH,FRBU.2 ; Skip nulls
CAXN CH,.CHFFD ; Form feed?
JRST FRBU.3 ; Yes, terminate the reading
FRBU.9: SOSL .BKFRE(P3) ; Decrement the count of free characters
JRST FRBU.8 ; Still room to store this one
AOS .BKFRE(P3) ; Rest to 0
MOVEI T1,(P3) ; Get te buffer address
MOVX T2,D.TXTS ; And the size
LOAD. T3,BLKEND,(T1) ; And the end address
MOVE P3,T3 ; Remember the old end
PUSHJ P,M$XPND ; Expand the buffer some more
SOS .BKFRE(T1) ; Fix the free count
LOAD. T2,BLKEND,(T1) ; Get the new end
STOR. P3,BLKEND,(T1) ; Fix it back
SUB T2,P3 ; Get the amount free
ADDM T2,.BKFRE(T1) ; Update it
MOVE P3,T1 ; Get the address back
FRBU.8: INCR. ,BLKEND,(P3) ; Bump the end point
IDPB CH,.BKPTR(P3) ; Store it
CAXE CH,.CHLFD ; Line feed?
AOJA P4,FRBU.1 ; No, count it and try again
SOSLE LFCNT ; Have enough line feeds yet?
AOJA P4,FRBU.1 ; No, keep reading
AOJA P4,FRBU.4 ; Yes, stop the read
FRBU.3: INCR. ,FDBFFC,(P1) ; Increment the form feed count
SOSLE FFCNT ; Are we done?
JRST FRBU.9 ; No, continue
BITON T1,TF.FFD,.BKTFL(P3) ; Flag that we ended with a form feed
JRST FRBU.6 ; And join the common code
FRBU.4: BITOFF T1,TF.FFD,.BKTFL(P3) ; Flag no form feed
FRBU.6: SETZM LASFDB ; No last FDB
POPJ P, ; And return
FRBU.5: CAXN T1,$FEEOF ; End of file?
JRST FRBU.4 ; Yes, go fix up the end
MOVEM P1,LASFDB ; Save the error FDB
PJRST F$ERR ; No, go give up
; Here to read the file in dump mode.
FRDUMP: MOVX T1,FD.EOF ; Get the EOF bit
TDNE T1,.FDFLG(P1) ; Are we already at EOF?
POPJ P, ; Yes, all done
LOAD. T1,TPTADR,+$QRTPT(P4) ; Get the buffer address
LOAD. T2,FDBSIZ,(P1) ; And get the size of the file
JUMPE T2,FRDU.0 ; Null file?
IMULX T2,5 ; Make it characters
LOAD. T3,BLKEND,(T1) ; Get the end pointer
JUMPN T3,IODERR ; Only allowed if at start of buffer
PUSHJ P,M$XPND ; Make the room for the buffer
MOVX T3,FD.TMP ; Check if this is a TMP: file
TDNE T3,.FDFLG(P1) ; . . .
JRST FRDTMP ; Yes, it already is in core
LOAD. P2,FDBSIZ,(P1) ; Get the size back
MOVN P2,P2 ; Negate it
MOVSI P2,(P2) ; Into left half
HRRI P2,.BKTLN-1(T1) ; Set up the IOWD
SETZ P3, ; Clear for the end of the command list
LOAD. T1,FDBCHN,(P1) ; Get the channel
MOVX T2,<INSVL.(.FOINP,FO.FNC)> ; Get the function
STOR T1,T2,FO.CHN ; Store the channel
MOVEI T3,P2 ; Get the address of the command list
MOVX T1,<XWD 2,T2> ; Get the pointer
FILOP. T1, ; Input the data
TXNN T1,IO.ERR ; Any errors?
JRST FRDU.1 ; Continue processing
STOR. T1,FDBIOS,(P1) ; Store the status
SKIPA P3,[EXP $FEMON] ; Get the error code to return
FRDU.1: SETO P3, ; Flag no error
LOAD. P2,TPTADR,(P4) ; Get the buffer address
LOAD. T1,FDBSIZ,(P1) ; Get the number of words we read
ADDI T1,.BKTLN-1(P2) ; Point to the last word of the data
MOVX T2,<BYTE(7)0,0,0,0,177> ; Get a mask to check for nulls
SETZ T3, ; Set up a counter
FRDU.2: TDNE T2,(T1) ; Is this a null?
JRST FRDU.3 ; No, all done
AOJ T3, ; Bump the count
ROT T2,7 ; Shift the mask
TRNN T2,1 ; do five chars?
JRST FRDU.2 ; No, continue
ROT T2,1 ; Skip the extra bit
CAILE T1,.BKTLN(P2) ; Done with all of the buffer?
SOJA T1,FRDU.2 ; And try again
; Here when we find a non-null character. The number of nulls is in
;T3.
FRDU.3: ADDM T3,.BKFRE(P2) ; Increase the free count
MOVN T3,T3 ; Negate the null count
ADDM T3,.BKEND(P2) ; And back off the end pointer
JUMPGE P3,FRDU.E ; Error?
FRDU.0: BITON T1,FD.EOF,.FDFLG(P1) ; No, flag eof
LOAD T1,.FDFLG(P1),FD.EB ; Get the EB flag
JMPT T1,.POPJ ; Just return if EB'ed
MOVE T1,P1 ; Otherwise close the file
PUSHJ P,F$CLOS ; . . .
PJRST F$ERR ; Error?
POPJ P, ; All done
; Here if an error occured on the FILOP.
FRDU.E: MOVE T1,P3 ; Get the error code
PJRST F$ERR ; And give the error
; Here to read a TMP: file in dump mode.
FRDTMP: LOAD. T1,TPTADR,+$QRTPT(P4) ; Get the pointer address
ADDX T1,.BKTLN ; Point to first data word
LOAD. T2,FDBBUF,(P1) ; Get the buffer address
HRLI T1,(T2) ; And set up the BLT pointer
LOAD. T2,FDBSIZ,(P1) ; Get the file size (in characters)
ADDI T2,(T1) ; Get the final address
BLT T1,-1(T2) ; And move the text
JRST FRDU.1 ; And go back to normal loop
SUBTTL F$WBUF - Write out a buffer to a file
;+
;.HL1 F$WBUF
; This routine will write out data from the given buffer into a file.
;.b.literal
; Usage:
; MOVEI T1,Text buffer address
; MOVEI T2,True= no form feed, False= maybe
; MOVEI T3,False= Force form feed, True= FF only if TF.FFD on
; MOVEI T4,FDB address
; MOVE A2,Start of text to write
; MOVE A1,End of text to write
; PUSHJ P,F$WBUF
; (return here)
;
;.end literal
;-
F$WBUF: $SAVE <P1,P2,P3,P4> ; Save some ac's
DMOVE P3,T2 ; Get the flags
MOVE P1,T1 ; Get the text buffer address
MOVE P2,T4 ; Save the FDB address
LOAD. T1,FDBMOD,(P2) ; Get the mode
PUSHJ P,@DBFTBL(T1) ; And dump out the buffer
JMPT P3,FWBU.0 ; All done if no form feed ever
MOVX T1,TF.FFD ; Get the flag bit
TDNN T1,.BKTFL(P1) ; Need a form feed from reading it?
JMPT P4,FWBU.0 ; No, only if forced from the call
MOVX CH,.CHFFD ; Get the character
MOVE T1,P2 ; And the FDB address
PUSHJ P,F$WRIT ; Write the character
PJRST F$ERR ; Couldn't, punt
FWBU.0: SETZM LASFDB ; Clear the last FDB that was used
POPJ P, ; All done
SUBTTL F$COPY - Copy from one file to another
;+
;.HL1 F$COPY
; This routine will perform the exit type function for a text
;buffer which has two files open. First it will copy the text from
;the text buffer into the output file. Next it will copy data directly
;from the input file to the output file. Any necessary conversion of
;data will be done during these operations.
;.b.literal
;
; Usage:
; MOVE T1,Text.buffer.address
; MOVE T2, (0 if REENTER command should abort, -1 if it should not)
; PUSHJ P,F$COPY
; (aborted due to REENTER)
; (all data copied, files still open)
;
;.end lit
;If a REENTER command is given and the routine is to abort, it will abort
;at the first line terminator character it sees after the reenter is seen.
;The upper level is responsible for re-filling the text buffer after that
;point.
;-
F$COPY: $SAVE <P1,P2,P3,P4> ; Save some working room
$SAVE <A1,A2> ; Save the arg registers also
MOVEM T2,REEABT ; Save the flag
MOVE P1,T1 ; Get the buffer address
LOAD. P2,BLKFDO,(P1) ; Get the output FDB address
LOAD. P3,BLKFDI,(P1) ; And the input FDB address
LOAD. T1,FDBMOD,(P2) ; Get the output mode
SETZ A2, ; Clear the first position
LOAD. A1,BLKEND,(P1) ; And get the final one
PUSHJ P,@DBFTBL(T1) ; Call correct dump buffer routine
LOAD T1,.BKTFL(P1),TF.FFD ; Get the form feed flag
JMPF T1,FCOP.1 ; If no form feed, all done
MOVX CH,.CHFFD ; Need a form feed, get the character
MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$WRIT ; Write the character
PJRST F$ERR ; Couldn't
FCOP.1: LOAD T1,.BKTFL(P1),TF.OPI ; Get the open for input flag
JMPF T1,FCOP.2 ; No, give a good return
MOVE T1,.FDFLG(P3) ; Get the flags
TXNE T1,FD.OPN ; File still open?
TXNE T1,FD.EOF ; Yes, at eof?
PJRST FCOP.2 ; Either closed or at eof
LOAD. T1,FDBMOD,(P2) ; Get the output mode
LOAD. T2,FDBMOD,(P3) ; And the input mode
PUSHJ P,@CPYTBL(T1) ; And copy the files
SKIPA ; Re-enter typed
FCOP.2: AOS (P) ; Give a skip return
SETZM LASFDB ; Clear the last FDB, since there was no err
POPJ P, ; Return to the caller
; Table of routines to copy data from text buffer to output file
TABDEF DBF,$FM ; Initialize the table
TABENT ASC,DBFASC ; Plain ASCII data
TABENT DFT,DBFASC ; Plain ASCII data
TABENT LSA,DBFGEN ; Line sequenced ASCII
TABENT SXB,DBFGEN ; SIXBIT data
TABENT DMP,DBFDMP ; Dump mode
TABEND ; End of table
; Table of routines to copy data from input file to output file
TABDEF CPY,$FM ; Table to be index by output mode
TABENT ASC,<Z @ASCTBL(T2)> ; ASCII
TABENT DFT,<Z @ASCTBL(T2)> ; ASCII
TABENT LSA,<Z @LSATBL(T2)> ; Line sequenced
TABENT SXB,<Z @SXBTBL(T2)> ; SIXBIT
TABENT DMP,IODERR ; Not allowed for dump mode
TABEND
TABDEF ASC,$FM ; Subtable for ASCII output
TABENT ASC,CPYA2A ; Direct copy
TABENT DFT,CPYA2A ; Direct copy
TABENT LSA,CPYGEN ; LSA input uses general copy routine
TABENT SXB,CPYGEN ; SIXBIT input uses general copy routine
TABEND
SXBTBL:
TABDEF LSA,$FM ; Subtable for LSA output
TABENT ASC,CPYGEN ; General routine for ASCII
TABENT DFT,CPYGEN ; General routine for ASCII
TABENT LSA,CPYGEN ; General routine for LSA
TABENT SXB,CPYGEN ; And for SIXBIT
TABEND
SUBTTL F$COPY -- Subroutines -- DBFGEN - General dump buffer routine
; This routine will write out the text from the text buffer into the output
;file. It assumes the ac's have been set up as:
;
; P1/ Text buffer address
; P2/ Output file FDB address
;
DBFGEN: MOVE T1,A2 ; Get the first pos
IDIVI T1,5 ; Get the word/char offsets
SUB A1,A2 ; Get the number of characters to write
MOVEI A2,.BKTLN(P1) ; Get the base address
ADDI A2,(T1) ; Point to correct place
HLL A2,BTAB-1(T2) ; And set up the byte pointer
DBFG.1: SOJL A1,.POPJ ; Done yet?
ILDB CH,A2 ; No, get a character
MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$WRIT ; Write it out
PJRST F$ERR ; Couldn't
JRST DBFG.1 ; Loop for the next
SUBTTL F$COPY -- Subroutines -- DBFDMP - Dump mode buffer routine
; This routine will write out the text from the text buffer into the output
;file. It assumes the ac's have been set up as:
;
; P1/ Text buffer address
; P2/ Output file FDB address
;
DBFDMP: JUMPN A2,IODERR ; This allowed?
CFME. ,BLKEND,(P1),A1 ; Must be entire buffer
JRST IODERR ; Give the error
SKPOPN 0(P2) ; File open?
JRST IODERR ; No, punt
JUMPE A1,[MOVE T1,P2 ; If nothing to output
PUSHJ P,F$CLOS ; just close the file
PJRST F$ERR ; Punt on errors
POPJ P,] ; Pass back good return
IDIVI A1,5 ; Get the number of words
JUMPE A2,DBFD.1 ; If no extra character positions, skip this
MOVEI T1,(A1) ; Get the final address
ADDI T1,.BKTLN(P1) ; And make it absolute
SETO T3, ; Get a mask
IMULX A2,-^D7 ; Get the amount to shift it
SETZ T2, ; Clear T2
LSHC T2,(A2) ; Shift in the mask
ANDCAM T3,(T1) ; Clear out the extra positions
AOJ A1, ; Count it
DBFD.1: MOVN A1,A1 ; Negate the count
HRLI A1,(A1) ; Put in left half
HRRI A1,.BKTLN-1(P1) ; And set up IOWD
SETZ A2, ; End the list
MOVX T1,FD.TMP ; Check if really a TMPCOR file
TDNE T1,.FDFLG(P2) ; . . .
JRST DBFD.T ; Yes, go handle it
DBFD.2: MOVX T2,<INSVL.(.FOOUT,FO.FNC)> ; Get the function code
LOAD. T1,FDBCHN,(P2) ; Get the channel number
STOR T1,T2,FO.CHN ; Store it
MOVEI T3,A1 ; Get the control list address
MOVX T1,<XWD 2,T2> ; Get the pointer
FILOP. T1, ; And output the buffer
JRST .+2 ; Couldn't
JRST [MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$CLOS ; Close the file
PJRST F$ERR ; Couldn't
POPJ P,] ; Return
STOR. T1,FDBIOS,(P2) ; Store the status
SKIPA T1,[EXP $FEMON] ; Get the error code
IODERR: MOVX T1,$FEIOD ; Get the error code
PJRST F$ERR ; And go handle the error
; Here if the file wants to go to TMPCOR.
; At this pointer, A1 contains the IOWD.
DBFD.T: MOVX T1,<XWD .TCRWF,T2> ; Get the pointer
LOAD. T2,FDBNAM,(P2) ; And the file name
MOVE T3,A1 ; And the IOWD
TMPCOR T1, ; Try to write it directly
JRST DBFD.D ; Can't, switch it to DSK
POPJ P, ; All done, return
DBFD.D: PUSHJ P,F$OB.T ; Switch to DSK:
PJRST F$ERR ; Can't
JRST DBFD.2 ; And go write things out
SUBTTL F$COPY -- Subroutines -- DBFASC - ASCII dump buffer routine
; This routine will write out the text from the text buffer into the output
;file. It assumes the ac's have been set up as:
;
; P1/ Text buffer address
; P2/ Output file FDB address
; P3/ Input file FDB address
;
; This routine will use the M$MSTR routine to copy the text into
;the output buffer.
DBFASC: $SAVE <P1,P2,P3,P4> ; Save some room
LOAD T1,.FDFLG(P1),FD.TMP ; Check if going to TMPCOR
JMPT T1,DBFGEN ; Yes, do it normal
DBFA.0: JUMPLE A1,DBFA.D ; Yes, go finish up
MOVE T3,.BFCTR+.FDBRH(P2) ; Get the counter
CAMLE T3,A1 ; Will all the chars from the buffer fit?
MOVE T3,A1 ; Yes, write them all
MOVE P4,T3 ; Get the number of chars for this pass
MOVE T1,A2 ; Get the current pointer
IDIVI T1,5 ; And convert to word/char address
HLL T1,BTAB-1(T2) ; Get the byte pointer
ADDI T1,.BKTLN(P1) ; And the address
MOVE T2,.BFPTR+.FDBRH(P2) ; Get the buffer pointer
PUSHJ P,M$MSTR ; Move the text
MOVE T1,P4 ; Get the character count
MOVE T2,P2 ; And the FDB to fix
PUSHJ P,FIXBRH ; And fix up the buffer headers
SKIPN .BFCTR+.FDBRH(P2) ; Buffer full?
PUSHJ P,CPYOUT ; Yes, output it
ADD A2,P4 ; Increment the position
SUB A1,P4 ; And decrement the count
JRST DBFA.0 ; Loop for next pass
DBFA.D: POPJ P, ; All done
SUBTTL F$COPY -- Subroutines -- FIXBRH - Fix a buffer header
; This routine will fix a buffer header for the number of characters
;written into the buffer without uses the counter/pointer in the header.
; Usage:
; MOVE T1,Number of characters
; MOVE T2,FDB address
; PUSHJ P,FIXBRH
FIXBRH: MOVN T3,T1 ; Get the count
ADDM T3,.BFCTR+.FDBRH(T2) ; And fix up the counter
MOVE T3,T1 ; Get another copy
IDIVI T3,5 ; Make the number of words plus extra bytes
ADDM T3,.BFPTR+.FDBRH(T2) ; Bump the pointer
JUMPE T4,.POPJ ; If no extra bytes, return
IBP .BFPTR+.FDBRH(T2) ; Bump the pointer
SOJG T4,.-1 ; Do enough increments
POPJ P, ; And return
SUBTTL F$COPY -- Subroutines -- CPYOUT - Output a buffer
; This routine will output a buffer of the output file. The ac's are
;assumed to be set up as:
; P2/ Output FDB address
CPYOUT: MOVE T1,P2 ; Get the FDB address
PUSHJ P,F$OBUF ; Output the buffer
PJRST F$ERR ; Couldn't
POPJ P, ; Did it, return
SUBTTL F$COPY -- Subroutines -- CPYGEN - General copy routine
; Here to copy from input file to output file. This routine assumes
;that the ac's are set up as follows:
; P1/ Text buffer address
; P2/ Output file FDB address
; P3/ Input file FDB address
;
CPYGEN: JUMPE P3,.POPJ1 ; If no input file, just return
CPYG.2: MOVE T1,P3 ; Get the FDB address
PUSHJ P,F$READ ; And read a character
JRST [CAXE T1,$FEEOF ; Get end of file?
PJRST F$ERR ; No, error
PJRST .POPJ1] ; Yes, all done
MOVE T1,P2 ; Got a character, get the ouput FDB address
PUSHJ P,F$WRIT ; Write the character
PJRST F$ERR ; Couldn't
SKIPE REEABT ; Supposed to abort now?
JRST CPYG.2 ; No, don't even bother checking
SKIPN XCTING ; Get a re-enter?
PUSHJ P,CKEOL ; Yes, only stop if end of a line
JRST CPYG.2 ; No reenter or not end of line, continue
POPJ P, ; Return now
SUBTTL F$COPY -- Subroutines -- CPYGEN - General copy routine
; Here to copy from input file to output file. This routine assumes
;that the ac's are set up as follows:
; P1/ Text buffer address
; P2/ Output file FDB address
; P3/ Input file FDB address
;
CPYA2A: MOVE T3,.BFCTR+.FDBRH(P2) ; Get the number of chars left in the output buffer
CAMLE T3,.BFCTR+.FDBRH(P3) ; Fewer chars in the input buffer?
MOVE T3,.BFCTR+.FDBRH(P3) ; Yes, get that count
MOVE T1,.BFPTR+.FDBRH(P3) ; get the source pointer
MOVE T2,.BFPTR+.FDBRH(P2) ; And the destination
MOVE P4,T3 ; Remeber how many chars
PUSHJ P,M$MSTR ; Move the text
MOVE T1,P4 ; Get the char count
MOVE T2,P2 ; And the FDB address
PUSHJ P,FIXBRH ; Fix the buffer header
MOVE T1,P4 ; Get the count back
MOVE T2,P3 ; And the address
PUSHJ P,FIXBRH ; And fix the input header
SKIPN .BFCTR+.FDBRH(P2) ; Need to output the buffer?
PUSHJ P,CPYOUT ; Yes, do it
SKIPE .BFCTR+.FDBRH(P3) ; Anything in the input buffer?
JRST CPYA.1 ; Yes, go for another pass
MOVE T1,P3 ; Get the FDB address
PUSHJ P,F$IBUF ; Input a buffer
JRST .+2 ; Error, check for EOF
JRST CPYA.1 ; Go loop
CAXE T1,$FEEOF ; End of file?
PJRST F$ERR ; No, give up
PJRST .POPJ1 ; Yes, all done
; Here to check for re-enter if necessary
CPYA.1: SKIPN REEABT ; Checking re-enters?
SKIPE XCTING ; Yes, re-enter typed?
JRST CPYA2A ; Continue copying
; Here if a re-enter was typed. Now copy chars until we copy an
;end of line character. At that point we can return and let
;top level handle it.
CPYA.2: MOVE T1,P3 ; Get the input FDB
PUSHJ P,F$READ ; Read a character
JRST [CAXE T1,$FEEOF ; Check for end of file
PJRST F$ERR ; No, error
PJRST .POPJ1] ; Yes, give skip return
MOVE T1,P2 ; Get the output FDB
PUSHJ P,F$WRIT ; Write the character
PJRST F$ERR ; Couldn't
PUSHJ P,CKEOL ; Line terminator?
JRST CPYA.2 ; No, keep copying
POPJ P, ; Yes, return
SUBTTL F$CHKP - Checkpoint a file
;+
;.hl1 F$CHKP
; This routine is used to checkpoint an output file to avoid losing the
;file in the event of a system crash.
;.lit
;
; Usage:
; MOVEI T1,FDB
; PUSHJ P,F$CHKP
; (return here always)
;
;.end lit
;-
F$CHKP: SKPOPN 0(T1) ; If the file open?
POPJ P, ; No, just return
$SAVE <P1,P2> ; Save some ac's
MOVX P1,FD.OUT ; Check if this is an output file
TDNN P1,.FDFLG(T1) ; Is it?
POPJ P, ; No, just return now
MOVX P2,<INSVL.(.FOURB,FO.FNC)> ; Get the function code
LOAD. P1,FDBCHN,(T1) ; Get the channel number
STOR P1,P2,FO.CHN ; Store it
MOVX P1,<XWD 1,P2> ; Get the FILOP. args
FILOP. P1, ; And attempt to checkpoint the file
JFCL ; Ignore the error
POPJ P, ; And return
SUBTTL F$CLOS - This routine will close a file
;+
;.HL1 F$CLOS
;This routine will close a file.
;.literal
;
; Usage:
; MOVEI T1,FDB
; PUSHJ P,F$CLOS
; (Normal return)
;
; Normal return:
; Nothing
;.end literal
;-
F$CLOS: MOVEM T1,LASFDB ; Store the last FDB
MOVE T2,.FDFLG(T1) ; Get the flags
TXNN T2,FD.OPN ; File open?
PJRST F$GRET ; No, give a good return
TXNE T2,FD.ENQ ; File ENQ.ed?
PUSHJ P,F$DEQ ; It is, DEQ. it first
TXNE T2,FD.TMP ; File from TMPCOR?
JRST F$CL.1 ; Yes, don't really need to close anything
MOVX T3,.FOREL ; Release the channel
LOAD. T2,FDBCHN,(T1) ; Get the channel
STOR T2,T3+.FOFNC,FO.CHN ; Store the channel
MOVE T2,[XWD 1,T3] ; Get the arugment pointer
FILOP. T2, ; Do it
JRST F$CL.E ; Can't do it
F$CL.2: BITOFF T2,FD.OPN,.FDFLG(T1) ; Clear the file is opened bit
PUSH P,T1 ; Save T1
LOAD. T1,FDBBUF,(T1) ; Get the buffer address
JUMPE T1,.+2 ; No buffer?
PUSHJ P,M$RBLK ; Return the block
POP P,T1 ; Restore T1
LOAD T2,.FDFLG(T1),FD.TMD ; Check if TMP file being written to disk
JMPF T2,F$GRET ; And give a skip return
PUSH P,T1 ; Yes, save T1
LOADS. T1,FDBNAM,(T1) ; Get the name swapped
ANDX T1,LH.ALF ; Keep only the left half
SETZ T2, ; Clear the IOWD
MOVX T3,<XWD .TCRDF,T1> ; Get the function
TMPCOR T3, ; And delete the TMPCOR file
JFCL ; Ignore the error
POP P,T1 ; Restore T1
PJRST F$GRET ; And return
F$CL.E: STOR. T2,FDBIOS,(T1) ; Store the iostat
MOVX T1,$FEMON ; Get the error code
POPJ P, ; Return
F$CL.1: TXNN T2,FD.OUT ; Output file to TMP:?
JRST F$CL.2 ; No, just return the buffer
LOAD. T2,FDBMOD,(T1) ; Get the I/O mode
CAXN T2,$FMDMP ; /MODE:DUMP?
JRST F$CL.2 ; Yes, file is already written
PUSH P,T1 ; Yes, save T1
LOAD. T2,FDBBUF,(T1) ; Get the buffer address
PUSH P,T2 ; Save the address
SUBI T2,@.FDBRH+.BFPTR(T1) ; And make the number of words used
SOJ T2, ; Plus one
HRLI T2,(T2) ; Put in the left half
HRR T2,(P) ; Get the address back
SOJ T2, ; Fix to an iowd
POP P,(P) ; Remove from the stack
LOAD. T1,FDBNAM,(T1) ; Get the file name
MOVX T3,<XWD .TCRWF,T1> ; Get the function
TMPCOR T3, ; And write the file
JRST F$CL.3 ; Couldn't, write it on disk
POP P,T1 ; Restore the FDB address
JRST F$CL.2 ; Go return the buffer
F$CL.3: POP P,T1 ; Get the FDB address back
PUSHJ P,F$OB.T ; Change the file to being written to disk
PJRST F$ERR ; Couldn't
JRST F$CLOS ; And start over again
SUBTTL F$RSET - This routine will reset an I/O channel
;+
;.hl1 F$RSET
; This routine will reset the I/O channel associated with the given
;FDB. It will cause the output file to be deleted, leaving the previous
;copy if there is one.
;.b.literal
; Usage:
; MOVE T1,FDB.address
; PUSHJ P,F$RSET
; (normal return)
;
;.end literal
;-
F$RSET: MOVX T2,FD.ENQ ; Check if file
TDNE T2,.FDFLG(T1) ; was ENQ.'ed
PUSHJ P,F$DEQ ; Yes, DEQ. it
LOAD. T2,FDBCHN,(T1) ; Get the channel
JUMPE T2,.POPJ ; Just return if zero
RESDV. T2, ; Clear the channel
JFCL ; Ignore the error
BITOFF T2,FD.OPN,.FDFLG(T1) ; Clear the open bit
LOAD. T2,FDBBUF,(T1) ; Get the address if one
JUMPE T2,.POPJ ; Return if no buffers
ZERO. ,FDBBUF,(T1) ; Clear the address of the buffers
MOVE T1,T2 ; Copy to the correct place
PJRST M$RBLK ; Return the block to the free core list
SUBTTL F$USET - Do a USETI/USETO FILOP
;+
;.HL1 F$USET
;This routine will do a USET? FILOP function.
;.literal
;
; Usage:
; MOVEI T1,FDB.address
; MOVE T2,Block number
; PUSHJ P,F$USET
; (Error return)
; (Normal return)
;.end literal
;-
F$USET: MOVEM T1,LASFDB ; Store the last FDB
MOVEM T2,T3+.FOIOS ; Store the block number in the IOS word
CFME. T3,FDBBLK,(T1),T2 ; At the right block
JRST F$US.2 ; Yes, go set the buffer header
CFML. T3,FDBBLK,(T1),T2 ; Are we before the correct block?
JRST F$US.1 ; No, go do the USETx
; Here to set the buffer header
F$US.2:
F$US.1: MOVE T2,.FDFLG(T1) ; Get the flags
TXNN T2,FD.OPN ; Is this file opened ?
JRST [MOVX T1,$FEOPN ; Get the error code
POPJ P,] ; Return
MOVX T3,.FOUSI ; Assume USETI function
TXNE T2,FD.OUT ; Open for output
MOVX T3,.FOUSO ; Yes - Make it a USETO
LOAD. T2,FDBCHN,(T1) ; Get the channel
STOR T2,T3+.FOFNC,FO.CHN ; Store the channel
MOVE T2,[XWD 2,T3] ; Get the argument block pointer
FILOP. T2, ; Do the FILOP.
JRST F$US.E ; Error
CFXN. T2,FDBMOD,(T1),$FMDMP ; /MODE:DUMP?
PJRST F$GRET ; Yes, all done
MOVX T2,.FOWAT ; Get the function
STOR T2,T3+.FOFNC,FO.FNC ; Store it
MOVE T2,[XWD 1,T3] ; Get the pointer
FILOP. T2, ; Wait for I/O to stop
JRST F$US.E ; Couldn't
MOVX T2,BF.IOU ; Get the use bit
MOVE T4,.FDBRH+.BFADR(T1) ; Get the address of the first
TXNE T4,BF.VBR ; Is this a virgin ring ?
JRST F$US.4 ; No,
F$US.3: ANDCAM T2,.BFHDR-1(T4) ; Clear the bit
LOAD T4,.BFHDR-1(T4),BF.NBA ; Get the address of the next buffer
; address
CAME T4,.FDBRH+.BFADR(T1) ; At the end ?
JRST F$US.3 ; No - Advance to the next buffer
BITON T2,BF.VBR,.FDBRH+.BFADR(T1) ; Magic a new virgin ring
F$US.4: MOVX T2,.FOINP ; Get the function
STOR T2,T3+.FOFNC,FO.FNC ; Store the functon
MOVE T2,[XWD 1,T3] ; Get the argument block addrss
FILOP. T2, ; Do the FILOP
JRST F$US.E ; Failed
JRST F$GRET ; Return
F$US.E: STOR. T2,FDBIOS,(T1) ; Store the I/O status
MOVX T1,$FEMON ; Make this a monitor error
POPJ P, ; Return to the caller
SUBTTL F$RENM - Rename a file
;+
;.HL1 F$RENM
;This routine will rename one file to another name.
;.literal
;
; Usage:
; MOVEI T1,FD.block ; From file decsriptor
; MOVEI T2,FD.block ; To file decsriptor
; PUSHJ P,F$RENM
; (Error return)
; (Normal return)
;
; Error return:
; T1 - Error code
; Normal return:
; Returns nothing.
;.end lteral
;-
F$RENM: MOVEM T1,LASFDB ; Store the last FDB
$SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,T1 ; Copy the arguments
STORE T1,OPNBEG,OPNEND,0 ; Clear the OPEN areas
MOVX T1,FO.ASC!FO.PRV!.FORNM ; Get the function and flags
CFXN. ,FDBNAM,(P2),0 ; Really a rename?
MOVX T1,FO.ASC!FO.PRV!.FODLT ; No, delete the file
MOVEM T1,FLP+.FOFNC ; Store it
MOVX T1,.IOASC ; Do this in ASCII mode
MOVEM T1,FLP+.FOIOS ; Store it
MOVE T1,P1 ; Get the "from" FDB address
PUSHJ P,FIXDEV ; Fix up the name and path
MOVE T1,P2 ; Get the other FDB
PUSHJ P,FIXDEV ; And fix it
LOAD. T1,FDBDEV,(P1) ; Get the device name
CFXN. ,FDBNAM,(P2),0 ; Delete instead?
STOR. T1,FDBDEV,(P2) ; Yes, use the same device
CFME. T2,FDBDEV,(P2),T1 ; See if the devices are the same
JRST [MOVX T1,$FECRS ; ++ Can not rename across strs
POPJ P,] ; Return to the caller
MOVEM T1,FLP+.FODEV ; Store the device name
MOVE T1,[XWD REN,ELB] ; Get the RENAME/LOOKUP block
MOVEM T1,FLP+.FOLEB ; Store in the FILOP. block
MOVEI T4,PTH ; Get the address of the path block
MOVEI T3,ELB ; Get the LOOKUP/ENTER block address
PUSHJ P,RENSUB ; Fill in the block
EXCH P1,P2 ; Move the blocks around
MOVEI T4,RPTH ; Get the rename path
MOVEI T3,REN ; Get the RENAME block address
PUSHJ P,RENSUB ; Fill in the block
MOVE T1,[XWD .FOLEN,FLP] ; Get the argument pointer
FILOP. T1, ; Rename the file
JRST F$RN.1 ; Couldn't
LOAD T1,FLP+.FOFNC,FO.CHN ; Get the channel number
RESDV. T1, ; And clear the channel
JFCL ; Couldn't
JRST F$GRET ; Return
F$RN.1: LOAD T2,FLP+.FOFNC,FO.CHN ; Get the channel number
RESDV. T2, ; Reset the channel
JFCL ; Ignore it
POPJ P, ; Give the error return
SUBTTL FIXDEV - Routine to fix up a device name and path
;+
;.hl1 FIXDEV
; This routine is used to fix up the device name and path in an
;FDB to be a device name which can be checked for a rename.
;.b.literal
; Usage:
; MOVEI T1,FDB.addres
; PUSHJ P,FIXDEV
; (return here)
;
;.end literal
;-
FIXDEV: STORE T2,PTH,PTH+.PTMAX,0 ; Clear the PATH block
LOAD. T2,FDBDEV,(T1) ; Get the device
JUMPE T2,.POPJ ; Return if no device
MOVEM T2,PTH+.PTSTR ; Store in the PATH block
MOVEI T2,PTH ; Get the address of the block
PATH. T2, ; Get the path for the device
POPJ P, ; Return
LOAD T2,PTH+.PTSWT,PT.IPP ; Implied PPN ?
JMPF T2,.POPJ ; Jump if false
BITON T2,FD.PTH,.FDFLG(P1) ; Flag we have a path
$SAVE <P1> ; Save P1
MOVE P1,[XWD -.PTMAX-.PTPPN,PTH+.PTPPN] ; Get the AOBJN pointer
HRRI T2,.FDPPN(T1) ; Get the address to store into
MOVE T3,(P1) ; Copy the items
MOVEM T3,(T2) ; . . .
ADDI T2,1 ; Point to next entry in the FDB
AOBJN P1,.-2 ; Loop
LOAD T2,PTH+.PTSWT,PT.SLT ; Get the search list
MOVE T2,SLTBL(T2) ; Get the search list name
STOR. T2,FDBDEV,(T1) ; Store it
POPJ P, ; Return
; Here is the table of search list names
.PTSLMAX==<1_WID(PT.SLT)>-1
TABDEF SL,.PTSL,<SIXBIT /DSK/>
TABENT J,<SIXBIT /DSK/> ; Job
TABENT A,<SIXBIT /ALL/> ; ALL:
TABENT S,<SIXBIT /SSL/> ; SSL:
TABEND
SUBTTL Subroutines -- RENSUB
;+
;.HL1 RENSUB
;This routine will fill in a path, and lookup block from a FDB block.
;.literal
;
; Usage:
; MOVEI T3,ELB
; MOVEI T4,PTH
; MOVEI P1,FDB
; PUSHJ P,RENSUB
; (Return)
;-
RENSUB: LOAD T1,.FDFLG(P1),FD.PTH ; Get the flag
JMPF T1,RENS.2 ; If not path then skip this
MOVEM T4,.RBPPN(T3) ; Store the pointer
MOVSI T1,-.PTMAX-.PTPPN ; Get the number of times to loop
HRRI T1,.FDPPN(P1) ; Get the address
MOVEI T2,.PTPPN-1(T4) ; Get the first address
RENS.1: PUSH T2,(T1) ; Move the item
AOBJN T1,RENS.1 ; Loop for all the items
MOVX T2,.PTSCY ; Assume /SCAN
MOVX T1,FD.SCN ; Check the flag
TDNN T1,.FDFLG(P1) ; . . .
SETZ T2, ; No, let it as is
STOR T2,.PTSWT(T4),PT.SCN ; store the switch
RENS.2: LOAD. T1,FDBNAM,(P1) ; Get the file name
MOVEM T1,.RBNAM(T3) ; Store ite
LOADS. T1,FDBEXT,(P1) ; Get the extensions
MOVEM T1,.RBEXT(T3) ; Store it
LOAD. T1,FDBPRO,(P1) ; Get the protection
STOR T1,.RBPRV(T3),RB.PRV ; Store in
LOAD. T1,FDBVER,(P1) ; Get the version number
MOVEM T1,.RBVER(T3) ; Store it
MOVX T1,.RBLEN ; Get the length of the block
MOVEM T1,.RBCNT(T3) ; Store it
POPJ P, ; Return to the caller
SUBTTL F$ERR - Error processing for the file errors
;+
;.HL1 F$ERR
;This routine will issue the reerror message for any file errors.
;It will output the FDB of the error message if it is required.
;-
F$ERR: $SAVE P1 ; Save P1
MOVE P1,T1 ; Move the error code into P1
CAXGE P1,$FEMIN ; Is this greater than the min ?
JRST F$ER.0 ; Yes - Skip this
CAXLE P1,$FEMAX ; Less then or equal to the max ?
STOPCD (ETB,<Error code too big>)
SKIPE FERTBL-$FEMIN(P1) ; Have an error message ?
JRST FERTBL-$FEMIN(P1) ; Yes - Go issue it
CAXE P1,$FEMON ; Is this a monitor error
STOPCD (UEC,<Unknown error code>)
; Here to process I/O errors
MOVE P1,LASFDB ; Get the address of the ast FDB
LOAD. P1,FDBIOS,(P1) ; Get the I/O status from the FDB
ERROR E.IOE ; Give an I/O error
; Here to handle he LOOKUP/ENTER errors
F$ER.0: CAXGE P1,ERMAX% ; Is this less than the max ?
JRST LERTBL(P1) ; Dispath to the table
ERROR E.UME ; ++ Unknown monitor error
; Define the table of errors for the error code
DEFINE FER(XXX,YYY),<IFB <YYY>,<ERROR E.'XXX>
IFNB <YYY>,<EXP 0>>
FERTBL: FERRORS ; Define the errors
; LOOKUP/ERROR table
DEFINE ENTERR<
ERR$(0,FNF,<File not found>)
ERR$(1,IPP,<No UFD for Project-Programmer Number>)
ERR$(2,PRT,<Protection Failure>)
ERR$(3,FBM,<File being modified>)
ERR$(4,AEF,<File already exists>)
ERR$(5,ISU,<Illegal sequence of UUO's>)
ERR$(6,TRN,<Transmission error>)
ERR$(7,NSF,<Not a SAVE file>)
ERR$(10,NEC,<Not enough core>)
ERR$(11,DNA,<Device not available>)
ERR$(12,NSD,<No such device>)
ERR$(13,ILU,<Illegal UUO. No two-register relocation>)
ERR$(14,NRM,<No room or quota exceeded on this file structure>)
ERR$(15,WLK,<File structure is write-locked>)
ERR$(16,NET,<Not enough monitor table space>)
ERR$(17,POA,<Partial allocation>)
ERR$(20,BNF,<Block not free>)
ERR$(21,CSD,<Cannot supersede a directory>)
ERR$(22,DNE,<CAnnot delete a non-empty directory>)
ERR$(23,SNF,<SFD not found>)
ERR$(24,SLE,<Search list empty>)
ERR$(25,LVL,<SFD nested too deeply>)
ERR$(26,NCE,<No create bit on on all structures>)
ERR$(27,SNS,<Segment not on swapping space>)
ERR$(30,FCU,<Cannot update file>)
ERR$(31,LOH,<Low segment overlaps high segment>)
ERR$(32,NLI,<CAnnot run program when not logged in>)
ERR$(33,ENQ,<File still has outstanding locks set>)
ERR$(34,BED,<Bad .EXE directory>)
ERR$(35,BEE,<Bad extension for .EXE file>)
ERR$(36,DTB,<Directory too big for .EXE file>)
ERR$(37,ENC,<TSK - Exceeded network capacity>)
ERR$(40,TNA,<TSK - Task not available>)
ERR$(41,UNN,<TSK - Undefined network node>)
>;end of enterr macro
DEFINE ERR$(NN,XXX,TEXT),<ERROR E.'XXX>
LERTBL: ENTERR
ERMAX%==.-LERTBL ; Define the max
SUBTTL CHKFFI - Check if file is found in a different area
;+
;.hl1 CHKFFI
; This routine will check if the file was found in a PATH different
;area than expected.
;If it is not, it will issue a TECFFI warning message.
;-
F..FFI==1B0 ; File found in message issued
F..NDP==1B1 ; File is not in default path
CHKFFI: SKIPN FPTH+.PTSTR ; Get the structure name we found the file on
PJRST FFIOFF ; None, must not be a disk
LOAD. T1,FDBDEV,(P2) ; Store the device name
MOVEM T1,RPTH+.PTSTR ; Save the device name
MOVE T1,[XWD .PTMAX,RPTH] ; Get the pointer
PATH. T1, ; Get the info for the device
JFCL ; Don't worry about it
MOVE T1,FPTH+.PTSTR ; Get the device where we found this thing
STOR. T1,FDBDEV,(P2) ; Store for typeout
LOAD T1,RPTH+.PTSWT,PT.IPP ; Check if implied PPN
MOVX T2,FD.PTH ; Check if path given
TDNN T2,.FDFLG(P2) ; . . .
JMPT T1,CHKF.5 ; No, if implied PPN, must check against assumed path
CHKF.0: MOVEI T3,.FDPPN(P2) ; Get the address of the path block
MOVX T1,<XWD -<.PTMAX-.PTPPN>,.PTPPN> ; Get the pointer for the blocks
TXZ P2,F..FFI!F..NDP ; Clear the two flags
CHKF.1: MOVE T2,FPTH(T1) ; Get the path where the file was
CAME T2,PTH(T1) ; Where we wanted it?
TXO P2,F..FFI ; No, flag we need the message
CAME T2,MYPATH(T1) ; In default path yet?
TXO P2,F..NDP ; No, remember that for later
ADDI T3,1 ; Bump the pointer
JUMPE T2,.+2 ; Skip if we hit the last one
AOBJN T1,CHKF.1 ; Loop for all SFD's
HRRZM P2,FFIFDB ; Save the FDB address
SKIPN PTH+.PTPPN ; Using default path for lookup?
TXNE P2,F..NDP ; Yes, is the place we found the file the default path?
TXNN P2,F..FFI ; Is the file found flag on ?
JRST CHKF.4 ; Don't need the message
TXNN F,F.SFFI ; Suppressing this ?
WARN E.FFI ; ++ File found in ....
CHKF.4: MOVX T1,FD.NDP ; Get the not in default path flag
TXNE P2,F..NDP ; Is it there?
IORM T1,.FDFLG(P2) ; No, flag the fact for the caller
BITON T1,FD.PTH,.FDFLG(P2) ; Light the path flag
CHKF.2: TXZ P2,F..FFI!F..NDP ; Clear the flags
MOVEI T2,.FDPPN(P2) ; Get the path block again
MOVX T1,<XWD -<.PTMAX-.PTPPN>,.PTPPN> ; And the pointer
CHKF.3: MOVE T3,FPTH(T1) ; Get the found path
MOVEM T3,(T2) ; Store it
AOJ T2, ; Bump this one
JUMPE T3,FFIOFF ; Done?
AOBJN T1,CHKF.3 ; Loop for the rest
FFIOFF: TXZ F,F.SFFI ; Clear the FFI flag
POPJ P, ; And return
; Here if the a device name with an implied path was given. Move the
;info so the check is if the file was realy found where expected.
CHKF.5: MOVE T1,[XWD RPTH,PTH] ; Get the BLT pointer
BLT T1,PTH+.PTMAX-1 ; And move the info
JRST CHKF.0 ; And go do the checks
FFIPTH: Z FPTH ; Point to the path block
SUBTTL Low segment for TECFIL
; The following is the low segment for the common routines
$IMPURE ; Data segment
LOWVER(FIL,2) ; Low segment version number
F$BZER:! ; Beginning of the area to clear
OPNBEG:! ; Start of the place to clear on an OPEN
ELB: BLOCK .RBLEN+1 ; ENTER/LOOKUP block
FLP: BLOCK .FOLEN ; FILOP block
PTH: BLOCK .PTMAX ; Path block for F$OPEN
REN: BLOCK .RBLEN+1 ; Rename block
RPTH: BLOCK .PTMAX ; Rename path block
FPTH: BLOCK .PTMAX ; Path the file was found in
OPNEND==.-1 ; End of the open block area
; Storage for F$RBUF
LFCNT: BLOCK 1 ; Max number of line feeds to read
FFCNT: BLOCK 1 ; Max number of form feeds to read
CHRCNT: BLOCK 1 ; Number of characters to expand buffer by
; (Read up to 2/3 this many chars)
ENDYNK: BLOCK 1 ; Place to terminate read if a line feed is seen
STPYNK: BLOCK 1 ; Place to terminate read regardless.
MYPPN: BLOCK 1 ; This job's PPN
MYNODE: BLOCK 1 ; The node this job is on
MYPATH: BLOCK .PTMAX ; Default path area
MYJOB: BLOCK 1 ; This job's job number
REEABT: BLOCK 1 ; Abort on re-renter flag for F$COPY
PRSSTK: BLOCK 1 ; Stack pointer on call to F$PARS
ERRRTN: BLOCK 1 ; Address of the error routine
RTN: BLOCK 1 ; Input routine
SAVRTN: BLOCK 1 ; Save location
FDAEM: BLOCK 1 ; FILDAE is running flag
OJBFF: BLOCK 1 ; Saved .JBFF over opening the file
; Last items for error message printing.
LASFDB: BLOCK 1 ; Address of the last FDB
LASSWT: BLOCK 1 ; Last switch seen
LASSWP: BLOCK 1 ; Pointer to last switch table used
LASSXB: BLOCK 1 ; Last sixbit item input
LASOCT: BLOCK 1 ; Last octal number input
FFIFDB: BLOCK 1 ; FDB address for FFI message
; Switch processing information
SWTIMD: BLOCK 1 ; Input mode
SWTOMD: BLOCK 1 ; Output mode
VERBEG:!
VERMAJ: BLOCK 1 ; Major version number
VERMIN: BLOCK 1 ; Minor version number
VEREDT: BLOCK 1 ; Edit level
VERWHO: BLOCK 1 ; Who version number
VEREND==.-1 ; End of version number storage
; ENQ/DEQ storage
ENQBEG:! ; Start of the ENQ/DEQ area
ENQHDR: BLOCK .ENQRI+1+.ENQPS+1 ; ENQ/DEQ header
ENQBLK=ENQHDR+.ENQRI+1 ; ENQ/DEQ block
STRING: BLOCK 20 ; Area for the building of the string
ENQEND==.-1 ; End of the ENQ/DEQ area
F$EZER==.-1 ; End of the area to clear
SUBTTL End of TECFIL
END ; End of TECFIL