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