Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tecf20.mac
There are 3 other files named tecf20.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; All rights reserved.
;
; This software is furnished under a license and may be used and copied
; only in accordance with the terms of such license and with the
; inclusion of the above copyright notice. This software or any other
; copies thereof may not be provided or otherwise made available to any
; other person. No title to and ownership of the software is hereby
; transferred.
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by 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(F20,<TECO File system interface -- TOPS-20>) ; 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 |
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 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
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,
> ; 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:
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.SYM ; Is this a symbol ?
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
; 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
;-
F$EBDF: TXO F,F.EB ; Flag doing an EB default
F$DFLT:
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:
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:
SUBTTL F$DEQ - DEQ a file
;+
;.hl1 F$DEQ
; This routine will release all current locks.
;-
F$DEQ: POPJ P, ; 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:
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:
; Here to write with no super
TMPWRI:
TMPWRS:
PJRST F$GRET ; Give the good return
; Here to read a TMP: file
TMPREA:
JRST F$GRET ; Return to the caller
; Routines to do preprocessing be for a FILOP.
; PREREA - Before a READ function
PREREA:
; PREAPP - Before an APPEND function
PREAPP: ; Same as PREWRI
; PREWRS - Write a file (Create a new file)
PREWRS: ; Same as PREWRI
; PREWRI - Write a file
PREWRI:
; PREDEL - Preprocessing for a DELETE
PREDEL:
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:
; Here to do the post processing for write and write/no superceeding
POSAPP:
POSWRI:
POSWRS:
POPJ P, ; Return
; POSDEL - After delete processing
POSDEL: 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:
; ERRDEL - Error processing for delete function
ERRDEL: 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:
; Here to input an LSA file
I$LSA:
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:
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:
F$OBUF:
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:
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:
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:
; 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:
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:
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 -- CPYA2A - ASCII to ASCII
; 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:
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:
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
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:
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:
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:
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
OPNEND==.-1 ; End of the open block area
; Storage for F$RBUF
; 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
; Switch processing information
SWTIMD: BLOCK 1 ; Input mode
SWTOMD: BLOCK 1 ; Output mode
; ENQ/DEQ storage
ENQBEG:! ; Start of the ENQ/DEQ area
F$EZER==.-1 ; End of the area to clear
SUBTTL End of TECF20
END ; End of TECF20