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 ; 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 ; 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 ; ; 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