; 0001 MODULE KERFIL (IDENT = '2.0.006' ; 0002 ) = ; 0003 BEGIN ; 0004 ! ; 0005 ; 0006 !++ ; 0007 ! FACILITY: ; 0008 ! KERMIT-32 Microcomputer to mainframe file transfer utility. ; 0009 ! ; 0010 ! ABSTRACT: ; 0011 ! KERFIL contains all of the file processing for KERMIT-32. This ; 0012 ! module contains the routines to input/output characters to files ; 0013 ! and to open and close the files. ; 0014 ! ; 0015 ! ENVIRONMENT: ; 0016 ! VAX/VMS user mode. ; 0017 ! ; 0018 ! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983 ; 0019 ! ; 0020 !-- ; 0021 ; 0022 %SBTTL 'Table of Contents' ; 0023 %SBTTL 'Revision History' ; 0024 ; 0025 !++ ; 0026 ! ; 0027 ! 1.0.000 By: Robert C. McQueen On: 28-March-1983 ; 0028 ! Create this module. ; 0029 ! 1.0.001 By: Robert C. McQueen On: 4-April-1983 ; 0030 ! Remove checks for in the input data stream. ; 0031 ! ; 0032 ! 1.0.002 By: Robert C. McQueen On: 31-May-1983 ; 0033 ! Fix a bad check in wildcard processing. ; 0034 ! ; 0035 ! 1.0.003 By: Nick Bush On: 13-June-1983 ; 0036 ! Add default file spec of .;0 so that wild-carded ; 0037 ! file types don't cause all version of a file to ; 0038 ! be transferred. ; 0039 ! ; 0040 ! 1.0.004 By: Robert C. McQueen On: 20-July-1983 ; 0041 ! Strip off the parity bit on the compares for incoming ASCII ; 0042 ! files. ; 0043 ! ; 0044 ! 1.2.005 By: Robert C. McQueen On: 15-August-1983 ; 0045 ! Attempt to improve the GET%FILE and make it smaller. ; 0046 ! Also start the implementation of the BLOCK file processing. ; 0047 ! ; 0048 ! 2.0.006 Release VAX/VMS Kermit-32 version 2.0 ; 0049 !-- ; 0050 ; 0051 %SBTTL 'Forward definitions' ; 0052 ; 0053 FORWARD ROUTINE ; 0054 FILE_DUMP, ! Dump the contents of the record ; 0055 DUMP_BUFFER, ! Worker routine for FILE_DUMP. ; 0056 GET_BUFFER, ! Routine to do $GET ; 0057 GET_ASCII, ! Get an ASCII character ; 0058 GET_BLOCK, ! Get a block character ; 0059 FILE_ERROR : NOVALUE; ! Error processing routine ; 0060 ; 0061 %SBTTL 'Require/Library files' ; 0062 ! ; 0063 ! INCLUDE FILES: ; 0064 ! ; 0065 ; 0066 LIBRARY 'SYS$LIBRARY:STARLET'; ; 0067 ; 0068 REQUIRE 'KERCOM.REQ'; ; 0238 ; 0239 REQUIRE 'KERERR.REQ'; ; 0291 ; 0292 %SBTTL 'Macro definitions' ; 0293 ! ; 0294 ! MACROS: ; 0295 ! ; 0296 %SBTTL 'Literal symbol definitions' ; 0297 ! ; 0298 ! EQUATED SYMBOLS: ; 0299 ! ; 0300 ! ; 0301 ! Various states for reading the data from the file ; 0302 ! ; 0303 ; 0304 LITERAL ; 0305 F_STATE_PRE = 0, ! Prefix state ; 0306 F_STATE_PRE1 = 1, ! Other prefix state ; 0307 F_STATE_DATA = 2, ! Data processing state ; 0308 F_STATE_POST = 3, ! Postfix processing state ; 0309 F_STATE_POST1 = 4, ! Secondary postfix processing state ; 0310 F_STATE_MIN = 0, ! Min state number ; 0311 F_STATE_MAX = 4; ! Max state number ; 0312 ; 0313 %SBTTL 'Local storage' ; 0314 ! ; 0315 ! OWN STORAGE: ; 0316 ! ; 0317 ; 0318 OWN ; 0319 EOF_FLAG, ! End of file reached. ; 0320 STATUS, ! Status returned by RMS calls ; 0321 ! used in the FIL_ERROR routine ; 0322 FILE_FAB : $FAB_DECL, ! FAB for file processing ; 0323 FILE_NAM : $NAM_DECL, ! NAM for file processing ; 0324 FILE_RAB : $RAB_DECL, ! RAB for file processing ; 0325 FILE_XABFHC : $XABFHC_DECL, ! XAB for file processing ; 0326 FILE_MODE, ! Mode of file (reading/writing) ; 0327 FILE_REC_POINTER, ! Pointer to the record information ; 0328 FILE_REC_COUNT, ! Count of the number of bytes ; 0329 REC_SIZE : LONG, ! Record size ; 0330 REC_ADDRESS : LONG, ! Record address ; 0331 EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0332 RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], ; 0333 RES_STR_D : BLOCK [8, BYTE]; ! Descriptor for the string ; 0334 ; 0335 %SBTTL 'Global storage' ; 0336 ! ; 0337 ! Global storage: ; 0338 ! ; 0339 ; 0340 GLOBAL ; 0341 FILE_TYPE, ! Type of file being xfered ; 0342 FILE_DESC : BLOCK [8, BYTE]; ! File name descriptor ; 0343 ; 0344 %SBTTL 'External routines and storage' ; 0345 ! ; 0346 ! EXTERNAL REFERENCES: ; 0347 ! ; 0348 ! ; 0349 ! Storage in KERMSG ; 0350 ! ; 0351 ; 0352 EXTERNAL ; 0353 FILE_SIZE, ! Number of characters in FILE_NAME ; 0354 FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; ; 0355 ; 0356 ! ; 0357 ! System libraries ; 0358 ! ; 0359 ; 0360 EXTERNAL ROUTINE ; 0361 LIB$GET_VM : ADDRESSING_MODE (GENERAL), ; 0362 LIB$FREE_VM : ADDRESSING_MODE (GENERAL), ; 0363 LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; ; 0364 ; 0365 %SBTTL 'File processing -- FILE_INIT - Initialization' ; 0366 ; 0367 GLOBAL ROUTINE FILE_INIT : NOVALUE = ; 0368 ; 0369 !++ ; 0370 ! FUNCTIONAL DESCRIPTION: ; 0371 ! ; 0372 ! This routine will initialize some of the storage in the file processing ; 0373 ! module. ; 0374 ! ; 0375 ! CALLING SEQUENCE: ; 0376 ! ; 0377 ! FILE_INIT(); ; 0378 ! ; 0379 ! INPUT PARAMETERS: ; 0380 ! ; 0381 ! None. ; 0382 ! ; 0383 ! IMPLICIT INPUTS: ; 0384 ! ; 0385 ! None. ; 0386 ! ; 0387 ! OUTPUT PARAMETERS: ; 0388 ! ; 0389 ! None. ; 0390 ! ; 0391 ! IMPLICIT OUTPUTS: ; 0392 ! ; 0393 ! None. ; 0394 ! ; 0395 ! COMPLETION CODES: ; 0396 ! ; 0397 ! None. ; 0398 ! ; 0399 ! SIDE EFFECTS: ; 0400 ! ; 0401 ! None. ; 0402 ! ; 0403 !-- ; 0404 ; 0405 BEGIN ; 0406 FILE_TYPE = FILE_ASC; ; 0407 ! Now set up the file specification descriptor ; 0408 FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0409 FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0410 FILE_DESC [DSC$A_POINTER] = FILE_NAME; ; 0411 FILE_DESC [DSC$W_LENGTH] = 0; ; 0412 EOF_FLAG = FALSE; ; 0413 END; ! End of FILE_INIT .TITLE KERFIL .IDENT \2.0.006\ .PSECT $OWN$,NOEXE,2 ;EOF_FLAG U.7: .BLKB 4 ;STATUS U.8: .BLKB 4 ;FILE_FAB U.9: .BLKB 80 ;FILE_NAM U.10: .BLKB 96 ;FILE_RAB U.11: .BLKB 68 ;FILE_XABFHC U.12: .BLKB 44 ;FILE_MODE U.13: .BLKB 4 ;FILE_REC_POINTER U.14: .BLKB 4 ;FILE_REC_COUNT U.15: .BLKB 4 ;REC_SIZE U.16: .BLKB 4 ;REC_ADDRESS U.17: .BLKB 4 ;EXP_STR U.18: .BLKB 252 ;RES_STR U.19: .BLKB 252 ;RES_STR_D U.20: .BLKB 8 .PSECT $GLOBAL$,NOEXE,2 FILE_TYPE:: .BLKB 4 FILE_DESC:: .BLKB 8 PR_MIN== 0 PR_NONE== 0 PR_MARK== 1 PR_EVEN== 2 PR_ODD== 3 PR_SPACE== 4 PR_MAX== 4 GC_MIN== 0 GC_LOGOUT== 0 GC_EXIT== 1 GC_MAX== 1 DP_FULL== 0 DP_HALF== 1 CHK_1CHAR== 49 CHK_2CHAR== 50 CHK_CRC== 51 MAX_MSG== 96 .EXTRN FILE_SIZE, FILE_NAME, LIB$GET_VM, LIB$FREE_VM, LIB$SIGNAL .PSECT $CODE$,NOWRT,2 .ENTRY FILE_INIT, ^M<> ;FILE_INIT, Save nothing ; 0367 MOVL #1, W^FILE_TYPE ;#1, FILE_TYPE ; 0406 MOVL #17694720, W^FILE_DESC ;#17694720, FILE_DESC ; 0411 MOVAB W^FILE_NAME, W^FILE_DESC+4 ;FILE_NAME, FILE_DESC+4 ; 0410 CLRL W^U.7 ;U.7 ; 0412 RET ; ; 0367 ; Routine Size: 28 bytes, Routine Base: $CODE$ + 0000 ; 0414 ; 0415 %SBTTL 'GET_FILE' ; 0416 ; 0417 GLOBAL ROUTINE GET_FILE (CHARACTER) = ; 0418 ; 0419 !++ ; 0420 ! FUNCTIONAL DESCRIPTION: ; 0421 ! ; 0422 ! This routine will return a character from the input file. ; 0423 ! The character will be stored into the location specified by ; 0424 ! CHARACTER. ; 0425 ! ; 0426 ! CALLING SEQUENCE: ; 0427 ! ; 0428 ! GET_FILE (LOCATION_TO_STORE_CHAR); ; 0429 ! ; 0430 ! INPUT PARAMETERS: ; 0431 ! ; 0432 ! LOCATION_TO_STORE_CHAR - This is the address to store the character ; 0433 ! into. ; 0434 ! ; 0435 ! IMPLICIT INPUTS: ; 0436 ! ; 0437 ! None. ; 0438 ! ; 0439 ! OUTPUT PARAMETERS: ; 0440 ! ; 0441 ! Character stored into the location specified. ; 0442 ! ; 0443 ! IMPLICIT OUTPUTS: ; 0444 ! ; 0445 ! None. ; 0446 ! ; 0447 ! COMPLETION CODES: ; 0448 ! ; 0449 ! True - Character stored into the location specified. ; 0450 ! False - End of file reached. ; 0451 ! ; 0452 ! SIDE EFFECTS: ; 0453 ! ; 0454 ! None. ; 0455 ! ; 0456 !-- ; 0457 ; 0458 BEGIN ; 0459 ; 0460 IF .EOF_FLAG THEN RETURN KER_EOF; ; 0461 ; 0462 SELECTONE .FILE_TYPE OF ; 0463 SET ; 0464 ; 0465 [FILE_ASC, FILE_BIN] : ; 0466 STATUS = GET_ASCII (.CHARACTER); ; 0467 ; 0468 [FILE_BLK] : ; 0469 STATUS = GET_BLOCK (.CHARACTER); ; 0470 TES; ; 0471 ; 0472 RETURN .STATUS; ; 0473 END; ! End of GET_FILE .ENTRY GET_FILE, ^M<> ;GET_FILE, Save nothing ; 0417 BLBC W^U.7, 1$ ;U.7, 1$ ; 0460 MOVL #134316115, R0 ;#134316115, R0 ; RET ; ; 1$: MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 0462 BLEQ 2$ ;2$ ; CMPL R0, #2 ;R0, #2 ; BGTR 2$ ;2$ ; PUSHL 4(AP) ;CHARACTER ; 0466 CALLS #1, W^U.4 ;#1, U.4 ; BRB 3$ ;3$ ; 2$: CMPL R0, #3 ;R0, #3 ; 0462 BNEQ 4$ ;4$ ; PUSHL 4(AP) ;CHARACTER ; 0469 CALLS #1, W^U.5 ;#1, U.5 ; 3$: MOVL R0, W^U.8 ;R0, U.8 ; 4$: MOVL W^U.8, R0 ;U.8, R0 ; 0458 RET ; ; 0417 ; Routine Size: 61 bytes, Routine Base: $CODE$ + 001C ; 0474 ; 0475 %SBTTL 'GET_ASCII - Get a character from an ASCII file' ; 0476 ROUTINE GET_ASCII (CHARACTER) = ; 0477 ; 0478 !++ ; 0479 ! FUNCTIONAL DESCRIPTION: ; 0480 ! ; 0481 ! CALLING SEQUENCE: ; 0482 ! ; 0483 ! INPUT PARAMETERS: ; 0484 ! ; 0485 ! None. ; 0486 ! ; 0487 ! IMPLICIT INPUTS: ; 0488 ! ; 0489 ! None. ; 0490 ! ; 0491 ! OUPTUT PARAMETERS: ; 0492 ! ; 0493 ! None. ; 0494 ! ; 0495 ! IMPLICIT OUTPUTS: ; 0496 ! ; 0497 ! None. ; 0498 ! ; 0499 ! COMPLETION CODES: ; 0500 ! ; 0501 ! None. ; 0502 ! ; 0503 ! SIDE EFFECTS: ; 0504 ! ; 0505 ! None. ; 0506 ! ; 0507 !-- ; 0508 ; 0509 BEGIN ; 0510 ; 0511 OWN ; 0512 CC_COUNT, ! Count of the number of CC things to output ; 0513 CC_TYPE; ! Type of carriage control being processed. ; 0514 ; 0515 LOCAL ; 0516 RAT; ; 0517 ; 0518 RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK); ; 0519 RETURN ; 0520 ; 0521 WHILE TRUE DO ; 0522 BEGIN ; 0523 ; 0524 SELECTONE .RAT OF ; 0525 SET ; 0526 ; 0527 [FAB$M_PRN, FAB$M_FTN, FAB$M_CR] : ; 0528 ; 0529 CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF ; 0530 SET ; 0531 ; 0532 [F_STATE_PRE] : ; 0533 BEGIN ; 0534 STATUS = GET_BUFFER (); ; 0535 ; 0536 IF NOT .STATUS OR .STATUS EQL KER_EOF ; 0537 THEN EXITLOOP .STATUS; ; 0538 ; 0539 SELECTONE .RAT OF ; 0540 SET ; 0541 ; 0542 [FAB$M_CR] : ; 0543 BEGIN ; 0544 .CHARACTER = CHR_LFD; ; 0545 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0546 EXITLOOP KER_NORMAL; ; 0547 END; ; 0548 ; 0549 [FAB$M_PRN] : ; 0550 BEGIN ; 0551 CC_COUNT = CH$RCHAR_A (FILE_REC_POINTER); ; 0552 CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); ; 0553 FILE_REC_COUNT = .FILE_REC_COUNT - 2; ; 0554 ; 0555 IF .CC_COUNT<6, 1> EQL 0 ; 0556 THEN ; 0557 BEGIN ; 0558 ; 0559 IF .CC_COUNT<0, 6> NEQ 0 ; 0560 THEN ; 0561 BEGIN ; 0562 .CHARACTER = CHR_LFD; ; 0563 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; ; 0564 EXITLOOP KER_NORMAL; ; 0565 END ; 0566 ELSE ; 0567 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0568 ; 0569 END ; 0570 ELSE ; 0571 BEGIN ; 0572 ; 0573 SELECTONE .CC_COUNT<4, 2> OF ; 0574 SET ; 0575 ; 0576 [%B'00'] : ; 0577 BEGIN ; 0578 .CHARACTER = .CC_COUNT<0, 4>; ; 0579 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0580 EXITLOOP KER_NORMAL; ; 0581 END; ; 0582 ; 0583 [%B'10'] : ; 0584 BEGIN ; 0585 .CHARACTER = .CC_COUNT<0, 4> + 128; ; 0586 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0587 EXITLOOP KER_NORMAL; ; 0588 END; ; 0589 ; 0590 [OTHERWISE, %B'11'] : ; 0591 EXITLOOP KER_ILLFILTYP; ; 0592 TES; ; 0593 ; 0594 END; ; 0595 ; 0596 END; ; 0597 ; 0598 [FAB$M_FTN] : ; 0599 BEGIN ; 0600 CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); ; 0601 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0602 ; 0603 SELECTONE .CC_TYPE OF ; 0604 SET ; 0605 ; 0606 [CHR_NUL] : ; 0607 BEGIN ; 0608 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0609 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0610 END; ; 0611 ; 0612 [%C'$', %C' ', OTHERWISE] : ; 0613 BEGIN ; 0614 .CHARACTER = CHR_LFD; ; 0615 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0616 END; ; 0617 ; 0618 [%C'0'] : ; 0619 BEGIN ; 0620 .CHARACTER = CHR_LFD; ; 0621 FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; ; 0622 CC_COUNT = 1; ; 0623 END; ; 0624 ; 0625 [%C'1'] : ; 0626 BEGIN ; 0627 .CHARACTER = CHR_FFD; ; 0628 EXITLOOP KER_NORMAL; ; 0629 END; ; 0630 ; 0631 [%C'+'] : ; 0632 BEGIN ; 0633 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0634 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0635 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0636 END; ; 0637 TES; ; 0638 ; 0639 EXITLOOP KER_NORMAL; ; 0640 END; ; 0641 TES; ; 0642 ; 0643 END; ; 0644 ; 0645 [F_STATE_PRE1] : ; 0646 ; 0647 IF .RAT EQL FAB$M_FTN OR .RAT EQL FAB$M_PRN ; 0648 THEN ; 0649 BEGIN ; 0650 .CHARACTER = CHR_LFD; ; 0651 CC_COUNT = .CC_COUNT - 1; ; 0652 ; 0653 IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN ; 0654 THEN ; 0655 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0656 ; 0657 EXITLOOP KER_NORMAL; ; 0658 END ; 0659 ELSE ; 0660 EXITLOOP KER_ILLFILTYP; ; 0661 ; 0662 [F_STATE_DATA] : ; 0663 BEGIN ; 0664 ; 0665 IF .FILE_REC_COUNT EQL 0 ; 0666 THEN ; 0667 FILE_FAB [FAB$L_CTX] = F_STATE_POST ; 0668 ELSE ; 0669 BEGIN ; 0670 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0671 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0672 EXITLOOP KER_NORMAL; ; 0673 END; ; 0674 ; 0675 END; ; 0676 ; 0677 [F_STATE_POST] : ; 0678 BEGIN ; 0679 ; 0680 SELECTONE .RAT OF ; 0681 SET ; 0682 ; 0683 [FAB$M_CR] : ; 0684 BEGIN ; 0685 .CHARACTER = CHR_CRT; ; 0686 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0687 EXITLOOP KER_NORMAL; ; 0688 END; ; 0689 ; 0690 [FAB$M_FTN] : ; 0691 BEGIN ; 0692 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0693 ; 0694 IF .CC_TYPE NEQ CHR_NUL AND .CC_TYPE NEQ %C'$' ; 0695 THEN ; 0696 BEGIN ; 0697 .CHARACTER = CHR_CRT; ; 0698 EXITLOOP KER_NORMAL; ; 0699 END; ; 0700 ; 0701 END; ; 0702 ; 0703 [FAB$M_PRN] : ; 0704 BEGIN ; 0705 ; 0706 IF .CC_TYPE<6, 1> EQL 0 ; 0707 THEN ; 0708 BEGIN ; 0709 ; 0710 IF .CC_COUNT<0, 6> NEQ 0 ; 0711 THEN ; 0712 BEGIN ; 0713 .CHARACTER = CHR_LFD; ; 0714 FILE_FAB [FAB$L_CTX] = F_STATE_POST1; ; 0715 EXITLOOP KER_NORMAL; ; 0716 END ; 0717 ELSE ; 0718 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0719 ; 0720 END ; 0721 ELSE ; 0722 BEGIN ; 0723 ; 0724 SELECTONE .CC_TYPE<4, 2> OF ; 0725 SET ; 0726 ; 0727 [%B'00'] : ; 0728 BEGIN ; 0729 .CHARACTER = .CC_TYPE<0, 4>; ; 0730 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0731 EXITLOOP KER_NORMAL; ; 0732 END; ; 0733 ; 0734 [%B'10'] : ; 0735 BEGIN ; 0736 .CHARACTER = .CC_TYPE<0, 4> + 128; ; 0737 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 0738 EXITLOOP KER_NORMAL; ; 0739 END; ; 0740 ; 0741 [OTHERWISE, %B'11'] : ; 0742 EXITLOOP KER_ILLFILTYP; ; 0743 TES; ; 0744 ; 0745 END; ; 0746 ; 0747 END; ; 0748 TES; ! End SELECTONE .RAT ; 0749 ; 0750 END; ; 0751 ; 0752 [F_STATE_POST1] : ; 0753 ; 0754 IF .RAT EQL FAB$M_PRN ; 0755 THEN ; 0756 BEGIN ; 0757 .CHARACTER = CHR_LFD; ; 0758 CC_COUNT = .CC_COUNT - 1; ; 0759 ; 0760 IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN ; 0761 THEN ; 0762 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0763 ; 0764 IF .CC_COUNT EQL -1 AND .RAT EQL FAB$M_PRN ; 0765 THEN ; 0766 BEGIN ; 0767 .CHARACTER = CHR_CRT; ; 0768 FILE_FAB [FAB$L_CTX] = F_STATE_DATA; ; 0769 END; ; 0770 ; 0771 EXITLOOP KER_NORMAL; ; 0772 END ; 0773 ELSE ; 0774 EXITLOOP KER_ILLFILTYP; ; 0775 ; 0776 TES; ! End of CASE .STATE ; 0777 ; 0778 [OTHERWISE] : ; 0779 BEGIN ; 0780 ; 0781 WHILE .FILE_REC_COUNT LEQ 0 DO ; 0782 BEGIN ; 0783 STATUS = GET_BUFFER (); ; 0784 ; 0785 IF NOT .STATUS OR .STATUS EQL KER_EOF ; 0786 THEN EXITLOOP .STATUS; ; 0787 ; 0788 END; ; 0789 ; 0790 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0791 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0792 EXITLOOP KER_NORMAL; ; 0793 END; ; 0794 TES; ! End of SELECTONE .RAT ; 0795 ; 0796 END; ! End WHILE TRUE DO loop ; 0797 ; 0798 END; ! End of GET_ASCII .PSECT $OWN$,NOEXE,2 ;CC_COUNT U.25: .BLKB 4 ;CC_TYPE U.26: .BLKB 4 .PSECT $CODE$,NOWRT,2 ;GET_ASCII U.4: .WORD ^M ;Save R2,R3 ; 0476 MOVAB W^U.14, R3 ;U.14, R3 ; MOVZBL -262(R3), R2 ;FILE_FAB+30, RAT ; 0518 BICL2 #8, R2 ;#8, RAT ; 1$: TSTL R2 ;RAT ; 0524 BLEQ 2$ ;2$ ; CMPL R2, #2 ;RAT, #2 ; BLEQ 3$ ;3$ ; 2$: CMPL R2, #4 ;RAT, #4 ; BEQL 3$ ;3$ ; BRW 37$ ;37$ ; 3$: CASEL -268(R3), #0, #4 ;FILE_FAB+24, #0, #4 ; 0529 4$: .WORD 5$-4$,- ;5$-4$,- ; 16$-4$,- ;16$-4$,- ; 22$-4$,- ;22$-4$,- ; 23$-4$,- ;23$-4$,- ; 34$-4$ ;34$-4$ ; 5$: CALLS #0, W^U.3 ;#0, U.3 ; 0534 MOVL R0, -296(R3) ;R0, STATUS ; BLBS R0, 6$ ;R0, 6$ ; 0536 RET ; ; 6$: CMPL R0, #134316115 ;R0, #134316115 ; BNEQ 7$ ;7$ ; RET ; ; 7$: CMPL R2, #2 ;RAT, #2 ; 0539 BNEQ 9$ ;9$ ; 8$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0544 BRB 13$ ;13$ ; 0545 9$: CMPL R2, #4 ;RAT, #4 ; 0539 BNEQ 14$ ;14$ ; MOVZBL @0(R3), 528(R3) ;@FILE_REC_POINTER, CC_COUNT ; 0551 INCL (R3) ;FILE_REC_POINTER ; MOVZBL @0(R3), 532(R3) ;@FILE_REC_POINTER, CC_TYPE ; 0552 INCL (R3) ;FILE_REC_POINTER ; SUBL2 #2, 4(R3) ;#2, FILE_REC_COUNT ; 0553 BBS #6, 528(R3), 11$ ;#6, CC_COUNT, 11$ ; 0555 BITB 528(R3), #63 ;CC_COUNT, #63 ; 0559 BNEQ 10$ ;10$ ; BRW 28$ ;28$ ; 10$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0562 MOVL #1, -268(R3) ;#1, FILE_FAB+24 ; 0563 BRB 21$ ;21$ ; 0561 11$: EXTZV #4, #2, 528(R3), R0 ;#4, #2, CC_COUNT, R0 ; 0573 BNEQ 12$ ;12$ ; EXTZV #0, #4, 528(R3), @4(AP) ;#0, #4, CC_COUNT, @CHARACTER ; 0578 BRB 20$ ;20$ ; 0579 12$: CMPL R0, #2 ;R0, #2 ; 0573 BNEQ 18$ ;18$ ; EXTZV #0, #4, 528(R3), @4(AP) ;#0, #4, CC_COUNT, @CHARACTER ; 0585 ADDL2 #128, @4(AP) ;#128, @CHARACTER ; 13$: BRB 20$ ;20$ ; 0586 14$: CMPL R2, #1 ;RAT, #1 ; 0539 BNEQ 26$ ;26$ ; MOVZBL @0(R3), 532(R3) ;@FILE_REC_POINTER, CC_TYPE ; 0600 INCL (R3) ;FILE_REC_POINTER ; DECL 4(R3) ;FILE_REC_COUNT ; 0601 MOVL 532(R3), R0 ;CC_TYPE, R0 ; 0603 BNEQ 8$ ;8$ ; 15$: MOVZBL @0(R3), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0608 INCL (R3) ;FILE_REC_POINTER ; DECL 4(R3) ;FILE_REC_COUNT ; 0609 BRB 27$ ;27$ ; 0603 16$: CLRL R0 ;R0 ; 0647 CMPL R2, #1 ;RAT, #1 ; BNEQ 17$ ;17$ ; INCL R0 ;R0 ; BRB 19$ ;19$ ; 17$: CMPL R2, #4 ;RAT, #4 ; 18$: BEQL 19$ ;19$ ; BRW 36$ ;36$ ; 19$: MOVL #10, @4(AP) ;#10, @CHARACTER ; 0650 DECL 528(R3) ;CC_COUNT ; 0651 BNEQ 27$ ;27$ ; 0653 BLBC R0, 27$ ;R0, 27$ ; 20$: MOVL #2, -268(R3) ;#2, FILE_FAB+24 ; 0655 21$: BRB 27$ ;27$ ; 0649 22$: TSTL 4(R3) ;FILE_REC_COUNT ; 0665 BNEQ 15$ ;15$ ; MOVL #3, -268(R3) ;#3, FILE_FAB+24 ; 0667 BRB 29$ ;29$ ; 0665 23$: CMPL R2, #2 ;RAT, #2 ; 0680 BNEQ 24$ ;24$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0685 BRB 32$ ;32$ ; 0686 24$: CMPL R2, #1 ;RAT, #1 ; 0680 BNEQ 25$ ;25$ ; CLRL -268(R3) ;FILE_FAB+24 ; 0692 MOVL 532(R3), R0 ;CC_TYPE, R0 ; 0694 BEQL 29$ ;29$ ; CMPL R0, #36 ;R0, #36 ; BEQL 29$ ;29$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0697 BRB 33$ ;33$ ; 0696 25$: CMPL R2, #4 ;RAT, #4 ; 0680 26$: BNEQ 29$ ;29$ ; BBS #6, 532(R3), 30$ ;#6, CC_TYPE, 30$ ; 0706 BITB 528(R3), #63 ;CC_COUNT, #63 ; 0710 BEQL 28$ ;28$ ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0713 MOVL #4, -268(R3) ;#4, FILE_FAB+24 ; 0714 27$: BRB 33$ ;33$ ; 0712 28$: MOVL #2, -268(R3) ;#2, FILE_FAB+24 ; 0718 29$: BRW 1$ ;1$ ; 0706 30$: EXTZV #4, #2, 532(R3), R0 ;#4, #2, CC_TYPE, R0 ; 0724 BNEQ 31$ ;31$ ; EXTZV #0, #4, 532(R3), @4(AP) ;#0, #4, CC_TYPE, @CHARACTER ; 0729 BRB 32$ ;32$ ; 0730 31$: CMPL R0, #2 ;R0, #2 ; 0724 BNEQ 36$ ;36$ ; EXTZV #0, #4, 532(R3), @4(AP) ;#0, #4, CC_TYPE, @CHARACTER ; 0736 ADDL2 #128, @4(AP) ;#128, @CHARACTER ; 32$: CLRL -268(R3) ;FILE_FAB+24 ; 0737 33$: BRB 39$ ;39$ ; 0735 34$: CLRL R1 ;R1 ; 0754 CMPL R2, #4 ;RAT, #4 ; BNEQ 36$ ;36$ ; INCL R1 ;R1 ; MOVL #10, @4(AP) ;#10, @CHARACTER ; 0757 DECL 528(R3) ;CC_COUNT ; 0758 MOVL 528(R3), R0 ;CC_COUNT, R0 ; 0760 BNEQ 35$ ;35$ ; CMPL R2, #1 ;RAT, #1 ; BNEQ 35$ ;35$ ; MOVL #2, -268(R3) ;#2, FILE_FAB+24 ; 0762 35$: CMPL R0, #-1 ;R0, #-1 ; 0764 BNEQ 39$ ;39$ ; BLBC R1, 39$ ;R1, 39$ ; MOVL #13, @4(AP) ;#13, @CHARACTER ; 0767 BRW 20$ ;20$ ; 0768 36$: MOVL #134316138, R0 ;#134316138, R0 ; 0774 RET ; ; 37$: TSTL 4(R3) ;FILE_REC_COUNT ; 0781 BGTR 38$ ;38$ ; CALLS #0, W^U.3 ;#0, U.3 ; 0783 MOVL R0, -296(R3) ;R0, STATUS ; BLBC R0, 38$ ;R0, 38$ ; 0785 CMPL R0, #134316115 ;R0, #134316115 ; BNEQ 37$ ;37$ ; 38$: DECL 4(R3) ;FILE_REC_COUNT ; 0790 MOVZBL @0(R3), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0791 INCL (R3) ;FILE_REC_POINTER ; 39$: MOVL #134316043, R0 ;#134316043, R0 ; 0779 RET ; ; 0476 ; Routine Size: 490 bytes, Routine Base: $CODE$ + 0059 ; 0799 %SBTTL 'GET_BLOCK - Get a character from a BLOCKed file' ; 0800 ROUTINE GET_BLOCK (CHARACTER) = ; 0801 ; 0802 !++ ; 0803 ! FUNCTIONAL DESCRIPTION: ; 0804 ! ; 0805 ! This routine will return the next byte from a blocked file. This ; 0806 ! routine will use the $READ RMS call to get the next byte from the ; 0807 ! file. This way all RMS header information can be passed to the ; 0808 ! other file system. ; 0809 ! ; 0810 ! CALLING SEQUENCE: ; 0811 ! ; 0812 ! STATUS = GET_BLOCK(CHARACTER); ; 0813 ! ; 0814 ! INPUT PARAMETERS: ; 0815 ! ; 0816 ! CHARACTER - Address to store the character in. ; 0817 ! ; 0818 ! IMPLICIT INPUTS: ; 0819 ! ; 0820 ! REC_POINTER - Pointer into the record. ; 0821 ! REC_ADDRESS - Address of the record. ; 0822 ! REC_COUNT - Count of the number of bytes left in the record. ; 0823 ! ; 0824 ! OUPTUT PARAMETERS: ; 0825 ! ; 0826 ! None. ; 0827 ! ; 0828 ! IMPLICIT OUTPUTS: ; 0829 ! ; 0830 ! None. ; 0831 ! ; 0832 ! COMPLETION CODES: ; 0833 ! ; 0834 ! KER_NORMAL - Got a byte ; 0835 ! KER_EOF - End of file gotten. ; 0836 ! ; 0837 ! SIDE EFFECTS: ; 0838 ! ; 0839 ! None. ; 0840 ! ; 0841 !-- ; 0842 ; 0843 BEGIN ; 0844 ; 0845 WHILE .FILE_REC_COUNT LEQ 0 DO ; 0846 BEGIN ; 0847 STATUS = $READ (RAB = FILE_RAB); ; 0848 ; 0849 IF NOT .STATUS ; 0850 THEN ; 0851 ; 0852 IF .STATUS EQL RMS$_EOF ; 0853 THEN ; 0854 BEGIN ; 0855 EOF_FLAG = TRUE; ; 0856 RETURN KER_EOF; ; 0857 END ; 0858 ELSE ; 0859 BEGIN ; 0860 FILE_ERROR (); ; 0861 EOF_FLAG = TRUE; ; 0862 RETURN KER_RMS32; ; 0863 END; ; 0864 ; 0865 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 0866 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 0867 END; ; 0868 ; 0869 FILE_REC_COUNT = .FILE_REC_COUNT - 1; ; 0870 .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); ; 0871 RETURN KER_NORMAL; ; 0872 END; ! End of GET_BLOCK .EXTRN SYS$READ ;GET_BLOCK U.5: .WORD ^M ;Save R2 ; 0800 MOVAB W^U.15, R2 ;U.15, R2 ; 1$: TSTL (R2) ;FILE_REC_COUNT ; 0845 BGTR 5$ ;5$ ; PUSHAB -120(R2) ;FILE_RAB ; 0847 CALLS #1, G^SYS$READ ;#1, SYS$READ ; MOVL R0, -300(R2) ;R0, STATUS ; BLBS -300(R2), 4$ ;STATUS, 4$ ; 0849 CMPL -300(R2), #98938 ;STATUS, #98938 ; 0852 BNEQ 2$ ;2$ ; MOVL #134316115, R0 ;#134316115, R0 ; 0849 BRB 3$ ;3$ ; 2$: CALLS #0, W^U.6 ;#0, U.6 ; 0860 MOVL #134316122, R0 ;#134316122, R0 ; 0849 3$: MOVL #1, -304(R2) ;#1, EOF_FLAG ; 0855 RET ; ; 0852 4$: MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER ; 0865 MOVZWL -86(R2), (R2) ;FILE_RAB+34, FILE_REC_COUNT ; 0866 BRB 1$ ;1$ ; 0845 5$: DECL (R2) ;FILE_REC_COUNT ; 0869 MOVZBL @-4(R2), @4(AP) ;@FILE_REC_POINTER, @CHARACTER ; 0870 INCL -4(R2) ;FILE_REC_POINTER ; MOVL #134316043, R0 ;#134316043, R0 ; 0843 RET ; ; 0800 ; Routine Size: 98 bytes, Routine Base: $CODE$ + 0243 ; 0873 %SBTTL 'GET_BUFFER - Routine to read a buffer.' ; 0874 ROUTINE GET_BUFFER = ; 0875 ; 0876 !++ ; 0877 ! FUNCTIONAL DESCRIPTION: ; 0878 ! ; 0879 ! This routine will read a buffer from the disk file. It will ; 0880 ! return various status depending if there was an error reading ; 0881 ! the disk file or if the end of file is reached. ; 0882 ! ; 0883 ! CALLING SEQUENCE: ; 0884 ! ; 0885 ! STATUS = GET_BUFFER (); ; 0886 ! ; 0887 ! INPUT PARAMETERS: ; 0888 ! ; 0889 ! None. ; 0890 ! ; 0891 ! IMPLICIT INPUTS: ; 0892 ! ; 0893 ! None. ; 0894 ! ; 0895 ! OUTPUT PARAMETERS: ; 0896 ! ; 0897 ! None. ; 0898 ! ; 0899 ! IMPLICIT OUTPUTS: ; 0900 ! ; 0901 ! FILE_REC_POINTER - Pointer into the record. ; 0902 ! FILE_REC_COUNT - Count of the number of bytes in the record. ; 0903 ! ; 0904 ! COMPLETION CODES: ; 0905 ! ; 0906 ! KER_NORMAL - Got a buffer ; 0907 ! KER_EOF - End of file reached. ; 0908 ! KER_RMS32 - RMS error ; 0909 ! ; 0910 ! SIDE EFFECTS: ; 0911 ! ; 0912 ! None. ; 0913 ! ; 0914 !-- ; 0915 ; 0916 BEGIN ; 0917 STATUS = $GET (RAB = FILE_RAB); ; 0918 ; 0919 IF NOT .STATUS ; 0920 THEN ; 0921 ; 0922 IF .STATUS EQL RMS$_EOF ; 0923 THEN ; 0924 BEGIN ; 0925 EOF_FLAG = TRUE; ; 0926 RETURN KER_EOF; ; 0927 END ; 0928 ELSE ; 0929 BEGIN ; 0930 FILE_ERROR (); ; 0931 EOF_FLAG = TRUE; ; 0932 RETURN KER_RMS32; ; 0933 END; ; 0934 ; 0935 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 0936 FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; ; 0937 RETURN KER_NORMAL; ; 0938 END; .EXTRN SYS$GET ;GET_BUFFER U.3: .WORD ^M ;Save R2 ; 0874 MOVAB W^U.8, R2 ;U.8, R2 ; PUSHAB 180(R2) ;FILE_RAB ; 0917 CALLS #1, G^SYS$GET ;#1, SYS$GET ; MOVL R0, (R2) ;R0, STATUS ; BLBS (R2), 3$ ;STATUS, 3$ ; 0919 CMPL (R2), #98938 ;STATUS, #98938 ; 0922 BNEQ 1$ ;1$ ; MOVL #134316115, R0 ;#134316115, R0 ; 0919 BRB 2$ ;2$ ; 1$: CALLS #0, W^U.6 ;#0, U.6 ; 0930 MOVL #134316122, R0 ;#134316122, R0 ; 0919 2$: MOVL #1, -4(R2) ;#1, EOF_FLAG ; 0925 RET ; ; 0922 3$: MOVL 308(R2), 296(R2) ;REC_ADDRESS, FILE_REC_POINTER ; 0935 MOVZWL 214(R2), 300(R2) ;FILE_RAB+34, FILE_REC_COUNT ; 0936 MOVL #134316043, R0 ;#134316043, R0 ; 0916 RET ; ; 0874 ; Routine Size: 81 bytes, Routine Base: $CODE$ + 02A5 ; 0939 %SBTTL 'PUT_FILE' ; 0940 ; 0941 GLOBAL ROUTINE PUT_FILE (CHARACTER) = ; 0942 ; 0943 !++ ; 0944 ! FUNCTIONAL DESCRIPTION: ; 0945 ! ; 0946 ! This routine will store a character into the record buffer ; 0947 ! that we are building. It will output the buffer to disk ; 0948 ! when the end of line characters are found. ; 0949 ! ; 0950 ! CALLING SEQUENCE: ; 0951 ! ; 0952 ! STATUS = PUT_FILE(Character); ; 0953 ! ; 0954 ! INPUT PARAMETERS: ; 0955 ! ; 0956 ! Character - Address of the character to output in the file. ; 0957 ! ; 0958 ! IMPLICIT INPUTS: ; 0959 ! ; 0960 ! None. ; 0961 ! ; 0962 ! OUTPUT PARAMETERS: ; 0963 ! ; 0964 ! Status - True if no problems writing the character ; 0965 ! False if there were problems writing the character. ; 0966 ! ; 0967 ! IMPLICIT OUTPUTS: ; 0968 ! ; 0969 ! None. ; 0970 ! ; 0971 ! COMPLETION CODES: ; 0972 ! ; 0973 ! None. ; 0974 ! ; 0975 ! SIDE EFFECTS: ; 0976 ! ; 0977 ! None. ; 0978 ! ; 0979 !-- ; 0980 ; 0981 BEGIN ; 0982 ; 0983 SELECTONE .FILE_TYPE OF ; 0984 SET ; 0985 ; 0986 [FILE_ASC] : ; 0987 BEGIN ; 0988 ; 0989 IF ((.CHARACTER AND %O'177') EQL CHR_LFD) OR ((.CHARACTER AND %O'177') EQL ; 0990 CHR_NUL) ; 0991 THEN ; 0992 RETURN KER_NORMAL; ; 0993 ; 0994 IF (.CHARACTER AND %O'177') EQL CHR_CRT THEN RETURN DUMP_BUFFER (); ; 0995 ; 0996 IF .FILE_REC_COUNT EQL .REC_SIZE ; 0997 THEN ; 0998 BEGIN ; 0999 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1000 RETURN KER_REC_TOO_BIG; ; 1001 END; ; 1002 ; 1003 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1004 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1005 END; ; 1006 ; 1007 [FILE_BIN] : ; 1008 BEGIN ; 1009 ; 1010 IF .FILE_REC_COUNT EQL .REC_SIZE ; 1011 THEN ; 1012 BEGIN ; 1013 LIB$SIGNAL (KER_REC_TOO_BIG); ; 1014 RETURN KER_REC_TOO_BIG; ; 1015 END; ; 1016 ; 1017 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1018 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1019 END; ; 1020 ; 1021 [FILE_BLK] : ; 1022 BEGIN ; 1023 ; 1024 IF .FILE_REC_COUNT EQL .REC_SIZE ; 1025 THEN ; 1026 BEGIN ; 1027 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1028 STATUS = $WRITE (RAB = FILE_RAB); ; 1029 FILE_REC_COUNT = 0; ; 1030 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1031 END; ; 1032 ; 1033 FILE_REC_COUNT = .FILE_REC_COUNT + 1; ; 1034 CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); ; 1035 END; ; 1036 TES; ; 1037 ; 1038 RETURN KER_NORMAL; ; 1039 END; ! End of PUT_FILE .EXTRN SYS$WRITE .ENTRY PUT_FILE, ^M ;PUT_FILE, Save R2 ; 0941 MOVAB W^U.15, R2 ;U.15, R2 ; MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 0983 CMPL R0, #1 ;R0, #1 ; BNEQ 1$ ;1$ ; CMPZV #0, #7, 4(AP), #10 ;#0, #7, CHARACTER, #10 ; 0989 BEQL 5$ ;5$ ; BITB 4(AP), #127 ;CHARACTER, #127 ; BEQL 5$ ;5$ ; CMPZV #0, #7, 4(AP), #13 ;#0, #7, CHARACTER, #13 ; 0994 BNEQ 2$ ;2$ ; CALLS #0, W^U.2 ;#0, U.2 ; RET ; ; 1$: CMPL R0, #2 ;R0, #2 ; 0983 BNEQ 3$ ;3$ ; 2$: CMPL (R2), 4(R2) ;FILE_REC_COUNT, REC_SIZE ; 1010 BNEQ 4$ ;4$ ; PUSHL #134316146 ;#134316146 ; 1013 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL #134316146, R0 ;#134316146, R0 ; 1012 RET ; ; 3$: CMPL R0, #3 ;R0, #3 ; 0983 BNEQ 5$ ;5$ ; CMPL (R2), 4(R2) ;FILE_REC_COUNT, REC_SIZE ; 1024 BNEQ 4$ ;4$ ; MOVW (R2), -86(R2) ;FILE_REC_COUNT, FILE_RAB+34 ; 1027 PUSHAB -120(R2) ;FILE_RAB ; 1028 CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE ; MOVL R0, -300(R2) ;R0, STATUS ; CLRL (R2) ;FILE_REC_COUNT ; 1029 MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER ; 1030 4$: INCL (R2) ;FILE_REC_COUNT ; 1033 MOVB 4(AP), @-4(R2) ;CHARACTER, @FILE_REC_POINTER ; 1034 INCL -4(R2) ;FILE_REC_POINTER ; 5$: MOVL #134316043, R0 ;#134316043, R0 ; 0981 RET ; ; 0941 ; Routine Size: 133 bytes, Routine Base: $CODE$ + 02F6 ; 1040 ; 1041 %SBTTL 'FILE_DUMP - Output a record to the disk.' ; 1042 ; 1043 GLOBAL ROUTINE FILE_DUMP = ; 1044 ; 1045 !++ ; 1046 ! FUNCTIONAL DESCRIPTION: ; 1047 ! ; 1048 ! This routine will dump the contents of the current record into the ; 1049 ! user's file. It will return the status of the operation. ; 1050 ! ; 1051 ! CALLING SEQUENCE: ; 1052 ! ; 1053 ! FILE_DUMP (); ; 1054 ! ; 1055 ! INPUT PARAMETERS: ; 1056 ! ; 1057 ! None. ; 1058 ! ; 1059 ! IMPLICIT INPUTS: ; 1060 ! ; 1061 ! FILE_REC_COUNT - Count of the number of characters in the record ; 1062 ! .REC_ADDRESS - Address of the record to output. ; 1063 ! None. ; 1064 ! ; 1065 ! OUTPUT PARAMETERS: ; 1066 ! ; 1067 ! None. ; 1068 ! ; 1069 ! IMPLICIT OUTPUTS: ; 1070 ! ; 1071 ! None. ; 1072 ! ; 1073 ! COMPLETION CODES: ; 1074 ! ; 1075 ! KER_NORMAL - Did ok. ; 1076 ! KER_RMS32 - RMS-32 error. ; 1077 ! ; 1078 ! SIDE EFFECTS: ; 1079 ! ; 1080 ! None. ; 1081 ! ; 1082 !-- ; 1083 ; 1084 BEGIN ; 1085 ; 1086 SELECTONE .FILE_TYPE OF ; 1087 SET ; 1088 ; 1089 [FILE_BIN] : ; 1090 RETURN DUMP_BUFFER (); ; 1091 TES; ; 1092 ; 1093 RETURN KER_NORMAL; ; 1094 END; ! End of FILE_DUMP U.1: .ENTRY FILE_DUMP, ^M<> ;FILE_DUMP, Save nothing ; 1043 MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 1086 CMPL R0, #2 ;R0, #2 ; BNEQ 1$ ;1$ ; CALLS #0, W^U.2 ;#0, U.2 ; 1090 RET ; ; 1$: MOVL #134316043, R0 ;#134316043, R0 ; 1084 RET ; ; 1043 ; Routine Size: 26 bytes, Routine Base: $CODE$ + 037B ; 1095 ; 1096 %SBTTL 'DUMP_BUFFER - Dump the current record to disk' ; 1097 ROUTINE DUMP_BUFFER = ; 1098 ; 1099 !++ ; 1100 ! FUNCTIONAL DESCRIPTION: ; 1101 ! ; 1102 ! This routine will dump the current record to disk. It doesn't ; 1103 ! care what type of file you are writing, unlike FILE_DUMP. ; 1104 ! ; 1105 ! CALLING SEQUENCE: ; 1106 ! ; 1107 ! STATUS = DUMP_BUFFER(); ; 1108 ! ; 1109 ! INPUT PARAMETERS: ; 1110 ! ; 1111 ! None. ; 1112 ! ; 1113 ! IMPLICIT INPUTS: ; 1114 ! ; 1115 ! None. ; 1116 ! ; 1117 ! OUTPUT PARAMETERS: ; 1118 ! ; 1119 ! None. ; 1120 ! ; 1121 ! IMPLICIT OUTPUTS: ; 1122 ! ; 1123 ! None. ; 1124 ! ; 1125 ! COMPLETION CODES: ; 1126 ! ; 1127 ! KER_NORMAL - Output went ok. ; 1128 ! KER_RMS32 - RMS-32 error. ; 1129 ! ; 1130 ! SIDE EFFECTS: ; 1131 ! ; 1132 ! None. ; 1133 ! ; 1134 !-- ; 1135 ; 1136 BEGIN ; 1137 ! ; 1138 ! First update the record length ; 1139 ! ; 1140 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1141 ! ; 1142 ! Now output the record to the file ; 1143 ! ; 1144 STATUS = $PUT (RAB = FILE_RAB); ; 1145 ! ; 1146 ! Update the pointers first ; 1147 ! ; 1148 FILE_REC_COUNT = 0; ; 1149 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1150 ! ; 1151 ! Now determine if we failed attempting to write the record ; 1152 ! ; 1153 ; 1154 IF NOT .STATUS ; 1155 THEN ; 1156 BEGIN ; 1157 FILE_ERROR (); ; 1158 RETURN KER_RMS32 ; 1159 END; ; 1160 ; 1161 RETURN KER_NORMAL ; 1162 END; ! End of DUMP_BUFFER .EXTRN SYS$PUT ;DUMP_BUFFER U.2: .WORD ^M ;Save R2 ; 1097 MOVAB W^U.15, R2 ;U.15, R2 ; MOVW (R2), -86(R2) ;FILE_REC_COUNT, FILE_RAB+34 ; 1140 PUSHAB -120(R2) ;FILE_RAB ; 1144 CALLS #1, G^SYS$PUT ;#1, SYS$PUT ; MOVL R0, -300(R2) ;R0, STATUS ; CLRL (R2) ;FILE_REC_COUNT ; 1148 MOVL 8(R2), -4(R2) ;REC_ADDRESS, FILE_REC_POINTER ; 1149 BLBS -300(R2), 1$ ;STATUS, 1$ ; 1154 CALLS #0, W^U.6 ;#0, U.6 ; 1157 MOVL #134316122, R0 ;#134316122, R0 ; 1156 RET ; ; 1$: MOVL #134316043, R0 ;#134316043, R0 ; 1136 RET ; ; 1097 ; Routine Size: 59 bytes, Routine Base: $CODE$ + 0395 ; 1163 %SBTTL 'OPEN_READING' ; 1164 ROUTINE OPEN_READING = ; 1165 ; 1166 !++ ; 1167 ! FUNCTIONAL DESCRIPTION: ; 1168 ! ; 1169 ! This routine will open a file for reading. It will return either ; 1170 ! true or false to the called depending on the success of the ; 1171 ! operation. ; 1172 ! ; 1173 ! CALLING SEQUENCE: ; 1174 ! ; 1175 ! status = OPEN_READING(); ; 1176 ! ; 1177 ! INPUT PARAMETERS: ; 1178 ! ; 1179 ! None. ; 1180 ! ; 1181 ! IMPLICIT INPUTS: ; 1182 ! ; 1183 ! None. ; 1184 ! ; 1185 ! OUTPUT PARAMETERS: ; 1186 ! ; 1187 ! None. ; 1188 ! ; 1189 ! IMPLICIT OUTPUTS: ; 1190 ! ; 1191 ! None. ; 1192 ! ; 1193 ! COMPLETION CODES: ; 1194 ! ; 1195 ! None. ; 1196 ! ; 1197 ! SIDE EFFECTS: ; 1198 ! ; 1199 ! None. ; 1200 ! ; 1201 !-- ; 1202 ; 1203 BEGIN ; 1204 ! ; 1205 ! We now have an expanded file specification that we can use to process ; 1206 ! the file. ; 1207 ! ; 1208 ; 1209 IF .FILE_TYPE NEQ FILE_BLK ; 1210 THEN ; 1211 BEGIN ; P 1212 $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM, ; 1213 XAB = FILE_XABFHC); ; 1214 END ; 1215 ELSE ; 1216 BEGIN ; P 1217 $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, ; 1218 NAM = FILE_NAM, XAB = FILE_XABFHC); ; 1219 END; ; 1220 ; 1221 $XABFHC_INIT (XAB = FILE_XABFHC); ; 1222 STATUS = $OPEN (FAB = FILE_FAB); ; 1223 ; 1224 IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) ; 1225 THEN ; 1226 BEGIN ; 1227 FILE_ERROR (); ; 1228 RETURN KER_RMS32; ; 1229 END; ; 1230 ; 1231 ! ; 1232 ! Now allocate a buffer for the records ; 1233 ! ; 1234 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]); ; 1235 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1236 ! ; 1237 ! Initialize the RAB for the $CONNECT RMS call ; 1238 ! ; P 1239 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS, ; 1240 USZ = .REC_SIZE); ; 1241 STATUS = $CONNECT (RAB = FILE_RAB); ; 1242 ; 1243 IF NOT .STATUS ; 1244 THEN ; 1245 BEGIN ; 1246 FILE_ERROR (); ; 1247 RETURN KER_RMS32; ; 1248 END; ; 1249 ; 1250 FILE_REC_COUNT = -1; ; 1251 FILE_FAB [FAB$L_CTX] = F_STATE_PRE; ; 1252 RETURN KER_NORMAL; ; 1253 END; ! End of OPEN_READING U.29= U.9 U.30= U.9 U.31= U.12 U.32= U.11 .EXTRN SYS$OPEN, SYS$CONNECT ;OPEN_READING U.28: .WORD ^M ;Save R2,R3,R4,R5,R6 ; 1164 MOVAB W^U.29, R6 ;U.29, R6 ; CMPL W^FILE_TYPE, #3 ;FILE_TYPE, #3 ; 1209 BEQL 1$ ;1$ ; MOVC5 #0, (SP), #0, #80, (R6) ;#0, (SP), #0, #80, $RMS_PTR ; 1213 MOVW #20483, (R6) ;#20483, $RMS_PTR ; MOVL #16777216, 4(R6) ;#16777216, $RMS_PTR+4 ; MOVB #2, 22(R6) ;#2, $RMS_PTR+22 ; BRB 2$ ;2$ ; 1$: MOVC5 #0, (SP), #0, #80, (R6) ;#0, (SP), #0, #80, $RMS_PTR ; 1218 MOVW #20483, (R6) ;#20483, $RMS_PTR ; MOVL #16777216, 4(R6) ;#16777216, $RMS_PTR+4 ; MOVB #34, 22(R6) ;#34, $RMS_PTR+22 ; 2$: MOVB #4, 31(R6) ;#4, $RMS_PTR+31 ; MOVAB 244(R6), 36(R6) ;FILE_XABFHC, $RMS_PTR+36 ; MOVAB 80(R6), 40(R6) ;FILE_NAM, $RMS_PTR+40 ; 1213 MOVC5 #0, (SP), #0, #44, 244(R6) ;#0, (SP), #0, #44, $RMS_PTR ; 1221 MOVW #11293, 244(R6) ;#11293, $RMS_PTR ; PUSHL R6 ;R6 ; 1222 CALLS #1, G^SYS$OPEN ;#1, SYS$OPEN ; MOVL R0, -4(R6) ;R0, STATUS ; CMPL -4(R6), #65537 ;STATUS, #65537 ; 1224 BEQL 3$ ;3$ ; CMPL -4(R6), #98353 ;STATUS, #98353 ; BNEQ 6$ ;6$ ; 3$: CMPL W^FILE_TYPE, #3 ;FILE_TYPE, #3 ; 1234 BNEQ 4$ ;4$ ; MOVZWL #512, R0 ;#512, R0 ; BRB 5$ ;5$ ; 4$: MOVZWL 254(R6), R0 ;FILE_XABFHC+10, R0 ; 5$: MOVL R0, 300(R6) ;R0, REC_SIZE ; PUSHAB 304(R6) ;REC_ADDRESS ; 1235 PUSHAB 300(R6) ;REC_SIZE ; CALLS #2, G^LIB$GET_VM ;#2, LIB$GET_VM ; MOVL R0, -4(R6) ;R0, STATUS ; MOVC5 #0, (SP), #0, #68, 176(R6) ;#0, (SP), #0, #68, $RMS_PTR ; 1240 MOVW #17409, 176(R6) ;#17409, $RMS_PTR ; MOVL #1048576, 180(R6) ;#1048576, $RMS_PTR+4 ; CLRB 206(R6) ;$RMS_PTR+30 ; MOVW 300(R6), 208(R6) ;REC_SIZE, $RMS_PTR+32 ; MOVL 304(R6), 212(R6) ;REC_ADDRESS, $RMS_PTR+36 ; MOVAB (R6), 236(R6) ;FILE_FAB, $RMS_PTR+60 ; PUSHAB 176(R6) ;FILE_RAB ; 1241 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT ; MOVL R0, -4(R6) ;R0, STATUS ; BLBS -4(R6), 7$ ;STATUS, 7$ ; 1243 6$: CALLS #0, W^U.6 ;#0, U.6 ; 1246 MOVL #134316122, R0 ;#134316122, R0 ; 1245 RET ; ; 7$: MNEGL #1, 296(R6) ;#1, FILE_REC_COUNT ; 1250 CLRL 24(R6) ;FILE_FAB+24 ; 1251 MOVL #134316043, R0 ;#134316043, R0 ; 1203 RET ; ; 1164 ; Routine Size: 269 bytes, Routine Base: $CODE$ + 03D0 ; 1254 %SBTTL 'FILE_OPEN' ; 1255 ; 1256 GLOBAL ROUTINE FILE_OPEN (FUNCTION) = ; 1257 ; 1258 !++ ; 1259 ! FUNCTIONAL DESCRIPTION: ; 1260 ! ; 1261 ! This routine will open a file for reading or writing depending on ; 1262 ! the function that is passed this routine. It will handle wildcards ; 1263 ! on the read function. ; 1264 ! ; 1265 ! CALLING SEQUENCE: ; 1266 ! ; 1267 ! status = FILE_OPEN(FUNCTION); ; 1268 ! ; 1269 ! INPUT PARAMETERS: ; 1270 ! ; 1271 ! FUNCTION - Function to do. Either FNC_READ or FNC_WRITE. ; 1272 ! ; 1273 ! IMPLICIT INPUTS: ; 1274 ! ; 1275 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1276 ! of the name. ; 1277 ! ; 1278 ! OUTPUT PARAMETERS: ; 1279 ! ; 1280 ! None. ; 1281 ! ; 1282 ! IMPLICIT OUTPUTS: ; 1283 ! ; 1284 ! FILE_NAME and FILE_SIZE set up with the file name and the length ; 1285 ! of the name. ; 1286 ! ; 1287 ! COMPLETION CODES: ; 1288 ! ; 1289 ! KER_NORMAL - File opened correctly. ; 1290 ! KER_RMS32 - Problem processing the file. ; 1291 ! ; 1292 ! SIDE EFFECTS: ; 1293 ! ; 1294 ! None. ; 1295 ! ; 1296 !-- ; 1297 ; 1298 BEGIN ; 1299 ; 1300 LOCAL ; 1301 SIZE : WORD, ! Length returned by $FAO ; 1302 TEMP1_DESC : BLOCK [8, BYTE], ! I/O descriptor ; 1303 TEMP2_DESC : BLOCK [8, BYTE]; ! I/O descriptor ; 1304 ; 1305 ! ; 1306 ! Now do the function dependent processing ; 1307 ! ; 1308 FILE_MODE = .FUNCTION; ; 1309 ! ; 1310 ! Select the correct routine depending on if we are reading or writing. ; 1311 ! ; 1312 ; 1313 SELECTONE .FUNCTION OF ; 1314 SET ; 1315 ; 1316 [FNC_READ] : ; 1317 BEGIN ; 1318 ! ; 1319 ! Now set up the FAB with the information it needs. ; 1320 ! ; P 1321 $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE, ; 1322 NAM = FILE_NAM, DNA = UPLIT (%ASCII'.;0'), DNS = 3); ; 1323 ! ; 1324 ! Now initialize the NAM block ; 1325 ! ; P 1326 $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR, ; 1327 ESS = NAM$C_MAXRSS); ; 1328 ! ; 1329 ! First parse the file specification. ; 1330 ! ; 1331 STATUS = $PARSE (FAB = FILE_FAB); ; 1332 ; 1333 IF NOT .STATUS ; 1334 THEN ; 1335 BEGIN ; 1336 FILE_ERROR (); ; 1337 RETURN KER_RMS32; ; 1338 END; ; 1339 ; 1340 STATUS = $SEARCH (FAB = FILE_FAB); ; 1341 ; 1342 IF NOT .STATUS ; 1343 THEN ; 1344 BEGIN ; 1345 FILE_ERROR (); ; 1346 RETURN KER_RMS32; ; 1347 END; ; 1348 ; 1349 ! ; 1350 ! We now have an expanded file specification that we can use to process ; 1351 ! the file. ; 1352 ! ; 1353 ; 1354 IF .FILE_TYPE NEQ FILE_BLK ; 1355 THEN ; 1356 BEGIN ; P 1357 $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, ; 1358 NAM = FILE_NAM, XAB = FILE_XABFHC); ; 1359 END ; 1360 ELSE ; 1361 BEGIN ; P 1362 $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, ; 1363 NAM = FILE_NAM, XAB = FILE_XABFHC); ; 1364 END; ; 1365 ; 1366 $XABFHC_INIT (XAB = FILE_XABFHC); ; 1367 STATUS = $OPEN (FAB = FILE_FAB); ; 1368 ; 1369 IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) ; 1370 THEN ; 1371 BEGIN ; 1372 FILE_ERROR (); ; 1373 RETURN KER_RMS32; ; 1374 END; ; 1375 ; 1376 ! ; 1377 ! Now allocate a buffer for the records ; 1378 ! ; 1379 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]) ; 1380 ; ; 1381 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1382 ! ; 1383 ! Initialize the RAB for the $CONNECT RMS call ; 1384 ! ; P 1385 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, ; 1386 UBF = .REC_ADDRESS, USZ = .REC_SIZE); ; 1387 STATUS = $CONNECT (RAB = FILE_RAB); ; 1388 ; 1389 IF NOT .STATUS ; 1390 THEN ; 1391 BEGIN ; 1392 FILE_ERROR (); ; 1393 RETURN KER_RMS32; ; 1394 END; ; 1395 ; 1396 FILE_REC_COUNT = -1; ; 1397 END; ! End of [FNC_READ] ; 1398 ; 1399 [FNC_WRITE] : ; 1400 BEGIN ; 1401 ; 1402 SELECTONE .FILE_TYPE OF ; 1403 SET ; 1404 ; 1405 [FILE_ASC] : ; 1406 BEGIN ; P 1407 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1408 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1409 ORG = SEQ, RFM = VAR, RAT = CR); ; 1410 END; ; 1411 ; 1412 [FILE_BIN] : ; 1413 BEGIN ; P 1414 $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, ; P 1415 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ; 1416 ORG = SEQ, RFM = VAR); ; 1417 END; ; 1418 ; 1419 [FILE_BLK] : ; 1420 BEGIN ; P 1421 $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME, ; 1422 FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM); ; 1423 END; ; 1424 TES; ; 1425 ; P 1426 $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR, ; 1427 RSS = NAM$C_MAXRSS); ; 1428 ! ; 1429 ! Now allocate a buffer for the records ; 1430 ! ; 1431 REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE MAX_REC_LENGTH); ; 1432 STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ; 1433 ! ; 1434 ! Now create the file ; 1435 ! ; 1436 STATUS = $CREATE (FAB = FILE_FAB); ; 1437 ; 1438 IF NOT .STATUS ; 1439 THEN ; 1440 BEGIN ; 1441 FILE_ERROR (); ; 1442 RETURN KER_RMS32; ; 1443 END; ; 1444 ; P 1445 $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ; 1446 ROP = ); ; 1447 STATUS = $CONNECT (RAB = FILE_RAB); ; 1448 ; 1449 IF NOT .STATUS ; 1450 THEN ; 1451 BEGIN ; 1452 FILE_ERROR (); ; 1453 RETURN KER_RMS32; ; 1454 END; ; 1455 ; 1456 FILE_REC_COUNT = 0; ; 1457 FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ; 1458 END; ; 1459 ; 1460 [OTHERWISE] : ; 1461 RETURN KER_INTERNALERR; ; 1462 TES; ; 1463 ; 1464 ! ; 1465 ! Initialize the output descriptors. ; 1466 ! ; 1467 TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1468 TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1469 TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME]; ; 1470 TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME]; ; 1471 TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1472 TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1473 TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE]; ; 1474 TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE]; ; 1475 FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME; ; 1476 CH$FILL (CHR_NUL, MAX_FILE_NAME, CH$PTR(FILE_NAME)); ; 1477 STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC); ; 1478 ; 1479 IF NOT .STATUS ; 1480 THEN ; 1481 BEGIN ; 1482 LIB$SIGNAL (.STATUS); ; 1483 RETURN .STATUS; ; 1484 END; ; 1485 ; 1486 FILE_SIZE = .SIZE; ; 1487 RETURN KER_NORMAL; ; 1488 END; ! End of FILE_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAA: .ASCII \.;0\<0> ; ; P.AAC: .ASCII \!AS!AS\<0><0> ; ; P.AAB: .LONG 17694726 ; ; .ADDRESS P.AAC ; ; U.34= U.9 U.35= U.10 U.36= U.9 U.37= U.9 U.38= U.12 U.39= U.11 U.40= U.9 U.41= U.9 U.42= U.9 U.43= U.10 U.44= U.11 .EXTRN SYS$PARSE, SYS$SEARCH, SYS$CREATE, SYS$FAO .PSECT $CODE$,NOWRT,2 .ENTRY FILE_OPEN, ^M ; ; MOVAB W^FILE_NAME, R11 ;FILE_NAME, R11 ; MOVAB G^SYS$CONNECT, R10 ;SYS$CONNECT, R10 ; MOVAB G^LIB$GET_VM, R9 ;LIB$GET_VM, R9 ; MOVAB W^FILE_TYPE, R8 ;FILE_TYPE, R8 ; MOVAB W^U.8, R7 ;U.8, R7 ; SUBL2 #20, SP ;#20, SP ; MOVL 4(AP), R0 ;FUNCTION, R0 ; 1308 MOVL R0, 292(R7) ;R0, FILE_MODE ; BEQL 1$ ;1$ ; 1313 BRW 9$ ;9$ ; 1$: MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1322 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #16777216, 8(R7) ;#16777216, $RMS_PTR+4 ; MOVB #2, 26(R7) ;#2, $RMS_PTR+22 ; MOVB #2, 35(R7) ;#2, $RMS_PTR+31 ; MOVAB 84(R7), 44(R7) ;FILE_NAM, $RMS_PTR+40 ; MOVAB (R11), 48(R7) ;FILE_NAME, $RMS_PTR+44 ; MOVAB W^P.AAA, 52(R7) ;P.AAA, $RMS_PTR+48 ; MOVB W^FILE_SIZE, 56(R7) ;FILE_SIZE, $RMS_PTR+52 ; MOVB #3, 57(R7) ;#3, $RMS_PTR+53 ; MOVC5 #0, (SP), #0, #96, 84(R7) ;#0, (SP), #0, #96, $RMS_PTR ; 1327 MOVW #24578, 84(R7) ;#24578, $RMS_PTR ; MNEGB #4, 86(R7) ;#4, $RMS_PTR+2 ; MOVAB 564(R7), 88(R7) ;RES_STR, $RMS_PTR+4 ; MNEGB #4, 94(R7) ;#4, $RMS_PTR+10 ; MOVAB 312(R7), 96(R7) ;EXP_STR, $RMS_PTR+12 ; PUSHAB 4(R7) ;FILE_FAB ; 1331 CALLS #1, G^SYS$PARSE ;#1, SYS$PARSE ; MOVL R0, (R7) ;R0, STATUS ; BLBC (R7), 2$ ;STATUS, 2$ ; 1333 PUSHAB 4(R7) ;FILE_FAB ; 1340 CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH ; MOVL R0, (R7) ;R0, STATUS ; 2$: BLBC (R7), 5$ ;STATUS, 5$ ; 1342 CMPL (R8), #3 ;FILE_TYPE, #3 ; 1354 BEQL 3$ ;3$ ; MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1358 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #16777216, 8(R7) ;#16777216, $RMS_PTR+4 ; MOVB #2, 26(R7) ;#2, $RMS_PTR+22 ; BRB 4$ ;4$ ; 3$: MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1363 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #16777216, 8(R7) ;#16777216, $RMS_PTR+4 ; MOVB #34, 26(R7) ;#34, $RMS_PTR+22 ; 4$: MOVB #4, 35(R7) ;#4, $RMS_PTR+31 ; MOVAB 248(R7), 40(R7) ;FILE_XABFHC, $RMS_PTR+36 ; MOVAB 84(R7), 44(R7) ;FILE_NAM, $RMS_PTR+40 ; 1358 MOVC5 #0, (SP), #0, #44, 248(R7) ;#0, (SP), #0, #44, $RMS_PTR ; 1366 MOVW #11293, 248(R7) ;#11293, $RMS_PTR ; PUSHAB 4(R7) ;FILE_FAB ; 1367 CALLS #1, G^SYS$OPEN ;#1, SYS$OPEN ; MOVL R0, (R7) ;R0, STATUS ; CMPL (R7), #65537 ;STATUS, #65537 ; 1369 BEQL 6$ ;6$ ; CMPL (R7), #98353 ;STATUS, #98353 ; BEQL 6$ ;6$ ; 5$: BRW 17$ ;17$ ; 6$: CMPL (R8), #3 ;FILE_TYPE, #3 ; 1379 BNEQ 7$ ;7$ ; MOVZWL #512, R0 ;#512, R0 ; BRB 8$ ;8$ ; 7$: MOVZWL 258(R7), R0 ;FILE_XABFHC+10, R0 ; 8$: MOVL R0, 304(R7) ;R0, REC_SIZE ; PUSHAB 308(R7) ;REC_ADDRESS ; 1381 PUSHAB 304(R7) ;REC_SIZE ; CALLS #2, (R9) ;#2, LIB$GET_VM ; MOVL R0, (R7) ;R0, STATUS ; MOVC5 #0, (SP), #0, #68, 180(R7) ;#0, (SP), #0, #68, $RMS_PTR ; 1386 MOVW #17409, 180(R7) ;#17409, $RMS_PTR ; MOVL #1048576, 184(R7) ;#1048576, $RMS_PTR+4 ; CLRB 210(R7) ;$RMS_PTR+30 ; MOVW 304(R7), 212(R7) ;REC_SIZE, $RMS_PTR+32 ; MOVL 308(R7), 216(R7) ;REC_ADDRESS, $RMS_PTR+36 ; MOVAB 4(R7), 240(R7) ;FILE_FAB, $RMS_PTR+60 ; PUSHAB 180(R7) ;FILE_RAB ; 1387 CALLS #1, (R10) ;#1, SYS$CONNECT ; MOVL R0, (R7) ;R0, STATUS ; BLBC (R7), 5$ ;STATUS, 5$ ; 1389 MNEGL #1, 300(R7) ;#1, FILE_REC_COUNT ; 1396 BRW 20$ ;20$ ; 1313 9$: CMPL R0, #1 ;R0, #1 ; BEQL 10$ ;10$ ; BRW 19$ ;19$ ; 10$: MOVL (R8), R6 ;FILE_TYPE, R6 ; 1402 CMPL R6, #1 ;R6, #1 ; BNEQ 11$ ;11$ ; MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1409 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #270532674, 8(R7) ;#270532674, $RMS_PTR+4 ; MOVB #1, 26(R7) ;#1, $RMS_PTR+22 ; MOVW #512, 33(R7) ;#512, $RMS_PTR+29 ; BRB 13$ ;13$ ; 11$: CMPL R6, #2 ;R6, #2 ; 1402 BNEQ 12$ ;12$ ; MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1416 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #270532674, 8(R7) ;#270532674, $RMS_PTR+4 ; MOVB #1, 26(R7) ;#1, $RMS_PTR+22 ; CLRB 33(R7) ;$RMS_PTR+29 ; BRB 13$ ;13$ ; 12$: CMPL R6, #3 ;R6, #3 ; 1402 BNEQ 14$ ;14$ ; MOVC5 #0, (SP), #0, #80, 4(R7) ;#0, (SP), #0, #80, $RMS_PTR ; 1422 MOVW #20483, 4(R7) ;#20483, $RMS_PTR ; MOVL #270532674, 8(R7) ;#270532674, $RMS_PTR+4 ; MOVB #33, 26(R7) ;#33, $RMS_PTR+22 ; 13$: MOVB #2, 35(R7) ;#2, $RMS_PTR+31 ; MOVAB 84(R7), 44(R7) ;FILE_NAM, $RMS_PTR+40 ; MOVAB (R11), 48(R7) ;FILE_NAME, $RMS_PTR+44 ; MOVB W^FILE_SIZE, 56(R7) ;FILE_SIZE, $RMS_PTR+52 ; 14$: MOVC5 #0, (SP), #0, #96, 84(R7) ;#0, (SP), #0, #96, $RMS_PTR ; 1427 MOVW #24578, 84(R7) ;#24578, $RMS_PTR ; MNEGB #4, 86(R7) ;#4, $RMS_PTR+2 ; MOVAB 564(R7), 88(R7) ;RES_STR, $RMS_PTR+4 ; MNEGB #4, 94(R7) ;#4, $RMS_PTR+10 ; MOVAB 312(R7), 96(R7) ;EXP_STR, $RMS_PTR+12 ; CMPL R6, #3 ;R6, #3 ; 1431 BNEQ 15$ ;15$ ; MOVZWL #512, R0 ;#512, R0 ; BRB 16$ ;16$ ; 15$: MOVZWL #4096, R0 ;#4096, R0 ; 16$: MOVL R0, 304(R7) ;R0, REC_SIZE ; PUSHAB 308(R7) ;REC_ADDRESS ; 1432 PUSHAB 304(R7) ;REC_SIZE ; CALLS #2, (R9) ;#2, LIB$GET_VM ; MOVL R0, (R7) ;R0, STATUS ; PUSHAB 4(R7) ;FILE_FAB ; 1436 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE ; MOVL R0, (R7) ;R0, STATUS ; BLBC (R7), 17$ ;STATUS, 17$ ; 1438 MOVC5 #0, (SP), #0, #68, 180(R7) ;#0, (SP), #0, #68, $RMS_PTR ; 1446 MOVW #17409, 180(R7) ;#17409, $RMS_PTR ; MOVL #1179648, 184(R7) ;#1179648, $RMS_PTR+4 ; CLRB 210(R7) ;$RMS_PTR+30 ; MOVL 308(R7), 220(R7) ;REC_ADDRESS, $RMS_PTR+40 ; MOVAB 4(R7), 240(R7) ;FILE_FAB, $RMS_PTR+60 ; PUSHAB 180(R7) ;FILE_RAB ; 1447 CALLS #1, (R10) ;#1, SYS$CONNECT ; MOVL R0, (R7) ;R0, STATUS ; BLBS (R7), 18$ ;STATUS, 18$ ; 1449 17$: CALLS #0, W^U.6 ;#0, U.6 ; 1452 MOVL #134316122, R0 ;#134316122, R0 ; 1451 RET ; ; 18$: CLRL 300(R7) ;FILE_REC_COUNT ; 1456 MOVL 308(R7), 296(R7) ;REC_ADDRESS, FILE_REC_POINTER ; 1457 BRB 20$ ;20$ ; 1313 19$: MOVL #134316050, R0 ;#134316050, R0 ; 1461 RET ; ; 20$: MOVW #270, 14(SP) ;#270, TEMP1_DESC+2 ; 1468 MOVL 160(R7), 16(SP) ;FILE_NAM+76, TEMP1_DESC+4 ; 1469 MOVZBW 143(R7), 12(SP) ;FILE_NAM+59, TEMP1_DESC ; 1470 MOVW #270, 6(SP) ;#270, TEMP2_DESC+2 ; 1472 MOVL 164(R7), 8(SP) ;FILE_NAM+80, TEMP2_DESC+4 ; 1473 MOVZBW 144(R7), 4(SP) ;FILE_NAM+60, TEMP2_DESC ; 1474 MOVZBW #132, 4(R8) ;#132, FILE_DESC ; 1475 MOVC5 #0, (SP), #0, #132, (R11) ;#0, (SP), #0, #132, FILE_NAME ; 1476 PUSHAB 4(SP) ;TEMP2_DESC ; 1477 PUSHAB 16(SP) ;TEMP1_DESC ; PUSHAB 4(R8) ;FILE_DESC ; PUSHAB 12(SP) ;SIZE ; PUSHAB W^P.AAB ;P.AAB ; CALLS #5, G^SYS$FAO ;#5, SYS$FAO ; MOVL R0, (R7) ;R0, STATUS ; BLBS (R7), 21$ ;STATUS, 21$ ; 1479 PUSHL (R7) ;STATUS ; 1482 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL (R7), R0 ;STATUS, R0 ; 1481 RET ; ; 21$: MOVZWL (SP), W^FILE_SIZE ;SIZE, FILE_SIZE ; 1486 MOVL #134316043, R0 ;#134316043, R0 ; 1298 RET ; ; 1256 ; Routine Size: 823 bytes, Routine Base: $CODE$ + 04DD ; 1489 ; 1490 %SBTTL 'FILE_CLOSE' ; 1491 ; 1492 GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) = ; 1493 ; 1494 !++ ; 1495 ! FUNCTIONAL DESCRIPTION: ; 1496 ! ; 1497 ! This routine will close a file that was opened by FILE_OPEN. ; 1498 ! It assumes any data associated with the file is stored in this ; 1499 ! module, since this routine is called by KERMSG. ; 1500 ! ; 1501 ! CALLING SEQUENCE: ; 1502 ! ; 1503 ! FILE_CLOSE(); ; 1504 ! ; 1505 ! INPUT PARAMETERS: ; 1506 ! ; 1507 ! ABORT_FLAG - True if file should not be saved. ; 1508 ! ; 1509 ! IMPLICIT INPUTS: ; 1510 ! ; 1511 ! None. ; 1512 ! ; 1513 ! OUTPUT PARAMETERS: ; 1514 ! ; 1515 ! None. ; 1516 ! ; 1517 ! IMPLICIT OUTPUTS: ; 1518 ! ; 1519 ! None. ; 1520 ! ; 1521 ! COMPLETION CODES: ; 1522 ! ; 1523 ! None. ; 1524 ! ; 1525 ! SIDE EFFECTS: ; 1526 ! ; 1527 ! None. ; 1528 ! ; 1529 !-- ; 1530 ; 1531 BEGIN ; 1532 ; 1533 IF .FILE_MODE EQL FNC_WRITE AND .FILE_REC_COUNT NEQ 0 ; 1534 THEN ; 1535 BEGIN ; 1536 SELECTONE .FILE_TYPE OF ; 1537 SET ; 1538 [FILE_ASC,FILE_BIN]: ; 1539 STATUS = DUMP_BUFFER (); ; 1540 [FILE_BLK] : ; 1541 BEGIN ; 1542 FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ; 1543 STATUS = $WRITE (RAB = FILE_RAB); ; 1544 IF NOT .STATUS ; 1545 THEN ; 1546 BEGIN ; 1547 FILE_ERROR (); ; 1548 STATUS = KER_RMS32; ; 1549 END ; 1550 ELSE ; 1551 STATUS = KER_NORMAL; ; 1552 END; ; 1553 TES; ; 1554 IF NOT .STATUS THEN RETURN .STATUS; ; 1555 ; 1556 END; ; 1557 ; 1558 STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS); ; 1559 IF .ABORT_FLAG THEN FILE_FAB [FAB$V_DLT] = TRUE; ; 1560 STATUS = $CLOSE (FAB = FILE_FAB); ; 1561 EOF_FLAG = FALSE; ; 1562 ; 1563 IF NOT .STATUS ; 1564 THEN ; 1565 BEGIN ; 1566 FILE_ERROR (); ; 1567 RETURN KER_RMS32; ; 1568 END ; 1569 ELSE ; 1570 RETURN KER_NORMAL; ; 1571 ; 1572 END; ! End of FILE_CLOSE .EXTRN SYS$CLOSE .ENTRY FILE_CLOSE, ^M ;FILE_CLOSE, Save R2 ; 1492 MOVAB W^U.8, R2 ;U.8, R2 ; CMPL 292(R2), #1 ;FILE_MODE, #1 ; 1533 BNEQ 4$ ;4$ ; TSTL 300(R2) ;FILE_REC_COUNT ; BEQL 4$ ;4$ ; MOVL W^FILE_TYPE, R0 ;FILE_TYPE, R0 ; 1536 BLEQ 1$ ;1$ ; CMPL R0, #2 ;R0, #2 ; BGTR 1$ ;1$ ; CALLS #0, W^U.2 ;#0, U.2 ; 1539 MOVL R0, (R2) ;R0, STATUS ; BRB 3$ ;3$ ; 1536 1$: CMPL R0, #3 ;R0, #3 ; BNEQ 3$ ;3$ ; MOVW 300(R2), 214(R2) ;FILE_REC_COUNT, FILE_RAB+34 ; 1542 PUSHAB 180(R2) ;FILE_RAB ; 1543 CALLS #1, G^SYS$WRITE ;#1, SYS$WRITE ; MOVL R0, (R2) ;R0, STATUS ; BLBS (R2), 2$ ;STATUS, 2$ ; 1544 CALLS #0, W^U.6 ;#0, U.6 ; 1547 MOVL #134316122, (R2) ;#134316122, STATUS ; 1548 BRB 3$ ;3$ ; 1544 2$: MOVL #134316043, (R2) ;#134316043, STATUS ; 1551 3$: BLBS (R2), 4$ ;STATUS, 4$ ; 1554 MOVL (R2), R0 ;STATUS, R0 ; RET ; ; 4$: PUSHAB 308(R2) ;REC_ADDRESS ; 1558 PUSHAB 304(R2) ;REC_SIZE ; CALLS #2, G^LIB$FREE_VM ;#2, LIB$FREE_VM ; MOVL R0, (R2) ;R0, STATUS ; BLBC 4(AP), 5$ ;ABORT_FLAG, 5$ ; 1559 BISB2 #128, 9(R2) ;#128, FILE_FAB+5 ; 5$: PUSHAB 4(R2) ;FILE_FAB ; 1560 CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE ; MOVL R0, (R2) ;R0, STATUS ; CLRL -4(R2) ;EOF_FLAG ; 1561 BLBS (R2), 6$ ;STATUS, 6$ ; 1563 CALLS #0, W^U.6 ;#0, U.6 ; 1566 MOVL #134316122, R0 ;#134316122, R0 ; 1531 RET ; ; 6$: MOVL #134316043, R0 ;#134316043, R0 ; RET ; ; 1492 ; Routine Size: 166 bytes, Routine Base: $CODE$ + 0814 ; 1573 ; 1574 %SBTTL 'NEXT_FILE' ; 1575 ; 1576 GLOBAL ROUTINE NEXT_FILE = ; 1577 ; 1578 !++ ; 1579 ! FUNCTIONAL DESCRIPTION: ; 1580 ! ; 1581 ! This routine will cause the next file to be opened. It will ; 1582 ! call the RMS-32 routine $SEARCH and $OPEN for the file. ; 1583 ! ; 1584 ! CALLING SEQUENCE: ; 1585 ! ; 1586 ! STATUS = NEXT_FILE; ; 1587 ! ; 1588 ! INPUT PARAMETERS: ; 1589 ! ; 1590 ! None. ; 1591 ! ; 1592 ! IMPLICIT INPUTS: ; 1593 ! ; 1594 ! FAB/NAM blocks set up from previous processing. ; 1595 ! ; 1596 ! OUTPUT PARAMETERS: ; 1597 ! ; 1598 ! None. ; 1599 ! ; 1600 ! IMPLICIT OUTPUTS: ; 1601 ! ; 1602 ! FAB/NAM blocks set up for the next file. ; 1603 ! ; 1604 ! COMPLETION CODES: ; 1605 ! ; 1606 ! TRUE - There is a next file. ; 1607 ! KER_RMS32 - No next file. ; 1608 ! ; 1609 ! SIDE EFFECTS: ; 1610 ! ; 1611 ! None. ; 1612 ! ; 1613 !-- ; 1614 ; 1615 BEGIN ; 1616 ; 1617 LOCAL ; 1618 TEMP1_DESC : BLOCK [8, BYTE], ! I/O descriptor ; 1619 TEMP2_DESC : BLOCK [8, BYTE], ! I/O descriptor ; 1620 SIZE : WORD; ! Size of the $FAO string ; 1621 ; 1622 ! ; 1623 ! Now search for the next file that we want to process. ; 1624 ! ; 1625 STATUS = $SEARCH (FAB = FILE_FAB); ; 1626 ; 1627 IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES; ; 1628 ; 1629 IF NOT .STATUS ; 1630 THEN ; 1631 BEGIN ; 1632 FILE_ERROR (); ; 1633 RETURN KER_RMS32; ; 1634 END; ; 1635 ; 1636 ! ; 1637 ! Now we have the new file name. All that we have to do is open the file ; 1638 ! for reading now. ; 1639 ! ; 1640 STATUS = OPEN_READING (); ; 1641 ; 1642 IF NOT .STATUS THEN RETURN .STATUS; ; 1643 ; 1644 ! ; 1645 ! Initialize the output descriptors. ; 1646 ! ; 1647 TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1648 TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1649 TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME]; ; 1650 TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME]; ; 1651 TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1652 TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1653 TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE]; ; 1654 TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE]; ; 1655 FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME; ; 1656 CH$FILL(CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); ; 1657 STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC); ; 1658 ; 1659 IF NOT .STATUS ; 1660 THEN ; 1661 BEGIN ; 1662 LIB$SIGNAL (.STATUS); ; 1663 RETURN .STATUS; ; 1664 END; ; 1665 ; 1666 FILE_SIZE = .SIZE; ; 1667 RETURN KER_NORMAL; ; 1668 END; ! End of NEXT_FILE .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAE: .ASCII \!AS!AS\<0><0> ; ; P.AAD: .LONG 17694726 ; ; .ADDRESS P.AAE ; ; .PSECT $CODE$,NOWRT,2 .ENTRY NEXT_FILE, ^M ;NEXT_FILE, Save R2,R3,R4,R5,R6 ; 1576 MOVAB W^U.8, R6 ;U.8, R6 ; SUBL2 #20, SP ;#20, SP ; PUSHAB 4(R6) ;FILE_FAB ; 1625 CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH ; MOVL R0, (R6) ;R0, STATUS ; CMPL (R6), #99018 ;STATUS, #99018 ; 1627 BNEQ 1$ ;1$ ; MOVL #134316131, R0 ;#134316131, R0 ; RET ; ; 1$: BLBS (R6), 2$ ;STATUS, 2$ ; 1629 CALLS #0, W^U.6 ;#0, U.6 ; 1632 MOVL #134316122, R0 ;#134316122, R0 ; 1631 RET ; ; 2$: CALLS #0, W^U.28 ;#0, U.28 ; 1640 MOVL R0, (R6) ;R0, STATUS ; BLBC (R6), 3$ ;STATUS, 3$ ; 1642 MOVW #270, 14(SP) ;#270, TEMP1_DESC+2 ; 1648 MOVL 160(R6), 16(SP) ;FILE_NAM+76, TEMP1_DESC+4 ; 1649 MOVZBW 143(R6), 12(SP) ;FILE_NAM+59, TEMP1_DESC ; 1650 MOVW #270, 6(SP) ;#270, TEMP2_DESC+2 ; 1652 MOVL 164(R6), 8(SP) ;FILE_NAM+80, TEMP2_DESC+4 ; 1653 MOVZBW 144(R6), 4(SP) ;FILE_NAM+60, TEMP2_DESC ; 1654 MOVZBW #132, W^FILE_DESC ;#132, FILE_DESC ; 1655 MOVC5 #0, (SP), #0, #132, W^FILE_NAME ;#0, (SP), #0, #132, FILE_NAME ; 1656 PUSHAB 4(SP) ;TEMP2_DESC ; 1657 PUSHAB 16(SP) ;TEMP1_DESC ; PUSHAB W^FILE_DESC ;FILE_DESC ; PUSHAB 12(SP) ;SIZE ; PUSHAB W^P.AAD ;P.AAD ; CALLS #5, G^SYS$FAO ;#5, SYS$FAO ; MOVL R0, (R6) ;R0, STATUS ; BLBS (R6), 4$ ;STATUS, 4$ ; 1659 PUSHL (R6) ;STATUS ; 1662 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; 3$: MOVL (R6), R0 ;STATUS, R0 ; 1661 RET ; ; 4$: MOVZWL (SP), W^FILE_SIZE ;SIZE, FILE_SIZE ; 1666 MOVL #134316043, R0 ;#134316043, R0 ; 1615 RET ; ; 1576 ; Routine Size: 175 bytes, Routine Base: $CODE$ + 08BA ; 1669 ; 1670 %SBTTL 'FILE_ERROR - Error processing for all RMS errors' ; 1671 ROUTINE FILE_ERROR : NOVALUE = ; 1672 ; 1673 !++ ; 1674 ! FUNCTIONAL DESCRIPTION: ; 1675 ! ; 1676 ! This routine will process all of the RMS-32 error returns. It will ; 1677 ! get the text for the error and then it will issue a KER_ERROR for ; 1678 ! the RMS failure. ; 1679 ! ; 1680 ! CALLING SEQUENCE: ; 1681 ! ; 1682 ! FILE_ERROR(); ; 1683 ! ; 1684 ! INPUT PARAMETERS: ; 1685 ! ; 1686 ! None. ; 1687 ! ; 1688 ! IMPLICIT INPUTS: ; 1689 ! ; 1690 ! STATUS - RMS error status. ; 1691 ! FILE_NAME - File name and extension. ; 1692 ! FILE_SIZE - Size of the thing in FILE_NAME. ; 1693 ! ; 1694 ! OUTPUT PARAMETERS: ; 1695 ! ; 1696 ! None. ; 1697 ! ; 1698 ! IMPLICIT OUTPUTS: ; 1699 ! ; 1700 ! None. ; 1701 ! ; 1702 ! COMPLETION CODES: ; 1703 ! ; 1704 ! None. ; 1705 ! ; 1706 ! SIDE EFFECTS: ; 1707 ! ; 1708 ! None. ; 1709 ! ; 1710 !-- ; 1711 ; 1712 BEGIN ; 1713 ; 1714 LOCAL ; 1715 ERR_LENGTH : WORD, ! Length of the text ; 1716 ERR_DESC : BLOCK [8, BYTE], ; 1717 ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)]; ; 1718 ; 1719 ERR_DESC [DSC$A_POINTER] = ERR_BUFFER; ; 1720 ERR_DESC [DSC$W_LENGTH] = MAX_MSG; ; 1721 ERR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1722 ERR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1723 $GETMSG (MSGID = .STATUS, MSGLEN = ERR_LENGTH, BUFADR = ERR_DESC, FLAGS = 0); ; 1724 ERR_DESC [DSC$W_LENGTH] = .ERR_LENGTH; ; 1725 LIB$SIGNAL (KER_RMS32, ERR_DESC, FILE_DESC); ; 1726 END; ! End of FILE_ERROR .EXTRN SYS$GETMSG ;FILE_ERROR U.6: .WORD ^M<> ;Save nothing ; 1671 MOVAB -108(SP), SP ;-108(SP), SP ; MOVAB 4(SP), 104(SP) ;ERR_BUFFER, ERR_DESC+4 ; 1719 MOVL #17694816, 100(SP) ;#17694816, ERR_DESC ; 1720 CLRQ -(SP) ;-(SP) ; 1723 PUSHAB 108(SP) ;ERR_DESC ; PUSHAB 12(SP) ;ERR_LENGTH ; PUSHL W^U.8 ;U.8 ; CALLS #5, G^SYS$GETMSG ;#5, SYS$GETMSG ; MOVW (SP), 100(SP) ;ERR_LENGTH, ERR_DESC ; 1724 PUSHAB W^FILE_DESC ;FILE_DESC ; 1725 PUSHAB 104(SP) ;ERR_DESC ; PUSHL #134316122 ;#134316122 ; CALLS #3, G^LIB$SIGNAL ;#3, LIB$SIGNAL ; RET ; ; 1671 ; Routine Size: 63 bytes, Routine Base: $CODE$ + 0969 ; 1727 %SBTTL 'End of KERFIL' ; 1728 END ! End of module ; 1729 ; 1730 ELUDOM ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 836 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$ 2472 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$ 36 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; LIBRARY STATISTICS ; ; -------- Symbols -------- Blocks ; File Total Loaded Percent Read ; ; SYS$SYSROOT:[SYSLIB]STARLET.L32;1 5809 124 2 290 ; COMMAND QUALIFIERS ; BLISS KERFIL/LIST=KERFIL.MAR/MACHINE_CODE=(ASSEM,NOBINARY,UNIQUE)/NOOBJECT/SOURCE=NOHEADER ; Compilation Complete .END