Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/getitm.mac
There are 21 other files named getitm.mac in the archive. Click here to see a list.
; UPD ID= 1587 on 5/14/84 at 10:03 AM by HOFFMAN
TITLE GETITM FOR COBOL V13
SUBTTL GET NEXT SOURCE WORD AL BLACKINGTON/CAM/SEB/DMN/JEH
SEARCH COPYRT
SALL
;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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P,UUOSYM
%%P==:%%P
MCS==:MCS
DBMS==:DBMS
IFN TOPS20,<SEARCH MONSYM,MACSYM>
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 SKPSRC ;READ ONE SOURCE CHARACTER
ENTRY PUTCRF ;PUT ITEM INTO CREF FILE
INTERN GETSRC ;[702]
INTERN SKPPGF,END2
INTERN FLG.LI,FLG.HI,FLG.H,FLG.NS.FLG.VX ;FIPS FLAGGER ROUTINES
IFE TOPS20,<
INTERN GETLB9 ;[1023]
>
IFN TOPS20,<
EXTERN RITCRF,CLSCRF,CLZLIB
>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
SALL
;EDITS
;NAME DATE COMMENTS
;V13*****************
;JEH 11-MAY-84 [1525] Allow use of 'STR:filnam.ext[P,PN] to specify
; library file in COPY statement
;JEH 04-May-84 [1524] Don't increment byte pointer into SRCBH before
; storing it in RPLBH+1 for copy replacing
;V12B****************
;DMN 22-Apr-83 [1463] Fix COPY REPLACING when BY and == are not on same line.
;DMN 7-Dec-82 [1440] COPY REPLACING loses terminal period if replacing a numeric literal.
;SMI 17-Sep-82 [1406] COPY REPLACING does not work if continued in A margin.
;RLF 2-Jul-82 [1372] COPY REPLACING does not know == are missing after
; BY for pseudo-text.
;RJD 23-Feb-82 [1342] Handle D in continuation column when scanning for end of literal
;WTK 30-Sep-81 [1314] Continuation character after "(" gives bad subscript.
;JSM 24-Sep-81 [1310] Compiler forgets first of two LIB devices.
;V12A****************
;V12A****************
;JSM 14-Apr-81 [1125] *** NOT INCLUDED, HAS BAD SIDE EFFECTS ***
; COPY REPLACING gives spurious warnings when numeric replacement
; precedes end of statement in DATA DIVISION.
;JEH 04-Mar-81 [1122] Save AC6 when opening second source file.
;JSM 24-Oct-80 [1065] With COPY REPLACING, check for end of library member.
;JSM 24-Oct-80 [1064] With COPY REPLACING don't split a line if the
; only input characters left are "." and line-feed.
;JSM 24-Oct-80 [1063] Special handling for paragraph names and
; 01 level numbers with COPY REPLACING.
;DAW 18-JUL-80 [1036] FIX PRINTING OF SPECIAL CHARS IN THE LISTING
;DMN 29-MAY-80 [1023] FIX VARIOUS PROBLEMS WITH PICTURES IN COPY REPLACING.
;DMN 20-MAY-80 [1022] FIX PROBLEM OF MISSING CHARACTER ON LISTING FILE IN COPY REPLACING.
;DMN 13-MAY-80 [1020] FIX LINE TOO LONG PROBLEM IN COPY REPLACING.
;DMN 25-APR-80 [1015] USE THE CORRECT RIGHT MARGIN ON COPY REPLACING.
;DMN 22-APR-80 [1013] FIX LOOP IF MISSING == ON COPY REPLACING.
;DMN 26-MAR-80 [1001] MAKE ALL "LITERAL" WORK IN COPY REPLACING.
;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] *** NOT USED ***
;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 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
SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,GITM3B ;YES, SEE IF LEGAL FIG-CON
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: SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,[LDB CT,[POINT 6,NAMWRD,5] ;YES, GET FIRST CHAR. OF NAME
CAIL CT,'A' ;SEE IF ALPHABETIC
CAILE CT,'Z'
PUSHJ PP,FLG.HI ;NO, FLAG IT
POPJ PP,]
MOVEI CT,USERN. ;NO
JRST GTITM2 ;RETURN
GITM3B: PUSH PP,CH ;GET AN ACC
MOVE CH,NAMWRD ;GET ACTUAL NAME
CAME CH,[SIXBIT /ZERO/]
CAMN CH,[SIXBIT /SPACE/]
JRST GITM3D ;THESE ARE LOW LEVEL
CAMN CH,[SIXBIT /QUOTE/]
JRST GITM3D ;SO IS THIS
CAME CH,[SIXBIT /HIGH-V/]
CAMN CH,[SIXBIT /LOW-VA/]
SKIPA CH,NAMWRD+1 ;THESE ARE POSSIBLE
JRST GITM3C ;NOTHING ELSE IS
CAME CH,[SIXBIT /ALUE/]
CAMN CH,[SIXBIT /LUE/]
JRST GITM3D ;THESE ARE LOW LEVEL
GITM3C: PUSHJ PP,FLG.HI ;WARN USER
GITM3D: POP PP,CH
POPJ PP,
;IT IS A DEFINED USER WORD
GTITM4: PUSH PP,TA
SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,[LDB CT,[POINT 6,NAMWRD,5] ;YES, GET FIRST CHAR. OF NAME
CAIL CT,'A' ;SEE IF ALPHABETIC
CAILE CT,'Z'
PUSHJ PP,FLG.HI ;NO, FLAG IT
POPJ PP,]
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,MNEMO. ;MNEMONIC?
JRST GTITM9 ;YES
GITM4A: POP PP,DT ;RESTORE DT
JRST GTITM2 ;RETURN
;CODE TABLE FOR USER NAMES
CODTAB: FILEN. ;FILTAB
DATAN. ;DATAB
CONDI. ;CONTAB
0 ;INVALID
PRONM. ;PROTAB
EXTNA. ;EXTAB
0 ;INVALID
MNEMO. ;MNETAB
;MNEMONIC NAME
GTITM9: MOVE TE,1(DT)
TLNN TE,MTCONS ;DEVICE-NAME?
MOVEI CT,SPECN. ;NO
TLNE TE,MTALPA ;ALPHABET-NAME?
MOVEI CT,ALPBN. ;YES
TLNE TE,MTSYMB ;SYMBOLIC-CHARACTER?
MOVEI CT,SYCHN. ;YES
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,FI.NAM## ;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,<
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,CD.NAM##
HLRZ TD,DT
CAIN TE,(TD)
SKIPA CT,[CDNAM.] ;CD-NAME CODE
GTM13A:>
MOVEI CT,RPNAM. ;REPORT-NAME CODE
MOVE TA,DT ;TA_NAMTAB ADDRESS
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. ;[150] RESET A-MARGIN SW
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
HRRZ TA,OPRTR+1 ;GET OPRTR CODE
IFN DBMS,<
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
>
CAIN TA,UDELIM ;ALSO IN "UNSTRING"
JRST GTITM2
CAIN TA,17 ;[*DMN*] ALSO USE FOR DEBUGGING IS OK
JRST GTITM2
SKIPE FLGSW ;FIPS FLAGGER?
CAIN TA,42 ;YES, BUT NOT FOR INSPECT
CAIA
PUSHJ PP,GITM3B ;FLAG ALL AS ILLEGAL
;[1001] ENTER HERE FROM COPY REPLACING TEST IF "ALL FLAG" IS ON
GITM34: PUSHJ PP,GETWRD ;[1001] 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
;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,':'
MOVEI TC,'-'
CAIN TC,';'
MOVEI TC,'.'
IDPB TC,TD
TLNE TD,770000
JRST PTCRF2
SOSG CRFBHO+2
PUSHJ PP,RITCRF
IDPB CH,CRFBHO+1
CAME TE,[POINT 6,NAMWRD+4,35]
JRST PTCRF1
MOVE CH,W2
TLZ CH,377774
SOSG CRFBHO+2
PUSHJ PP,RITCRF
IDPB CH,CRFBHO+1
POPJ PP,
IFE TOPS20,<
RITCRF: 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
DMOVEM LN,SAVBLN
GTWD1B: TSWF FEOF; ;END-OF-FILE?
JRST SETEND ;YES
TSWFZ FECOPY ;ANY LIBRARY TO FINISH UP?
PUSHJ PP,ENDCPY ;YES--DO SO
GTWD1Z: PUSHJ PP,GETCH ;[1314] GET NEXT CHARACTER
CAIE CH,"-" ;[1314] MAKE SURE WEARE NOT
JRST GTWD1Y ;[1314] LOOKING AT A
CAIN CP,7 ;[1314] CONTINUATION CHARACTER
JRST GTWD1Z ;[1314]
GTWD1Y: 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,$HT
JRST GETWD1
DMOVEM LN,WORDLN
SWOFF FNEEDS;
MOVE TE,SAVBLN
JUMPE TE,GTWD1C
MOVEM TE,BLNKLN
MOVE TE,SAVBCP
MOVEM TE,BLNKCP
GTWD1C: MOVE CT,INPTCP
MOVEM CT,INPTST
TSWT FRTST ;[1576] ARE WE READING FOR REPLACEMENT TEST?
JRST GTW1CC ;[1576] NO
DMOVE W1,LIBBH+1 ;[1576] STORE LIB FILE BUFFER HDR
DMOVEM W1,ENDTKN##+1 ;[1576] AT THE POINT WHERE THE TOKEN STARTS,
MOVE CT,RPLBLK ;[1576] NOT AT WHERE THE SCAN FOR THE TOKEN
MOVEM CT,ENDTKN ;[1576] STARTS, COULD BE POINTING TO COMMENT
SKIPE TKNBH+1 ;[1576] HAS THE FIRST TOKEN IN REPLACEMENT
JRST GTW1CC ;[1576] STRING BEEN STORED?
GTW1CD: MOVEM CT,TKNBH## ;[1576] NO
DMOVEM W1,TKNBH+1 ;[1576]
GTW1CC: SETZB CT,LC ;[1576] CLEAR COUNTERS
SETZM SAVBLN
DMOVE PB,[POINT 7,LITVAL
POINT 6,NAMWRD]
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: CAIN CH,"_" ;ALLOW UNDER_SCORE
JRST GTWD5C ;AS EQUIVALENT TO HYPHEN
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
GTWD5C: SKIPE FLGSW ;ARE WE CHECKING FIPS FLAGGER?
PUSHJ PP,FLG.VX ;YES, FLAG AT VAX LEVEL
MOVEI CH,"-" ;CONVERT TO HYPHEN
AOJA LC,GTWD3A ;STASH IT
;TRY FOR NON-NUMERIC LITERAL
GETWD6: CAIN CH,$QT ;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,MAXLIT ; [213] NO--TOO BIG?
AOJA CT,GTWD7B ;NO--INCREMENT AND JUMP
MOVEI DW,E.56 ;YES
CAIN CT,MAXLIT ;HAVE WE PUT OUT DIAG?
PUSHJ PP,FATAL ;NO--PUT IT OUT
AOJA CT,GETWD7 ; [213] COUNT UP OVERSIZED LITERAL
GTWD7B:
IFN ANS82,<
SKIPN FLGSW ;DO WE NEED FIPS FLAGGER?
JRST GTWD7C ;NO, BYPASS THIS TEST
CAIN CT,MXLT74+1 ;IS IT TOO BIG FOR 74 STANDARD?
PUSHJ PP,FLG.8 ;YES, TEST AT 82 LEVEL
CAIN CT,MXLT82+1 ;IS IT TOO BIG FOR 82 STANDARD?
PUSHJ PP,FLG.VX ;YES, FLAG AT VAX LEVEL
GTWD7C:>
CAIGE CH,140
CAIGE CH,40
TLO W1,GWASCI
IDPB CH,PB
JRST GETWD7
;CLOSING QUOTE FOUND
GETWD8: 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,$HT ;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,MAXLIT ; [213] LIMIT LITERAL SIZE
MOVEI CT,MAXLIT ; [213] TO 120 OR 256 CHARS
SWOFF FALIT ;CLOSING QUOTE SEEN
DMOVEM LN,SAVBLN ;UPDATE PTRS TO END OF LITERAL
PUSHJ PP,GTWD18
MOVEM CT,TKNSIZ ;[1576]
AOS TKNSIZ ;[1576] ADD 2 FOR
AOS TKNSIZ ;[1576] OPEN AND CLOSE QUOTES
JRST ENDLIT
;CONTINUATION COLUMN WHEN SCANNING NON-NUMERIC LITERAL
GETWD9: CAIE CH," " ;SPACE?
JRST GTWD9B ;NO
DMOVE 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,$HT ;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,$HT
JRST ENDWRD ;YES--IT IS A SPACE OR A TAB
DMOVEM LN,SAVLN1 ;SAVE LINE NUMBER AND 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: DMOVE LN,SAVLN1
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: DMOVE LN,SAVLN1
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: DMOVE LN,SAVLN1
JUMPN CT,ENDWRD ;ANYTHING SO FAR?
JRST GETWRD
;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
DMOVE 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: SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.HI ;YES, TEST AT HIGH-INTERMEDIATE LEVEL
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 SETPN0 ;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
CAIN CH,":"
MOVSI W1,COLNWD
JUMPN W1,SETPN0
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,SETPN0
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
DMOVEM LN,SAVLN1 ;SAVE LOCATION
POPJ PP,
;RETURN A PERIOD
TESTWD: TSWTZ FREGWD; ;ALSO "REGET WORD"?
JRST TSTWD1 ;NO--SIMPLY RETURN A PERIOD
DMOVEM W1,SAVEWD ;SAVE THAT WORD
MOVE CT,ITEMCT
MOVEM CT,SAVEWD+2
TSTWD1: MOVSI W1,PERWD
POPJ PP,
;PUNCTUATION OF SOME KIND
SETPN0: DMOVE LN,SAVLN1
SKIPE FLGSW ;FIPS FLAGGER?
CAIN CH,"." ;YES, BUT PERIOD IS LEGAL
JRST SETPN2 ;NO
CAIE CH,"(" ;LEFT PAREN IS LEGAL
CAIN CH,")" ;SO IS RIGHT PAREN
JRST SETPN2
PUSHJ PP,FLG.HI ;FLAG ALL OTHERS BELOW HIGH-INTERMEDIATE LEVEL
SETPN1: DMOVE LN,SAVLN1
SETPN2: DPB LN,GWLN
DPB CP,GWCP
DMOVEM LN,WORDLN
POPJ PP, ;RETURN
SETPLS: MOVSI W1,PLUSWD ;PLUS
MOVEI CH,"+"
JRST SETPN0
SETMIN: MOVSI W1,MINWD ;MINUS
MOVEI CH,"-"
JRST SETPN0
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: MOVEM CT,TKNSIZ## ;[1576] Store token size
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: DMOVE LN,WORDLN ;SET "LN" & "CP"
DPB LN,GWLN
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
DMOVEM LN,SAVBLN ;SAVE LOCATION OF THE BLANK
TSWF FRTST ;SEARCHING FOR REPLACEMENT MATCH?
PUSHJ PP,SVLKAR ;YES
SKIPGE RPLBH+0 ;SPECIAL IF READING 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,"D" ;[1342] A DEBUG LINE?
CAIN CH,"d" ;[1342]
TRNA ;[1342]
JRST GETK2A ;[1342] NO--CHECK FOR HYPHEN
MOVEI CH," " ;[1342] REPLACE WITH A SPACE
JRST GETK6 ;[1342] AND RETURN
GETK2A: CAIE CH,"-" ;IS CONTINUATION COLUMN A HYPHEN?
JRST GETK5 ;NO--ERROR
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.HI ;YES, TEST AT HIGH-INTERMEDIATE LEVEL
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,$HT
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
CAIL CP,CPMAXN ;NO, TOO MANY CHARACTERS?
JRST GETCH1 ;YES
;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,$HT ;IS IT A TAB?
JRST GTCH10 ;YES
;CHARACTER OK--LEAVE
GETCH9: MOVE LN,SAVELN ;GET CURRENT LINE
POPJ PP, ;LEAVE
;END OF SOURCE LINE--TOO MANY CHARACTERS
GETCH1: MOVE LN,SAVELN
MOVEI DW,E.82
TSWT FNOCPY ;NO ERROR IF NOT LISTING
PUSHJ PP,FATAL
MOVE CP,SAVECP
GETCH2: PUSHJ PP,GETSRC ;GET NEXT ONE
CAIE CH,$LF ;END OF LINE?
CAIN CH,$FF
JRST FINLIN ;YES
JRST GETCH2 ;NO--LOOP
;SEQUENCED INPUT
GETCH3: CAIGE CH,^D73 ;NO--COLUMN 72 BEEN PASSED YET?
JRST GETCH5 ;NO
GETCH7: CAIE CP,^D81 ;Yes, but are we outside the comment area?
JRST GETCH8 ;Not for the first time
MOVEI DW,E.82
TSWT FNOCPY ;Yes, but no error if not listing
PUSHJ PP,FATAL
GETCH8: PUSHJ PP,GETSRC ;IGNORE REST OF LINE
CAIE CH,$LF
CAIN CH,$FF
JRST FINLIN
JRST GETCH7
;INPUT CHARACTER WAS TAB--BUMP INPTCP
GTCH10: MOVE CH,INPTCP
ADDI CH,1 ;IT ALWAYS POINTS AT PREVIOUS CHARACTER
IORI CH,7
SUBI CH,1
MOVEM CH,INPTCP
MOVEI CH,$HT
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,<
SKIPE FINVOK
JRST FINSK5 ;DBMS
>
LDB CH,SRCBH+1 ;PUT OUT LAST CHARACTER
JRST PUTCPY ; AND RETURN
IFN DBMS,<
FINSK5: LDB CH,DBBUFH+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
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,$HT ; TAB?
JRST GETSQ5 ;YES
CAIN CH,"*" ;NO--COMMENT?
JRST GTSQ10 ;YES
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
;"/" IN COLUMN 7
GTSQ13: LDB CH,$LFPTR ;SEE IF LINE TERMINATOR WAS FF
CAIE CH,$FF ; IF SO LEAVE IT ALONE
MOVEI CH,$VT ;OTHERWISE REPLACE LF BY VT TO SIGNAL "/" IN COL 7.
DPB CH,$LFPTR ;IN BUFFER
MOVEI CH,"/" ;PUT SLASH BACK
JRST GTSQ10 ;AND MAKE A COMMENT
;HERE WITH D IN COLUMN 7
GTSQ14: SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.LI ;YES, TEST AT LOW-INTERMEDIATE LEVEL
GTSQ15: 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
IFE TOPS20,<
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,
;SPECIAL CHARACTER PROCESSING
;CHARACTERS ABOVE CODE 137
;[1036] RUBOUT GETS CONVERTED TO SPACE, ALL OTHERS GET PRINTED
GETSR1: CAIE CH,177 ;[1036] SKIP IF RUBOUT
JRST PUTCIF ;[1036] NO, JUST PUT IN CPY FILE AS IS
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
IN.GT2: SOSGE DBBUFH+2 ;MORE CHARACTERS?
JRST IN.INP ;NO, GET ANOTHER BUFFER
ILDB CH,DBBUFH+1 ;GET CHARACTER
JRST GETSL ;RETURN AS NORMAL
IN.INP:
IFE TOPS20,<
IN DBCHAN,
JRST IN.GT2 ;INPUT OK
GETSTS DBCHAN,CH ;INPUT ERROR
TRNN CH,IO.ERR ;ERRORS?
JRST IN.EOF ;NO, END-OF-FILE
MOVEI CH,DBDEV ;YES, SET UP FOR ABORT
MOVSI TA,'DSK'
MOVEM TA,DBDEV
JRST DEVDED
>
IFN TOPS20,<
PUSHJ PP,GETDBS## ;GET NEXT BUFFER
JRST IN.EOF ;EOF
JRST IN.GT2 ;OK
>
IN.EOF: SETZM FINVOK ;CLEAR INVOKE FLAG
IFE TOPS20,<
SETZM DBBLCK ;[316]
RENAME DBCHAN,DBBLCK ;[316]
CLOSE DBCHAN, ;NOT REALLY NECESSARY
RELEASE DBCHAN,
>
IFN TOPS20,<
PUSHJ PP,CLZDBS## ;CLOSE DBMS INVOKE FILE
>
MOVEI CH,$LF ;RETURN LINE-FEED
SKIPE DBONLY ;[453] WAS /S ON BEFORE?
SWON FSEQ ;[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,$HT ;TAB?
JRST GTSR2B ;NO
MOVEI CH," " ;YES--REPLACE WITH SPACE
PUSHJ PP,GTSR2D
MOVEI CH,$HT
JRST PUTCIF
GTSR2B: CAIE CH,$LF ;LINE-FEED?
CAIN CH,$FF ;NO--FORM-FEED?
POPJ PP, ;YES--RETURN
CAIG CH,$DC4 ;NO--OTHER PRINTER CONTROL?
CAIGE CH,$DLE
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:
IFN TOPS20,<
AOS SRCBFC ;ADD ONE TO BUFFER COUNT
PUSHJ PP,GETSRB## ;GET ANOTHER BUFFER
JRST GTSR3A ;NO MORE SOURCE
SKIPL RPLBH+0
JRST GETSR0
MOVE CH,SRCBH+1
MOVEM CH,RPLBH+1
MOVE CH,SRCBH+2
MOVEM CH,RPLBH+2
JRST GETSR0
>
IFE TOPS20,<
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,IO.ERR
JRST GETSR4 ;NO
RELEASE SRC, ;RELEASE THIS DEVICE
PUSH PP,I1 ;[1122]
PUSHJ PP,STINFL ;SET UP NEXT SOURCE FILE
POP PP,I1 ;[1122]
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
IFE TOPS20,<
RELEASE LIB,
SKIPE CREFSW
CLOSE CRF,
>
IFN TOPS20,<
PUSHJ PP,CLZLIB ;CLOSE ANY LIBRARY FILE
SKIPN CREFSW ;IF /CREF
JRST GTSR3B
PUSHJ PP,RITCRF ;OUTPUT PARTIAL BUFFER
PUSHJ PP,CLSCRF ;AND CLOSE FILE
>
GTSR3B: MOVEI CH,7 ;[352]
MOVEM CH,SRCCOL
GTBLNK: MOVEI CH,$LF ;RETURN A LINE-FEED
POPJ PP,
IFE TOPS20,<
;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,$HT ;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
;[1576] JRST SKPSR4
JRST SKPSR1 ;[1576] character has already been output
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
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.LI ;YES, TEST AT LOW-INTERMEDIATE LEVEL
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
CAIN TYPE,PRIOD. ;ANY MODULE NAME GIVEN?
JRST CPE852 ;NO, 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
MOVE TA,NAMWRD+1 ;GET SECOND WORD AGAIN
TLZ TA,777700 ;AND CHECK FOR MORE THAN 8 CHARS.
JUMPE TA,CPLB0 ;ITS OK, 8 OR LESS
EWARNW E.649 ;TOO MANY, WARN USER
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
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.H ;YES, TEST AT HIGH LEVEL
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]
IFE TOPS20,<
MOVE TC,[POINT 6,NAMWRD]
>
IFN TOPS20,<
MOVE TC,[POINT 7,LIBSPC]
>
CPLB51: ILDB TD,TB
IFE TOPS20,<
CAIN TD,":" ;TEST FOR DEVICE
JRST CPLB58 ;FOUND ONE
CAIN TD,"." ;TEST FOR EXTENSION
JRST CPLB59 ;FOUND ONE TO FOLLOW
>
CAIN TD,"[" ;[PPN]?
JRST CPLB53 ;YES
IFE TOPS20,<
CAIL TD,141 ;IS IT LOWER CASE?
CAILE TD,172 ;...
JRST .+2 ;NO
TRZA TD,100 ;CONVERT LOWER CASE TO SIXBIT
SUBI TD,40 ;CONVERT UPPER CASE TO SIXBIT
IDPB TD,TC
>
IFN TOPS20,<
IDPB TD,TC ;PUT IN LIBSPC
>; END TOPS20
CPLB52: SOJG TA,CPLB51 ;PUT LITERAL IN NAMWRD
IFN TOPS20,<
SETZ TD, ;GET A NULL
IDPB TD,TC ;PUT IT AFTER FILE SPEC
JRST CPLB56
>
;Here when library-name is not a literal.
;For TOPS-10 keep as sixbit name and extension.
;For TOPS-20 convert to Ascii name.ext
CPLB55: HRRZ TB,NAMWRD+1 ;TEST FOR TOO MANY CHARACTERS
SKIPE TB
EWARNW E.650 ;TOO MANY, WARN USER
IFN TOPS20,<
HLLZ TB,NAMWRD+1 ;GET EXTENSION
JUMPN TB,CPLLIB ;IF NONE,
MOVSI TB,'LIB' ; DEFAULT TO .LIB
MOVEM TB,NAMWRD+1 ;
CPLLIB: MOVEI TA,^D9 ;SIZE OF NAME+EXT
MOVE TB,[POINT 6,NAMWRD]
MOVE TC,[POINT 7,LIBSPC##]
CPLB54: ILDB TD,TB
ADDI TD," " ;ASCII
IDPB TD,TC
CAIN TA,4 ;END OF NAME?
JRST [MOVEI TD,"."
IDPB TD,TC
JRST .+1]
SOJG TA,CPLB54
>
IFE TOPS20,<
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 CPLB56 ;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
CPLB56: MOVEM TA,LIBHDR ;STORE NEW FILE NAME
MOVEM TB,LIBHDR+1 ;AND EXTENSION
MOVEI TC,IOSRCS ;GET START OF LIST
CPLB57: HLLZ TD,DEVEXT(TC) ;[1310] GET FILE EXTENSION BY ITSELF
SKIPN TD ;[1310] NULL EXTENSION?
MOVSI TD,'LIB' ;[1310] YES, ALLOW 'LIB' TO MATCH
CAMN TA,DEVFIL(TC) ;SEE IF FILE NAME MATCH
CAME TB,TD ;[1310] AND EXTENSION
JRST CPLB77 ;NO
MOVE TD,DEVSW(TC) ;GET SWITCHES
SOJN TD,CPLB77 ;JUMP IF NOT LIBRARY
MOVE TC,DEVDEV(TC) ;GET DEVICE
JRST CPLB88 ;NOW OPEN IT
>
IFN TOPS20,<
;Test to see if new library is same as one we already have open.
CPLB56: SKIPG LIBJFN ;DO WE HAVE A LIBRARY JFN?
JRST CPLB77 ;NO, SO IT CANNOT MATCH
MOVE TA,[POINT 7,LIBSPC]
MOVE TB,[POINT 7,LIBOSP##] ;OLD SPEC
CPLB59: ILDB TC,TA
ILDB TD,TB
CAME TD,TC
JRST CPLB60 ;NO MATCH
SKIPE TC
JUMPN TD,CPLB59 ;NOT FOUND TERMINAL NULL YET
JRST CPLB0 ;EXACT MATCH
CPLB60: JRST CPLB77 ;NOW OPEN NEW LIBRARY
>
IFE TOPS20,<
CPLB58: MOVE TC,NAMWRD ;GET DEVICE NAME
MOVEM TC,NAMWRD+2 ;STORE IN SAFE PLACE
SETZM NAMWRD ;CLEAR OUT DEVICE
SETZM LIBPP## ;AND [PPN]
SKIPA TC,[POINT 6,NAMWRD]
CPLB59: MOVE TC,[POINT 6,NAMWRD+1]
JRST CPLB52 ;CONTINUE WITH THE SCAN
>;END IFE TOPS20 [1525]
CPLB53: SOJLE TA,CPLB5X ;ERROR
PUSHJ PP,CPLBPP ;GET LHS
SKIPN TC
HLRZ TC,MYPPN## ;GET DEFAULT
HRLZM TC,LIBPP## ;[1525]
CAIE TD,"," ;MUST BE COMMA
JRST CPLB5X ;ERROR
PUSHJ PP,CPLBPP ;GET RHS
SKIPN TC
HRRZ TC,MYPPN
HRRM TC,LIBPP
IFN TOPS20,<
CAIE TD,"]" ;[1525]
JRST CPLB5X ;[1525] NO SFD'S ON TOPS 20
LDB TE,GWVAL ;[1525] GET SIZE OF LITERAL
MOVE TB,[POINT 7,LITVAL] ;[1525] GET STR:
MOVE TC,[POINT 7,LIBSPC] ;[1525] REDEPOSIT
CPLBP2: ILDB TD,TB ;[1525]
CAIN TD,":" ;[1525]
JRST CPLBP3 ;[1525]
IDPB TD,TC ;[1525]
SOJG TE,CPLBP2 ;[1525]
JRST CPLB5X ;[1525] FOUND [P,PN], BUT NO STRUCTURE
CPLBP3: PUSH PP,T1 ;[1525]
PUSH PP,T2 ;[1525]
PUSH PP,T3 ;[1525]
MOVE T1,[POINT 7,LIBSPC] ;[1525] OVERWRITE
MOVE T2,LIBPP## ;[1525]
MOVE T3,T1 ;[1525]
PPNST% ;[1525]
ERJMP CPE607 ;[1525] NOT A VALID [P,PN]
CPLBP4: MOVE TC,T1 ;[1525] POINTS TO NEXT POSIT IN LIBSPC
POP PP,T3 ;[1525] RESTORE THE AC'S
POP PP,T2 ;[1525]
POP PP,T1 ;[1525]
CPLBP5: ILDB TD,TB ;[1525] CONTINUING PICKING UP CHAR UNTIL "["
CAIN TD,"[" ;[1525]
JRST CPLBP6 ;[1525] HIT [,], FINISHED FILE NAME
IDPB TD,TC ;[1525]
SOJG TE,CPLBP5 ;[1525]
JRST CPE285 ;[1525]RESCANNED WHOLE LITERAL, NEVER FOUND "["
CPLBP6: SETZ TA, ;[1525]
JRST CPLB52 ;[1525] NOW GO FIND THE FILE
>; END IFN TOPS20
IFE TOPS20,<
CAIN TD,"]" ;DID IT END CORRECTLY?
JRST CPLB55 ;YES
CAIE TD,"," ;SFD?
JRST CPLB5X ;NO
MOVE TD,[LIBPTH+.PTSFD,,LIBPTH+.PTSFD+1]
SETZM LIBPTH+.PTSFD
BLT TD,LIBPTH+.PTSFD+6 ;CLEAN IT OUT
MOVEI TD,LIBPTH## ;SETUP SFD BLOCK POINTER
EXCH TD,LIBPP
MOVEM TD,LIBPTH+.PTPPN
MOVE TC,[POINT 6,LIBPTH+.PTSFD]
CPLBP2: SOJL TA,CPLB5X
ILDB TD,TB
CAIN TD,"," ;END OF THIS FIELD?
JRST CPLBP3 ;YES
CAIN TD,"]" ;END OF SFD?
JRST CPLB55 ;YES
CAIL TD,141 ;IS IT LOWER CASE?
CAILE TD,172 ;...
JRST .+2 ;NO
TRZA TD,100 ;CONVERT LOWER CASE TO SIXBIT
SUBI TD,40 ;CONVERT UPPER CASE TO SIXBIT
IDPB TD,TC
JRST CPLBP2
CPLBP3: HRLI TC,(POINT 6,) ;START AGAIN
AOJA TC,CPLBP2 ;ON NEXT WORD
>
CPLB5X:
IFE TOPS20,<
OUTSTR [ASCIZ /%Illegal file specification for /] ;[1525]
PUSHJ PP,STLB30
OUTSTR [ASCIZ / - continuing
/]
>
IFN TOPS20,<
PUSH PP,T1
HRROI T1,[ASCIZ /%Illegal file specification for /] ;[1525]
PSOUT%
PUSHJ PP,STLB30
HRROI T1,[ASCIZ / - continuing
/]
PSOUT%
POP PP,T1
>
JRST CPLB55 ;AND CONTINUE
CPLBPP: SETZ TC,
CPLBP1: SOJL TA,CPLB5X ;ERROR IF WE RUN OUT OF DIGITS
ILDB TD,TB
CAIL TD,"0" ;TEST FOR DIGIT (RADIX 8)
CAILE TD,"7"
POPJ PP, ;NO, RETURN
LSH TC,3
IORI TC,-"0"(TD) ;BUILT NUMBER
JRST CPLBP1
IFE TOPS20,<
CPLB77: ADDI TC,DEVSIZ ;INCREMENT TO NEXT
CAIGE TC,SRCEND ;ALL DONE?
JRST CPLB57 ;NOT YET
SKIPN TC,NAMWRD+2 ;DID USER SUPPLY A DEVICE?
MOVSI TC,'DSK' ;NO, ASSUME DSK
CPLB88: MOVEM TC,LIBDEV ;SET IT UP
MOVEM TC,LIBDV## ;SAVE FOR ERROR MESSAGE
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
PUSHJ PP,OPENIT
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
>
IFN TOPS20,<
CPLB77: PUSHJ PP,OPNLIB## ;GET NEW LIBRARY
>
JRST CPLB0 ;SEE WHATS NEXT
CPLB1: CAIE TYPE,REPLA. ;IS IT 'REPLACING'?
JRST CPE286 ;NO, ERROR
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.H ;YES, TEST AT HIGH LEVEL
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'
CAIE TYPE,EQUAL. ;[1406] IS ITEM AN '='?
CAIN TYPE,EQUAL.+AMRGN. ;[1406] POSSIBLY IN A-MARGIN?
TRNA ;[1406] YES, CONTINUE
JRST CPLB21 ;NO
CAIE CH,"=" ;LOOK AHEAD AND CHECK NEXT DELIMITER FOR ==
JRST CPLB21 ;ITS NOT
PUSHJ PP,GETITM ;GET RID OF ==
CAIE TYPE,EQUAL. ;[1406]
CAIN TYPE,EQUAL.+AMRGN. ;[1406]
JRST CPLB20
EWARNW E.605 ;[557] '==' PSEUDO-TEXT DELIMITERS INCORRECT
JRST CPYERR ;[557]
CPLB19: PUSHJ PP,PSTWRI ;WRITE ITEM
CPLB20: CAIE TYPE,PIC.+AMRGN. ;[1576]
CAIN TYPE,PIC. ;PICTURE IS SPECIAL
PUSHJ PP,PSTPIC
PUSHJ PP,GETITM ;GET NEXT ITEM
CAIE TYPE,ENDIT. ;[1372] IS THIS THE END-OF-FILE?
CAIN TYPE,ENDIT.+AMRGN. ;[1372]
JRST CPB36A ;[1372] YES, SOMETHING IS WRONG.
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,SAVELN ;[1013] SAVE LINE # ALSO
MOVEM CH,R1LNO## ;[1013] IN CASE MISSING ENDING ==
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,ENDIT. ;[1013] END-OF-FILE?
CAIN TYPE,ENDIT.+AMRGN. ;[1013]
JRST CPLB36 ;[1013] YES, GIVE ERROR
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,
CPLB35: ILDB CH,TB ;[1463] MAKE SURE WE ARE POSITIONED AT FIRST "="
DPB TC,TB ;[1463] CLEAR CHAR IN ANY CASE
CAIE CH,"=" ;[1463] GOT THERE YET?
JRST CPLB35 ;[1463] NO
IDPB TC,TB ;[1463] YES, REPLACE 2ND = BY NULL
PUSHJ PP,GETITM ;BYPASS ==
PUSHJ PP,GETITM ;GET WHAT FOLLOWS ==
JRST CPLB45
CPLB36: DMOVE LN,R1LNO ;[1013] GET LN & CP OF INITIAL ==
CPB36A: MOVEI DW,E.633 ;[1372] [1013] TELL USER ABOUT MISSING ==
JRST FATAL ;[1013]
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
SETO TB, ;[1576] MAY HAVE BEEN A COUPLE OF TERMINATING
ADJBP TB,SRCBH+1 ;[1576] CHARACTERS SINCE SCAN DOESN'T
LDB TB,TB ;[1576] STOP ON A LINE FEED, SO BACK UP
CAIN TB,$LF ;[1576] THE POINTER AND LOOK
AOS SRCBH+2 ;[1576]
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
DMOVE TC,SRCBH+1
DMOVEM TC,RPLBH+1
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 RPLTS1 ;[1022] NO, SO ALL OK
LDB CH,LIBBH+1 ;[1022] GET LAST CHAR READ IN CASE IT WAS LF
CAIE CH,$LF ;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
PUSHJ PP,BKPCPY ;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL
PUSHJ PP,BKPLIB ;[1022] BACKUP SOURCE IN LIBRARY BUFFER
RPLTS1: PUSHJ PP,RPLSAV ;[1022] 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.
SETZM TKNBH+1 ;[1576] Zero ptr so will store new one
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
SETOM CPYRMW## ;[1023] SIGNAL WE ARE ABOUT TO READ MORE WORDS
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!FECOPY ;[1023] TURN OFF END-OF-FILE SEEN AND REPLACEMENT TEST IN EFFECT
SKIPN NCPYSW ;OK TO OUTPUT TO CPYFIL NOW
SWOFF FNOCPY ;UNLESS FORBIDDEN AT A HIGHER LEVER
PUSH PP,W1 ;[1576] NO AC'S ANYWHERE
MOVE W1,RPLBH+1 ;[1576] WHERE SCAN FOR REPLACEABLE TOKEN STARTS
CAME W1,TKNBH+1 ;[1576] WHERE TOKEN WAS FOUND
MOVE W1,L1CPO ;[1576] GET THE OUTPUT CHAR POSIT BEFORE LOOK-
MOVEM W1,SAVECP ;[1576] AHEAD STARTED TO RESTORE ACTIVE VALUE
PUSHJ PP,WRTCMT ;[1576] WRITE OUT THE DIFFERENCE, PROB. COMMENT
MOVE W1,TKNSIZ ;[1576] SIZE OF LAST TOKEN SCANNED
HLRZ CH,TE ;[1576] GET COPY OF W1, LOOK AT FLAGS
CAIE CH,GWRESV.+PRIOD. ;[1576] WAS LAST MATCH FOR A PERIOD?
SOS W1 ;[1576] SUBTRACT 1 SINCE BPTR WILL BE ADVANCED
MOVE CH,W1 ;[1576]
ADJBP W1,ENDTKN+1 ;[1576] POINT AT END OF LAST REPLACED TOKEN
CAMLE CH,ENDTKN+2 ;[1576] ALL IN SAME BUFFER?
JRST [SUB CH,ENDTKN+2 ;[1576] NO - ADJUST BUFFER HEADER
AOS ENDTKN+0 ;[1576] ADVANCE BLOCK NUMBER
MOVNS CH ;[1576] RESET COUNT OF UNPROCESSED
ADDI CH,1200 ;[1576] CHARACTERS
MOVEM CH,ENDTKN+2 ;[1576]
SUBI W1,200 ;[1576] BACK UP BYTE POINTER
JRST .+1] ;[1576]
CAMN W1,LIBBH+1 ;[1576] IF MATCHES, NO TRAILING COMMENT, ETC.
SETZ W1, ;[1576] SO ZERO THE BYTE POINTER
MOVEM W1,ENDTKN+1 ;[1576] STORE IN BUFFER HEADER
POP PP,W1 ;[1576]
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
IFE TOPS20,<
USETI LIB,(TE)
IN LIB,
PSTR4A: SKIPA TE,L2BH1 ;OK
JRST GETLB9
>
IFN TOPS20,<
SKIPE TE ;
SOS TE ;CONVERT TO WORD ADDRESS
LSH TE,7 ;
PUSHJ PP,SFPLIB## ;SET FILE POINTER
PUSHJ PP,GETLBA## ;FILL BUFFER
PSTR4A: MOVE TE,L2BH1
>
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 TD,1(CT) ;[1020] GET COUNTS
SETZ TE, ;[1020]
LSHC TE,9 ;[1020]
MOVEM TE,R1CPO ;[1020] SAVECP BEFORE
SETZ TE, ;[1020]
LSHC TE,9 ;[1020]
MOVEM TE,R1CPI ;[1020] INPTCP BEFORE
LSH TD,-9 ;[1020]
HLRZM TD,R2CPO ;[1020] SAVECP AFTER
LSH TD,-9 ;[1020]
ANDI TD,777 ;[1020]
MOVEM TD,R2CPI ;[1020] INPTCP AFTER
MOVE CP,R1CPO ;GET WHERE OUTPUT STARTS FOR REPLACEMENT
ADD CP,RPLBH+2 ;WHERE IT ENDS
CAIL CP,CPMAXN ;[1015] WOULD LINE BE TOO LONG?
JRST PSTR4C ;[1015] YES, START NEW ONE
TSWF FSEQ ;[1015] IF SEQUENCED INPUT WORRY ABOUT RIGHT MARGIN
CAIGE CP,^D73 ;[1015] ARE WE IN THE COMMENT FIELD?
SKIPA CP,SAVECP ;[1015] NO, WHERE WE ARE NOW
JRST PSTR4C ;YES, TOO BAD
ADD CP,RPLBH+2
CAIG CP,^D72 ;WILL THAT TAKE US INTO COMMENT FIELD?
JRST PSTRD5 ;NO, JUST REPLACE WHERE WE ARE
TSWF FSEQ ;[1015] IF NOT SEQUENCED THEN THE LINE IS LONGER
JRST PSTR4C ;[1015] SEQUENCED, TOO BAD
CAIGE CP,CPMAXN ;[1015] WOULD LINE STILL BE TOO LONG?
JRST PSTRD5 ;[1015] NO
PSTR4C: MOVE CP,R1CPO ;GET REPL. START
SUB CP,SAVECP ;GET DIFF BETWEEN LIBRARY AND REPLACEMENT
JUMPLE CP,[MOVEI CH,$LF ;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: 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
SKIPN CPYRMW ;[1023] DID WE READ MULTIPLE WORDS?
JRST PSTRD1 ;[1023] NO,TRY AGAIN
TRNA ;[1023] YES, WE MUST BACKUP FIRST
PSTRD9: SETZM CPYRMW ;[1023] USE THIS TO SIGNAL FAILED TO FIND MATCH
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
IFE TOPS20,<
USETI LIB,(TE) ;NO, RESET ON OLD BLOCK
IN LIB,
PSTR10: SKIPA TE,RPLBH+1 ;OK, GET BYTE PTR
JRST GETLB9 ;ERROR
>
IFN TOPS20,<
SKIPE TE ;
SOS TE ;CONVERT TO WORD ADDRESS
LSH TE,7 ;
PUSHJ PP,SFPLIB## ;SET FILE POINTER
PUSHJ PP,GETLBA## ;FILL BUFFER
PSTR10: MOVE TE,RPLBH+1
>
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 FREGCH!FREGWD!FGTPER!FECOPY ;[1023]
SKIPE CPYRMW ;[1023] ARE WE JUST RESTORING THE SOURCE?
JRST PSTR12 ;[1023] YES, THEN WE WILL TRY TO MATCH SOME MORE
SWOFF FNOCPY!FRTST ;[1023] NO, RESET FLAGS SO REAL READ TAKES PLACE
MOVE TE,RPLLOC ;POINT TO START
MOVEM TE,RPLNXT
ADDI TE,1 ;POINT TO FIRST WORD
MOVEM TE,RPLNXW
PSTR12: SETZM CPYRMW ;[1023] CLEAR COUNTER
JUMPN CP,PSTR11 ;[1001] OK IF IN MIDDLE OF LINE
PUSHJ PP,GETSEQ ;WORRY ABOUT SEQ NUMBER
SWON FREGCH ;REGET LAST CHAR
PSTR11: TLNE W1,GWALL ;[1001] WAS "ALL" SEEN BEFORE CURRENT ITEM?
JRST GITM34 ;[1001] YES, RESET FLAG AGAIN
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
CPE607: POP PP,T3 ;[1525]
POP PP,T2 ;[1525]
POP PP,T1 ;[1525]
EWARNW E.607 ;[1525] CAN'T TRANSLATE [P,PN]
JRST CPYERR ;[1525]
CPE852: EWARNW E.852 ;'NO MODULE NAME FOUND'
SWOFF FNOCPY ;
JRST CPYER1 ;DON'T SKIP NEXT SOURCE
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
CPYER1: 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
;[1576] Write out comment preceding/following replaced token to cpyfil
WRTCMT: ;[1576]
PUSH PP,TE ;[1576] GET SOME AC'S
PUSH PP,W1 ;[1576]
PUSH PP,W2 ;[1576]
MOVE TE,RPLBH+0 ;[1576] GET THE BLOCK NBR WHERE TEXT STARTED
CAMN TE,RPLBLK ;[1576] DOES IT MATCH THE CURRENT NBR?
JRST WTCMT2 ;[1576] YES
WTCMT1: MOVE TE,RPLBH ;[1576] PUT IT IN TE
PUSHJ PP,WTSTBF ;[1576] BACK UP THE LIBRARY FILE
AOS RPLBH+0 ;[1576]
WTCMT2: SOSG RPLBH+2 ;[1576] DECREMENT AVAILABLE CHARACTER COUNT
JRST WTCMT1 ;[1576] NO MORE, GET ANOTHER BUFFER FULL
IBP RPLBH+1 ;[1576] ADVANCE THE BYTE POINTER
MOVE CH,RPLBH+1 ;[1576] HAVE WE PROCESSED ALL THE CHARACTERS
CAMN CH,TKNBH+1 ;[1576] UP TO THE TOKEN TO BE REPLACED?
JRST WTCMT4 ;[1576] YES
MOVE CH,@RPLBH+1 ;[1576] NO, LOOK AT THE CONTENTS OF THE WORD
TRNN CH,1 ;[1576] IS IT A LINE NUMBER WORD?
JRST WTCMT3 ;[1576] NO, LIBRARY TEXT
JUMPL CH,WTCMT4 ;[1576] END OF PROGRAM?
MOVNI CH,5 ;[1576] NO--JUMP OVER 5 CHARACTERS
ADDB CH,RPLBH+2 ;[1576]
JUMPLE CH,WTCMT1 ;[1576] JUMP IF BUFFER NOW EMPTY
AOS RPLBH+1 ;[1576] IT ISN'T--BUMP BYTE POINTER
MOVEI CH,40 ;[1576] PUT OUT SIX BLANKS
MOVNI TE,6 ;[1576]
PUSHJ PP,PUTCPY ;[1576]
AOJN TE,.-1 ;[1576]
MOVE CH,RPLBH+1 ;[1576] HAS THE BYTE POINTER NOW BEEN ADVANCED
CAMN CH,TKNBH+1 ;[1576] TO THE TOKEN TO BE REPLACED?
JRST WTCMT4 ;[1576] YES
WTCMT3: LDB CH,RPLBH+1 ;[1576] LOAD A LIBRARY TEXT CHARACTER
JUMPE CH,WTCMT2 ;[1576]
AOS L1CPI ;[1576] ADVANCE INPUT CHAR START POSITION
PUSHJ PP,PUTCIF ;[1576] WRITE OUT THE CHAR. TO CPYFIL
JRST WTCMT2 ;[1576]
WTCMT4: MOVE TE,SAVECP ;[1576] PUT THE NEW OUTPUT CHAR POSITION
MOVEM TE,L1CPO ;[1576] IN COPY REPLACING PLACE HOLDER
MOVE TE,RPLBLK ;[1576] IF LIBBH+1 POINTS TO A DIFFERENT
CAME TE,TKNBH+0 ;[1576] BUFFER, RELOAD IT NOW
PUSHJ PP,WTSTBF ;[1576]
POP PP,W2 ;[1576] RESTORE AC'S
POP PP,W1 ;[1576]
POP PP,TE ;[1576]
POPJ PP, ;[1576]
WTSTBF: PUSH PP,LIBBH ;[1576] SAVE CURRENT LIB FILE BUFFER HEADER
PUSH PP,LIBBH+1 ;[1576]
PUSH PP,LIBBH+2 ;[1576]
IFE TOPS20,<
USETI LIB,(TE) ;[1576]
IN LIB, ;[1576]
SKIPA TE,LIBBH+1 ;[1576] OK
JRST GETLB9 ;[1576] ERROR
>
IFN TOPS20,<
SKIPE TE ;[1576]
SOS TE ;[1576] CONVERT TO WORD ADDRESS
LSH TE,7 ;[1576]
PUSHJ PP,SFPLIB## ;[1576] SET FILE POINTER
PUSHJ PP,GETLBA## ;[1576] FILL BUFFER
>
DMOVE W1,LIBBH+1 ;[1576] PUT THE ACTIVE BUFFER HEADER
SKIPG RPLBH+2 ;[1576] INTO THE REPLACEMENT BUFFER HEADER
DMOVEM W1,RPLBH+1 ;[1576]
POP PP,LIBBH+2 ;[1576] RESTORE THE LIB FILE'S ACTUAL HEADER
POP PP,LIBBH+1 ;[1576]
POP PP,LIBBH ;[1576]
POPJ PP, ;[1576]
;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
IFE TOPS20,<
IN LIB, ;GET ANOTHER BUFFER FULL
JRST GETLB2
GETSTS LIB,CH ;END-FILE?
TRNE CH,IO.ERR
JRST GETLB9 ;NO--TROUBLE
>
IFN TOPS20,<
PUSHJ PP,GETLBA ;GET NEXT BUFFER
JRST GETLB2
>
GETLB5: SETOM LIBBH+2 ;[557] FORCE COUNT FINISHED
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
TSWT FRTST ;[1023] JUST DOING REPLACEMENT CHECK?
SWOFF FRLIB
; SWOFF FPERWD ;[1125] TURN OFF FLAG TO RETURN NON-EXISTENT PERIOD
JRST GTBLNK
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,
;[1576] Have now finished replacing token. If there is a trailing comment,
;[1576] copy it now.
GETCP4: ;[1576]
MOVE CH,ENDTKN+1 ;[1576] POINTER TO END OF REPLACED TOKENS
JUMPE CH,GTCP4B ;[1576] CONTINUE
CAMN CH,LIBBH+1 ;[1576] IF NO TRAILING DATA
JRST GTCP4B ;[1576]
HRLZI CH,ENDTKN ;[1576] COPY TRAILING BUFFER HEADER
HRRI CH,RPLBH ;[1576] INTO REPLACEMENT BUFFER HEADER
BLT CH,RPLBH+2 ;[1576]
MOVEI CH,1 ;[1576] BACK UP LIB FILE POINTER BY ONE
ADJBP CH,LIBBH+1 ;[1576] AND STORE IN TKNBH+1 TO MARK
MOVEM CH,TKNBH+1 ;[1576] WHERE TO STOP COPY
PUSHJ PP,WRTCMT ;[1576] WRITE OUT TRAILING DATA
MOVE CH,INPTCP ;[1576] REPLACE INPUT CHAR POSITION AFTER COPY
MOVEM CH,L2CPI ;[1576] WITH NEW ACTUAL COUNT FOR PADDING CALC
GTCP4B: SWOFF FCOPY ;[1576] 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
;[1064] Check for "." and line-feed as only remaining characters in the
;[1064] input library member line before splitting the line in the output
;[1064] listing. We have to look ahead 2 characters.
IFN DEBUG,<
SKIPG LIBBH+2 ;Can we look ahead?
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1064] Get byte pointer to library buffer.
ILDB CH,CH ;[1065] Look ahead to next character.
CAIE CH,"." ;[1064] Is it a "."?
JRST GTCP4L ;[1064] No, go on to check for split line.
IFN DEBUG,<
MOVE CH,LIBBH+2 ;Can we look ahead
SOSGE CH ;2 characters?
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1064] Get byte pointer to library buffer again.
IBP CH ;[1064] Need to look 2 ahead now.
ILDB CH,CH ;[1064] Get the character 2 ahead.
CAIE CH,$LF ;[1064] Is the next char. a line-feed?
JRST GTCP4L ;NO, BREAK THE LINE IN TWO
; JRST [TSWF FCLAS1 ;[1125] Yes, are we processing numeric literal?
; SWON FPERWD ;[1125] Yes, set flag to return non-existent period
; JRST GETLIB] ;[1125] [1064] Go pick up a "." for list.
MOVEI CH,"." ;[1440] STORE PERIOD SO WE WILL STOP SCAN
MOVEM CH,TERSCN ;[1440] ON PERIOD IN CASE OF NUMERIC LITERAL
JRST GETLIB ;[M1125] [1064] Yes, go pick up a "." for real.
;[1064] No, go to do split-line stuff
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
;[1065] We have to check for end of library copy member in COPY REPLACING,
;[1065] as well as in vanilla COPY, otherwise COPY REPLACING will overflow
;[1065] into the next available library copy member.
GTCP4Z: SKIPG LIBBH+2 ;Can we look ahead?
IFE DEBUG,<
JFCL ;No, ignore problem for now
>
IFN DEBUG,<
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1065] Get byte pointer to library buffer.
ILDB CH,CH ;[1065] Look ahead to next character.
CAIN CH,177 ;[1065] From -1 terminator word?
JRST GETLB5 ;[1065] Yes, go put "." in output and clean up end of copy.
MOVEI CH,$LF ;START NEW LINE
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
IFE TOPS20,<
SKIPN SRCDEV ;[352] ANY MORE SOURCE CHARS?
>
IFN TOPS20,<
SKIPN SRCJFN##
>
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
IFE TOPS20,<
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
>
IFN TOPS20,<
SKIPG LIBJFN ;DO WE HAVE A LIBARY FILE YET?
PUSHJ PP,OPNLIB ;NO, TRY DEFAULT
SKIPG LIBJFN## ;DO WE HAVE ONE NOW?
JRST STLB20 ;NO LIBRARY FILE
SETZ TE, ;START AT BEGINNING OF FILE
PUSHJ PP,SFPLIB## ;SET FILE POINTER
PUSHJ PP,GETLBA## ;FILL BUFFER
DMOVE TC,LIBNAM ;GET LIBRARY ROUTINE NAME
>
LSHC TC,-6
TRZ TB,-1
LSH TB,-1
IFE TOPS20,<
MOVE TA,LIBBH+1 ;SET TA TO POINT TO ROUGH-TABLE
>
IFN TOPS20,<
SOS TA,LIBBH+1 ;WE USE 440700 TYPE BYTE POINTER
>
DMOVE TE,1(TA) ;COMPARE LIBNAM TO FIRST ENTRY
PUSHJ PP,SETLBC
CAIA ;EQUAL
JRST SETLB4 ;GREATER
IFE TOPS20,<
MOVEI TE,2 ;LESS, SET USETI WORD
>
IFN TOPS20,<
MOVEI TE,200 ;LESS, SET SFPTR% WORD
>
JRST SETL5A
IFE TOPS20,<
SETLBE: GETSTS LIB,CH ;[655] GET ERROR STATUS
TRNN CH,IO.ERR ;[655] END-OF-FILE?
OUTSTR [ASCIZ /Premature end-of-file found on library file
/]
; JRST GETLB9 ;[655] CONTINUE WITH STANDARD ERROR MESSAGE
GETLB9: MOVEI CH,LIBDEV ;ERROR ON LIBRARY DEVICE
JRST DEVDED
>
;SEARCH ROUGH-TABLE
SETLB4: ADDI TA,2
DMOVE TE,1(TA)
PUSHJ PP,SETLBC
JRST SETLB5
JRST SETLB4
SKIPA TE,0(TA) ;ITEM FOUND--GET ADDRESS
SETLB5: MOVE TE,2(TA)
TLZ TE,777700
IFE TOPS20,<
LSH TE,-7
ADDI TE,1
>
;AN APPROPRIATE ROUGH-TABLE ENTRY HAS BEEN LOCATED.
SETL5A:
IFE TOPS20,<
USETI LIB,(TE) ;READ IN FINE-TABLE
IN LIB,
SKIPA TA,LIBBH+1 ;SET UP AN IOWD TO FINE TABLE
JRST SETLBE ;[655] ERROR
>
IFN TOPS20,<
PUSHJ PP,SFPLIB ;SET FILE POINTER
PUSHJ PP,GETLBA ;GET A BUFFER FULL
SOS TA,LIBBH+1 ;WE USE 440700 TYPE BYTE POINTER
>
HRLI TA,-^D64
;SEARCH THE FINE TABLE
SETLB6: DMOVE TE,1(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
IFE TOPS20,<
USETI LIB,(TE)
IN LIB,
AOSA LIBBH+2
JRST SETLBE ;[655] ERROR
>
IFN TOPS20,<
SKIPE TE ;
SOS TE ;CONVERT BACK TO WORD ADDRESS
LSH TE,7
PUSHJ PP,SFPLIB ;SET FILE POINTER
PUSHJ PP,GETLBA ;GET A BUFFER FULL
AOS LIBBH+2 ;INCREMENT COUNT BECAUSE OF WAY WE READ FILE
>
MOVEI TE,0
LSHC TE,7
ADDM TE,LIBBH+1
IMULI TE,5
MOVNS TE
ADDM TE,LIBBH+2
SWON FRLIB
MOVEI CH,$LF
SETL8A: PUSHJ PP,PUTCPY ;PUT LF IN CPY FILE SO LISTING LOOKS OK
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 ;[156] NO, GET BACK THIS FIRST CHAR LATER
TSWTZ FREGCH ;[1022] IF FREGCH IS ON THEN MAYBE WE JUST SAW CR-LF
JRST SETLB9 ;[1022] NO, SO ALL OK
LDB CH,LIBBH+1 ;[1022] GET LAST CHAR READ IN CASE IT WAS LF
CAIE CH,$LF ;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
SETLB9: PUSHJ PP,BKPCPY ;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL
;[1063] When we begin a new line under COPY REPLACING usually we just
;[1063] back up one character in the library buffer and march on.
;[1063] However, with procedure division paragraph names and 01 level numbers
;[1063] there are some problems with synchronization.
LDB CH,LIBBH+1 ;[1063] Get current char. from lib buffer
CAIN CH,$LF ;[1063] Is it a line-feed?
JRST SETL8A ;[1063] Yes, put it out to output buffer
TSWF FRLIB ;No, did the copy library end already?
JRST [PUSHJ PP,BKPLIB ;[1063] No, back up lib buffer
JRST RPLSAV] ;[1063] Save required items and return
SWOFF FECOPY ;Cleanup the flags
SETZM RPLCNT ;Things work better if not replacing
POPJ PP, ;Just return
SETL9B: MOVE CT,PHASEN ;[1063] Find if we are in DATA DIVISION.
CAIN CT,"C" ;[1063]
TSWF FLETTR ;[1063] Yes, but if it contains a non-digit it is not a level number.
PUSHJ PP,BKPCPY ;[1063] Back up the output COPY buffer.
PJRST RPLSAV ;SAVE REQUIRED ITEMS AND RETURN
;GET A LIBRARY PROGRAM (CONT'D).
;ERRORS
;NO LIBRARY FILE
STLB20:
IFE TOPS20,<
OUTSTR [ASCIZ "%Library file "]
PUSHJ PP,STLB30 ;PRINT DEV:FILE.EXT
OUTSTR [ASCIZ " not found - continuing
"]
>
IFN TOPS20,<
PUSH PP,T1
HRROI T1,[ASCIZ "%Library file "]
PSOUT%
MOVEI T1,.PRIOU
HRROI T1,LIBSPC ;ASSUME WE HAVE ONE
SKIPN LIBSPC ;IF NOT TYPE DEFAULT
HRROI T1,[ASCIZ /LIBARY.LIB/]
PSOUT%
HRROI T1,[ASCIZ " not found - continuing
"]
PSOUT%
POP PP,T1
>
MOVEI DW,E.75
IFE TOPS20,<
MOVE CP,LIBHDR ;[557] GET LIBRARY NAME
CAME CP,['LIBARY'] ;[557] JUST THE DEFAULT
>
IFN TOPS20,<
SKIPN LIBSPC
>
MOVEI DW,E.607 ;[557] NO, THEREFORE WE FAILED TO FIND IT
JRST STLB29
;PROGRAM NOT FOUND
STLB21:
IFE TOPS20,<
OUTSTR [ASCIZ "%Library routine "]
>
IFN TOPS20,<
PUSH PP,T1
HRROI T1,[ASCIZ "%Library routine "]
PSOUT%
>
MOVE TA,[POINT 6,LIBNAM]
STLB22: ILDB TE,TA ;CONVERT ALL ':' BACK TO '-'
JUMPE TE,STLB23 ;FINISHED
CAIE TE,':'
JRST STLB22
MOVEI TE,'-'
DPB TE,TA
JRST STLB22
STLB23: MOVE TA,LIBNAM
PUSHJ PP,SIXOUT
MOVE TA,LIBNAM+1
PUSHJ PP,SIXOUT
IFE TOPS20,<
OUTSTR [ASCIZ " in "]
PUSHJ PP,STLB30 ;PRINT DEV:FILE.EXT
OUTSTR [ASCIZ " not found - continuing
"]
>
IFN TOPS20,<
HRROI T1,[ASCIZ " in "]
PSOUT%
PUSHJ PP,STLB30 ;PRINT DEV:FILE.EXT
HRROI T1,[ASCIZ " not found - continuing
"]
PSOUT%
POP PP,T1
>
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
STLB30:
IFE TOPS20,<
PUSH PP,LIBDEV ;SAVE CURRENT DEVICE (USUALLY ZERO TO INDICATE ERROR)
SKIPN TA,LIBDV## ;GET DEVICE
MOVSI TA,'DSK'
MOVEM TA,LIBDEV ;SETUP THE CORRECT DEVICE
MOVEI DA,LIBDEV ;POINT TO DATA BLOCK
PUSHJ PP,FILOUT## ;TYPE THE FULL FILE SPEC
POP PP,LIBDEV
>
IFN TOPS20,<
;NOTE, ON ENTRY T1 HAS ALREADY BEEN SAVED
PUSH PP,T2
PUSH PP,T3
MOVEI T1,.PRIOU ;OUTPUT TO TERMINAL
MOVE T2,LIBJFN##
SETZ T3,
JFNS%
ERJMP .+1
POP PP,T3
POP PP,T2
>
POPJ PP,
;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
SUBTTL FIPS FLAGGER TESTS
FLG.LI: PUSH PP,CH ;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.LI ;GET FLAG LEVEL OF LOW-INTERMEDIATE
JRST FLG.X ;MAKE THE TEST
FLG.HI: PUSH PP,CH ;SAVE THE CHAR. (, OR ;)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.HI ;GET FLAG LEVEL OF HIGH-INTERMEDIATE
JRST FLG.X ;MAKE THE TEST
FLG.H: PUSH PP,CH ;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.H ;GET FLAG LEVEL OF HIGH
FLG.X: ANDCM TA,FLGSW ;CLEAR THE BITS WE ALLOW
SKIPE TA ;IS THIS WITHIN LIMITS?
PUSHJ PP,FLG.ES## ;NO
POP PP,TA
POP PP,CH
POPJ PP,
FLG.NS: PUSH PP,CH ;SAVE THE CHAR.
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.NS ;GET FLAG LEVEL OF NON-STANDARD
JRST FLG.X ;MAKE THE TEST
FLG.8: PUSH PP,CH ;SAVE THE CHAR.
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.8 ;GET FLAG LEVEL OF ANS-8x COMPATABILITY
JRST FLG.X ;MAKE THE TEST
FLG.VX: PUSH PP,CH ;SAVE THE CHAR.
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.VX ;GET FLAG LEVEL OF VAX COMPATABILITY NON-STANDARD
JRST FLG.X ;MAKE THE TEST
SUBTTL EXTERNALS
IFE TOPS20,<
EXTERN DEVDED,CRFDEV,LIBDEV,LIBHDR,SRCDEV,SRCEND,STINFL,OPENIT,CPYBHO,CRFBHO
EXTERN IOSRCS,DEVFIL,DEVDEV,DEVEXT,DEVSW,DEVSIZ
EXTERN DEVBH
>
IFN TOPS20,<
EXTERN CPYBH,CRFBH
SYN CPYBH,CPYBHO
SYN CRFBH,CRFBHO
>
EXTERN FATAL,WARN,TRYNAM
EXTERN PUTCPY,PUTCIF,PUTFEL,SIXOUT,LNKSET
EXTERN CURCPY,LIBBH,LIBNAM
EXTERN RPLCNT,RPLLOC,RPLNXT
EXTERN GETENT,PHASEN,OPRTR,DCPNT.
EXTERN PSCAN,PICBUF,PICPTR
EXTERN SRCBH,CREFSW,CPMAXN
EXTERN SEQIN
EXTERN WASERC,PUNPTR,PLUSWD,MINWD,MULWD,LPARWD,EXPWD,PERWD,ENDIT
EXTERN COLNWD
EXTERN NAMWRD,LITVAL,NAMVAL,FILLOC,FILNXT
EXTERN GWNAMP,GWVAL,GWLN,GWCP
EXTERN CPOPJ,CPOPJ1
IFN DBMS,<
EXTERN FINVOK,DBBUFH,DBONLY
IFE TOPS20,<
EXTERN DBDEV,DBBLCK
>>
IFN MCS,<
EXTERN CDLOC,CDNXT
>
EXTERN NOIDHY,DEBSW
EXTERN $LFPTR
;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. MATCHES 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 STORED 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