Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
stinfl.mac
There are 7 other files named stinfl.mac in the archive. Click here to see a list.
; UPD ID= 1598 on 12/29/78 at 9:36 AM by N:<NIXON>
TITLE STINFL FOR COBOL V12
SUBTTL INITIALIZE AN INPUT FILE 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
;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
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
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,1
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
CALLI TA,$DEVCH ;GET CHARACTERISTICS
MOVE TB,DEVSW(DA) ;IS THIS THE LIBRARY?
TRNE TB,1
JRST STINFA ;YES
MOVEI DC,SRC ;NO--USE SOURCE CHANNEL
JRST OPENIN
STINFA: TLNN TA,$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,0 ;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
MOVE I4,DEVPP(DA) ;GET PROJ, PROG
JUMPN I2,OPNIN2 ;ANY EXTENSION?
OPNIN1: MOVE TA,DEVSW(DA) ; NO EXTENSION IS IT THE LIBRARY? [256]
TRNN TA,1 ; [256]
TLOA I2,'CBL' ;NO--USE "CBL"
HRLZI I2,'LIB' ;YES--USE "LIB" [256]
XCT I0 ;TRY DEFAULT EXTENSION--DO LOOKUP [256]
TRNA ;NOT FOUND [256]
JRST OPNIN3 ; [256]
TRNE TA,1 ;IS IT THE LIBRARY?
JRST OPNI1D ;YES, GO TRY NULL EXTENSION.
HRLZI I2,'COB' ;NO, TRY "COB".
XCT I0 ;DO THE LOOKUP.
TRNA ;NOT FOUND TRY THE NULL EXTENSION.
JRST OPNIN3
OPNI1D: SETZ I2, ; TRY NULL EXTENSION [256]
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,1 ;LIBRARY?
JRST OPNIN4 ;YES
TRNE TA,2 ;NO--REWIND?
MTAPE SRC,$REW ;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
POPJ PP,
;ERRORS WHILE INITIALIZING THE DEVICE
;DEVICE UNAVAILABLE
CANTOP: MOVEI TB,MESS3
TYPEIT: MOVEI CH,"?"
TTCALL 1,CH
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
TYPIT1: TTCALL 3,(TB)
TYPIT2: TSWT FDSKC;
SWOFF FECOM;
JRST RESTRT
;LOOKUP FAILURE
NOLOOK: TTCALL 3,[ASCIZ "?CANNOT FIND "]
HRRZ TA,I2
JUMPN TA,ERATYP
PUSHJ PP,FILOUT
JRST TYPIT2
;LIBRARY DEVICE NOT DSK
NOTDSK: MOVEI TB,MESS4
JRST TYPIT1
MESS3: ASCIZ ": UNAVAILABLE"
MESS4: ASCIZ "?LIBRARY FILES MUST BE ON DISK"
END