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