; 0001 0 MODULE KERFIL (IDENT = '3.1.053' ; 0002 0 ) = ; 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 ; 0116 1 %SBTTL 'Forward definitions' ; 0117 1 ; 0118 1 FORWARD ROUTINE ; 0119 1 LOG_PUT, ! Write a buffer out ; 0120 1 DUMP_BUFFER, ! Worker routine for FILE_DUMP. ; 0121 1 GET_BUFFER, ! Routine to do $GET ; 0122 1 GET_ASCII, ! Get an ASCII character ; 0123 1 GET_BLOCK, ! Get a block character ; 0124 1 FILE_ERROR : NOVALUE; ! Error processing routine ; 0125 1 ; 0126 1 %SBTTL 'Require/Library files' ; 0127 1 ! ; 0128 1 ! INCLUDE FILES: ; 0129 1 ! ; 0130 1 ; 0131 1 LIBRARY 'SYS$LIBRARY:STARLET'; ; 0132 1 ; 0133 1 REQUIRE 'KERCOM.REQ'; ; 0338 1 ; 0339 1 REQUIRE 'KERERR.REQ'; ; 0404 1 ; 0405 1 %SBTTL 'Macro definitions' ; 0406 1 ! ; 0407 1 ! MACROS: ; 0408 1 ! ; 0409 1 %SBTTL 'Literal symbol definitions' ; 0410 1 ! ; 0411 1 ! EQUATED SYMBOLS: ; 0412 1 ! ; 0413 1 ! ; 0414 1 ! Various states for reading the data from the file ; 0415 1 ! ; 0416 1 ; 0417 1 LITERAL ; 0418 1 F_STATE_PRE = 0, ! Prefix state ; 0419 1 F_STATE_PRE1 = 1, ! Other prefix state ; 0420 1 F_STATE_DATA = 2, ! Data processing state ; 0421 1 F_STATE_POST = 3, ! Postfix processing state ; 0422 1 F_STATE_POST1 = 4, ! Secondary postfix processing state ; 0423 1 F_STATE_MIN = 0, ! Min state number ; 0424 1 F_STATE_MAX = 4; ! Max state number ; 0425 1 ; 0426 1 ! ; 0427 1 ! Buffer size for log file ; 0428 1 ! ; 0429 1 ; 0430 1 LITERAL ; 0431 1 LOG_BUFF_SIZE = 256; ! Number of bytes in log file buffer ; 0432 1 ; 0433 1 %SBTTL 'Local storage' ; 0434 1 ! ; 0435 1 ! OWN STORAGE: ; 0436 1 ! ; 0437 1 ; 0438 1 OWN ; 0439 1 SEARCH_FLAG, ! Can/cannot do $SEARCH ; 0440 1 DEV_CLASS, ! Type of device we are reading ; 0441 1 EOF_FLAG, ! End of file reached. ; 0442 1 FILE_FAB : $FAB_DECL, ! FAB for file processing ; 0443 1 FILE_NAM : $NAM_DECL, ! NAM for file processing ; 0444 1 FILE_RAB : $RAB_DECL, ! RAB for file processing ; 0445 1 FILE_XABFHC : $XABFHC_DECL, ! XAB for file processing ; 0446 1 FILE_MODE, ! Mode of file (reading/writing) ; 0447 1 FILE_REC_POINTER, ! Pointer to the record information ; 0448 1 FILE_REC_COUNT, ! Count of the number of bytes ; 0449 1 REC_SIZE : LONG, ! Record size ; 0450 1 REC_ADDRESS : LONG, ! Record address ; 0451 1 FIX_SIZE : LONG, ! Fixed control region size ; 0452 1 FIX_ADDRESS : LONG, ! Address of buffer for fixed control region ; 0453 1 EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0454 1 RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0455 1 RES_STR_D : BLOCK [8, BYTE]; ! Descriptor for the string ; 0456 1 ; 0457 1 %SBTTL 'Global storage' ; 0458 1 ! ; 0459 1 ! Global storage: ; 0460 1 ! ; 0461 1 ; 0462 1 GLOBAL ; 0463 1 FILE_TYPE, ! Type of file being xfered ; 0464 1 FILE_DESC : BLOCK [8, BYTE]; ! File name descriptor ; 0465 1 ; 0466 1 %SBTTL 'External routines and storage' ; 0467 1 ! ; 0468 1 ! EXTERNAL REFERENCES: ; 0469 1 ! ; 0470 1 ! ; 0471 1 ! Storage in KERMSG ; 0472 1 ! ; 0473 1 ; 0474 1 EXTERNAL ; 0475 1 ALT_FILE_SIZE, ! Number of characters in FILE_NAME ; 0476 1 ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! Storage ; 0477 1 FILE_SIZE, ! Number of characters in FILE_NAME ; 0478 1 FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ; 0479 1 TY_FIL, ![026] Flag that file names are being typed ; 0480 1 CONNECT_FLAG, ![026] Indicator of whether we have a terminal to type on ; 0481 1 FIL_NORMAL_FORM; ![026] File specification type ; 0482 1 ; 0483 1 ![026] ; 0484 1 ![026] Routines in KERTT ; 0485 1 ![026] ; 0486 1 ; 0487 1 EXTERNAL ROUTINE ; 0488 1 TT_OUTPUT : NOVALUE, ! Force buffered output ; 0489 1 TT_TEXT : NOVALUE; ! Output an ASCIZ string ; 0490 1 ; 0491 1 ! ; 0492 1 ! System libraries ; 0493 1 ! ; 0494 1 ; 0495 1 EXTERNAL ROUTINE ; 0496 1 LIB$GET_VM : ADDRESSING_MODE (GENERAL), ; 0497 1 LIB$FREE_VM : ADDRESSING_MODE (GENERAL), ; 0498 1 LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; ; 0499 1 ; 0500 1 %SBTTL 'File processing -- FILE_INIT - Initialization' ; 0501 1 ; 0502 1 GLOBAL ROUTINE FILE_INIT : NOVALUE = ; 0503 1 ; 0504 1 !++ ; 0505 1 ! FUNCTIONAL DESCRIPTION: ; 0506 1 ! ; 0507 1 ! This routine will initialize some of the storage in the file processing ; 0508 1 ! module. ; 0509 1 ! ; 0510 1 ! CALLING SEQUENCE: ; 0511 1 ! ; 0512 1 ! FILE_INIT(); ; 0513 1 ! ; 0514 1 ! INPUT PARAMETERS: ; 0515 1 ! ; 0516 1 ! None. ; 0517 1 ! ; 0518 1 ! IMPLICIT INPUTS: ; 0519 1 ! ; 0520 1 ! None. ; 0521 1 ! ; 0522 1 ! OUTPUT PARAMETERS: ; 0523 1 ! ; 0524 1 ! None. ; 0525 1 ! ; 0526 1 ! IMPLICIT OUTPUTS: ; 0527 1 ! ; 0528 1 ! None. ; 0529 1 ! ; 0530 1 ! COMPLETION CODES: ; 0531 1 ! ; 0532 1 ! None. ; 0533 1 ! ; 0534 1 ! SIDE EFFECTS: ; 0535 1 ! ; 0536 1 ! None. ; 0537 1 ! ; 0538 1 !-- ; 0539 1 ; 0540 2 BEGIN ; 0541 2 FILE_TYPE = FILE_ASC; ; 0542 2 ! Now set up the file specification descriptor ; 0543 2 FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0544 2 FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0545 2 FILE_DESC [DSC$A_POINTER] = FILE_NAME; ; 0546 2 FILE_DESC [DSC$W_LENGTH] = 0; ; 0547 2 EOF_FLAG = FALSE; ; 0548 1 END; ! End of FILE_INIT .TITLE KERFIL .IDENT \3.1.053\ .PSECT $OWN$,NOEXE,2 ;SEARCH_FLAG U.7: .BLKB 4 ;DEV_CLASS U.8: .BLKB 4 ;EOF_FLAG U.9: .BLKB 4 ;FILE_FAB U.10: .BLKB 80 ;FILE_NAM U.11: .BLKB 96 ;FILE_RAB U.12: .BLKB 68 ;FILE_XABFHC U.13: .BLKB 44 ;FILE_MODE U.14: .BLKB 4 ;FILE_REC_POINTER U.15: .BLKB 4 ;FILE_REC_COUNT U.16: .BLKB 4 ;REC_SIZE U.17: .BLKB 4 ;REC_ADDRESS U.18: .BLKB 4 ;FIX_SIZE U.19: .BLKB 4 ;FIX_ADDRESS U.20: .BLKB 4 ;EXP_STR U.21: .BLKB 256 ;RES_STR U.22: .BLKB 256 ;RES_STR_D U.23: .BLKB 8 .PSECT $GLOBAL$,NOEXE,2 FILE_TYPE:: .BLKB 4 FILE_DESC:: .BLKB 8 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== 100 .EXTRN ALT_FILE_SIZE, ALT_FILE_NAME, FILE_SIZE, FILE_NAME, TY_FIL, CONNECT_FLAG, FIL_NORMAL_FORM .EXTRN TT_OUTPUT, TT_TEXT, LIB$GET_VM, LIB$FREE_VM, LIB$SIGNAL .PSECT $CODE$,NOWRT,2 .ENTRY FILE_INIT, ^M<> ;FILE_INIT, Save nothing ; 0502 MOVL #1, W^FILE_TYPE ;#1, FILE_TYPE ; 0541 MOVL #17694720, W^FILE_DESC ;#17694720, FILE_DESC ; 0546 MOVAB W^FILE_NAME, W^FILE_DESC+4 ;FILE_NAME, FILE_DESC+4 ; 0545 CLRL W^U.9 ;U.9 ; 0547 RET ; ; 0548 ; Routine Size: 28 bytes, Routine Base: $CODE$ + 0000 ; 0549 1 ; 0550 1 %SBTTL 'GET_FILE' ; 0551 1 ; 0552 1 GLOBAL ROUTINE GET_FILE (CHARACTER) = ; 0553 1 ; 0554 1 !++ ; 0555 1 ! FUNCTIONAL DESCRIPTION: ; 0556 1 ! ; 0557 1 ! This routine will return a character from the input file. ; 0558 1 ! The character will be stored into the location specified by ; 0559 1 ! CHARACTER. ; 0560 1 ! ; 0561 1 ! CALLING SEQUENCE: ; 0562 1 ! ; 0563 1 ! GET_FILE (LOCATION_TO_STORE_CHAR); ; 0564 1 ! ; 0565 1 ! INPUT PARAMETERS: ; 0566 1 ! ; 0567 1 ! LOCATION_TO_STORE_CHAR - This is the address to store the character ; 0568 1 ! into. ; 0569 1 ! ; 0570 1 ! IMPLICIT INPUTS: ; 0571 1 ! ; 0572 1 ! None. ; 0573 1 ! ; 0574 1 ! OUTPUT PARAMETERS: ; 0575 1 ! ; 0576 1 ! Character stored into the location specified. ; 0577 1 ! ; 0578 1 ! IMPLICIT OUTPUTS: ; 0579 1 ! ; 0580 1 ! None. ; 0581 1 ! ; 0582 1 ! COMPLETION CODES: ; 0583 1 ! ; 0584 1 ! True - Character stored into the location specified. ; 0585 1 ! False - End of file reached. ; 0586 1 ! ; 0587 1 ! SIDE EFFECTS: ; 0588 1 ! ; 0589 1 ! None. ; 0590 1 ! ; 0591 1 !-- ; 0592 1 ; 0593 2 BEGIN ; 0594 2 ; 0595 2 LOCAL ; 0596 2 STATUS; ! Random status values ; 0597 2 ; 0598 2 IF .EOF_FLAG THEN RETURN KER_EOF; ; 0599 2 ; 0600 2 SELECTONE .FILE_TYPE OF ; 0601 2 SET ; 0602 2 ; 0603 2 [FILE_ASC, FILE_BIN, FILE_FIX] : ; 0604 2 STATUS = GET_ASCII (.CHARACTER); ; 0605 2 ; 0606 2 [FILE_BLK] : ; 0607 2 STATUS = GET_BLOCK (.CHARACTER); ; 0608 2 TES; ; 0609 2 ; 0610 2 RETURN .STATUS; ; 0611 1 END; ! End of GET_FILE .ENTRY GET_FILE, ^M<> ;GET_FILE, Save nothing ; 0552 BLBC W^U.9, 1$ ;U.9, 1$ ; 0598 MOVL #134316131, R0 ;#134316131, R0 ; RET ; ; 1$: MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 0600 BLEQ 2$ ;2$ ; 0603 CMPL R0, #2 ;R0, #2 ; BLEQ 3$ ;3$ ; 2$: CMPL R0, #4 ;R0, #4 ; BNEQ 4$ ;4$ ; 3$: PUSHL 4(AP) ;CHARACTER ; 0604 CALLS #1, W^U.4 ;#1, U.4 ; RET ; ; 4$: CMPL R0, #3 ;R0, #3 ; 0606 BNEQ 5$ ;5$ ; PUSHL 4(AP) ;CHARACTER ; 0607 CALLS #1, W^U.5 ;#1, U.5 ; 5$: RET ; ; 0611 ; Routine Size: 55 bytes, Routine Base: $CODE$ + 001C ; 0612 1 ; 0613 1 %SBTTL 'GET_ASCII - Get a character from an ASCII file' ; 0614 1 ROUTINE GET_ASCII (CHARACTER) = ; 0615 1 ; 0616 1 !++ ; 0617 1 ! FUNCTIONAL DESCRIPTION: ; 0618 1 ! ; 0619 1 ! CALLING SEQUENCE: ; 0620 1 ! ; 0621 1 ! INPUT PARAMETERS: ; 0622 1 ! ; 0623 1 ! None. ; 0624 1 ! ; 0625 1 ! IMPLICIT INPUTS: ; 0626 1 ! ; 0627 1 ! None. ; 0628 1 ! ; 0629 1 ! OUPTUT PARAMETERS: ; 0630 1 ! ; 0631 1 ! None. ; 0632 1 ! ; 0633 1 ! IMPLICIT OUTPUTS: ; 0634 1 ! ; 0635 1 ! None. ; 0636 1 ! ; 0637 1 ! COMPLETION CODES: ; 0638 1 ! ; 0639 1 ! None. ; 0640 1 ! ; 0641 1 ! SIDE EFFECTS: ; 0642 1 ! ; 0643 1 ! None. ; 0644 1 ! ; 0645 1 !-- ; 0646 1 ; 0647 2 BEGIN ; 0648 2 ; 0649 2 OWN ; 0650 2 CC_COUNT, ! Count of the number of CC things to output ; 0651 2 CC_TYPE; ! Type of carriage control being processed. ; 0652 2 ; 0653 2 LOCAL ; 0654 2 STATUS, ! For status values ; 0655 2 RAT; ; 0656 2 ; 0657 2 RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK); ; 0658 2 ; 0659 2 IF .DEV_CLASS EQL DC$_MAILBOX THEN RAT = FAB$M_CR; ! Mailbox needs CR's ; 0660 2 ; 0661 2 WHILE TRUE DO ; 0662 3 BEGIN ; 0663 3 ; 0664 3 SELECTONE .RAT OF ; 0665 3 SET ; 0666 3 ; 0667 3 [FAB$M_PRN, FAB$M_FTN, FAB$M_CR] : ; 0668 3 ; 0669 3 CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF ; 0670 3 SET ; 0671 3 ; 0672 3 [F_STATE_PRE] : ; 0673 4 BEGIN ; 0674 4 STATUS = GET_BUFFER (); ; 0675 4 ; 0676 4 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS; ; 0677 4 ; 0678 4 SELECTONE .RAT OF ; 0679 4 SET ; 0680 4 ; 0681 4 [FAB$M_CR] : ; 0682 5 BEGIN ; 0683 5 ![017] .CHARACTER = CHR_LFD; ; 0684 5 ![017] Just switch state to data. This means we won't get leading line feeds ; 0685 5 ![017] since nothing seems to like them anyway. ; 0686 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0687 5 ![017] RETURN KER_NORMAL; ; 0688 4 END; ; 0689 4 ; 0690 4 [FAB$M_PRN] : ; 0691 5 BEGIN ; 0692 5 ; 0693 5 LOCAL ; 0694 5 TEMP_POINTER; ; 0695 5 ; 0696 5 TEMP_POINTER = CH$PTR (.FILE_RAB [RAB$L_RHB]); ; 0697 5 CC_COUNT = CH$RCHAR_A (TEMP_POINTER); ; 0698 5 CC_TYPE = CH$RCHAR_A (TEMP_POINTER); ; 0699 5 ; 0700 5 IF .CC_COUNT<7, 1> EQL 0 ; 0701 5 THEN ; 0702 6 BEGIN ; 0703 6 ; 0704 6 IF .CC_COUNT<0, 7> NEQ 0 ; 0705 6 THEN ; 0706 7 BEGIN ; 0707 7 .CHARACTER = CHR_LFD; ; 0708 7 CC_COUNT = .CC_COUNT - 1; ; 0709 7 ; 0710 7 IF .CC_COUNT GTR 0 ; 0711 7 THEN ; 0712 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1 ; 0713 7 ELSE ; 0714 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0715 7 ; 0716 7 RETURN KER_NORMAL; ; 0717 7 END ; 0718 6 ELSE ; 0719 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0720 6 ; 0721 6 END ; 0722 5 ELSE ; 0723 6 BEGIN ; 0724 6 ; 0725 6 SELECTONE .CC_COUNT<5, 2> OF ; 0726 6 SET ; 0727 6 ; 0728 6 [%B'00'] : ; 0729 7 BEGIN ; 0730 7 .CHARACTER = .CC_COUNT<0, 5>; ; 0731 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0732 7 RETURN KER_NORMAL; ; 0733 6 END; ; 0734 6 ; 0735 6 [%B'10'] : ; 0736 7 BEGIN ; 0737 7 .CHARACTER = .CC_COUNT<0, 5> + 128; ; 0738 7 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0739 7 RETURN KER_NORMAL; ; 0740 6 END; ; 0741 6 ; 0742 6 [OTHERWISE, %B'11'] : ; 0743 6 RETURN KER_ILLFILTYP; ; 0744 6 TES; ; 0745 6 ; 0746 5 END; ; 0747 5 ; 0748 4 END; ; 0749 4 ; 0750 4 [FAB$M_FTN] : ; 0751 5 BEGIN ; 0752 5 IF .FILE_REC_COUNT LEQ 0 ; 0753 5 THEN ; 0754 5 CC_TYPE = %C' ' ; 0755 5 ELSE ; 0756 6 BEGIN ; 0757 6 CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); ; 0758 6 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0759 5 END; ; 0760 5 ; 0761 5 SELECTONE .CC_TYPE OF ; 0762 5 SET ; 0763 5 ; 0764 5 [CHR_NUL] : ; 0765 6 BEGIN ; 0766 6 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0767 6 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0768 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0769 5 END; ; 0770 5 ; 0771 5 [%C'0'] : ; 0772 6 BEGIN ; 0773 6 .CHARACTER = CHR_LFD; ; 0774 6 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; ; 0775 6 CC_COUNT = 1; ; 0776 5 END; ; 0777 5 ; 0778 5 [%C'1'] : ; 0779 6 BEGIN ; 0780 6 .CHARACTER = CHR_FFD; ; 0781 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0782 6 RETURN KER_NORMAL; ; 0783 5 END; ; 0784 5 ; 0785 5 [%C'+'] : ; 0786 6 BEGIN ; 0787 6 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0788 6 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0789 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0790 5 END; ; 0791 5 ; 0792 5 [%C'$', %C' '] : ; 0793 6 BEGIN ; 0794 6 .CHARACTER = CHR_LFD; ; 0795 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0796 5 END; ; 0797 5 ; 0798 5 [OTHERWISE] : ; 0799 6 BEGIN ; 0800 6 .CHARACTER = .CC_TYPE; ; 0801 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0802 5 END; ; 0803 5 TES; ; 0804 5 ; 0805 5 RETURN KER_NORMAL; ; 0806 4 END; ; 0807 4 TES; ; 0808 4 ; 0809 3 END; ; 0810 3 ; 0811 3 [F_STATE_PRE1] : ; 0812 3 ; 0813 3 IF .RAT EQL FAB$M_FTN OR .RAT EQL FAB$M_PRN ; 0814 3 THEN ; 0815 4 BEGIN ; 0816 4 .CHARACTER = CHR_LFD; ; 0817 4 CC_COUNT = .CC_COUNT - 1; ; 0818 4 ; 0819 4 IF .CC_COUNT LEQ 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0820 4 ; 0821 4 RETURN KER_NORMAL; ; 0822 4 END ; 0823 3 ELSE ; 0824 3 RETURN KER_ILLFILTYP; ; 0825 3 ; 0826 3 [F_STATE_DATA] : ; 0827 4 BEGIN ; 0828 4 ; 0829 4 IF .FILE_REC_COUNT LEQ 0 ; 0830 4 THEN ; 0831 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST ; 0832 4 ELSE ; 0833 5 BEGIN ; 0834 5 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0835 5 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0836 5 RETURN KER_NORMAL; ; 0837 4 END; ; 0838 4 ; 0839 3 END; ; 0840 3 ; 0841 3 [F_STATE_POST] : ; 0842 4 BEGIN ; 0843 4 ; 0844 4 SELECTONE .RAT OF ; 0845 4 SET ; 0846 4 ; 0847 4 [FAB$M_CR] : ; 0848 5 BEGIN ; 0849 5 .CHARACTER = CHR_CRT; ; 0850 5 FILE_FAB [FAB$L_CTX] = F_STATE_POST1; ; 0851 5 ![017] So we get a line feed ; 0852 5 RETURN KER_NORMAL; ; 0853 4 END; ; 0854 4 ; 0855 4 [FAB$M_FTN] : ; 0856 5 BEGIN ; 0857 5 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0858 5 ; 0859 5 IF .CC_TYPE NEQ CHR_NUL AND .CC_TYPE NEQ %C'$' ; 0860 5 THEN ; 0861 6 BEGIN ; 0862 6 .CHARACTER = CHR_CRT; ; 0863 6 RETURN KER_NORMAL; ; 0864 5 END; ; 0865 5 ; 0866 4 END; ; 0867 4 ; 0868 4 [FAB$M_PRN] : ; 0869 5 BEGIN ; 0870 5 ; 0871 5 IF .CC_TYPE<7, 1> EQL 0 ; 0872 5 THEN ; 0873 6 BEGIN ; 0874 6 ; 0875 6 IF .CC_TYPE<0, 7> NEQ 0 ; 0876 6 THEN ; 0877 7 BEGIN ; 0878 7 .CHARACTER = CHR_LFD; ; 0879 7 CC_COUNT = .CC_TYPE; ; 0880 7 FILE_FAB [FAB$L_CTX] = F_STATE_POST1; ; 0881 7 RETURN KER_NORMAL; ; 0882 7 END ; 0883 6 ELSE ; 0884 6 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0885 6 ; 0886 6 END ; 0887 5 ELSE ; 0888 6 BEGIN ; 0889 6 ; 0890 6 SELECTONE .CC_TYPE<5, 2> OF ; 0891 6 SET ; 0892 6 ; 0893 6 [%B'00'] : ; 0894 7 BEGIN ; 0895 7 .CHARACTER = .CC_TYPE<0, 5>; ; 0896 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0897 7 RETURN KER_NORMAL; ; 0898 6 END; ; 0899 6 ; 0900 6 [%B'10'] : ; 0901 7 BEGIN ; 0902 7 .CHARACTER = .CC_TYPE<0, 5> + 128; ; 0903 7 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0904 7 RETURN KER_NORMAL; ; 0905 6 END; ; 0906 6 ; 0907 6 [OTHERWISE, %B'11'] : ; 0908 6 RETURN KER_ILLFILTYP; ; 0909 6 TES; ; 0910 6 ; 0911 5 END; ; 0912 5 ; 0913 4 END; ; 0914 4 TES; ! End SELECTONE .RAT ; 0915 4 ; 0916 3 END; ; 0917 3 ; 0918 3 [F_STATE_POST1] : ; 0919 3 ; 0920 3 IF .RAT EQL FAB$M_PRN ; 0921 3 THEN ; 0922 4 BEGIN ; 0923 4 .CHARACTER = CHR_LFD; ; 0924 4 CC_COUNT = .CC_COUNT - 1; ; 0925 4 ; 0926 4 IF .CC_COUNT LEQ 0 AND .RAT EQL FAB$M_FTN ; 0927 4 THEN ; 0928 4 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0929 4 ; 0930 4 IF .CC_COUNT LEQ -1 AND .RAT EQL FAB$M_PRN ; 0931 4 THEN ; 0932 5 BEGIN ; 0933 5 .CHARACTER = CHR_CRT; ; 0934 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0935 4 END; ; 0936 4 ; 0937 4 RETURN KER_NORMAL; ; 0938 4 END ; 0939 3 ELSE ; 0940 3 ![017] ; 0941 3 ![017] Generate line feed after CR for funny files ; 0942 3 ![017] ; 0943 3 ; 0944 3 IF .RAT EQL FAB$M_CR ; 0945 3 THEN ; 0946 4 BEGIN ; 0947 4 .CHARACTER = CHR_LFD; ![017] Return a line feed ; 0948 4 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0949 4 ![017] Next we get data ; 0950 4 RETURN KER_NORMAL; ; 0951 4 END ; 0952 3 ELSE ; 0953 3 RETURN KER_ILLFILTYP; ; 0954 3 ; 0955 3 TES; ! End of CASE .STATE ; 0956 3 ; 0957 3 [OTHERWISE] : ; 0958 4 BEGIN ; 0959 4 ; 0960 4 WHILE .FILE_REC_COUNT LEQ 0 DO ; 0961 5 BEGIN ; 0962 5 STATUS = GET_BUFFER (); ; 0963 5 ; 0964 5 IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS; ; 0965 5 ; 0966 4 END; ; 0967 4 ; 0968 4 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0969 4 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0970 4 RETURN KER_NORMAL; ; 0971 3 END; ; 0972 3 TES; ! End of SELECTONE .RAT ; 0973 3 ; 0974 2 END; ! End WHILE TRUE DO loop ; 0975 2 ; 0976 2 RETURN KER_ILLFILTYP; ! Shouldn't get here ; 0977 1 END; ! End of GET_ASCII .PSECT $OWN$,NOEXE,2 ;CC_COUNT U.28: .BLKB 4 ;CC_TYPE U.29: .BLKB 4 .PSECT $CODE$,NOWRT,2 ;GET_ASCII U.4: .WORD ^M ;Save R2,R3,R4 ; 0614 MOVAB W^U.28, R4 ;U.28, R4 ; MOVZBL -806(R4), R2 ;FILE_FAB+30, RAT ; 0657 BICL2 #8, R2 ;#8, RAT ; CMPL -844(R4), #160 ;DEV_CLASS, #160 ; 0659 BNEQ 1$ ;1$ ; MOVL #2, R2 ;#2, RAT ; 1$: TSTL R2 ;RAT ; 0667 BLEQ 2$ ;2$ ; CMPL R2, #2 ;RAT, #2 ; BLEQ 3$ ;3$ ; 2$: CMPL R2, #4 ;RAT, #4 ; BEQL 3$ ;3$ ; BRW 49$ ;49$ ; 3$: CASEL -812(R4), #0, #4 ;FILE_FAB+24, #0, #4 ; 0669 4$: .WORD 5$-4$,- ;5$-4$,- ; 27$-4$,- ;27$-4$,- ; 30$-4$,- ;30$-4$,- ; 32$-4$,- ;32$-4$,- ; 42$-4$ ;42$-4$ ; 5$: CALLS #0, W^U.3 ;#0, U.3 ; 0674 BLBS R0, 6$ ;STATUS, 6$ ; 0676 RET ; ; 6$: CMPL R0, #134316131 ;STATUS, #134316131 ; BNEQ 7$ ;7$ ; RET ; ; 7$: CMPL R2, #2 ;RAT, #2 ; 0681 BEQL 8$ ;8$ ; CMPL R2, #4 ;RAT, #4 ; 0690 BNEQ 14$ ;14$ ; MOVL -616(R4), R1 ;FILE_RAB+44, TEMP_POINTER ; 0696 MOVZBL (R1)+, (R4) ;(TEMP_POINTER)+, CC_COUNT ; 0697 MOVZBL (R1)+, 4(R4) ;(TEMP_POINTER)+, CC_TYPE ; 0698 TSTB (R4) ;CC_COUNT ; 0700 BLSS 10$ ;10$ ; BITB (R4), #127 ;CC_COUNT, #127 ; 0704 8$: BNEQ 9$ ;9$ ; BRW 38$ ;38$ ; 9$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0707 DECL (R4) ;CC_COUNT ; 0708 BLEQ 20$ ;20$ ; 0710 MOVL #1, -812(R4) ;#1, FILE_FAB+24 ; 0712 BRB 18$ ;18$ ; 10$: EXTZV #5, #2, (R4), R1 ;#5, #2, CC_COUNT, R1 ; 0725 BNEQ 11$ ;11$ ; 0728 EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER ; 0730 BRB 13$ ;13$ ; 0731 11$: CMPL R1, #2 ;R1, #2 ; 0735 BEQL 12$ ;12$ ; BRW 47$ ;47$ ; 12$: EXTZV #0, #5, (R4), @4(AP) ;#0, #5, CC_COUNT, @CHARACTER ; 0737 ADDL2 #128, @4(AP) ;#128, @CHARACTER ; 13$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 ; 0738 BRW 46$ ;46$ ; 0739 14$: CMPL R2, #1 ;RAT, #1 ; 0750 BEQL 15$ ;15$ ; BRW 1$ ;1$ ; 15$: TSTL -540(R4) ;FILE_REC_COUNT ; 0752 BGTR 16$ ;16$ ; MOVL #32, 4(R4) ;#32, CC_TYPE ; 0754 BRB 17$ ;17$ ; 16$: MOVZBL @-544(R4), 4(R4) ;@FILE_REC_POINTER, CC_TYPE ; 0757 INCL -544(R4) ;FILE_REC_POINTER ; DECL -540(R4) ;FILE_REC_COUNT ; 0758 17$: MOVL 4(R4), R1 ;CC_TYPE, R1 ; 0761 BEQL 22$ ;22$ ; 0764 CMPL R1, #48 ;R1, #48 ; 0771 BNEQ 19$ ;19$ ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0773 MOVL #1, -812(R4) ;#1, FILE_FAB+24 ; 0774 MOVL #1, (R4) ;#1, CC_COUNT ; 0775 18$: BRW 34$ ;34$ ; 0761 19$: CMPL R1, #49 ;R1, #49 ; 0778 BNEQ 21$ ;21$ ; MOVL #12, @4(AP) ;#12, @CHARACTER ; 0780 20$: BRB 26$ ;26$ ; 0781 21$: CMPL R1, #43 ;R1, #43 ; 0785 BNEQ 23$ ;23$ ; 22$: MOVZBL @-544(R4), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0787 INCL -544(R4) ;FILE_REC_POINTER ; DECL -540(R4) ;FILE_REC_COUNT ; 0788 BRB 26$ ;26$ ; 0789 23$: CMPL R1, #32 ;R1, #32 ; 0792 BEQL 24$ ;24$ ; CMPL R1, #36 ;R1, #36 ; BNEQ 25$ ;25$ ; 24$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0794 BRB 26$ ;26$ ; 0795 25$: MOVL R1, @4(AP) ;R1, @CHARACTER ; 0800 26$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 ; 0801 BRB 36$ ;36$ ; 0805 27$: CMPL R2, #1 ;RAT, #1 ; 0813 BEQL 28$ ;28$ ; CMPL R2, #4 ;RAT, #4 ; BEQL 28$ ;28$ ; BRW 47$ ;47$ ; 28$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0816 SOBGTR (R4), 29$ ;CC_COUNT, 29$ ; 0817 BRW 13$ ;13$ ; 0819 29$: BRW 46$ ;46$ ; 0817 30$: TSTL -540(R4) ;FILE_REC_COUNT ; 0829 BGTR 31$ ;31$ ; MOVL #3, -812(R4) ;#3, FILE_FAB+24 ; 0831 BRB 39$ ;39$ ; 31$: MOVZBL @-544(R4), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0834 INCL -544(R4) ;FILE_REC_POINTER ; DECL -540(R4) ;FILE_REC_COUNT ; 0835 BRB 36$ ;36$ ; 0836 32$: CMPL R2, #2 ;RAT, #2 ; 0847 BNEQ 35$ ;35$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0849 33$: MOVL #4, -812(R4) ;#4, FILE_FAB+24 ; 0850 34$: BRB 36$ ;36$ ; 0852 35$: CMPL R2, #1 ;RAT, #1 ; 0855 BNEQ 37$ ;37$ ; CLRL -812(R4) ;FILE_FAB+24 ; 0857 MOVL 4(R4), R1 ;CC_TYPE, R1 ; 0859 BEQL 39$ ;39$ ; CMPL R1, #36 ;R1, #36 ; BEQL 39$ ;39$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0862 36$: BRW 51$ ;51$ ; 0863 37$: CMPL R2, #4 ;RAT, #4 ; 0868 BNEQ 39$ ;39$ ; TSTB 4(R4) ;CC_TYPE ; 0871 BLSS 40$ ;40$ ; BITB 4(R4), #127 ;CC_TYPE, #127 ; 0875 BEQL 38$ ;38$ ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0878 MOVL 4(R4), (R4) ;CC_TYPE, CC_COUNT ; 0879 BRB 33$ ;33$ ; 0880 38$: MOVL #2, -812(R4) ;#2, FILE_FAB+24 ; 0884 39$: BRW 1$ ;1$ ; 0871 40$: EXTZV #5, #2, 4(R4), R1 ;#5, #2, CC_TYPE, R1 ; 0890 BNEQ 41$ ;41$ ; 0893 EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER ; 0895 BRB 45$ ;45$ ; 0896 41$: CMPL R1, #2 ;R1, #2 ; 0900 BNEQ 47$ ;47$ ; EXTZV #0, #5, 4(R4), @4(AP) ;#0, #5, CC_TYPE, @CHARACTER ; 0902 ADDL2 #128, @4(AP) ;#128, @CHARACTER ; BRB 45$ ;45$ ; 0903 42$: CLRL R3 ;R3 ; 0920 CMPL R2, #4 ;RAT, #4 ; BNEQ 44$ ;44$ ; INCL R3 ;R3 ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0923 DECL (R4) ;CC_COUNT ; 0924 MOVL (R4), R1 ;CC_COUNT, R1 ; 0926 BGTR 43$ ;43$ ; CMPL R2, #1 ;RAT, #1 ; BNEQ 43$ ;43$ ; MOVL #2, -812(R4) ;#2, FILE_FAB+24 ; 0928 43$: TSTL R1 ;R1 ; 0930 BGEQ 46$ ;46$ ; BLBC R3, 46$ ;R3, 46$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0933 BRW 13$ ;13$ ; 0934 44$: CMPL R2, #2 ;RAT, #2 ; 0944 BNEQ 47$ ;47$ ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0947 45$: CLRL -812(R4) ;FILE_FAB+24 ; 0948 46$: MOVL #134316043, R1 ;#134316043, R1 ; 0950 BRB 48$ ;48$ ; 47$: MOVL #134316154, R1 ;#134316154, R1 ; 0953 48$: MOVL R1, R0 ;R1, R0 ; 0944 RET ; ; 49$: TSTL -540(R4) ;FILE_REC_COUNT ; 0960 BGTR 50$ ;50$ ; CALLS #0, W^U.3 ;#0, U.3 ; 0962 BLBC R0, 52$ ;STATUS, 52$ ; 0964 CMPL R0, #134316131 ;STATUS, #134316131 ; BNEQ 49$ ;49$ ; RET ; ; 50$: DECL -540(R4) ;FILE_REC_COUNT ; 0968 MOVZBL @-544(R4), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0969 INCL -544(R4) ;FILE_REC_POINTER ; 51$: MOVL #134316043, R0 ;#134316043, R0 ; 0970 52$: RET ; ; 0977 ; Routine Size: 590 bytes, Routine Base: $CODE$ + 0053 ; 0978 1 %SBTTL 'GET_BLOCK - Get a character from a BLOCKed file' ; 0979 1 ROUTINE GET_BLOCK (CHARACTER) = ; 0980 1 ; 0981 1 !++ ; 0982 1 ! FUNCTIONAL DESCRIPTION: ; 0983 1 ! ; 0984 1 ! This routine will return the next byte from a blocked file. This ; 0985 1 ! routine will use the $READ RMS call to get the next byte from the ; 0986 1 ! file. This way all RMS header information can be passed to the ; 0987 1 ! other file system. ; 0988 1 ! ; 0989 1 ! CALLING SEQUENCE: ; 0990 1 ! ; 0991 1 ! STATUS = GET_BLOCK(CHARACTER); ; 0992 1 ! ; 0993 1 ! INPUT PARAMETERS: ; 0994 1 ! ; 0995 1 ! CHARACTER - Address to store the character in. ; 0996 1 ! ; 0997 1 ! IMPLICIT INPUTS: ; 0998 1 ! ; 0999 1 ! REC_POINTER - Pointer into the record. ; 1000 1 ! REC_ADDRESS - Address of the record. ; 1001 1 ! REC_COUNT - Count of the number of bytes left in the record. ; 1002 1 ! ; 1003 1 ! OUPTUT PARAMETERS: ; 1004 1 ! ; 1005 1 ! None. ; 1006 1 ! ; 1007 1 ! IMPLICIT OUTPUTS: ; 1008 1 ! ; 1009 1 ! None. ; 1010 1 ! ; 1011 1 ! COMPLETION CODES: ; 1012 1 ! ; 1013 1 ! KER_NORMAL - Got a byte ; 1014 1 ! KER_EOF - End of file gotten. ; 1015 1 ! ; 1016 1 ! SIDE EFFECTS: ; 1017 1 ! ; 1018 1 ! None. ; 1019 1 ! ; 1020 1 !-- ; 1021 1 ; 1022 2 BEGIN ; 1023 2 ; 1024 2 LOCAL ; 1025 2 STATUS; ! Random status values ; 1026 2 ; 1027 2 WHILE .FILE_REC_COUNT LEQ 0 DO ; 1028 3 BEGIN ; 1029 3 STATUS = $READ (RAB = FILE_RAB); ; 1030 3 ; 1031 3 IF NOT .STATUS ; 1032 3 THEN ; 1033 3 ; 1034 3 IF .STATUS EQL RMS$_EOF ; 1035 3 THEN ; 1036 4 BEGIN ; 1037 4 EOF_FLAG = TRUE; ; 1038 4 RETURN KER_EOF; ; 1039 4 END ; 1040 3 ELSE ; 1041 4 BEGIN ; 1042 4 FILE_ERROR (.STATUS); ; 1043 4 EOF_FLAG = TRUE; ; 1044 4 RETURN KER_RMS32; ; 1045 3 END; ; 1046 3 ; 1047 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1048 3 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 1049 2 END; ; 1050 2 ; 1051 2 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 1052 2 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 1053 2 RETURN KER_NORMAL; ; 1054 1 END; ! End of GET_BLOCK .EXTRN SYS$READ ;GET_BLOCK U.5: .WORD ^M ;Save R2,R3 ; 0979 MOVAB W^U.16, R3 ;U.16, R3 ; 1$: TSTL (R3) ;FILE_REC_COUNT ; 1027 BGTR 5$ ;5$ ; PUSHAB -120(R3) ;FILE_RAB ; 1029 CALLS #1, G^SYS$READ ;#1, SYS$READ ; MOVL R0, R2 ;R0, STATUS ; BLBS R2, 4$ ;STATUS, 4$ ; 1031 CMPL R2, #98938 ;STATUS, #98938 ; 1034 BNEQ 2$ ;2$ ; MOVL #134316131, R0 ;#134316131, R0 ; 1041 BRB 3$ ;3$ ; 2$: PUSHL R2 ;STATUS ; 1042 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1044 3$: MOVL #1, -300(R3) ;#1, EOF_FLAG ; 1037 RET ; ; 1041 4$: MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER ; 1047 MOVZWL -86(R3), (R3) ;FILE_RAB+34, FILE_REC_COUNT ; 1048 BRB 1$ ;1$ ; 1027 5$: DECL (R3) ;FILE_REC_COUNT ; 1051 MOVZBL @-4(R3), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 1052 INCL -4(R3) ;FILE_REC_POINTER ; MOVL #134316043, R0 ;#134316043, R0 ; 1053 RET ; ; 1054 ; Routine Size: 94 bytes, Routine Base: $CODE$ + 02A1 ; 1055 1 %SBTTL 'GET_BUFFER - Routine to read a buffer.' ; 1056 1 ROUTINE GET_BUFFER = ; 1057 1 ; 1058 1 !++ ; 1059 1 ! FUNCTIONAL DESCRIPTION: ; 1060 1 ! ; 1061 1 ! This routine will read a buffer from the disk file. It will ; 1062 1 ! return various status depending if there was an error reading ; 1063 1 ! the disk file or if the end of file is reached. ; 1064 1 ! ; 1065 1 ! CALLING SEQUENCE: ; 1066 1 ! ; 1067 1 ! STATUS = GET_BUFFER (); ; 1068 1 ! ; 1069 1 ! INPUT PARAMETERS: ; 1070 1 ! ; 1071 1 ! None. ; 1072 1 ! ; 1073 1 ! IMPLICIT INPUTS: ; 1074 1 ! ; 1075 1 ! None. ; 1076 1 ! ; 1077 1 ! OUTPUT PARAMETERS: ; 1078 1 ! ; 1079 1 ! None. ; 1080 1 ! ; 1081 1 ! IMPLICIT OUTPUTS: ; 1082 1 ! ; 1083 1 ! FILE_REC_POINTER - Pointer into the record. ; 1084 1 ! FILE_REC_COUNT - Count of the number of bytes in the record. ; 1085 1 ! ; 1086 1 ! COMPLETION CODES: ; 1087 1 ! ; 1088 1 ! KER_NORMAL - Got a buffer ; 1089 1 ! KER_EOF - End of file reached. ; 1090 1 ! KER_RMS32 - RMS error ; 1091 1 ! ; 1092 1 ! SIDE EFFECTS: ; 1093 1 ! ; 1094 1 ! None. ; 1095 1 ! ; 1096 1 !-- ; 1097 1 ; 1098 2 BEGIN ; 1099 2 ; 1100 2 LOCAL ; 1101 2 STATUS; ! Random status values ; 1102 2 ; 1103 2 STATUS = $GET (RAB = FILE_RAB); ; 1104 2 ; 1105 2 IF NOT .STATUS ; 1106 2 THEN ; 1107 2 ; 1108 2 IF .STATUS EQL RMS$_EOF ; 1109 2 THEN ; 1110 3 BEGIN ; 1111 3 EOF_FLAG = TRUE; ; 1112 3 RETURN KER_EOF; ; 1113 3 END ; 1114 2 ELSE ; 1115 3 BEGIN ; 1116 3 FILE_ERROR (.STATUS); ; 1117 3 EOF_FLAG = TRUE; ; 1118 3 RETURN KER_RMS32; ; 1119 2 END; ; 1120 2 ; 1121 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1122 2 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 1123 2 RETURN KER_NORMAL; ; 1124 1 END; .EXTRN SYS$GET ;GET_BUFFER U.3: .WORD ^M<> ;Save nothing ; 1056 PUSHAB W^U.12 ;U.12 ; 1103 CALLS #1, G^SYS$GET ;#1, SYS$GET ; BLBS R0, 3$ ;STATUS, 3$ ; 1105 CMPL R0, #98938 ;STATUS, #98938 ; 1108 BNEQ 1$ ;1$ ; MOVL #134316131, R0 ;#134316131, R0 ; 1115 BRB 2$ ;2$ ; 1$: PUSHL R0 ;STATUS ; 1116 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1118 2$: MOVL #1, W^U.9 ;#1, U.9 ; 1111 RET ; ; 1115 3$: MOVL W^U.18, W^U.15 ;U.18, U.15 ; 1121 MOVZWL W^U.12+34, W^U.16 ;U.12+34, U.16 ; 1122 MOVL #134316043, R0 ;#134316043, R0 ; 1123 RET ; ; 1124 ; Routine Size: 76 bytes, Routine Base: $CODE$ + 02FF ; 1125 1 %SBTTL 'PUT_FILE' ; 1126 1 ; 1127 1 GLOBAL ROUTINE PUT_FILE (CHARACTER) = ; 1128 1 ; 1129 1 !++ ; 1130 1 ! FUNCTIONAL DESCRIPTION: ; 1131 1 ! ; 1132 1 ! This routine will store a character into the record buffer ; 1133 1 ! that we are building. It will output the buffer to disk ; 1134 1 ! when the end of line characters are found. ; 1135 1 ! ; 1136 1 ! CALLING SEQUENCE: ; 1137 1 ! ; 1138 1 ! STATUS = PUT_FILE(Character); ; 1139 1 ! ; 1140 1 ! INPUT PARAMETERS: ; 1141 1 ! ; 1142 1 ! Character - Address of the character to output in the file. ; 1143 1 ! ; 1144 1 ! IMPLICIT INPUTS: ; 1145 1 ! ; 1146 1 ! None. ; 1147 1 ! ; 1148 1 ! OUTPUT PARAMETERS: ; 1149 1 ! ; 1150 1 ! Status - True if no problems writing the character ; 1151 1 ! False if there were problems writing the character. ; 1152 1 ! ; 1153 1 ! IMPLICIT OUTPUTS: ; 1154 1 ! ; 1155 1 ! None. ; 1156 1 ! ; 1157 1 ! COMPLETION CODES: ; 1158 1 ! ; 1159 1 ! None. ; 1160 1 ! ; 1161 1 ! SIDE EFFECTS: ; 1162 1 ! ; 1163 1 ! None. ; 1164 1 ! ; 1165 1 !-- ; 1166 1 ; 1167 2 BEGIN ; 1168 2 ; 1169 2 LOCAL ; 1170 2 STATUS; ! Random status values ; 1171 2 ; 1172 2 SELECTONE .FILE_TYPE OF ; 1173 2 SET ; 1174 2 ; 1175 2 [FILE_ASC] : ; 1176 3 BEGIN ; 1177 3 ![022] ; 1178 3 ![022] If the last character was a carriage return and this is a line feed, ; 1179 3 ![022] we will just dump the record. Otherwise, if the last character was ; 1180 3 ![022] a carriage return, output both it and the current one. ; 1181 3 ![022] ; 1182 3 ; 1183 3 IF .FILE_FAB [FAB$L_CTX] NEQ F_STATE_DATA ; 1184 3 THEN ; 1185 4 BEGIN ; 1186 4 ; 1187 4 IF (.CHARACTER AND %O'177') EQL CHR_LFD ; 1188 4 THEN ; 1189 5 BEGIN ; 1190 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 1191 5 RETURN DUMP_BUFFER (); ; 1192 5 END ; 1193 4 ELSE ; 1194 5 BEGIN ; 1195 5 ; 1196 5 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1197 5 THEN ; 1198 6 BEGIN ; 1199 6 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1200 6 RETURN KER_REC_TOO_BIG; ; 1201 5 END; ; 1202 5 ; 1203 5 CH$WCHAR_A (CHR_CRT, FILE_REC_POINTER); ; 1204 5 ! Store the carriage return we deferred ; 1205 5 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1206 5 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ! Back to normal data ; 1207 4 END; ; 1208 4 ; 1209 3 END; ; 1210 3 ; 1211 3 ![022] ; 1212 3 ![022] Here when last character was written to the file normally. Check if ; 1213 3 ![022] this character might be the end of a record (or at least the start of ; 1214 3 ![022] end. ; 1215 3 ![022] ; 1216 3 ; 1217 3 IF (.CHARACTER AND %O'177') EQL CHR_CRT ; 1218 3 THEN ; 1219 4 BEGIN ; 1220 4 FILE_FAB [FAB$L_CTX] = F_STATE_POST; ! Remember we saw this ; 1221 4 RETURN KER_NORMAL; ! And delay until next character ; 1222 3 END; ; 1223 3 ; 1224 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1225 3 THEN ; 1226 4 BEGIN ; 1227 4 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1228 4 RETURN KER_REC_TOO_BIG; ; 1229 3 END; ; 1230 3 ; 1231 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1232 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1233 2 END; ; 1234 2 ; 1235 2 [FILE_BIN, FILE_FIX] : ; 1236 3 BEGIN ; 1237 3 ; 1238 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1239 3 THEN ; 1240 4 BEGIN ; 1241 4 ![016] LIB$SIGNAL (KER_REC_TOO_BIG); ; 1242 4 ![016] RETURN KER_REC_TOO_BIG; ; 1243 4 STATUS = DUMP_BUFFER (); ; 1244 4 ; 1245 4 IF NOT .STATUS ; 1246 4 THEN ; 1247 5 BEGIN ; 1248 5 LIB$SIGNAL (.STATUS); ; 1249 5 RETURN .STATUS; ; 1250 4 END; ; 1251 4 ; 1252 3 END; ; 1253 3 ; 1254 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1255 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1256 2 END; ; 1257 2 ; 1258 2 [FILE_BLK] : ; 1259 3 BEGIN ; 1260 3 ; 1261 3 IF .FILE_REC_COUNT GEQ .REC_SIZE ; 1262 3 THEN ; 1263 4 BEGIN ; 1264 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1265 4 STATUS = $WRITE (RAB = FILE_RAB); ; 1266 4 FILE_REC_COUNT = 0; ; 1267 4 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1268 3 END; ; 1269 3 ; 1270 3 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1271 3 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1272 2 END; ; 1273 2 TES; ; 1274 2 ; 1275 2 RETURN KER_NORMAL; ; 1276 1 END; ! End of PUT_FILE .EXTRN SYS$WRITE .ENTRY PUT_FILE, ^M ;PUT_FILE, Save R2,R3,R4 ; 1127 MOVAB G^LIB$SIGNAL, R4 ;LIB$SIGNAL, R4 ; MOVAB W^U.16, R3 ;U.16, R3 ; MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 1172 CMPL R0, #1 ;R0, #1 ; 1175 BNEQ 5$ ;5$ ; CMPL -272(R3), #2 ;FILE_FAB+24, #2 ; 1183 BEQL 2$ ;2$ ; CMPZV #0, #7, 4(AP), #10 ;#0, #7, CHARACTER, #10 ; 1187 BNEQ 1$ ;1$ ; MOVL #2, -272(R3) ;#2, FILE_FAB+24 ; 1190 CALLS #0, W^U.2 ;#0, U.2 ; 1191 RET ; ; 1$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE ; 1196 BGEQ 4$ ;4$ ; MOVB #13, @-4(R3) ;#13, @FILE_REC_POINTER ; 1203 INCL -4(R3) ;FILE_REC_POINTER ; INCL (R3) ;FILE_REC_COUNT ; 1205 MOVL #2, -272(R3) ;#2, FILE_FAB+24 ; 1206 2$: CMPZV #0, #7, 4(AP), #13 ;#0, #7, CHARACTER, #13 ; 1217 BNEQ 3$ ;3$ ; MOVL #3, -272(R3) ;#3, FILE_FAB+24 ; 1220 BRB 9$ ;9$ ; 1221 3$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE ; 1224 BLSS 8$ ;8$ ; 4$: PUSHL #134316162 ;#134316162 ; 1227 CALLS #1, (R4) ;#1, LIB$SIGNAL ; MOVL #134316162, R0 ;#134316162, R0 ; 1228 RET ; ; 5$: CMPL R0, #2 ;R0, #2 ; 1235 BEQL 6$ ;6$ ; CMPL R0, #4 ;R0, #4 ; BNEQ 7$ ;7$ ; 6$: CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE ; 1238 BLSS 8$ ;8$ ; CALLS #0, W^U.2 ;#0, U.2 ; 1243 MOVL R0, R2 ;R0, STATUS ; BLBS R2, 8$ ;STATUS, 8$ ; 1245 PUSHL R2 ;STATUS ; 1248 CALLS #1, (R4) ;#1, LIB$SIGNAL ; MOVL R2, R0 ;STATUS, R0 ; 1249 RET ; ; 7$: CMPL R0, #3 ;R0, #3 ; 1258 BNEQ 9$ ;9$ ; CMPL (R3), 4(R3) ;FILE_REC_COUNT, REC_SIZE ; 1261 BLSS 8$ ;8$ ; MOVW (R3), -86(R3) ;FILE_REC_COUNT, FILE_RAB+34 ; 1264 PUSHAB -120(R3) ;FILE_RAB ; 1265 CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE ; MOVL R0, R2 ;R0, STATUS ; CLRL (R3) ;FILE_REC_COUNT ; 1266 MOVL 8(R3), -4(R3) ;REC_ADDRESS, FILE_REC_POINTER ; 1267 8$: INCL (R3) ;FILE_REC_COUNT ; 1270 MOVB 4(AP), @-4(R3) ;CHARACTER, @FILE_REC_POINTER ; 1271 INCL -4(R3) ;FILE_REC_POINTER ; 9$: MOVL #134316043, R0 ;#134316043, R0 ; 1275 RET ; ; 1276 ; Routine Size: 197 bytes, Routine Base: $CODE$ + 034B ; 1277 1 ; 1278 1 %SBTTL 'DUMP_BUFFER - Dump the current record to disk' ; 1279 1 ROUTINE DUMP_BUFFER = ; 1280 1 ; 1281 1 !++ ; 1282 1 ! FUNCTIONAL DESCRIPTION: ; 1283 1 ! ; 1284 1 ! This routine will dump the current record to disk. It doesn't ; 1285 1 ! care what type of file you are writing, unlike FILE_DUMP. ; 1286 1 ! ; 1287 1 ! CALLING SEQUENCE: ; 1288 1 ! ; 1289 1 ! STATUS = DUMP_BUFFER(); ; 1290 1 ! ; 1291 1 ! INPUT PARAMETERS: ; 1292 1 ! ; 1293 1 ! None. ; 1294 1 ! ; 1295 1 ! IMPLICIT INPUTS: ; 1296 1 ! ; 1297 1 ! None. ; 1298 1 ! ; 1299 1 ! OUTPUT PARAMETERS: ; 1300 1 ! ; 1301 1 ! None. ; 1302 1 ! ; 1303 1 ! IMPLICIT OUTPUTS: ; 1304 1 ! ; 1305 1 ! None. ; 1306 1 ! ; 1307 1 ! COMPLETION CODES: ; 1308 1 ! ; 1309 1 ! KER_NORMAL - Output went ok. ; 1310 1 ! KER_RMS32 - RMS-32 error. ; 1311 1 ! ; 1312 1 ! SIDE EFFECTS: ; 1313 1 ! ; 1314 1 ! None. ; 1315 1 ! ; 1316 1 !-- ; 1317 1 ; 1318 2 BEGIN ; 1319 2 ; 1320 2 LOCAL ; 1321 2 STATUS; ! Random status values ; 1322 2 ; 1323 2 ! ; 1324 2 ! First update the record length ; 1325 2 ! ; 1326 2 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1327 2 ! ; 1328 2 ! Now output the record to the file ; 1329 2 ! ; 1330 2 STATUS = $PUT (RAB = FILE_RAB); ; 1331 2 ! ; 1332 2 ! Update the pointers first ; 1333 2 ! ; 1334 2 FILE_REC_COUNT = 0; ; 1335 2 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1336 2 ! ; 1337 2 ! Now determine if we failed attempting to write the record ; 1338 2 ! ; 1339 2 ; 1340 2 IF NOT .STATUS ; 1341 2 THEN ; 1342 3 BEGIN ; 1343 3 FILE_ERROR (.STATUS); ; 1344 3 RETURN KER_RMS32 ; 1345 2 END; ; 1346 2 ; 1347 2 RETURN KER_NORMAL ; 1348 1 END; ! End of DUMP_BUFFER .EXTRN SYS$PUT ;DUMP_BUFFER U.2: .WORD ^M ;Save R2 ; 1279 MOVAB W^U.16, R2 ;U.16, R2 ; MOVW (R2), -86(R2) ;FILE_REC_COUNT, FILE_RAB+34 ; 1326 PUSHAB -120(R2) ;FILE_RAB ; 1330 CALLS #1, G^SYS$PUT ;#1, SYS$PUT ; CLRL (R2) ;FILE_REC_COUNT ; 1334 MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER ; 1335 BLBS R0, 1$ ;STATUS, 1$ ; 1340 PUSHL R0 ;STATUS ; 1343 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1344 RET ; ; 1$: MOVL #134316043, R0 ;#134316043, R0 ; 1347 RET ; ; 1348 ; Routine Size: 54 bytes, Routine Base: $CODE$ + 0410 ; 1349 1 %SBTTL 'OPEN_READING' ; 1350 1 ROUTINE OPEN_READING = ; 1351 1 ; 1352 1 !++ ; 1353 1 ! FUNCTIONAL DESCRIPTION: ; 1354 1 ! ; 1355 1 ! This routine will open a file for reading. It will return either ; 1356 1 ! true or false to the called depending on the success of the ; 1357 1 ! operation. ; 1358 1 ! ; 1359 1 ! CALLING SEQUENCE: ; 1360 1 ! ; 1361 1 ! status = OPEN_READING(); ; 1362 1 ! ; 1363 1 ! INPUT PARAMETERS: ; 1364 1 ! ; 1365 1 ! None. ; 1366 1 ! ; 1367 1 ! IMPLICIT INPUTS: ; 1368 1 ! ; 1369 1 ! None. ; 1370 1 ! ; 1371 1 ! OUTPUT PARAMETERS: ; 1372 1 ! ; 1373 1 ! None. ; 1374 1 ! ; 1375 1 ! IMPLICIT OUTPUTS: ; 1376 1 ! ; 1377 1 ! None. ; 1378 1 ! ; 1379 1 ! COMPLETION CODES: ; 1380 1 ! ; 1381 1 ! None. ; 1382 1 ! ; 1383 1 ! SIDE EFFECTS: ; 1384 1 ! ; 1385 1 ! None. ; 1386 1 ! ; 1387 1 !-- ; 1388 1 ; 1389 2 BEGIN ; 1390 2 ; 1391 2 LOCAL ; 1392 2 STATUS; ! Random status values ; 1393 2 ; 1394 2 ! ; 1395 2 ! We now have an expanded file specification that we can use to process ; 1396 2 ! the file. ; 1397 2 ! ; 1398 2 ; 1399 2 IF .FILE_TYPE NEQ FILE_BLK ; 1400 2 THEN ; 1401 3 BEGIN ; P 1402 3 $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM, ; 1403 3 XAB = FILE_XABFHC); ; 1404 3 END ; 1405 2 ELSE ; 1406 3 BEGIN ; P 1407 3 $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, ; 1408 3 NAM = FILE_NAM, XAB = FILE_XABFHC); ; 1409 2 END; ; 1410 2 ; 1411 2 $XABFHC_INIT (XAB = FILE_XABFHC); ; 1412 2 STATUS = $OPEN (FAB = FILE_FAB); ; 1413 2 ; 1414 3 IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) ; 1415 2 THEN ; 1416 3 BEGIN ; 1417 3 FILE_ERROR (.STATUS); ; 1418 3 RETURN KER_RMS32; ; 1419 2 END; ; 1420 2 ; 1421 2 ! ; 1422 2 ! Now allocate a buffer for the records ; 1423 2 ! ; 1424 2 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]); ; 1425 2 ; 1426 2 IF .REC_SIZE EQL 0 THEN REC_SIZE = MAX_REC_LENGTH; ; 1427 2 ; 1428 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1429 2 ! ; 1430 2 ![107] Determine if we need a buffer for the fixed control area ; 1431 2 ! ; 1432 2 FIX_SIZE = .FILE_FAB [FAB$B_FSZ]; ; 1433 2 ; 1434 2 IF .FIX_SIZE NEQ 0 ; 1435 2 THEN ; 1436 3 BEGIN ; 1437 3 STATUS = LIB$GET_VM (FIX_SIZE, FIX_ADDRESS); ; 1438 2 END; ; 1439 2 ; 1440 2 ! ; 1441 2 ! Initialize the RAB for the $CONNECT RMS call ; 1442 2 ! ; P 1443 2 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS, ; 1444 2 USZ = .REC_SIZE); ; 1445 2 ; 1446 2 IF .FIX_SIZE NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .FIX_ADDRESS; ; 1447 2 ; 1448 2 ![017] Store header address ; 1449 2 STATUS = $CONNECT (RAB = FILE_RAB); ; 1450 2 ; 1451 2 IF NOT .STATUS ; 1452 2 THEN ; 1453 3 BEGIN ; 1454 3 FILE_ERROR (.STATUS); ; 1455 3 RETURN KER_RMS32; ; 1456 2 END; ; 1457 2 ; 1458 2 FILE_REC_COUNT = -1; ; 1459 2 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1460 2 RETURN KER_NORMAL; ; 1461 1 END; ! End of OPEN_READING U.32= U.10 U.33= U.10 U.34= U.13 U.35= U.12 .EXTRN SYS$OPEN, SYS$CONNECT ;OPEN_READING U.31: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8 ; 1350 MOVAB G^LIB$GET_VM, R8 ;LIB$GET_VM, R8 ; MOVAB W^U.32, R7 ;U.32, R7 ; CMPL W^FILE_TYPE, #3 ;FILE_TYPE, #3 ; 1399 BEQL 1$ ;1$ ; MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1403 MOVW #20483, (R7) ;#20483, $RMS_PTR ; MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 ; MOVB #2, 22(R7) ;#2, $RMS_PTR+22 ; BRB 2$ ;2$ ; 1$: MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1408 MOVW #20483, (R7) ;#20483, $RMS_PTR ; MOVL #16777216, 4(R7) ;#16777216, $RMS_PTR+4 ; MOVB #34, 22(R7) ;#34, $RMS_PTR+22 ; 2$: MOVB #4, 31(R7) ;#4, $RMS_PTR+31 ; MOVAB 244(R7), 36(R7) ;FILE_XABFHC, $RMS_PTR+36 ; MOVAB 80(R7), 40(R7) ;FILE_NAM, $RMS_PTR+40 ; 1403 MOVC5 #0, (SP), #0, #44, 244(R7) ;#0, (SP), #0, #44, $RMS_PTR ; 1411 MOVW #11293, 244(R7) ;#11293, $RMS_PTR ; PUSHL R7 ;R7 ; 1412 CALLS #1, G^SYS$OPEN ;#1, SYS$OPEN ; MOVL R0, R6 ;R0, STATUS ; CMPL R6, #65537 ;STATUS, #65537 ; 1414 BEQL 3$ ;3$ ; CMPL R6, #98353 ;STATUS, #98353 ; BEQL 3$ ;3$ ; BRW 9$ ;9$ ; 3$: CMPL W^FILE_TYPE, #3 ;FILE_TYPE, #3 ; 1424 BNEQ 4$ ;4$ ; MOVZWL #512, R0 ;#512, R0 ; BRB 5$ ;5$ ; 4$: MOVZWL 254(R7), R0 ;FILE_XABFHC+10, R0 ; 5$: MOVL R0, 300(R7) ;R0, REC_SIZE ; BNEQ 6$ ;6$ ; 1426 MOVZWL #4096, 300(R7) ;#4096, REC_SIZE ; 6$: PUSHAB 304(R7) ;REC_ADDRESS ; 1428 PUSHAB 300(R7) ;REC_SIZE ; CALLS #2, (R8) ;#2, LIB$GET_VM ; MOVL R0, R6 ;R0, STATUS ; MOVZBL 63(R7), 308(R7) ;FILE_FAB+63, FIX_SIZE ; 1432 BEQL 7$ ;7$ ; 1434 PUSHAB 312(R7) ;FIX_ADDRESS ; 1437 PUSHAB 308(R7) ;FIX_SIZE ; CALLS #2, (R8) ;#2, LIB$GET_VM ; MOVL R0, R6 ;R0, STATUS ; 7$: MOVC5 #0, (SP), #0, #68, 176(R7) ;#0, (SP), #0, #68, $RMS_PTR ; 1444 MOVW #17409, 176(R7) ;#17409, $RMS_PTR ; MOVL #1048576, 180(R7) ;#1048576, $RMS_PTR+4 ; CLRB 206(R7) ;$RMS_PTR+30 ; MOVW 300(R7), 208(R7) ;REC_SIZE, $RMS_PTR+32 ; MOVL 304(R7), 212(R7) ;REC_ADDRESS, $RMS_PTR+36 ; MOVAB (R7), 236(R7) ;FILE_FAB, $RMS_PTR+60 ; TSTL 308(R7) ;FIX_SIZE ; 1446 BEQL 8$ ;8$ ; MOVL 312(R7), 220(R7) ;FIX_ADDRESS, FILE_RAB+44 ; 8$: PUSHAB 176(R7) ;FILE_RAB ; 1449 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT ; MOVL R0, R6 ;R0, STATUS ; BLBS R6, 10$ ;STATUS, 10$ ; 1451 9$: PUSHL R6 ;STATUS ; 1454 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1455 RET ; ; 10$: MNEGL #1, 296(R7) ;#1, FILE_REC_COUNT ; 1458 CLRL 24(R7) ;FILE_FAB+24 ; 1459 MOVL #134316043, R0 ;#134316043, R0 ; 1460 RET ; ; 1461 ; Routine Size: 315 bytes, Routine Base: $CODE$ + 0446 ; 1462 1 %SBTTL 'FILE_OPEN' ; 1463 1 ; 1464 1 GLOBAL ROUTINE FILE_OPEN (FUNCTION) = ; 1465 1 ; 1466 1 !++ ; 1467 1 ! FUNCTIONAL DESCRIPTION: ; 1468 1 ! ; 1469 1 ! This routine will open a file for reading or writing depending on ; 1470 1 ! the function that is passed this routine. It will handle wildcards ; 1471 1 ! on the read function. ; 1472 1 ! ; 1473 1 ! CALLING SEQUENCE: ; 1474 1 ! ; 1475 1 ! status = FILE_OPEN(FUNCTION); ; 1476 1 ! ; 1477 1 ! INPUT PARAMETERS: ; 1478 1 ! ; 1479 1 ! FUNCTION - Function to do. Either FNC_READ or FNC_WRITE. ; 1480 1 ! ; 1481 1 ! IMPLICIT INPUTS: ; 1482 1 ! ; 1483 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1484 1 ! of the name. ; 1485 1 ! ; 1486 1 ! OUTPUT PARAMETERS: ; 1487 1 ! ; 1488 1 ! None. ; 1489 1 ! ; 1490 1 ! IMPLICIT OUTPUTS: ; 1491 1 ! ; 1492 1 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1493 1 ! of the name. ; 1494 1 ! ; 1495 1 ! COMPLETION CODES: ; 1496 1 ! ; 1497 1 ! KER_NORMAL - File opened correctly. ; 1498 1 ! KER_RMS32 - Problem processing the file. ; 1499 1 ! ; 1500 1 ! SIDE EFFECTS: ; 1501 1 ! ; 1502 1 ! None. ; 1503 1 ! ; 1504 1 !-- ; 1505 1 ; 1506 2 BEGIN ; 1507 2 ; 1508 2 EXTERNAL ROUTINE ; 1509 2 ! ; 1510 2 ! This external routine is called to perform any checks on the file ; 1511 2 ! specification that the user wishes. It must return a true value ; 1512 2 ! if the access is to be allowed, and a false value (error code) if ; 1513 2 ! access is to be denied. The error code may be any valid system wide ; 1514 2 ! error code, any Kermit-32 error code (KER_xxx) or a user specific code, ; 1515 2 ! provided a message file defining the error code is loaded with Kermit-32. ; 1516 2 ! ; 1517 2 ! The routine is called as: ; 1518 2 ! ; 1519 2 ! STATUS = USER_FILE_CHECK ( FILE NAME DESCRIPTOR, READ/WRITE FLAG) ; 1520 2 ! ; 1521 2 ! The file name descriptor points to the file specification supplied by ; 1522 2 ! the user. The read/write flag is TRUE if the file is being read, and ; 1523 2 ! false if it is being written. ; 1524 2 ! ; 1525 2 USER_FILE_CHECK : ADDRESSING_MODE(GENERAL) WEAK; ; 1526 2 ; 1527 2 LOCAL ; 1528 2 STATUS, ! Random status values ; 1529 2 ITMLST : VECTOR [4, LONG], ! For GETDVI call ; 1530 2 SIZE : WORD; ! Size of resulting file name ; 1531 2 ; 1532 2 ! ; 1533 2 ! Assume we can do searches ; 1534 2 ! ; 1535 2 SEARCH_FLAG = TRUE; ; 1536 2 DEV_CLASS = DC$_DISK; ! Assume disk file ; 1537 2 ! ; 1538 2 ! Now do the function dependent processing ; 1539 2 ! ; 1540 2 FILE_MODE = .FUNCTION; ; 1541 2 FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE; ! Length of file name ; 1542 2 ! ; 1543 2 ! Call user routine (if any) ; 1544 2 ! ; 1545 2 IF USER_FILE_CHECK NEQ 0 ; 1546 2 THEN ; 1547 3 BEGIN ; 1548 3 STATUS = USER_FILE_CHECK (FILE_DESC, %REF (.FILE_MODE EQL FNC_READ)); ; 1549 3 IF NOT .STATUS ; 1550 3 THEN ; 1551 4 BEGIN ; 1552 4 LIB$SIGNAL (.STATUS); ; 1553 4 RETURN .STATUS; ; 1554 3 END; ; 1555 2 END; ; 1556 2 ! ; 1557 2 ! Select the correct routine depending on if we are reading or writing. ; 1558 2 ! ; 1559 2 ; 1560 2 SELECTONE .FUNCTION OF ; 1561 2 SET ; 1562 2 ; 1563 2 [FNC_READ] : ; 1564 3 BEGIN ; 1565 3 ! ; 1566 3 ! Determine device type ; 1567 3 ! ; 1568 3 ITMLST [0] = DVI$_DEVCLASS^16 + 4; ! Want device class ; 1569 3 ITMLST [1] = DEV_CLASS; ! Put it there ; 1570 3 ITMLST [2] = ITMLST [2]; ! Put the size here ; 1571 3 ITMLST [3] = 0; ! End the list ; 1572 3 STATUS = $GETDVI (DEVNAM = FILE_DESC, ITMLST = ITMLST); ; 1573 3 ! If not a disk, can't do search ; 1574 3 ; 1575 3 IF .STATUS AND .DEV_CLASS NEQ DC$_DISK THEN SEARCH_FLAG = FALSE; ; 1576 3 ; 1577 3 ! ; 1578 3 ! Now set up the FAB with the information it needs. ; 1579 3 ! ; P 1580 3 $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE, ; 1581 3 NAM = FILE_NAM, DNA = UPLIT (%ASCII'.;0'), DNS = 3); ; 1582 3 ! ; 1583 3 ! Now initialize the NAM block ; 1584 3 ! ; P 1585 3 $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR, ; 1586 3 ESS = NAM$C_MAXRSS); ; 1587 3 ! ; 1588 3 ! First parse the file specification. ; 1589 3 ! ; 1590 3 STATUS = $PARSE (FAB = FILE_FAB); ; 1591 3 ; 1592 3 IF NOT .STATUS ; 1593 3 THEN ; 1594 4 BEGIN ; 1595 4 FILE_ERROR (.STATUS); ; 1596 4 RETURN KER_RMS32; ; 1597 3 END; ; 1598 3 ; 1599 3 IF .SEARCH_FLAG ; 1600 3 THEN ; 1601 4 BEGIN ; 1602 4 STATUS = $SEARCH (FAB = FILE_FAB); ; 1603 4 ; 1604 4 IF NOT .STATUS ; 1605 4 THEN ; 1606 5 BEGIN ; 1607 5 FILE_ERROR (.STATUS); ; 1608 5 RETURN KER_RMS32; ; 1609 4 END; ; 1610 4 ; 1611 3 END; ; 1612 3 ; 1613 3 ! ; 1614 3 ! We now have an expanded file specification that we can use to process ; 1615 3 ! the file. ; 1616 3 ! ; 1617 3 STATUS = OPEN_READING (); ![017] Open the file ; 1618 3 ; 1619 3 IF NOT .STATUS THEN RETURN .STATUS; ![017] If we couldn't, pass error back ; 1620 3 ; 1621 3 ![026] ; 1622 3 ![026] Tell user what name we ended up with for storing the file ; 1623 3 ![026] ; 1624 3 ; 1625 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL ; 1626 3 THEN ; 1627 4 BEGIN ; 1628 4 ; 1629 4 IF .FILE_NAM [NAM$B_RSS] GTR 0 ; 1630 4 THEN ; 1631 5 BEGIN ; 1632 5 CH$WCHAR (CHR_NUL, ; 1633 5 CH$PTR (.FILE_NAM [NAM$L_RSA], ; 1634 5 .FILE_NAM [NAM$B_RSL])); ; 1635 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]); ; 1636 5 END ; 1637 4 ELSE ; 1638 5 BEGIN ; 1639 5 CH$WCHAR (CHR_NUL, ; 1640 5 CH$PTR (.FILE_NAM [NAM$L_ESA], ; 1641 5 .FILE_NAM [NAM$B_ESL])); ; 1642 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]); ; 1643 4 END; ; 1644 4 ; 1645 4 TT_TEXT (UPLIT (%ASCIZ' as ')); ; 1646 3 END; ; 1647 3 ; 1648 2 END; ! End of [FNC_READ] ; 1649 2 ; 1650 2 [FNC_WRITE] : ; 1651 3 BEGIN ; 1652 3 ; 1653 3 SELECTONE .FILE_TYPE OF ; 1654 3 SET ; 1655 3 ; 1656 3 [FILE_ASC] : ; 1657 4 BEGIN ; P 1658 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1659 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1660 4 ORG = SEQ, RFM = VAR, RAT = CR); ; 1661 3 END; ; 1662 3 ; 1663 3 [FILE_BIN] : ; 1664 4 BEGIN ; P 1665 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1666 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1667 4 ORG = SEQ, RFM = VAR); ; 1668 3 END; ; 1669 3 ; 1670 3 [FILE_FIX] : ; 1671 4 BEGIN ; P 1672 4 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1673 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1674 4 ORG = SEQ, RFM = FIX, MRS = 512); ; 1675 3 END; ; 1676 3 ; 1677 3 [FILE_BLK] : ; 1678 4 BEGIN ; P 1679 4 $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME, ; 1680 4 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM); ; 1681 3 END; ; 1682 3 TES; ; 1683 3 ; 1684 3 ![030] ; 1685 3 ![030] If we had an alternate file name from the receive command, use it ; 1686 3 ![030] instead of what KERMSG has told us. ; 1687 3 ![030] ; 1688 3 ; 1689 3 IF .ALT_FILE_SIZE GTR 0 ; 1690 3 THEN ; 1691 4 BEGIN ; 1692 4 LOCAL ; 1693 4 ALT_FILE_DESC : BLOCK [8, BYTE]; ; 1694 4 ; 1695 4 ALT_FILE_DESC = .FILE_DESC; ; 1696 4 ALT_FILE_DESC [DSC$W_LENGTH] = .ALT_FILE_SIZE; ; 1697 4 ALT_FILE_DESC [DSC$A_POINTER] = ALT_FILE_NAME; ; 1698 4 IF USER_FILE_CHECK NEQ 0 ; 1699 4 THEN ; 1700 5 BEGIN ; 1701 5 STATUS = USER_FILE_CHECK (ALT_FILE_DESC, %REF (.FILE_MODE EQL FNC_READ)); ; 1702 5 IF NOT .STATUS ; 1703 5 THEN ; 1704 6 BEGIN ; 1705 6 LIB$SIGNAL (.STATUS); ; 1706 6 RETURN .STATUS; ; 1707 5 END; ; 1708 4 END; ; 1709 4 FILE_FAB [FAB$L_FNA] = ALT_FILE_NAME; ; 1710 4 FILE_FAB [FAB$B_FNS] = .ALT_FILE_SIZE; ; 1711 3 END; ; 1712 3 ; P 1713 3 $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR, ; 1714 3 RSS = NAM$C_MAXRSS); ; 1715 3 ! ; 1716 3 ! Now allocate a buffer for the records ; 1717 3 ! ; 1718 3 ![016] Determine correct buffer size ; 1719 3 ; 1720 3 SELECTONE .FILE_TYPE OF ; 1721 3 SET ; 1722 3 ; 1723 3 [FILE_ASC] : ; 1724 3 REC_SIZE = MAX_REC_LENGTH; ; 1725 3 ; 1726 3 [FILE_BIN] : ; 1727 3 REC_SIZE = 510; ; 1728 3 ; 1729 3 [FILE_BLK, FILE_FIX] : ; 1730 3 REC_SIZE = 512; ; 1731 3 TES; ; 1732 3 ; 1733 3 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1734 3 ! ; 1735 3 ! Now create the file ; 1736 3 ! ; 1737 3 STATUS = $CREATE (FAB = FILE_FAB); ; 1738 3 ; 1739 3 IF NOT .STATUS ; 1740 3 THEN ; 1741 4 BEGIN ; 1742 4 FILE_ERROR (.STATUS); ; 1743 4 RETURN KER_RMS32; ; 1744 3 END; ; 1745 3 ; P 1746 3 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ; 1747 3 ROP = ); ; 1748 3 STATUS = $CONNECT (RAB = FILE_RAB); ; 1749 3 ; 1750 3 IF NOT .STATUS ; 1751 3 THEN ; 1752 4 BEGIN ; 1753 4 FILE_ERROR (.STATUS); ; 1754 4 RETURN KER_RMS32; ; 1755 3 END; ; 1756 3 ; 1757 3 ![022] ; 1758 3 ![022] Set the initial state into the FAB field. This is used to remember ; 1759 3 ![022] whether we need to ignore the line feed which follows a carriage return. ; 1760 3 ![022] ; 1761 3 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 1762 3 FILE_REC_COUNT = 0; ; 1763 3 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1764 3 ![026] ; 1765 3 ![026] Tell user what name we ended up with for storing the file ; 1766 3 ![026] ; 1767 3 ; 1768 3 IF ( NOT .CONNECT_FLAG) AND .TY_FIL ; 1769 3 THEN ; 1770 4 BEGIN ; 1771 4 TT_TEXT (UPLIT (%ASCIZ' as ')); ; 1772 4 ; 1773 4 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 1774 4 THEN ; 1775 5 BEGIN ; 1776 5 CH$WCHAR (CHR_NUL, ; 1777 5 CH$PTR (.FILE_NAM [NAM$L_RSA], ; 1778 5 .FILE_NAM [NAM$B_RSL])); ; 1779 5 TT_TEXT (.FILE_NAM [NAM$L_RSA]); ; 1780 5 END ; 1781 4 ELSE ; 1782 5 BEGIN ; 1783 5 CH$WCHAR (CHR_NUL, ; 1784 5 CH$PTR (.FILE_NAM [NAM$L_ESA], ; 1785 5 .FILE_NAM [NAM$B_ESL])); ; 1786 5 TT_TEXT (.FILE_NAM [NAM$L_ESA]); ; 1787 4 END; ; 1788 4 ; 1789 4 TT_OUTPUT (); ; 1790 3 END; ; 1791 3 ; 1792 2 END; ; 1793 2 ; 1794 2 [OTHERWISE] : ; 1795 2 RETURN KER_INTERNALERR; ; 1796 2 TES; ; 1797 2 ; 1798 2 ![026] ; 1799 2 ![026] Copy the file name based on the type of file name we are to use. ; 1800 2 ![026] The possibilities are: ; 1801 2 ![026] Normal - Just copy name and type ; 1802 2 ![026] Full - Copy entire name string (either resultant or expanded) ; 1803 2 ![026] Untranslated - Copy string from name on (includes version, etc.) ; 1804 2 ; 1805 2 IF .DEV_CLASS EQL DC$_MAILBOX ; 1806 2 THEN ; 1807 3 BEGIN ; 1808 3 SIZE = 0; ; 1809 3 FILE_NAME = 0; ; 1810 3 END ; 1811 2 ELSE ; 1812 2 ; 1813 2 SELECTONE .FIL_NORMAL_FORM OF ; 1814 2 SET ; 1815 2 ; 1816 2 [FNM_FULL] : ; 1817 3 BEGIN ; 1818 3 ; 1819 3 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 1820 3 THEN ; 1821 4 BEGIN ; 1822 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), ; 1823 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 1824 4 SIZE = .FILE_NAM [NAM$B_RSL]; ; 1825 4 END ; 1826 3 ELSE ; 1827 4 BEGIN ; 1828 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), ; 1829 4 CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 1830 4 SIZE = .FILE_NAM [NAM$B_ESL]; ; 1831 4 END ; 1832 4 ; 1833 2 END; ; 1834 2 ; 1835 2 [FNM_NORMAL, FNM_UNTRAN] : ; 1836 3 BEGIN ; 1837 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]), ; 1838 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL, ; 1839 3 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 1840 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE]; ; 1841 2 END; ; 1842 2 TES; ; 1843 2 ; 1844 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE; ; 1845 2 ; 1846 2 RETURN KER_NORMAL; ; 1847 1 END; ! End of FILE_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAA: .ASCII \.;0\<0> ; ; P.AAB: .ASCII \ as \<0><0><0><0> ; ; P.AAC: .ASCII \ as \<0><0><0><0> ; ; U.37= U.10 U.38= U.11 U.39= U.10 U.40= U.10 U.41= U.10 U.42= U.10 U.43= U.11 U.44= U.12 .EXTRN SYS$GETDVI, SYS$PARSE, SYS$SEARCH, SYS$CREATE .WEAK USER_FILE_CHECK .PSECT $CODE$,NOWRT,2 .ENTRY FILE_OPEN, ^M ; ; MOVAB W^U.37, R11 ;U.37, R11 ; SUBL2 #28, SP ;#28, SP ; MOVL #1, -12(R11) ;#1, SEARCH_FLAG ; 1535 MOVL #1, -8(R11) ;#1, DEV_CLASS ; 1536 MOVL 4(AP), R2 ;FUNCTION, R2 ; 1540 MOVL R2, 288(R11) ;R2, FILE_MODE ; MOVW W^FILE_SIZE, W^FILE_DESC ;FILE_SIZE, FILE_DESC ; 1541 MOVAB G^USER_FILE_CHECK, R0 ;USER_FILE_CHECK, R0 ; 1545 CLRL R8 ;R8 ; TSTL R0 ;R0 ; BEQL 2$ ;2$ ; INCL R8 ;R8 ; CLRL (SP) ;(SP) ; 1548 TSTL 288(R11) ;FILE_MODE ; BNEQ 1$ ;1$ ; INCL (SP) ;(SP) ; 1$: PUSHL SP ;SP ; PUSHAB W^FILE_DESC ;FILE_DESC ; CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK ; MOVL R0, R7 ;R0, STATUS ; BLBS R7, 2$ ;STATUS, 2$ ; 1549 BRW 19$ ;19$ ; 2$: TSTL R2 ;R2 ; 1563 BEQL 3$ ;3$ ; BRW 11$ ;11$ ; 3$: MOVL #262148, 12(SP) ;#262148, ITMLST ; 1568 MOVAB -8(R11), 16(SP) ;DEV_CLASS, ITMLST+4 ; 1569 MOVAB 20(SP), 20(SP) ;ITMLST+8, ITMLST+8 ; 1570 CLRL 24(SP) ;ITMLST+12 ; 1571 CLRQ -(SP) ;-(SP) ; 1572 CLRQ -(SP) ;-(SP) ; PUSHAB 28(SP) ;ITMLST ; PUSHAB W^FILE_DESC ;FILE_DESC ; CLRQ -(SP) ;-(SP) ; CALLS #8, G^SYS$GETDVI ;#8, SYS$GETDVI ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 4$ ;STATUS, 4$ ; 1575 CMPL -8(R11), #1 ;DEV_CLASS, #1 ; BEQL 4$ ;4$ ; CLRL -12(R11) ;SEARCH_FLAG ; 4$: MOVC5 #0, (SP), #0, #80, (R11) ;#0, (SP), #0, #80, $RMS_PTR ; 1581 MOVW #20483, (R11) ;#20483, $RMS_PTR ; MOVL #16777216, 4(R11) ;#16777216, $RMS_PTR+4 ; MOVB #2, 22(R11) ;#2, $RMS_PTR+22 ; MOVB #2, 31(R11) ;#2, $RMS_PTR+31 ; MOVAB 80(R11), 40(R11) ;FILE_NAM, $RMS_PTR+40 ; MOVAB W^FILE_NAME, 44(R11) ;FILE_NAME, $RMS_PTR+44 ; MOVAB W^P.AAA, 48(R11) ;P.AAA, $RMS_PTR+48 ; MOVB W^FILE_SIZE, 52(R11) ;FILE_SIZE, $RMS_PTR+52 ; MOVB #3, 53(R11) ;#3, $RMS_PTR+53 ; MOVC5 #0, (SP), #0, #96, 80(R11) ;#0, (SP), #0, #96, $RMS_PTR ; 1586 MOVW #24578, 80(R11) ;#24578, $RMS_PTR ; MNEGB #1, 82(R11) ;#1, $RMS_PTR+2 ; MOVAB 572(R11), 84(R11) ;RES_STR, $RMS_PTR+4 ; MNEGB #1, 90(R11) ;#1, $RMS_PTR+10 ; MOVAB 316(R11), 92(R11) ;EXP_STR, $RMS_PTR+12 ; PUSHL R11 ;R11 ; 1590 CALLS #1, G^SYS$PARSE ;#1, SYS$PARSE ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 5$ ;STATUS, 5$ ; 1592 BLBC -12(R11), 6$ ;SEARCH_FLAG, 6$ ; 1599 PUSHL R11 ;R11 ; 1602 CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH ; MOVL R0, R7 ;R0, STATUS ; 5$: BLBS R7, 6$ ;STATUS, 6$ ; 1604 BRW 26$ ;26$ ; 6$: CALLS #0, W^U.31 ;#0, U.31 ; 1617 MOVL R0, R7 ;R0, STATUS ; BLBS R7, 7$ ;STATUS, 7$ ; 1619 BRW 20$ ;20$ ; 7$: BLBS W^CONNECT_FLAG, 10$ ;CONNECT_FLAG, 10$ ; 1625 BLBC W^TY_FIL, 10$ ;TY_FIL, 10$ ; TSTB 82(R11) ;FILE_NAM+2 ; 1629 BEQL 8$ ;8$ ; MOVZBL 83(R11), R0 ;FILE_NAM+3, R0 ; 1634 ADDL2 84(R11), R0 ;FILE_NAM+4, R0 ; CLRB (R0) ;(R0) ; PUSHL 84(R11) ;FILE_NAM+4 ; 1635 BRB 9$ ;9$ ; 8$: MOVZBL 91(R11), R0 ;FILE_NAM+11, R0 ; 1641 ADDL2 92(R11), R0 ;FILE_NAM+12, R0 ; CLRB (R0) ;(R0) ; PUSHL 92(R11) ;FILE_NAM+12 ; 1642 9$: CALLS #1, W^TT_TEXT ;#1, TT_TEXT ; PUSHAB W^P.AAB ;P.AAB ; 1645 CALLS #1, W^TT_TEXT ;#1, TT_TEXT ; 10$: BRW 31$ ;31$ ; 1560 11$: CMPL R2, #1 ;R2, #1 ; 1650 BEQL 12$ ;12$ ; BRW 30$ ;30$ ; 12$: MOVL W^FILE_TYPE, R6 ;FILE_TYPE, R6 ; 1653 CMPL R6, #1 ;R6, #1 ; 1656 BNEQ 13$ ;13$ ; MOVC5 #0, (SP), #0, #80, (R11) ;#0, (SP), #0, #80, $RMS_PTR ; 1660 MOVW #20483, (R11) ;#20483, $RMS_PTR ; MOVL #270532674, 4(R11) ;#270532674, $RMS_PTR+4 ; MOVB #1, 22(R11) ;#1, $RMS_PTR+22 ; MOVW #512, 29(R11) ;#512, $RMS_PTR+29 ; BRB 16$ ;16$ ; 13$: CMPL R6, #2 ;R6, #2 ; 1663 BNEQ 14$ ;14$ ; MOVC5 #0, (SP), #0, #80, (R11) ;#0, (SP), #0, #80, $RMS_PTR ; 1667 MOVW #20483, (R11) ;#20483, $RMS_PTR ; MOVL #270532674, 4(R11) ;#270532674, $RMS_PTR+4 ; MOVB #1, 22(R11) ;#1, $RMS_PTR+22 ; CLRB 29(R11) ;$RMS_PTR+29 ; BRB 16$ ;16$ ; 14$: CMPL R6, #4 ;R6, #4 ; 1670 BNEQ 15$ ;15$ ; MOVC5 #0, (SP), #0, #80, (R11) ;#0, (SP), #0, #80, $RMS_PTR ; 1674 MOVW #20483, (R11) ;#20483, $RMS_PTR ; MOVL #270532674, 4(R11) ;#270532674, $RMS_PTR+4 ; MOVB #1, 22(R11) ;#1, $RMS_PTR+22 ; CLRB 29(R11) ;$RMS_PTR+29 ; MOVB #1, 31(R11) ;#1, $RMS_PTR+31 ; MOVAB 80(R11), 40(R11) ;FILE_NAM, $RMS_PTR+40 ; MOVAB W^FILE_NAME, 44(R11) ;FILE_NAME, $RMS_PTR+44 ; MOVB W^FILE_SIZE, 52(R11) ;FILE_SIZE, $RMS_PTR+52 ; MOVW #512, 54(R11) ;#512, $RMS_PTR+54 ; BRB 17$ ;17$ ; 1653 15$: CMPL R6, #3 ;R6, #3 ; 1677 BNEQ 17$ ;17$ ; MOVC5 #0, (SP), #0, #80, (R11) ;#0, (SP), #0, #80, $RMS_PTR ; 1680 MOVW #20483, (R11) ;#20483, $RMS_PTR ; MOVL #270532674, 4(R11) ;#270532674, $RMS_PTR+4 ; MOVB #33, 22(R11) ;#33, $RMS_PTR+22 ; 16$: MOVB #2, 31(R11) ;#2, $RMS_PTR+31 ; MOVAB 80(R11), 40(R11) ;FILE_NAM, $RMS_PTR+40 ; MOVAB W^FILE_NAME, 44(R11) ;FILE_NAME, $RMS_PTR+44 ; MOVB W^FILE_SIZE, 52(R11) ;FILE_SIZE, $RMS_PTR+52 ; 17$: MOVL W^ALT_FILE_SIZE, R0 ;ALT_FILE_SIZE, R0 ; 1689 BLEQ 22$ ;22$ ; MOVL W^FILE_DESC, 4(SP) ;FILE_DESC, ALT_FILE_DESC ; 1695 MOVW R0, 4(SP) ;R0, ALT_FILE_DESC ; 1696 MOVAB W^ALT_FILE_NAME, 8(SP) ;ALT_FILE_NAME, ALT_FILE_DESC+4 ; 1697 BLBC R8, 21$ ;R8, 21$ ; 1698 CLRL (SP) ;(SP) ; 1701 TSTL 288(R11) ;FILE_MODE ; BNEQ 18$ ;18$ ; INCL (SP) ;(SP) ; 18$: PUSHL SP ;SP ; PUSHAB 8(SP) ;ALT_FILE_DESC ; CALLS #2, G^USER_FILE_CHECK ;#2, USER_FILE_CHECK ; MOVL R0, R7 ;R0, STATUS ; BLBS R7, 21$ ;STATUS, 21$ ; 1702 19$: PUSHL R7 ;STATUS ; 1705 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; 20$: MOVL R7, R0 ;STATUS, R0 ; 1706 RET ; ; 21$: MOVAB W^ALT_FILE_NAME, 44(R11) ;ALT_FILE_NAME, FILE_FAB+44 ; 1709 MOVB W^ALT_FILE_SIZE, 52(R11) ;ALT_FILE_SIZE, FILE_FAB+52 ; 1710 22$: MOVC5 #0, (SP), #0, #96, 80(R11) ;#0, (SP), #0, #96, $RMS_PTR ; 1714 MOVW #24578, 80(R11) ;#24578, $RMS_PTR ; MNEGB #1, 82(R11) ;#1, $RMS_PTR+2 ; MOVAB 572(R11), 84(R11) ;RES_STR, $RMS_PTR+4 ; MNEGB #1, 90(R11) ;#1, $RMS_PTR+10 ; MOVAB 316(R11), 92(R11) ;EXP_STR, $RMS_PTR+12 ; MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 1720 CMPL R0, #1 ;R0, #1 ; 1723 BNEQ 23$ ;23$ ; MOVZWL #4096, 300(R11) ;#4096, REC_SIZE ; 1724 BRB 25$ ;25$ ; 23$: CMPL R0, #2 ;R0, #2 ; 1726 BNEQ 24$ ;24$ ; MOVZWL #510, 300(R11) ;#510, REC_SIZE ; 1727 BRB 25$ ;25$ ; 24$: CMPL R0, #3 ;R0, #3 ; 1729 BLSS 25$ ;25$ ; CMPL R0, #4 ;R0, #4 ; BGTR 25$ ;25$ ; MOVZWL #512, 300(R11) ;#512, REC_SIZE ; 1730 25$: PUSHAB 304(R11) ;REC_ADDRESS ; 1733 PUSHAB 300(R11) ;REC_SIZE ; CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM ; MOVL R0, R7 ;R0, STATUS ; PUSHL R11 ;R11 ; 1737 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 26$ ;STATUS, 26$ ; 1739 MOVC5 #0, (SP), #0, #68, 176(R11) ;#0, (SP), #0, #68, $RMS_PTR ; 1747 MOVW #17409, 176(R11) ;#17409, $RMS_PTR ; MOVL #1179648, 180(R11) ;#1179648, $RMS_PTR+4 ; CLRB 206(R11) ;$RMS_PTR+30 ; MOVL 304(R11), 216(R11) ;REC_ADDRESS, $RMS_PTR+40 ; MOVAB (R11), 236(R11) ;FILE_FAB, $RMS_PTR+60 ; PUSHAB 176(R11) ;FILE_RAB ; 1748 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT ; MOVL R0, R7 ;R0, STATUS ; BLBS R7, 27$ ;STATUS, 27$ ; 1750 26$: PUSHL R7 ;STATUS ; 1753 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1754 RET ; ; 27$: MOVL #2, 24(R11) ;#2, FILE_FAB+24 ; 1761 CLRL 296(R11) ;FILE_REC_COUNT ; 1762 MOVL 304(R11), 292(R11) ;REC_ADDRESS, FILE_REC_POINTER ; 1763 BLBS W^CONNECT_FLAG, 31$ ;CONNECT_FLAG, 31$ ; 1768 BLBC W^TY_FIL, 31$ ;TY_FIL, 31$ ; PUSHAB W^P.AAC ;P.AAC ; 1771 CALLS #1, W^TT_TEXT ;#1, TT_TEXT ; MOVZBL 83(R11), R0 ;FILE_NAM+3, R0 ; 1773 BLEQ 28$ ;28$ ; CLRB @84(R11)[R0] ;@FILE_NAM+4[R0] ; 1778 PUSHL 84(R11) ;FILE_NAM+4 ; 1779 BRB 29$ ;29$ ; 28$: MOVZBL 91(R11), R0 ;FILE_NAM+11, R0 ; 1785 ADDL2 92(R11), R0 ;FILE_NAM+12, R0 ; CLRB (R0) ;(R0) ; PUSHL 92(R11) ;FILE_NAM+12 ; 1786 29$: CALLS #1, W^TT_TEXT ;#1, TT_TEXT ; CALLS #0, W^TT_OUTPUT ;#0, TT_OUTPUT ; 1789 BRB 31$ ;31$ ; 1560 30$: MOVL #134316050, R0 ;#134316050, R0 ; 1795 RET ; ; 31$: CMPL -8(R11), #160 ;DEV_CLASS, #160 ; 1805 BNEQ 32$ ;32$ ; CLRW R6 ;SIZE ; 1808 CLRL W^FILE_NAME ;FILE_NAME ; 1809 BRB 37$ ;37$ ; 1805 32$: MOVL W^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 ; 1813 CMPL R0, #2 ;R0, #2 ; 1816 BNEQ 34$ ;34$ ; MOVZBL 83(R11), R7 ;FILE_NAM+3, R7 ; 1819 BLEQ 33$ ;33$ ; MOVC5 R7, @84(R11), #0, #132, W^FILE_NAME ;R7, @FILE_NAM+4, #0, #132, FILE_NAME ; 1823 MOVW R7, R6 ;R7, SIZE ; 1824 BRB 37$ ;37$ ; 1817 33$: MOVZBL 91(R11), R0 ;FILE_NAM+11, R0 ; 1828 MOVC5 R0, @92(R11), #0, #132, W^FILE_NAME ;R0, @FILE_NAM+12, #0, #132, FILE_NAME ; 1829 MOVZBW 91(R11), R6 ;FILE_NAM+11, SIZE ; 1830 BRB 37$ ;37$ ; 1817 34$: CMPL R0, #1 ;R0, #1 ; 1835 BEQL 35$ ;35$ ; CMPL R0, #4 ;R0, #4 ; BNEQ 37$ ;37$ ; 35$: MOVZBL 139(R11), R10 ;FILE_NAM+59, R10 ; 1837 MOVZBL 140(R11), R9 ;FILE_NAM+60, R9 ; 1838 MOVZBL #132, R8 ;#132, R8 ; MOVAB W^FILE_NAME, R7 ;FILE_NAME, R7 ; 1839 MOVC5 R10, @156(R11), #0, R8, (R7) ;R10, @FILE_NAM+76, #0, R8, (R7) ; BGEQ 36$ ;36$ ; ADDL2 R10, R7 ;R10, R7 ; SUBL2 R10, R8 ;R10, R8 ; MOVC5 R9, @160(R11), #0, R8, (R7) ;R9, @FILE_NAM+80, #0, R8, (R7) ; 36$: MOVZBL 139(R11), R0 ;FILE_NAM+59, R0 ; 1840 MOVZBL 140(R11), R1 ;FILE_NAM+60, R1 ; ADDW3 R1, R0, R6 ;R1, R0, SIZE ; 37$: CMPW R6, #132 ;SIZE, #132 ; 1844 BLEQU 38$ ;38$ ; MOVZBL #132, W^FILE_SIZE ;#132, FILE_SIZE ; BRB 39$ ;39$ ; 38$: MOVZWL R6, W^FILE_SIZE ;SIZE, FILE_SIZE ; 39$: MOVL #134316043, R0 ;#134316043, R0 ; 1846 RET ; ; 1847 ; Routine Size: 1064 bytes, Routine Base: $CODE$ + 0581 ; 1848 1 ; 1849 1 %SBTTL 'FILE_CLOSE' ; 1850 1 ; 1851 1 GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) = ; 1852 1 ; 1853 1 !++ ; 1854 1 ! FUNCTIONAL DESCRIPTION: ; 1855 1 ! ; 1856 1 ! This routine will close a file that was opened by FILE_OPEN. ; 1857 1 ! It assumes any data associated with the file is stored in this ; 1858 1 ! module, since this routine is called by KERMSG. ; 1859 1 ! ; 1860 1 ! CALLING SEQUENCE: ; 1861 1 ! ; 1862 1 ! FILE_CLOSE(); ; 1863 1 ! ; 1864 1 ! INPUT PARAMETERS: ; 1865 1 ! ; 1866 1 ! ABORT_FLAG - True if file should not be saved. ; 1867 1 ! ; 1868 1 ! IMPLICIT INPUTS: ; 1869 1 ! ; 1870 1 ! None. ; 1871 1 ! ; 1872 1 ! OUTPUT PARAMETERS: ; 1873 1 ! ; 1874 1 ! None. ; 1875 1 ! ; 1876 1 ! IMPLICIT OUTPUTS: ; 1877 1 ! ; 1878 1 ! None. ; 1879 1 ! ; 1880 1 ! COMPLETION CODES: ; 1881 1 ! ; 1882 1 ! None. ; 1883 1 ! ; 1884 1 ! SIDE EFFECTS: ; 1885 1 ! ; 1886 1 ! None. ; 1887 1 ! ; 1888 1 !-- ; 1889 1 ; 1890 2 BEGIN ; 1891 2 ; 1892 2 LOCAL ; 1893 2 STATUS; ! Random status values ; 1894 2 ; 1895 2 ![022] ; 1896 2 ![022] If there might be something left to write ; 1897 2 ![022] ; 1898 2 ; 1899 3 IF .FILE_MODE EQL FNC_WRITE AND (.FILE_REC_COUNT GTR 0 OR .FILE_FAB [FAB$L_CTX] NEQ ; 1900 3 F_STATE_DATA) ; 1901 2 THEN ; 1902 3 BEGIN ; 1903 3 ; 1904 3 SELECTONE .FILE_TYPE OF ; 1905 3 SET ; 1906 3 ; 1907 3 [FILE_FIX] : ; 1908 4 BEGIN ; 1909 4 ; 1910 4 INCR I FROM .FILE_REC_COUNT TO .REC_SIZE - 1 DO ; 1911 4 CH$WCHAR_A (CHR_NUL, FILE_REC_POINTER); ; 1912 4 ; 1913 4 STATUS = DUMP_BUFFER (); ; 1914 3 END; ; 1915 3 ; 1916 3 [FILE_ASC, FILE_BIN] : ; 1917 3 STATUS = DUMP_BUFFER (); ; 1918 3 ; 1919 3 [FILE_BLK] : ; 1920 4 BEGIN ; 1921 4 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1922 4 STATUS = $WRITE (RAB = FILE_RAB); ; 1923 4 ; 1924 4 IF NOT .STATUS ; 1925 4 THEN ; 1926 5 BEGIN ; 1927 5 FILE_ERROR (.STATUS); ; 1928 5 STATUS = KER_RMS32; ; 1929 5 END ; 1930 4 ELSE ; 1931 4 STATUS = KER_NORMAL; ; 1932 4 ; 1933 3 END; ; 1934 3 TES; ; 1935 3 ; 1936 3 IF NOT .STATUS THEN RETURN .STATUS; ; 1937 3 ; 1938 2 END; ; 1939 2 ; 1940 2 ! ; 1941 2 ! If reading from a mailbox, read until EOF to allow the process on the other ; 1942 2 ! end to terminal gracefully. ; 1943 2 ! ; 1944 2 ; 1945 2 IF .FILE_MODE EQL FNC_READ AND .DEV_CLASS EQL DC$_MAILBOX AND NOT .EOF_FLAG ; 1946 2 THEN ; 1947 2 ; 1948 2 DO ; 1949 2 STATUS = GET_BUFFER () ; 1950 2 UNTIL ( NOT .STATUS) OR .EOF_FLAG; ; 1951 2 ; 1952 2 STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 1953 2 ; 1954 2 IF .FIX_SIZE NEQ 0 THEN STATUS = LIB$FREE_VM (FIX_SIZE, FIX_ADDRESS); ; 1955 2 ; 1956 2 IF .ABORT_FLAG AND .FILE_MODE EQL FNC_WRITE ; 1957 2 THEN ; 1958 2 FILE_FAB [FAB$V_DLT] = TRUE ; 1959 2 ELSE ; 1960 2 FILE_FAB [FAB$V_DLT] = FALSE; ; 1961 2 ; 1962 2 STATUS = $CLOSE (FAB = FILE_FAB); ; 1963 2 EOF_FLAG = FALSE; ; 1964 2 ; 1965 2 IF NOT .STATUS ; 1966 2 THEN ; 1967 3 BEGIN ; 1968 3 FILE_ERROR (.STATUS); ; 1969 3 RETURN KER_RMS32; ; 1970 3 END ; 1971 2 ELSE ; 1972 2 RETURN KER_NORMAL; ; 1973 2 ; 1974 1 END; ! End of FILE_CLOSE .EXTRN SYS$CLOSE .ENTRY FILE_CLOSE, ^M ;FILE_CLOSE, Save R2,R3,R4 ; 1851 MOVAB G^LIB$FREE_VM, R4 ;LIB$FREE_VM, R4 ; MOVAB W^U.14, R3 ;U.14, R3 ; CMPL (R3), #1 ;FILE_MODE, #1 ; 1899 BNEQ 9$ ;9$ ; TSTL 8(R3) ;FILE_REC_COUNT ; BGTR 1$ ;1$ ; CMPL -264(R3), #2 ;FILE_FAB+24, #2 ; BEQL 9$ ;9$ ; 1$: MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 1904 CMPL R0, #4 ;R0, #4 ; 1907 BNEQ 4$ ;4$ ; SUBL3 #1, 8(R3), R0 ;#1, FILE_REC_COUNT, I ; 1911 BRB 3$ ;3$ ; 2$: CLRB @4(R3) ;@FILE_REC_POINTER ; INCL 4(R3) ;FILE_REC_POINTER ; 3$: AOBLSS 12(R3), R0, 2$ ;REC_SIZE, I, 2$ ; BRB 5$ ;5$ ; 1913 4$: TSTL R0 ;R0 ; 1916 BLEQ 6$ ;6$ ; CMPL R0, #2 ;R0, #2 ; BGTR 6$ ;6$ ; 5$: CALLS #0, W^U.2 ;#0, U.2 ; 1917 MOVL R0, R2 ;R0, STATUS ; BRB 8$ ;8$ ; 6$: CMPL R0, #3 ;R0, #3 ; 1919 BNEQ 8$ ;8$ ; MOVW 8(R3), -78(R3) ;FILE_REC_COUNT, FILE_RAB+34 ; 1921 PUSHAB -112(R3) ;FILE_RAB ; 1922 CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE ; MOVL R0, R2 ;R0, STATUS ; BLBS R2, 7$ ;STATUS, 7$ ; 1924 PUSHL R2 ;STATUS ; 1927 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R2 ;#134316138, STATUS ; 1928 BRB 8$ ;8$ ; 1924 7$: MOVL #134316043, R2 ;#134316043, STATUS ; 1931 8$: BLBS R2, 9$ ;STATUS, 9$ ; 1936 MOVL R2, R0 ;STATUS, R0 ; RET ; ; 9$: TSTL (R3) ;FILE_MODE ; 1945 BNEQ 11$ ;11$ ; CMPL -296(R3), #160 ;DEV_CLASS, #160 ; BNEQ 11$ ;11$ ; BLBS -292(R3), 11$ ;EOF_FLAG, 11$ ; 10$: CALLS #0, W^U.3 ;#0, U.3 ; 1949 MOVL R0, R2 ;R0, STATUS ; BLBC R2, 11$ ;STATUS, 11$ ; 1950 BLBC -292(R3), 10$ ;EOF_FLAG, 10$ ; 11$: PUSHAB 16(R3) ;REC_ADDRESS ; 1952 PUSHAB 12(R3) ;REC_SIZE ; CALLS #2, (R4) ;#2, LIB$FREE_VM ; MOVL R0, R2 ;R0, STATUS ; TSTL 20(R3) ;FIX_SIZE ; 1954 BEQL 12$ ;12$ ; PUSHAB 24(R3) ;FIX_ADDRESS ; PUSHAB 20(R3) ;FIX_SIZE ; CALLS #2, (R4) ;#2, LIB$FREE_VM ; MOVL R0, R2 ;R0, STATUS ; 12$: BLBC 4(AP), 13$ ;ABORT_FLAG, 13$ ; 1956 CMPL (R3), #1 ;FILE_MODE, #1 ; BNEQ 13$ ;13$ ; BISB2 #128, -283(R3) ;#128, FILE_FAB+5 ; 1958 BRB 14$ ;14$ ; 13$: BICB2 #128, -283(R3) ;#128, FILE_FAB+5 ; 1960 14$: PUSHAB -288(R3) ;FILE_FAB ; 1962 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE ; MOVL R0, R2 ;R0, STATUS ; CLRL -292(R3) ;EOF_FLAG ; 1963 BLBS R2, 15$ ;STATUS, 15$ ; 1965 PUSHL R2 ;STATUS ; 1968 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 1972 RET ; ; 15$: MOVL #134316043, R0 ;#134316043, R0 ; RET ; ; 1974 ; Routine Size: 268 bytes, Routine Base: $CODE$ + 09A9 ; 1975 1 ; 1976 1 %SBTTL 'NEXT_FILE' ; 1977 1 ; 1978 1 GLOBAL ROUTINE NEXT_FILE = ; 1979 1 ; 1980 1 !++ ; 1981 1 ! FUNCTIONAL DESCRIPTION: ; 1982 1 ! ; 1983 1 ! This routine will cause the next file to be opened. It will ; 1984 1 ! call the RMS-32 routine $SEARCH and $OPEN for the file. ; 1985 1 ! ; 1986 1 ! CALLING SEQUENCE: ; 1987 1 ! ; 1988 1 ! STATUS = NEXT_FILE; ; 1989 1 ! ; 1990 1 ! INPUT PARAMETERS: ; 1991 1 ! ; 1992 1 ! None. ; 1993 1 ! ; 1994 1 ! IMPLICIT INPUTS: ; 1995 1 ! ; 1996 1 ! FAB/NAM blocks set up from previous processing. ; 1997 1 ! ; 1998 1 ! OUTPUT PARAMETERS: ; 1999 1 ! ; 2000 1 ! None. ; 2001 1 ! ; 2002 1 ! IMPLICIT OUTPUTS: ; 2003 1 ! ; 2004 1 ! FAB/NAM blocks set up for the next file. ; 2005 1 ! ; 2006 1 ! COMPLETION CODES: ; 2007 1 ! ; 2008 1 ! TRUE - There is a next file. ; 2009 1 ! KER_RMS32 - No next file. ; 2010 1 ! ; 2011 1 ! SIDE EFFECTS: ; 2012 1 ! ; 2013 1 ! None. ; 2014 1 ! ; 2015 1 !-- ; 2016 1 ; 2017 2 BEGIN ; 2018 2 ; 2019 2 LOCAL ; 2020 2 SIZE : WORD, ! Size of the $FAO string ; 2021 2 STATUS; ! Random status values ; 2022 2 ; 2023 2 ! ; 2024 2 ! If we can't do a search, just return no more files ; 2025 2 ! ; 2026 2 ; 2027 2 IF NOT .SEARCH_FLAG THEN RETURN KER_NOMORFILES; ; 2028 2 ; 2029 2 ! ; 2030 2 ! Now search for the next file that we want to process. ; 2031 2 ! ; 2032 2 STATUS = $SEARCH (FAB = FILE_FAB); ; 2033 2 ; 2034 2 IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES; ; 2035 2 ; 2036 2 IF NOT .STATUS ; 2037 2 THEN ; 2038 3 BEGIN ; 2039 3 FILE_ERROR (.STATUS); ; 2040 3 RETURN KER_RMS32; ; 2041 2 END; ; 2042 2 ; 2043 2 ! ; 2044 2 ! Now we have the new file name. All that we have to do is open the file ; 2045 2 ! for reading now. ; 2046 2 ! ; 2047 2 STATUS = OPEN_READING (); ; 2048 2 ; 2049 2 IF NOT .STATUS THEN RETURN .STATUS; ; 2050 2 ; 2051 2 ![026] ; 2052 2 ![026] Copy the file name based on the type of file name we are to use. ; 2053 2 ![026] The possibilities are: ; 2054 2 ![026] Normal - Just copy name and type ; 2055 2 ![026] Full - Copy entire name string (either resultant or expanded) ; 2056 2 ![026] Untranslated - Copy string from name on (includes version, etc.) ; 2057 2 ; 2058 2 SELECTONE .FIL_NORMAL_FORM OF ; 2059 2 SET ; 2060 2 ; 2061 2 [FNM_FULL] : ; 2062 3 BEGIN ; 2063 3 ; 2064 3 IF .FILE_NAM [NAM$B_RSL] GTR 0 ; 2065 3 THEN ; 2066 4 BEGIN ; 2067 4 CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), CHR_NUL, ; 2068 4 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2069 4 SIZE = .FILE_NAM [NAM$B_RSL]; ; 2070 4 END ; 2071 3 ELSE ; 2072 4 BEGIN ; 2073 4 CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), CHR_NUL, ; 2074 4 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2075 4 SIZE = .FILE_NAM [NAM$B_ESL]; ; 2076 4 END ; 2077 4 ; 2078 2 END; ; 2079 2 ; 2080 2 [FNM_NORMAL, FNM_UNTRAN] : ; 2081 3 BEGIN ; 2082 3 CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]), ; 2083 3 .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL, ; 2084 3 MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 2085 3 SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE]; ; 2086 2 END; ; 2087 2 TES; ; 2088 2 ; 2089 2 IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE; ; 2090 2 ; 2091 2 RETURN KER_NORMAL; ; 2092 1 END; ! End of NEXT_FILE .ENTRY NEXT_FILE, ^M ; ; MOVAB W^U.11+11, R11 ;U.11+11, R11 ; BLBC -103(R11), 1$ ;SEARCH_FLAG, 1$ ; 2027 PUSHAB -91(R11) ;FILE_FAB ; 2032 CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH ; MOVL R0, R2 ;R0, STATUS ; CMPL R2, #99018 ;STATUS, #99018 ; 2034 BNEQ 2$ ;2$ ; 1$: MOVL #134316147, R0 ;#134316147, R0 ; RET ; ; 2$: BLBS R2, 3$ ;STATUS, 3$ ; 2036 PUSHL R2 ;STATUS ; 2039 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 2040 RET ; ; 3$: CALLS #0, W^U.31 ;#0, U.31 ; 2047 MOVL R0, R2 ;R0, STATUS ; BLBS R2, 4$ ;STATUS, 4$ ; 2049 MOVL R2, R0 ;STATUS, R0 ; RET ; ; 4$: MOVL W^FIL_NORMAL_FORM, R0 ;FIL_NORMAL_FORM, R0 ; 2058 CMPL R0, #2 ;R0, #2 ; 2061 BNEQ 6$ ;6$ ; MOVZBL -8(R11), R6 ;FILE_NAM+3, R6 ; 2064 BLEQ 5$ ;5$ ; MOVC5 R6, @-7(R11), #0, #132, W^FILE_NAME ;R6, @FILE_NAM+4, #0, #132, FILE_NAME ; 2068 MOVW R6, R7 ;R6, SIZE ; 2069 BRB 9$ ;9$ ; 2062 5$: MOVZBL (R11), R0 ;FILE_NAM+11, R0 ; 2073 MOVC5 R0, @1(R11), #0, #132, W^FILE_NAME ;R0, @FILE_NAM+12, #0, #132, FILE_NAME ; 2074 MOVZBW (R11), R7 ;FILE_NAM+11, SIZE ; 2075 BRB 9$ ;9$ ; 2062 6$: CMPL R0, #1 ;R0, #1 ; 2080 BEQL 7$ ;7$ ; CMPL R0, #4 ;R0, #4 ; BNEQ 9$ ;9$ ; 7$: MOVZBL 48(R11), R10 ;FILE_NAM+59, R10 ; 2082 MOVZBL 49(R11), R9 ;FILE_NAM+60, R9 ; 2083 MOVZBL #132, R8 ;#132, R8 ; MOVAB W^FILE_NAME, R6 ;FILE_NAME, R6 ; 2084 MOVC5 R10, @65(R11), #0, R8, (R6) ;R10, @FILE_NAM+76, #0, R8, (R6) ; BGEQ 8$ ;8$ ; ADDL2 R10, R6 ;R10, R6 ; SUBL2 R10, R8 ;R10, R8 ; MOVC5 R9, @69(R11), #0, R8, (R6) ;R9, @FILE_NAM+80, #0, R8, (R6) ; 8$: MOVZBL 48(R11), R0 ;FILE_NAM+59, R0 ; 2085 MOVZBL 49(R11), R1 ;FILE_NAM+60, R1 ; ADDW3 R1, R0, R7 ;R1, R0, SIZE ; 9$: CMPW R7, #132 ;SIZE, #132 ; 2089 BLEQU 10$ ;10$ ; MOVZBL #132, W^FILE_SIZE ;#132, FILE_SIZE ; BRB 11$ ;11$ ; 10$: MOVZWL R7, W^FILE_SIZE ;SIZE, FILE_SIZE ; 11$: MOVL #134316043, R0 ;#134316043, R0 ; 2091 RET ; ; 2092 ; Routine Size: 214 bytes, Routine Base: $CODE$ + 0AB5 ; 2093 1 ; 2094 1 %SBTTL 'LOG_OPEN - Open a log file' ; 2095 1 ; 2096 1 GLOBAL ROUTINE LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) = ; 2097 1 ; 2098 1 !++ ; 2099 1 ! FUNCTIONAL DESCRIPTION: ; 2100 1 ! ; 2101 1 ! CALLING SEQUENCE: ; 2102 1 ! ; 2103 1 ! STATUS = LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) ; 2104 1 ! ; 2105 1 ! INPUT PARAMETERS: ; 2106 1 ! ; 2107 1 ! LOG_DESC - Address of descriptor for file name to be opened ; 2108 1 ! ; 2109 1 ! LOG_FAB - Address of FAB for file ; 2110 1 ! ; 2111 1 ! LOG_RAB - Address of RAB for file ; 2112 1 ! ; 2113 1 ! IMPLICIT INPUTS: ; 2114 1 ! ; 2115 1 ! None. ; 2116 1 ! ; 2117 1 ! OUPTUT PARAMETERS: ; 2118 1 ! ; 2119 1 ! LOG_FAB and LOG_RAB updated. ; 2120 1 ! ; 2121 1 ! IMPLICIT OUTPUTS: ; 2122 1 ! ; 2123 1 ! None. ; 2124 1 ! ; 2125 1 ! COMPLETION CODES: ; 2126 1 ! ; 2127 1 ! Error code or true. ; 2128 1 ! ; 2129 1 ! SIDE EFFECTS: ; 2130 1 ! ; 2131 1 ! None. ; 2132 1 ! ; 2133 1 !-- ; 2134 1 ; 2135 2 BEGIN ; 2136 2 ; 2137 2 MAP ; 2138 2 LOG_DESC : REF BLOCK [8, BYTE], ! Name descriptor ; 2139 2 LOG_FAB : REF $FAB_DECL, ! FAB for file ; 2140 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2141 2 ; 2142 2 LOCAL ; 2143 2 STATUS, ! Random status values ; 2144 2 REC_ADDRESS, ! Address of record buffer ; 2145 2 REC_SIZE; ! Size of record buffer ; 2146 2 ; 2147 2 ! ; 2148 2 ! Get memory for records ; 2149 2 ! ; 2150 2 REC_SIZE = LOG_BUFF_SIZE; ; 2151 2 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 2152 2 ; 2153 2 IF NOT .STATUS ; 2154 2 THEN ; 2155 3 BEGIN ; 2156 3 LIB$SIGNAL (.STATUS); ; 2157 3 RETURN .STATUS; ; 2158 2 END; ; 2159 2 ; 2160 2 ! ; 2161 2 ! Initialize the FAB and RAB ; 2162 2 ! ; P 2163 2 $FAB_INIT (FAB = .LOG_FAB, FAC = PUT, FNA = .LOG_DESC [DSC$A_POINTER], ; P 2164 2 FNS = .LOG_DESC [DSC$W_LENGTH], FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR, ; 2165 2 RAT = CR, CTX = 0, DNA = UPLIT (%ASCII'.LOG'), DNS = 4); ; 2166 2 STATUS = $CREATE (FAB = .LOG_FAB); ; 2167 2 ; 2168 2 IF NOT .STATUS ; 2169 2 THEN ; 2170 3 BEGIN ; 2171 3 FILE_ERROR (.STATUS); ; 2172 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ! Dump record buffer ; 2173 3 RETURN KER_RMS32; ; 2174 2 END; ; 2175 2 ; P 2176 2 $RAB_INIT (RAB = .LOG_RAB, FAB = .LOG_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ; 2177 2 RSZ = .REC_SIZE, UBF = .REC_ADDRESS, USZ = .REC_SIZE, ROP = , CTX = 0); ; 2178 2 STATUS = $CONNECT (RAB = .LOG_RAB); ; 2179 2 ; 2180 2 IF NOT .STATUS ; 2181 2 THEN ; 2182 3 BEGIN ; 2183 3 FILE_ERROR (.STATUS); ; 2184 3 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 2185 3 $CLOSE (FAB = .LOG_FAB); ; 2186 3 RETURN KER_RMS32; ; 2187 3 END ; 2188 2 ELSE ; 2189 2 RETURN .STATUS; ; 2190 2 ; 2191 1 END; ! End of LOG_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAD: .ASCII \.LOG\ ; ; .PSECT $CODE$,NOWRT,2 .ENTRY LOG_OPEN, ^M ; ; MOVAB G^LIB$FREE_VM, R9 ;LIB$FREE_VM, R9 ; SUBL2 #8, SP ;#8, SP ; MOVZWL #256, 4(SP) ;#256, REC_SIZE ; 2150 PUSHL SP ;SP ; 2151 PUSHAB 8(SP) ;REC_SIZE ; CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM ; MOVL R0, R8 ;R0, STATUS ; BLBS R8, 1$ ;STATUS, 1$ ; 2153 PUSHL R8 ;STATUS ; 2156 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; BRW 4$ ;4$ ; 2157 1$: MOVL 8(AP), R7 ;LOG_FAB, R7 ; 2165 MOVC5 #0, (SP), #0, #80, (R7) ;#0, (SP), #0, #80, (R7) ; MOVW #20483, (R7) ;#20483, (R7) ; MOVL #270532674, 4(R7) ;#270532674, 4(R7) ; MOVB #1, 22(R7) ;#1, 22(R7) ; MOVW #512, 29(R7) ;#512, 29(R7) ; MOVB #2, 31(R7) ;#2, 31(R7) ; MOVL 4(AP), R0 ;LOG_DESC, R0 ; MOVL 4(R0), 44(R7) ;4(R0), 44(R7) ; MOVAB W^P.AAD, 48(R7) ;P.AAD, 48(R7) ; MOVB (R0), 52(R7) ;(R0), 52(R7) ; MOVB #4, 53(R7) ;#4, 53(R7) ; PUSHL R7 ;R7 ; 2166 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE ; MOVL R0, R8 ;R0, STATUS ; BLBS R8, 2$ ;STATUS, 2$ ; 2168 PUSHL R8 ;STATUS ; 2171 CALLS #1, W^U.6 ;#1, U.6 ; PUSHL SP ;SP ; 2172 PUSHAB 8(SP) ;REC_SIZE ; CALLS #2, (R9) ;#2, LIB$FREE_VM ; BRB 3$ ;3$ ; 2173 2$: MOVL 12(AP), R6 ;LOG_RAB, R6 ; 2177 MOVC5 #0, (SP), #0, #68, (R6) ;#0, (SP), #0, #68, (R6) ; MOVW #17409, (R6) ;#17409, (R6) ; MOVL #1179648, 4(R6) ;#1179648, 4(R6) ; CLRB 30(R6) ;30(R6) ; MOVW 4(SP), 32(R6) ;REC_SIZE, 32(R6) ; MOVW 4(SP), 34(R6) ;REC_SIZE, 34(R6) ; MOVL (SP), 36(R6) ;REC_ADDRESS, 36(R6) ; MOVL (SP), 40(R6) ;REC_ADDRESS, 40(R6) ; MOVL R7, 60(R6) ;R7, 60(R6) ; PUSHL R6 ;R6 ; 2178 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT ; MOVL R0, R8 ;R0, STATUS ; BLBS R8, 4$ ;STATUS, 4$ ; 2180 PUSHL R8 ;STATUS ; 2183 CALLS #1, W^U.6 ;#1, U.6 ; PUSHL SP ;SP ; 2184 PUSHAB 8(SP) ;REC_SIZE ; CALLS #2, (R9) ;#2, LIB$FREE_VM ; PUSHL R7 ;R7 ; 2185 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE ; 3$: MOVL #134316138, R0 ;#134316138, R0 ; 2189 RET ; ; 4$: MOVL R8, R0 ;STATUS, R0 ; RET ; ; 2191 ; Routine Size: 243 bytes, Routine Base: $CODE$ + 0B8B ; 2192 1 ; 2193 1 %SBTTL 'LOG_CLOSE - Close a log file' ; 2194 1 ; 2195 1 GLOBAL ROUTINE LOG_CLOSE (LOG_FAB, LOG_RAB) = ; 2196 1 ; 2197 1 !++ ; 2198 1 ! FUNCTIONAL DESCRIPTION: ; 2199 1 ! ; 2200 1 ! This routine will close an open log file. It will also ensure that ; 2201 1 !the last buffer gets dumped. ; 2202 1 ! ; 2203 1 ! CALLING SEQUENCE: ; 2204 1 ! ; 2205 1 ! STATUS = LOG_CLOSE (LOG_FAB, LOG_RAB); ; 2206 1 ! ; 2207 1 ! INPUT PARAMETERS: ; 2208 1 ! ; 2209 1 ! LOG_FAB - Address of log file FAB ; 2210 1 ! ; 2211 1 ! LOG_RAB - Address of log file RAB ; 2212 1 ! ; 2213 1 ! IMPLICIT INPUTS: ; 2214 1 ! ; 2215 1 ! None. ; 2216 1 ! ; 2217 1 ! OUPTUT PARAMETERS: ; 2218 1 ! ; 2219 1 ! None. ; 2220 1 ! ; 2221 1 ! IMPLICIT OUTPUTS: ; 2222 1 ! ; 2223 1 ! None. ; 2224 1 ! ; 2225 1 ! COMPLETION CODES: ; 2226 1 ! ; 2227 1 ! Resulting status. ; 2228 1 ! ; 2229 1 ! SIDE EFFECTS: ; 2230 1 ! ; 2231 1 ! None. ; 2232 1 ! ; 2233 1 !-- ; 2234 1 ; 2235 2 BEGIN ; 2236 2 ; 2237 2 MAP ; 2238 2 LOG_FAB : REF $FAB_DECL, ! FAB for log file ; 2239 2 LOG_RAB : REF $RAB_DECL; ! RAB for log file ; 2240 2 ; 2241 2 LOCAL ; 2242 2 STATUS, ! Random status values ; 2243 2 REC_ADDRESS, ! Address of record buffer ; 2244 2 REC_SIZE; ! Size of record buffer ; 2245 2 ; 2246 2 ! ; 2247 2 ! First write out any outstanding data ; 2248 2 ! ; 2249 2 ; 2250 2 IF .LOG_RAB [RAB$L_CTX] GTR 0 THEN LOG_PUT (.LOG_RAB); ! Dump current buffer ; 2251 2 ; 2252 2 ! ; 2253 2 ! Return the buffer ; 2254 2 ! ; 2255 2 REC_SIZE = LOG_BUFF_SIZE; ! Get size of buffer ; 2256 2 REC_ADDRESS = .LOG_RAB [RAB$L_RBF]; ! And address ; 2257 2 LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 2258 2 ! ; 2259 2 ! Now disconnect the RAB ; 2260 2 ! ; 2261 2 STATUS = $DISCONNECT (RAB = .LOG_RAB); ; 2262 2 ; 2263 2 IF NOT .STATUS ; 2264 2 THEN ; 2265 3 BEGIN ; 2266 3 FILE_ERROR (.STATUS); ; 2267 3 RETURN KER_RMS32; ; 2268 2 END; ; 2269 2 ; 2270 2 ! ; 2271 2 ! Now we can close the file ; 2272 2 ! ; 2273 2 STATUS = $CLOSE (FAB = .LOG_FAB); ; 2274 2 ; 2275 2 IF NOT .STATUS THEN FILE_ERROR (.STATUS); ; 2276 2 ; 2277 2 ! ; 2278 2 ! And return the result ; 2279 2 ! ; 2280 2 RETURN .STATUS; ; 2281 1 END; ! End of LOG_CLOSE .EXTRN SYS$DISCONNECT .ENTRY LOG_CLOSE, ^M ;LOG_CLOSE, Save R2 ; 2195 SUBL2 #8, SP ;#8, SP ; MOVL 8(AP), R2 ;LOG_RAB, R2 ; 2250 TSTL 24(R2) ;24(R2) ; BLEQ 1$ ;1$ ; PUSHL R2 ;R2 ; CALLS #1, W^U.1 ;#1, U.1 ; 1$: MOVZWL #256, 4(SP) ;#256, REC_SIZE ; 2255 MOVL 40(R2), (SP) ;40(R2), REC_ADDRESS ; 2256 PUSHL SP ;SP ; 2257 PUSHAB 8(SP) ;REC_SIZE ; CALLS #2, G^LIB$FREE_VM ;#2, LIB$FREE_VM ; PUSHL R2 ;R2 ; 2261 CALLS #1, G^SYS$DISCONNECT ;#1, SYS$DISCONNECT ; MOVL R0, R2 ;R0, STATUS ; BLBS R2, 2$ ;STATUS, 2$ ; 2263 PUSHL R2 ;STATUS ; 2266 CALLS #1, W^U.6 ;#1, U.6 ; MOVL #134316138, R0 ;#134316138, R0 ; 2267 RET ; ; 2$: PUSHL 4(AP) ;LOG_FAB ; 2273 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE ; MOVL R0, R2 ;R0, STATUS ; BLBS R2, 3$ ;STATUS, 3$ ; 2275 PUSHL R2 ;STATUS ; CALLS #1, W^U.6 ;#1, U.6 ; 3$: MOVL R2, R0 ;STATUS, R0 ; 2280 RET ; ; 2281 ; Routine Size: 100 bytes, Routine Base: $CODE$ + 0C7E ; 2282 1 ; 2283 1 %SBTTL 'LOG_CHAR - Log a character to a file' ; 2284 1 ; 2285 1 GLOBAL ROUTINE LOG_CHAR (CH, LOG_RAB) = ; 2286 1 ; 2287 1 !++ ; 2288 1 ! FUNCTIONAL DESCRIPTION: ; 2289 1 ! ; 2290 1 ! This routine will write one character to an open log file. ; 2291 1 !If the buffer becomes filled, it will dump it. It will also ; 2292 1 !dump the buffer if a carriage return line feed is seen. ; 2293 1 ! ; 2294 1 ! CALLING SEQUENCE: ; 2295 1 ! ; 2296 1 ! STATUS = LOG_CHAR (.CH, LOG_RAB); ; 2297 1 ! ; 2298 1 ! INPUT PARAMETERS: ; 2299 1 ! ; 2300 1 ! CH - The character to write to the file. ; 2301 1 ! ; 2302 1 ! LOG_RAB - The address of the log file RAB. ; 2303 1 ! ; 2304 1 ! IMPLICIT INPUTS: ; 2305 1 ! ; 2306 1 ! None. ; 2307 1 ! ; 2308 1 ! OUPTUT PARAMETERS: ; 2309 1 ! ; 2310 1 ! None. ; 2311 1 ! ; 2312 1 ! IMPLICIT OUTPUTS: ; 2313 1 ! ; 2314 1 ! None. ; 2315 1 ! ; 2316 1 ! COMPLETION CODES: ; 2317 1 ! ; 2318 1 ! Any error returned by LOG_PUT, else TRUE. ; 2319 1 ! ; 2320 1 ! SIDE EFFECTS: ; 2321 1 ! ; 2322 1 ! None. ; 2323 1 ! ; 2324 1 !-- ; 2325 1 ; 2326 2 BEGIN ; 2327 2 ; 2328 2 MAP ; 2329 2 LOG_RAB : REF $RAB_DECL; ! Log file RAB ; 2330 2 ; 2331 2 LOCAL ; 2332 2 STATUS; ! Random status value ; 2333 2 ; 2334 2 ! ; 2335 2 ! If this character is a line feed, and previous was a carriage return, then ; 2336 2 ! dump the buffer and return. ; 2337 2 ! ; 2338 2 ; 2339 2 IF .CH EQL CHR_LFD ; 2340 2 THEN ; 2341 3 BEGIN ; 2342 3 ! ; 2343 3 ! If we seem to have overfilled the buffer, that is because we saw a CR ; 2344 3 ! last, and had no place to put it. Just reset the size and dump the buffer. ; 2345 3 ! ; 2346 3 ; 2347 3 IF .LOG_RAB [RAB$L_CTX] GTR LOG_BUFF_SIZE ; 2348 3 THEN ; 2349 4 BEGIN ; 2350 4 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE; ; 2351 4 RETURN LOG_PUT (.LOG_RAB); ; 2352 3 END; ; 2353 3 ; 2354 3 ! ; 2355 3 ! If last character in buffer is a CR, then dump buffer without the CR ; 2356 3 ! ; 2357 3 ; 2358 3 IF CH$RCHAR (CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX] - 1)) EQL CHR_CRT ; 2359 3 THEN ; 2360 4 BEGIN ; 2361 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] - 1; ; 2362 4 RETURN LOG_PUT (.LOG_RAB); ; 2363 3 END; ; 2364 3 ; 2365 2 END; ; 2366 2 ; 2367 2 ! ; 2368 2 ! Don't need to dump buffer because of end of line problems. Check if ; 2369 2 ! the buffer is full. ; 2370 2 ! ; 2371 2 ; 2372 2 IF .LOG_RAB [RAB$L_CTX] GEQ LOG_BUFF_SIZE ; 2373 2 THEN ; 2374 3 BEGIN ; 2375 3 ! ; 2376 3 ! If character we want to store is a carriage return, then just count it and ; 2377 3 ! don't dump the buffer yet. ; 2378 3 ! ; 2379 3 ; 2380 3 IF .CH EQL CHR_CRT ; 2381 3 THEN ; 2382 4 BEGIN ; 2383 4 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1; ; 2384 4 RETURN KER_NORMAL; ; 2385 3 END; ; 2386 3 ; 2387 3 ! ; 2388 3 ! We must dump the buffer to make room for more characters ; 2389 3 ! ; 2390 3 STATUS = LOG_PUT (.LOG_RAB); ; 2391 3 ; 2392 3 IF NOT .STATUS THEN RETURN .STATUS; ; 2393 3 ; 2394 2 END; ; 2395 2 ; 2396 2 ! ; 2397 2 ! Here when we have some room to store the character ; 2398 2 ! ; 2399 2 CH$WCHAR (.CH, CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX])); ; 2400 2 LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1; ; 2401 2 RETURN KER_NORMAL; ; 2402 1 END; ! End of LOG_CHAR .ENTRY LOG_CHAR, ^M ;LOG_CHAR, Save R2 ; 2285 CMPL 4(AP), #10 ;CH, #10 ; 2339 BNEQ 3$ ;3$ ; MOVL 8(AP), R2 ;LOG_RAB, R2 ; 2347 CMPL 24(R2), #256 ;24(R2), #256 ; BLEQ 1$ ;1$ ; MOVZWL #256, 24(R2) ;#256, 24(R2) ; 2350 BRB 2$ ;2$ ; 2351 1$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 ; 2358 CMPB -1(R0), #13 ;-1(R0), #13 ; BNEQ 3$ ;3$ ; DECL 24(R2) ;24(R2) ; 2361 2$: PUSHL R2 ;R2 ; 2362 CALLS #1, W^U.1 ;#1, U.1 ; RET ; ; 3$: MOVL 8(AP), R2 ;LOG_RAB, R2 ; 2372 CMPL 24(R2), #256 ;24(R2), #256 ; BLSS 4$ ;4$ ; CMPL 4(AP), #13 ;CH, #13 ; 2380 BEQL 5$ ;5$ ; PUSHL R2 ;R2 ; 2390 CALLS #1, W^U.1 ;#1, U.1 ; BLBC R0, 6$ ;STATUS, 6$ ; 2392 4$: ADDL3 24(R2), 40(R2), R0 ;24(R2), 40(R2), R0 ; 2399 MOVB 4(AP), (R0) ;CH, (R0) ; 5$: INCL 24(R2) ;24(R2) ; 2400 MOVL #134316043, R0 ;#134316043, R0 ; 2401 6$: RET ; ; 2402 ; Routine Size: 104 bytes, Routine Base: $CODE$ + 0CE2 ; 2403 1 ; 2404 1 %SBTTL 'LOG_LINE - Log a line to a log file' ; 2405 1 ; 2406 1 GLOBAL ROUTINE LOG_LINE (LINE_DESC, LOG_RAB) = ; 2407 1 ; 2408 1 !++ ; 2409 1 ! FUNCTIONAL DESCRIPTION: ; 2410 1 ! ; 2411 1 ! This routine will write an entire line to a log file. And previously ; 2412 1 ! written characters will be dumped first. ; 2413 1 ! ; 2414 1 ! CALLING SEQUENCE: ; 2415 1 ! ; 2416 1 ! STATUS = LOG_LINE (LINE_DESC, LOG_RAB); ; 2417 1 ! ; 2418 1 ! INPUT PARAMETERS: ; 2419 1 ! ; 2420 1 ! LINE_DESC - Address of descriptor for string to be written ; 2421 1 ! ; 2422 1 ! LOG_RAB - RAB for log file ; 2423 1 ! ; 2424 1 ! IMPLICIT INPUTS: ; 2425 1 ! ; 2426 1 ! None. ; 2427 1 ! ; 2428 1 ! OUPTUT PARAMETERS: ; 2429 1 ! ; 2430 1 ! None. ; 2431 1 ! ; 2432 1 ! IMPLICIT OUTPUTS: ; 2433 1 ! ; 2434 1 ! None. ; 2435 1 ! ; 2436 1 ! COMPLETION CODES: ; 2437 1 ! ; 2438 1 ! KER_NORMAL or LOG_PUT error code. ; 2439 1 ! ; 2440 1 ! SIDE EFFECTS: ; 2441 1 ! ; 2442 1 ! None. ; 2443 1 ! ; 2444 1 !-- ; 2445 1 ; 2446 2 BEGIN ; 2447 2 ; 2448 2 MAP ; 2449 2 LINE_DESC : REF BLOCK [8, BYTE], ! Descriptor for string ; 2450 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2451 2 ; 2452 2 LOCAL ; 2453 2 STATUS; ! Random status value ; 2454 2 ; 2455 2 ! ; 2456 2 ! First check if anything is already in the buffer ; 2457 2 ! ; 2458 2 ; 2459 2 IF .LOG_RAB [RAB$L_CTX] GTR 0 ; 2460 2 THEN ; 2461 3 BEGIN ; 2462 3 STATUS = LOG_PUT (.LOG_RAB); ! Yes, write it out ; 2463 3 ; 2464 3 IF NOT .STATUS THEN RETURN .STATUS; ! Pass back any errors ; 2465 3 ; 2466 2 END; ; 2467 2 ; 2468 2 ! ; 2469 2 ! Copy the data to the buffer ; 2470 2 ! ; 2471 2 CH$COPY (.LINE_DESC [DSC$W_LENGTH], CH$PTR (.LINE_DESC [DSC$A_POINTER]), CHR_NUL, ; 2472 2 LOG_BUFF_SIZE, CH$PTR (.LOG_RAB [RAB$L_RBF])); ; 2473 2 ; 2474 2 IF .LINE_DESC [DSC$W_LENGTH] GTR LOG_BUFF_SIZE ; 2475 2 THEN ; 2476 2 LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE ; 2477 2 ELSE ; 2478 2 LOG_RAB [RAB$L_CTX] = .LINE_DESC [DSC$W_LENGTH]; ; 2479 2 ; 2480 2 ! ; 2481 2 ! Now just dump the buffer ; 2482 2 ! ; 2483 2 RETURN LOG_PUT (.LOG_RAB); ; 2484 1 END; ! End of LOG_LINE .ENTRY LOG_LINE, ^M ;LOG_LINE, Save R2,R3,R4,R5,R6,R7 ; 2406 MOVL 8(AP), R6 ;LOG_RAB, R6 ; 2459 TSTL 24(R6) ;24(R6) ; BLEQ 1$ ;1$ ; PUSHL R6 ;R6 ; 2462 CALLS #1, W^U.1 ;#1, U.1 ; BLBC R0, 4$ ;STATUS, 4$ ; 2464 1$: MOVL 4(AP), R7 ;LINE_DESC, R7 ; 2471 MOVC5 (R7), @4(R7), #0, #256, @40(R6) ;(R7), @4(R7), #0, #256, @40(R6) ; 2472 CMPW (R7), #256 ;(R7), #256 ; 2474 BLEQU 2$ ;2$ ; MOVZWL #256, 24(R6) ;#256, 24(R6) ; 2476 BRB 3$ ;3$ ; 2$: MOVZWL (R7), 24(R6) ;(R7), 24(R6) ; 2478 3$: PUSHL R6 ;R6 ; 2483 CALLS #1, W^U.1 ;#1, U.1 ; 4$: RET ; ; 2484 ; Routine Size: 62 bytes, Routine Base: $CODE$ + 0D4A ; 2485 1 %SBTTL 'LOG_FAOL - Log an FAO string to the log file' ; 2486 1 ; 2487 1 GLOBAL ROUTINE LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB) = ; 2488 1 ; 2489 1 !++ ; 2490 1 ! FUNCTIONAL DESCRIPTION: ; 2491 1 ! ; 2492 1 ! This routine will write an FAOL string to the output file. ; 2493 1 ! ; 2494 1 ! CALLING SEQUENCE: ; 2495 1 ! ; 2496 1 ! STATUS = LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB); ; 2497 1 ! ; 2498 1 ! INPUT PARAMETERS: ; 2499 1 ! ; 2500 1 ! FAOL_DESC - Address of descriptor for string to be written ; 2501 1 ! ; 2502 1 ! FAOL_PARAMS - Parameter list for FAOL call ; 2503 1 ! ; 2504 1 ! LOG_RAB - RAB for log file ; 2505 1 ! ; 2506 1 ! IMPLICIT INPUTS: ; 2507 1 ! ; 2508 1 ! None. ; 2509 1 ! ; 2510 1 ! OUPTUT PARAMETERS: ; 2511 1 ! ; 2512 1 ! None. ; 2513 1 ! ; 2514 1 ! IMPLICIT OUTPUTS: ; 2515 1 ! ; 2516 1 ! None. ; 2517 1 ! ; 2518 1 ! COMPLETION CODES: ; 2519 1 ! ; 2520 1 ! KER_NORMAL or $FAOL or LOG_PUT error code. ; 2521 1 ! ; 2522 1 ! SIDE EFFECTS: ; 2523 1 ! ; 2524 1 ! None. ; 2525 1 ! ; 2526 1 !-- ; 2527 1 ; 2528 2 BEGIN ; 2529 2 ; 2530 2 MAP ; 2531 2 FAOL_DESC : REF BLOCK [8, BYTE], ! Descriptor for string ; 2532 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2533 2 ; 2534 2 LITERAL ; 2535 2 FAOL_BUFSIZ = 256; ! Length of buffer ; 2536 2 ; 2537 2 LOCAL ; 2538 2 FAOL_BUFFER : VECTOR [FAOL_BUFSIZ, BYTE], ! Buffer for FAOL output ; 2539 2 FAOL_BUF_DESC : BLOCK [8, BYTE], ! Descriptor for buffer ; 2540 2 STATUS; ! Random status value ; 2541 2 ; 2542 2 ! ; 2543 2 ! Initialize descriptor for buffer ; 2544 2 ! ; 2545 2 FAOL_BUF_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 2546 2 FAOL_BUF_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 2547 2 FAOL_BUF_DESC [DSC$A_POINTER] = FAOL_BUFFER; ; 2548 2 FAOL_BUF_DESC [DSC$W_LENGTH] = FAOL_BUFSIZ; ; 2549 2 ! ; 2550 2 ! Now do the FAOL to generate the full text ; 2551 2 ! ; P 2552 2 STATUS = $FAOL (CTRSTR = .FAOL_DESC, OUTBUF = FAOL_BUF_DESC, ; 2553 2 OUTLEN = FAOL_BUF_DESC [DSC$W_LENGTH], PRMLST = .FAOL_PARAMS); ; 2554 2 IF NOT .STATUS THEN RETURN .STATUS; ; 2555 2 ! ; 2556 2 ! Dump the text into the file ; 2557 2 ! ; 2558 2 INCR I FROM 1 TO .FAOL_BUF_DESC [DSC$W_LENGTH] DO ; 2559 3 BEGIN ; 2560 3 STATUS = LOG_CHAR ( .FAOL_BUFFER [.I - 1], .LOG_RAB); ; 2561 3 IF NOT .STATUS THEN RETURN .STATUS; ; 2562 2 END; ; 2563 2 ; 2564 2 RETURN KER_NORMAL; ; 2565 2 ; 2566 1 END; ! End of LOG_FAOL .EXTRN SYS$FAOL .ENTRY LOG_FAOL, ^M ;LOG_FAOL, Save R2,R3 ; 2487 MOVAB -260(SP), SP ;-260(SP), SP ; PUSHL #17694976 ;#17694976 ; 2548 MOVAB 8(SP), 4(SP) ;FAOL_BUFFER, FAOL_BUF_DESC+4 ; 2547 PUSHL 8(AP) ;FAOL_PARAMS ; 2553 PUSHAB 4(SP) ;FAOL_BUF_DESC ; PUSHAB 8(SP) ;FAOL_BUF_DESC ; PUSHL 4(AP) ;FAOL_DESC ; CALLS #4, G^SYS$FAOL ;#4, SYS$FAOL ; BLBC R0, 3$ ;STATUS, 3$ ; 2554 MOVZWL (SP), R3 ;FAOL_BUF_DESC, R3 ; 2558 CLRL R2 ;I ; 2560 BRB 2$ ;2$ ; 1$: PUSHL 12(AP) ;LOG_RAB ; MOVZBL 11(SP)[R2], -(SP) ;FAOL_BUFFER-1[I], -(SP) ; CALLS #2, W^LOG_CHAR ;#2, LOG_CHAR ; BLBC R0, 3$ ;STATUS, 3$ ; 2561 2$: AOBLEQ R3, R2, 1$ ;R3, I, 1$ ; 2558 MOVL #134316043, R0 ;#134316043, R0 ; 2564 3$: RET ; ; 2566 ; Routine Size: 75 bytes, Routine Base: $CODE$ + 0D88 ; 2567 1 ; 2568 1 %SBTTL 'LOG_PUT - Write a record buffer for a log file' ; 2569 1 ROUTINE LOG_PUT (LOG_RAB) = ; 2570 1 ; 2571 1 !++ ; 2572 1 ! FUNCTIONAL DESCRIPTION: ; 2573 1 ! ; 2574 1 ! This routine will output one buffer for a log file. ; 2575 1 ! ; 2576 1 ! CALLING SEQUENCE: ; 2577 1 ! ; 2578 1 ! STATUS = LOG_PUT (LOG_RAB); ; 2579 1 ! ; 2580 1 ! INPUT PARAMETERS: ; 2581 1 ! ; 2582 1 ! LOG_RAB - RAB for log file. ; 2583 1 ! ; 2584 1 ! IMPLICIT INPUTS: ; 2585 1 ! ; 2586 1 ! None. ; 2587 1 ! ; 2588 1 ! OUPTUT PARAMETERS: ; 2589 1 ! ; 2590 1 ! None. ; 2591 1 ! ; 2592 1 ! IMPLICIT OUTPUTS: ; 2593 1 ! ; 2594 1 ! None. ; 2595 1 ! ; 2596 1 ! COMPLETION CODES: ; 2597 1 ! ; 2598 1 ! Status value from RMS ; 2599 1 ! ; 2600 1 ! SIDE EFFECTS: ; 2601 1 ! ; 2602 1 ! None. ; 2603 1 ! ; 2604 1 !-- ; 2605 1 ; 2606 2 BEGIN ; 2607 2 ; 2608 2 MAP ; 2609 2 LOG_RAB : REF $RAB_DECL; ! RAB for file ; 2610 2 ; 2611 2 ! ; 2612 2 ! Calculate record size ; 2613 2 ! ; 2614 2 LOG_RAB [RAB$W_RSZ] = .LOG_RAB [RAB$L_CTX]; ; 2615 2 LOG_RAB [RAB$W_USZ] = .LOG_RAB [RAB$W_RSZ]; ; 2616 2 ! ; 2617 2 ! Buffer will be empty when we finish ; 2618 2 ! ; 2619 2 LOG_RAB [RAB$L_CTX] = 0; ; 2620 2 ! ; 2621 2 ! And call RMS to write the buffer ; 2622 2 ! ; 2623 2 RETURN $PUT (RAB = .LOG_RAB); ; 2624 1 END; ! End of LOG_PUT ;LOG_PUT U.1: .WORD ^M<> ;Save nothing ; 2569 MOVL 4(AP), R0 ;LOG_RAB, R0 ; 2614 MOVW 24(R0), 34(R0) ;24(R0), 34(R0) ; MOVW 34(R0), 32(R0) ;34(R0), 32(R0) ; 2615 CLRL 24(R0) ;24(R0) ; 2619 PUSHL R0 ;R0 ; 2623 CALLS #1, G^SYS$PUT ;#1, SYS$PUT ; RET ; ; 2624 ; Routine Size: 29 bytes, Routine Base: $CODE$ + 0DD3 ; 2625 1 %SBTTL 'FILE_ERROR - Error processing for all RMS errors' ; 2626 1 ROUTINE FILE_ERROR (STATUS) : NOVALUE = ; 2627 1 ; 2628 1 !++ ; 2629 1 ! FUNCTIONAL DESCRIPTION: ; 2630 1 ! ; 2631 1 ! This routine will process all of the RMS-32 error returns. It will ; 2632 1 ! get the text for the error and then it will issue a KER_ERROR for ; 2633 1 ! the RMS failure. ; 2634 1 ! ; 2635 1 ! CALLING SEQUENCE: ; 2636 1 ! ; 2637 1 ! FILE_ERROR(); ; 2638 1 ! ; 2639 1 ! INPUT PARAMETERS: ; 2640 1 ! ; 2641 1 ! None. ; 2642 1 ! ; 2643 1 ! IMPLICIT INPUTS: ; 2644 1 ! ; 2645 1 ! STATUS - RMS error status. ; 2646 1 ! FILE_NAME - File name and extension. ; 2647 1 ! FILE_SIZE - Size of the thing in FILE_NAME. ; 2648 1 ! ; 2649 1 ! OUTPUT PARAMETERS: ; 2650 1 ! ; 2651 1 ! None. ; 2652 1 ! ; 2653 1 ! IMPLICIT OUTPUTS: ; 2654 1 ! ; 2655 1 ! None. ; 2656 1 ! ; 2657 1 ! COMPLETION CODES: ; 2658 1 ! ; 2659 1 ! None. ; 2660 1 ! ; 2661 1 ! SIDE EFFECTS: ; 2662 1 ! ; 2663 1 ! None. ; 2664 1 ! ; 2665 1 !-- ; 2666 1 ; 2667 2 BEGIN ; 2668 2 ; 2669 2 LOCAL ; 2670 2 ERR_LENGTH : WORD, ! Length of the text ; 2671 2 ERR_DESC : BLOCK [8, BYTE], ; 2672 2 ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)]; ; 2673 2 ; 2674 2 ERR_DESC [DSC$A_POINTER] = ERR_BUFFER; ; 2675 2 ERR_DESC [DSC$W_LENGTH] = MAX_MSG; ; 2676 2 ERR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 2677 2 ERR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 2678 2 $GETMSG (MSGID = .STATUS, MSGLEN = ERR_LENGTH, BUFADR = ERR_DESC, FLAGS = 0); ; 2679 2 ERR_DESC [DSC$W_LENGTH] = .ERR_LENGTH; ; 2680 2 LIB$SIGNAL (KER_RMS32, ERR_DESC, FILE_DESC); ; 2681 1 END; ! End of FILE_ERROR .EXTRN SYS$GETMSG ;FILE_ERROR U.6: .WORD ^M<> ;Save nothing ; 2626 MOVAB -112(SP), SP ;-112(SP), SP ; MOVAB 4(SP), 108(SP) ;ERR_BUFFER, ERR_DESC+4 ; 2674 MOVL #17694820, 104(SP) ;#17694820, ERR_DESC ; 2675 CLRQ -(SP) ;-(SP) ; 2678 PUSHAB 112(SP) ;ERR_DESC ; PUSHAB 12(SP) ;ERR_LENGTH ; PUSHL 4(AP) ;STATUS ; CALLS #5, G^SYS$GETMSG ;#5, SYS$GETMSG ; MOVW (SP), 104(SP) ;ERR_LENGTH, ERR_DESC ; 2679 PUSHAB W^FILE_DESC ;FILE_DESC ; 2680 PUSHAB 108(SP) ;ERR_DESC ; PUSHL #134316138 ;#134316138 ; CALLS #3, G^LIB$SIGNAL ;#3, LIB$SIGNAL ; RET ; ; 2681 ; Routine Size: 62 bytes, Routine Base: $CODE$ + 0DF0 ; 2682 1 %SBTTL 'End of KERFIL' ; 2683 1 END ! End of module ; 2684 1 ; 2685 0 ELUDOM ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 856 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $GLOBAL$ 12 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 3630 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$ 24 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;1 9776 139 1 581 00:00.8 ; COMMAND QUALIFIERS ; BLISS KERFIL/LIST=KERFIL.MAR/MACHINE_CODE=(ASSEM,NOBINARY,UNIQUE)/NOOBJECT/SOURCE=NOHEADER ; Compilation Complete .END