Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/cobola.mac
There are 7 other files named cobola.mac in the archive. Click here to see a list.
; UPD ID= 3528 on 5/7/81 at 10:46 AM by NIXON
TITLE COBOLA FOR COBOL V12C
SUBTTL COBOL INITIALIZATION AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P,UUOSYM
%%P==:%%P
DBMS==:DBMS
DEBUG==:DEBUG
EBCMP.==:EBCMP.
MPWCEX==:MPWCEX
BIS==:BIS
ONESEG==:ONESEG
IFE TOPS20,<SEARCH MACTEN>
IFN TOPS20,<SEARCH MONSYM,MACSYM>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
SALL
DEFINE TYPE(ADDR),<
OUTSTR ADDR
>
;FLAGS USED IN SWITCH SCANNING
FL.LIB==1 ;FILE IS A LIBRARY
FL.REW==2 ;DEVICE NEEDS REWINDING
IFE TOPS20,<
FL.ZRO==4 ;DIRECTORY NEEDS CLEARING
>
;EDIT HISTORY
;V12*****************
;NAME DATE COMMENTS
;DMN 20-APR-83 [1462] REMOVE DUPLICATE RESERVED WORD CONFLICT.
;DMN 03-DEC-82 [1435] Prevent TI wait state after error message
; is printed
;RLF 19-NOV-82 [1432] TURN ON SWITCH TO TYPE ERROR MESSAGES
;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
COBOLA: PORTAL START ;COMMANDS FROM TTY
PORTAL COMDSK ;COMMANDS FROM DISK
PORTAL COBLAR ;RESTART
$COPYRIGHT ;Put standard copyright statement in EXE file
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: MOVEI SW,0 ;CLEAR FLAGS
;START A NEW COMPILATION
COBLAR: TSWF FDSKC ;INPUT COMMAND FROM TTY?
JRST COBLAS ;NO
CALLI $RESET ;YES
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
COBLAS:
SETZM SUBPRG## ;ASSUME MAIN PROGRAM UNTIL FURTHER NOTICE
SETZM SLASHJ## ;CLR /J SWITCH
IFN TOPS20,<
SWON FREENT ;ASSUME 2 SEG CODE IF TOPS-20
>
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)
IFE ONESEG,<
MOVE TA,RUNDEV ;IS RUN DEVICE REALLY A DISK?
DEVCHR TA,
TXNN TA,DV.DSK
JRST NOTDSK ;NO--ERROR
> ;END IFE ONESEG
;SET UP IMPURE AREA.
;GET RID OF LEADING CARRIAGE-RETURNS IN COMMAND STRING.
SETFAZ A;
TSWF FDSKC ;[266] DSK INPUT FOR COMMANDS
JRST COBAST ;[266] YES SKIP THIS
PUSHJ PP,TTYON## ;[266] TURN ON TTY IF USER TYPED CONT O
TYPE [ASCIZ/
*/]
COBAST: ;[266] NEW LABEL
PUSHJ PP,SETIMP ;SET UP IMPURE AREA
PUSHJ PP,GETDT ;SET UP DATE, TIME AND DEFAULT PATH
PUSHJ PP,GETVER ;SET UP VERSION NUMBER
JRST TESTCR
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?
IFN ANS68,<
TYPE [ASCIZ/COBOL: /];NO
>
IFN ANS74,<
TYPE [ASCIZ/CBL74: /]; 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
TSWTZ FHELP ;/H?
JRST SETSR1 ;NO
HELP:
IFN ANS68,<
IFE FT68274,<
MOVE 1,[SIXBIT "COBOL"] ;YES, PRINT COBOL.HLP
>
IFN FT68274,<
MOVE 1,[SIXBIT "68274"]
>
>
IFN ANS74,<
MOVE 1,[SIXBIT "CBL74"] ;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
SETSR1: 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
IFE FT68274,<
MOVSI TA,'REL'
>
IFN FT68274,<
MOVSI TA,'CVT' ;USE DEFAULT CONVERTED EXTENSION
>
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:
IFE FT68274,<
MOVEI I1,.IOBIN
>
IFN FT68274,<
MOVEI I1,.IOASC ;ITS THE CONVERTED SOURCE FILE
>
MOVEI DA,BINDEV
MOVEI DC,BIN
SKIPN BINDEV ;ANY BINARY FILE?
JRST INITL ;NO
PUSHJ PP,OPNOUT
IFN FT68274,<
MOVE TA,.JBFF
MOVEM TA,BINBUF##
OUTBUF BIN,2
>
MOVE TA,BINSWS## ;REWIND?
TRNE TA,FL.REW
MTREW. BIN,
IFE TOPS20,<
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,
IFE TOPS20,<
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##
IFE FT68274,<
MOVE TA,GENBUF## ;BINFIL OVERLAYS GENFIL
MOVEM TA,BINBUF##
>
;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
SKIPE (LN) ;DONE?
JRST SETN1 ;NO--LOOP
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]
MOVE 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##
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;
;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"
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
;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:>
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: 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]
IFE TOPS20,<
SETOM MYPATH## ;MY JOB,,GET PATH FUNCTION
MOVE TA,[11,,MYPATH]
PATH. TA, ;GET DEFAULT PATH
SETZM MYPPN## ;FAILED
>
IFN TOPS20,<
GETPPN TA, ;GET LOGGED-IN PPN
JFCL ;JUST INCASE JACCT ON
MOVEM TA,MYPPN## ;STORE IT
>
POPJ PP,
;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,
;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
IFE TOPS20,<
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
SWON FTERA ;[1432] TURN ON SWITCH FOR TYPING ON TTY
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"
IFN ANS74,<
SETOM DEBSW## ;B - GENERATE DEBUG CODE
>
IFN ANS68,<
JRST BADCSW
>
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
>
JRST BADCSW ;G -
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 BADCSW ;V -
JRST SWICHW ;W -
JRST SWICHX ;X - DEFAULT THINGS TO EBCDIC INSTEAD OF SIXBIT.
IFN ANS68,<
JRST BADCSW ;Y -
>
IFN ANS74,<
JRST SWICHY ;Y - SET FIPS FLAGGER LEVEL
>
IFN TOPS20,<
JRST BADCSW ;Z -
>
IFE TOPS20,<
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
IFE TOPS20,<
SWON FREENT ;R - TURN ON "/R"
>
IFN TOPS20,<
SETOM RENSW## ;R - SET FLAG FOR COBOLG, LEAVE FREENT ON
>
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,
IFE TOPS20,<
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:
IFN EBCMP.,<
HRROI TA,%US.EB ;DISPLAY-9
MOVEM TA,DEFDSP## ;SET DEFAULT MODE
POPJ PP,
>
IFE EBCMP.,<
MOVEI TB,[ASCIZ -?/X is not allowed, for an EBCDIC/COMP-3 compiler
reassemble the compiler and OTS with EBCMP.==1-]
JRST BADCOM
>
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,
>
IFN ANS74,<
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 > 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/
/
;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 CMDS 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
;DOUBLE NAMTAB ENTRY
DBLNAM: TYPE [ASCIZ/?COBOLA: NAMTAB entry duplicated
/]
JRST KILL##
;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##
;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
;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
SUBTTL TABLE OF RESERVED WORDS
;VERBS
;001 ACCEPT 020 MOVE
;002 ADD 021 MULTIPLY
;003 ALTER 022 NOTE
;004 CLOSE 023 OPEN
;005 COMPUTE 024 PERFORM
;006 COPY 025 READ
;007 DISPLAY 026 RELEASE
;010 DIVIDE 027 RETURN
;011 ELSE 030 SEARCH
;012 031 SEEK
;013 ENTER 032 SET,SETS
;014 EXAMINE 033 SORT
;015 EXIT 034 STOP
;016 GO 035 SUBTRACT
;017 IF 036 USE
; 037 WRITE
;040 INITIATE
;041 GENERATE
;042 TERMINATE
;043 DELETE
;044 REWRITE
;045 STORE
;046 INSERT
;047 MODIFY
;050 GET
;051 REMOVE
;052 FIND
;053 RECEIVE
;054 SEND
;055 DISABLE
;056 ENABLE
;060 STRING
;061 UNSTRING
;062 RETAIN
;063 FREE
;064 METER--JSYS
;WORDS USED ONLY BY ID & ED SCANS
;100 [%316]ACCESS TO 267 126 PROGRAM-ID
;101 ACTUAL 127 RANDOM
;102 ALTERNATE 130 REMARKS
;103 <EMPTY> 131 RERUN
;104 ASSIGN 132 RESERVE
;105 AUTHOR 133 SAME
;106 CONFIGURATION 134 SECURITY
;107 <EMPTY> 135 SEGMENT-LIMIT
;110 DATE-COMPILED 136 SELECT
;111 ENVIRONMENT 137 SEQUENTIAL
; 140 SIGN
;112 FILE-CONTROL 141 SOURCE-COMPUTER
;113 FILE-LIMIT,FILE-LIMITS 142 SPECIAL-NAMES
;114 I-O-CONTROL 143 FILE-STATUS
;115 INSTALLATION 144 TAPE
;116 MEMORY 145 WORDS
;117 MODULES 146 <EMPTY>
;120 MULTIPLE 147 COMMA
;121 OBJECT-COMPUTER 150 DECIMAL-POINT
;122 151 MODE
;123 OPTIONAL 152 RELATIVE
;124 POSITION 153 DEFERRED
;125 PROCESSING 154 CHANNEL
; 155 STANDARD-ASCII
; 156 PDP-6
; 157 PDP-10, DECSYSTEM-10
; 160 RECORDING
; 161 DENSITY
; 162 PARITY
; 163 ASCII
; 164 SIXBIT
; 165 BINARY
; 166 DECSYSTEM-20
; 167 ODD
; 170 EVEN
; 171 BYTE
; 172 METER--ING
;WORDS WHICH CAN GO AWAY AFTER DD SCAN
;201 ALPHANUMERIC 222 LIMIT[S]
;202 BLANK 223 LEFT
;203 BLOCK 224 OCCURS
;204 COMP,COMPUTATIONAL 225 OMITTED
;205 COMP-1,COMPUTATIONAL-1 226 PIC,PICTURE
;206 CONTAINS 227 RD
;207 COMP-3,COMPUTATIONAL-3 230 REDEFINES
;210 DATE-WRITTEN 231 RENAMES
;211 DATABASE-KEY
;212 DISPLAY-6 232 RIGHT
;213 DISPLAY-7 233 SD
;214 FD 234 COMP-2,COMPUTATIONAL-2
;215 DISPLAY-9 235 SYNC,SYNCHRONIZED
;216 IDENTIFICATION,ID 236 USAGE
;217 INDEX 237 VALUE,VALUES
;220 INDEXED
;221 JUST,JUSTIFIED
;240 WORKING-STORAGE 260 CONTROL[S]
;241 CHARACTERS [74] TO 642 261 COMPILE
;242 USER-AREA 262 FINAL
;243 LINKAGE 263 FOOTING
;244 SUB-SCHEMA 264 GROUP
;245 SCHEMA 265 HEADING
;246 INVOKE 266 INDICATE
;247 TYPE 267 ACCESS
;250 RH 270 NUMBER
;251 PH 271 <EMPTY>
;252 CH 272 PLUS
;253 DE,DETAIL 273 REPORT[S]
;254 CF 274 RESET
;255 PF 275 SOURCE
;256 RF 276 SUM
;257 COLUMN 277 CODE
;WORDS USED BY ALL PHASES
;300 ADVANCING 341 LEADING
;301 AFTER 342 LESS,"<"
;302 CONSOLE
;303 ALPHABETIC 343 LINE,LINES
;304 AND 344 LOCK
;305 ARE (SEE IS) 345 NEGATIVE
;305 IS (SEE ARE) 346 NEXT
;306 ASCENDING 347 NO
;307 AT 350 NOT
;310 BEFORE 351 NUMERIC
;311 BEGINNING 352 ON
;312 BY 353 OR
;313 COBOL 354 OUTPUT
;314 CORR,CORRESPONDING 355 POSITIVE
;315 DECLARATIVES 356 PROCEED
;316 DEPENDING 357 RECORD,RECORDS
;317 DESCENDING 360 REEL (SEE UNIT)
;320 DOWN 360 UNIT (SEE REEL)
;321 ENDING 361 REPLACING
;322 EQUAL,EQUALS,"=" 362 REVERSED
;323 ERROR 363 REWIND
;324 EVERY 364 ROUNDED
;325 FILE 365 RUN
;326 FIRST 366 SECTION
;327 FOR 367 SENTENCE
;330 FROM 370 TALLYING
;331 GIVING 371 THAN
;332 GREATER,">" 372 THRU,THROUGH
;333 INPUT-OUTPUT,I-O 373 TIMES
;334 IN (SEE OF) 374 TO
;334 OF (SEE IN) 375 UNTIL
;335 INPUT 376 UP
;336 INTO 377 UPON
;337 INVALID
;340 KEY,KEYS
;400 USING 405 DIVISION
;401 VARYING 406 END
;402 WHEN 407 STANDARD
;403 WITH 410 LABEL
;404 SIZE 411 PROCEDURE, PROCEDURES
; 412 OFF
; 413 REMAINDER
; 414 MACRO
; 415 FORTRAN-IV
; 416 SWITCH
; 417 REPORTING
;420 TRACE ;500 CLASS
;421 FILLER ;501 POINTER
;422 CALL ;502 SEGMENT
;423 FORTRAN ;503 ESI
;424 CANCEL ;504 EMI
;425 ENTRY ;505 EGI
;426 GOBACK ;506 EPI
;427 PROGRAM ;507 TERMINAL
;430 OVERFLOW ;510 PAGE
;431 ANY ;511 DATA
;432 EMPTY ;512 DELIMITED
;433 MEMBER,MEMBERS ;513 DELIMITER
;434 OWNER ;514 VERB
;435 AREA ;515 OTHERS
;436 CURRENCY ;516 ALLOWING
;437 SUPPRESS ;517 NONE
;440 UPDATE ;520 UNAVAILABLE
;441 ONLY ;521 READ-REWRITE
;442 SELECTIVE ;522 READ-WRITE
;443 RUN-UNIT ;523 FREED
;444 STATUS ;524 RETAINED
;445 CURRENT ;525 POSITIONING
;446 PRIOR ;526 JOURNAL
;447 LAST ;527 CHECK
;450 DUPLICATE, DUPLICATES ;530 SEQUENCE
;451 WITHIN ;531 TRANSACTION
;452 PRIVACY ;532 VIA
;453 USAGE-MODE
;454 RETRIEVAL
;455 PROTECTED
;456 EXCLUSIVE
;457 COMMUNICATION ;537 COMPILER-BREAK-IN-PHASE ;[1462]
;460 CD
;461 INITIAL
;462 SYMBOLIC, NOMINAL
;463 QUEUE
;464 SUB-QUEUE-1
;465 SUB-QUEUE-2
;466 SUB-QUEUE-3
;467 MESSAGE
;470 DATE
;471 TIME
;472 TEXT
;473 LENGTH
;474 COUNT
;475 DEPTH
;476 DESTINATION
;477 TABLE
;ANS-74 RESERVED WORDS
;600 ALSO
;601 BOTTOM
;602 CLOCK-UNITS
;603 CODE-SET
;604 COLLATING
;605 DAY
;615 DEBUGGING
;616 DYNAMIC
;617 EOP, END-OF-PAGE
;620 EXCEPTION
;621 EXTEND
;622 INSPECT
;623 LINAGE
;624 LINAGE-COUNTER
;625 RMS
;626 MERGE
;627 NATIVE
;630 ORGANIZATION
;631 CHECKPOINT
;632 PRINTING
;633 REFERENCES
;634 SEPARATE
;635
;636 SORT-MERGE
;637 STANDARD-1
;640 START
;641 TRAILING
;642 CHARACTER, CHARACTERS
;643 EBCDIC
;700 HIGH-VALUE,HIGH-VALUES 704 TALLY
;701 LOW-VALUE,LOW-VALUES 705 ZERO,ZEROS,ZEROES
;702 QUOTE,QUOTES 706 ALL
;703 SPACE,SPACES 707 TODAY
;765 , 772 +
;766 ; 773 -
;767 ( 774 /
;770 ) 775 *
;771 . 776 **
;777 END OF SOURCE
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
IFN ANS68,<NTVAL ACTUA.,ACTUAL>
NTVAL ADD.,ADD
NTVAL ADVAN.,ADVANCING
NTVAL AFTER.,AFTER
NTVAL ALL.,ALL
NTVAL ALLOW.,ALLOWING
NTVAL ALPHB.,ALPHABETIC
IFN ANS74,<NTVAL ALSO.,ALSO>
NTVAL ALTER.,ALTER
NTVAL ALTRN.,ALTERNATE
NTVAL AND.,AND
NTVAL ANY.,ANY
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 BEFOR.,BEFORE
IFN ANS68,<NTVAL BEGIN.,BEGINNING>
NTVAL BINRY.,BINARY
NTVAL BLANK.,BLANK
NTVAL BLOCK.,BLOCK
IFN ANS74,<NTVAL BOTTO.,BOTTOM>
NTVAL BY.,BY
NTVAL BYTE.,BYTE
NTVAL CALL.,CALL
NTVAL CAN.,CANCEL
IFN MCS!TCS!ANS74,<NTVAL CD.,CD>
NTVAL CF.,CF
NTVAL CH.,CH
NTVAL CHANN.,CHANNEL
IFN ANS74,<NTVAL CHARA.,CHARACTER>
NTVAL CHARA.,CHARACTERS
NTVAL CHECK.,CHECK
NTVAL CHKPT.,CHECKPOINT
IFN MCS!TCS,<NTVAL CLASS.,CLASS>
;IFN ANS74,<NTVAL CLCKU.,CLOCK:UNITS>
NTVAL CLOSE.,CLOSE
NTVAL COBOL.,COBOL
NTVAL CODE.,CODE
IFN ANS74,<NTVAL CDSET.,CODE:SET>
IFN ANS74,<NTVAL COLLA.,COLLATING>
NTVAL COL.,COLUMN
NTVAL COMMA,COMMA
NTVAL COMM.,COMMUNICATION
NTVAL COMP.,COMP
NTVAL COMP1.,COMP:1
;IFN ANS74,<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
;IFN ANS74,<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
IFN MCS!TCS!ANS74,<NTVAL DATE..,DATE>
NTVAL DATEC.,DATE:COMPILED
NTVAL DATEW.,DATE:WRITTEN
IFN ANS74,<NTVAL DAY..,DAY>
NTVAL DE.,DE
IFN ANS74,<NTVAL DEBUG.,DEBUGGING>
NTVAL DECPN.,DECIMAL:POINT
NTVAL DECLA.,DECLARATIVES
NTVAL PDP10.,DECSYSTEM10
NTVAL PDP10.,DECSYSTEM:10
NTVAL DEC20.,DECSYSTEM:20
NTVAL DEFER.,DEFERRED
NTVAL DELET.,DELETE
NTVAL DLIMD.,DELIMITED
NTVAL DLIMR.,DELIMITER
NTVAL DENSIT,DENSITY
NTVAL DEPEN.,DEPENDING
IFN ANS68,<IFN MCS!TCS,<NTVAL DEPTH.,DEPTH>> ;OBSOLETE
NTVAL DESCN.,DESCENDING
IFN MCS!TCS,<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>
IFN ANS74,<NTVAL DUPL.,DUPLICATES>
IFN ANS74,<NTVAL DYNAM.,DYNAMIC>
IFN ANS74,<NTVAL EBCDC.,EBCDIC>
IFN MCS!TCS,<NTVAL EGI.,EGI>
NTVAL ELSE.,ELSE
IFN MCS!TCS,<NTVAL EMI.,EMI>
IFN DBMS,<NTVAL EMPTY.,EMPTY>
NTVAL ENABL.,ENABLE
NTVAL END.,END
IFN ANS74,<NTVAL EOP.,END:OF:PAGE>
IFN ANS68,<NTVAL ENDIN.,ENDING>
NTVAL ENTER.,ENTER
NTVAL ENTRY.,ENTRY
NTVAL ENVIR.,ENVIRONMENT
IFN ANS74,<NTVAL EOP.,EOP>
IFN MCS!TCS,<IFE TOPS20,<NTVAL EPI.,EPI>>
NTVAL EQUAL.,EQUAL
NTVAL EQUAL.,EQUALS
NTVAL ERROR.,ERROR
IFN MCS!TCS,<NTVAL ESI.,ESI>
NTVAL EVEN.,EVEN
NTVAL EVERY.,EVERY
IFN ANS68,<NTVAL EXAMI.,EXAMINE>
IFN DBMS,<NTVAL EXCL.,EXCLUSIVE
NTVAL EXCL.,EXCL>
IFN ANS74,<NTVAL EXCEP.,EXCEPTION>
NTVAL EXIT.,EXIT
NTVAL EXTEN.,EXTEND
NTVAL FD.,FD
NTVAL FILE.,FILE
NTVAL FILEC.,FILE:CONTROL
IFN ANS68,<NTVAL FILEL.,FILE:LIMIT>
IFN ANS68,<NTVAL FILEL.,FILE:LIMITS>
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
IFN ANS68,<NTVAL FORTR.,FORTRAN:IV>
NTVAL FREE.,FREE
NTVAL FREED.,FREED
NTVAL FROM.,FROM
NTVAL GEN.,GENERATE
NTVAL GET.,GET
NTVAL GIVIN.,GIVING
NTVAL GO.,GO
IFN ANS68,<NTVAL GOBAK.,GOBACK>
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
IFN MCS!TCS!ANS74,<NTVAL INITL.,INITIAL>
NTVAL INIT.,INITIATE
NTVAL INPUT.,INPUT
NTVAL IO.,INPUT:OUTPUT
NTVAL INSRT.,INSERT
IFN ANS74,<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
IFN MCS!TCS!ANS74,<NTVAL LNGTH.,LENGTH>
NTVAL LESS.,LESS
NTVAL LIM.,LIMIT
NTVAL LIM.,LIMITS
IFN ANS74,<NTVAL LINAG.,LINAGE>
IFN ANS74,<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>
IFN CSTATS,<NTVAL METNG.,METER::ING>
IFN CSTATS,<NTVAL METJS.,METER::JSYS>
NTVAL MERG.,MERGE
IFN MCS!TCS!ANS74,<NTVAL MSG.,MESSAGE>
NTVAL MODE.,MODE
NTVAL MODIF.,MODIFY
NTVAL MODUL.,MODULES
NTVAL MOVE.,MOVE
NTVAL MULTP.,MULTIPLE
NTVAL MULTI.,MULTIPLY
IFN ANS74,<NTVAL NATIV.,NATIVE>
NTVAL NEGAT.,NEGATIVE
NTVAL NEXT.,NEXT
NTVAL NO.,NO
IFN ANS68,<NTVAL SYMBL.,NOMINAL>
NTVAL NONE.,NONE
NTVAL NOT.,NOT
IFN ANS68,<NTVAL NOTE.,NOTE>
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
IFN ANS74,<NTVAL ORGAN.,ORGANIZATION>
NTVAL OTHER.,OTHERS
NTVAL OUTPU.,OUTPUT
NTVAL OVRFL.,OVERFLOW
IFN DBMS,<NTVAL OWNER.,OWNER>
NTVAL PAGE.,PAGE
NTVAL PARIT.,PARITY
NTVAL PDP10.,PDP:10
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
IFN ANS74,<NTVAL PRINT.,PRINTING>
IFN DBMS,<NTVAL PRIOR.,PRIOR>
IFN DBMS,<NTVAL PRVCY.,PRIVACY>
NTVAL PROC.,PROCEDURE
IFN ANS74,<NTVAL PROC.,PROCEDURES>
NTVAL PROCE.,PROCEED
IFN ANS68,<NTVAL PRCSS.,PROCESSING>
NTVAL PGM.,PROGRAM
NTVAL PGMID.,PROGRAM:ID
IFN DBMS,<NTVAL PROT.,PROTECTED
NTVAL PROT.,PROT>
IFN MCS!TCS,<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
IFN ANS74,<NTVAL REFER.,REFERENCES>
NTVAL RELAT.,RELATIVE
NTVAL RELEA.,RELEASE
NTVAL REMAI.,REMAINDER
IFN ANS68,<NTVAL REMAR.,REMARKS>
NTVAL REMOV.,REMOVE
IFN ANS74,<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
IFN ANS74,<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
IFN ANS68,<NTVAL SEEK.,SEEK>
IFN MCS!TCS,<NTVAL SGMNT.,SEGMENT>
NTVAL SEGME.,SEGMENT:LIMIT
NTVAL SELEC.,SELECT
NTVAL SEND.,SEND
IFN DBMS,<NTVAL SELTV.,SELECTIVE>
NTVAL SENT.,SENTENCE
IFN ANS74,<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
IFN ANS74,<NTVAL SRTMG.,SORT:MERGE>
NTVAL SOUR.,SOURCE
NTVAL SOURC.,SOURCE:COMPUTER
NTVAL SPACE.,SPACE
NTVAL SPACE.,SPACES
NTVAL SPECI.,SPECIAL:NAMES
NTVAL STAND.,STANDARD
IFN ANS74,<NTVAL STND1.,STANDARD:1>
NTVAL STDAS.,STANDARD:ASCII
IFN ANS74,<NTVAL START.,START>
NTVAL STATU.,STATUS
NTVAL STOP,STOP
NTVAL STORE.,STORE
NTVAL STRIN.,STRING
IFN DBMS,<NTVAL SBSCH.,SUB:SCHEMA>
IFN MCS!TCS,<NTVAL SUBQ1.,SUB:QUEUE:1
NTVAL SUBQ2.,SUB:QUEUE:2
NTVAL SUBQ3.,SUB:QUEUE:3>
NTVAL SUBTR.,SUBTRACT
NTVAL SUM.,SUM
IFN DBMS!<ANS74&RPW>,<NTVAL SUPPR.,SUPPRESS>
NTVAL SWTCH.,SWITCH
NTVAL SYMBL.,SYMBOLIC
NTVAL SYNCH.,SYNC
NTVAL SYNCH.,SYNCHRONIZED
IFN MCS!TCS,<NTVAL TABLE.,TABLE>
IFN ANS68,<NTVAL TALLY,TALLY>
NTVAL TLYNG.,TALLYING
NTVAL TAPE.,TAPE
IFN MCS!TCS,<NTVAL TERML.,TERMINAL>
NTVAL TERM.,TERMINATE
IFN MCS!TCS,<NTVAL TEXT.,TEXT>
NTVAL THAN.,THAN
NTVAL THRU.,THROUGH
NTVAL THRU.,THRU
IFN MCS!TCS!ANS74,<NTVAL TIME..,TIME>
NTVAL TIMES.,TIMES
NTVAL TO.,TO
IFN ANS68,<NTVAL TODAY,TODAY>
IFN ANS74,<NTVAL TOP.,TOP>
NTVAL TRAC.,TRACE
IFN ANS74,<NTVAL TRAIL.,TRAILING>
NTVAL TRANS.,TRANSACTION
NTVAL TYPE.,TYPE
NTVAL UNAVA.,UNAVAILABLE
NTVAL UNIT.,UNIT
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
0
IF2,< I==0
REPEAT 1000,<PURGIT \I
I==I+1>
PURGE I,Z
>
END COBOLA