CWRITE
* /--- FILE TYPE = E
* /--- BLOCK CWRITE 00 000 81/07/13 01.08
IDENT CWRITE
LCC OVERLAY(1,1)
*
TITLE OVERLAYS FOR COMMAND READINS
TITLE CWRITE
*
*
CST
*
*
CWRITE$ OVFILE
*
CWRTOV OVRLAY
QUAL
SB1 FSWRITE LOG -WRITE- TEXT
RJ =XPUBTEXT
SA1 OVARG1 GET OVERLAY ARGUMENT
SB1 X1
JP B1+*+1
*
+ EQ NWRITE
+ EQ NEXACTC
+ EQ NWRTCIN
*+ EQ DISIN
*
*
* /--- BLOCK TWRITIN 00 000 85/01/21 10.48
*
*
* NEW WRITE ROUTINES FOR CONDENSE
*
* PROPERLY RECORDS X AND Y INCREMENTS
* FOR BACKSPACE, SUB, SUP, RAISE, LOWER
* CR, ETC.
*
*
* SHARES THE CHARACTER DEFINITION TABLE WITH
* FORMAT (THIS IS THE ONLY TABLE WHICH DEFINES
* ALL OF THE OPERATIONS)
EXT ERRORC
EXT PUTCODE,GETLINE
EXT WRITE0=
EXT WRITE1=
EXT WRITE2=
EXT WRITE3=
EXT WRITE4=
EXT WRITEC=
EXT ZAT= GET AROUND LOADER PROBLEM
AT= EQU ZAT=-1 GET AROUND LOADER PROBLEM
EXT LNGUNIT
EXT ERRTAGS,ERRNAME,ERRSTOR
EXT ERRXYTG,ERR2MNY,ERR2FEW
EXT ERRTERM,ERRUARG,ERRVTYP
EXT ERROUTR,ERRCNTD,ERRXORQ
EXT ERRBAL
EXT CONV2
UNUSED= EQU ERRORC FOR UNDEFINED OPERATIONS
XTEXT TITLE GET EXTERNAL TEXTS
*
*
BSS 0
*
XLLL SET *L
*
*CALL CHRDEF
*CALL CHARS2
ENTER SPACE 3
*** GENERATE LOCAL SUBROUTINE ENTRY
*
PURGMAC ENTER
MACRO ENTER,NAME
ENT. IFC EQ,*NAME**
2 ERR LABEL FIELD BLANK, MACRO CALL IGNORED
ENT. ELSE
NAME SPACE 0
DATA 0L_NAME
NAME DATA 0
EXITNAM= SET NAME
ENT. ENDIF
ENDM
EXIT SPACE 4
*** GENERATE EXIT CODE
PURGMAC EXIT
MACRO EXIT,A,BB
EXT1 IFC EQ,*A**
EXT1 IFC EQ,*BB**
EQ EXITNAM=
EXT1 ELSE
EXT2 IFC NE,*A**
EQ A
EXT2 ELSE
EQ BB
EXT2 ENDIF
EXT1 ENDIF
ENDM
*
LOC XLLL+400B
*
*
* /--- BLOCK LOCAL MAC 00 000 85/01/21 10.46
PLNTCODE TITLE LOCAL MACROS
*** PLNTCODE - PLANT COMMANDS IN WRITCBUF
*
*
PLNTCODE MACRO
SA1 WRKPNT
SA2 INWC
IX7 X2-X1
PL X7,LNGUNIT
SX7 X1-1
SA7 A1
SA6 X1+WRITCBUF
ENDM
CHRACTN SPACE 5
*** CHRACTN - ACTION FOR PLOTABLE CHARACTER
*
*
CHRACTN MACRO
PACKCHR X5
ENDM
PACKCHR SPACE 5
**** PACKCHR - PACKS AND STORES CHARACTERS
*
*
PACKCHR MACRO XN
LOCAL NN
SB4 B4+B1 COUNT
LX7 6
BX7 XN+X7
SB7 B7-B1
* SENSE ASSEMBLY FULL
NZ B7,NN
SA7 A7+B1
MX7 0
SB7 10
NN BSS 0
ENDM
BKSPCHR SPACE 5
*** BKSPCHR - REMOVE ONE CHARACTER FROM PACKED STRING
*
*
BKSPCHR MACRO
LOCAL NN
* TEST ASSEMBLY EMPTY
SX1 B7-10
NZ X1,NN
* BACK UP ASSEMBLY
SA1 A7-B1
BX7 X1
SA7 A1
SA1 A1+B1
BX7 X1
SB7 B0
* BACK SPACE ASSEMBLY
NN MX1 -6
BX7 X1*X7
LX7 -6
SB4 B4-B1
* /--- BLOCK LOCAL MAC 00 000 78/03/20 11.50
SB7 B7+B1
ENDM
NEXTCHR SPACE 5
*** NEXTCHR - FETCHS NEXT CHAR AND SETS UP X2 WITH THE ACTION
*
*
NEXTCHR MACRO EXIT
SA5 A5+B1
ZR X5,EXIT
* CHECK CHARACTER
SB2 X5+B5
ZR B2,EXIT
BX2 X0+X5
SA2 X2+OUTABLE
ENDM
TESTMEM SPACE 5
*** MEMTEST - TEST FOR SPECIAL MEMORY
*
*
TESTMEM MACRO JUMP
SX1 B2-6
PL X1,JUMP
ENDM
TSTX SPACE 5
*** TSTX DEFINE DO NOTHING MACROS
* UNCOVER
*
*
TSTX MACRO
BSS 0
ENDM
UNCOVER OPSYN TSTX
RECOVER SPACE 5
*** RECOVER - FOR PACKER
*
*
RECOVER MACRO
EQ CHAR
ENDM
AUTOBKSP SPACE 5
*** AUTOBKSP - AUTOMATIC BACKSPACE
*
*
AUTOBKSP MACRO
PL X0,CHAR NO ACCESS
DEACC
EQ CHAR
ENDM
RAISER SPACE 4
*** RAISER - DO RAISER OPERATIONS
*
*
RAISER MACRO
SX0 X0 CLEAR ACCESS FLAG
EQ CHAR
ENDM
SPECIAL SPACE 5
*** SPECIAL - DO SPECIAL CHARACTER OPERATIONS
*
*
SPECIAL MACRO
LOCAL LL,MM
SX1 X2-RMGACTN CHECK FOR RIGHT MARGIN
NZ X1,LL
SX5 1R1 CHANGE TO SIMPLE BACKWARD
EQ MM AND PACK IT AWAY
LL SX1 X2-ORIACTN CHECK FOR ENTER ORIENTAL
NZ X1,MM
SA2 A2
LX2 18
UX2,B0 X2 HORIZ/VERT CHAR
LX2 18
SX1 X2-1R- MINUS SIGN = VERTICAL
NZ X1,MM
SX5 1R% SWITCH TO VERTICAL
MM PACKCHR X5
ENDM
CRINC SPACE 5
**** CRINC - PROCESS REGISTERS FOR CR*S
*
*
CRINC MACRO
MX3 0
MX0 0
YINC -YCHRINC
ENDM
WCR SPACE 5
*** WCR - SPECIAL CR ACTION MACRO
*
*
WCR MACRO
CRINC
SB3 -B1
ENDM
CR SPACE 5
*** CR - PROCESS CR TO MARGIN
*
*
CR MACRO
WCR
EQ CHAR
ENDM
ALCR SPACE 5
*** ALCR - PROCESS CR TO BORDER
*
*
ALCR MACRO
CRINC
SB3 B1
EQ CHAR
ENDM
BKSP SPACE 5
*** BKSP - PROCESS BACKSPACE
*
*
PURGMAC BKSP
BKSP MACRO
XINC -XCHRINC
EQ CHAR
* /--- BLOCK LOCAL MAC 00 000 78/03/20 11.50
ENDM
TSTCNT SPACE 5
*** MACRO TO TEST FOR A CONTINUATION
*
*
* NO CONTINUATION EXIT TO EXIT
*
*
TSTCNT MACRO EXIT
SA1 NEXTCOM GET NEXT COMMAND
* /--- BLOCK LOCAL MAC 00 000 78/03/14 23.54
SA2 K8S
BX1 X1-X2 TEST CONTINUATION
NZ X1,EXIT
ENDM
PLNTELMT SPACE 5
*** MACRO TO PLANT ELEMENT IN TABLE
*
*
PLNTELMT MACRO
* COMBINE COMMAND TYPE AND PARAMETERS
BX6 X6+X7
* TEST FOR UNIT TOO LONG
SA1 INWC
SA2 WRKPNT
IX7 X1-X2
PL X7,LNGUNIT
* INCREMENT POINTER AND PLANT ITEM
SX7 X1+B1
SA7 A1
SA6 X1+WRITCBUF
ENDM
EMBED0 SPACE 5
*** DO EMBEDDING OPERATION
*
*
EMBED0 MACRO
SX0 X0
EQ PACKER
ENDM
ACOMMA SPACE 4
*** ACOMMA - DO UNIVERSAL DELIMINATOR OPS
*
PURGMAC ACOMMA
*
ACOMMA MACRO
SA1 CSET=
BX0 X1
SX1 B5-77B CHECK ACTIVE
ZR X1,PACKER IF ACTIVE
XINC XCHRINC
EQ CHAR3 JUST CONTINUE
ENDM
EMBED1 SPACE 5
*** DO EMBEDDING OPERATION
*
*
EMBED1 MACRO
XINC XCHRINC
EQ CHAR3
ENDM
PLNTCR SPACE 5
*** PLNTCR - DO END OF LINE CARRIAGE RETURN ACTION
*
*
PLNTCR MACRO
WCR
SX1 KCR
PACKCHR X1
RJ WGETLINE
SA5 TAG-1
ENDM
PLNTWRD SPACE 5
*** PLNTWRD - PLANT WORD IN FORWARD EXPANDING
* TABLE
*
* X6 - CONTAINS THE ITEM
*
* CHECKS FOR TABLE OVERLFOW
*
*
PLNTWRD MACRO T
LOCAL NN
* GET TABLE DESCRIPTOR
SA1 L.T
UX2,B2 L.T
SA6 X2+B2
SB2 B2+1
PX7 X2,B2
SA7 A2
* CHECK FOR OVERFLOW ON NEXT ITEM
NG B2,NN
RJ LGETSPC
NN BSS 0
ENDM
PLNTCOD SPACE 5
*** PLNTCOD - PLANT CODE IN BACKWARD EXPANDING
* TABLE
*
* X6 - CONTAINS ITEM
*
*
PLNTCOD MACRO T
LOCAL NN
* GET TABLE DESCRIPTOR
SA2 O.T
UX2,B2 X2
* UPDATE TABLE PARAMETERS
SB2 B2-1
SA6 X2,B2
PX7 X2,B2
SA7 A2
* CHECK FOR TABLE UNDERFLOW ON NEXT ITEM
* /--- BLOCK LOCAL MAC 00 000 76/07/24 11.34
NZ B2,NN
RJ OGETSPC
NN BSS 0
ENDM
FORWRD SPACE 4
*** FORWRD - PROCESS FORWARD STRING
*
*
PURGMAC FORWRD
FORWRD MACRO
SB6 B0 MARK FORWARD
EQ /FORWRD/CHAR
ENDM
BACKWRD SPACE 4
*** BACKWRD - PROCESS BACKWARD STRING
*
*
PURGMAC BACKWRD
BACKWRD MACRO
SB6 1 MARK BACKWARD
EQ /BCKWRD/CHAR
ENDM
RMARG SPACE 4
*** PROCESS SET TO RIGHT MARGIN
*
*
PURGMAC RMARG
RMARG MACRO
* SX3 512-XCHRINC
ENDM
* /--- BLOCK WRITE 00 000 77/04/24 23.20
NWRITE TITLE NEW WRITEC COMMAND
*** NEW WRITE COMMAND WHICH ALLOWS EMBEDDING
*
*
* SPECIAL EMBEDDING CHARACTER IS ACCESS 0
*
LIST M,G
*
NWRITE BSS 0
SA5 TAG-1 SET UP FOR PACKER
SB5 7777B SET TO IMPOSSIBLE CHARACTER
SB1 1 SET UNIVERSAL CONSTANT
RJ ECSINTL DO PRESETS
WRT1 SB6 B0 CLEAR LEFT WRITING
RJ PACKER
NZ X5,WRT3 PROCESS ^0 ^1
TSTCNT WRT2 SENSE END OF STATEMENT
PLNTCR
EQ WRT1 AND CONTINUE WITH COMMAND
WRT2 RJ ECSFINAL FINISH UP WRITE COMMAND
SA7 COMNUM SET UP COMMAND TYPE
EQ PUTCODE
WRT3 SX1 X5-1R, SENSE SPECIAL WRITEC TERMINATOR
ZR X1,WRT1 JUST CONTINUE
SA1 A5+B1 TRY FOR MODE CHANGE
SX1 X1-1RM
ZR X1,WRT4 YES EMBED MODE IN STRING
RJ EMBEDER FINISH UP IN EMBED
SA7 COMNUM
EQ PUTCODE
WRT4 RJ CPMODE
EQ WRT1
* /--- BLOCK EXACTC 00 000 77/04/24 21.48
EXACTC TITLE NEW EXACTC COMMAND FOR LEFT WRITTING
*** NEW EXACTC COMMAND. PROPERLY HANDLES LEFT
* WRITTING AND INCLUDES UNIVERSAL SEPARATOR
*
NEXACTC BSS 0
CALL COMPILE GET NGETVAR CODE
SB1 1 SET UNIVERSAL CONSTANT
BX6 X1 SAVE NGETVAR CODE
LX6 -XCODEL POSITION FOR COMMAND
SA6 =XBRVAR SET UP FOR EXIT PROCESS
MX7 0 CLEAR STORAGE POINTER
SA7 WRKPNT RELATIVE ELEMENT IDENT ADR
SA7 WORK CLEAR FIRST LOCATION
SA7 CONV3 CLEAR NUMBER OF ITEMS
SA1 INX PRESENT INFO POINTER
SX6 INFO SET UP A7 FOR PACKER
IX6 X1+X6 FIRST TEXT LOCATION
SA6 ORGA7 PRESET FOR LENGTH CHECKS
SA1 X6-1 BACK UP ONE
BX7 X1
SA7 A1 AND SET UP A7
SA1 LASTKEY GET EXPRESSION TERMINATIOR
BX1 -X1 SET UP TERMINATOR
SB5 X1 IN B5
SA2 WORDPT GET FIRST TAG CHARACTER
SA2 X2
SA5 A2-B1 SET UP A5 FOR PACKER
SB6 B0 CLEAR LEFT WRITING
ZR X1,XCLN ELEMENTS START ON NEXT LINE
SX1 X1+1R, SENSE SPECIAL EMBED
NZ X1,NEXC1
SA1 A5-B1 TRY FOR ACCESS
SX1 X1-ACCESS
NZ X1,NEXC1
SB5 77B
NEXC1 ZR X2,XCLN START WITH NEXT LINE
EQ XCLN1
XCLN SPACE 4
*** PROCESS EXACTC ITEMS
*
* ELEMENT TERMINATES ONLY AT SPECIAL CHARACTER
*
*
XCLN TSTCNT ERRCNTD MUST BE CONTINUATION
CALL WGETLINE
SA5 TAG-1 SET UP FOR PACKER
XCLN1 RJ EXCINTL INITIALIZE BUFFERS
XCLN2 RJ PACKER PACK UP ELEMENT
SX1 X5+B5 CHECK FOR TERMINATOR
ZR X1,XCLN3 IF END OF ELEMENT
ZR X5,XCLN3 IF END OF LINE
SX1 X5-1R, TRY FOR SPECIAL SEPARATOR
NZ X1,XCLN2 CONTINUE PACKING
SX1 B5-77B CHECK IF ACTIVE
NZ X1,XCLN2 IF NOT ACTIVE
RJ BKSPCHR REMOVE SEPARATOR
RJ BKSPCHR
XCLN3 RJ EXCFINL FINALIZE ENTRY
SA5 A5 CHECK FOR END OF LINE
ZR X5,XCLN4 IF END OF LINE
SA1 A5+B1 ELEMENT MAY END WITH SEPARATOR
NZ X1,XCLN1 IF MORE ELEMENTS TO DO
XCLN4 TSTCNT EXFINAL CHECK FOR CONTINUATION
CALL WGETLINE GET NEXT LINE
SA5 TAG-1 INITIALIZE FOR PACKER
EQ XCLN1
* /--- BLOCK EXACTC 00 000 76/08/13 04.32
EXCFINL SPACE 4
*** PROCESS EXIT FROM COMMAND
*
*
EXFINAL SA1 CONV3 GET NUMBER OF ELEMENTS
ZR X1,ERR2FEW --- EXIT IF NO ITEMS
SX1 X1-1 0 TO N-1
AX1 1 NUMBER OF WORDS
SB2 X1 COUNT OF WORDS
SX2 INFO
SX2 INFO-1 CALCULATE TABLE BIAS
SX6 A7 MARK TABLE ORIGIN
IX6 X6-X2 RELATIVE LOCATION
SA6 CONV2
SA1 WORK-1 PRESET TO BEG OF ITEMS -1
EXCFN1 SA1 A1+B1 FETCH ITEM
BX7 X1
SA7 A7+B1 PLANT IT
SB2 B2-B1 DECREMENT COUNT
PL B2,EXCFN1 LOOP
EXCFN2 SX6 INFO GET RELATIVE OF LAST WORD USED
SX2 A7
IX6 X2-X6
SA6 INX UPDATE INFO POINTER
SA4 COMNUM GET COMMAND NUMBER
BX6 X4 FOR STANDARD PROCESS
EQ =XCONUL4 --- EXIT VIA CONDITNL BRANCH
* /--- BLOCK NEW WRITEC 00 000 77/04/24 21.48
NWRTCIN TITLE PROCESS WRITEC COMMAND
*** PROCESS WRITEC COMMAND
*
* SET UP TABLE AND DISTINGUISH COMMAND FORMAT
*
*
NWRTCIN BSS 0
RJ =XCOMPILE GET NGETVAR CODE
SB1 1 SET UNIVERSAL CONSTANT
BX6 X1 SAVE NGETVAR CODE
MX7 0 CLEAR STORAGE POINTER
SA6 WCOMND
SA7 INWC
SX6 WRCBLTH-1 SET UP COMMAND POINTER
SA6 WRKPNT
SA1 LASTKEY GET EXPRESSION TERMINATIOR
BX1 -X1 SET UP TERMINATOR
SB5 X1 IN B5
SA2 WORDPT GET FIRST TAG CHARACTER
SA2 X2
SA5 A2-B1 SET UP A5 FOR PACKER
SB6 B0 CLEAR LEFT WRITING
ZR X1,WCLN ELEMENTS START ON NEXT LINE
SX1 X1+1R, SENSE SPECIAL EMBED
NZ X1,NWRT1
SA1 A5-B1 TRY FOR ACCESS
SX1 X1-ACCESS
NZ X1,NWRT1
SB5 77B
NWRT1 ZR X2,WCLN START WITH NEXT LINE
EQ WCLN1
WCLN SPACE 5
*** PROCESS SPECIAL WRITEC
*
* ELEMENT TERMINATES ONLY AT SPECIAL CHARACTER
* /--- BLOCK NEW WRIT6C 00 000 76/07/25 09.16
* END OF LINE GENERATES CR
*
*
WCLN TSTCNT ERRCNTD MUST BE CONTINUATION
RJ WGETLINE
SA5 TAG-1 SET UP FOR PACKER
WCLN1 RJ ECSINTL INITIALIZE REGS
WCLN2 RJ PACKER
SX1 X5+B5 CHECK FOR TERMINATOR
ZR X1,WCLN3
NZ X5,WCLN6 PROCESS ^0
TSTCNT WCLN3 NO CONTINUATION IS ALSO END
PLNTCR
EQ WCLN2 CONTINUE WITH ELEMENT
WCLN3 ZR B4,WCLN5 SENSE NO CHAR
RJ ECSFINAL FINISH UP ELEMENT
WCLN3A PLNTELMT PLANT IT
SA5 A5 CHECK FOR END OF LINE
ZR X5,WCLN4 JUMP ON EOL
SA1 A5+B1 LAST ITEM MIGHT END WITH COMMA OR SEMICOLON
NZ X1,WCLN1 JUMP IF NOT EOL
WCLN4 TSTCNT WCFIN CONTINUATION TEST
RJ WGETLINE
SA5 TAG-1
EQ WCLN1
WCLN5 SX6 0 NULL WRITE OPERATION
SX7 WRITE0=
EQ WCLN3A AND PLANT ELEMENT
WCLN6 SX1 X5-1R, SENSE SPECIAL WRITEC TERMINATOR
ZR X1,WCLN7 AND CONTINUE
SA1 A5+B1 TRY FOR MODE CHANGE
SX1 X1-1RM
ZR X1,WCLN8 YES EMBED MODE IN STRING
RJ EMBEDER FINISH UP IN EMBED
EQ WCLN3A AND PLANT ELEMENT
WCLN7 SX1 B5-77B CHECK SPECIAL TERMINATOR ACTIVE
NZ X1,WCLN2 IF NOT JUST CONTINUE
RJ BKSPCHR
RJ BKSPCHR
EQ WCLN3 END ELEMENT
WCLN8 RJ CPMODE
EQ WCLN2
WCFIN SPACE 5
*** PROCESS END ACTIONS
*
*
* FIX UP COMMAND WORD
*
*
WCFIN SA1 WCOMND GET NGETVAR CODE
SA2 INX AND PRESENT STORAGE POINTER(INFO)
SA3 INWC AND PRESENT STORAGE POINTER(WRITCBUF)
SA4 ATEMPEC ADDRESS OF ECS BUFFER
BX0 X4 ECS TEMP BUFFER
SB2 X3 NUMBER OF ELEMENTS TO TRANSFER
SA0 WRITCBUF TO INFO BUFFER
WE B2 TRANSFER ELEMENTS
RJ =XECSPRTY
SA0 X2+INFO
SX6 X2+B2 BUMP INX
SA6 A2
RE B2
RJ ECSPRTY
SX3 X3-1 RANGE IS O-(N-1)
* /--- BLOCK PROCESS EM 00 000 76/07/22 02.46
LX3 -24 POSITION RANGE
SB2 X2 STORAGE BIAS TO B2
PX3 B2,X3 PACK BIAS AND RANGE
BX6 X1+X3 PACK NGETVAR CODE
LX6 -XCODEL FINAL POSITIONING
SX7 WRITEC=
SA7 COMNUM
EQ PUTCODE PLANT IT
EMBEDER TITLE PROCESS EMBEDDED COMMANDS
*** PROCESS EMBEDDED COMMANDS
*
*
* EXIT WITH DATA IN X6, AND COMMAND TYPE IN X7
*
*
EMBEDER ENTER
RJ EINTL DO INITIALIZATIONS
EMBD1 RJ BKSPCHR DUMP ^0
RJ BKSPCHR
ZR B4,EMBD2 IGNOR NULL WRITES
RJ ECSFINAL FINISH UP WRITE
BX6 X6+X7 COMBINE DATA AND COMMAND TYPE
PLNTCODE
EMBD2 SX6 A5+B1 SET UP FOR EMBEDDOR
SA6 WORDPT
SX6 B5 SAVE TERMINATING CHAR
SA6 WSAVEREG
SX6 B6
SA6 A6+B1
CALL EMBED
SB1 1
SA1 WSAVEREG
SB5 X1 RESTORE TERMINATOR
SA1 A1+B1
SB6 X1
SA1 COMNUM GET COMMAND TYPE
BX6 X1+X6 COMBINE WITH DATA
PLNTCODE
SA1 WORDPT SET UP A5
SA5 X1 GET LAST CHAR
SX2 X5+B5 END OF ELEMENT TEST
ZR X2,EMBD7
ZR X5,EMBD4 END OF LINE TEST
SA5 A5-B1 FOR PACKER
RJ ECSINTL INITIALIZE FOR ADDITIONAL WRITE
EMBD3 RJ PACKER PROCESS WRITE
SX1 X5+B5 END OF ELEMENT TEST
ZR X1,EMBD6
ZR X5,EMBD5 END OF LINE TEST
SX1 X5-1R, SENSE SPECIAL WRITEC TERMINATOR
ZR X1,EMBD8 BACKUP AND QUIT
SA1 A5+B1 TRY FOR MODE CHANGE
SX1 X1-1RM
ZR X1,EMBD9 YES EMBED MODE IN STRING
EQ EMBD1 PROCESS EMBEDDED ELEMENT
*
* POSSIBLE END OF ELEMENT
*
EMBD4 TSTCNT EMBD7
RJ ECSINTL INITIAL FOR NEXT WRITE
SA1 COMNUM CHECK FOR -AT- COMMAND
SX2 AT=
IX2 X1-X2
ZR X2,EMBD4A NO CR FOR AT
SX2 X2-1 CHECK FOR AT*
ZR X2,EMBD4A
PLNTCR
EQ EMBD3
EMBD4A RJ WGETLINE
SA5 TAG-1
EQ EMBD3 PROCESS NEXT WRITE SEGMENT
*
* POSSIBLE END OF WRITE
* /--- BLOCK PROCESS MO 00 000 76/07/25 09.26
*
EMBD5 TSTCNT EMBD6
PLNTCR
EQ EMBD3 CONTINUE WITH WRITE
*
*
EMBD6 ZR B4,EMBD7 IGNOR NULL WRITES
RJ ECSFINAL FINISH WRITE
BX6 X6+X7
PLNTCODE
EMBD7 RJ EFINAL FINISH UP EMBEDDED COMMANDS
EXIT
EMBD8 SX1 B5-77B CHECK FOR SPECIAL ACTIVE
NZ X1,EMBD3
RJ BKSPCHR
RJ BKSPCHR
EQ EMBD6
EMBD9 RJ CPMODE
EQ EMBD3 CONTINUE TO PACK
CPMODE TITLE PROCESS MODE CHANGE
*** PROCESS EMBEDED MODE CHANGES
* CONVERT TO SPECIAL ACCESS KEYS
*
*
CPMODE ENTER ENTRY/EXIT
RJ BKSPCHR REMOVE EMBED ACCESS
RJ BKSPCHR REMOVE EMBED 0
SA1 A5+2 CHECK FORMAT
SX2 X1-1R,
NZ X2,ERRTERM
SA1 A5+4
SX2 X1-ACCESS
NZ X2,ERRTERM
SA1 A5+5
SX2 X1-1R1 CHECK ENDING
NZ X2,ERRTERM
SA1 A5+3 GET TYPE
SB2 1R2
SX2 X1-1RE
ZR X2,PMD1
SB2 1R3
SX2 X1-1RW
ZR X2,PMD1
SB2 1R4
SX2 X1-1RR
NZ X2,ERRNAME
PMD1 SX5 KUP PLANT SHIFT CODE
PACKCHR X5
SX5 B2
PACKCHR X5 PACK UP SPECIAL ACCESS
SA5 A5+5
EXIT
* /--- BLOCK PACKER 00 000 76/08/09 03.48
PACKER TITLE PACK UP LINE INTO BUFFER
* ROUTINE TO PACK CHARACTER STRING INTO A BUFFER
*
PACKER ENTER EXIT/ENTRY
ZR B6,/FORWRD/CHAR IF NORMAL WRITING
NG B6,/BCKWRD/CHAR IF LEFT WRITING BUT NOT NEW
SX5 KUP SET UP FOR LEFT WRITING
PACKCHR X5
SX5 1R1
PACKCHR X5
EQ /BCKWRD/CHAR IF LEFT WRITING
QUAL FORWRD
* LIST M,X,S
CHARACTR PACKER SPECIAL SCANNING MACRO
PURGMAC XINC
XINC MACRO ARG
LOCAL L
L EQU ARG
SX3 X3-L
ENDM
QUAL BCKWRD
CHARACTR PACKER
QUAL
** DEFINE RMARG AND ORIENTV ACTIONS
RMGACTN EQU /BCKWRD/RMGACTN
ORVACTN EQU /BCKWRD/ORIACTN
LIST *
* /--- BLOCK PACKER 00 000 76/08/11 17.25
ECSINTL SPACE 5
**** ECSINTL - INITIALIZE WORK BUFFER FOR ECS EXTRA
* STORAGE USED
*
* INITIALIZE ALSO VARIOUS REGS
*
PURGMAC XINC
XINC MACRO ARG
LOCAL L
L EQU ARG
SX3 X3+L
ENDM
ECSINTL ENTER
SA2 WORK-1 PRESET A7/X7
BX7 X2
SA7 A2
MX7 0
SB7 10
SB3 B0 CLEAR CR FALG
SB4 B0 CLEAR CHARACTER COUNT
MX0 0 CLEAR TO NORMAL FONT
MX3 0 CLEAR X
MX4 0 CLEAR Y
PX4 X4
EXIT
ECSFINAL SPACE 5
* /--- BLOCK ECSFINAL 00 000 77/03/31 14.54
*
**** ECSFINAL - WRITE INTO LAST OF ECS BUFFER THE
* INFO DATA, AND SET UP COMMAND WORD
* WITH LENGTH AND BIAS IN X6
* LENGTH AS A PACKED EXPONENT
* BIAS AS THE NEXT 16 BITS
* XINC AS THE NEXT 10 BITS
* YINC AS THE NEXT 10 BITS
*
* EXIT WITH COMMAND TYPE IN X7
*
*
ECSFINAL ENTER
*
*PT SAVING A5,B5,B6 PROBABLY NOT NEEDED (2/28/77)
SX6 A5 SAVE A5
SA6 WSAVEREG
SX6 B5 AND B5
SA6 A6+1
SX6 B6 AND B6
SA6 A6+B1
*
* FIRST CLEAN UP X7
*
NZ B4,ECSF1 SENSE NO CHARS
SX1 1R
PACKCHR X1 PACK SPACE
XINC XCHRINC
ECSF1 RJ FIX.X7 POSITION X7
*
* NOW PLANT IN ECS
*
ECSF2 SA0 WORK CM BUFFER
SB2 A0-B1 LENGTH CAOC
SB2 A7-B2 LENGTH TO B2
*
SA2 ECSARGS NUMBER OF ECS ARGS
SX1 B2
IX7 X1+X2 INCREMENT NUMBER OF ARGS
SX1 X7-ECSRESL
PL X1,LNGUNIT SEE IF TOO MANY ECS ARGS
SA7 A2 WRITE OUT NEW LENGTH
SA1 ECSRESB ADDRESS OF ECS ARGS BUFFER
IX0 X1+X2 ADDRESS AT WHICH TO INSERT
+ WE B2 WRITE OUT
RJ ECSPRTY
*
SB1 1 RESET UNIVERSAL CON
SA1 WSAVEREG RESET A5/B5
SA5 X1
SA1 A1+B1
SB5 X1
SA1 A1+B1
SB6 X1
*
* CONSTRUCT COMMAND WORD
*
SX1 B4-3777B CHECK IF TOO MANY CHARACTERS
PL X1,ERRLNG
BX6 X2 GET OFFSET INTO ECS ARGS
LX6 -12-16 POSITION FOR COMMAND WORD
SB4 B4-1777B OFFSET NUMBER OF CHARS
PX6 X6,B4 PACK NUMBER OF CHARS
MX0 -10 SET UP COMMAND WORD
BX3 -X0*X3 TRUNCATE TO 9 BITS PLUS SIGN
UX4,B2 X4 RECOVER TEMP BIAS
SX1 B2
IX4 X4-X1
BX4 -X0*X4 YYY TRUNCATE
LX3 22
LX4 12 POSITION YYY
BX6 X3+X6 MERGE
BX6 X4+X6
SX1 B6 MARK DIRECTION
LX1 11
BX6 X1+X6
*
* SET TYPE OF COMMAND
*
NZ B3,ECSF3 SENSE CR
* /--- BLOCK PROCESS10 00 000 77/03/29 20.59
*
SX7 WRITE1= NO CR
EXIT
ECSF3 NG B3,ECSF4 SENSE CR TO MARGIN
SX7 WRITE2= SET UP CR TO BORDER
EXIT
ECSF4 SX7 WRITE3=
EXIT
*
BKSPCHR SPACE 5
*** ROUTINE TO BKSP A CHAR
*
*
BKSPCHR ENTER
BKSPCHR
EXIT
EINTL SPACE 5
*** INITIALIZE FOR EMBEDDING
*
*
EINTL ENTER
SX6 WRCBLTH-1 SET UP COMMAND POINTER
SA6 WRKPNT
EXIT
EFINAL SPACE 5
*** EFINAL - FINAL ACTIONS FOR EMBEDDING
*
*
EFINAL ENTER
*
*PT PROBABLY DO NOT NEED THESE SAVES (2/28/77)
SX6 A5 SAVE A5
SA6 WSAVEREG
SX6 B5 AND B5
SA6 A6+1
SX6 B6
SA6 A6+B1
*
* SET UP FOR ECS WRITE
*
SA1 WRKPNT CALC COMMAND LENGTH
BX2 -X1
SB4 X2+WRCBLTH-1 LENGTH
SA0 X1+WRITCBUF+1 ECS
*
SA1 ECSRESB START OF ECS ARGS
SA2 ECSARGS NUMBER OF ECS ARGS
IX0 X1+X2 ADDRESS TO INSERT MORE
SX1 B4
IX7 X2+X1 NEW NUMBER OF ECS ARGS
SA7 A2 UPDATE NEW LENGTH
SX1 X7-ECSRESL
PL X1,LNGUNIT SEE IF TOO MANY ARGS
+ WE B4 WRITE OUT
RJ ECSPRTY
*
SB1 1 RESET UNIVERSAL CON
SA1 WSAVEREG RESET A5/B5
SA5 X1
SA1 A1+B1
SB5 X1
SA1 A1+B1
SB6 X1
*
*
* CALC COMMAND BIAS
*
BX6 X2 GET OFFSET IN ECS ARGS
LX6 -12-16
PX6 X6,B4 BIAS AND LENGTH
SX7 WRITE4= COMMAND TYPE
EXIT
* /--- BLOCK WGETLINE 00 000 77/03/31 15.06
WGETLINE SPACE 5
**** WGETLINE
*
* EXIT WITH B6 = 0
*
WGETLINE ENTER
SX6 B3 SAVE B3,B4,B5,B7,A7,X0,X3,X4,X7
SA6 WSAVEREG
SX6 B4
LX6 18
SX1 B7
BX6 X1+X6
LX6 18
SX1 A7
BX6 X1+X6
SA6 A6+B1
SA7 A6+B1
BX6 X0
SA6 A7+B1
BX6 X3
SA6 A6+B1
BX6 X4
SA6 A6+B1
SX6 B5
SA6 A6+B1
*
* * * END TEST AT EVERY LINE TO STAY IN WORK BUFFER
*
SX2 B4-3777B CHECK IF TOO MANY
PL X2,ERRLNG
*
* * *
*
RJ GETLINE
SB1 1
SA1 WSAVEREG RESTORE REGS
SB3 X1
SA1 A1+B1
SA2 X1
BX7 X2
SA7 X1
AX1 18
SB7 X1
AX1 18
SB4 X1
SA1 A1+B1
BX7 X1
SA1 A1+B1
BX0 X1
SA1 A1+B1
BX3 X1
SA1 A1+B1
BX4 X1
SA1 A1+B1
SB5 X1
SB6 B0
*
EXIT
*
*
WRKPNT DATA 0 COMMAND POINTER IN WRITCBUF
INWC DATA 0 STORAGE POINTER IN WRITCBUF
WCOMND DATA 0 TEMP STORAGE FOR WRITEC COMMAND
WSAVEREG BSSZ 7
CSET= DATA 0 IN CONDENSE ALWAYS USE READ ONLY FONT
* /--- BLOCK EXACTSUBS 00 000 76/08/13 03.05
EXCSUBS TITLE VARIOUS SUBROUTINES FOR EXACTC
*** INITIALIZE FOR AN ELEMENT
*
* SETS UP FOR PACKER
*
*
EXCINTL ENTER EXIT/ENTRY
MX7 0 CLEAR CHARACTER ACCUM
SB7 10 SET NUMBER OF CHARS REMAINING
SB4 B0 NUMBER OF CHARS IN ELEMENT = 0
SB3 B0
MX0 0 SET TO NORMAL FONT
* THE FOLOWING ARE SET FOR X/Y OPERATIONS
MX3 0
MX4 0
PX4 X4
EXIT
EXCFINL SPACE 4
*** CLEAN UP ELEMENT AND BUMP COUNTERS
*
*
EXCFINL ENTER
*
RJ FIX.X7 GO FIXUP X7
*
*
* NOW FORM THE ELEMENT IDENTIFIER
*
*
EXCF1 SA1 ORGA7
SX6 INFO
IX6 X1-X6 RELATIVE ADDRESS IN *INFO*
LX6 30-12
SX2 B4 TOTAL NUMBER OF CHARACTERS
LX2 30-12-12
BX6 X2+X6
SA1 WRKPNT CURRENT TABLE ADDRESS
SA2 WORK+X1
SA3 =XCONV3 CURRENT NUMBER OF ENTRIES
BX6 X2+X6
LX3 -1 TEST ODD/EVEN
NG X3,EXCF3 IF ODD
LX6 30 POSITION EVEN ENTRIES TO TOP
SA6 A2
EXCF2 LX3 1 RESTORE TRUE COUNT
SX6 X3+B1 AND BUMP IT
SA6 A3
SX6 A7+B1 SAVE POSSIBLE ORG FOR NEXT ELMT
SA6 ORGA7
EXIT
EXCF3 SA6 A2 PLANT COMPLETED WORD
SX6 X1+B1 BUMP NUMBER OF IDENTS
SA6 A1
MX6 0 CLEAR NEXT WORD
SA6 A2+B1
EQ EXCF2
ORGA7 DATA 0 RELATIVE ORIGIN OF ELEMENT
* /--- BLOCK FIX.X7 00 000 77/11/12 04.41
FIX.X7 SPACE 4
*** COMMON ACTIONS TO POSITION X7 FOR EXACTC/WRITEC
*
*
FIX.X7 ENTER
* FIX UP X7 IF NECESSARY
*
SX1 B7-10 TEST NUMBER OF REMAINING CHARS IN WORD
ZR X1,FIX.X7 IF NO CHARACTERS IN ACCUM
SX1 B7 CALCULATE SHIFT COUNT
LX1 1
SX1 X1+B7 X3
LX1 1 X6
SB7 X1
LX7 B7,X7 POSITON LAST WORD
SA7 A7+1 PLANT IT
EXIT
*
* TITLE DISPLAY CODE OUTPUT COMMAND
**** DISIN - PROCESS DISPLAY CODE OUTPUT
*
*
* DISIN CALL SYSTEST LIMIT TO SYSTEM PROGRAMS
* SX7 10 DEFAULT NUMBER OF CHARACTERS
* CALL SHOWAGO USE SHOWA DRIVER
* EQ =XPUTCODE
**
**
******
PURGMAC SB1
******
ERRLNG SB1 108 TOO MANY CHARS IN WRITE TAG
EQ =XERR
*
K8S DATA 8L SPACES
*
*
QUAL CWRTOV
ENDOV
*
* /--- BLOCK END 00 000 77/04/24 22.07
*
*
OVTABLE
*
*
END CWRITE$