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