Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/getsrc.mac
There is 1 other file named getsrc.mac in the archive. Click here to see a list.
	TITLE	GETSRC FOR RPGII 1A(1)
	SUBTTL	JUNE 24, 1975  17:02:12		BOB CURRIER

	TWOSEG
	RELOC	400000

	ENTRY	GETSRC			; GET ONE CHAR FROM SOURCE
	ENTRY	PUTCPY			; PUT A CHARACTER INTO COPY FILE
	ENTRY	GETDEC			; GET A DECIMAL NUMBER FROM SOURCE FILE
	ENTRY	GTCHAR			; GET A CHARACTER, PLACE IN CARD BUFFER
	ENTRY	GETCRD			; PICK UP A CARD IMAGE, DOING SOME INTERPRETATION
	ENTRY	GETDCB			; GET A DECIMAL NUMBER OUT OF CRDBUF
	ENTRY	CRDSIX			; GET SIXBIT CHARACTERS
	ENTRY	PUTEOL			; APPEND AN E-O-L CHAR TO CPYFIL
;GET A CHARACTER FROM A SOURCE FILE

GETSRC:	TSWF	FEOF;			; END OF FILE?
	JRST	GTBLNK			; YES - GIVE HIM A LINE-FEED

	TSWFZ	FREGCH;			; REGET CHARACTER?
	JRST	REGETS			; YUP -

	SOSG	SRCBH+2			; BUFFER FULL?
	JRST	GETSR3			; YES - WELL GO EMPTY IT DUMMY

GETSR0:	ILDB	CH,SRCBH+1		; STUFF THAT CHAR

GETSL:	CAIGE	CH,40			; A CONTROL CHARACTER?
	JRST	GETSR2			; YES - TREAT IT CAREFULLY
	CAIL	CH,"a"			; [270] a lower case a?
	CAILE	CH,"z"			; [270] thru a lower case z?
	  JRST	PUTCPY			; [270] no - all ok
	SUBI	CH,40			; [270] yes - convert to upper case
	JRST	PUTCPY

;REGET PREVIOUS CHARACTER

REGETS:	LDB	CH,SRCBH+1		; LOAD THAT BYTE
	POPJ	PP,

;RETURN A LINE-FEED

GTBLNK:	MOVEI	CH,12
	JRST	PUTCPY
;PROCESS SPECIAL CHARACTERS
;(I.E. LESS THAN 40 OCTAL)

GETSR2:	JUMPE	CH,GETSRC		; IGNORE NULLS
	CAIE	CH,15			;    AND CARRIAGE RETURNS
	CAIN	CH,32			;    AND END FILES
	JRST	GETSRC

	CAIE	CH,11			; TAB?
	JRST	GTSR2B			; NO -

	MOVEI	CH," "			; YES - REPLACE WITH A SPACE
	DPB	CH,SRCBH+1		; STORE FOR POSSIBLE REGET
	PUSH	PP,CH			; STORE CHAR
	MOVEI	CH,11			; PUT A TAB IN CPYFIL
	PUSHJ	PP,PUTCPY
	POP	PP,CH			; RESTORE CHARACTER
	POPJ	PP,			; EXIT

GTSR2B:	CAIE	CH,12			; LINE-FEED?
	CAIN	CH,14			; FORM FEED?
	POPJ	PP,			; YES - LET IT GO

	CAIG	CH,24			; OTHER CARRIAGE CONTROL (13,20-24)
	CAIGE	CH,20
	CAIN	CH,13
	JRST	GTSRC2			; YES - 

	PUSH	PP,CH			; NO - STORE CHARACTER
	MOVEI	CH,"^"			; (UP YOURS, CPYFIL)
	PUSHJ	PP,PUTCPY
	MOVE	CH,(PP)
	ADDI	CH,100			; CONVERT FROM CONTROL
	PUSHJ	PP,PUTCPY
	POP	PP,CH
	POPJ	PP,

GTSRC2:	MOVEI	CH,12			; FORCE A LINE-FEED
	DPB	CH,SRCBH+1
	POPJ	PP,

;NEW BUFFER REQUIRED

GETSR3:	IN	SRC,			; FILL A BUFFER
	JRST	GETSR0

	GETSTS	SRC,CH			; ERROR?
	TRNE	CH,$ERAS
	JRST	GETSR4			; NOT AN END OF FILE ERROR

	RELEASE	SRC,			; RELEASE SOURCE DEVICE

	TSWF	FNOCPY;			; ARE WE IN CALFIL?
	JRST	GTSR3A			; YES - ONLY ONE CALFIL

	PUSHJ	PP,STINFL		; SET UP NEXT SOURCE
	SKIPE	SRCDEV			; WAS THERE ANY?
	JRST	GETSR3			; YES -

