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