IDENT RESEQ,FWA,RESEQ
ABS
SST
SYSCOM B1
ENTRY RESEQ
ENTRY RFL=
SPACE 4
*COMMENT RESEQ - TIME SHARING RESEQUENCE ROUTINE.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE RESEQ - TIME SHARING RESEQUENCE ROUTINE.
SPACE 4
*** RESEQ - TIME SHARING RESEQUENCE ROUTINE.
*
* D.A. HIVELEY 71/02/14.
SPACE 4
*** RESEQ IS USED TO RESEQUENCE SOURCE FILES WHICH HAVE LEADING
* SEQUENCE NUMBERS OR TO ADD SEQUENCE NUMBERS TO AN
* UNSEQUENCED FILE. THIS MAINLY INCLUDES FORTRAN AND BASIC
* SOURCE CODE. THE FORMAT OF EACH INDIVIDUAL SOURCE LINE
* MAINTAINED. FOR BASIC PROGRAMS AN INTERNAL CHANGE OF LINE
* NUMBERS MUST BE MADE. FOR NON-BASIC PROGRAMS, ALL
* SUBROUTINES REQUIRED BY BASIC ONLY ARE OVERLAYED WITH
* BUFFERS. IF THE FILE TYPE IS DECLARED *T*, THEN THE FILE
* DATA IS NOT INSPECTED AT ALL. FIVE DIGIT SEQUENCE NUMBERS
* PLUS A BLANK ARE MERELY ADDED TO THE BEGINNING OF EACH LINE.
* DIRECT ACCESS FILES MAY BE RESEQUENCED.
*** THE FORMAT COMMAND.
*
* RESEQ(PFILE,TYPE,SLINO,INCR)
*
* PFILE = PRIMARY FILE NAME.
* TYPE = B - BASIC.
* = F - FORTRAN.
* = T - TEXT.
* = OTHER.
* SLINO = STARTING LINE NUMBER.
* INCR = INCREMENT.
*** DAYFILE MESSAGES.
*
* *LINE NUMBER LIMIT EXCEEDED* - IF LINE NUMBER ENCOUNTERED
* OR REQUIRED GREATER THAN 99999.
* *RESEQ COMMAND ERROR.* - NO PARAMETERS WERE GIVEN OR A SPECIAL
* CHARACTER WAS USED AS A PARAMETER ON THE COMMAND.
* * RESEQ ERRORS.* - IF UNABLE TO FIND LINE NUMBERS,
* ALL ERRORS WRITTEN TO FILE OUTPUT.
* *RESEQ NUMERIC PARAM ERROR.* - ROUTINE *CVD* TRIED TO
* CONVERT A NON-NUMERIC PARAMETER.
* * INCORRECT WRITE ON READ ONLY FILE.* (CIO ERROR 03) = DIRECT
* ACCESS INPUT FILE WAS NOT ATTACHED IN WRITE MODE.
*CALL COMCMAC
TITLE WORKING STORAGE AND ASSEMBLY CONSTANTS.
ORG 111B
FWA BSS 0
SPACE 4
**** ASSEMBLY CONSTANTS.
FETL EQU 10 FET LENGTH
LIMIT EQU 99999 LINE NUMBER LIMIT FOR RESEQUENCE
MNCL EQU 160 MAXIMUM NUMBER OF CHARACTERS IN A LINE
MWBL EQU MNCL/5 MAXIMUM NUMBER OF WORDS IN A LINE
NUMD EQU 5 MAXIMUM NUMBER OF DIGITS IN A LINE NUMBER
OBUFL EQU 101B OUTPUT BUFFER LENGTH
USBA$ SET 1 ENABLES UNPACKING OF 6/12 CHARACTERS
USBL$ SET 1 SPECIFIES STRING BUFFER IN USER PROGRAM
SPACE 4
** WORKING STORAGE.
CSET CON 0 CHARACTER SET (0 = NORMAL, 1 = 6/12 ASCII)
DAF CON 0 FILE TYPE (0 = DIRECT ACCESS)
FLDL CON 0 FIELD LENGTH
INCR CON 10 DEFAULT LINE NUMBER INCREMENT
LNTE CON 0 LWA+1 OF LINE NUMBER TABLE
LNTS CON 0 FWA OF LINE NUMBER TABLE
LNUM CON 100 DEFAULT INITIAL LINE NUMBER
SYST CON 2 FILE TYPE (-1 = FORTRAN)
( 0 = BASIC )
( 1 = TEXT )
( 2 = OTHER )
SPACE 4
** FET DEFINITIONS.
O BSS 0
OUTPUT FILEB OBUF,OBUFL,EPR,FET=FETL OUTPUT FET
SCR FILEB 2,1,FET=FETL SCRATCH FILE FET
SCR1 FILEB 2,1,FET=FETL SCRATCH FILE FET
INP FILEB 2,1,FET=FETL INPUT FILE FET
TITLE SUBROUTINES
** RES - RESEQUENCE.
*
* USES X - ALL.
* A - ALL.
* B - 2, 3, 4, 5, 6.
*
* CALLS ADL, CDD, CVD, PLB, PRE, RBF, STF, USB.
*
* MACROS ABORT, ENDRUN, MEMORY, MESSAGE, READC, READEI, READO,
* READW, RENAME, RETURN, REWIND, WRITEC, WRITER, WRITEW.
RESEQ BSS 0 ENTRY
RJ PRE PRESET
REWIND INP
READEI X2
RES1 SX6 B0+
SA6 RESA CLEAR TRUNCATED LINE FLAG
READC INP,WBUF,MWBL+1
NZ X1,RES16 IF EOI REACHED
BX6 X4
MX0 -12
RES2 BX6 -X0*X6
ZR X6,RES3 IF EOL ENCOUNTERED
READO X2
EQ RES2 CHECK FOR EOL
RES3 SB2 WBUF UNPACK LINE INTO STRING BUFFER
SB6 MNCL+1
SA1 CSET GET CHARACTER SET
SB3 X1+
RJ USB
SA2 SYST
SB6 SBUF
SB5 NUMD
SX2 X2-1
ZR X2,RES6 IF TEXT
SX2 B0+
SB4 60
RES4 SA3 B6
GT B6,B7,RES5 IF END OF LINE
SX4 X3-1R0
SX5 X3-1R+
NG X4,RES5 IF LETTER
PL X5,RES5 IF SPECIAL CHARACTER
SB5 B5-B1
LX2 6
SB4 B4-6
IX2 X2+X3
SB6 B6+B1
NZ B5,RES4 IF NOT *NUMD* DIGITS
RES5 LX6 X2,B4
SA6 RESB OLD LINE NUMBER
SX6 B5-NUMD
NZ X6,RES7 IF LINE NUMBER PRESENT
SA4 SYST
SX4 X4+1
ZR X4,RES7 IF FORTRAN
RES6 SB6 B6-B1
SX6 1R
SA6 B6 INSERT BLANK
RES7 SA1 LNUM
RJ CDD CONVERT LINE NUMBER TO DISPLAY CODE
BX2 X6
RJ ADL GO ADD NEW LINE NUMBER TO LINE
SB4 B7-B6
SB4 B4+B1
SB3 MNCL
LE B4,B3,RES8 IF NO TRUNCATION
SB4 B3
SX7 B1
SA7 RESA
RES8 SA1 WBUF PACK LINE INTO WORKING BUFFER
SA2 B6+
RJ PLB
SA2 INCR
SX3 LIMIT
SA1 LNUM
IX6 X1+X2
IX3 X3-X1
NG X3,RES12 IF LIMIT EXCEEDED
SA6 LNUM
SA2 SYST
NZ X2,RES9 IF NOT BASIC
SA2 RESB
RJ CVD
NG X6,RES23 IF CONVERSION ERROR
LX6 24-0 SET UP *LNT* ENTRY
LX1 42-0
BX6 X1+X6 MERGE OLD NUMBER WITH NEW NUMBER
SA3 LNTE
SX7 X3+B1
SA5 FLDL
SA6 X3+
SA7 A3
IX7 X5-X7
PL X7,RES9 IF NO TABLE OVERFLOW
SX7 X5+2000B
SA7 A5+
MEMORY CM,,R,X7
RES9 WRITEC SCR1,WBUF
SA1 RESA
ZR X1,RES1 IF LINE WAS NOT TRUNCATED
RJ ITM ISSUE TRUNCATION MESSAGE
EQ RES1 PROCESS NEXT LINE
RES12 SX2 O SET ADDRESS OF FET
RJ STF CHECK IF OUTPUT ASSIGNED TO TERMINAL
NZ X6,RES13 IF NOT TELEX ORIGIN
WRITEC O,(=C*LINE NUMBER LIMIT EXCEEDED.*)
EQ RES23 SKIP ISSUING THE DAYFILE MESSAGE
RES13 MESSAGE (=C*LINE NUMBER LIMIT EXCEEDED.*)
EQ RES23 COMPLETE ERROR TERMINATION
RES16 REWIND INP,R
SA1 SYST
NZ X1,RES17 IF NOT BASIC
RJ RBF RESEQUENCE BASIC FILE
RETURN SCR1
SA1 SCR
EQ RES18 FINISH FILE PROCESSING
RES17 SA1 SCR1
RES18 SA0 A1
SX0 77B
BX2 X0*X1
SX2 X2-3
NZ X2,RES19 IF FILE USED
SA2 ARGR
SX3 B1
MX0 42 MASK OFF NAME
BX2 X0*X2
IX6 X2+X3
SA6 A1
WRITER A0,R
EQ RES22 COMPLETE NORMAL TERMINATION
RES19 WRITER A0
REWIND X2,R
SA3 DAF
ZR X3,RES20 IF DIRECT ACCESS INPUT FILE
RENAME A0,ARGR
EQ RES22 COMPLETE NORMAL TERMINATION
RES20 READEI X2
RES21 READW A0,SBUF,MNCL
BX0 X1
SX4 B6-SBUF
WRITEW INP,SBUF,X4
PL X0,RES21 IF NOT EOF, COMPLETE COPY
WRITER X2
REWIND X2,R
RES22 WRITER O NORMAL TERMINATION
ENDRUN
RES23 REWIND INP
RETURN SCR
RETURN SCR1
MESSAGE (=C* RESEQ ERRORS.*)
WRITER O
ABORT ERROR TERMINATION
RESA CON 0 TRUNCATED LINE FLAG
RESB CON 0 OLD LINE NUMBER
ADL SPACE 4,15
** ADL - ADD LINE NUMBER
*
* ENTRY (B6) = STRING BUFFER ADDRESS+1 OF START OF STATEMENT.
* (X2) = LINE NO. RIGHT JUSTIFIED WITH LEADING BLANKS.
*
* EXIT NUMBER STORED IN STRING BUFFER.
* (B6) = STRING BUFFER ADDRESS OF LAST DIGIT STORED.
*
* USES X - 0, 2, 5, 6, 7.
* A - 6, 7.
* B - 5, 6.
ADL SUBR ENTRY/EXIT
SB5 NUMD
SX7 1R0
SX0 77B
ADL1 BX6 X0*X2
SX5 X6-1R
ZR X5,ADL2 IF SPACE
SB6 B6-B1
SA6 B6
SB5 B5-B1
ZR B5,ADLX IF *NUMD* DIGITS
AX2 6
EQ ADL1 ADD NEXT DIGIT
ADL2 SB6 B6-B1
SA7 B6
SB5 B5-B1
NZ B5,ADL2 IF NOT *NUMD* DIGITS
EQ ADLX RETURN
CVD SPACE 4,15
** CVD - CONVERT DISPLAY CODE NUMBER TO OCTAL.
*
* ENTRY (X2) = LEFT JUSTIFIED NUMBER WITH TRAILING ZEROES.
*
* EXIT (X6) = RIGHT JUSTIFIED NUMBER (IN OCTAL).
* (X6) = NEG., ERROR IN PARAMETER.
*
* USES X - 0, 2, 4, 6, 7.
*
* MACROS MESSAGE.
CVD SUBR ENTRY/EXIT
SX6 B0+
MX0 -6
CVD1 LX2 6
BX4 -X0*X2
ZR X4,CVDX IF END OF NUMBER
SX7 X4-1R+
SX4 X4-1R0
NG X4,CVD2 IF ALPHA
PL X7,CVD2 IF SPECIAL CHARACTER
LX7 X6,B1
LX6 3
IX6 X6+X7
IX6 X6+X4
EQ CVD1 CHECK NEXT CHARACTER
CVD2 MESSAGE (=C*RESEQ NUMERIC PARAM ERROR.*)
SX6 -B1
EQ CVDX RETURN
ITM SPACE 4,15
** ITM - ISSUE TRUNCATION MESSAGE.
*
* ENTRY (WBUF) = LINE NUMBER IN PACKED FORM.
*
* EXIT MESSAGE WRITTEN TO *OUTPUT*.
*
* USES X - 1, 2.
* A - 1.
* B - 2, 3, 5.
*
* CALLS SNM.
*
* MACROS WRITEC.
ITM SUBR ENTRY/EXIT
SA1 WBUF
MX2 6*NUMD
BX1 X1*X2 MASK OUT LINE NUMBER
SB2 1R0
SB3 WBUF
SB5 -ITMA
RJ SNM SET NAME IN MESSAGE
WRITEC O,WBUF
EQ ITMX RETURN
ITMA DATA C* LINE 00000 TRUNCATED.*
PLB SPACE 4,15
** PLB - PACK LINE INTO A BUFFER.
*
* ENTRY (A1) = ADDRESS OF WORD TO START PACKING IN.
* (A2) = ADDRESS OF STRING BUFFER TO PACK.
* (B4) = LENGTH OF STRING TO PACK.
*
* EXIT LINE PACKED INTO BUFFER.
*
* USES X - 2, 4, 5, 7.
* A - 2, 7.
* B - 2, 4, 5, 7.
PLB3 LX7 B2 LEFT ADJUST FINAL PACKED WORD
SA7 A1+B7 STORE PACKED WORD
SB5 12
GE B2,B5,PLBX IF EOL GUARANTEED IN LAST WORD
BX7 X7-X7
SA7 A7+B1
PLB SUBR ENTRY/EXIT
MX4 54
SB2 60
SB7 B0
SA2 A2-1
SX7 B0+
PLB1 ZR B4,PLB3 IF ALL CHARACTERS HAVE BEEN PACKED
SA2 A2+B1 GET NEXT CHARACTER
BX5 X4*X2
ZR X5,PLB2 IF NOT A TWELVE BIT CHARACTER
AX5 6
LX7 6
BX7 X7+X5 PACK ESCAPE PARAT OF CHARACTER
SB2 B2-6
BX2 -X4*X2 GET BOTTOM SIX BITS OF CHARACTER
GT B2,PLB2 IF ROOM LEFT FOR CHARACTER
SA7 A1+B7
SB7 B7+B1
SX7 B0+
SB2 60
PLB2 LX7 6
BX7 X7+X2 ADD NEW CHARACTER
SB2 B2-6
SB4 B4-B1
GT B2,PLB1 IF ROOM LEFT FOR MORE CHARACTERS
SA7 A1+B7 STORE PACKED WORD
SB7 B7+B1
SX7 B0
SB2 60
EQ PLB1 PROCESS NEXT CHARACTER
TITLE COMMON DECKS, LITERALS AND BUFFERS
** COMMON DECKS.
LIST X
*CALL COMCBLP
LIST -X
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCDXB
*CALL COMCLFM
*CALL COMCRDC
*CALL COMCRDO
*CALL COMCRDW
*CALL COMCSNM
*CALL COMCSTF
*CALL COMCSYS
*CALL COMCUSB
*CALL COMCWTC
*CALL COMCWTW
BUFFERS SPACE 4,10
** BUFFERS.
OBUF BSS OBUFL+1
NBUF BSS NUMD+1 LINE NUMBER BUFFER
USBB BSS 0
SBUF BSS MNCL+1 STRING BUFFER
WBUF BSS MWBL+1 WORKING BUFFER
SPACE 4
USE LITERALS
SPACE 4
** IF THE FILE TYPE IS NOT BASIC, ALL ROUTINES FROM
* THIS POINT ON ARE OVERLAYED WITH BUFFERS.
BUFF BSS 0
TITLE BASIC INTERNAL LINE NUMBER RESEQUENCE ROUTINES
RBF SPACE 4,10
** RBF - RESEQUENCE BASIC FILE.
*
* EXIT RESEQUENCED FILE RESIDING ON *SCR*.
*
* USES X - ALL.
* A - 1, 2, 6, 7.
* B - 2, 3, 4, 6, 7.
*
* CALLS BLP, PLB, USB.
*
* MACROS READC, READEI, READO, RETURN, REWIND, WRITEC, WRITER.
RBF SUBR ENTRY/EXIT
SA2 SCR1
MX1 -18
BX3 -X1*X2
SX3 X3-3
NZ X3,RBF1 IF FILE *SCR1* WAS USED
SX4 1033B
BX2 X1*X2
IX6 X2+X4
SA6 A2+ SET FILE NAME AND STATUS
EQ RBF2 INITIALIZE FET FOR FILE *SCR*
RBF1 WRITER SCR1
REWIND X2
READEI X2
RBF2 RETURN SCR,R PREPARE SCRATCH FILE
SA2 SCR CLEAR FUNCTION CODE FROM FET
MX0 42
BX7 X0*X2
SX0 3
BX7 X0+X7
SA7 A2
SA1 INP+1
SA2 INP+4
BX7 X1
SA7 SCR+1 SET FIRST
SX7 X7
SA7 A7+B1 SET IN
SX6 X2
SA7 A7+B1 SET OUT
SA6 A7+B1 SET LIMIT
* READ A LINE.
RBF3 SX6 B0+
SA6 RBFA CLEAR TRUNCATE FLAG
READC SCR1,WBUF,MWBL+1
NZ X1,RBFX IF EOI REACHED, RETURN
BX6 X4
MX0 -12
RBF4 BX6 -X0*X6
ZR X6,RBF5 IF EOL ENCOUNTERED
READO X2
EQ RBF4 CHECK FOR EOL
RBF5 SB2 WBUF UNPACK LINE INTO STRING BUFFER
SB6 MNCL+1
SA1 CSET GET CHARACTER SET
SB3 X1+
RJ USB
SB2 B7-SBUF-MNCL
NG B2,RBF6 IF LINE NOT TOO LONG
SB7 MNCL+SBUF
SX7 B1+
SA7 RBFA SET TRUNCATION FLAG
RBF6 SB2 B7+B1 BASIC RESEQUENCE THE LINE
SB7 SBUF+NUMD
SX5 B1 SET *LNT* SORTED
SX6 SBUF+MNCL
SA1 LNTS
SA2 LNTE
SX3 B0+
RJ BLP
SA2 RBFA MARK ANY TRUNCATION
BX6 X1+X2
SA6 A2
SA2 SBUF PACK RESEQUENCED LINE
SA1 WBUF
SB4 B7-SBUF
RJ PLB
WRITEC SCR,WBUF WRITE OUT UPDATED LINE
SA1 RBFA
ZR X1,RBF3 IF LINE WAS NOT TRUNCATED
RJ ITM ISSUE TRUNCATION MESSAGE
EQ RBF3 PROCESS NEXT LINE
RBFA CON 0 TRUNCATE FLAG
SPACE 4
IBUFF BSS 0
SPACE 4,10
SPACE 4
TITLE PRE-RESEQUENCE PROCESSOR
** PRE - PRE-RESEQUENCE PROCESSOR.
*
* *PRE* SETS UP THE FET FOR THE FILES, DETERMINES THE FILE
* TYPE, STARTING LINE NUMBER AND INCREMENT, AND STORES THESE
* INTO THEIR CORRESPONDING CELLS. IF AN ERROR IS DETECTED IN
* THE STARTING LINE NUMBER, A MESSAGE IS ISSUED AND THE PROGRAM
* IS ENDED. A FET IS ALSO ESTABLISHED FOR *SCR1*.
* *PRE* IS THEN OVERLAYED WITH BUFFERS.
*
* EXIT (SYST) - SYSTEM TYPE(-1=FORTRAN,0=BASIC,1=TEXT,
* 2=OTHER).
* (LNUM) - STARTING LINE NUMBER.
* (INCR) - INCREMENT.
* (LNTS) = FWA OF LINE NUMBER TABLE.
* (LNTE) = LWA+1 OF LINE NUMBER TABLE.
*
* USES X - ALL.
* A - 1, 2, 3, 5, 6, 7.
*
* CALLS CVD.
*
* MACROS ABORT, MESSAGE, RETURN, STATUS, TSTATUS.
PRE SUBR ENTRY/EXIT
SB1 1
SX6 A0-4
SA6 FLDL SAVE FIELD LENGTH
RETURN SCR1,R PREPARE SCRATCH FILE
MX0 42 CLEAR FUNCTION CODE FROM FET
SA1 SCR1
BX6 X0*X1
SX0 3
BX6 X0+X6
SA6 A1
SX0 77B
SA3 ACTR
SX3 X3-1
PL X3,PRE3 IF PARAMETER COUNT NOT ZERO
PRE2 MESSAGE (=C*RESEQ COMMAND ERROR.*)
ABORT
PRE3 SA2 ARGR
MX5 42
SX4 3
BX6 X5*X2
IX6 X4+X6
SA6 INP SET FIRST WORD OF PRIMARY FILE FET
SX3 X3-1
NG X3,PRE5 IF NO SYSTEM PASSED
SA2 ARGR+1 GET FILE TYPE (B=BASIC)
BX2 X5*X2
LX2 6
SX1 B1+B1
BX6 X2-X1
ZR X6,PRE4 IF TYPE BASIC
SX6 B1
SA1 =1RT
BX7 X2-X1
SA1 =1RF
BX5 X2-X1
NZ X5,PRE3.1 IF TYPE NOT FORTRAN
SX6 -B1
EQ PRE4 STORE FILE TYPE
PRE3.1 NZ X7,PRE5 IF TYPE NOT TEXT
PRE4 SA6 SYST STORE FILE TYPE
PRE5 SA1 JOPR CHECK JOB ORIGIN TYPE
LX1 -24
MX0 -12
BX1 -X0*X1
SX1 X1-IAOT
NZ X1,PRE5.1 IF NOT INTERACTIVE ORIGIN JOB
TSTATUS PREA GET INTERACTIVE STATUS
SA1 PREA+1 CHECK CHARACTER SET
SX6 B1+
LX1 0-2
BX6 X6*X1
SA6 CSET SAVE CHARACTER SET (NORMAL/ASCII)
PRE5.1 SA5 FLDL
SA2 SYST
NZ X2,PRE6 IF FILE TYPE NOT BASIC
SX7 IBUFF
IX6 X5-X7
AX6 2
EQ PRE7 INITIALIZE REST OF FET
PRE6 SX7 BUFF OVERLAY BASIC ONLY ROUTINES
IX6 X5-X7 SUBROUTINES WITH INPUT BUFFERS
AX6 1
PRE7 SX6 X6-50
SX4 FETL-5 FET LENGTH - 5
IX6 X6+X7
LX4 18
IX7 X7+X4
SA7 INP+1 SET FIRST
SX7 X7
SA7 A7+B1 SET IN
SA7 A7+B1 SET OUT
SA6 A7+B1 SET LIMIT
SX3 X3-1
NG X3,PRE9 IF NO STARTING LINE NUMBER PASSED
SA2 ARGR+2 GET STARTING LINE NUMBER
MX0 -6
BX7 -X0*X2
NZ X7,PRE2 IF SPECIAL CHARACTER
ZR X2,PRE9 IF NO PARAMETER
RJ CVD CONVERT STARTING LINE NUMBER
NG X6,PRE8 IF CONVERSION ERROR
SX5 X6-LIMIT
NG X5,PRE8.1 IF LINE NUMBER LIMIT NOT EXCEEDED
MESSAGE (=C*LINE NUMBER LIMIT EXCEEDED.*)
PRE8 ABORT
PRE8.1 SA6 LNUM SAVE STARTING LINE NUMBER
PRE9 SX3 X3-1
NG X3,PRE10 IF NO INCREMENT PASSED
SA2 ARGR+3 GET LINE INCREMENT
MX0 -6
BX6 -X0*X2
NZ X6,PRE2 IF SPECIAL CHARACTER
ZR X2,PRE10 IF NO PARAMETER
RJ CVD CONVERT LINE NUMBER INCREMENT
NG X6,PRE8 IF CONVERSION ERROR
SA6 INCR SAVE INCREMENT
PRE10 STATUS INP,P
SA1 INP+5
MX3 -6
BX7 X7-X7
AX1 6
BX4 -X3*X1
SX6 X4-PMFT
SA6 DAF STORE DIRECT ACCESS FILE FLAG
SA3 INP+4
SA7 A1+B1 CLEAR RANDOM INDEX
SX7 X3+B1
SX5 FETL-5 FET LENGTH - 5
LX5 18
BX6 X7+X5
SA6 SCR1+1 SET FIRST
SA7 A6+B1 SET IN
SA7 A7+B1 SET OUT
SA5 SYST
NZ X5,PRE11 IF FILE TYPE NOT BASIC
SA1 INP+2
IX4 X3-X1 BUFFER LENGTH
IX6 X7+X4
SX6 X6+100
SX7 X6+B1
SA7 LNTS
SA7 LNTE
EQ PRE12 SET LIMIT
PRE11 SA1 FLDL
SX6 X1+
PRE12 SA6 SCR1+4 SET LIMIT
EQ PREX RETURN
PREA BSS 2 BUFFER FOR *TSTATUS* MACRO
SPACE 4
RFL= EQU 6000B
END