Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
dmlio.mac
There are 22 other files named dmlio.mac in the archive. Click here to see a list.
TITLE DMLIO
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH GENDCL,DMLSYM,STRING,STRDCL ;[M575] STRDCL INCL FOR DEFN
;[575] OF CONSTANT BYTSIZ
SEGMEN
IFNDEF TOPS10,<TOPS10==1>
;EDITS
;V12A******************
;NAME DATE COMMENTS
;JSM 3-FEB-81 [575] DO NOT INTERPOLATE THE DASH CONTINUATION
; CHARACTER ON A CONTINUATION LINE OF A COBOL BIND
; STATEMENT IF THE TERMINATING CHARACTER OF THE
; PREVIOUS LINE IS A COMMA.
;**********************
;V12*******************
;NAME DATE COMMENTS
;HRB JUN-7-79 [317/377/421] FIX COBOL CONTINUATION LINES
;
;********************
;V10*****************
;NAME DATE COMMENTS
;SSC MAR-5-75 PLACED 6A EDIT %316 DIRECTLY IN V10
; NOTE THIS IS A NEW MODULE FOR COBOL
;********************
ENTRY OBJOUT,OWRITE,VOKOUT,VWRITE,BUFINI,OBJFLU,CWRITE
IFNDEF $COB,<$COB==0>
IFE $COB,<PRINTX <ASSEMBLING FOR FORTRAN>>
IFN $COB,<PRINTX <ASSEMBLING FOR COBOL>>
REG(CHANPT,4)
IFN $COB,< ;BECAUSE OF IMPURE.MAC
DEFINE DATA(NAM,LEN)<
EXTERN NAM
>
DEFINE GDATA (NAM,LEN)<
EXTERN NAM
>
>
DATA(OBJAREA,^D14) ;STORAGE FOR .FOR LINES
DATA(VOKAREA,^D14)
DATA(TEMPBP,2) ;USED IN WRITE
DATA(BUF.CP,2) ;ARG TO CHKSTR IN WRITE
DATA(LINCHK,2) ;DITTO FOR OBJOUT
DATA(NLEFT) ;FOR CHKSTR, IN OBJOUT
DATA(NN)
DATA(BUF.CN) ;DITTO FOR WRITE
DATA(B.OR.L) ;BUF OR LINE
DATA(ARG.T1) ;ONLY HISEG ARG-LISTS
IFE $COB,<
OBJPTR:: POINT 7,OBJAREA
XWD LOUTMAX,0
VOKPTR:: POINT 7,VOKAREA
XWD LOUTMAX,0
0
ARGWRI:
0 ;FILLED IN AT RUNTIME
[APPEND]
LINCHK
NLEFT
NN
WRIFILL: ;8 ARGS
0
0
0
0
0
0
0
0
>
SUBTTL CONSTANT DATA
$FUNCT (DMLIO) ;FORCE HIGH SEG
IFE $COB,<
ENDCOM:
STRIPT (<)
>)
CONTIN:
STRIPT (<
1>)
>
IFN $COB,<
ENDCOM:
STRIPT (<.
>)
CONTIN:
STRIPT (<
- >)
NEWLIN: ;[A421] INSIDE THE IFN $COB
STRIPT (<
>)
>
SUBTTL VARIOUS I/O ROUTINES
$FUNCT (OBJOUT) ;VARIABLE NUMBER
MOVEI R1,RELCHAN
SETOM B.OR.L ;SET LINE
COPI ARGWRI,OBJPTR
JRST LINOUT
$FUNCT (OWRITE)
MOVEI R1,RELCHAN
SETZM B.OR.L
COPI ARGWRI,BUFPTR(R1)
JRST LINOUT
$FUNCT (VOKOUT)
MOVEI R1,VOKCHAN
SETOM B.OR.L ;SET LINE
COPI ARGWRI,VOKPTR
JRST LINOUT
$FUNCT (VWRITE)
MOVEI R1,VOKCHAN
SETZM B.OR.L
COPI ARGWRI,BUFPTR(R1)
; JRST LINOUT
LINOUT:
SAVE <CHANPT>
MOVE CHANPT,R1
MOVEI R1,WRIFILL
SETZM NLEFT ;INIT FOR CHKSTR
SETZM NN ;FOR ARGCOPY
YOYO ARGCOPY,<WRIFILL,NN,AP>
WRI.LP:
MOVEI AP,ARGWRIT
PUSHJ P,CHKSTR##
JUMPL R0,IOEND
SKIPE B.OR.L ;SKIP SAYS BUFFER
JRST WRI.L1 ;[M575]
;[575] THE FOLLOWING CODE IS COMMENTED OUT BECAUSE IT NEEDED TO BE EXPANDED
;[575] AND I DIDN'T WANT TO PUT A JRST [LITERAL INSIDE ANOTHER ONE.
;[D575] JRST [
;[D575] MOVE R1,ARGWRI
;[D575] YOYO OUTSTR,<CHANPT,ARGWRI>
;[D575] MOVEI R1,CONTIN
;[D575] YOYO OUTSTR,<CHANPT,R1>
;[D575] MOVE R1,ARGWRI
;[D575] HLLZS 1(R1) ;RESET LENGTH TO ZERO
;[D575] JRST WRI.LP]
YOYO BUFOUT ;BUFOUT RESETS STRING PTR
JRST WRI.LP
WRI.L1: ;[575] THE FOLLOWING CODE HAS BEEN MOVED DOWN FROM ABOVE, AND
;[575] THE NEW CODE IS COMMENTED WITH THE FLAG [A575].
;[575] THE OLD CODE MERELY ASSUMED THAT IT SHOULD INCLUDE A DASH
;[575] FOR EVERY CONTINUATION LINE OF A DBMS BIND STATEMENT.
;[575] HOWEVER, IF A DBMS DATA-NAME IS TERMINATED AT THE END OF
;[575] LINE, THE DASH IS NOT NEEDED ON THE CONTINUATION LINE.
;[575] THE NEW CODE LOCATES THE LAST CHARACTER IN THE BUFFER,
;[575] WHICH IS KNOWN AT THIS POINT TO BE THE LAST CHARACTER IN
;[575] THE INTERPOLATED LINE. IF THIS CHARACTER IS A COMMA, THE
;[575] THE CONTINUATION DASH IS NOT NEEDED.
;[575]
MOVE R1,ARGWRI ;[575]
YOYO OUTSTR,<CHANPT,ARGWRI> ;[575]
MOVEI R1,CONTIN ;[575] PUT CONTINUATION FLAG INTO R1 AS
;[575] AS DEFAULT ACTION.
PUSH P,R2 ;[A575] GET 4 AC'S TO WORK WITH
PUSH P,R3 ;[A575]
PUSH P,R4 ;[A575]
PUSH P,R5 ;[A575]
MOVE R2,ARG.T1 ;[A575] GET PTR TO OUTPUT DBMS BUFFER
MOVE R3,0(R2) ;[A575] GET "BYTE PTR" TO 1ST CHAR - 1.
HRRZ R4,1(R2) ;[A575] GET CHAR CNT CURRENTLY IN BUFFER
;[A575] SINCE THIS OUTPUT FILE IS SINGLE-BUFFERED, WE HAVE
;[A575] TO MAKE SURE THAT WE ARE GOING TO BE WORKING ONLY
;[A575] WITHIN THAT BUFFER.
CAIG R4,0 ;[A575] ZERO OR LESS?
JRST WRI.L2 ;[A575] YES, TOO BAD, CANT TEST FOR ","
HLRZ R5,1(R2) ;[A575] GET BUFFER SIZE
CAMLE R4,R5 ;[A575] STILL INSIDE BUFFER?
JRST WRI.L2 ;[A575] NO, TOO BAD, ...
;[A575] NEXT WE CREATE THE BYTE POINTER TO THE CURRENT
;[A575] CHARACTER POSITION IN THE BUFFER - 1.
IDIVI R4,CPW ;[A575] DIVIDE BY CNT OF ASCII BYTES IN
;[A575] A WORD
ADD R3,R4 ;[A575] ADD QUOT TO WORD PART OF BYTE PTR
ADDI R3,1 ;[A575] BUMP UP BY ONE WORD
MOVEI R4,CPW+1 ;[A575] SET UP FOR DIFFERENTIAL FOR BYTE
;[A575] POS CALCULATION
SUB R4,R5 ;[A575] SUB BYTE REMAINDER
IMULI R4,BYTSIZ ;[A575] MULT IT BY SIZE OF ASCII BYTE
ADDI R4,1 ;[A575] ALIGN ON ASCII BYTE POS
LSH R4,14 ;[A575] SHIFT IT TO "P" LOC FOR BYTE PTR
HLRZ R2,R3 ;[A575] GET "S" LOC FOR BYTE PTR
ADD R2,R4 ;[A575] ADD IN "P" LOC
HRL R3,R2 ;[A575] MOVE TO LH OF BYTE PTR. NOW HAVE
;[A575] CREATED ENTIRE BYTE PTR TO CURRENT
;[A575] CHAR POS -1
;[A575] THEN WE GET THE CHARACTER AND TEST IT AND IF NEC-
;[A575] ESSARY SET UP THE ARGUMENT TO GENERATE A NEW LINE
;[A575] WITHOUT THE CONTINUATION CHARACTER.
ILDB R4,R3 ;[A575] GET CURRENT CHAR FROM BUFFER
CAIN R4,"," ;[A575] IS IT A ","?
MOVEI R1,NEWLIN ;[A575] YES, WE SHOULD START A NEW LINE
;[A575] IN THE OUTPUT TEXT.
;[A575] IF NOT, JUST LEAVE CONTINUATION
;[A575] FLAG IN R1.
WRI.L2: ;[A575]
POP P,R5 ;[A575] GIVE BACK THE 4 AC'S
POP P,R4 ;[A575]
POP P,R3 ;[A575]
POP P,R2 ;[A575]
YOYO OUTSTR,<CHANPT,R1> ;[575]
MOVE R1,ARGWRI ;[575]
HLLZS 1(R1) ;RESET LENGTH TO ZERO ;[575]
JRST WRI.LP ;[575]
;[575] END OF EDIT 575
$FUNCT BUFINI,<CHAN>
SAVE <CHANPT>
MOVEI CHANPT,@CHAN(AP)
YOYO BUFOUT ;FRIST SETS UP BUFHDR
JRST IOEND
$FUNCT OBJFLUSH
FUNCT CWRITE,<RELCHAN,OBJPTR> ;PUT AT PARTIAL LINE
FUNCT CWRITE,<RELCHAN,ENDCOM> ;ENDCOM IS <END OF CALL><CRLF> SO OBJOUT CAN'T BE
;USED FOR DUMPING ARBITRARY STATS
HLLZS OBJPTR+1 ;PRESERVE MAX, SET LEN DOWN
RETURN
;
;OBJCNTN - FIX COBOL CONTINUATION PROBLEM WITH ENTER MACRO SBIND
;THIS IS EDIT 317/377/421. NOTE - THIS EDIT ALREADY APPEARS IN THE
;V6 SOURCES.
;
$FUNCT (OBJCNTN)
IFN $COB,<
FUNCT CWRITE,<RELCHAN,OBJPTR>
FUNCT CWRITE,<RELCHAN,NEWLIN>
HLLZS OBJPTR+1
>
RETURN
;END EDIT 317/377/421
$FUNCT (CWRITE,<CHAN,OUTBP>) ;AT SOME POINT MUST BE GENERALIZED
SAVE <CHANPT>
MOVEI CHANPT,@CHAN(AP)
MOVEI R1,@OUTBP(AP)
YOYO OUTSTR,<CHANPT,OUTBP>
JRST IOEND
;;;;;;;;;;;;;;;;
IOEND: RESTOR <CHANPT>
RETURN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
$YOYO (OUTSTR,<CHANPT,OUTBP>)
DCOPY TEMPBP,0(R1) ;TO PASS ON
SETZM BUF.CN
COPI ARG.T1,BUFPTR(CHANPT)
BUF.LP:
FUNCT CHKSTR,<@ARG.T1,[APPEND],BUF.CP,BUF.CN,ONE,TEMPBP>
JUMPL R0,LEAVE
YOYO BUFOUT
JRST BUF.LP
$YOYO BUFOUT
IFN TOPS10,<
HRRZ R0,BUFPTR+1(CHANPT) ;SETUP WORD CNT
IDIVI R0,5
SKIPE R1 ;REMAINDER?
ADDI R0,1
MOVE R1,HDR(CHANPT)
HRRM R0,1(R1)
XCT OUTINST(CHANPT)
SKIPA
HALT ;SHOULD'T HAPPEN
COPY BUFPTR(CHANPT),HDR+1(CHANPT)
HRLZ R0,HDR+2(CHANPT) ;SET UP MAXIMUM
MOVEM R0,BUFPTR+1(CHANPT)
>
RETURN
$YOYO ARGCOPY,<R1,NN,AP>
HRL R1,AP ;FOR BLT
HLRE AP,-1(AP)
MOVMS AP
ADDM AP,NN
ADDI AP,0(R1)
BLT R1,-1(AP)
RETURN
END