Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
stinfl.mac
There are 7 other files named stinfl.mac in the archive. Click here to see a list.
; UPD ID= 3289 on 12/19/80 at 11:09 AM by NIXON
TITLE STINFL FOR COBOL V12C
SUBTTL INITIALIZE AN INPUT FILE 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
IFE TOPS20,<SEARCH MACTEN>
IFN TOPS20,<SEARCH MONSYM,MACSYM>
;EDITS
;V10*****************
;NAME DATE COMMENTS
; EHM 2-MAR-78 [530] FIX COBOL TO LOOK FOR FILE WITH NUL EXT IF USER TYPE =FILE.
;********************
;EDIT 302 FIX DATE 75 PROBLEM OF SOURCE FILE DATE IN LISTING
;EDIT 256 REVERSE ORDER OF LOOKUP FOR SOURCE AND LIBARY FILES
; SO THAT .CBL (.LIB) IS LOOKED FOR FIRST
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY STINFL ;SET UP AN INPUT FILE
ENTRY OPENIT ;DO "OPEN"--SET UP FOR "LOOKUP" & "ENTER"
EXTERNAL SIXOUT, RESTRT, ERATYP, FILOUT
EXTERNAL DEVDEV,DEVSW,DEVPP,DEVFIL,DEVEXT,DEVBH,DEVBUF,DEVBLK
EXTERNAL LOOKOP,OPENOP,INBOP,I0CHAN
EXTERNAL SRCEND,SRCDEV,LIBDEV,DEVSIZ
FL.LIB==1 ;FILE IS A LIBRARY
FL.REW==2 ;DEVICE MUST BE REWOUND
STINFL: HRRZ DA,SRCEND ;GET ADDRESS OF NEXT SOURCE FILE DATA
CAIE DA,SRCEND ;ANY MORE ENTRIES?
SKIPN 0(DA) ;YES--EMPTY?
JRST OPNIN7 ;YES--NO MORE SOURCE FILES
MOVE TA,DEVSW(DA) ;IS IT LIBRARY FILE?
TRNN TA,FL.LIB
TLOA DA,SRCDEV ;NO
HRLI DA,LIBDEV ;YES
MOVS TA,DA
MOVEI DA,(TA)
PUSH PP,DEVBUF(DA)
BLT TA,DEVSIZ-1(DA)
POP PP,DEVBUF(DA)
MOVEI TA,DEVSIZ
ADDM TA,SRCEND
MOVE TA,DEVDEV(DA) ;GET THE DEVICE
DEVCHR TA, ;GET CHARACTERISTICS
MOVE TB,DEVSW(DA) ;IS THIS THE LIBRARY?
TRNE TB,FL.LIB
JRST STINFA ;YES
MOVEI DC,SRC ;NO--USE SOURCE CHANNEL
JRST OPENIN
STINFA: TXNN TA,DV.DSK ;IS DEVICE A DSK?
JRST NOTDSK ;NO--ERROR
MOVEI DC,LIB ;USE LIBRARY CHANNEL
MOVE TB,[SIXBIT /LIBARY/]
SKIPN DEVFIL(DA) ;ANY FILE NAME?
MOVEM TB,DEVFIL(DA) ;NO--USE "LIBARY"
;INITIALIZE AN INPUT FILE
OPENIN: MOVEI I1,.IOASC ;ASCII MODE
MOVEI I3,DEVBH(DA) ;CREATE AN XWD
PUSHJ PP,OPENIT ;DO "OPEN", SET UP FOR "LOOKUP"
MOVE I0,LOOKOP ;CREATE A LOOKUP
DPB DC,I0CHAN
JUMPN I2,OPNIN2 ;ANY EXTENSION?
MOVE TA,DEVSW(DA) ;[256] NO EXTENSION IS IT THE LIBRARY?
TRNN TA,FL.LIB ;[256]
TLOA I2,'CBL' ;NO--USE "CBL"
HRLZI I2,'LIB' ;[256] YES--USE "LIB"
XCT I0 ;[256] TRY DEFAULT EXTENSION--DO LOOKUP
IFN ANS68,<
TRNA ;[256] NOT FOUND
>
IFN ANS74,<
TDZA I2,I2 ;NOT FOUND, TRY NUL EXTENSION
>
JRST OPNIN3 ;[256]
IFN ANS68,<
TRNE TA,FL.LIB ;IS IT THE LIBRARY?
JRST OPNI1D ;YES, GO TRY NULL EXTENSION.
HRLZI I2,'COB' ;NO, TRY "COB".
XCT I0 ;DO THE LOOKUP.
OPNI1D: TDZA I2,I2 ;[256] NOT FOUND TRY THE NULL EXTENSION.
JRST OPNIN3
>
XCT I0
JRST NOLOOK ;DIDN'T FIND THAT EITHER--ERROR
JRST OPNIN3
OPNIN2: HLLZS I2,DEVEXT(DA) ;[530] GET RID OF FLAG SET TO INDICATE
;[530] USER TYPED . (DOT) IN COMMAND STRING
XCT I0 ;DO LOOKUP
JRST NOLOOK ;ERROR
OPNIN3: MOVSI TA,I1 ;SAVE SOURCE FILE INFO FOR LISTING
HRRI TA,SRCFIL##
BLT TA,SRCFIL+2
HLLZ TA,SRCFIL+1 ;PUT EXT IN BYTES 2, 3, 4
LSH TA,-6 ; SO SIXIT OF COBOLF WORKS
HRRZ TB,SRCFIL+1 ; [302] GET HIGH ORDER DATE
LSH TB,-^D15 ; [302] POSITON TO BYTE 6
IOR TA,TB ; [302] COMBINE WITH EXT
MOVEM TA,SRCFIL+1
MOVE TA,DEVSW(DA) ;GET SWITCHES
TRNE TA,FL.LIB ;LIBRARY?
JRST OPNIN4 ;YES
TRNE TA,FL.REW ;NO--REWIND?
MTREW. SRC, ;YES--REWIND MTA
;SET UP A BUFFER
OPNIN4: SKIPN TA,DEVBUF(DA)
MOVE TA,.JBFF##
MOVEM TA,.JBFF
MOVEM TA,DEVBUF(DA)
MOVE I0,INBOP
CAIN DC,LIB ;IS THIS FOR LIBRARY?
HRRI I0,1 ;YES--SINGLE BUFFERED
DPB DC,I0CHAN
XCT I0
SETZM DEVBLK(DA)
CAIN DC,LIB ;LIBRARY FILE?
JRST OPNIN6 ;YES
ADDI TA,406 ;NO--MAKE ROOM FOR TWO BUFFERS
HRRM TA,.JBFF
POPJ PP,
OPNIN6: ADDI TA,203 ;MAKE ROOM FOR ONE BUFFER
HRRM TA,.JBFF
JRST STINFL
;NO MORE SOURCE FILES
OPNIN7: SETZM SRCDEV
POPJ PP,
;OPEN THE FILE AND SET UP PARAMETERS FOR ENTER OR LOOKUP
OPENIT: MOVE I2,DEVDEV(DA) ;GET DEVICE NAME
MOVE I0,OPENOP ;CREATE AN OPEN
DPB DC,I0CHAN
XCT I0 ;OPEN
JRST CANTOP ;CANNOT--ERROR
MOVE I1,DEVFIL(DA) ;GET FILE NAME
MOVE I2,DEVEXT(DA) ;GET EXTENSION
MOVEI I3,0 ;ZERO IN THIRD WORD
MOVE I4,DEVPP(DA) ;GET PROJ, PROG
POPJ PP,
;ERRORS WHILE INITIALIZING THE DEVICE
;DEVICE UNAVAILABLE
CANTOP: OUTSTR [ASCIZ/?CBLDVU Device is unavailable: /]
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
OUTSTR [ASCIZ/
/] ;END WITH CRLF
TYPIT2: TSWT FDSKC;
SWOFF FECOM;
JRST RESTRT
;LOOKUP FAILURE
NOLOOK: OUTSTR [ASCIZ "?CBLCFF Cannot find file: "]
HRRZ TA,I2
JUMPN TA,ERATYP
PUSHJ PP,FILOUT
OUTSTR [ASCIZ /
/] ;FILOUT DOES NOT SUPPLY CR-LF ANYMORE
JRST TYPIT2
;LIBRARY DEVICE NOT DSK
NOTDSK: OUTSTR [ASCIZ/?CBLLFM Library files must be on disk
/]
JRST TYPIT2
END