Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50517/edit.mac
There are 36 other files named edit.mac in the archive. Click here to see a list.
TITLE EDIT FOR RPGLIB %1
SUBTTL EDIT STRING PROCESSOR
; EDIT - EDIT STRING PROCESSOR FOR RPGLIB %1
;
; THIS PORTION OF THE RUNTIME SYSTEM HANDLES ALL EDITING
; FUNCTIONS AS WELL AS THE FUNCTION OF LITERAL OUTPUT.
; MAIN EDITING ALGORITHIM COURTESY RON CURRIER.
;
; BOB CURRIER OCTOBER 22, 1975 21:03:03
;
; ALL RIGHTS RESERVED, BOB CURRIER
;
TWOSEG
RELOC 400000
SEARCH RPGSWI ; FIND SWITCH MACRO
SEARCH RPGPRM ; GET PARAMETERS
SEARCH MACTEN, UUOSYM, RPGUNV ; PICK UP ALL SORTS OF GOODIES
SALL ; MAKE LISTING READABLE
ENTRY EDIT. ; AND BY THIS NAME SHALL I BE KNOWN
SEARCH INTERM ; DEFAULT ON SWITCHES
DEBUG==:DEBUG
EBCMP.==:EBCMP.
TRAILB==:TRAILB
BIS==:BIS
;
;EDIT. MAIN ENTRY POINT AND LAUNCHING PAD FOR ALL OTHER ROUTINES
;
;
;
EDIT.: SWOFF FEDWAR; ; turn off whole array flag
MOVE TA,CUROCH## ; GET THE CURRENT FIELD POINTER
LDB TB,OC.LTF## ; GET LITERAL FLAG
JUMPE TB,.EDIT ; IS REAL EDITING TASK, NOT LIT
LDB TB,OC.END## ; GET END POSITION IN OUTPUT RECORD
LDB TC,OC.LSZ## ; GET LITERAL SIZE
SUB TB,TC ; MAKE POINTER TO START OF CHARACTERS
ADDI TB,1 ; ADJUST USING FINAGLE'S CONSTANT
MOVE TA,CUROTF## ; GET POINTER TO THE CURRENT FILE
LDB TF,OT.CHN## ; GET CHANNEL
IMULI TF,CHNSIZ## ; AND MAKE INTO A POINTER
ADD TF,CHNBAS## ; SAME WAY WE ALWAYS DO
PUSHJ PP,SETPNT## ; MAKE AN ILDB POINTER
MOVE TA,CUROCH ; RECOVER THE POINTER
LDB TC,OC.EDP## ; GET POINTER TO LITERAL
SUBI TC,1 ; ADJUST FOR ILDB
TLO TC,(6B11) ; AND MAKE INTO POINTER
EDIT.1: ILDB CH,TC ; GET A LITERAL CHARACTER
CAIN CH,'_' ; END OF STRING?
JRST .EAREX ; [132] yes - try to exit
IDPB CH,TB ; NO - STORE BYTE
JRST EDIT.1 ; AND LOOP
.EDIT: LDB TB,OC.RSV## ; GET RESERVED WORD FLAG
JUMPN TB,EDRSV ; IS RESERVED WORD, GO PROCESS
LDB TB,OC.IDX## ; GET INDEX
SKIPE TB ; IS THERE ONE?
PUSHJ PP,.EDARE ; YES - SET UP TO EDIT ARRAY
LDB TB,OC.OCC## ; get number of occurances
SKIPE TB ; whole array?
PUSHJ PP,.EDWAR ; yes -
.EDT1A: LDB TB,OC.EDT## ; GET EDIT CODE
JUMPN TB,EDC. ; IS SUCH A THING, GO PROCESS
.EDT1B: LDB TB,OC.EDP## ; [122] GET EDIT WORD POINTER
JUMPN TB,.EDIT3 ; IF THERE IS ONE, IS REAL EDITIED FIELD
LDB TB,OC.FLD## ; IS SIMPLE EDIT - GET FIELD TYPE
CAIN TB,2 ; BINARY?
JRST .EDIT2 ; YES -
LDB TB,OC.END ; NO - GET THE END POSITION
LDB TC,OC.SIZ## ; GET THE SIZE OF THE FIELD
TSWT FEDWAR; ; WHOLE ARRAY?
JRST .+6 ; [140] NO -
ADDI TC,2 ; [140] allow for two blanks preceding field
MOVE TD,.EDOCC ; YES - GET NUMBER OF OCCURS
SUB TD,.EDIDX ; DIMINISH BY CURRENT INDEX-1
ADDI TD,1 ; [140] adjust
IMUL TC,TD ; AND MULTIPLY
SUB TB,TC ; SUBTRACT TO GET START
ADDI TB,1 ; BUMP TO ORGIN 0
SETOM BLNKAF ; DEFAULT TO NO BLANK AFTER
LDB TC,OC.BLA ; GET BLANK AFTER FLAG
SKIPE TC ; ARE WE BLA-ING
SETZM BLNKAF ; SHO'NUF HONEY'CHILE
TSWF FEDWAR; ; WHOLE ARRAY?
PUSHJ PP,.ED1WA ; YES - SET UP POINTER
MOVE TA,CUROTF ; GET OTF POINTER
LDB TF,OT.CHN ; GET FILE CHANNEL
IMULI TF,CHNSIZ ; MAKE INTO POINTER
ADD TF,CHNBAS ; USING TIME TESTED RECIPE
PUSHJ PP,SETPNT ; MAKE INTO POINTER TO DEST.
MOVE TA,CUROCH ; GET BACK OCHTAB POINTER
LDB TC,OC.SRC## ; GET SOURCE POINTER
LDB TD,OC.SIZ ; GET SIZE AS COUNTER
JUMPE TD,.EDIT3 ; IF ZERO IS BAD
TSWT FEDWAR; ; [140] whole array?
JRST .EDIT1 ; [140] no -
SETZ CH, ; [140] yes - get sixbit space
IDPB CH,TB ; [140] output a space
IDPB CH,TB ; [140] make that two spaces
.EDIT1: ILDB CH,TC ; GET A CHARACTER
SKIPN TE,BLNKAF## ; ARE WE BLANKING?
DPB TE,TC ; YES - WELL DO IT ALREADY
IDPB CH,TB ; STASH THAT CHARACTER
SOJG TD,.EDIT1 ; LOOP UNTIL DONE
JRST .EAREX ; ALL DONE
.EDIT2: LDB PA,OC.SRC ; GET SOURCE POINTER
TLZ PA,7777 ; CLEAR OUT BYTE SIZE GARBAGE
LDB TB,OC.SIZ ; GET FIELD SIZE
HRLZS TB ; GET COUNT INTO PROPER HALF
ADD PA,TB ; AND MAKE INTO PARAMETER
JRST PD6.## ; AND LET SOMEONE ELSE DO ALL THE WORK
;EDRSV MOVE A RESERVED WORD TO GET READY FOR EDIT
;
;
;
EDRSV: SUBI TB,1 ; MAKE INTO REAL TABLE INDEX
CAIL TB,4 ; PAGEn?
JRST EDRSV3 ; YES -
PUSHJ PP,GTDATE## ; SET UP DATE ENTRIES
MOVE TC,SIZTAB(TB) ; GET FIELD SIZE
LDB TD,OC.SIZ ; GET DEST SIZE
CAME TD,TC ; ARE THEY THE SAME?
JRST EDRSV1 ; NO - WANTS TO MAKE IT DIFFICULT
MOVE TD,PNTTAB(TB) ; YES - GET POINTER TO ITEM
LDB TE,OC.SRC ; GET PLACE TO PUT IT
EDRSV0: ILDB CH,TD ; GET A CHARACTER
IDPB CH,TE ; STASH IT
SOJG TC,EDRSV0 ; LOOP UNTIL DONE
JRST .EDIT+2 ; RETURN
EDRSV1: CAMG TD,TC ; DEST > SOURCE?
JRST EDRSV2 ; NO - MUST ADJUST PNTTAB ENTRY
SUB TD,TC ; YES - MUST ADJUST OC.SRC POINTER
LDB TE,OC.SRC ; GET POINTER
IBP TE ; BUMP
SOJG TD,.-1 ; AND KEEP BUMPING UNTIL DONE
MOVE TD,PNTTAB(TB) ; GET POINTER
JRST EDRSV0 ; AND GO MOVE
EDRSV2: SUB TC,TD ; GET SIZE
MOVE TD,PNTTAB(TB) ; GET POINTER
LDB TE,OC.SRC ; AND ANOTHER POINTER
JRST EDRSV0 ; AND MOVE IT
EDRSV3: PUSH PP,TA ; STASH POINTER 'CAUSE PD6. MESSES IT
LDB AC2,OC.SRC ; GET SOURCE POINTER
TLZ AC2,7777 ; CLEAN IT UP A BIT
LDB TC,OC.SIZ ; GET FIELD SIZE
HRLZS TC ; BYTE SWAP
ADD AC2,TC ; STICK INTO BYTE RESIDUE
MOVE PA,[Z AC1,AC2] ; GET PD6. PARAMETER
AOS AC1,@PGTAB-4(TB) ; GET PAGE COUNT
PUSHJ PP,PD6.## ; GO CONVERT
POP PP,TA ; RESTORE POINTER
JRST .EDIT+2 ; AND GO EDIT
SIZTAB: OCT 6
OCT 2
OCT 2
OCT 2
PNTTAB: POINT 6,UDATE##
POINT 6,UDAY##,23
POINT 6,UMON##,23
POINT 6,UYEAR##,23
PGTAB: EXP PAGE##
EXP PAGE1##
EXP PAGE2##
;EDC. ROUTINE TO SET UP EDIT MASK FOR EDIT CODES
;
;
;
EDC.: SWOFF FSPAC; ; [075] make sure switch is off
CAILE TB,14 ; X,Y,Z ?
JRST EDC.7 ; YEP....
HRR SW,EDFLGS-1(TB) ; NO - GET FLAGS
MOVE TH,[POINT 6,MSKBUF##,5] ; GET POINTER TO BUFFER
LDB TB,OC.DEC## ; GET DECIMAL POSITIONS
LDB TD,OC.SIZ ; GET SIZE
SKIPE TB ; ANYDEC?
SWON FDEC; ; YES - FLAG AS SUCH
SUB TD,TB ; GET NON DEC POSITIONS
MOVE TE,TD ; AND ANOTHER FUDGE
IDIVI TE,3 ; ONE COMMA FOR EVERY THREE
JUMPE TF,EDC.1 ; IF MULTIPLE OF THREE IS EASY
EDC.0: SETZ CH, ; A SPACE!
IDPB CH,TH ; STASH IN EDIT WORD
SOJG TF,.-1 ; LOOP UNTIL DONE
EDC.1: JUMPE TE,EDC.2 ; EXIT IF DONE
MOVEI CH,',' ; ELSE GET A COMMA
TSWF COMMA; ; COMMA TIME?
IDPB CH,TH ; YES - STASH IT
MOVEI TF,3 ; RELOAD THE COUNTER
SUBI TE,1 ; DECREMENT COMMA GROUP COUNT
JRST EDC.0 ; AND KEEP ON LOOPING
EDC.2: TSWF FDEC; ; ANY DECIMALS?
JRST EDC.6 ; YES -
TSWT FZERO; ; ZERO SUPPRESS?
JRST EDC.5 ; NO
MOVEI CH,'0' ; GET THAT ZERO
LDB TB,TH ; [142] get the last character we output
DPB CH,TH ; [142] replace it with a zero
IDPB TB,TH ; [142] and place character after zero
EDC.5: TSWT FMINUS; ; A MINUS TYPE FLAG?
JRST EDC.4 ; NO -
MOVEI CH,'-' ; YES -
IDPB CH,TH ; STASH IT
EDC.3: LDB TB,OC.EDP ; [123] get edit word pointer
JUMPE TB,EDC.11 ; [123] skip over code if none
HRLI TB,440600 ; [123] make into byte pointer
ILDB CH,TB ; [123] get a character
CAIN CH,'$' ; [123] floating dollar?
SWON DOLLR; ; [123] yes - turn on flag
CAIN CH,'*' ; [123] no - asterisk fill?
SWON ASTER; ; [123] yes -
ILDB CH,TB ; [123] get next character
CAIN CH,'*' ; [123] asterisk?
SWON ASTER; ; [123] yes - asterisk fill with fixed dollar
EDC.11: SETZ CH, ; GET A SPACE
TSWF DOLLR; ; A DOLLAR?
MOVEI CH,'2' ; YES ASSUME FLOATING DOLLAR
TSWF ASTER; ; ASTERISK FILL?
MOVEI CH,'*' ; YES - FLAG AS SUCH
TSWF DOLLR; ; [123] floating dollar?
TSWT ASTER; ; [123] and asterisk fill?
SKIPA ; [123] no -
MOVEI CH,'3' ; [123] yes - flag as such
JUMPN CH,.+2 ; STILL A SPACE?
SWON FSPAC; ; YES - FLAG AS SUCH FOR LATER
DPB CH,[POINT 6,MSKBUF,5] ; DEPOSIT WHATEVER IT IS
;EDC. (cont'd)
;
;
EDC.8: MOVEI CH,'_' ; END OF MASK
IDPB CH,TH ; STASH
TSWF FEDWAR; ; [132] whole arrays?
PUSHJ PP,.ED1WA ; [132] yes - set up source pointer
LDB TF,OC.SRC ; GET SOURCE POINTER
IBP TF ; BUMP
LDB TH,OC.SIZ ; GET SIZE
JUMPE TH,PPJMP ; IF ZERO, GET THE HELL OUT OF HERE
MOVE TE,[POINT 6,MSKBUF] ; GET MASK POINTER
TSWFZ FSPAC; ; DID WE STASH A SPACE?
IBP TE ; YES - SKIP OVER IT
JRST .EDITX ; AND FAKE 'EM OUT
EDC.4: TSWT CREDIT; ; CR FLAG
JRST EDC.3 ; NO - NO MINUS INDICATOR
MOVEI CH,'C' ; GET A C
IDPB CH,TH ; STASH
MOVEI CH,'R' ; GET AN R
IDPB CH,TH ; STASH THAT TOO
JRST EDC.3 ; LOOP ON BACK
EDC.6: MOVEI CH,'0' ; [124] get a zero fill flag
TSWF FZERO; ; [127] are we zero filling?
IDPB CH,TH ; [127] yes - stash the character
MOVEI CH,'.' ; [124] get decimal point
IDPB CH,TH ; YES -
SETZ CH, ; GET THAT SPACE
IDPB CH,TH ; STASH THAT TOO
SOJG TB,.-1 ; LOOP UNTIL DONE
JRST EDC.5 ; GO FLAG MINUS
EDC.7: CAIN TB,15 ; X?
JRST .EDT1B ; [122] yes - no editing
CAIE TB,17 ; Z?
JRST EDC.9 ; NO - MUST BE Y
MOVE TH,[POINT 6,MSKBUF] ; YES - GET POINTER
SETZ CH, ; GET A SPACE
LDB TC,OC.SIZ ; GET FIELD SIZE
IDPB CH,TH ; STICK OUT A SPACE
SOJG TC,.-1 ; LOOP UNTIL DONE
JRST EDC.8 ; EXIT WHEN DONE
EDC.9: MOVE TH,[POINT 6,MSKBUF] ; GET POINTER
LDB TC,OC.SIZ ; GET SIZE
SETZ CH, ; GET A SPACE
MOVEI TB,'/' ; GET A SLASH
EDC.10: IDPB CH,TH ; PUT OUT A SPACE
SOJE TC,EDC.8 ; EXIT WHEN DONE
IDPB CH,TH ; OUTPUT ANOTHER SPACE
SOJE TC,EDC.8 ; SEE IF DONE AGAIN
IDPB TB,TH ; IF NOT PUT OUT A SLASH
JRST EDC.10 ; AND KEEP LOOPING
;EDC. (cont'd)
;
;
;
EDFLGS: EXP COMMA+FZERO ; 1
EXP COMMA ; 2
EXP FZERO ; 3
EXP 0 ; 4
EXP COMMA+FZERO+CREDIT ; A
EXP COMMA+CREDIT ; B
EXP FZERO+CREDIT ; C
EXP CREDIT ; D
EXP COMMA+FZERO+FMINUS ; J
EXP COMMA+FMINUS ; K
EXP FZERO+FMINUS ; L
EXP FMINUS ; M
;.EDARE Routine to set up byte pointer to edit array entries
;
;
;
.EDARE: LDB TC,OC.IMD## ; get immediate flag
JUMPN TC,.EDARI ; jump if set
LDB TC,OC.ARP## ; else get pointer to array
PUSHJ PP,SUBSC.## ; and subscript away
.EDARC: MOVE TA,CUROCH ; get back current pointer
DPB TB,OC.SRC ; stash resultant pointer
POPJ PP, ; and exit
.EDARI: LDB TB,OC.IDX ; [133] get proper index
LDB TA,OC.ARP ; get array pointer
PUSHJ PP,SUBS## ; subscript away
PJRST .EDARC ; and go stash pointer
;.EDWAR Routine to check for whole array/table
;
;
;
.EDWAR: LDB TC,OC.TAB## ; get table flag
JUMPN TC,.EDTAB ; leap if table
MOVEM TB,.EDOCC## ; save occurances
SETZM .EDIDX## ; and initialize index
SWON FEDWAR; ; turn on flag
POPJ PP, ; and exit
;.EDTAB Handle table entry
;
;
;
.EDTAB: LDB TC,OC.ARP ; get pointer to table pointer
MOVE TC,(TC) ; get table pointer
MOVE TB,-1(TC) ; [135] get current index
JRST .EDARI+1 ; [135] go subscript
;.ED1WA Set up source pointer for whole array
;
;
;
.ED1WA: PUSH PP,TB ; save an AC
LDB TA,OC.ARP ; get array pointer
AOS TB,.EDIDX ; get the index
PUSHJ PP,SUBS ; do the subscript
MOVE TA,CUROCH ; get back OCHTAB pointer
DPB TB,OC.SRC ; save new source pointer
POP PP,TB ; restore an AC
POPJ PP, ; exit
;.EAREX Exit routine
;
;
;
.EAREX: TSWT FEDWAR; ; processing whole array
POPJ PP, ; no - exit
MOVE TB,.EDIDX ; yes - get current index
CAMN TB,.EDOCC ; are we at the end?
POPJ PP, ; yes - exit
MOVE TA,CUROCH ; [132] set up pointer to OCHTAB item
JRST .EDT1A ; no - the big loop
;
; MAIN EDITING ROUTINE
;
; ACCEPTS AS INPUT:
; ECHAR PREPROCESSED EDIT MASK
; DCHAR DATA WORDS
; OCHAR OUTPUT DATA AREA
;
;
; D_E_O_1;
; ZFILL_MFLAG_FLOATD_NUMFLG_FALSE
; IF ECHAR(1) = " " THEN FILL_" ";
; IF ECHAR(1) = "*" THEN FILL_"*"; E_2;
; IF ECHAR(1) = "$" THEN FILL_" "; OCHAR(1)_"$"; E_O_2;
; IF ECHAR(1) = "0" THEN FILL_"0"; ZFILL_TRUE
; IF ECHAR(1) = "1" THEN FILL_"*"; OCHAR(1)_"$"; E_O_2;
; IF ECHAR(1) = "2" THEN FILL_" "; FLOATD_TRUE; E_2;
; IF ECHAR(1) = "3" THEN FILL_"*"; FLOATD_TRUE; E_2;
; IF ECHAR(1) = "4" THEN FILL_"0"; OCHAR(1)_"$"; NUMFLG_ZFILL_TRUE; E_O_2;
; IF DCHAR(1) = "-" THEN MFLAG_TRUE; D_2;
;
;L1: IF ECHAR(E) = "_" THEN OCHAR(O)_"_"; RETURN;
; IF DCHAR(D) = "_" THEN /* RAN OUT OF DATA */
; WHILE TRUE DO
; IF ECHAR(E) = "_" THEN OCHAR(O)_"_"; RETURN;
; IF ECHAR(E) = "&" THEN OCHAR(O)_" "; GOTO N1;
; IF (ECHAR(E) = "-") AND NOT MFLAG THEN OCHAR(O)_" "; GOTO N1;
; IF (ECHAR(E) = "C") AND (ECHAR(E+1) = "R") AND NOT MFLAG THEN
; OCHAR(O)_OCHAR(O+1)_" "; O_O+1; E_E+1; GOTO N1;
; OCHAR(O)_ECHAR(E);
;
;N1: O_O+1; E_E+1;
; END; ELSE
;
; IF ECHAR(E) = " " THEN /* REPLACEABLE EDIT CHAR */
; IF DCHAR(D) = "0" THEN
; IF NUMFLG THEN OCHAR(O)_"0"; GOTO NEXT;
; ELSE OCHAR(O)_FILL; GOTO NEXT;
; ELSE /* DATA IS NON-ZERO */
; IF NOT NUMFLG THEN /* IS FIRST NON-ZERO */
; IF FLOATD THEN OCHAR(O)_"$"; O_O+1; NUMFLG_TRUE;
; OCHAR(O)_DCHAR(D); GOTO NEXT;
; ELSE /* NON-REPLACEABLE EDIT CHAR */
; IF (ECHAR(E) = "0") AND NOT ZFILL THEN FILL_"0"; ZFILL_NUMFLG_TRUE; E_E+1;
; GOTO L1;
; IF ECHAR(E) = "&" THEN OCHAR(O)_" "; GOTO L2;
; IF NUMFLG THEN OCHAR(O)_ECHAR(E);
; ELSE OCHAR(O)_FILL;
;
;L2: E_E+1; O_O+1; GOTO L1;
;
;NEXT: D_D+1; GOTO L2;
;
;START OF REAL EDITING ROUTINE
;
;
.EDIT3: TSWF FEDWAR; ; WHOLE ARRAY?
PUSHJ PP,.ED1WA ; YES - SET UP SOURCE POINTER
LDB TF,OC.SRC ; GET SOURCE POINTER
IBP TF ; BUMP ONCE FOR GOOD MEASURE
LDB TH,OC.SIZ ; PICK UP FIELD SIZE
JUMPE TH,PPJMP ; GET THE HELL OUT OF HERE IF ZERO
LDB TE,OC.EDP ; GET POINTER TO EDIT WORD
TLO TE,440600 ; MAKE INTO BYTE POINTER
.EDITX: MOVE TG,[POINT 6,EDBUF##] ; GET POINTER INTO TEMP STORAGE
SETOM BLNKAF ; SET TO NO BLANKING
LDB TC,OC.BLA## ; GET OCHTAB ENTRY
SKIPE TC ; SKIP IF NO BLANKING
SETZM BLNKAF ; SET TO BLANK
SWOFF <ZFILL!MFLAG!FLOATD!NUMFLG>; CLEAR SOME FLAGS
PUSH PP,TE ; SAVE POINTER
ILDB CH,TE ; GET A EDIT WORD CHARACTER
POP PP,TE ; RESTORE POINTER
SETZB TB,CHOUNT ; ZAP OUR INDEX AND COUNTER
SETZM FILL ; [124] make sure fill defaults to space
JUMPE CH,.EDIT6 ; SKIP OVER SCANNER IF SPACE
.EDIT4: CAMN CH,TAB1(TB) ; FIND IT YET?
JRST @TAB2(TB) ; YES - DISPATCH TO APPROPRIATE ROUTINE
SKIPE TAB1(TB) ; NO - IS THE END-OF-TABLE?
AOJA TB,.EDIT4 ; NO - LOOP
.EDIT5: LDB CH,TF ; YES - GET A DATA CHARACTER
CAIE CH,'-' ; UNARY MINUS?
JRST L1 ; NO -
SWON MFLAG; ; YES - SET MINUS FLAG
SKIPN TC,BLNKAF ; BLANKING?
DPB TC,TF ; YES -
IBP TF ; BUMP PAST SIGN
SUBI TH,1 ; DECREMENT COUNT
JRST L1 ; AND OFF TO THE LAND OF L1
TAB1: '*'
'$'
'0'
'1'
'2'
'3'
'4'
'5'
0
TAB2: EXP .EDIT7
EXP EDIT7B
EXP EDIT7C
EXP EDIT7D
EXP EDIT7E
EXP EDIT7F
EXP EDIT7G
EXP EDIT7H
.EDIT6: SETZM FILL ; FILL_" "
JRST .EDIT5 ; AND BAC
.EDIT7: MOVEI CH,'*' ; GET A STAR
EDIT7A: IBP TE ; E_2
MOVEM CH,FILL##
JRST .EDIT5
EDIT7B: MOVEI CH,'$'
IDPB CH,TG ; FIXED DOLLAR
AOS CHOUNT## ; BUMP COUNTER
IBP TE
JRST .EDIT6
EDIT7H: IBP TE ; skip over a space
EDIT7C: SWON ZFILL; ; ZERO FILL
MOVEI CH,'0'
JRST EDIT7A ; store fill character and bump pointer
EDIT7D: MOVEI CH,'$' ; ANOTHER BRAND OF FIXED DOLLAR
IDPB CH,TG
AOS CHOUNT
JRST .EDIT7 ; FILL WITH STARS
EDIT7E: SWON FLOATD; ; FLOATING DOLLAR
SETZM FILL ; FILL OF SPACES
IBP TE ; [146] bump past item
JRST .EDIT5
EDIT7F: SWON FLOATD; ; ANOTHER FLOATING DOLLAR
JRST .EDIT7 ; WITH CHECK PROTECT
EDIT7G: MOVEI CH,'$' ; FIXED DOLLAR
IDPB CH,TG
AOS CHOUNT
SWON <NUMFLG!ZFILL>;
MOVEI CH,'0'
JRST EDIT7A
L1: ILDB CH,TE ; GET A EDIT WORD CHARACTER
CAIN CH,'_' ; END OF STRING?
JRST .EDIT. ; YES - END OF LINE
LDB TB,TF ; GET A DATA CHARACTER
JUMPG TH,LX ; NOT DONE YET -
L1.0: CAIN CH,'_' ; KEEP LOOPING TILL WE FIND ONE
JRST .EDIT. ; CAUSE WE'RE DONE WHEN WE DO
CAIE CH,'&' ; NXB?
JRST L1.2 ; NO -
L1.1: MOVEI CH,' ' ; YES - CONVERT TO REAL BLANK
IDPB CH,TG ; STASH IT
JRST N1 ; AND GO FOR ANOTHER
L1.2: CAIN CH,'-' ; SIGN?
TSWF MFLAG; ; NEGATIVE NUMBER
TRNA ; EITHER NOT "-" OR NEGATIVE
JRST L1.1 ; POSITIVE NUMBER
CAIE CH,'C' ; START OF A 'CR'?
JRST L1.3 ; MUST NOT BE
PUSH PP,TE ; COULD BE - STASH POINTER
ILDB TB,TE ; GET THE NEXT CHARACTER
POP PP,TE ; RESTORE POINTER
CAIN TB,'R' ; AN 'R' ?
TSWF MFLAG; ; AND A MINUS?
JRST L1.3 ; EITHER NOT A "CR" OR A NEGATIVE NUMBER
MOVEI CH,' ' ; ELSE PAD WITH BLANKS
IDPB CH,TG ; STASH
IDPB CH,TG ; STASH
IBP TE ; BUMP
AOS CHOUNT ; THUMP
JRST N1 ; JUMP
L1.3: CAIN CH,'0' ; IS IT A ZERO?
JRST N1+1 ; YES - IGNORE IT
IDPB CH,TG ; STASH THAT CHAR, TOTE THAT BARGE
N1: AOS CHOUNT ; ANOTHER CHAR DELIVERED SAFELY HOME
ILDB CH,TE ; GET ANOTHER CHARACTER
JRST L1.0 ; AND LOOP
LX: CVTSNM 6,TB,TB ; CONVERT A SIXBIT CHAR TO NUMBER
TLZE TB,1B18 ; IS A NEGATIVE NUMBER?
SWONS MFLAG; ; YES - TURN ON FLAG
SWOFF MFLAG; ; NO - TURN OFF FLAG
JUMPN CH,LX.3 ; LEAP IF NOT SPACE
CAIE TB,'0' ; REPLACEABLE EDIT CHAR
JRST LX.1 ; BUT NOT A ZERO
TSWT NUMFLG; ; HAVE WE SEEN A NUMBER
MOVE TB,FILL ; NO - USE FILL
IDPB TB,TG ; YES - USE ZERO
JRST NEXT ; AND GO GET ANOTHER HELPING
LX.1: TSWFS NUMFLG; ; DATA IS NON-ZERO
JRST LX.2 ; NOT FIRST NON-ZERO
TSWT FLOATD; ; FLOATER?
JRST LX.2 ; NO -
MOVEI TC,'$' ; YES - GET THAT DOLLAR SIGN
IDPB TC,TG ; STASH
AOS CHOUNT ; BUMP ME
LX.2: IDPB TB,TG ; STASH THAT CHARACTER
JRST NEXT ; AND TRY AGAIN
LX.3: CAIN CH,'0' ; EDIT CHAR A ZERO?
TSWF ZFILL; ; AND ZFILL STILL OFF?
JRST LX.4 ; MUST BE
MOVEM CH,FILL ; NO - SET FILL TO '0'
SWON <ZFILL!NUMFLG>; ; AND SET SOME FLAGS
JRST L1 ; TRY SOME MORE
LX.4: CAIE CH,'&' ; NXB?
JRST LX.5 ; NOPE
MOVEI TC,' ' ; YES - CONVERT TO REAL SPACE
IDPB TC,TG ; STASH
JRST L2 ; AND OFF WE GO
LX.5: TSWT NUMFLG; ; WELL?
MOVE CH,FILL ; IF NOT NUMFLG THEN OCHAR_FILL
IDPB CH,TG ; OUTPUT
L2: AOS CHOUNT ; BUMP THAT COUNT
JRST L1 ; AND LOOP
NEXT: SKIPN TC,BLNKAF ; BLANKING?
DPB TC,TF ; YES - DO IT TO IT
IBP TF ; BUMP SOURCE POINTER
SUBI TH,1 ; DECREMENT
JRST L2 ; AND TRY HARDER
.EDIT.: IDPB CH,TG ; STASH THAT BACK ARROW
MOVE TA,CUROCH ; GET OCHTAB POINTER
LDB TB,OC.END ; GET END POSITION
MOVE TC,CHOUNT ; GET STRING SIZE
TSWT FEDWAR; ; WHOLE ARRAY?
JRST .+6 ; [140] NO -
ADDI TC,2 ; [140] yes - allow for two blanks
MOVE TD,.EDOCC ; YES - GET NUMBER OF OCCURS
SUB TD,.EDIDX ; SUBTRACT INDEX-1
ADDI TD,1 ; [140] adjust result
IMUL TC,TD ; GET REAL END POSITION
SUB TB,TC ; AND FIGURE OUT START POSTION
ADDI TB,1 ; FUDGE FACTOR
MOVE TA,CUROTF ; GET OTFTAB POINTER
LDB TF,OT.CHN ; GET CHANNEL
IMULI TF,CHNSIZ ; MAKE INTO POINTER
ADD TF,CHNBAS ;
PUSHJ PP,SETPNT ; MAKE INTO BYTE POINTER
MOVE TC,[POINT 6,EDBUF] ; GET POINTER INTO TEMP STOREAGE
SETOM BLNKAF ; SET TO NO MORE BLANKING
TSWT FEDWAR; ; [140] editing whole array?
JRST EDIT.1 ; [140] no - go output the stuff
SETZ CH, ; [140] yes - get sixbit space
IDPB CH,TB ; [140] output a blank
IDPB CH,TB ; [140] and another
JRST EDIT.1 ; AND FINISH UP ELSEWHERE
PPJMP: POPJ PP, ; EXIT
SW==0
AC1==1
AC2==2
TA==4
TB==5
TC==6
TD==7
TE==10
TF==11
CH==12
TG==13
CH2==14
TH==15
PA==16
PP==17
END