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$