home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
b
/
vmsfil.mar
< prev
next >
Wrap
Text File
|
2020-01-01
|
176KB
|
4,157 lines
; 0001 0 MODULE KERFIL (IDENT = '3.3.119',
; 0002 0 ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)) =
; 0003 1 BEGIN
; 0004 1 !<BLF/WIDTH:90>
; 0005 1
; 0006 1 !++
; 0007 1 ! FACILITY:
; 0008 1 ! KERMIT-32 Microcomputer to mainframe file transfer utility.
; 0009 1 !
; 0010 1 ! ABSTRACT:
; 0011 1 ! KERFIL contains all of the file processing for KERMIT-32. This
; 0012 1 ! module contains the routines to input/output characters to files
; 0013 1 ! and to open and close the files.
; 0014 1 !
; 0015 1 ! ENVIRONMENT:
; 0016 1 ! VAX/VMS user mode.
; 0017 1 !
; 0018 1 ! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983
; 0019 1 !
; 0020 1 !--
; 0021 1
; 0022 1 %SBTTL 'Table of Contents'
; 0023 1 %SBTTL 'Revision History'
; 0024 1
; 0025 1 !++
; 0026 1 !
; 0027 1 ! 1.0.000 By: Robert C. McQueen On: 28-March-1983
; 0028 1 ! Create this module.
; 0029 1 ! 1.0.001 By: Robert C. McQueen On: 4-April-1983
; 0030 1 ! Remove checks for <FF> in the input data stream.
; 0031 1 !
; 0032 1 ! 1.0.002 By: Robert C. McQueen On: 31-May-1983
; 0033 1 ! Fix a bad check in wildcard processing.
; 0034 1 !
; 0035 1 ! 1.0.003 By: Nick Bush On: 13-June-1983
; 0036 1 ! Add default file spec of .;0 so that wild-carded
; 0037 1 ! file types don't cause all version of a file to
; 0038 1 ! be transferred.
; 0039 1 !
; 0040 1 ! 1.0.004 By: Robert C. McQueen On: 20-July-1983
; 0041 1 ! Strip off the parity bit on the compares for incoming ASCII
; 0042 1 ! files.
; 0043 1 !
; 0044 1 ! 1.2.005 By: Robert C. McQueen On: 15-August-1983
; 0045 1 ! Attempt to improve the GET%FILE and make it smaller.
; 0046 1 ! Also start the implementation of the BLOCK file processing.
; 0047 1 !
; 0048 1 ! 2.0.006 Release VAX/VMS Kermit-32 version 2.0
; 0049 1 !
; 0050 1 ! 2.0.016 By: Nick Bush On: 4-Dec-1983
; 0051 1 ! Change how binary files are written to (hopefully) improve
; 0052 1 ! the performance. We will now use 510 records and only
; 0053 1 ! write out the record when it is filled (instead of writing
; 0054 1 ! one record per packet). This should cut down on the overhead
; 0055 1 ! substantially.
; 0056 1 !
; 0057 1 ! 2.0.017 By: Nick Bush On: 9-Dec-1983
; 0058 1 ! Fix processing for VFC format files. Also fix GET_ASCII
; 0059 1 ! for PRN and FTN record types. Change GET_ASCII so that
; 0060 1 ! 'normal' CR records get sent with trailing CRLF's instead
; 0061 1 ! of <LF>record<CR>. That was confusing too many people.
; 0062 1 !
; 0063 1 ! 2.0.022 By: Nick Bush On: 15-Dec-1983
; 0064 1 ! Add Fixed record size (512 byte) format for writing files.
; 0065 1 ! This can be used for .EXE files. Also clean up writing
; 0066 1 ! ASCII files so that we don't lose any characters.
; 0067 1 !
; 0068 1 ! 2.0.024 By: Robert C. McQueen On: 19-Dec-1983
; 0069 1 ! Delete FILE_DUMP.
; 0070 1 !
; 0071 1 ! 2.0.026 By: Nick Bush On: 3-Jan-1983
; 0072 1 ! Add options for format of file specification to be
; 0073 1 ! sent in file header packets. Also type out full file
; 0074 1 ! specification being sent/received instead of just
; 0075 1 ! the name we are telling the other end to use.
; 0076 1 !
; 0077 1 ! 2.0.030 By: Nick Bush On: 3-Feb-1983
; 0078 1 ! Add the capability of receiving a file with a different
; 0079 1 ! name than given by KERMSG. The RECEIVE and GET commands
; 0080 1 ! now really are different.
; 0081 1 !
; 0082 1 ! 2.0.035 By: Nick Bush On: 8-March-1984
; 0083 1 ! Add LOG SESSION command to set a log file for CONNECT.
; 0084 1 ! While we are doing so, clean up the command parsing a little
; 0085 1 ! so that we don't have as many COPY_xxx routines.
; 0086 1 !
; 0087 1 ! 2.0.036 By: Nick Bush On: 15-March-1984
; 0088 1 ! Fix PUT_FILE to correctly handle carriage returns which are
; 0089 1 ! not followed by line feeds. Count was being decremented
; 0090 1 ! Instead of incremented.
; 0091 1 !
; 0092 1 ! 2.0.040 By: Nick Bush On: 22-March-1984
; 0093 1 ! Fix processing of FORTRAN carriage control to handle lines
; 0094 1 ! which do not contain the carriage control character (i.e., zero
; 0095 1 ! length records). Previously, this type of record was sending
; 0096 1 ! infinite nulls.
; 0097 1 !
; 0098 1 ! 3.0.045 Start of version 3.
; 0099 1 !
; 0100 1 ! 3.0.046 By: Nick Bush On: 29-March-1984
; 0101 1 ! Fix debugging log file to correctly set/clear file open
; 0102 1 ! flag. Also make log files default to .LOG.
; 0103 1 !
; 0104 1 ! 3.0.050 By: Nick Bush On: 2-April-1984
; 0105 1 ! Add SET SERVER_TIMER to determine period between idle naks.
; 0106 1 ! Also allow for a routine to process file specs before
; 0107 1 ! FILE_OPEN uses them. This allows individual sites to
; 0108 1 ! restrict the format of file specifications used by Kermit.
; 0109 1 !
; 0110 1 ! 3.1.053 By: Robert C. McQueen On: 9-July-1984
; 0111 1 ! Fix FORTRAN carriage control processing to pass along
; 0112 1 ! any character from the carriage control column that is
; 0113 1 ! not really carriage control.
; 0114 1 !
; 0115 1 ! Start version 3.2
; 0116 1 !
; 0117 1 ! 3.2.067 By: Robert C. McQueen On: 8-May-1985
; 0118 1 ! Use $GETDVIW instead of $GETDVI.
; 0119 1 !
; 0120 1 ! 3.2.070 By: David Stevens On: 16-July-1985
; 0121 1 ! Put "Sending: " prompt into NEXT_FILE routine, to make
; 0122 1 ! VMS KERMIT similar to KERMIT-10.
; 0123 1 !
; 0124 1 ! 3.2.077 By: Robert McQueen On: 8-May-1986
; 0125 1 ! Fix FORTRAN CC once and for all (I hope).
; 0126 1 !
; 0127 1 ! Start of version 3.3
; 0128 1 !
; 0129 1 ! 3.3.105 By: Robert McQueen On: 8-July-1986
; 0130 1 ! Do some clean up and attempt to fix LINK-W-TRUNC errors
; 0131 1 ! from a BLISS-32 bug.
; 0132 1 !
; 0133 1 ! 3.3.106 By: Robert McQueen On: 8-July-1986
; 0134 1 ! Fix problem of closing a fixed file and losing data.
; 0135 1 !
; 0136 1 ! 3.3.111 By: Robert McQueen On: 2-Oct-1986
; 0137 1 ! Make Kermit-32 not eat the parity from a CR if a LF doesn't
; 0138 1 ! follow it when writing an ASCII file.
; 0139 1 !
; 0140 1 ! 3.3.112 JHW0001 Jonathan H. Welch, 28-Apr-1988 12:11
; 0141 1 ! Fix the message generated in NEXT_FILE so that the
; 0142 1 ! filenames displayed (i.e. Sending: foo.bar;1 as foo.bar)
; 0143 1 ! are always terminated by a null (ASCIZ).
; 0144 1 !
; 0145 1 ! 3.3.117 JHW006 Jonathan H. Welch, 12-May-1988
; 0146 1 ! Calls to LIB$SIGNAL with multiple arguments were
; 0147 1 ! not coded correctly. For calls with multiple arguments
; 0148 1 ! an argument count was added.
; 0149 1 ! Minor changes to KERM_HANDLER to make use of the changed
; 0150 1 ! argument passing method.
; 0151 1 !
; 0152 1 ! 3.3.118 JHW010 Jonathan H. Welch, 23-Apr-1990 09:42
; 0153 1 ! Added SET FILE BLOCKSIZE nnn (where nnn is the record size
; 0154 1 ! in bytes) command for incoming BINARY and FIXED file transfers.
; 0155 1 ! If no blocksize has been specified the old behavior (510 byte
; 0156 1 ! records plus 2 bytes (for CR/LF) for BINARY files and 512
; 0157 1 ! byte records for FIXED files will be used.
; 0158 1 ! Also modified SHOW FILE to display record size when appropriate.
; 0159 1 !
; 0160 1 ! 3.3.119 JHW015 Jonathan H. Welch, 16-Jul-1990 15:30
; 0161 1 ! Fixed the logic in GET_ASCII which was causing an infinite
; 0162 1 ! loop for files with print file carriage control.
; 0163 1 !--
; 0164 1
; 0165 1 %SBTTL 'Forward definitions'
; 0166 1
; 0167 1 FORWARD ROUTINE
; 0168 1 LOG_PUT, ! Write a buffer out
; 0169 1 DUMP_BUFFER, ! Worker routine for FILE_DUMP.
; 0170 1 GET_BUFFER, ! Routine to do $GET
; 0171 1 GET_ASCII, ! Get an ASCII character
; 0172 1 GET_BLOCK, ! Get a block character
; 0173 1 FILE_ERROR : NOVALUE; ! Error processing routine
; 0174 1
; 0175 1 %SBTTL 'Require/Library files'
; 0176 1 !
; 0177 1 ! INCLUDE FILES:
; 0178 1 !
; 0179 1
; 0180 1 LIBRARY 'SYS$LIBRARY:STARLET';
; 0181 1
; 0182 1 REQUIRE 'KERCOM.REQ';
; 0391 1
; 0392 1 %SBTTL 'Macro definitions'
; 0393 1 !
; 0394 1 ! MACROS:
; 0395 1 !
; 0396 1 %SBTTL 'Literal symbol definitions'
; 0397 1 !
; 0398 1 ! EQUATED SYMBOLS:
; 0399 1 !
; 0400 1 !
; 0401 1 ! Various states for reading the data from the file
; 0402 1 !
; 0403 1
; 0404 1 LITERAL
; 0405 1 F_STATE_PRE = 0, ! Prefix state
; 0406 1 F_STATE_PRE1 = 1, ! Other prefix state
; 0407 1 F_STATE_DATA = 2, ! Data processing state
; 0408 1 F_STATE_POST = 3, ! Postfix processing state
; 0409 1 F_STATE_POST1 = 4, ! Secondary postfix processing state
; 0410 1 F_STATE_MIN = 0, ! Min state number
; 0411 1 F_STATE_MAX = 4; ! Max state number
; 0412 1
; 0413 1 !
; 0414 1 ! Buffer size for log file
; 0415 1 !
; 0416 1
; 0417 1 LITERAL
; 0418 1 LOG_BUFF_SIZE = 256; ! Number of bytes in log file buffer
; 0419 1
; 0420 1 %SBTTL 'Local storage'
; 0421 1 !
; 0422 1 ! OWN STORAGE:
; 0423 1 !
; 0424 1
; 0425 1 OWN
; 0426 1 SEARCH_FLAG, ! Can/cannot do $SEARCH
; 0427 1 DEV_CLASS, ! Type of device we are reading
; 0428 1 EOF_FLAG, ! End of file reached.
; 0429 1 FILE_FAB : $FAB_DECL, ! FAB for file processing
; 0430 1 FILE_NAM : $NAM_DECL, ! NAM for file processing
; 0431 1 FILE_RAB : $RAB_DECL, ! RAB for file processing
; 0432 1 FILE_XABFHC : $XABFHC_DECL, ! XAB for file processing
; 0433 1 FILE_MODE, ! Mode of file (reading/writing)
; 0434 1 FILE_REC_POINTER, ! Pointer to the record information
; 0435 1 FILE_REC_COUNT, ! Count of the number of bytes
; 0436 1 REC_SIZE : LONG, ! Record size
; 0437 1 REC_ADDRESS : LONG, ! Record address
; 0438 1 FIX_SIZE : LONG, ! Fixed control region size
; 0439 1 FIX_ADDRESS : LONG, ! Address of buffer for fixed control region
; 0440 1 EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
; 0441 1 RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
; 0442 1 RES_STR_D : BLOCK [8, BYTE]; ! Descriptor for the string
; 0443 1
; 0444 1 %SBTTL 'Global storage'
; 0445 1 !
; 0446 1 ! Global storage:
; 0447 1 !
; 0448 1
; 0449 1 GLOBAL
; 0450 1
; 0451 1 file_blocksize, ! Block size of for BINARY and FIXED files.
; 0452 1 file_blocksize_set, ! 0=user has not specified a blocksize, 1=user has specified a blocksize
; 0453 1 FILE_TYPE, ! Type of file being xfered
; 0454 1 FILE_DESC : BLOCK [8, BYTE]; ! File name descriptor
; 0455 1
; 0456 1 %SBTTL 'External routines and storage'
; 0457 1 !
; 0458 1 ! EXTERNAL REFERENCES:
; 0459 1 !
; 0460 1 !
; 0461 1 ! Storage in KERMSG
; 0462 1 !
; 0463 1
; 0464 1 EXTERNAL
; 0465 1 ALT_FILE_SIZE, ! Number of characters in FILE_NAME
; 0466 1 ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! Storage
; 0467 1 FILE_SIZE, ! Number of characters in FILE_NAME
; 0468 1 FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
; 0469 1 TY_FIL, ! Flag that file names are being typed
; 0470 1 CONNECT_FLAG, ! Indicator of whether we have a terminal to type on
; 0471 1 FIL_NORMAL_FORM; ! File specification type
; 0472 1
; 0473 1 !
; 0474 1 ! Routines in KERTT
; 0475 1 !
; 0476 1
; 0477 1 EXTERNAL ROUTINE
; 0478 1 TT_OUTPUT : NOVALUE; ! Force buffered output
; 0479 1
; 0480 1 !
; 0481 1 ! System libraries
; 0482 1 !
; 0483 1
; 0484 1 EXTERNAL ROUTINE
; 0485 1 LIB$GET_VM : ADDRESSING_MODE (GENERAL),
; 0486 1 LIB$FREE_VM : ADDRESSING_MODE (GENERAL),
; 0487 1 LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE;
; 0488 1
; 0489 1 %SBTTL 'File processing -- FILE_INIT - Initialization'
; 0490 1
; 0491 1 GLOBAL ROUTINE FILE_INIT : NOVALUE =
; 0492 1
; 0493 1 !++
; 0494 1 ! FUNCTIONAL DESCRIPTION:
; 0495 1 !
; 0496 1 ! This routine will initialize some of the storage in the file processing
; 0497 1 ! module.
; 0498 1 !
; 0499 1 ! CALLING SEQUENCE:
; 0500 1 !
; 0501 1 ! FILE_INIT();
; 0502 1 !
; 0503 1 ! INPUT PARAMETERS:
; 0504 1 !
; 0505 1 ! None.
; 0506 1 !
; 0507 1 ! IMPLICIT INPUTS:
; 0508 1 !
; 0509 1 ! None.
; 0510 1 !
; 0511 1 ! OUTPUT PARAMETERS:
; 0512 1 !
; 0513 1 ! None.
; 0514 1 !
; 0515 1 ! IMPLICIT OUTPUTS:
; 0516 1 !
; 0517 1 ! None.
; 0518 1 !
; 0519 1 ! COMPLETION CODES:
; 0520 1 !
; 0521 1 ! None.
; 0522 1 !
; 0523 1 ! SIDE EFFECTS:
; 0524 1 !
; 0525 1 ! None.
; 0526 1 !
; 0527 1 !--
; 0528 1
; 0529 2 BEGIN
; 0530 2 FILE_TYPE = FILE_ASC;
; 0531 2 file_blocksize = 512;
; 0532 2 file_blocksize_set = 0;
; 0533 2
; 0534 2 ! Now set up the file specification descriptor
; 0535 2 FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
; 0536 2 FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
; 0537 2 FILE_DESC [DSC$A_POINTER] = FILE_NAME;
; 0538 2 FILE_DESC [DSC$W_LENGTH] = 0;
; 0539 2 EOF_FLAG = FALSE;
; 0540 1 END; ! End of FILE_INIT
.TITLE KERFIL
.IDENT \3.3.119\
.PSECT $OWN$,NOEXE,2
;SEARCH_FLAG
U.7: .BLKB 4 ; 00000
;DEV_CLASS
U.8: .BLKB 4 ; 00004
;EOF_FLAG
U.9: .BLKB 4 ; 00008
;FILE_FAB
U.10: .BLKB 80 ; 0000C
;FILE_NAM
U.11: .BLKB 96 ; 0005C
;FILE_RAB
U.12: .BLKB 68 ; 000BC
;FILE_XABFHC
U.13: .BLKB 44 ; 00100
;FILE_MODE
U.14: .BLKB 4 ; 0012C
;FILE_REC_POINTER
U.15: .BLKB 4 ; 00130
;FILE_REC_COUNT
U.16: .BLKB 4 ; 00134
;REC_SIZE
U.17: .BLKB 4 ; 00138
;REC_ADDRESS
U.18: .BLKB 4 ; 0013C
;FIX_SIZE
U.19: .BLKB 4 ; 00140
;FIX_ADDRESS
U.20: .BLKB 4 ; 00144
;EXP_STR
U.21: .BLKB 256 ; 00148
;RES_STR
U.22: .BLKB 256 ; 00248
;RES_STR_D
U.23: .BLKB 8 ; 00348
.PSECT $GLOBAL$,NOEXE,2
FILE_BLOCKSIZE::
.BLKB 4 ; 00000
FILE_BLOCKSIZE_SET::
.BLKB 4 ; 00004
FILE_TYPE::
.BLKB 4 ; 00008
FILE_DESC::
.BLKB 8 ; 0000C
FNM_NORMAL== 1
FNM_FULL== 2
FNM_UNTRAN== 4
PR_MIN== 0
PR_NONE== 0
PR_MARK== 1
PR_EVEN== 2
PR_ODD== 3
PR_SPACE== 4
PR_MAX== 4
GC_MIN== 1
GC_EXIT== 1
GC_DIRECTORY== 2
GC_DISK_USAGE== 3
GC_DELETE== 4
GC_TYPE== 5
GC_HELP== 6
GC_LOGOUT== 7
GC_LGN== 8
GC_CONNECT== 9
GC_RENAME== 10
GC_COPY== 11
GC_WHO== 12
GC_SEND_MSG== 13
GC_STATUS== 14
GC_COMMAND== 15
GC_KERMIT== 16
GC_JOURNAL== 17
GC_VARIABLE== 18
GC_PROGRAM== 19
GC_MAX== 19
DP_FULL== 0
DP_HALF== 1
CHK_1CHAR== 49
CHK_2CHAR== 50
CHK_CRC== 51
MAX_MSG== 1002
.EXTRN ALT_FILE_SIZE, ALT_FILE_NAME, FILE_SIZE, FILE_NAME, TY_FIL, CONNECT_FLAG, FIL_NORMAL_FORM
.EXTRN TT_OUTPUT, LIB$GET_VM, LIB$FREE_VM, LIB$SIGNAL
.PSECT $CODE$,NOWRT,2
.ENTRY FILE_INIT, ^M<R2> ;FILE_INIT, Save R2 0491 0004 00000
MOVAB G^FILE_TYPE, R2 ;FILE_TYPE, R2 52 00000000' 00 9E 00002
MOVL #1, (R2) ;#1, FILE_TYPE 0530 62 01 D0 00009
MOVZWL #512, -8(R2) ;#512, FILE_BLOCKSIZE 0531 F8 A2 0200 8F 3C 0000C
CLRL -4(R2) ;FILE_BLOCKSIZE_SET 0532 FC A2 D4 00012
MOVL #17694720, 4(R2) ;#17694720, FILE_DESC 0538 04 A2 010E0000 8F D0 00015
MOVAB G^FILE_NAME, 8(R2) ;FILE_NAME, FILE_DESC+4 0537 08 A2 00000000G 00 9E 0001D
CLRL G^U.9 ;U.9 0539 00000000' 00 D4 00025
RET ; 0540 04 0002B
; Routine Size: 44 bytes, Routine Base: $CODE$ + 0000
; 0541 1
; 0542 1 %SBTTL 'GET_FILE'
; 0543 1
; 0544 1 GLOBAL ROUTINE GET_FILE (CHARACTER) =
; 0545 1
; 0546 1 !++
; 0547 1 ! FUNCTIONAL DESCRIPTION:
; 0548 1 !
; 0549 1 ! This routine will return a character from the input file.
; 0550 1 ! The character will be stored into the location specified by
; 0551 1 ! CHARACTER.
; 0552 1 !
; 0553 1 ! CALLING SEQUENCE:
; 0554 1 !
; 0555 1 ! GET_FILE (LOCATION_TO_STORE_CHAR);
; 0556 1 !
; 0557 1 ! INPUT PARAMETERS:
; 0558 1 !
; 0559 1 ! LOCATION_TO_STORE_CHAR - This is the address to store the character
; 0560 1 ! into.
; 0561 1 !
; 0562 1 ! IMPLICIT INPUTS:
; 0563 1 !
; 0564 1 ! None.
; 0565 1 !
; 0566 1 ! OUTPUT PARAMETERS:
; 0567 1 !
; 0568 1 ! Character stored into the location specified.
; 0569 1 !
; 0570 1 ! IMPLICIT OUTPUTS:
; 0571 1 !
; 0572 1 ! None.
; 0573 1 !
; 0574 1 ! COMPLETION CODES:
; 0575 1 !
; 0576 1 ! True - Character stored into the location specified.
; 0577 1 ! False - End of file reached.
; 0578 1 !
; 0579 1 ! SIDE EFFECTS:
; 0580 1 !
; 0581 1 ! None.
; 0582 1 !
; 0583 1 !--
; 0584 1
; 0585 2 BEGIN
; 0586 2 !
; 0587 2 ! Define the various condition codes that we check for in this routine
; 0588 2 !
; 0589 2 EXTERNAL LITERAL
; 0590 2 KER_EOF; ! End of file
; 0591 2
; 0592 2 LOCAL
; 0593 2 STATUS; ! Random status values
; 0594 2
; 0595 2 IF .EOF_FLAG THEN RETURN KER_EOF;
; 0596 2
; 0597 2 SELECTONE .FILE_TYPE OF
; 0598 2 SET
; 0599 2
; 0600 2 [FILE_ASC, FILE_BIN, FILE_FIX] :
; 0601 2 STATUS = GET_ASCII (.CHARACTER);
; 0602 2
; 0603 2 [FILE_BLK] :
; 0604 2 STATUS = GET_BLOCK (.CHARACTER);
; 0605 2 TES;
; 0606 2
; 0607 2 RETURN .STATUS;
; 0608 1 END; ! End of GET_FILE
.EXTRN KER_EOF
.ENTRY GET_FILE, ^M<> ;GET_FILE, Save nothing 0544 0000 00000
BLBC G^U.9, 1$ ;U.9, 1$ 0595 08 00000000' 00 E9 00002
MOVL #KER_EOF, R0 ;#KER_EOF, R0 50 00000000G 8F D0 00009
RET ; 04 00010
1$: MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 0597 50 00000000' 00 D0 00011
BLEQ 2$ ;2$ 0600 05 15 00018
CMPL R0, #2 ;R0, #2 02 50 D1 0001A
BLEQ 3$ ;3$ 05 15 0001D
2$: CMPL R0, #4 ;R0, #4 04 50 D1 0001F
BNEQ 4$ ;4$ 0B 12 00022
3$: PUSHL 4(AP) ;CHARACTER 0601 04 AC DD 00024
CALLS #1, G^U.4 ;#1, U.4 00000000V 00 01 FB 00027
RET ; 04 0002E
4$: CMPL R0, #3 ;R0, #3 0603 03 50 D1 0002F
BNEQ 5$ ;5$ 0A 12 00032
PUSHL 4(AP) ;CHARACTER 0604 04 AC DD 00034
CALLS #1, G^U.5 ;#1, U.5 00000000V 00 01 FB 00037
5$: RET ; 0607 04 0003E
; Routine Size: 63 bytes, Routine Base: $CODE$ + 002C
; 0609 1 %SBTTL 'GET_ASCII - Get a character from an ASCII file'
; 0610 1 ROUTINE GET_ASCII (CHARACTER) =
; 0611 1
; 0612 1 !++
; 0613 1 ! FUNCTIONAL DESCRIPTION:
; 0614 1 !
; 0615 1 ! CALLING SEQUENCE:
; 0616 1 !
; 0617 1 ! INPUT PARAMETERS:
; 0618 1 !
; 0619 1 ! None.
; 0620 1 !
; 0621 1 ! IMPLICIT INPUTS:
; 0622 1 !
; 0623 1 ! None.
; 0624 1 !
; 0625 1 ! OUPTUT PARAMETERS:
; 0626 1 !
; 0627 1 ! None.
; 0628 1 !
; 0629 1 ! IMPLICIT OUTPUTS:
; 0630 1 !
; 0631 1 ! None.
; 0632 1 !
; 0633 1 ! COMPLETION CODES:
; 0634 1 !
; 0635 1 ! KER_EOF - End of file encountered
; 0636 1 ! KER_ILLFILTYP - Illegal file type
; 0637 1 ! KER_NORMAL - Normal return
; 0638 1 !
; 0639 1 ! SIDE EFFECTS:
; 0640 1 !
; 0641 1 ! None.
; 0642 1 !
; 0643 1 !--
; 0644 1
; 0645 2 BEGIN
; 0646 2 !
; 0647 2 ! Status codes that are returned by this module
; 0648 2 !
; 0649 2 EXTERNAL LITERAL
; 0650 2 KER_EOF, ! End of file encountered
; 0651 2 KER_ILLFILTYP, ! Illegal file type
; 0652 2 KER_NORMAL; ! Normal return
; 0653 2
; 0654 2 OWN
; 0655 2 CC_COUNT, ! Count of the number of CC things to output
; 0656 2 CC_TYPE; ! Type of carriage control being processed.
; 0657 2
; 0658 2 LOCAL
; 0659 2 STATUS, ! For status values
; 0660 2 RAT;
; 0661 2 %SBTTL 'GET_FTN_FILE_CHARACTER - Get a character from an Fortran carriage control file'
; 0662 2 ROUTINE GET_FTN_FILE_CHARACTER (CHARACTER) =
; 0663 2 !++
; 0664 2 ! FUNCTIONAL DESCRIPTION:
; 0665 2 !
; 0666 2 ! This routine will get a character from a FORTRAN carriage control file.
; 0667 2 ! A FORTRAN carriage control file is one with FAB$M_FTN on in the FAB$B_RAT
; 0668 2 ! field.
; 0669 2 !
; 0670 2 ! FORMAL PARAMETERS:
; 0671 2 !
; 0672 2 ! CHARACTER - Address of where to store the character
; 0673 2 !
; 0674 2 ! IMPLICIT INPUTS:
; 0675 2 !
; 0676 2 ! CC_TYPE - Carriage control type
; 0677 2 !
; 0678 2 ! IMPLICIT OUTPUTS:
; 0679 2 !
; 0680 2 ! CC_TYPE - Updated if this is the first characte of the record
; 0681 2 !
; 0682 2 ! COMPLETION_CODES:
; 0683 2 !
; 0684 2 ! System service or Kermit status code
; 0685 2 !
; 0686 2 ! SIDE EFFECTS:
; 0687 2 !
; 0688 2 ! Next buffer can be read from the data file.
; 0689 2 !--
; 0690 3 BEGIN
; 0691 3 !
; 0692 3 ! Dispatch according to the state of the file being read. Beginning of
; 0693 3 ! record, middle of record, end of record
; 0694 3 !
; 0695 3 WHILE TRUE DO
; 0696 3 CASE .FILE_FAB[FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF
; 0697 3 SET
; 0698 3 !
; 0699 3 ! Here at the beginning of a record. We must read the buffer from the file
; 0700 3 ! at this point. Once the buffer is read we must then determine what to do
; 0701 3 ! with the FORTRAN carriage control that at the beginning of the buffer.
; 0702 3 !
; 0703 3 [F_STATE_PRE ]:
; 0704 4 BEGIN
; 0705 4 !
; 0706 4 ! Local variables
; 0707 4 !
; 0708 4 LOCAL
; 0709 4 STATUS; ! Status returned by the
; 0710 4 ! GET_BUFFER routine
; 0711 4 !
; 0712 4 ! Get the buffer
; 0713 4 !
; 0714 4 STATUS = GET_BUFFER (); ! Get a buffer from the system
; 0715 5 IF (NOT .STATUS) ! If this call failed
; 0716 5 OR (.STATUS EQL KER_EOF) ! or we got an EOF
; 0717 4 THEN
; 0718 4 RETURN .STATUS; ! Just return the status
; 0719 4 !
; 0720 4 ! Here with a valid buffer full of data all set to be decoded
; 0721 4 !
; 0722 4 IF .FILE_REC_COUNT LEQ 0 ! If nothing, use a space
; 0723 4 THEN ! for the carriage control
; 0724 4 CC_TYPE = %C' '
; 0725 4 ELSE
; 0726 5 BEGIN
; 0727 5 CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER);
; 0728 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1;
; 0729 4 END;
; 0730 4 !
; 0731 4 ! Dispatch on the type of carriage control that we are processing
; 0732 4 !
; 0733 4 SELECTONE .CC_TYPE OF
; 0734 4 SET
; 0735 4 !
; 0736 4 ! All of these just output:
; 0737 4 ! <DATA> <Carriage-control>
; 0738 4 !
; 0739 4 [CHR_NUL, %C'+'] :
; 0740 5 BEGIN
; 0741 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0742 4 END;
; 0743 4 !
; 0744 4 ! This outputs:
; 0745 4 ! <LF><DATA><CR>
; 0746 4 !
; 0747 4 [%C'$', %C' '] :
; 0748 5 BEGIN
; 0749 5 .CHARACTER = CHR_LFD;
; 0750 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0751 5 RETURN KER_NORMAL;
; 0752 4 END;
; 0753 4 !
; 0754 4 ! This outputs:
; 0755 4 ! <LF><LF><DATA><CR>
; 0756 4 !
; 0757 4 [%C'0'] :
; 0758 5 BEGIN
; 0759 5 .CHARACTER = CHR_LFD;
; 0760 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1;
; 0761 5 RETURN KER_NORMAL;
; 0762 4 END;
; 0763 4 !
; 0764 4 ! This outputs:
; 0765 4 ! <FORM FEED><DATA><CR>
; 0766 4 !
; 0767 4 [%C'1'] :
; 0768 5 BEGIN
; 0769 5 .CHARACTER = CHR_FFD;
; 0770 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0771 5 RETURN KER_NORMAL;
; 0772 4 END;
; 0773 4 !
; 0774 4 ! If we don't know the type of carriage control, then just return the
; 0775 4 ! character we read as data and set the carriage control to be space
; 0776 4 ! to fool the post processing of the record
; 0777 4 !
; 0778 4 [OTHERWISE] :
; 0779 5 BEGIN
; 0780 5 .CHARACTER = .CC_TYPE; ! Return the character
; 0781 5 CC_TYPE = %C' '; ! Treat as space
; 0782 5 FILE_REC_POINTER = CH$PLUS(.FILE_REC_POINTER,-1);
; 0783 5 FILE_REC_COUNT = .FILE_REC_COUNT + 1;
; 0784 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0785 5 RETURN KER_NORMAL
; 0786 4 END;
; 0787 4 TES;
; 0788 4
; 0789 3 END;
; 0790 3 !
; 0791 3 ! Here to add the second LF for the double spacing FORTRAN carriage control
; 0792 3 !
; 0793 3 [F_STATE_PRE1 ]:
; 0794 4 BEGIN
; 0795 4 .CHARACTER = CHR_LFD;
; 0796 4 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0797 4 RETURN KER_NORMAL;
; 0798 3 END;
; 0799 3 !
; 0800 3 ! Here to read the data of the record
; 0801 3 !
; 0802 3 [F_STATE_DATA]:
; 0803 4 BEGIN
; 0804 4 !
; 0805 4 ! Here to read the data of the record and return it to the caller
; 0806 4 ! This section can only return KER_NORMAL to the caller
; 0807 4 !
; 0808 4 IF .FILE_REC_COUNT LEQ 0 ! Anything left in the buffer
; 0809 4 THEN
; 0810 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST ! No, do post processing
; 0811 4 ELSE
; 0812 5 BEGIN
; 0813 5 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ! Get a character
; 0814 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ! Decrement the count
; 0815 5 RETURN KER_NORMAL; ! Give a good return
; 0816 4 END;
; 0817 3 END;
; 0818 3 !
; 0819 3 ! Here to do post processing of the record. At this point we are going
; 0820 3 ! to store either nothing as the post fix, a carriage return for overprinting
; 0821 3 ! or a carriage return and then a line feed in the POST1 state.
; 0822 3 !
; 0823 3 [F_STATE_POST ]:
; 0824 4 BEGIN
; 0825 4 SELECTONE .CC_TYPE OF
; 0826 4 SET
; 0827 4 !
; 0828 4 ! This stat is for no carriage control on the record. This is for
; 0829 4 ! 'null' carriage control (VMS manual states: "Null carriage control
; 0830 4 ! (print buffer contents.)" and for prompt carriage control.
; 0831 4 !
; 0832 4 [CHR_NUL, %C'$' ]:
; 0833 5 BEGIN
; 0834 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE
; 0835 4 END;
; 0836 4 !
; 0837 4 ! This is the normal state, that causes the postfix for the data to be
; 0838 4 ! a line feed.
; 0839 4 !
; 0840 4 [%C'0', %C'1', %C' ', %C'+' ]:
; 0841 5 BEGIN
; 0842 5 .CHARACTER = CHR_CRT;
; 0843 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 0844 5 RETURN KER_NORMAL
; 0845 4 END;
; 0846 4 TES;
; 0847 4
; 0848 3 END;
; 0849 3 !
; 0850 3 ! Here if we are in a state that this routine doesn't set. Just assume that
; 0851 3 ! something screwed up and give an illegal file type return to the caller
; 0852 3 !
; 0853 3 [INRANGE, OUTRANGE]:
; 0854 3 RETURN KER_ILLFILTYP;
; 0855 3
; 0856 3 TES
; 0857 2 END;
.PSECT $OWN$,NOEXE,2
;CC_COUNT
U.30: .BLKB 4 ; 00350
;CC_TYPE
U.31: .BLKB 4 ; 00354
.EXTRN KER_ILLFILTYP, KER_NORMAL
.PSECT $CODE$,NOWRT,2
;GET_FTN_FILE_CHARACTER
U.32: .WORD ^M<R2> ;Save R2 0662 0004 00000
MOVAB G^U.10+24, R2 ;U.10+24, R2 52 00000000' 00 9E 00002
1$: CASEL (R2), #0, #4 ;FILE_FAB+24, #0, #4 0696 00 62 CF 00009
; 04 0000C
2$: .WORD 4$-2$,- ;4$-2$,- 008D 0012 0000D
14$-2$,- ;14$-2$,- 00B4 0096 00011
16$-2$,- ;16$-2$,- 000A 00015
18$-2$,- ;18$-2$,-
3$-2$ ;3$-2$
3$: MOVL #KER_ILLFILTYP, R0 ;#KER_ILLFILTYP, R0 0854 50 00000000G 8F D0 00017
RET ; 04 0001E
4$: CALLS #0, G^U.3 ;#0, U.3 0714 00000000V 00 00 FB 0001F
BLBS R0, 5$ ;STATUS, 5$ 0715 01 50 E8 00026
RET ; 04 00029
5$: CMPL R0, #KER_EOF ;STATUS, #KER_EOF 0716 00000000G 8F 50 D1 0002A
BNEQ 6$ ;6$ 01 12 00031
RET ; 04 00033
6$: TSTL 272(R2) ;FILE_REC_COUNT 0722 0110 C2 D5 00034
BGTR 7$ ;7$ 07 14 00038
MOVL #32, 816(R2) ;#32, CC_TYPE 0724 0330 C2 20 D0 0003A
BRB 8$ ;8$ 12 11 0003F
7$: MOVL 268(R2), R0 ;FILE_REC_POINTER, R0 0727 50 010C C2 D0 00041
MOVZBL (R0), 816(R2) ;(R0), CC_TYPE 0330 C2 60 9A 00046
INCL 268(R2) ;FILE_REC_POINTER 010C C2 D6 0004B
DECL 272(R2) ;FILE_REC_COUNT 0728 0110 C2 D7 0004F
8$: MOVL 816(R2), R0 ;CC_TYPE, R0 0733 50 0330 C2 D0 00053
BEQL 9$ ;9$ 0739 05 13 00058
CMPL R0, #43 ;R0, #43 2B 50 D1 0005A
BNEQ 11$ ;11$ 05 12 0005D
9$: MOVL #2, (R2) ;#2, FILE_FAB+24 0741 62 02 D0 0005F
10$: BRB 1$ ;1$ A5 11 00062
11$: CMPL R0, #32 ;R0, #32 0747 20 50 D1 00064
BEQL 14$ ;14$ 31 13 00067
CMPL R0, #36 ;R0, #36 24 50 D1 00069
BEQL 14$ ;14$ 2C 13 0006C
CMPL R0, #48 ;R0, #48 0757 30 50 D1 0006E
BNEQ 12$ ;12$ 09 12 00071
MOVL #10, @4(AP) ;#10, @CHARACTER 0759 04 BC 0A D0 00073
MOVL #1, (R2) ;#1, FILE_FAB+24 0760 62 01 D0 00077
BRB 22$ ;22$ 0761 72 11 0007A
12$: CMPL R0, #49 ;R0, #49 0767 31 50 D1 0007C
BNEQ 13$ ;13$ 06 12 0007F
MOVL #12, @4(AP) ;#12, @CHARACTER 0769 04 BC 0C D0 00081
BRB 15$ ;15$ 0770 17 11 00085
13$: MOVL R0, @4(AP) ;R0, @CHARACTER 0780 04 BC 50 D0 00087
MOVL #32, 816(R2) ;#32, CC_TYPE 0781 0330 C2 20 D0 0008B
DECL 268(R2) ;FILE_REC_POINTER 0782 010C C2 D7 00090
INCL 272(R2) ;FILE_REC_COUNT 0783 0110 C2 D6 00094
BRB 15$ ;15$ 0784 04 11 00098
14$: MOVL #10, @4(AP) ;#10, @CHARACTER 0795 04 BC 0A D0 0009A
15$: MOVL #2, (R2) ;#2, FILE_FAB+24 0796 62 02 D0 0009E
BRB 22$ ;22$ 0797 4B 11 000A1
16$: TSTL 272(R2) ;FILE_REC_COUNT 0808 0110 C2 D5 000A3
BGTR 17$ ;17$ 05 14 000A7
MOVL #3, (R2) ;#3, FILE_FAB+24 0810 62 03 D0 000A9
BRB 10$ ;10$ B4 11 000AC
17$: MOVL 268(R2), R0 ;FILE_REC_POINTER, R0 0813 50 010C C2 D0 000AE
MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 000B3
INCL 268(R2) ;FILE_REC_POINTER 010C C2 D6 000B7
DECL 272(R2) ;FILE_REC_COUNT 0814 0110 C2 D7 000BB
BRB 22$ ;22$ 0815 2D 11 000BF
18$: MOVL 816(R2), R0 ;CC_TYPE, R0 0825 50 0330 C2 D0 000C1
BEQL 19$ ;19$ 0832 05 13 000C6
CMPL R0, #36 ;R0, #36 24 50 D1 000C8
BNEQ 20$ ;20$ 04 12 000CB
19$: CLRL (R2) ;FILE_FAB+24 0834 62 D4 000CD
BRB 10$ ;10$ 91 11 000CF
20$: CMPL R0, #32 ;R0, #32 0840 20 50 D1 000D1
BEQL 21$ ;21$ 12 13 000D4
CMPL R0, #43 ;R0, #43 2B 50 D1 000D6
BEQL 21$ ;21$ 0D 13 000D9
CMPL R0, #48 ;R0, #48 30 50 D1 000DB
BLSS 10$ ;10$ 82 19 000DE
CMPL R0, #49 ;R0, #49 31 50 D1 000E0
BLEQ 21$ ;21$ 03 15 000E3
BRW 1$ ;1$ FF21 31 000E5
21$: MOVL #13, @4(AP) ;#13, @CHARACTER 0842 04 BC 0D D0 000E8
CLRL (R2) ;FILE_FAB+24 0843 62 D4 000EC
22$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 0844 50 00000000G 8F D0 000EE
RET ; 0857 04 000F5
; Routine Size: 246 bytes, Routine Base: $CODE$ + 006B
; 0858 2 %SBTTL 'GET_ASCII - Main logic'
; 0859 2 RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK);
; 0860 2
; 0861 2 IF .DEV_CLASS EQL DC$_MAILBOX THEN RAT = FAB$M_CR; ! Mailbox needs CR's
; 0862 2
; 0863 2 WHILE TRUE DO
; 0864 3 BEGIN
; 0865 3
; 0866 3 SELECTONE .RAT OF
; 0867 3 SET
; 0868 3
; 0869 3 [FAB$M_FTN ]:
; 0870 4 BEGIN
; 0871 4 RETURN GET_FTN_FILE_CHARACTER (.CHARACTER)
; 0872 3 END;
; 0873 3
; 0874 3 [FAB$M_PRN, FAB$M_CR] :
; 0875 3
; 0876 3 CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF
; 0877 3 SET
; 0878 3
; 0879 3 [F_STATE_PRE] :
; 0880 4 BEGIN
; 0881 4 STATUS = GET_BUFFER ();
; 0882 4
; 0883 4 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;
; 0884 4
; 0885 4 SELECTONE .RAT OF
; 0886 4 SET
; 0887 4
; 0888 4 [FAB$M_CR] :
; 0889 5 BEGIN
; 0890 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0891 4 END;
; 0892 4
; 0893 4 [FAB$M_PRN] :
; 0894 5 BEGIN
; 0895 5
; 0896 5 LOCAL
; 0897 5 TEMP_POINTER;
; 0898 5
; 0899 5 TEMP_POINTER = CH$PTR (.FILE_RAB [RAB$L_RHB]);
; 0900 5 CC_COUNT = CH$RCHAR_A (TEMP_POINTER);
; 0901 5 CC_TYPE = CH$RCHAR_A (TEMP_POINTER);
; 0902 5
; 0903 5 IF .CC_COUNT<7, 1> EQL 0
; 0904 5 THEN
; 0905 6 BEGIN
; 0906 6
; 0907 6 IF .CC_COUNT<0, 7> NEQ 0
; 0908 6 THEN
; 0909 7 BEGIN
; 0910 7 .CHARACTER = CHR_LFD;
; 0911 7 CC_COUNT = .CC_COUNT - 1;
; 0912 7
; 0913 7 IF .CC_COUNT GTR 0
; 0914 7 THEN
; 0915 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1
; 0916 7 ELSE
; 0917 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0918 7
; 0919 7 RETURN KER_NORMAL;
; 0920 7 END
; 0921 6 ELSE
; 0922 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0923 6
; 0924 6 END
; 0925 5 ELSE
; 0926 6 BEGIN
; 0927 6
; 0928 6 SELECTONE .CC_COUNT<5, 2> OF
; 0929 6 SET
; 0930 6
; 0931 6 [%B'00'] :
; 0932 7 BEGIN
; 0933 7 .CHARACTER = .CC_COUNT<0, 5>;
; 0934 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0935 7 RETURN KER_NORMAL;
; 0936 6 END;
; 0937 6
; 0938 6 [%B'10'] :
; 0939 7 BEGIN
; 0940 7 .CHARACTER = .CC_COUNT<0, 5> + 128;
; 0941 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0942 7 RETURN KER_NORMAL;
; 0943 6 END;
; 0944 6
; 0945 6 [OTHERWISE, %B'11'] :
; 0946 6 RETURN KER_ILLFILTYP;
; 0947 6 TES;
; 0948 5 END;
; 0949 4 END;
; 0950 4 TES;
; 0951 4
; 0952 3 END;
; 0953 3
; 0954 3 [F_STATE_PRE1] :
; 0955 3
; 0956 3 IF .RAT EQL FAB$M_PRN
; 0957 3 THEN
; 0958 4 BEGIN
; 0959 4 .CHARACTER = CHR_LFD;
; 0960 4 CC_COUNT = .CC_COUNT - 1;
; 0961 4
; 0962 4 IF .CC_COUNT LEQ 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 0963 4
; 0964 4 RETURN KER_NORMAL;
; 0965 4 END
; 0966 3 ELSE
; 0967 3 RETURN KER_ILLFILTYP;
; 0968 3
; 0969 3 [F_STATE_DATA] :
; 0970 4 BEGIN
; 0971 4
; 0972 4 IF .FILE_REC_COUNT LEQ 0
; 0973 4 THEN
; 0974 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST
; 0975 4 ELSE
; 0976 5 BEGIN
; 0977 5 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
; 0978 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1;
; 0979 5 RETURN KER_NORMAL;
; 0980 4 END;
; 0981 4
; 0982 3 END;
; 0983 3
; 0984 3 [F_STATE_POST] :
; 0985 4 BEGIN
; 0986 4
; 0987 4 SELECTONE .RAT OF
; 0988 4 SET
; 0989 4
; 0990 4 [FAB$M_CR] :
; 0991 5 BEGIN
; 0992 5 .CHARACTER = CHR_CRT;
; 0993 5 FILE_FAB [FAB$L_CTX] = F_STATE_POST1;
; 0994 5 ! So we get a line feed
; 0995 5 RETURN KER_NORMAL;
; 0996 4 END;
; 0997 4
; 0998 4
; 0999 4 [FAB$M_PRN] :
; 1000 5 BEGIN
; 1001 5
; 1002 5 IF .CC_TYPE<7, 1> EQL 0
; 1003 5 THEN
; 1004 6 BEGIN
; 1005 6
; 1006 6 IF .CC_TYPE<0, 7> NEQ 0
; 1007 6 THEN
; 1008 7 BEGIN
; 1009 7 .CHARACTER = CHR_LFD;
; 1010 7 CC_COUNT = .CC_TYPE;
; 1011 7 FILE_FAB [FAB$L_CTX] = F_STATE_POST1;
; 1012 7 RETURN KER_NORMAL;
; 1013 7 END
; 1014 6 ELSE
; 1015 6 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1016 6 END
; 1017 5 ELSE
; 1018 6 BEGIN
; 1019 6
; 1020 6 SELECTONE .CC_TYPE<5, 2> OF
; 1021 6 SET
; 1022 6
; 1023 6 [%B'00'] :
; 1024 7 BEGIN
; 1025 7 .CHARACTER = .CC_TYPE<0, 5>;
; 1026 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1027 7 RETURN KER_NORMAL;
; 1028 6 END;
; 1029 6
; 1030 6 [%B'10'] :
; 1031 7 BEGIN
; 1032 7 .CHARACTER = .CC_TYPE<0, 5> + 128;
; 1033 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1034 7 RETURN KER_NORMAL;
; 1035 6 END;
; 1036 6
; 1037 6 [OTHERWISE, %B'11'] :
; 1038 6 RETURN KER_ILLFILTYP;
; 1039 6 TES;
; 1040 6
; 1041 5 END;
; 1042 5
; 1043 4 END;
; 1044 4 TES; ! End SELECTONE .RAT
; 1045 4
; 1046 3 END;
; 1047 3
; 1048 3 [F_STATE_POST1] :
; 1049 3
; 1050 3 IF .RAT EQL FAB$M_PRN
; 1051 3 THEN
; 1052 4 BEGIN
; 1053 4 .CHARACTER = CHR_LFD;
; 1054 4 CC_COUNT = .CC_COUNT - 1;
; 1055 4
; 1056 4 IF .CC_COUNT LEQ -1
; 1057 4 THEN
; 1058 5 BEGIN
; 1059 5 .CHARACTER = CHR_CRT;
; 1060 5 ! FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 1061 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1062 4 END;
; 1063 4
; 1064 4 RETURN KER_NORMAL;
; 1065 4 END
; 1066 3 ELSE
; 1067 3 !
; 1068 3 ! Generate line feed after CR for funny files
; 1069 3 !
; 1070 3
; 1071 4 IF (.RAT EQL FAB$M_CR)
; 1072 3 THEN
; 1073 4 BEGIN
; 1074 4 .CHARACTER = CHR_LFD; ! Return a line feed
; 1075 4 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1076 4 ! Next we get data
; 1077 4 RETURN KER_NORMAL;
; 1078 4 END
; 1079 3 ELSE
; 1080 3 RETURN KER_ILLFILTYP;
; 1081 3
; 1082 3 TES; ! End of CASE .STATE
; 1083 3
; 1084 3 [OTHERWISE] :
; 1085 4 BEGIN
; 1086 4
; 1087 4 WHILE .FILE_REC_COUNT LEQ 0 DO
; 1088 5 BEGIN
; 1089 5 STATUS = GET_BUFFER ();
; 1090 5
; 1091 5 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;
; 1092 5
; 1093 4 END;
; 1094 4
; 1095 4 FILE_REC_COUNT = .FILE_REC_COUNT - 1;
; 1096 4 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
; 1097 4 RETURN KER_NORMAL;
; 1098 3 END;
; 1099 3 TES; ! End of SELECTONE .RAT
; 1100 3
; 1101 2 END; ! End WHILE TRUE DO loop
; 1102 2
; 1103 2 RETURN KER_ILLFILTYP; ! Shouldn't get here
; 1104 1 END; ! End of GET_ASCII
;GET_ASCII
U.4: .WORD ^M<R2,R3,R4,R5,R6> ;Save R2,R3,R4,R5,R6 0610 007C 00000
MOVL #KER_EOF, R6 ;#KER_EOF, R6 56 00000000G 8F D0 00002
MOVAB G^U.3, R5 ;U.3, R5 55 00000000V 00 9E 00009
MOVAB G^U.30, R4 ;U.30, R4 54 00000000' 00 9E 00010
MOVZBL -806(R4), R2 ;FILE_FAB+30, RAT 0859 52 FCDA C4 9A 00017
BICL2 #8, R2 ;#8, RAT 52 08 CA 0001C
CMPL -844(R4), #160 ;DEV_CLASS, #160 0861 000000A0 8F FCB4 C4 D1 0001F
BNEQ 1$ ;1$ 03 12 00028
MOVL #2, R2 ;#2, RAT 52 02 D0 0002A
1$: CMPL R2, #1 ;RAT, #1 0869 01 52 D1 0002D
BNEQ 2$ ;2$ 09 12 00030
PUSHL 4(AP) ;CHARACTER 0871 04 AC DD 00032
CALLS #1, W^U.32 ;#1, U.32 FED0 CF 01 FB 00035
RET ; 04 0003A
2$: CMPL R2, #2 ;RAT, #2 0874 02 52 D1 0003B
BEQL 3$ ;3$ 08 13 0003E
CMPL R2, #4 ;RAT, #4 04 52 D1 00040
BEQL 3$ ;3$ 03 13 00043
BRW 31$ ;31$ 0128 31 00045
3$: CASEL -812(R4), #0, #4 ;FILE_FAB+24, #0, #4 0876 00 FCD4 C4 CF 00048
; 04 0004D
4$: .WORD 5$-4$,- ;5$-4$,- 0075 000A 0004E
12$-4$,- ;12$-4$,- 00A8 0088 00052
15$-4$,- ;15$-4$,- 0101 00056
18$-4$,- ;18$-4$,-
27$-4$ ;27$-4$
5$: CALLS #0, (R5) ;#0, GET_BUFFER 0881 65 00 FB 00058
MOVL R0, R3 ;R0, STATUS 53 50 D0 0005B
BLBS R3, 7$ ;STATUS, 7$ 0883 03 53 E8 0005E
6$: BRW 32$ ;32$ 0120 31 00061
7$: CMPL R3, R6 ;STATUS, R6 56 53 D1 00064
BEQL 6$ ;6$ F8 13 00067
CMPL R2, #2 ;RAT, #2 0888 02 52 D1 00069
BEQL 8$ ;8$ 2A 13 0006C
CMPL R2, #4 ;RAT, #4 0893 04 52 D1 0006E
BNEQ 1$ ;1$ BA 12 00071
MOVL -616(R4), R0 ;FILE_RAB+44, TEMP_POINTER 0899 50 FD98 C4 D0 00073
MOVZBL (R0)+, (R4) ;(TEMP_POINTER)+, CC_COUNT 0900 64 80 9A 00078
MOVZBL (R0)+, 4(R4) ;(TEMP_POINTER)+, CC_TYPE 0901 04 A4 80 9A 0007B
TSTB (R4) ;CC_COUNT 0903 64 95 0007F
BLSS 10$ ;10$ 1C 19 00081
BITB (R4), #127 ;CC_COUNT, #127 0907 7F 8F 64 93 00083
BEQL 8$ ;8$ 0F 13 00087
MOVL #10, @4(AP) ;#10, @CHARACTER 0910 04 BC 0A D0 00089
DECL (R4) ;CC_COUNT 0911 64 D7 0008D
BLEQ 14$ ;14$ 0913 3E 15 0008F
MOVL #1, -812(R4) ;#1, FILE_FAB+24 0915 FCD4 C4 01 D0 00091
BRB 17$ ;17$ 5C 11 00096
8$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 0922 FCD4 C4 02 D0 00098
9$: BRB 1$ ;1$ 8E 11 0009D
10$: EXTZV #5, #2, (R4), R0 ;#5, #2, CC_COUNT, R0 0928 02 05 EF 0009F
; 50 64 000A2
BNEQ 11$ ;11$ 0931 08 12 000A4
EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER 0933 05 00 EF 000A6
; 04 BC 64 000A9
BRB 14$ ;14$ 0934 21 11 000AC
11$: CMPL R0, #2 ;R0, #2 0938 02 50 D1 000AE
BNEQ 13$ ;13$ 13 12 000B1
EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER 0940 05 00 EF 000B3
; 04 BC 64 000B6
ADDL2 #128, @4(AP) ;#128, @CHARACTER 04 BC 00000080 8F C0 000B9
BRB 14$ ;14$ 0941 0C 11 000C1
12$: CMPL R2, #4 ;RAT, #4 0956 04 52 D1 000C3
13$: BNEQ 26$ ;26$ 74 12 000C6
MOVL #10, @4(AP) ;#10, @CHARACTER 0959 04 BC 0A D0 000C8
SOBGTR (R4), 21$ ;CC_COUNT, 21$ 0960 50 64 F5 000CC
14$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 0962 FCD4 C4 02 D0 000CF
BRB 21$ ;21$ 0964 49 11 000D4
15$: TSTL -540(R4) ;FILE_REC_COUNT 0972 FDE4 C4 D5 000D6
BGTR 16$ ;16$ 07 14 000DA
MOVL #3, -812(R4) ;#3, FILE_FAB+24 0974 FCD4 C4 03 D0 000DC
BRB 23$ ;23$ 42 11 000E1
16$: MOVL -544(R4), R0 ;FILE_REC_POINTER, R0 0977 50 FDE0 C4 D0 000E3
MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 000E8
INCL -544(R4) ;FILE_REC_POINTER FDE0 C4 D6 000EC
DECL -540(R4) ;FILE_REC_COUNT 0978 FDE4 C4 D7 000F0
17$: BRB 30$ ;30$ 0979 78 11 000F4
18$: CMPL R2, #2 ;RAT, #2 0990 02 52 D1 000F6
BNEQ 19$ ;19$ 06 12 000F9
MOVL #13, @4(AP) ;#13, @CHARACTER 0992 04 BC 0D D0 000FB
BRB 20$ ;20$ 0993 19 11 000FF
19$: CMPL R2, #4 ;RAT, #4 0999 04 52 D1 00101
BNEQ 9$ ;9$ 97 12 00104
TSTB 4(R4) ;CC_TYPE 1002 04 A4 95 00106
BLSS 24$ ;24$ 1D 19 00109
BITB 4(R4), #127 ;CC_TYPE, #127 1006 7F 8F 04 A4 93 0010B
BEQL 22$ ;22$ 0F 13 00110
MOVL #10, @4(AP) ;#10, @CHARACTER 1009 04 BC 0A D0 00112
MOVL 4(R4), (R4) ;CC_TYPE, CC_COUNT 1010 64 04 A4 D0 00116
20$: MOVL #4, -812(R4) ;#4, FILE_FAB+24 1011 FCD4 C4 04 D0 0011A
21$: BRB 34$ ;34$ 1012 78 11 0011F
22$: CLRL -812(R4) ;FILE_FAB+24 1015 FCD4 C4 D4 00121
23$: BRW 1$ ;1$ FF05 31 00125
24$: EXTZV #5, #2, 4(R4), R0 ;#5, #2, CC_TYPE, R0 1020 02 05 EF 00128
; 50 04 A4 0012B
BNEQ 25$ ;25$ 1023 09 12 0012E
EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER 1025 05 00 EF 00130
; 04 BC 04 A4 00133
BRB 29$ ;29$ 1026 31 11 00137
25$: CMPL R0, #2 ;R0, #2 1030 02 50 D1 00139
26$: BNEQ 35$ ;35$ 63 12 0013C
EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER 1032 05 00 EF 0013E
; 04 BC 04 A4 00141
ADDL2 #128, @4(AP) ;#128, @CHARACTER 04 BC 00000080 8F C0 00145
BRB 29$ ;29$ 1033 1B 11 0014D
27$: CMPL R2, #4 ;RAT, #4 1050 04 52 D1 0014F
BNEQ 28$ ;28$ 0D 12 00152
MOVL #10, @4(AP) ;#10, @CHARACTER 1053 04 BC 0A D0 00154
SOBGEQ (R4), 34$ ;CC_COUNT, 34$ 1054 3E 64 F4 00158
MOVL #13, @4(AP) ;#13, @CHARACTER 1059 04 BC 0D D0 0015B
BRB 29$ ;29$ 1061 09 11 0015F
28$: CMPL R2, #2 ;RAT, #2 1071 02 52 D1 00161
BNEQ 35$ ;35$ 3B 12 00164
MOVL #10, @4(AP) ;#10, @CHARACTER 1074 04 BC 0A D0 00166
29$: CLRL -812(R4) ;FILE_FAB+24 1075 FCD4 C4 D4 0016A
30$: BRB 34$ ;34$ 1077 29 11 0016E
31$: TSTL -540(R4) ;FILE_REC_COUNT 1087 FDE4 C4 D5 00170
BGTR 33$ ;33$ 12 14 00174
CALLS #0, (R5) ;#0, GET_BUFFER 1089 65 00 FB 00176
MOVL R0, R3 ;R0, STATUS 53 50 D0 00179
BLBC R3, 32$ ;STATUS, 32$ 1091 05 53 E9 0017C
CMPL R3, R6 ;STATUS, R6 56 53 D1 0017F
BNEQ 31$ ;31$ EC 12 00182
32$: MOVL R3, R0 ;STATUS, R0 50 53 D0 00184
RET ; 04 00187
33$: DECL -540(R4) ;FILE_REC_COUNT 1095 FDE4 C4 D7 00188
MOVL -544(R4), R0 ;FILE_REC_POINTER, R0 1096 50 FDE0 C4 D0 0018C
MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 00191
INCL -544(R4) ;FILE_REC_POINTER FDE0 C4 D6 00195
34$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1097 50 00000000G 8F D0 00199
RET ; 04 001A0
35$: MOVL #KER_ILLFILTYP, R0 ;#KER_ILLFILTYP, R0 1103 50 00000000G 8F D0 001A1
RET ; 04 001A8
; Routine Size: 425 bytes, Routine Base: $CODE$ + 0161
; 1105 1 %SBTTL 'GET_BLOCK - Get a character from a BLOCKed file'
; 1106 1 ROUTINE GET_BLOCK (CHARACTER) =
; 1107 1
; 1108 1 !++
; 1109 1 ! FUNCTIONAL DESCRIPTION:
; 1110 1 !
; 1111 1 ! This routine will return the next byte from a blocked file. This
; 1112 1 ! routine will use the $READ RMS call to get the next byte from the
; 1113 1 ! file. This way all RMS header information can be passed to the
; 1114 1 ! other file system.
; 1115 1 !
; 1116 1 ! CALLING SEQUENCE:
; 1117 1 !
; 1118 1 ! STATUS = GET_BLOCK(CHARACTER);
; 1119 1 !
; 1120 1 ! INPUT PARAMETERS:
; 1121 1 !
; 1122 1 ! CHARACTER - Address to store the character in.
; 1123 1 !
; 1124 1 ! IMPLICIT INPUTS:
; 1125 1 !
; 1126 1 ! REC_POINTER - Pointer into the record.
; 1127 1 ! REC_ADDRESS - Address of the record.
; 1128 1 ! REC_COUNT - Count of the number of bytes left in the record.
; 1129 1 !
; 1130 1 ! OUPTUT PARAMETERS:
; 1131 1 !
; 1132 1 ! None.
; 1133 1 !
; 1134 1 ! IMPLICIT OUTPUTS:
; 1135 1 !
; 1136 1 ! None.
; 1137 1 !
; 1138 1 ! COMPLETION CODES:
; 1139 1 !
; 1140 1 ! KER_NORMAL - Got a byte
; 1141 1 ! KER_EOF - End of file gotten.
; 1142 1 ! KER_RMS32 - RMS error
; 1143 1 !
; 1144 1 ! SIDE EFFECTS:
; 1145 1 !
; 1146 1 ! None.
; 1147 1 !
; 1148 1 !--
; 1149 1
; 1150 2 BEGIN
; 1151 2 !
; 1152 2 ! Status codes returned by this module
; 1153 2 !
; 1154 2 EXTERNAL LITERAL
; 1155 2 KER_RMS32, ! RMS error encountered
; 1156 2 KER_EOF, ! End of file encountered
; 1157 2 KER_NORMAL; ! Normal return
; 1158 2
; 1159 2 LOCAL
; 1160 2 STATUS; ! Random status values
; 1161 2
; 1162 2 WHILE .FILE_REC_COUNT LEQ 0 DO
; 1163 3 BEGIN
; 1164 3 STATUS = $READ (RAB = FILE_RAB);
; 1165 3
; 1166 3 IF NOT .STATUS
; 1167 3 THEN
; 1168 3
; 1169 3 IF .STATUS EQL RMS$_EOF
; 1170 3 THEN
; 1171 4 BEGIN
; 1172 4 EOF_FLAG = TRUE;
; 1173 4 RETURN KER_EOF;
; 1174 4 END
; 1175 3 ELSE
; 1176 4 BEGIN
; 1177 4 FILE_ERROR (.STATUS);
; 1178 4 EOF_FLAG = TRUE;
; 1179 4 RETURN KER_RMS32;
; 1180 3 END;
; 1181 3
; 1182 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
; 1183 3 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
; 1184 2 END;
; 1185 2
; 1186 2 FILE_REC_COUNT = .FILE_REC_COUNT - 1;
; 1187 2 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
; 1188 2 RETURN KER_NORMAL;
; 1189 1 END; ! End of GET_BLOCK
.EXTRN KER_RMS32, SYS$READ
;GET_BLOCK
U.5: .WORD ^M<R2,R3> ;Save R2,R3 1106 000C 00000
MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 00002
1$: TSTL (R3) ;FILE_REC_COUNT 1162 63 D5 00009
BGTR 5$ ;5$ 43 14 0000B
PUSHAB -120(R3) ;FILE_RAB 1164 88 A3 9F 0000D
CALLS #1, G^SYS$READ ;#1, SYS$READ 00000000G 00 01 FB 00010
MOVL R0, R2 ;R0, STATUS 52 50 D0 00017
BLBS R2, 4$ ;STATUS, 4$ 1166 28 52 E8 0001A
CMPL R2, #98938 ;STATUS, #98938 1169 0001827A 8F 52 D1 0001D
BNEQ 2$ ;2$ 09 12 00024
MOVL #KER_EOF, R0 ;#KER_EOF, R0 1173 50 00000000G 8F D0 00026
BRB 3$ ;3$ 10 11 0002D
2$: PUSHL R2 ;STATUS 1177 52 DD 0002F
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00031
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1179 50 00000000G 8F D0 00038
3$: MOVL #1, -300(R3) ;#1, EOF_FLAG 1172 FED4 C3 01 D0 0003F
RET ; 1179 04 00044
4$: MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER 1182 FC A3 08 A3 D0 00045
MOVZWL -86(R3), (R3) ;FILE_RAB+34, FILE_REC_COUNT 1183 63 AA A3 3C 0004A
BRB 1$ ;1$ B9 11 0004E
5$: DECL (R3) ;FILE_REC_COUNT 1186 63 D7 00050
MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1187 50 FC A3 D0 00052
MOVZBL (R0), @4(AP) ;(R0), @CHARACTER 04 BC 60 9A 00056
INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 0005A
MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1188 50 00000000G 8F D0 0005D
RET ; 04 00064
; Routine Size: 101 bytes, Routine Base: $CODE$ + 030A
; 1190 1 %SBTTL 'GET_BUFFER - Routine to read a buffer.'
; 1191 1 ROUTINE GET_BUFFER =
; 1192 1
; 1193 1 !++
; 1194 1 ! FUNCTIONAL DESCRIPTION:
; 1195 1 !
; 1196 1 ! This routine will read a buffer from the disk file. It will
; 1197 1 ! return various status depending if there was an error reading
; 1198 1 ! the disk file or if the end of file is reached.
; 1199 1 !
; 1200 1 ! CALLING SEQUENCE:
; 1201 1 !
; 1202 1 ! STATUS = GET_BUFFER ();
; 1203 1 !
; 1204 1 ! INPUT PARAMETERS:
; 1205 1 !
; 1206 1 ! None.
; 1207 1 !
; 1208 1 ! IMPLICIT INPUTS:
; 1209 1 !
; 1210 1 ! None.
; 1211 1 !
; 1212 1 ! OUTPUT PARAMETERS:
; 1213 1 !
; 1214 1 ! None.
; 1215 1 !
; 1216 1 ! IMPLICIT OUTPUTS:
; 1217 1 !
; 1218 1 ! FILE_REC_POINTER - Pointer into the record.
; 1219 1 ! FILE_REC_COUNT - Count of the number of bytes in the record.
; 1220 1 !
; 1221 1 ! COMPLETION CODES:
; 1222 1 !
; 1223 1 ! KER_NORMAL - Got a buffer
; 1224 1 ! KER_EOF - End of file reached.
; 1225 1 ! KER_RMS32 - RMS error
; 1226 1 !
; 1227 1 ! SIDE EFFECTS:
; 1228 1 !
; 1229 1 ! None.
; 1230 1 !
; 1231 1 !--
; 1232 1
; 1233 2 BEGIN
; 1234 2 !
; 1235 2 ! The following are the various status values returned by this routien
; 1236 2 !
; 1237 2 EXTERNAL LITERAL
; 1238 2 KER_NORMAL, ! Normal return
; 1239 2 KER_EOF, ! End of file
; 1240 2 KER_RMS32; ! RMS error encountered
; 1241 2
; 1242 2 LOCAL
; 1243 2 STATUS; ! Random status values
; 1244 2
; 1245 2 STATUS = $GET (RAB = FILE_RAB);
; 1246 2
; 1247 2 IF NOT .STATUS
; 1248 2 THEN
; 1249 2
; 1250 2 IF .STATUS EQL RMS$_EOF
; 1251 2 THEN
; 1252 3 BEGIN
; 1253 3 EOF_FLAG = TRUE;
; 1254 3 RETURN KER_EOF;
; 1255 3 END
; 1256 2 ELSE
; 1257 3 BEGIN
; 1258 3 FILE_ERROR (.STATUS);
; 1259 3 EOF_FLAG = TRUE;
; 1260 3 RETURN KER_RMS32;
; 1261 2 END;
; 1262 2
; 1263 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
; 1264 2 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
; 1265 2 RETURN KER_NORMAL;
; 1266 1 END;
.EXTRN SYS$GET
;GET_BUFFER
U.3: .WORD ^M<R2> ;Save R2 1191 0004 00000
MOVAB G^U.12, R2 ;U.12, R2 52 00000000' 00 9E 00002
PUSHL R2 ;R2 1245 52 DD 00009
CALLS #1, G^SYS$GET ;#1, SYS$GET 00000000G 00 01 FB 0000B
BLBS R0, 3$ ;STATUS, 3$ 1247 28 50 E8 00012
CMPL R0, #98938 ;STATUS, #98938 1250 0001827A 8F 50 D1 00015
BNEQ 1$ ;1$ 09 12 0001C
MOVL #KER_EOF, R0 ;#KER_EOF, R0 1254 50 00000000G 8F D0 0001E
BRB 2$ ;2$ 10 11 00025
1$: PUSHL R0 ;STATUS 1258 50 DD 00027
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00029
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1260 50 00000000G 8F D0 00030
2$: MOVL #1, -180(R2) ;#1, EOF_FLAG 1253 FF4C C2 01 D0 00037
RET ; 1260 04 0003C
3$: MOVL 128(R2), 116(R2) ;REC_ADDRESS, FILE_REC_POINTER 1263 74 A2 0080 C2 D0 0003D
MOVZWL 34(R2), 120(R2) ;FILE_RAB+34, FILE_REC_COUNT 1264 78 A2 22 A2 3C 00043
MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1265 50 00000000G 8F D0 00048
RET ; 04 0004F
; Routine Size: 80 bytes, Routine Base: $CODE$ + 036F
; 1267 1 %SBTTL 'PUT_FILE'
; 1268 1
; 1269 1 GLOBAL ROUTINE PUT_FILE (CHARACTER) =
; 1270 1
; 1271 1 !++
; 1272 1 ! FUNCTIONAL DESCRIPTION:
; 1273 1 !
; 1274 1 ! This routine will store a character into the record buffer
; 1275 1 ! that we are building. It will output the buffer to disk
; 1276 1 ! when the end of line characters are found.
; 1277 1 !
; 1278 1 ! CALLING SEQUENCE:
; 1279 1 !
; 1280 1 ! STATUS = PUT_FILE(Character);
; 1281 1 !
; 1282 1 ! INPUT PARAMETERS:
; 1283 1 !
; 1284 1 ! Character - Address of the character to output in the file.
; 1285 1 !
; 1286 1 ! IMPLICIT INPUTS:
; 1287 1 !
; 1288 1 ! None.
; 1289 1 !
; 1290 1 ! OUTPUT PARAMETERS:
; 1291 1 !
; 1292 1 ! Status - True if no problems writing the character
; 1293 1 ! False if there were problems writing the character.
; 1294 1 !
; 1295 1 ! IMPLICIT OUTPUTS:
; 1296 1 !
; 1297 1 ! None.
; 1298 1 !
; 1299 1 ! COMPLETION CODES:
; 1300 1 !
; 1301 1 ! None.
; 1302 1 !
; 1303 1 ! SIDE EFFECTS:
; 1304 1 !
; 1305 1 ! None.
; 1306 1 !
; 1307 1 !--
; 1308 1
; 1309 2 BEGIN
; 1310 2 !
; 1311 2 ! Completion codes
; 1312 2 !
; 1313 2 EXTERNAL LITERAL
; 1314 2 KER_REC_TOO_BIG, ! Record too big
; 1315 2 KER_NORMAL; ! Normal return
; 1316 2 !
; 1317 2 ! Local variables
; 1318 2 !
; 1319 2 OWN
; 1320 2 SAVED_CHARACTER : UNSIGNED BYTE; ! Character we may have to
; 1321 2 ! write later on
; 1322 2 LOCAL
; 1323 2 STATUS; ! Random status values
; 1324 2
; 1325 2 SELECTONE .FILE_TYPE OF
; 1326 2 SET
; 1327 2
; 1328 2 [FILE_ASC] :
; 1329 3 BEGIN
; 1330 3 !
; 1331 3 ! If the last character was a carriage return and this is a line feed,
; 1332 3 ! we will just dump the record. Otherwise, if the last character was
; 1333 3 ! a carriage return, output both it and the current one.
; 1334 3 !
; 1335 3
; 1336 3 IF .FILE_FAB [FAB$L_CTX] NEQ F_STATE_DATA
; 1337 3 THEN
; 1338 4 BEGIN
; 1339 4
; 1340 4 IF (.CHARACTER AND %O'177') EQL CHR_LFD
; 1341 4 THEN
; 1342 5 BEGIN
; 1343 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 1344 5 RETURN DUMP_BUFFER ();
; 1345 5 END
; 1346 4 ELSE
; 1347 5 BEGIN
; 1348 5
; 1349 5 IF .FILE_REC_COUNT GEQ .REC_SIZE
; 1350 5 THEN
; 1351 6 BEGIN
; 1352 6 LIB$SIGNAL (KER_REC_TOO_BIG);
; 1353 6 RETURN KER_REC_TOO_BIG;
; 1354 5 END;
; 1355 5
; 1356 5 CH$WCHAR_A (.SAVED_CHARACTER, FILE_REC_POINTER);
; 1357 5 ! Store the carriage return we deferred
; 1358 5 FILE_REC_COUNT = .FILE_REC_COUNT + 1;
; 1359 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ! Back to normal data
; 1360 4 END;
; 1361 4
; 1362 3 END;
; 1363 3
; 1364 3 !
; 1365 3 ! Here when last character was written to the file normally. Check if
; 1366 3 ! this character might be the end of a record (or at least the start of
; 1367 3 ! end.
; 1368 3 !
; 1369 3
; 1370 3 IF (.CHARACTER AND %O'177') EQL CHR_CRT
; 1371 3 THEN
; 1372 4 BEGIN
; 1373 4 SAVED_CHARACTER = .CHARACTER; ! Save the character for later
; 1374 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST; ! Remember we saw this
; 1375 4 RETURN KER_NORMAL; ! And delay until next character
; 1376 3 END;
; 1377 3
; 1378 3 IF .FILE_REC_COUNT GEQ .REC_SIZE
; 1379 3 THEN
; 1380 4 BEGIN
; 1381 4 LIB$SIGNAL (KER_REC_TOO_BIG);
; 1382 4 RETURN KER_REC_TOO_BIG;
; 1383 3 END;
; 1384 3
; 1385 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1;
; 1386 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
; 1387 2 END;
; 1388 2
; 1389 2 [FILE_BIN, FILE_FIX] :
; 1390 3 BEGIN
; 1391 3
; 1392 3 IF .FILE_REC_COUNT GEQ .REC_SIZE
; 1393 3 THEN
; 1394 4 BEGIN
; 1395 4 STATUS = DUMP_BUFFER ();
; 1396 4
; 1397 4 IF NOT .STATUS
; 1398 4 THEN
; 1399 5 BEGIN
; 1400 5 LIB$SIGNAL (.STATUS);
; 1401 5 RETURN .STATUS;
; 1402 4 END;
; 1403 4
; 1404 3 END;
; 1405 3
; 1406 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1;
; 1407 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
; 1408 2 END;
; 1409 2
; 1410 2 [FILE_BLK] :
; 1411 3 BEGIN
; 1412 3
; 1413 3 IF .FILE_REC_COUNT GEQ .REC_SIZE
; 1414 3 THEN
; 1415 4 BEGIN
; 1416 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
; 1417 4 STATUS = $WRITE (RAB = FILE_RAB);
; 1418 4 FILE_REC_COUNT = 0;
; 1419 4 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
; 1420 3 END;
; 1421 3
; 1422 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1;
; 1423 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
; 1424 2 END;
; 1425 2 TES;
; 1426 2
; 1427 2 RETURN KER_NORMAL;
; 1428 1 END; ! End of PUT_FILE
.PSECT $OWN$,NOEXE,2
;SAVED_CHARACTER
U.34: .BLKB 1 ; 00358
.EXTRN KER_REC_TOO_BIG, SYS$WRITE
.PSECT $CODE$,NOWRT,2
.ENTRY PUT_FILE, ^M<R2,R3,R4,R5,R6> ;PUT_FILE, Save R2,R3,R4,R5,R6 1269 007C 00000
MOVAB G^LIB$SIGNAL, R6 ;LIB$SIGNAL, R6 56 00000000G 00 9E 00002
MOVL #KER_REC_TOO_BIG, R5 ;#KER_REC_TOO_BIG, R5 55 00000000G 8F D0 00009
MOVAB G^U.2, R4 ;U.2, R4 54 00000000V 00 9E 00010
MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 00017
MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 1325 50 00000000' 00 D0 0001E
CMPL R0, #1 ;R0, #1 1328 01 50 D1 00025
BNEQ 5$ ;5$ 55 12 00028
CMPL -272(R3), #2 ;FILE_FAB+24, #2 1336 02 FEF0 C3 D1 0002A
BEQL 2$ ;2$ 2A 13 0002F
CMPZV #0, #7, 4(AP), #10 ;#0, #7, CHARACTER, #10 1340 07 00 ED 00031
; 0A 04 AC 00034
BNEQ 1$ ;1$ 09 12 00037
MOVL #2, -272(R3) ;#2, FILE_FAB+24 1343 FEF0 C3 02 D0 00039
CALLS #0, (R4) ;#0, DUMP_BUFFER 1344 64 00 FB 0003E
RET ; 04 00041
1$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1349 04 A3 63 D1 00042
BGEQ 4$ ;4$ 2E 18 00046
MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1356 50 FC A3 D0 00048
MOVB 548(R3), (R0) ;SAVED_CHARACTER, (R0) 60 0224 C3 90 0004C
INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 00051
INCL (R3) ;FILE_REC_COUNT 1358 63 D6 00054
MOVL #2, -272(R3) ;#2, FILE_FAB+24 1359 FEF0 C3 02 D0 00056
2$: CMPZV #0, #7, 4(AP), #13 ;#0, #7, CHARACTER, #13 1370 07 00 ED 0005B
; 0D 04 AC 0005E
BNEQ 3$ ;3$ 0D 12 00061
MOVB 4(AP), 548(R3) ;CHARACTER, SAVED_CHARACTER 1373 0224 C3 04 AC 90 00063
MOVL #3, -272(R3) ;#3, FILE_FAB+24 1374 FEF0 C3 03 D0 00069
BRB 9$ ;9$ 1375 64 11 0006E
3$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1378 04 A3 63 D1 00070
BLSS 8$ ;8$ 51 19 00074
4$: PUSHL R5 ;R5 1381 55 DD 00076
CALLS #1, (R6) ;#1, LIB$SIGNAL 66 01 FB 00078
MOVL R5, R0 ;R5, R0 1382 50 55 D0 0007B
RET ; 04 0007E
5$: CMPL R0, #2 ;R0, #2 1389 02 50 D1 0007F
BEQL 6$ ;6$ 05 13 00082
CMPL R0, #4 ;R0, #4 04 50 D1 00084
BNEQ 7$ ;7$ 18 12 00087
6$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE 1392 04 A3 63 D1 00089
BLSS 8$ ;8$ 38 19 0008D
CALLS #0, (R4) ;#0, DUMP_BUFFER 1395 64 00 FB 0008F
MOVL R0, R2 ;R0, STATUS 52 50 D0 00092
BLBS R2, 8$ ;STATUS, 8$ 1397 2F 52 E8 00095
PUSHL R2 ;STATUS 1400 52 DD 00098
CALLS #1, (R6) ;#1, LIB$SIGNAL 66 01 FB 0009A
MOVL R2, R0 ;STATUS, R0 1401 50 52 D0 0009D
RET ; 04 000A0
7$: CMPL R0, #3 ;R0, #3 1410 03 50 D1 000A1
BNEQ 9$ ;9$ 2E 12 000A4
MOVL (R3), R0 ;FILE_REC_COUNT, R0 1413 50 63 D0 000A6
CMPL R0, 4(R3) ;R0, REC_SIZE 04 A3 50 D1 000A9
BLSS 8$ ;8$ 18 19 000AD
MOVW R0, -86(R3) ;R0, FILE_RAB+34 1416 AA A3 50 B0 000AF
PUSHAB -120(R3) ;FILE_RAB 1417 88 A3 9F 000B3
CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE 00000000G 00 01 FB 000B6
MOVL R0, R2 ;R0, STATUS 52 50 D0 000BD
CLRL (R3) ;FILE_REC_COUNT 1418 63 D4 000C0
MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER 1419 FC A3 08 A3 D0 000C2
8$: INCL (R3) ;FILE_REC_COUNT 1422 63 D6 000C7
MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 1423 50 FC A3 D0 000C9
MOVB 4(AP), (R0) ;CHARACTER, (R0) 60 04 AC 90 000CD
INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 000D1
9$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1427 50 00000000G 8F D0 000D4
RET ; 04 000DB
; Routine Size: 220 bytes, Routine Base: $CODE$ + 03BF
; 1429 1
; 1430 1 %SBTTL 'DUMP_BUFFER - Dump the current record to disk'
; 1431 1 ROUTINE DUMP_BUFFER =
; 1432 1
; 1433 1 !++
; 1434 1 ! FUNCTIONAL DESCRIPTION:
; 1435 1 !
; 1436 1 ! This routine will dump the current record to disk. It doesn't
; 1437 1 ! care what type of file you are writing, unlike FILE_DUMP.
; 1438 1 !
; 1439 1 ! CALLING SEQUENCE:
; 1440 1 !
; 1441 1 ! STATUS = DUMP_BUFFER();
; 1442 1 !
; 1443 1 ! INPUT PARAMETERS:
; 1444 1 !
; 1445 1 ! None.
; 1446 1 !
; 1447 1 ! IMPLICIT INPUTS:
; 1448 1 !
; 1449 1 ! None.
; 1450 1 !
; 1451 1 ! OUTPUT PARAMETERS:
; 1452 1 !
; 1453 1 ! None.
; 1454 1 !
; 1455 1 ! IMPLICIT OUTPUTS:
; 1456 1 !
; 1457 1 ! None.
; 1458 1 !
; 1459 1 ! COMPLETION CODES:
; 1460 1 !
; 1461 1 ! KER_NORMAL - Output went ok.
; 1462 1 ! KER_RMS32 - RMS-32 error.
; 1463 1 !
; 1464 1 ! SIDE EFFECTS:
; 1465 1 !
; 1466 1 ! None.
; 1467 1 !
; 1468 1 !--
; 1469 1
; 1470 2 BEGIN
; 1471 2 !
; 1472 2 ! Completion codes returned:
; 1473 2 !
; 1474 2 EXTERNAL LITERAL
; 1475 2 KER_NORMAL, ! Normal return
; 1476 2 KER_RMS32; ! RMS-32 error
; 1477 2 !
; 1478 2 ! Local variables
; 1479 2 !
; 1480 2 LOCAL
; 1481 2 STATUS; ! Random status values
; 1482 2
; 1483 2 !
; 1484 2 ! First update the record length
; 1485 2 !
; 1486 2 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
; 1487 2 !
; 1488 2 ! Now output the record to the file
; 1489 2 !
; 1490 2 STATUS = $PUT (RAB = FILE_RAB);
; 1491 2 !
; 1492 2 ! Update the pointers first
; 1493 2 !
; 1494 2 FILE_REC_COUNT = 0;
; 1495 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
; 1496 2 !
; 1497 2 ! Now determine if we failed attempting to write the record
; 1498 2 !
; 1499 2
; 1500 2 IF NOT .STATUS
; 1501 2 THEN
; 1502 3 BEGIN
; 1503 3 FILE_ERROR (.STATUS);
; 1504 3 RETURN KER_RMS32
; 1505 2 END;
; 1506 2
; 1507 2 RETURN KER_NORMAL
; 1508 1 END; ! End of DUMP_BUFFER
.EXTRN SYS$PUT
;DUMP_BUFFER
U.2: .WORD ^M<R2> ;Save R2 1431 0004 00000
MOVAB G^U.16, R2 ;U.16, R2 52 00000000' 00 9E 00002
MOVW (R2), -86(R2) ;FILE_REC_COUNT, FILE_RAB+34 1486 AA A2 62 B0 00009
PUSHAB -120(R2) ;FILE_RAB 1490 88 A2 9F 0000D
CALLS #1, G^SYS$PUT ;#1, SYS$PUT 00000000G 00 01 FB 00010
CLRL (R2) ;FILE_REC_COUNT 1494 62 D4 00017
MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER 1495 FC A2 08 A2 D0 00019
BLBS R0, 1$ ;STATUS, 1$ 1500 11 50 E8 0001E
PUSHL R0 ;STATUS 1503 50 DD 00021
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00023
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1504 50 00000000G 8F D0 0002A
RET ; 04 00031
1$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1507 50 00000000G 8F D0 00032
RET ; 04 00039
; Routine Size: 58 bytes, Routine Base: $CODE$ + 049B
; 1509 1 %SBTTL 'OPEN_READING'
; 1510 1 ROUTINE OPEN_READING =
; 1511 1
; 1512 1 !++
; 1513 1 ! FUNCTIONAL DESCRIPTION:
; 1514 1 !
; 1515 1 ! This routine will open a file for reading. It will return either
; 1516 1 ! true or false to the called depending on the success of the
; 1517 1 ! operation.
; 1518 1 !
; 1519 1 ! CALLING SEQUENCE:
; 1520 1 !
; 1521 1 ! status = OPEN_READING();
; 1522 1 !
; 1523 1 ! INPUT PARAMETERS:
; 1524 1 !
; 1525 1 ! None.
; 1526 1 !
; 1527 1 ! IMPLICIT INPUTS:
; 1528 1 !
; 1529 1 ! None.
; 1530 1 !
; 1531 1 ! OUTPUT PARAMETERS:
; 1532 1 !
; 1533 1 ! None.
; 1534 1 !
; 1535 1 ! IMPLICIT OUTPUTS:
; 1536 1 !
; 1537 1 ! None.
; 1538 1 !
; 1539 1 ! COMPLETION CODES:
; 1540 1 !
; 1541 1 ! KER_NORMAL - Normal return
; 1542 1 ! KER_RMS32 - RMS error encountered
; 1543 1 !
; 1544 1 ! SIDE EFFECTS:
; 1545 1 !
; 1546 1 ! None.
; 1547 1 !
; 1548 1 !--
; 1549 1
; 1550 2 BEGIN
; 1551 2 !
; 1552 2 ! Completion codes returned:
; 1553 2 !
; 1554 2 EXTERNAL LITERAL
; 1555 2 KER_NORMAL, ! Normal return
; 1556 2 KER_RMS32; ! RMS-32 error
; 1557 2
; 1558 2 LOCAL
; 1559 2 STATUS; ! Random status values
; 1560 2
; 1561 2 !
; 1562 2 ! We now have an expanded file specification that we can use to process
; 1563 2 ! the file.
; 1564 2 !
; 1565 2
; 1566 2 IF .FILE_TYPE NEQ FILE_BLK
; 1567 2 THEN
; 1568 3 BEGIN
; P 1569 3 $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM,
; 1570 3 XAB = FILE_XABFHC);
; 1571 3 END
; 1572 2 ELSE
; 1573 3 BEGIN
; P 1574 3 $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM,
; 1575 3 NAM = FILE_NAM, XAB = FILE_XABFHC);
; 1576 2 END;
; 1577 2
; 1578 2 $XABFHC_INIT (XAB = FILE_XABFHC);
; 1579 2 STATUS = $OPEN (FAB = FILE_FAB);
; 1580 2
; 1581 3 IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF)
; 1582 2 THEN
; 1583 3 BEGIN
; 1584 3 FILE_ERROR (.STATUS);
; 1585 3 RETURN KER_RMS32;
; 1586 2 END;
; 1587 2
; 1588 2 !
; 1589 2 ! Now allocate a buffer for the records
; 1590 2 !
; 1591 2 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]);
; 1592 2
; 1593 2 IF .REC_SIZE EQL 0 THEN REC_SIZE = MAX_REC_LENGTH;
; 1594 2
; 1595 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
; 1596 2 !
; 1597 2 ! Determine if we need a buffer for the fixed control area
; 1598 2 !
; 1599 2 FIX_SIZE = .FILE_FAB [FAB$B_FSZ];
; 1600 2
; 1601 2 IF .FIX_SIZE NEQ 0
; 1602 2 THEN
; 1603 3 BEGIN
; 1604 3 STATUS = LIB$GET_VM (FIX_SIZE, FIX_ADDRESS);
; 1605 2 END;
; 1606 2
; 1607 2 !
; 1608 2 ! Initialize the RAB for the $CONNECT RMS call
; 1609 2 !
; P 1610 2 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS,
; 1611 2 USZ = .REC_SIZE);
; 1612 2
; 1613 2 IF .FIX_SIZE NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .FIX_ADDRESS;
; 1614 2
; 1615 2 ! Store header address
; 1616 2 STATUS = $CONNECT (RAB = FILE_RAB);
; 1617 2
; 1618 2 IF NOT .STATUS
; 1619 2 THEN
; 1620 3 BEGIN
; 1621 3 FILE_ERROR (.STATUS);
; 1622 3 RETURN KER_RMS32;
; 1623 2 END;
; 1624 2
; 1625 2 FILE_REC_COUNT = -1;
; 1626 2 FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
; 1627 2 RETURN KER_NORMAL;
; 1628 1 END; ! End of OPEN_READING
U.36= U.10
U.37= U.10
U.38= U.13
U.39= U.12
.EXTRN SYS$OPEN, SYS$CONNECT
;OPEN_READING
U.35: .WORD ^M<R2,R3,R4,R5,R6,R7,R8,R9> ;Save R2,R3,R4,R5,R6,R7,R8,R9 1510 03FC 00000
MOVAB G^FILE_TYPE, R9 ;FILE_TYPE, R9 59 00000000' 00 9E 00002
MOVAB G^LIB$GET_VM, R8 ;LIB$GET_VM, R8 58 00000000G 00 9E 00009
MOVAB G^U.36, R7 ;U.36, R7 57 00000000' 00 9E 00010
CMPL (R9), #3 ;FILE_TYPE, #3 1566 03 69 D1 00017
BEQL 1$ ;1$ 1B 13 0001A
MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR 1570 6E 00 2C 0001C
; 0050 8F 00 0001F
; 67 00023
MOVW #20483, (R7) ;#20483, $RMS_PTR 67 5003 8F B0 00024
MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 04 A7 01000000 8F D0 00029
MOVB #2, 22(R7) ;#2, $RMS_PTR+22 16 A7 02 90 00031
BRB 2$ ;2$ 19 11 00035
1$: MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR 1575 6E 00 2C 00037
; 0050 8F 00 0003A
; 67 0003E
MOVW #20483, (R7) ;#20483, $RMS_PTR 67 5003 8F B0 0003F
MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 04 A7 01000000 8F D0 00044
MOVB #34, 22(R7) ;#34, $RMS_PTR+22 16 A7 22 90 0004C
2$: MOVB #4, 31(R7) ;#4, $RMS_PTR+31 1F A7 04 90 00050
MOVAB 244(R7), 36(R7) ;FILE_XABFHC, $RMS_PTR+36 24 A7 00F4 C7 9E 00054
MOVAB 80(R7), 40(R7) ;FILE_NAM, $RMS_PTR+40 1570 28 A7 50 A7 9E 0005A
MOVC5 #0, (SP), #0, #44, 244(R7) ;#0, (SP), #0, #44, $RMS_PTR 1578 6E 00 2C 0005F
; 2C 00 00062
; 00F4 C7 00064
MOVW #11293, 244(R7) ;#11293, $RMS_PTR 00F4 C7 2C1D 8F B0 00067
PUSHL R7 ;R7 1579 57 DD 0006E
CALLS #1, G^SYS$OPEN ;#1, SYS$OPEN 00000000G 00 01 FB 00070
MOVL R0, R6 ;R0, STATUS 56 50 D0 00077
CMPL R6, #65537 ;STATUS, #65537 1581 00010001 8F 56 D1 0007A
BEQL 3$ ;3$ 0C 13 00081
CMPL R6, #98353 ;STATUS, #98353 00018031 8F 56 D1 00083
BEQL 3$ ;3$ 03 13 0008A
BRW 9$ ;9$ 0092 31 0008C
3$: CMPL (R9), #3 ;FILE_TYPE, #3 1591 03 69 D1 0008F
BNEQ 4$ ;4$ 07 12 00092
MOVZWL #512, R0 ;#512, R0 50 0200 8F 3C 00094
BRB 5$ ;5$ 05 11 00099
4$: MOVZWL 254(R7), R0 ;FILE_XABFHC+10, R0 50 00FE C7 3C 0009B
5$: MOVL R0, 300(R7) ;R0, REC_SIZE 012C C7 50 D0 000A0
BNEQ 6$ ;6$ 1593 07 12 000A5
MOVZWL #4096, 300(R7) ;#4096, REC_SIZE 012C C7 1000 8F 3C 000A7
6$: PUSHAB 304(R7) ;REC_ADDRESS 1595 0130 C7 9F 000AE
PUSHAB 300(R7) ;REC_SIZE 012C C7 9F 000B2
CALLS #2, (R8) ;#2, LIB$GET_VM 68 02 FB 000B6
MOVL R0, R6 ;R0, STATUS 56 50 D0 000B9
MOVZBL 63(R7), 308(R7) ;FILE_FAB+63, FIX_SIZE 1599 0134 C7 3F A7 9A 000BC
BEQL 7$ ;7$ 1601 0E 13 000C2
PUSHAB 312(R7) ;FIX_ADDRESS 1604 0138 C7 9F 000C4
PUSHAB 308(R7) ;FIX_SIZE 0134 C7 9F 000C8
CALLS #2, (R8) ;#2, LIB$GET_VM 68 02 FB 000CC
MOVL R0, R6 ;R0, STATUS 56 50 D0 000CF
7$: MOVC5 #0, (SP), #0, #68, 176(R7) ;#0, (SP), #0, #68, $RMS_PTR 1611 6E 00 2C 000D2
; 0044 8F 00 000D5
; 00B0 C7 000D9
MOVW #17409, 176(R7) ;#17409, $RMS_PTR 00B0 C7 4401 8F B0 000DC
MOVL #1048576, 180(R7) ;#1048576, $RMS_PTR+4 00B4 C7 00100000 8F D0 000E3
CLRB 206(R7) ;$RMS_PTR+30 00CE C7 94 000EC
MOVW 300(R7), 208(R7) ;REC_SIZE, $RMS_PTR+32 00D0 C7 012C C7 B0 000F0
MOVL 304(R7), 212(R7) ;REC_ADDRESS, $RMS_PTR+36 00D4 C7 0130 C7 D0 000F7
MOVAB (R7), 236(R7) ;FILE_FAB, $RMS_PTR+60 00EC C7 67 9E 000FE
TSTL 308(R7) ;FIX_SIZE 1613 0134 C7 D5 00103
BEQL 8$ ;8$ 07 13 00107
MOVL 312(R7), 220(R7) ;FIX_ADDRESS, FILE_RAB+44 00DC C7 0138 C7 D0 00109
8$: PUSHAB 176(R7) ;FILE_RAB 1616 00B0 C7 9F 00110
CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 00114
MOVL R0, R6 ;R0, STATUS 56 50 D0 0011B
BLBS R6, 10$ ;STATUS, 10$ 1618 11 56 E8 0011E
9$: PUSHL R6 ;STATUS 1621 56 DD 00121
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00123
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1622 50 00000000G 8F D0 0012A
RET ; 04 00131
10$: MNEGL #1, 296(R7) ;#1, FILE_REC_COUNT 1625 0128 C7 01 CE 00132
CLRL 24(R7) ;FILE_FAB+24 1626 18 A7 D4 00137
MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 1627 50 00000000G 8F D0 0013A
RET ; 04 00141
; Routine Size: 322 bytes, Routine Base: $CODE$ + 04D5
; 1629 1 %SBTTL 'FILE_OPEN'
; 1630 1
; 1631 1 GLOBAL ROUTINE FILE_OPEN (FUNCTION) =
; 1632 1
; 1633 1 !++
; 1634 1 ! FUNCTIONAL DESCRIPTION:
; 1635 1 !
; 1636 1 ! This routine will open a file for reading or writing depending on
; 1637 1 ! the function that is passed this routine. It will handle wildcards
; 1638 1 ! on the read function.
; 1639 1 !
; 1640 1 ! CALLING SEQUENCE:
; 1641 1 !
; 1642 1 ! status = FILE_OPEN(FUNCTION);
; 1643 1 !
; 1644 1 ! INPUT PARAMETERS:
; 1645 1 !
; 1646 1 ! FUNCTION - Function to do. Either FNC_READ or FNC_WRITE.
; 1647 1 !
; 1648 1 ! IMPLICIT INPUTS:
; 1649 1 !
; 1650 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length
; 1651 1 ! of the name.
; 1652 1 !
; 1653 1 ! OUTPUT PARAMETERS:
; 1654 1 !
; 1655 1 ! None.
; 1656 1 !
; 1657 1 ! IMPLICIT OUTPUTS:
; 1658 1 !
; 1659 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length
; 1660 1 ! of the name.
; 1661 1 !
; 1662 1 ! COMPLETION CODES:
; 1663 1 !
; 1664 1 ! KER_NORMAL - File opened correctly.
; 1665 1 ! KER_RMS32 - Problem processing the file.
; 1666 1 ! KER_INTERNALERR - Internal Kermit-32 error.
; 1667 1 !
; 1668 1 ! SIDE EFFECTS:
; 1669 1 !
; 1670 1 ! None.
; 1671 1 !
; 1672 1 !--
; 1673 1
; 1674 2 BEGIN
; 1675 2 !
; 1676 2 ! Completion codes returned:
; 1677 2 !
; 1678 2 EXTERNAL LITERAL
; 1679 2 KER_NORMAL, ! Normal return
; 1680 2 KER_INTERNALERR, ! Internal error
; 1681 2 KER_RMS32; ! RMS-32 error
; 1682 2
; 1683 2 EXTERNAL ROUTINE
; 1684 2 TT_TEXT : NOVALUE; ! Output an ASCIZ string
; 1685 2
; 1686 2 EXTERNAL ROUTINE
; 1687 2 !
; 1688 2 ! This external routine is called to perform any checks on the file
; 1689 2 ! specification that the user wishes. It must return a true value
; 1690 2 ! if the access is to be allowed, and a false value (error code) if
; 1691 2 ! access is to be denied. The error code may be any valid system wide
; 1692 2 ! error code, any Kermit-32 error code (KER_xxx) or a user specific code,
; 1693 2 ! provided a message file defining the error code is loaded with Kermit-32.
; 1694 2 !
; 1695 2 ! The routine is called as:
; 1696 2 !
; 1697 2 ! STATUS = USER_FILE_CHECK ( FILE NAME DESCRIPTOR, READ/WRITE FLAG)
; 1698 2 !
; 1699 2 ! The file name descriptor points to the file specification supplied by
; 1700 2 ! the user. The read/write flag is TRUE if the file is being read, and
; 1701 2 ! false if it is being written.
; 1702 2 !
; 1703 2 USER_FILE_CHECK : ADDRESSING_MODE(GENERAL) WEAK;
; 1704 2
; 1705 2 LOCAL
; 1706 2 STATUS, ! Random status values
; 1707 2 ITMLST : VECTOR [4, LONG], ! For GETDVI call
; 1708 2 SIZE : WORD; ! Size of resulting file name
; 1709 2
; 1710 2 !
; 1711 2 ! Assume we can do searches
; 1712 2 !
; 1713 2 SEARCH_FLAG = TRUE;
; 1714 2 DEV_CLASS = DC$_DISK; ! Assume disk file
; 1715 2 !
; 1716 2 ! Now do the function dependent processing
; 1717 2 !
; 1718 2 FILE_MODE = .FUNCTION;
; 1719 2 FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE; ! Length of file name
; 1720 2 !
; 1721 2 ! Call user routine (if any)
; 1722 2 !
; 1723 2 IF USER_FILE_CHECK NEQ 0
; 1724 2 THEN
; 1725 3 BEGIN
; 1726 3 STATUS = USER_FILE_CHECK (FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
; 1727 3 IF NOT .STATUS
; 1728 3 THEN
; 1729 4 BEGIN
; 1730 4 LIB$SIGNAL (.STATUS);
; 1731 4 RETURN .STATUS;
; 1732 3 END;
; 1733 2 END;
; 1734 2 !
; 1735 2 ! Select the correct routine depending on if we are reading or writing.
; 1736 2 !
; 1737 2
; 1738 2 SELECTONE .FUNCTION OF
; 1739 2 SET
; 1740 2
; 1741 2 [FNC_READ] :
; 1742 3 BEGIN
; 1743 3 !
; 1744 3 ! Determine device type
; 1745 3 !
; 1746 3 ITMLST [0] = DVI$_DEVCLASS^16 + 4; ! Want device class
; 1747 3 ITMLST [1] = DEV_CLASS; ! Put it there
; 1748 3 ITMLST [2] = ITMLST [2]; ! Put the size here
; 1749 3 ITMLST [3] = 0; ! End the list
; 1750 3 STATUS = $GETDVIW (DEVNAM = FILE_DESC, ITMLST = ITMLST);
; 1751 3 !
; 1752 3 ! If not a disk, can't do search
; 1753 3 !
; 1754 3 IF .STATUS AND .DEV_CLASS NEQ DC$_DISK THEN SEARCH_FLAG = FALSE;
; 1755 3
; 1756 3 !
; 1757 3 ! Now set up the FAB with the information it needs.
; 1758 3 !
; P 1759 3 $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE,
; 1760 3 NAM = FILE_NAM, DNM = '.;0');
; 1761 3 !
; 1762 3 ! Now initialize the NAM block
; 1763 3 !
; P 1764 3 $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR,
; 1765 3 ESS = NAM$C_MAXRSS);
; 1766 3 !
; 1767 3 ! First parse the file specification.
; 1768 3 !
; 1769 3 STATUS = $PARSE (FAB = FILE_FAB);
; 1770 3
; 1771 3 IF NOT .STATUS
; 1772 3 THEN
; 1773 4 BEGIN
; 1774 4 FILE_ERROR (.STATUS);
; 1775 4 RETURN KER_RMS32;
; 1776 3 END;
; 1777 3
; 1778 3 IF .SEARCH_FLAG
; 1779 3 THEN
; 1780 4 BEGIN
; 1781 4 STATUS = $SEARCH (FAB = FILE_FAB);
; 1782 4
; 1783 4 IF NOT .STATUS
; 1784 4 THEN
; 1785 5 BEGIN
; 1786 5 FILE_ERROR (.STATUS);
; 1787 5 RETURN KER_RMS32;
; 1788 4 END;
; 1789 4
; 1790 3 END;
; 1791 3
; 1792 3 !
; 1793 3 ! We now have an expanded file specification that we can use to process
; 1794 3 ! the file.
; 1795 3 !
; 1796 3 STATUS = OPEN_READING (); ! Open the file
; 1797 3
; 1798 3 IF NOT .STATUS THEN RETURN .STATUS; ! If we couldn't, pass error back
; 1799 3
; 1800 3 !
; 1801 3 ! Tell user what name we ended up with for storing the file
; 1802 3 !
; 1803 3
; 1804 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL
; 1805 3 THEN
; 1806 4 BEGIN
; 1807 4
; 1808 4 IF .FILE_NAM [NAM$B_RSS] GTR 0
; 1809 4 THEN
; 1810 5 BEGIN
; 1811 5 CH$WCHAR (CHR_NUL,
; 1812 5 CH$PTR (.FILE_NAM [NAM$L_RSA],
; 1813 5 .FILE_NAM [NAM$B_RSL]));
; 1814 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]);
; 1815 5 END
; 1816 4 ELSE
; 1817 5 BEGIN
; 1818 5 CH$WCHAR (CHR_NUL,
; 1819 5 CH$PTR (.FILE_NAM [NAM$L_ESA],
; 1820 5 .FILE_NAM [NAM$B_ESL]));
; 1821 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]);
; 1822 4 END;
; 1823 4
; 1824 4 TT_TEXT (UPLIT (%ASCIZ' as '));
; 1825 3 END;
; 1826 3
; 1827 2 END; ! End of [FNC_READ]
; 1828 2
; 1829 2 [FNC_WRITE] :
; 1830 3 BEGIN
; 1831 3
; 1832 3 SELECTONE .FILE_TYPE OF
; 1833 3 SET
; 1834 3
; 1835 3 [FILE_ASC] :
; 1836 4 BEGIN
; P 1837 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
; P 1838 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
; 1839 4 ORG = SEQ, RFM = VAR, RAT = CR);
; 1840 3 END;
; 1841 3
; 1842 3 [FILE_BIN] :
; 1843 4 BEGIN
; P 1844 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
; P 1845 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
; 1846 4 ORG = SEQ, RFM = VAR);
; 1847 3 END;
; 1848 3
; 1849 3 [FILE_FIX] :
; 1850 4 BEGIN
; P 1851 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
; P 1852 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
; P 1853 4 ORG = SEQ, RFM = FIX, MRS = (IF .file_blocksize_set
; P 1854 4 THEN .file_blocksize
; 1855 4 ELSE 512));
; 1856 3 END;
; 1857 3
; 1858 3 [FILE_BLK] :
; 1859 4 BEGIN
; P 1860 4 $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME,
; 1861 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM);
; 1862 3 END;
; 1863 3 TES;
; 1864 3
; 1865 3 !
; 1866 3 ! If we had an alternate file name from the receive command, use it
; 1867 3 ! instead of what KERMSG has told us.
; 1868 3 !
; 1869 3
; 1870 3 IF .ALT_FILE_SIZE GTR 0
; 1871 3 THEN
; 1872 4 BEGIN
; 1873 4 LOCAL
; 1874 4 ALT_FILE_DESC : BLOCK [8, BYTE];
; 1875 4
; 1876 4 ALT_FILE_DESC = .FILE_DESC;
; 1877 4 ALT_FILE_DESC [DSC$W_LENGTH] = .ALT_FILE_SIZE;
; 1878 4 ALT_FILE_DESC [DSC$A_POINTER] = ALT_FILE_NAME;
; 1879 4 IF USER_FILE_CHECK NEQ 0
; 1880 4 THEN
; 1881 5 BEGIN
; 1882 5 STATUS = USER_FILE_CHECK (ALT_FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
; 1883 5 IF NOT .STATUS
; 1884 5 THEN
; 1885 6 BEGIN
; 1886 6 LIB$SIGNAL (.STATUS);
; 1887 6 RETURN .STATUS;
; 1888 5 END;
; 1889 4 END;
; 1890 4 FILE_FAB [FAB$L_FNA] = ALT_FILE_NAME;
; 1891 4 FILE_FAB [FAB$B_FNS] = .ALT_FILE_SIZE;
; 1892 3 END;
; 1893 3
; P 1894 3 $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR,
; 1895 3 RSS = NAM$C_MAXRSS);
; 1896 3 !
; 1897 3 ! Now allocate a buffer for the records
; 1898 3 !
; 1899 3 ! Determine correct buffer size
; 1900 3
; 1901 3 SELECTONE .FILE_TYPE OF
; 1902 3 SET
; 1903 3
; 1904 3 [FILE_ASC] :
; 1905 3 REC_SIZE = MAX_REC_LENGTH;
; 1906 3
; 1907 3 [FILE_BIN] :
; 1908 4 REC_SIZE = (IF .file_blocksize_set THEN .file_blocksize
; 1909 3 ELSE 510);
; 1910 3
; 1911 3 [FILE_BLK] :
; 1912 3 REC_SIZE = 512;
; 1913 3
; 1914 3 [FILE_FIX] :
; 1915 4 REC_SIZE = (IF .file_blocksize_set THEN .file_blocksize
; 1916 3 ELSE 512);
; 1917 3
; 1918 3 TES;
; 1919 3
; 1920 3 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
; 1921 3 !
; 1922 3 ! Now create the file
; 1923 3 !
; 1924 3 STATUS = $CREATE (FAB = FILE_FAB);
; 1925 3
; 1926 3 IF NOT .STATUS
; 1927 3 THEN
; 1928 4 BEGIN
; 1929 4 FILE_ERROR (.STATUS);
; 1930 4 RETURN KER_RMS32;
; 1931 3 END;
; 1932 3
; P 1933 3 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
; 1934 3 ROP = <NLK, WAT>);
; 1935 3 STATUS = $CONNECT (RAB = FILE_RAB);
; 1936 3
; 1937 3 IF NOT .STATUS
; 1938 3 THEN
; 1939 4 BEGIN
; 1940 4 FILE_ERROR (.STATUS);
; 1941 4 RETURN KER_RMS32;
; 1942 3 END;
; 1943 3
; 1944 3 !
; 1945 3 ! Set the initial state into the FAB field. This is used to remember
; 1946 3 ! whether we need to ignore the line feed which follows a carriage return.
; 1947 3 !
; 1948 3 FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
; 1949 3 FILE_REC_COUNT = 0;
; 1950 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
; 1951 3 !
; 1952 3 ! Tell user what name we ended up with for storing the file
; 1953 3 !
; 1954 3
; 1955 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL
; 1956 3 THEN
; 1957 4 BEGIN
; 1958 4 TT_TEXT (UPLIT (%ASCIZ' as '));
; 1959 4
; 1960 4 IF .FILE_NAM [NAM$B_RSL] GTR 0
; 1961 4 THEN
; 1962 5 BEGIN
; 1963 5 CH$WCHAR (CHR_NUL,
; 1964 5 CH$PTR (.FILE_NAM [NAM$L_RSA],
; 1965 5 .FILE_NAM [NAM$B_RSL]));
; 1966 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]);
; 1967 5 END
; 1968 4 ELSE
; 1969 5 BEGIN
; 1970 5 CH$WCHAR (CHR_NUL,
; 1971 5 CH$PTR (.FILE_NAM [NAM$L_ESA],
; 1972 5 .FILE_NAM [NAM$B_ESL]));
; 1973 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]);
; 1974 4 END;
; 1975 4
; 1976 4 TT_OUTPUT ();
; 1977 3 END;
; 1978 3
; 1979 2 END;
; 1980 2
; 1981 2 [OTHERWISE] :
; 1982 2 RETURN KER_INTERNALERR;
; 1983 2 TES;
; 1984 2
; 1985 2 !
; 1986 2 ! Copy the file name based on the type of file name we are to use.
; 1987 2 ! The possibilities are:
; 1988 2 ! Normal - Just copy name and type
; 1989 2 ! Full - Copy entire name string (either resultant or expanded)
; 1990 2 ! Untranslated - Copy string from name on (includes version, etc.)
; 1991 2
; 1992 2 IF .DEV_CLASS EQL DC$_MAILBOX
; 1993 2 THEN
; 1994 3 BEGIN
; 1995 3 SIZE = 0;
; 1996 3 FILE_NAME = 0;
; 1997 3 END
; 1998 2 ELSE
; 1999 2
; 2000 2 SELECTONE .FIL_NORMAL_FORM OF
; 2001 2 SET
; 2002 2
; 2003 2 [FNM_FULL] :
; 2004 3 BEGIN
; 2005 3
; 2006 3 IF .FILE_NAM [NAM$B_RSL] GTR 0
; 2007 3 THEN
; 2008 4 BEGIN
; 2009 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]),
; 2010 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2011 4 SIZE = .FILE_NAM [NAM$B_RSL];
; 2012 4 END
; 2013 3 ELSE
; 2014 4 BEGIN
; 2015 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]),
; 2016 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2017 4 SIZE = .FILE_NAM [NAM$B_ESL];
; 2018 4 END
; 2019 4
; 2020 2 END;
; 2021 2
; 2022 2 [FNM_NORMAL, FNM_UNTRAN] :
; 2023 3 BEGIN
; 2024 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
; 2025 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
; 2026 3 MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2027 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
; 2028 2 END;
; 2029 2 TES;
; 2030 2
; 2031 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;
; 2032 2
; 2033 2 RETURN KER_NORMAL;
; 2034 1 END; ! End of FILE_OPEN
.PSECT $PLIT$,NOWRT,NOEXE,2
P.AAA: .ASCII \.;0\ ; 30 3B 2E 00000
.BLKB 1 ; 00003
P.AAB: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 00004
P.AAC: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 0000C
U.41= U.10
U.42= U.11
U.43= U.10
U.44= U.10
U.45= U.10
U.46= U.10
U.47= U.11
U.48= U.12
.EXTRN KER_INTERNALERR, TT_TEXT, SYS$GETDVIW, SYS$PARSE, SYS$SEARCH, SYS$CREATE
.WEAK USER_FILE_CHECK
.PSECT $CODE$,NOWRT,2
.ENTRY FILE_OPEN, ^M<R2,R3,R4,R5,R6,R7,-;FILE_OPEN, Save R2,R3,R4,R5,R6,R7,- 1631 0FFC 00000
R8,R9,R10,R11> ;R8,R9,R10,R11
SUBL2 #28, SP ;#28, SP 5E 1C C2 00002
MOVL #1, G^U.7 ;#1, U.7 1713 00000000' 00 01 D0 00005
MOVL #1, G^U.8 ;#1, U.8 1714 00000000' 00 01 D0 0000C
MOVL 4(AP), R2 ;FUNCTION, R2 1718 52 04 AC D0 00013
MOVL R2, G^U.14 ;R2, U.14 00000000' 00 52 D0 00017
MOVW G^FILE_SIZE, G^FILE_DESC ;FILE_SIZE, FILE_DESC 1719 00000000' 00 00000000G 00 B0 0001E
MOVAB G^USER_FILE_CHECK, R0 ;USER_FILE_CHECK, R0 1723 50 00000000G 00 9E 00029
CLRL R8 ;R8 58 D4 00030
TSTL R0 ;R0 50 D5 00032
BEQL 2$ ;2$ 26 13 00034
INCL R8 ;R8 58 D6 00036
CLRL (SP) ;(SP) 1726 6E D4 00038
TSTL G^U.14 ;U.14 00000000' 00 D5 0003A
BNEQ 1$ ;1$ 02 12 00040
INCL (SP) ;(SP) 6E D6 00042
1$: PUSHL SP ;SP 5E DD 00044
PUSHAB G^FILE_DESC ;FILE_DESC 00000000' 00 9F 00046
CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK 00000000G 00 02 FB 0004C
MOVL R0, R7 ;R0, STATUS 57 50 D0 00053
BLBS R7, 2$ ;STATUS, 2$ 1727 03 57 E8 00056
BRW 22$ ;22$ 02F7 31 00059
2$: TSTL R2 ;R2 1741 52 D5 0005C
BEQL 3$ ;3$ 03 13 0005E
BRW 11$ ;11$ 016B 31 00060
3$: MOVL #262148, 12(SP) ;#262148, ITMLST 1746 0C AE 00040004 8F D0 00063
MOVAB G^U.8, 16(SP) ;U.8, ITMLST+4 1747 10 AE 00000000' 00 9E 0006B
MOVAB 20(SP), 20(SP) ;ITMLST+8, ITMLST+8 1748 14 AE 14 AE 9E 00073
CLRL 24(SP) ;ITMLST+12 1749 18 AE D4 00078
CLRQ -(SP) ;-(SP) 1750 7E 7C 0007B
CLRQ -(SP) ;-(SP) 7E 7C 0007D
PUSHAB 28(SP) ;ITMLST 1C AE 9F 0007F
PUSHAB G^FILE_DESC ;FILE_DESC 00000000' 00 9F 00082
CLRQ -(SP) ;-(SP) 7E 7C 00088
CALLS #8, G^SYS$GETDVIW ;#8, SYS$GETDVIW 00000000G 00 08 FB 0008A
MOVL R0, R7 ;R0, STATUS 57 50 D0 00091
BLBC R7, 4$ ;STATUS, 4$ 1754 0F 57 E9 00094
CMPL G^U.8, #1 ;U.8, #1 01 00000000' 00 D1 00097
BEQL 4$ ;4$ 06 13 0009E
CLRL G^U.7 ;U.7 00000000' 00 D4 000A0
4$: MOVC5 #0, (SP), #0, #80, G^U.41 ;#0, (SP), #0, #80, U.41 1760 6E 00 2C 000A6
; 0050 8F 00 000A9
; 00000000' 00 000AD
MOVW #20483, G^U.41 ;#20483, U.41 00000000' 00 5003 8F B0 000B2
MOVL #16777216, G^U.41+4 ;#16777216, U.41+4 00000000' 00 01000000 8F D0 000BB
MOVB #2, G^U.41+22 ;#2, U.41+22 00000000' 00 02 90 000C6
MOVB #2, G^U.41+31 ;#2, U.41+31 00000000' 00 02 90 000CD
MOVAB G^U.11, G^U.41+40 ;U.11, U.41+40 00000000' 00 00000000' 00 9E 000D4
MOVAB G^FILE_NAME, G^U.41+44 ;FILE_NAME, U.41+44 00000000' 00 00000000G 00 9E 000DF
MOVAB G^P.AAA, G^U.41+48 ;P.AAA, U.41+48 00000000' 00 00000000' 00 9E 000EA
MOVB G^FILE_SIZE, G^U.41+52 ;FILE_SIZE, U.41+52 00000000' 00 00000000G 00 90 000F5
MOVB #3, G^U.41+53 ;#3, U.41+53 00000000' 00 03 90 00100
MOVC5 #0, (SP), #0, #96, G^U.42 ;#0, (SP), #0, #96, U.42 1765 6E 00 2C 00107
; 0060 8F 00 0010A
; 00000000' 00 0010E
MOVW #24578, G^U.42 ;#24578, U.42 00000000' 00 6002 8F B0 00113
MNEGB #1, G^U.42+2 ;#1, U.42+2 00000000' 00 01 8E 0011C
MOVAB G^U.22, G^U.42+4 ;U.22, U.42+4 00000000' 00 00000000' 00 9E 00123
MNEGB #1, G^U.42+10 ;#1, U.42+10 00000000' 00 01 8E 0012E
MOVAB G^U.21, G^U.42+12 ;U.21, U.42+12 00000000' 00 00000000' 00 9E 00135
PUSHAB G^U.10 ;U.10 1769 00000000' 00 9F 00140
CALLS #1, G^SYS$PARSE ;#1, SYS$PARSE 00000000G 00 01 FB 00146
MOVL R0, R7 ;R0, STATUS 57 50 D0 0014D
BLBC R7, 5$ ;STATUS, 5$ 1771 17 57 E9 00150
BLBC G^U.7, 6$ ;U.7, 6$ 1778 16 00000000' 00 E9 00153
PUSHAB G^U.10 ;U.10 1781 00000000' 00 9F 0015A
CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH 00000000G 00 01 FB 00160
MOVL R0, R7 ;R0, STATUS 57 50 D0 00167
5$: BLBS R7, 6$ ;STATUS, 6$ 1783 03 57 E8 0016A
BRW 33$ ;33$ 0312 31 0016D
6$: CALLS #0, W^U.35 ;#0, U.35 1796 FD49 CF 00 FB 00170
MOVL R0, R7 ;R0, STATUS 57 50 D0 00175
BLBS R7, 7$ ;STATUS, 7$ 1798 03 57 E8 00178
BRW 23$ ;23$ 01DE 31 0017B
7$: BLBS G^CONNECT_FLAG, 10$ ;CONNECT_FLAG, 10$ 1804 46 00000000G 00 E8 0017E
BLBC G^TY_FIL, 10$ ;TY_FIL, 10$ 3F 00000000G 00 E9 00185
TSTB G^U.11+2 ;U.11+2 1808 00000000' 00 95 0018C
BEQL 8$ ;8$ 10 13 00192
MOVL G^U.11+4, R0 ;U.11+4, R0 1812 50 00000000' 00 D0 00194
MOVZBL G^U.11+3, R1 ;U.11+3, R1 1813 51 00000000' 00 9A 0019B
BRB 9$ ;9$ 0E 11 001A2
8$: MOVL G^U.11+12, R0 ;U.11+12, R0 1819 50 00000000' 00 D0 001A4
MOVZBL G^U.11+11, R1 ;U.11+11, R1 1820 51 00000000' 00 9A 001AB
9$: CLRB (R1)[R0] ;(R1)[R0] 6140 94 001B2
PUSHL R0 ;R0 1821 50 DD 001B5
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 001B7
PUSHAB G^P.AAB ;P.AAB 1824 00000000' 00 9F 001BE
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 001C4
10$: BRW 38$ ;38$ 1738 0335 31 001CB
11$: CMPL R2, #1 ;R2, #1 1829 01 52 D1 001CE
BEQL 12$ ;12$ 03 13 001D1
BRW 37$ ;37$ 0325 31 001D3
12$: MOVL G^FILE_TYPE, R6 ;FILE_TYPE, R6 1832 56 00000000' 00 D0 001D6
CMPL R6, #1 ;R6, #1 1835 01 56 D1 001DD
BNEQ 13$ ;13$ 32 12 001E0
MOVC5 #0, (SP), #0, #80, G^U.43 ;#0, (SP), #0, #80, U.43 1839 6E 00 2C 001E2
; 0050 8F 00 001E5
; 00000000' 00 001E9
MOVW #20483, G^U.43 ;#20483, U.43 00000000' 00 5003 8F B0 001EE
MOVL #270532674, G^U.43+4 ;#270532674, U.43+4 00000000' 00 10200042 8F D0 001F7
MOVB #1, G^U.43+22 ;#1, U.43+22 00000000' 00 01 90 00202
MOVW #512, G^U.43+29 ;#512, U.43+29 00000000' 00 0200 8F B0 00209
BRB 14$ ;14$ 32 11 00212
13$: CMPL R6, #2 ;R6, #2 1842 02 56 D1 00214
BNEQ 15$ ;15$ 30 12 00217
MOVC5 #0, (SP), #0, #80, G^U.44 ;#0, (SP), #0, #80, U.44 1846 6E 00 2C 00219
; 0050 8F 00 0021C
; 00000000' 00 00220
MOVW #20483, G^U.44 ;#20483, U.44 00000000' 00 5003 8F B0 00225
MOVL #270532674, G^U.44+4 ;#270532674, U.44+4 00000000' 00 10200042 8F D0 0022E
MOVB #1, G^U.44+22 ;#1, U.44+22 00000000' 00 01 90 00239
CLRB G^U.44+29 ;U.44+29 00000000' 00 94 00240
14$: BRW 19$ ;19$ 00A4 31 00246
15$: CMPL R6, #4 ;R6, #4 1849 04 56 D1 00249
BNEQ 18$ ;18$ 73 12 0024C
MOVC5 #0, (SP), #0, #80, G^U.45 ;#0, (SP), #0, #80, U.45 1855 6E 00 2C 0024E
; 0050 8F 00 00251
; 00000000' 00 00255
MOVW #20483, G^U.45 ;#20483, U.45 00000000' 00 5003 8F B0 0025A
MOVL #270532674, G^U.45+4 ;#270532674, U.45+4 00000000' 00 10200042 8F D0 00263
MOVB #1, G^U.45+22 ;#1, U.45+22 00000000' 00 01 90 0026E
CLRB G^U.45+29 ;U.45+29 00000000' 00 94 00275
MOVB #1, G^U.45+31 ;#1, U.45+31 00000000' 00 01 90 0027B
MOVAB G^U.11, G^U.45+40 ;U.11, U.45+40 00000000' 00 00000000' 00 9E 00282
MOVAB G^FILE_NAME, G^U.45+44 ;FILE_NAME, U.45+44 00000000' 00 00000000G 00 9E 0028D
MOVB G^FILE_SIZE, G^U.45+52 ;FILE_SIZE, U.45+52 00000000' 00 00000000G 00 90 00298
BLBC G^FILE_BLOCKSIZE_SET, 16$ ;FILE_BLOCKSIZE_SET, 16$ 09 00000000' 00 E9 002A3
MOVL G^FILE_BLOCKSIZE, R0 ;FILE_BLOCKSIZE, R0 50 00000000' 00 D0 002AA
BRB 17$ ;17$ 05 11 002B1
16$: MOVZWL #512, R0 ;#512, R0 50 0200 8F 3C 002B3
17$: MOVW R0, G^U.45+54 ;R0, U.45+54 00000000' 00 50 B0 002B8
BRB 20$ ;20$ 54 11 002BF
18$: CMPL R6, #3 ;R6, #3 1858 03 56 D1 002C1
BNEQ 20$ ;20$ 4F 12 002C4
MOVC5 #0, (SP), #0, #80, G^U.46 ;#0, (SP), #0, #80, U.46 1861 6E 00 2C 002C6
; 0050 8F 00 002C9
; 00000000' 00 002CD
MOVW #20483, G^U.46 ;#20483, U.46 00000000' 00 5003 8F B0 002D2
MOVL #270532674, G^U.46+4 ;#270532674, U.46+4 00000000' 00 10200042 8F D0 002DB
MOVB #33, G^U.46+22 ;#33, U.46+22 00000000' 00 21 90 002E6
19$: MOVB #2, G^U.46+31 ;#2, U.46+31 00000000' 00 02 90 002ED
MOVAB G^U.11, G^U.46+40 ;U.11, U.46+40 00000000' 00 00000000' 00 9E 002F4
MOVAB G^FILE_NAME, G^U.46+44 ;FILE_NAME, U.46+44 00000000' 00 00000000G 00 9E 002FF
MOVB G^FILE_SIZE, G^U.46+52 ;FILE_SIZE, U.46+52 00000000' 00 00000000G 00 90 0030A
20$: MOVL G^ALT_FILE_SIZE, R0 ;ALT_FILE_SIZE, R0 1870 50 00000000G 00 D0 00315
BLEQ 25$ ;25$ 58 15 0031C
MOVL G^FILE_DESC, 4(SP) ;FILE_DESC, ALT_FILE_DESC 1876 04 AE 00000000' 00 D0 0031E
MOVW R0, 4(SP) ;R0, ALT_FILE_DESC 1877 04 AE 50 B0 00326
MOVAB G^ALT_FILE_NAME, 8(SP) ;ALT_FILE_NAME, ALT_FILE_DESC+4 1878 08 AE 00000000G 00 9E 0032A
BLBC R8, 24$ ;R8, 24$ 1879 2B 58 E9 00332
CLRL (SP) ;(SP) 1882 6E D4 00335
TSTL G^U.14 ;U.14 00000000' 00 D5 00337
BNEQ 21$ ;21$ 02 12 0033D
INCL (SP) ;(SP) 6E D6 0033F
21$: PUSHL SP ;SP 5E DD 00341
PUSHAB 8(SP) ;ALT_FILE_DESC 08 AE 9F 00343
CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK 00000000G 00 02 FB 00346
MOVL R0, R7 ;R0, STATUS 57 50 D0 0034D
BLBS R7, 24$ ;STATUS, 24$ 1883 0D 57 E8 00350
22$: PUSHL R7 ;STATUS 1886 57 DD 00353
CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00355
23$: MOVL R7, R0 ;STATUS, R0 1887 50 57 D0 0035C
RET ; 04 0035F
24$: MOVAB G^ALT_FILE_NAME, G^U.10+44 ;ALT_FILE_NAME, U.10+44 1890 00000000' 00 00000000G 00 9E 00360
MOVB G^ALT_FILE_SIZE, G^U.10+52 ;ALT_FILE_SIZE, U.10+52 1891 00000000' 00 00000000G 00 90 0036B
25$: MOVC5 #0, (SP), #0, #96, G^U.47 ;#0, (SP), #0, #96, U.47 1895 6E 00 2C 00376
; 0060 8F 00 00379
; 00000000' 00 0037D
MOVW #24578, G^U.47 ;#24578, U.47 00000000' 00 6002 8F B0 00382
MNEGB #1, G^U.47+2 ;#1, U.47+2 00000000' 00 01 8E 0038B
MOVAB G^U.22, G^U.47+4 ;U.22, U.47+4 00000000' 00 00000000' 00 9E 00392
MNEGB #1, G^U.47+10 ;#1, U.47+10 00000000' 00 01 8E 0039D
MOVAB G^U.21, G^U.47+12 ;U.21, U.47+12 00000000' 00 00000000' 00 9E 003A4
MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 1901 50 00000000' 00 D0 003AF
CMPL R0, #1 ;R0, #1 1904 01 50 D1 003B6
BNEQ 26$ ;26$ 0B 12 003B9
MOVZWL #4096, G^U.17 ;#4096, U.17 1905 00000000' 00 1000 8F 3C 003BB
BRB 32$ ;32$ 44 11 003C4
26$: CMPL R0, #2 ;R0, #2 1907 02 50 D1 003C6
BNEQ 27$ ;27$ 0E 12 003C9
BLBS G^FILE_BLOCKSIZE_SET, 29$ ;FILE_BLOCKSIZE_SET, 29$ 1908 23 00000000' 00 E8 003CB
MOVZWL #510, R0 ;#510, R0 1909 50 01FE 8F 3C 003D2
BRB 31$ ;31$ 1908 2A 11 003D7
27$: CMPL R0, #3 ;R0, #3 1911 03 50 D1 003D9
BNEQ 28$ ;28$ 0B 12 003DC
MOVZWL #512, G^U.17 ;#512, U.17 1912 00000000' 00 0200 8F 3C 003DE
BRB 32$ ;32$ 21 11 003E7
28$: CMPL R0, #4 ;R0, #4 1914 04 50 D1 003E9
BNEQ 32$ ;32$ 1C 12 003EC
BLBC G^FILE_BLOCKSIZE_SET, 30$ ;FILE_BLOCKSIZE_SET, 30$ 1915 09 00000000' 00 E9 003EE
29$: MOVL G^FILE_BLOCKSIZE, R0 ;FILE_BLOCKSIZE, R0 50 00000000' 00 D0 003F5
BRB 31$ ;31$ 05 11 003FC
30$: MOVZWL #512, R0 ;#512, R0 1916 50 0200 8F 3C 003FE
31$: MOVL R0, G^U.17 ;R0, U.17 1915 00000000' 00 50 D0 00403
32$: PUSHAB G^U.18 ;U.18 1920 00000000' 00 9F 0040A
PUSHAB G^U.17 ;U.17 00000000' 00 9F 00410
CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM 00000000G 00 02 FB 00416
MOVL R0, R7 ;R0, STATUS 57 50 D0 0041D
PUSHAB G^U.10 ;U.10 1924 00000000' 00 9F 00420
CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE 00000000G 00 01 FB 00426
MOVL R0, R7 ;R0, STATUS 57 50 D0 0042D
BLBC R7, 33$ ;STATUS, 33$ 1926 4F 57 E9 00430
MOVC5 #0, (SP), #0, #68, G^U.48 ;#0, (SP), #0, #68, U.48 1934 6E 00 2C 00433
; 0044 8F 00 00436
; 00000000' 00 0043A
MOVW #17409, G^U.48 ;#17409, U.48 00000000' 00 4401 8F B0 0043F
MOVL #1179648, G^U.48+4 ;#1179648, U.48+4 00000000' 00 00120000 8F D0 00448
CLRB G^U.48+30 ;U.48+30 00000000' 00 94 00453
MOVL G^U.18, G^U.48+40 ;U.18, U.48+40 00000000' 00 00000000' 00 D0 00459
MOVAB G^U.10, G^U.48+60 ;U.10, U.48+60 00000000' 00 00000000' 00 9E 00464
PUSHAB G^U.12 ;U.12 1935 00000000' 00 9F 0046F
CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 00475
MOVL R0, R7 ;R0, STATUS 57 50 D0 0047C
BLBS R7, 34$ ;STATUS, 34$ 1937 11 57 E8 0047F
33$: PUSHL R7 ;STATUS 1940 57 DD 00482
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 00484
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 1941 50 00000000G 8F D0 0048B
RET ; 04 00492
34$: MOVL #2, G^U.10+24 ;#2, U.10+24 1948 00000000' 00 02 D0 00493
CLRL G^U.16 ;U.16 1949 00000000' 00 D4 0049A
MOVL G^U.18, G^U.15 ;U.18, U.15 1950 00000000' 00 00000000' 00 D0 004A0
BLBS G^CONNECT_FLAG, 38$ ;CONNECT_FLAG, 38$ 1955 51 00000000G 00 E8 004AB
BLBC G^TY_FIL, 38$ ;TY_FIL, 38$ 4A 00000000G 00 E9 004B2
PUSHAB G^P.AAC ;P.AAC 1958 00000000' 00 9F 004B9
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 004BF
MOVZBL G^U.11+3, R1 ;U.11+3, R1 1960 51 00000000' 00 9A 004C6
BLEQ 35$ ;35$ 09 15 004CD
MOVL G^U.11+4, R0 ;U.11+4, R0 1964 50 00000000' 00 D0 004CF
BRB 36$ ;36$ 1965 0E 11 004D6
35$: MOVL G^U.11+12, R0 ;U.11+12, R0 1971 50 00000000' 00 D0 004D8
MOVZBL G^U.11+11, R1 ;U.11+11, R1 1972 51 00000000' 00 9A 004DF
36$: CLRB (R1)[R0] ;(R1)[R0] 6140 94 004E6
PUSHL R0 ;R0 1973 50 DD 004E9
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 004EB
CALLS #0, G^TT_OUTPUT ;#0, TT_OUTPUT 1976 00000000G 00 00 FB 004F2
BRB 38$ ;38$ 1738 08 11 004F9
37$: MOVL #KER_INTERNALERR, R0 ;#KER_INTERNALERR, R0 1982 50 00000000G 8F D0 004FB
RET ; 04 00502
38$: CMPL G^U.8, #160 ;U.8, #160 1992 000000A0 8F 00000000' 00 D1 00503
BNEQ 39$ ;39$ 0A 12 0050E
CLRW R6 ;SIZE 1995 56 B4 00510
CLRL G^FILE_NAME ;FILE_NAME 1996 00000000G 00 D4 00512
BRB 42$ ;42$ 3B 11 00518
39$: MOVL G^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 2000 50 00000000G 00 D0 0051A
CMPL R0, #2 ;R0, #2 2003 02 50 D1 00521
BNEQ 43$ ;43$ 31 12 00524
MOVZBL G^U.11+3, R7 ;U.11+3, R7 2006 57 00000000' 00 9A 00526
BLEQ 40$ ;40$ 09 15 0052D
MOVL G^U.11+4, R0 ;U.11+4, R0 2009 50 00000000' 00 D0 0052F
BRB 41$ ;41$ 2010 0E 11 00536
40$: MOVZBL G^U.11+11, R7 ;U.11+11, R7 2015 57 00000000' 00 9A 00538
MOVL G^U.11+12, R0 ;U.11+12, R0 50 00000000' 00 D0 0053F
41$: MOVC5 R7, (R0), #0, #132, G^FILE_NAME ;R7, (R0), #0, #132, FILE_NAME 2016 60 57 2C 00546
; 0084 8F 00 00549
; 00000000G 00 0054D
MOVW R7, R6 ;R7, SIZE 2017 56 57 B0 00552
42$: BRB 46$ ;46$ 2000 49 11 00555
43$: CMPL R0, #1 ;R0, #1 2022 01 50 D1 00557
BEQL 44$ ;44$ 05 13 0055A
CMPL R0, #4 ;R0, #4 04 50 D1 0055C
BNEQ 46$ ;46$ 3F 12 0055F
44$: MOVZBL G^U.11+59, R9 ;U.11+59, R9 2024 59 00000000' 00 9A 00561
MOVL G^U.11+76, R0 ;U.11+76, R0 50 00000000' 00 D0 00568
MOVZBL G^U.11+60, R8 ;U.11+60, R8 2025 58 00000000' 00 9A 0056F
MOVL G^U.11+80, R11 ;U.11+80, R11 5B 00000000' 00 D0 00576
MOVZBL #132, R10 ;#132, R10 2026 5A 84 8F 9A 0057D
MOVAB G^FILE_NAME, R7 ;FILE_NAME, R7 57 00000000G 00 9E 00581
MOVC5 R9, (R0), #0, R10, (R7) ;R9, (R0), #0, R10, (R7) 60 59 2C 00588
; 5A 00 0058B
; 67 0058D
BGEQ 45$ ;45$ 0C 18 0058E
ADDL2 R9, R7 ;R9, R7 57 59 C0 00590
SUBL2 R9, R10 ;R9, R10 5A 59 C2 00593
MOVC5 R8, (R11), #0, R10, (R7) ;R8, (R11), #0, R10, (R7) 6B 58 2C 00596
; 5A 00 00599
; 67 0059B
45$: ADDW3 R8, R9, R6 ;R8, R9, SIZE 2027 59 58 A1 0059C
; 56 0059F
46$: CMPW R6, #132 ;SIZE, #132 2031 0084 8F 56 B1 005A0
BLEQU 47$ ;47$ 0A 1B 005A5
MOVZBL #132, G^FILE_SIZE ;#132, FILE_SIZE 00000000G 00 84 8F 9A 005A7
BRB 48$ ;48$ 07 11 005AF
47$: MOVZWL R6, G^FILE_SIZE ;SIZE, FILE_SIZE 00000000G 00 56 3C 005B1
48$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2033 50 00000000G 8F D0 005B8
RET ; 04 005BF
; Routine Size: 1472 bytes, Routine Base: $CODE$ + 0617
; 2035 1
; 2036 1 %SBTTL 'FILE_CLOSE'
; 2037 1
; 2038 1 GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) =
; 2039 1
; 2040 1 !++
; 2041 1 ! FUNCTIONAL DESCRIPTION:
; 2042 1 !
; 2043 1 ! This routine will close a file that was opened by FILE_OPEN.
; 2044 1 ! It assumes any data associated with the file is stored in this
; 2045 1 ! module, since this routine is called by KERMSG.
; 2046 1 !
; 2047 1 ! CALLING SEQUENCE:
; 2048 1 !
; 2049 1 ! FILE_CLOSE();
; 2050 1 !
; 2051 1 ! INPUT PARAMETERS:
; 2052 1 !
; 2053 1 ! ABORT_FLAG - True if file should not be saved.
; 2054 1 !
; 2055 1 ! IMPLICIT INPUTS:
; 2056 1 !
; 2057 1 ! None.
; 2058 1 !
; 2059 1 ! OUTPUT PARAMETERS:
; 2060 1 !
; 2061 1 ! None.
; 2062 1 !
; 2063 1 ! IMPLICIT OUTPUTS:
; 2064 1 !
; 2065 1 ! None.
; 2066 1 !
; 2067 1 ! COMPLETION CODES:
; 2068 1 !
; 2069 1 ! None.
; 2070 1 !
; 2071 1 ! SIDE EFFECTS:
; 2072 1 !
; 2073 1 ! None.
; 2074 1 !
; 2075 1 !--
; 2076 1
; 2077 2 BEGIN
; 2078 2 !
; 2079 2 ! Completion codes returned:
; 2080 2 !
; 2081 2 EXTERNAL LITERAL
; 2082 2 KER_NORMAL, ! Normal return
; 2083 2 KER_RMS32; ! RMS-32 error
; 2084 2
; 2085 2 LOCAL
; 2086 2 STATUS; ! Random status values
; 2087 2
; 2088 2 !
; 2089 2 ! If there might be something left to write
; 2090 2
; 2091 2 !
; 2092 2
; 2093 3 IF .FILE_MODE EQL FNC_WRITE AND (.FILE_REC_COUNT GTR 0 OR .FILE_FAB [FAB$L_CTX] NEQ
; 2094 3 F_STATE_DATA)
; 2095 2 THEN
; 2096 3 BEGIN
; 2097 3
; 2098 3 SELECTONE .FILE_TYPE OF
; 2099 3 SET
; 2100 3
; 2101 3 [FILE_FIX] :
; 2102 4 BEGIN
; 2103 4
; 2104 4 INCR I FROM .FILE_REC_COUNT TO .REC_SIZE - 1 DO
; 2105 4 CH$WCHAR_A (CHR_NUL, FILE_REC_POINTER);
; 2106 4 FILE_REC_COUNT = .REC_SIZE; ! Store the byte count
; 2107 4 STATUS = DUMP_BUFFER ();
; 2108 3 END;
; 2109 3
; 2110 3 [FILE_ASC, FILE_BIN] :
; 2111 3 STATUS = DUMP_BUFFER ();
; 2112 3
; 2113 3 [FILE_BLK] :
; 2114 4 BEGIN
; 2115 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
; 2116 4 STATUS = $WRITE (RAB = FILE_RAB);
; 2117 4
; 2118 4 IF NOT .STATUS
; 2119 4 THEN
; 2120 5 BEGIN
; 2121 5 FILE_ERROR (.STATUS);
; 2122 5 STATUS = KER_RMS32;
; 2123 5 END
; 2124 4 ELSE
; 2125 4 STATUS = KER_NORMAL;
; 2126 4
; 2127 3 END;
; 2128 3 TES;
; 2129 3
; 2130 3 IF NOT .STATUS THEN RETURN .STATUS;
; 2131 3
; 2132 2 END;
; 2133 2
; 2134 2 !
; 2135 2 ! If reading from a mailbox, read until EOF to allow the process on the other
; 2136 2 ! end to terminal gracefully.
; 2137 2 !
; 2138 2
; 2139 2 IF .FILE_MODE EQL FNC_READ AND .DEV_CLASS EQL DC$_MAILBOX AND NOT .EOF_FLAG
; 2140 2 THEN
; 2141 2
; 2142 2 DO
; 2143 2 STATUS = GET_BUFFER ()
; 2144 2 UNTIL ( NOT .STATUS) OR .EOF_FLAG;
; 2145 2
; 2146 2 STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
; 2147 2
; 2148 2 IF .FIX_SIZE NEQ 0 THEN STATUS = LIB$FREE_VM (FIX_SIZE, FIX_ADDRESS);
; 2149 2
; 2150 2 IF .ABORT_FLAG AND .FILE_MODE EQL FNC_WRITE
; 2151 2 THEN
; 2152 2 FILE_FAB [FAB$V_DLT] = TRUE
; 2153 2 ELSE
; 2154 2 FILE_FAB [FAB$V_DLT] = FALSE;
; 2155 2
; 2156 2 STATUS = $CLOSE (FAB = FILE_FAB);
; 2157 2 EOF_FLAG = FALSE;
; 2158 2
; 2159 2 IF NOT .STATUS
; 2160 2 THEN
; 2161 3 BEGIN
; 2162 3 FILE_ERROR (.STATUS);
; 2163 3 RETURN KER_RMS32;
; 2164 3 END
; 2165 2 ELSE
; 2166 2 RETURN KER_NORMAL;
; 2167 2
; 2168 1 END; ! End of FILE_CLOSE
.EXTRN SYS$CLOSE
.ENTRY FILE_CLOSE, ^M<R2,R3,R4,R5,R6,- ;FILE_CLOSE, Save R2,R3,R4,R5,R6,R7 2038 00FC 00000
R7> ;
MOVAB G^LIB$FREE_VM, R7 ;LIB$FREE_VM, R7 57 00000000G 00 9E 00002
MOVL #KER_NORMAL, R6 ;#KER_NORMAL, R6 56 00000000G 8F D0 00009
MOVL #KER_RMS32, R5 ;#KER_RMS32, R5 55 00000000G 8F D0 00010
MOVAB G^U.6, R4 ;U.6, R4 54 00000000V 00 9E 00017
MOVAB G^U.16, R3 ;U.16, R3 53 00000000' 00 9E 0001E
CMPL -8(R3), #1 ;FILE_MODE, #1 2093 01 F8 A3 D1 00025
BNEQ 9$ ;9$ 73 12 00029
TSTL (R3) ;FILE_REC_COUNT 63 D5 0002B
BGTR 1$ ;1$ 07 14 0002D
CMPL -272(R3), #2 ;FILE_FAB+24, #2 2094 02 FEF0 C3 D1 0002F
BEQL 9$ ;9$ 68 13 00034
1$: MOVL G^FILE_TYPE, R0 ;FILE_TYPE, R0 2098 50 00000000' 00 D0 00036
CMPL R0, #4 ;R0, #4 2101 04 50 D1 0003D
BNEQ 4$ ;4$ 1C 12 00040
MOVL 4(R3), R1 ;REC_SIZE, R1 2104 51 04 A3 D0 00042
SUBL3 #1, (R3), R2 ;#1, FILE_REC_COUNT, I 63 01 C3 00046
; 52 00049
BRB 3$ ;3$ 09 11 0004A
2$: MOVL -4(R3), R0 ;FILE_REC_POINTER, R0 2105 50 FC A3 D0 0004C
CLRB (R0) ;(R0) 60 94 00050
INCL -4(R3) ;FILE_REC_POINTER FC A3 D6 00052
3$: AOBLSS R1, R2, 2$ ;R1, I, 2$ 52 51 F2 00055
; F3 00058
MOVL R1, (R3) ;R1, FILE_REC_COUNT 2106 63 51 D0 00059
BRB 5$ ;5$ 2107 09 11 0005C
4$: TSTL R0 ;R0 2110 50 D5 0005E
BLEQ 6$ ;6$ 0F 15 00060
CMPL R0, #2 ;R0, #2 02 50 D1 00062
BGTR 6$ ;6$ 0A 14 00065
5$: CALLS #0, W^U.2 ;#0, U.2 2111 F858 CF 00 FB 00067
MOVL R0, R2 ;R0, STATUS 52 50 D0 0006C
BRB 8$ ;8$ 26 11 0006F
6$: CMPL R0, #3 ;R0, #3 2113 03 50 D1 00071
BNEQ 8$ ;8$ 21 12 00074
MOVW (R3), -86(R3) ;FILE_REC_COUNT, FILE_RAB+34 2115 AA A3 63 B0 00076
PUSHAB -120(R3) ;FILE_RAB 2116 88 A3 9F 0007A
CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE 00000000G 00 01 FB 0007D
MOVL R0, R2 ;R0, STATUS 52 50 D0 00084
BLBS R2, 7$ ;STATUS, 7$ 2118 0A 52 E8 00087
PUSHL R2 ;STATUS 2121 52 DD 0008A
CALLS #1, (R4) ;#1, FILE_ERROR 64 01 FB 0008C
MOVL R5, R2 ;R5, STATUS 2122 52 55 D0 0008F
BRB 8$ ;8$ 03 11 00092
7$: MOVL R6, R2 ;R6, STATUS 2125 52 56 D0 00094
8$: BLBS R2, 9$ ;STATUS, 9$ 2130 04 52 E8 00097
MOVL R2, R0 ;STATUS, R0 50 52 D0 0009A
RET ; 04 0009D
9$: TSTL -8(R3) ;FILE_MODE 2139 F8 A3 D5 0009E
BNEQ 11$ ;11$ 20 12 000A1
CMPL -304(R3), #160 ;DEV_CLASS, #160 000000A0 8F FED0 C3 D1 000A3
BNEQ 11$ ;11$ 15 12 000AC
BLBS -300(R3), 11$ ;EOF_FLAG, 11$ 10 FED4 C3 E8 000AE
10$: CALLS #0, W^U.3 ;#0, U.3 2143 F6E0 CF 00 FB 000B3
MOVL R0, R2 ;R0, STATUS 52 50 D0 000B8
BLBC R2, 11$ ;STATUS, 11$ 2144 05 52 E9 000BB
BLBC -300(R3), 10$ ;EOF_FLAG, 10$ F0 FED4 C3 E9 000BE
11$: PUSHAB 8(R3) ;REC_ADDRESS 2146 08 A3 9F 000C3
PUSHAB 4(R3) ;REC_SIZE 04 A3 9F 000C6
CALLS #2, (R7) ;#2, LIB$FREE_VM 67 02 FB 000C9
MOVL R0, R2 ;R0, STATUS 52 50 D0 000CC
TSTL 12(R3) ;FIX_SIZE 2148 0C A3 D5 000CF
BEQL 12$ ;12$ 0C 13 000D2
PUSHAB 16(R3) ;FIX_ADDRESS 10 A3 9F 000D4
PUSHAB 12(R3) ;FIX_SIZE 0C A3 9F 000D7
CALLS #2, (R7) ;#2, LIB$FREE_VM 67 02 FB 000DA
MOVL R0, R2 ;R0, STATUS 52 50 D0 000DD
12$: BLBC 4(AP), 13$ ;ABORT_FLAG, 13$ 2150 0E 04 AC E9 000E0
CMPL -8(R3), #1 ;FILE_MODE, #1 01 F8 A3 D1 000E4
BNEQ 13$ ;13$ 08 12 000E8
BISB2 #128, -291(R3) ;#128, FILE_FAB+5 2152 FEDD C3 80 8F 88 000EA
BRB 14$ ;14$ 06 11 000F0
13$: BICB2 #128, -291(R3) ;#128, FILE_FAB+5 2154 FEDD C3 80 8F 8A 000F2
14$: PUSHAB -296(R3) ;FILE_FAB 2156 FED8 C3 9F 000F8
CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 000FC
MOVL R0, R2 ;R0, STATUS 52 50 D0 00103
CLRL -300(R3) ;EOF_FLAG 2157 FED4 C3 D4 00106
BLBS R2, 15$ ;STATUS, 15$ 2159 09 52 E8 0010A
PUSHL R2 ;STATUS 2162 52 DD 0010D
CALLS #1, (R4) ;#1, FILE_ERROR 64 01 FB 0010F
MOVL R5, R0 ;R5, R0 2163 50 55 D0 00112
RET ; 04 00115
15$: MOVL R6, R0 ;R6, R0 2166 50 56 D0 00116
RET ; 04 00119
; Routine Size: 282 bytes, Routine Base: $CODE$ + 0BD7
; 2169 1
; 2170 1 %SBTTL 'NEXT_FILE'
; 2171 1
; 2172 1 GLOBAL ROUTINE NEXT_FILE =
; 2173 1
; 2174 1 !++
; 2175 1 ! FUNCTIONAL DESCRIPTION:
; 2176 1 !
; 2177 1 ! This routine will cause the next file to be opened. It will
; 2178 1 ! call the RMS-32 routine $SEARCH and $OPEN for the file.
; 2179 1 !
; 2180 1 ! CALLING SEQUENCE:
; 2181 1 !
; 2182 1 ! STATUS = NEXT_FILE;
; 2183 1 !
; 2184 1 ! INPUT PARAMETERS:
; 2185 1 !
; 2186 1 ! None.
; 2187 1 !
; 2188 1 ! IMPLICIT INPUTS:
; 2189 1 !
; 2190 1 ! FAB/NAM blocks set up from previous processing.
; 2191 1 !
; 2192 1 ! OUTPUT PARAMETERS:
; 2193 1 !
; 2194 1 ! None.
; 2195 1 !
; 2196 1 ! IMPLICIT OUTPUTS:
; 2197 1 !
; 2198 1 ! FAB/NAM blocks set up for the next file.
; 2199 1 !
; 2200 1 ! COMPLETION CODES:
; 2201 1 !
; 2202 1 ! TRUE - There is a next file.
; 2203 1 ! KER_RMS32 - No next file.
; 2204 1 !
; 2205 1 ! SIDE EFFECTS:
; 2206 1 !
; 2207 1 ! None.
; 2208 1 !
; 2209 1 !--
; 2210 1
; 2211 2 BEGIN
; 2212 2 !
; 2213 2 ! Completion codes returned:
; 2214 2 !
; 2215 2 EXTERNAL LITERAL
; 2216 2 KER_NORMAL, ! Normal return
; 2217 2 KER_NOMORFILES, ! No more files to read
; 2218 2 KER_RMS32; ! RMS-32 error
; 2219 2
; 2220 2 EXTERNAL ROUTINE
; 2221 2 TT_TEXT : NOVALUE; ! Output an ASCIZ string
; 2222 2
; 2223 2 LOCAL
; 2224 2 SIZE : WORD, ! Size of the $FAO string
; 2225 2 STATUS; ! Random status values
; 2226 2
; 2227 2 !
; 2228 2 ! If we can't do a search, just return no more files
; 2229 2 !
; 2230 2
; 2231 2 IF NOT .SEARCH_FLAG THEN RETURN KER_NOMORFILES;
; 2232 2
; 2233 2 !
; 2234 2 ! Now search for the next file that we want to process.
; 2235 2 !
; 2236 2 STATUS = $SEARCH (FAB = FILE_FAB);
; 2237 2
; 2238 2 IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES;
; 2239 2
; 2240 2 IF NOT .STATUS
; 2241 2 THEN
; 2242 3 BEGIN
; 2243 3 FILE_ERROR (.STATUS);
; 2244 3 RETURN KER_RMS32;
; 2245 2 END;
; 2246 2
; 2247 2 !
; 2248 2 ! Now we have the new file name. All that we have to do is open the file
; 2249 2 ! for reading now.
; 2250 2 !
; 2251 2 STATUS = OPEN_READING ();
; 2252 2
; 2253 2 IF NOT .STATUS THEN RETURN .STATUS;
; 2254 2
; 2255 2 !
; 2256 2 ! Copy the file name based on the type of file name we are to use.
; 2257 2 ! The possibilities are:
; 2258 2 ! Normal - Just copy name and type
; 2259 2 ! Full - Copy entire name string (either resultant or expanded)
; 2260 2 ! Untranslated - Copy string from name on (includes version, etc.)
; 2261 2
; 2262 2 SELECTONE .FIL_NORMAL_FORM OF
; 2263 2 SET
; 2264 2
; 2265 2 [FNM_FULL] :
; 2266 3 BEGIN
; 2267 3
; 2268 3 IF .FILE_NAM [NAM$B_RSL] GTR 0
; 2269 3 THEN
; 2270 4 BEGIN
; 2271 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), CHR_NUL,
; 2272 4 MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2273 4 SIZE = .FILE_NAM [NAM$B_RSL];
; 2274 4 END
; 2275 3 ELSE
; 2276 4 BEGIN
; 2277 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), CHR_NUL,
; 2278 4 MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2279 4 SIZE = .FILE_NAM [NAM$B_ESL];
; 2280 4 END
; 2281 4
; 2282 2 END;
; 2283 2
; 2284 2 [FNM_NORMAL, FNM_UNTRAN] :
; 2285 3 BEGIN
; 2286 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
; 2287 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
; 2288 3 MAX_FILE_NAME, CH$PTR (FILE_NAME));
; 2289 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
; 2290 2 END;
; 2291 2 TES;
; 2292 2
; 2293 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;
; 2294 2
; 2295 2 !
; 2296 2 ! Put prompt for NEXT_FILE sending in here
; 2297 2 !
; 2298 2 IF ( NOT .CONNECT_FLAG) AND .TY_FIL
; 2299 2 THEN
; 2300 3 BEGIN
; 2301 3 TT_TEXT (UPLIT (%ASCIZ 'Sending: '));
; 2302 3 .FILE_NAM [NAM$L_RSA] + .FILE_NAM [NAM$B_RSL] = 0;
; 2303 3 TT_TEXT (.FILE_NAM [NAM$L_RSA]);
; 2304 3 TT_TEXT (UPLIT (%ASCIZ ' as '));
; 2305 3 TT_OUTPUT ();
; 2306 2 END;
; 2307 2
; 2308 2 RETURN KER_NORMAL;
; 2309 1 END; ! End of NEXT_FILE
.PSECT $PLIT$,NOWRT,NOEXE,2
P.AAD: .ASCII \Sending: \<0><0><0> ; 3A 67 6E 69 64 6E 65 53 00014
; 00 00 00 20 0001C
P.AAE: .ASCII \ as \<0><0><0><0> ; 00 00 00 00 20 73 61 20 00020
.EXTRN KER_NOMORFILES
.PSECT $CODE$,NOWRT,2
.ENTRY NEXT_FILE, ^M<R2,R3,R4,R5,R6,R7,-;NEXT_FILE, Save R2,R3,R4,R5,R6,R7,- 2172 0FFC 00000
R8,R9,R10,R11> ;R8,R9,R10,R11
BLBC G^U.7, 1$ ;U.7, 1$ 2231 19 00000000' 00 E9 00002
PUSHAB G^U.10 ;U.10 2236 00000000' 00 9F 00009
CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH 00000000G 00 01 FB 0000F
MOVL R0, R2 ;R0, STATUS 52 50 D0 00016
CMPL R2, #99018 ;STATUS, #99018 2238 000182CA 8F 52 D1 00019
BNEQ 2$ ;2$ 08 12 00020
1$: MOVL #KER_NOMORFILES, R0 ;#KER_NOMORFILES, R0 50 00000000G 8F D0 00022
RET ; 04 00029
2$: BLBS R2, 3$ ;STATUS, 3$ 2240 11 52 E8 0002A
PUSHL R2 ;STATUS 2243 52 DD 0002D
CALLS #1, G^U.6 ;#1, U.6 00000000V 00 01 FB 0002F
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2244 50 00000000G 8F D0 00036
RET ; 04 0003D
3$: CALLS #0, W^U.35 ;#0, U.35 2251 F7A1 CF 00 FB 0003E
MOVL R0, R2 ;R0, STATUS 52 50 D0 00043
BLBS R2, 4$ ;STATUS, 4$ 2253 04 52 E8 00046
MOVL R2, R0 ;STATUS, R0 50 52 D0 00049
RET ; 04 0004C
4$: MOVL G^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 2262 50 00000000G 00 D0 0004D
CMPL R0, #2 ;R0, #2 2265 02 50 D1 00054
BNEQ 7$ ;7$ 31 12 00057
MOVZBL G^U.11+3, R6 ;U.11+3, R6 2268 56 00000000' 00 9A 00059
BLEQ 5$ ;5$ 09 15 00060
MOVL G^U.11+4, R0 ;U.11+4, R0 2271 50 00000000' 00 D0 00062
BRB 6$ ;6$ 2272 0E 11 00069
5$: MOVZBL G^U.11+11, R6 ;U.11+11, R6 2277 56 00000000' 00 9A 0006B
MOVL G^U.11+12, R0 ;U.11+12, R0 50 00000000' 00 D0 00072
6$: MOVC5 R6, (R0), #0, #132, G^FILE_NAME ;R6, (R0), #0, #132, FILE_NAME 2278 60 56 2C 00079
; 0084 8F 00 0007C
; 00000000G 00 00080
MOVW R6, R7 ;R6, SIZE 2279 57 56 B0 00085
BRB 10$ ;10$ 2262 49 11 00088
7$: CMPL R0, #1 ;R0, #1 2284 01 50 D1 0008A
BEQL 8$ ;8$ 05 13 0008D
CMPL R0, #4 ;R0, #4 04 50 D1 0008F
BNEQ 10$ ;10$ 3F 12 00092
8$: MOVZBL G^U.11+59, R11 ;U.11+59, R11 2286 5B 00000000' 00 9A 00094
MOVL G^U.11+76, R0 ;U.11+76, R0 50 00000000' 00 D0 0009B
MOVZBL G^U.11+60, R10 ;U.11+60, R10 2287 5A 00000000' 00 9A 000A2
MOVL G^U.11+80, R9 ;U.11+80, R9 59 00000000' 00 D0 000A9
MOVZBL #132, R8 ;#132, R8 2288 58 84 8F 9A 000B0
MOVAB G^FILE_NAME, R6 ;FILE_NAME, R6 56 00000000G 00 9E 000B4
MOVC5 R11, (R0), #0, R8, (R6) ;R11, (R0), #0, R8, (R6) 60 5B 2C 000BB
; 58 00 000BE
; 66 000C0
BGEQ 9$ ;9$ 0C 18 000C1
ADDL2 R11, R6 ;R11, R6 56 5B C0 000C3
SUBL2 R11, R8 ;R11, R8 58 5B C2 000C6
MOVC5 R10, (R9), #0, R8, (R6) ;R10, (R9), #0, R8, (R6) 69 5A 2C 000C9
; 58 00 000CC
; 66 000CE
9$: ADDW3 R10, R11, R7 ;R10, R11, SIZE 2289 5B 5A A1 000CF
; 57 000D2
10$: CMPW R7, #132 ;SIZE, #132 2293 0084 8F 57 B1 000D3
BLEQU 11$ ;11$ 0A 1B 000D8
MOVZBL #132, G^FILE_SIZE ;#132, FILE_SIZE 00000000G 00 84 8F 9A 000DA
BRB 12$ ;12$ 07 11 000E2
11$: MOVZWL R7, G^FILE_SIZE ;SIZE, FILE_SIZE 00000000G 00 57 3C 000E4
12$: BLBS G^CONNECT_FLAG, 13$ ;CONNECT_FLAG, 13$ 2298 44 00000000G 00 E8 000EB
BLBC G^TY_FIL, 13$ ;TY_FIL, 13$ 3D 00000000G 00 E9 000F2
PUSHAB G^P.AAD ;P.AAD 2301 00000000' 00 9F 000F9
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 000FF
MOVL G^U.11+4, R0 ;U.11+4, R0 2302 50 00000000' 00 D0 00106
MOVZBL G^U.11+3, R1 ;U.11+3, R1 51 00000000' 00 9A 0010D
PUSHAB (R1)[R0] ;(R1)[R0] 6140 9F 00114
CLRL @(SP)+ ;@(SP)+ 9E D4 00117
PUSHL R0 ;R0 2303 50 DD 00119
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 0011B
PUSHAB G^P.AAE ;P.AAE 2304 00000000' 00 9F 00122
CALLS #1, G^TT_TEXT ;#1, TT_TEXT 00000000G 00 01 FB 00128
CALLS #0, G^TT_OUTPUT ;#0, TT_OUTPUT 2305 00000000G 00 00 FB 0012F
13$: MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2308 50 00000000G 8F D0 00136
RET ; 04 0013D
; Routine Size: 318 bytes, Routine Base: $CODE$ + 0CF1
; 2310 1
; 2311 1 %SBTTL 'LOG_OPEN - Open a log file'
; 2312 1
; 2313 1 GLOBAL ROUTINE LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) =
; 2314 1
; 2315 1 !++
; 2316 1 ! FUNCTIONAL DESCRIPTION:
; 2317 1 !
; 2318 1 ! CALLING SEQUENCE:
; 2319 1 !
; 2320 1 ! STATUS = LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB)
; 2321 1 !
; 2322 1 ! INPUT PARAMETERS:
; 2323 1 !
; 2324 1 ! LOG_DESC - Address of descriptor for file name to be opened
; 2325 1 !
; 2326 1 ! LOG_FAB - Address of FAB for file
; 2327 1 !
; 2328 1 ! LOG_RAB - Address of RAB for file
; 2329 1 !
; 2330 1 ! IMPLICIT INPUTS:
; 2331 1 !
; 2332 1 ! None.
; 2333 1 !
; 2334 1 ! OUPTUT PARAMETERS:
; 2335 1 !
; 2336 1 ! LOG_FAB and LOG_RAB updated.
; 2337 1 !
; 2338 1 ! IMPLICIT OUTPUTS:
; 2339 1 !
; 2340 1 ! None.
; 2341 1 !
; 2342 1 ! COMPLETION CODES:
; 2343 1 !
; 2344 1 ! Error code or true.
; 2345 1 !
; 2346 1 ! SIDE EFFECTS:
; 2347 1 !
; 2348 1 ! None.
; 2349 1 !
; 2350 1 !--
; 2351 1
; 2352 2 BEGIN
; 2353 2 !
; 2354 2 ! Completion codes returned:
; 2355 2 !
; 2356 2 EXTERNAL LITERAL
; 2357 2 KER_NORMAL, ! Normal return
; 2358 2 KER_RMS32; ! RMS-32 error
; 2359 2
; 2360 2 MAP
; 2361 2 LOG_DESC : REF BLOCK [8, BYTE], ! Name descriptor
; 2362 2 LOG_FAB : REF $FAB_DECL, ! FAB for file
; 2363 2 LOG_RAB : REF $RAB_DECL; ! RAB for file
; 2364 2
; 2365 2 LOCAL
; 2366 2 STATUS, ! Random status values
; 2367 2 REC_ADDRESS, ! Address of record buffer
; 2368 2 REC_SIZE; ! Size of record buffer
; 2369 2
; 2370 2 !
; 2371 2 ! Get memory for records
; 2372 2 !
; 2373 2 REC_SIZE = LOG_BUFF_SIZE;
; 2374 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
; 2375 2
; 2376 2 IF NOT .STATUS
; 2377 2 THEN
; 2378 3 BEGIN
; 2379 3 LIB$SIGNAL (.STATUS);
; 2380 3 RETURN .STATUS;
; 2381 2 END;
; 2382 2
; 2383 2 !
; 2384 2 ! Initialize the FAB and RAB
; 2385 2 !
; P 2386 2 $FAB_INIT (FAB = .LOG_FAB, FAC = PUT, FNA = .LOG_DESC [DSC$A_POINTER],
; P 2387 2 FNS = .LOG_DESC [DSC$W_LENGTH], FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR,
; 2388 2 RAT = CR, CTX = 0, DNA = UPLIT (%ASCII'.LOG'), DNS = 4);
; 2389 2 STATUS = $CREATE (FAB = .LOG_FAB);
; 2390 2
; 2391 2 IF NOT .STATUS
; 2392 2 THEN
; 2393 3 BEGIN
; 2394 3 FILE_ERROR (.STATUS);
; 2395 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ! Dump record buffer
; 2396 3 RETURN KER_RMS32;
; 2397 2 END;
; 2398 2
; P 2399 2 $RAB_INIT (RAB = .LOG_RAB, FAB = .LOG_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
; 2400 2 RSZ = .REC_SIZE, UBF = .REC_ADDRESS, USZ = .REC_SIZE, ROP = <NLK, WAT>, CTX = 0);
; 2401 2 STATUS = $CONNECT (RAB = .LOG_RAB);
; 2402 2
; 2403 2 IF NOT .STATUS
; 2404 2 THEN
; 2405 3 BEGIN
; 2406 3 FILE_ERROR (.STATUS);
; 2407 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
; 2408 3 $CLOSE (FAB = .LOG_FAB);
; 2409 3 RETURN KER_RMS32;
; 2410 3 END
; 2411 2 ELSE
; 2412 2 RETURN .STATUS;
; 2413 2
; 2414 1 END; ! End of LOG_OPEN
.PSECT $PLIT$,NOWRT,NOEXE,2
P.AAF: .ASCII \.LOG\ ; 47 4F 4C 2E 00028
.PSECT $CODE$,NOWRT,2
.ENTRY LOG_OPEN, ^M<R2,R3,R4,R5,R6,R7,- ;LOG_OPEN, Save R2,R3,R4,R5,R6,R7,- 2313 07FC 00000
R8,R9,R10> ;R8,R9,R10
MOVAB G^LIB$FREE_VM, R10 ;LIB$FREE_VM, R10 5A 00000000G 00 9E 00002
MOVAB G^U.6, R9 ;U.6, R9 59 00000000V 00 9E 00009
SUBL2 #8, SP ;#8, SP 5E 08 C2 00010
MOVZWL #256, 4(SP) ;#256, REC_SIZE 2373 04 AE 0100 8F 3C 00013
PUSHL SP ;SP 2374 5E DD 00019
PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0001B
CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM 00000000G 00 02 FB 0001E
MOVL R0, R8 ;R0, STATUS 58 50 D0 00025
BLBS R8, 1$ ;STATUS, 1$ 2376 0C 58 E8 00028
PUSHL R8 ;STATUS 2379 58 DD 0002B
CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 0002D
BRW 4$ ;4$ 2380 00BD 31 00034
1$: MOVL 8(AP), R7 ;LOG_FAB, R7 2388 57 08 AC D0 00037
MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, (R7) 6E 00 2C 0003B
; 0050 8F 00 0003E
; 67 00042
MOVW #20483, (R7) ;#20483, (R7) 67 5003 8F B0 00043
MOVL #270532674, 4(R7) ;#270532674, 4(R7) 04 A7 10200042 8F D0 00048
MOVB #1, 22(R7) ;#1, 22(R7) 16 A7 01 90 00050
MOVW #512, 29(R7) ;#512, 29(R7) 1D A7 0200 8F B0 00054
MOVB #2, 31(R7) ;#2, 31(R7) 1F A7 02 90 0005A
MOVL 4(AP), R0 ;LOG_DESC, R0 50 04 AC D0 0005E
MOVL 4(R0), 44(R7) ;4(R0), 44(R7) 2C A7 04 A0 D0 00062
MOVAB G^P.AAF, 48(R7) ;P.AAF, 48(R7) 30 A7 00000000' 00 9E 00067
MOVB (R0), 52(R7) ;(R0), 52(R7) 34 A7 60 90 0006F
MOVB #4, 53(R7) ;#4, 53(R7) 35 A7 04 90 00073
PUSHL R7 ;R7 2389 57 DD 00077
CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE 00000000G 00 01 FB 00079
MOVL R0, R8 ;R0, STATUS 58 50 D0 00080
BLBS R8, 2$ ;STATUS, 2$ 2391 0F 58 E8 00083
PUSHL R8 ;STATUS 2394 58 DD 00086
CALLS #1, (R9) ;#1, FILE_ERROR 69 01 FB 00088
PUSHL SP ;SP 2395 5E DD 0008B
PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0008D
CALLS #2, (R10) ;#2, LIB$FREE_VM 6A 02 FB 00090
BRB 3$ ;3$ 2396 57 11 00093
2$: MOVL 12(AP), R6 ;LOG_RAB, R6 2400 56 0C AC D0 00095
MOVC5 #0, (SP), #0, #68, (R6) ;#0, (SP), #0, #68, (R6) 6E 00 2C 00099
; 0044 8F 00 0009C
; 66 000A0
MOVW #17409, (R6) ;#17409, (R6) 66 4401 8F B0 000A1
MOVL #1179648, 4(R6) ;#1179648, 4(R6) 04 A6 00120000 8F D0 000A6
CLRB 30(R6) ;30(R6) 1E A6 94 000AE
MOVW 4(SP), 32(R6) ;REC_SIZE, 32(R6) 20 A6 04 AE B0 000B1
MOVW 4(SP), 34(R6) ;REC_SIZE, 34(R6) 22 A6 04 AE B0 000B6
MOVL (SP), 36(R6) ;REC_ADDRESS, 36(R6) 24 A6 6E D0 000BB
MOVL (SP), 40(R6) ;REC_ADDRESS, 40(R6) 28 A6 6E D0 000BF
MOVL R7, 60(R6) ;R7, 60(R6) 3C A6 57 D0 000C3
PUSHL R6 ;R6 2401 56 DD 000C7
CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 000C9
MOVL R0, R8 ;R0, STATUS 58 50 D0 000D0
BLBS R8, 4$ ;STATUS, 4$ 2403 1E 58 E8 000D3
PUSHL R8 ;STATUS 2406 58 DD 000D6
CALLS #1, (R9) ;#1, FILE_ERROR 69 01 FB 000D8
PUSHL SP ;SP 2407 5E DD 000DB
PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 000DD
CALLS #2, (R10) ;#2, LIB$FREE_VM 6A 02 FB 000E0
PUSHL R7 ;R7 2408 57 DD 000E3
CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 000E5
3$: MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2409 50 00000000G 8F D0 000EC
RET ; 04 000F3
4$: MOVL R8, R0 ;STATUS, R0 50 58 D0 000F4
RET ; 2412 04 000F7
; Routine Size: 248 bytes, Routine Base: $CODE$ + 0E2F
; 2415 1
; 2416 1 %SBTTL 'LOG_CLOSE - Close a log file'
; 2417 1
; 2418 1 GLOBAL ROUTINE LOG_CLOSE (LOG_FAB, LOG_RAB) =
; 2419 1
; 2420 1 !++
; 2421 1 ! FUNCTIONAL DESCRIPTION:
; 2422 1 !
; 2423 1 ! This routine will close an open log file. It will also ensure that
; 2424 1 !the last buffer gets dumped.
; 2425 1 !
; 2426 1 ! CALLING SEQUENCE:
; 2427 1 !
; 2428 1 ! STATUS = LOG_CLOSE (LOG_FAB, LOG_RAB);
; 2429 1 !
; 2430 1 ! INPUT PARAMETERS:
; 2431 1 !
; 2432 1 ! LOG_FAB - Address of log file FAB
; 2433 1 !
; 2434 1 ! LOG_RAB - Address of log file RAB
; 2435 1 !
; 2436 1 ! IMPLICIT INPUTS:
; 2437 1 !
; 2438 1 ! None.
; 2439 1 !
; 2440 1 ! OUPTUT PARAMETERS:
; 2441 1 !
; 2442 1 ! None.
; 2443 1 !
; 2444 1 ! IMPLICIT OUTPUTS:
; 2445 1 !
; 2446 1 ! None.
; 2447 1 !
; 2448 1 ! COMPLETION CODES:
; 2449 1 !
; 2450 1 ! Resulting status.
; 2451 1 !
; 2452 1 ! SIDE EFFECTS:
; 2453 1 !
; 2454 1 ! None.
; 2455 1 !
; 2456 1 !--
; 2457 1
; 2458 2 BEGIN
; 2459 2 !
; 2460 2 ! Completion codes returned:
; 2461 2 !
; 2462 2 EXTERNAL LITERAL
; 2463 2 KER_RMS32; ! RMS-32 error
; 2464 2
; 2465 2 MAP
; 2466 2 LOG_FAB : REF $FAB_DECL, ! FAB for log file
; 2467 2 LOG_RAB : REF $RAB_DECL; ! RAB for log file
; 2468 2
; 2469 2 LOCAL
; 2470 2 STATUS, ! Random status values
; 2471 2 REC_ADDRESS, ! Address of record buffer
; 2472 2 REC_SIZE; ! Size of record buffer
; 2473 2
; 2474 2 !
; 2475 2 ! First write out any outstanding data
; 2476 2 !
; 2477 2
; 2478 2 IF .LOG_RAB [RAB$L_CTX] GTR 0 THEN LOG_PUT (.LOG_RAB); ! Dump current buffer
; 2479 2
; 2480 2 !
; 2481 2 ! Return the buffer
; 2482 2 !
; 2483 2 REC_SIZE = LOG_BUFF_SIZE; ! Get size of buffer
; 2484 2 REC_ADDRESS = .LOG_RAB [RAB$L_RBF]; ! And address
; 2485 2 LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
; 2486 2 !
; 2487 2 ! Now disconnect the RAB
; 2488 2 !
; 2489 2 STATUS = $DISCONNECT (RAB = .LOG_RAB);
; 2490 2
; 2491 2 IF NOT .STATUS
; 2492 2 THEN
; 2493 3 BEGIN
; 2494 3 FILE_ERROR (.STATUS);
; 2495 3 RETURN KER_RMS32;
; 2496 2 END;
; 2497 2
; 2498 2 !
; 2499 2 ! Now we can close the file
; 2500 2 !
; 2501 2 STATUS = $CLOSE (FAB = .LOG_FAB);
; 2502 2
; 2503 2 IF NOT .STATUS THEN FILE_ERROR (.STATUS);
; 2504 2
; 2505 2 !
; 2506 2 ! And return the result
; 2507 2 !
; 2508 2 RETURN .STATUS;
; 2509 1 END; ! End of LOG_CLOSE
.EXTRN SYS$DISCONNECT
.ENTRY LOG_CLOSE, ^M<R2,R3> ;LOG_CLOSE, Save R2,R3 2418 000C 00000
MOVAB G^U.6, R3 ;U.6, R3 53 00000000V 00 9E 00002
SUBL2 #8, SP ;#8, SP 5E 08 C2 00009
MOVL 8(AP), R2 ;LOG_RAB, R2 2478 52 08 AC D0 0000C
TSTL 24(R2) ;24(R2) 18 A2 D5 00010
BLEQ 1$ ;1$ 09 15 00013
PUSHL R2 ;R2 52 DD 00015
CALLS #1, G^U.1 ;#1, U.1 00000000V 00 01 FB 00017
1$: MOVZWL #256, 4(SP) ;#256, REC_SIZE 2483 04 AE 0100 8F 3C 0001E
MOVL 40(R2), (SP) ;40(R2), REC_ADDRESS 2484 6E 28 A2 D0 00024
PUSHL SP ;SP 2485 5E DD 00028
PUSHAB 8(SP) ;REC_SIZE 08 AE 9F 0002A
CALLS #2, G^LIB$FREE_VM ;#2, LIB$FREE_VM 00000000G 00 02 FB 0002D
PUSHL R2 ;R2 2489 52 DD 00034
CALLS #1, G^SYS$DISCONNECT ;#1, SYS$DISCONNECT 00000000G 00 01 FB 00036
MOVL R0, R2 ;R0, STATUS 52 50 D0 0003D
BLBS R2, 2$ ;STATUS, 2$ 2491 0D 52 E8 00040
PUSHL R2 ;STATUS 2494 52 DD 00043
CALLS #1, (R3) ;#1, FILE_ERROR 63 01 FB 00045
MOVL #KER_RMS32, R0 ;#KER_RMS32, R0 2495 50 00000000G 8F D0 00048
RET ; 04 0004F
2$: PUSHL 4(AP) ;LOG_FAB 2501 04 AC DD 00050
CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 00053
MOVL R0, R2 ;R0, STATUS 52 50 D0 0005A
BLBS R2, 3$ ;STATUS, 3$ 2503 05 52 E8 0005D
PUSHL R2 ;STATUS 52 DD 00060
CALLS #1, (R3) ;#1, FILE_ERROR 63 01 FB 00062
3$: MOVL R2, R0 ;STATUS, R0 2508 50 52 D0 00065
RET ; 04 00068
; Routine Size: 105 bytes, Routine Base: $CODE$ + 0F27
; 2510 1
; 2511 1 %SBTTL 'LOG_CHAR - Log a character to a file'
; 2512 1
; 2513 1 GLOBAL ROUTINE LOG_CHAR (CH, LOG_RAB) =
; 2514 1
; 2515 1 !++
; 2516 1 ! FUNCTIONAL DESCRIPTION:
; 2517 1 !
; 2518 1 ! This routine will write one character to an open log file.
; 2519 1 !If the buffer becomes filled, it will dump it. It will also
; 2520 1 !dump the buffer if a carriage return line feed is seen.
; 2521 1 !
; 2522 1 ! CALLING SEQUENCE:
; 2523 1 !
; 2524 1 ! STATUS = LOG_CHAR (.CH, LOG_RAB);
; 2525 1 !
; 2526 1 ! INPUT PARAMETERS:
; 2527 1 !
; 2528 1 ! CH - The character to write to the file.
; 2529 1 !
; 2530 1 ! LOG_RAB - The address of the log file RAB.
; 2531 1 !
; 2532 1 ! IMPLICIT INPUTS:
; 2533 1 !
; 2534 1 ! None.
; 2535 1 !
; 2536 1 ! OUPTUT PARAMETERS:
; 2537 1 !
; 2538 1 ! None.
; 2539 1 !
; 2540 1 ! IMPLICIT OUTPUTS:
; 2541 1 !
; 2542 1 ! None.
; 2543 1 !
; 2544 1 ! COMPLETION CODES:
; 2545 1 !
; 2546 1 ! Any error returned by LOG_PUT, else TRUE.
; 2547 1 !
; 2548 1 ! SIDE EFFECTS:
; 2549 1 !
; 2550 1 ! None.
; 2551 1 !
; 2552 1 !--
; 2553 1
; 2554 2 BEGIN
; 2555 2 !
; 2556 2 ! Completion codes returned:
; 2557 2 !
; 2558 2 EXTERNAL LITERAL
; 2559 2 KER_NORMAL; ! Normal return
; 2560 2
; 2561 2 MAP
; 2562 2 LOG_RAB : REF $RAB_DECL; ! Log file RAB
; 2563 2
; 2564 2 LOCAL
; 2565 2 STATUS; ! Random status value
; 2566 2
; 2567 2 !
; 2568 2 ! If this character is a line feed, and previous was a carriage return, then
; 2569 2 ! dump the buffer and return.
; 2570 2 !
; 2571 2
; 2572 2 IF .CH EQL CHR_LFD
; 2573 2 THEN
; 2574 3 BEGIN
; 2575 3 !
; 2576 3 ! If we seem to have overfilled the buffer, that is because we saw a CR
; 2577 3 ! last, and had no place to put it. Just reset the size and dump the buffer.
; 2578 3 !
; 2579 3
; 2580 3 IF .LOG_RAB [RAB$L_CTX] GTR LOG_BUFF_SIZE
; 2581 3 THEN
; 2582 4 BEGIN
; 2583 4 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE;
; 2584 4 RETURN LOG_PUT (.LOG_RAB);
; 2585 3 END;
; 2586 3
; 2587 3 !
; 2588 3 ! If last character in buffer is a CR, then dump buffer without the CR
; 2589 3 !
; 2590 3
; 2591 3 IF CH$RCHAR (CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX] - 1)) EQL CHR_CRT
; 2592 3 THEN
; 2593 4 BEGIN
; 2594 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] - 1;
; 2595 4 RETURN LOG_PUT (.LOG_RAB);
; 2596 3 END;
; 2597 3
; 2598 2 END;
; 2599 2
; 2600 2 !
; 2601 2 ! Don't need to dump buffer because of end of line problems. Check if
; 2602 2 ! the buffer is full.
; 2603 2 !
; 2604 2
; 2605 2 IF .LOG_RAB [RAB$L_CTX] GEQ LOG_BUFF_SIZE
; 2606 2 THEN
; 2607 3 BEGIN
; 2608 3 !
; 2609 3 ! If character we want to store is a carriage return, then just count it and
; 2610 3 ! don't dump the buffer yet.
; 2611 3 !
; 2612 3
; 2613 3 IF .CH EQL CHR_CRT
; 2614 3 THEN
; 2615 4 BEGIN
; 2616 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
; 2617 4 RETURN KER_NORMAL;
; 2618 3 END;
; 2619 3
; 2620 3 !
; 2621 3 ! We must dump the buffer to make room for more characters
; 2622 3 !
; 2623 3 STATUS = LOG_PUT (.LOG_RAB);
; 2624 3
; 2625 3 IF NOT .STATUS THEN RETURN .STATUS;
; 2626 3
; 2627 2 END;
; 2628 2
; 2629 2 !
; 2630 2 ! Here when we have some room to store the character
; 2631 2 !
; 2632 2 CH$WCHAR (.CH, CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX]));
; 2633 2 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
; 2634 2 RETURN KER_NORMAL;
; 2635 1 END; ! End of LOG_CHAR
.ENTRY LOG_CHAR, ^M<R2,R3> ;LOG_CHAR, Save R2,R3 2513 000C 00000
MOVAB G^U.1, R3 ;U.1, R3 53 00000000V 00 9E 00002
CMPL 4(AP), #10 ;CH, #10 2572 0A 04 AC D1 00009
BNEQ 3$ ;3$ 2B 12 0000D
MOVL 8(AP), R2 ;LOG_RAB, R2 2580 52 08 AC D0 0000F
CMPL 24(R2), #256 ;24(R2), #256 00000100 8F 18 A2 D1 00013
BLEQ 1$ ;1$ 08 15 0001B
MOVZWL #256, 24(R2) ;#256, 24(R2) 2583 18 A2 0100 8F 3C 0001D
BRB 2$ ;2$ 2584 0F 11 00023
1$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 2591 28 A2 18 A2 C1 00025
; 50 0002A
CMPB -1(R0), #13 ;-1(R0), #13 0D FF A0 91 0002B
BNEQ 3$ ;3$ 09 12 0002F
DECL 24(R2) ;24(R2) 2594 18 A2 D7 00031
2$: PUSHL R2 ;R2 2595 52 DD 00034
CALLS #1, (R3) ;#1, LOG_PUT 63 01 FB 00036
RET ; 04 00039
3$: MOVL 8(AP), R2 ;LOG_RAB, R2 2605 52 08 AC D0 0003A
CMPL 24(R2), #256 ;24(R2), #256 00000100 8F 18 A2 D1 0003E
BLSS 4$ ;4$ 0E 19 00046
CMPL 4(AP), #13 ;CH, #13 2613 0D 04 AC D1 00048
BEQL 5$ ;5$ 12 13 0004C
PUSHL R2 ;R2 2623 52 DD 0004E
CALLS #1, (R3) ;#1, LOG_PUT 63 01 FB 00050
BLBC R0, 6$ ;STATUS, 6$ 2625 14 50 E9 00053
4$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 2632 28 A2 18 A2 C1 00056
; 50 0005B
MOVB 4(AP), (R0) ;CH, (R0) 60 04 AC 90 0005C
5$: INCL 24(R2) ;24(R2) 2633 18 A2 D6 00060
MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2634 50 00000000G 8F D0 00063
6$: RET ; 04 0006A
; Routine Size: 107 bytes, Routine Base: $CODE$ + 0F90
; 2636 1
; 2637 1 %SBTTL 'LOG_LINE - Log a line to a log file'
; 2638 1
; 2639 1 GLOBAL ROUTINE LOG_LINE (LINE_DESC, LOG_RAB) =
; 2640 1
; 2641 1 !++
; 2642 1 ! FUNCTIONAL DESCRIPTION:
; 2643 1 !
; 2644 1 ! This routine will write an entire line to a log file. And previously
; 2645 1 ! written characters will be dumped first.
; 2646 1 !
; 2647 1 ! CALLING SEQUENCE:
; 2648 1 !
; 2649 1 ! STATUS = LOG_LINE (LINE_DESC, LOG_RAB);
; 2650 1 !
; 2651 1 ! INPUT PARAMETERS:
; 2652 1 !
; 2653 1 ! LINE_DESC - Address of descriptor for string to be written
; 2654 1 !
; 2655 1 ! LOG_RAB - RAB for log file
; 2656 1 !
; 2657 1 ! IMPLICIT INPUTS:
; 2658 1 !
; 2659 1 ! None.
; 2660 1 !
; 2661 1 ! OUPTUT PARAMETERS:
; 2662 1 !
; 2663 1 ! None.
; 2664 1 !
; 2665 1 ! IMPLICIT OUTPUTS:
; 2666 1 !
; 2667 1 ! None.
; 2668 1 !
; 2669 1 ! COMPLETION CODES:
; 2670 1 !
; 2671 1 ! KER_NORMAL or LOG_PUT error code.
; 2672 1 !
; 2673 1 ! SIDE EFFECTS:
; 2674 1 !
; 2675 1 ! None.
; 2676 1 !
; 2677 1 !--
; 2678 1
; 2679 2 BEGIN
; 2680 2
; 2681 2 MAP
; 2682 2 LINE_DESC : REF BLOCK [8, BYTE], ! Descriptor for string
; 2683 2 LOG_RAB : REF $RAB_DECL; ! RAB for file
; 2684 2
; 2685 2 LOCAL
; 2686 2 STATUS; ! Random status value
; 2687 2
; 2688 2 !
; 2689 2 ! First check if anything is already in the buffer
; 2690 2 !
; 2691 2
; 2692 2 IF .LOG_RAB [RAB$L_CTX] GTR 0
; 2693 2 THEN
; 2694 3 BEGIN
; 2695 3 STATUS = LOG_PUT (.LOG_RAB); ! Yes, write it out
; 2696 3
; 2697 3 IF NOT .STATUS THEN RETURN .STATUS; ! Pass back any errors
; 2698 3
; 2699 2 END;
; 2700 2
; 2701 2 !
; 2702 2 ! Copy the data to the buffer
; 2703 2 !
; 2704 2 CH$COPY (.LINE_DESC [DSC$W_LENGTH], CH$PTR (.LINE_DESC [DSC$A_POINTER]), CHR_NUL,
; 2705 2 LOG_BUFF_SIZE, CH$PTR (.LOG_RAB [RAB$L_RBF]));
; 2706 2
; 2707 2 IF .LINE_DESC [DSC$W_LENGTH] GTR LOG_BUFF_SIZE
; 2708 2 THEN
; 2709 2 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE
; 2710 2 ELSE
; 2711 2 LOG_RAB [RAB$L_CTX] = .LINE_DESC [DSC$W_LENGTH];
; 2712 2
; 2713 2 !
; 2714 2 ! Now just dump the buffer
; 2715 2 !
; 2716 2 RETURN LOG_PUT (.LOG_RAB);
; 2717 1 END; ! End of LOG_LINE
.ENTRY LOG_LINE, ^M<R2,R3,R4,R5,R6,R7,- ;LOG_LINE, Save R2,R3,R4,R5,R6,R7,R8 2639 01FC 00000
R8> ;
MOVAB G^U.1, R8 ;U.1, R8 58 00000000V 00 9E 00002
MOVL 8(AP), R6 ;LOG_RAB, R6 2692 56 08 AC D0 00009
TSTL 24(R6) ;24(R6) 18 A6 D5 0000D
BLEQ 1$ ;1$ 08 15 00010
PUSHL R6 ;R6 2695 56 DD 00012
CALLS #1, (R8) ;#1, LOG_PUT 68 01 FB 00014
BLBC R0, 4$ ;STATUS, 4$ 2697 26 50 E9 00017
1$: MOVL 4(AP), R7 ;LINE_DESC, R7 2704 57 04 AC D0 0001A
MOVC5 (R7), @4(R7), #0, #256, @40(R6) ;(R7), @4(R7), #0, #256, @40(R6) 2705 04 B7 67 2C 0001E
; 0100 8F 00 00022
; 28 B6 00026
CMPW (R7), #256 ;(R7), #256 2707 0100 8F 67 B1 00028
BLEQU 2$ ;2$ 08 1B 0002D
MOVZWL #256, 24(R6) ;#256, 24(R6) 2709 18 A6 0100 8F 3C 0002F
BRB 3$ ;3$ 04 11 00035
2$: MOVZWL (R7), 24(R6) ;(R7), 24(R6) 2711 18 A6 67 3C 00037
3$: PUSHL R6 ;R6 2716 56 DD 0003B
CALLS #1, (R8) ;#1, LOG_PUT 68 01 FB 0003D
4$: RET ; 04 00040
; Routine Size: 65 bytes, Routine Base: $CODE$ + 0FFB
; 2718 1 %SBTTL 'LOG_FAOL - Log an FAO string to the log file'
; 2719 1
; 2720 1 GLOBAL ROUTINE LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB) =
; 2721 1
; 2722 1 !++
; 2723 1 ! FUNCTIONAL DESCRIPTION:
; 2724 1 !
; 2725 1 ! This routine will write an FAOL string to the output file.
; 2726 1 !
; 2727 1 ! CALLING SEQUENCE:
; 2728 1 !
; 2729 1 ! STATUS = LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB);
; 2730 1 !
; 2731 1 ! INPUT PARAMETERS:
; 2732 1 !
; 2733 1 ! FAOL_DESC - Address of descriptor for string to be written
; 2734 1 !
; 2735 1 ! FAOL_PARAMS - Parameter list for FAOL call
; 2736 1 !
; 2737 1 ! LOG_RAB - RAB for log file
; 2738 1 !
; 2739 1 ! IMPLICIT INPUTS:
; 2740 1 !
; 2741 1 ! None.
; 2742 1 !
; 2743 1 ! OUPTUT PARAMETERS:
; 2744 1 !
; 2745 1 ! None.
; 2746 1 !
; 2747 1 ! IMPLICIT OUTPUTS:
; 2748 1 !
; 2749 1 ! None.
; 2750 1 !
; 2751 1 ! COMPLETION CODES:
; 2752 1 !
; 2753 1 ! KER_NORMAL or $FAOL or LOG_PUT error code.
; 2754 1 !
; 2755 1 ! SIDE EFFECTS:
; 2756 1 !
; 2757 1 ! None.
; 2758 1 !
; 2759 1 !--
; 2760 1
; 2761 2 BEGIN
; 2762 2 !
; 2763 2 ! Completion codes returned:
; 2764 2 !
; 2765 2 EXTERNAL LITERAL
; 2766 2 KER_NORMAL; ! Normal return
; 2767 2
; 2768 2 MAP
; 2769 2 FAOL_DESC : REF BLOCK [8, BYTE], ! Descriptor for string
; 2770 2 LOG_RAB : REF $RAB_DECL; ! RAB for file
; 2771 2
; 2772 2 LITERAL
; 2773 2 FAOL_BUFSIZ = 256; ! Length of buffer
; 2774 2
; 2775 2 LOCAL
; 2776 2 FAOL_BUFFER : VECTOR [FAOL_BUFSIZ, BYTE], ! Buffer for FAOL output
; 2777 2 FAOL_BUF_DESC : BLOCK [8, BYTE], ! Descriptor for buffer
; 2778 2 STATUS; ! Random status value
; 2779 2
; 2780 2 !
; 2781 2 ! Initialize descriptor for buffer
; 2782 2 !
; 2783 2 FAOL_BUF_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
; 2784 2 FAOL_BUF_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
; 2785 2 FAOL_BUF_DESC [DSC$A_POINTER] = FAOL_BUFFER;
; 2786 2 FAOL_BUF_DESC [DSC$W_LENGTH] = FAOL_BUFSIZ;
; 2787 2 !
; 2788 2 ! Now do the FAOL to generate the full text
; 2789 2 !
; P 2790 2 STATUS = $FAOL (CTRSTR = .FAOL_DESC, OUTBUF = FAOL_BUF_DESC,
; 2791 2 OUTLEN = FAOL_BUF_DESC [DSC$W_LENGTH], PRMLST = .FAOL_PARAMS);
; 2792 2 IF NOT .STATUS THEN RETURN .STATUS;
; 2793 2 !
; 2794 2 ! Dump the text into the file
; 2795 2 !
; 2796 2 INCR I FROM 1 TO .FAOL_BUF_DESC [DSC$W_LENGTH] DO
; 2797 3 BEGIN
; 2798 3 STATUS = LOG_CHAR ( .FAOL_BUFFER [.I - 1], .LOG_RAB);
; 2799 3 IF NOT .STATUS THEN RETURN .STATUS;
; 2800 2 END;
; 2801 2
; 2802 2 RETURN KER_NORMAL;
; 2803 2
; 2804 1 END; ! End of LOG_FAOL
.EXTRN SYS$FAOL
.ENTRY LOG_FAOL, ^M<R2,R3> ;LOG_FAOL, Save R2,R3 2720 000C 00000
MOVAB -260(SP), SP ;-260(SP), SP 5E FEFC CE 9E 00002
PUSHL #17694976 ;#17694976 2786 010E0100 8F DD 00007
MOVAB 8(SP), 4(SP) ;FAOL_BUFFER, FAOL_BUF_DESC+4 2785 04 AE 08 AE 9E 0000D
PUSHL 8(AP) ;FAOL_PARAMS 2791 08 AC DD 00012
PUSHAB 4(SP) ;FAOL_BUF_DESC 04 AE 9F 00015
PUSHAB 8(SP) ;FAOL_BUF_DESC 08 AE 9F 00018
PUSHL 4(AP) ;FAOL_DESC 04 AC DD 0001B
CALLS #4, G^SYS$FAOL ;#4, SYS$FAOL 00000000G 00 04 FB 0001E
BLBC R0, 3$ ;STATUS, 3$ 2792 22 50 E9 00025
MOVZWL (SP), R3 ;FAOL_BUF_DESC, R3 2796 53 6E 3C 00028
CLRL R2 ;I 52 D4 0002B
BRB 2$ ;2$ 10 11 0002D
1$: PUSHL 12(AP) ;LOG_RAB 2798 0C AC DD 0002F
MOVZBL 11(SP)[R2], -(SP) ;FAOL_BUFFER-1[I], -(SP) 7E 0B AE42 9A 00032
CALLS #2, W^LOG_CHAR ;#2, LOG_CHAR FF18 CF 02 FB 00037
BLBC R0, 3$ ;STATUS, 3$ 2799 0B 50 E9 0003C
2$: AOBLEQ R3, R2, 1$ ;R3, I, 1$ 2796 52 53 F3 0003F
; EC 00042
MOVL #KER_NORMAL, R0 ;#KER_NORMAL, R0 2802 50 00000000G 8F D0 00043
3$: RET ; 04 0004A
; Routine Size: 75 bytes, Routine Base: $CODE$ + 103C
; 2805 1
; 2806 1 %SBTTL 'LOG_PUT - Write a record buffer for a log file'
; 2807 1 ROUTINE LOG_PUT (LOG_RAB) =
; 2808 1
; 2809 1 !++
; 2810 1 ! FUNCTIONAL DESCRIPTION:
; 2811 1 !
; 2812 1 ! This routine will output one buffer for a log file.
; 2813 1 !
; 2814 1 ! CALLING SEQUENCE:
; 2815 1 !
; 2816 1 ! STATUS = LOG_PUT (LOG_RAB);
; 2817 1 !
; 2818 1 ! INPUT PARAMETERS:
; 2819 1 !
; 2820 1 ! LOG_RAB - RAB for log file.
; 2821 1 !
; 2822 1 ! IMPLICIT INPUTS:
; 2823 1 !
; 2824 1 ! None.
; 2825 1 !
; 2826 1 ! OUPTUT PARAMETERS:
; 2827 1 !
; 2828 1 ! None.
; 2829 1 !
; 2830 1 ! IMPLICIT OUTPUTS:
; 2831 1 !
; 2832 1 ! None.
; 2833 1 !
; 2834 1 ! COMPLETION CODES:
; 2835 1 !
; 2836 1 ! Status value from RMS
; 2837 1 !
; 2838 1 ! SIDE EFFECTS:
; 2839 1 !
; 2840 1 ! None.
; 2841 1 !
; 2842 1 !--
; 2843 1
; 2844 2 BEGIN
; 2845 2
; 2846 2 MAP
; 2847 2 LOG_RAB : REF $RAB_DECL; ! RAB for file
; 2848 2
; 2849 2 !
; 2850 2 ! Calculate record size
; 2851 2 !
; 2852 2 LOG_RAB [RAB$W_RSZ] = .LOG_RAB [RAB$L_CTX];
; 2853 2 LOG_RAB [RAB$W_USZ] = .LOG_RAB [RAB$W_RSZ];
; 2854 2 !
; 2855 2 ! Buffer will be empty when we finish
; 2856 2 !
; 2857 2 LOG_RAB [RAB$L_CTX] = 0;
; 2858 2 !
; 2859 2 ! And call RMS to write the buffer
; 2860 2 !
; 2861 2 RETURN $PUT (RAB = .LOG_RAB);
; 2862 1 END; ! End of LOG_PUT
;LOG_PUT
U.1: .WORD ^M<> ;Save nothing 2807 0000 00000
MOVL 4(AP), R0 ;LOG_RAB, R0 2852 50 04 AC D0 00002
MOVW 24(R0), 34(R0) ;24(R0), 34(R0) 22 A0 18 A0 B0 00006
MOVW 34(R0), 32(R0) ;34(R0), 32(R0) 2853 20 A0 22 A0 B0 0000B
CLRL 24(R0) ;24(R0) 2857 18 A0 D4 00010
PUSHL R0 ;R0 2861 50 DD 00013
CALLS #1, G^SYS$PUT ;#1, SYS$PUT 00000000G 00 01 FB 00015
RET ; 04 0001C
; Routine Size: 29 bytes, Routine Base: $CODE$ + 1087
; 2863 1 %SBTTL 'FILE_ERROR - Error processing for all RMS errors'
; 2864 1 ROUTINE FILE_ERROR (STATUS) : NOVALUE =
; 2865 1
; 2866 1 !++
; 2867 1 ! FUNCTIONAL DESCRIPTION:
; 2868 1 !
; 2869 1 ! This routine will process all of the RMS-32 error returns. It will
; 2870 1 ! get the text for the error and then it will issue a KER_ERROR for
; 2871 1 ! the RMS failure.
; 2872 1 !
; 2873 1 ! CALLING SEQUENCE:
; 2874 1 !
; 2875 1 ! FILE_ERROR();
; 2876 1 !
; 2877 1 ! INPUT PARAMETERS:
; 2878 1 !
; 2879 1 ! None.
; 2880 1 !
; 2881 1 ! IMPLICIT INPUTS:
; 2882 1 !
; 2883 1 ! STATUS - RMS error status.
; 2884 1 ! FILE_NAME - File name and extension.
; 2885 1 ! FILE_SIZE - Size of the thing in FILE_NAME.
; 2886 1 !
; 2887 1 ! OUTPUT PARAMETERS:
; 2888 1 !
; 2889 1 ! None.
; 2890 1 !
; 2891 1 ! IMPLICIT OUTPUTS:
; 2892 1 !
; 2893 1 ! None.
; 2894 1 !
; 2895 1 ! COMPLETION CODES:
; 2896 1 !
; 2897 1 ! None.
; 2898 1 !
; 2899 1 ! SIDE EFFECTS:
; 2900 1 !
; 2901 1 ! None.
; 2902 1 !
; 2903 1 !--
; 2904 1
; 2905 2 BEGIN
; 2906 2 !
; 2907 2 ! KERMIT completion codes
; 2908 2 !
; 2909 2 EXTERNAL LITERAL
; 2910 2 KER_RMS32; ! RMS-32 error
; 2911 2
; 2912 2 LOCAL
; 2913 2 ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)],
; 2914 2 ERR_DESC : BLOCK [8, BYTE] PRESET ! String descriptor to
; 2915 2 ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! the error buffer
; 2916 2 [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! standard string
; 2917 2 [DSC$W_LENGTH ] = MAX_MSG, ! descriptor
; 2918 2 [DSC$A_POINTER ] = ERR_BUFFER);
; 2919 2
; P 2920 2 $GETMSG (MSGID = .STATUS,
; P 2921 2 MSGLEN = ERR_DESC [DSC$W_LENGTH],
; P 2922 2 BUFADR = ERR_DESC,
; 2923 2 FLAGS = 1);
; 2924 2 LIB$SIGNAL (KER_RMS32, 2, ERR_DESC, FILE_DESC);
; 2925 1 END; ! End of FILE_ERROR
.EXTRN SYS$GETMSG
;FILE_ERROR
U.6: .WORD ^M<> ;Save nothing 2864 0000 00000
MOVAB -1008(SP), SP ;-1008(SP), SP 5E FC10 CE 9E 00002
PUSHL #17695722 ;#17695722 2918 010E03EA 8F DD 00007
MOVAB 8(SP), 4(SP) ;ERR_BUFFER, ERR_DESC+4 04 AE 08 AE 9E 0000D
MOVQ #1, -(SP) ;#1, -(SP) 2923 7E 01 7D 00012
PUSHAB 8(SP) ;ERR_DESC 08 AE 9F 00015
PUSHAB 12(SP) ;ERR_DESC 0C AE 9F 00018
PUSHL 4(AP) ;STATUS 04 AC DD 0001B
CALLS #5, G^SYS$GETMSG ;#5, SYS$GETMSG 00000000G 00 05 FB 0001E
PUSHAB G^FILE_DESC ;FILE_DESC 2924 00000000' 00 9F 00025
PUSHAB 4(SP) ;ERR_DESC 04 AE 9F 0002B
PUSHL #2 ;#2 02 DD 0002E
PUSHL #KER_RMS32 ;#KER_RMS32 00000000G 8F DD 00030
CALLS #4, G^LIB$SIGNAL ;#4, LIB$SIGNAL 00000000G 00 04 FB 00036
RET ; 2925 04 0003D
; Routine Size: 62 bytes, Routine Base: $CODE$ + 10A4
; 2926 1 %SBTTL 'End of KERFIL'
; 2927 1 END ! End of module
; 2928 1
; 2929 0 ELUDOM
; PSECT SUMMARY
;
; Name Bytes Attributes
;
; $OWN$ 857 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2)
; $GLOBAL$ 20 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2)
; $CODE$ 4322 NOVEC,NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2)
; . ABS . 0 NOVEC,NOWRT,NORD ,NOEXE,NOSHR, LCL, ABS, CON,NOPIC,ALIGN(0)
; $PLIT$ 44 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2)
; Library Statistics
;
; -------- Symbols -------- Pages Processing
; File Total Loaded Percent Mapped Time
;
; SYS$COMMON:[SYSLIB]STARLET.L32;2 12540 136 1 721 00:00.4
; COMMAND QUALIFIERS
; BLIS/LIS/MACH=(ASSEM,UNIQUE)/SOURCE=NOHEAD VMSFIL.BLI
; Compilation Complete
.END
