Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
cobola.mac
There are 7 other files named cobola.mac in the archive. Click here to see a list.
; UPD ID= 1967 on 7/2/79 at 1:55 PM by N:<NIXON>
TITLE COBOLA FOR COBOL V12
SUBTTL COBOL INITIALIZATION AL BLACKINGTON/CAM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
DBMS==:DBMS
DEBUG==:DEBUG
EBCMP.==:EBCMP.
MPWCEX==:MPWCEX
BIS==:BIS
IFE TOPS20,<SEARCH UUOSYM> ;FOR GETTABS
;EDITS
;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 [144]
TWOSEG
RELOC 400000
SALL
COBOLA: JRST 1,START ;COMMANDS FROM TTY
JRST 1,COMDSK ;COMMANDS FROM DISK
JRST 1,COBLAR ;RESTART
START: SKIPN 11 ; CHECK RUN-TIME DEVICE [144]
MOVSI 11,(SIXBIT 'DSK') ; IF NONE USE DSK [144]
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
INIT COM,1 ;GET TTY FOR COMMAND CHANNEL
SIXBIT "TTY"
XWD 0,COMBH##
HALT .-3 ;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?
CALLI TA,$DEVCH
TLNN TA,$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 ; DSK INPUT FOR COMMANDS [266]
JRST COBAST ; YES SKIP THIS [266]
PUSHJ PP,TTYON## ; TURN ON TTY IF USER TYPED CONT O [266]
TTCALL 3,[ASCIZ "
*"]
COBAST: ; NEW LABEL [266]
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;
TTCALL 3,[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,15 ;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,<
TTCALL 3,[ASCIZ "COBOL: "]; NO
>
IFN ANS74,<
TTCALL 3,[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
TRNE TA,$BIN ;BINARY LEGAL?
TLNN TA,$OUT ;YES--OUTPUT DEVICE?
JRST BADBIN ;NO--ERROR
;SET UP LISTING DEVICE
SETLST: CAIN CH,"=" ;ANY FILE THERE?
JRST SETLSA ;NO
CAIN CH,15 ;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
TLNN TA,$OUT ;OUTPUT DEVICE?
JRST BADOUT ;NO--ERROR
;SET UP SOURCE DEVICE
SETSRC: CAIN CH,15 ;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,<
MOVE 1,[SIXBIT "COBOL"] ;YES, PRINT COBOL.HLP
>
IFN ANS74,<
MOVE 1,[SIXBIT "CBL74"] ;YES, PRINT COBOL.HLP
>
PUSHJ 17,.HELPR##
JRST BADC2 ;IGNORE ALL ELSE IN COMMAND STRING
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
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,[XWD LIBSET##,LIBDEV##] ;NO--TRY "DSK:LIBARY.LIB"
BLT TA,LIBDEV+3
MOVEI DA,LIBDEV
MOVEI I1,0
MOVEI I3,DEVBH##(DA)
MOVEI DC,LIB
PUSHJ PP,OPENIT##
HRRZ TA,.JBFF
MOVEM TA,LIBBUF##
INBUF LIB,1
MOVEI I4,0
LOOKUP LIB,I1
SETZM LIBDEV
;INITIALIZE BINARY DEVICE
INITB: MOVEI I1,14
MOVEI DA,BINDEV
MOVEI DC,BIN
SKIPN BINDEV ;ANY BINARY FILE?
JRST INITL ;NO
PUSHJ PP,OPNOUT
MOVE TA,BINSWS## ;REWIND?
TRNE TA,2
MTAPE BIN,$REW
IFE TOPS20,<
TRNE TA,4 ;CLEAR DIRECTORY?
CALLI BIN,$CLEAR
>
SETOM BINBLK##
;INITIALIZE LISTING DEVICE
INITL: MOVEI I1,0
MOVEI DA,LSTDEV
MOVEI DC,LST
TSWF FNOLST; ;ANY LISTING DEVICE?
JRST INITS ;NO
MOVE TA,LSTDEV ;YES--TTY?
CALLI TA,$DEVCH
TLNE TA,$AVAIL
TLNN TA,$CONSL
JRST INITL1 ;NO
TLNN TA,$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,2
MTAPE LST,$REW
IFE TOPS20,<
TRNE TA,4 ;CLEAR DIRECTORY?
CALLI LST,$CLEAR
>
SETOM LSTBLK##
;INITIALIZE SCRATCH FILES
INITS: TSWF FNOLST ;IF NO LISTING,
SETZM CREFSW ; CLEAR '/C'
CALLI TC,$PJOB ;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,14 ;USUALLY BINARY MODE
CAIN DC,CPY ;CPYFIL?
MOVEI I1,0 ;YES--ASCII MODE
CAIE DC,NAM ;NAMFIL
CAIN DC,LIT ; OR LITFIL?
MOVEI I1,17 ;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##
;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 TA,[POINT 6,(LN)]
MOVE TB,[POINT 6,NAMWRD]
SETX1A: ILDB CH,TA
CAIN CH,"."-40
MOVEI CH,";"-40
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,(SIXBIT "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,1
JRST SCNCM6 ;NO--ERROR
SCNCM2: MOVE TA,LASTDV
MOVEM TA,DEVDEV(DA)
CALLI TA,$DEVCH
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,15 ;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
MOVE I4,DEVPP##(DA)
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: TLNN TA,$IN ;INPUT DEVICE?
JRST NOTIN ;NO--ERROR
TLNE TA,$DIREC ;DIRECTORY DEVICE?
SKIPE DEVFIL(DA) ;YES--ANY FILE NAME?
SKIPA TB,DEVSW(DA) ;YES, LIBRARY FILE?
JRST NOFILE ;NO--ERROR
TRNE TB,1
TLNE TA,$DSK ;YES--IS IT DSK?
POPJ PP, ;YES
JRST BADLIB ;NO--ERROR
;SET UP TO GET COMMANDS FROM DISK
COMDSK: MOVEM 7,RUNPPN ;SAVE DEV AND PPN OF RUN COMMAND
MOVEM 11,RUNDEV
MOVSI SW,FDSKC/1000000 ;CLEAR FLAGS--SET "COMMANDS FROM DISK"
CALLI $RESET
MOVSI TA,(SIXBIT "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
CALLI TB,$CORE ;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
CALLI TA,$TMPCR ; 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: INIT COM,0
SIXBIT /DSK/
XWD 0,COMBH
JRST START1 ; [344] NO DSK -- USE TTY
MOVEI I1,(SIXBIT "COB") ;SET UP LOOKUP PARAMETERS
MOVSI I2,(SIXBIT "TMP")
SETZB I3,I4
HLRZM I2,COMEXT##
CALLI TC,$PJOB ;PUT IN JOB NUMBER
MOVEI I0,3
IDIVI TC,^D10
ADDI TB,"0"-40
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: MOVE TA,[XWD %WEDID,WEDIED##] ;MOVE "GETSEG" ROUTINE TO LOW-SEGMENT
IFN DEBUG,<
BLT TA,-1+DDTSTP##
MOVE TA,[XWD %GTFNM,GETFNM]
>
BLT TA,GETEND##
MOVE TA,RUNPPN ;GETSEG WILL USE DEV AND PPN
MOVEM TA,GETFNM+4 ; OF RUN COMMAND
MOVE TA,RUNDEV
MOVEM TA,GETFNM##
IFE TOPS20,<
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+3 ;SAVE SFD
MOVEI TA,GETPTH## ;GET POINTER
EXCH TA,GETFNM+4 ;SWAP WITH PPN
MOVEM TA,GETPTH+2 ;SAVE PPN
HRROI TA,.GTRS1
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+4
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS2
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+5
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS3
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+6
JUMPE TA,SETI2 ;ALL DONE
HRROI TA,.GTRS4
GETTAB TA, ;NEXT SFD
JRST SETI2
MOVEM TA,GETPTH+7
SETZM GETPTH+8 ;TERMINATE WITH ZERO
SETI2:>
MOVE TB,[XWD FSTCLR##,FSTCLR+1]
SETZM FSTCLR
HLRZ TE,.JBSA##
IFN DEBUG,< IFE TOPS20,<
MOVEI TD,(TB)
CAIG TD,DDT
MOVEI TE,DDT
>>
BLT TB,-1(TE)
MOVEI TE,-1+WRKSIZ##
IFN DEBUG,< IFE TOPS20,<
ADDI TE,^D50+DDTEND## ;LEAVE ROOM FOR DDT
SUBI TE,DDT
>>
JRST SETCOR##
;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: CALLI TC,$DATE ;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"-40 ;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"-40
IDPB TE,TC
GTVER4: HRRZ TE,.JBVER## ;GET PATCH NUMBER
JUMPE TE,GTVER5 ;IF ZERO, DON'T PRINT IT
MOVEI CH,"("-40
IDPB CH,TC
PUSHJ PP,GTVER8
MOVEI CH,")"-40
IDPB CH,TC
GTVER5: LDB TE,[POINT 3,.JBVER,2] ;GET EDITOR
JUMPE TE,GTVER9 ;IF PDP-10 DEVELOPMENT, DON'T PRINT IT
MOVEI CH,"-"-40
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"-40
IDPB TE,TC
GTVER9: 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,15 ;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
CALLI TA,$DEVCH ;YES--GET CHARACTERISTICS
JUMPE TA,NOTDEV ;IS IT A LEGAL DEVICE?
POPJ PP,
GTFL4B: JUMPE TA,GTFL4C
SKIPE DEVFIL(DA)
JRST BADSTR
MOVEM TA,DEVFIL(DA)
GTFL4C: 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,15
JRST BADSTR
CALLI $RESET
SKIPN I2,DEVDEV(DA)
MOVSI I2,(SIXBIT "DSK")
MOVEI I1,0
MOVEI I3,COMBH
OPEN COM,I1
JRST NOCOMD
SKIPE I1,DEVFIL(DA)
JRST GTF12D
MOVEI I2,3
CALLI I3,$PJOB
IDIVI I3,^D10
MOVEI I0,"0"-40(I4)
LSHC I0,-6
SOJG I2,.-3
HRRI I1,(SIXBIT "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,(SIXBIT "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]
CALLI CH,$RUN
HALT .+1
TTCALL 3,[ASCIZ "?MONITOR ERROR -- RUN UUO RETURNED TO COBOL
"]
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
SWON FHELP ;H - TURN ON /H
SETOM SUBPRG ;I - DO NOT GENERATE START ADDRESS
SETOM SLASHJ ;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)
IFE TOPS20,<
SWON FREENT ;R - TURN ON "/R"
>
IFN TOPS20,<
SETOM RENSW## ;R - SET FLAG FOR COBOLG, LEAVE FREENT ON
>
SWON FSEQ; ;S - TURN ON "/S"
IFN DEBUG,<
JRST SWICHT ;T -
>
IFE DEBUG,<
JRST BADCSW
>
SWOFF FREENT ;U - TURN OFF "/R"
JRST BADCSW ;V -
JRST SWICHW ;W -
JRST SWICHX ;DEFAULT THINGS TO EBCDIC INSTEAD OF SIXBIT.
IFN ANS68,<
JRST BADCSW ;Y -
>
IFN ANS74,<
SETOM FLGSW## ;Y - SET '/Y' - FLAG NON-STANDARD EXTENSIONS
>
IFN TOPS20,<
JRST BADCSW ;Z -
>
IFE TOPS20,<
JRST SWICHZ ;Z -
>
SWICHL: MOVEI TA,1 ;SET "L" FLAG IN TABLE
JRST SWZWL
SWICHQ: SETOM OPTSW ;/O
SETOM PRODSW ;/P
SETOM QUIKSW## ;/Q
POPJ PP,
IFE TOPS20,<
SWICHZ: MOVEI TA,4 ;SET "Z" FLAG IN TABLE
JRST SWZWL
>
SWICHW: MOVEI TA,2 ;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 LIBOL WITH EBCMP.==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.
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, 15
CAIN CH, "/"
SOS (PP)
POPJ PP,
>
IFE MPWCEX,<
SWICHD: MOVEI TB, [ASCIZ -?"/D" IS NOT ALLOWED, FOR MULTIPLE PERFORMS WITH A COMMON EXIT
?REASSEMBLE THE COMPILER AND LIBOL WITH MPWCEX==1-]
JRST BADCOM
>
IFN DEBUG,<
;TO HANDLE "T" SWITCHES WHEN DEBUGGING
SWICHT: PUSHJ PP,COMKAR
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 GETDC2 ;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 GETDC2 ;NO
IMULI TA,^D10 ;YES--ADD TO SUM
ADDI TA,-"0"(CH)
PUSHJ PP,COMKAR ;GET NEXT DIGIT
JRST GETDC1 ;LOOP
GETDC2: SWON FCOMCH ;REGET LAST CHAR
POPJ PP, ;RETURN
;TO HANDLE "K" SWITCH WHEN DEBUGGING
SWICHK: PUSHJ PP,COMKAR
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
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,15 ;IGNORE CARRIAGE-RETURNS
JRST COMKAR
COMKRA: CAIG CH,"z" ;BETWEEN LC Z AND LC A? [255]
CAIGE CH,"a"
CAIA ;NOT LC
SUBI CH,40 ;YES, CONVERT TO UC
CAIN CH,32 ;END-FILE?
JRST COMKR9 ;YES
CAIE CH,12
CAIN CH,14
JRST COMK99
CAIN CH,33 ;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
TRNE CH,$ERAS ;ANY ERROR FLAGS UP?
JRST COMKR8 ;YES--WE LOSE
CLOSE COM, ;CLOSE COMMAND FILE
MOVE CH,COMEXT ;IS EXTENSION
CAIE CH,(SIXBIT "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,(SIXBIT "COB")
MOVEM CH,COMBH+1
MOVS CH,.JBSA
SUBI CH,1
HRLI CH,-200
MOVEM CH,COMBH+2
MOVE CH,[XWD 2,COMBH+1]
CALLI CH,$TMPCR
JFCL
;END OF COMMAND FILE
COMKR3: SWON FECOM ;TURN ON "END OF COMMAND"
COMKR4: MOVEI CH,15 ;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: TTCALL 3,[ASCIZ "?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;
TTCALL 3,[ASCIZ "
"]
JRST COMKR4
;ERROR ROUTINES
IFE ONESEG,<
;"DSK" IS NOT THE DISK
NOTDSK: TTCALL 3,[ASCIZ /? "DSK" IS NOT THE DISK
/]
CALLI $EXIT
>
;TOO MANY OUTPUT FILES
TUMANY: MOVEI TB,[ASCIZ "?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,"?"
TTCALL 1,CH
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT##
JRST BADCOM
;ERROR ROUTINES (CONT'D)
;SOMETHING STRANGE ABOUT STRING
BADSTR: MOVEI TB,[ASCIZ "?IMPROPER COBOL COMMAND"]
JRST BADCOM
;COMMAND DEVICE UNAVAILABLE
NOCOMD: MOVEI TB,[ASCIZ "?INDIRECT COMMAND DEVICE UNAVAILABLE"]
JRST BADCOM
;COMMAND FILE CANNOT BE FOUND
NOCOMF: MOVEI TB,[ASCIZ "?CANNOT FIND COMMAND FILE"]
JRST BADCOM
;NAME TOO LONG
BADNAM: MOVEI TB,[ASCIZ "?NAME OF MORE THAN 6 CHARACTERS"]
JRST BADCOM
;BAD PROJECT-PROGRAMMER NUMBER
BADPPN: MOVEI TB,[ASCIZ "?IMPROPER PROJECT-PROGRAMMER NUMBER"]
JRST BADCOM
;IMPROPER CHARACTER IN STRING
BADKAR: MOVEI TB,[ASCIZ "?IMPROPER CHARACTER IN COMMAND"]
JRST BADCOM
;BAD SWITCH
BADCSW: MOVEI TB,"?"
TTCALL 1,TB
TTCALL 1,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,"?"
TTCALL 1,CH
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
JRST BADCOM
;ERROR ROUTINES (CONT'D).
;NO FILE FOR DIRECTORY DEVICE
NOFILE: TTCALL 3,[ASCIZ "?NO FILE NAME FOR "]
JRST BADC0
;TOO MANY SOURCE FILES
NOROOM: MOVEI TB,[ASCIZ "?TOO MANY SOURCE FILES"]
JRST BADCOM
;NO SOURCE FILES AT ALL
NOSRC: TSWFZ FHELP ;IS /H ON?
JRST HELP ;YES, OK
MOVEI TB,[ASCIZ "?NO SOURCE FILES SPECIFIED"]
;TYPE OUT MESSAGE AND RESTART COMPILATION
BADCOM::TTCALL 3,(TB)
BADC0: TTCALL 3,[ASCIZ "
"]
BADC1: TSWF FESRC!FECOM ;END OF COMMAND STRING?
JRST BADC2 ;YES
PUSHJ PP,COMKAR ;NO--GET CHARACTER
CAIE CH,15 ;CARRIAGE-RETURN?
JRST BADC1 ;NO--LOOP
BADC2: TSWT FDSKC ;COMMANDS FROM TTY?
JRST START1 ; [344] YES
AND SW,[EXP FDSKC] ;NO--CLEAR ALL SWITCHES EXCEPT FDSKC
JRST COBLAS
;ERROR ROUTINES (CONT'D).
;LIBRARY DEVICE IMPROPER
BADLIB: MOVEI TB,[ASCIZ "?LIBRARY DEVICE MUST BE DSK"]
JRST BADCOM
;DOUBLE NAMTAB ENTRY
DBLNAM: TTCALL 3,[ASCIZ "NAMTAB ENTRY DUPLICATED
"]
JRST KILL
;CANNOT ENTER A FILE
NOENTR: TTCALL 3,[ASCIZ "?CANNOT ENTER "]
JRST ERATYP##
;NOT ENOUGH CORE TO CONTINUE COMPILATION
NOTNUF: TTCALL 3,[ASCIZ /?NOT ENOUGH CORE TO CONTINUE COMPILATION
/]
JRST RESTRT##
;THIS ROUTINE IS MOVED TO THE LOW-SEGMENT
%WEDID: JRST @WEDIED+1 ;GO TO "KILL" ROUTINE
Z
%GETLD: MOVEM 17,SAVEAC##+17 ;SAVE
IFE ONESEG,<
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
CALLI 1,11 ; THE HI-SEGMENT
JRST 4,WEDIED+.-%WEDID ;COULDN'T--MONITOR PROBLEM
MOVEI 1,GETFNM ;CALL
CALLI 1,$GTSEG ; GETSEG
JRST 4,WEDIED+.-%WEDID ;ERROR
MOVSI 17,SAVEAC ;RESTORE AC'S
BLT 17,16
> ;END ONESEG CONDITIONAL
HRRZ 17,REGO ;STARTING ADDRESS
ADDB 17,GETFST ;ADD IN INCREMENT
MOVE 17,SAVEAC+17
IFN DEBUG,<
SETZM .JBSYM##
IF1,<
PRINTX %LOAD SYMBOLS IN THE HIGH SEGMENT%
>>
%DDTST: JRST @GETFST## ;GO TO HI-SEGMENT
%GTFNM: Z ;DEVICE
Z ;FILE NAME
Z ;EXT
Z ;0
Z ;PPN
Z ;CORE
IFE TOPS20,<
%GTPTH: Z ;NOT USED
Z ;NOT USED
Z ;PPN
Z ;SFD #1
Z ;SFD #2
Z ;SFD #3
Z ;SFD #4
Z ;SFD #5
Z ;0
>
%GTFST: Z
%CANT: TTCALL 3,WEDIED+%CANT+2-%WEDID
CALLI $EXIT
ASCIZ "?CANNOT RESTART"
;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
;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),<
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
;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
; 421 FILLER
;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
;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
;500 CLASS
;501 POINTER
;ANS-74 RESERVED WORDS
;600 ALSO
;601 BOTTOM
;602 CLOCK-UNITS
;603 CODE-SET
;604 COLLATING
;605 DAY
;606 DEBUG-CONTENTS
;607 DEBUG-ITEM
;610 DEBUG-LINE
;611 DEBUG-NAME
;612 DEBUG-SUB-1
;613 DEBUG-SUB-2
;614 DEBUG-SUB-3
;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
;RESERVED WORDS BY NAME
DEFINE TABLE, <XLIST
NTVAL 001,ACCEPT
NTVAL 267,ACCESS
IFN ANS68,<NTVAL 101,ACTUAL>
NTVAL 002,ADD
NTVAL 300,ADVANCING
NTVAL 301,AFTER
NTVAL 706,ALL
NTVAL 516,ALLOWING
NTVAL 303,ALPHABETIC
IFN ANS74,<NTVAL 600,ALSO>
NTVAL 003,ALTER
NTVAL 102,ALTERNATE
NTVAL 304,AND
NTVAL 431,ANY
NTVAL 305,ARE
NTVAL 435,AREA
NTVAL 435,AREAS
NTVAL 306,ASCENDING
NTVAL 163,ASCII
NTVAL 104,ASSIGN
NTVAL 307,AT
NTVAL 105,AUTHOR
NTVAL 310,BEFORE
IFN ANS68,<NTVAL 311,BEGINNING>
NTVAL 165,BINARY
NTVAL 202,BLANK
NTVAL 203,BLOCK
IFN ANS74,<NTVAL 601,BOTTOM>
NTVAL 312,BY
NTVAL BYTE.,BYTE
NTVAL 422,CALL
NTVAL 424,CANCEL
IFN MCS!TCS!ANS74,<NTVAL 460,CD>
NTVAL 254,CF
NTVAL 252,CH
NTVAL 154,CHANNEL
IFN ANS74,<NTVAL CHARA.,CHARACTER>
NTVAL CHARA.,CHARACTERS
NTVAL CHECK.,CHECK
NTVAL CHKPT.,CHECKPOINT
IFN MCS!TCS,<NTVAL 500,CLASS>
;IFN ANS74,<NTVAL 602,CLOCK:UNITS>
NTVAL 004,CLOSE
NTVAL 313,COBOL
NTVAL 277,CODE
IFN ANS74,<NTVAL 603,CODE:SET>
IFN ANS74,<NTVAL 604,COLLATING>
NTVAL 257,COLUMN
NTVAL 147,COMMA
NTVAL 457,COMMUNICATION
NTVAL 204,COMP
NTVAL 205,COMP:1
NTVAL 207,COMP:3
IFN DBMS,<NTVAL 261,COMPILE>
NTVAL 204,COMPUTATIONAL
NTVAL 205,COMPUTATIONAL:1
NTVAL 207,COMPUTATIONAL:3
NTVAL 005,COMPUTE
NTVAL 106,CONFIGURATION
NTVAL 302,CONSOLE
NTVAL 206,CONTAINS
NTVAL 260,CONTROL
NTVAL 260,CONTROLS
NTVAL 006,COPY
NTVAL 314,CORR
NTVAL 314,CORRESPONDING
NTVAL 474,COUNT
NTVAL 436,CURRENCY
IFN DBMS,<NTVAL 445,CURRENT>
NTVAL 511,DATA
NTVAL 211,DATABASE:KEY
NTVAL 211,DBKEY
IFN MCS!TCS!ANS74,<NTVAL 470,DATE>
NTVAL 110,DATE:COMPILED
NTVAL 210,DATE:WRITTEN
IFN ANS74,<NTVAL 605,DAY>
NTVAL 253,DE
;IFN ANS74,<NTVAL 606,DEBUG:CONTENTS>
;IFN ANS74,<NTVAL 607,DEBUG:ITEM>
;IFN ANS74,<NTVAL 610,DEBUG:LINE>
;IFN ANS74,<NTVAL 611,DEBUG:NAME>
;IFN ANS74,<NTVAL 612,DEBUG:SUB:1>
;IFN ANS74,<NTVAL 613,DEBUG:SUB:2>
;IFN ANS74,<NTVAL 614,DEBUG:SUB:3>
IFN ANS74,<NTVAL 615,DEBUGGING>
NTVAL 150,DECIMAL:POINT
NTVAL 315,DECLARATIVES
NTVAL 157,DECSYSTEM10
NTVAL 157,DECSYSTEM:10
NTVAL 166,DECSYSTEM:20
NTVAL 153,DEFERRED
NTVAL 043,DELETE
NTVAL 512,DELIMITED
NTVAL 513,DELIMITER
NTVAL 161,DENSITY
NTVAL 316,DEPENDING
IFN MCS!TCS,<NTVAL 475,DEPTH>
NTVAL 317,DESCENDING
IFN MCS!TCS,<NTVAL 476,DESTINATION>
NTVAL 253,DETAIL
NTVAL 055,DISABLE
NTVAL 007,DISPLAY
NTVAL 212,DISPLAY:6
NTVAL 213,DISPLAY:7
NTVAL 215,DISPLAY:9
NTVAL 010,DIVIDE
NTVAL 405,DIVISION
NTVAL 320,DOWN
IFN DBMS,<NTVAL 450,DUP
NTVAL 450,DUPLICATE>
IFN ANS74,<NTVAL 450,DUPLICATES>
IFN ANS74,<NTVAL 616,DYNAMIC>
IFN ANS74,<NTVAL EBCDC.,EBCDIC>
IFN MCS!TCS,<NTVAL 505,EGI>
NTVAL 011,ELSE
IFN MCS!TCS,<NTVAL 504,EMI>
IFN DBMS,<NTVAL 432,EMPTY>
NTVAL 056,ENABLE
NTVAL 406,END
IFN ANS74,<NTVAL 617,END:OF:PAGE>
IFN ANS68,<NTVAL 321,ENDING>
NTVAL 013,ENTER
NTVAL 425,ENTRY
NTVAL 111,ENVIRONMENT
IFN ANS74,<NTVAL 617,EOP>
IFN MCS,<NTVAL 506,EPI>
NTVAL 322,EQUAL
NTVAL 322,EQUALS
NTVAL 323,ERROR
IFN MCS!TCS,<NTVAL 503,ESI>
NTVAL 170,EVEN
NTVAL 324,EVERY
IFN ANS68,<NTVAL 014,EXAMINE>
IFN DBMS,<NTVAL 456,EXCLUSIVE
NTVAL 456,EXCL>
IFN ANS74,<NTVAL 620,EXCEPTION>
NTVAL 015,EXIT
NTVAL 621,EXTEND
NTVAL 214,FD
NTVAL 325,FILE
NTVAL 112,FILE:CONTROL
IFN ANS68,<NTVAL 113,FILE:LIMIT>
IFN ANS68,<NTVAL 113,FILE:LIMITS>
NTVAL 143,FILE:STATUS
NTVAL 421,FILLER
NTVAL 262,FINAL
NTVAL 052,FIND
NTVAL 326,FIRST
NTVAL 263,FOOTING
NTVAL 327,FOR
NTVAL 423,FORTRAN
IFN ANS68,<NTVAL 415,FORTRAN:IV>
NTVAL 063,FREE
NTVAL 523,FREED
NTVAL 330,FROM
NTVAL 041,GENERATE
NTVAL 050,GET
NTVAL 331,GIVING
NTVAL 016,GO
NTVAL 426,GOBACK
NTVAL 332,GREATER
NTVAL 264,GROUP
NTVAL 265,HEADING
NTVAL 700,HIGH:VALUE
NTVAL 700,HIGH:VALUES
NTVAL 333,I:O
NTVAL 114,I:O:CONTROL
NTVAL 216,ID
NTVAL 216,IDENTIFICATION
NTVAL 017,IF
NTVAL 334,IN
NTVAL 217,INDEX
NTVAL 220,INDEXED
NTVAL 266,INDICATE
IFN MCS!TCS!ANS74,<NTVAL 461,INITIAL>
NTVAL 040,INITIATE
NTVAL 335,INPUT
NTVAL 333,INPUT:OUTPUT
NTVAL 046,INSERT
IFN ANS74,<NTVAL 622,INSPECT>
NTVAL 115,INSTALLATION
NTVAL 336,INTO
NTVAL 337,INVALID
NTVAL 246,INVOKE
NTVAL 305,IS
IFN DBMS,<NTVAL 526,JOURNAL>
NTVAL 221,JUST
NTVAL 221,JUSTIFIED
NTVAL 340,KEY
NTVAL 340,KEYS;; ;ALLOW PLURAL FORM FOR READABILITY
NTVAL 410,LABEL
NTVAL 447,LAST
NTVAL 341,LEADING
NTVAL 223,LEFT
IFN MCS!TCS!ANS74,<NTVAL 473,LENGTH>
NTVAL 342,LESS
NTVAL 222,LIMIT
NTVAL 222,LIMITS
IFN ANS74,<NTVAL 623,LINAGE>
IFN ANS74,<NTVAL 624,LINAGE:COUNTER>
NTVAL 343,LINE
NTVAL 343,LINES
NTVAL 243,LINKAGE
NTVAL 344,LOCK
NTVAL 701,LOW:VALUE
NTVAL 701,LOW:VALUES
NTVAL 414,MACRO
NTVAL 116,MEMORY
IFN DBMS,<NTVAL 433,MEMBER>
IFN DBMS,<NTVAL 433,MEMBERS>
IFN CSTATS,<NTVAL 172,METER::ING>
IFN CSTATS,<NTVAL 064,METER::JSYS>
NTVAL 626,MERGE
IFN MCS!TCS!ANS74,<NTVAL 467,MESSAGE>
NTVAL 151,MODE
NTVAL 047,MODIFY
NTVAL 117,MODULES
NTVAL 020,MOVE
NTVAL 120,MULTIPLE
NTVAL 021,MULTIPLY
IFN ANS74,<NTVAL NATIV.,NATIVE>
NTVAL 345,NEGATIVE
NTVAL 346,NEXT
NTVAL 347,NO
IFN ANS68,<NTVAL 462,NOMINAL>
NTVAL 517,NONE
NTVAL 350,NOT
IFN ANS68,<NTVAL 022,NOTE>
NTVAL 270,NUMBER
NTVAL 351,NUMERIC
NTVAL 121,OBJECT:COMPUTER
NTVAL 224,OCCURS
NTVAL 167,ODD
NTVAL 334,OF
NTVAL 412,OFF
NTVAL 225,OMITTED
NTVAL 352,ON
IFN DBMS,<NTVAL 441,ONLY>
NTVAL 023,OPEN
NTVAL 123,OPT
NTVAL 123,OPTIONAL
NTVAL 353,OR
IFN ANS74,<NTVAL ORGAN.,ORGANIZATION>
NTVAL 515,OTHERS
NTVAL 354,OUTPUT
NTVAL 430,OVERFLOW
IFN DBMS,<NTVAL 434,OWNER>
NTVAL 510,PAGE
NTVAL 162,PARITY
NTVAL 157,PDP:10
NTVAL 024,PERFORM
NTVAL 255,PF
NTVAL 251,PH
NTVAL 226,PIC
NTVAL 226,PICTURE
NTVAL 272,PLUS
NTVAL 501,POINTER
NTVAL 124,POSITION
NTVAL 525,POSITIONING
NTVAL 355,POSITIVE
IFN ANS74,<NTVAL 632,PRINTING>
IFN DBMS,<NTVAL 446,PRIOR>
IFN DBMS,<NTVAL 452,PRIVACY>
NTVAL 411,PROCEDURE
IFN ANS74,<NTVAL 411,PROCEDURES>
NTVAL 356,PROCEED
IFN ANS68,<NTVAL 125,PROCESSING>
NTVAL 427,PROGRAM
NTVAL 126,PROGRAM:ID
IFN DBMS,<NTVAL 455,PROTECTED
NTVAL 455,PROT>
IFN MCS!TCS,<NTVAL 463,QUEUE>
NTVAL 702,QUOTE
NTVAL 702,QUOTES
NTVAL 127,RANDOM
NTVAL 227,RD
NTVAL 025,READ
NTVAL 521,READ:REWRITE
NTVAL 522,READ:WRITE
NTVAL 053,RECEIVE
NTVAL 357,RECORD
NTVAL 160,RECORDING
NTVAL 357,RECORDS
NTVAL 230,REDEFINES
NTVAL 360,REEL
IFN ANS74,<NTVAL 632,REFERENCES>
NTVAL 152,RELATIVE
NTVAL 026,RELEASE
NTVAL 413,REMAINDER
IFN ANS68,<NTVAL 130,REMARKS>
NTVAL 051,REMOVE
IFN ANS74,<NTVAL 051,REMOVAL>
NTVAL 231,RENAMES
NTVAL 361,REPLACING
NTVAL 273,REPORT
NTVAL 273,REPORTS
NTVAL 417,REPORTING
NTVAL 131,RERUN
NTVAL 132,RESERVE
NTVAL 274,RESET
NTVAL 062,RETAIN
NTVAL 524,RETAINED
IFN DBMS,<NTVAL 454,RETRIEVAL
NTVAL 454,RETR>
NTVAL 027,RETURN
NTVAL 362,REVERSED
NTVAL 363,REWIND
NTVAL 044,REWRITE
NTVAL 256,RF
NTVAL 250,RH
NTVAL 232,RIGHT
; NTVAL RMS.,RMS
NTVAL 364,ROUNDED
NTVAL 365,RUN
IFN DBMS,<NTVAL 443,RUN:UNIT>
NTVAL 133,SAME
NTVAL 245,SCHEMA
NTVAL 233,SD
NTVAL 030,SEARCH
NTVAL 366,SECTION
NTVAL 134,SECURITY
IFN ANS68,<NTVAL 031,SEEK>
IFN MCS!TCS,<NTVAL 502,SEGMENT>
NTVAL 135,SEGMENT:LIMIT
NTVAL 136,SELECT
NTVAL 054,SEND
IFN DBMS,<NTVAL 442,SELECTIVE>
NTVAL 367,SENTENCE
IFN ANS74,<NTVAL 634,SEPARATE>
NTVAL SEQCE.,SEQUENCE
NTVAL 137,SEQUENTIAL
NTVAL 032,SET
IFN DBMS,<NTVAL 032,SETS>
NTVAL 140,SIGN
NTVAL 164,SIXBIT
NTVAL 404,SIZE
NTVAL 033,SORT
IFN ANS74,<NTVAL SRTMG.,SORT:MERGE>
NTVAL 275,SOURCE
NTVAL 141,SOURCE:COMPUTER
NTVAL 703,SPACE
NTVAL 703,SPACES
NTVAL 142,SPECIAL:NAMES
NTVAL 407,STANDARD
IFN ANS74,<NTVAL 637,STANDARD:1>
NTVAL 155,STANDARD:ASCII
IFN ANS74,<NTVAL 640,START>
NTVAL 444,STATUS
NTVAL 034,STOP
NTVAL 045,STORE
NTVAL 060,STRING
IFN DBMS,<NTVAL 244,SUB:SCHEMA>
IFN MCS!TCS,<NTVAL 464,SUB:QUEUE:1
NTVAL 465,SUB:QUEUE:2
NTVAL 466,SUB:QUEUE:3>
NTVAL 035,SUBTRACT
NTVAL 276,SUM
IFN DBMS,<NTVAL 437,SUPPRESS>
NTVAL 416,SWITCH
NTVAL 462,SYMBOLIC
NTVAL 235,SYNC
NTVAL 235,SYNCHRONIZED
IFN MCS!TCS,<NTVAL 477,TABLE>
IFN ANS68,<NTVAL 704,TALLY>
NTVAL 370,TALLYING
NTVAL 144,TAPE
IFN MCS!TCS,<NTVAL 507,TERMINAL>
NTVAL 042,TERMINATE
IFN MCS!TCS,<NTVAL 472,TEXT>
NTVAL 371,THAN
NTVAL 372,THROUGH
NTVAL 372,THRU
IFN MCS!TCS!ANS74,<NTVAL 471,TIME>
NTVAL 373,TIMES
NTVAL 374,TO
IFN ANS68,<NTVAL 707,TODAY>
IFN ANS74,<NTVAL TOP.,TOP>
NTVAL 420,TRACE
IFN ANS74,<NTVAL 641,TRAILING>
NTVAL 531,TRANSACTION
NTVAL 247,TYPE
NTVAL 520,UNAVAILABLE
NTVAL 360,UNIT
NTVAL 061,UNSTRING
NTVAL 375,UNTIL
NTVAL 376,UP
IFN DBMS,<NTVAL 440,UPDATE
NTVAL 440,UPDATES>
NTVAL 377,UPON
NTVAL 236,USAGE
IFN DBMS,<NTVAL 453,USAGE:MODE>
NTVAL 036,USE
NTVAL 242,USER:NUMBER
NTVAL 400,USING
NTVAL 237,VALUE
NTVAL 237,VALUES
NTVAL 401,VARYING
NTVAL 514,VERB
IFN DBMS,<NTVAL 532,VIA>
NTVAL 402,WHEN
NTVAL 403,WITH
IFN DBMS,<NTVAL 451,WITHIN>
NTVAL 145,WORDS
NTVAL 240,WORKING:STORAGE
NTVAL 037,WRITE
NTVAL 705,ZERO
NTVAL 705,ZEROES
NTVAL 705,ZEROS
LIST>
DEFINE PUTVAL (C,D), <Z==.
XWD X'D,C>
DEFINE SETVAL (E), <
.XCREF X'E
X'E==.-Z>
DEFINE NTVAL (A,B), <
PUTVAL A,\I
SIXBIT "'B' "
SETVAL \I
I==I+1
>
DEFINE PURGIT (E), <
PURGE X'E
>
SALL
.XCREF I,Z
I==0
NAMDAT: TABLE;
0
IF2,< I==0
REPEAT 1000,<PURGIT \I
I==I+1>
PURGE I,Z
>
END COBOLA