IDENT DMPCCC,ORG ABS SST ENTRY DMPCCC ENTRY RFL= ENTRY SSJ= SYSCOM B1 *COMMENT 84/04/01. DMPCCC - DUMP CCC MEMORY. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. TITLE DMPCCC - DUMP *CCC* MEMORY. SPACE 4 *** DMPCCC - DUMP CCC MEMORY. * L. E. LOVETT 84/04/01. SPACE 4,10 *** DMPCCC - DUMP CCC MEMORY. * * *DMPCCC* PROVIDES THE CAPABILITY TO DYNAMICALLY AUTODUMP * THE *CCC* MEMORY. THE CALLING JOB MUST BE SYSTEM ORIGIN * OR THE USER MUST BE VALIDATED FOR SYSTEM ORIGIN PRIVILEGES, * AND THE SYSTEM MUST BE IN ENGINEERING MODE. * * *DMPCCC* READS THE *CCC* MEMORY VIA THE *PP* PROGRAM *DCC* * AND FORMATS THE DATA INTO AN OUTPUT FILE. *DMPCCC* WILL ISSUE * APPROPRIATE MESSAGES TO INDICATE THE SUCCESS OR FAILURE OF * THE AUTODUMP ATTEMPT. SPACE 4,10 *** COMMAND FORMAT. * * DMPCCC(C=CH,L=LFN) * * CH CHANNEL NUMBER TO DUMP *CCC* FROM. THE SPECIFIED * CHANNEL MUST BE IN THE RANGE 0 - 13B OR 20B - 33B OR * C0 - C11B FOR CONCURRENT CHANNELS. * CHANNEL 0 WILL BE ASSUMED IF NO CHANNEL IS SPECIFIED * ON THE CALL. * * LFN OUTPUT FILE NAME. DEFAULT IS *OUTPUT*. SPACE 4,10 *** DAYFILE MESSAGES. * * * DUMP COMPLETE.* * INFORMATIVE MESSAGE INDICATING THE COMPLETION OF THE * DUMP UTILITY. * * * EQUIVALENCE MISSING.* * A SYNTAX ERROR WAS ENCOUNTERED WITH THE COMMAND. THE * COMMAND PARAMETER WAS NOT SEPARATED FROM ITS EQUIVALENC * VALUE BY AN *=*. * * * INCORRECT CHANNEL NUMBER.* * THE SPECIFIED CHANNEL NUBER WAS NOT IN THE RANGE * 0 - 13B OR 20B - 33B OR C0 - C11B. * * * 8/9 NOT ALLOWED IN OCTAL FIELD.* * THE CHANNEL NUMBER WAS SPECIFIED WITH A POST SUFFIX * OF *B* WHILE AN *8* OR *9* WAS SPECIFIED. * * * NUMERIC FIELD MUST NOT BE BLANK.* * NO CHANNEL VALUE WAS SPECIFIED WITH THE *C* PARAMETER. * * * INCORRECT DIRECTIVE NAME.* * AN UNRECOGNIZED PARAMETER HAS BEEN SPECIFIED ON THE * COMMAND. SPACE 4,10 ** COMMON DECKS. *CALL COMCMAC SPACE 4 ** ASSEMBLY CONSTANTS. LNP EQU 84 LINES/PRINTER PAGE CCSZ EQU 40000B *CCC* MEMORY SIZE CCSZA SET CCSZ*2+4 NMBL SET CCSZA/5+100B DUMP BUFFER SIZE LFBL EQU 2001B LIST FILE BUFFER LENGTH WBFL EQU 64 WORKING BUFFER LENGTH SSJ= EQU 400000B TITLE DATA ASSIGNMENTS. DATA SPACE 4 ** DATA ASSIGNMENTS. ORG 110B ORG BSS 0 L BSS 0 LIST FILE OUTPUT FILEC LFB,LFBL,FET=8 ORG L CON 0LOUTPUT+15B ORG L+8 N FILEB NMB,NMBL,FET=9 ORG N VFD 12/0,18/0,18/0,12/0 ORG N+9 BA CON LB1 BUFFER ADDRESS NA CON 0 CCC ADDRESS NL CON 0#4000 LIMIT ADDRESS CCHF CON 0 CONCURRENT CHANNEL FLAG SPACE 4 ** LIST FILE CONTROLS. LN CON 10000 LINE NUMBER LP CON LNP LINES/PAGE PN CON 0 PAGE NUMBER TTL DATA H*1 DUMP OF * PAGE TITLE LINE DATA 10H CCC, CH DATA 40H00. DTE BSS 1 DATE FOR OUTPUT TME BSS 1 TIME FOR OUTPUT PGE BSS 1 PAGE FOR OUTPUT CON 0 STL DATA 10H0 DATA C* 0 1 2 3 4 5 6 7 8 , 9 A B C D E F* TITLE MAIN PROGRAM. DMP SPACE 4,20 ** DMPCCC - MAIN PROGRAM. DMPCCC RJ PRS PRESET PROGRAM DMP1 SA1 NA ADVANCE *CCC* ADDRESS SX6 X1+16 SA6 A1 SA4 NL IX4 X1-X4 PL X4,DMP5 IF END OF DUMP RJ CHD CONVERT ADDRESS TO DISPLAY SA1 BA SET BUFFER ADDRESS LX6 30 MX0 48 SB3 6 BX0 X0*X6 SB2 X1 RJ RDL READ DUMP LINE NZ X1,DMP4 IF END OF DATA SA1 BA SET BUFFER ADDRESS SX2 LB1&LB2 TOGGLE BUFFER BX6 X1-X2 COMPARE BUFFERS SA3 X1+B1 MX7 1 SA4 X6+B1 BX7 X7+X1 SX6 X6 DMP2 BX2 X3-X4 SA3 A3+B1 SA4 A4+B1 NZ X2,DMP3 IF LINE NOT DUPLICATE NG X2,DMP3 IF LINE NOT DUPLICATE NZ X3,DMP2 IF NOT END OF NEW LINE NG X1,DMP1 IF DUPLICATE LINES WRITTEN SA7 A1 SET DUPLICATE LINES WRITTEN SB2 =C* DUPLICATED LINES.* RJ LSL LIST LINE EQ DMP1 GET NEXT LINE TO PRINT DMP3 SA6 A1 SB2 X1 RJ LSL LIST LINE EQ DMP1 GET NEXT LINE TO PRINT DMP4 SA1 BA BUFFER ADDRESS SB2 X1 RJ LSL LIST LINE DMP5 WRITER L MESSAGE (=C* DUMP COMPLETE.*) ENDRUN TITLE SUBROUTINES. CHD SPACE 4 ** CHD - CONVERT HEXADECIMAL DIGITS. * * *CHD* CONVERTS UP TO 10 DIGITS TO DISPLAY CODE WITH LEADING * ZERO SUPPRESSION. CONVERSION CONTAINS SPACE FILL AND IS * RIGHT AND LEFT JUSTIFIED. * * ENTRY (X1) = NUMBER TO BE CONVERTED. * * EXIT (X6) = DISPLAY CODE CONVERSION RIGHT JUSTIFIED. * (X4) = DISPLAY CODE CONVERSION LEFT JUSTIFIED. * (B2) = 6*COUNT OF DIGITS CONVERTED. * * USES A - 4. * B - 2, 3. * X - 1, 2, 3, 4, 6. CHD SUBR ENTRY/EXIT SA4 =1H MX2 -4 SB2 B0 CLEAR JUSTIFY COUNT CHD1 BX3 -X2*X1 EXTRACT DIGIT LX4 -6 SHIFT ASSEMBLY SB2 B2+6 SB3 X3-10 SX3 1R0+X3-1R NG B3,CHD2 IF DIGIT LESS THAN 10 SX3 1RA+B3-1R CHD2 AX1 4 SHIFT OFF DIGIT IX4 X4+X3 ADD DIGIT TO ASSEMBLY NZ X1,CHD1 LOOP TO ZERO DIGIT LX4 -6 LEFT JUSTIFY ASSEMBLY LX6 X4,B2 RIGHT JUSTIFY ASSEMBLY EQ CHD RETURN LSL SPACE 4 ** LSL - LIST LINE. * * ENTRY (B2) = ADDRESS OF LINE IN C-FORMAT. * * EXIT LINE WRITTEN TO OUTPUT FILE. * * USES A - 1, 2, 6, 7. * B - 2. * X - 1, 2, 6, 7. * * CALLS CDD. * * MACROS WRITEC. LSL1 SX6 X1+B1 ADVANCE LINE POINTER SA6 A1 BX1 X6 CONVERT PAGE NUMBER RJ CDD CONVERT DECIMAL TO DISPLAY SA1 LSLB SET PAGE NUMBER ON OUTPUT BX6 X1-X6 SA6 PGE WRITEC L,TTL WRITE LIST TITLE WRITEC L,STL WRITE LIST SUBTITLE WRITEC L,(=C* *) SKIP A LINE WRITEC L,(=C* *) SKIP A LINE SA1 LSLA RESTORE ADDRESS OF LINE SB2 X1 LSL2 WRITEC L,B2 WRITE DATA LINE LSL SUBR ENTRY/EXIT SA1 LN SET LINE NUMBER SA2 LP SET LINES PER PAGE SX6 X1+B1 ADVANCE LINE NUMBER SA6 A1 IX1 X6-X2 NG X1,LSL2 IF NO PAGE OVERFLOW SA1 PN SET PAGE NUMBER SX6 6 RESET LINE COUNT SX7 B2 SAVE ADDRESS OF LINE SA6 A6 SA7 LSLA NZ X1,LSL1 IF NOT FIRST PAGE SB2 X2-80 NG B2,LSL1 IF NOT 8 LINES/INCH WRITEC L,(=1LT) SET 8 LINES PER INCH SA1 PN SET PAGE NUMBER EQ LSL1 WRITE PAGE HEADER LSLA BSS 1 ADDRESS OF DATA LINE LSLB CON 5L PAGE&5L PAGE NUMBER IDENTIFIER RDL SPACE 4 ** RDL - READ DUMP LINE. * * ENTRY (B2) = OUTPUT WORD ADDRESS. * (B3) = OUTPUT WORD CHARACTER POSITION. * (X0) = PARTIAL ASSEMBLY. * * EXIT (X1) = EOR STATUS. * * USES A - 1, 2, 3, 4, 6, 7. * B - 2, 3, 4, 5, 6, 7. * X - ALL. * * MACROS READO. * ADD CHARACTER TRANSLATION OF MEMORY DUMP TO THE END * OF THE DUMP LINE. RDL9 SA2 RDLB SA6 RDLA+1 SAVE INPUT STATUS SX6 B4 MX3 -36 SA6 A6-B1 LX2 48 BX6 -X3*X2 BX4 X3*X2 SA2 A2+B1 BX7 X0+X6 BX6 X4+X2 SA2 A2+B1 MX4 -12 SA3 A2+B1 SA7 B2 SA6 B2+B1 LX2 12 LX3 24 BX7 -X4*X3 BX6 X4*X3 BX7 X2+X7 SA7 A6+B1 SA6 A7+B1 MX7 0 SET LINE TERMINATOR SA7 A7+2 RDL SUBR ENTRY/EXIT SA1 RDLA SET INPUT WORD STATUS MX2 -4 MX3 -7 SB5 16 SA4 A1+B1 SB4 X1 BX5 X5-X5 BX6 X4 SB6 B1+B1 SB7 RDLB RDL1 ZR B4,RDL8 IF END OF INPUT WORD LX6 8 EXTRACT NEXT 4 BITS SB4 B4-B1 RDL2 BX1 -X2*X6 SB6 B6-B1 LX6 4 NEXT 4 BITS SX7 X1-10 CONVERT HEX DIGIT SX4 1R0+X1 NG X7,RDL3 IF DIGIT LESS THAN 10 SX4 1RA+X7 RDL3 BX1 -X2*X6 LX4 X4,B3 SB3 B3-6 SX7 X1-10 SX1 1R0+X1 NG X7,RDL4 IF DIGIT LESS THAN 10 SX1 1RA+X7 RDL4 BX0 X0+X4 BX4 -X3*X6 CONVERT CHARACTER SX4 1R LX1 X1,B3 LX5 6 BX0 X0+X1 BX5 X5+X4 NZ B3,RDL5 IF OUTPUT WORD NOT FULL SB3 60 BX7 X0 MX0 0 SA7 B2 SB2 B2+B1 RDL5 SB3 B3-6 NZ B6,RDL1 IF 4 DIGITS NOT DONE SB3 B3-6 ADD SPACES SX1 2R LX1 X1,B3 BX0 X0+X1 SB5 B5-B1 SB6 B1+B1 NZ B3,RDL6 IF OUTPUT WORD NOT FULL SB3 60 BX7 X0 MX0 0 SA7 B2 SB2 B2+B1 RDL6 SX7 B5 CHECK WORD MX1 -2 SB3 B3-6 BX1 -X1*X7 NZ X1,RDL7 IF NOT 4TH WORD BX7 X5 STORE CONVERSION SA7 B7 MX5 0 SB7 B7+B1 RDL7 NZ B5,RDL1 IF NOT 8 WORDS EQ RDL9 ADD CHARACTER TRANSLATION * READ NEXT WORD. RDL8 READO N MX2 -4 SB4 4 MX3 -7 LX6 8 ZR X1,RDL2 IF NOT EOR BX7 X0 SA7 B2 EQ RDL9 ADD CHARACTER TRANSLATION RDLA CON 0,0 INPUT WORD STATUS RDLB BSS 4 CHARACTER TRANSLATION STORAGE SPACE 4 ** COMMON DECKS. *CALL COMCCDD *CALL COMCCIO *CALL COMCMVE *CALL COMCRDO *CALL COMCRDW *CALL COMCSYS *CALL COMCWTC *CALL COMCWTW SPACE 4 ** BUFFERS. USE // SEG LB1 BSS 15 LINE BUFFER 1 LB2 BSS 15 LINE BUFFER 2 LFB EQU * LIST FILE BUFFER NMB EQU LFB+LFBL MEMORY BUFFER RFL= EQU NMB+NMBL+100B PRS SPACE 4 ** PRS - PRESET PROGRAM. PRS SUBR ENTRY/EXIT SB1 1 SA1 N SET E=0 IN THE FET MX0 3 BX6 -X0*X1 SA6 A1+ SX7 LINP SET LINES/PAGE SA7 LP SX6 A0+ SET FIELD LENGTH SA6 N+4 MOVE PRSB,PRSA,2 COPY FILE ACCESS LIST SA1 CCDR UNPACK CONTROL STATEMENT SB2 ISB INPUT STRING BUFFER RJ UCS UNPACK C-FORMAT TO S-FORMAT RJ ARG PROCESS ARGUMENTS DATE DTE GET CURRENT DATE CLOCK TME GET CURRENT TIME * FORM PAGE TITLE LINE USING CHANNEL. SA1 TTL+2 SET CHANNEL IN TITLE SA2 N MX3 -5 LX3 -12 BX2 -X3*X2 MX3 -3 LX3 -12 BX4 -X3*X2 LX2 3 LX3 6 BX7 -X3*X2 IX6 X1+X4 IX6 X6+X7 SA6 A1 SA2 A2 SA1 NA SET CCC ADDRESSES SA3 NL LX1 12 LX3 30 BX6 X2+X1 BX6 X6+X3 SA6 A2 SA1 CCHF CHECK FOR CONCURRENT CHANNEL NZ X1,PRS1 IF A CONCURRENT CHANNEL SYSTEM DCC,R,N CALL *DCC* EQ PRSX RETURN PRS1 SYSTEM CPM,R,PRSC,140B*100B RECALL N WAIT FOR DUMP COMPLETE EQ PRSX RETURN PRSA BSS 0 FILE ACCESS LIST CON 0LOUTPUT+L CON 0 PRSB EQU *-PRSA PRSC VFD 36/0,12/0,12/0 VFD 18/3RDCC,6/40B,36/N * USED BY TCS. EC CON 0 ERROR COUNTER EM CON 0 ERROR MESSAGE EP CON 0 ERROR POINTER CST SPACE 4 ** CONTROL STATMENT TABLE. CST BSS 0 CON 0LL L = LIST FILE VFD 6/,18/L,18/PRSA,18/AFN CON 0LCH CH = CHANNEL NUMBER CON ACH CON 0LC C = CHANNEL NUMBER CON ACH CON 0 ABT SPACE 4 ** ABT - ABORT JOB. * * ENTRY (X7) = DAYFILE MESSAGE ADDRESS. * * EXIT JOB ABORTED. * * * MACROS ABORT, MESSAGE. ABT MESSAGE X7 ABORT ACH SPACE 4 ** ACH - ASSEMBLE CHANNEL. * * ENTRY (X5) = PARAMETER SEPARATOR. * (A5) = ADDRESS OF PARAMETER SEPARATOR IN LIST. * * EXIT (N) = CONVERTED CHANNEL NUMBER. * (A5) = ADDRESS OF PARAMETER LIST. * * ERROR *ERM* CALLED IF PARAMETER ERROR. * (X7) = ERROR MESSAGE ADDRESS. * * USES A - 1, 6, 5. * B - 2, 3. * X - 1, 5, 6, 7. * * CALLS ASD, ERM. ACH SB2 X5-1R= CHECK SEPARATOR SX7 =C* EQUIVALENCE MISSING.* NZ B2,ERM IF NOT *=* SA5 A5+1 ASSEMBLE CHANNEL SX6 X5-1RC ZR X6,ACH2 IF CONCURRENT CHANNEL RJ ASD ASSEMBLE OCTAL DIGITS SB2 X6-34B CHECK CHANNEL SB3 X6-20B SX7 =C* INCORRECT CHANNEL NUMBER.* PL B2,ERM IF CHANNEL NUMBER OUT OF RANGE PL B3,ACH1 IF CHANNEL IN RANGE SB2 X6-14B PL B2,ERM IF CHANNEL OUT OF RANGE ACH1 SA1 N SET CHANNEL IN REQUEST MX7 -6 LX1 -48 BX1 X7*X1 BX6 X1+X6 LX6 48 SA6 A1 EQ TCSX RETURN ACH2 SA5 A5+1 RJ ASD SX7 =C* INCORRECT CHANNEL NUMBER.* SB2 X6-12B PL B2,ERM IF CHANNEL OUT OF RANGE SX6 X6+40B SET CONCURRENT BIAS BX7 X6 LX7 12 SET CHANNEL IN *CPM* CALL SA7 PRSC SA7 CCHF FLAG CONCURRENT CHANNEL SA1 =10H CCC, CHH BX7 X1 SA7 TTL+1 SET NEW TITLE LINE EQ ACH1 SET CHANNEL IN *DCC* CALL AFN SPACE 4 ** AFN - ASSEMBLE FILE NAME. * * ENTRY (X5) = PARAMETER SEPARATOR. * (A5) = ADDRESS OF PARAMETER SEPARATOR IN LIST. * (X2) = TRANSLATION TABLE ENTRY. * * EXIT FILENAME SET IN *FET* (*0* = NO FILE). * * USES A - 1, 5, 7. * B - 2, 3. * X - 0, 1, 2, 5, 6, 7. * * CALLS ASN. AFN SB2 X5-1R= CHECK SEPARATOR AX2 18 GET ASSUMED FILE NAME SA1 X2 AX2 18 SET FET ADDRESS MX6 42 SB3 X2 BX6 X6*X1 NZ B2,AFN1 IF NOT *=* SA5 A5+B1 SKIP SEPARATOR BX0 X2 RJ ASN ASSEMBLE NAME NZ X7,AFN3 IF ERROR IN FILE NAME SX7 1R0 CHECK NAME LX7 54 BX2 X0 BX7 X7-X6 ZR X7,AFN2 IF *0* AFN1 SA1 X2 REPLACE FILE NAME MX7 42 BX1 -X7*X1 BX7 X1+X6 NZ X1,AFN2 IF STATUS IS SET SX1 B1 BX7 X1+X6 AFN2 SA7 X2 EQ TCSX RETURN AFN3 SX7 =C* UNRECOGNIZED FILE NAME.* EQ ERM ARG SPACE 4 ** ARG - PROCESS ARGUMENTS. * * ENTRY (ISB) = STRING BUFFER CONTAINING CONTROL CARD IMAGE. * * EXIT (X1) = ZERO. * ALL PARAMETERS PROCESSED. * * ERROR *ABT* CALLED IF PARAMETER ERROR. * (X7) = ERROR MESSAGE ADDRESS. * * USES A - 1, 2, 3, 4, 5. * B - 2, 3. * X - ALL. * * CALLS ABT, ASN, TCS. * * MACROS MESSAGE. ARG SUBR ENTRY/EXIT SA5 ISB FIRST CHARACTER RJ ASN ASSEMBLE NAME ARG1 SB2 X5-1R) SB3 X5-1R. ZR B2,ARGX IF END OF COMMAND ZR B3,ARGX IF END OF COMMAND SA5 A5+1 SKIP SEPARATOR SX0 CST RJ TCS TRANSLATE CONTROL STATEMENT SA1 EM ZR X1,ARG1 LOOP IF NO ERROR MESSAGE MESSAGE X1 SX7 ARGA EQ ABT ABORT JOB ARGA DATA C* CONTROL STATEMENT ERROR.* ASD SPACE 4 ** ASD - ASSEMBLE DIGITS. * * ENTRY (X5) = FIRST CHARACTER TO ASSEMBLE. * (A5) = ADDRESS OF CHARACTER STRING. * (B2) = ZERO IF OCTAL BASE ASSUMED. * = NON-ZERO IF DECIMAL BASE ASSUMED. * * EXIT (X6) = ASSEMBLED DIGITS. * (X5) = NEXT CHARACTER TO BE PROCESSED. * (A5) = ADDRESS OF NEXT CHARACTER. * * ERROR *ERM* CALLED IF VALUE ERROR. * (X7) = ERROR MESSAGE ADDRESS. * * USES A - 5, 6. * B - 2, 3, 4, 5, 6. * X - 1, 2, 3, 5, 6, 7. * * CALLS ERM. ASD1 LX3 X7,B4 DECIMAL*10 SX5 X5+B3 CONVERT CHARACTER IX7 X3+X7 LX6 3 OCTAL*8 LX7 1 BX6 X6+X5 OCTAL+NEW DIGIT IX7 X7+X5 DECIMAL+NEW DIGIT AX5 3 NOTE *8*/*9* SB5 B5+X5 SA5 A5+B1 NEXT CHARACTER SB6 X5 CHECK CHARACTER LX3 X1,B6 NG X3,ASD1 IF DIGIT SX1 X5-1RD CHECK NEXT CHARACTER SX2 X5-1RB NZ X1,ASD2 IF NOT *D* SA5 A5+B1 SKIP CHARACTER BX6 X7 RETURN DECIMAL EQ ASDX RETURN ASD2 NZ X2,ASD3 IF NOT *B* SA5 A5+1 SKIP CHARACTER ZR B5,ASDX IF *8*/*9* NOT PRESENT SX7 =C* 8/9 NOT ALLOWED IN OCTAL FIELD.* EQ ERM PROCESS ERROR ASD3 SB2 B2+B5 SET BASE ZR B2,ASDX IF OCTAL BX6 X7 RETURN DECIMAL ASD SUBR ENTRY/EXIT MX1 10 MASK FOR *0* - *9* SB3 -1R0 SB4 B1+B1 LX1 -1R0 SX6 A5 SET ERROR POINTER SB5 B0 CLEAR *8*/*9* PRESENCE SB6 X5 CHECK CHARACTER MX7 0 CLEAR DECIMAL ASSEMBLY SA6 EP BX6 X6-X6 CLEAR OCTAL ASSEMBLY LX3 X1,B6 NG X3,ASD1 IF DIGIT SX7 =C* NUMERIC FIELD MUST NOT BE BLANK.* EQ ERM PROCESS ERROR ASN SPACE 4 ** ASN - ASSEMBLE NAME. * * ENTRY (X5) = FIRST CHARACTER IN NAME. * (A5) = ADDRESS OF FIRST CHARACTER. * * EXIT (X6) = ASSEMBLED NAME. * (X5) = NEXT CHARACTER TO BE PROCESSED. * (A5) = ADDRESS OF NEXT CHARACTER. * (X7) = 0, IF NO ERROR. * (X7) = 1, IF ERROR ENCOUNTERED. * * USES A - 5, 7. * B - 2, 4. * X - 1, 2, 5, 6, 7. ASN1 LX5 X5,B2 MERGE NG B2,ASNX IF ASSEMBLY FULL BX6 X6+X5 SA5 A5+B1 NEXT CHARACTER SB2 B2-6 SB4 X5 ASN2 AX2 X1,B4 LX2 59 NG X2,ASN1 IF LETTER OR DIGIT SX7 B0+ SET NO ERROR ASN SUBR ENTRY/EXIT MX1 36 MASK FOR LETTERS AND DIGITS SB2 54 BX6 X6-X6 CLEAR ASSEMBLY SX7 A5 SET ERROR POINTER LX1 37 SB4 X5+ SA7 EP SX7 B1+ PRESET ERROR EQ ASN2 ASSEMBLE NAME TCS SPACE 4 ** TCS - TRANSLATE CONTROL STATEMENT. * * ENTRY (X0) = ADDRESS OF STATEMENT TRANSLATION TABLE. * * EXIT PROCESSOR DEFINED FOR PARAMETER ENTERED. * * ERROR *ERM* CALLED PROCESSOR NOT DEFINED FOR PARAMETER. * (X7) = ERROR MESSAGE ADDRESS. * * USES A - 1, 2, 6, 7. * B - 2. * X - 1, 2, 3, 6, 7. * * CALLS ERM. ERM SA2 EC ADVANCE ERROR COUNTER SA7 EM SET ERROR MESSAGE ADDRESS SX6 X2+B1 SA6 A2 TCS SUBR ENTRY/EXIT RJ ASN ASSEMBLE NAME NZ X7,TCS1.1 IF ERROR SA1 X0 START NAME SEARCH TCS1 BX3 X1-X6 SA2 A1+B1 ZR X3,TCS2 IF MATCH FOUND SA1 A2+B1 NEXT ENTRY NZ X1,TCS1 LOOP TO END OF TABLE TCS1.1 SX7 TCSA EQ ERM TCS2 SB2 X2 PROCESS STATMENT JP B2 TCSA DATA C* INCORRECT DIRECTIVE NAME.* UCS SPACE 4 ** UCS - UNPACK C-FORMAT TO S-FORMAT. * * UCS UNPACKS A C-FORMAT LINE TO AN S-FORMAT LINE (1 CHARACTER/ * WORD). TRAILING SPACES ARE DELETED, AND THE END OF LINE IS * MARKED BY A NEGATIVE WORD (BITS 0-58 = 0, BIT 59 = 1). * * ENTRY (A1) = FIRST WORD ADDRESS OF C-FORMAT BUFFER. * (X1) = FIRST WORD OF C-FORMAT BUFFER. * (B2) = FIRST WORD ADDRESS OF S-FORMAT BUFFER. * * EXIT (A1) = ADDRESS OF LAST WORD OF C-FORMAT BUFFER. * (A6) = ADDRESS+1 OF LAST CHARACTER OF S-FORMAT BUFFER. * * USES A - 1, 2, 3, 6, 7. * B - 3, 4. * X - 0, 1, 2, 3, 5, 6, 7. UCS SUBR ENTRY/EXIT SA2 B2-B1 PRESET A6 MX3 1 SB3 -1R SX6 B0 BX7 X2 MX2 -6 SA6 A2 SX0 1R UCS1 LX1 6 NEXT CHARACTER BX6 -X2*X1 LX3 6 BX1 X2*X1 IX5 X6-X0 ZR X5,UCS1.5 IF LEADING SPACE SA6 A6+B1 SX0 3R UCS1.5 PL X3,UCS2 IF NOT END OF WORD SA1 A1+1 NEXT WORD UCS2 NZ X6,UCS1 IF NOT ZERO CHARACTER NZ X1,UCS1 IF NOT END OF LINE NG X1,UCS1 GET NEXT CHARACTER SA3 A6-B1 DELETE TRAILING SPACES MX6 1 UCS3 SB4 X3+B3 SA3 A3-B1 ZR B4,UCS3 IF NEXT CHARACTER ZERO SX3 -B3 SA7 A2+ RESTORE WORD BEFORE LINE BX6 X6+X3 SA6 A3+2 SET END OF LINE EQ UCSX RETURN CON 0 ISB EQU * STRING BUFFER SPACE 4 END