IDENT MODIFY,FETS,MODIFY ABS ENTRY MODIFY ENTRY RFL= SYSCOM B1 MODIFY TITLE MODIFY - SOURCE LIBRARY EDITING PROGRAM. *COMMENT MODIFY - SOURCE LIBRARY EDITING PROGRAM. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. DOC SPACE 4 *** MODIFY - SOURCE LIBRARY EDITING PROGRAM. * G. R. MANSFIELD. 69/06/22. * A. D. FORET. 74/12/05. * A. D. FORET. 76/08/04. SPACE 4,20 *** MODIFY IS A SOURCE LIBRARY EDITING PROGRAM * DESIGNED TO AID IN THE DEVELOPMENT AND MAINTENANCE * OF A SYSTEM OF PROGRAMS OR DECKS. THE SOURCE LINES * ARE MAINTAINED IN SUCH A MANNER THAT EACH DIRECTIVE HAS * PERMANENT SEQUENCING INFORMATION AS LONG AS THE LINE * REMAINS ON THE PROGRAM LIBRARY. CARD SPACE 4,20 *** COMMAND CALL. * * MODIFY(P1,P2,P3...PN) * * *PN* MAY BE ONE OF THE FOLLOWING - * * SECOND DEFAULT IS THE VALUE OF THE PARAMETER IF IT IS NOT * EQUATED. IF NO SECOUND DEFAULT IS SPECIFIED IT IS THE SAME * AS THE FIRST DEFAULT. * * PN DESCRIPTION * * I DIRECTIVE INPUT. DEFAULT IS *INPUT*. * * P PROGRAM LIBRARY FILE. DEFAULT IS *OPL*. * * C COMPILE FILE OUTPUT. DEFAULT IS *COMPILE*. * * N NEW PROGRAM LIBRARY. DEFAULT IS NOT SELECTED. * SECOND DEFAULT IS *NPL*. * * S SOURCE FILE. DEFAULT IS NOT SELECTED. * SECOND DEFAULT IS *SOURCE*. * * L LIST OUTPUT FILE. DEFAULT IS *OUTPUT*. * * LO LIST OPTIONS. DEFAULT IS *E* IF LIST OUTPUT FILE IS * ASSIGNED TO THE TERMINAL, OTHERWISE DEFAULT IS * *ECTMWDS*. * * OPTION DESCRIPTION * * E ERRORS. * C DIRECTIVES OTHER THAN *INSERT*, * *DELETE*, AND *RESTORE*. * T INPUT TEXT. * M MODIFICATIONS PERFORMED. * W COMPILE FILE DIRECTIVES. * D DECK STATUS. * S STATISTICS. * I INACTIVE LINES. * A ACTIVE LINES. * * * A WRITE COMPRESSED COMPILE. DEFAULT IS NOT SELECTED. * * BL BURSTABLE LISTING. GENERATE OUTPUT LISTING EASILY * SEPARABLE INTO COMPONENTS. A NEW PAGE WILL BE * STARTED ON THE OUTPUT LISTING FOR EACH INDIVIDUAL * DECK. DEFAULT IS NOT SELECTED. * * D IGNORE ALL ERRORS. DEFAULT IS NOT SELECTED. * * F MODIFY ALL DECKS. DEFAULT IS NOT SELECTED. * * U MODIFY ONLY DECKS MENTIONED ON *DECK* DIRECTIVES. * DEFAULT IS NOT SELECTED. * * NR NO REWIND ON COMPILE. DEFAULT IS NOT SELECTED. * * X REWIND *INPUT* AND *OUTPUT* FILES, SET *A* * OPTION AND CALL SPECIFIED PROGRAM WHEN * MODIFICATION IS COMPLETE. DEFAULT PROGRAM * IS *COMPASS*. DEFAULT IS NOT SELECTED. * * Q SAME AS *X* EXCEPT THAT *INPUT* AND *OUTPUT* * ARE NOT REWOUND. * * Z TAKE DIRECTIVES ONLY FROM COMMAND. DEFAULT IS * NOT SELECTED. * EXAMPLE - MODIFY(...Z...)XDDDDDXDDDXDDD * X IS ANY CHARACTER NOT IN *D*. * D IS A MODIFY DIRECTIVE. * * CV CONVERSION OPTION. DEFAULT NOT SELECTED. * *CV* MAY BE EITHER 63 OR 64. * CV=MAD64 INDICATES THAT MODIFY SHOULD CONVERT THE * OLD *MADIFY* COMPRESSION CODES TO THE MODIFY CODE. * * IF *X* OR *Q* OPTIONS ARE SELECTED THE FOLLOWING * ADDITIONAL OPTIONS APPLY. * * CB SET ASSEMBLER *B* ARGUMENT. DEFAULT IS *LGO*. * * CS SET ASSEMBLER *S* ARGUMENT. DEFAULT IS *SYSTEXT*. * * CG SET ASSEMBLER *G* ARGUMENT. DEFAULT IS *0*. * SECOND DEFAULT IS *SYSTEXT*. * * CL SET ASSEMBLER *L* ARGUMENT. DEFAULT IS *0*. * SECOND DEFAULT IS *OUTPUT*. DAYFILE SPACE 4,25 *** DAYFILE MESSAGES. * * * * MODIFICATION COMPLETE.* - NORMAL COMPLETION MESSAGE. * * * MODIFICATION ERRORS.* - ERRORS ENCOUNTERED WHILE * PROCESSING DIRECTIVES. * * * ERROR IN MODIFY ARGUMENTS.* - AN INCORRECT COMMAND * OPTION WAS ENCOUNTERED. * * * FILE NAME CONFLICT.* - TWO OR MORE FILES HAVE THE SAME * NAME. * * * DIRECTIVE ERRORS.* - INCORRECT DIRECTIVES WERE ENCOUNTERED. * * * NO DIRECTIVES.* - INPUT FILE WAS EMPTY, AND DIRECTIVES * WERE REQUIRED. * * * ERROR IN DIRECTORY.* - THE DIRECTORY ON THE PROGRAM * LIBRARY WAS NOT IN THE PROPER FORMAT. * * * PL ERROR IN DECK DECKNAM* - AN ERROR WAS ENCOUNTERED * DURING PROCESSING OF DECK *DECKNAM*. * * * PROGRAM LIBRARY EMPTY.* - THE SPECIFIED OPL FILE CONTAINED * NO DATA. * * * -LO- ERROR, MUST BE IN -ECTMWDSIA-.* - *LO* OPTION * SPECIFIED NOT VALID. * * * NNNN ERRORS IN DECKNAM - * - DECK *DECKNAM* * CONTAINED *NNNN* ERRORS. * * * S OPTION INCORRECT WITH A, X OR Q.* - COMPRESSED COMPILE * AND SOURCE OUTPUT NOT ALLOWED SIMULTANEOUSLY. * * * X OR Q INCORRECT WITHOUT COMPILE.* - SELECTION OF *X* * OR *Q* OPTIONS WITHOUT WRITING A COMPILE FILE * IS NOT PERMITTED. * * * DECKNAM - INCORRECT CS, 63 ASSUMED.* - CHARACTER SET * IDENTIFICATION FOR DECK *DECKNAM* DID NOT INDICATE * IT WAS EITHER 63 OR 64 CHARACTER SET. MODIFY * ASSUMES IT TO BE 63 CHARACTER SET AND MAKES IT * SUCH ON A NEW PROGRAM LIBRARY, IF ONE IS BEING * CREATED. * * * DECKNAM - MIXED CHARACTER SET DETECTED.* - UPON EDITING * THE INDICATED DECK MODIFY DETECTED THAT THE CHARACTER * SET OF THIS DECK WAS DIFFERENT FROM THOSE ALREADY * PROCESSED. PROGRAM LIBRARIES CONTAINING RECORDS OF * MORE THAN ONE CHARACTER SET ARE INCORRECT. * * * REDUNDANT CONVERSION IGNORED.* - CONVERSION TO THE * DESIRED CHARACTER SET IS REDUNDANT SINCE THE * OLD PROGRAM LIBRARY IS ALREADY IN THE SPECIFIED * RESULTANT CHARACTER SET MODE. * * *INCORRECT CS ON INPUT.* - A 64 CHARACTER INPUT WAS * DETECTED WHILE THE PL IS 63. THIS MIXED MODE * IS NOT ALLOWED. A 63 CHARACTER SET ZERO CHARACTER * IS NOT DEFINED. * * * CSET - UNKNOWN CHARACTER SET.* - AN UNKNOWN CHARACTER * SET WAS SPECIFIED. * * * DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK* * A REDUNDANT NESTED CALL WAS FOUND. A CALL, CALLC, * NIFCALL, OR IFCALL CALLS A COMMON DECK WHICH HAS * HAS ALREADY BEEN CALLED IN THE CURRENT NESTING * SEQUENCE. OPERATOR SPACE 4,15 *** OPERATOR MESSAGES. * * * MODIFY / DECKNAM * - DECK *DECKNAM* IS CURRENTLY HAVING * MODIFICATIONS PROCESSED AGAINST IT. * * * CREATE / DECKNAM * - DECK *DECKNAM* IS CURRENTLY BEING * TRANSFORMED FROM SOURCE TO COMPRESSED FORMAT. * * * IGNORE / DECKNAM * - MODIFICATIONS TO DECK *DECKNAM* * ARE BEING IGNORED, IN RESPONSE TO AN *IGNORE* * DIRECTIVE. * * * SKIP / RECNAME * - RECORD *RECNAME* IS BEING SKIPPED. MODIFY TITLE GENERAL DESCRIPTION. *** THE MODIFY EDITING PROCESS IS CONTROLLED BY THE USE OF * DIRECTIVE LINES, WHICH ARE NORMALLY READ FROM THE JOB * INPUT FILE. A DIRECTIVE CONSISTS OF A PREFIX CHARACTER * IN COLUMN ONE FOLLOWED IMMEDIATELY BY A DIRECTIVE NAME. THE * PREFIX CHARACTER IS PRESET TO -*-, BUT MAY BE CHANGED VIA A * DIRECTIVE. THE DIRECTIVE IS TERMINATED BY ANY CHARACTER * WITH A DISPLAY CODE VALUE .GE. 55B. THE MAXIMUM LENGTH OF * ANY MODIFY NAME IS SEVEN CHARACTERS. * * OUTPUT FROM MODIFY IS PLACED ON A FILE CALLED *COMPILE* FOR * FURTHER PROCESSING BY OTHER PROGRAMS. THESE LINES CONTAIN * SEQUENCING INFORMATION AFTER THE LAST CHARACTER OF SOURCE * DATA. THIS INFORMATION MAY BE SUPPRESSED OR IT,S POSITION * CHANGED VIA DIRECTIVES. THE *COMPILE* MAY ALSO BE DIVIDED * INTO LOGICAL RECORDS OR FILES. * * THE PROGRAM LIBRARY CONSISTS OF TWO OR MORE LOGICAL RECORDS * OF SOURCE LINES WHICH ARE REFERRED TO AS DECKS. THE USUAL * DECKS CONSISTS OF A SINGLE PROGRAM. CERTAIN DECKS MAY BE * *COMMON* DECKS. COMMON DECKS MAY BE CALLED FROM OTHER DECKS * FOR INSERTION OF THE TEXT OF THE *COMMON* DECK INTO THE * COMPILE FILE. THIS FEATURE ALLOWS SEVERAL ROUTINES TO SHARE * IDENTICAL SUBROUTINES OR DATA BLOCKS. *COMMON* DECKS MAY ALSO * BE CALLED FROM OTHER *COMMON* DECKS. * * THE PROGRAM LIBRARY IS TREATED AS A RANDOM ACCESS FILE AND * AS SUCH, MUST RESIDE ON MASS STORAGE. A DIRECTIVE IS PROVIDED * FOR COPYING THE PROGRAM LIBRARY ONTO MASS STORAGE. * * DECKS MAY REMOVED, REPLACED, OR INSERTED INTO THE PROGRAM * LIBRARY BY USE OF COPY UTILITIES SUCH AS *COPYX*, *COPYBR*, * OR *LIBEDIT*. * * DECKS MAY BE MODIFIED BY INSERTION, DELETION, AND RESTORATION * OF LINES VIA DIRECTIVE. DELETED LINES ARE MARKED INACTIVE, * BUT NOT DELETED FROM THE PROGRAM LIBRARY. THE LINE MAY BE * REACTIVATED BY RESTORATION. * * FACILITIES INCLUDED IN MODIFY ARE - * * PREPARATION OF PROGRAM LIBRARY FROM SOURCE. * MODIFICATION OF DECKS BY INSERTION, DELETION, AND RESTORATION. * PRODUCTION OF SOURCE FROM THE PROGRAM LIBRARY. * GENERATION OF PROGRAM LIBRARIES. * COMPREHENSIVE LIST OUTPUT OF THE MODIFICATION PROCESS. * COMPREHENSIVE LIST OUTPUT OF THE STATUS OF THE LIBRARY. * CONTROL OF MODIFIED OUTPUT FOR PROCESSING BY OTHER PROCESSORS. * ABILITY TO PROCESS INPUT FROM ALTERNATE INPUT FILES. * PROCESSING OF DIRECTIVES FROM THE MODIFY COMMAND. * DIVISION OF COMPILE FILE INTO RECORDS AND FILES. * ABILITY TO SIMULTANEOUSLY PROCESS MORE THAN ONE LIBRARY. * SUPPORT OF 63 OR 64 CHARACTER SET PROGRAM LIBRARIES. * CONDITIONAL PROCESSING OF OUTPUT TO COMPILE FILE. FILES TITLE FILE FORMATS. ** FILE FORMATS. * * SOURCE. * THE SOURCE FILE CONSISTS OF ONE OR MORE RECORDS * REPRESENTING THE DECKS. EACH DECK IS PRECEEDED BY ONE OR TWO * LINES WHICH ARE USED FOR DECK GENERATION. THE FIRST * CONTAINS THE NAME OF THE DECK BEGINNING IN COLUMN ONE. * THE SECOND LINE, IF IT CONTAINS THE NAME *COMMON* BEGINNING * IN COLUMN ONE, SIGNIFIES THAT THE DECK WILL BE GIVEN COMMON * STATUS ON THE PROGRAM LIBRARY. THESE LINE(S) ARE NOT PART * OF THE DECK RECORD WHEN PLACED ON THE PROGRAM LIBRARY. * * * PROGRAM LIBRARY. * * THE PROGRAM LIBRARY CONTAINS TWO OR MORE RECORDS. * THE LAST RECORD IS A DIRECTORY OF ALL PRECEEDING RECORDS. * EACH DECK RECORD IS OF THE FOLLOWING FORMAT - * * WORD CONTENTS * * PREFIX TABLE. * *T ID 12/7700,12/0016,36/ *T,ID+1 42/DECKNAM,18/ *T,ID+2 60/CREATION DATE *T,ID+3 60/LAST MODIFICATION DATE *T,ID+4 60/ *T,ID+5 60/ *T,ID+6 60/ *T,ID+7 60/ *T,ID+10 60/ *T,ID+11 60/ *T,ID+12 60/ *T,ID+13 60/ *T,ID+14 60/ *T,ID+15 60/ *T,ID+16 48/,6/A,6/CS * * A ASCII CHARACTER SET FLAG. * 1 = ASCII 6/12 CHARACTER SET. * 0 = DISPLAY CODE. * * CS CHARACTER SET OF RECORD. * 64 = 64 CHARACTER SET. * 0 = 63 CHARACTER SET. * OTHER, IMPLIES 63 CHARACTER SET. * * * MODIFIER TABLE, N+1 WORDS LONG. * *T MT 12/TYPE,36/,12/N *T, MT+1 42/MODNAM,1/,1/Y,16/ * * TYPE 7001, IF NORMAL DECK. * 7002, IF COMMON DECK. * N NUMBER OF MODIFIERS. * Y YANK FLAG. * * MODNAM MODIFIER NAME. * * CONTROL INFORMATION FOR EACH LINE. * *T CARD 1/A,5/WC,18/SEQ,18/MHB,18/MHB *T,CARD+1 6/,18/MHB,18/MHB,18/MHB *T,CARD+2 6/,18/MHB,18/MHB,18/END *T,LINE+N 60/TEXT OF COMPRESSED LINE * * A IF SET, LINE IS ACTIVE. * WC WORD COUNT OF COMPRESSED LINE. * SEQ LINE SEQUENCE NUMBER. * END THE LIST OF MHB-S IS TERMINATED BY ONE TO FIVE ZERO * BYTES, AS REQUIRED TO FILL THE WORD. * * MODIFICATION HISTORY BYTE. * *T MHB 1/,1/A,16/MOD * * MOD ORDINAL INTO MODIFIER TABLE OF THE MODIFIER THAT * CAUSED THIS STATUS CHANGE FOR THE LINE. * 0, IF ORIGINAL LINE. * A SET IF THE MODIFIER ACTIVATED THE LINE. * * PROGRAM LIBRARY DIRECTORY. * * THE PREFIX TABLE FOR THE PROGRAM LIBRARY DIRECTORY * IS IN STANDARD KRONOS PREFIX TABLE FORMAT. * * DIRECTORY TABLE. * *T DIR 12/7000,30/,18/L *T DIR+1 42/DECK NAME 1,18/TYPE *T DIR+2 30/,30/RANDOM ADDRESS 1 *T DIR+3 42/DECK NAME 2,18/TYPE *T DIR+4 30/,30/RANDOM ADDRESS 2 *T DIR+N*2 42/ DECK NAME N,18/TYPE *T DIR+N*2+1 30/,30/RANDOM ADDRESS N * * L LENGTH IN WORDS. * TYPE 7001, IF NORMAL DECK * 7002, IF COMMON DECK. TITLE ASSEMBLY CONSTANTS AND MACRO DEFINITIONS. ASSEMBLY SPACE 4,10 **** ASSEMBLY CONSTANTS. OBUFL EQU 4004B OUTPUT BUFFER LENGTH CBUFL EQU 10022B COMPILE FILE BUFFER LENGTH SBUFL EQU 4004B SOURCE FILE BUFFER LENGTH MBUFL EQU 10022B SCRATCH FILE BUFFER LENGTH PBUFL EQU 16044B OPL FILE BUFFER LENGTH NBUFL EQU 10022B NPL FILE BUFFER LENGTH TBUFL EQU 4004B SCRATCH BUFFER (MULTIPLE OF 1001B) IWMACS EQU 150 MAXIMUM INPUT LINE WIDTH 150 CHARACTERS IWMAX EQU IWMACS*2 MAXIMUM INPUT WIDTH BUFFER SIZE BUFL EQU IWMAX+1 BUFFER LENGTH FLINL EQU 2000B FIELD LENGTH INCREMENT MTBSL EQU 14000B NOMINAL TABLE LENGTH MXCCL EQU 37B MAXIMUM LENGTH OF COMPRESSED LINE CMFL EQU 600B *COMPASS* DEFAULT FL FETLEN EQU 10 ALL FETS MUST BE 10 WORDS LONG FETODL EQU 16 LENGTH OF OD FET EXTENSION **** COMMON SPACE 4,10 * COMMON DECKS. *CALL COMCMAC *CALL COMCCMD *CALL COMSSRT MACROS SPACE 4,20 ** MACRO DEFINITIONS. ADDWRD SPACE 4,10 ** ADDWRD - ADD WORD TO TABLE. * * ADDWRD TNAM,WORD * * TNAM NAME OF TABLE. * WORD WORD TO ADD. * * CALLS ADW. PURGMAC ADDWRD ADDWRD MACRO T,W IFC NE,$X1$W$,1 BX1 W R= A0,T RJ ADW ENDM CARD SPACE 4,20 ** CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION. * * CARD NAME,ADDR * * NAME DIRECTIVE NAME. * ADDR ADDRESS OF DIRECTIVE PROCESSOR * IF *ADDR* NOT SPECIFIED, EXECUTION BEGINS * AT *NAME*. * * CALLS CKC. NOREF .X PURGMAC CARD CARD MACRO N,AD LOCAL A,B,C IF DEF,//.X,1 D IFNE //.X,* RMT CON 0 A BSS 0 RMT SA0 A RJ CKC QUAL B BSS 0 .X SET B QUAL * D ENDIF RMT C SET AD N CON 0L_N+C RMT ENDM ALLOC SPACE 4,10 ** ALLOC - ALLOCATE *N* ADDITIONAL WORDS TO TABLE *TNAM*. * * ALLOC TNAM,N,S * * TNAM TABLE NAME. * N NUMBER OF WORDS TO ALLOCATE. * S ALLOCATE TABLE SLACK ROOM ONLY. * * CALLS ATS, ATX. PURGMAC ALLOC ALLOC MACRO T,N,S R= X1,N R= A0,T IFC EQ,$S$$ RJ ATS ELSE RJ ATX ENDIF ENDM PRINT SPACE 4,10 ** PRINT - PRINT LINE. * * PRINT FWA,N * * FWA FWA OF LINE. * N WORD COUNT OF LINE IN *S* FORMAT. IF MISSING * LINE IN *C* FORMAT. * * CALLS WOF. PURGMAC PRINT PRINT MACRO F,N SX1 F IFC NE,$N$$ R= X2,N ELSE BX2 X2-X2 ENDIF RJ WOF ENDM SEARCH SPACE 4,20 ** SEARCH - SEARCH TABLE *TNAM* FOR *ENTRY*. * * SEARCH TNAM,ENTRY,BITS * * TNAM TABLE NAME. * ENTRY ENTRY TO SEARCH FOR. * BITS ADDITIONAL BITS FROM 0 - 16. * * CALLS STB. PURGMAC SEARCH SEARCH MACRO T,E,B R= A0,T IFC NE,$X6$E$,1 BX6 E MX1 42 IFC NE,$B$$,2 R= X2,B BX1 X1+X2 RJ STB ENDM TABLE SPACE 4,15 ** TABLE - GENERATE MANAGED TABLE. * * TABLE TNAM * * TNAM NAME OF TABLE. * * EXIT F.TNAM - NAME OF WORD CONTAINING TABLE FWA. * L.TNAM - NAME OF WORD CONTAINING TABLE LENGTH. PURGMAC TABLE MACRO TABLE,T,N T EQU * CON MTBS F.T EQU FTAB+T RMT L.T EQU LTAB+T ORG L.T CON 0 ORG NTAB+T CON N RMT ENDM LISTOP SPACE 4,15 ** LISTOP - CHECK LIST OPTION. * * LISTOP TYPE,ADDR,INS,REG * * TYPE OPTION LETTER. * ADDR ADDRESS TO JUMP TO. * INS ALTERNATE INSTRUCTION TO EXECUTE, DEFAULT IS *PL*. * REG ALTERNATE REGISTER TO USE, DEFAULT IS *X1*. PURGMAC LISTOP LISTOP MACRO T,A,I,R .INS MICRO 1,2,*I_PL* .REG MICRO 1,1,*R_1* SA".REG" LO LX".REG" 59-LO.T ".INS" X".REG",A ENDM OPTION SPACE 4,15 ** OPTION - DEFINE BIT VALUE OF OPTION. * * OPTION TYPE * * TYPE OPTION LETTER. * * THE SYMBOL LO.X IS GENERATED, WHERE X IS THE OPTION BIT * CORRESPONDING TO THE LETTER *X*. .OPT SET 0 NOREF .OPT PURGMAC OPTION OPTION MACRO T LO.T EQU .OPT .OPT SET .OPT+1 OPTION RMT CON 0R_T OPTION RMT LO.T DECMIC LO.T ENDM READK SPACE 4 *** READK - READ CODED LINE TO WORKING BUFFER. * * * READK FILE,BUF,N * * WORDS ARE UNPACKED AND STORED IN THE WORKING BUFFER ONE 6/12 * CHARACTER/WORD UNTIL THE END OF LINE (0000) BYTE IS SENSED. * IF THE CODED LINE TERMINATES BEFORE *N* CHARACTERS ARE * STORED, THE WORKING BUFFER IS FILLED WITH SPACE CODES. * * CALLS SSR. PURGMAC READK READK MACRO F,S,N R= B6,S R= B7,N R= X2,F RJ =XSSR ENDM WRITEK SPACE 4,10 *** WRITEK - WRITE CODED LINE FROM LINE BUFFER. * * * WRITEK FILE,BUF,N * * 6/12 CHARACTERS ARE PACKED FROM THE WORKING BUFFER 5-10 * CHARACTERS PER WORD. * TRAILING CODES ARE DELETED BEFORE CHARACTERS ARE PACKED. * * CALLS SSW. PURGMAC WRITEK WRITEK MACRO F,S,N R= B6,S R= B7,N R= X2,F RJ =XSSW ENDM QUAL SPACE 4 ** DEFINE QUAL BLOCK ORDER. QUAL QUAL DIRECT QUAL PRESET QUAL MACRO$ QUAL FETS TITLE FILE DEFINITIONS. ** FILE DEFINITIONS. ORG 110B FETS BSS 0 ALL FETS ARE 26 WORDS LONG I BSS 0 DIRECTIVE INPUT FILE INPUT FILEC SBUF,SBUFL,FET=10 BSSZ FETODL O BSS 0 LIST OUTPUT FILE OUTPUT FILEC OBUF,OBUFL,FET=10 BSSZ FETODL C BSS 0 COMPILE FILE COMPILE FILEC CBUF,CBUFL+SBUFL,FET=10 BSSZ FETODL S BSS 0 SOURCE FILE SOURCE FILEC SBUF,SBUFL,FET=10 ORG S CON 0 ORG S+FETLEN BSSZ FETODL M BSS 0 SCRATCH FILE ZZZZZG0 RFILEB MBUF,MBUFL,FET=10 ORG M+7 CON 0LSCR1+3 ORG M+FETLEN BSSZ FETODL P BSS 0 PROGRAM LIBRARY FILE OPL RFILEB PBUF,PBUFL,FET=10 ORG P+7 CON 0LOPL+3 ORG P+FETLEN BSSZ FETODL N BSS 0 NEW PROGRAM LIBRARY FILE NPL RFILEB NBUF,NBUFL,FET=10 ORG N CON 0 ORG N+8 ORG N+FETLEN BSSZ FETODL A BSS 0 SCRATCH FILE ZZZZZG1 RFILEC CBUF,CBUFL,FET=10 ORG A+7 CON 0LSCR2+3 ORG A+FETLEN BSSZ FETODL T BSS 0 INSERTION TEXT OVERFLOW FILE ZZZZZG2 RFILEB TBUF,TBUFL,FET=10 ORG T CON 0 ORG T+7 CON 0LSCR3+3 ORG T+FETLEN BSSZ FETODL FETSL BSS 0 TITLE MANAGED TABLE DEFINITIONS. TABLES SPACE 4,10 ** MODIFY MANAGED TABLES. * * MANAGED TABLES ARE REFERENCED BY TABLE NUMBER *TNAM*. * * F.TNAM FWA OF TABLE. * L.TNAM LENGTH OF TABLE. * * *TABLE* MACRO GENERATES THE ABOVE SYMBOLS. FTAB BSS 0 LOC 0 TDKN SPACE 4,10 ** TDKN - TABLE OF DECK NAMES. * *T TDKN 42/DECK NAME,18/ *T,TDKN+1 24/ADDRESS OF FILE NAME,36/RANDOM ADDRESS OF RECORD TDKN TABLE 10 TABLE OF DECK NAMES TNME SPACE 4,15 ** TNME - TABLE OF NAMES MENTIONED ON DIRECTIVE LINES. * *T TNME 42/ NAME, 1/, 1/ U, 1/ Y, 1/, 1/ I, 12/, 1/ A * * NAME NAME MENTIONED ON DIRECTIVE LINE. * U IF NOT SET, INDICATED *UNYANK*. SET FOR *YANK*. * Y SET FOR *YANK* OR *UNYANK*. * I SET IF IDENT NAME. * A ALL AFTER FLAG. * * SET TO -*******- ON INITIAL ENTRY. TNME TABLE 10 TABLE OF NAMES TMOD SPACE 4,20 ** TMOD - TABLE OF MODIFICATIONS. * *T TMOD 1/I,1/R,4/,18/AFC,18/NFC,18/NEXT *T,TMOD+1 1/E,5/,18/ALC,18/NLC,18/EC *T,TMOD+2 2/,16/IMN,18/NCI,24/AIT * * I SET IF INSERT. NOT SET IF DELETE. * R SET IF RESTORE. * AFC ADDRESS OF MODIFIER OF FIRST LINE FOR MODIFICATION. * NFC NUMBER OF FIRST LINE FOR MODIFICATION. * NEXT ADDRESS OF NEXT MODIFICATION. * E SET IF ERROR. * ALC ADDRESS OF MODIFIER OF LAST LINE FOR MODIFICATION. * NLC NUMBER OF LAST LINE FOR MODIFICATION. * EC ERROR CODE. * IMN INDEX OF MODIFIER NAME FOR MODIFICATION. * NCI NUMBER OF LINES TO INSERT. * AIT ADDRESS OF INSERTION TEXT. TMOD TABLE 30 TABLE OF MODIFICATIONS TDKI SPACE 4,12 ** TDKI - TABLE OF DECK IDENTIFIERS. * * WHEN PROCESSING DIRECTIVES - * *T TDKI 42/DECK NAME,18/ * * WHEN PROCESSING MODIFICATIONS - * *T TDKI 42/IDENTIFIER,1/Y,17/CARD NUMBER * * Y YANK FLAG. TDKI TABLE 10 TABLE OF DECK IDENTIFIERS TNCD SPACE 4,10 ** TNCD - TABLE OF NEXT LINES. * * TABLE PARALLELS *TDKI*. * *T TNCD 42/,18/NEXT * * NEXT NEXT LINE TO BE PROCESSED. TNCD TABLE 10 TABLE OF NEXT LINES TEDT SPACE 4,12 ** TEDT - TABLE OF DECKS TO BE EDITED. * *T TEDT 42/DECK NAME,18/AFM *T TEDT+1 42/,18/ADK * * AFM ADDRESS OF FIRST MODIFICATION. * ADK ADDRESS OF DECK IN *TDKN*. TEDT TABLE 10 TABLE OF DECKS TO BE EDITED TNDK SPACE 4,10 ** TNDK - TABLE OF NEW DECKS. * * SEE *TDKN* TABLE FORMAT. TNDK TABLE 10 TABLE OF NEW DECKS TECD SPACE 4,10 ** TECD - TABLE OF EDITED COMMON DECKS. * * SEE *TDKN* TABLE FORMAT. TECD TABLE 10 TABLE OF EDITED COMMON DECKS TDEF SPACE 4,10 ** TDEF - TABLE OF DEFINED NAMES. * *T DEF 42/ DEFINED NAME, 1/ I, 1/ , 16/ VALUE * * I DEFINITION OF SYMBOL ENCOUNTERED ON INPUT. IF THIS * BIT IS SET COMPILE FILE DEFINITIONS OF THE SAME * SYMBOL WILL BE IGNORED. TDEF TABLE 10 TABLE OF DEFINED NAMES TIGD SPACE 4,10 ** TIGD - TABLE OF DECKS TO BE IGNORED. * *T TIGD 42/DECK NAME,18/ TIGD TABLE 10 TABLE OF DECKS TO BE IGNORED TMVE SPACE 4,10 ** TMVE - TABLE OF MOVE AND PURGE DIRECTIVES. * *T TMVE 1/P,23/,18/DNR,18/DNP * * P PURGE BIT. * DNR DECK NAME INDEX OF MOVE REFERENCE. * DNP DECK NAME INDEX OF PURGE/MOVE. TMVE TABLE 10 TABLE OF MOVE AND PURGE DIRECTIVES TNCC SPACE 4,10 ** TNCC - TABLE OF NESTED COMMON DECK CALLS. * *T TNCC 42/DECK NAME,18/SKIP COUNT TNCC TABLE 50 TABLE OF NESTED COMMON DECK CALLS TCCD SPACE 4,10 ** TCCD - TABLE OF CALLED COMMON DECKS. * *T TCCD 42/DECK NAME,18/0 TCCD TABLE 200 TABLE OF CALLED COMMON DECKS TTXT SPACE 4,10 ** TXTT - TABLE OF INSERTION TEXT. * * VARIABLE LENGTH ENTRIES. * * COMPRESSED LINE TEXT. TTXT TABLE IWMAX TABLE OF INSERTION TEXT TCDK SPACE 4,10 ** TCDK - TABLE OF COMMON DECKS. * * SEE *TXTT* TABLE FORMAT. TCDK TABLE 0 TABLE OF COMMON DECKS SPACE 4 * MANAGED TABLES VALUES. FTABL BSS 0 LOC *O CON MTBS LWA+1 OF ALL TABLES LTAB BSS 0 NTAB EQU LTAB+FTABL HERE OPTION SPACE 4,10 ** OPTION - LIST OPTION TABLE. OPTION E ERRORS OPTION C OTHER INPUT DIRECTIVES OPTION T INPUT TEXT OPTION M MODIFICATIONS OPTION W COMPILE FILE DIRECTIVES OPTION D DECK STATUS OPTION S STATISTICS OPTION I INACTIVE LINES OPTION A ACTIVE LINES TITLE TEMPORARY STORAGE ASSIGNMENTS. COMMON SPACE 4 ** COMMON DATA. T1 CON 0 TEMPORARY STORAGE T2 CON 0 TEMPORARY STORAGE FL CON 0 FIELD LENGTH DL CON -0 LENGTH OF ORIGINAL DECK TABLE PC CON 1R* DIRECTIVE PREFIX CHARACTER PCC CON 1R* COMPILE PREFIX CHARACTER CH CON 0 CHARACTER POINTER SC CON 72 SEQUENCE NUMBER COLUMN - 1 CON 0 CURRENT VALUE OF SC (RESET FOR EACH DECK) PL CON 0LOPL PROGRAM LIBRARY NAME NC CON 0 LINES WRITTEN TO COMPILE THIS RECORD CON 0 TOTAL NUMBER OF LINES ON COMPILE FILE RI CON 0 RANDOM INDEX RETURN CON 0 IW CON 72 DEFAULT INPUT LINE WIDTH DISCOL CON 00B DISPLAY CODE COLON CHARACTER DISPER CON 63B DISPLAY CODE PERCENT CHARACTER SFL CON 0 STORE FL EFL CON 0 *ECS* FIELD LENGTH CDC CON 0 OPLC LINE COUNT - RESET FOR EACH DECK CDS CON 0 OPLC SKIP COUNT - RESET FOR EACH DECK SPACE 4 ** MODIFICATION CONTROLS. EI CON 0 EDIT TABLE INDEX MA CON 0 MODIFICATION ADDRESS CON 0 DELETE MODIFICATION ADDRESS CON 0 INSERT MODIFICATION ADDRESS DN CON 0 CURRENT DECK NAME DA CON 0 CURRENT DECK ADDRESS EC CON 0 DECK ERROR COUNTER CC CON 0 INACTIVE LINE COUNTER CON 0 ACTIVE LINE COUNTER CON 0 INSERTED LINE COUNTER SPACE 4 ** LIST CONTROLS. BL CON 0 BURSTABLE LISTING FLAG ERRM CON 0 ADDRESS OF ERROR MESSAGE LO CON 0 LIST OPTIONS LC CON 99999 LINE COUNT LL CON 0 LINE LIMIT ERRNZ LL-LC-1 LOCATIONS MUST BE CONTIGUOUS PN CON 1 PAGE NUMBER TL CON TLT ADDRESS OF TITLE TEXT TO CON 0 TERMINAL OUTPUT FORMAT FLAG TI CON 1 TERMINAL INPUT FORMAT FLAG FLAGS SPACE 4,6 ** FLAGS. EF CON 0 ERROR (TOTAL ERRORS DURING MODIFICATION) DE CON 0 DIRECTIVE ERROR COUNT EA CON DE DIRECTIVE ERROR COUNTER ADDRESS CD CON 0 COMMON DECK LF CON 0 SET IF DATA TRANSMITTED TO LIST FILE YK CON 0 YANK IN DIRECTIVES YD CON 0 YANK IN DECK UP CON 0 *UPDATE* FLAG FOR INSERTION LINE NUMBERS COPL CON -1 CHARACTER SET OF OPL CNPL CON -1 CHARACTER SET OF NPL CVT CON 0 CONVERSION OPTION MADCV CON 0 MADIFY CONVERSION FLAG IG CON 0 IGNORE DIRECTIVES PRESENT IFIP CON 0 *IF IN PROGRESS FLAG * .EQ. 0 IMPLIES NO IF IN PROGRESS * .LT. 0 IMPLIES FALSE CONDITION PRESENT * .GT. 0 IMPLIES TRUE CONTITION PRESENT SPACE 4,6 ** FLAGS SET BY COMMAND PARAMETERS. CL CON 0 LINE LISTED CON 0 LINE TO BE LISTED FLAG DB CON 0 DEBUG NR CON 0 NO REWIND FOR PROGRAM LIBRARY NS CON 0 NO SEQUENCE NUMBERS ON COMPILE FILE CON 0 CURRENT NO SEQUENCE FLAG (RESET EACH DECK) SS CON 0 SEQUENCE NUMBERS ON SOURCE FILE AM CON 0 *A* MODE CON 0 FIRST LINE OF RECORD FLAG FM CON 0 *F* MODE QM CON 0 *Q* MODE UM CON 0 *U* MODE XM CON 0 *X* MODE ZM CON 0 *Z* MODE CMNF CON 1 COMMENTS NEEDED FLAG CSR CON -0 CHARACTER SET REQUEST (*EC*) CSD SPACE 4,10 * CHARACTER SET DEFINITIONS. .DIS EQU 0 DISPLAY CODE 63/64 .AS612 EQU 1 ASCII 6/12 (63/64) TCST SPACE 4,10 ** TABLE OF SYMBOLIC NAMES OF CHARACTER SETS. * *T TCST 42/ CS NAME,18/ CS ORDINAL * TCST BSS 0 CON 0LDISPLAY+.DIS DISPLAY CON 0LASCII+.AS612 ASCII (6/12) CON 0 MAXIMUM CHARACTER SETS * CHARACTER SET CONTROLS. CSC CON .AS612 CURRENT CHARACTER SET SETC CON -1 NEG = USE CHARACTER SET OF DECK * 0 = USE DISPLAY SET (FOLD IF NECESSARY) * 1 = USE 6/12 ASCII SET MODIFY TITLE MODIFY - MAIN PROGRAM. ** MODIFY - MAIN PROGRAM. MODIFY SB1 1 (B1) = 1 RJ /PRESET/PRS PRESET PROGRAM RJ /DIRECT/PDC PROCESS DIRECTIVE LINES RJ /DIRECT/IMP INITIALIZE MODIFICATION PASS RJ /DIRECT/PMP PROCESS *MOVE* AND *PURDECK* SX6 EC SET MODIFICATION ERROR COUNTER ADDRESS SA6 EA EQ MOD6 BEGIN NEXT DECK * PROCESS MODIFICATIONS. MOD1 BX6 X6-X6 CLEAR LINE LIST SA5 MA+2 CHECK MODIFICATIONS SA6 CL SA6 CL+1 SA6 CDAC CLEAR LINE ACTIVITY ZR X5,MOD2 IF NO MODIFICATIONS RJ INS PROCESS INSERT SA5 MA CHECK MODIFICATIONS EQ MOD3 MOD2 SA0 P READ LINE FROM PROGRAM LIBRARY RJ RPF READ PROGRAM FILE NZ X1,MOD5 IF EOR SA5 MA+1 CHECK MODIFICATION ADDRESS MOD3 ZR X5,MOD4 IF NO MODIFICATIONS RJ DEL PROCESS DELETE/RESTORE MOD4 RJ SCS SET LINE STATUS RJ WRC WRITE LINE SA1 CL+1 ZR X1,MOD1 IF NO LIST RJ LCS LIST LINE STATUS EQ MOD1 LOOP * COMPLETE PROCESSING. MOD5 RJ CDK COMPLETE DECK MOD6 RJ BDK BEGIN NEXT DECK NZ X7,MOD1 IF DECK TO BE PROCESSED SA0 N WRITE DIRECTORY RJ WDR WRITE DIRECTORY RJ LST LIST STATISTICS RJ CMF COMPLETE FILES SA1 EF SA2 DB SA3 DE DIRECTIVE ERROR COUNT SA0 =C* MODIFICATION/DIRECTIVE ERRORS.* NZ X3,MOD8 IF DEBUG AND AT LEAST DIRECTIVE ERRORS ZR X1,MOD7 IF NO MODIFICATION ERRORS SA0 =C* MODIFICATION ERRORS.* ZR X2,ABT1 IF DEBUG NOT SET AND MODIFICATION ERRORS EQ MOD8 ISSUE MESSAGE MOD7 SA0 =C* MODIFICATION COMPLETE.* MOD8 MESSAGE A0 RJ CAS CALL ASSEMBLER ENDRUN BDK SPACE 4,20 ** BDK - BEGIN DECK. * * EXIT (X7) .NE. 0, IF DECK READY FOR PROCESSING. * * USES X - ALL. * A - 1, 2, 3, 4, 5, 6, 7. * B - 2. * * CALLS LDS, RMT, SFN, SNC. BDK SUBR ENTRY/EXIT SA1 EI CHECK EDIT TABLE SA2 L.TEDT IX7 X2-X1 SX6 X1+2 ADVANCE EDIT INDEX ZR X7,BDKX IF END OF TABLE - RETURN SA3 F.TEDT LOOK UP EDIT TABLE ENTRY SB2 X1 SA2 X3+B2 SA6 A1 MX4 -17 SET MODIFICATION ADDRESS BX7 -X4*X2 MX0 42 MASK DECK NAME SA7 MA BX6 X0*X2 SA1 A2+B1 SET DECK ADDRESS BX7 X1 SA6 A2 CLEAR MODIFICATION POINTER SA6 DN SET DECK NAME SA6 BDKA+1 ENTER DECK NAME IN MESSAGE SA7 DA BX1 X6 RJ SFN ENTER DECK NAME IN SUBTITLE SA6 SBTL+2 SA1 BL ZR X1,BDK1 IF BURSTABLE LISTING NOT SPECIFIED SX7 99999 FORCE PAGE EJECT SA7 LC BDK1 BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE LENGTH SA7 L.TDKI SA7 L.TCCD CLEAR TABLE OF CALLED COMMON DECKS SA7 L.TNCC CLEAR TABLE OF NESTED COMMON DECK CALLS SA7 CD CLEAR COMMON DECK FLAG SA7 L.TNCD CLEAR NEXT LINE TABLE SA7 IFIP CLEAR *IF CONDITION FLAG RJ RMT READ MODIFIER TABLE MESSAGE BDKA,1 ISSUE CONSOLE MESSAGE SA1 S ZR X1,BDK1.2 IF NO SOURCE RECALL A1 WRITEW S,DN,1 WRITE DECK NAME SA1 CSC ZR X1,BDK1.1 IF NOT AN ASCII DECK WRITEW X2,(=0LASCII),1 BDK1.1 SA1 CD ZR X1,BDK1.2 IF NOT COMMON DECK WRITEW X2,(=0LCOMMON),1 BDK1.2 SA1 SC RESET SEQUENCE COLUMN SA2 NS RESET NO SEQUENCE FLAG BX6 X1 LX7 X2 SA6 A1+B1 SA7 A2+B1 SA3 BDKB ZR X3,BDK2 IF NO PREVIOUS USE OF SCRATCH FILE RECALL M BX6 X6-X6 CLEAR NEW PROGRAM LIBRARY SA6 A3 SA6 M BDK2 SA1 CD ZR X1,BDK3 IF NOT COMMON DECK SA3 MA SA4 YD IX5 X3+X4 ZR X5,BDK3 IF NO MODIFICATIONS SA1 M+7 USE SCRATCH FILE FOR COMMON DECK BX6 X1 SX7 B1 SET NEW PROGRAM LIBRARY FLAG SA6 M SA7 BDKB BDK3 SA1 N SA2 M BX1 X1+X2 ZR X1,BDK4 IF NO NEW PROGRAM LIBRARY RJ WMT WRITE MODIFIER TABLE SA2 M ZR X2,BDK4 IF NO SCRATCH NPL SA1 F.TNDK SA2 L.TNDK IX3 X1+X2 SA1 X3-1 ADDWRD TECD,X1 ENTER DECK NAME BDK4 RJ LDS LIST DECK STATUS SA1 CD SA2 AM NZ X1,BDK5 IF COMMON DECK ZR X2,BDK5 IF NOT *A* MODE SA1 C ZR X1,BDK5 IF NO COMPILE FILE SA2 A2+B1 NZ X2,BDK5 IF NOT FIRST DECK SX6 B1 SA6 A2 WRITEW C,CIDT,1 WRITE *A* MODE FLAG BDK5 BX6 X6-X6 CLEAR LINE COUNTS SA6 CC SA6 A6+B1 SA6 A6+B1 RJ SNC SET NEXT LINES SA1 MA FORCE INITIAL MODIFICATION SX6 X1 SX7 B1 SA6 A1+B1 EQ BDKX RETURN BDKA CON 10H MODIFY / CON 0 BDKB CON 0 NEW PROGRAM LIBRARY FLAG FOR COMMON DECK CDK SPACE 4,20 ** CDK - COMPLETE DECK. * * ISSUE ERROR MESSAGE IF APPROPRIATE, COMPLETE DECK * ON NEW PROGRAM LIBRARY IF SELECTED AND RESET * MISCELLANEOUS FLAGS. * * USES X - 1, 2, 5, 6, 7. * A - 1, 2, 5, 6, 7. * B - 7. * * CALLS ADW, CDD, LUM, WOF. CDK SUBR ENTRY/EXIT SA5 MA ZR X5,CDK1 IF NO MODIFICATIONS RJ LUM LIST UNPROCESSED MODIFICATIONS CDK1 SA2 EF PROPAGATE ERRORS SA1 EC BX7 X7-X7 CLEAR ERROR COUNT IX6 X2+X1 SA7 A1 SA6 A2 SA7 CD CLEAR COMMON DECK FLAG SX6 -B1 SA6 SETC CLEAR *CSET INDICATOR ZR X1,CDK3 IF NO ERRORS SA2 SBTL+2 SB7 X1 BX6 X2 SA2 =10H ERRORS IN NE B7,B1,CDK2 IF MORE THAN 1 SA2 =10H ERROR IN LX6 6 SHIFT NAME CDK2 BX7 X2 LX6 -6 SA7 CDKA+1 SA6 A7+B1 SX1 B7 CONVERT COUNT RJ CDD CONVERT TO DECIMAL DISPLAY SA6 A7-B1 MESSAGE A6,3 CDK3 SA1 N ZR X1,CDK4 IF NO NPL WRITER N,R SA1 RI ENTER RANDOM INDEX SX2 N+7 LX2 36 ADDWRD TNDK,X2+X1 CDK4 SA1 M ZR X1,CDK5 IF NO SCRATCH NPL WRITER M,R SA1 RI+1 SX2 M+7 LX2 36 ADDWRD TECD,X2+X1 CDK5 WRITER S LISTOP D,CDKX IF *D* OPTION OFF PRINT (=C* *) SA1 CC INACTIVE LINE COUNT RJ CDD CONVERT TO DECIMAL DISPLAY SA6 CDKC SA1 A1+1 ACTIVE LINE COUNT RJ CDD CONVERT TO DECIMAL DISPLAY SA6 CDKB+1 SA1 A1+1 INSERTED LINE COUNT RJ CDD CONVERT TO DECIMAL DISPLAY SA6 CDKD PRINT CDKB SA1 MA SA2 YD IX6 X1+X2 ZR X6,CDK IF NO MODIFICATIONS - RETURN SX6 99999 FORCE PAGE EJECT SA6 LC EQ CDKX RETURN CDKA DATA 10H DATA 10HERRORS IN DATA 10H DATA 0 CDKB DATA 10H DATA 10H DATA 20H ACTIVE LINE(S). CDKC DATA 10H DATA 20H INACTIVE LINE(S). CDKD DATA 10H DATA 20H INSERTED LINE(S). DATA 0 INS TITLE MODIFICATION PROCESSORS. INS SPACE 4,20 ** INS - PROCESS INSERTIONS. * * ENTRY (A5) = INSERT POINTER ADDRESS. * (X5) = INSERT ADDRESS. * * USES X - 0, 1, 2, 3, 5, 6, 7. * A - 1, 2, 3, 5, 6, 7. * B - 2, 4. * * CALLS RTF. INS SUBR ENTRY/EXIT SA5 X5+ SA5 X5+2 READ TEXT RJ RTF READ TEXT FILE LX5 -42 EXTRACT IDENTIFIER ADDRESS SA1 X5+B1 ADVANCE LINE COUNT SX2 B1 IX7 X1+X2 SA7 A1 LX2 24 DECREMENT INSERTION COUNT IX6 X6-X2 SA6 A5 AX6 24 CHECK FOR END OF TEXT SB2 X6 NZ B2,INS1 IF NOT END OF TEXT SA2 MA+2 UNLINK INSERT BX6 X6-X6 MX0 -18 SA6 A2 CLEAR INSERT SA2 X2 SA3 X2 BX6 X0*X2 BX0 -X0*X3 IX6 X6+X0 SB4 A2-MA-1 SA6 A2 NZ B4,INS1 IF NOT FIRST INSERT SA6 A2-B1 INS1 LX1 -24 SET IDENTIFIER INDEX SA2 F.TDKI SB2 X1 SA3 X2+B2 MERGE DECK IDENTIFIER AND LINE NUMBER MX0 44 SX6 X7 BX1 X0*X3 IX6 X1+X6 SX7 B2+1S16 SET FIRST MHB RESTORED SA6 A3 SET LINE COUNTER SA7 TMHB SA6 CDID SET LINE ID SX7 B1 SET MHB COUNT = 1 SA7 A7-B1 EQ INSX RETURN DEL SPACE 4,15 ** DEL - PROCESS DELETIONS. * * ENTRY (A5) = MODIFICATION TABLE ADDRESS. * (X5) = ADDRESS OF MODIFICATION ADDRESS TABLE. * * USES ALL. DEL11 SX6 X5 SET INSERT ADDRESS BX7 X7-X7 CLEAR MODIFICATION INDICATOR SA6 MA+2 NZ X0,DELX IF MODIFICATIONS REMAIN SA7 MA+1 DEL SUBR ENTRY/EXIT SA1 L.TNCD SA2 F.TNCD SB3 B0 SB4 X1 SX7 1S16 DEL0 SA7 X2+B3 SET HIGH LINE NUMBER SB3 B3+B1 NE B3,B4,DEL0 IF NOT COMPLETE SA1 F.TDKI (B7) = TABLE DIFFERENCE IX6 X2-X1 SB7 X6 SB2 X5 BX0 X0-X0 MX5 0 SA1 A5 SET POINTER ADDRESS DEL1 ZR B2,DEL11 IF END OF MODIFICATION TABLE SA0 A1 SAVE POINTER ADDRESS SA1 B2 CHECK NEXT ENTRY SA2 B2+B1 (B4) = LAST LIMIT LINE COUNTER SB2 X1 SET NEXT INDEX MI X2,DEL1 IF ERROR FLAG SET LX1 -18 (B3) = FIRST LIMIT LINE NUMBER SB3 X1 LX1 -18 (B5) = CURRENT LINE NUMBER SA4 X1 SA3 X1+B7 (B6) = MINIMUM LINE NUMBER SB5 X4 SB6 X3 LX2 -18 GT B3,B6,DEL2 IF LAST MODIFICATION LOWER SX6 B3 SA6 A3 DEL2 LT B5,B3,DEL1 IF FIRST LIMIT NOT REACHED * PROCESS ACTIVE INSERT OR DELETE. LX1 36 SB4 X2 SX7 1S16 BX4 X7*X4 NZ X4,DEL9 IF MOD TO YANKED IDENT PL X1,DEL5 IF NOT INSERT DEL3 SA2 A1+2 CHECK TEXT STATUS AX2 24 SB4 X2 SX0 X0+B1 ZR B4,DEL4 IF NO TEXT SX5 A0 UPDATE MODIFICATON INDEX EQ DEL1 LOOP DEL4 MX7 -18 UNLINK INSERT SA1 A1 BX6 -X7*X1 SA1 A0 BX7 X7*X1 IX6 X6+X7 SB4 A0-MA-1 SA6 A0 NZ B4,DEL1 IF NOT FIRST INSERT SA6 A0-B1 EQ DEL1 LOOP * PROCESS DELETE. DEL5 LX2 -18 (B6) = CURRENT LINE NUMBER SA3 X2 SB6 X3 SX0 X0+B1 COUNT DELETION GT B6,B4,DEL8 IF CURRENT LINE BEYOND LAST LIMIT SA3 A2+B1 EXTRACT MODIFICATION SET INDEX LX3 -42 SA4 X3+B1 LX4 -24 SX6 X4 LX1 59-57 SA4 NMHB (X4) = INDEX OF LAST MHB PL X1,DEL6 IF MODIFICATION IS DELETION SX6 X6+1S16 SET RESTORE BIT DEL6 SA6 X4+TMHB STORE LAST MHB MX7 -16 CHECK PREVIOUS MHB SA3 A6-B1 BX3 -X7*X3 BX6 -X7*X6 IX2 X6-X3 ZR X2,DEL8 IF SAME IDENTIFIER MI X2,DEL7 IF PREVIOUS MODIFIER SX6 X4+1 SA6 A4+ DEL7 NE B4,B6,DEL1 IF LAST LIMIT NOT REACHED SA2 A2 CONVERT TO INSERT AT LAST LIMIT MX1 1 SX7 B2 IX2 X2+X7 BX7 X1+X2 SA7 A2-B1 EQ DEL3 LOOP * NOTE- IF (X2) = 0, ERROR IS OVERLAP. DEL8 SX7 B1+B1 SET OVERLAP ZR X2,DEL10 IF OVERLAP SX7 X7+B1 SET RANGE ERROR NE B3,B4,DEL10 IF RANGE ERROR NE B5,B6,DEL10 IF NOT SAME LINE DEL9 SX7 B0+ SET DIRECTIVE NOT REACHED DEL10 SA2 A2 ADD ERROR CODE TO WORD 2 MX1 1 BX7 X1+X7 BX7 X7+X2 SA7 A2 EQ DEL1 LOOP SCS SPACE 4,20 ** SCS - SET LINE STATUS. * * SET LINE ACTIVITY ACCORDING TO LAST MHB AND YANK * STATUS. LIST MODIFICATION TO LINE. * * ENTRY (NMHB) = MHB COUNT. * * USES X - 0, 1, 2, 3, 6, 7. * A - 1, 2, 3, 6, 7. * B - 2, 3. * * CALLS ECD. SCS SUBR ENTRY/EXIT SA1 NMHB (B2) = MHB COUNT SA2 F.TDKI (B3) = FWA DECK IDENTIFIER TABLE MX0 -16 MHB INDEX MASK SB2 X1 SB3 X2 BX7 X7-X7 CLEAR STATUS SA2 A1+B1 FIRST MHB BX3 -X0*X2 ZR X3,SCS1 IF ORIGINAL LINE SA2 CC+2 ADVANCE INSERTED LINE COUNT SX6 X2+B1 SA6 A2 SCS1 SA1 A1+B1 NEXT MHB BX3 -X0*X1 SET MODIFIER INDEX SB2 B2-B1 COUNT MHB SA2 X3+B3 LX2 59-16 CHECK YANK MI X2,SCS2 IF MODIFIER YANKED BX7 X1 STATUS = MHB STATUS SCS2 NZ B2,SCS1 IF NOT END OF MHB,S SA3 CDAC COMPARE STATUS LX7 59-16 BX6 X7-X3 SA7 A3 SET NEW STATUS SX1 B1 LX7 1 BX2 X1*X7 SA3 CC+X2 COUNT LINE SX7 X3+B1 SA7 A3 PL X6,SCSX IF UNCHANGED - RETURN LISTOP M,SCSX IF NO LIST FOR MODIFICATION - RETURN RJ ECD EXPAND LINE SA3 CDAC CHECK STATUS SX6 1RA SX7 1R MI X3,SCS3 IF ACTIVE SX6 1R SX7 1RD SCS3 SA6 CHSP+5 SA7 A6+1 SA6 CL+1 EQ SCSX RETURN SNC SPACE 4,10 ** SNC - SET NEXT LINES. * * USES X - 1, 2, 3, 4, 6, 7. * A - 0, 1, 2, 3, 4, 6. * B - 2, 3, 4, 6, 7. SNC SUBR ENTRY/EXIT SA1 L.TNCD SA2 F.TNCD SB3 B0 SB4 X1 SX7 1S16 SX2 X2+ SB2 2 SNC1 SA7 X2+B3 SET HIGH LINE NUMBER SB3 B3+B1 NE B3,B4,SNC1 IF END OF TABLE NOT REACHED SA1 MA SA4 F.TDKI (B7) = TABLE DIFFERENCE SB2 X1+ IX6 X2-X4 SB7 X6 SNC2 ZR B2,SNCX IF END OF MODIFICATION TABLE - RETURN SA0 A1 SAVE POINTER ADDRESS SA1 B2 CHECK NEXT ENTRY SA4 B2+B1 SB2 X1 SET NEXT ENTRY LX1 -18 (B3) = FIRST LIMIT LINE NUMBER SB3 X1 LX1 -18 (B6) = MINIMUM LINE NUMBER MI X4,SNC2 IF ERROR FLAG SET SA3 X1+B7 SB6 X3+ GT B3,B6,SNC3 IF LAST MODIFICATION LOWER SX6 B3+ UPDATE MINIMUM LINE NUMBER SA6 A3+ SNC3 NZ B3,SNC2 IF FIRST LIMIT NOT REACHED * PROCESS ACTIVE INSERT OR DELETE. LX1 36 PL X1,SNC2 IF NOT INSERT SA2 A1+2 AX2 24 SB4 X2 ZR B4,SNC4 IF NO TEXT SX6 A0+ SA6 MA+2 EQ SNC2 LOOP SNC4 MX7 -18 UNLINK INSERT SA1 A1 BX6 -X7*X1 SA1 A0 BX7 X7*X1 IX6 X6+X7 SA6 A0+ EQ SNC2 LOOP TITLE WRITE COMPILE FILE PROCESSORS. ** WRC - WRITE LINE. * * WRITE LINE TO NEW PROGRAM LIBRARY, SOURCE, COMPILE, AND * LIST OUTPUT AS REQUIRED. * *WRC* WILL CALL *WCC* IF A COMPRESSED COMPILE FILE IS TO * BE WRITTEN. FOR NON-COMPRESSED COMPILE FILE GENERATION * *WCF* WILL BE CALLED. * * USES X - 1, 2. * A - 1, 2. * * CALLS WCC, WNF, WSC. WRC2 RJ WSC WRITE STANDARD COMPILE FILE WRC SUBR ENTRY/EXIT SA1 N SA2 M BX1 X1+X2 ZR X1,WRC1 IF NO NEW PROGRAM LIBRARY RJ WNF WRITE NEW PROGRAM LIBRARY WRC1 SA1 AM SA2 CD ZR X1,WRC2 IF NOT *A* MODE NZ X2,WRCX IF COMMON DECK - RETURN RJ WCC WRITE COMPRESSED COMPILE FILE EQ WRCX RETURN WCC SPACE 4,10 ** WCC - WRITE COMPRESSED COMPILE FILE. * * ENTRY (PCC) = PREFIX CHARACTER. * (CDTX) = FIRST WORD OF LINE TEXT. * * EXIT (X1) = 0, IF COMMENT LINE AND COMMENTS NOT NEEDED. * COMPRESSED LINE WRITTEN TO COMPILE FILE. * IF SUSPECTED COMPILE FILE DIRECTIVE ENCOUNTERED * *WSC* WILL BE CALLED TO PROCESS THE INTERESTING LINE. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3. * * CALLS WSC, WTW=. WCC2 SA1 CMNF CHECK FOR COMMENTS NEEDED ZR X1,WCCX IF NO COMMENTS NEEDED * WRITE LINE TO COMPILE FILE. WCC3 SA2 IFIP *IF CONDITION FLAG MI X2,WCC4 IF INACTIVE SEQUENCE IN PROGRESS SA2 CSC GET CHARACTER SET OF COMDECK SA1 SETC CHECK FOR *CSET NG X1,WCC3.1 IF NO *CSET NZ X1,WCC3.1 IF *CSET,ASCII ZR X2,WCC3.1 IF DISPLAY COMMON DECK AND *CSET DISPLAY RJ ECD EXPAND AND CONVERT ASCII LINE RJ RCL RE-COMPRESS CONVERTED LINE WCC3.1 SA1 CDWC WRITE IDENTIFICATION + COMPRESSED LINE WRITEW C,A1+B1,X1+B1 SA1 NC ADVANCE LINE COUNT SX2 B1 IX6 X1+X2 SA6 A1+ WCC4 SX1 B1+ SET NOT COMMENT LINE FLAG WCC SUBR ENTRY/EXIT SA1 CDAC CHECK LINE ACTIVITY SA2 C CHECK FOR COMPILE FILE BEING WRITTEN PL X1,WCCX IF LINE NOT ACTIVE ZR X2,WCCX IF NO COMPILE FILE BEING WRITTEN SA1 CDTX FIRST WORD OF COMPRESSED LINE SA4 WCCA COMPILE FILE PREFIX CHARACTER BX3 X1-X4 COMPARE FIRST CHARACTER AGAINST PREFIX AX3 54 NZ X3,WCC3 IF NOT COMMENT LINE NG X3,WCC3 IF NOT COMMENT LINE MX0 -12 * CHECK FOR SUSPECTED COMPILE FILE DIRECTIVES. SA2 CD CHECK FOR COMMON DECK ZR X2,WCC1 IF NOT COMMON DECK SA4 WCCB BEGIN SEARCH AFTER CALLS FOR COMMON DECKS WCC1 BX3 X4-X1 COMPARE DATA BX2 -X0*X4 ZR X4,WCC2 IF AT END OF DIRECTIVES AND COMMENT LINE SB2 X2+ AX3 X3,B2 SA4 A4+B1 NZ X3,WCC1 IF NO MATCH - LOOP FOR NEXT DIRECTIVE RJ WSC WRITE COMPILE FILE SX1 B1 EQ WCCX RETURN WCCA BSS 0 DECK TABLE FWA VFD 6/0,42/0LCALL,12/5*6 *CALL VFD 6/0,42/0LCALLC,12/4*6 *CALLC VFD 6/0,42/0LCALLALL,12/2*6 *CALLALL VFD 6/0,42/0LIFCALL,12/3*6 *IFCALL VFD 6/0,42/0LNIFCALL,12/2*6 *NIFCALL WCCB BSS 0 COMMON DECK/DECK TABLE FWA VFD 6/0,42/0LCOMMENT,12/2*6 *COMMENT VFD 6/0,42/0LCSET,12/5*6 *CSET VFD 6/0,42/0LCWEOR,12/4*6 *CWEOR VFD 6/0,42/0LDEFINE,12/3*6 *DEFINE VFD 6/0,42/0LELSE,12/5*6 *ELSE VFD 6/0,42/0LENDIF,12/4*6 *ENDIF VFD 6/0,42/0LIF,12/7*6 *IF VFD 6/0,42/0LNOSEQ,12/4*6 *NOSEQ VFD 6/0,42/0LSEQ,12/6*6 *SEQ VFD 6/0,42/0LWEOF,12/5*6 *WEOF VFD 6/0,42/0LWEOR,12/5*6 *WEOR VFD 6/0,42/0LWIDTH,12/4*6 *WIDTH CON 0 TABLE TERMINATOR WCF SPACE 4,10 ** WCF - WRITE COMPILE FILE. * * ENTRY (CHAR) = FWA OF CHARACTER STRING BUFFER. * * USES X - 1, 2, 6. * A - 1, 2, 6. * * CALLS LCS. WCFX LISTOP W,WCF IF NO LIST FOR DIRECTIVE RJ LCS LIST LINE STATUS WCF PS 0 ENTRY/EXIT * PROCESS POSSIBLE *IF CONDITION ALTERATION. CARD ELSE CARD ENDIF * PROCESS ALL OTHER POSSIBLE COMPILE FILE DIRECTIVES. WCF1 SA1 IFIP CHECK *IF CONDITION MI X1,WCF IF INACTIVE SEQUENCE IN PROGRESS CARD COMMENT CARD CWEOR CARD DEFINE CARD IF,IFX CARD NOSEQ,NSQ CARD SEQ CARD WEOF CARD WEOR CARD WIDTH,WDH WCF2 SA2 NS+1 SA1 AM NZ X1,WCF5 IF *A* MODE * *WCF3* AND *WCF4* ENTERED FROM *COMMENT DIRECTIVE PROCESSOR. WCF3 SA1 SC+1 NZ X2,WCF4 IF NO SEQUENCE NUMBERS SX1 X1+14 WCF4 WRITEK C,CHAR,X1 WRITE LINE TO COMPILE EQ WCF6 * WRITE COMPRESSED LINE. WCF5 WRITEW C,CDID,1 WRITE IDENTIFICATION WRITEC X2,CDTX WRITE COMPRESSED LINE WCF6 SA1 NC ADVANCE LINE COUNT SX2 B1 IX6 X1+X2 SA6 A1 EQ WCF RETURN WSC SPACE 4,10 ** WSC - WRITE STANDARD COMPILE FILE. * * ENTRY (C) = COMPILE FILE NAME. * (S) = SOURCE FILE NAME. * (CD) = COMMON DECK FLAG. * (CDAC) = LINE ACTIVITY FLAG. * * EXIT COMPILE FILE WRITTEN AS NEEDED. * * USES X - 1, 2, 6. * A - 1, 2, 6. * * CALLS CKC, ECD, WCF. WSC4 LISTOP I,WSCX IF NO LIST FOR INACTIVE LINE - RETURN SX6 1RI WSC5 SA6 CHSP+4 SET ACTIVITY INDICATOR SA6 CL+1 SET LIST REQUESTED FLAG WSC SUBR ENTRY/EXIT RJ ECD EXPAND LINE SA1 CDAC SA2 S PL X1,WSC3 IF LINE NOT ACTIVE ZR X2,WSC2 IF NO SOURCE FILE SA1 SC+1 WRITE SOURCE SA2 SS ZR X2,WSC1 IF NO SEQUENCE NUMBERS SX1 X1+14 WSC1 WRITEK S,CHAR,X1 WSC2 SA1 C CHECK FOR COMPILE FILE BEING WRITTEN SA2 CD COMMON DECK FLAG ZR X1,WSC3 IF NO COMPILE FILE NZ X2,WSC3 IF COMMON DECK * CHECK FOR COMMON DECK CALL DIRECTIVES. CARD CALL *CALL CARD CALLC *CALLC CARD CALLALL *CALLALL CARD CSET CARD IFCALL *IFCALL CARD NIFCALL *NIFCALL RJ WCF WRITE COMPILE FILE WSC3 SA1 CDAC CHECK LINE ACTIVITY PL X1,WSC4 IF LINE INACTIVE SX6 1RA LISTOP A,WSC5,MI IF LIST FOR ACTIVE LINE SELECTED EQ WSCX RETURN TITLE COMPILE FILE DIRECTIVE PROCESSORS. *** COMPILE FILE CONTROL DIRECTIVES. * * THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE. * THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY * OR RESULT FROM INSERTION. CALL SPACE 4,10 *** CALL DNAME * * PLACE A COPY OF DECK *DNAME* ON COMPILE FILE. CALL SA1 IFIP CHECK FOR INACTIVE SEQUENCE IN PROGRESS MI X1,WRCX IF INACTIVE SEQUENCE IN PROGRESS RECALL M RJ ASN ASSEMBLE NAME RJ WCD WRITE COMMON DECK EQ WRCX RETURN CALLC SPACE 4,10 *** CALLC DNAME * * PLACE A COPY OF DECK *DNAME* ON COMPILE FILE, IF IT HAS NOT * ALREADY BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE * FILE DIRECTIVE. CALLC SA1 IFIP CHECK FOR INACTIVE SEQUENCE IN PROGRESS NG X1,WRCX IF INACTIVE SEQUENCE IN PROGRESS RECALL M RJ ASN ASSEMBLE NAME SEARCH TCCD,X6 SEARCH TABLE OF PREVIOUSLY CALLED DECKS NZ X2,WRCX IF FOUND - RETURN RJ WCD WRITE COMMON DECK EQ WRCX RETURN CALLALL SPACE 4,10 *** CALLALL STRING * * PLACE COPY OF EACH COMMON DECK WITH LEADING CHARACTERS = * STRING. CALLALL SA1 CH SAVE FIRST CHARACTER ADDRESS SA2 IFIP CHECK INACTIVE SEQUENCE SX6 X1+B1 MI X2,WRCX IF INACTIVE SEQUENCE IN PROGRESS SA6 CLAA RJ ASN ASSEMBLE NAME SA1 CH SA2 CLAA MX4 6 FORM NAME MASK IX5 X1-X2 LX5 1 SB3 X5 LX5 1 SB3 B3+X5 AX7 X4,B3 BX3 X6 SA6 CLAA STORE STRING SA7 A6+B1 STORE MASK LX4 X7 SB2 B1+B1 BX2 X2-X2 SA1 L.TDKN CLA1 IX6 X1-X2 ZR X6,WRCX IF END OF DECK NAMES - RETURN SB3 X2 SA5 F.TDKN CHECK NAME SX2 X2+B2 ADVANCE DECK NAME INDEX SA5 X5+B3 BX6 X4*X5 IX7 X6-X3 NZ X7,CLA1 IF NO MATCH SX6 X5-7 NZ X6,CLA1 IF NOT COMMON DECK LX5 59-16 MI X5,CLA1 IF DECK NOT ACTIVE LX5 17 MX0 42 MASK NAME SX7 X2+ SAVE INDEX BX6 X0*X5 SA7 CLAA+2 RJ WCD WRITE COMMON DECK SA3 CLAA RESTORE STRING SA4 A3+B1 RESTORE MASK SA2 A4+B1 RESTORE INDEX SB2 2 SA1 L.TDKN EQ CLA1 LOOP CLAA CON 0 CON 0 CON 0 COMMENT SPACE 4,10 *** COMMENT CCC-CCC * * PLACE COMMENT CCC-CCC IN COMPILE FILE IN FOLLOWING FORMAT - * COMMENT CRDATE MODDATE CCC-CCC * 1 2 3 * 2 1 1 1 * WHERE CRDATE = CREATION DATE * MODDATE = LAST MODIFICATION DATE COMMENT SA1 SC+1 SET SEQUENCE NUMBER COLUMN SA2 CHAR+X1 PRESET (A6) BX6 X2 SA3 CH SET FIRST CHARACTER SA6 A2 SB2 A2-B1 SET LAST COLUMN OF COMMENT SB3 X3 SET FIRST COLUMN OF COMMENT GE B3,B2,CMT2 IF COMMENT EMPTY SB4 B2-CHAR-30 SET WORD COUNT FOR COMMENT MI B4,CMT2 IF NO ROOM FOR COMMENT SA2 B3+B4 UNPACK COMMENT CMT1 BX6 X2 SA6 A6-B1 SB4 B4-B1 SA2 A2-B1 PL B4,CMT1 IF NOT COMPLETE CMT2 SB3 CHAR ENTER COMMENT PSEUDO SA1 =9L COMMENT RJ UPN UNPACK NAME SA1 TIDT+2 ENTER CREATION DATE RJ UPN UNPACK NAME SA1 TIDT+3 CHECK MODIFICATION DATE NZ X1,CMT3 IF DECK MODIFIED SA1 =1H CMT3 RJ UPN UNPACK NAME SX6 1R SA6 B3+ SA1 AM NZ X1,CMT4 IF *A* MODE SA2 NS+1 EQ WCF3 * WRITE COMPRESSED LINE IDENTIFICATION. CMT4 WRITEW C,CDID,1 WRITE IDENTIFICATION SA1 SC+1 EQ WCF4 CSET SPACE 4,10 *** CSET DNAME * * DECLARE CHARACTER SET TO BE USED IN PROCESSING * CALLED COMMON DECKS. CSET RJ ASN ASSEMBLE NAME OF *CSET* MX3 42 SA1 TCST-1 FWA-1 OF CHARACTER SET TABLE CSET1 SA1 A1+B1 ZR X1,CSET2 IF UNKNOWN CHARACTER SET BX4 X3*X1 BX7 X6-X4 NZ X7,CSET1 IF NO MATCH BX7 -X3*X1 SA7 SETC SET NEW CHARACTER SET EQ WRCX RETURN CSET2 SA0 =C/ CSET - UNKNOWN CHARACTER SET./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ WRCX RETURN CWEOR SPACE 4,10 *** CWEOR * * WRITE END OF RECORD ON COMPILE FILE IF BUFFER IS NOT EMPTY. CWEOR RECALL C SA1 NC CHECK LINE COUNT ZR X1,WRCX IF NO LINES WRITTEN THIS RECORD - RETURN EQ WEOR DEFINE SPACE 4,10 *** DEFINE NAME,VALUE * * SET THE VALUE OF *NAME* TO *VALUE*. IF *VALUE* IS * NOT PRESENT A VALUE OF ZERO IS ASSUMED. * * DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*, * *ENDIF* AND *IFCALL* DIRECTIVES. * * WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN * PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE * FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*. DEFINE RJ ASN ASSEMBLE NAME BX5 X6 SAVE NAME SX7 X7+B1 ADVANE BEYOND SEPARATOR SA7 A1+ RJ ASD ASSEMBLE VALUE BX0 X7 SAVE VALUE * CHECK FOR VALUE IN RANGE. AX7 16 ZR X7,DEF1 IF VALUE WITHIN RANGE SA0 =C/ VALUE ERROR./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ WCF RETURN * SEARCH FOR SYMBOL. DEF1 SEARCH TDEF,X5 SEARCH FOR PREVIOUSLY DEFINED SYMBOL NZ X2,DEF2 IF PREVIOUSLY DEFINED ADDWRD A0,X5 ADD SYMBOL TO TABLE SA2 A6+ SET VALUE * ENTER SYMBOL VALUE INTO DEFINITION. DEF2 LX2 59-17 MI X2,WCFX IF DEFINED ON INPUT LX2 17-59 REPOSITION SYMBOL MX1 42 BX2 X1*X2 CLEAR PREVIOUS VALUE DEFINITION BX6 X2+X0 SYMBOL + VALUE SA6 A2 SET IN TABLE EQ WCFX RETURN ELSE SPACE 4,10 *** ELSE * * REVERSE MODIFICATION EFFECTS OF PREVIOUS *IF. ELSE SA1 IFIP CHECK FOR *IF IN PROGRESS ZR X1,ELS1 IF NO *IF IN PROGRESS BX6 -X1 REVERSE PREVIOUS *IF CONDITION SA6 A1 EQ WCFX ELS1 SA0 =C/ NO *IF IN PROGRESS./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ WCF RETURN ENDIF SPACE 4,10 *** ENDIF * * TERMINATE *IF RANGE. ENDIF SA1 IFIP CHECK FOR *IF IN PROGRESS ZR X1,EIF1 IF NO *IF IN PROGRESS BX6 X6-X6 CLEAR *IF IN PROGRESS FLAG SA6 A1 EQ WCFX RETURN EIF1 SA0 =C/ NO *IF IN PROGRESS./ RJ LCE LIST COMPILE FILE ERROR MESSAGE EQ WCF RETURN IFX SPACE 4,10 *** IF ATR,NAME,VALUE * * *ATR* MAY ASSUME ONE OF THE FOLLOWING VALUES. * * DEF SYMBOL REFERENCED BY ATTRIBUTE DEFINED. * UNDEF SYMBOL REFERENCED BY ATTRIBUTE UNDEFINED. * EQ SYMBOL REFERENCED BY ATTRIBUTE EQUAL TO *VALUE*. * NE SYMBOL REFERENCED BY ATTRIBUTE NOT EQUAL TO *VALUE*. * * IF THE CONDITION SPECIFIED BY THE ATTRIBUTE EXPRESSION * IS TRUE, AN ACTIVE *IF RANGE WILL BE INITIATED. * * IF THE CONDITION IS FALSE THEN ALL LINES NORMALLY * WRITTEN TO THE COMPILE FILE AND COMPILE FILE DIRECTIVES * WILL BE TREATED AS INACTIVE FOR THE CURRENT MODIFICATION * RUN. * * LINES WILL BE SKIPPED UNTIL THE OCCURENCE OF AN *ELSE OR * *ENDIF COMPILE FILE DIRECTIVE. IFX RJ ASN ASSEMBLE ATTRIBUTE SX7 X7+B1 SKIP SEPARATOR SA6 IFXA SAVE ATTRIBUTE SA7 A1 RJ ASN ASSEMBLE SYMBOL NAME SX7 X7+B1 SA6 A6+B1 SAVE SYMBOL NAME SA7 A1+ RJ ASD ASSEMBLE SYMBOL VALUE * CHECK FOR VALUE SPECIFICATION IN RANGE. BX3 X7 AX7 16 SA0 =C/ VALUE ERROR./ NZ X7,IFX6 IF VALUE ERROR. * PROCESS SPECIFICATION. SA1 IFIP CHECK *IF IN PROGRESS FLAG SA0 =C/ RECURSIVE *IF-S INCORRECT./ NZ X1,IFX6 IF *IF ALREADY IN PROGRESS SA2 IFXA ATTRIBUTE SA4 A2+B1 SYMBOLIC NAME SA0 =C/ INCORRECT ATTRIBUTE./ ZR X2,IFX6 IF NO ATTRIBUTE MX0 36 SA5 IFXB-1 FWA - 1 OF ATTRIBUTE TABLE * SEARCH FOR ATTRIBUTE. IFX1 SA5 A5+1 ADVANCE TO NEXT ENTRY BX7 X0*X5 BX6 X7-X2 COMPARE SYMBOL ZR X5,IFX6 IF AT END OF ATTRIBUTE TABLE NZ X6,IFX1 IF NO MATCH SX2 X5 VALUE MASKING EXPRESSION LX5 59-18 ATTRIBUTE TEST TYPE FLAG * SEARCH FOR SYMBOL AND DETERMINE ACTION. SEARCH TDEF,X3+X4,X2 MI X5,IFX2 IF NEGATIVE ATTRIBUTE TEST EQ IFX3 POSITIVE ATTRIBUTE TEST * PROCESS NEGATIVE ATTRIBUTE EXPRESSIONS. IFX2 ZR X2,IFX4 IF *IF EXPRESSION TRUE EQ IFX5 *IF EXPRESSION FALSE * PROCESS POSITIVE ATTRIBUTE EXPRESSIONS. IFX3 ZR X2,IFX5 IF *IF EXPRESSION FLASE EQ IFX4 *IF EXPRESSION TRUE * EXPRESSION TRUE. IFX4 SX6 B1 SET TRUE *IF EXPRESSION TEST FALG SA6 A1 EQ WCFX RETURN * EXPRESSION FLASE. IFX5 SX6 -B1 SET FALSE *IF EXPRESSION TEST SA6 A1 EQ WCFX RETURN IFX6 RJ LCE LIST COMPILE FILE DIRECTIVE ERROR MESSAGE EQ WCF RETURN IFXA CON 0 ATTRIBUTE TEMPORARY CON 0 SYMBOL TEMPORARY IFXB BSS 0 TABLE OF ATTRIBUTES VFD 36/0LDEF,6/0,18/0 DEFINED TEST VFD 36/0LUNDEF,6/1,18/0 UNDEFINED TEST VFD 36/0LEQ,6/0,18/377777B EQUAL TEST VFD 36/0LNE,6/1,18/377777B NOT EQUAL TEST CON 0 IFCALL SPACE 4,10 *** IFCALL NAME,DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF * *NAME* IS DEFINED. IFCALL RJ ASN ASSEMBLE NAME SEARCH TDEF,X6 SEARCH FOR NAME ZR X2,WRCX IF NOT FOUND - RETURN SX7 X7+B1 SKIP SEPARATOR SA7 CH EQ CALL PROCESS AS *CALL NIFCALL SPACE 4,10 *** NIFCALL NAME,DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF * *NAME* IS NOT DEFINED. NIFCALL RJ ASN ASSEMBLE NAME SEARCH TDEF,X6 SEARCH FOR NAME NZ X2,WRCX IF FOUND - RETURN SX7 X7+B1 SKIP SEPARATOR SA7 CH EQ CALL PROCESS AS *CALL NOSEQ SPACE 4,10 *** NOSEQ * * REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE. NSQ SX6 B1+ SET NO SEQUENCE NUMBER FLAG SA6 NS+1 EQ WCFX LIST LINE SEQ SPACE 4,8 *** SEQ * * REQUEST SEQUENCE NUMBERS ON COMPILE FILE. SEQ SX6 B0+ CLEAR NO SEQUENCE NUMBER FLAG SA6 NS+1 EQ WCFX LIST LINE WIDTH SPACE 4,10 *** WIDTH N * * SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*. WDH RJ ASD ASSEMBLE COLUMN NUMBER SB2 X7-IWMACS-1 MI B2,WDH1 IF IN RANGE SA0 =C/ COLUMN NUMBER OUT OF RANGE./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR MESSAGE EQ WCF RETURN * PROCESS WIDTH DIRECTIVE. WDH1 SA1 SC+1 READ CURRENT SEQUENCE NUMBER COLUMN SB2 X1+CHAR SB3 X7+CHAR EQ B2,B3,WCFX IF NEW WIDTH = CURRENT WIDTH - LIST LINE SA7 A1 UPDATE WIDTH SB5 B0 SB4 16 GT B2,B3,WDH4 IF DECREASE IN WIDTH * PROCESS INCREASE IN WIDTH. WDH2 SA1 B2+B4 MOVE SEQUENCE FIELD UP BX6 X1 SA6 B3+B4 SB4 B4-B1 PL B4,WDH2 IF MOVE NOT COMPLETE SX6 1R WDH3 SA6 A6-B1 BLANK FILL LINE SB3 B3-B1 NE B2,B3,WDH3 IF NOT AT END OF LINE EQ WCFX LIST LINE * PROCESS DECREASE IN WIDTH. WDH4 SA1 B2+B5 MOVE SEQUENCE FIELD DOWN BX6 X1 SA6 B3+B5 SB5 B5+B1 NE B4,B5,WDH4 IF MOVE NOT COMPLETE SX6 1R BLANK FILL REMAINDER OF BUFFER WDH5 SA6 B3+B5 SB3 B3+B1 NE B2,B3,WDH5 IF NOT COMPLETE EQ WCFX LIST LINE WEOF SPACE 4,10 *** WEOF * * WRITE END OF FILE ON *COMPILE* FILE. WEOF WRITEF C,R WEF1 SA1 NC PROPAGATE TOTAL LINE COUNT SA2 A1+B1 BX6 X6-X6 CLEAR LINE COUNT THIS RECORD IX7 X1+X2 SA6 A1 SA7 A2+ SA1 AM ZR X1,WCFX IF NOT *A* MODE WRITEW C,CIDT,1 WRITE COMPILE FILE *A* MODE FLAG EQ WCFX LIST LINE WEOR SPACE 4,10 *** WEOR N * * WRITE END OF RECORD (LEVEL N) ON COMPILE FILE. * IF N = 15 THIS IS THE SAME AS A WEOF DIRECTIVE. * ANY OTHER VALUE WRITES AN END OF RECORD. WEOR RJ ASD ASSEMBLE LEVEL NUMBER SB2 X7-17B ZR B2,WEOF IF EOR LEVEL 17 PROCESS AS *WEOF* WRITER C,R EQ WEF1 WCD TITLE COMMON DECK PROCESSOR. WCD SPACE 4,20 ** WCD - WRITE COMMON DECK. * * DECK WRITTEN FROM EITHER MEMORY, NEW PROGRAM LIBRARY, * OR PROGRAM LIBRARY. * * ENTRY (X6) = DECK NAME, ELSE ZERO IF DECK NAME NOT CORRECT. * * USES ALL. * * CALLS DNL, ECD, INL, LCE, LCS, PCS, PCW, RPF, WCC, WCF. WCD14 LISTOP E,WCD15 IF NO ERROR LIST BX7 X7-X7 SA7 CL CLEAR LINE LISTED STATUS SA0 =C/ UNKNOWN DECK./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR WCD15 RJ DNL DECREMENT COMMON DECK NESTING LEVEL NZ X6,WCD0.1 IF STACK NOT EMPTY SA6 CD SA6 WCDE CLEAR NESTING COMMON DECK NAME SA1 WCDF BX7 X1 SA7 CSC RESTORE CHARACTER SET OF CALLING DECK WCD SUBR ENTRY/EXIT SA1 CSC GET CHARACTER SET OF CALLING DECK BX7 X1 SA7 WCDF SAVE IT NZ X6,WCD0 IF NAME IS OK BX7 X7-X7 SA7 CL CLEAR LINE LISTED STATUS SA0 =C/ UNKNOWN DECK./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ WCDX RETURN AFTER ERROR WCD0 RJ INL INCREMENT COMMON DECK NESTING LEVEL WCD0.1 SA1 L.TCDK ZR X1,WCD4 IF NO DECKS IN MEMORY * CHECK DECKS IN MEMORY. SA2 F.TCDK MX0 42 SB3 X1 SB2 B0+ WCD1 EQ B2,B3,WCD4 IF END OF DECKS SA3 X2+B2 CHECK NAME BX7 X0*X3 SB2 X3+B2 IX4 X7-X6 NZ X4,WCD1 IF NO MATCH SX6 X3 EXTRACT LENGTH OF TCDK COMMON DECK SA3 A3+B1 SET CHARACTER SET OF COMMON DECK BX7 X3 SA7 CSC SX7 A3+1 SET START SA6 WCDC SAVE DECK LENGTH SA7 WCDD SAVE DECK START POSITION LISTOP W,WCD1.1 IF NO LIST SET FOR DIRECTIVE RJ LCS LIST LINE STATUS * COPY DECK FROM MEMORY. WCD1.1 SX6 B1+ SET COMMON DECK FLAG SA6 CD WCD2 SA1 WCDC RESET LENGTH OF DECK SA4 A1+B1 ERRNZ WCDD-WCDC-1 CODE ASSUMES VALUE SB2 X1 ZR B2,WCD15 IF END OF COPY - RETURN SA1 X4 STORE IDENTIFICATION SA2 A1+B1 START MOVE BX6 X1 SA6 CDID MX0 48 WCD3 LX6 X2 SA6 A6+B1 BX3 -X0*X2 SA2 A2+B1 SB2 B2-B1 NZ X3,WCD3 IF NOT AT END OF LINE SX7 A2 UPDATE START OF NEXT LINE SX6 A6-CDID WORD COUNT OF COMPRESSED LINE SA6 CDWC SET WORD COUNT OF COMPRESSED LINE SX6 B2-1 SET WORD COUNT SA7 WCDD SA6 A7-1 RJ PCW WRITE COMPILE FILE ZR X6,WCD2 IF SAME NESTING LEVEL EQ WCD0 ENTER NEXT NESTING LEVEL * SEARCH DECK NAME TABLES. WCD4 BX0 X6 SAVE DECK NAME RECALL M SX3 7 SEARCH FOR DECK IN NEW DECKS SEARCH TECD,X0+X3,377777B NZ X2,WCD5 IF FOUND SX3 7 SEARCH FOR DECK IN OLD DECKS SEARCH TDKN,X0+X3,377777B ZR X2,WCD14 IF COMMON DECK NOT FOUND * INITIALIZE COMMON DECK READ FROM PROGRAM LIBRARY. WCD5 SA2 A2+1 BX6 X2 AX2 36 SET FILE NAME SA1 X2 BX7 X1 SA6 M+6 SA7 M SA2 A7+B1 GET *FIRST* SX6 X2 SA6 A2+B1 SA6 A6+B1 SET BUFFER EMPTY SA2 CL+1 NZ X2,WCD6 IF LINE SHOULD BE LISTED LISTOP W,WCD7 IF NO LIST FOR DIRECTIVE WCD6 RJ LCS LIST LINE STATUS WCD7 RECALL P READ M BEGIN READ READW M,BUF,TIDTL READ IDENT TABLE SX6 B1+ SA6 CD INDICATE COMMON DECK SB5 BUF FWA OF IDENT TABLE RJ PCS PROCESS OPL CHARACTER SET READW M,T1,1 READ MODIFIER TABLE WORD SA5 L.TDKI SAVE CURENT IDENTIFIER TABLE LENGTH SA1 T1 AUGMENT IDENTIFIER TABLE + ZR X1,* ALLOC TDKI,X1+B1 BX6 X2 SAVE CURRENT FWA LX7 X5 SA6 WCDB SA7 A6+B1 IX6 X2+X5 SET TEMPORARY FWA SA4 BUF+1 SET DECK NAME SA1 T1 SX2 B1 BX7 X4+X2 SX1 X1 SA6 F.TDKI SA7 X6 SX7 X7+1 ADD WORD FOR CHARACTER SET INDICATOR SA7 WCDD SET POINTER WORD ZR X1,WCD8 IF NO MODIFIERS READW M,X6+B1,X1 READ MODIFIERS WCD8 SA3 L.TCDK SET COMMON DECK LENGTH BX6 X3 SA6 WCDC ALLOC TCDK,2 ALLOCATE FOR POINTER AND CHARACTER SET ZR X3,WCD11.1 IF NO ROOM SA1 CSC SET CHARACTER SET INDICATOR IN TCDK SA3 L.TCDK BX7 X1 SA2 F.TCDK SB2 X3-1 SA7 X2+B2 * COPY COMMON DECK TO COMPILE FILE. WCD9 SA0 M FET ADDRESS RJ RPF READ PROGRAM FILE NZ X1,WCD13 IF EOR SA1 CDAC PL X1,WCD9 IF LINE INACTIVE RJ PCW WRITE COMPILE FILE SA6 WCDE SAVE NAME OF COMMON DECK NZ X6,WCD12 IF NEXT NESTING LEVEL ZR X1,WCD9 IF COMMENT OR NOT SAVING IN MEMORY * SAVE COMMON DECK IN MEMORY IF POSSIBLE. SA1 WCDD SA5 CDWC ZR X1,WCD9 IF NO ROOM FOR COMMON DECK ALLOC TCDK,X5+B1 ALLOCATE FOR TEXT ZR X3,WCD12 IF NO ROOM IX7 X3-X5 SET FWA SB2 X5+B1 SB3 X7-1 SA1 CDID WCD11 BX6 X1 SA6 X2+B3 X2 = FWA OF TABLE SB2 B2-B1 SA1 A1+B1 SB3 B3+B1 NZ B2,WCD11 IF MORE TEXT REMAINS SX5 X5+B1 ADVANCE LENGTH SA1 WCDD IX6 X1+X5 SA6 A1 EQ WCD9 READ NEXT LINE WCD11.1 MX6 0 SA6 WCDE CLEAR COMMON DECK NAME WCD12 SA1 WCDC RESET OLD LENGTH SX6 X1 BX7 X7-X7 CLEAR POINTER WORD SA6 L.TCDK SA7 WCDD SA2 F.TCDK RESET END OF TABLE IX6 X2+X1 SA6 A2+B1 SA1 WCDE ZR X1,WCD9 IF SAME NESTING LEVEL, READ NEXT LINE * RESET ALL CONDITIONS. WCD13 RECALL P SA2 WCDB RESET DECK IDENTIFIER FWA BX6 X6-X6 CLEAR SCRATCH FILE SA3 A2+B1 RESET LENGTH SA6 M SA4 P+6 RESET FILE BX6 X2 LX7 X3 SA6 F.TDKI SA7 L.TDKI MX1 30 RESET FILE POSITION BX2 X1*X4 SA3 WCDD GET POINTER WORD AX4 30 IX6 X2+X4 SA1 A3-B1 LAST LENGTH SA6 A4 SA2 L.TCDK ZR X2,WCD13.1 IF *TCDK* EMPTY SA2 F.TCDK BX6 X3 SB2 X1+ SA6 X2+B2 WCD13.1 SA3 WCDE ZR X3,WCD15 IF NESTING STACK IS EMPTY, RETURN BX6 X3 EQ WCD0 ENTER NEXT NESTING LEVEL WCDB CON 0 FWA OF DECK IDENTIFIER TABLE CON 0 LENGTH OF DECK IDENTIFIER TABLE WCDC CON 0 LAST COMMON DECK LENGTH WCDD CON 0 NEW POINTER WORD WCDE CON 0 COMMON DECK NAME OF NEXT NESTING LEVEL WCDF CON 0 SAVE CHARACTER SET OF CALLING DECK ABT TITLE SUBROUTINES. ABT SPACE 4,10 ** ABT - ABORT MODIFY. * * ENTRY (X0) = ADDRESS OF ERROR MESSAGE. * * CALLS CMF. ABT RJ CMF COMPLETE FILES ABT1 MESSAGE A0 SEND ERROR MESSAGE ABORT ADW SPACE 4,20 ** ADW - ADD ENTRY TO A TABLE. * * ENTRY (A0) = TABLE POINTER ADDRESS. * (X1) = TABLE ENTRY TO ADD. * * EXIT (X6) = TABLE ENTRY. * (A6) = ADDRESS OF TABLE ENTRY. * (X3) = INDEX OF TABLE ENTRY. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - 2. * * CALLS ATS. ADW1 BX6 X1 ENTER WORD SX7 X3+B1 ADVANCE LENGTH SA6 X2+B2 SA7 A3 ADW SUBR ENTRY/EXIT SA2 FTAB+A0 CHECK TABLE ROOM SA3 LTAB+A0 SA4 A2+B1 IX6 X2+X3 SB2 X3 IX7 X4-X6 NZ X7,ADW1 IF ROOM FOR WORD SA2 NTAB+A0 ALLOCATE TABLE BX6 X1 SAVE WORD SA6 ADWA ALLOC A0,X2 SA4 NTAB+A0 RESET LAST LENGTH SA1 ADWA RESTORE WORD IX3 X3-X4 SB2 X3 EQ ADW1 ENTER WORD ADWA CON 0 TEMPORARY STORAGE AMD SPACE 4,15 ** AMD - ASSEMBLE MODIFIER. * * ADD AND LINK MODIFIERS INTO MODIFIER TABLE. * * ENTRY (B6) = ADDRESS OF LINKED LIST OF MODIFIERS. * * USES X - ALL. * A - 1, 2, 4, 5, 6, 7. * B - 2, 3, 6, 7. * * CALLS LER, UPN. * * MACROS ADDWRD, PRINT, SEARCH. * PROCESS DUPLICATED MODIFIER NAME. AMD6 SB3 CHAR ENTER NAME IN ERROR MESSAGE BX1 X6 SX7 B6 SAVE ADDRESS OF LINKED LIST SX6 B1 SET ERROR FLAG SA7 AMDA SA6 A7+B1 RJ UPN UNPACK NAME PRINT -CHSP,B3+X1 SX0 =C*DUPLICATE MODIFIER NAME.* RJ LER LIST ERROR SA2 AMDA RESTORE ADDRESS OF LINKED LIST SB6 X2+ NZ B6,AMD0 IF NOT AT THE END OF THE CHAIN AMD7 SX6 B0+ CLEAR MODIFICATIONS SA6 MA AMD SUBR ENTRY/EXIT SX7 B0+ CLEAR ERROR FLAG SA7 AMDB AMD0 SA2 L.TDKI SET CURRENT LENGTH SB7 X2 MX0 42 AMD1 SA1 B6 NEXT MODIFICATION LINK SA5 A1+2 EXTRACT MODIFICATION IDENTIFIER ADDRESS SB6 X1 LX5 18 SA4 X5 SEARCH FOR IDENTIFIER IN DECK TABLE SEARCH TDKI,X4 NZ X2,AMD2 IF FOUND ADDWRD TDKI,X1*X4 ADD NEW MODIFIER SA1 X5+B1 ENTER MODIFIER INDEX SX6 X3 SA2 UP CHECK UPDATE MODE LX6 24 SA6 A1 ZR X2,AMD2 IF NOT *UPDATE* MODE BX1 -X0*X1 PROPAGATE LINE COUNT IX6 X6+X1 SA6 A1+ AMD2 SB2 X3+ CHECK MODIFIER INDEX LT B2,B7,AMD6 IF OLD MODIFIER NZ B6,AMD1 IF NOT AT END OF CHAIN SA1 AMDB NZ X1,AMD7 IF ERRORS OCCURRED SA1 MA SET MODIFICATION ADDRESS SB6 X1+ ZR X1,AMDX IF NO MODIFIERS - RETURN * CONVERT LINE IDENTIFIERS. AMD3 SA5 B6 LOOK UP FIRST LIMIT SB6 X5 LX5 24 SA2 X5 SEARCH A0,X2 ZR X2,AMD5 IF NOT FOUND BX2 X1*X5 ADD MODIFIER ADDRESS SA4 A5+B1 LOOK UP SECOND LIMIT SX3 A2 IX6 X2+X3 LX6 36 SA6 A5 ZR X4,AMD4 IF NOT DEFINED LX4 24 SA2 X4 SEARCH A0,X2 ZR X2,AMD5 IF NOT FOUND BX2 X1*X4 ADD MODIFIER ADDRESS SX3 A2 IX6 X2+X3 LX6 36 SA6 A4+ AMD4 NZ B6,AMD3 IF NOT AT END OF MODIFICATION CHAIN EQ AMDX RETURN * PROCESS UNKNOWN IDENTIFIER NAME. AMD5 SA1 A5+B1 SET UNKNOWN MODIFIER FLAG MX3 2 SA2 A1+B1 CLEAR TEXT LX3 1 MX0 42 BX6 X3+X1 LX0 24 SA6 A1 BX7 X0*X2 SA7 A2 EQ AMD4 AMDA CON 0 ADDRESS OF LINKED LIST AMDB CON 0 DUPLICATE MODIFIER ERROR FLAG ASD SPACE 4,20 ** ASD - ASSEMBLE DIGITS. * * ENTRY (CH) = CHARACTER POINTER. * * EXIT (X7) = ASSEMBLED DIGITS. * (B2) = 0, IF NUMERIC FIELD NULL. * (B2) .NE. 0, IF NUMERIC FIELD NOT NULL. * * USES X - 1, 2, 3, 6, 7. * A - 1, 2, 6. * B - 2. ASD3 SX6 =C*INCORRECT NUMERIC FIELD.* SA6 ERRM SX7 B0+ ASD SUBR ENTRY/EXIT SA1 CH GET NEXT CHARACTER BX7 X7-X7 CLEAR ASSEMBLY SA2 X1 SB2 B0+ SX3 X2-1R+ ZR X2,ASD3 IF TERMINATOR PL X3,ASD3 IF SEPARATOR ASD1 SX2 X2-1R0 MI X2,ASD3 IF ALPHA LX3 X7,B1 LAST DIGIT * 10 LX7 3 IX3 X3+X7 SX1 X1+B1 SET NEXT CHARACTER IX7 X3+X2 ADD NEW DIGIT SA2 X1 SB2 X2-1R+ ZR X2,ASD2 IF SEPARATOR MI B2,ASD1 IF NOT SEPARATOR ASD2 SX6 X1 UPDATE CHARACTER POINTER SA6 A1 EQ ASDX RETURN ASN SPACE 4,20 ** ASN - ASSEMBLE NAME. * * ASSEMBLE UP TO 7 CHARACTER NAME TO A SEPARATOR. * * ENTRY (CHAR) = FIRST CHARACTER IN STRING. * (CH) = CHARACTER STRING CURRENT INDEX. * * EXIT (X6) = NAME, LEFT JUSTIFIED ZERO FILL. * (X6) = 0, IF SEPARATOR OR .GT. 7 CHARACTERS ASSEMBLED. * (A1) = CH. * (X7) = UPDATED CHARACTER POINTER. * * USES X - 1, 2, 6, 7. * A - 1, 2, 7. * B - 2. ASN2 MX1 6 SX7 A2 ASN3 LX6 6 BX2 X1*X6 ZR X2,ASN3 IF NOT YET LEFT JUSTIFIED SA7 A1+ UPDATE CHARACTER POINTER MX1 -18 BX2 -X1*X6 ZR X2,ASNX IF .GT. 7 CHARACTERS SX6 B0+ CLEAR ASSEMBLY SA2 X1+ ASN SUBR ENTRY/EXIT SA1 CH CHECK FIRST CHARACTER SA2 X1 BX6 X6-X6 CLEAR ASSEMBLY MX1 -6 BX2 -X1*X2 MASK OFF POSSIBLE ESCAPE CODE SB2 X2-1R ZR X2,ASNX IF SEPARATOR, RETURN NG B2,ASN1 IF NOT SEPARATOR * CHECK POSSIBLE 6/12 ESCAPE CODE. SB2 X2-76B NZ B2,ASNX IF SEPARATOR SA2 A2+B1 BX2 -X1*X2 SB2 X2-1RZ-1 END OF LOWER CASE LETTERS (Z) ZR X2,ASNX IF SEPARATOR, RETURN PL B2,ASNX IF SEPARATOR, RETURN ASN1 LX6 6 SHIFT ASSEMBLY BX6 X6+X2 MERGE NEW CHARACTER SA2 A2+1 NEXT CHARACTER BX2 -X1*X2 MASK OFF POSSIBLE ESCAPE CODE SB2 X2-1R ZR X2,ASN2 IF SEPARATOR MI B2,ASN1 IF NOT SEPARATOR * CHECK POSSIBLE 6/12 ESCAPE CODE. SB2 X2-76B NZ B2,ASN2 IF NOT ESCAPE CODE THEN SEPARATOR SA2 A2+B1 BX2 -X1*X2 SB2 X2-1RZ-1 END OF LOWER CASE ALPHABETICS ZR X2,ASN2 IF SEPARATOR NG B2,ASN1 IF NOT SEPARATOR EQ ASN2 ATS SPACE 4,20 ** ATS - ALLOCATE TABLE SPACE. * * ENTRY (A0) = TABLE NUMBER. * (X1) = NUMBER OF ADDITIONAL WORDS TO ALLOCATE. * * EXIT (X2) = TABLE FWA. * (X3) = NEW TABLE LENGTH. * = ZERO - NO ROOM FOR TCDK TABLE EXPANSION. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - 2, 3. * * CALLS ABT, WTW=. ATS9 SA2 FTAB+A0 SET RESPONSE SA3 LTAB+A0 ATS SUBR ENTRY/EXIT SA2 FTAB+A0 CHECK TABLE SPACE SA3 LTAB+A0 IX7 X3+X1 ADVANCE LENGTH SA4 A2+B1 IX6 X2+X7 SA7 A3 IX4 X4-X6 MI X4,ATS1 IF NO ROOM FOR CHANGE BX3 X7 EQ ATSX RETURN * CHECK AVAILABLE STORAGE. ATS1 SA2 FTAB+FTABL CHECK STORAGE SA3 FL IX6 X2+X1 IX7 X3-X6 MI X7,ATS4 IF NO ROOM FOR INCREASE SA6 A2 UPDATE LWA+1 OF ALL TABLES SB2 A0+B1 SB3 FTABL BX4 X2 EQ B2,B3,ATS9 IF LAST TABLE - RETURN * MOVE HIGHER TABLE UP. ATS2 SA2 A2-B1 ADVANCE FWA OF HIGHER TABLES IX6 X2+X1 SA6 A2 SB2 B2+B1 NE B2,B3,ATS2 IF NOT END OF TABLES IX3 X4-X2 (B2) = WORD COUNT SB3 X1 (B3) = MOVE INCREMENT ZR X3,ATS9 IF NO MOVE NEEDED SB2 X3+ SA1 X4-1 BEGIN AT LWA ATS3 BX6 X1 MOVE TABLE UP SA6 A1+B3 SB2 B2-B1 SA1 A1-B1 NZ B2,ATS3 IF MOVE NOT COMPLETE EQ ATS9 EXIT TO SET RESPONSE ATS4 SX3 A0-TCDK SA2 L.TCDK ZR X3,ATSX IF COMMON DECK TABLE - RETURN * CLEAR COMMON DECKS. ZR X2,ATS5 IF NO COMMON DECKS IN MEMORY SA3 F.TCDK BX6 X6-X6 CLEAR COMMON DECKS LX7 X3 SA6 A2+ SA7 FTAB+FTABL EQ ATS1 ATTEMPT TO ALLOCATE AGAIN * DUMP INSERTION TEXT. ATS5 SA2 T SA4 L.TTXT NZ X2,ATS8 IF TEXT FILE BEGUN ZR X4,ATS8 IF NO TEXT SX7 X1 SAVE CHANGE SX6 B4 SAVE B4 - B7 SB2 A0-TTXT NZ B2,ATS6 IF NOT TEXT TABLE INCREASE IX4 X4-X1 (X4) = ACTUAL LENGTH ATS6 SA7 ATSA SX7 B5 SA6 A7+B1 SA7 A6+B1 SX6 B6 SX7 B7 SA6 A7+B1 SA7 A6+B1 SA3 F.TTXT LWA+1 ALL TABLES = FWA TEXT TABLE BX6 X6-X6 CLEAR TEXT TABLE LENGTH LX7 X3 SA6 A4 SA7 FTAB+FTABL SA7 A7-B1 FWA COMMON DECKS = FWA TEXT TABLE SA1 T+7 SET TEXT FILE NAME BX6 X1 SA6 A2 EVICT A2,R DUMP TEXT TABLE WRITEW X2,X3,X4 SA1 EI ZR X1,ATS7 IF NO EDITING BEGUN WRITER X2,R SA1 X2+1 REWIND POINTERS SX7 X1 SA7 A1+B1 SA7 A7+B1 BX7 X7-X7 INSURE NO HIT ON TEXT INDEX SA7 T+5 ATS7 SA1 ATSA RESET CHANGE SB2 A0-TTXT SA2 A1+B1 RESTORE B4 - B7 SA3 A2+B1 SB4 X2 SB5 X3 SA2 A3+B1 SA3 A2+B1 SB6 X2 SB7 X3 NZ B2,ATS1 IF NOT TEXT TABLE REQUEST - RETRY EQ ATSX RETURN * ALLOCATE ADDITIONAL MEMORY. ATS8 SA3 FL INCREMENT FL SX7 X3+FLINL BX4 X1 SAVE X1 SA7 A3 SET NEW FL MEMORY CM,,R,X7 BX1 X4 RESTORE X1 EQ ATS1 ATTEMPT TO ALLOCATE AGAIN ATSA CON 0 TEMPORARIES CON 0 CON 0 CON 0 CON 0 ATX SPACE 4,20 ** ATX - ALLOCATE TABLE EXPANSION SPACE. * * ENTRY (A0) = TABLE POINTER ADDRESS. * (X1) = TABLE BLOCK SIZE. * * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - 2. * * CALLS ATS. ATX SUBR ENTRY/EXIT SA2 FTAB+A0 CHECK TABLE ROOM SA3 LTAB+A0 IX2 X2+X1 ADD DESIRED BLOCK SIZE SA4 A2+B1 IX6 X2+X3 SB2 X3 IX7 X4-X6 PL X7,ATXX IF ROOM FOR BLOCK BX6 X1 SAVE WORD SA6 ATXA ALLOC A0,X1 SA1 ATXA RESTORE WORD IX7 X3-X1 SA7 A3 RESET TABLE CONTENT LENGTH EQ ATXX RETURN ATXA CON 0 TEMPORARY STORAGE CAS SPACE 4,20 ** CAS - CALL ASSEMBLER. * * ENTRY (QM) = *Q* MODE ASSEMBLER NAME. * (XM) = *X* MODE ASSEMBLER NAME. * (NC) = LINES WRITTEN TO COMPILE FILE. * (NC+1) = LINES WRITTEN TO COMPILE FILE * IN LAST RECORD. * (SFL) = SYSTEM FIELD LENGTH. * * EXIT IF *X* OR *Q* MODE, EXIT IS TO ASSEMBLER * AND A0 AND X0 ARE SET UP WITH EXTENDED MEMORY AND FL, * OTHERWISE RETURN. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - 0, 1, 2, 3, 4, 6, 7. * * CALLS MVE=. CAS SUBR ENTRY/EXIT SA1 QM CHECK FOR *X* OR *Q* MODE SA2 XM SA3 NC CHECK FOR LINES WRITTEN ON COMPILE BX6 X1+X2 SA4 A3+B1 ZR X6,CASX IF NOT *X* OR *Q* MODE - RETURN BX3 X3+X4 ZR X3,CASX IF NO LINES WRITTEN ON COMPILE - RETURN SA1 SFL SA0 X1 SA6 CASA STORE ASSEMBLER NAME MEMORY CM,,R,X1 RESTORE ORIGINAL FL SX7 CASBL-1 SA7 ACTR SET ARGUMENT COUNT MOVE CASBL,CASB,ARGR MOVE PARAMETERS MOVE CASGL,CASG,CCDR MOVE COMMAND SA1 EFL RESTORE *ECS* FIELD LENGTH BX0 X1 SYSTEM LDR,R,CASA CALL ASSEMBLER EQ CASX RETURN CASA CON 0 LOADER CALL WORDS CON 140BS36 CASB BSS 0 ASSEMBLER PARAMETER LIST CON 0LI+1R= CON 0LCOMPILE CON 0LL+1R= CASC CON 0L0 CON 0LB+1R= CASD CON 0LLGO CON 0LS+1R= CASE CON 0LSYSTEXT CON 0LG+1R= CASF CON 0L0 CON 0 CASBL EQU *-CASB CASG BSS 0 ASSEMBLER COMMAND DUP 8,1 CON 1H CON 0 CASGL EQU *-CASG CKC SPACE 4,20 ** CKC - CHECK LINE. * * ENTRY (A0) - ADDRESS OF FLAG LIST WORD. * *T LIST 42/FLAG NAME,18/PROCESSOR ADDR. * * EXIT (X4) = 0 IF NULL DIRECTIVE. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - 1, 2, 7. * B - 2, 3, 5. * * CALLS *ASN* AND SPECIAL LINE PROCESSORS. CKC SUBR ENTRY/EXIT SA1 CHAR CHECK FIRST CHARACTER SA2 PC CHECK PREFIX CHARACTER MX6 -6 BX1 -X6*X1 USE 6 BIT CHARACTER ONLY SX7 A1+B1 BX3 X1-X2 SX4 X1-1R SA7 CH SET SECOND CHARACTER RJ ASN ASSEMBLE NAME MX0 42 SA1 A0+ BX4 X4+X6 SET EXIT CONDITION SB3 64 NZ X3,CKCX IF FIRST CHARACTER .NE. PREFIX - RETURN ZR X6,CKCX IF BLANK NAME - RETURN CKC1 ZR X1,CKCX IF END OF LIST - RETURN IX7 X1-X6 COMPARE NAMES SB5 X1 SET PROCESSOR ADDRESS BX3 X0*X7 SA1 A1+B1 NEXT LIST ENTRY NZ X3,CKC1 IF NO MATCH SA1 CH CHECK NEXT CHARACTER SA2 X1+1 CKC2 SB2 X2-1R NZ B2,CKC3 IF NOT BLANK SA2 A2+B1 NEXT CHARACTER SB3 B3-B1 PL B3,CKC2 IF NOT AT END OF LINE CKC3 SX7 A2 SET NEXT CHARACTER ADDRESS SA7 A1 JP B5 PROCESS SPECIAL LINE CMF SPACE 4,20 ** CMF - COMPLETE FILES. * * WRITE DIRECTORY, RETURN SCRATCH FILES, REWIND MODSET, * INSURE EVEN PAGE COUNT AND TERMINATE OUTPT FILE. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - 6, 7. * * MACROS RECALL, RETURN, REWIND, WRITER, WRITEW. CMF SUBR ENTRY/EXIT RECALL P WRITER C RETURN T REWIND S SA1 NR NZ X1,CMF1 IF NO REWIND SET REWIND C CMF1 SA1 O SA2 LF ZR X1,CMF3 IF NO OUTPUT FILE SA3 PN ZR X2,CMF3 IF NOTHING LISTED LX3 59-0 NG X3,CMF2 IF PAGE NUMBER EVEN SA1 TO ZR X1,CMF2 IF TERMINAL OUTPUT WRITEW O,(=2L1 ),1 EJECT CMF2 WRITER O CMF3 SA1 A ZR X1,CMF4 IF FILE NOT USED RECALL A CMF4 RECALL M SA1 M+7 SA2 A+7 BX6 X1 LX7 X2 SA6 M SA7 A RETURN M RETURN A SB6 FETS WAIT FOR ALL FILES QUIET SB7 FETSL CMF5 SA1 B6 ZR X1,CMF6 IF FILE NOT DEFINED RECALL B6 CMF6 SB6 B6+FETLEN+FETODL NE B6,B7,CMF5 IF MORE FILES TO PROCESS EQ CMFX RETURN CPF SPACE 4,30 ** CPF - CONVERT PROGRAM FILE. * * ENTRY (CDTX) = FIRST WORD OF COMPRESSED LINE. * (CDWC) = WORD COUNT OF COMPRESSED LINE. * * EXIT (X2) = -6 BIT MASK. * (X0) = 2074BS48. * (B5) = (B7) = 60. * (B2) = 6. * (A5) = CDTX. * (X5) = (CDTX). * * USES X - 0, 1, 2, 5. * A - 1, 5. * B - 2, 4, 5, 7. * * CALLS CFT, CTF. CPF SUBR ENTRY/EXIT SA1 CVT CHECK FOR CONVERSION ZR X1,CPFX IF NO CONVERSION SX0 2074B CONSTANT - XN=0, BN=60 UPON UNPACK SB7 60 CONSTANT 60 LX0 48 SB5 B7 SB2 6 CONSTANT 6 MX2 -6 CHARACTER MASK SA5 CDTX FWA OF COMPRESSED LINE BUFFER MI X1,CFT IF 64 TO 63 CHARACTER SET CONVERSION * EQ CTF 63 TO 64 CHARACTER SET CONVERSION CTF SPACE 4,20 ** CTF - CONVERT 63 TO 64 CHARACTER SET. * * CONVERTS A COMPRESSED LINE FROM 63 TO 64 CHARACTER * SET. A *0001* BYTE IS CONVERTED TO *5555* AND A *63* * CODE BECOMES A *0001* BYTE. THE WORD COUNT IS ALSO * UPDATED. SINCE THE NEW COMPRESSED LINE MAY BE LONGER THAN * THE OLD, THE LINE IS NOT CONVERTED IN PLACE. THE CONVERTED * LINE IS MOVED BACK TO THE *CDTX* BUFFER AFTER CONVERSION. * * IN *ASCII* MODE, 63 CHARACTER SET PERCENT (*7404B*) IS * CONVERTED TO *63B*. * * * ENTRY (X2) = -6 BIT MASK. * (X0) = 2074BS48. * (B5) = (B7) = 60. * (B2) = 6. * (A5) = CDTX. * (X5) = (CDTX). * * EXIT (CDTX) = CONVERTED LINE IMAGE. * (CDWC) = UPDATED LINE WORD COUNT. * * USES X - 1, 3, 4, 5, 6, 7. * A - 1, 5, 6, 7. * B - 3, 4, 5, 6, 7. * * CALLS MVE=. *CTF BSS 0 SA1 CSC CHARACTER SET (DISPLAY/ASCII) CURRENT DECK SB4 X1 SA1 CVTX-1 PRESET (A6) BX6 X1 SA6 A1+ UX6,B6 X0 SET REGISTERS CTF1 LX5 6 PICK NEXT CHARACTER SB5 B5-6 DECREMENT CHARACTER COUNT BX4 -X2*X5 NZ B5,CTF2 IF NOT END OF INPUT WORD SA5 A5+B1 ADVANCE TO NEXT WORD SB5 B7 RESET CHARACTER COUNT CTF2 SX1 X4-63B CHECK FOR 63 CHARACTER SET COLON ZR X4,CTF4 IF COMPRESSION CHARACTER (*00*) ZR X1,CTF8 IF COLON SA1 MADCV ZR B4,CTF3 IF DISPLAY CODE MODE NZ X1,CTF3 IF MADIFY CONVERSION SX1 X4-74B NZ X1,CTF3 IF NOT ESCAPE CODE 74B LX7 B2,X5 TRY NEXT CHARACTER BX1 -X2*X7 SX7 X1-04 NZ X7,CTF3 IF NOT *7404B* (PERCENT) SX4 63B (X4) = 64 CHARACTER SET PERCENT LX5 6 SB5 B5-6 NZ B5,CTF3 IF NOT END OF INPUT WORD SA5 A5+B1 SB5 B7 RESET CHARACTER COUNT CTF3 LX6 6 PROCESS NORMAL CHARACTER SB6 B6-6 DECREMENT CHARACTER COUNT BX6 X6+X4 INSERT NEXT CHARACTER NZ B6,CTF1 IF OUTPUT WORD NOT EXHAUSTED SA6 A6+B1 SET CURRENT WORD UX6,B6 X0 RESET REGISTERS EQ CTF1 GET NEXT CHARACTER * PROCESS COMPRESSION CODE. CTF4 LX5 6 PROCESS CHARACTER FOLLOWING COMPRESSION BX4 -X2*X5 SB5 B5-6 DECREMENT CHARACTER COUNT NZ B5,CTF5 IF INPUT WORD NOT EMPTY SA5 A5+B1 ADVANCE TO NEXT WORD SB5 B7 CTF5 ZR X4,CTF9 IF END OF LINE SB3 X4-1 CHECK FOR *0001* BYTE ZR B3,CTF7 IF *0001* BYTE LX6 6 INSERT *00* CTF6 SB6 B6-B2 NZ B6,CTF3 IF NOT END OF OUTPUT WORD SA6 A6+B1 SET CURRENT WORD UX6,B6 X0 RESET REGISTERS EQ CTF3 PROCESS COMPRESSION AS NORMAL CHARACTER * PROCESS *0001* CODE. CTF7 SX4 1R CONVERT *0001* TO *5555* LX6 6 INSERT *55* BX6 X6+X4 EQ CTF6 PROCESS SPACE AS NORMAL CHARACTER * PROCESS *63* CODE. CTF8 SA1 MADCV NZ X1,CTF3 IF MADIFY CONVERSION SX4 B1 CONVERT *63* TO *0001* LX6 6 INSERT *00* ZR B4,CTF6 IF DISPLAY CODE, PROCESS *01* AS NORMAL SX1 74B BX6 X6+X1 SX4 04B MAKE *63* INTO *7404* IN ASCII MODE EQ CTF6 PROCESS *01* AS NORMAL CHARACTER * PROCESS END OF LINE. CTF9 LX6 X6,B6 POSITION LAST WORD MX3 -12 SA6 A6+B1 BX4 -X3*X6 CHECK FOR END OF LINE IN CURRENT WORD ZR X4,CTF10 IF END OF LINE PRESENT BX6 X6-X6 SET END OF LINE WORD SA6 A6+B1 CTF10 SX7 A6-CVTX+1 SET UPDATED WORD COUNT SA7 CDWC MOVE X7,CVTX,CDTX MOVE TO COMPRESSED LINE BUFFER EQ CPFX RETURN CFT SPACE 4,20 ** CFT - CONVERT 64 TO 63 CHARACTER SET. * * CONVERTS A COMPRESSED LINE FROM 64 TO 63 CHARACTER * SET. A *0001* BYTE IS CONVERTED TO A *63* AND A * *63* IS CONVERTED TO A *55*. * * ENTRY (X2) = -6 BIT MASK. * (X0) = 2074BS48. * (B5) = (B7) = 60. * (B2) = 6. * (A5) = CDTX. * (X5) = (CDTX). * * EXIT (CDTX) = CONVERTED LINE IMAGE. * (CDWC) = UPDATED LINE WORD COUNT. * * USES X - 1, 3, 4, 5, 6, 7. * A - 1, 4, 5, 6, 7. * B - 4, 5, 6. CFT SA1 CSC CHARACTER SET (DISPLAY/ASCII) CURRENT DECK SA4 CVTX-1 PRESET (A6) SB4 X1 BX6 X4 SA6 A4 UX6,B6 X0 SET REGISTERS CFT1 LX5 6 GET NEXT CHARACTER SB5 B5-6 DECREMENT CHARACTER COUNT BX4 -X2*X5 NZ B5,CFT2 IF NOT END OF INPUT WORD SA5 A5+B1 SET NEXT WORD SB5 B7 RESET CHARACTER COUNT CFT2 ZR X4,CFT4 IF COMPRESSION CODE OR COLON SX1 X4-74B NZ X1,CFT2.1 IF NOT ESCAPE CODE 74B LX7 B2,X5 CHECK NEXT CHARACTER BX1 -X2*X7 SX7 X1-04B CHECK FOR 64 CHARACTER SET COLON NZ X7,CFT2.1 IF NOT 64 CHARACTER SET COLON (*7404*) SX4 63B SET 63 CHARACTER SET COLON (*63B*) LX5 6 SB5 B5-6 NZ B5,CFT3 IF NOT END OF INPUT WORD SA5 A5+B1 SB5 B7 RESET CHARACTER COUNT EQ CFT3 INSERT CHARACTER CFT2.1 SX1 X4-63B CHECK FOR PERCENT SIGN NZ X1,CFT3 IF NOT PERCENT SIGN EQ B4,B1,CFT9 IF ASCII MODE SX4 1R CONVERT PERCENT TO BLANK CFT3 LX6 6 INSERT CHARACTER SB6 B6-6 BX6 X6+X4 NZ B6,CFT1 IF OUTPUT WORD NOT FULL SA6 A6+B1 SET CURRENT WORD UX6,B6 X0 RESET REGISTERS EQ CFT1 GET NEXT CHARACTER * PROCESS COMPRESSION/COLON CODES. CFT4 LX5 6 GET NEXT CHARACTER SB5 B5-6 DECREMENT CHARACTER COUNT BX4 -X2*X5 ZR X4,CFT7 IF END OF LINE NZ B5,CFT5 IF INPUT WORD NOT EXHAUSTED SA5 A5+1 GET NEXT CHARACTER SB5 B7+ RESET CHARACTER COUNT CFT5 SX1 X4-1 CHECK FOR *0001* CODE ZR X1,CFT6 IF COLON (*0001*) LX6 6 SET *00* SB6 B6-B2 DECREMENT CHARACTER COUNT NZ B6,CFT3 IF OUTPUT WORD NOT EXHAUSTED SA6 A6+B1 UX6,B6 X0 EQ CFT3 PROCESS AS NORMAL CHARACTER * PROCESS *0001* CODE. CFT6 SX4 63B CONVERT *0001* TO *63* EQ CFT3 PROCESS AS NORMAL CHARACTER * PROCESS END OF LINE. CFT7 LX6 X6,B6 LEFT JUSTIFY ASSEMBLY MX3 -12 CHECK FOR END OF LINE SUPPLIED SA6 A6+B1 SET LAST WORD BX4 -X3*X6 ZR X4,CFT8 IF END OF LINE PRESENT BX6 X6-X6 SA6 A6+B1 CFT8 SX7 A6-CVTX+1 SET UPDATED WORD COUNT SA7 CDWC MOVE X7,CVTX,CDTX MOVE TO COMPRESSED LINE BUFFER EQ CPFX RETURN * PROCESS *63* IN ASCII MODE. CFT9 SX1 74B MAKE PERCENT IN ASCII CHARACTER SET LX6 6 SB6 B6-B2 SX4 04B BX6 X6+X1 NZ B6,CFT3 IF OUTPUT WORD NOT EXHAUSTED SA6 A6+B1 UX6,B6 X0 EQ CFT3 PROCESS AS NORMAL CHARACTER DNL SPACE 4,15 ** DNL - DECREMENT NESTING LEVEL. * * ENTRY NONE. * * EXIT (X6) = COMMON DECK NAME OF PREVIOUS NESTING LEVEL. * = 0 IF NO NESTING. * * USES X - 1, 2, 3, 6, 7. * A - 1, 2, 6, 7. DNL SUBR ENTRY/EXIT SX6 0 SA1 L.TNCC SA6 CDC CLEAR COMMON DECK LINE COUNT SA6 CDS CLEAR COMMON DECK SKIP COUNT ZR X1,DNLX IF NO NESTING SX6 X1-1 SA6 A1 DECREMENT TABLE LENGTH ZR X6,DNLX IF NO NESTING SA2 F.TNCC IX3 X6+X2 MX2 42 SA1 X3-1 GET PREVIOUS NESTING LEVEL NAME SX7 X1 SKIP COUNT BX6 X2*X1 COMMON DECK NAME SA7 CDS SET SKIP COUNT EQ DNLX RETURN ECD SPACE 4,20 ** ECD - EXPAND LINE. * * ENTRY (CDTX) = FIRST WORD OF COMPRESSED LINE. * * EXIT (B7) = LWA+1 OF LAST CHARACTER IN EXPANDED LINE. * (CHAR) = FIRST CHARACTER OF EXPANDED LINE. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - ALL. * * CALLS CDD. ECD SUBR ENTRY/EXIT SA3 CSC CHARACTER SET OF DECK SA4 SETC CHECK FOR *CSET ZR X3,ECD0 IF DECK IS DISPLAY * DECK IS 6/12 ASCII. SB6 B1+ NZ X4,ECD0.1 IF NOT *CSET,DISPLAY - UNPACK 6/12 ASCII SB6 B0+ EQ ECD0.1 OTHERWISE *CSET,DISPLAY FOLD TO UPPER CASE * DECK IS DISPLAY. ECD0 SB6 -B1 UNPACK 6 BIT CHARACTERS NG X4,ECD0.1 IF NO *CSET ZR X4,ECD0.1 IF *CSET,DISPLAY SB6 B1+ UNPACK 6/12 ASCII CHARACTERS ECD0.1 SA1 SC+1 SET LAST COLUMN SX6 1R SET TO BLANK FILL BUFFER SB7 X1+B1 SA6 CHAR PRESET (A6) MX0 -6 SB2 -B7 SB5 10 CONSTANT 10 SB4 B5 ECD1 SB7 B7-B1 BLANK FILL LINE SA6 A6+B1 PL B7,ECD1 IF NOT COMPLETE SB3 CHAR+1+X1 SA1 CDTX EQ ECD3 * EXPAND LINE TEXT. ECD1.1 SX2 X7-76B SX4 X7-74B ZR X2,ECD1.2 IF 76B ESCAPE CODE NZ X4,ECD2 IF NO ESCAPE CODES BX3 X1 LX3 6 BX2 -X0*X3 SX4 X2-1 SX3 X2-2 ZR X4,ECD1.3 IF 7401B UNPACK AT SIGN ZR X3,ECD1.3 IF 7402B UNPACK CIRCUMFLEX SX4 X2-4 SX3 X2-7 ZR X4,ECD1.3 IF 7404B UNPACK COLON (64) OR PERCENT (63) ZR X3,ECD1.3 IF 7407B UNPACK GRAVE ACCENT EQ ECD2 OTHERWISE UNPACK 6 BIT CHARACTERS ECD1.2 BX4 X1 LX4 6 BX3 -X0*X4 SX4 X3-37B PL X4,ECD2 IF .GT. 7636B UNPACK 6 BIT CHARACTERS ECD1.3 LX7 6 12 BIT CHARACTER SB4 B4-B1 LX1 6 BX2 -X0*X1 BX7 X7+X2 NZ B4,ECD2 IF NOT END OF WORD SA1 A1+B1 SB4 B5 ECD2 PL B2,ECD7 IF LINE LIMIT REACHED SA7 B2+B3 STORE CHARACTER SB2 B2+B1 ECD3 SB4 B4-1 SHIFT TO NEXT CHARACTER LX1 6 BX7 -X0*X1 NZ B4,ECD4 IF NOT END OF WORD SA1 A1+B1 SET NEXT WORD SB4 B5 ECD4 ZR X7,ECD4.1 IF CURRENT CHARACTER IS *00* NG B6,ECD2 IF UNPACKING 6 BIT CHARACTERS ZR B6,ECD11 IF CONVERTING LOWER TO UPPER CASE EQ ECD1.1 OTHERWISE UNPACK 12 BIT ASCII ECD4.1 SB4 B4-1 LX1 6 EXTRACT SPACE COUNT BX7 -X0*X1 ECDA BSS 0 NZ B4,ECD5 IF NOT END OF WORD * NZ B4,ECD6 (63 CHARACTER SET) SA1 A1+B1 SET NEXT WORD SB4 B5 RESET CHARACTER COUNT ECDB BSS 0 ECD5 SB7 X7 CHECK COMPRESSION CODE * EQ ECD6 (63 CHARACTER SET) NE B7,B1,ECD6 IF NOT *0001* BX7 X7-X7 INSERT *00* CHARACTER EQ ECD2 * PROCESS COMPRESSION CODE. ECD6 SX4 X7+B1 SET COMPRESSION COUNT SB2 X4+B2 SET BLANKS IN BUFFER NZ X7,ECD3 IF NOT END OF WORD * ENTER IDENTIFIER NAME. ECD7 SA2 CDID GET LINE IDENTIFICATION SB7 B2+B3 SET ADDRESS OF LAST CHARACTER +1 MX3 -16 SB2 7 LX2 6 ECD8 BX7 -X0*X2 NEXT CHARACTER SB2 B2-1 LX2 6 NZ X7,ECD9 IF NOT *00* SX7 1R SET BLANK ECD9 SA7 B3-B1 SB3 B3+B1 NZ B2,ECD8 IF NOT AT END OF NAME * ENTER LINE NUMBER. LX2 12 CONVERT LINE NUMBER BX1 -X3*X2 RJ CDD CONVERT TO DECIMAL DISPLAY SB2 9 LX6 24 MX0 -6 ECD10 BX7 -X0*X6 ENTER SEQUENCE NUMBER SB2 B2-B1 SA7 A7+B1 LX6 6 NZ B2,ECD10 IF NOT AT END OF SEQUENCE NUMBER SB3 A7+1 RETURN WITH NEXT CHARACTER POSITION EQ ECDX * CONVERT 6/12 ASCII TO DISPLAY CODE. * * X0 = 6 BIT CHARACTER MASK (LOW ORDER CHARACTER). * X1 = UNPACK REGISTER POSITIONED TO NEXT CHARACTER. * X7 = CURRENT ESCAPE CODE RIGHT JUSTIFIED. * B4 = COUNT OF CHARACTERS UNPACKED FROM X1. * B5 = 10 (NUMBER OF 6 BIT CHARACTERS IN A WORD). ECD11 BX3 X1 LX3 6 BX2 -X0*X3 GET NEXT CHARACTER SX4 X7-74B SX3 X7-76B ZR X4,ECD14 IF 74B ESCAPE CODE NZ X3,ECD2 IF NO ESCAPE CODES ZR X2,ECD2 IF 7600B, PROCESS AS 2 CHARACTERS SX4 X2-37B PL X4,ECD2 IF .GT. 7636B, PROCESS AS 2 CHARACTERS SX4 X2-33B NG X4,ECD12 IF LOWER CASE CONVERT TO UPPER CASE * CHECK FOR ISO NATIONAL CHARACTERS. SX7 61B ZR X4,ECD13 IF LEFT BRACE CONVERT TO LEFT BRACKET SX4 X2-34B SX7 75B ZR X4,ECD13 IF VERTICAL LINE CONVERT TO BACK SLASH SX4 X2-35B SX7 62B ZR X4,ECD13 IF RIGHT BRACE CONVERT TO RIGHT BRACKET SX2 76B CONVERT TILDE TO CIRCUMFLEX ECD12 BX7 X2 STRIP AWAY 76B ASCII ESCAPE CODE ECD13 SB4 B4-B1 LX1 6 NZ B4,ECD2 IF DISPLAY CODE CHARACTER SA1 A1+B1 SET UP NEXT WORD SB4 B5 EQ ECD2 STORE DISPLAY CODE CHARACTER ECD14 BX3 X2 POSSIBLE 74B ESCAPE CODE FOUND SX4 X3-1 ZR X4,ECD13 IF AT SIGN (IN X7) SX4 X3-2 SX2 76B ZR X4,ECD12 IF CIRCUMFLEX SX4 X3-7 ZR X4,ECD13 IF 7407B - UNPACK GRAVE ACCENT SX4 X3-4 NZ X4,ECD2 IF NOT 7407B - 2 CHARACTERS SA4 COPL CHECK FOR 63 OR 64 CHARACTER SET SA2 DISCOL NZ X4,ECD12 IF 64 UNPACK COLON SA2 DISPER EQ ECD12 OTHERWISE UNPACK 63 PERCENT (55B) INL SPACE 4,15 ** INL - INCREMENT NESTING LEVEL. * * INCREMENT NESTING LEVEL OF COMMON DECK CALLS. * * ENTRY (X6) = COMMON DECK NAME. * * EXIT (X6) = COMMON DECK NAME. * * USES X - 0, 1, 4, 7. * A - 1, 4, 7. * B - 2. * * MACROS ADDWRD, SEARCH. INL1 SX7 0 SA7 CDC RESET LINE COUNT SA7 CDS RESET SKIP COUNT SEARCH TCCD,X6 NZ X2,INLX IF ALREADY CALLED COMMON DECK ADDWRD TCCD,X6 ADD NAME TO TABLE OF CALLED DECKS INL SUBR ENTRY/EXIT MX0 42 BX6 X0*X6 ADDWRD TNCC,X6 PUSH DECK NAME ON STACK LE B2,B0,INL1 IF NO PREVIOUS ENTRY SA1 CDC GET COUNT OF LINES OF PREVIOUS OPLC SA4 A6-B1 GET PREVIOUS ENTRY BX4 X0*X4 BX7 X4+X1 INCLUDE SKIP COUNT SA7 A4 EQ INL1 SEARCH TABLE OF CALLED COMMON DECKS PCS SPACE 4,15 ** PCS - PROCESS OPL CHARACTER SET. * * CHECK AND/OR INITIALIZE *MODIFY* FOR 63/64 CHARACTER * AND DISPLAY/ASCII CHARACTER SET OPL PROCESSING. * * ENTRY (B5) = FWA OF IDENT TABLE FOR RECORD. * * EXIT IF INITIAL ENTRY. * (ECDA) INITIALIZED. * (ECDB) INITIALIZED. * * USES X - 1, 2, 3, 4, 5.6, 7. * A - 0, 1, 3, 4, 6, 7. * B - 2. * * CALLS ABT, SFN. PCS SUBR ENTRY/EXIT SA5 B5+16B CHECK CHARACTER SET OF RECORD MX1 -6 MASK OFF 63/64 CHARACTER SET BX5 -X1*X5 * VERIFY OPL CHARACTER SET. SX3 X5-64B CHECK FOR 64 CHARACTER SET PL ZR X3,PCS1 IF 64 CHARACTER SET ZR X5,PCS1 IF 63 CHARACTER SET (*00*) SA1 B5+B1 INCORRECT CHARACTER SET DECK NAME RJ SFN SPACE FILL DECK NAME SX2 1R &1R- FORM MESSAGE BX5 X5-X5 SET 63 CHARACTER SET LX6 -6 BX6 X6-X2 SA6 PCSB SET MESSAGE SA1 A5 CORRECT CHARACTER SET IN HEADER MX2 54 BX7 X2*X1 PRESERVE ASCII FLAG SA7 A1 MESSAGE A6,3 * DECKNAM - INCORRECT CS, 63 ASSUMED.* * CHECK FOR MIXED PL,S. PCS1 SA4 COPL PREVIOUS CHARACTER SET BX3 X4-X5 COMPARE PREVIOUS AGAINST CURRENT BX6 X5 CHARACTER SET OF CURRENT RECORD SB2 X5 CHARACTER SET OF CURRENT RECORD SA6 A4 SET PREVIOUS CHARACTER SET MI X4,PCS2 IF INITIAL ENTRY * COMPARE AGAINST CHARACTER SET OF PREVIOUS RECORD. ZR X3,PCS11 IF SAME CHARACTER SET - CHECK ASCII FLAG SA1 B5+B1 SET DECK NAME IN MESSAGE RJ SFN SPACE FILL DECK NAME SX2 1R &1R- FORM MESSAGE LX6 -6 BX6 X6-X2 SA6 PCSC SA0 A6 ADDRESS OF MESSAGE EQ ABT * CHECK REDUNDANT CONVERSION. PCS2 SA3 CVT CHECK AGAINST CONVERSION OPTION ZR X3,PCS7 IF NO CONVERSION SPECIFIED SB2 X3-63B NZ X5,PCS4 IF PROGRAM LIBRARY IS 64 CHARACTER SET NZ B2,PCS5 IF NOT REDUNDANT, NOT 63 TO 63 CONVERSION PCS3 MESSAGE (=C* REDUNDANT CONVERSION IGNORED.*),3 BX6 X6-X6 CLEAR CONVERSION IF REDUNDANT SA6 A3 EQ PCS7 PROCESS AS NO CONVERSION PCS4 NE B1,B2,PCS5 IF NOT 64 TO 64 REDUNDANCY SA1 MADCV NZ X1,PCS5 IF MADIFY CONVERSION - NOT REDUNDANT SB2 64B NEW PROGRAM LIBRARY CHARACTER SET EQ PCS3 REDUNDANT 64 TO 64 CONVERSION PCS5 ZR B2,PCS6 IF CONVERSION TO 63 CHARACTER SET SB2 64B SET CONVERSION TO 64 CHARACTER SET PCS6 SX7 B2-1 SET CONVERSION FLAG SA7 A3+ * MODIFY INSTRUCTIONS FOR 63 CHARACTER SET. PCS7 NZ B2,PCS8 IF 64 CHARACTER SET SA1 PCSE SA0 PCSD NZ X1,ABT IF INPUT 64 WHILE PL IS 63 SA1 PCSA MODIFY INSTRUCTIONS SA2 A1+B1 BX6 X1 BX7 X2 SA6 ECDA SA7 ECDB * INITIALIZE PROGRAM LIBRARY/COMPILE FILE CHARACTER SETS. PCS8 SX7 B2 NEW CHARACTER SET SA1 CIDT COMPILE FILE HEADER SKELETON SA7 CNPL CHARACTER SET OF NEW PROGRAM LIBRARY LX7 24 BX6 X7+X1 SA6 A1 * STORE DISPLAY CODE COLON AND PERCENT CHARACTERS. ZR B2,PCS9 IF 63 CHARACTER SET MX7 0 00B = 64 CHARACTER SET COLON SX6 63B 63B = 64 CHARACTER SET PERCENT EQ PCS10 STORE CHARACTERS PCS9 SX7 63B 63 CHARACTER SET COLON SX6 1R 63 CHARACTER SET PERCENT PCS10 SA7 DISCOL COLON SA6 DISPER PERCENT * DETERMINE IF DECK IS DISPLAY OR 6/12 ASCII. PCS11 SA2 MADCV CHECK FOR MADIFY CONVERSION SX6 1 SET ASCII BIT FOR THIS DECK NZ X2,PCS12 IF MADIFY CONVERSION SA1 A5 GET CHARACTER SET WORD MX4 -6 LX1 -6 SHIFT TO ASCII/DISPLAY FIELD BX6 -X4*X1 PCS12 SA6 CSC SET CURRENT CHARACTER SET EQ PCSX RETURN PCSA NZ B4,ECD6 IF NOT END OF WORD (63 CHARACTER SET) SA1 A1+B1 SB4 B5 + EQ ECD6 (63 CHARACTER SET) PCSB DATA C* DECKNAM - INCORRECT CS, 63 ASSUMED.* PCSC DATA C* DECKNAM - MIXED CHARACTER SET DETECTED.* PCSD DATA C* INCORRECT CS ON INPUT.* PCSE DATA 0 INPUT 64 SET INDICATOR PLE SPACE 4,20 ** PLE - PROCESS LIBRARY ERROR. * * ISSUES LIBRARY ERROR MESSAGE AND ABORTS JOB. * * CALLS ABT. PLE SA1 DN SET DECK NAME IN MESSAGE BX6 X1 SA6 PLEB SA0 PLEA ABORT JOB EQ ABT PLEA DATA 20H PL ERROR IN DECK PLEB CON 0 PCW SPACE 4,20 ** PCW - PROCESS COMPILE FILE WRITE. * * WRITE COMMON DECK DATA IF NOT CALL TO OTHER COMMON DECK. * TRAP NESTING OF COMMON DECKS. * * ENTRY NONE. * * EXIT (X1) = ZERO = NORMAL RETURN * = NONZERO = SKIP THIS LINE * (X6) = COMMON DECK NAME IF CALL ENCOUNTERED. * ELSE 0, AND LINE WRITTEN. * * USES ALL. * * CALLS ASN, ECD, LCE, WCC, WCF. * * MACROS CARD, LISTOP, RECALL, SEARCH. PCW7 SA1 AM CHECK FOR COMPRESSED COMPILE FILE ZR X1,PCW8 IF NOT COMPRESSED MODE RJ WCC WRITE COMPRESSED COMPILE FILE EQ PCW10 NORMAL RETURN PCW8 RJ ECD EXPAND LINE PCW9 RJ WCF WRITE COMPILE FILE SX1 1 THIS LINE IS NOT A COMMENT PCW10 MX6 0 NORMAL RETURN - NO COMMON DECK NESTING PCW SUBR ENTRY/EXIT SA2 CDC INCREMENT LINE COUNT SA1 CDS GET SKIP COUNT SX7 X2+B1 SA7 A2 ZR X1,PCW1 IF NOTHING TO SKIP SX7 X1-1 SA7 A1 MX1 0 INDICATE SKIPPING BX6 X6-X6 EQ PCWX RETURN SKIPPING THIS LINE PCW1 SA1 CDTX SA2 WCCA GET PREFIX CHARACTER BX3 X2-X1 AX3 54 NG X3,PCW7 IF NOT COMMENT LINE NZ X3,PCW7 IF NOT COMMENT LINE RJ ECD EXPAND LINE CARD CALL,PCW2 *CALL CARD CALLC,PCW4 *CALLC CARD IFCALL,PCW5 *IFCALL CARD NIFCALL,PCW6 *NIFCALL EQ PCW9 WRITE COMPILE FILE COMPILE SPACE 4,10 *** COMPILE FILE CONTROL DIRECTIVES. * * THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE. * THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY * OR RESULT FROM INSERTION. CALL SPACE 4,10 *** CALL DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE. PCW2 SA1 IFIP NG X1,PCW10 IF INACTIVE RECALL M RJ ASN ASSEMBLE NAME PCW3 NZ X6,PCW3.5 IF NAME IS OK BX7 X7-X7 SA7 CL CLEAR LINE LISTED STATUS SA0 =C/ UNKNOWN DECK./ RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ PCW10 RETURN AFTER ERROR PCW3.5 SEARCH TNCC,X6 CHECK IF RECURSIVE CALL ZR X2,PCWX IF NOT FOUND IN NESTING STACK LISTOP E,PCW10 IF NO ERROR LIST - RETURN SA0 PCWA RJ LCE LIST COMPILE FILE DIRECTIVE ERROR EQ PCW10 NORMAL RETURN CALLC SPACE 4,10 *** CALLC DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF IT * HAS NOT BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE * FILE DIRECTIVE. PCW4 SA1 IFIP NG X1,PCW10 IF INACTIVE RECALL M RJ ASN ASSEMBLE NAME SEARCH TCCD,X6 ZR X2,PCW3 IF NOT FOUND - PROCESS AS *CALL EQ PCW10 NORMAL RETURN IFCALL SPACE 4,10 *** IFCALL NAME,DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF * *NAME* IS DEFINED. PCW5 RJ ASN ASSEMBLE NAME SEARCH TDEF,X6 SEARCH FOR NAME ZR X2,PCW10 IF NOT FOUND - RETURN SX7 X7+B1 SKIP SEPARATOR SA7 CH EQ PCW2 PROCESS AS *CALL NIFCALL SPACE 4,10 *** NIFCALL NAME,DNAME * * PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF * *NAME* IS NOT DEFINED. PCW6 RJ ASN ASSEMBLE NAME SEARCH TDEF,X6 SEARCH FOR NAME NZ X2,PCW10 IF FOUND - RETURN SX7 X7+B1 SKIP SEPARATOR SA7 CH EQ PCW2 PROCESS AS *CALL PCWA DATA C* DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK* RCL SPACE 4,15 ** RCL - RE-COMPRESS LINE. * * ENTRY (CHAR) = CHARACTER STRING OF LINE. * (B7) = LAST CHARACTER POSITION IN STRING BUFFER. * * EXIT (CDTX) = COMPRESSED LINE. * (CDWC) = WORD COUNT OF COMPRESSED LINE. * * USES ALL. * PROCESS END OF LINE. RCL8 LX6 X6,B6 SHIFT UP LAST WORD MX3 -12 SA6 A6+1 BX4 -X3*X6 SB2 A1+ BX6 X6-X6 ZR X4,RCL9 IF LINE TERMINATED SA6 A6+1 TERMINATE LINE RCL9 SX7 A6-B2 SET WORD COUNT SA7 A1-B1 RCL SUBR ENTRY/EXIT SX7 B7-1 SAVE LAST CHARACTER POSITION SA7 RCLL SX0 2074B (X0) = CONSTANT 60 FOR UNPACK SB4 100B SB3 -B1 SA1 CDID PRESET (A6) LX0 48 SA5 CHAR FIRST CHARACTER SB7 B4+B1 BX6 X1 SA6 A1 SB2 6 UX6,B6 X0 RESET REGISTERS SA2 RCLL SET LAST CHARACTER POSITION SB5 -B1 BX1 -X2 SX7 1R EQ RCL7 ENTER TO PROCESS FIRST CHARACTER RCL1 SB5 B5+1 RCL2 LX6 6 00 CHARACTER SB6 B6-B2 SX4 B4-B1 COMPRESSION = 77B SB3 B5-B7 NZ B6,RCL3 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS RCL3 PL B3,RCL4 IF .GT. 64 BLANKS SX4 B5-B1 COMPRESSION = COUNT - 1 SB3 -B1 RCL4 NZ X4,RCL5 IF CHARACTER IS NOT *00* LX6 6 INSERT *00* SB6 B6-B2 SX4 B1 SET *01* NZ B6,RCL5 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS RCL5 BX3 X4 SAVE CHARACTER AX4 6 CHECK FOR ESCAPE CODE ZR X4,RCL6 IF NO ESCAPE CODE LX6 6 SHIFT ASSEMBLY SB6 B6-B2 BX6 X6+X4 MERGE NEW CHARACTER SB5 B3 NZ B6,RCL6 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS RCL6 MX4 -6 BX4 -X4*X3 CLEAN OFF ESCAPE CODE LX6 6 SHIFT ASSEMBLY SB6 B6-B2 BX6 X6+X4 MERGE NEW CHARACTER SB5 B3 NZ B6,RCL7 IF NOT END OF WORD SA6 A6+B1 UX6 B6,X0 RCL7 IX3 X5-X7 CHECK CHARACTER BX4 X5 SB5 B5+B1 COUNT BLANK SB3 X1 -( LWA + 1 ) OF STRING BUFFER SB3 B3+A5 CHECK FOR END OF LINE SA5 A5+B1 NEXT CHARACTER ZR B3,RCL8 IF END OF LINE ZR X3,RCL7 IF BLANK SB3 -1 ZR B5,RCL4 IF NO BLANKS BX4 X7 SA5 A5-B1 BACKSPACE EQ B5,B1,RCL4 IF 1 BLANK SB5 B5-1 NE B5,B1,RCL1 IF NOT 2 BLANKS SA5 A5-1 BACKSPACE EQ RCL4 CHECK FOR *00* CHARACTER RCLL CON 0 LAST CHARACTER POSITION IN STRING BUFFER RMT SPACE 4,25 ** RMT - READ MODIFIER TABLE. * * ENTRY (DN) = DECK NAME. * (MA) = MODIFICATION TABLE ADDRESS. * * USES X - ALL. * A - 1, 2, 3, 4, 5, 6, 7. * B - ALL. * * CALLS AMD, ATS, PCS, POC. RMT SUBR ENTRY/EXIT SA1 DA GET DECK TABLE ENTRY SA3 X1+B1 SET RANDOM ADDRESS MX7 -30 BX7 -X7*X3 AX3 36 SET FILE NAME SA7 P+6 SA2 X3 BX6 X2 SA6 P READ A6 INITIATE NEW READ READW X2,TIDT,TIDTL READ IDENT TABLE NZ X1,PLE IF EOR SA1 TIDT LX1 12 SB2 X1-7700B NZ B2,PLE IF NO IDENT TABLE SA1 TIDT+1 CHECK DECK NAME SA2 DN BX3 X1-X2 NZ X3,PLE IF NO MATCH ADDWRD TDKI,X1 ADD DECK NAME TO DECK IDENTIFIER TABLE ADDWRD TNCD,X6-X6 ADD NEXT LINE NUMBER SB5 TIDT FWA OF IDENT TABLE RJ PCS PROCESS CHARACTER SET READW P,T1,1 READ MODIFIER TABLE LENGTH NZ X1,PLE IF EOR SA1 T1 CHECK TABLE LX1 18 BX6 X6-X6 SB2 X1-700100B SB3 X1-700200B ZR B2,RMT1 IF NORMAL DECK NZ B3,PLE IF NOT COMMON DECK SX6 B1 RMT1 SA6 CD SET DECK STATUS LX1 42 SET TABLE LENGTH SB7 X1 ZR B7,RMT2 IF NO MODIFIERS ALLOC TNCD,B7 ALLOCATE FOR MODIFIERS ALLOC TDKI,B7 READW P,X2+B1,B7 READ MODIFIERS RMT2 SA3 MA ZR X3,RMT3 IF NO MODIFICATIONS SB6 X3 RJ AMD ADD MODIFIERS SA1 L.TDKI ALLOCATE PARALLEL TABLE SB7 X1 ALLOC TNCD,B7 RMT3 SA1 YK ZR X1,RMTX IF NO YANKS - RETURN * ADD YANKS. SA2 L.TDKI SEARCH MODIFIER TABLE SA1 F.TDKI SX0 1S16 YANK/UNYANK MASK SB4 X2+ SA5 X1 BX7 X7-X7 CLEAR YANK COUNT RMT4 EQ B4,B1,RMT6 IF END OF MODIFIER TABLE SA5 A5+B1 NEXT ENTRY SB4 B4-B1 SX2 1S15 SEARCH FOR YANK SEARCH TNME,X5+X2,X2 ZR X2,RMT4 IF NOT FOUND BX1 X0*X2 CLEAR/SET YANK IN MODIFIER LX2 59-0 RMT5 BX5 -X0*X5 IX6 X5+X1 SA6 A5 SX7 X7+B1 COUNT YANK PL X2,RMT4 IF NOT YANK AFTER SA5 A5+B1 NEXT ENTRY SB4 B4-B1 NZ B4,RMT5 IF NOT AT END OF MODIFIERS RMT6 SA7 YD SET YANK FLAG EQ RMTX RETURN RPF SPACE 4,25 ** RPF - READ LINE FROM PROGRAM LIBRARY. * * EXIT (X1) = 0, IF NO EOR READ. * * USES ALL. * * CALLS RDC=. RPF SUBR ENTRY/EXIT READC A0,BUF,BUFL READ MHB,S NZ X1,RPFX IF EOR - RETURN SA1 BUF SHIFT TO FIRST MHB LX1 24 SX6 -B1 CLEAR MHB COUNT MX0 -18 SB2 B1 2 MHB-S ON FIRST PASS RPF1 LX1 18 SHIFT TO NEXT MHB BX7 -X0*X1 SB2 B2-B1 SX6 X6+B1 ZR X7,RPF2 IF END OF MHB LIST SA7 TMHB+X6 STORE MHB PL B2,RPF1 IF NOT AT END OF WORD SA1 A1+B1 NEXT WORD SB2 B1+B1 RESET MHB COUNT LX1 6 EQ RPF1 LOOP * READ COMPRESSED LINE. RPF2 SA5 BUF SET LINE ACTIVITY MX0 -16 SET IDENTIFIER INDEX MASK BX7 X5 SA6 NMHB SA7 CDAC READC A0,CDTX,MXCCL READ COMPRESSED LINE NZ X1,PLE IF EOR SX7 B6-CDTX SET WORD COUNT OF LINE LX5 -18 EXTRACT IDENTIFIER INDEX SA7 CDWC BX4 -X0*X5 SA2 F.TDKI SB2 X4 AX5 18 SET LINE NUMBER SA2 X2+B2 SET LINE IDENTIFIER SX3 X5 SA4 F.TNCD BX6 X0*X2 IX7 X6+X3 SA4 X4+B2 CHECK NEXT LINE FOR MODIFICATION SA7 A2 SET LINE COUNTER SA7 CDID IX6 X3-X4 NZ X6,RPF3 IF NO MODIFICATION SA2 MA SET MODIFICATION SX6 X2+ SA6 A2+1 RPF3 RJ CPF CONVERT PROGRAM FILE BX1 X1-X1 CLEAR EOR EQ RPFX RETURN RTF SPACE 4,20 ** RTF - READ LINE FROM TEXT FILE. * * ENTRY (A5) = TEXT INDEX ADDRESS. * (X5) = TEXT INDEX. * * EXIT (X6) = UPDATED TEXT INDEX. * * USES X - 1, 2, 3, 4, 5, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - ALL. RTF SUBR ENTRY/EXIT SA1 T SA2 F.TTXT NZ X1,RTF2 IF TEXT FILE WRITTEN SB2 X5 FIRST WORD INDEX MX4 -12 SA6 CDID PRESET (A6) SB3 A6-1 SA1 X2+B2 FIRST WORD BX7 X7-X7 RTF1 LX6 X1 MOVE WORD BX2 -X4*X1 SA6 A6+B1 SX7 X7+B1 COUNT WORD SA1 A1+B1 READ NEXT WORD NZ X2,RTF1 IF NOT ZERO BYTE SA7 B3 SET LINE LENGTH IX6 X5+X7 ADVANCE TEXT INDEX EQ RTFX RETURN * PROCESS DATA ON TEXT FILE. RTF2 SA1 T+5 CHECK TEXT FILE POSITION SA2 T+2 SX6 TBUF MX4 -24 IX7 X2-X6 BX4 -X4*X5 IX6 X4-X1 MI X6,RTF4 IF REQUIRED TEXT BEFORE BUFFER IX7 X6-X7 MX3 -12 PL X7,RTF4 IF REQUIRED TEXT AFTER BUFFER SB7 X2 (B7) = BUFFER LIMIT BX7 X7-X7 CLEAR WORD COUNT SB6 X6+TBUF (B6) = STARTING ADDRESS SA6 CDID PRESET (A6) SA1 B6 FIRST WORD SB3 A6-B1 RTF3 EQ B6,B7,RTF4 IF END OF BUFFER REACHED LX6 X1 MOVE WORD BX2 -X3*X1 SB6 B6+B1 SA6 A6+B1 SX7 X7+B1 COUNT WORD SA1 A1+B1 READ NEXT WORD NZ X2,RTF3 IF NOT ZERO BYTE SA7 B3 SET LINE LENGTH IX6 X5+X7 ADVANCE TEXT INDEX EQ RTFX RETURN RTF4 AX4 6 SET RANDOM ADDRESS SX6 B1 IX6 X4+X6 LX4 6 SET CURRENT TEXT INDEX BX7 X4 SA6 T+6 SA7 A6-B1 SX6 TBUF SET IN = OUT = FIRST SA6 T+2 SA6 A6+B1 READ T,R EQ RTF2 RESTART MOVE STB SPACE 4,20 ** STB - SEARCH TABLE FOR ENTRY WITH MASK. * * ENTRY (A0) = TABLE NUMBER. * (X1) = MASK. * (X6) = ENTRY TO SEARCH FOR. * * EXIT (X2) = 0, IF ENTRY NOT FOUND. * (X2) .NE. 0, TABLE ENTRY. * (A2) = ADDRESS OF TABLE ENTRY. * (X3) = INDEX OF TABLE ENTRY. * * USES X - 2, 3. * A - 2, 3. * B - 2. STB2 SA2 A2-B1 RESTORE ENTRY SX3 A2-B3 SET INDEX STB SUBR ENTRY/EXIT SA3 FTAB+A0 SA2 LTAB+A0 ZR X2,STBX IF TABLE EMPTY - RETURN SB2 X2 SB3 X3 SA2 X3 STB1 BX3 X6-X2 CHECK ENTRY SB2 B2-B1 BX3 X1*X3 SA2 A2+B1 ZR X3,STB2 IF REQUESTED ENTRY FOUND NZ B2,STB1 IF NOT END OF TABLE BX2 X2-X2 IF ENTRY NOT FOUND EQ STBX RETURN UPN SPACE 4,20 ** UPN - UNPACK NAME. * * ENTRY (X1) = NAME, LEFT JUSTIFIED ZERO FILL. * (B3) = CHARACTER ADDRESS. * * EXIT (B3) = UPDATED CHARACTER ADDRESS. * * USES X - 1, 6, 7. * A - 7. * B - 3. UPN1 BX7 -X6*X1 GET NEXT CHARACTER BX1 X6*X1 ERASE CURRENT CHARACTER SA7 B3+ SB3 B3+B1 ADVANCE ADDRESS LX1 6 NZ X1,UPN1 IF NOT END OF NAME SX7 1R SET TERMINAL BLANK SA7 B3+ UPN SUBR ENTRY/EXIT MX6 -6 LX1 6 EQ UPN1 WDR SPACE 4,25 ** WDR - WRITE DIRECTORY TO PROGRAM LIBRARY. * * ENTRY (A0) = ADDRESS OF FET FOR FILE. * * SET DATE IN IDENT TABLE AND WRITE TO *NPL*. * * USES X - 1, 2, 3, 4, 5, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - ALL. * * CALLS WTW=. WDR SUBR ENTRY/EXIT SA1 A0+ SA2 L.TNDK ZR X1,WDRX IF NO NEW PROGRAM LIBRARY - RETURN ZR X2,WDRX IF NO NEW DECKS - RETURN RECALL A0 SA1 PL ENTER PROGRAM LIBRARY NAME SA2 DATE ENTER DATE IN IDENT TABLE BX6 X1 LX7 X2 SA6 TIDT+1 SA7 A6+B1 BX7 X7-X7 CLEAR MODIFICATION DATE SA7 A7+B1 WRITEW A0,TIDT,TIDTL SA5 L.TNDK MERGE DECK COUNT AND DIRECTORY ID SA2 WDRA BX6 X5+X2 SA6 T1 WRITEW A0,T1,1 SA1 F.TNDK REMOVE FILE NAME POINTERS SB2 B1+B1 SB3 X5 MX4 24 SA2 X1+B1 BX6 -X4*X2 WDR1 SA6 A2 SB3 B3-B2 SA2 A2+B2 BX6 -X4*X2 NZ B3,WDR1 IF NOT COMPLETE WRITEW A0,X1,X5 WRITE DECK NAME TABLE WRITEF X2,R EQ WDRX RETURN WDRA CON 7000BS48 DIRECTORY ID WMT SPACE 4,20 ** WMT - WRITE MODIFIER TABLE. * * ADD DECK TO NEW DECK NAME TABLE. WRITE MODIFIER TABLE * TO *NPL*. * * USES ALL. * * CALLS ADW, WTW=. WMT SUBR ENTRY/EXIT SA1 MA SA2 DN ENTER DECK NAME IN IDENT TABLE SA3 TIDT+3 ZR X1,WMT1 IF NO MODIFICATIONS SA3 DATE ENTER NEW DATE WMT1 BX6 X2 LX7 X3 SA6 TIDT+1 SA7 TIDT+3 SA1 CD SX3 X1+6 ADDWRD TNDK,X2+X3 ENTER DECK NAME SX1 RI SET RANDOM INDEX RETURN ADDRESS SX2 X1 LX1 30 BX6 X1+X2 SA6 N+6 SX1 X2+B1 SX2 X1 LX1 30 BX6 X2+X1 SA6 M+6 SA1 CD SA2 WMTA ZR X1,WMT2 IF NOT COMMON DECK SA2 WMTB WMT2 SA1 L.TDKI MERGE MODIFIER COUNT AND MODIFIER TABLE ID SX5 X1-1 BX6 X2+X5 SA6 T1 SA2 CSC GET DISPLAY/ASCII FLAG SA1 CNPL SET CHARACTER SET OF NEW PROGRAM LIBRARY LX2 6 BX6 X1+X2 MERGE DISPLAY/ASCII FLAG SA6 TIDT+16B SA1 N ZR X1,WMT3 IF NO NEW PROGRAM LIBRARY WRITEW N,TIDT,TIDTL WRITE IDENT TABLE WRITEW N,T1,1 WRITE MODIFIER ID SA1 F.TDKI WRITE DECK MODIFIERS WRITEW X2,X1+B1,X5 SA1 M ZR X1,WMTX IF NOT SCRATCH FILE - RETURN WMT3 WRITEW M,TIDT,TIDTL WRITE IDENT TABLE WRITEW X2,T1,1 WRITE MODIFIER ID SA1 F.TDKI WRITE DECK MODIFIERS WRITEW X2,X1+B1,X5 EQ WMTX RETURN WMTA CON 7001BS48 MODIFIER TABLE ID FOR DECK WMTB CON 7002BS48 MODIFIER TABLE ID FOR COMMON DECK WNF SPACE 4,25 ** WNF - WRITE LINE TO NEW PROGRAM LIIBRARY. * * ENTRY (CDAC) = LINE ACTIVITY FLAG. * (CDID) = LINE IDENTIFICATION. * (CDWC) = WORD COUNT OF COMPRESSED LINE. * (CDTX) = FWA OF TEXT OF COMPRESSED LINE. * (NMHB) = NUMBER OF MODIFICATION HISTORY BYTES (MHBS). * (THMB) = TABLE OF MHBS. * * USES ALL. * * CALLS WTW=. WNF SUBR ENTRY/EXIT SA1 CDAC ACTIVITY TO BIT 59 SA5 NMHB STORE MHB TERMINATORS MX3 1 SA2 A1+B1 WORD COUNT OF LINE TO BITS 54 - 58 BX6 X6-X6 BX1 X3*X1 SA6 TMHB+X5 LX1 24 SA3 A2+B1 LINE NUMBER TO BITS 36 - 53 MX0 -16 SA6 A6+B1 LX2 18 SB3 X5 MHB COUNT BX3 -X0*X3 SA6 A6+B1 BX1 X1+X2 SA5 A5+B1 FIRST MHB SB2 B1 2 MHB,S ON FIRST PASS IX7 X1+X3 SA7 BUF * PACK AND WRITE MHB TABLE. WNF1 LX7 18 PACK MHB-S SB3 B3-B1 BX7 X5+X7 SB2 B2-B1 SA5 A5+B1 NEXT MHB PL B2,WNF1 IF NOT AT END OF WORD OF MHB,S SA7 A7+B1 STORE WORD SB2 B1+B1 BX7 X7-X7 PL B3,WNF1 IF NOT DONE WITH ALL MHB,S SX5 A7-BUF * WRITE MHB TABLE AND COMPRESSED LINE. SA1 N ZR X1,WNF2 IF NO NEW PROGRAM LIBRARY WRITEW N,BUF+1,X5 SA1 CDWC WRITEW X2,CDTX,X1 SA1 M ZR X1,WNFX IF NO SCRATCH LIBRARY - RETURN WNF2 WRITEW M,BUF+1,X5 SA1 CDWC WRITEW X2,CDTX,X1 EQ WNFX RETURN WOF SPACE 4,20 ** WOF - WRITE OUTPUT FILE. * * ENTRY (X1) .GT. 0, FWA OF LINE IN *C* FORMAT. * (X1) .LT. 0, -(FWA) OF LINE IN *S* FORMAT. * (X2) = LENGTH OF LINE IN *S* FORMAT. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * * CALLS CDD. * * MACROS WRITEC, WRITES, WRITEW. WOF SUBR ENTRY/EXIT SX6 B1+ INDICATE DATA WRITTEN TO OUTPUT FILE SA3 LC ADVANCE LINE COUNT SA6 LF SX6 X3+B1 SA6 A3 SA4 A3+B1 IX7 X6-X4 NG X7,WOF5 IF BOTTOM OF PAGE NOT REACHED BX6 X1 SAVE REQUEST LX7 X2 SA6 WOFA SA7 A6+B1 SA1 PN ADVANCE PAGE NUMBER SX7 X1+B1 SX6 3 RESET LINE COUNT SA6 A3 SA7 A1 RJ CDD CONVERT PAGE NUMBER MX1 -12 LX6 4*6 STORE PAGE NUMBER BX6 X1*X6 SA6 PAGE SA1 TO SX2 O ZR X1,WOF1 IF TERMINAL OUTPUT WRITEW X2,(=1H1),1 SA1 TL WRITEW X2,X1,6 WRITEW X2,TITL,TITLL EQ WOF2 CONTINUE PROCESSING WOF1 SA3 PN SX3 X3-2 NZ X3,WOF2 IF NOT FIRST TIME WRITEW X2,TERL,TERLL WRITEW X2,(=C* *),1 WRITE END OF LINE WOF2 SA1 WOFB CHECK IF TIME FOR CONTROL IMAGE SX6 B1 SA6 A1 SA3 TO NZ X1,WOF4 IF *MODIFY* CONTROL HAS BEEN OUTPUT ZR X3,WOF3 IF TERMINAL OUTPUT WRITEW X2,(=1H),1 *MODIFY* CONTROL IMAGE WOF3 WRITEW X2,CCDR,8 WRITEW X2,(=C* *),1 WRITE END OF LINE SA1 LC SET LINE COUNT FOR EXTRA LINE SX6 X1+B1 SA6 A1 WOF4 WRITEW X2,SBTL,SBTLL SA1 WOFA RESTORE REQUEST SA2 A1+B1 WOF5 NG X1,WOF6 IF *S* FORMAT WRITEC O,X1 EQ WOFX RETURN WOF6 BX1 -X1 WRITEK O,X1,X2 EQ WOFX RETURN WOFA CON 0 CON 0 WOFB CON 0 *MODIFY* CONTROL LINE ISSUE FLAG SSR SPACE 4,15 ** SSR - SELECT *S* READ FUNCTION. * * SELECT *RDS=* OR *RDA=* DEPENDING ON CHARACTER SET. * * ENTRY (CSC) = CURRENT CHARACTER SET. * * USES X - 3. * A - 3. * * CALLS RDA=, RDS=. SSR SUBR ENTRY/EXIT SA3 CSC GET CURRENT CHARACTER SET NZ X3,SSR1 IF ASCII RJ =XRDS= DISPLAY CODE EQ SSRX RETURN SSR1 RJ =XRDA= 6/12 DISPLAY BASED ASCII EQ SSRX RETURN SSW SPACE 4,15 ** SSW - SELECT *S* WRITE FUNCTION. * * SELECT *WTS=* OR *WTA=* DEPENDING ON CHARACTER SET. * * ENTRY (CSC) = CURRENT CHARACTER SET. * * USES X - 3. * A - 3. * * CALLS WTA=, WTS=. SSW SUBR ENTRY/EXIT SA3 CSC GET CURRENT CHARACTER SET NZ X3,SSW1 IF ASCII RJ =XWTS= DISPLAY CODE EQ SSWX RETURN SSW1 RJ =XWTA= 6/12 DISPLAY BASED ASCII EQ SSWX RETURN TITLE LIST SUBROUTINES. LCE SPACE 4,10 ** LCE - LIST COMPILE FILE DIRECTIVE ERROR MESSAGE. * * ENTRY (A0) = ERROR MESSAGE ADDRESS. * * EXIT ERROR MESSAGE AND LINE IN ERROR LISTED. * * USES X - 0, 1. * A - 1. * B - 3. * * CALLS ECD, LCS, LER, UPN. LCE SUBR ENTRY/EXIT SA1 AM CHECK FOR COMPRESSED COMPILE GENERATION ZR X1,LCE1 IF NOT COMPRESSED COMPILE FILE GENERATION RJ ECD EXPAND COMPRESSED LINE LCE1 SA1 =9L *ERROR* SB3 CHSP RJ UPN UNPACK ERROR DATA RJ LCS LIST LINE SX0 A0 RJ LER LIST ERROR MESSAGE EQ LCEX RETURN LCS SPACE 4,15 ** LCS - LIST LINE STATUS. * * USES X - 0, 1, 2, 3, 6. * A - 1, 2, 3, 6. * B - 2, 3, 4, 5. * * CALLS CDD, UPN, WOF. LCS SUBR ENTRY/EXIT SA1 CL NZ X1,LCSX IF LINE LISTED - RETURN BX6 X6-X6 SA6 A1+B1 CLEAR LIST REQUEST SA1 TMHB SA2 SC+1 MX0 -16 BX6 -X0*X1 SB6 CHAR+15+X2 ZR X6,LCS1 IF DECK LINE SA2 F.TDKI ADD CURRENT DECK NUMBER SA3 X2 BX1 -X0*X3 RJ CDD CONVERT TO DECIMAL DISPLAY LX6 4*6 BX1 X6 SB3 B6+ RJ UPN UNPACK NAME SB6 B3+ LCS1 PRINT -CHSP,B6+X1 LIST LINE SX6 1R CLEAR STATUS SA6 CHSP+4 SA6 A6+B1 SA6 A6+B1 SA6 CL SET LINE LISTED EQ LCSX RETURN LDS SPACE 4,15 ** LDS - LIST DECK STATUS. * * USES X - ALL. * A - 1, 2, 3, 4, 6, 7. * B - ALL. * * CALLS LTB, SFN, WOF. LDS SUBR ENTRY/EXIT LISTOP D,LDSX IF NO LIST FOR DECK STATUS - RETURN SA1 DN DECK NAME RJ SFN SPACE FILL NAME SA2 F.TDKI LX6 -12 SX4 X2+B1 SA6 BUF SA3 L.TDKI SX0 =C*MODIFIERS.* SX5 X3-1 RJ LTB LIST TABLE PRINT (=C* *) EQ LDSX RETURN LER SPACE 4,20 ** LER - LIST ERROR MESSAGE. * * ENTRY (X0) = ERROR MESSAGE ADDRESS. * (EA) = ERROR COUNTER ADDRESS TO BE INCREMENTED. * * EXIT CHSP CLEARED. * (EC) = INCREMENTED BY 1. * * USES ALL. * * CALLS WTC=, WTW=. LER SUBR ENTRY/EXIT LISTOP E,LER1 IF NO ERROR LIST SA2 O CHECK FOR OUTPUT FILE ZR X2,LER1 IF NO OUTPUT FILE WRITEW O,(=8A******* ),1 WRITEC X2,X0 SA2 LC ADVANCE LINE COUNT SX7 X2+B1 SA7 A2 LER1 SB2 9 CLEAR CHARACTER SPACING SX6 1R LER2 SA6 CHSP+B2 SB2 B2-1 PL B2,LER2 IF NOT COMPLETE SA1 EA ADVANCE ERROR COUNT SA1 X1 SX6 X1+B1 SA6 A1 EQ LERX RETURN LST SPACE 4,20 ** LST - LIST STATISTICS. * * LIST DECKS ON PROGRAM LIBRARY. LIST DECKS ON *NPL*. * * USES ALL. * * CALLS CDD, LTB, WOF. LST SUBR ENTRY/EXIT LISTOP S,LSTX IF NO LIST FOR STATISTICS - RETURN SX6 =60HSTATISTICS. SX7 99999 FORCE PAGE EJECT SA6 TL SA7 LC SA1 =1H CLEAR FIRST WORD OF BUFFER SX7 B1+B1 RESET WORDS/ENTRY BX6 X1 SA6 BUF SA7 LTBA SA6 SBTL+1 CLEAR SUBTITLE SA6 A6+B1 * LIST DECKS ON PROGRAM LIBRARY. SX0 =C*DECKS ON PROGRAM LIBRARY.* SA4 F.TDKN SA5 DL RJ LTB LIST TABLE * LIST COMMON DECKS ON PROGRAM LIBRARY. SA1 DL SA2 F.TDKN BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE SA5 X2 SA7 L.TDKI ZR X1,LST3 IF NO DECKS IN PROGRAM LIBRARY SB6 B1+B1 MX0 -16 SB7 X1+ LST1 BX1 -X0*X5 SB2 X1-7 NZ B2,LST2 IF NOT COMMON DECK ADDWRD TDKI,X5 ADD DECK ADDWRD A0,X6-X6 LST2 SB7 B7-B6 SA5 A5+B6 NZ B7,LST1 IF NOT END OF DECK NAME TABLE LST3 SA4 F.TDKI SA5 L.TDKI SX0 =C*COMMON DECKS ON PROGRAM LIBRARY.* RJ LTB LIST TABLE * LIST INTRODUCED DECKS. SA1 L.TDKN SA2 DL IX5 X1-X2 ZR X5,LST4 IF NO DECKS INTRODUCED SA3 F.TDKN IX4 X3+X2 SX0 =C*DECKS ADDED BY INITIALIZATION DIRECTIVES.* RJ LTB LIST TABLE * LIST DECKS ON NEW PROGRAM LIBRARY. LST4 SA1 N ZR X1,LST5 IF NO NEW PROGRAM LIBRARY SX0 =C*DECKS ON NEW PROGRAM LIBRARY.* SA4 F.TNDK SA5 L.TNDK RJ LTB LIST TABLE * REMOVE COMMON DECKS FROM EDIT TABLE. LST5 SA1 L.TEDT SA4 F.TEDT SB3 X1 BX5 X5-X5 SA2 X4 SB4 X4 SA3 C ZR X1,LST8 IF EDIT TABLE EMPTY ZR X3,LST8 IF NO COMPILE FILE SB6 B1+B1 SB2 -B6 LST6 BX6 X2 STORE DECK NAME SA1 A2+B1 CHECK DECK TYPE SA3 X1 BX7 X1 SB7 X3-OCRT SA6 B4+X5 SA7 A6+B1 SX5 X5+B6 NZ B7,LST7 IF NOT COMMON DECK SX5 X5+B2 LST7 SB3 B3-B6 SA2 A2+B6 NZ B3,LST6 IF NOT END OF EDIT TABLE * LIST DECKS ON COMPILE FILE. LST8 SX0 =C*DECKS WRITTEN ON COMPILE FILE.* RJ LTB LIST TABLE PRINT (=C* *) * LIST STORAGE USED AND LINE COUNT. SA1 FTAB+FTABL ROUND UP STORAGE USED SX7 MTBS+300 MINIMUM CORE REQUIRED IX3 X1-X7 PL X3,LST9 IF CURRENT USED MORE THAN MINIMUM SX1 X7 LST9 SA2 =1AB MX0 -3 SB3 1R0-1R SB2 B0 SX1 X1+77B ROUND UP FL USED AX1 6 LX1 6 LST10 BX7 -X0*X1 CONVERT TO OCTAL DISPLAY LX2 -6 SB2 B2+6 SX3 X7+B3 AX1 3 IX2 X2+X3 NZ X1,LST10 IF NOT FINISHED CONVERTING LX6 X2,B2 SA6 LSTA+1 SA1 NC LINE COUNT SA2 A1+B1 IX1 X1+X2 RJ CDD CONVERT TO DECIMAL DISPLAY SA6 LSTB PRINT LSTA EQ LSTX RETURN LSTA DATA 10H DATA 10H DATA H* STORAGE USED.* LSTB DATA 10H DATA C* LINES WRITTEN ON COMPILE FILE.* LTB SPACE 4,20 ** LTB - LIST TABLE. * * LIST SPECIFIED TABLE ON OUTPUT FILE. * * ENTRY (X0) = MESSAGE ADDRESS. * (X4) = TABLE ADDRESS. * (X5) = LENGTH OF TABLE. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - ALL. * B - 2, 3, 4, 5, 6. * * CALLS SFN, WOF. LTB SUBR ENTRY/EXIT SA1 LC CHECK LINE COUNT SA0 X4 (A0) = TABLE ADDRESS SA2 A1+B1 SX6 X1+4 IX7 X6-X2 PL X7,LTB1 IF NOT ROOM FOR FIRST LINE OF TABLE PRINT (=C* *) SA1 LC BX6 X1 LTB1 SA6 A1 UPDATE LINE COUNT MX3 -12 COPY MESSAGE TO BUFFER SA2 X0 LX6 X2 SB2 BUF+1 LTB2 SA6 B2 BX7 -X3*X2 SB2 B2+B1 SA2 A2+B1 LX6 X2 NZ X7,LTB2 IF NOT END OF MESSAGE PRINT BUF SA1 =1H CLEAR FIRST WORD OF BUFFER BX6 X1 MX0 42 SA6 BUF PRINT (=C* *) NZ X5,LTB3 IF TABLE NOT EMPTY PRINT (=C+ * NONE * +) EQ LTBX RETURN * LIST SPECIFIED TABLE. LTB3 SA1 LTBA SET ENTRY COUNT SB2 X1-1 AX4 X5,B2 COMPUTE NUMBER OF ROWS SX3 X4+11 PX6 X3 SA2 =12. FX4 X6/X2 UX3 B2,X4 BX6 X6-X6 CLEAR ENTRY INDEX LX0 X3,B2 PX2 X0 COMPUTE ENTRY INCREMENT (ROWS*ENTRY) PX7 X1 SA6 A1+B1 DX3 X7*X2 UX6 X3 SA6 A6+B1 LTB4 SX0 X0-1 DECREMENT ROW COUNT SA1 LTBA+1 SET ENTRY INDEX MI X0,LTBX IF ALL ROWS LISTED - RETURN SA2 A1-B1 ADVANCE TABLE SA3 A1+B1 SET ENTRY INCREMENT IX6 X1+X2 SB3 X1 SB6 X3 MX4 42 SA6 A1 SB4 X5 SB5 B0+ LTB5 SA1 B3+A0 TABLE ENTRY BX1 X4*X1 RJ SFN SPACE FILL NAME SA1 A1 TABLE ENTRY LX1 59-16 CHECK YANK BIT PL X1,LTB6 IF NOT YANKED SA2 LTBB ADD() IX6 X6+X2 LTB6 LX6 -6 STORE NAME SA6 BUF+1+B5 SB5 B5+B1 SB3 B3+B6 LT B3,B4,LTB5 IF NOT AT END OF LINE BX6 X6-X6 SA6 A6+B1 PRINT BUF MX4 42 EQ LTB4 LOOP LTBA CON 2 WORDS/ENTRY CON 0 TEMPORARY CON 0 TEMPORARY LTBB CON 10H ) (-1H LUM SPACE 4,15 ** LUM - LIST UNPROCESSED MODIFICATIONS. * * ENTRY (X5) = MODIFICATION TABLE ADDRESS. * * USES X - ALL. * A - 1, 2, 3, 4, 5, 6, 7. * B - 2, 3. * * CALLS LER, PML, SFN, UPN, WOF. LUM SUBR ENTRY/EXIT SA1 =9L *ERROR* SB3 CHAR RJ UPN UNPACK NAME LUM1 SB3 X5 ZR B3,LUMX IF END OF MODIFICATIONS - RETURN SA5 B3 SA1 A5+B1 LX6 X5,B1 MI X1,LUM2 IF ERROR FLAG SET MI X6,LUM2 IF DELETE SA2 A1+B1 CHECK TEXT STATUS AX2 24 SX7 X2 ZR X7,LUM1 IF TEXT PROCESSED * AN ERROR OCCURRED ON MODIFICATION LINE. LUM2 SX6 X5 SAVE POSITION SB2 B1+B1 SA6 LUMA SA2 A5+B2 ENTER IDENTIFIER NAME AX2 42 SA1 X2 MX0 42 BX1 X0*X1 RJ SFN SPACE FILL NAME BX1 X6 SB3 CHAR+10 RJ UPN UNPACK NAME SB2 B1+1 PL X5,LUM3 IF NOT INSERT SA1 =7LINSERT, EQ LUM4 LUM3 SA1 =7LDELETE, LX2 X5,B2 PL X2,LUM4 IF DELETE SA1 =8LRESTORE, LUM4 RJ UPN UNPACK MODIFICATION TYPE RJ PML PREPARE MODIFICATION LIMIT SA1 A5 SA5 A5+B1 CHECK NEXT WORD MX2 36 BX6 X1-X5 LX2 54 BX7 X2*X6 ZR X7,LUM5 IF SAME IDENTIFICATION BX6 X2*X5 ZR X6,LUM5 IF LIMIT = 0 SX6 1R, ADD COMMA TO PREVIOUS LIMIT SA6 B3-B1 RJ PML PREPARE MODIFICATION LIMIT LUM5 SX0 B3-CHAR PRINT (=C* *) PRINT -CHAR,X0 SA5 A5 EXTRACT ERROR CODE SB2 X5 SA1 LUMB+B2 SET ERROR SX0 X1 RJ LER LIST ERROR SA5 LUMA RESTORE POSITION EQ LUM1 LOOP LUMA CON 0 LUMB BSS 0 LOC 0 CON =C*DIRECTIVE NOT REACHED.* CON =C*UNKNOWN MODIFIER.* CON =C*OVERLAPPING MODIFICATION.* CON =C*FIRST SOURCE LINE IS AFTER SECOND SOURCE LINE.* LOC *O PML SPACE 4,15 ** PML - PREPARE MODIFICATION LIMIT. * * ENTRY (X5) = MODIFICATION LIMIT WORD. * (A6) = NEXT BUFFER ADDRESS. * * USES X - 0, 1, 2, 3, 4, 5, 6. * A - 1, 6, 7. * B - 2, 3, 5. * * CALLS CDD, UPN. PML SUBR ENTRY/EXIT AX5 18 SET LINE NUMBER SX3 X5 AX5 18 SA1 X5 SET MODIFIER NAME MX0 42 BX1 X0*X1 RJ UPN UNPACK NAME SX6 1R. ADD PERIOD SA6 B3 SB6 B3+B1 SX1 X3 CONVERT NUMBER RJ CDD CONVERT TO DECIMAL DISPLAY SB3 B6 BX1 X4 LEFT JUSTIFIED NUMBER RJ UPN UNPACK NUMNER EQ PMLX RETURN BUFFERS TITLE COMMON DECKS AND BUFFERS. ** PROGRAM LIBRARY DIRECTIVE PROCESSOR TABLE. HERE DATA 0 END OF TABLE SPACE 4 *CALL COMCDXB *CALL COMCCDD *CALL COMCSFN *CALL COMCMVE *CALL COMCRDA *CALL COMCRDC *CALL COMCRDS *CALL COMCRDW *CALL COMCWTA *CALL COMCWTC *CALL COMCWTS *CALL COMCWTW *CALL COMCCIO *CALL COMCSYS SPACE 4 ** BUFFERS. BUFFERS SPACE 4 USE BUFFERS BLOCKS SPACE 4,10 ** BLOCK STORAGE. TITLE SPACE 4,6 ** TITLE LINE. TITL DATA 20H MODIFY - VER 1.2 DATE CON 1H TIME CON 1H CON 4APAGE PAGE CON 1H TITLL EQU *-TITL ** TERMINAL TITLE LINE. TERL DATA 50H MODIFY - VER 1.2 TERDT CON 1H TERTM CON 1H TERLL EQU *-TERL SPACE 4,6 ** ALTERNATE TITLE. ALT DATA 60HDECK STATUS AND MODIFICATIONS. * *MODIFY* INPUT SUB-HEADER. TLT DATA 60HMODIFY INPUT. SUB SPACE 4,6 ** SUB-TITLE LINE. SBTL DATA 30H CON 0 CON 2L SBTLL EQU *-SBTL IDENT SPACE 4,6 ** IDENT TABLE. TIDT VFD 12/7700B,12/TIDTL-1,36/0 BSSZ 16B TIDTL EQU *-TIDT SPACE 4,6 ** COMPRESSED COMPILE FILE HEADER. CIDT VFD 12/7700B,12/TIDTL-1,12/0000B,24/0 OPL SPACE 4,6 ** OPL FILE NAME TABLE. TOFN CON 0 INDEX BSS 50 TOFNL EQU *-TOFN CDAC SPACE 4,10 ** PROGRAM LIBRARY PROCESSING BUFFERS. * * THE ORDER OF THE FOLLOWING MUST * BE MAINTAINED. CDAC CON 1S59 LINE ACTIVITY CDWC CON 0 WORD COUNT OF COMPRESSED LINE CDID CON 1 CARD ID CDTX BSS MXCCL TEXT OF COMPRESSED LINE CVTX BSS MXCCL CONVERSION BUFFER NMHB CON 1 NUMBER OF MODIFICATION HISTORY BYTES TMHB CON 1S16 MODIFICATION HISTORY BYTE TABLE BSS 199 CDCT SPACE 4,10 ** CHARACTER STRING BUFFER. CDCT DATA 1 LINE COUNT-(MUST PROCEED CHSP) CHSP BSS 0 SPACING FOR LIST DUP 10+IWMAX+26,1 CON 1R CHAR EQU CHSP+10 USBB EQU CHAR STRING BUFFER BUFFERS SPACE 4,10 ** BUFFER ALLOCATION. BUF BSS 0 SCRATCH BUFFER PBUF EQU BUF+BUFL OBUF EQU PBUF+PBUFL CBUF EQU OBUF+OBUFL SBUF EQU CBUF+CBUFL MBUF EQU SBUF+SBUFL NBUF EQU MBUF+MBUFL TBUF EQU NBUF+NBUFL MTBS EQU TBUF+TBUFL RFL= EQU MTBS+MTBSL+4 ERRNG PBUF-USBB-81 STRING BUFFER OVERFLOWS CODE IDENT SPACE 4 IDENT TERMINATE BLOCK QUAL DIRECT PDC TITLE DIRECTIVE LINE PROCESSING. ** DIRECTIVE LINE PROCESSORS WILL BE OVERLAID AFTER COMPLETION. DATA SPACE 4 ** DATA STORAGE. ORG PBUF CDLS CON 0 LINE LIST FLAGS INSF CON 0 INSERT FLAG AIDT CON 0 ASSUMED IDENTIFIER NUMBER LCAC CON 0 ADDRESS+1 OF LAST CHARACTER ON *READS* * THE ORDER OF THE FOLLOWING MUST BE MAINTAINED. MDTI CON 0 MODIFICATION TABLE INDEX IDT1 CON 0 FIRST LIMIT IDENTIFICATION CON 0 IDT2 CON 0 SECOND LIMIT IDENTIFICATION CON 0 MDSA CON 0 MODIFICATION SET NAME ADDRESS PDC SPACE 4,10 *** INPUT RECORD COMMENTS. * * THE FOLLOWING DIRECTIVE IS RECOGNIZED AS A COMMENT IN THE * MODIFY INPUT STREAM. * * / CCC-CCC PDC SPACE 4,10 ** PDC - PROCESS DIRECTIVE LINES. PDC10 RJ IPC INSERT PREFIX CHARACTER PDC SUBR ENTRY/EXIT SA1 ZM CHECK FOR *Z* MODE ARGUMENT NZ X1,PDC0 IF *Z* ARGUMENT SELECTED SA1 I ZR X1,PDC9 IF NO INPUT FILE READ I PDC0 BSS 0 RJ RDD READ FIRST DIRECTIVE NZ X1,PDC9 IF EOR EQ PDC2 * PROCESS NEXT DIRECTIVE. PDC1 RJ RDD READ DIRECTIVE NZ X1,PDC8 IF EOR PDC2 CARD COPY RJ CRD CONDITIONALLY READ DIRECTORY PDC3 SA1 PDCB INCREMENT DIRECTIVE COUNT SX7 X1+B1 SA7 A1 CARD COPYPL CARD CREATE CARD CSET CARD DECK CARD DEFINE CARD EDIT CARD IDENT CARD INWIDTH CARD MOVE CARD NOSEQ CARD OPLFILE CARD PREFIX CARD PREFIXC CARD PURDECK CARD SEQ CARD SORSEQ CARD UNYANK CARD UPDATE CARD WIDTH CARD YANK CARD IGNORE RMT VFD 42/1L/,18/PDC6 LIST COMMENT LINE RMT SX6 1S"LO.T" SA6 CDLS CARD D,DELETE CARD DELETE CARD I,INSERT CARD INSERT CARD MODNAME CARD RESTORE SA2 INSF NZ X2,PDC4 IF INSERTING NZ X4,ERR1 IF NOT NULL DIRECTIVE SA1 PDCB DECREMENT DIRECTIVE COUNT SX7 X1-1 SA7 A1 EQ PDC6.1 CONTINUE PDC4 RJ CCD COMPRESS LINE RJ WTF WRITE TEXT FILE SA1 F.TMOD INCREMENT DIRECTIVE COUNT SA2 L.TMOD SX0 B1+ IX3 X1+X2 LX0 24 SA1 X3-1 IX6 X1+X0 SA6 A1 * DIRECTIVE PROCESSORS RETURN HERE TO LIST LINE. PDC5 SX6 1 SET *CREATE*, *COPYPL* NOT ALLOWED SA6 PDCA PDC6 RJ LDC LIST LINE PDC6.1 SA1 DL MI X1,PDC1 IF NO DIRECTORY * DIRECTIVE PROCESSORS RETURN HERE TO READ NEXT LINE. PDC7 RJ RDD READ NEXT DIRECTIVE ZR X1,PDC3 IF NOT EOR/EOF/EOI PDC8 SA1 DE CHECK FOR DIRECTIVE ERRORS SA2 DB NZ X1,PDC8.1 IF ERRORS SA1 PDCB GET DIRECTIVE COUNT ZR X1,PDC9 IF NO DIRECTIVES PROCESSED EQ PDC10 CONTINUE PDC8.1 NZ X2,PDC10 IF DEBUG SELECTED BX6 X6-X6 CLEAR EDIT TABLE SA6 L.TEDT RJ LST LIST STATISTICS SA0 =C* DIRECTIVE ERRORS.* EQ ABT * PROCESS EMPTY INPUT FILE. PDC9 SA1 FM SA0 =C* NO DIRECTIVES.* ZR X1,ABT IF NOT *F* MODE SA5 P+7 READ *P* FILE DIRECTORY RJ RDR READ DIRECTORY NZ X0,ABT IF ERRORS IN OPL SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH BX6 X1 SA6 DL EQ PDC10 COMPLETE PROCESSING PDCA CON 0 *CREATE*, *COPY* ALLOWED FLAG PDCB CON 0 DIRECTIVE COUNT ERR SPACE 4 ** ERR - DIRECTIVE ERROR PROCESSORS. ERR SA6 ERRM SET ERROR MESSAGE ADDRESS EQ PDC6 EXIT ERR1 SX6 =C*INCORRECT DIRECTIVE.* EQ ERR ERR2 SX6 =C*FORMAT ERROR IN DIRECTIVE.* EQ ERR ERR3 SX6 =C*IDENT NAME PREVIOUSLY REFERENCED.* EQ ERR ERR4 SX6 =C* INITIALIZATION DIRECTIVE OUT OF ORDER.* EQ ERR PUT OUT ERROR MESSAGE AND CONTINUE SPACE 4,10 *** INITIALIZATION DIRECTIVES. * * THE FOLLOWING DIRECTIVES MUST BE THE FIRST DIRECTIVES * OTHER THAN FILE MANIPULATION DIRECTIVES. * DECKS INTRODUCED BY THESE DIRECTIVES TAKE PRECEDENCE OVER * ANY PREVIOUS DECKS BY THE SAME NAME. * THESE PREVIOUS DECKS ARE DENOTED IN THE DIRECTORY LISTS * BY BEING ENCLOSED IN PARENS. COPY SPACE 4,10 *** COPY FNAME,RNAME * * COPY PROGRAM LIBRARY *FNAME* TO OPL FILE FOR RANDOM ACCESS. * *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD * TO BE COPIED. COPY SA1 P SA2 CPYA SX5 P+7 SET PROGRAM LIBRARY NAME ZR X1,ERR1 IF NO PROGRAM LIBRARY NAME NZ X2,CPY1 IF NOT FIRST ENTRY EVICT A1,R CPY1 SA1 PDCA NZ X1,ERR4 IF *COPY* NOT ALLOWED RECALL M SA1 X5 SET FILE NAME BX6 X1 SX7 X5 SET FILE NAME ADDRESS SA6 X2 SA7 CPYA RJ SAF SET ALTERNATE FILE SA1 CH CHECK NEXT CHARACTER SX2 B1+B1 SET BINARY FILE IX7 X6+X2 SA3 X1 BX6 X6-X6 SA7 A SB2 X3-1R, NZ B2,CPY2 IF NO COMMA SX7 X1+B1 SKIP COMMA SA7 A1 RJ ASN ASSEMBLE RECORD NAME CPY2 SA6 CPYB SET RECORD NAME READ A READW A,BUF,BUFL READ FIRST PART SX6 =C*COPY FILE EMPTY.* MI X1,ERR IF EOR/EOF/EOI * READ REMAINDER OF RECORD(S). CPY3 BX6 X1 SAVE WORD COUNT SA6 T1 SX1 B6 LWA+1 OF DATA READ SX2 BUF SET RECORD TYPE RJ SRT SET RECORD TYPE SB2 X6-ODRT NZ B2,CPY5 IF NOT *OPLD* CPY4 READW A,BUF,BUFL SKIP DIRECTORY ZR X1,CPY4 IF NOT EOR/EOF/EOI EQ CPY8 * COPY ONE RECORD. CPY5 SA7 CPYC+1 ENTER DECK NAME IN MESSAGE ADDWRD TNDK,X6 ENTER RECORD NAME ADDWRD A0,X6-X6 SX7 A6 SET RANDOM RETURN ADDRESS SA7 M+6 MESSAGE CPYC,1 ISSUE CONSOLE MESSAGE SA1 T1 CHECK RECORD LENGTH NZ X1,CPY7 IF SHORT BLOCK CPY6 WRITEW M,BUF,BUFL WRITE RECORD READW A,BUF,BUFL READ NEXT BLOCK ZR X1,CPY6 IF NOT EOR/EOF/EOI CPY7 WRITEW M,BUF,X1-BUF WRITER X2 SA1 CPYB ZR X1,CPY8 IF NO RECORD NAME OPTION SA2 CPYC+1 COMPARE NAMES BX6 X2-X1 ZR X6,CPY9 IF RECORD REACHED * BEGIN NEXT RECORD. CPY8 READ A BEGIN NEW READ RECALL M READW A,BUF,BUFL PL X1,CPY3 IF NOT EOF SA2 CPYB ZR X2,CPY9 IF NO RECORD NAME OPTION SA3 CPYC+1 BX7 X2-X3 ZR X7,CPY9 IF RECORD REACHED SX6 =C*RECORD NOT FOUND.* SA6 ERRM CPY9 RJ LDC LIST DIRECTIVE LINE SA2 =10H LISTOP C,CPY10 IF NO LIST FOR COPY LINE BX6 X2 SA4 F.TNDK LIST RECORDS COPIED SA5 L.TNDK SA6 BUF SX0 =C*RECORDS COPIED.* RJ LTB LIST TABLE PRINT (=C* *) CPY10 SA0 M WRITE DIRECTORY RJ WDR WRITE DIRECTORY SA5 CPYA ADD DECKS RJ ADK ADD DECK MESSAGE CCDR,1 SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH BX6 X1 SA6 DL EQ PDC7 EXIT TO READ NEXT LINE CPYA CON 0 FILE NAME ADDRESS CPYB CON 0 RECORD NAME IF REQUESTED CPYC CON 10H COPY / CON 0 COPYPL SPACE 4,10 *** COPYPL FNAME,DNAME * * COPY PROGRAM LIBRARY *FNAME* TO AN INTERNAL FILE FOR RANDOM * ACCESS. * *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD * TO BE COPIED. COPYPL SX5 A+7 COPY TO SCRATCH FILE EQ CPY1 CREATE SPACE 4,10 *** CREATE FNAME * * CREATE DECK(S) FROM SOURCE FILE *FNAME*. * DECKS ARE CREATED TO A SCRATCH FILE FOR MODIFICATION USE. * IF A DECK DUPLICATES A DECK ON THE PROGRAM LIBRARY, THE * NEW DECK IS USED FOR MODIFICATION. CREATE SA1 PDCA NZ X1,ERR4 IF *CREATE* NOT ALLOWED SA1 CVT DIS-ALLOW CREATE WITH CONVERSION SA0 =C*CREATE NOT ALLOWED WITH CONVERSION.* NZ X1,ABT IF CONVERSION BEING MADE RJ SAF SET ALTERNATE FILE SA1 CH CHECK NEXT CHARACTER SA3 X1 SB2 X3-1R CHECK FOR BLANK TERMINATOR NZ B2,ERR1 IF NOT TERMINATED SA6 A SET CREATION FILE NAME READ A READW A,T1,1 SA0 =C*CREATION FILE EMPTY.* NZ X1,ABT IF EOR/EOF/EOI RJ LDC LIST DIRECTIVE LINE SB6 TIDTL-1 CLEAR *77* TABLE SX7 B0+ CRT0 SA7 TIDT+B6 SB6 B6-1 GT B6,B1,CRT0 IF NOT COMPLETE SA1 A+7 USE SCRATCH FILE SA2 DATE SET CREATION DATE BX6 X1 LX7 X2 SA6 M BX6 X6-X6 SA6 N CLEAR NEW PROGRAM LIBRARY SA7 TIDT+2 RECALL A SA1 X2+B1 SET OUT = FIRST SX6 X1 SA6 A1+2 SA1 IW READS A,CHAR,X1 * BEGIN NEW DECK. CRT1 SX6 CHAR SET CHARACTER POINTER SA6 CH BX7 X7-X7 SA7 CD CLEAR COMMON DECK SA7 CRTF CLEAR CHARACTER SET FOUND SX7 .DIS NOMINAL CHARACTER SET IS DISPLAY SA7 CSC RJ ASN ASSEMBLE NAME SA0 =C*FORMAT ERROR IN DIRECTIVE.* ZR X6,ABT IF NAME BLANK OR TOO LONG SA6 DN SET DECK NAME SA6 CRTA+1 INSERT NAME IN MESSAGE MESSAGE A6-B1,1 CRT1.1 SA1 IW LOOP LOOKING FOR COMMON/ASCII/DISPLAY READK A,CHAR,X1 READ NEXT LINE SX6 B6 LAST CHARACTER ADDRESS SA6 LCAC SX6 CHAR SET CHARACTER POINTER SA6 CH RJ ASN ASSEMBLE NAME ZR X6,CRT2 IF BLANK NAME OR TOO LONG SA2 CD NZ X2,CRT1.2 IF COMMON DECK HEADER CARD ALREADY FOUND SA1 =0LCOMMON BX2 X6-X1 SX7 B1 NZ X2,CRT1.2 IF NOT A *COMMON* DECK SA7 CD SET COMMON DECK EQ CRT1.1 READ NEXT LINE CRT1.2 SA2 CRTF NZ X2,CRT2 IF CHARACTER SET HEADER CARD ALREADY FOUND SA6 CSR INDICATE CHARACTER SET REQUEST RJ RCS REQUEST CHARACTER SET NZ X6,CRT2 IF THIS LINE NOT CHARACTER SET HEADER SX7 B1 SA7 CRTF FIRST PASS CHARACTER SET HEADER SA1 CD ZR X1,CRT1.1 IF COMMON DECK HEADER NOT FOUND YET SA1 IW READK A,CHAR,X1 READ TEXT FOLLOWING HEADER CARDS SX6 B6+ SET LAST CHARACTER ADDRESS SA6 LCAC CRT2 RJ WMT WRITE MODIFIER TABLE * COPY SOURCE TEXT. CRT3 RJ CCD COMPRESS LINE RJ WNF WRITE NEW PROGRAM LIBRARY SA1 CDID ADVANCE LINE NUMBER SX6 X1+B1 SA6 A1 SA1 IW READK A,CHAR,X1 READ NEXT LINE SX6 B6+ SET LAST CHARACTER ADDRESS SA6 LCAC ZR X1,CRT3 IF NO EOR/EOF/EOI * COMPLETE CURRENT DECK. WRITER M,R END CURRENT DECK SA1 RI+1 ENTER RANDOM INDEX SX2 N+7 LX2 36 ADDWRD TNDK,X2+X1 SX6 B1 RESET LINE COUNTER SA6 CDID READ A BEGIN NEW RECORD SA1 IW READS A,CHAR,X1 READ NEXT LINE ZR X1,CRT1 IF NOT EOR/EOF/EOI * TERMINATE CREATE. LISTOP C,CRT4 IF NO LIST FOR DIRECTIVE SX0 =C*DECKS CREATED.* SA4 F.TNDK LIST DECKS SA5 L.TNDK SA1 =1H BX6 X1 SA6 BUF RJ LTB LIST TABLE PRINT (=C* *) CRT4 SA1 N+7 RESTORE NEW PROGRAM LIBRARY FILE SX5 A+7 ADD DECKS BX7 X1 SA7 N BX6 X6-X6 CLEAR SCRATCH FILE NAME SA6 M RJ ADK ADD DECK MESSAGE CCDR,1 EQ PDC7 EXIT TO READ NEXT LINE CRTA CON 10H CREATE / CON 0 CRTF CON 0 CHARACTER SET REQUEST FOUND FOR THIS DECK CSET SPACE 4,10 *** CSET DNAME * * DECLARE THE INITIAL CHARACTER SET FOR READING MODSETS. * IF OMITTED, *CSET* DEFAULTS TO *ASCII*. CSET RJ ASN ASSEMBLE NAME OF *CSET* MX3 42 SA1 TCST-1 FWA-1 OF CHARACTER SET TABLE CSET1 SA1 A1+B1 ZR X1,CSET2 IF UNKNOWN CHARACTER SET BX4 X3*X1 BX7 X6-X4 NZ X7,CSET1 IF NO MATCH BX7 -X3*X1 SA7 CSC EQ PDC6 RETURN CSET2 SX6 =C*CSET - UNKNOWN CHARACTER SET.* EQ ERR EXIT WITH ERROR MESSAGE OPLFILE SPACE 4,10 *** OPLFILE FNAME,FNAME,...,FNAME * * DECLARE FILE(S) *FNAME* TO BE AN ADDITIONAL PROGRAM LIBRARY * FILE(S). OPLFILE SA1 PDCA NZ X1,ERR4 IF *OPLFILE* NOT ALLOWED RJ SAF SET ALTERNATE FILE SA1 TOFN SB2 X1-TOFNL+1 MI B2,OFN1 IF ROOM IN FILE NAME TABLE SX6 =C*TOO MANY OPL FILES.* EQ ERR OFN1 SB2 X1+B1 ADD FILE NAME SX3 B1+B1 BX6 X6+X3 SX7 B2 ADVANCE INDEX SA6 A1+B2 SA7 A1+ SA5 A1+B2 READ DIRECTORY RJ RDR READ DIRECTORY SX6 A0+ NZ X0,ERR IF ERRORS IN OPL SA1 CH CHECK NEXT CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R, SA6 A1+ ZR B2,OPLFILE IF COMMA LOOP EQ PDC6 EXIT DECK SPACE 4,10 *** MODIFICATION DIRECTIVES. * * MODIFICATION DIRECTIVES WHICH REFER TO ACTUAL LINES ON THE * PROGRAM LIBRARY INCLUDE THE IDENTIFICATION OF THE LINE AT * WHICH MODIFICATION TAKES PLACE. THE IDENTIFICATION HAS THE * GENERAL FORM *MNAME*.*NUMBER*, WHERE *MNAME* = THE NAME OF * THE MODIFIER, AND *NUMBER* IS THE NUMBER OF THE LINE. * FOR ORIGINAL LINES IN THE DECK, THE LINE IDENTIFICATION MAY * BE SHORTENED TO *NUMBER*. THE IDENTIFICATION IS REFERRED * TO AS *C* OR *CN* IN THE DESCRIPTION OF THE DIRECTIVES. DECK SPACE 4,10 *** DECK DNAME * * SET DECK NAME FOR MODIFICATION TO *DNAME* * THIS DIRECTIVE MUST PRECEED ALL DIRECTIVES WHICH RESULT IN * THE MODIFICATION OF A DECK. DECK RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NAME BLANK OR TOO LONG SA1 IG ZR X1,DCK2 IF NO IGNORES SEARCH TIGD,X6 ZR X2,DCK2 IF DECK IS NOT TO BE IGNORED SA6 DCKA+1 MESSAGE A6-B1,1 SA1 LO CHECK LIST OPTIONS SA2 CDLS BX6 X1*X2 ZR X6,DCK0 IF LIST OPTION OFF PRINT (=C* IGNORE THE FOLLOWING DECK*) PRINT (=C* *) DCK0 RJ LDC LIST DIRECTIVE LINE DCK1 RJ RDD READ DIRECTIVE NZ X1,PDC8 IF EOR CARD IDENT CARD EDIT CARD DECK SX7 1S"LO.T" SA7 CDLS RJ LDC LIST IGNORED LINES EQ DCK1 DCK2 SX1 6 SEARCH TDKN,X6+X1,777776B NZ X2,DCK3 IF DECK FOUND MX6 0 SA6 MDTI CLEAR CURRENT DECK NAME SA6 INSF CLEAR INSERT FLAG SX6 =C*UNKNOWN DECK.* EQ ERR DCK3 SX5 A2 SET DECK ADDRESS SEARCH TDKI,X6 SEARCH FOR PREVIOUS ENTRY NZ X2,DCK4 IF FOUND ADDWRD A0,X1*X6 ENTER DECK TABLE DCK4 BX6 X3 SET EDIT INDEX SX7 X5 SET DECK NAME ADDRESS SA6 MDTI SA7 AIDT BX6 X6-X6 CLEAR INSERT SA6 INSF EQ PDC5 EXIT DCKA DATA 10H IGNORE / DATA 0 DEFINE SPACE 4,10 *** DEFINE NAME,VALUE * * SET THE VALUE OF *NAME* TO *VALUE*. IF *VALUE* IS * NOT PRESENT A VALUE OF ZERO IS ASSUMED. * * DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*, * *ENDIF* AND *IFCALL* DIRECTIVES. * * WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN * PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE * FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*. DEFINE SA1 INSF CHECK FOR INSERT IN PROGRESS NZ X1,PDC4 IF INSERT FLAG SET * PROCESS DEFINE DIRECTIVE. ZR X6,ERR2 IF NAME BLANK OR TOO LONG RJ ASN ASSEMBLE NAME SEARCH TDEF,X6 SEARCH FOR NAME NZ X2,DEF1 IF SYMBOL ALREADY EXISTS ADDWRD A0,X6 ADD ENTRY TO TABLE SA2 A6+ GET ENTRY * ASSEMBLE VALUE AND DEFINITION. DEF1 SA5 A2 SA1 CH SKIP SEPARATOR SX6 X1+B1 SA6 A1 RJ ASD ASSEMBLE NUMERIC VALUE NZ B2,DEF2 IF FIELD NOT NULL SX6 B0+ SA6 ERRM CLEAR ERROR FLAG AND USE DEFAULT VALUE DEF2 BX3 X7 AX7 16 NZ X7,DEF3 IF VALUE TO LARGE MX1 42 BX5 X1*X5 MX4 1 SET DEFINED ON INPUT FLAG LX4 17-59 BX6 X4+X3 FLAG + VALUE BX6 X5+X6 FLAG + SYMBOL + VALUE SA6 A5 SET IN TABLE EQ PDC6 RETURN * VALUE ERROR. DEF3 SX6 =C/ VALUE ERROR./ EQ ERR DELETE SPACE 4,10 *** DELETE C * D C * * DELETE DIRECTIVE *C* AND INSERT FOLLOWING TEXT. DELETE SPACE 4,10 *** DELETE C1,C2 * D C1,C2 * * DELETE LINES *C1* THROUGH *C2* AND INSERT FOLLOWING TEXT. DELETE SX6 2 SET DELETE DLT1 SA6 T1 RJ AMI ASSEMBLE FIRST DELETE IDENTIFIER SA1 CH CHECK NEXT CHARACTER SA6 IDT1 SET FIRST IDENTIFIER SA7 A6+B1 SA2 X1 SB7 X2-1R ZR B7,DLT2 IF BLANK RJ AMI ASSEMBLE SECOND IDENTIFIER DLT2 SA6 IDT2 SET SECOND IDENTIFIER SA7 A6+1 SA1 T1 ENTER MODIFICATION TABLE RJ EMT ENTER MODIFIER TABLE SX6 1 SET INSERT FLAG SA6 INSF EQ PDC5 EXIT EDIT SPACE 4,10 *** EDIT D1 * EDIT D1,D2,...DN * EDIT D1.DN * * REQUEST EDITING OF DECK(S) D1 - DN. EDIT RJ ASN ASSEMBLE NAME SB7 B0 1 ENTRY SA1 IG ZR X1,EDI1 IF NO IGNORES SEARCH TIGD,X6 NZ X2,EDI5 IF DECK IS TO BE IGNORED EDI1 SX3 6 SEARCH FOR DECK SEARCH TDKN,X6+X3,377776B ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR ZR X2,EDI6 IF NOT FOUND SA1 CH CHECK NEXT CHARACTER SA3 X1 SB2 X3-1R. SA5 A2+ NZ B2,EDI3 IF NOT PERIOD SX7 X1+B1 SKIP PERIOD SA7 A1 RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NAME BLANK OR TOO LONG SA1 IG ZR X1,EDI2 IF NO IGNORES SEARCH TIGD,X6 NZ X2,ERR2 IF DECK IS TO BE IGNORED - *D1.DN* ILLEGAL EDI2 SX3 6 SEARCH FOR DECK SEARCH TDKN,X6+X3,377776B ZR X6,ERR2 IF NAME BLANK OR TOO LONG ZR X2,EDI6 IF NOT FOUND SB6 A5 SET NUMBER OF ENTRIES SB7 A2-B6 SX6 =C/NAMES SEPARATED BY *.* IN WRONG ORDER./ MI B7,ERR IF FIRST NAME AFTER SECOND EDI3 BX6 X5 CHECK DECK STATUS LX6 59-16 MI X6,EDI4 IF IGNORE BIT SET SEARCH TEDT,X5 SEARCH FOR PREVIOUS ENTRY NZ X2,EDI4 IF FOUND ADDWRD A0,X1*X5 ENTER DECK IN EDIT TABLE SX1 A5 ADDWRD A0,X1 EDI4 SB7 B7-2 SA5 A5+2 PL B7,EDI3 IF NOT AT END OF REQUESTED DECKS EDI5 SA1 CH CHECK NEXT CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R ZR B2,PDC5 IF BLANK - RETURN NE B2,B1,ERR2 IF NOT COMMA - FORMAT ERROR SA6 A1 SKIP COMMA EQ EDIT LOOP EDI6 SA1 EDTA+1 SET NAME IN MESSAGE MX2 30 BX1 X2*X1 LX6 30 BX3 -X2*X6 IX7 X1+X3 MX2 12 BX6 X2*X6 SA7 A1 SA6 A1+1 SX6 EDTA SET MESSAGE ADDRESS EQ ERR EDTA DATA 30HUNKNOWN DECK - IDENT SPACE 4,10 *** IDENT MNAME * * BEGIN MODIFICATION SET WITH MODIFIER *MNAME*. IDENT RJ ASN ASSEMBLE NAME SX2 1S13 SEARCH FOR IDENTIFIER NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SEARCH TNME,X6 DONT ALLOW DUPLICATE IDENT LINES NZ X2,ERR3 IF MOD REFERENCED BEFORE IDENT LINE ADDWRD A0,X6 ADD IDENTIFIER ADDWRD A0,X6-X6 SA2 A6-B1 SX7 A2 SA1 A2 RESTORE NAME SA7 MDSA MX0 42 BX1 X0*X1 RJ SFN SPACE FILL NAME SA1 =10H-IDENT- BX7 X1 SA6 SBTL+2 SA7 A6-B1 BX6 X6-X6 CLEAR INSERT SA6 INSF LISTOP T,IDN1 IF INPUT TEXT NOT SELECTED SX7 99999 FORCE PAGE EJECT SA7 LC SX6 B1+ SA6 CDCT RESTART INPUT SEQUENCING EQ PDC5 EXIT IDN1 LISTOP C,PDC5 IF DIRECTIVE LIST NOT SELECTED PRINT (=C* *) PRINT (=C* *) EQ PDC5 INSERT SPACE 4,10 *** INSERT C * I C * * INSERT FOLLOWING LINES AFTER *C*. INSERT RJ AMI ASSEMBLE INSERT IDENTIFIER SA6 IDT1 SET FIRST LIMIT SA7 A6+B1 BX6 X6-X6 SA1 CH CHECK NEXT CHARACTER SA2 X1 SB7 X2-1R NZ B7,ERR2 IF NOT BLANK - FORMAT ERROR SA6 A7+B1 CLEAR SECOND LIMIT SA6 A6+B1 SX1 4 ENTER INSERT INTO MODIFICATION TABLE RJ EMT ENTER MODIFIER TABLE SX6 1 SET INSERT FLAG SA6 INSF EQ PDC5 EXIT INWIDTH SPACE 4,10 *** INWIDTH N * * SET THE WIDTH OF THE INPUT LINES TO N. INWIDTH RJ ASD ASSEMBLE COLUMN NUMBER SB2 X7-IWMACS-1 MI B2,INW2 IF IN RANGE INW1 SX6 =C*COLUMN OUT OF RANGE.* EQ ERR INW2 SA7 IW SX6 1R CLEAR INPUT BUFFER SB2 CHAR+X7 SB3 CHAR+IWMAX INW3 EQ B2,B3,PDC6 IF COMPLETE SA6 B2 SB2 B2+B1 EQ INW3 LOOP FOR REMAINDER OF BUFFER MODNAME SPACE 4,10 *** MODNAME MNAME * * SET ASSUMED MODIFIER NAME TO *MNAME*. * NOTE - IF THIS DIRECTIVE IS USED, THE DECK NAME MUST BE * RESET BY ANOTHER -MODNAME- DIRECTIVE. MODNAME RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SEARCH TNME,X6 SEARCH FOR NAME NZ X2,MNM1 IF FOUND ADDWRD A0,X6 ADD NEW NAME SA2 A6 MNM1 SX6 A2 SET ASSUMED IDENTIFIER ADDRESS SA6 AIDT EQ PDC5 EXIT MOVE SPACE 4,10 *** MOVE D1,D2 * MOVE D1,D2,...,DN * * MOVE DECK D2 TO BE AFTER DECK D1. MOVE RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR SX3 6 SEARCH FOR DECK SEARCH TDKN,X6+X3,377776B ZR X2,EDI6 IF NOT FOUND SA1 CH CHECK NEXT CHARACTER SX5 X3 SA3 X1 SB2 X3-1R, NZ B2,ERR2 IF NOT COMMA SX7 X1+B1 SKIP COMMA SA7 A1 MVE1 RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR SX3 6 SEARCH FOR DECK SEARCH TDKN,X6+X3,377776B ZR X2,EDI6 IF NOT FOUND LX5 18 BX1 X5+X3 SX5 X3+ ADDWRD TMVE,X1 ENTER IN MOVE TABLE SA1 CH CHECK NEXT CHARACTER SA3 X1 SX7 X1+B1 SB2 X3-1R ZR B2,PDC5 IF BLANK - RETURN NE B2,B1,ERR2 IF NOT COMMA - FORMAT ERROR SA7 A1 SKIP COMMA EQ MVE1 LOOP NOSEQ SPACE 4,10 *** NOSEQ * * REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE. NOSEQ SX6 B1+ SET NO SEQUENCE NUMBERS FLAG SA1 INSF NZ X1,PDC4 IF INSERT FLAG SA6 NS EQ PDC6 EXIT PREFIX SPACE 4,10 *** PREFIX C * * SET DIRECTIVE PREFIX = *C*. C MAY BE ANY 6 BIT DISPLAY * CODE CHARACTER. PREFIX SA1 CH SA2 X1+ SB7 X2-1R ZR B7,ERR2 IF CHARACTER IS BLANK MX3 -6 BX6 -X3*X2 USE 6 BIT CHARACTER ONLY SA6 PC EQ PDC6 EXIT PREFIXC SPACE 4,10 *** PREFIXC C * * SET COMPILE FILE DIRECTIVE PREFIX = *C*. C MAY BE ANY 6 * BIT DISPLAY CODE CHARACTER. PREFIXC SA1 CH CHECK NEW PREFIX CHARACTER SA2 X1 SB7 X2-1R ZR B7,ERR2 IF CHARACTER IS BLANK MX3 -6 BX6 -X3*X2 USE 6 BIT CHARACTER ONLY SA6 PCC EQ PDC6 EXIT PURDECK SPACE 4,10 *** PURDECK D1 * PURDECK D1,D2,...,DN * PURDECK D1.DN * * REQUEST PURGE OF DECK(S) D1 - DN. PURDECK RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SX3 6 SEARCH FOR DECK NAME SEARCH TDKN,X6+X3,377776B ZR X2,EDI6 IF NOT FOUND MX1 1 ADDWRD TMVE,X1+X3 ENTER IN MOVE TABLE SA5 A6 SA1 CH CHECK NEXT CHARACTER SA3 X1 SX7 X1+1 SB2 X3-1R ZR B2,PDC5 IF BLANK - RETURN NE B2,B1,PUR1 IF NOT COMMA SA7 A1 SKIP COMMA EQ PURDECK LOOP PUR1 SB2 X3-1R. NZ B2,ERR2 FORMAT ERROR IF NOT PERIOD SA7 A1 RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SX3 6 SEARCH TDKN,X6+X3,377776B ZR X2,EDI6 IF NOT FOUND LX3 18 IX6 X5+X3 SA6 A5 JP PDC5 RESTORE SPACE 4,10 *** RESTORE C * * RESTORE DIRECTIVE *C*, AND INSERT FOLLOWING TEXT. RESTORE SPACE 4,10 *** RESTORE C1,C2 * * RESTORE LINES *C1* THROUGH *C2*, AND INSERT FOLLOWING TEXT. RESTORE SX6 3 SET RESTORE EQ DLT1 PROCESS AS DELETE SEQ SPACE 4,10 *** SEQ. * * REQUEST SEQUENCE NUMBERS ON COMPILE FILE. SEQ SX6 B0+ SET SEQUENCE NUMBERS FLAG SA1 INSF NZ X1,PDC4 IF INSERT FLAG SA6 NS EQ PDC6 EXIT SORSEQ SPACE 4,10 *** SORSEQ * * REQUEST SEQUENCE NUMBERS ON SOURCE FILE. SORSEQ BSS 0 ENTRY SX6 B1+ SET SEQUENCE NUMBERS FLAG SA6 SS EQ PDC6 EXIT UNYANK SPACE 4,10 *** UNYANK MNAME * * REMOVE A PREVIOUS YANK ON MODIFIER *MNAME*. UNYANK SPACE 4,10 *** UNYANK MNAME,* * * REMOVE PREVIOUS YANKS ON ALL MODIFIERS FROM *MNAME* ON. UNYANK RJ ASN ASSEMBLE IDENT NAME ZR X6,ERR2 IF NAME BLANK OR TOO LONG SX7 1S15 SET UNYANK STATUS BX6 X6+X7 EQ YNK1 PROCESS YANK UPDATE SPACE 4,10 *** UPDATE * * PROPAGATE LINE COUNTS FOR IDENTS BETWEEN DECKS. * WHEN THIS OPTION IS USED, THE ORDER OF EDITING IS DETERMINED * BY THE ORDER OF THE PROGRAM LIBRARY, AND INSERTION TEXT * NUMBERS WILL BE THE SAME AS THOSE PRODUCED BY *UPDATE*. UPDATE SX6 B1 SET -UPDATE- FLAG SA6 UP EQ PDC6 EXIT WIDTH SPACE 4,10 *** WIDTH N * * SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*. WIDTH RJ ASD ASSEMBLE COLUMN NUMBER SB2 X7-IWMACS-1 PL B2,INW1 IF OUT OF RANGE SA1 INSF NZ X1,PDC4 IF INSERT FLAG SA7 SC SET SEQUENCE NUMBER COLUMN EQ PDC6 EXIT YANK SPACE 4,10 *** YANK MNAME * * REMOVE EFFECTS OF MODIFIER *MNAME*. YANK SPACE 4,10 *** YANK MNAME,* * * REMOVE EFFECTS OF MODIFIERS FROM *MNAME* ON. * ANY MODIFIERS WHICH HAVE BEEN YANKED ARE DENOTED IN THE * MODIFIER LIST BY ENCLOSING PARENS. YANK RJ ASN ASSEMBLE IDENT NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SX7 3S15 SET YANK BIT BX6 X6+X7 YNK1 SX3 6 SEARCH FOR DECK NAME SEARCH TDKN,X6+X3,777776B NZ X2,ERR1 IF INCORRECT DIRECTIVE FOUND SX2 1S15 SEARCH FOR YANK NAME SEARCH TNME,X6+X2,X2 ZR X2,YNK2 IF NOT FOUND MX4 -15 ENTER NEW STATUS BX2 -X4*X2 BX6 X6+X2 SA6 A2 EQ YNK3 * PROCESS ALL PARAMETERS. YNK2 ADDWRD A0,X6 ENTER NEW YANK NAME YNK3 SA1 CH CHECK NEXT CHARACTER SX7 B1 SET YANK FLAG SA2 X1 SX7 X1+1 SA7 YK SB2 X2-1R, NZ B2,PDC5 IF NOT COMMA - RETURN SA2 X7 CHECK NEXT CHARACTER SX3 B1 SB2 X2-1R* NZ B2,ERR1 IF NOT ASTERISK BX6 X3+X6 SET ALL AFTER FLAG SA6 A6 EQ PDC5 EXIT IGNORE SPACE 4,10 *** IGNORE D1 * IGNORE D1,D2,...,DN * * CAUSES ANY FURTHER MODIFICATION DIRECTIVES TO THE DESIGNATED * DECK(S) TO BE IGNORED. IGNORE RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SEARCH TIGD,X6 NZ X2,IGN1 IF FOUND - IGNORE DUPLICATED IGNORES ADDWRD A0,X6 ENTER DECK NAME IGN1 SA1 CH CHECK NEXT CHARACTER SX7 B1 IGNORE FLAG SA2 X1 SX7 X1+1 SA7 IG SET IGNORE FLAG SB2 X2-1R ZR B2,PDC5 IF BLANK - RETURN NE B2,B1,ERR2 IF NOT COMMA SA7 A1+ EQ IGNORE ADK TITLE DIRECTIVE PROCESSING SUBROUTINES. ADK SPACE 4,20 ** ADK - ADD FROM NEW DECK TABLE TO DECK TABLE. * * ENTRY (X5) - FILE NAME ADDRESS. * * EXIT TNDK - CLEARED. * * USES ALL. * * CALLS ADW, STB. ADK SUBR ENTRY/EXIT SA1 L.TNDK ZR X1,ADKX IF NO NEW DECKS - RETURN ALLOC TDKN,X1,S ALLOCATE TABLE SLACK FOR LARGE BLOCK SA1 L.TNDK SB4 B0 PREPARE TO ADD NEW DECKS SB5 X1 SX6 X5 SET FILE NAME ADDRESS MX0 24 SB6 2 SA6 T1 ADK1 SA1 F.TNDK CHECK FOR PREVIOUS DECK SA5 X1+B4 SB2 X5-OPRT ZR B2,ADK2 IF TYPE = OPL NE B2,B1,ADK6 IF TYPE .NE. OPLC ADK2 SEARCH TDKN,X5,377777B ZR X2,ADK3 IF NOT FOUND SX1 1S16 SET IGNORE BIT BX6 X2+X1 SA6 A2 ADK3 SA1 FM ZR X1,ADK5 IF NOT -F- MODE SEARCH TEDT,X5 LOOK UP EDIT ENTRY NZ X2,ADK4 IF FOUND ADDWRD A0,X1*X5 ADD ENTRY ADDWRD A0,X6-X6 SA2 A6-B1 ADK4 SA1 F.TDKN SET NEW DECK ADDRESS SA3 L.TDKN IX6 X1+X3 SA0 TDKN SA6 A2+B1 ADK5 ADDWRD A0,X5 ADD NEW DECK SB2 B4+B1 REPLACE FILE NAME ADDRESS SA1 F.TNDK SA5 X1+B2 SA2 T1 BX5 -X0*X5 LX2 36 IX1 X2+X5 ADDWRD A0,X1 ADK6 SB5 B5-B6 ADVANCE TABLE SB4 B4+B6 NZ B5,ADK1 IF NOT END OF NEW DECKS SA1 F.TNME SET ASSUMED IDENTIFIER ADDRESS BX6 X6-X6 CLEAR NEW DECK NAME TABLE LX7 X1 SA6 L.TNDK SA7 MDSA EQ ADKX RETURN AMI SPACE 4,20 ** AMI - ASSEMBLE MODIFICATION IDENTIFICATION. * * EXIT (X6) - LINE NAME. * (X7) - LINE NUMBER. * * USES ALL. * * CALLS ADW, ASD, ASN, STB. AMI SUBR ENTRY/EXIT SA1 MDTI ZR X1,ERR1 IF NO DECK DIRECTIVE - INCORRECT DIRECTIVE SA5 CH SAVE CURRENT CHARACTER POINTER RJ ASN ASSEMBLE IDENTIFIER NAME SA1 A5 CHECK NEXT CHARACTER SA4 AIDT GET ASSUMED IDENTIFIER SA2 X1 SB2 X2-1R. ZR B2,AMI1 IF PERIOD NZ X4,AMI2 IF ASSUMED IDENTIFIER PRESENT EQ ERR1 INCORRECT DIRECTIVE AMI1 SX5 X1+B1 SKIP PERIOD SEARCH TNME,X6 SEARCH FOR IDENTIFIER SX4 A2 NZ X2,AMI2 IF FOUND ADDWRD A0,X6 ENTER IDENTIFIER SX4 A6+ SET ADDRESS AMI2 SX6 X5 SET CHARACTER POSITION SA6 A5 RJ ASD ASSEMBLE NUMBER SA1 A5+ CHECK NEXT CHARACTER SX6 X4 SET ADDRESS SA2 X1 SB2 X2-1R ZR B2,AMIX IF NOT BLANK - RETURN NE B2,B1,ERR1 IF NOT COMMA SX6 X1+B1 SKIP COMMA SA6 A1 SX6 X4 RESET ADDRESS EQ AMIX RETURN CCC SPACE 4,10 ** CCC - COMPRESS CONVERTED LINE. * * ENTRY (B7) = LAST CHARACTER +1 OF CONVERTED LINE. * * CALLS CCD. CCC1 RJ CCD COMPRESS LINE CCC SUBR ENTRY/EXIT SX7 B7-1 SA7 LCAC STORE END OF LINE POSITION EQ CCC1 COMPRESS LINE CCD SPACE 4,15 ** CCD - COMPRESS LINE. * * ENTRY (CHAR) - CHARACTER STRING OF LINE. * * EXIT (CDTX) - COMPRESSED LINE. * (CDWC) - WORD COUNT OF COMPRESSED LINE. * * USES ALL. * PROCESS END OF LINE. CCD8 LX6 X6,B6 SHIFT UP LAST WORD MX3 -12 SA6 A6+1 BX4 -X3*X6 SB2 A1+ BX6 X6-X6 ZR X4,CCD9 IF LINE TERMINATED SA6 A6+1 TERMINATE LINE CCD9 SX7 A6-B2 SET WORD COUNT SA7 A1-B1 SX6 A0 SET 64 CHARACTER INDICATOR SA6 PCSE CCD SUBR ENTRY/EXIT SA0 B0 INITIALIZE 64 CHARACTER INDICATOR SX0 2074B (X0) = CONSTANT 60 FOR UNPACK SB4 100B SB3 -B1 SA1 CDID PRESET (A6) LX0 48 SA5 CHAR FIRST CHARACTER SB7 B4+B1 BX6 X1 SA6 A1 SB2 6 UX6,B6 X0 RESET REGISTERS SA2 LCAC SET LAST CHARACTER POSITION SB5 -B1 BX1 -X2 SX7 1R EQ CCD6 ENTER TO PROCESS FIRST CHARACTER CCD1 SB5 B5+1 CCD2 LX6 6 00 CHARACTER SB6 B6-B2 SX4 B4-B1 COMPRESSION = 77B SB3 B5-B7 NZ B6,CCD3 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS CCD3 PL B3,CCD4 IF .GT. 64 BLANKS SX4 B5-B1 COMPRESSION = COUNT - 1 SB3 -B1 CCD4 NZ X4,CCD5 IF CHARACTER IS NOT *00* LX6 6 INSERT *00* SA0 B1 64 CHARACTER SET CHARACTER ENCOUNTERED SB6 B6-B2 SX4 B1 SET *01* NZ B6,CCD5 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS CCD5 BX3 X4 SAVE CHARACTER AX4 6 CHECK FOR ESCAPE CODE ZR X4,CCD5.1 IF NO ESCAPE CODE LX6 6 SHIFT ASSEMBLY SB6 B6-B2 BX6 X6+X4 MERGE NEW CHARACTER SB5 B3 NZ B6,CCD5.1 IF NOT END OF WORD SA6 A6+B1 UX6,B6 X0 RESET REGISTERS CCD5.1 MX4 -6 BX4 -X4*X3 CLEAN OFF ESCAPE CODE LX6 6 SHIFT ASSEMBLY SB6 B6-B2 BX6 X6+X4 MERGE NEW CHARACTER SB5 B3 NZ B6,CCD6 IF NOT END OF WORD SA6 A6+B1 UX6 B6,X0 CCD6 IX3 X5-X7 CHECK CHARACTER BX4 X5 SB5 B5+B1 COUNT BLANK SB3 X1 -( LWA + 1 ) OF STRING BUFFER SB3 B3+A5 CHECK FOR END OF LINE SA5 A5+B1 NEXT CHARACTER ZR B3,CCD8 IF END OF LINE ZR X3,CCD6 IF BLANK SB3 -1 ZR B5,CCD4 IF NO BLANKS BX4 X7 SA5 A5-B1 BACKSPACE EQ B5,B1,CCD4 IF 1 BLANK SB5 B5-1 NE B5,B1,CCD1 IF NOT 2 BLANKS SA5 A5-1 BACKSPACE EQ CCD4 EMT SPACE 4,20 ** EMT - ENTER MODIFICATION TABLE. * * ENTRY (X1) - MODIFICATION REQUEST. * 4 = INSERT. * 3 = RESTORE. * 2 = DELETE. * (MDTI) - EDIT TABLE INDEX. * (MDSA) - ADDRESS OF MODIFICATION SET NAME. * (IDT1 - IDT1+1) - FIRST MODIFICATION LIMIT. * (IDT2 - IDT2+1) - SECOND MODIFICATION LIMIT. * * CALLS ADW. EMT SUBR ENTRY/EXIT * ENTER FIRST WORD SA2 MDTI EDIT INDEX TO BITS 00 - 17 LX1 57 MODIFICATION TO BITS 57 - 59 SA3 A2+B1 MODIFIER NAME POINTER TO BITS 36 - 53 IX1 X1+X2 SA4 A3+B1 LINE NUMBER TO BITS 18 - 35 LX3 18 IX6 X3+X4 LX6 18 BX1 X1+X6 ADDWRD TMOD,X1 * ENTER SECOND WORD. SA2 IDT2 MODIFIER NAME POINTER TO BITS 36 - 53 LX2 18 SA3 A2+B1 LINE NUMBER TO BITS 18 - 35 BX1 X2+X3 LX1 18 ADDWRD A0,X1 * ENTER THIRD WORD SA2 MDSA MODIFICATION SET ADDRESS TO BITS 42 - 59 SA1 T+5 TEXT ADDRESS TO BITS 00 - 24 LX2 42 IX1 X2+X1 ADDWRD A0,X1 EQ EMTX RETURN IMP SPACE 4,15 ** IMP - INITIALIZE MODIFICATION PROCESSING. * * LINK MODIFICATION TABLE BY DECKS. ENTER MODIFICATION TABLE * LINKAGE IN EDIT TABLE. RESET FETS. * * USES ALL. IMP SUBR ENTRY/EXIT SA1 PCC COMPILE PREFIX CHARACTER BX6 X1 SA6 PC SA1 =10H DECK - SX6 ALT SET ALTERNATE TITLE LINE SX7 99999 FORCE PAGE EJECT SA6 TL SA7 LC BX6 X1 SX7 B1 WORDS/ENTRY = 1 SA6 SBTL+1 SA7 LTBA * LINK MODIFICATION TABLE BY DECKS. SA1 L.TMOD INITIALIZE REGISTERS SA2 F.TMOD SB2 X1 MX0 42 ZR B2,IMP2 IF MODIFICATION TABLE EMPTY SA3 F.TDKI SB3 3 SB4 X3 SB2 B2-B3 SA2 X2+B2 GET MODIFICATION TABLE ENTRY BX5 X0*X2 REMOVE DECK LINKAGE IMP1 SA1 B4+X2 GET DECK TABLE ENTRY SX3 A2 SET NEW DECK TO MOD LINK BX4 X0*X1 REMOVE PREVIOUS LINK FROM DECK ENTRY SB2 B2-B3 SA2 A2-B3 DECREMENT TO NEXT MODIFICATION BX7 -X0*X1 IX6 X4+X3 RESTORE EDIT ENTRY BX7 X5+X7 SA6 A1+ SA7 A2+B3 STORE LINKED MODIFICATION BX5 X0*X2 REMOVE EDIT LINKAGE PL B2,IMP1 IF NOT AT END OF TABLE * ENTER MODIFICATION TABLE LINKAGE IN EDIT TABLE. IMP2 SA3 UM NZ X3,IMP7 IF *U* MODE SA1 L.TDKI SA2 F.TDKI SB5 X1 SA5 X2 ZR B5,IMP5 IF DECK TABLE EMPTY IMP3 SEARCH TEDT,X5 SEARCH EDIT TABLE ZR X2,IMP4 IF NOT FOUND SX1 X5 ENTER MODIFICATION TABLE LINK BX6 X1+X2 SA6 A2+ IMP4 SB5 B5-B1 SA5 A5+B1 NZ B5,IMP3 IF NOT END OF DECK IDENTIFIERS IMP5 SA1 UP NZ X1,IMP9 IF *UPDATE* OPTION SELECTED * GUARANTEE THAT COPYRIGHT RECORD, IF PRESENT, IS FIRST. IMP6 SX6 7 COMMON DECK SA1 =C*COPYRT* COPYRIGHT RECORD SEARCH TDKN,X6+X1,777776B ZR X2,IMP6.3 IF COPYRIGHT RECORD IS NOT PRESENT MX2 42 CLEAR DECK FLAGS BX6 X2*X6 SB5 A2 SAVE DECK ADDRESS SEARCH TEDT,X6 SB4 A2 SAVE ENTRY ADDRESS NZ X2,IMP6.1 IF DECK IN EDIT TABLE ADDWRD TEDT,X6 SX1 B5 ADDWRD TEDT,X1 * MOVE THE COPYRIGHT DECK TO THE FIRST ENTRY. SB4 A6-B1 SAVE ENTRY ADDRESS IMP6.1 SX4 X3-2 NG X4,IMP6.3 IF FIRST ORDINAL OF THE TABLE SA1 F.TEDT FIRST ORDINAL LOCATION SB5 X1 SA1 B4 PRESENT POSITON SA2 B4+B1 SECOND ENTRY SB4 A2+B1 IMP6.2 BX6 X1 BX7 X2 SA1 B5 SA2 B5+B1 SA6 B5 SA7 B5+B1 SB5 A2+B1 NE B5,B4,IMP6.2 IF NOT FINISHED MOVING DOWN * RESET FETS. IMP6.3 SA1 T SX6 B0+ SA6 M ZR X1,IMPX IF TEXT FILE NOT USED - RETURN WRITER A1,R SA1 X2+1 REWIND POINTERS SX7 X1 SA7 A1+B1 SA7 A7+B1 MX7 60 INSURE NO HIT ON TEXT ADDRESS SA7 T+5 EQ IMPX RETURN * FOR *U* MODE, ENTER DECK IDENTIFIER TABLE IN EDIT TABLE. IMP7 SA1 F.TDKI SA2 L.TDKI BX7 X7-X7 CLEAR EDIT LENGTH SB7 X2 SA7 L.TEDT SB7 B7-B1 ZR B7,IMP5 IF NO DECKS SA5 X1+B1 FIRST ENTRY IMP8 ADDWRD TEDT,X5 MX0 42 SX1 6 BX6 X0*X6 SEARCH TDKN,X1+X6,777776B SX1 A2 ADDWRD TEDT,X1 SB7 B7-B1 SA5 A5+B1 NZ B7,IMP8 IF MORE DECKS TO PROCESS EQ IMP5 * FOR *UPDATE* OPTION, ORDER EDIT TABLE ACCORDING TO DECK TABLE. IMP9 SA1 F.TDKN SA2 L.TDKN BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE LENGTH SB7 X2 SA7 L.TDKI SA5 X1+ SB6 2 IMP10 SEARCH TEDT,X5 ZR X2,IMP11 IF DECK NOT IN EDIT TABLE SA1 A2+B1 ENTER EDIT ENTRY BX0 X1 ADDWRD TDKI,X2 ADDWRD A0,X0 IMP11 SB7 B7-B6 SA5 A5+B6 PL B7,IMP10 IF MORE DECKS TO PROCESS SA1 L.TEDT COPY BACK TO EDIT TABLE SA2 F.TEDT SB7 X1 SB6 B0 SA3 F.TDKI IMP12 EQ B6,B7,IMP6 IF COMPLETE SA1 X3+B6 BX6 X1 SA6 X2+B6 SB6 B6+B1 EQ IMP12 LOOP IPC SPACE 4,10 ** IPC - INSERT PREFIX CHARACTER. * * ENTRY (PCC) = COMPILE FILE PREFIX CHARACTER. * (WCCA) = TABLE OF COMPILE FILE DIRECTIVES. * * EXIT (WCCA) = INITIALIZED WITH PREFIX CHARACTER IN UPPER * 6-BITS OF TABLE ENTRY. * * USES X - 1, 2, 6. * A - 1, 2, 6. IPC SUBR ENTRY/EXIT SA2 PCC COMPILE FILE PREFIX CHARACTER SA1 WCCA-1 INITIALIZE LOOP LX2 54 IPC1 SA1 A1+B1 INSERT CHARACTER BX6 X1+X2 ZR X1,IPCX IF AT END OF TABLE SA6 A1 EQ IPC1 LOOP FOR REMAINDER OF TABLE LDC SPACE 4,20 ** LDC - LIST DIRECTIVE LINE. * * ENTRY (CHAR) - LINE IN *S* FORMAT. * (CDLS) - LINE LIST STATUS. * (ERRM) - ERROR MESSAGE, IF NEEDED. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - 1, 2, 3, 4, 6, 7. * B - ALL. * * CALLS LER, UPN, WOF. LDC SUBR ENTRY/EXIT SA1 ERRM ZR X1,LDC1 IF NO ERROR MESSSAGE SX7 1S"LO.E" SA1 =9L *ERROR* SA7 CDLS SB3 CHSP RJ UPN UNPACK NAME LISTOP E,LDC1,MI IF ERROR LIST ON SA1 EA ADVANCE DIRECTIVE ERROR COUNTER SA2 X1 SX6 X2+B1 SA6 A2 BX6 X6-X6 CLEAR ERROR SA6 ERRM EQ LDCX RETURN LDC1 SA1 LO CHECK LIST OPTION SA2 CDLS BX6 X1*X2 ZR X6,LDC5 IF NO LIST FOR LINE SA1 RDDB SX6 2 IX1 X1-X6 SX2 125 PL X1,LDC3 IF READPL SA1 CDCT MX0 -16 SX6 B1 BX1 -X0*X1 IX7 X6+X1 SA7 A1 DIRECTIVE COUNT RJ CDD CONVERT TO DECIMAL DISPLAY SB2 9 MX0 -6 LX6 24 LDC2 BX7 -X0*X6 SB2 B2-B1 SA7 A7+B1 LX6 6 NZ B2,LDC2 IF NOT COMPLETE SA4 IW INPUT WIDTH SX2 X4+10 SA1 A ZR X1,LDC3 IF NO ALTERNATE FILE SX2 118 LDC3 PRINT -CHSP,X2 SX6 1R SB2 8 SA6 CHSP RESTORE SPACES TO CHSP LDC4 SB2 B2-B1 SA6 A6+B1 NZ B2,LDC4 IF NOT COMPLETE LDC5 SA1 ERRM ZR X1,LDCX IF NO ERROR MESSAGE - RETURN BX6 X6-X6 CLEAR ERROR MESSAGE SA6 A1 SX0 X1 RJ LER LIST ERROR MESSAGE EQ LDCX PMP SPACE 4 ** PMP - PROCESS MOVE AND PURDECK DIRECTIVES. * * USE TABLE *TMVE* TO REORDER THE EDIT TABLE. PMP SUBR ENTRY/EXIT BX6 X6-X6 SA6 T1 PMP1 SA1 T1 CHECK MOVE TABLE SA2 L.TMVE IX7 X2-X1 SX6 X1+B1 ADVANCE MOVE INDEX ZR X7,PMPX IF END OF TABLE - RETURN SA3 F.TMVE LOOK UP MOVE ENTRY SB2 X1 SA2 X3+B2 SA6 A1 SA3 F.TDKN LOOK UP DECK NAME IX6 X2+X3 LX3 18 IX6 X6+X3 SA6 T2 SA1 X6 SEARCH TEDT,X1 SEARCH FOR DECK NAME ZR X2,PMP1 IF NOT FOUND SA1 A2+B1 SAVE EDIT ENTRY BX6 X2 BX7 X1 SA6 PMPA SA7 A6+B1 SA2 F.TEDT SA1 L.TEDT DECREMENT EDIT LENGTH SX6 X1-2 SA6 A1 IX1 X6-X3 IX3 X2+X3 BX6 X3 SA6 PMPA+2 ZR X1,PMP2 IF NO MOVE MOVE X1,X3+2,X3 PURGE EDIT ENTRY PMP2 SA1 T2 MI X1,PMP4 IF MOVE COMPLETE LX1 -18 SA2 X1 SEARCH FOR DECK NAME SEARCH TEDT,X2 ZR X2,PMP1 IF NOT FOUND SB2 B1+B1 SX6 A2+B2 SA1 L.TEDT SA2 F.TEDT SA6 T2 SX7 X1+B2 INCREMENT TABLE LENGTH SA7 A1 SX3 X3+B2 IX2 X2+X3 IX1 X1-X3 ZR X1,PMP3 IF NO MOVE MOVE X1,X2,X2+B2 ADD MOVED ENTRY PMP3 SA1 T2 SA2 PMPA SA3 A2+B1 BX6 X2 BX7 X3 SA6 X1 SA7 X1+B1 EQ PMP1 LOOP PMP4 LX1 -18 SX3 X1 SA2 F.TDKN BX1 X3-X2 ZR X1,PMP1 IF NO SECOND ADDRESS TO PURGE SA2 X3 SEARCH TEDT,X2 ZR X2,PMP1 IF NOT FOUND SX2 A2+2 SA3 PMPA+2 PICK UP WHERE 1ST PURGE WAS PERFORMED IX1 X2-X3 SX6 =C/NAMES SEPARATED BY *.* IN WRONG ORDER./ ZR X1,PMP1 IF NOTHING TO MOVE NG X1,ERR IF PURGE ORDER INCORRECT SA4 L.TEDT SA5 F.TEDT IX6 X4-X1 IX5 X5+X4 IX1 X5-X2 SA6 A4 MOVE X1,X2,X3 EQ PMP1 PMPA CON 0 CON 0 CON 0 RCS SPACE 4,15 ** RCS - RESET CHARACTER SET. * * RESET CURRENT CHARACTER SET. * * ENTRY (CSR) = REQUESTED CHARACTER SET NAME. * = 0 - DISPLAY CHARACTER SET MESSAGE. * * EXIT (X6) = ERROR MESSAGE ADDRESS IF NON-ZERO. * (CSC) = CURRENT CHARACTER SET. * (CSR) = 0. * * USES A - 1, 2, 3, 6, 7. * X - 1, 2, 3, 4, 6, 7. * B - NONE. * * MACROS MESSAGE, TLX. * * CALLS NONE. RCS SUBR ENTRY/EXIT SA1 CSR GET REQUESTED CHARACTER SET ZR X1,RCS4 IF MESSAGE REQUEST MX3 42 BX2 X1 SA1 TCST-1 FWA-1 OF CHARSET TABLE SX6 RCSA PRESET ERROR MESSAGE RCS1 SA1 A1+B1 ZR X1,RCSX IF UNKNOWN CHARSET BX4 X3*X1 BX7 X2-X4 NZ X7,RCS1 IF NO MATCH BX7 -X3*X1 SA7 CSC SET NEW CHARACTER SET RCS3 BX6 X6-X6 CLEAR ERROR MESSAGE FLAG SA6 CSR CLEAR CHARACTER SET REQUEST EQ RCSX RETURN RCS4 SA2 RCSB NG X1,RCS3 IF NO EXPLICIT CS REQUEST ZR X2,RCS3 IF NO MESSAGE, RETURN MESSAGE X2,3,R EQ RCS3 RETURN RCSA DATA C* UNKNOWN CHARACTER SET.* RCSB CON 0 MESSAGE ADDDRESS IF NON-ZERO. RDD SPACE 4,15 ** RDD - READ DIRECTIVE. * * *READ*, *SKIP*, *REWIND* DIRECTIVES PROCESSED HERE. * * EXIT (X1) - .NE. 0, IF EOR/EOF ENCOUNTERED. * * USES ALL. * * CALLS ECD, LDC, UPN, WOF. RDD SUBR ENTRY/EXIT RDD1 SA5 RDDB NZ X5,RDD9 IF READPL INPUT SA1 A NZ X1,RDD6 IF ALTERNATE INPUT SA1 IW READK I,CHAR,X1 NZ X1,RDDX IF EOR/EOF/EOI - RETURN RDD2 SX6 B6+ SA6 LCAC RDD3 SX6 1BS"LO.C" SA6 CDLS CARD BKSP CARD READ CARD READPL CARD RETURN CARD REWIND CARD SKIP CARD SKIPR BX1 X1-X1 RETURN WITH NO EOR EQ RDDX RETURN * RETURN HERE TO CLEAR ALTERNATE INPUT AND LIST LINE. RDD4 BX6 X6-X6 CLEAR ALTERNATE INPUT SA6 A SA6 RDDB CLEAR READPL FLAG RJ LDC LIST LINE MESSAGE CCDR,1 ISSUE CONSOLE MESSAGE SX6 1R BLANK FILL BUFFER SB2 25 RDD5 SA6 CHAR+IWMAX+B2 SB2 B2-B1 PL B2,RDD5 IF NOT COMPLETE EQ RDD1 PROCESS NEXT INPUT * ALTERNATE INPUT READ. RDD6 SA5 RDDB NZ X5,RDD9 IF READPL INPUT SA1 IW READK A,CHAR,X1 ZR X1,RDD2 IF NO EOR SA3 RDDA ZR X3,RDD7 IF NOT *READ* N,* MI X1,RDD7 IF EOF READ A BEGIN NEW READ READC A,BUF,20 READ FIRST LINE MI X1,RDD7 IF EOF SX6 X1-BUF CHECK LENGTH NZ X6,RDD6 IF NEXT RECORD NOT ZERO LENGTH RDD7 BX7 X7-X7 CLEAR ALTERNATE INPUT SA7 X2 SA7 RDDA CLEAR (*) FLAG RDD8 SA7 RDDB CLEAR READPL FLAG LISTOP C,RDD1 IF NO LIST SET FOR DIRECTIVE PRINT (=C* *) PRINT (=C* *) EQ RDD1 PROCESS NEXT INPUT RDD9 SA1 RDDB+1 ZR X1,RDD11 IF LAST LINE READ READC N,BUF,BUFL READ MHBS NZ X1,RDD11 IF EOR READC X2,CDTX,MXCCL READ COMPRESSED LINE NZ X1,RDD11 IF EOR RDD10 SA1 BUF SA2 =00177777177777000000B SA3 RDDB BX6 X2*X1 IX6 X6-X3 SA6 A3+B1 PL X1,RDD9 IF LINE INACTIVE MX0 -16 SET LINE ID SA2 F.TNCD AX1 18 BX6 -X0*X1 IX6 X6+X2 AX1 18 SA2 X6 LINE NAME BX6 -X0*X1 SEQUENCE NUMBER BX2 X0*X2 IX6 X2+X6 SA6 CDID RJ ECD EXPAND LINE SX6 B7 ADDRESS OF LAST CHARACTER FROM LINE + 1 SA6 LCAC EQ RDD3 * TERMINATE READPL. RDD11 RECALL N SA1 X2+B1 SET IN = OUT = FIRST SX6 X1 SA6 A1+B1 SA6 A6+B1 SA1 A FILE NAME MX0 42 BX1 X0*X1 RJ SFN SPACE FILL NAME SB3 CHAR+IWMAX+1 ENTER NAME IN CHAR BX1 X6 RJ UPN UNPACK NAME BX7 X7-X7 CLEAR MODIFIER TABLE SA1 N+7 REPLACE NPL NAME BX6 X1 SA7 L.TNCD SA6 N EQ RDD8 RDDA CON 0 -READ- (*) FLAG RDDB CON 0 -READPL- FLAG CON 0 SPACE 4 *** FILE MANIPULATION DIRECTIVES. * * PROCESSED FROM INPUT FILE. THESE DIRECTIVES ARE NOT ALLOWED * ON ALTERNATE INPUT. BKSP SPACE 4,10 *** BKSP FNAME * * BACKSPACE FILE *FNAME* 1 RECORD. BKSP SPACE 4,10 *** BKSP FNAME,N * * BACKSPACE FILE *FNAME* *N* RECORDS. BKSP SX6 B1 SET BACKSPACE FLAG EQ SKP1 READ SPACE 4,10 *** READ FNAME,RNAME * * USE FILE *FNAME* FOR DIRECTIVE INPUT. * *RNAME* IF PRESENT, SPECIFIES THE NAME OF THE RECORD TO * BE USED. *FNAME* MUST BE IN SOURCE FILE FORMAT. * I.E. THE FIRST WORD OF EACH RECORD IS THE NAME OF THE * RECORD. THIS WORD IS DISCARDED BEFORE DIRECTIVE INPUT * IS PROCESSED. THE SEARCH TERMINATES ON AN END OF FILE. * WHEN END OF RECORD IS REACHED, DIRECTIVE INPUT RETURNS TO * NORMAL INPUT FILE. * * IF *RNAME* = (*), ALL RECORDS UP TO AN EOF OR A ZERO * LENGTH RECORD ARE READ. READ RJ SAF SET ALTERNATE FILE SA6 A SET FILE NAME SA1 CH CHECK NEXT CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R, NZ B2,RAF6 IF NOT COMMA SA6 A1 SKIP COMMA RJ ASN ASSEMBLE RECORD NAME BX1 X6 CHECK NAME LX7 X6 ZR X6,RAF7 IF NO RECORD NAME LX7 18 SX7 X7-1L* ZR X7,RAF5 IF ASTERISK RJ SFN SPACE FILL NAME BX5 X6 SAVE NAME READ A RAF1 READC A,BUF,MXCCL READ FIRST LINE MI X1,RAF4 IF EOF SA1 BUF SPACE FILL NAME RJ SFN SPACE FILL NAME BX7 X6-X5 ZR X7,RAF3 IF RECORDS MATCH SB2 BUF+BUFL READW A,B6,B2-B6 SX1 B6 LWA+1 OF DATA READ SX2 BUF SET RECORD TYPE RJ SRT SET RECORD TYPE SA7 RAFA+1 ENTER NAME IN MESSAGE MESSAGE A7-B1,1 RAF2 READW A,BUF,BUFL READ NEXT PART ZR X1,RAF2 IF NOT EOR/EOF/EOI READ X2 BEGIN NEW READ EQ RAF1 PROCESS NEXT RECORD RAF3 RJ LDC LIST LINE SA1 A SPACE FILL FILE NAME MX0 42 BX1 X0*X1 RJ SFN SPACE FILL NAME SB3 CHAR+IWMAX+1 ENTER NAME IN CHARACTER BUFFER BX1 X6 RJ UPN UNPACK NAME MESSAGE CCDR,1 RESET CONSOLE MESSAGE EQ RDD1 READ NEXT LINE RAF4 SX6 =C*RECORD NOT FOUND.* EQ RAF8 SET ERROR MESSAGE RAF5 SX6 B1 SET ASTERISK FLAG SA6 RDDA READ A BEGIN READ READC A,BUF,MXCCL READ FIRST LINE EQ RAF3 RAF6 READ A,R LOAD BUFFER SA1 A+2 SA3 A1+B1 (A+3) BX6 X1-X3 NZ X6,RAF3 IF DATA READ SX6 =C*EMPTY FILE.* EQ RAF8 SET ERROR MESSAGE RAF7 SX6 =C*RECORD NAME MISSING.* RAF8 SA6 ERRM SET ERROR MESSAGE EQ RDD4 EXIT RAFA CON 10H SKIP / CON 0 READPL SPACE 4,10 *** READPL DNAME,C1,C2 * * READ LINES *C1* THROUGH *C2* FROM PROGRAM LIBRARY. * * IF *C1* AND *C2* ARE MISSING, READ ENTIRE DECK. READPL SA1 RDDB SX6 =C*OPERATION INCORRECT FROM ALTERNATE INPUT.* NZ X1,ERR IF ALTERNATE INPUT ACTIVE RJ CRD CONDITIONALLY READ DIRECTORY RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMAT ERROR SEARCH TDKN,X6,200000B SEARCH FOR DECK SX6 =C*UNKNOWN DECK.* ZR X2,ERR IF DECK NOT FOUND SA1 A2+B1 SET RANDOM ADDRESS SX6 A2 SET IDENTIFIER ADDRESS SA6 RPLA MX0 30 BX6 -X0*X1 AX1 36 SA3 X1 PROGRAM LIBRARY NAME SA6 N+6 BX7 X3 SX6 B1 SA7 N SA6 RDDB SX6 IWMACS+1 SET LINE NUMBER COLUMN SA6 SC+1 READ N INITIATE NEW READ READW N,TIDT,TIDTL READ IDENT TABLE NZ X1,PLE IF EOR SA1 TIDT LX1 12 SB2 X1-7700B NZ B2,PLE IF NO IDENT TABLE SA1 TIDT+1 ADD DECK NAME TO IDENTIFIER TABLE ADDWRD TNCD,X1 SB5 TIDT FWA OF IDENT TABLE RJ PCS PROCESS CHARACTER SET READW N,T1,1 READ MODIFIER TABLE LENGTH NZ X1,PLE IF EOR SA1 T1 CHECK TABLE SB7 X1 SET TABLE LENGTH LX1 18 SB2 X1-700100B SB3 X1-700200B ZR B2,RPL1 IF NORMAL DECK NZ B3,PLE IF NOT COMMON DECK RPL1 ZR B7,RPL2 IF NO MODIFIERS ALLOC TNCD,B7 ALLOCATE FOR MODIFIERS READW N,X2+B1,B7 READ MODIFIERS RPL2 SA1 CH CHECK SEPARATOR CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R SA6 A1+ ZR B2,RPL9 IF READ ENTIRE DECK NE B2,B1,ERR2 IF FORMAT ERROR SA1 MDTI MODIFICATION TABLE INDEX SA2 AIDT ASSUMED IDENTIFIER BX6 X1 LX7 X2 SA3 RPLA DECK NAME ADDRESS SA6 A3 SA7 A3+B1 BX6 X3 SX7 B1 SA6 A2 ASSUMED IDENTIFIER = DECK NAME ADDRESS SA7 A1 INDEX = 1 RJ AMI ASSEMBLE FIRST IDENTIFIER SA7 T1 SA1 X6 FIND MODIFIER INDEX SEARCH TNCD,X1 NZ X2,RPL4 IF FOUND RPL3 SA1 RPLA RESTORE MODNAME SA2 A1+1 BX6 X1 LX7 X2 SA6 MDTI SA7 AIDT SX6 =C*UNKNOWN MODNAME.* EQ RPL8 RPL4 LX3 18 FORM FIRST LINE MASK SA1 T1 LX1 36 BX6 X1+X3 SA6 A1 RJ AMI ASSEMBLE SECOND IDENTIFIER SA7 T2 SA1 X6+ FIND MODIFIER INDEX SEARCH TNCD,X1 ZR X2,RPL3 IF NOT FOUND SA1 T2 FORM LAST LINE MASK LX3 18 LX1 36 BX6 X1+X3 SA6 A1 SA1 RPLA RESTORE MODNAME SA2 A1+1 BX6 X1 LX7 X2 SA6 MDTI SA7 AIDT SA1 =00177777177777000000B SA5 T1 BX0 X1 * SEARCH FOR START OF TEXT. RPL5 READC N,BUF,BUFL READ MHBS NZ X1,RPL7 IF EOR READC X2,CDTX,MXCCL READ COMPRESSED LINE NZ X1,RPL7 IF EOR SA1 BUF BX1 X0*X1 IX6 X1-X5 NZ X6,RPL5 IF NOT AT BEGINNING OF TEXT RPL6 RJ LDC LIST LINE SA1 T2 SET ALTERNATE READ BX6 X1 SA6 RDDB MESSAGE CCDR,1 RESET CONSOLE MESSAGE EQ RDD10 PROCESS LINE RPL7 SX6 =C*CARD NOT FOUND.* RPL8 SA6 ERRM RECALL N SA1 N+1 RESET IN = OUT = FIRST SX6 X1 BX7 X7-X7 SA6 A1+B1 SA6 A6+B1 SA7 L.TNCD EQ RDD4 EXIT * READ ENTIRE DECK. RPL9 READC N,BUF,BUFL READ MHBS NZ X1,RPL7 IF EOR READC X2,CDTX,MXCCL READ COMPRESSED LINE SX6 10 SET ALTERNATE READ SA6 T2 EQ RPL6 RPLA CON 0 MODIFICATION TABLE INDEX CON 0 ASSUMED IDENTIFIED RETURN SPACE 4,10 *** RETURN FNAME,FNAME,...,FNAME * * RETURN FILE(S) *FNAME*. RETURN RJ SAF SET ALTERNATE FILE SA6 A SET FILE NAME EVICT A,R RETURN FILE SA1 CH CHECK NEXT CHARACTER BX6 X6-X6 CLEAR ALTERNATE FILE SA2 X1 SB2 X2-1R, SA6 A NZ B2,RDD4 IF NO COMMA - LIST LINE SX7 X1+B1 SKIP COMMA SA7 A1 EQ RETURN PROCESS NEXT NAME REWIND SPACE 4,10 *** REWIND FNAME,FNAME,...,FNAME * * REWIND FILE(S) *FNAME*. REWIND RJ SAF SET ALTERNATE FILE SA6 A SET FILE NAME REWIND A,R REWIND FILE SA1 CH CHECK NEXT CHARACTER BX6 X6-X6 CLEAR ALTERNATE FILE SA2 X1 SB2 X2-1R, SA6 A NZ B2,RDD4 IF NO COMMA - LIST LINE SX7 X1+B1 SKIP COMMA SA7 A1 EQ REWIND PROCESS NEXT NAME SKIP SPACE 4,10 *** SKIP FNAME * * SKIP 1 RECORD ON FILE *FNAME*. SKIP SPACE 4,10 *** SKIP FNAME,N * * SKIP *N* RECORDS ON FILE *FNAME*. SKIP SX6 B0+ SET FORWARD FLAG SKP1 SA6 T2 RJ SAF SET ALTERNATE FILE SA1 CH CHECK NEXT CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R ZR B2,SKP2 IF BLANK NE B2,B1,ERR1 IF NOT COMMA SA6 A1 RJ ASD ASSEMBLE RECORD COUNT SB2 X7 SKP2 SA1 T1 SET FILE NAME SA5 T2 LX6 X1 BX7 X7-X7 SEND SKIPPING MESSAGE SA6 A SA7 RAFA+1 MESSAGE A7-B1,1 NZ X5,SKP3 IF BACKSPACE SKIPF A,B2,R EQ RDD4 EXIT SKP3 SKIPB A,B2,R EQ RDD4 EXIT SKIPR SPACE 4,10 *** SKIPR FNAME,RNAME * * SKIP RECORDS ON FILE *FNAME* THROUGH RECORD *RNAME*. SKIPR RJ SAF SET ALTERNATE FILE SA1 CH CHECK NEXT CHARACTER SA2 X1 SX6 X1+B1 SB2 X2-1R, NZ B2,ERR1 IF NOT COMMA SA6 A1 SKIP COMMA RJ ASN ASSEMBLE RECORD NAME BX5 X6 SA1 T1 SET FILE NAME BX7 X1 SA7 A SKR1 READ A BEGIN READ READW X2,BUF,BUFL MI X1,SKR3 IF EOF SX1 B6 LWA+1 OF DATA READ SX2 BUF SET RECORD TYPE RJ SRT SET RECORD TYPE BX0 X7 SAVE NAME SA7 RAFA+1 MESSAGE A7-B1,1 SKR2 READW A,BUF,BUFL ZR X1,SKR2 IF NOT EOR/EOF/EOI BX7 X0-X5 COMPARE NAMES NZ X7,SKR1 IF NO MATCH EQ RDD4 EXIT SKR3 SX6 =C*RECORD NOT FOUND.* SA6 ERRM EQ RDD4 CRD SPACE 4,10 ** CRD - CONDITIONALLY READ DIRECTORY. * * USES ALL. * * CALLS RDR. CRD SUBR ENTRY/EXIT SA1 DL PL X1,CRDX IF DIRECTORY ALREADY READ - RETURN SA5 P+7 RJ RDR READ DIRECTORY NZ X0,ABT IF ERRORS IN OPL SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH BX6 X1 SA6 DL EQ CRDX RETURN RDR SPACE 4,20 ** RDR - READ DIRECTORY FROM PROGRAM LIBRARY. * * CHECK PROGRAM LIBRARY FORMAT. READ DECK NAME TABLE. * * ENTRY (A5) - ADDRESS OF FILE NAME. * (X5) - FILE NAME. * * EXIT (X0) - 0, IF NO ERRORS. * (A0) - ADDRESS OF ERROR MESSAGE, IF ERROR. * * USES ALL. * * CALLS ABT, ADW, ATS, RDW=. RDR5 SA0 =C* ERROR IN DIRECTORY.* RDR6 SX0 B1+ ERROR RETURN RDR SUBR ENTRY/EXIT BX0 X0-X0 CLEAR ERROR ZR X5,RDRX IF NO PROGRAM LIBRARY - RETURN RECALL M BX6 X5 SA6 X2 SKIPEI X2 SKIPB M,2 BACKSPACE OVER DIRECTORY READ M READW X2,TIDT,TIDTL READ IDENT TABLE SA0 =C* PROGRAM LIBRARY EMPTY.* NZ X1,RDR6 IF EOR - FILE NOT FOUND SA1 TIDT LX1 18 SA2 A1+B1 SB2 X1-770000B NZ B2,RDR5 IF NO IDENT TABLE BX6 X2 SET PROGRAM LIBRARY NAME SA6 PL READW M,T1,1 READ FIRST WORD NZ X1,RDR5 IF EOR SA1 T1 SX5 X1 SET DIRECTORY LENGTH LX1 18 SB2 X1-700000B NZ B2,RDR5 IF NOT DIRECTORY ZR X5,RDR5 IF EMPTY ALLOC TNDK,X5,S ALLOCATE TABLE SLACK FOR LARGE BLOCK RDR2 READW M,T1,2 READ RECORD NAME SA1 T1 CHECK TYPE SB2 X1-OPRT ZR B2,RDR3 IF OPL DECK NE B2,B1,RDR4 IF NOT OPL COMMON DECK ERRNZ OPRT+1-OCRT CODE ASSUMES VALUE RDR3 ADDWRD TNDK,X1 ENTER DECK NAME SA1 T2 ENTER RANDOM INDEX ADDWRD A0,X1 RDR4 SX5 X5-2 NZ X5,RDR2 IF NOT AT END OF DIRECTORY SX5 A5 ADD DECKS RJ ADK ADD DECK RECALL M RESET SCRATCH BUFFER SA1 X2+B1 SA2 M+7 SX6 X1 BX7 X2 SA6 A1+B1 SA6 A6+B1 SA7 A1-B1 BX0 X0-X0 EQ RDRX RETURN SAF SPACE 4,15 ** SAF - SET ALTERNATE INPUT FILE. * * EXIT (X6) - FILE NAME AND STATUS. * (X7) - FILE NAME, ZERO FILL. * (T1) - FILE NAME AND STATUS. * * USES X - 0, 1, 3, 6, 7. * A - 1, 6. * B - 2, 6, 7. * * CALLS ASN. SAF SUBR ENTRY/EXIT SA1 A ZR X1,SAF1 IF ALTERNATE FILE NOT ACTIVE SX6 =C*OPERATION INCORRECT FROM ALTERNATE INPUT.* EQ ERR SAF1 RJ ASN ASSEMBLE NAME ZR X6,ERR2 IF NO NAME - FORMT ERROR MX0 42 SB6 FETS SET FET SEARCH SB7 FETSL SB2 FETLEN+FETODL SAF2 SA1 B6 READ FET NAME BX3 X6-X1 SB6 B6+B2 BX7 X0*X3 NZ X7,SAF3 IF NO MATCH SX6 =C*RESERVED FILE NAME.* EQ ERR SAF3 NE B6,B7,SAF2 IF MORE FETS TO PROCESS SX1 B1 SET CODED FILE STATUS BX7 X0*X6 IX6 X7+X1 SA6 T1 SET NEW FILE NAME EQ SAFX RETURN WTF SPACE 4,12 ** WTF - WRITE LINE TO TEXT FILE. * * ADD LINE TO TEXT TABLE, IF NOT FULL. OTHERWISE WRITE TO * TEXT FILE. * * USES X - 1, 2, 3, 4, 6. * A - 0, 1, 2, 3, 4, 6. * B - 2, 3. * * CALLS ATS, CCD. WTF SUBR ENTRY/EXIT SA1 CDWC ADVANCE FTEXT ADDRESS SA2 T+5 SA3 T CHECK FTEXT FILE IX6 X1+X2 SA6 A2 NZ X3,WTF2 IF TEXT FILE BEGUN ALLOC TTXT,X1 ALLOCATE ROOM SA4 T SA1 CDWC NZ X4,WTF2 IF TEXT FILE BEGUN SB3 X1 IX3 X2+X3 SB2 B0 IX4 X3-X1 SA1 CDTX WTF1 BX6 X1 COPY TEXT LINE SA6 X4+B2 SB2 B2+B1 SA1 A1+B1 NE B2,B3,WTF1 IF NOT AT END OF LINE EQ WTFX RETURN WTF2 WRITEW T,CDTX,X1 EQ WTFX RETURN SPACE 4 ** ADDITIONAL COMMON DECKS. *CALL COMCSRT SPACE 4 ** INPUT DIRECTIVE PROCESSOR TABLE. HERE CON 0 END OF TABLE IDENT SPACE 4 IDENT QUAL PRESET ERR SPACE 4,4 ERRMI PBUF+PBUFL-* DIRECTIVE PROCESSOR OVERFLOWS INTO PRESET PRESET TITLE MODIFY PRESET. PRS SPACE 4,10 ** PRS - PRESET MODIFY. * * ENTRY (A0) - FL. * * USES X - 1, 2, 4, 6. * A - 0, 1, 2, 4, 6. * B - 4, 5. * * CALLS ARG, IAF, ICS, IVI, IXQ, IZI, PCV, SMM, SOF. * * MACROS CLOCK, DATE, GETFLC, GETPP, WRITEC. PRS SUBR ENTRY/EXIT BX6 X0 SAVE *ECS* FIELD LENGTH SA6 EFL SX6 A0-10B SA6 FL SET FIELD LENGTH GETFLC SFL SA1 SFL MX2 -12 LX1 -36 BX6 -X2*X1 LAST COMMAND FL LX6 6 *100 SX1 CMFL COMPARE DEFAULT FL LX1 6 IX2 X1-X6 DEFAULT - LAST COMMAND FL NG X2,PRS1 IF LAST COMMAND FL .GT. DEFAULT FL BX6 X1 PRS1 SA6 A1+ SET FL DATE DATE REQUEST DATE SA1 DATE SET DATE IN SHORT TITLE BX6 X1 SA6 TERDT SA1 ACTR SET ARGUMENT COUNT SA2 DATE SET DATE IN IDENT TABLE SB4 X1 BX6 X2 SA6 TIDT+2 CLOCK TIME REQUEST TIME SA1 TIME SET TIME IN SHORT TITLE BX6 X1 SA6 TERTM SB5 ARGT AGRUMENT TABLE ADDRESS SA4 ARGR FIRST ARGUMENT RJ ARG PROCESS ARGUMENTS SA0 =C* ERROR IN MODIFY ARGUMENTS.* NZ X1,ABT1 IF ARGUMENT ERROR RJ SOF SET OUTPUT FORMAT RJ SMM SET MODIFICATION MODE RJ IAF INITIALIZE ALL FILES RJ IXQ INITIALIZE *X* OR *Q* MODE PARAMETERS ZR X1,ABT1 IF ERROR IN *Q* OR *X* MODE RJ PCV PROCESS CONVERSION OPTION NZ X4,ABT1 IF ERROR IN *CV* OPTION RJ IZI INITIALIZE *Z* MODE INPUT RJ IVI INITIALIZE VARIOUS ITEMS RJ ICS INITIALIZE CHARACTER SET NZ X6,ABT1 IF INCORRECT CHARACTER SET SPECIFIED GETPP BUF,LL,BUF GET PAGE SIZE PARAMETERS RJ IOD INITIALIZE OPTICAL DISK FET EXTENSIONS SA1 TO ZR X1,PRSX IF TERMINAL OUTPUT WRITEC O,BUF WRITE PRINT DENSITY FORMAT CONTROL EQ PRSX RETURN TITLE ARGUMENT TABLE AND PRESET TEMPORARIES. ARGT SPACE 4,10 ** ARGT - ARGUMENT TABLE. ARGT BSS 0 A ARG -NSN,AM COMPRESSED COMPILE BL ARG -NSN,BL BURSTABLE LISTING C ARG C,C COMPILE FILE CB ARG CASD,CASD,400B *CB* OPTION CG ARG NGTXT,CASF,400B *CG* OPTION CL ARG CLO,CASC,400B *CL* OPTION CS ARG CASE,CASE,400B *CS* OPTION CV ARG CVT,CVT CONVERSION OPTION D ARG -NSN,DB DEBUG MODE F ARG -NSN,FM FULL MODIFY MODE I ARG I,I INPUT FILE L ARG O,O LIST OUTPUT FILE LO ARG LO,LO,400B LIST OPTIONS N ARG NNPL,N NEW PROGRAM LIBRARY NR ARG -NSN,NR *NR* OPTION P ARG P,P PROGRAM LIBRARY Q ARG NASSM,QM *Q* OPTION S ARG NSOURCE,S SOURCE FILE U ARG -NSN,UM *U* MODE X ARG NASSM,XM *X* MODE Z ARG -*,ZM *Z* MODE ARG SPACE 4,10 ** PRESET TEMPORARIES. NNPL CON 0LNPL+3 NSOURCE CON 0LSOURCE+1 NASSM CON 0LCOMPASS NGTXT CON 0LSYSTEXT NSN CON 1 CLO CON 0LOUTPUT TITLE MODIFY PRESET SUBROUTINES. IAF SPACE 4,20 ** IAF - INITIALIZE ALL FILES. * * CHECK FOR FILE NAME CONFLICTS AND INITIALIZE ALL FILES. * * USES X - 0, 1, 2, 3, 4, 6, 7. * A - 0, 1, 2, 3, 4, 6, 7. * B - 2, 5, 6, 7. IAF SUBR ENTRY/EXIT * CHECK FOR FILE NAME CONFLICTS. SB6 FETS INITIALIZE FOR FET SEARCH SB7 FETSL MX0 42 SB2 FETLEN+FETODL LENGTH OF EACH FET+EXTENSION SA0 =C* FILE NAME CONFLICT.* IAF1 SA1 B6+ OUTER SEARCH LOOP SB5 B6+B2 ADVANCE TO NEXT FET BX1 X0*X1 CLEAR C/S BITS IAF2 SA2 B5+ INNER SEARCH LOOP BX2 X0*X2 CLEAR C/S BITS BX7 X2-X1 COMPARE ZR X2,IAF3 IF FILE NOT DEFINED ZR X7,ABT1 IF FILE NAMES COMPARE IAF3 SB5 B5+B2 ADVANCE INNER SEARCH LOOP LT B5,B7,IAF2 IF SEARCH NOT COMPLETE SB6 B6+B2 NE B6,B7,IAF1 IF NOT COMPLETE * INITIALIZE FILES. SA1 O SET UP FOR INTERACTIVE I/O BX6 X0*X1 SX2 A1 ADDRESS OF FET BX7 X7-X7 IX6 X6+X2 R= A6,ARGR SA7 A6+B1 EVICT A,R EVICT M,R SA1 S CHCK FOR SOURCE REQUESTED ZR X1,IAF4 IF NOT SOURCE FILE REWIND A1 SA1 AM CHECK FOR *A*, *X* OR *Q* SELECTED SA2 XM SA3 QM SA0 =C* S OPTION INCORRECT WITH X, Q, OR A.* BX4 X1+X2 BX4 X4+X3 NZ X4,ABT1 IF EITHER *A*, *X*, OR *Q* SELECTED SX7 CBUF+CBUFL REDUCE COMPILE FILE BUFFER LENGTH SA7 C+4 IAF4 SA1 N CHECK FOR NEW PROGRAM LIBRARY ZR X1,IAF5 IF NO NEW PROGRAM LIBRARY BX6 X1 SAVE FILE NAME SA6 N+7 EVICT A1,R IAF5 SA1 NR CHECK FOR *NR* SELECTED NZ X1,IAF6 IF *NR* SELECTED REWIND C,R IAF6 SA1 P SAVE OLD PROGRAM LIBRARY FILE NAME BX6 X1 BX7 X7-X7 CLEAR SCRATCH FILE NAME SA6 P+7 SA7 A EQ IAFX SPACE 4 ** IOD - INITIALIZE OPTICAL DISK FET EXTENSIONS. * * USES X - 0, 1, 2, 3, 6, 7. * A - 1, 2, 3, 6, 7. * B - 6, 7. IOD SUBR ENTRY/EXIT * CHECK FOR OPTICAL DISK FILE AND SET EXTENSION. SX6 FETS INITIALIZE FOR FET SEARCH IOD1 SA1 X6 LOAD FIRST FET WORD MX0 42 SA6 IODA SX6 X6-M ZR X6,IOD1.1 IF FILE M SA2 IODB BX3 X0*X1 FILE NAME SX2 X2 BX6 X3+X2 SA6 A2 FILINFO IODB GET FILE INFORMATION SA3 IODB+1 GET DEVICE TYPE AND STATUS AX3 48 SX2 X3-2ROD OPTICAL DISK DEVICE TYPE NZ X2,IOD2 IF NOT OPTICAL DISK DEVICE IOD1.1 SA2 IODA SX7 FETODL OPTICAL DISK FET EXTENSION LENGTH SX3 X2+12B SET OPTICAL FET BUFFER AFTER FET LX7 18 BX7 X3+X7 SA7 X2+11B STORE POINTER AND LENGTH OPEN X2,READNR,R IOD2 SX0 FETLEN+FETODL SA2 IODA IX6 X2+X0 SB6 X6 SB7 FETSL LT B6,B7,IOD1 IF FET SCAN NOT COMPLETE SB6 0 SB7 FETODL IOD3 SA1 B6+P+FETLEN MOVE P FET EXTENSION TO M BX6 X1 SA6 B6+M+FETLEN SB6 B6+B1 NE B7,B6,IOD3 IF NOT DONE WITH MOVE EQ IODX RETURN IODA BSSZ 1 FET ADDRESS STORAGE IODB VFD 42/0,6/5,12/1 *FILINFO* PARAMETER BLOCK BSSZ 5 ICS SPACE 4,20 ** ICS - INITIALIZE CHARACTER SET. * * CHECK AND INITIALIZE CHARACTER SET AND * ENSURE COMPRESSED COMPILE FILE IS NOT IN USE. * * ENTRY (CSR) = CHARACTER SET NAME. * * EXIT (X6) = 0, IF NO ERROR ENCOUNTERED. * (A0) = ADDRESS OF ERROR MESSAGE, IF APPROPRIATE. * (CSC) = CURRENT CHARACTER SET. * * USES X - 1, 2, 3, 4, 6, 7. * A - 1, 2, 7. * B - NONE. * * MACROS TSTATUS. * * CALLS RCS, STF. ICS SUBR ENTRY/EXIT SA2 I MX3 42 BX4 X3*X2 ZR X4,ICS2 IF *Z* INPUT SX2 A2 RJ STF NZ X6,ICS2 IF NOT CONNECTED *INPUT* FILE TSTATUS ICSA GET TERMINAL CHARACTER SET MX3 -1 SA2 ICSA+1 LX2 -2 BX1 -X3*X2 (X1) = 0 FOR DISPLAY, 1 FOR ASCII BX6 -X1 SA6 TI TERMINAL INPUT CHARACTER SET FLAG ICS2 RJ /DIRECT/RCS RESET CHARACTER SET SA0 X6 SET POSSIBLE ERROR MESSAGE EQ ICSX RETURN ICSA BSSZ 2 TSTATUS RETURN BLOCK IVI SPACE 4,15 ** IVI - INITIALIZE VARIOUS ITEMS. * * SPACE FILL COMMAND, PRESET DECK INENTIFIER TABLE * AND SET ASSUMED MODIFIER NAME. * * USES X - 1, 6. * A - 0, 1, 6. * B - 4, 5. * * CALLS ADW, SFN. IVI SUBR ENTRY/EXIT SB4 B0+ BLANK FILL COMMAND SB5 8 IVI1 SA1 CCDR+B4 RJ SFN SPACE FILL NAME SB4 B4+B1 SA6 A1 NE B4,B5,IVI1 IF NOT COMPLETE BX6 X6-X6 SA6 A6+B1 SET END OF LINE ADDWRD TDKI,X6-X6 PRESET DECK IDENTIFIER TABLE SA1 =7L******* SET ASSUMED MODIFIER NAME ADDWRD TNME,X1 ADDWRD A0,X6-X6 EQ IVIX RETURN IXQ SPACE 4,20 ** IXQ - INITIALIZE *X* OR *Q* MODE PARAMETERS. * * ENTRY (XM) - COMMAND *X* MODE PARAMETER. * (QM) - COMMAND *Q* MODE PARAMETER. * (ZM) = CONTROL STATEMENT *Z* MODE PARAMETER. * * EXIT (X1) - 0, IF ERROR ENCOUNTERED. * (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE. * * USES X - ALL. * A - ALL. * B - 2. * * CALLS SFN, ZTB. * * MACROS REWIND. IXQ4 SX1 B1+ IXQ SUBR ENTRY/EXIT SA1 XM CHECK *X* OR *Q* SELECTED SA2 QM BX1 X1+X2 MX0 -6 ZR X1,IXQ4 IF NEITHER SELECTED RJ SFN SPACE FILL ASSEMBLER NAME BX6 X0*X6 SX7 1R( BX6 X6+X7 SA1 C SET COMPILE FILE NAME MX2 42 CLEAR C/S BITS BX1 X2*X1 SA0 =C* X OR Q INCORRECT WITHOUT COMPILE.* ZR X1,IXQX IF NO COMPILE FILE SA7 AM SELECT MODIFY *A* MODE SA2 LO CHECK USER SELECTED LIST OPTIONS SA6 CASG SET ASSEMBLER NAME NZ X2,IXQ1 IF USER SELECTED LIST OPTION SX7 1S"LO.E" SELECT ERROR LIST SA7 LO SET LIST OPTION IXQ1 SA5 IXQA SET UP PARAMETER STENCIL SA4 =0L0 LX1 -12 MOVE ASSEMBLER INPUT FILE NAME INTO PLACE BX1 X1+X5 OVERLAY WITH STENCIL RJ ZTB CONVERT ZEROES TO BLANKS SA1 CASC GET LIST OPTION SPECIFIED SA6 A6+B1 SET ASSEMBLER LIST OPTION SA5 A5+B1 SET UP STENCIL FOR ASSEMBLER LIST OPTION BX7 X4-X1 CHECK FOR DISPLAY *0* NZ X7,IXQ2 IF COMPASS LIST SELECTED SA7 CMNF CLEAR COMPILE FILE COMMENTS FLAG IXQ2 LX1 -12 POSITION ARGUMENT BX1 X1+X5 OVERLAY WITH STENCIL RJ ZTB CONVERT ZEROES TO BLANKS SA1 CASD ASSLEMBLER BINARY OUTPUT FILE SA6 A6+B1 SET LIST OPTION SA5 A5+B1 BINARY OUTPUT PARAMETER STENCIL LX1 -12 POSITION ARGUMENT BX1 X1+X5 RJ ZTB CONVERT ZEROES TO BLANKS SA1 CASE ASSEMBLER *S* OPTION SA6 A6+B1 BINARY OUTPUT FILE NAME SA5 A5+B1 LX1 -12 BX1 X1+X5 RJ ZTB CONVERT ZEROES TO BLANKS SA1 CASF ASSEMBLER *G* OPTION SA5 A5+B1 BX2 X4-X1 ZR X2,IXQ3 IF *G* NOT SELECTED SA4 IXQB CLEAR *S* IF *G* SELECTED BX6 X4 IXQ3 SA6 A6+B1 *S* OPTION TO COMMAND LX1 -12 SET *G* OPTION BX1 X1+X5 RJ ZTB CONVERT ZEROES TO BLANKS SX7 2RA) SA6 A6+B1 *G* OPTION TO COMMAND LX7 48 SA1 XM CHECK FOR MODIFY *X* MODE SA7 A6+B1 COMMAND TERMINATOR ZR X1,IXQ4 IF *X* NOT SELECTED - RETURN REWIND O REWIND OUTPUT FILE SA1 ZM CHECK FOR MODIFY *Z* MODE NZ X1,IXQX IF SELECTED REWIND I REWIND INPUT FILE EQ IXQ4 RETURN IXQA CON 2LI=+1R, INPUT COMMAND STENCIL CON 2LL=+1R, LIST COMMAND STENCIL CON 2LB=+1R, BINARY OUTPUT COMMAND STENCIL CON 2LS=+1R, *S* OPTION COMMAND STENCIL CON 2LG=+1R, *G* OPTION COMMAND STENCIL IXQB CON 10HS=0 , IZI SPACE 4,20 ** IZI - INITIALIZE *Z* MODE INPUT. * * CLEARS THE FILE NAME IN THE *INPUT* FILE FET AND * ENTERS THE *Z* DIRECTIVES IN THE *INPUT* FILE * CIRCULAR BUFFER. * * ENTRY (ZM) = NONZERO IF *Z* MODE SELECTED. * * EXIT (I) = FILE NAME CLEARED. * = CIRCULAR BUFFER PRESET WITH CONTROL STATEMENT * *Z* MODE DIRECTIVES. * * USES A - 2, 6. * X - 2, 6. * B - 2, 3. * * CALLS ZAP. IZI SUBR ENTRY/EXIT SA2 ZM CHECK FOR *Z* MODE ZR X2,IZIX IF NOT SELECTED, RETURN SA2 I CLEAR *INPUT* FILE NAME MX6 -18 BX6 -X6*X2 SA6 A2 SX2 A2 SET FET ADDRESS FOR *ZAP* RJ ZAP PROCESS *Z* MODE DIRECTIVES SA2 IW SX6 1R CLEAR INPUT BUFFER SB2 CHAR+X2 SB3 CHAR+IWMAX IZI1 EQ B2,B3,IZIX IF COMPLETE SA6 B2 SB2 B2+B1 EQ IZI1 CONTINUE CLEARING BUFFER PCV SPACE 4,15 ** PCV - PROCESS *CV* OPTION. * * ENTRY (CVT) - .NE. 0, IF *CV* OPTION SELECTED. * * EXIT (X4) - 0, IF NO ERROR. * (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE. * * USES X - ALL. * A - 0, 1, 5, 6. * B - 2, 3, 4, 5, 7. * * CALLS DXB. PCV1 SA1 CSMR SET NEW PROGRAM LIBRARY CHARACTER SET SX6 64B MI X1,PCV2 IF SYSTEM IS 64 CHARACTER SET SX6 B0+ PCV2 SA6 CNPL CHARACTER SET OF NEW PROGRAM LIBRARY PCV SUBR ENTRY/EXIT SA5 CVT CHECK FOR CONVERSION SPECIFIED BX4 X4-X4 CLEAR ERROR SB7 B0 SET OCTAL BASE ZR X5,PCV1 IF NO CONVERSION SPECIFIED SA1 MAD64 BX1 X5-X1 COMPARE CVT AND MAD64 NZ X1,PCV0 IF MAD64 NOT SPECIFIED SX6 B1 SA6 MADCV SET MADIFY CONVERSION FLAG SA1 MOD64 BX6 X1 SA6 CVT TREAT AS 63 TO 64 CONVERSION BX5 X6 UPDATE X5 AS WELL PCV0 BSS 0 RJ DXB CONVERT TO BINARY SA0 =C* CV OPTION INCORRECT.* NZ X4,PCVX IF INCORRECT *CV* OPTION SA6 A5+ SET OPTION SB2 X6-63B CHECK OPTION BX6 X6-X6 SA6 C CLEAR COMPILE FILE IF CONVERTING ZR B2,PCV2 IF *63* SX6 64B EQ B1,B2,PCV2 IF *64* SX4 B1+ SET ERROR EQ PCVX IF NOT *64* OR *63* MAD64 CON 5LMAD64 MOD64 CON 2L64 SLC SPACE 4,20 ** SLC - SET LIST CONTROL. * * EXIT (LO) INITIALIZED. * * USES X - ALL. * A - 0, 1, 3, 6, 7. * B - 2, 3, 4. SLC3 SA6 LO SLC SUBR ENTRY/EXIT SX4 B1+ BIT CONSTANT SA1 LO GET *LO* OPTIONS MX0 -6 BX6 X6-X6 INITIALIZE RESULT REGISTER ZR X1,SLCX IF NOT SELECTED SA0 =C* -LO- ERROR MUST BE IN -ECTMWDSIA-.* SB2 SLCA LIST OPTION TABLE SLC1 LX1 6 PICK NEXT LETTER BX5 -X0*X1 ZR X5,SLC3 IF COMPLETE SB3 B0+ SLC2 SA3 B2+B3 GET NEXT OPTION BX2 X5-X3 COMPARE ZR X3,ABT1 IF END OF OPTION TABLE SB3 B3+B1 ADVANCE INDEX NZ X2,SLC2 IF NO MATCH SB4 B3-B1 LX7 X4,B4 BX6 X6+X7 ADD CURRENT OPTION EQ SLC1 LOOP FOR NEXT LETTER SLCA BSS 0 OPTION TABLE OPTION HERE CON 0 END OF TABLE SMM SPACE 4,20 ** SMM - SET MODIFICATION MODE. * * SET MODIFICATION MODE ACCORDING TO *F* AND * *U* OPTIONS. THE *F* OPTION OVER-RIDES THE * *U* OPTION. * * EXIT (UM) INITIALIZED. * * USES X - 1, 2, 6. * A - 1, 2, 6. SMM SUBR ENTRY/EXIT SA1 FM SA2 UM BX6 X6-X6 SET TO CLEAR *U* MODE NZ X1,SMM1 IF *F* MODE SELECTED BX6 X2 RESET *U* MODE SMM1 SA6 A2 CLEAR/SET *U* MODE EQ SMMX RETURN SOF SPACE 4,20 ** SOF - SET OUTPUT FORMAT. * * SET TERMINAL OUTPUT FLAG AND DEFAULT LIST OPTIONS. * * ENTRY (LO) = CONTROL STATEMENT *LO* PARAMETERS. * = 0 IF OMITTED. * * EXIT (LO) = LIST OPTION BIT MAP. * = DEFAULT OPTIONS IF OMITTED FROM * CONTROL STATEMENT. * (TO) = 0 IF OUTPUT ASSIGNED TO * INTERACTIVE TERMINAL. * * USES X - 1, 2, 6. * A - 1, 2, 6. * * CALLS SLC, STF. SOF SUBR ENTRY/EXIT * SET TERMINAL FILE DEFAULT OPTIONS. SX2 O CHECK OUTPUT FILE RESIDENCE RJ STF SA6 TO SET TERMINAL OUTPUT FLAG SA2 SOFA ZR X6,SOF2 IF ASSIGNED TO TERMINAL * SET NON-TERMINAL FILE DEFAULT OPTIONS. SA1 XM NZ X1,SOF2 IF *X* PARAMETER SELECTED SA2 SOFB SET *X* DEFAULT OPTIONS * PROCESS SPECIFIED OR DEFAULT OPTIONS. SOF2 SA1 LO READ CONTROL STATEMENT OPTIONS NZ X1,SOF3 IF OPTIONS ENTERED BX6 X2 STORE DEFAULT OPTIONS SA6 A1 SOF3 RJ SLC SET LIST CONTROLS EQ SOFX RETURN SOFA CON 0LE DEFAULT TERMINAL OPTIONS SOFB CON 0LECTMWDS DEFAULT NON-TERMINAL OPTIONS COMMON SPACE 4,10 ** PRESET COMMON DECKS. QUAL$ EQU 1 PREVENT QUALIFICATION *CALL COMCARG *CALL COMCCPM *CALL COMCSTF *CALL COMCUSB *CALL COMCZAP *CALL COMCZTB MODIFY TTL MODIFY - SOURCE LIBRARY EDITING PROGRAM. SPACE 4 *CALL COMCLFM END MODIFY SOURCE LIBRARY EDITING PROGRAM