TITLE PREDIT FOR RPGII %1 SUBTTL EDIT WORD PREPROCESSOR ; ; PREDIT EDIT WORD PREPROCESSOR FOR RPGII %1 ; ; THIS PORTION OF PHASE E HANDLES THE OUTPUT EDIT WORDS ; AND LITERALS. LITERAL ARE TRANFERRED TO LITAB INTACT, ; WHILE EDIT WORDS ARE PREPROCESSED TO MAKE THE EDITING JOB ; EASIER FOR THE RUNTIME SYSTEM. ; ; BOB CURRIER OCTOBER 6, 1975 15:12:51 ; ; ALL RIGHTS RESERVED, BOB CURRIER ; TWOSEG RELOC 400000 ENTRY PREDIT ; ONLY ONE ENTRY POINT ; PREPROCESSOR FLOW ; ; THE PREPROCESSOR USES THE FOLLOWING LOGIC, REPRESENTED HERE ; IN SAIL FORMAT. ; ; INPUT: 7 BIT POINTER TO EDIT WORD ; OUT: 6 BIT POINTER TO PREP WORD ; OUTPUT: 0 IN ANY POSITION MEANS ZERO FILL FROM NOW ON. ; NOTE THAT THE ZERO DOES NOT TAKE UP A PRINT POSITION. ; ; COL 1 - $ FIXED $, " " FILL ; * "*" FILL ; 0 "0" FILL ; 1 FIXED $, "*" FILL ; 2 FLOAT $, " " FILL ; 3 FLOAT $, "*" FILL ; 4 FIXED $, "0" FILL ; ; I_1; ZFILL_STAR_ZERO_FLOATD_FALSE; ; ; WHILE (INPUT(I) NOT = "_") AND (INPUT(I) NOT = ".") DO ; IF INPUT(I) = "*" THEN STAR_TRUE; INPUT(I)_" "; EXIT; ; IF (INPUT(I) = "$") AND (I NOT = 1) THEN FLOATD_TRUE; ; INPUT(I)_" "; ; I_I+1; ; END; ; ; I_O_2; ; IF (INPUT(1) = "0") AND (INPUT(2) = " ") THEN OUT(1)_"0"; OUT(2)_" "; O_3; ; ZFILL_TRUE; GOTO L1; ; ELSE OUT(1)_" "; OUT(2)_"0"; O_3; GOTO L1; ; ; IF INPUT(1) = "$" THEN ; IF STAR THEN OUT(1)_"1"; GOTO L1; ; ELSE IF INPUT(2) = "0" THEN OUT(1)_"4"; ; OUT(2)_" "; ; ZFILL_TRUE; ; O_I_3; ; GOTO L1; ; ELSE OUT(1)_"$"; GOTO L1; ; ; IF FLOATD THEN ; IF STAR THEN OUT(1)_"3"; ; ELSE OUT(1)_"2"; ; ELSE OUT(1)_INPUT(1); ; ;L1: WHILE INPUT(1) NOT = "_" DO ; IF (INPUT(I) = "0") AND NOT ZFILL THEN OUT(O)_" "; ; ZFILL_TRUE; ; O_O+1; ; OUT(O)_INPUT(I); ; O_O+1; I_I+1; ; END; ; OUT(O)_"_"; ; ;RETURN; ; ;START IT UP ; PREDIT: MOVE TA,CUROCH## ; GET POINTER MOVE TC,ELITPC## ; GET LITAB PC DPB TC,OC.EDP## ; STORE AS POINTER TO EDIT WORD MOVE TA,CURDAT## ; GET POINTER TO DATAB LDB TC,DA.NAM## ; GET NAMTAB LINK JUMPN TC,PRE.02 ; HAS A LINK, MUST BE EDIT WORD MOVE TA,TB ; MUST BE LITERAL, GET VALTAB LINK PUSHJ PP,LNKSET## ; SET UP LINKER HRRZ TB,TA ; GET INTO WORKING AC ADD TB,[POINT 7,0] ; AND MAKE A POINT ILDB CH,TB ; GET CHARACTER COUNT MOVE TD,CH ; SAVE FOR FUTURE USE IDIVI CH,6 ; GET NUMBER OF WORDS JUMPE CH+1,.+2 ; REMAINDER? ADDI CH,1 ; YES - ROUND UPWARDS HRLZI TA,SIXLIT## ; IDENTIFY AS SIXBIT LITERAL HRR TA,CH ; ADD IN WORD COUNT PUSHJ PP,STASHL## ; STICK IT OUT IN LITFIL ADDM CH,ELITPC ; INCREMENT LITAB PC MOVE TC,[POINT 6,TA] ; GET POINTER INTO TA SETZ TA, ; AND SET TA TO ALL SPACES PRE.00: ILDB CH,TB ; GET A CHARACTER SUBI CH,40 ; INTO THE MIGHTY REALM OF SIXBIT IDPB CH,TC ; STASH INTO OUR AC CAIN CH,'_' ; A BACK ARROW? JRST PRE.01 ; YES - MUST BE DONE TLNE TC,770000 ; ANY ROOM LEFT IN TA? JRST PRE.00 ; YES - KEEP ON TRUCKIN' PUSHJ PP,STASHL ; NO - DUMP THE AC JRST PRE.00-2 ; AND GET ANOTHER HELPING PRE.01: PUSHJ PP,STASHL ; PUT OUT THAT LAST WORD SETO TE, ; FLAG AS LITERAL POPJ PP, ; AND EXIT THIS ROUTINE ;ENTRY POINT FOR EDIT WORD PREPROCESSING ; ;COME HERE WHEN A TRUE EDIT WORD IS FOUND, AS OPPOSED TO A LITERAL. ; ; PRE.02: SWOFF FZFILL!FSTAR!FLOATD!FZERO; RESET ALL BEASTS SWON FIRST; ; GREAT AND SMALL SETZM REPCNT## ; zap count of replaceable edit characters MOVE TA,CUROCH ; get edited item pointer LDB TC,OC.SIZ## ; get size of item JUMPE TC,PRE.5A ; error if not defined MOVE TA,TB ; GET VALTAB LINK PUSHJ PP,LNKSET ; AND SET UP LINK HLL TA,[POINT 7,0,13] ; MAKE INTO A BYTE POINTER MOVE TC,TA ; SAVE PRE.03: LDB CH,TA ; GET A CHARACTER CAIE CH,"_" ; HIT END? CAIN CH,"." ; OR DECIMAL? JRST PRE.06 ; YES - EXIT CAIE CH,"*" ; CHECK PROTECT? JRST PRE.04 ; NO - SWON FSTAR; ; YES - MOVEI CH," " ; GET A SPACE DPB CH,TA ; AND REPLACE THE STAR JRST PRE.06 ; AND EXIT PRE.04: CAIN CH,"$" ; DOLLAR? TSWFZ FIRST; ; AND NOT FIRST? JRST PRE.05 ; NO - SWON FLOATD; ; YES - FLOAT THE DOLLAR MOVEI CH," " ; AND REPLACE IT WITH A DPB CH,TA ; A SPACE PRE.05: ILDB CH,TA ; GET ANOTHER CHARACTER SWOFF FIRST; ; ONE ACT OF LOVE CAN ONLY BE PERFORMED ONCE JRST PRE.03+1 ; AND LOOP PRE.5A: MOVE TA,CURDAT ; get datab pointer LDB TB,DA.LIN ; get line number MOVEM TB,SAVELN ; stash for WARN WARN 148; ; invalid field name SETZ TE, ; say this was edit word POPJ PP, ; and exit PREDIT PRE.06: MOVE TD,[POINT 7,PREPOT##] ; GET POINTER INTO TEMP SETZB TE,PREPOT ; ZAP FIRST WORD MOVE TB,[XWD PREPOT,PREPOT+1]; SET UP TO ZAP REST BLT TB,PREPOT+5 ; AND DO IT LDB CH,TC ; GRAB A CHAR CAIE CH,"0" ; BIG ZERO? JRST PRE.07 ; NO - PUSH PP,TC ; STASH POINTER ILDB TB,TC ; GET NEXT CHAR POP PP,TC ; RECOVER POINTER CAIE TB," " ; IS IT A SPACE? JRST PRE.6A ; NO - MUST NOT BE WHAT WE THINK IT SHOULD BE IDPB CH,TD ; STASH IT AOS REPCNT ; bump count of replaceable chars ADDI TE,1 MOVEI CH," " ; RESET TO SPACE IDPB CH,TD ; STASH THIS ONE TOO AOS REPCNT ; another replaceable character ADDI TE,1 SWON FZFILL; ; SET FLAG IBP TC ; SET UP TO GET NEXT CHAR JRST PRE.09 ; GOTO L1 PRE.6A: MOVEI CH," " ; GET A SPACE IDPB CH,TD ; OUT(1)_" " AOS REPCNT ; bump replacement counter MOVEI CH,"0" ; GET A ZERO IDPB CH,TD ; OUT(2)_"0" IBP TC ; GET READY TO GET NEXT CHAR AOJA TE,PRE.09 ; GO TO L1 PRE.07: CAIE CH,"$" ; DOLLAR? JRST PRE.08 ; NO - TSWT FSTAR; ; STAR = TRUE? JRST PRE07A ; NO - MOVEI CH,"1" ; GET AN ASCII 1 IDPB CH,TD ; STASH IN STORAGE ADDI TE,1 IBP TC ; BUMP POINTER JRST PRE.09 ; GOTO L1; PRE07A: ILDB CH,TC ; GET ANOTHER CHARACTER CAIE CH,"0" ; ZERO?? JRST PRE07B ; NO - MOVEI CH,"4" ; YES - SET COL 1 TO "4" IDPB CH,TD ; OUTPUT IT ADDI TE,1 ; bump count MOVEI CH," " ; ALSO OUTPUT A SPACE IDPB CH,TD ; THUSLY AOS REPCNT ; another replaceable character ADDI TE,1 ; and another plain old character IBP TC ; I <- 3 JRST PRE.09 ; GOTO L1; PRE07B: MOVEI CH,"$" ; OUTPUT A DOLLAR IDPB CH,TD ; LIKE THIS ADDI TE,1 ; bump count JRST PRE.09 ; LEAVE I = 2 PRE.08: TSWT FLOATD; ; FLOATD = TRUE? JRST PRE08B ; NO - MOVEI CH,"2" ; DEFAULT TO 2 TSWF FSTAR; ; STAR = FALSE? MOVEI CH,"3" ; no - output a 3 IDPB CH,TD ; OUTPUT IT ADDI TE,1 ; bump count IBP TC ; I <- 2 JRST PRE.09 ; GOTO L1; PRE08B: CAIN CH," " ; a space? AOS REPCNT ; yes - replacable character IDPB CH,TD ; STASH THE CURRENT CHARACTER ADDI TE,1 IBP TC ; I <- 2 ;L1: ; ; ; PRE.09: LDB CH,TC ; GET A CHARACTER CAIN CH,"_" ; END? JRST PRE.10 ; YES - CAIN CH,"0" ; ZERO? TSWF FZFILL; ; AND ZFILL FALSE? JRST PRE09A ; NO - MOVEI TB," " ; YES - ADD EXTRA SPACE IDPB TB,TD ; OUTPUT OUR EXTRA AOS REPCNT ; bump replacable counter ADDI TE,1 ; and regular counter SWON FZFILL; ; AND TURN ON ZFILL SO IT ONLY HAPPENS ONCE PRE09A: CAIN CH," " ; a space? AOS REPCNT ; yes - a replacable character IDPB CH,TD ; STASH CURRENT CHARACTER AOJ TE, ILDB CH,TC ; GET ANOTHER CHARACTER JRST PRE.09+1 ; AND LOOP PRE.10: IDPB CH,TD ; OUTPUT OUR BACK ARROW ;I DON'T GIVE A DAMN WHAT ANSI SAYS, IT'S STILL BACK ARROW TO ME! ADDI TE,1 ; bump count MOVE TA,CUROCH ; get pointer LDB TB,OC.SIZ ; get size of field CAMN TB,REPCNT ; is it the same as number of replaceables? JRST PRE10A ; yes - all's ok LDB CH,[POINT 7,PREPOT,6] ; get flag character CAIE CH,"0" ; zero? (special case) JRST PRE12A ; no - error MOVEI CH,"5" ; yes - reset to "5" DPB CH,[POINT 7,PREPOT,6] ; this means EDIT must eat one space for us PRE10A: MOVE TD,TE ; GET NUMBER OF CHARACTERS IDIVI TD,6 ; GET NUMBER OF WORDS FOR SIXBIT JUMPE TC,.+2 ; REMAINDER? ADDI TD,1 ; NO - BUMP 1 ADDM TD,ELITPC ; INCREMENT PC HRLI TD,SIXLIT ; MAKE INTO LITAB ARG MOVE TA,TD ; GET INTO PROPER AC PUSHJ PP,STASHL ; AND STUFF INTO LITAB MOVE TB,[POINT 7,PREPOT] ; GET POINTER INTO TEMP MOVE TC,[POINT 6,TA] ; GET POINTER INTO AC SETZ TA, ; SET TO SPACES PRE.11: ILDB CH,TB ; GET A CHARACTER CAIN CH,"_" ; BACK ARROW? JRST PRE.12 ; YES - MUST BE END 'O LINE SUBI CH,40 ; I CROWN YOU SIXBIT IDPB CH,TC ; STASH CHARACTER TLNE TC,770000 ; ALL OUT OF ROOM IN AC? JRST PRE.11 ; NO - LOOP ON BACK PUSHJ PP,STASHL ; YES - OUTPUT WORD JRST PRE.11-2 ; AND RESET POINTER PRE.12: SUBI CH,40 ; CONVERT ME TO SIXBIT TOO IDPB CH,TC ; STASH THAT BACK ARROW PUSHJ PP,STASHL ; AND OUTPUT THAT LAST WORD SETZ TE, ; FLAG AS EDIT WORD POPJ PP, ; ALL DONE - RETURN; PRE12A: MOVE TA,CURDAT ; get datab pointer LDB TB,DA.EDT## ; [302] get edit code JUMPN TB,PRE10A ; [302] no error if there is one LDB TB,DA.LIN## ; get defining line number MOVEM TB,SAVELN## ; stash for error routines WARN 277; ; improper length JRST PRE10A ; continue anyways ;THIS IS THE END END