Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
getitm.mac
There are 21 other files named getitm.mac in the archive. Click here to see a list.
; UPD ID= 2009 on 8/21/79 at 1:43 PM by N:<NIXON>
TITLE GETITM FOR COBOL-68 & COBOL-74
SUBTTL GET NEXT SOURCE WORD AL BLACKINGTON/CAM/SEB/DMN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
MCS==:MCS
TCS==:TCS
STRING==:STRING
DBMS==:DBMS
ENTRY GETITM ;GET NEXT WORD A DETERMINE TYPE
ENTRY GETKAR ;GET NEXT CHARACTER FOR A WORD OR NUMERIC LITERAL.
ENTRY GETCH ;GET NEXT CHARACTER FOR A NON-NUMERIC LITERAL.
ENTRY GETFCH ;GET VERY FIRST CHARACTER IN THE SOURCE FILE.
ENTRY GETWRD ;GET NEXT WORD OR LITERAL FROM SOURCE
ENTRY FINSKP ;COMPLETE SKIPPING OF PARAGRAPH
ENTRY SETLIB ;SET UP FOR READING LIBRARY FILE
ENTRY SKPSRC ;READ ONE SOURCE CHARACTER
ENTRY PUTCRF ;PUT ITEM INTO CREF FILE
INTERN GETSRC ;[702]
TWOSEG
RELOC 400000
SALL
;EDITS
;NAME DATE COMMENTS
;V12*****************
;DMN 21-AUG-79 [726] FIX COPY REPLACING WHEN MULTIPLE OF SIX CHARS.
;DMN 30-APR-79 [704] FIX MULTIPLE COPY REPLACING ORDERING BUG.
;DMN 30-APR-79 [702] MAKE GETSRC A GLOBAL SYMBOL FOR DATE-COMPILED.
;DMN 9-MAR-79 [657] FIX PROBLEM WITH LOOKAHEAD IN COPY REPLACING INTEGER.
;DMN 6-MAR-79 [655] CHECK FOR PREMATURE EOF ON LIBRARY FILE
;DMN 18-DEC-78 [620] STORE SEQ. NO. CORRECTLY FOR DATE-COMPILED PARAGRAPH.
;DMN 15-DEC-78 [617] IF FGTPER IS ON DON'T TEST FOR REPLACEMENT
;DMN 9-NOV-78 [***] FIX INFINITE LOOP IF TERMINAL == IS IN A-MARGIN
;DMN 19-SEP-78 [557] FIX VARIOUS COPY REPLACING BUGS
;V11*****************
;DMN REWROTE COPY VERB
;V10*****************
;EHM 10-JAN-77 [526] IGNORE EDITS PAGE MARKS SO CONTINUATION WORKS
;EHM 02-JUN-77 [477] DO BETTER RECOVERY WHEN LIBARY NOT FOUND
;MDL 20-APR-77 [470]BE MORE AWARE WHEN "DECIMAL-POINT IS COMMA"
;DPL 09-DEC-76 [453] MAKE /S WORK FOR DBMS
;SSC 3-5-75 PUT 6A EDIT %316 DIRECTLY INTO V10
;********************
; EDIT 367 FIX THE MISSING OF LISTING OF ".", "," OR ";" THAT IS IN
; A LIBARY
; EDIT 364 DBMS FIX - MAKE ONLY ONE CALL TO DBGETF BECAUSE ONLY ONE
; INVOKE STATEMENT ALLOWED.
; EDIT 354 FIX TO HANDLE SOURCE CHAR COUNTER.
; EDIT 352 "I/O TO UNASSIGN " PROBLEM WHILE ATTEMPTING TO READ LIBRARY
; FILE IF "COPY" IS LAST COBOL STATEMENT IN SOURCE FILE.
; EDIT 323 ALLOW "ALL" TO BE USED AS A DEVICE IN A "SELECT" STATEMENT
; EDIT 275 RECOVER PROPERLY UPON RETURN FROM LIBARY FILE
; EDIT 213 DO NOT ALLOW COPY IN WITHIN A LIBARY; IF LITERAL TOO LONG-,GIVE ERROR MSG ONLY ONCE
;**EDIT 156 FIXES COMMENT PROBLEM ON FIRST LINE OF A LIBRARY INPUT
;**EDIT 150 RESET SEARCH SWITCH WASERC FOR SAVED ITEM
GETITM: TSWF FPERWD ;GET PERIOD AND LAST WORD?
JRST [PUSHJ PP,GETWRD ;YES, GET PERIOD
JRST GITM1A] ;BUT DON'T CHECK FOR REPLACING
TSWF FREGWD ;NO--REGET PREVIOUS WORD?
JRST GETWRD ;YES--DO SO, AND RETURN
SKIPE W2,SAVEWD+1 ;ANYTHING SAVED?
JRST GITM20 ;YES
PUSHJ PP,GETWRD ;GET NEXT WORD
GITM1C: TSWF FRLIB ;[557] READING FROM LIBRARY?
TSWF FCOPY ;YES, BUT REPLACING?
JRST GITM1A ;NO
SKIPE RPLCNT ;ANY REPLACEMENTS?
JRST RPLTST ;YES, SEE IF THIS IS ONE
GITM1A: TLNN W1,GWLIT ;LITERAL?
TLNN W1,GWRESV ;NO--RESERVED WORD?
JRST GTITM3 ;NO
LDB CT,GWVAL ;YES--FIGURATIVE CONSTANT?
CAIL CT,700
CAILE CT,707
JRST GTITM2 ;NO
CAIN CT,ALL. ;MAYBE--"ALL"?
JRST GITM30 ;YES
IFN ANS68,<
CAIN CT,TALLY ;NO--TALLY?
JRST GTITM5 ;YES
>
MOVEI CT,FIGCN. ;IT IS A FIGURATIVE CONSTANT
TLO W1,GWFIGC
GTITM2: SETZM WASERC ;ASSUME IT WAS NOT 'SEARCH'
CAIN CT,SEARC. ;IS IT 'SEARCH'?
SETOM WASERC ;YES--SET FLAG
LDB TE,GWCP ;GET CHARACTER POSITION
CAIGE TE,^D12 ;IN A-MARGIN?
IORI CT,AMRGN. ;YES--SET FLAG
MOVEM CT,ITEMCT
CAIE CT,COPY. ; [213] "COPY" ?
CAIN CT,COPY.+AMRGN. ; [213] POSSIBLY WITHIN A-MARGIN
CAIA ; [213] YES
POPJ PP, ;RETURN
TSWT FRLIB ; [213] ARE WE WITHN A LIBARY ROUTINE?
JRST CPYLIB ;GO HANDLE COPY
MOVEI DW,E.492 ; [213] COPY WITHIN A LIBARY ILLEGAL
PUSHJ PP,FATAL ; [213]
GITM2B: PUSHJ PP,GETWRD ; [213] GET NEXT WORD
HLRZM W1,TA ; [213] MOVE FOR TESTING
CAIE TA,PERWD ; [213] IF PERIOD
CAIN TA,ENDIT ; [213] OR END OF SOURCE
JRST GITM1A ; [213] DONE-GO ON
TSWT FCOPY!FRLIB ; [213] OR IF NO LONGER IN LIBARY
JRST GITM1A ; [213] DONE- GO ON
JRST GITM2B ; [213] KEEP SEARCHING
;NOT A RESERVED WORD
GTITM3: TLNE W1,GWLIT ;IS IT A LITERAL?
JRST GITM10 ;YES
SKIPE CREFSW ;IF WE ARE CREFFING,
PUSHJ PP,PTCRF0 ; WRITE OUT CREF ITEM
TLNE W1,GWNOT ;NO--IN NAMTAB?
JRST GITM3A ;NO
HRRZ CT,(TA) ;YES
JUMPN CT,GTITM4 ;DEFINED?
GITM3A: MOVEI CT,USERN. ;NO
JRST GTITM2 ;RETURN
;IT IS A DEFINED USER WORD
GTITM4: PUSH PP,TA
MOVE TA,0(TA) ;GET TABLE LINK
LDB CT,[POINT 3,TA,20] ;GET CODE
EXCH DT,0(PP) ;SAVE DT, DT_NAMTAB ADDRESS
JUMPE CT,GITM12 ;IF CODE ZERO, SPECIAL
PUSHJ PP,LNKSET ;GET TABLE ADDRESS INTO TA
GITM4B: EXCH TA,DT ;DT_TABLE ADDRESS, TA_NAMTAB ADDRESS
MOVE CT,CODTAB(CT)
CAIN CT,DATAN. ;DATAB?
JRST GITM4A ;YES
CAIN CT,MNEMO. ;NO--MNEMONIC?
JRST GTITM9 ;YES
GITM4A: POP PP,DT ;RESTORE DT
JRST GTITM2 ;RETURN
IFN ANS68,<;TALLY
GTITM5: MOVEI CT,DATAN. ;PRETEND IT'S A DATA-NAME
TLO W1,GWFIGC ;BUT TURN ON "FIG. CONST." ANYWAY
JRST GTITM2
>
;MNEMONIC NAME
GTITM9: MOVE TE,1(DT) ;DEVICE-NAME?
TLNN TE,MTCONS
MOVEI CT,SPECN. ;NO
JRST GITM4A ;RETURN
;IT IS A LITERAL
GITM10: TLNE W1,GWNLIT ;NUMERIC?
JRST GITM11 ;YES
MOVEI CT,LITER. ;NO
JRST GTITM2
GITM11: MOVEI CT,INTGR.
TLNE W1,GWDP ;DECIMAL-POINT?
AOJA CT,GTITM2 ;YES
JRST GTITM2 ;NO--INTEGER
;ITEM IS CODE ZERO.
;IT IS EITHER A FILE-NAME OR A REPORT-NAME.
GITM12: MOVE TE,FILNXT ;GET SIZE OF
SUB TE,FILLOC ; FILTAB
CAILE TA,(TE) ;IS ITEM WITHIN FILTAB?
JRST GITM13 ;NO
ADD TA,FILLOC ;MAYBE--GET ABSOLUTE ADDRESS
LDB TE,[POINT 15,0(TA),17]; GET FILTAB'S NAMTAB LINK
HLRZ TD,DT ;GET RELATIVE NAMTAB ADDRESS
CAIN TE,(TD) ;IS IT SAME AS THIS ONE?
JRST GITM4B ;YES
GITM13:
IFN MCS!TCS,<
MOVE TA,(DT) ;GET TABLE LINK FROM NAMTAB
MOVE TE,CDNXT
SUB TE,CDLOC ;IS THIS WITHIN CDTAB?
CAILE TA,(TE)
JRST GTM13A ;NO
ADD TA,CDLOC
LDB TE,[POINT 15,0(TA),17]
HLRZ TD,DT
CAIE TE,(TD)
JRST GTM13A
MOVE TA,DT
MOVEI CT,CDNAM.
JRST GITM4A
GTM13A:
>
MOVE TA,DT ;TA_NAMTAB ADDRESS
MOVEI CT,RPNAM. ;REPORT-NAME CODE
JRST GITM4A
;SOMETHING WAS SAVED AT A PREVIOUS TIME, BY "FPERWD".
GITM20: MOVE W1,SAVEWD
MOVE CT,SAVEWD+2
MOVEM CT,ITEMCT
SETZM SAVEWD+1
LDB CP,GWCP
LDB LN,GWLN
TSWF FEOF ;END OF SOURCE?
JRST GITM21 ;YES
TLNE W1,GWLIT ;WAS IT A LITERAL?
POPJ PP, ;YES
TLZ W1,GWNOT ;NO--GO LOOK IN NAMTAB
PUSHJ PP,TRYNAM
TLOA W1,GWNOT
HRR W1,0(TA)
TRZ CT,AMRGN. ;RESET A-MARGIN SW [150]
JRST GTITM2 ;CHECK FOR SEARCH AND POSSIBLY RESET A-MARGIN SWITCH
GITM21: MOVSI W1,ENDIT ;RETURN AN "END OF PROG"
LDB CT,GWVAL
POPJ PP,
;THE WORD "ALL" WAS SEEN
GITM30: MOVE TA,PHASEN ; [323] GET CURRENT PHASE
CAIN TA,"B" ; [323] IF IN PHASE B (ENV DIVISION)
JRST GTITM2 ; [323] ALLOW IT- WE MAY BE IN SELECT
SKIPE WASERC ;WAS PREVIOUS WORD 'SEARCH'?
JRST GTITM2 ;YES--THEN NO LITERAL IS COMING
IFN DBMS,<
HRRZ TA,OPRTR+1 ;GET OPRTR CODE
CAIN TA,46 ; USING OPERATOR?
JRST GTITM2 ;YES, "ALL" IS OK HERE
CAIE TA,63 ;IS IT OPEN OR CLOSE?
CAIN TA,62
JRST GTITM2 ;YES, "ALL" IS OK HERE.
CAIN TA,122 ;"DELETE" COMMAND IS OK TOO.
JRST GTITM2
>
IFN STRING,<
HRRZ TA,OPRTR+1 ;GET OPRTR CODE
CAIN TA,UDELIM ;ALSO IN "UNSTRING"
JRST GTITM2
>
PUSHJ PP,GETWRD ;GET NEXT WORD
TLNN W1,GWLIT ;LITERAL?
TLNN W1,GWRESV ;NO--IS NEW WORD RESERVED?
JRST GITM35 ;NO
LDB CT,GWVAL ;IS NEW WORD A FIG. CONST.?
CAIL CT,700
CAILE CT,707
JRST GITM33 ;NO--ERROR
CAIN CT,ALL. ;MAYBE--"ALL" AGAIN?
JRST GITM33 ;YES--ERROR
MOVEI CT,FIGCN. ;NO--IT IS A FIG. CONST.
TLOA W1,GWFIGC!GWALL ;[557]
GITM35: TLO W1,GWALL ;[557] NO--SET "ALL" FLAG
JRST GITM1C ;[557] RETURN TO SET UP "CT" AND CHECK REPLACING
;ERROR WITH "ALL"
GITM33: MOVEI DW,E.273
PUSHJ PP,FATAL
JRST GITM1A
;CODE TABLE FOR USER NAMES
CODTAB: FILEN. ;FILTAB
DATAN. ;DATAB
CONDI. ;CONTAB
0 ;INVALID
PRONM. ;PROTAB
EXTNA. ;EXTAB
0 ;INVALID
MNEMO. ;MNETAB
;PUT ITEM ONTO CREF FILE
PUTCRF: SKIPN CREFSW ;IF NO CREF FILE,
POPJ PP, ; FORGET IT
PTCRF0: MOVE TE,[POINT 6,NAMWRD]
PTCRF1: MOVE TD,[POINT 6,CH]
PTCRF2: ILDB TC,TE
CAIN TC,":"-40
MOVEI TC,"-"-40
CAIN TC,";"-40
MOVEI TC,"."-40
IDPB TC,TD
TLNE TD,770000
JRST PTCRF2
SOSG CRFBHO+2
PUSHJ PP,PTCRF9
IDPB CH,CRFBHO+1
CAME TE,[POINT 6,NAMWRD+4,35]
JRST PTCRF1
MOVE CH,W2
TLZ CH,377774
SOSG CRFBHO+2
PUSHJ PP,PTCRF9
IDPB CH,CRFBHO+1
POPJ PP,
PTCRF9: OUT CRF,
POPJ PP,
MOVEI CH,CRFDEV
JRST DEVDED
;SCAN THE NEXT WORD.
;SET UP WORD DESCRIPTORS.
GETWRD: SETZM SAVECH
TSWFZ FPERWD; ;RETURN A PERIOD AND A WORD?
JRST TESTWD ;YES
TSWFZ FREGWD; ;NO--RETURN SAME WORD?
JRST REGWRD ;YES
TSWFZ FGTPER; ;RETURN A PERIOD?
JRST SETPER ;YES
TSWFZ FGTMIN; ;NO--RETURN A "-"?
JRST SETMIN ;YES
SETZM SAVEWD+1 ;INSURE NOTHING SAVED
SETZM NAMWRD ;CLEAR NAMWRD
MOVE TA,[XWD NAMWRD,NAMWRD+1]
BLT TA,NAMWRD+4
TSWF FRTST ;SEARCHING FOR REPLACEMENT TEXT
SETZM L2BH0 ;YES, CLEAR SO WE KNOW IF GETKAR SAVED LAST BLANK
SETZM R3BH0 ;...
SWOFF FLETTR!FALIT ;TURN OFF "ALPHA" FLAGS
JRST GTWD1B
;SCAN THE NEXT WORD (CONT'D).
;INITIALIZE.
GETWD1: TSWTZ FNEEDS ;TURN OFF "SPACE NEEDED"
JRST GTWD1B
MOVEM CP,SAVBCP
MOVEM LN,SAVBLN
GTWD1B: TSWF FEOF; ;END-OF-FILE?
JRST SETEND ;YES
TSWFZ FECOPY ;ANY LIBRARY TO FINISH UP?
PUSHJ PP,ENDCPY ;YES--DO SO
PUSHJ PP,GETCH ;GET NEXT CHARACTER
TSWF FRTST ;[557] JUST DOING REPLACEMENT TEST?
JRST [SKIPGE LIBBH+2 ;[557] YES, BUT IS LIBRARY DONE?
POPJ PP, ;[557] YES, JUST GIVE UP
JRST .+1] ;[557] NO
CAIE CH," "
CAIN CH,$TAB
JRST GETWD1
MOVEM LN,WORDLN
MOVEM CP,WORDCP
SWOFF FNEEDS;
MOVE TE,SAVBLN
JUMPE TE,GTWD1C
MOVEM TE,BLNKLN
MOVE TE,SAVBCP
MOVEM TE,BLNKCP
GTWD1C: MOVE CT,INPTCP
MOVEM CT,INPTST
SETZB CT,LC ;CLEAR COUNTERS
SETZM SAVBLN
MOVE PA,[POINT 6,NAMWRD]
MOVE PB,[POINT 7,LITVAL]
SETZB W1,W2
SETZM NOCONT ;SET "CONTINUATIONS LEGAL" INDICATION
TSWF FCOPY ;ARE WE COPYING
SKIPN EOLKAR ;YES--END-OF-LINE TO GO OUT?
JRST GETWD2 ;NO
SWON FREGCH ;YES--SET "REGET CHARACTER"
MOVE CH,EOLKAR
PUSHJ PP,PUTCPY
PUSHJ PP,GETSRC
;FIRST NON-BLANK CHARACTER SEEN
GETWD2: CAIL CH,141 ;CONVERT LC TO UC
CAILE CH,172
JRST .+2 ;NOT LC
TRZ CH,40
CAIG CH,"Z" ;LETTER?
CAIGE CH,"A"
JRST GETWD5 ;NO
TLNE W1,GWLIT ;YES--IS THIS A LITERAL?
JRST GTWD5A ;YES--ERROR
GETWD3: SWON FLETTR; ;NO--SET FLETTR
GTWD3A: CAIGE CT,^D30 ;30 CHARACTERS YET?
AOJA CT,GTWD3B ;NO--INCREMENT AND JUMP
MOVEI DW,E.55 ;YES
CAIN CT,^D30 ;HAVE WE PUT OUT DIAG?
PUSHJ PP,WARN ;NO--PUT IT OUT
AOJA CT,GETWD4
GTWD3B: IDPB CH,PB
CAIN CH,"-" ;IS IT "-"?
MOVEI CH,":" ;YES--SUBSTITUTE ":"
SUBI CH,40 ;CONVERT TO SIXBIT
IDPB CH,PA ;STASH IT
GETWD4: PUSHJ PP,GETKAR ;GET NEXT CHARACTER
JRST GETWD2
GETWD5: CAIG CH,"9" ;NOT LETTER--DIGIT?
CAIGE CH,"0"
JRST GTWD10 ;NO
GTWD5B: AOJA LC,GTWD3A ;YES--STASH IT
GTWD5A: MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GETWD4
;TRY FOR NON-NUMERIC LITERAL
GETWD6: CAIN CH,$QUOTE ;QUOTE?
JRST GTWD6A
CAIE CH,"'"
JRST GTWD11 ;NO
GTWD6A: JUMPE CT,GTWD6C ;YES--ANYTHING SEEN?
SWON FREGCH; ;YES--SET "REGET CHARACTER"
JRST ENDWRD ;FINISH UP
GTWD6C: TLO W1,GWLIT ;TURN ON "LITERAL" FLAG
SWON FLETTR!FALIT; ;TURN ON "ALPHA" FLAGS
MOVEM CH,TERMQ ;SAVE DELIMITER
GETWD7: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7?
CAIN TE,7
JRST GETWD9 ;YES
CAMN CH,TERMQ ;NO--CLOSING QUOTE?
JRST GETWD8 ;YES
GTWD7A: CAIGE CT,^D120 ; [213] NO--TOO BIG?
AOJA CT,GTWD7B ;NO--INCREMENT AND JUMP
MOVEI DW,E.56 ;YES
CAIN CT,^D120 ;HAVE WE PUT OUT DIAG?
PUSHJ PP,FATAL ;NO--PUT IT OUT
AOJA CT,GETWD7 ; [213] COUNT UP OVERSIZED LITERAL
GTWD7B: CAIGE CH,140
CAIGE CH,40
TLO W1,GWASCI
IDPB CH,PB
JRST GETWD7
;CLOSING QUOTE FOUND
GETWD8:
IFN ANS74,<
PUSHJ PP,GETCH ;LOOK AHEAD
MOVE TE,SRCCOL ;COLUMN 7?
CAIN TE,7
GTWD8X: CAIE CH,"-" ;HYPHEN?
JRST GTWD8A ;NO
GTWD8Z: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7 AGAIN?
CAIN TE,7
JRST GTWD8X ;YES
CAIE CH,$TAB ;NO--TAB?
CAIN CH," " ;NO--SPACE?
JRST GTWD8Z ;YES--LOOP
CAMN CH,TERMQ ;FIRST CHAR A QUOTE
JRST GETWD8 ;YES, GET RID OF IT [SEE NC215]
GTWD8A: CAMN CH,TERMQ ;IS IT 2 CONSECUTIVE QUOTES?
JRST GTWD7A ;YES, PASS ONE
SWON FREGCH ;NO, SET REGET CHAR
MOVE CH,TERMQ ;JUST INCASE
>
CAILE CT,^D120 ; [213] LIMIT LITERAL SIZE
MOVEI CT,^D120 ; [213] TO 120 CHARS
SWOFF FALIT ;CLOSING QUOTE SEEN
MOVEM LN,SAVBLN ;UPDATE PTRS TO END OF LITERAL
MOVEM CP,SAVBCP
PUSHJ PP,GTWD18
JRST ENDLIT
;CONTINUATION COLUMN WHEN SCANNING NON-NUMERIC LITERAL
GETWD9: CAIE CH," " ;SPACE?
JRST GTWD9B ;NO
MOVE CP,WORDCP
MOVE LN,WORDLN
MOVEI DW,E.70 ;YES--ERROR
GTWD9A: PUSHJ PP,FATAL
JRST ENDWRD
GTWD9B: CAIN CH,"-" ;HYPHEN?
JRST GTWD9C ;YES
MOVEI DW,E.73 ;NO--ERROR
JRST GTWD9A ;QUIT
GTWD9C: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7 AGAIN?
CAIN TE,7
JRST GETWD9 ;YES
CAIE CH,$TAB ;NO--TAB?
CAIN CH," " ;NO--SPACE?
JRST GTWD9C ;YES--LOOP
CAMN CH,TERMQ ;NO--QUOTE?
JRST GETWD7 ;YES--EVERYTHING OK
PUSH PP,CH
MOVEI DW,E.71 ;NO--WARN HIM
PUSHJ PP,WARN
POP PP,CH
JRST GTWD7A ;GO STASH IT
;TRY A SPACE OR TAB
GTWD10: CAIE CH," "
CAIN CH,$TAB
JRST ENDWRD ;YES--IT IS A SPACE OR A TAB
MOVEM LN,SAVLN1 ;SAVE LINE NUMBER AND
MOVEM CP,SAVCP1 ; CHARACTER POSITION
MOVEM CH,SAVECH ; AND CHARACTER
;TRY A HYPHEN
CAIE CH,"-" ;HYPHEN?
JRST GETWD6 ;NO
JUMPE CT,GTW10C ;YES--FIRST CHARACTER?
PUSHJ PP,GETKAR ;NO--GET NEXT ONE
CAIN CH," " ;SPACE?
JRST GTW10A ;YES
SWON FREGCH; ;NO--SET "REGET CHARACTER"
TLNE W1,GWSIGN!GWDP ;IS IT A SIGNED LITERAL?
JRST GTW10D ;YES--ERROR
MOVEI CH,"-" ;GET HYPHEN BACK
TLO W1,GWHYF ;TURN ON "THERE IS A HYPHEN"
JRST GETWD3
;SPACE AFTER "-"
GTW10A: TSWT FARITH ;EXPRESSION?
JRST GW10AA ;NO
SWON FGTMIN; ;YES--SET "REGET MINUS"
JRST ENDWRD
GW10AA: MOVE LN,SAVLN1
MOVE CP,SAVCP1
MOVEI DW,E.54 ;NOT EXPRESSION--ERROR
PUSHJ PP,FATAL
JRST ENDWRD
;INPUT CHARACTER IS A HYPHEN (CONT'D)
;WORD STARTED WITH A HYPHEN
;HAS TO BE A LITERAL
GTW10C: IDPB CH,PB
TLO W1,GWLIT!GWSIGN
AOJA CT,GETWD4
;IMPROPER LITERAL--SIGN AFTER EITHER SIGN OR DECIMAL POINT
GTW10D: MOVE LN,SAVLN1
MOVE CP,SAVCP1
MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GETWD4
;TRY A PERIOD
GTWD11: CAIE CH,"." ;PERIOD?
JRST GTWD12 ;NO
TSWT FLETTR; ;ANY LETTERS SO FAR?
CAME CH,DCPNT. ;NO--ALSO DECIMAL POINT?
JRST GTW11C ;NO
SKIPGE RPLBH+0 ;SEARCHING FOR REPLACEMENTS?
PUSHJ PP,SVPKAR ;YES, SAVE LOC OF PERIOD
SKIPE TERSCN ;[657] SHOULD WE TERMINATE SCAN NOW?
JRST [CAME CH,TERSCN ;[657] MAKE SURE ITS WHAT WE EXPECTED
JRST .+1 ;[657] SOME SORT OF ERROR
MOVEI CH," " ;[657] RETURN A SPACE
SETZM TERSCN ;[657] ONLY DO IT ONCE
JRST .+2] ;[657] BUT DON'T READ NEXT CHARACTER
PUSHJ PP,GETKAR ;YES
JUMPE CT,GTW11H ;WAS DECIMAL POINT THE FIRST CHARACTER?
CAIG CH,"9" ;NO--IS THIS A DIGIT?
CAIGE CH,"0"
JRST GTW11B ;NO
GTW11A: TLOE W1,GWDP ;YES--SET "DECIMAL-POINT" INDICATION
JRST GTW11G ;ALREADY SET--ERROR
TLO W1,GWLIT
MOVEI TC,"."
IDPB TC,PB ;STASH PERIOD
SETZM SAVECH
AOJA CT,GTWD5B ;KICK UP COUNT--GO TO LITERAL
GTW11B: SWON FGTPER;
CAIE CH," " ;IS IT A SPACE?
JRST GTW11F ;NO--ERROR
TSWF FRLIB ;[657] READING FROM LIBRARY?
TSWF FCOPY ;[657] YES, BUT REPLACING?
JRST GTW11D ;[657] NO NEED FOR SPECIAL CHECK
SKIPE RPLCNT ;[657] ANY POSSIBILITY OF REPLACEMENTS?
TSWT FRTST ;[657] YES, BUT ARE WE ON THE REAL READ PASS
JRST GTW11D ;[657] NO NEED FOR SPECIAL CHECK
MOVEI CP,"." ;[657] YES
MOVEM CP,TERSCN ;[657] SET FLAG TO STOP ON READ SCAN
JRST GTW11D ;[657] AND CONTINUE
GTW11C: SWON FGTPER!FNEEDS; ;SET "GET A PERIOD" AND "SPACE NEEDED"
GTW11D: MOVE CP,SAVCP1
MOVE LN,SAVLN1
JUMPN CT,ENDWRD ;ANYTHING SO FAR?
;***** TEMPORARY UNTIL EDIT 617 IS FIXED *****
JRST GETWRD
;*****
TSWF FRLIB ;[617] READING FROM LIBRARY?
TSWF FCOPY ;[617] YES, BUT REPLACING?
JRST GETWRD ;[617] NO NEED FOR SPECIAL CHECK
SKIPE RPLCNT ;[617] ANY POSSIBILITY OF REPLACEMENTS?
TSWF FRTST ;[617] YES, BUT ARE WE ACTUALLY CHECKING?
JRST GETWRD ;[617] NO NEED FOR SPECIAL CHECK
;[617] WE NEED TO CHECK IN CASE WE ARE CALLED FROM GITM1C-1 (THE USUAL CASE) IF SO
;[617] WE MUST BYPASS THE REPLACEMENT TEST FOR THE FAKE PERIOD (THE REAL ONE HAS BEEN DONE)
;[617] OTHERWISE SIDE EFFECTS WHICH ARE DIFFICULT TO PREVENT CAUSE THE LISTING TO BE
;[617] BACKED UP AND THE CURRENT CHARACTER TO BE OVERWRITTEN.
PUSHJ PP,GETWRD ;[617] GET THE PERIOD
EXCH CH,0(PP) ;[617] GET RETURN, SAVE ACC
HRRZ CH,CH ;[617] GET THE ADDRESS ONLY
CAIN CH,GITM1C ;[617] ON RETURN WILL WE TEST FOR REPLACEMENT?
MOVEI CH,GITM1A ;[617] YES, BUT WE DON'T WANT TO
EXCH CH,0(PP) ;[617] SWAP BACK
POPJ PP, ;[617]
;FIRST CHARACTER WAS DECIMAL POINT
GTW11H: CAIE CH," " ;WAS IT FOLLOWED BY A SPACE?
JRST GTW11J ;NO--MUST BE A LITERAL
SWON FGTPER; ;YES--WARN HIM
JRST GTW11D
GTW11J: TLO W1,GWLIT!GWDP
SWON FREGCH;
MOVEI CH,"."
IDPB CH,PB
SETZM SAVECH
AOJA CT,GETWD4
GTW11F: JUMPN CT,GTW11E ;ANYTHING BEFORE THE PERIOD?
SWON FNEEDS; ;NO--SET "SPACE REQUIRED"
JRST GTW11D
GTW11E: MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GTW11D
;TWO DECIMAL POINTS IN LITERAL
GTW11G: PUSH PP,CH
MOVEI DW,E.77
MOVE CP,SAVCP1
MOVE LN,SAVLN1
PUSHJ PP,FATAL
POP PP,CH
JRST GTWD3A
;TRY COMMA AND SEMI-COLON
GTWD12: CAIE CH,"," ;IS IT A COMMA?
JRST GTW12B ;NO
CAME CH,DCPNT. ;YES--ALSO DECIMAL POINT?
JRST GTW12C ;NO
TSWF FLETTR ;[470] YES, ALL DIGITS SO FAR?
JRST GTW12C ;[470] NO, MUST BE LITERAL OR DATA NAME
PUSHJ PP,GETKAR ;YES--LOOK AT NEXT CHARACTER
CAIG CH,"9" ;DIGIT?
CAIGE CH,"0"
JRST GTW12D
JRST GTW11A ;YES--TREAT AS DECIMAL POINT
GTW12B: CAIE CH,";" ;SEMI-COLON?
JRST GTWD13 ;NO
GTW12C: PUSHJ PP,GETKAR
GTW12D: CAIE CH," "
SWON FREGCH;
JRST GTW11D
;TRY PLUS
GTWD13: CAIE CH,"+" ;NO--IS IT "+"?
JRST GTWD14 ;NO
JUMPE CT,GTW10C ;YES--FIRST CHARACTER?
MOVEI DW,E.620 ;PROBABLY AN ERROR
PUSHJ PP,WARN
MOVEI CH,"+" ;RELOAD CHARACTER
SWON FREGCH;
JRST ENDWRD
;TRY SPECIAL CHARACTERS
GTWD14: JUMPE CT,GTWD15 ;FIRST CHARACTER?
SWON FREGCH; ;NO--SET "REGET CHARACTER"
JRST ENDWRD
GTWD15: CAIE CH,"*" ;CHECK FOR "*"
JRST GTW15A ;NO
MOVSI W1,MULWD ;YES--IS NEXT "*" ALSO?
PUSHJ PP,GETKAR
CAIN CH,"*"
JRST GTW15D ;YES--IT'S "**"
SWON FREGCH; ;NO
CAIN CH," " ;IS NEXT CHARACTER SPACE?
JRST SETPN1 ;YES
JRST GTW17A ;NO
GTW15D: MOVSI W1,EXPWD
JRST GTW17A
GTW15A: MOVEI W1,0
CAIN CH,"-"
MOVSI W1,MINWD
CAIN CH,"+"
MOVSI W1,PLUSWD
CAIN CH,"("
MOVSI W1,LPARWD
JUMPN W1,SETPN1
MOVE TA,PUNPTR
GTW15B: HRRZ TB,0(TA)
CAMN CH,TB
JRST GTWD17
AOBJN TA,GTW15B
;BAD CHARACTER
MOVEI DW,E.57 ;PUT OUT DIAG
PUSHJ PP,FATAL
JUMPE CT,GETWRD ;ANTHING SO FAR?
JRST ENDWRD ;YES--FINISH UP
;A SPECIAL CHARACTER WAS SEEN. CHECK FOR FOLLOWING PUNCTUATION.
GTWD17: HLLZ W1,0(TA)
GTW17A: PUSHJ PP,SETPN1
PUSH PP,LN
PUSH PP,CP
PUSHJ PP,GTWD18
POP PP,CP
POP PP,LN
POPJ PP,
GTWD18: SETZM SAVECH
PUSHJ PP,GETKAR ;GET NEXT CHARACTER
CAIN CH," " ;SPACE?
POPJ PP, ;YES
CAIN CH,"." ;NO--PERIOD?
SWON FGTPER!FNEEDS ;YES--SET FLAGS
CAIE CH,";" ;SEMICOLON OR
CAIN CH,"," ;COMMA?
SWON FNEEDS ;YES--SET "SPACE NEEDED"
TSWT FNEEDS ;ANY PUNCTUATION SEEN?
JRST REGLST ;NO, CHARACTER NOT PUNCTUATION--GET IT NEXT TIME
MOVEM CH,SAVECH ;YES--SAVE IT
MOVEM LN,SAVLN1 ;SAVE
MOVEM CP,SAVCP1 ; LOCATION
POPJ PP,
;RETURN A PERIOD
TESTWD: TSWTZ FREGWD; ;ALSO "REGET WORD"?
JRST TSTWD1 ;NO--SIMPLY RETURN A PERIOD
MOVEM W1,SAVEWD ;SAVE THAT WORD
MOVEM W2,SAVEWD+1
MOVE CT,ITEMCT
MOVEM CT,SAVEWD+2
TSTWD1: MOVSI W1,PERWD
POPJ PP,
;PUNCTUATION OF SOME KIND
SETPN1: MOVE LN,SAVLN1
MOVE CP,SAVCP1
SETPN2: DPB LN,GWLN
MOVEM LN,WORDLN
DPB CP,GWCP
MOVEM CP,WORDCP
POPJ PP, ;RETURN
SETPLS: MOVSI W1,PLUSWD ;PLUS
MOVEI CH,"+"
JRST SETPN1
SETMIN: MOVSI W1,MINWD ;MINUS
MOVEI CH,"-"
JRST SETPN1
SETPER: MOVSI W1,PERWD ;PERIOD
MOVEI CH,"."
JRST SETPN1
;END-OF-FILE HAD BEEN SEEN BEFORE
SETEND: MOVSI W1,ENDIT
MOVE LN,SAVELN
MOVEI CP,7
JRST SETPN2
;REGET SAME WORD
REGWRD: MOVE CT,ITEMCT
TLNE W1,GWLIT ;LITERAL?
POPJ PP, ;YES--RETURN
TLZ W1,GWNOT
PUSHJ PP,TRYNAM ;NO--GET NAMTAB ENTRY
TLOA W1,GWNOT ;THERE ISN'T ONE
HRR W1,0(TA)
POPJ PP,
;WORD HAS BEEN SCANNED
ENDWRD: TLNE W1,GWLIT ;LITERAL?
JRST ENDLIT ;YES
TSWF FLETTR; ;NO--ALL DIGITS?
JRST ENDWR0 ;NO
CAIG CT,^D18 ;YES, BUT IS IT TOO BIG
JRST ENDLIT ;NO
SWON FLETTR ;YES, MAKE IT A USER-NAME
ENDWR0: PUSHJ PP,TRYNAM ;FIND WORD IN NAMTAB
JRST ENDWD2 ;NOT FOUND
MOVE TB,0(TA) ;GET FLAG WORD
LDB TD,NAMVAL ;GET RESERVED WORD VALUE OR CPYTAB POINTER
TLNN TB,NAMRSV/1000000; RESERVED WORD?
JRST ENDWD4 ;NO
DPB TD,GWVAL ;YES--SET VALUE IN W1
TLO W1,GWRESV ;SET "RESERVED" FLAG
ENDWD4: HRR W1,TB ;GET TABLE ADDRESS
HLRZ TB,TA ;SET NAMTAB POINTER
DPB TB,GWNAMP
ENDWD1: MOVE LN,WORDLN ;SET "LN"
DPB LN,GWLN
MOVE CP,WORDCP ;SET "CP"
DPB CP,GWCP
POPJ PP, ;RETURN
ENDWD2: TLO W1,GWNOT
JRST ENDWD1
;LITERAL HAS BEEN SCANNED
ENDLIT: TLO W1,GWLIT ;SET "LITERAL" FLAG
PUSH PP,CT
PUSH PP,CT+1 ;GET 2 ACCS
JUMPE CT,[SETZM LITVAL ;NUL LITERAL SO CLEAR VALUE
JRST ENDL1B]
IDIVI CT,5 ;GET NO. OF WORDS
JUMPE CT+1,ENDL1B ;NO REMAINDER
MOVE CT+1,[BYTE (7) 177
BYTE (7) 177,177
BYTE (7) 177,177,177
BYTE (7) 177,177,177,177]-1(CT+1)
ANDM CT+1,LITVAL(CT)
ENDL1B: POP PP,CT+1
POP PP,CT
TSWT FLETTR; ;NON-NUMERIC?
JRST ENDL2 ;NO
ENDL1: DPB CT,GWVAL ;SET SIZE
JRST ENDWD1
ENDL2: JUMPE LC,ENDL3 ;ANY SIZE?
TLO W1,GWNLIT ;YES--SET "NUMERIC" FLAG
CAIG LC,^D18 ;TOO BIG?
JRST ENDL1
MOVEI DW,E.56 ;YES--PUT OUT DIAG
PUSHJ PP,FATAL
MOVEI CT,^D18 ;REDUCE SIZE
JRST ENDL1
ENDL3: LDB CH,[POINT 7,LITVAL,6];NO SIZE--IS IT "+"?
CAIE CH,"+"
JRST SETMIN ;NO--MUST BE "-"
JRST SETPLS ;YES
;GET A CHARACTER FOR A WORD OR NUMERIC LITERAL.
;IF A SPACE IS SEEN, THE REMAINDER OF THE LINE IS SCANNED. IF NOTHING
; IS LEFT ON THE LINE, THE CONTINUATION COLUMN OF THE NEXT LINE
; IS CHECKED. IF HYPHEN, THAT LINE IS SCANNED UNTIL A NON-BLANK
; CHARACTER IS FOUND.
;IF THERE IS NO CONTINUATION, AND A SPACE IS FOUND, THE SPACE IS RETURNED.
;IF THERE IS A CONTINUATION, THE FIRST NON-SPACE ON THE LINE IS RETURNED.
GETKAR: PUSHJ PP,GETK9
CAIN TE,7 ;IS IT CONTINUATION COLUMN?
JRST GETK2 ;YES
CAIE CH," "
JRST GETK4A
MOVEM LN,SAVBLN ;SAVE LOCATION OF THE BLANK
MOVEM CP,SAVBCP
TSWF FRTST ;SEARCHING FOR REPLACEMENT MATCH?
PUSHJ PP,SVLKAR ;YES
SKIPGE RPLBH+0 ;SPECIAL IF READIND SRC FOR REPLACEMENT
JRST SVSKAR ;YES
GETK1: PUSHJ PP,GETK9 ;YES--GET NEXT CHARACTER
CAIN TE,7 ;IS IT CONTINUATION COLUMN?
JRST GETK2 ;YES
CAIN CH," " ;NO--IS IT SPACE?
JRST GETK1 ;YES--CONTINUE SCANNING
MOVEI CH," " ;RETURN A SPACE
REGLST: SWON FREGCH; ;NO--SET "REGET CHARACTER" FLAG
POPJ PP,
SVSKAR: MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R3BH1
MOVE CH,SRCBH+2
MOVEM CH,R3BH2
MOVE CH,SRCBFC
MOVEM CH,R3BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R3CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R3CPI ;INPUT CHAR. POS.
JRST GETK1 ;NOW GO ON
SVPKAR: MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R4BH1
MOVE CH,SRCBH+2
MOVEM CH,R4BH2
MOVE CH,SRCBFC
MOVEM CH,R4BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R4CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R4CPI ;INPUT CHAR. POS.
POPJ PP,
SVLKAR: MOVE CH,RPLBLK
MOVEM CH,L2BH0 ;SAVE CURRENT LIBRARY BLOCK #
MOVE CH,LIBBH+1
ADD CH,[070000,,0]
SKIPGE CH
SUB CH,[430000,,1]
MOVEM CH,L2BH1 ;BACKUP OVER THIS CHAR AND SAVE BYTE PTR.
MOVE CH,LIBBH+2
ADDI CH,1
MOVEM CH,L2BH2 ;CHAR. COUNT
MOVE CH,SAVECP
MOVEM CH,L2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,L2CPI ;INPUT CHAR. POS.
POPJ PP,
;GET A CHARACTER FOR WORD OR NUMERIC LITERAL (CONT'D).
;CONTINUATION COLUMN SEEN.
GETK2: CAIN CH," " ;IS CONTINUATION COLUMN A SPACE?
JRST GETK6 ;YES--RETURN
CAIE CH,"-" ;IS CONTINUATION COLUMN A HYPHEN?
JRST GETK5 ;NO--ERROR
GETK4: PUSHJ PP,GETK9 ;YES--SCAN THIS NEW LINE
CAIN TE,7 ;CONTINUATION COLUMN AGAIN?
JRST GETK2 ;YES
CAIN CH," " ;NO--STIL SPACE?
JRST GETK4 ;YES--LOOP
SETZM SAVBLN ;NO--CLEAR "SAVBLN"
GETK4A: SETZM NOCONT
POPJ PP, ;RETURN
GETK5: MOVEI DW,E.73 ;CONTINUATION NOT SPACE OR HYPHEN
PUSHJ PP,FATAL
MOVEI CH," "
GETK6: SETOM NOCONT
POPJ PP,
GETK9: PUSHJ PP,GETCH
MOVE TE,SRCCOL ;REMEMBER SOURCE COLUMN
TSWF FEOF;
POPJ PP,
CAIN CH,$TAB
MOVEI CH," "
CAIL CH,140
SUBI CH,40
POPJ PP,
;GET THE NEXT CHARACTER FROM THE SOURCE LINE, EVEN IF SPACE.
GETCH: MOVE CP,SAVECP ;RESET CHARACTER POSITION
TSWF FREGCH; ;RE-GET SAME CHARACTER?
JRST GETCH5 ;YES
AOS CH,INPTCP
TSWF FSEQ; ;SEQUENCED INPUT?
JRST GETCH3 ;YES
CAIGE CP,CPMAXN ;NO, TOO MANY CHARACTERS?
JRST GETCH5 ;NO
MOVE LN,SAVELN
MOVEI CP,7
MOVEI DW,E.82
TSWT FNOCPY ;NO ERROR IF NOT LISTING
PUSHJ PP,FATAL
MOVE CP,SAVECP
;END OF SOURCE LINE--TOO MANY CHARACTERS
GETCH1: PUSHJ PP,GETSRC ;GET NEXT ONE
CAIE CH,$LF ;END OF LINE?
CAIN CH,$FF
JRST FINLIN ;YES
JRST GETCH1 ;NO--LOOP
;SEQUENCED INPUT
GETCH3: CAIGE CH,^D73 ;NO--COLUMN 72 BEEN PASSED YET?
JRST GETCH5 ;NO
GETCH8: PUSHJ PP,GETSRC ;YES, IGNORE REST OF LINE
CAIE CH,$LF
CAIN CH,$FF
JRST FINLIN
JRST GETCH8
;STILL SOME SOURCE ON THIS LINE
GETCH5: PUSHJ PP,GETSRC ;GET NEXT CHARACTER
CAIE CH,$LF ;END OF LINE?
CAIN CH,$FF
JRST FINLIN ;YES
GETCH6: MOVE TE,INPTCP ;[354] SAVE SOURCE COLUMN
MOVEM TE,SRCCOL ; [354]
CAIN CH,$TAB ;IS IT A TAB?
JRST GTCH10 ;YES
;CHARACTER OK--LEAVE
GETCH9: MOVE LN,SAVELN ;GET CURRENT LINE
POPJ PP, ;LEAVE
;INPUT CHARACTER WAS TAB--BUMP INPTCP
GTCH10: MOVE CH,INPTCP
ADDI CH,4
ANDCMI CH,7
ADDI CH,3
MOVEM CH,INPTCP
MOVEI CH,$TAB
JRST GETCH9
;END OF SOURCE LINE--PRINTER CONTROL HAS BEEN SEEN
FINLIN: TSWT FNOCPY ;IGNORE EOL IF NOT COPYING TO CPYFIL
MOVEM CH,EOLKAR
PUSHJ PP,PUTCIF
TSWT FRLIB ;READING LIBRARY?
TSWT FEOF ;NO--END OF INPUT?
JRST GETSEQ ;NO--START NEW LINE
;END OF SOURCE
MOVEI CH," " ;RETURN A SPACE
MOVEI CP,7 ; FOR COLUMN 7
AOS SAVELN ;KICK UP LINE COUNT
JRST GETCH9 ;LEAVE
;PARAGRAPH HAS BEEN DELETED AND FIRST CHARACTER OF NEXT PARAGRAPH NAME SEEN.
;PUT OUT THAT FIRST CHARACTER.
FINSKP: SWOFF FNOCPY;
MOVEI CH,$LF
PUSHJ PP,PUTCPY
TSWF FEOF;
POPJ PP,
FINSK3: MOVEI CH,1(CP)
CAML CH,INPTCP
JRST FINSK4
MOVEI CH," "
PUSHJ PP,PUTCPY
JRST FINSK3
FINSK4: SWON FREGCH; ;TURN ON "REGET CHARACTER"
IFN DBMS,<
SKIPN FINVOK
JRST .+3
LDB CH,DBBUFH+1
SKIPA
>
LDB CH,SRCBH+1 ;PUT OUT LAST CHARACTER
JRST PUTCPY ; AND RETURN
;GET THE VERY FIRST CHARACTER FROM THE SOURCE FILE
GETFCH: SETZM SAVELN ;SET LINE COUNT TO ZERO
SETOM NOCONT
MOVEI CH,$FF
PUSHJ PP,PUTFEL
SETZM EOLKAR
SETZM SEQIN
;START A NEW SOURCE LINE
GETSEQ: SETZM SAVECP ;STARTING AT COLUMN 1
TSWF FSEQ ;SEQUENCED INPUT?
JRST GETSQ7 ;YES
PUSHJ PP,GETSRC ;GET A CHARACTER
CAIN CH,$LF ;[526] END OF
JRST GETSQ4 ;YES
CAIN CH,$FF ;[526] FORM FEED ON FIRST CHAR SPECIAL
JRST GTSQ6B ;[526] IGNORE SO CONTINUATION WORKS
IFN DBMS,<
SKIPE FINVOK
SKIPA TD,@DBBUFH+1
>
MOVE TD,@SRCBH+1 ;NO--IS IT
TSWF FRLIB ;READING FROM LIBRARY?
MOVE TD,@LIBBH+1 ;YES
TRNN TD,1 ; A SEQUENCE NUMBER?
JRST GETSQ9 ;NO
CAMN TD,[<ASCII/ />+1] ;[526] IS THIS AN EDITS PAGE MARK
JRST GETSQ6 ;[526] YES HANDLE SEPARATELY
MOVEI TD,6 ;[526] NO REGULAR SEQUENCE NUMBER
JRST GETSQ8
GETSQ2: CAIE CH,"-" ;CONTINUATION?
JRST GETSQ3 ;NO
IFN ANS74,<
SKIPE NOIDHY ;ARE THEY ALLOWED HERE
JRST [MOVEI DW,E.700 ;NOT IN ID, GIVE ERROR
PUSHJ PP,FATAL
MOVEI CH,"-" ;PUT HYPHEN BACK
JRST GETSQ5] ;AND CONTINUE
>
SKIPN NOCONT ;YES--ARE THEY LEGAL?
JRST GETSQ5 ;YES
MOVE LN,SAVELN ;NO--
MOVEI DW,E.279 ; PUT OUT
PUSHJ PP,FATAL ; DIAG
MOVEI CH," " ;REPLACE WITH SPACE
GETSQ3: CAIE CH," " ;SPACE OR
CAIN CH,$TAB ; TAB?
JRST GETSQ5 ;YES
CAIN CH,"*" ;NO--COMMENT?
JRST GTSQ10 ;YES
IFN ANS74,<
CAIN CH,"/" ;SLASH
JRST GTSQ13 ;YES
TSWF FSEQ ;SEQUENCED INPUT?
JRST GTSQ3A ;YES
CAIE CH,"\" ;LOOK FOR \D
JRST GETSQ4 ;NOT
PUSHJ PP,GETSRC ;GET NEXT CHARACTER
GTSQ3A: CAIE CH,"D" ;DEBUG
CAIN CH,"d"
JRST GTSQ14 ;YES
>
GETSQ4:
MOVE CH,RPLFLG ;GET DEFERED FLAGS ALSO
TSWT FEOF!FECOPY ;END OF FILE OR END OF COPY?
TLNE CH,(FECOPY) ;REALLY FINISHED WITH LIBRARY ITSELF?
CAIA ;YES, DON'T REGET LAST CHAR.
SWON FREGCH ;NO--REGET LATER
GTSQ4A: MOVEI CH," " ;REPLACE WITH SPACE
GETSQ5: MOVEI CP,7 ;RESET CP AND
MOVEM CP,INPTCP ; INPUT COLUMN NUMBER
TSWTZ FNCOFF ;WAS FNOCPY TURNED OFF AT FINLIN?
JRST GETCH6 ;NO
SWON FNOCPY ;YES, TURN IT BACK ON NOW
SWON FNEEDS ;ALSO REQUEST A DUMMY PERIOD
JRST GETCH6 ;LEAVE
; [526]COME HERE TO HANDLE EDITS PAGE MARKS
GETSQ6: MOVEI TD,7 ;[526] 5 BLANKS CR FF (GETSRC GOBBLES NULS)
GTSQ6A: PUSHJ PP,GETSRC ;[526] GET THE NEXT CHARACTER
CAIE CH,$FF ;[526] DID WE GET THE FORM FEED YET?
SOJG TD,GTSQ6A ;[526] NO LOOP BACK FOR MORE
GTSQ6B: PUSHJ PP,PUTCPY ;[526] PUT OUT THE FORM FEED
JRST GETSEQ ;[526] GO BACK FOR NEXT LINE
;START A NEW SOURCE LINE (CONT'D)
;SEQUENCED INPUT -- COPY COLUMNS 1-6, GET COLUMN 7
GETSQ7: MOVEI TD,7
GETSQ8: SETOM SEQIN
GTSQ8A: PUSHJ PP,GETSRC
CAIE CH,$LF
CAIN CH,$FF
JRST GETSQ4
SOJG TD,GTSQ8A
JRST GETSQ2
;PUT OUT 6 SPACES IN PLACE OF SEQUENCE NUMBER
GETSQ9: TSWF FNOCPY ;IGNORE IF NOT OUTPUTING TO CPYFIL
JRST GETSQ2
MOVE TE,CH ;SAVE CH
MOVEI CH," " ;REPLACE THAT SOURCE CHARACTER
DPB CH,CPYBHO+1 ; WITH SPACE
MOVEI TD,5
PUSHJ PP,PUTCPY
SOJG TD,.-1
MOVE CH,TE ;RESTORE CH
PUSHJ PP,PUTCPY
JRST GETSQ2
IFN ANS74,<
;"/" IN COLUMN 7
GTSQ13: MOVEI CH,$FF ;REPLACE LF BY FF
DPB CH,$LFPTR ;IN BUFFER
MOVEI CH,"/" ;PUT SLASH BACK
JRST GTSQ10 ;AND MAKE A COMMENT
;HERE WITH D IN COLUMN 7
GTSQ14: SKIPN DEBSW ;DEBUG ON?
TSWF FRTST ;NO, BUT ARE WE JUST DOING REPLACEMENT CHECK?
JRST GTSQ4A ;YES, COMPILE THIS LINE
;NO, JUST MAKE A COMMENT
>
;"*" IN COLUMN 7
GTSQ10: SETOM NOCONT
GTSQ11: PUSHJ PP,GETSRC
CAIE CH,$LF
CAIN CH,$FF
JRST GETSQ4
JRST GTSQ11
;GET A CHARACTER FROM THE SOURCE FILE BUFFER
GETSRC: TSWF FECOPY;
JRST GTBLNK
TSWF FRLIB ;DO WE READ LIBFIL?
JRST GETLIB
TSWF FEOF; ;END OF FILE?
JRST GTBLNK ;YES
SKIPN SRCDEV ;[352] ANY MORE IN SOURCE FILES?
JRST GTSR3A ;[352] NO MORE SOURCE ANYWHERE
IFN DBMS,<
SKIPE FINVOK ;ARE WE IN INVOKE?
JRST IN.GET
>
TSWFZ FREGCH; ;REGET PREVIOUS CHARACTER?
JRST REGETS ;YES
SOSG SRCBH+2
JRST GETSR3
GETSR0: ILDB CH,SRCBH+1
GETSL: CAIGE CH,40 ;CONTROL CHARACTER?
JRST GETSR2 ;YES
CAIL CH,140 ;NO--SIXBIT CHARACTER?
JRST GETSR1
JRST PUTCIF
;REGET PREVIOUS CHARACTER
REGETS: LDB CH,SRCBH+1
POPJ PP,
;RETURN A LINE-FEED
GTBLNK: MOVEI CH,$LF
POPJ PP,
;SPECIAL CHARACTER PROCESSING
;CHARACTERS ABOVE CODE 137
GETSR1: CAIG CH,172 ;LOWER CASE?
CAIGE CH,141
JRST GTSR1B ;NO
JRST PUTCIF
GTSR1B: PUSH PP,CH ;SAVE CHARACTER
MOVEI CH," " ;PUT SPACE IN CPYFIL
GTSR1D: PUSHJ PP,PUTCIF
POP PP,CH ;RESTORE CHARACTER
POPJ PP, ;RETURN
IFN DBMS,<
IN.GET: TSWFZ FREGCH ;REGET CHARACTER?
JRST DB.GET ;YES
SOSGE DBBUFH+2 ;MORE CHARACTERS?
JRST IN.INP ;NO, GET ANOTHER BUFFER
IN.GT2: ILDB CH,DBBUFH+1 ;GET CHARACTER
JRST GETSL ;RETURN AS NORMAL
IN.INP: IN DBCHAN,
JRST IN.GT2 ;INPUT OK
GETSTS DBCHAN,CH ;INPUT ERROR
TRNN CH,$ERAS ;ERORS?
JRST IN.EOF ;NO, END-OF-FILE
MOVEI CH,DBDEV ;YES, SET UP FOR ABORT
MOVSI TA,'DSK'
MOVEM TA,DBDEV
JRST DEVDED
IN.EOF: SETZM FINVOK ;CLEAR INVOKE FLAG
SETZM DBBLCK ;[316]
RENAME DBCHAN,DBBLCK ;[316]
CLOSE DBCHAN, ;NOT REALLY NECESSARY
RELEASE DBCHAN,
MOVEI CH,$LF ;RETURN LINE-FEED
SKIPE DBONLY ;[453] WAS /S ON BEFORE?
TLO SW,20 ;[453] YES--TURN IT BACK ON
SETZM DBONLY ;[453] AND TURN THIS OFF
POPJ PP, ;RETURN LIKE NOTHING HAPPENED!!
DB.GET: LDB CH,DBBUFH+1
POPJ PP,
>
;SPECIAL CHARACTER PROCESSING (CONT'D)
;CHARACTERS BELOW CODE 040
GETSR2: JUMPE CH,GETSRC ;IGNORE NULLS
CAIE CH,$CR ; AND CARRIAGE-RETURNS
CAIN CH,$CZ ; AND END-FILES
JRST GETSRC
CAIE CH,$TAB ;TAB?
JRST GTSR2B ;NO
MOVEI CH," " ;YES--REPLACE WITH SPACE
PUSHJ PP,GTSR2D
MOVEI CH,$TAB
JRST PUTCIF
GTSR2B: CAIE CH,$LF ;LINE-FEED?
CAIN CH,$FF ;NO--FORM-FEED?
POPJ PP, ;YES--RETURN
CAIG CH,24 ;NO--OTHER PRINTER CONTROL?
CAIGE CH,20
CAIN CH,$VT
JRST GTSR2C
PUSH PP,CH ;YES
MOVEI CH,"^"
PUSHJ PP,PUTCIF
MOVE CH,(PP)
ADDI CH,100
JRST GTSR1D
GTSR2C: MOVEI CH,$LF ;YES--FORCE LINE-FEED
GTSR2D: TSWF FRLIB;
POPJ PP, ;[557] IF FROM LIBRARY DON'T DO ANYTHING SPECIAL
IFN DBMS,<
SKIPN FINVOK
JRST GTSR2F
DPB CH,DBBUFH+1
POPJ PP,
GTSR2F:>
DPB CH,SRCBH+1 ;RESTORE FOR POSSIBLE REGET
POPJ PP, ;RETURN
;NEW BUFFER REQUIRED
GETSR3: SKIPL RPLBH+0 ;NEED TO SAVE CURRENT BUFFER?
JRST GTSR3X ;NO
PUSH PP,TA
PUSH PP,TB ;SAVE ACCS
PUSH PP,TC
PUSH PP,TD ;DEFINITELY NEEDS TO BE SAVED
PUSH PP,TE
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
MOVE TB,RPLBH+2 ;GET CHAR. COUNT
ADDM TB,(TA) ;ADD TO WHATS ALREADY THERE
HRRZ TA,SRCBH+1
HRRZ TB,RPLBH+1
SUBI TA,-1(TB) ;GET SIZE IN WORDS
PUSH PP,TA
HRLI TA,CD.CPY
PUSHJ PP,GETENT
HRL TA,RPLBH+1 ;FORM BLT PTR
POP PP,TB
ADDI TB,(TA) ;END OF BLT
BLT TA,-1(TB) ;COPY ALL WE NEED
POP PP,TE
POP PP,TD
POP PP,TC
POP PP,TB
POP PP,TA
GTSR3X: SKIPN SRCDEV ;[352] ANY MORE SOURCE FILE CHARS??
JRST GTSR3A ;[352] NO CLOSE EVERYTHING OUT, WE ARE DONE.
AOS SRCBFC ;INCREMENT BUFFER COUNT
IN SRC, ;FILL BUFFER
JRST [SKIPL RPLBH+0
JRST GETSR0
MOVE CH,SRCBH+1
ADD CH,[440000,,1] ;ADVANCE TO NEXT WORD
MOVEM CH,RPLBH+1
MOVE CH,SRCBH+2
MOVEM CH,RPLBH+2
JRST GETSR0]
GETSTS SRC,CH ;ERROR--SEE IF END-FILE
TRNE CH,$ERAS
JRST GETSR4 ;NO
RELEASE SRC, ;RELEASE THIS DEVICE
PUSHJ PP,STINFL ;SET UP NEXT SOURCE FILE
SKIPE SRCDEV ;WAS THERE ANY?
JRST GETSR3 ;YES
;NO MORE SOURCE
SKIPE LIBDEV ;[352] ANY LIBRARY DEVICE?
JRST [SWOFF FCOPY ;[352] YES TURN OFF COPY
JRST GTSR3B] ;[352] RETURN LF TO KEEP LIB DEVICE OPEN.
GTSR3A: SWON FEOF; ;SET "END-FILE" SWITCH
RELEASE LIB,
SKIPE CREFSW
CLOSE CRF,
GTSR3B: ;[352]
MOVEI CH,7
MOVEM CH,SRCCOL
JRST GTBLNK ;RETURN $LF
;ERROR ON SOURCE DEVICE
GETSR4: MOVEI CH,SRCDEV
JRST DEVDED
;SYNTAX SCANNER HAS DETECTED AN ERROR AND IS SKIPPING PAST DATA.
;GET NEXT SOURCE CHARACTER.
SKPSRC: TSWFZ FGTPER;
JRST SKPSR6
TSWFZ FGTMIN;
JRST SKPSR8
TSWF FCOPY ;ARE WE COPYING?
JRST SKPSR3 ;YES
TSWF FECOPY ;HAS COPY JUST FINISHED?
JRST SKPSR5 ;YES, CLEAN UP
PUSHJ PP,GETCH ;NO--GET A CHARACTER
SKPSR1: CAIN CH,$TAB ;CHANGE TAB TO SPACE
MOVEI CH," "
CAIN CH," "
SWOFF FNEEDS;
SKPSR2: TSWF FNOCPY;
MOVE CP,SRCCOL
POPJ PP,
SKPSR3: MOVE CH,INPTCP
TSWF FREGCH;
SUBI CH,1
CAMLE CH,SAVECP
JRST SKPSR9
TSWFZ FECOPY ;SHOULD WE CLEAN UP LIBRARY?
JRST SKPSR5 ;YES
SKIPE CH,EOLKAR ;NO--ANY LINE TO TERMINATE?
PUSHJ PP,PUTCPY ;YES--DO SO
PUSHJ PP,GETCH ;GET A CHARACTER
TSWFZ FECOPY ;DONE WITH LIBRARY NOW?
JRST SKPSR5 ;YES
SKIPN EOLKAR
JRST SKPSR4
PUSH PP,CH
MOVE CH,EOLKAR
PUSHJ PP,PUTCPY
POP PP,CH
SKPSR4: PUSHJ PP,PUTCPY
JRST SKPSR1
SKPSR5: PUSHJ PP,ENDCPY
JRST SKPSRC
SKPSR6: MOVEI CH,"."
JRST SKPSR2
SKPSR8: MOVEI CH,"-"
TSWF FCOPY;
PUSHJ PP,PUTCPY
JRST SKPSR2
SKPSR9: MOVEI CH," "
PUSHJ PP,PUTCPY
JRST SKPSR3
SUBTTL COPY VERB
COMMENT \
THE NEW FORMAT OF THE CPYTAB IS AS FOLLOWS:
0 ;ALWAYS 0
NEXT REPLACEMENT ,, LENGTH OF THIS REPLACEMENT
TYPE (LHS W1) ,, FLAG + SIZE IN WORDS
TEXT SIXBIT FOR NAMES, ASCII FOR LITERALS
...
BYTE POINTER (LHS) ,, CHARACTER COUNT
BYTE (9) SAVECP(BEFORE), INPTCP(BEFORE), SAVECP(AFTER), INPTCP(AFTER)
REPLACEMENT TEXT IN ASCII
...
NEXT BLOCK
\
CONTF==1B18 ;REPLACEMENT TEST IS CONTINUED
;EITHER QUALIFIED OR PSEUDO-TEXT
CPYLIB: SWOFF FRTST ;MAKE SURE ITS OFF
SETZM CURCPY ;RESET CPYTAB POINTERS
SETZM RPLCNT ;CLEAR READ COUNT
SETZM RPLLOC ;CLEAR POINTER TO PSEUDO-TEST
SETZM RPLNXT ;AND CURRENT POINTER
MOVE TA,CPYLOC
MOVEM TA,CPYNXT
MOVEM W2,CPYW2 ;SAVE POSITION OF 'COPY' IN SOURCE
PUSHJ PP,GETITM ;GET LIBRARY-NAME
TLNE W1,GWLIT ;LITERAL?
JRST CPE285 ;YES, ERROR
MOVE TA,NAMWRD ;STORE 1ST 6 CHARS OF NAME
MOVEM TA,LIBNAM
HLRZ TA,NAMWRD+1 ;STORE 7TH & 8TH CHARS
ANDI TA,777700
HRLZM TA,LIBNAM+1
CPLB0: PUSHJ PP,GETITM ;GET NEXT ITEM OF SOURCE
CAIN TYPE,PRIOD. ;PERIOD?
JRST CPLB99 ;ENDED WITH PERIOD --- SET UP COPY & GO TO IT
CAIE TYPE,IN. ;NO, IS IT IN OR OF?
JRST CPLB1 ;NO
PUSHJ PP,GETITM ;GET LIBRARY FILE NAME
TLNN W1,GWLIT ;LITERAL?
JRST CPLB55 ;NO
LDB TA,GWVAL ;GET LITERAL SIZE
MOVE TB,[POINT 7,LITVAL]
MOVE TC,[POINT 6,NAMWRD]
CPLB56: ILDB TD,TB
TRZN TD,40 ;LOWER CASE?
SUBI TD,40 ;NO
IDPB TD,TC
SOJG TA,CPLB56 ;PUT LITERAL IN NAMWRD
CPLB55: MOVE TA,NAMWRD ;GET FILE NAME
HLLZ TB,NAMWRD+1 ;AND EXTENSION
SKIPN TB
MOVSI TB,'LIB' ;IF NULL USE DEFAULT
CAME TA,LIBHDR ;NAME MATCH WHAT WE CURRENTLY HAVE?
JRST CPLB57 ;NO
CAMN TB,LIBHDR+1 ;AND EXTENSION
JRST CPLB0 ;YES, GET NEXT ITEM
HLRZ TC,LIBHDR+1
CAMN TB,[SIXBIT /LIB/]
JUMPE TC,CPLB0 ;'LIB' CAN MATCH NULL
CPLB57: MOVEM TA,LIBHDR ;STORE NEW FILE NAME
MOVEM TB,LIBHDR+1 ;AND EXTENSION
MOVEI TC,IOSRCS ;GET START OF LIST
CPLB66: CAMN TA,DEVFIL(TC) ;SEE IF FILE NAME MATCH
CAME TB,DEVEXT(TC) ;AND EXTENSION
JRST CPLB77 ;NO
MOVE TD,DEVSW(TC) ;GET SWITCHES
SOJN TD,CPLB77 ;JUMP IF NOT LIBRARY
MOVE TC,DEVDEV(TC) ;GET DEVICE
MOVEM TC,LIBDEV ;SET IT UP
JRST CPLB88 ;NO OPEN IT
CPLB77: ADDI TC,DEVSIZ ;INCREMENT TO NEXT
CAIGE TC,SRCEND ;ALL DONE?
JRST CPLB66 ;NOT YET
MOVSI TC,'DSK' ;YES, ASSUME DSK
MOVEM TC,LIBDEV ;SET IT UP
CPLB88: CLOSE LIB, ;INCASE ITS OPEN
MOVSI TA,(1B0) ;VIRGIN RING BIT
IORM TA,LIBBH ;WHAT WE WANT IT TO BE
PUSH PP,LIBBH ;SAVE BUFFER HEADER
MOVEI TA,700
HRLZM TA,LIBBH+1 ;SETUP NO POINTER
PUSH PP,DA
PUSH PP,DC
PUSH PP,I0
PUSH PP,I1
PUSH PP,I2
PUSH PP,I3
PUSH PP,I4
MOVEI DA,LIBDEV
SETZ I1,
MOVEI I3,DEVBH(DA)
MOVEI DC,LIB
CLOSE LIB,0
PUSHJ PP,OPENIT
SETZ I4,
LOOKUP LIB,I1
SETZM LIBDEV ;FAILED
POP PP,I4
POP PP,I3
POP PP,I2
POP PP,I1
POP PP,I0
POP PP,DC
POP PP,DA
POP PP,LIBBH
JRST CPLB0 ;SEE WHATS NEXT
CPLB1: CAIE TYPE,REPLA. ;IS IT 'REPLACING'?
JRST CPE286 ;NO, ERROR
CPLB2: AOS RPLCNT ;COUNT ONE MORE
MOVE TA,[CD.CPY,,1] ;GET 1 WORD FOR HEADER
PUSHJ PP,GETENT
SKIPN TB,RPLLOC ;FIRST TIME
JRST .+3
ADD TB,CPYLOC ;GET ADDRESS
HLRM TA,(TB) ;LINK IN
HLRZM TA,RPLLOC ;ADVANCE POINTER
PUSHJ PP,GETITM ;GET ITEM AFTER 'REPLACING'
TLNE W1,GWRESV ;RESERVED WORD?
CAIE TYPE,EQUAL. ;YES, =
JRST CPLB21 ;NO
CAIE CH,"=" ;LOOK AHEAD AND CHECK NEXT DELIMITER FOR ==
JRST CPLB21 ;ITS NOT
PUSHJ PP,GETITM ;GET RID OF ==
CAIN TYPE,EQUAL.
JRST CPLB20
EWARNW E.605 ;[557] '==' PSEUDO-TEXT DELIMITERS INCORRECT
JRST CPYERR ;[557]
CPLB19: PUSHJ PP,PSTWRI ;WRITE ITEM
CPLB20: CAIN TYPE,PIC. ;PICTURE IS SPECIAL
PUSHJ PP,PSTPIC
PUSHJ PP,GETITM ;GET NEXT ITEM
TLNE W1,GWRESV ;RESERVED
CAIE TYPE,EQUAL. ;=
JRST CPLB19 ;NO
CAIE CH,"=" ;==
JRST CPLB19 ;NO
PUSHJ PP,GETITM ;YES, GET IT
HRRZ TA,CPYLOC
ADD TA,RPLNXW ;GET START OF LAST BLOCK
MOVEI TB,CONTF
ANDCAM TB,(TA) ;LAST ONE IS NOT CONTINUED
PUSHJ PP,GETITM ;GET NEXT ITEM
CAIN TYPE,BY. ;BETTER BE BY
JRST CPLB27 ;DONE
CPE124: EWARNW E.124 ;''BY' EXPECTED'
JRST CPYERR ;SKIP TO NEXT PARAGRAPH
;HERE IF NOT PSEUDO-TEXT
CPLB21: TLNE W1,GWLIT ;LITERAL
JRST CPLB22 ;YES
MOVSI TA,-5 ;MAX. WORD SIZE
SKIPE NAMWRD(TA) ;COUNT NO. OF WORDS
AOBJN TA,.-1 ; WITH THIS LOOP
AOJA TA,CPLB23 ;SIZE + 1 FOR COUNT
CPLB22: LDB TB,GWVAL ;GET LIT COUNT
ADDI TB,4
IDIVI TB,5
MOVEI TA,1(TB) ;GET SIZE + 1 FOR COUNT
CPLB23: HRRI W1,-1(TA) ;SIZE
HRLI TA,CD.CPY
PUSHJ PP,GETENT ;GET SPACE
MOVEM W1,0(TA) ;STORE FLAG ,, SIZE
HLRZM TA,RPLNXW ;INCASE WE NEED TO QUALIFY IT
HRLI TB,NAMWRD
TLNE W1,GWLIT
HRLI TB,LITVAL ;EITHER NAME OR LIT
HRRI TB,1(TA) ;BLT PTR
ADDI TA,(W1)
BLT TB,(TA) ;COPY IT
PUSHJ PP,GETITM ;WHAT'S NEXT
CAIN TYPE,BY. ;THE WORD 'BY'?
JRST CPLB27 ;YES
CAIE TYPE,IN. ;IN OR OF?
JRST CPE124 ;NOT THERE, TOO BAD
MOVE TA,RPLNXW ;GET LAST SUB-ITEM
ADD TA,CPYLOC
MOVEI TB,CONTF ;FLAG
IORM TB,(TA) ;MARK IT
PUSHJ PP,GETITM ;GET QUALIFYING NAME
JRST CPLB21 ;TRY AGAIN
CPLB27: MOVE TA,[CD.CPY,,2]
PUSHJ PP,GETENT ;GET SPACE FOR BYTE POINTER
HLRZM TA,RPLNXT ;SAVE INDEX
IFE TOPS20,<
MOVE CH,SRCBH+1 ;GET SOURCE BYTE POINTER
ADD CH,[070000,,0] ;BACKUP BYTE POINTER
SKIPGE CH ;OK, IN SAME WORD
SUB CH,[430000,,1] ;BACKUP TO NEXT WORD
>
IFN TOPS20,<
SETO CH,
ADJBP CH,SRCBH+1 ;BACKUP 1 BYTE
>
HLLZM CH,(TA) ;INITIAL PTR,,COUNT
MOVEM CH,RPLBH+1 ;SAVE IT
MOVE CH,SRCBH+2
ADDI CH,1 ;BACKUP COUNT ALSO
MOVEM CH,RPLBH+2 ;SAVE IT
MOVE CH,SAVECP
SUBI CH,1 ;POINT TO THIS NOT NEXT
MOVEM CH,R1CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
SUBI CH,1 ;POINT TO THIS NOT NEXT
MOVEM CH,R1CPI ;INPUT CHAR. POS.
SETOM RPLBH+0 ;SET FLAG FOR GETSR3
PUSHJ PP,GETITM ;NEXT ITEM
TLNE W1,GWRESV
CAIE TYPE,EQUAL. ;LOOK FOR =
JRST CPLB40 ;NO
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT
JRST CPLB40 ;NO, NEEDS ==
MOVE CH,SAVECP
MOVEM CH,R1CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R1CPI ;INPUT CHAR. POS.
PUSHJ PP,GETITM ;GET RID OF ==
PUSHJ PP,GETITM ;GET NEXT
TLNE W1,GWRESV
CAIE TYPE,EQUAL. ;LOOK FOR =
JRST CPLB34 ;NO
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT END
JRST CPLB34 ;NO, NEEDS ==
;NOW WE HAVE NULL REPLACEMENT
MOVE CH,R1CPO ;MAKE BEFORE
MOVEM CH,R2CPO ;= AFTER
MOVE CH,R1CPI
MOVEM CH,R2CPI
MOVE CH,RPLBH+2 ;GET PREV. COUNT
PUSH PP,SRCBH+2 ;SAVE CURRENT
MOVEM CH,SRCBH+2 ;SO WE CAN SAVE NO WORDS
PUSHJ PP,CPYSRC ;JUST SETUP HEADERS
POP PP,SRCBH+2 ;GET CHAR COUNT BACK
PUSHJ PP,GETITM ;BYPASS ==
PUSHJ PP,GETITM ;GET WHAT FOLLOWS
JRST CPLB45 ;AND CONTINUE
CPLB33: PUSHJ PP,GETITM ;GET NEXT
CPLB34: TLNN W1,GWRESV ;[***] IS IT A RESERVED WORD?
JRST CPLB33 ;[***] NO, SO IT CANNOT BE ==
CAIE TYPE,EQUAL. ;LOOK FOR =
CAIN TYPE,EQUAL.+AMRGN. ;[***] POSSIBLY IN A-MARGIN
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT END
JRST CPLB33 ;NO, NEEDS ==
MOVE CH,SAVECP
MOVEM CH,R2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R2CPI ;INPUT CHAR. POS.
MOVEI TB,2
ADDM TB,SRCBH+2 ;DON'T COUNT ==
PUSHJ PP,CPYSRC ;COPY UP TO ==
MOVNI TB,2
ADDM TB,SRCBH+2
MOVE TA,RPLNXT ;ALSO REMOVE FIRST ==
ADD TA,CPYLOC
HLLZ TB,(TA)
HRRI TB,2(TA) ;FORM BYTE PTR
SETZ TC,
IDPB TC,TB ;REPLACE = BY NULL
IDPB TC,TB
PUSHJ PP,GETITM ;BYPASS ==
PUSHJ PP,GETITM ;GET WHAT FOLLOWS ==
JRST CPLB45
CPLB37: AOSA PARCNT ;COUNT ONE MORE "("
CPLB38: SOS PARCNT ;COUNT ONE LESS ")"
JRST CPLB40
CPLB39: PUSHJ PP,GETITM ;GET NEXT ITEM
CPLB40: SKIPE R3BH0 ;DID WE GET TO GETKAR?
JRST CPLB46 ;YES, JUST USE UP TO FIRST SPACE
MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R2BH1
MOVE CH,SRCBH+2
MOVEM CH,R2BH2
MOVE CH,SRCBFC
MOVEM CH,R2BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R2CPI ;INPUT CHAR. POS.
CPLB41: PUSHJ PP,GETITM ;GET NEXT ITEM
CAIN TYPE,LPREN. ;SUBSCRIPTED?
JRST CPLB37 ;YES
CAIN TYPE,RPREN. ;")"
JRST CPLB38 ;YES, COUNT DOWN
SKIPE PARCNT ;IN SIDE PARENS?
JRST CPLB40 ;YES
CAIN TYPE,IN. ;QUALIFIED?
JRST CPLB39 ;GET QUALIFIER
MOVE TB,SRCBFC
CAME TB,R2BH0 ;DID SRC CHANGE BUFFERS?
JRST CPLB50 ;YES, ITS ALREADY STORED
PUSH PP,SRCBH+1 ;SAVE CURRENT BYTE PTR AND COUNT
PUSH PP,SRCBH+2
MOVE TB,R2BH1
MOVEM TB,SRCBH+1 ;REPLACE WITH ONE JUST AFTER ITEM
MOVE TB,R2BH2
MOVEM TB,SRCBH+2 ;SO WE DON'T COPY SPACES, COMMENTS ETC.
AOS SRCBH+2 ;REMOVE SPACE OR TERMINATOR
PUSHJ PP,CPYSRC ;COPY SOURCE
POP PP,SRCBH+2
POP PP,SRCBH+1
CPLB45: CAIE TYPE,PRIOD. ;[***] PERIOD?
CAIN TYPE,PRIOD.+AMRGN. ;[***] POSSIBLY IN A-MARGIN
JRST CPLB99 ;YES
SWON FREGWD ;REGET WORD AGAIN
JRST CPLB2 ;MUST BE ANOTHER REPLACING CLAUSE
CPLB46: MOVE CH,[R3BH0,,R2BH0] ;JUST USE UP TO FIRST SPACE
TSWF FGTPER ;DID WE ALSO SEE A PERIOD
HRLI CH,R4BH0 ;YES, BACKUP TO IT
BLT CH,R2CPI
JRST CPLB41
CPLB50: SETZM RPLBH+0 ;CLEAR COPY BUFFER FLAG
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
HRRZ TB,0(TA) ;GET WHAT IT WAS
SUB TB,R2BH2 ;MINUS ORIGIN
SUBI TB,1 ;MINUS TERMINATOR
HRRM TB,0(TA) ;PUT BACK AS ALL WE NEED
MOVE TB,R1CPO ;SAVECP BEFORE
LSH TB,9
ADD TB,R1CPI ;INPTCP BEFORE
LSH TB,9
ADD TB,R2CPO ;SAVECP AFTER
LSH TB,9
ADD TB,R2CPI ;INPTCP AFTER
MOVEM TB,1(TA) ;SAVE POSITION COUNTS
JRST CPLB45
CPLB99: PUSHJ PP,SETLIB ;DONE, SET UP COPY & AND GET STARTED
MOVN TB,RPLCNT ;NO. OF POSSIBLE REPLACEMENTS
HRLZM TB,RPLCNT ;FORM AOBJN PTR
JUMPE TB,GETITM ;NO REPLACEMENTS POSSIBLE
SWON FRTST!FNOCPY ;SIGNAL TO MAKE REPLACEMENT CHECK
;AND DON'T LIST UNTIL CHECKED
MOVEI TB,1
MOVEM TB,RPLLOC ;POINT TO START
MOVEM TB,RPLNXT
ADDI TB,1 ;POINT TO FIRST WORD
MOVEM TB,RPLNXW
JRST GETITM ;GET FIRST ITEM FROM COPY AND RETURN
CPYSRC: SETZM RPLBH+0 ;CLEAR COPY BUFFER FLAG
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
MOVE TB,RPLBH+2 ;GET CHAR. COUNT
SUB TB,SRCBH+2
ADDM TB,(TA) ;ADD TO WHATS ALREADY THERE
MOVE TB,R1CPO ;SAVECP BEFORE
LSH TB,9
ADD TB,R1CPI ;INPTCP BEFORE
LSH TB,9
ADD TB,R2CPO ;SAVECP AFTER
LSH TB,9
ADD TB,R2CPI ;INPTCP AFTER
MOVEM TB,1(TA) ;SAVE POSITION COUNTS
HRRZ TA,0(TA) ;GET CHAR. COUNT
JUMPE TA,CPOPJ ;RETURN IF 0
HRRZ TA,SRCBH+1
HRRZ TB,RPLBH+1
SUBI TA,-1(TB) ;GET SIZE IN WORDS
PUSH PP,TA
HRLI TA,CD.CPY
PUSHJ PP,GETENT
MOVE TC,TA
HRL TC,RPLBH+1 ;FORM BLT PTR
POP PP,TB
ADDI TB,(TA) ;END OF BLT
BLT TC,-1(TB) ;COPY ALL WE NEED
MOVE TB,SRCBH+1
MOVEM TB,RPLBH+1
MOVE TB,SRCBH+2
MOVEM TB,RPLBH+2
POPJ PP,
PSTWRI: TLNE W1,GWLIT ;LITERAL?
JRST PSTWRL ;YES
MOVSI TB,-5 ;MAX. SIZE
SKIPE NAMWRD(TB) ;GET PART OF NAME
AOBJN TB,.-1 ;LOOP FOR REST OF NAME
AOJA TB,PSTWRW ;COUNT 1 FOR HEADER
PSTWRL: LDB TB,GWVAL ;GET LENGTH OF LIT
ADDI TB,4+5 ;ROUND UP
IDIVI TB,5 ;NO. OF WORDS
PSTWRW: HRRZ TA,TB
MOVE TB,W1
HRRI TB,CONTF-1(TA) ;SAVE WORD COUNT MINUS HEADER + FLAG
PUSH PP,TB
HRLI TA,CD.CPY
PUSHJ PP,GETENT ;GET SPACE FOR LITERAL OR PSEUDO-TEXT
POP PP,0(TA) ;STORE TYPE,,FLAG+WORD COUNT
HRRZ TB,CPYLOC
SUBI TA,(TB) ;GET REL ADDRESS
MOVEM TA,RPLNXW ;SO WE CAN FIXUP THE LAST
ADDI TA,(TB)
HRRZ TB,0(TA)
TRZ TB,CONTF ;GET LENGTH BACK
ADD TB,TA
EXCH TA,TB ;TB ORIGIN, TA END
ADDI TB,1
HRLI TB,NAMWRD ;FROM
TLNE W1,GWLIT
HRLI TB,LITVAL
SKIPE PICNXT ;[557] PIC TEXT?
HRLI TB,PICBUF ;YES
BLT TB,(TA) ;MOVE LITERAL
SETZM PICNXT ;[557] CLEAR PIC NEXT FLAG
POPJ PP,
PSTPIC: PUSHJ PP,PSCAN
SETOM PICNXT ;[557] MARK AS PIC TEXT
SETZ W1, ;[557] CLEAR FLAGS
TSWF FGTPER!FREGCH ;DID WE READ-AHEAD
DPB W1,PICPTR ;YES, REMOVE IT
MOVSI TB,-7
SKIPE PICBUF(TB)
AOBJN TB,.-1
AOJA TB,PSTWRW
;HERE TO SEE IF CURRENT ITEM SHOULD BE REPLACED
RPLTST: TSWF FRTST ;CHECKING THIS WORD
JRST PSTRD1 ;YES
HLRZ CT,W1
CAIN CT,GWRESV+PIC. ;IF THIS IS PICTURE
JRST GITM1A ;PASS DISCRIPTORS ALSO
SWON FRTST ;NO, BUT CHECK NEXT ONE
TSWTZ FREGCH!FGTPER ;DID WE LOOKAHEAD
JRST .+3 ;NO
PUSHJ PP,BKPLIB ;YES, UNDO DAMAGE
PUSHJ PP,BKPCPY ;AND IN CPYFIL
PUSHJ PP,RPLSAV ;SAVE ITEMS NEEDED FOR REPLACEMENT TESTING
SWON FNOCPY ;TURN NO COPY BACK ON
JRST GITM1A ;RETURN AND PROCCESS WORD
RPLSAV: MOVE CT,RPLBLK
MOVEM CT,RPLBH+0 ;SAVE CURRENT BLOCK #
MOVE CT,LIBBH+1 ;GET BYTE PTR
MOVEM CT,RPLBH+1 ;SAVE IT
MOVE CT,LIBBH+2 ;AND COUNT
MOVEM CT,RPLBH+2
MOVE CP,INPTCP ;SAVE INPUT CHAR. POSITION
MOVEM CP,RPLICP
MOVE CP,SAVECP ;SAVE CHAR. POSITION
MOVEM CP,RPLCP
MOVE CT,RPLBLK ;YES
MOVEM CT,L1BH0 ;SAVE CURRENT LIBRARY BLOCK #
MOVE CT,LIBBH+1
MOVEM CT,L1BH1 ;BYTE POINTER
MOVE CT,LIBBH+2
MOVEM CT,L1BH2 ;CHAR. COUNT
MOVE CT,SAVECP
MOVEM CT,L1CPO ;OUTPUT CHAR. POS.
MOVE CT,INPTCP
MOVEM CT,L1CPI ;INPUT CHAR. POS.
POPJ PP,
PSTRD1: MOVE CT,RPLNXW ;GET NEXT WORD POINTER
ADD CT,CPYLOC ;PLUS BASE
MOVE TE,(CT) ;GET FLAGS & SIZE
TLNE W1,GWLIT ;LITERAL?
JRST PSTRD2 ;YES
TLNE TE,GWLIT ;NO, BUT IS TARGET?
JRST PSTRD8 ;YES, NO MATCH
TRNE TE,-1-CONTF ;IS SIZE 0
JRST PSTRD3 ;NO, OK UP TO NOW
XOR TE,W1 ;YES, SEE IF SAME (MUST BE "." "(" OR ")")
TLNN TE,-1 ;MATCH?
AOJA CT,PSTR3A ;YES, BYPASS W1 AND POINT TO BYTE PTR
JRST PSTRD8 ;NO
PSTRD2: XOR TE,W1 ;SAME SIZE & TYPE?
TLNE TE,-1^!GWALL ;[557] BUT ALLOW ALL IN EITHER LITERAL
JRST PSTRD8 ;NO
XOR TE,W1 ;YES, PUT SIZE BACK
PSTRD3: ANDI TE,37777 ;WORD SIZE ONLY
PUSH PP,TE ;[726] SAVE WORD COUNT
MOVN TE,TE
HRL CT,TE
ADDI CT,1 ;AOBJN PTR AT LAST
SKIPE PICNXT ;[557] PIC?
TROA W1,PICBUF ;YES
HRRI W1,NAMWRD
TLNE W1,GWLIT
HRRI W1,LITVAL ;FORM OTHER POINTER
MOVE TE,(CT) ;GET WORD
CAME TE,(W1) ;MATCH?
JRST PSTR8A ;[726] NO
ADDI W1,1 ;INCREMENT
AOBJN CT,.-4 ;LOOP
POP PP,TE ;[726] GET WORD COUNT BACK
CAIE TE,7 ;[726] CHECKED ALL WORDS?
TLNE W1,GWLIT ;[726] OR A LITERAL?
JRST PSTR3A ;[726] YES, THAT'S A MATCH
SKIPN PICNXT ;[726] IF PICTURE THEN 7 WORD MAX
CAIE TE,5 ;[726] 5 WORDS ONLY FOR DATA-ITEMS
TRNA ;[726] NO
JRST PSTR3A ;[726] ITS A MATCH
SKIPE (W1) ;[726] NEXT WORD ZERO?
JRST PSTRD8 ;[726] NO, NO MATCH THEN
PSTR3A: SETZM PICNXT ;[557] CLEAR PIC FOLLOWING FLAG
MOVE TE,INPTST ;GET START OF ITEM
SKIPN RPLCST ;FIRST TIME?
MOVEM TE,RPLCST ;SO WE KNOW IF IN A OR B MARGIN
MOVE TE,RPLNXW ;TOTAL MATCH
ADD TE,CPYLOC
MOVE TE,(TE) ;SEE IF MORE TO TEST
TRNN TE,CONTF
JRST PSTRD4 ;NO
SETZM L2BH0 ;INCASE WE DON'T GET TO GETKAR
HLRZ CT,TE
ANDI TE,377777 ;YES
ADDI TE,1 ;HEADER WORD ALSO
ADDM TE,RPLNXW ;INCREMENT POINTER
CAIE CT,GWRESV+PIC. ;IS NEXT A PICTURE?
JRST GETITM ;NO
PUSHJ PP,PSCAN ;YES, GET IT
SETOM PICNXT ;[557] SIGNAL PICTURE
SETZ W1, ;[557] CLEAR FLAGS
TSWF FGTPER!FREGCH ;DID WE READ-AHEAD
DPB W1,PICPTR ;YES, REMOVE IT
JRST PSTRD1 ;TRY IT
PSTRD4: SWOFF FRTST ;OK TO OUTPUT TO CPYFIL NOW
SKIPN NCPYSW ;UNLESS FORBIDDEN AT A HIGHER LEVER
SWOFF FNOCPY ;NOT
HLRZ TE,TE ;GET W1 STORED
CAIE TE,GWRESV.+PRIOD. ;WAS LAST MATCH FOR A PERIOD?
JRST PSTR4E ;NO
SWOFF FREGCH!FGTPER ;YES, WE WANT TO BYPASS IT
PUSHJ PP,SVLKAR ;GO SETUP WITH CURRENT VALUES
IBP L2BH1 ;BUT WE WANT NEXT CHAR
SOS L2BH2
AOS L2CPO ;AND FOR CHAR. POS
AOS L2CPI
PSTR4E: SETZM PADCNT ;ASSUME NO PADDING
MOVE TE,(CT) ;GET BYTE PTR & COUNT
HRRZM TE,RPLBH+2
HLLZM TE,RPLBH+1 ;STORE LHS OF POINTER
SKIPN TE,L2BH0 ;DID GETKAR SETUP FIRST SPACE
JRST [PUSHJ PP,SVLKAR ;NO, GO SETUP WITH CURRENT
JRST PSTR4A]
TSWT FGTPER ;YES, BUT DID WE SEE A PERIOD ALSO?
JRST PSTR4D ;NO
MOVE CH,L2BH1 ;GET BYTE PTR
ADD CH,[070000,,0]
SKIPGE CH
SUB CH,[430000,,1]
MOVEM CH,L2BH1 ;BACKUP 1 CHAR
AOS L2BH2
SOS L2CPO ;BACKUP CHAR. POS.
SOS L2CPI
PSTR4D: CAMN TE,RPLBLK ;YES, SAME BLOCK?
JRST PSTR4A ;YES
MOVEM TE,RPLBLK ;NO, SAVE WHAT IT WILL BE
USETI LIB,(TE)
IN LIB,
PSTR4A: SKIPA TE,L2BH1 ;OK
JRST GETLB9
MOVEM TE,LIBBH+1 ;SET BYTE PTR
MOVE TE,L2BH2
MOVEM TE,LIBBH+2 ;BYTE COUNT
MOVE CP,L1CPI ;GET FIRST CHAR.
CAIE CP,7 ;START OF NEW LINE?
JRST PSTR4F ;NO
MOVE CP,RPLCST ;YES, WHICH MARGIN?
CAIGE CP,^D12 ;"B"?
JRST PSTR4F ;NO
MOVEI CP,5
MOVEM CP,PADCNT
MOVEI CH," "
PUSHJ PP,PUTCPY ;OUTPUT 4 SPACES
SOSLE PADCNT
JRST .-3
MOVEI CP,^D12 ;RESET TO "B" MARGIN
MOVEM CP,L1CPI
MOVEM CP,L1CPO
PSTR4F: MOVE CP,L1CPI
MOVEM CP,INPTCP ;RESTORE INPUT PTR
MOVE CP,L1CPO
MOVEM CP,SAVECP ;RESTORE OUTPUT (SHOULD NOT HAVE CHANGED)
MOVE CP,R1CPO ;GET WHERE OUTPUT STARTS FOR REPLACEMENT
ADD CP,RPLBH+2 ;WHERE IT ENDS
CAILE CP,^D72 ;ARE WE UP TO COMMENT FIELD?
JRST PSTR4C ;YES, TOO BAD
MOVE CP,SAVECP ;WHERE WE ARE NOW
ADD CP,RPLBH+2
CAIG CP,^D72 ;WILL THAT TAKE US INTO COMMENT FIELD?
JRST PSTRD5 ;NO, JUST REPLACE WHERE WE ARE
PSTR4C: MOVE CP,R1CPO ;GET REPL. START
SUB CP,SAVECP ;GET DIFF BETWEEN LIBRARY AND REPLACEMENT
JUMPLE CP,[MOVEI CH,12 ;THIS COULD BE A PROBLEM IF LINE IS LONG
PUSHJ PP,PUTCPY ;SO START NEW LINE
MOVE TE,R1CPI ;[557] RESET INPUT POINTER
MOVEM TE,INPTCP ;[557] SO WE KNOW IF IN COL 72 ETC.
JRST PSTR4C] ;AND PAD OUT TO WHERE REPLACEMENT TEXT IS
MOVEM CP,PADCNT ;STORE NO. OF PAD SPACES
PSTRD5: MOVE TD,1(CT) ;GET COUNTS
SETZ TE,
LSHC TE,9
MOVEM TE,R1CPO ;SAVECP BEFORE
SETZ TE,
LSHC TE,9
MOVEM TE,R1CPI ;INPTCP BEFORE
LSH TD,-9
HLRZM TD,R2CPO ;SAVECP AFTER
LSH TD,-9
ANDI TD,777
MOVEM TD,R2CPI ;INPTCP AFTER
SKIPN TE,RPLBH+2 ;CHAR COUNT
JRST PSTRD6 ;JUST NULL
ADDI TE,5+4 ;+ 1 WORD + FUDGE FACTOR FOR SAFETY
IDIVI TE,5
ADDI CT,2 ;POINT TO TEXT
HRLI CT,PSTBUF
MOVS CT,CT ;BLT PTR
HRRM CT,RPLBH+1 ;COMPLETE BYTE POINTER
ADDI TE,(CT)
BLT CT,-1(TE) ;MOVE DATA TO SAFE PLACE
PSTRD6: SWON FCOPY ;SIGNAL REPLACING
SWOFF FREGCH!FGTPER ;NOT FOR REPLACEMENT
MOVE CP,INPTCP
MOVEM CP,RPLICP
MOVE CP,SAVECP
MOVEM CP,RPLCP ;SAVE CHAR. POSITIONS
MOVEI TE,2 ;[704] REINITIALIZE POINTER
MOVEM TE,RPLNXW ;[704] TO POINT TO FIRST AVAILABLE ITEM
SETZM TERSCN ;[657] CLEAR SINCE WE ARE NOT READING SAME SOURCE
JRST GETITM ;GO GET IT
PSTR8A: POP PP,TE ;[726] RESTORE STACK
PSTRD8: SETZM PICNXT ;[557] CLEAR PIC FOLLOWING FLAG
SETZM RPLCST ;CLEAR FIRST INPTST COUNTER
MOVE CT,RPLNXT ;GET BASE OF THIS TEST
ADD CT,CPYLOC ;FIX IN CORE
SKIPN CT,0(CT) ;GET OFFSET OF NEXT TEST
JRST PSTRD9 ;NO, MORE
MOVEM CT,RPLNXT ;POINT TO IT
ADDI CT,1 ;AND TO DATA ITEM
MOVEM CT,RPLNXW
JRST PSTRD1 ;TRY AGAIN
PSTRD9: MOVE TE,RPLBH+0 ;GET ORIGINAL BLOCK NUMBER
CAMN TE,RPLBLK ;SAME AS CURRENT?
JRST PSTR10 ;YES
MOVEM TE,RPLBLK ;THIS WILL SOON BE CURRENT
USETI LIB,(TE) ;NO, RESET ON OLD BLOCK
IN LIB,
PSTR10: SKIPA TE,RPLBH+1 ;OK, GET BYTE PTR
JRST GETLB9 ;ERROR
MOVEM TE,LIBBH+1 ;RESET IT
MOVE TE,RPLBH+2
MOVEM TE,LIBBH+2 ;SAME FOR COUNT
MOVE CP,RPLICP
MOVEM CP,INPTCP
MOVE CP,RPLCP ;RESTORE CP
MOVEM CP,SAVECP
SWOFF FNOCPY!FRTST!FREGCH!FREGWD!FGTPER
MOVE TE,RPLLOC ;POINT TO START
MOVEM TE,RPLNXT
ADDI TE,1 ;POINT TO FIRST WORD
MOVEM TE,RPLNXW
JUMPN CP,GETITM ;OK IF IN MIDDLE OF LINE
PUSHJ PP,GETSEQ ;WORRY ABOUT SEQ NUMBER
SWON FREGCH ;REGET LAST CHAR
JRST GETITM ;GET ITEM AGAIN
BKPLIB: AOS LIBBH+2 ;COUNT LAST CHAR
SOS INPTCP
MOVE TE,LIBBH+1
ADD TE,[070000,,0]
SKIPGE TE
SUB TE,[430000,,1]
MOVEM TE,LIBBH+1 ;BACKUP BYTE PTR
SOS CP,SAVECP ;BACKUP CPYFIL POSITION
POPJ PP,
BKPCPY: TSWF FNOCPY ;DID WE WRITE TO CPYFIL?
POPJ PP, ;NO
AOS CPYBHO+2 ;COUNT LAST CHAR
MOVE TE,CPYBHO+1
ADD TE,[070000,,0]
SKIPGE TE
SUB TE,[430000,,1]
MOVEM TE,CPYBHO+1 ;BACKUP BYTE PTR
POPJ PP,
CPE285: EWARNW E.285 ;YES, ILLEGAL LIBRARY-NAME
JRST CPYERR ;SKIP REST OF PARAGRAPH
CPE286: EWARNW E.286 ;'COPY STATMENT MUST END WITH PERIOD'
; JRST CPYERR ;SKIP REST OF PARAGRAPH
CPYERR: PUSHJ PP,CLRCPY ;CLR CPYTAB AS IF COPY IS ALL FINISHED (IT IS)
SWOFF FNOCPY ;TURN OFF 'NO LISTING' FLAG
TRZ FGTPER ; DON'T GET PERIOD FROM GETITM
PUSHJ PP,SKPPGF ;SKIP TO END OF PARAGRAPH
PUSHJ PP,GETITM ;GET A SOURCE ITEM
SWON FREGWD ;SET REGET WORD BIT
POPJ PP,
;SKIP TO END OF PARAGRAPH
;THE TRICK IS TO FIND A CHARACTER IN THE A-FIELD THAT IS NOT
;EITHER A SPACE, TAB, OR HYPHEN
;(ASTERISKS ARE FILTERED OUT AT A MUCH EARLIER STAGE)
SKPPGF::PUSHJ PP,SKPSRC ;GET NEXT SOURCE CHAR.
CAIN CP,7 ;ALREADY AT COLUMN 7?
JRST ENDB ;YES, WHAT KIND OF CHAR.?
CAIGE CP,^D12 ;IN B-FIELD?
JRST ENDB.2 ;NO, MUST BE IN A-FIELD
ENDPAR: PUSHJ PP,SKPSRC ;GET CHARACTER
ENDB: TSWF FEOF ;END-OF-FILE?
JRST END2 ;EOF FOUND
CAIE CP,7 ;COLUMN 7?
JRST ENDPAR ;NO, GET TO NEXT LINE
CAIE CH," " ;YES, SPACE?
JRST ENDPAR ;NO, MUST BE A HYPHEN
ENDB.1: PUSHJ PP,SKPSRC ;GET CHARACTER
TSWF FEOF ;END-OF-FILE?
JRST END2 ;YES
CAIL CP,^D12 ;INTO B-FIELD YET?
JRST ENDB ;YES, SKIP REST OF LINE
ENDB.2: CAIN CH," " ;IS IT A SPACE?
JRST ENDB.1 ;YES
CAIL CH,"a" ;ABOVE LOWER CASE A?
MOVEI CH,-40(CH) ;YES MOVE IT INTO THE UPPER CASE SET.
CAIL CH,"A" ;IS IT ALPHABETIC?
CAILE CH,"Z"
JRST ENDB ;NOT A LETTER
END2:: TRZ SW,FREGWD+FGTPER+FNEEDS ;CLR OTHER FLAGS
JRST REGLST ;REGET THE LAST CHARACTER
;GET A CHARACTER FROM THE LIBRARY FILE
GETLIB: TSWF FCOPY ;COPYING FROM REPLACEMENT BUFFER?
JRST GETCPY ;YES
TSWFZ FREGCH ;REGET A CHARACTER?
JRST REGETL ;YES
GETLB1: SOSG LIBBH+2 ;NO--GET NEXT CHARACTER
JRST GETLB4
GETLB2: IBP LIBBH+1
MOVE CH,@LIBBH+1 ;IS THIS A LINE-NUMBER WORD?
TRNN CH,1
JRST GETLB3 ;NO
JUMPL CH,GETLB5 ;END OF PROGRAM?
MOVNI CH,5 ;NO--JUMP OVER 5 CHARACTERS
ADDB CH,LIBBH+2
JUMPLE CH,GETLB1 ;JUMP IF BUFFER NOW EMPTY
AOS LIBBH+1 ;IT ISN'T--BUMP BYTE POINTER
GETLB3: LDB CH,LIBBH+1
JUMPE CH,GETLB1
JRST GETSL
GETLB4: AOS RPLBLK ;INCREMENT CURRENT BLOCK
IN LIB, ;GET ANOTHER BUFFER FULL
JRST GETLB2
GETSTS LIB,CH ;END-FILE?
TRNE CH,$ERAS
JRST GETLB9 ;NO--TROUBLE
GETLB5: SETOM LIBBH+2 ;[557] FORCE COUNT FINISHED
TSWF FRTST ;JUST DOING CHECK?
JRST GTBLNK ;YES, GIVE UP, RETURN BLANK
TSWF FCOPY ;STILL DOING REPLACEMENTS
JRST [MOVSI CH,(FECOPY) ;YES
IORM CH,RPLFLG ;MARK IT FOR AFTER COPY
JRST GTBLNK] ;BUT WE STILL NEED LIBRARY
SWON FECOPY ;SET "CLEAN UP COPY" INDICATOR
SWOFF FRLIB;
JRST GTBLNK
GETLB9: MOVEI CH,LIBDEV ;ERROR ON LIBRARY DEVICE
JRST DEVDED
REGETL: LDB CH,LIBBH+1
JUMPE CH,GETLB1
CAIN CH,177 ;[557] JUST INCASE WE READ END OF PROGRAM -1
MOVEI CH," " ;[557] YES, RETURN A SPACE TO AVOID ERROR
POPJ PP,
;GET A CHARACTER FROM THE REPLACEMENT BUFFER
GETCPY: TSWFZ FREGCH ;REGET A CHARACTER?
JRST REGETC ;YES
GETCP0: SOSGE PADCNT ;[557] PADDING NEEDED?
JRST GETCP1 ;[557] NO
MOVEI CH," " ;[557]
PUSHJ PP,PUTCPY ;[557] PAD WITH BLANKS
AOS INPTCP ;[557] COUNT AS INPUT CHARACTER
JRST GETCP0 ;[557]
GETCP1: SOSGE RPLBH+2 ;NO--GET NEXT CHARACTER
JRST GETCP4
IBP RPLBH+1
MOVE CH,@RPLBH+1 ;IS THIS A LINE-NUMBER WORD?
TRNN CH,1
JRST GETCP3 ;NO
MOVNI CH,5 ;JUMP OVER 5 CHARACTERS
ADDB CH,RPLBH+2
JUMPLE CH,GETCP1 ;JUMP IF BUFFER NOW EMPTY
AOS RPLBH+1 ;IT ISN'T--BUMP BYTE POINTER
GETCP3: LDB CH,RPLBH+1
JUMPE CH,GETCP1
JRST GETSL
REGETC: LDB CH,RPLBH+1
JUMPE CH,GETCP1
POPJ PP,
GETCP4: SWOFF FCOPY ;TURN OFF REPLACING REQUIRED
IOR SW,RPLFLG ;RESTORE OLD FLAGS
SETZM RPLFLG
TSWF FECOPY ;PREVIOUSLY SEEN END OF LIBRARY?
JRST GETCP5 ;YES
SWOFF FREGCH!FGTPER
GTCP4L: MOVE CP,L2CPI ;GET NEXT CHAR. POS.
SUB CP,INPTCP ;SEE IF IT WILL FIT ON THIS LINE
JUMPL CP,GTCP4Z ;NO, START NEW LINE
JUMPE CP,GTCP4A ;NO PROBLEM
MOVEM CP,PADCNT ;SAFE PLACE FOR COUNT
MOVEI CH," "
PUSHJ PP,PUTCPY ;PAD WITH BLANKS
SOSLE PADCNT
JRST .-3
GTCP4A: MOVEI CH,"."
TSWF FGTPER ;NEED PERIOD?
PUSHJ PP,PUTCPY ;YES, SO PUT ON CPYFIL
LDB CH,LIBBH+1 ;GET LAST CHAR.
TSWF FREGCH ;NEED IT
PUSHJ PP,PUTCPY
MOVE CP,SAVECP
ADDI CP,1 ;INPUT IS 1 AHEAD STILL
MOVEM CP,INPTCP
JRST GETLIB ;GET NEXT CHAR. FROM LIBRARY
GTCP4Z: MOVEI CH,$CR ;START NEW LINE
PUSHJ PP,PUTCPY
MOVEI CH,$LF
PUSHJ PP,PUTCPY
SETZM INPTCP ;RESET INPUT POS.
AOS INPTCP ; TO 1
JRST GTCP4L ;TRY AGAIN
GETCP5: MOVEI CH,"." ;RETURN A PERIOD
TSWT FGTPER ;UNLESS PERIOD NOT NEEDED
MOVEI CH," " ;IN WHICH CASE RETURN SPACE
JRST PUTCIF ;PUT ON LISTING ALSO
;GET A LIBRARY PROGRAM.
;ENTER WITH CP SET TO PERIOD TERMINATING THE COPY CLAUSE,
; CPYW2 POINTING TO "COPY", AND PROGRAM-NAME IN LIBNAM.
SETLIB: SETZM REGKAR
TSWTZ FREGCH ;CHARACTER TO REGET?
JRST SETLB2 ;NO
SKIPN SRCDEV ;[352] ANY MORE SOURCE CHARS?
JRST SETLB2 ;[352] NO, NO CHAR TO REGET EVER.
LDB TE,SRCBH+1 ;YES--PICK IT UP
MOVEM TE,REGKAR
TSWT FSEQ ;SEQUENCED FILE?
JRST SETLB1 ;NO
MOVE CP,SAVECP ;GET CHAR. POS
CAILE CP,^D72 ;IN COMMENT FIELD
JRST SETLB2 ;YES, JUST LEAVE CHAR ALONE
SETLB1: MOVSI TE,7B<^D18+5>
ADDM TE,CPYBHO+1
AOS CPYBHO+2
SETLB2: MOVE CP,SAVECP
MOVEM CP,CPYCP ;SAVE CHARACTER POSITION
SKIPN LIBDEV ;IS THERE A LIBRARY FILE?
JRST STLB20 ;NO--WE LOSE
USETI LIB,1 ;GET READY TO READ ROUGH TABLE
IN LIB, ;READ ROUGH TABLE
SKIPA TC,LIBNAM ;PICK UP LIBRARY ROUTINE NAME
JRST SETLBE ;[655] ERROR
MOVE TB,LIBNAM+1
LSHC TC,-6
TRZ TB,-1
LSH TB,-1
MOVE TA,LIBBH+1 ;SET TA TO POINT TO ROUGH-TABLE
MOVE TE,1(TA) ;COMPARE LIBNAM TO FIRST ENTRY
MOVE TD,2(TA)
PUSHJ PP,SETLBC
CAIA ;EQUAL
JRST SETLB4 ;GREATER
MOVEI TE,2 ;LESS
JRST SETL5A
SETLBE: GETSTS LIB,CH ;[655] GET ERROR STATUS
TRNN CH,$ERAS ;[655] END-OF-FILE?
OUTSTR [ASCIZ /Premature end-of-file found on library file
/]
JRST GETLB9 ;[655] CONTINUE WITH STANDARD ERROR MESSAGE
;SEARCH ROUGH-TABLE
SETLB4: ADDI TA,2
MOVE TE,1(TA)
MOVE TD,2(TA)
PUSHJ PP,SETLBC
JRST SETLB5
JRST SETLB4
SKIPA TE,0(TA) ;ITEM FOUND--GET ADDRESS
SETLB5: MOVE TE,2(TA)
TLZ TE,777700
LSH TE,-7
ADDI TE,1
;AN APPROPRIATE ROUGH-TABLE ENTRY HAS BEEN LOCATED.
SETL5A: USETI LIB,(TE) ;READ IN FINE-TABLE
IN LIB,
SKIPA TA,LIBBH+1 ;SET UP AN IOWD TO FINE TABLE
JRST SETLBE ;[655] ERROR
HRLI TA,-^D64
;SEARCH THE FINE TABLE
SETLB6: MOVE TE,1(TA)
MOVE TD,2(TA)
PUSHJ PP,SETLBC
JRST SETLB8
AOJA TA,SETLB7
JRST STLB21
SETLB7: AOBJN TA,SETLB6
JRST STLB21
;PROGRAM FOUND
SETLB8: MOVSI TE,(FSEQ)
AND TE,SW ;PRESERVE STATE OF FSEQ
MOVEM TE,CPYFLG
SETZM RPLFLG ;[557] CLEAR REPLACEMENT FLAG ALSO
SWOFF FSEQ ;TURN IT OFF
MOVE TE,2(TA)
TLZE TE,40 ;LIBRARY SEQUENCED?
SWON FSEQ
TLZ TE,777700
LSHC TE,-7
ADDI TE,1
HRRZM TE,RPLBLK ;STORE PTR TO CURRENT BLOCK
HRRZM TE,RPLBH ;PTR TO INITIAL BLOCK
USETI LIB,(TE)
IN LIB,
AOSA LIBBH+2
JRST SETLBE ;[655] ERROR
MOVEI TE,0
LSHC TE,7
ADDM TE,LIBBH+1
IMULI TE,5
MOVNS TE
ADDM TE,LIBBH+2
SWON FRLIB
MOVEI CH,$LF
PUSHJ PP,PUTCPY
PUSHJ PP,GETSEQ ;FORCE FIRST LIBRARY CHAR TO START ON NEW LINE.
;ALSO, PASS OVER ANY COMMENTS
SKIPN RPLCNT ;ANY REPLACEMENTS TO DO?
JRST REGLST ;NO, GET BACK THIS FIRST CHAR LATER [156]
PUSHJ PP,BKPLIB ;BACKUP IN LIBRARY BUFFER
PUSHJ PP,BKPCPY ;AND IN CPYFIL
PJRST RPLSAV ;SAVE REQUIRED ITEMS AND RETURN
;GET A LIBRARY PROGRAM (CONT'D).
;ERRORS
;NO LIBRARY FILE
STLB20: TTCALL 3,[ASCIZ "%LIBRARY FILE NOT FOUND - CONTINUING
"]
MOVEI DW,E.75
MOVE CP,LIBHDR ;[557] GET LIBRARY NAME
CAME CP,['LIBARY'] ;[557] JUST THE DEFAULT
MOVEI DW,E.607 ;[557] NO, THEREFORE WE FAILED TO FIND IT
JRST STLB29
;PROGRAM NOT FOUND
STLB21: TTCALL 3,[ASCIZ "%LIBRARY ROUTINE "]
MOVE TA,LIBNAM
PUSHJ PP,SIXOUT
MOVE TA,LIBNAM+1
PUSHJ PP,SIXOUT
TTCALL 3,[ASCIZ " NOT FOUND - CONTINUING
"]
MOVEI DW,E.74
STLB29: MOVE CP,CPYW2
LDB LN,[POINT 13,CPYW2,28]
SWOFF FCOPY!FRLIB ;[477] IF LIBARY NOT FOUND, CAN'T COPY
JRST FATAL
;COMPARE LIBNAM AGAINST CONTENTS OF TE & TD.
;IF EQUAL, RETURN TO CALL + 1.
;IF LIBNAM > TE,TD RETURN TO CALL+2.
;IF LIBNAM < TE,TD RETURN TO CALL+3.
SETLBC: LSHC TE,-6
TRZ TD,-1
LSH TD,-1
CAME TC,TE
JRST SETLC1
CAMN TB,TD
POPJ PP,
AOS (PP)
CAMG TB,TD
AOS (PP)
POPJ PP,
SETLC1: AOS (PP)
CAMG TC,TE
AOS (PP)
POPJ PP,
;SPACE OVER UNTIL PREVIOUS SOURCE CHARACTER POSITION REACHED
ENDCPY: SWOFF FSEQ ;TURN OF FSEQ
IOR SW,CPYFLG ;PUT IT BACK THE WAY IT WAS
MOVEI CH,$LF
SKIPN SAVECP ;IF JUST STARTED NEW LINE
MOVEI CH," " ;DON'T PUT OUT EXTRA ONE
ENDCP1: PUSHJ PP,PUTCPY
MOVEI CH,1(CP)
CAML CH,CPYCP
JRST ENDCP2
MOVEI CH," "
JRST ENDCP1
ENDCP2: MOVEM CH,INPTCP ;[275] RESTORE LAST SOURCE CHAR POS BEFORE GOING TO LIBARY
SKIPE CH,REGKAR
SWONS FREGCH;
MOVEI CH," "
PUSHJ PP,PUTCPY
;CLEAR OUT CPYTAB AFTER END-OF-PROGRAM IN CPYFIL.
CLRCPY: HRRZ TE,CPYLOC
HRLI TE,1(TE)
MOVS TE,TE ;BUILD BLT PTR
HRRZ TD,CPYNXT
BLT TE,-1(TD) ;ZERO ALL OF CPYTAB
MOVE TE,CPYLOC ;YES--RESET CPYNXT
MOVEM TE,CPYNXT
SWOFF FCOPY!FECOPY!FRLIB ;TURN OFF "WE ARE COPYING"
POPJ PP, ;RETURN
;CHARACTERS USED
$TAB==11
$LF==12
$VT==13
$FF==14
$CR==15
$CZ==32
$QUOTE==42
EXTERN FATAL,WARN,DEVDED,STINFL,TRYNAM
EXTERN PUTCPY,PUTCIF,PUTFEL,SIXOUT,LNKSET
EXTERN CURCPY,CPYBHO,LIBHDR,LIBBH,LIBDEV,LIBNAM
EXTERN RPLCNT,RPLLOC,RPLNXT
EXTERN IOSRCS,DEVFIL,DEVDEV,DEVEXT,DEVSW,DEVSIZ,SRCEND
EXTERN GETENT,PHASEN,OPRTR,DCPNT.
EXTERN DEVBH,OPENIT
EXTERN PSCAN,PICBUF,PICPTR
EXTERN SRCBH,SRCDEV,CRFBHO,CRFDEV,CREFSW,CPMAXN
EXTERN SEQIN
EXTERN WASERC,PUNPTR,PLUSWD,MINWD,MULWD,LPARWD,EXPWD,PERWD,ENDIT
EXTERN NAMWRD,LITVAL,NAMVAL,FILLOC,FILNXT
EXTERN GWNAMP,GWVAL,GWLN,GWCP
EXTERN CPOPJ,CPOPJ1
IFN DBMS,<
EXTERN FINVOK,DBBUFH,DBDEV,DBBLCK,DBONLY
>
IFN MCS!TCS,<
EXTERN CDLOC,CDNXT
>
IFN ANS74,<
EXTERN NOIDHY,$LFPTR,DEBSW
>
;EXTERNAL DATA LOCATIONS OF INTEREST DURING COPY AND REPLACING
EXTERN CPYLOC ;FIRST WORD OF COPY TABLE
EXTERN CPYNXT ;NEXT FREE WORD IN COPY TABLE
EXTERN CPYFLG ;STORE STATUS OF FLAGS BEFORE COPY
EXTERN CPYCP ;CHARACTER POSITION OF WORD FOLLOWING COPY STATEMENT
EXTERN CPYW2 ;SAVE "W2" DURING COPY
EXTERN EOLKAR ;END-OF-LINE CHARACTER FOR LAST LINE
EXTERN ITEMCT ;TO SAVE "CT"
EXTERN BLNKLN ;LINE NUMBER OF FIRST OF A SERIRS OF BLANKS
EXTERN BLNKCP ;CHARACTER POSITION OF FIRST OF A SERIES OF BLANKS
EXTERN SAVBCP ;TO SAVE BLNKCP
EXTERN SAVBLN ;TO SAVE BLNKLN
EXTERN SRCCOL ;INPUT COLUMN (SAME AS INPTCP UNLESS TABS)
EXTERN INPTCP ;INPUT CHARACTER POSITION FOR SEQUENCED SOURCE
EXTERN INPTST ;FIRST INPUT CHARACTER POSITION FOR ITEM
EXTERN TERMQ ;CHARACTER DELIMITING ALPHA LITERAL
EXTERN NOCONT ;IF -1, THEN CONTINUATION CARDS ARE ILLEGAL
EXTERN NCPYSW ;IF -1, OUTPUT TO CPYFIL IS FORBIDDEN
EXTERN PADCNT ;NO. OF SPACES NEEDED TO LINE UP COPY REPLACEMENT
EXTERN PARCNT ;NO. OF PARENS SEEN DURING REPLACEMENT TEST
EXTERN PICNXT ;[557] -1 WHEN NEXT DATUM IS, OR COULD BE, A PICTURE STRING
EXTERN REGKAR ;A CHARACTER FROM SRCFIL, SAVED UPON ENTERING SETLIB
EXTERN RPLFLG ;FLAGS STORED BEFORE COPY REPLACING
EXTERN RPLLOC ;POINTER TO START OF REPLACEMENT LIST
EXTERN RPLNXT ;POINTER TO NEXT REPLACEMENT ITEM
EXTERN RPLNXW ;POINTER TO NEXT REPLACEMENT WORD
EXTERN RPLCNT ;COUNT OF REPLACEMENTS
EXTERN RPLBH ;REPLACEMENT "BUFFER HEADER" INFO
EXTERN RPLCP ;STORE "CP" SO WE CAN BACK UP
EXTERN RPLICP ;DITTO FOR "INPTCP"
EXTERN RPLCST ;"INPTST" STORED ON FIRST REPLACEMENT
EXTERN RPLBLK ;CURRENT LIBRARY BLOCK NUMBER
EXTERN PSTBUF ;STORE PSEUDO-TEXT
EXTERN SRCBFC ;BLOCK NUMBER OF INPUT SOURCE BUFFER
EXTERN TERSCN ;[657] IF NON-ZERO TERMINATE SCAN IF CURRENT CHAR. MACTCHES CONTENTS
EXTERN SAVECH ;TERMINATING PUNCTUATION OF A WORD
EXTERN SAVECP ;"CP" SAVED IN "GETCH"
EXTERN SAVELN ;"LN" SAVED IN "GETCH"
EXTERN SAVCP1 ;"CP" SAVED IN "GETWRD"
EXTERN SAVLN1 ;"LN" SAVED IN "GETWRD"
EXTERN SAVEWD ;TO SAVE "W1" & "W2"
EXTERN WORDCP ;"CP" FOR FIRST CHARACTER OF DATUM
EXTERN WORDLN ;"LN" FOR FIRST CHARCHTER OF DATAUM
;ITEMS TO BE SAVED BEFORE REPLACEMENT TEST (AT RPLSAV)
EXTERN L1BH0 ;RPLBLK
EXTERN L1BH1 ;LIBBH+1
EXTERN L1BH2 ;LIBBH+2
EXTERN L1CPI ;INPTCP
EXTERN L1CPO ;SAVECP
;ITEMS TO BE SETUP ON FIRST BLANK ON LINE (AT SVLKAR)
EXTERN L2BH0 ;RPLBLK
EXTERN L2BH1 ;LIBBH+1
EXTERN L2BH2 ;LIBBH+2
EXTERN L2CPI ;INPTCP
EXTERN L2CPO ;SAVECP
EXTERN R1CPO
EXTERN R1CPI
;ITEMS TO BE STORE JUST AFTER DATUM (AT CPLB40)
EXTERN R2BH0
EXTERN R2BH1
EXTERN R2BH2
EXTERN R2CPO
EXTERN R2CPI
;ITEMS TO BE SAVED AT (SVSKAR)
EXTERN R3BH0
EXTERN R3BH1
EXTERN R3BH2
EXTERN R3CPO
EXTERN R3CPI
;ITEMS TO BE SAVED AT (SVPKAR)
EXTERN R4BH0
EXTERN R4BH1
EXTERN R4BH2
EXTERN R4CPI
EXTERN R4CPO
END