;NO MORE SOURCE

GTSR3A:	SWON	FEOF;			; SET "END OF FILE" FLAG
	SKIPE	CREFSW
	CLOSE	CRF,
	MOVEI	CH,12
	POPJ	PP,

;ERROR ON SOURCE DEVICE

GETSR4:	MOVEI	CH,SRCDEV
	JRST	DEVDED
;PUT A CHARACTER INTO CPYFIL

PUTCPY:	TSWF	FNOCPY;			; ARE WE COPYING?
	POPJ	PP,			; NO -
	SOSG	CPYBHO+2		; BUFFER FULL?
	JRST	PTC003			; TRY GENTLE PHILLIP'S MILK OF MAGNESIA

PTC004:	IDPB	CH,CPYBHO+1
	POPJ	PP,

PTC003:	OUT	CPY,			; OUTPUT A BUFFER FULL
	JRST	PTC004			; ALL'S WELL WITH THE WORLD

	MOVE	CH,CPYDEV		; WE BLEW IT
	JRST	DEVDED

;PUT A END OF LINE CHARACTER INTO CPYFIL.
;IN ADDITION TO THIS TASK IT ALSO INSERTS A LINE NUMBER
;INTO THE SAME WORD.
;

PUTEOL:	PUSH	PP,CH			; SAVE CH
	MOVE	CH,CPYBHO+1		; GET CURRENT WORD
	TLNN	CH,760000		; IS IT FINISHED?
	JRST	PUTEL2			; YES -

	MOVEI	CH,0			; NO - PAD WITH A NULL
	PUSHJ	PP,PUTCPY		; STASH IN CPYFIL
	JRST	PUTEOL+1		; LOOP

PUTEL2:	POP	PP,CH			; RESTORE CH

