Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/cobola.mac
There are 7 other files named cobola.mac in the archive. Click here to see a list.
; UPD ID= 816 on 2/8/83 at 4:12 PM by NIXON
TITLE COBOLA FOR COBOL V13
SUBTTL COBOL INITIALIZATION AL BLACKINGTON/CAM
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
%%P==:%%P
DBMS==:DBMS
DEBUG==:DEBUG
MPWCEX==:MPWCEX
ONESEG==:ONESEG
IFE TOPS20,<SEARCH MACTEN,UUOSYM>
IFN TOPS20,<SEARCH MONSYM,MACSYM>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
SALL
IFE TOPS20,<
DEFINE TYPE(ADDR),<
OUTSTR ADDR
>>
IFN TOPS20,<
DEFINE TYPE(ADDR),<
PUSH PP,T1
HRROI T1,ADDR
PSOUT%
POP PP,T1
>>
ENTRY COBOLA
IFN TOPS20,<
INTERN SETIMP ;CLEAR IMPURE AREA
>
EXTERN AS7482,SAVJFF,CREFSW
IFE TOPS20,<
EXTERN COMBH,DEVBH,DEVDEV,DEVEXT,DEVFIL,IOCHAN,LSTDEV,OPENIT
>
;EDIT HISTORY
;V12B****************
;NAME DATE COMMENTS
;DMN 3-Dec-82 [1435] Prevent TI wait state after error message is printed.
;V12*****************
;NAME DATE COMMENTS
;CLRH 31-MAY-79 [713] DO TMPCOR IN THE RIGHT ADDRESS IF CORE UUO IS NEEDED.
;DMN 19-SEP-78 [556] FIX GETTAB 135 IF FILDAEMON IS TURNED OFF
;V10*****************
;NAME DATE COMMENTS
;EHM 2-MAR-78 [530] FIX COMMAND SCANNER TO LOOK FOR NUL FILE
; IF USER TYPES =FILE.
;SSC 28-SEPT-77 ADDED KEYWORDS FOR DBMS-V6: TRANSACTION, VIA, MEMBERS
;SSC 29-JUL-76 ADDED KEYWORD JOURNAL FOR DBMS S. U.
;GPS 12/23/74 ADD KEYWORDS FOR SIMULTAUEOUS UPDATE
;ACK 12-JAN-75 1. ALTMODE/BACKARROW CODE REMOVAL.
; 2. "/X" CODE FOR EBCDIC/COMP-3.
; 3. "/D:SIZE" SWITCH FOR MULTIPLE PERFORMS.
; 4. ADD KEYWORDS "STANDARD-ASCII" AND "FILE-STATUS".
;SSC MAR-5-75 PUT 6A EDIT %316 DIRECTLY INTO V10
;********************
; EDIT 344 FIX "DSK NOT DSK MSG IF NO COMMAND FILE.
; EDIT 255 FIX TO ALWAYS ACCEPT LC LETTERS IN COMMAND STRING
; EDIT 144 FIXES DSK IS NOT THE DSK
;TOPS-10 programs start here.
;TOPS-20 programs start in COBSCN and call here to start phase A.
COBOLA:
IFE TOPS20,<
PORTAL START ;COMMANDS FROM TTY
PORTAL COMDSK ;COMMANDS FROM DISK
PORTAL COBLAR ;RESTART
IFN ONESEG,<
;RESTART DUE TO "START" CONSOLE COMMAND
REDO: MOVEI SW,0
;RESTART DUE TO "REENTER" CONSOLE COMMAND
; ALSO USED BY COBOLG, COBOLK, AND QUITS [506]
RESTRT: TSWF FECOM; ;ANY MORE COMMANDS?
CALLI $EXIT ;NO--QUIT
AND SW,[EXP FDSKC] ;TURN OFF ALL FLAGS EXCEPT FDSKC
JRST COBLAR ;RESTART
>
START:
IFE ONESEG,<
SKIPN 11 ;[144] CHECK RUN-TIME DEVICE
MOVSI 11,'DSK' ;[144] IF NONE USE DSK
MOVEM 7,RUNPPN## ;SAVE DEV AND PPN OF RUN COMMAND
MOVEM 11,RUNDEV##
>
START1: SETZB SW,CCLSW## ;CLEAR FLAGS AND SIGNAL ENTERED FROM NORMAL ENTRY POINT
;START A NEW COMPILATION
COBLAR: TSWF FDSKC ;INPUT COMMAND FROM TTY?
JRST COBLAS ;NO
OPEN COM,[.IOASL ;GET TTY FOR COMMAND CHANNEL
SIXBIT /TTY/
XWD 0,COMBH##]
HALT .-1 ;NO TTY?
INBUF COM,2 ;GET 2 COMMAND BUFFERS
SETZM SAVJFF ;IF RESTART, FORCE SAVING JOBFF
;ENTER HERE FROM CCL ENTRY POINT, ALL PATHS REJOIN HERE
COBLAS:
IFE ONESEG,<
MOVE TA,RUNDEV ;IS RUN DEVICE REALLY A DISK?
DEVCHR TA,
TXNN TA,DV.DSK
JRST NOTDSK ;NO--ERROR
> ;END IFE ONESEG
SKIPN TA,SAVJFF ;SAVE JOBFF IF IT WASN'T DONE ALREADY
MOVE TA,.JBFF
MOVEM TA,SAVJFF
MOVEM TA,.JBFF ;RESTORE JOBFF
; ZERO ALL OF FREE CORE
CAMG TA,.JBREL##
SETZM (TA)
AOS TA
HRL TA,.JBFF##
HRRZ TB,.JBREL
CAMLE TB,.JBFF
BLT TA,(TB)
>;END IFE TOPS20
;SET UP IMPURE AREA.
;GET RID OF LEADING CARRIAGE-RETURNS IN COMMAND STRING.
SETFAZ A;
IFE TOPS20,<
TSWT FDSKC ;[266] DSK INPUT FOR COMMANDS
PUSHJ PP,TTYON## ;[266] NO, TURN ON TTY IF USER TYPED CONT O
PUSHJ PP,SETIMP ;SET UP IMPURE AREA
>;END IFE TOPS20
PUSHJ PP,GETDT ;SET UP DATE, TIME AND DEFAULT PATH
PUSHJ PP,GETVER ;SET UP VERSION NUMBER
IFE TOPS20,<
TYPEST: TSWT FDSKC;
TYPE [ASCIZ/
*/]
TESTCR: PUSHJ PP,COMKAR ;GET FIRST CHARACTER FROM COMMAND
TSWF FECOM; ;END OF COMMAND FILE?
CALLI $EXIT ;YES--QUIT
JUMPE CH,TYPEST ;NO--NULL?
CAIN CH,$CR ;NO--CARRIAGE-RETURN?
JRST TYPEST ;YES--LOOP
SWON FCOMCH; ;NO--SET "REGET CHARACTER"
SWON FTERA ;SET 'WE ARE TYPING ERRORS'
SETZM CREFSW## ;CLEAR '/C'
;SET UP BINARY DEVICE
SETBIN: MOVEI DA,BINDEV##
PUSHJ PP,GETFIL ;GET FIRST FILE
HLLZS DEVEXT(DA) ;[530] CLEAR .(DOT) SEEN FLAG IF SET
TSWF FDSKC ;INPUT FROM TTY?
TYPE [ASCIZ/COBOL: /];NO
CAIE CH,"-" ;IS IT "NULL FILE"?
JRST SETBNB ;NO
SETZM BINDEV ;YES
PUSHJ PP,COMKAR
CAIE CH,","
CAIN CH,"="
JRST SETLST
JRST TUMANY
SETBNA: MOVSI TA,'DSK' ;USE DEVICE "DSK"
MOVEM TA,BINDEV
JRST SETLST
SETBNB: JUMPE TA,SETBNA
TXNE TA,DV.M14 ;BINARY LEGAL?
TXNN TA,DV.OUT ;YES--OUTPUT DEVICE?
JRST BADBIN ;NO--ERROR
;SET UP LISTING DEVICE
SETLST: CAIN CH,"=" ;ANY FILE THERE?
JRST SETLSA ;NO
CAIN CH,$CR ;END OF STRING?
JRST NOSRC ;YES--ERROR
MOVEI DA,LSTDEV##
PUSHJ PP,GETFIL ;GET SECOND FILE
HLLZS DEVEXT(DA) ;[530] CLEAR .(DOT) SEEN FLAG IF SET
CAIE CH,"-" ;IS IT A "NULL FILE"?
JRST SETLSB ;NO
SWON FNOLST ;YES
PUSHJ PP,COMKAR
CAIE CH,"="
JRST TUMANY
SETLSA: MOVSI TA,'DSK' ;NO DEVICE--USE "DSK"
MOVEM TA,LSTDEV ;SET LIST DEVICE
JRST SETSRC ;IT MUST BE LEGAL
SETLSB: JUMPE TA,SETLSA
TXNN TA,DV.OUT ;OUTPUT DEVICE?
JRST BADOUT ;NO--ERROR
;SET UP SOURCE DEVICE
SETSRC: CAIN CH,$CR ;END OF STRING?
JRST NOSRC ;YES--ERROR
CAIE CH,"=" ;ANY MORE OUTPUT FILES?
JRST TUMANY ;YES--ERROR
PUSHJ PP,SCNCOM ;SCAN ALL SOURCE FILES
PUSHJ PP,STINFL## ;SET UP FIRST SOURCE FILE
TSWFZ FHELP ;/H?
JRST HELP ;YES
SKIPN SRCDEV## ;ANY FILE THERE?
JRST NOSRC ;NO--ERROR
;FILE NAMES HAVE BEEN READ--FINALIZE
MOVE TA,SRCDEV+1
SKIPN LSTDEV+1 ;ANY LIST FILE-NAME?
MOVEM TA,LSTDEV+1 ;NO--JAM SOURCE NAME
SKIPN BINDEV+1 ;ANY BINARY FILE-NAME?
MOVEM TA,BINDEV+1 ;NO--JAM SOURCE NAME
MOVSI TA,'REL'
SKIPN BINDEV+2 ;ANY BINARY EXTENSION?
MOVEM TA,BINDEV+2 ;NO--USE "REL"
MOVSI TA,'LST'
SKIPN LSTDEV+2 ;ANY LISTING EXTENSION?
MOVEM TA,LSTDEV+2 ;NO--USE "LST"
SKIPE LIBSWS## ;ANY LIBRARY?
JRST INITB ;YES
MOVE TA,[LIBSET,,LIBDEV##] ;NO--TRY "DSK:LIBARY.LIB"
BLT TA,LIBDEV+3
SETZM LIBPP##
MOVEI DA,LIBDEV
MOVEI I1,.IOASC
MOVEI I3,DEVBH##(DA)
MOVEI DC,LIB
PUSHJ PP,OPENIT##
HRRZ TA,.JBFF
MOVEM TA,LIBBUF##
INBUF LIB,1
LOOKUP LIB,I1
SETZM LIBDEV
;INITIALIZE BINARY DEVICE
INITB:
MOVEI I1,.IOBIN
MOVEI DA,BINDEV
MOVEI DC,BIN
SKIPN BINDEV ;ANY BINARY FILE?
JRST INITL ;NO
PUSHJ PP,OPNOUT
MOVE TA,BINSWS## ;REWIND?
TRNE TA,FL.REW
MTREW. BIN,
TRNE TA,FL.ZRO ;CLEAR DIRECTORY?
UTPCLR BIN,
SETOM BINBLK##
;INITIALIZE LISTING DEVICE
INITL: MOVEI I1,.IOASC
MOVEI DA,LSTDEV
MOVEI DC,LST
TSWF FNOLST; ;ANY LISTING DEVICE?
JRST INITS ;NO
MOVE TA,LSTDEV ;YES--TTY?
DEVCHR TA,
TXNE TA,DV.AVL
TXNN TA,DV.TTU
JRST INITL1 ;NO
TXNN TA,DV.MTA ;TEST FOR NUL:
SWON FLTTY; ;YES
INITL1: PUSHJ PP,OPNOUT
MOVE TA,.JBFF
MOVEM TA,LSTBUF##
OUTBUF LST,2
MOVE TA,LSTSWS## ;REWIND?
TRNE TA,FL.REW
MTREW. LST,
TRNE TA,FL.ZRO ;CLEAR DIRECTORY?
UTPCLR LST,
SETOM LSTBLK##
;INITIALIZE SCRATCH FILES
INITS: TSWF FNOLST ;IF NO LISTING,
SETZM CREFSW ; CLEAR '/C'
PJOB TC, ;GET JOB NUMBER INTO LH OF TA, DECIMAL
MOVEI TD,3
IDIVI TC,^D10
ADDI TB,"0"-40
LSHC TB,-6
SOJG TD,.-3
MOVE TB,DEVXWD
OPNSCR: MOVE DA,DEVTAB(TB)
MOVSI TC,'DSK' ;SCRATCH DEVICE
MOVEM TC,DEVDEV##(DA)
HLR TA,DEVTAB(TB) ;CREATE FILE NAME
MOVEM TA,DEVFIL##(DA)
MOVSI TC,'TMP' ;SCRATCH FILES EXTENSION
MOVEM TC,DEVEXT##(DA)
MOVEI DC,FSC(TB) ;SET CHANNEL NUMBER
CAIE DC,CRF ;IF THIS IS
JRST OPNSC0 ; CREF FILE
SKIPN CREFSW ; AND THERE IS NO '/C',
JRST OPNSC1 ; DON'T OPEN THE CREF FILE
OPNSC0: MOVEI I3,DEVBHI##(DA)
HRLI I3,3(I3)
MOVEI I4,0
MOVEI I1,.IOBIN ;USUALLY BINARY MODE
CAIN DC,CPY ;CPYFIL?
MOVEI I1,.IOASC ;YES--ASCII MODE
CAIE DC,NAM ;NAMFIL
CAIN DC,LIT ; OR LITFIL?
MOVEI I1,.IODMP ;YES--DUMP MODE
PUSHJ PP,OPNTMP
SETOM DEVBLK##(DA) ;SET BLOCK COUNT TO -1
CAIE DC,LIT ;"LIT"?
CAIN DC,AS3 ;"AS3"?
JRST OPNSC1 ;YES--NO BUFFER NOW
CAIN DC,NAM ;LIKEWISE FOR
JRST OPNSC1 ; NAMFIL
HRRZ I0,.JBFF ;NO--SET BUFFER ADDRESS
MOVEM I0,DEVBUF##(DA)
MOVE I0,OUTBOP##
DPB DC,I0CHAN##
XCT I0 ;DO AN OUTBUF
OPNSC1: AOBJN TB,OPNSCR
MOVE TA,SRCBUF## ;AS3FIL OVERLAYS SRCFIL
MOVEM TA,AS3BUF##
MOVE TA,GENBUF## ;BINFIL OVERLAYS GENFIL
MOVEM TA,BINBUF##
>;END IFE TOPS20
;SET UP LISTING IF WE ARE DEBUGGING
IFN DEBUG,<
PUSHJ PP,HDROUT##
>
;SET UP ALL WORK AREAS EXCEPT NAMTAB
SETWRK: HRRZ TA,.JBFF##
MOVEM TA,FREESP##
MOVE TA,WRKXWD
STWRK1: MOVE TB,(TA)
MOVE TC,TB
HRR TC,FREESP
MOVEM TC,(TB)
MOVEM TC,1(TB)
HLRE TC,TB
MOVMS TC
ADDI TC,1
ADDB TC,FREESP
STWRK3: CAMG TC,TOPLOC##
JRST STWRK2
PUSHJ PP,ADDCOR##
MOVE TC,FREESP
JRST STWRK3
STWRK2: AOBJN TA,STWRK1
JRST SETNAM
;SET UP INITIAL ENTRIES IN NAMTAB.
;ENTER AT "SETNAM".
PUSHJ PP,ADDCOR ;GRAB ANOTHER 1K OF CORE
SETNAM: MOVE TA,TOPLOC ;ROOM FOR
SUBI TA,1+NAMPSZ## ; NAMTAB
SUB TA,NTSIZE## ; + NM1TAB
SUB TA,NTSIZE ; + NM2TAB?
CAMGE TA,FREESP
JRST SETNAM-1 ;NO--GRAB ROOM
MOVE TE,[XWD NTSIZE,SIZTAB##]
MOVNI TD,NTNSIZ##
BLT TE,SIZTAB-1(TD)
MOVE TE,NTSIZE
MOVEM TE,NM12SZ##
MOVE TE,[XWD NTNSIZ,SIZTAB]
MOVEM TE,NSZPTR##
HRLI TA,TC
MOVEM TA,NM1LOC##
MOVSI TE,(TA)
HRRI TE,1(TA)
SETOM (TA)
ADD TA,NM12SZ
BLT TE,-1(TA)
MOVEM TA,NM2LOC##
MOVSI TE,(TA)
HRRI TE,1(TA)
SETZM (TA)
ADD TA,NM12SZ
BLT TE,-1(TA)
HRLI TA,-1+NAMNSZ##
MOVEM TA,NAMLOC##
MOVEM TA,NAMNXT##
MOVEI LN,NAMDAT ;BEGINNING OF TABLE IN "RESVWD"
;SET UP NAMTAB (CONT'D)
SETN1: SETZM NAMWRD## ;CLEAR NAMWRD
MOVE TB,[XWD NAMWRD,NAMWRD+1]
BLT TB,NAMWRD+4
HLRZ TB,(LN) ;GET <SIZE OF ENTRY> + 1
MOVEI TC,NAMWRD ;SET UP <XWD 1(LN),NAMWRD>
HRLI TC,1(LN)
BLT TC,NAMWRD-2(TB) ;MOVE ENTRY TO NAMWRD
PUSHJ PP,TRYNAM## ;SEE IF IT IS THERE
JRST SETN2 ;NO--OK
JRST DBLNAM ;YES--ERROR
SETN2: PUSHJ PP,BLDNAM## ;CREATE AN ENTRY IN NAMTAB
HRLZ TB,(LN)
TLO TB,NAMRSV/1B17
MOVEM TB,(TA)
HLRZ TA,(LN) ;STEP TO NEXT NAMDAT ENTRY
ADD LN,TA
SKIPGE AS7482 ;DO WE WANT JUST COBOL-74?
CAIGE LN,NAMD82 ;AND HAVE WE FINISHED ALL BUT 8x RESERVED WORDS?
SKIPN (LN) ;NO, BUT ARE WE DONE WITH FULL TABLE?
JRST SETN3 ;YES
JRST SETN1 ;NO--LOOP
SETN3: HRRZ TA,NM1LOC ;YES--RESET LEFT HALF OF FREESP
SUB TA,FREESP
HRLM TA,FREESP
;SET UP INITIAL ENTRIES IN EXTAB
SETEXT: SETZM NAMWRD+1 ;CLEAR NAMWRD'S LAST 4 LOCS
MOVE TA,[XWD NAMWRD+1,NAMWRD+2]
BLT TA,NAMWRD+4
MOVS TE,EXTLOC ;CLEAR EXTAB
HRR TE,EXTLOC+3
SUBI TE,1
PUSHJ PP,CLRSOM
MOVE LN,EXTPTR## ;GET TABLE POINTER
SETEX1: MOVE TB,[POINT 6,NAMWRD]
MOVSI TA,(POINT 6,(LN))
SETX1A: ILDB CH,TA
CAIN CH,'.'
MOVEI CH,';'
IDPB CH,TB
TLNE TA,770000
JRST SETX1A
PUSHJ PP,TRYNAM
JRST SETEX2
JRST DBLNAM ;YES--ERROR
SETEX2: PUSHJ PP,BLDNAM ;NO--ADD IT TO NAMTAB
SETEX3: MOVE TB,EXTNXT##
AOBJP TB,SETEX4 ;ROOM FOR FIRST WORD?
TLO TA,500000 ;YES--PUT NAMTAB CHAIN IN EXTAB
HLLZM TA,(TB)
HRRZI TD,(TB) ;SET UP EXTAB LINK
HRRZ TE,EXTLOC
SUBI TD,(TE)
IORI TD,<CD.EXT>B20
AOBJP TB,SETEX4 ;ROOM FOR SECOND WORD?
SETZM (TB) ;YES--CLEAR IT
MOVEM TB,EXTNXT ;YES--RESTORE EXTNXT
AOBJN LN,SETEX1 ;ANY MORE ENTRIES?
JRST FINISH ;NO
SETEX4: PUSH PP,TA ;EXPAND EXTAB
PUSHJ PP,XPNEXT##
POP PP,TA
JRST SETEX3
;FINISH UP PHASE A
FINISH: HLLZS SW ;CLEAR RH OF SWITCHES
PUSHJ PP,GETFCH## ;SET UP SRCFIL
SWON FREGCH;
SETZM WASERC## ;LAST WORD WAS NOT 'SEARCH', OBVIOUSLY
MOVEI TA,"." ;SET "DECIMAL POINT IS PERIOD"
MOVEM TA,DCPNT.##
MOVEI TA,","
MOVEM TA,COMA.##
MOVEI TA,100
MOVEM TA,GENWRD##
IFE TOPS20,<
IFN DEBUG,<TSWC FOBJEC>
TSWF FNOLST ;IF NO LISTING,
SWOFF FOBJEC!FMAP ; THEN NO MAPS NOR ASSEMBLY LISTING
TSWF FNOLST ;IF NO LISTING,
SETZM LSTDEV ; CLEAR DEVICE NAME
TSWF FLTTY ;IF LISTING ON TTY,
SWOFF FTERA ; WE DON'T TYPE ERRORS TWICE
>
ENDFAZ A;
IFE TOPS20,<
;SCAN REMAINDER OF SOURCE FILES IN COMMAND STRING
SCNCOM: MOVSI DA,'DSK'
MOVEM DA,LASTDV##
MOVEI DA,IOSRCS## ;SET SRCEND## & DA
MOVEM DA,SRCEND##
SCNCM1: TSWF FESRC ;ANY MORE SOURCE FILES?
JRST SCNCM5 ;NO
PUSHJ PP,GETFIL ;YES--GET NEXT ONE
JUMPN TA,SCNCM3 ;JUMP IF DEVICE FOUND
SKIPN DEVFIL(DA) ;NO DEVICE--ANY FILE?
SKIPE DEVEXT(DA)
JRST SCNCM2 ;YES
MOVE TB,DEVSW##(DA) ;NO--IS THIS A LIBRARY?
TRNN TB,FL.LIB
JRST SCNCM6 ;NO--ERROR
SCNCM2: MOVE TA,LASTDV
MOVEM TA,DEVDEV(DA)
DEVCHR TA,
SCNCM3: PUSHJ PP,CHEKIN ;CHECK VALIDITY OF FILE
ADDI DA,DEVSIZ ;KICK UP TO NEXT ENTRY
MOVEM DA,SRCEND
CAIE DA,SRCEND ;TABLES FULL?
JRST SCNCM1 ;NO--LOOP
TSWT FESRC ;YES--ANY MORE SOURCES?
JRST NOROOM ;YES--ERROR
SCNCM5: MOVEI TA,IOSRCS ;RESET SRCEND
MOVEM TA,SRCEND
POPJ PP,
SCNCM6: CAIN CH,$CR ;END OF LINE?
CAIE DA,IOSRCS ;YES--ANY SOURCE FILES?
JRST SCNCM2 ;YES
JRST NOSRC ;NO--ERROR
;OPEN UP OUTPUT DEVICE
;ENTER WITH DA POINTING TO A FILE ENTRY SET UP BY GETFIL.
OPNOUT: MOVSI I3,DEVBH(DA) ;ENTRY FOR BIN, LST
PUSHJ PP,OPENIT ;OPEN AND SET UP ENTER
JRST OPNTM1
OPNTMP: PUSHJ PP,OPENIT ;OPEN AND SET UP ENTER
CAIN DC,LIT ;DON'T ENTER IF
POPJ PP, ; LITFIL
MOVSI I3,(100B8) ;SET NO PROTECTION, SO WE CAN ALWAYS
; READ AND DELETE THIS FILE
OPNTM1: MOVE I0,ENTROP## ;CREATE AN ENTER
DPB DC,I0CHAN
XCT I0 ;ENTER
JRST NOENTR ;CANNOT
POPJ PP,
;CHECK VALIDITY OF SOURCE FILE.
;ENTER WITH CHARACTERISTICS IN TA.
CHEKIN: TXNN TA,DV.IN ;INPUT DEVICE?
JRST NOTIN ;NO--ERROR
TXNE TA,DV.DIR ;DIRECTORY DEVICE?
SKIPE DEVFIL(DA) ;YES--ANY FILE NAME?
SKIPA TB,DEVSW(DA) ;YES, LIBRARY FILE?
JRST NOFILE ;NO--ERROR
TRNE TB,FL.LIB
TXNE TA,DV.DSK ;YES--IS IT DSK?
POPJ PP, ;YES
JRST BADLIB ;NO--ERROR
;SET UP TO GET COMMANDS FROM DISK
COMDSK:
IFE ONESEG,<
MOVEM 7,RUNPPN ;SAVE DEV AND PPN OF RUN COMMAND
MOVEM 11,RUNDEV
>
MOVX SW,FDSKC ;CLEAR FLAGS--SET "COMMANDS FROM DISK"
MOVEI TA,1
MOVEM TA,CCLSW
CALLI $RESET
MOVSI TA,'COB' ;SET UP FIRST
MOVEM TA,COMBH+1 ; WORD FOR TMPCOR UUO
MOVE TA,.JBFF ;CHECK IF THERE IS ENOUGH CORE
ADDI TA,200-1
CAMG TA,.JBREL## ;ENOUGH FREE SPACE?
JRST COREOK ;YES
MOVE TB,TA
CORE TB, ;GET MORE CORE
JRST NOTNUF ;NOT ENOUGH
;[713] MOVEM TA,.JBFF ;RESET JBFF
COREOK: MOVE TA,.JBFF ;SET UP
SUBI TA,1 ; SECOND
HRLI TA,-200 ; WORD
MOVEM TA,COMBH+2 ; FOR TMPCOR UUO
MOVE TA,[XWD 1,COMBH+1] ;GET FILE IN
TMPCOR TA, ; CORE
JRST CMDSK5 ;WAS NONE--TRY DISK
MOVE TB,.JBFF ;SET UP
HRLI TB,(POINT 7,0) ; BYTE-POINTER TO
MOVEM TB,COMBH+1 ; COMMAND
ADDM TA,.JBFF ;UPDATE JOBFF WITH SIZE OF INPUT
IMULI TA,5 ;CALCULATE
ADDI TA,1 ; NUMBER OF CHARACTERS + 1
MOVEM TA,COMBH+2 ;STASH THAT
SETZM COMBH ;CLEAR COMBH TO INDICATE "TMPCOR"
JRST CMDSK9 ;RETURN
CMDSK5: OPEN COM,[.IOASC
SIXBIT /DSK/
XWD 0,COMBH]
JRST START1 ; [344] NO DSK -- USE TTY
MOVEI I1,'COB' ;SET UP LOOKUP PARAMETERS
MOVSI I2,'TMP'
SETZB I3,I4
HLRZM I2,COMEXT##
PJOB TC, ;PUT IN JOB NUMBER
MOVEI I0,3
IDIVI TC,^D10
ADDI TB,'0'
LSHC TB,-6
SOJG I0,.-3
HLL I1,TA
INBUF COM,1 ;GET A SINGLE BUFFER
LOOKUP COM,I1 ;LOOKUP "JJJCOB.TMP"
JRST START1 ; [344] NOT FOUND -- USE TTY.
CMDSK9: MOVE TE,.JBFF##
MOVEM TE,SAVJFF##
JRST COBLAS
>;END IFE TOPS20
;SET UP IMPURE AREA
SETIMP:
IFE ONESEG,<
MOVE TA,[XWD %WEDID,WEDIED##] ;MOVE "GETSEG" ROUTINE TO LOW-SEGMENT
IFN DEBUG,<
BLT TA,-1+DDTSTP## ;DON'T OVERWRITE BREAKPOINT THAT MIGHT BE AT DDTSTP
>
IFE DEBUG,<
BLT TA,GETEND##
>>
IFE ONESEG,<
MOVE TA,RUNPPN ;GETSEG WILL USE DEV AND PPN
MOVEM TA,GETFNM+4 ; OF RUN COMMAND
MOVE TA,RUNDEV
MOVEM TA,GETFNM##
HRROI TA,.GTRDV
GETTAB TA, ;GET DEVICE
JRST SETI2 ;PRE 6.03
JUMPE TA,SETI2 ;[556] NOT IMPLEMENTED
MOVEM TA,GETFNM ;SAVE ACTUAL DEVICE
HRROI TA,.GTRDI
GETTAB TA, ;GET DIRECTORY
JRST SETI2
MOVEM TA,GETFNM+4 ;SAVE ACTUAL PPN
HRROI TA,.GTRS0
GETTAB TA, ;GET SFD #1
JRST SETI2 ;PRE 6.04
JUMPE TA,SETI2 ;NO SFD
MOVEM TA,GETPTH+.PTSFD ;SAVE SFD
MOVEI TA,GETPTH## ;GET POINTER
EXCH TA,GETFNM+4 ;SWAP WITH PPN
MOVEM TA,GETPTH+.PTPPN ;SAVE PPN
HRROI TA,.GTRS1
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+.PTSFD+1
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS2
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH++.PTSFD+2
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS3
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+.PTSFD+3
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS4
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+.PTSFD+4
SETZM GETPTH+.PTSFD+5 ;TERMINATE WITH ZERO
SETI2:>
IFN TOPS20,<
;ZERO ALL OF FREE CORE HERE (I.E. .JBFF THROUGH .JBREL)
HRRZ TA,.JBFF
CAMG TA,.JBREL##
SETZM (TA)
AOS TA
HRL TA,.JBFF##
HRRZ TB,.JBREL
CAMLE TB,.JBFF
BLT TA,(TB)
>
MOVE TB,[XWD FSTCLR##,FSTCLR+1]
SETZM FSTCLR
BLT TB,LSTCLR## ;CLEAR ALL LOWSEG LOCS
MOVE TE,[SETI3,,RVBLT##]
BLT TE,RVBLT+2 ;SETUP REVERSE BLT
HLRZ TE,.JBSA## ;GET INITIAL .JBFF
ADDI TE,WRKSIZ## ; SET SIZE FOR THE SMALLEST PROGRAM TO USE
IORI TE,777 ;ROUND UP TO NEAREST PAGE
JRST SETCOR##
SETI3: POP TE,0(TE) ;STANDARD POP REVERSE BLT CODE
JUMPL TE,RVBLT ;I.E. JUMPL TE,.-1
POPJ PP,
;CLEAR SOME CORE
;ENTER WITH FIRST ADDRESS IN LH OF "TE", LAST ADDRESS IN RH OF "TE"
CLRSOM: HLRZ TD,TE
SETZM (TD)
HLL TD,TE
ADDI TD,1
BLT TD,(TE)
POPJ PP,
;GET CURRENT DATE AND TIME
GETDT:
IFN TOPS20,<
HRROI T1,STDATE## ;WHERE TO RETURN DATE AND TIME
SETO T2, ; OF NOW
MOVX T3,OT%NSC ; NO SECONDS
ODTIM%
MOVEI TA,377
ANDCAM TA,STDATE+1 ;CLEAR LAST SPACE FOR COMPATABILITY
>
IFE TOPS20,<
DATE TC, ;GET DATE
IDIVI TC,^D31 ;TB_(DAY-1)
PUSHJ PP,DECONV ;CONVERT TO TWO DECIMAL DIGITS
DPB TB,[POINT 14,STDATE,13]
IDIVI TC,^D12 ;TB_(MONTH-1)
MOVE TB,MOTABL(TB)
LSHC TB,-16
IORM TB,STDATE##
LSHC TB,-1
MOVEM TA,STDATE+1
MOVEI TB,^D63(TC) ;TB_(YEAR-1)
CAIL TB,^D100-1 ;CK FOR YEAR 2000+
SUBI TB,^D100 ;IF SO, CHANGE TO 00+
PUSHJ PP,DECONV
DPB TB,[POINT 14,STDATE+1,27]
CALLI TC,$TIME ;GET TIME
IDIVI TC,^D1000*^D60 ;CONVERT TO MINUTES
IDIVI TC,^D60 ;TB_MINUTES, TC_HOURS
PUSHJ PP,DECONV+1
LSH TB,1
IOR TB,[ASCII " :"]
MOVEM TB,STTIME##
MOVE TB,TC
PUSHJ PP,DECONV+1
DPB TB,[POINT 14,STTIME,13]
SETOM MYPATH## ;MY JOB,,GET PATH FUNCTION
MOVE TA,[11,,MYPATH]
PATH. TA, ;GET DEFAULT PATH
SETZM MYPPN## ;FAILED
>
POPJ PP,
IFE TOPS20,<
;CONVERT A NUMBER TO DECIMAL
DECONV: ADDI TB,1 ;ADD 1 TO IT
IDIVI TB,^D10 ;TA_UNITS, TB_TENS
LSH TB,7
ADDI TB,14060(TA) ;CONVERT TO ASCII
POPJ PP,
>
;SET UP VERSION NUMBER
GETVER: SETZM VERZUN##
SETZM VERZUN+1
SETZM VERZUN+2
MOVE TC,[POINT 6,VERZUN]
LDB TE,[POINT 9,.JBVER,11] ;GET VERSION NUMBER
SKIPE TE ;IF NON-ZERO,
PUSHJ PP,GTVER8 ; PRINT IT
LDB TE,[POINT 6,.JBVER,17] ;GET MINOR VERSION NUMBER
JUMPE TE,GTVER4 ;IF ZERO, NO LETTER
CAIG TE,^D26 ;IF LESS THAN 27,
SOJA TE,GTVER3 ; IT IS SINGLE LETTER
MOVEI CH,'A' ;IT IS DOUBLE LETTER
MOVEI TE,-1(TE)
GTVER1: SUBI TE,^D26
CAILE TE,^D25
AOJA CH,GTVER1
GTVER2: IDPB CH,TC
GTVER3: ADDI TE,'A'
IDPB TE,TC
GTVER4: HRRZ TE,.JBVER## ;GET PATCH NUMBER
JUMPE TE,GTVER5 ;IF ZERO, DON'T PRINT IT
MOVEI CH,'('
IDPB CH,TC
PUSHJ PP,GTVER8
MOVEI CH,')'
IDPB CH,TC
GTVER5: LDB TE,[POINT 3,.JBVER,2] ;GET EDITOR
JUMPE TE,CPOPJ## ;IF PDP-10 DEVELOPMENT, DON'T PRINT IT
MOVEI CH,'-'
IDPB CH,TC
GTVER8: LDB TD,[POINT 3,TE,35]
HRLM TD,(PP)
LSH TE,-3
SKIPE TE
PUSHJ PP,GTVER8
HLRZ TE,(PP)
ADDI TE,'0'
IDPB TE,TC
POPJ PP,
IFE TOPS20,<
;GET IN "DEV:FILE.EXT[PROJ,PROG]/X"
GETFIL: MOVEI TA,1(DA)
HRLI TA,(DA)
SETZM (DA)
BLT TA,-1+DEVSIZ##(DA)
TSWFZ FCOMWD; ;DEVICE WAITING?
JRST GETFL6 ;YES
GETFL1: PUSHJ PP,GETSIX ;NO--GET ONE
CAIN CH,":" ;":"?
JRST GETFL7 ;YES
GETFL2: CAIE CH,"=" ;"="?
CAIN CH,"," ;","?
JRST GTFL4A ;YES
CAIN CH,"." ;"."?
JRST GETFL5 ;YES
CAIN CH,"[" ;"["?
JRST GETFL8 ;YES
CAIN CH,$CR ;END OF COMMAND?
JRST GETFL4 ;YES
CAIN CH,"/" ;SWITCH?
JRST GETFL9 ;
CAIN CH,"-"
JRST GTFL8H
CAIN CH,"("
JRST GTFL13
CAIN CH,"@"
JRST GTFL12
CAIN CH,"!"
JRST GTFL14
CAIE CH," " ;SPACE?
JRST BADKAR ;NO--BAD CHARACTER
PUSHJ PP,COMKAR ;YES--GET NEXT CHARACTER
GTFL2A: CAIN CH," " ;ANOTHER SPACE?
JRST .-2 ;YES--LOOP
CAIG CH,"Z" ;NO--LETTER?
CAIGE CH,"A"
SKIPA ;NO
JRST GETFL3 ;TREAT IT LIKE COMMA
CAIG CH,"9" ;NOT LETTER--DIGIT?
CAIGE CH,"0"
JRST GETFL2 ;NO--TRY PUNCTUATION
GETFL3: MOVEI CH,"," ;LETTER OR DIGIT--TREAT LIKE COMMA
SWON FCOMCH; ;SET "REGET CHARACTER"
JRST GTFL4A
;STASH FILE-NAME AND LEAVE
GETFL4: SWON FESRC; ;END OF COMMAND STRING
GTFL4A: PUSHJ PP,GTFL4B
SKIPN TA,DEVDEV(DA) ;ANY DEVICE?
POPJ PP, ;NO--RETURN
DEVCHR TA, ;YES--GET CHARACTERISTICS
JUMPE TA,NOTDEV ;IS IT A LEGAL DEVICE?
POPJ PP,
GTFL4B: JUMPE TA,CPOPJ
SKIPE DEVFIL(DA)
JRST BADSTR
MOVEM TA,DEVFIL(DA)
POPJ PP,
;DOT--STASH FILE-NAME, GET EXTENSION
GETFL5: SKIPE DEVEXT(DA)
JRST BADSTR
PUSHJ PP,GTFL4B
PUSHJ PP,GETSIX
HLLZM TA,DEVEXT(DA)
AOS DEVEXT(DA) ;[530] TURN ON .(DOT) SEEN FLAG
MOVEI TA,0
JRST GETFL2
;GET PREVIOUS DEVICE
GETFL6: SKIPA TA,LASTDV ;GET PREVIOUS DEVICE
;COLON--STASH DEVICE NAME
GETFL7: MOVEM TA,LASTDV ;STASH AS LAST DEVICE
SKIPE DEVDEV(DA) ;IS THERE ONE ALREADY?
JRST GTFL7A
MOVEM TA,DEVDEV(DA) ;NO--STASH IN DEVICE ENTRY
JRST GETFL1
GTFL7A: SWON FCOMWD; ;YES--SET "REGET WORD"
POPJ PP,
;BRACKET--GET PROJ,PROG
GETFL8: PUSHJ PP,GTFL4B
PUSHJ PP,GETNUM ;GET PROJ
JRST [CAIN CH,"-" ;HYPHEN?
JRST [SETZB TA,DEVPP(DA) ;YES, MEANS DEFAULT
PUSHJ PP,COMKAR ;GET NEXT
JRST GTFL8A] ;CHECK END
CAIE CH,"," ;COMMA?
JRST BADPPN ;ERROR
HLRZ TA,MYPPN ;GET DEFAULT
JRST .+1]
CAIE CH,"," ;COMMA SEPERATOR?
JRST BADPPN ;NO--ERROR
MOVSM TA,DEVPP##(DA) ;YES--STASH
PUSHJ PP,GETNUM ;GET PROG
JRST [CAIE CH,"," ;COMMA?
CAIN CH,"]" ;OR END?
SKIPA TA,MYPPN ;GET DEFAULT
JRST BADPPN ;ERROR
JRST .+1]
HRRM TA,DEVPP(DA) ;STASH
CAIE CH,"," ;SFD'S TO FOLLOW?
JRST GTFL8A ;NO
MOVEI TA,DEVPTH##(DA) ;GET PATH POINTER
EXCH TA,DEVPP(DA) ;SWAP WITH PPN
MOVEM TA,DEVDIR##(DA) ;AND PUT IN PATH BLOCK
PUSH PP,DA
HRLI DA,-5 ;FORM AOBJN POINTER
GTFL8B: PUSHJ PP,GETSIX ;YES, GET IT
MOVEM TA,DEVSFD##(DA)
CAIN CH,"," ;MORE?
AOBJN DA,GTFL8B ;YES
POP PP,DA
GTFL8A: CAIE CH,"]" ;"]"?
JRST BADPPN ;NO--ERROR
JRST GETFL1
;HYPHEN -- IT SHOULD BE ALONE
GTFL8H: JUMPN TA,BADKAR
SKIPN DEVDEV(DA)
SKIPE DEVFIL(DA)
JRST BADKAR
SKIPN DEVPP(DA)
SKIPE DEVEXT(DA)
JRST BADKAR
POPJ PP,
;SWITCH (/ TYPE)
GETFL9: PUSHJ PP,GTFL4B
PUSHJ PP,COMKAR
PUSHJ PP,SWICH
GTFL10: MOVEI TA,0
SKIPE DEVDEV(DA)
JRST GTFL11
SKIPN DEVFIL(DA) ;IS THERE ANY FILE?
SKIPE DEVEXT(DA)
SKIPA
JRST GETFL1 ;NO--LOOP
GTFL11: PUSHJ PP,COMKAR ;YES--GET NEXT CHARACTER
JRST GTFL2A
;"@" SEEN -- SET UP INDIRECT COMMAND FILE
GTFL12: PUSHJ PP,GTFL4B ;STASH FILE NAME
SKIPN DEVDEV(DA) ;ANY ENTRY?
SKIPE DEVFIL(DA)
JRST GTF12A ;YES
SKIPN DEVPP(DA) ;NOT YET--TRY SOME MORE
SKIPE DEVEXT(DA)
JRST GTF12A ;YES
PUSHJ PP,GETFIL ;NO--SCAN SOME MORE
HLLZS DEVEXT(DA) ;[530] CLEAR .(DOT) SEEN FLAG IF SET
JRST GTF12B
GTF12A: PUSHJ PP,COMKAR
GTF12B: CAIE CH,$CR
JRST BADSTR
CALLI $RESET
SKIPN I2,DEVDEV(DA)
MOVSI I2,'DSK'
MOVEI I1,.IOASC
MOVEI I3,COMBH
OPEN COM,I1
JRST NOCOMD
SKIPE I1,DEVFIL(DA)
JRST GTF12D
MOVEI I2,3
PJOB I3,
IDIVI I3,^D10
MOVEI I0,'0'(I4)
LSHC I0,-6
SOJG I2,.-3
HRRI I1,'COB'
GTF12D: HLLZ I2,DEVEXT(DA)
GTF12E: MOVEI I3,0
MOVE I4,DEVPP(DA)
JUMPE I2,GTF12H
GTF12F: LOOKUP COM,I1
JRST NOCOMF
GTF12G: HLRZM I2,COMEXT
INBUF COM,1
MOVE TE,.JBFF
MOVEM TE,SAVJFF
MOVSI SW,FDSKC/1000000
PUSHJ PP,GETFIL ;[530]
HLLZS DEVEXT(DA) ;[530] CLEAR .(DOT) SEEN FLAG IF SET
POPJ PP, ;[530]
GTF12H: MOVSI I2,'CCL'
LOOKUP COM,I1
TDZA I2,I2
JRST GTF12G
MOVE I4,DEVPP(DA)
JRST GTF12F
;SWITCH [( TYPE]
GTFL13: PUSHJ PP,GTFL4B
PUSHJ PP,COMKAR
GTF13A: PUSHJ PP,SWICH
PUSHJ PP,COMKAR
CAIE CH,")"
JRST GTF13A
JRST GTFL10
;"!" SEEN -- CALL CUSP
GTFL14: SKIPN TE,DEVDEV(DA) ;GET USER DEVICE
MOVSI TE,'SYS' ;DEFAULT TO SYS
SKIPN TD,DEVFIL(DA) ;FILE
MOVE TD,TA ;IT HAS'NT BEEN STORED YET
HLLZ TC,DEVEXT(DA) ;EXTENSION
SETZB TB,PP ;CLEAR PROT/DATE AND CORE ARG
MOVE TA,DEVPP(DA) ;PPN
MOVE CH,[XWD 1,TE]
RUN CH,
HALT .+1
TYPE [ASCIZ /?CBLRUR RUN UUO returned to COBOL: Monitor error
/]
CALLI $EXIT
;DETERMINE TYPE OF SWITCH
SWICH: CAIL CH,"A" ;RANGE CHECK SWITCH
CAILE CH,"Z"
JRST BADCSW ;NOT IN RANGE
XCT SWTAB-"A"(CH) ;SET SWITCH
POPJ PP,
SWTAB:
SWON FOBJEC; ;A - TURN ON "/A"
SETOM DEBSW## ;B - GENERATE DEBUG CODE
SETOM CREFSW ;C - SET '/C'
JRST SWICHD ;D - SET /D:nnnnnn
SWON FFATAL; ;E - TURN ON "/E"
IFN DEBUG,<
JRST SWICHF ;F -
>
IFE DEBUG,<
JRST BADCSW
>
SETOM NOCPYL## ;G - TURN ON DON'T LIST LIBRARY FILE
SWON FHELP ;H - TURN ON /H
JRST SWICHI ;I - DO NOT GENERATE START ADDRESS
JRST SWICHJ ;J - GENERATE START ADDRESS NO MATTER WHAT
IFN DEBUG,<
JRST SWICHK ;K -
>
IFE DEBUG,<
JRST BADCSW
>
JRST SWICHL ;L -
SWON FMAP; ;M - TURN ON "/M"
SWOFF FTERA ;N - TURN OFF 'WE'R TYPING ERRORS'
SETOM OPTSW## ;O - SET /O - OPTIMIZATION REQUIRED
SETOM PRODSW## ;P - SET '/P' - PRODUCTION MODE REQUIRED
JRST SWICHQ ;Q - SET '/Q' - QUICK MODE (NO ERROR CHECKING + /P + /O)
JRST SWICHR ;R - TURN ON "/R"
SWON FSEQ; ;S - TURN ON "/S"
IFN DEBUG,<
JRST SWICHT ;T - TRACE
>
IFE DEBUG,<
JRST BADCSW
>
JRST SWICHU ;U - TURN OFF "/R"
JRST SWICHV ;V - SET ANSI STANDARD (74 OR 82)
JRST SWICHW ;W -
JRST SWICHX ;X - DEFAULT THINGS TO EBCDIC INSTEAD OF SIXBIT.
JRST SWICHY ;Y - SET FIPS FLAGGER LEVEL
JRST SWICHZ ;Z -
SWICHI: SKIPE SLASHJ ;IF WE HAVE ALREADY SEEN /J
JRST BADIJ ;GIVE ERROR MESSAGE
SETOM SUBPRG ;DO NOT GENERATE START ADDRESS
POPJ PP,
SWICHJ: SKIPE SUBPRG ;IF WE HAVE ALREADY SEEN /I
JRST BADIJ ;GIVE ERROR MESSAGE
SETOM SLASHJ ;GENERATE START ADDRESS NO MATTER WHAT
POPJ PP,
BADIJ: MOVEI TB,[ASCIZ \?Switches /I and /J are mutually exclusive.\]
JRST BADCOM
SWICHR: SKIPGE SEENRU## ;IF WE HAVE ALREADY SEEN /U
JRST BADRU ;GIVE ERROR MESSAGE
SWON FREENT ;R - TURN ON "/R"
AOS SEENRU ;SET FLAG +1
POPJ PP,
SWICHU: SKIPLE SEENRU ;IF WE HAVE ALREADY SEEN /R
JRST BADRU ;GIVE ERROR MESSAGE
SWOFF FREENT ;U - TURN OFF "/R"
SETOM SEENRU ;SET FLAG -1
POPJ PP,
BADRU: MOVEI TB,[ASCIZ \?Switches /R and /U are mutually exclusive.\]
JRST BADCOM
SWICHL: MOVEI TA,FL.LIB ;SET "L" FLAG IN TABLE
JRST SWZWL
SWICHQ: SETOM OPTSW ;/O
SETOM PRODSW ;/P
SETOM QUIKSW## ;/Q
POPJ PP,
SWICHV: PUSHJ PP,COMKAR ;/V
CAIE CH,":" ;IS NEXT CHAR A ":"
JRST SWCHV1 ;NO TOGGLE THE DEFAULT
PUSHJ PP,COMKAR ;GET THE NEXT CHARACTER
CAIN CH,"7" ;CHECK FOR 74
JRST SWCHV7 ;ITS 74
CAIN CH,"8" ;TRY FOR 82
JRST SWCHV8 ;FOUND IT
SWCHVE: MOVEI TB,[ASCIZ /?Bad V switch/]
JRST BADCOM
SWCHV1:
IFL ANS82,<
MOVEI TA,1
MOVEM TA,AS7482 ;DEFAULT TO ANS 82 STANDARD
MOVSI TA,(SW.A74)
>
IFG ANS82,<
SETOM AS7482 ;DEFAULT TO ANS 74 STANDARD
MOVSI TA,(SW.A82)
>
IORM TA,COBXSW## ;WILL STORE IN FEATURE TEST LATER
JRST SWCHVR ;REGET THE CHARACTER
SWCHV7: SETOM AS7482## ;SET TO ANS 74 STANDARD
MOVSI TA,(SW.A74)
IORM TA,COBXSW
PUSHJ PP,COMKAR ;SEE IF USER TYPED /V:74
CAIE CH,"4"
JRST SWCHV9 ;NO
POPJ PP, ;YES
SWCHV8: MOVEI TA,1
MOVEM TA,AS7482 ;SET TO ANS 82 STANDARD
MOVSI TA,(SW.A82)
IORM TA,COBXSW
PUSHJ PP,COMKAR ;SEE IF USER TYPED /V:8x
CAIL CH,"0" ;ALLOW ANY DIGIT FOR NOW
CAILE CH,"9"
CAIN CH,"X" ;OR 8X
POPJ PP, ;YES
SWCHV9: PUSHJ PP,SWCHD5 ;SEE IF VALID TERMINATOR
SWCHVR: SWONS FCOMCH ;YES, REGET THE CHARACTER
JRST SWCHVE ;NO, GIVE ERROR
POPJ PP,
SWICHZ: MOVEI TA,FL.ZRO ;SET "Z" FLAG IN TABLE
JRST SWZWL
SWICHW: MOVEI TA,FL.REW ;SET "W" FLAG IN TABLE
SWZWL: IORM TA,DEVSW(DA)
POPJ PP,
SWICHX: HRROI TA,%US.EB ;DISPLAY-9
MOVEM TA,DEFDSP## ;SET DEFAULT MODE
POPJ PP,
IFE MPWCEX,<
SWICHD: MOVEI TB, [ASCIZ -?/D is not allowed, for multiple PERFORMs with a common exit
reassemble the compiler and OTS with MPWCEX==1-]
JRST BADCOM
>
IFN MPWCEX,<
SWICHD: PUSHJ PP, COMKAR ;GET THE NEXT CHAR.
CAIE CH, ":" ;IF IT'S NOT ":"
JRST SWCHD3 ; IT'S AN ERROR.
MOVEI TA, 6 ;SET THE MAXIMUM NUMBER OF
MOVEM TA, OJPPSZ+1 ; DIGITS ALLOWED.
PUSHJ PP, COMKAR ;GET THE FIRST ONE.
CAIG CH, "7" ;IS IT OCTAL?
CAIGE CH, "0"
JRST SWCHD2 ;NO, ERROR.
SWCHD1: MOVE TA, OJPPSZ## ;GET THE OLD SIZE.
LSH TA, 3 ;MULTIPLY IT BY 8.
ADDI TA, -"0"(CH) ;ADD IN THIS DIGIT.
MOVEM TA, OJPPSZ ;SAVE IT.
SOSG OJPPSZ+1 ;CAN THERE BE MORE?
POPJ PP, ;NO, RETURN.
PUSHJ PP, COMKAR ;GET THE NEXT CHAR.
CAIG CH, "7" ;OCTAL DIGIT?
CAIGE CH, "0"
JRST SWCHD4 ;NO, GO SEE WHAT IT IS.
JRST SWCHD1 ;GO ADD IT IN.
;COME HERE IF THE FIRST CHAR IN THE VALUE FIELD IS NOT AN OCTAL DIGIT.
SWCHD2: PUSHJ PP, SWCHD5 ;GO SEE WHAT IT IS.
SKIPA TB, [Z [ASCIZ -?Missing value in /D switch.-]]
SWCD2A: MOVEI TB, [ASCIZ -?Bad value in /D switch.-]
JRST BADCOM
SWCHD3: MOVEI TB, [ASCIZ -?Missing ":" in /D:nnnnnn switch.-]
JRST BADCOM
;COME HERE IF WE FIND A NON OCTAL DIGIT.
SWCHD4: PUSHJ PP, SWCHD5 ;GO SEE WHAT IT IS.
SWCHRC: SWONS FCOMCH ;REMEMBER TO REGET THE CHAR.
JRST SWCD2A ;BAD VALUE.
POPJ PP, ;RETURN.
SWCHD5: AOS (PP)
CAIE CH, ","
CAIN CH, "="
SOS (PP)
CAIE CH, $CR
CAIN CH, "/"
SOS (PP)
POPJ PP,
>
SWICHY: SETZM FLGSW## ;START OFF CLEAN
PUSHJ PP,COMKAR ;GET NEXT CHAR.
CAIE CH,":" ;MUST BE COLON
JRST SWCHYE ;IF NOT ITS AN ERROR
PUSHJ PP,COMKAR ;GET THE FIRST CHAR.
CAIN CH,"-" ;MINUS IS SPECIAL
JRST [PUSHJ PP,SWCHYA ;YES, GET THE SWITCH MASK
MOVE CH,FLGSW ;GET THE MASK
TRNE CH,%LV.L ;NOW TURN ON ALL INCLUDED FIPS FLAGS
TROA CH,%LV.LI ;LOW IMPLIES LOW-INTERMEDIATE ETC
TRNE CH,%LV.LI
TROA CH,%LV.HI
TRNE CH,%LV.HI
TRO CH,%LV.H
SETCAM CH,FLGSW ;COMPLIMENT IT
POPJ PP,]
PUSHJ PP,SWCHYB ;NO, GET THE MASK
MOVE CH,FLGSW ;GET THE MASK
TRNE CH,%LV.H ;NOW TURN ON ALL INCLUDED FIPS FLAGS
TROA CH,%LV.HI ;HIGH IMPLIES HIGH-INTERMEDIATE ETC
TRNE CH,%LV.HI
TRO CH,%LV.LI
TRO CH,%LV.L ;ALWAYS TURN ON LOW-LEVEL
MOVEM CH,FLGSW ;PUT FLAGS BACK
POPJ PP,
SWCHYA: PUSHJ PP,COMKAR ;GET THE CHAR.
SWCHYB: CAIG CH,"9" ;IS IT A DIGIT?
CAIGE CH,"0" ;...
JRST SWCHYC ;NO
XCT [JRST SWCHYE ;0 - ILLEGAL
MOVEI CH,%LV.L ;1 - LOW
MOVEI CH,%LV.LI ;2 - LOW-INTERMEDIATE
MOVEI CH,%LV.HI ;3 - HIGH-INTERMEDIATE
MOVEI CH,%LV.H ;4 - HIGH
JRST SWCHYE ;5 - ERROR
MOVEI CH,%LV.68 ;6 - COBOL-68
JRST SWCHYE ;7 - ERROR
MOVEI CH,%LV.8 ;8 - COBOL-8x
JRST SWCHYE ;9 - ERROR
]-"0"(CH)
SWCHYD: IORM CH,FLGSW ;STORE NEW MASK BITS
JRST SWCHYA ;LOOP
SWCHYC: CAIG CH,"Z" ;IS IT A LETTER?
CAIGE CH,"A" ;...
JRST SWCHRC ;NO
CAIN CH,"D" ;DBMS?
MOVSI CH,%LV.DB ;YES
CAIN CH,"I" ;IBM COMPATIBILITY?
MOVSI CH,%LV.IB ;YES
CAIN CH,"N" ;NON-STANDARD EXTENSION?
MOVSI CH,%LV.NS ;YES
CAIN CH,"R" ;REPORT WRITER?
MOVSI CH,%LV.RP ;YES
CAIN CH,"V" ;VAX-COBOL?
MOVSI CH,%LV.VX ;YES
TRNE CH,-1 ;DID WE FIND SOMETHING?
JRST SWCHYE ;NO
MOVS CH,CH
JRST SWCHYD ;YES
SWCHYE: MOVEI TB,[ASCIZ /?Bad Y switch/]
JRST BADCOM
IFN DEBUG,<
;TO HANDLE "T" SWITCHES WHEN DEBUGGING
SWICHT: PUSHJ PP,COMKAR
CAIN CH,":" ;IF ITS A COLON
PUSHJ PP,COMKAR ;EAT IT UP
MOVEI TA,0
CAIN CH,"A" ;TEST FOR ALL
MOVEI TA,TRACEI!TRACEE!TRACED!TRACEP
CAIN CH,"I"
HRRZI TA,TRACEI
CAIN CH,"E"
HRRZI TA,TRACEE
CAIN CH,"D"
HRRZI TA,TRACED
CAIN CH,"P"
HRRZI TA,TRACEP
IORM TA,CORESW##
JUMPE TA,SWCHTE ;ERROR
SETOM TRACFL## ;INIT ALLOW SYNTAX SCAN TRACING
PUSHJ PP,COMKAR ;GET NEXT CHARACTER
CAIE CH,":" ;RANGE TO FOLLOW?
JRST SWCHRC ;NO
PUSHJ PP,GETDEC ;GET FIRST LINE NUMBER
MOVEM TA,TRCLN1## ;STORE FIRST
PUSHJ PP,COMKAR ;GET HYPHEN
CAIE CH,"-"
JRST SWCHTE ;NO!
PUSHJ PP,GETDEC ;GET SECOND LINE NUMBER
MOVEM TA,TRCLN2## ;STORE IT
POPJ PP, ;RETURN
SWCHTE: MOVEI TB,[ASCIZ /?Bad T switch/]
JRST BADCOM
;PICK UP AN DECIMAL NUMBER
GETDEC: MOVEI TA,0 ;CLEAR THE SUM
PUSHJ PP,COMKAR ;GET FIRST CHARACTER
CAIN CH," " ;SPACE?
JRST .-2 ;YES--IGNORE IT
GETDC1: CAIG CH,"9" ;DECIMAL DIGIT?
CAIGE CH,"0"
JRST SWCHRC ;NO
IMULI TA,^D10 ;YES--ADD TO SUM
ADDI TA,-"0"(CH)
PUSHJ PP,COMKAR ;GET NEXT DIGIT
JRST GETDC1 ;LOOP
;TO HANDLE "K" SWITCH WHEN DEBUGGING
SWICHK: PUSHJ PP,COMKAR
CAIN CH,":" ;IF ITS A COLON
PUSHJ PP,COMKAR ;EAT IT UP
CAIG CH,"G"
CAIGE CH,"A"
JRST SWCHKA
HRLZI TA,%KILLA
SWCHKB: LSH TA,-"A"(CH)
IORM TA,CORESW
POPJ PP,
SWCHKA: MOVEI TB,[ASCIZ /?Bad K switch/]
JRST BADCOM
;TO HANDLE "F" SWITCH WHEN DEBUGGING
SWICHF: PUSHJ PP,COMKAR
CAIN CH,":" ;IF ITS A COLON
PUSHJ PP,COMKAR ;EAT IT UP
CAIG CH,"G"
CAIGE CH,"A"
JRST SWCHFA
HRLZI TA,%KILFA
JRST SWCHKB
SWCHFA: MOVEI TB,[ASCIZ /?Bad F switch/]
JRST BADCOM
>
;PICK UP A SIXBIT WORD FROM COMMAND STRING
GETSIX: MOVEI TA,0
MOVE TB,[POINT 6,TA]
GETSX1: PUSHJ PP,COMKAR ;NO--GET NEXT
GETSX2: CAIG CH,"Z" ;LETTER?
CAIGE CH,"A"
JRST GETSX4 ;NO
GETSX3: TLNN TB,770000
JRST BADNAM
SUBI CH,40 ;YES--STASH IT
IDPB CH,TB
JRST GETSX1
GETSX4: CAIG CH,"9" ;NOT LETTER--DIGIT?
CAIGE CH,"0"
POPJ PP, ;NO--RETURN
JRST GETSX3 ;YES--STASH IT
;PICK UP AN OCTAL NUMBER
GETNUM: MOVEI TA,0 ;CLEAR THE SUM
PUSHJ PP,COMKAR ;GET FIRST CHARACTER
CAIN CH," " ;SPACE?
JRST .-2 ;YES--IGNORE IT
CAIE CH,"," ;COMMA?
CAIN CH,"-" ;OR HYPHEN?
POPJ PP, ;YES, THEY ARE SPECIAL
CAIN CH,"]" ;SO IS ]
POPJ PP, ;IF FIRST
GETNM1: CAIG CH,"7" ;OCTAL DIGIT?
CAIGE CH,"0"
JRST GETNM2 ;NO
LSH TA,3 ;YES--ADD TO SUM
IORI TA,-"0"(CH)
TLNE TA,-1 ;SUM GT. 777777?
JRST BADPPN ;YES--ERROR
PUSHJ PP,COMKAR ;NO--GET NEXT DIGIT
JRST GETNM1 ;LOOP
GETNM2: JUMPE TA,BADPPN ;SUM = 0?
AOS (PP) ;SKIP RETURN IF OK
POPJ PP, ;NO--RETURN
;GET A CHARACTER FROM COMMAND STRING
COMKAR: TSWFZ FCOMCH; ;REGET SAME CHARACTER?
JRST COMKR6 ;YES
COMKR0: SOSG COMBH+2 ;GET CHARACTER FROM DISK OR TMPCOR
JRST COMKR2
COMKR1: ILDB CH,COMBH+1
JUMPE CH,COMKAR ;IGNORE NULLS
CAIN CH,$CR ;IGNORE CARRIAGE-RETURNS
JRST COMKAR
COMKRA: CAIG CH,"z" ;[255] BETWEEN LC Z AND LC A?
CAIGE CH,"a"
CAIA ;NOT LC
SUBI CH,40 ;YES, CONVERT TO UC
CAIN CH,$CZ ;END-FILE?
JRST COMKR9 ;YES
CAIE CH,$LF
CAIN CH,$FF
JRST COMK99
CAIN CH,$ALT ;TREAT ALTMODE AS EOL
JRST COMK99
POPJ PP,
;GET NEXT BUFFER FULL OF COMMANDS
COMKR2: SKIPN COMBH ;FROM TMPCOR?
JRST COMK2B ;YES--NO MORE
IN COM, ;GET NEXT BUFFER
JRST COMKR1 ;NO ERRORS--RETURN
GETSTS COM,CH ;ERROR--GET DEVICE STATUS
TXNE CH,IO.ERR ;ANY ERROR FLAGS UP?
JRST COMKR8 ;YES--WE LOSE
CLOSE COM, ;CLOSE COMMAND FILE
MOVE CH,COMEXT ;IS EXTENSION
CAIE CH,'TMP' ; "TMP"?
JRST COMK2A ;NO--DON'T DELETE
MOVEI CH,0 ;DELETE
RENAME COM,CH ; COMMAND
JFCL ; FILE
COMK2A: RELEASE COM, ;RELEASE IT
JRST COMKR3
;GET RID OF TMPCOR AREA
COMK2B: MOVSI CH,'COB'
MOVEM CH,COMBH+1
MOVS CH,.JBSA
SUBI CH,1
HRLI CH,-200
MOVEM CH,COMBH+2
MOVE CH,[XWD 2,COMBH+1]
TMPCOR CH,
JFCL
;END OF COMMAND FILE
COMKR3: SWON FECOM ;TURN ON "END OF COMMAND"
COMKR4: MOVEI CH,$CR ;RETURN A CARRIAGE-RETURN
POPJ PP,
;REGET SAME CHARACTER
COMKR6: LDB CH,COMBH+1 ;FROM DISK OR TMPCOR
JRST COMKRA ; GO CHECK FOR LC [255]
;READ ERROR--WE LOSE
COMKR8: TYPE [ASCIZ/?CBLTEC Transmission error on command file/]
CALLI $EXIT
;AN EOF WAS SEEN
COMKR9: PUSHJ PP,COMK99
JRST COMKR3
;TYPE OUT <C.R.>, <L.F.> IF INPUT FROM TTY
COMK99: TSWT FDSKC;
TYPE CRLF
JRST COMKR4
CRLF: ASCIZ/
/
;HELP ROUTINE
HELP: MOVE 1,[SIXBIT "COBOL"] ;YES, PRINT COBOL.HLP
PUSHJ PP,.HELPR##
;[1435] IGNORE ALL ELSE IN COMMAND STRING
AND SW,[EXP FDSKC] ;[1435] CLEAR ALL SWITCHES EXCEPT FDSKC
JRST COBLAR ;[1435] GET NEXT LINE
;ERROR ROUTINES
IFE ONESEG,<
;"DSK" IS NOT A DISK
NOTDSK: TYPE [ASCIZ/?CBLDND "DSK" is not a disk
/]
CALLI $EXIT
>
;TOO MANY OUTPUT FILES
TUMANY: MOVEI TB,[ASCIZ /?CBLICC Improper COBOL command/]
JRST BADCOM
;BINARY DEVICE CANNOT DO BINARY
BADBIN: MOVEI TB,[ASCIZ/: cannot write in binary/]
JRST TYPEIT
;OUTPUT DEVICE CANNOT DO OUTPUT
BADOUT: MOVEI TB,[ASCIZ/: cannot do output/]
JRST TYPEIT
;SOURCE FILE IS NOT AN INPUT DEVICE
NOTIN: MOVEI TB,[ASCIZ/: cannot do input/]
TYPEIT: MOVEI CH,"?"
OUTCHR CH
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT##
JRST BADCOM
;ERROR ROUTINES (CONT'D)
;SOMETHING STRANGE ABOUT STRING
BADSTR: MOVEI TB,[ASCIZ/?CBLICC improper COBOL command/]
JRST BADCOM
;COMMAND DEVICE UNAVAILABLE
NOCOMD: MOVEI TB,[ASCIZ/?CBLCDA Indirect command device unavailable/]
JRST BADCOM
;COMMAND FILE CANNOT BE FOUND
NOCOMF: MOVEI TB,[ASCIZ/?CBLCFC Cannot find command file/]
JRST BADCOM
;NAME TOO LONG
BADNAM: MOVEI TB,[ASCIZ/?CBLNM6 Name of more than six characters/]
JRST BADCOM
;BAD PROJECT-PROGRAMMER NUMBER
BADPPN: MOVEI TB,[ASCIZ/?CBLIPP Improper project-programmer number/]
JRST BADCOM
;IMPROPER CHARACTER IN STRING
BADKAR: MOVEI TB,[ASCIZ/?CBLICC Improper character in command/]
JRST BADCOM
;BAD SWITCH
BADCSW: MOVEI TB,"?"
OUTCHR TB
OUTCHR CH
MOVEI TB,[ASCIZ/ is not a legal switch/]
JRST BADCOM
;ERRORS WHILE INITIALIZING THE DEVICE
;NOT A LEGAL DEVICE
NOTDEV: MOVEI TB,[ASCIZ/: is not a legal device/]
MOVEI CH,"?"
OUTCHR CH
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
JRST BADCOM
;ERROR ROUTINES (CONT'D).
;NO FILE FOR DIRECTORY DEVICE
NOFILE: TYPE [ASCIZ/?CBLNFN No file name for /]
PUSHJ PP,FILOUT## ;[1435] TYPE DEVICE
JRST BADC0
;TOO MANY SOURCE FILES
NOROOM: MOVEI TB,[ASCIZ/?CBLTMS Too many source files/]
JRST BADCOM
;NO SOURCE FILES AT ALL
NOSRC: TSWFZ FHELP ;IS /H ON?
JRST HELP ;YES, OK
MOVEI TB,[ASCIZ/?CBLNSF No source files specified/]
;TYPE OUT MESSAGE AND RESTART COMPILATION
BADCOM:: TYPE <(TB)>
BADC0: TYPE CRLF
TSWT FDSKC ;[1435] IF COMMANDS ARE FROM TTY: RESTORE LAST CHAR
SWON FCOMCH ;[1435] IN CASE <CR-LF> WAS ILLEGAL CHARACTER
BADC1: TSWF FESRC!FECOM ;END OF COMMAND STRING?
JRST BADC2 ;YES
PUSHJ PP,COMKAR ;NO--GET CHARACTER
CAIE CH,$CR ;CARRIAGE-RETURN?
JRST BADC1 ;NO--LOOP
BADC2: TSWT FDSKC ;COMMANDS FROM TTY?
JRST START1 ; [344] YES
EXIT ;[1435] NO, GIVE UP
;ERROR ROUTINES (CONT'D).
;LIBRARY DEVICE IMPROPER
BADLIB: MOVEI TB,[ASCIZ/?CBLMBD Library device must be DSK/]
JRST BADCOM
;CANNOT ENTER A FILE
NOENTR: TYPE [ASCIZ/?CBLCEF Cannot ENTER /]
JRST ERATYP##
;NOT ENOUGH CORE TO CONTINUE COMPILATION
NOTNUF: TYPE [ASCIZ/?CBLNEC Not enough core to continue compilation
/]
JRST RESTRT##
>;END IFE TOPS20
;DOUBLE NAMTAB ENTRY
DBLNAM: TYPE [ASCIZ/?COBOLA: NAMTAB entry duplicated
/]
JRST KILL##
;THIS ROUTINE IS MOVED TO THE LOW-SEGMENT
;NOTE, IMPURE MUST BE CHANGED TO MATCH ANY CHANGES TO THESE DEFINITIONS
IFE ONESEG,<
%WEDID: JRST @WEDIED+1 ;GO TO "KILL" ROUTINE
Z
%CANT: TYPE <WEDIED+%CANT+2-%WEDID>
CALLI $EXIT
ASCIZ /?CBLCNR Cannot restart/
%GETLD: MOVEM 17,SAVEAC##+17 ;SAVE
MOVEI 17,SAVEAC ; ALL
BLT 17,SAVEAC+16 ; AC'S
MOVEI 1,WEDIED+%CANT-%WEDID ;SET UP "REENTR" TO GO TO ERROR
HRRM 1,.JBREN##
HRRM 1,.JBSA
MOVSI 1,1 ;THROW AWAY
CORE 1, ; THE HI-SEGMENT
JRST 4,WEDIED+.-%WEDID ;COULDN'T--MONITOR PROBLEM
MOVEI 1,GETFNM ;CALL
GETSEG 1, ; GETSEG
JRST 4,WEDIED+.-%WEDID ;ERROR
MOVSI 17,SAVEAC ;RESTORE AC'S
BLT 17,16
IFN DEBUG,<SETZM .JBSYM##>
%DDTST: JRST COBEXO## ;GO TO HI-SEGMENT
>;END ONESEG CONDITIONAL
IFE TOPS20,<
;TABLE OF SCRATCH DEVICES
;LH IS NAME OF A FILE, IN SIXBIT
;RH IS THE ADDRESS OF AN ENTRY TO CONTAIN DEVICE NAME, ETC.
DEVTAB: XWD 'NAM',NAMDEV##
XWD 'ERA',ERADEV##
XWD 'GEN',GENDEV##
XWD 'CPY',CPYDEV##
XWD 'AS1',AS1DEV##
XWD 'AS2',AS2DEV##
XWD 'AS3',AS3DEV##
XWD 'LIT',LITDEV##
XWD 'CRF',CRFDEV##
DEVXWD: XWD DEVTAB-.,0
;DEFAULT FOR LIBRARY FILE
LIBSET: SIXBIT "DSK"
SIXBIT "LIBARY"
SIXBIT "LIB"
Z
;TABLE OF MONTHS
MOTABL: ASCII "-Jan-"
ASCII "-Feb-"
ASCII "-Mar-"
ASCII "-Apr-"
ASCII "-May-"
ASCII "-Jun-"
ASCII "-Jul-"
ASCII "-Aug-"
ASCII "-Sep-"
ASCII "-Oct-"
ASCII "-Nov-"
ASCII "-Dec-"
>
;TABLE OF WORK TABLES
DEFINE TABSET (A,B,C,E,F,G,H),<
IFDIF <NAM>,<A>,<IFN ^D'B,<
XWD -^D'B-1,A'LOC
EXTERNAL A'LOC
>>>
XALL
WRKTAB: TABLES
WRKXWD: XWD WRKTAB-.,WRKTAB
DEFINE PUTVAL (C,D), <Z==.
XWD X'D,C>
DEFINE SETVAL (E), <
.XCREF X'E
X'E==.-Z>
DEFINE NTVAL (A,B), <
XLIST
PUTVAL A,\I
SIXBIT "'B' "
SETVAL \I
I==I+1
LIST
>
DEFINE PURGIT (E), <
PURGE X'E
>
SALL
.XCREF I,Z
I==0
NAMDAT: NTVAL ACCEP.,ACCEPT
NTVAL ACCES.,ACCESS
NTVAL ADD.,ADD
NTVAL ADVAN.,ADVANCING
NTVAL AFTER.,AFTER
NTVAL ALL.,ALL
NTVAL ALLOW.,ALLOWING
NTVAL ALPHB.,ALPHABETIC
NTVAL ALSO.,ALSO
NTVAL ALTER.,ALTER
NTVAL ALTRN.,ALTERNATE
NTVAL AND.,AND
NTVAL ANY.,ANY
NTVAL APPLY.,APPLY
NTVAL ARE.,ARE
NTVAL AREA.,AREA
NTVAL AREA.,AREAS
NTVAL ASCND.,ASCENDING
NTVAL ASCII.,ASCII
NTVAL ASSGN.,ASSIGN
NTVAL AT.,AT
NTVAL AUTHR.,AUTHOR
NTVAL BASLK.,BASIC:LOCKING
NTVAL BEFOR.,BEFORE
NTVAL BINRY.,BINARY
NTVAL BLANK.,BLANK
NTVAL BLANK.,BLANKS
NTVAL BLOCK.,BLOCK
NTVAL BOTTO.,BOTTOM
NTVAL BY.,BY
NTVAL BYTE.,BYTE
NTVAL CALL.,CALL
NTVAL CAN.,CANCEL
NTVAL CD.,CD
NTVAL CF.,CF
NTVAL CH.,CH
NTVAL CHANN.,CHANNEL
NTVAL CHARA.,CHARACTER
NTVAL CHARA.,CHARACTERS
NTVAL CHECK.,CHECK
NTVAL CHKPT.,CHECKPOINT
NTVAL CLASS.,CLASS
NTVAL CLOSE.,CLOSE
NTVAL COBOL.,COBOL
NTVAL CODE.,CODE
NTVAL CDSET.,CODE:SET
NTVAL COLLA.,COLLATING
NTVAL COL.,COLUMN
NTVAL COMMA,COMMA
NTVAL COMM.,COMMUNICATION
NTVAL COMP.,COMP
NTVAL COMP1.,COMP:1
NTVAL COMP2.,COMP:2
NTVAL COMP3.,COMP:3
IFN DBMS,<NTVAL COMPIL.,COMPILE>
IFN DEBUG,<NTVAL COMPB.,COMPILER:BREAK:IN:PHASE>
NTVAL COMP.,COMPUTATIONAL
NTVAL COMP1.,COMPUTATIONAL:1
NTVAL COMP2.,COMPUTATIONAL:2
NTVAL COMP3.,COMPUTATIONAL:3
NTVAL COMPU.,COMPUTE
NTVAL CONFG.,CONFIGURATION
NTVAL CONSL.,CONSOLE
NTVAL CONTA.,CONTAINS
NTVAL CONTR.,CONTROL
NTVAL CONTR.,CONTROLS
NTVAL COPY.,COPY
NTVAL CORR.,CORR
NTVAL CORR.,CORRESPONDING
NTVAL COUNT.,COUNT
NTVAL CURR.,CURRENCY
IFN DBMS,<NTVAL CURNT.,CURRENT>
NTVAL DATA.,DATA
NTVAL DBKEY.,DATABASE:KEY
NTVAL DBKEY.,DBKEY
NTVAL DATE..,DATE
NTVAL DATEC.,DATE:COMPILED
NTVAL DATEW.,DATE:WRITTEN
NTVAL DAY..,DAY
NTVAL DE.,DE
NTVAL DEBUG.,DEBUGGING
NTVAL DECPN.,DECIMAL:POINT
NTVAL DECLA.,DECLARATIVES
NTVAL DEFER.,DEFERRED
NTVAL DELET.,DELETE
NTVAL DLIMD.,DELIMITED
NTVAL DLIMR.,DELIMITER
NTVAL DENSIT,DENSITY
NTVAL DEPEN.,DEPENDING
NTVAL DESCN.,DESCENDING
NTVAL DEST.,DESTINATION
NTVAL DE.,DETAIL
NTVAL DISAB.,DISABLE
NTVAL DISPL.,DISPLAY
NTVAL DSPL6.,DISPLAY:6
NTVAL DSPL7.,DISPLAY:7
NTVAL DSPL9.,DISPLAY:9
NTVAL DIVID.,DIVIDE
NTVAL DIVIS.,DIVISION
NTVAL DOWN.,DOWN
IFN DBMS,<NTVAL DUPL.,DUP
NTVAL DUPL.,DUPLICATE>
NTVAL DUPL.,DUPLICATES
NTVAL DYNAM.,DYNAMIC
NTVAL EBCDC.,EBCDIC
NTVAL EGI.,EGI
NTVAL ELSE.,ELSE
NTVAL EMI.,EMI
IFN DBMS,<NTVAL EMPTY.,EMPTY>
NTVAL ENABL.,ENABLE
NTVAL END.,END
NTVAL EOP.,END:OF:PAGE
NTVAL ENTER.,ENTER
NTVAL ENTRY.,ENTRY
NTVAL ENVIR.,ENVIRONMENT
NTVAL EOP.,EOP
IFE TOPS20,<IFN MCS,<NTVAL EPI.,EPI>>
NTVAL EQUAL.,EQUAL
NTVAL EQUAL.,EQUALS
NTVAL ERROR.,ERROR
NTVAL ESI.,ESI
NTVAL EVEN.,EVEN
NTVAL EVERY.,EVERY
IFN DBMS,<NTVAL EXCL.,EXCLUSIVE
NTVAL EXCL.,EXCL>
NTVAL EXCEP.,EXCEPTION
NTVAL EXIT.,EXIT
NTVAL EXTEN.,EXTEND
NTVAL FD.,FD
NTVAL FILE.,FILE
NTVAL FILEC.,FILE:CONTROL
NTVAL FILST.,FILE:STATUS
NTVAL FILLE.,FILLER
NTVAL FINAL.,FINAL
NTVAL FIND.,FIND
NTVAL FIRST.,FIRST
NTVAL FOOT.,FOOTING
NTVAL FOR.,FOR
NTVAL F10.,FORTRAN
NTVAL FREE.,FREE
NTVAL FREED.,FREED
NTVAL FROM.,FROM
NTVAL GEN.,GENERATE
NTVAL GET.,GET
NTVAL GIVIN.,GIVING
NTVAL GO.,GO
NTVAL GREAT.,GREATER
NTVAL GROUP.,GROUP
NTVAL HEADG.,HEADING
NTVAL HIVAL.,HIGH:VALUE
NTVAL HIVAL.,HIGH:VALUES
NTVAL IO.,I:O
NTVAL IOCON.,I:O:CONTROL
NTVAL ID.,ID
NTVAL ID.,IDENTIFICATION
NTVAL IF.,IF
NTVAL IN.,IN
NTVAL INDEX.,INDEX
NTVAL INDXD.,INDEXED
NTVAL INDIC.,INDICATE
NTVAL INITL.,INITIAL
NTVAL INIT.,INITIATE
NTVAL INPUT.,INPUT
NTVAL IO.,INPUT:OUTPUT
NTVAL INSRT.,INSERT
NTVAL INSPC.,INSPECT
NTVAL INSTA.,INSTALLATION
NTVAL INTO.,INTO
NTVAL INVAL.,INVALID
NTVAL INVOK.,INVOKE
NTVAL IS.,IS
IFN DBMS,<NTVAL JOURN.,JOURNAL>
NTVAL JUST.,JUST
NTVAL JUST.,JUSTIFIED
NTVAL KEY,KEY
NTVAL KEY,KEYS;; ;ALLOW PLURAL FORM FOR READABILITY
NTVAL LABEL.,LABEL
NTVAL LAST.,LAST
NTVAL LEAD.,LEADING
NTVAL LEFT.,LEFT
NTVAL LNGTH.,LENGTH
NTVAL LESS.,LESS
NTVAL LIM.,LIMIT
NTVAL LIM.,LIMITS
NTVAL LINAG.,LINAGE
NTVAL LNGCO.,LINAGE:COUNTER
NTVAL LINE.,LINE
NTVAL LINE.,LINES
NTVAL LINKG.,LINKAGE
NTVAL LOCK.,LOCK
NTVAL LOVAL.,LOW:VALUE
NTVAL LOVAL.,LOW:VALUES
NTVAL MACRO.,MACRO
NTVAL MEMOR.,MEMORY
IFN DBMS,<NTVAL MEMBR.,MEMBER>
IFN DBMS,<NTVAL MEMBR.,MEMBERS>
NTVAL MERG.,MERGE
NTVAL MSG.,MESSAGE
NTVAL MODE.,MODE
NTVAL MODIF.,MODIFY
NTVAL MODUL.,MODULES
NTVAL MOVE.,MOVE
NTVAL MULTP.,MULTIPLE
NTVAL MULTI.,MULTIPLY
NTVAL NATIV.,NATIVE
NTVAL NEGAT.,NEGATIVE
NTVAL NEXT.,NEXT
NTVAL NO.,NO
NTVAL NONE.,NONE
NTVAL NOT.,NOT
NTVAL NUMBR.,NUMBER
NTVAL NUMER.,NUMERIC
NTVAL OBJEC.,OBJECT:COMPUTER
NTVAL OCCUR.,OCCURS
NTVAL ODD.,ODD
NTVAL OF.,OF
NTVAL OFF.,OFF
NTVAL OMITT.,OMITTED
NTVAL ON.,ON
IFN DBMS,<NTVAL ONLY.,ONLY>
NTVAL OPEN.,OPEN
NTVAL OPTIO.,OPT
NTVAL OPTIO.,OPTIONAL
NTVAL OR.,OR
NTVAL ORGAN.,ORGANIZATION
NTVAL OTHER.,OTHERS
NTVAL OUTPU.,OUTPUT
NTVAL OVRFL.,OVERFLOW
IFN DBMS,<NTVAL OWNER.,OWNER>
NTVAL PAGE.,PAGE
NTVAL PARIT.,PARITY
NTVAL PERFO.,PERFORM
NTVAL PF.,PF
NTVAL PH.,PH
NTVAL PIC.,PIC
NTVAL PIC.,PICTURE
NTVAL PLS.,PLUS
NTVAL PNTR.,POINTER
NTVAL PSTN.,POSITION
NTVAL PSTNG.,POSITIONING
NTVAL PSTV.,POSITIVE
NTVAL PRINT.,PRINTING
IFN DBMS,<NTVAL PRIOR.,PRIOR>
IFN DBMS,<NTVAL PRVCY.,PRIVACY>
NTVAL PROC.,PROCEDURE
NTVAL PROC.,PROCEDURES
NTVAL PROCE.,PROCEED
NTVAL PGM.,PROGRAM
NTVAL PGMID.,PROGRAM:ID
IFN DBMS,<NTVAL PROT.,PROT
NTVAL PROT.,PROTECTED>
NTVAL PROTC.,PROTECTION
NTVAL QUEUE.,QUEUE
NTVAL QUOTE.,QUOTE
NTVAL QUOTE.,QUOTES
NTVAL RAND.,RANDOM
NTVAL RD.,RD
NTVAL READ.,READ
NTVAL READR.,READ:REWRITE
NTVAL READW.,READ:WRITE
NTVAL RECEV.,RECEIVE
NTVAL REC.,RECORD
NTVAL RECRDG,RECORDING
NTVAL REC.,RECORDS
NTVAL REDEF.,REDEFINES
NTVAL REEL.,REEL
NTVAL REFER.,REFERENCES
NTVAL RELAT.,RELATIVE
NTVAL RELEA.,RELEASE
NTVAL REMAI.,REMAINDER
NTVAL REMOV.,REMOVE
NTVAL REMOV.,REMOVAL
NTVAL RENAM.,RENAMES
NTVAL REPLA.,REPLACING
NTVAL REPOR.,REPORT
NTVAL REPOR.,REPORTS
NTVAL REPTG.,REPORTING
NTVAL RERUN.,RERUN
NTVAL RESER.,RESERVE
NTVAL RESET.,RESET
NTVAL RETAI.,RETAIN
NTVAL RETAD.,RETAINED
IFN DBMS,<NTVAL RETR.,RETRIEVAL
NTVAL RETR.,RETR>
NTVAL RETUR.,RETURN
NTVAL REVER.,REVERSED
NTVAL REWIN.,REWIND
NTVAL REWRT.,REWRITE
NTVAL RF.,RF
NTVAL RH.,RH
NTVAL RIGHT.,RIGHT
NTVAL RMS.,RMS
NTVAL ROUND.,ROUNDED
NTVAL RUN.,RUN
IFN DBMS,<NTVAL RNUNT.,RUN:UNIT>
NTVAL SAME.,SAME
NTVAL SCHEM.,SCHEMA
NTVAL SD.,SD
NTVAL SEARC.,SEARCH
NTVAL SECT.,SECTION
NTVAL SECUR.,SECURITY
NTVAL SGMNT.,SEGMENT
NTVAL SEGME.,SEGMENT:LIMIT
NTVAL SELEC.,SELECT
NTVAL SEND.,SEND
IFN DBMS,<NTVAL SELTV.,SELECTIVE>
NTVAL SENT.,SENTENCE
NTVAL SEPER.,SEPARATE
NTVAL SEQCE.,SEQUENCE
NTVAL SEQU.,SEQUENTIAL
NTVAL SET.,SET
IFN DBMS,<NTVAL SET.,SETS>
NTVAL SIGN.,SIGN
NTVAL SIXBT.,SIXBIT
NTVAL SIZE.,SIZE
NTVAL SORT.,SORT
NTVAL SRTMG.,SORT:MERGE
NTVAL SOUR.,SOURCE
NTVAL SOURC.,SOURCE:COMPUTER
NTVAL SPACE.,SPACE
NTVAL SPACE.,SPACES
NTVAL SPECI.,SPECIAL:NAMES
NTVAL STAND.,STANDARD
NTVAL STND1.,STANDARD:1
NTVAL STDAS.,STANDARD:ASCII
NTVAL START.,START
NTVAL STATU.,STATUS
NTVAL STOP,STOP
NTVAL STORE.,STORE
NTVAL STRIN.,STRING
IFN DBMS,<NTVAL SBSCH.,SUB:SCHEMA>
NTVAL SUBQ1.,SUB:QUEUE:1
NTVAL SUBQ2.,SUB:QUEUE:2
NTVAL SUBQ3.,SUB:QUEUE:3
NTVAL SUBTR.,SUBTRACT
NTVAL SUM.,SUM
NTVAL SUPPR.,SUPPRESS
NTVAL SWTCH.,SWITCH
NTVAL SYMBL.,SYMBOLIC
NTVAL SYNCH.,SYNC
NTVAL SYNCH.,SYNCHRONIZED
NTVAL TABLE.,TABLE
NTVAL TLYNG.,TALLYING
NTVAL TAPE.,TAPE
NTVAL TERML.,TERMINAL
NTVAL TERM.,TERMINATE
NTVAL TEXT.,TEXT
NTVAL THAN.,THAN
NTVAL THRU.,THROUGH
NTVAL THRU.,THRU
NTVAL TIME..,TIME
NTVAL TIMES.,TIMES
NTVAL TO.,TO
NTVAL TOP.,TOP
NTVAL TRAC.,TRACE
NTVAL TRAIL.,TRAILING
NTVAL TRANS.,TRANSACTION
NTVAL TYPE.,TYPE
NTVAL UNAVA.,UNAVAILABLE
NTVAL UNIT.,UNIT
NTVAL UNLOC.,UNLOCK
NTVAL UNSTR.,UNSTRING
NTVAL UNTIL.,UNTIL
NTVAL UP.,UP
IFN DBMS,<NTVAL UPDAT.,UPDATE
NTVAL UPDAT.,UPDATES>
NTVAL UPON.,UPON
NTVAL USAGE.,USAGE
IFN DBMS,<NTVAL USGMD.,USAGE:MODE>
NTVAL USE.,USE
NTVAL PPN.,USER:NUMBER
NTVAL USING.,USING
NTVAL VALUE.,VALUE
NTVAL VALUE.,VALUES
NTVAL VARYI.,VARYING
NTVAL VERB.,VERB
IFN DBMS,<NTVAL VIA.,VIA>
NTVAL WHEN.,WHEN
NTVAL WITH.,WITH
IFN DBMS,<NTVAL WITHN.,WITHIN>
NTVAL WORDS.,WORDS
NTVAL WORKI.,WORKING:STORAGE
NTVAL WRITE.,WRITE
NTVAL ZERO.,ZERO
NTVAL ZERO.,ZEROES
NTVAL ZERO.,ZEROS
;ANS-8x RESERVED words
NAMD82: NTVAL ALPHA.,ALPHABET
NTVAL ALPHL.,ALPHABETIC:LOWER
NTVAL ALPHU.,ALPHABETIC:UPPER
NTVAL ALPHN.,ALPHANUMERIC
NTVAL ALPHE.,ALPHANUMERIC:EDITED
NTVAL COMMN.,COMMON
NTVAL CNTNT.,CONTENT
NTVAL CONT.,CONTINUE
NTVAL CONVS.,CONVERSION
NTVAL CONVT.,CONVERTING
NTVAL DOW.,DAY:OF:WEEK
NTVAL ENDXX.,END:ADD
NTVAL ENDXX.,END:CALL
NTVAL ENDXX.,END:COMPUTE
NTVAL ENDXX.,END:DELETE
NTVAL ENDXX.,END:DIVIDE
NTVAL ENDXX.,END:ENTER
NTVAL ENDXX.,END:EVALUATE
NTVAL ENDXX.,END:FREE
NTVAL ENDXX.,END:IF
NTVAL ENDXX.,END:MULTIPLY
NTVAL ENDXX.,END:OPEN
NTVAL ENDXX.,END:PERFORM
NTVAL ENDXX.,END:READ
NTVAL ENDXX.,END:RECEIVE
NTVAL ENDXX.,END:RETAIN
NTVAL ENDXX.,END:RETURN
NTVAL ENDXX.,END:REWRITE
NTVAL ENDXX.,END:SEARCH
NTVAL ENDXX.,END:START
NTVAL ENDXX.,END:STRING
NTVAL ENDXX.,END:SUBTRACT
NTVAL ENDXX.,END:UNSTRING
NTVAL ENDXX.,END:WRITE
NTVAL EVAL.,EVALUATE
NTVAL EXTER.,EXTERNAL
NTVAL FALSE.,FALSE
NTVAL GLOBL.,GLOBAL
NTVAL INITI.,INITIALIZE
NTVAL NUMED.,NUMERIC:EDITED
NTVAL ORDER.,ORDER
NTVAL OTHER.,OTHER
NTVAL PADD.,PADDING
NTVAL PURG.,PURGE
NTVAL REFER.,REFERENCE
NTVAL RFMOD.,REFERENCE:MODIFIER
NTVAL REPLC.,REPLACE
NTVAL STND2.,STANDARD:2
NTVAL TEST.,TEST
NTVAL THEN.,THEN
NTVAL TRUE.,TRUE
0
IF2,< I==0
REPEAT 1000,<PURGIT \I
I==I+1>
PURGE I,Z
>
END COBOLA