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