PUTFEL:	PUSHJ	PP,PUTCPY		; PUT OUT EOL CHARACTER
	LDB	CH,[POINT 7,SAVELN,28]	; GET FIRST 7 BITS OF LINE NUMBER
	PUSHJ	PP,PUTCPY		; STUFF INTO CPYFIL
	MOVE	CH,SAVELN		; PUT OUT REST OF NUMBER
	PUSHJ	PP,PUTCPY		; INTO CPYFIL
	MOVEI	CH,1			; SET "THIS IS A CONTROL WORD" BIT
	IORM	CH,@CPYBHO+1		; STORE IT
	AOS	SAVELN			; INCREMENT LINE COUNTER
	MOVE	TB,SAVELN		; CHECK FOR LINE NUMBER OVERFLOW
	CAIG	TB,17774		; DID WE OVERFLOW?
	POPJ	PP,			; NOPE

	OUTSTR	[ASCIZ "SOURCE PROGRAM TOO LONG
"]
	SWON	FEOF!FFATAL		; SET SOME FLAGS
	POPJ	PP,			; EXIT

	SUBTTL	PICK UP A CARD IMAGE

;GETCRD		VERSION 2
;
;VERSION 2 REPRESENTS A TOTAL CHANGE IN PHILOSOPHY AND A SPEED INCREASE
;OF ABOUT 30-40 TIMES. THIS ROUTINE SETS UP THE FOLLOWING REGISTERS
;ONLY:
;
;	CRDBUF		80 PACKED ASCII CHARACTERS, MAKING UP ONE CARD IMAGE
;	FRMTYP		CHARACTER FROM COLUMN 6
;	COMMNT		CHARACTER FROM COLUMN 7
;

GETCRD:	MOVEI	TB,^D80			; 80 COLUMN CARDS
	MOVE	TC,[POINT 7,CRDBUF]	; PLACE TO PUT THEM

GETCD1:	PUSHJ	PP,GTCHAR		; GET A CHARACTER
	IDPB	CH,TC			; STASH CHARACTER
	SOJN	TB,GETCD1		; LOOP UNTIL DONE

	PUSHJ	PP,GETSRC		; GET A CHARACTER
	CAIE	CH,12			; LINE FEED?
	JRST	.-2			; NO - LOOP UNTIL IT IS

	TSWT	FNOCPY;			; ARE WE COPYING?
	PUSHJ	PP,PUTEOL		; YES - OUTPUT EOL CHARACTER

	LDB	CH,[BPNT 6,]		; GET COLUMN 6
	MOVEM	CH,FRMTYP##		; STORE

	LDB	CH,[BPNT 7,]		; GET COLUMN 7
	MOVEM	CH,COMMNT##		; STORE

	SWOFF	FREGCH;			; MAKE SURE IT'S OFF
	POPJ	PP,			; AND EXIT

	SUBTTL	PICK UP A DECIMAL DIGIT

;DIGIT COUNT IN TB, NUMBER IS RETURNED IN TC

GETDEC:	MOVEI	TC,0			; ZERO OUT OUR SUM
	PUSHJ	PP,GTCHAR		; GET A CHARACTER
	CAIN	CH," "			; IS IT A SPACE?
	JRST	GETDC4			; YES - IGNORE IT

GETDC1:	CAIG	CH,"9"
	CAIGE	CH,"0"
	JRST	GETDC2			; BAD CHARACTER

	IMULI	TC,^D10			; OH...WE DO IT IN BASE TEN
	ADDI	TC,-"0"(CH)		; ADD IN NEW DIGIT
	SOJE	TB,GETDC3		; WE USED UP ALL OUR DIGITS?
	PUSHJ	PP,GTCHAR		; GET ANOTHER CHARATCER
	JRST	GETDC1			; NO - GET ANOTHER DISH

GETDC3:	POPJ	PP,			; ALL DONE...

GETDC4:	SOJE	TB,GETDC3		; DEDUCT ONE FOR THE SPACE
	JRST	GETDEC+1		; LOOP ON BACK, SUGAH

GETDC2:	CAIE	CH," "			; IS INVALID CHAR A SPACE?
	POPJ	PP,			; ALAS, 'TIS NOT

	MOVEI	CH,"0"			; YES - KLUDGE TO BE A ZERO
	JRST	GETDC1+3		; ADD IT ON IN
	SUBTTL GET A CHARACTER

GTCHAR:	PUSHJ	PP,GETSRC		; GET A CHARACTER FROM A SOURCE FILE
	CAIN	CH,12			; DID WE BYTE THE DUST?
	JRST	GTCHR3			; YES - IT'S A SPECIAL CASE

	POPJ	PP,			; NO -

GTCHR3:	MOVEI	CH," "
	SWON	FREGCH;
	POPJ	PP,

SUBTTL GET A DECIMAL NUMBER FROM CRDBUF
;DIGIT COUNT IN TB; NUMBER LEFT IN TC

GETDCB:	MOVEI	TC,0			; ZERO OUT SUM
	ILDB	CH,TA			; GET A CHARACTER
	CAIN	CH," "			; LEADING SPACE?
	JRST	GETDB4

GETDB1:	CAIG	CH,"9"			; CHECK FOR VALID DECIMAL NUMBER
	CAIGE	CH,"0"
	JRST	GETDB2			; NO VALID -

	IMULI	TC,^D10			; TIMES TEN
	ADDI	TC,-"0"(CH)
	SOJE	TB,GETDB3

	ILDB	CH,TA
	JRST	GETDB1

GETDB3:	POPJ	PP,

GETDB4:	SOJE	TB,GETDB3
	JRST	GETDCB+1

GETDB2:	CAIE	CH," "
	POPJ	PP,

	MOVEI	CH,"0"
	JRST	GETDB1+3

	SUBTTL GET SOME SIXBIT CHARACTERS
;
;ENTER WITH POINTER TO SOURCE IN TA, POINTER TO
;DESTINATION IN TB, AND COUNT IN TC.
;

CRDSIX:	HRRZ	CH,TA			; GET THE BYTE POINTER
	CAIN	CH,NAMWRD##		; PUTTING IT IN NAMWRD?
	JRST	CRDSX1			; YES - GO CLEAR IT FIRST

CRDSX2:	ILDB	CH,TA			; GET A CHARACTER
	SUBI	CH,40			; CONVERT TO SIXBIT
	IDPB	CH,TB			; STUFF IT
	SOJN	TC,CRDSX2		; DECREMENT COUNTER AND LOOP
	POPJ	PP,			; EXIT -


CRDSX1:	SETZM	NAMWRD			; ZAP FIRST WORD
	MOVE	CH,[XWD NAMWRD,NAMWRD+1]; SET UP FOR BLIT
	BLT	CH,NAMWRD+4		; AND BLIT AWAY!
	JRST	CRDSX2			; BACK TO MAINSTREAM

EXTERNAL DEVDED,SRCBH,STINFL,SRCDEV,CREFSW,CPYDEV,CPYBHO
EXTERNAL CRDBUF,SAVELN
EXTERNAL RESTRT

	END