Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/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