Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/predit.mac
There is 1 other file named predit.mac in the archive. Click here to see a list.
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