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