

; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 1

; Digital Equipment Corporation

;

;	0001	MODULE FRMOD1 (

;	0002			LANGUAGE (BLISS32),

;	0003			IDENT = 'A0003'

;	0004			) =

;	0005	BEGIN

;	0006	

;	0007	!

;	0008	! COPYRIGHT (C) 1977

;	0009	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754

;	0010	!

;	0011	! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE

;	0012	! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY WITH  THE INCLUSION OF THE

;	0013	! ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPIES THEREOF,

;	0014	! MAY NOT BE PROVIDED OR  OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON

;	0015	! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE

;	0016	! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES

;	0017	! REMAIN IN DEC.

;	0018	!

;	0019	! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE

;	0020	! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT

;	0021	! CORPORATION.

;	0022	!

;	0023	! DEC ASSUMES  NO  RESPONSIBILITY  FOR  THE USE OR  RELIABILITY OF ITS

;	0024	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

;	0025	

;	0026	!++

;	0027	!

;	0028	! FACILITY:  MTAACP

;	0029	!

;	0030	! ABSTRACT:

;	0031	!

;	0032	!	THIS MODULE FORMATS A FILES-11 STRUCTURE LEVEL 1

;	0033	!	FILE HEADER

;	0034	!

;	0035	! ENVIRONMENT:

;	0036	!

;	0037	!	STARLET OPERATING SYSTEM, INCLUDING PRIVILEGED SYSTEM SERVICES

;	0038	!	AND INTERNAL EXEC ROUTINES.

;	0039	!

;	0040	!--

;	0041	!

;	0042	!

;	0043	! AUTHOR:  D. H. GILLESPIE,	 CREATION DATE:  19-MAY-1977  17:06

;	0044	!

;	0045	! REVISION HISTORY:

;	0046	!

;	0047	!

;	0048	!   D. H. Gillespie, 2-Mar-1978  12:30

;	0049	!   X0002 - CORRECT BUG WHICH DROPPED FORMS CONTROL INFORMATION FROM NON-VAX TAPES

;	0050	!

;	0051	!   D. H. Gillespie, 12-May-78  13:34

;	0052	!   A0001 - change CURRENT_VCB in a register

;	0053	!

;	0054	!   D. H. Gillespie, 18-May-78  13:18

;	0055	!   A0002A - remove subroutine calls



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 1-1

; Digital Equipment Corporation

;

;	0056	

;	0057	!   D. H. Gillespie, 11-Aug-1978  12:30

;	0058	!	X0003 - Add facility to return original attributes of file(NOSPAN)

;	0059	!

;	0060	!**

;	0061	LIBRARY 'SYS$LIBRARY:LIB.L32';

;	0062	REQUIRE 'SRC$:MTADEF.B32';

;	0358	

;	0359	LINKAGE

;	0360		JSB_CHAR	= JSB() : GLOBAL(COUNT = 2, STRINGP = 3);

;	0361	

;	0362	! ROUTINES IN THIS MODULE

;	0363	!

;	0364	

;	0365	FORWARD ROUTINE

;	0366		FORMAT_F11HOD1	: COMMON_CALL NOVALUE,	!FORMAT FILES-11 ODS1 FILE HEADER

;	0367		FORMAT_DATEOD1	: COMMON_CALL NOVALUE,	!FORMATES DATE FOR STRUCTURE LEVEL 1

;	0368		FORMAT_FID	: COMMON_CALL NOVALUE,	!FORMAT FID

;	0369	

;	0370	! SUBROUTINES FOR NMB

;	0371		GETCHAR		:JSB_CHAR,		!GET CHAR FROM INPUT STRING

;	0372		TYPE		:JSB_CHAR;		!DETERMINES CLASS OF CHAR



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2

; Digital Equipment Corporation

;

;	0373	GLOBAL ROUTINE FORMAT_F11HOD1(HEADER) : COMMON_CALL NOVALUE  =

;	0374	

;	0375	!++

;	0376	!

;	0377	! FUNCTIONAL DESCRIPTION:

;	0378	!	THIS ROUTINE FORMATS A FILE HEADER FOR FILES-11 ON-DISK STRUCTURE 1

;	0379	!

;	0380	! CALLING SEQUENCE:

;	0381	!	FORMAT_F11HOD1(ARG1)

;	0382	!

;	0383	! INPUT PARAMETERS:

;	0384	!	ARG1 - ADDRESS OF BUFFER

;	0385	!

;	0386	! IMPLICIT INPUTS:

;	0387	!	CURRENT_VCB - ADDRESS OF CURRENT VCB

;	0388	!	TAPE HEADER LABELS READ IN OR DEFAULTED

;	0389	!

;	0390	! OUTPUT PARAMETERS:

;	0391	!	ARG1 - ADDRESS OF BUFFER

;	0392	!

;	0393	! IMPLICIT OUTPUTS:

;	0394	!	NONE

;	0395	!

;	0396	! ROUTINE VALUE:

;	0397	!	NONE

;	0398	!

;	0399	! SIDE EFFECTS:

;	0400	!	HEADER RECEIVES 512 CHARACTERS OF FILES-11 ODS-1 FILE HEADER

;	0401	!

;	0402	!--

;	0403	

;	0404	BEGIN

;	0405	

;	0406	EXTERNAL REGISTER

;	0407		COMMON_REG;

;	0408	

;	0409	EXTERNAL ROUTINE

;	0410		LIB$CVT_DTB	: ADDRESSING_MODE(ABSOLUTE),	!CONVERT DECIMAL TO BINARY

;	0411		PARSE_FILE_ID,

;	0412		CALC_VERSION;

;	0413		

;	0414	

;	0415	MAP

;	0416		HEADER:		REF BBLOCK;		!ADDRESS OF OUTPUT BUFFER

;	0417	

;	0418	EXTERNAL

;	0419		LOCAL_FIB	: BBLOCK,

;	0420		CURRENT_UCB	: REF BBLOCK,		!ADDRESS OF CURRENT UNIT CONTROL BLOCK

;	0421		HDR1		: REF BBLOCK,		!ADDRESS OF HDR1(EOF1) LABEL

;	0422		HDR2		: REF BBLOCK;		!ADDRESS OF HDR2(EOF2) LABEL

;	0423	

;	0424	BIND

;	0425		RECTYPE_ANSI	= UPLIT BYTE('UFDVS') : VECTOR[,BYTE],

;	0426		RECTYPE_FILE11	= UPLIT BYTE(0,1,2,3,0) : VECTOR[,BYTE],

;	0427		RECATTR_ASCI	= UPLIT BYTE('MA ') : VECTOR [,BYTE],



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2-1

; Digital Equipment Corporation

;

;	0428		RECATTR_FILE11	= UPLIT BYTE(0,1,2) : VECTOR [,BYTE];

;	0429	

;	0430	LITERAL

;	0431		RECTYPE_LEN 	= 5,

;	0432		RECATTR_LEN	= 3;

;	0433	

;	0434	! FILL IN CONSTANTS

;	0435	CH$FILL(0,512,.HEADER);

;	0436	HEADER[FHD$B_IDOFFSET] = FHD$C_LENGTH / 2;

;	0437	HEADER[FHD$B_MPOFFSET] = (FHD$C_LENGTH + FHI$C_LENGTH + FHI$S_MTHDR1 + FHI$S_MTHDR2) / 2;

;	0438	HEADER[FHD$W_STRUCLEV] = FHD$C_LEVEL1;

;	0439	

;	0440	! FILL IN OTHER KNOWN PARTS FROM HDR1, HDR2 LABELS

;	0441	FORMAT_FID(HEADER[FHD$W_FID_NUM]);		!FID

;	0442	

;	0443	! FORMAT FILEOWNER, FILE PROTECTION AND USER CHARARTERISTICS

;	0444	(HEADER[FHD$W_FILEOWNER])<0,8> = .CURRENT_UCB[UCB$L_OWNUIC];		!OWNER FROM UCB

;	0445	(HEADER[FHD$W_FILEOWNER])<8,8> = .(CURRENT_UCB[UCB$L_OWNUIC] + 2) <0,8>;

;	0446	(HEADER[FHD$W_FILEOWNER])<16,16> = .CURRENT_UCB[UCB$W_VPROT];	!PROTECTION FROM UCB

;	0447	(HEADER[FHD$W_FILEOWNER]+4)<0,8,> = 0;				!USER CHAR DOESN'T APPLY

;	0448	

;	0449	

;	0450	! PICKUP ANSI STANDARD ATTRIUBTES

;	0451	(BIND

;	0452		RECATTR		= HEADER[FHD$W_RECATTR]	: BBLOCK;

;	0453	

;	0454	RECATTR[FAT$B_RTYPE] = 0;

;	0455	

;	0456	DECR I FROM RECTYPE_LEN - 1 TO 0 DO

;	0457	    BEGIN

;	0458	    IF .RECTYPE_ANSI[.I] EQL .HDR2[HD2$B_RECFORMAT] THEN 

;	0459	    RECATTR[FAT$B_RTYPE] = .RECTYPE_FILE11[.I];

;	0460	    END;

;	0461	(LOCAL VALUE;

;	0462	LIB$CVT_DTB(HD2$S_RECLEN,HDR2[HD2$T_RECLEN],VALUE);

;	0463	IF .HDR2[HD2$B_RECFORMAT] EQL 'D' THEN VALUE = .VALUE - 4;	!SUBTRACT COUNT OVERHEAD

;	0464	RECATTR[FAT$W_RSIZE] = .VALUE<0,16>;

;	0465	RECATTR[FAT$W_MAXREC] = .VALUE<0,16>);

;	0466	RECATTR[FAT$B_RATTRIB] = .RECATTR_FILE11[2];

;	0467	

;	0468	DECR I FROM RECATTR_LEN - 1 TO 0 DO

;	0469	    BEGIN

;	0470	    IF .RECATTR_ASCI[.I] EQL .HDR2[HD2$B_FORMCNTRL] THEN

;	0471	    RECATTR[FAT$B_RATTRIB] = .RECATTR_FILE11[.I]

;	0472	    END;

;	0473	

;	0474	IF .CURRENT_VCB[VCB$V_STARFILE]

;	0475	THEN

;	0476	    BEGIN

;	0477	    CH$MOVE(HD2$S_RECATR1,HDR2[HD2$T_RECATR1],RECATTR);

;	0478	    CH$MOVE(HD2$S_RECATR2,HDR2[HD2$T_RECATR2],RECATTR+HD2$S_RECATR1);

;	0479	    END;

;	0480	

;	0481	! RECORDS DO NOT SPAN BLOCK BOUNDAREIS

;	0482	! IF THE USER REQUESTS THE ORIGINAL ATTRIBUTES OF THE FILE, DON'T SET SPAN



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2-2

; Digital Equipment Corporation

;

;	0483	IF NOT .LOCAL_FIB[FIB$V_PRSRV_ATR] 

;	0484	THEN RECATTR[FAT$B_RATTRIB] = .RECATTR[FAT$B_RATTRIB] OR FAT$M_NOSPAN);

;	0485	

;	0486	(GLOBAL REGISTER

;	0487		COUNT		= 2,		!NUMBER OF CHARACTERS REMAINING IN STRING

;	0488		STRINGP 	= 3 : REF VECTOR[,BYTE];	!STRING PTER

;	0489	LOCAL

;	0490		BUFFER: REF VECTOR [,WORD],		!ADDRESS FOR RAD50 NAME

;	0491		DESCFN:	VECTOR [2],			!STRING DESCRIPTOR FOR FILE NAME

;	0492		DESCTY:	VECTOR [2];			!STRING DESCRIPTOR FOR FILE TYPE

;	0493	

;	0494	! PARSE THE FILE IDENTIFICATION FIELD IN HDR1

;	0495	BUFFER = HEADER[FHD$C_LENGTH + FHI$W_FILENAME];

;	0496	PARSE_FILE_ID(DESCFN,DESCTY);

;	0497	

;	0498	! CONVERT FILE NAME TO RAD50

;	0499	COUNT = .DESCFN[0];				!PICKUP LENGTH OF FILE NAME

;	0500	STRINGP = .DESCFN[1];				!PICKUP ADDRESS OF FILE NAME STRING

;	0501	

;	0502	DECRU I FROM 3 TO 1 DO

;	0503	    BEGIN

;	0504	    DECRU J FROM 3 TO 1 DO

;	0505		BUFFER[0] = .BUFFER[0] * 40 + GETCHAR();

;	0506	    BUFFER = .BUFFER + 2;

;	0507	    END;

;	0508	

;	0509	! CONVERT FILE TYPE TO RAD50

;	0510	COUNT = .DESCTY[0];				!PICKUP LENGTH OF FILE TYPE

;	0511	STRINGP = .DESCTY[1];				!PICKUP ADDRESS OF FILE TYPE STRING

;	0512	

;	0513	DECRU J FROM 3 TO 1 DO

;	0514	    BEGIN

;	0515	    BUFFER[0] = .BUFFER[0] * 40 + GETCHAR();

;	0516	    END;

;	0517	

;	0518	! CONVERT GENERATION NUMBER AND GENERATION VERSION NUMBER TO BINARY

;	0519	! FILE VERSION NUMBER

;	0520	CALC_VERSION(.BUFFER+2));

;	0521	

;	0522	FORMAT_DATEOD1(HDR1[HD1$T_CREATEDT],HEADER[FHD$C_LENGTH+FHI$T_CREDATE],1);

;	0523	FORMAT_DATEOD1(HDR1[HD1$T_EXPIREDT],HEADER[FHD$C_LENGTH+FHI$T_EXPDATE],0);

;	0524	CH$MOVE(160,.HDR1,HEADER[FHD$C_LENGTH+FHI$T_MTHDR1]);

;	0525	

;	0526	! NOW CALCULATE CHECKSUM

;	0527	(BIND

;	0528		VHEADER		= HEADER	:	VECTOR[,WORD];

;	0529	DECR I FROM 254 TO 0 DO

;	0530	    HEADER[FHD$W_CHECKSUM] = .HEADER[FHD$W_CHECKSUM] + .VHEADER[.I]);

;	0531	END;				!END OF ROUTINE





							    .TITLE  FRMOD1

							    .IDENT  \A0003\



							    .PSECT  $CODE$,NOWRT,2



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2-3

; Digital Equipment Corporation

;



					      00000 P.AAA:  .ASCII  \UFDVS\						      ;

					      00005	    .BLKB   3

					      00008 P.AAB:  .BYTE   0, 1, 2, 3, 0					      ;

					      0000D	    .BLKB   3

					      00010 P.AAC:  .ASCII  \MA \						      ;

					      00013	    .BLKB   1

					      00014 P.AAD:  .BYTE   0, 1, 2						      ;

					      00017	    .BLKB   1



						    RECTYPE_ANSI=	P.AAA

						    RECTYPE_FILE11=	P.AAB

						    RECATTR_ASCI=	P.AAC

						    RECATTR_FILE11=	P.AAD

							    .GLOBL  LIB$CVT_DTB, PARSE_FILE_ID, CALC_VERSION, LOCAL_FIB

							    .GLOBL  CURRENT_UCB, HDR1, HDR2



					 07FC 00018 	    .ENTRY  FORMAT_F11HOD1, Save R2,R3,R4,R5,R6,R7,R8,R9,R10	      ; 0373

		         59	0000G  CF  9E 0001A 	    MOVAB   HDR2, R9						      ;

		         5A	  DE   AF  9E 0001F 	    MOVAB   RECTYPE_ANSI, R10					      ;

		         5E	       14  C2 00023 	    SUBL2   #20, SP						      ;

		         58	  04   AC  D0 00026 	    MOVL    HEADER, R8						      ; 0435

	   00	         6E	       00  2C 0002A 	    MOVC5   #0, (SP), #0, #512, (R8)				      ;

		         68	0200   8F     0002E									      ;

		         68	7E17   8F  B0 00032 	    MOVW    #32279, (R8)					      ; 0436

		    06   A8	0101   8F  B0 00037 	    MOVW    #257, 6(R8)						      ; 0438

				  02   A8  9F 0003D 	    PUSHAB  2(R8)						      ; 0441

		  0000V  CF	       01  FB 00040 	    CALLS   #1, FORMAT_FID					      ;

		         51	  08   A8  9E 00045 	    MOVAB   8(R8), R1						      ; 0444

		         50	0000G  CF  D0 00049 	    MOVL    CURRENT_UCB, R0					      ;

		         52	  1C   A0  9E 0004E 	    MOVAB   28(R0), R2						      ;

		         61	       62  90 00052 	    MOVB    (R2), (R1)						      ;

		    01   A1	  02   A2  90 00055 	    MOVB    2(R2), 1(R1)					      ; 0445

		    02   A1	  1A   A0  B0 0005A 	    MOVW    26(R0), 2(R1)					      ; 0446

				  04   A1  94 0005F 	    CLRB    4(R1)						      ; 0447

	   56	         58	       0E  C1 00062 	    ADDL3   #14, R8, R6						      ; 0452

				       66  94 00066 	    CLRB    (R6)						      ; 0454

	   51	         69	       04  C1 00068 	    ADDL3   #4, HDR2, R1					      ; 0458

		         50	       04  D0 0006C 	    MOVL    #4, I						      ; 0456

		         61	     6A40  91 0006F 1$:     CMPB    RECTYPE_ANSI[I], (R1)				      ; 0458

				       05  12 00073 	    BNEQ    2$							      ;

		         66	  08 AA40  90 00075 	    MOVB    RECTYPE_FILE11[I], (R6)				      ; 0459

		         F2	       50  F4 0007A 2$:     SOBGEQ  I, 1$						      ; 0456

				       5E  DD 0007D 	    PUSHL   SP							      ; 0462

	   7E	         69	       0A  C1 0007F 	    ADDL3   #10, HDR2, -(SP)					      ;

				       05  DD 00083 	    PUSHL   #5							      ;

	      00000000G  9F	       03  FB 00085 	    CALLS   #3, @#LIB$CVT_DTB					      ;

		         57	       69  D0 0008C 	    MOVL    HDR2, R7						      ; 0463

		    44   8F	  04   A7  91 0008F 	    CMPB    4(R7), #68						      ;

				       03  12 00094 	    BNEQ    3$							      ;

		         6E	       04  C2 00096 	    SUBL2   #4, VALUE						      ;

		    02   A6	       6E  B0 00099 3$:     MOVW    VALUE, 2(R6)					      ; 0464

		    10   A6	       6E  B0 0009D 	    MOVW    VALUE, 16(R6)					      ; 0465

		    01   A6	  16   AA  90 000A1 	    MOVB    RECATTR_FILE11+2, 1(R6)				      ; 0466

		         50	       02  D0 000A6 	    MOVL    #2, I						      ; 0468



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2-4

; Digital Equipment Corporation

;

		    24   A7	  10 AA40  91 000A9 4$:     CMPB    RECATTR_ASCI[I], 36(R7)				      ; 0470

				       06  12 000AF 	    BNEQ    5$							      ;

		    01   A6	  14 AA40  90 000B1 	    MOVB    RECATTR_FILE11[I], 1(R6)				      ; 0471

		         EF	       50  F4 000B7 5$:     SOBGEQ  I, 4$						      ; 0468

		         0B	  2D   AB  E9 000BA 	    BLBC    45(CURRENT_VCB), 6$					      ; 0474

	   66	    0F   A7	       14  28 000BE 	    MOVC3   #20, 15(R7), (R6)					      ; 0477

      14   A6	    25   A7	       0C  28 000C3 	    MOVC3   #12, 37(R7), 20(R6)					      ; 0478

	   04	  0000G  CF	       01  E0 000C9 6$:     BBS     #1, LOCAL_FIB+2, 7$					      ; 0483

		    01   A6	       08  88 000CF 	    BISB2   #8, 1(R6)						      ; 0484

	   54	         58	       2E  C1 000D3 7$:     ADDL3   #46, R8, BUFFER					      ; 0495

				  04   AE  9F 000D7 	    PUSHAB  DESCTY						      ; 0496

				  10   AE  9F 000DA 	    PUSHAB  DESCFN						      ;

		  0000G  CF	       02  FB 000DD 	    CALLS   #2, PARSE_FILE_ID					      ;

		         52	  0C   AE  7D 000E2 	    MOVQ    DESCFN, COUNT					      ; 0499

		         57	       03  D0 000E6 	    MOVL    #3, I						      ; 0502

		         55	       03  D0 000E9 8$:     MOVL    #3, J						      ; 0504

		         56	       64  3C 000EC 9$:     MOVZWL  (BUFFER), R6					      ; 0505

		         56	       28  C4 000EF 	    MULL2   #40, R6						      ;

				     0000  30 000F2 	    BSBW    GETCHAR						      ;

	   64	         56	       50  A1 000F5 	    ADDW3   R0, R6, (BUFFER)					      ;

				       55  D7 000F9 	    DECL    J							      ; 0504

		         01	       55  D1 000FB 	    CMPL    J, #1						      ;

				       EC  1E 000FE 	    BGEQU   9$							      ;

		         54	       02  C0 00100 	    ADDL2   #2, BUFFER						      ; 0506

				       57  D7 00103 	    DECL    I							      ; 0502

		         01	       57  D1 00105 	    CMPL    I, #1						      ;

				       DF  1E 00108 	    BGEQU   8$							      ;

		         52	  04   AE  7D 0010A 	    MOVQ    DESCTY, COUNT					      ; 0510

		         55	       03  D0 0010E 	    MOVL    #3, J						      ; 0513

		         56	       64  3C 00111 10$:    MOVZWL  (BUFFER), R6					      ; 0515

		         56	       28  C4 00114 	    MULL2   #40, R6						      ;

				     0000  30 00117 	    BSBW    GETCHAR						      ;

	   64	         56	       50  A1 0011A 	    ADDW3   R0, R6, (BUFFER)					      ;

				       55  D7 0011E 	    DECL    J							      ; 0513

		         01	       55  D1 00120 	    CMPL    J, #1						      ;

				       EC  1E 00123 	    BGEQU   10$							      ;

				  02   A4  9F 00125 	    PUSHAB  2(BUFFER)						      ; 0520

		  0000G  CF	       01  FB 00128 	    CALLS   #1, CALC_VERSION					      ;

				       01  DD 0012D 	    PUSHL   #1							      ; 0522

				  47   A8  9F 0012F 	    PUSHAB  71(R8)						      ;

	   7E	  0000G  CF	       29  C1 00132 	    ADDL3   #41, HDR1, -(SP)					      ;

		  0000V  CF	       03  FB 00138 	    CALLS   #3, FORMAT_DATEOD1					      ;

				       7E  D4 0013D 	    CLRL    -(SP)						      ; 0523

				  54   A8  9F 0013F 	    PUSHAB  84(R8)						      ;

	   7E	  0000G  CF	       2F  C1 00142 	    ADDL3   #47, HDR1, -(SP)					      ;

		  0000V  CF	       03  FB 00148 	    CALLS   #3, FORMAT_DATEOD1					      ;

      5C   A8	  0000G  DF	00A0   8F  28 0014D 	    MOVC3   #160, @HDR1, 92(R8)					      ; 0524

		         50	  FE   8F  9A 00156 	    MOVZBL  #254, I						      ; 0529

		  01FE   C8	  04 AC40  A0 0015A 11$:    ADDW2   VHEADER[I], 510(R8)					      ; 0530

		         F6	       50  F4 00161 	    SOBGEQ  I, 11$						      ; 0529

					   04 00164 	    RET     							      ; 0373



; Routine Size:  333 bytes







; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 2-5

; Digital Equipment Corporation

;

;	0532	



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 3

; Digital Equipment Corporation

;

;	0533	ROUTINE GETCHAR : JSB_CHAR =

;	0534	

;	0535	!++

;	0536	!

;	0537	! FUNCTIONAL DESCRIPTION:

;	0538	!

;	0539	!	THIS ROUTINE RETURNS THE RAD-50 CODE OF THE NEXT CHARACTER IN THE

;	0540	!	INPUT STRING IF IT IS IN THE RAD-50 SET. IF END OF

;	0541	!	STRING HAS BEEN REACHED, IT RETURNS ZERO.  IF IT IS A NON-RAD50 CHAR, THEN IT IS MAPPED TO Z

;	0542	!

;	0543	! CALLING SEQUENCE:

;	0544	!	GETCHAR ()

;	0545	!

;	0546	! INPUT PARAMETERS:

;	0547	!	NONE

;	0548	!

;	0549	! IMPLICIT INPUTS:

;	0550	!	COUNT: CHARACTERS REMAINING IN STRING

;	0551	!	STRINGP: STRING POINTER

;	0552	!

;	0553	! OUTPUT PARAMETERS:

;	0554	!	NONE

;	0555	!

;	0556	! IMPLICIT OUTPUTS:

;	0557	!	NONE

;	0558	!

;	0559	! ROUTINE VALUE:

;	0560	!	CHARACTER CODE

;	0561	!

;	0562	! SIDE EFFECTS:

;	0563	!	COUNT DECREMENTED AND STRINGP ADVANCED.

;	0564	!

;	0565	!--

;	0566	

;	0567	BEGIN

;	0568	EXTERNAL REGISTER

;	0569		COUNT		= 2,		!NUMBER OF CHARACTERS REMAINING IN STRING

;	0570		STRINGP 	= 3 : REF VECTOR[,BYTE];	!STRING PTER

;	0571	

;	0572	LOCAL

;	0573		CHAR;				! CHARACTER IN PROCESS

;	0574	

;	0575	

;	0576	! GET THE NEXT CHARACTER FROM THE STRING AND DISPATCH IN ITS TYPE.

;	0577	!

;	0578	

;	0579	CHAR = .STRINGP[0];

;	0580	

;	0581	CASE TYPE () FROM 0 TO 4 OF

;	0582	    SET

;	0583	    [0]:	CHAR = 0;

;	0584	    [1]:				! UPPER CASE ALPHA

;	0585		BEGIN

;	0586		CHAR = .CHAR - 'A' + 1;		! CONVERT TO RAD-50 CODE

;	0587		COUNT = .COUNT - 1;		! ADVANCE TO NEXT CHARACTER



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 3-1

; Digital Equipment Corporation

;

;	0588		STRINGP = .STRINGP + 1;

;	0589		END;

;	0590	    [2]:				! LOWER CASE ALPHA

;	0591		BEGIN

;	0592		CHAR = .CHAR - 'a' + 1;		! CONVERT TO RAD-50 CODE

;	0593		COUNT = .COUNT - 1;		! ADVANCE TO NEXT CHARACTER

;	0594		STRINGP = .STRINGP + 1;

;	0595		END;

;	0596	    [3]:				! NUMERIC

;	0597		BEGIN

;	0598		CHAR = .CHAR - '0' + 30;	! CONVERT TO RAD-50 CODE

;	0599		COUNT = .COUNT - 1;		! ADVANCE TO NEXT CHARACTER

;	0600		STRINGP = .STRINGP + 1;

;	0601		END;

;	0602	    [4]:

;	0603		BEGIN

;	0604		CHAR = 'Z' - 'A' + 1;

;	0605		COUNT = .COUNT - 1;

;	0606		STRINGP = .STRINGP + 1;

;	0607		END;

;	0608	    TES;

;	0609	

;	0610	RETURN .CHAR;

;	0611	

;	0612	END;					! END OF ROUTINE GETCHAR











				       10  BB 00165 GETCHAR:PUSHR   #^M<R4>						      ; 0533

		         54	       63  9A 00167 	    MOVZBL  (STRINGP), CHAR					      ; 0579

				     0000  30 0016A 	    BSBW    TYPE						      ; 0581

	   04	         00	       50  CF 0016D 	    CASEL   R0, #0, #4						      ;

	 0014	       000E	     000A     00171 1$:     .WORD   2$-1$,-						      ;

		       001F	     001A     00177		    3$-1$,-						      ;

								    4$-1$,-						      ;

								    5$-1$,-						      ;

								    6$-1$						      ;

				       54  D4 0017B 2$:     CLRL    CHAR						      ; 0583

				       18  11 0017D 	    BRB     8$							      ; 0581

		         54	  C0   A4  9E 0017F 3$:     MOVAB   -64(R4), CHAR					      ; 0586

				       0E  11 00183 	    BRB     7$							      ; 0587

		         54	  A0   A4  9E 00185 4$:     MOVAB   -96(R4), CHAR					      ; 0592

				       08  11 00189 	    BRB     7$							      ; 0593

		         54	       12  C2 0018B 5$:     SUBL2   #18, CHAR						      ; 0598

				       03  11 0018E 	    BRB     7$							      ; 0599

		         54	       1A  D0 00190 6$:     MOVL    #26, CHAR						      ; 0604

				       52  D7 00193 7$:     DECL    COUNT						      ; 0605

				       53  D6 00195 	    INCL    STRINGP						      ; 0606

		         50	       54  D0 00197 8$:     MOVL    CHAR, R0						      ; 0610

				       10  BA 0019A 	    POPR    #^M<R4>						      ; 0533

					   05 0019C 	    RSB     							      ;



; Routine Size:  56 bytes



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 3-2

; Digital Equipment Corporation

;







; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 4

; Digital Equipment Corporation

;

;	0613	ROUTINE TYPE : JSB_CHAR =

;	0614	

;	0615	!++

;	0616	!

;	0617	! FUNCTIONAL DESCRIPTION:

;	0618	!

;	0619	!	THIS ROUTINE DETERMINES THE TYPE CODE OF THE CURRENT CHARACTER

;	0620	!	IN THE STRING.

;	0621	!

;	0622	! CALLING SEQUENCE:

;	0623	!	TYPE ()

;	0624	!

;	0625	! INPUT PARAMETERS:

;	0626	!	NONE

;	0627	!

;	0628	! IMPLICIT INPUTS:

;	0629	!	COUNT: NUMBER OF CHARACTERS LEFT IN STRING

;	0630	!	STRINGP: STRING POINTER

;	0631	!

;	0632	! OUTPUT PARAMETERS:

;	0633	!	NONE

;	0634	!

;	0635	! IMPLICIT OUTPUTS:

;	0636	!	NONE

;	0637	!

;	0638	! ROUTINE VALUE:

;	0639	!	TYPE CODE OF CHARACTER:

;	0640	!	0: END OF STRING

;	0641	!	1: UPPER CASE ALPHA

;	0642	!	2: LOWER CASE ALPHA

;	0643	!	3: NUMERIC

;	0644	!	4: NON-RAD50

;	0645	!

;	0646	! SIDE EFFECTS:

;	0647	!	NONE

;	0648	!

;	0649	!--

;	0650	

;	0651	BEGIN

;	0652	EXTERNAL REGISTER

;	0653		COUNT		= 2,		!NUMBER OF CHARACTERS REMAINING IN STRING

;	0654		STRINGP 	= 3 : REF VECTOR[,BYTE];	!STRING PTER

;	0655	

;	0656	! CHARACTER MATCH TABLES. FIRST IS LOW CHARACTER OF RANGE, SECOND IS

;	0657	! HIGH CHARACTER. TYPE IS TABLE INDEX OF THE MATCHING RANGE.

;	0658	!

;	0659	

;	0660	BIND

;	0661		LOWCHAR		= UPLIT BYTE (0, 'Aa0') : VECTOR [,BYTE],

;	0662		HIGHCHAR	= UPLIT BYTE (0, 'Zz9') : VECTOR [,BYTE];

;	0663	

;	0664	! IF THE STRING IS EMPTY RETURN 0 AS THE TYPE. ELSE SEARCH THE TABLES.

;	0665	!

;	0666	

;	0667	IF .COUNT LEQ 0 THEN RETURN 0;



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 4-1

; Digital Equipment Corporation

;

;	0668	

;	0669	INCR I FROM 1 TO 3 DO

;	0670	    IF .STRINGP[0] GEQU .LOWCHAR[.I]

;	0671	    AND .STRINGP[0] LEQU .HIGHCHAR[.I]

;	0672	    THEN RETURN .I;

;	0673	

;	0674	RETURN 4;				! OTHER CHARACTERS ARE SKIPPED

;	0675	

;	0676	

;	0677	END;					! END OF ROUTINE TYPE







					      0019D	    .BLKB   3

					      001A0 P.AAE:  .BYTE   0							      ;

					      001A1 	    .ASCII  \Aa0\						      ;

					      001A4 P.AAF:  .BYTE   0							      ;

					      001A5 	    .ASCII  \Zz9\						      ;



						    LOWCHAR=		P.AAE

						    HIGHCHAR=		P.AAF





				       52  D5 001A8 TYPE:   TSTL    COUNT						      ; 0667

				       19  15 001AA 	    BLEQ    3$							      ;

		         50	       01  D0 001AC 	    MOVL    #1, I						      ; 0669

		    EC AF40	       63  91 001AF 1$:     CMPB    (STRINGP), LOWCHAR[I]				      ; 0670

				       07  1F 001B4 	    BLSSU   2$							      ;

		    E9 AF40	       63  91 001B6 	    CMPB    (STRINGP), HIGHCHAR[I]				      ; 0671

				       0A  1B 001BB 	    BLEQU   4$							      ;

	   EE	         50	       03  F3 001BD 2$:     AOBLEQ  #3, I, 1$						      ; 0669

		         50	       04  D0 001C1 	    MOVL    #4, R0						      ; 0674

					   05 001C4 	    RSB     							      ;

				       50  D4 001C5 3$:     CLRL    R0							      ; 0613

					   05 001C7 4$:     RSB     							      ;



; Routine Size:  32 bytes







; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 5

; Digital Equipment Corporation

;

;	0678	ROUTINE FORMAT_DATEOD1(INPDT,OUTPTR,TIME_REQUESTED) : COMMON_CALL NOVALUE =

;	0679	

;	0680	!++

;	0681	!

;	0682	! FUNCTIONAL DESCRIPTION:

;	0683	!	THIS ROUTINE FORMATS AN ON-DISK STRUCTURE ONE DATE FROM A

;	0684	!	JULIAN DATE ON MAG TAPE

;	0685	!

;	0686	! CALLING SEQUENCE:

;	0687	!	FORMAT_DATEOD1(ARG1,ARG2,ARG3)

;	0688	!

;	0689	! INPUT PARAMETERS:

;	0690	!	ARG1 - ADDRESS OF INPUT JULIAN DATE

;	0691	!	ARG2 - ADDRESS OF OUTPUT BUFFER

;	0692	!	ARG3 - 0 IF TIME IS NOT REQUESTED, 1 IF TIME IS REQUESTED

;	0693	!

;	0694	! IMPLICIT INPUTS:

;	0695	!	NONE

;	0696	!

;	0697	! OUTPUT PARAMETERS:

;	0698	!	ARG2 - ADDRESS OF OUTPUT BUFFER

;	0699	!

;	0700	! IMPLICIT OUTPUTS:

;	0701	!	NONE

;	0702	!

;	0703	! ROUTINE VALUE:

;	0704	!	NONE

;	0705	!

;	0706	! SIDE EFFECTS:

;	0707	!	DATE ATTRIBUTE WRITTEN TO OUTPUT BUFFER (DDMMMYY)

;	0708	!	IF TIME WANTED, FOLLOWED BY (000000)

;	0709	!

;	0710	!--

;	0711	

;	0712	BEGIN

;	0713	

;	0714	EXTERNAL REGISTER

;	0715		COMMON_REG;

;	0716	

;	0717	

;	0718	LOCAL

;	0719		DATA:	BLOCK [BYTE,12],		!WORK AREA IN WHICH DATE IS FORMATTED

;	0720		PTR,					!POINTER TO OUTPUT BUFFER

;	0721		INPTR,					!POINTER TO INPUT BUFFER

;	0722		CHAR;					!CHAR FROM INPUT STRING

;	0723	

;	0724	EXTERNAL ROUTINE

;	0725		CONVDATE_J2R;				!CONVERT ANSI JULIAN DATE TO DIGITAL REGULAR

;	0726	

;	0727	! CONVERT JULIAN DATE IN HDR1 TO DDMMMYY AND IF TIME IS REQUESTED, RETURN SIX ZEROS

;	0728	IF NOT CONVDATE_J2R(DATA,.INPDT)

;	0729	THEN RETURN;					!ASSUME OUTPUT BUFFER INITIALIZED TO ZERO

;	0730	

;	0731	(.OUTPTR)<0,16> = .(DATA)<0,16>;

;	0732	(.OUTPTR+2)<0,24> = .(DATA+3)<0,24>;



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 5-1

; Digital Equipment Corporation

;

;	0733	(.OUTPTR+5)<0,16> = .(DATA+9)<0,16>;

;	0734	

;	0735	IF .TIME_REQUESTED THEN CH$FILL('0',6,(.OUTPTR+7));

;	0736	END;						!END OF ROUTINE







							    .GLOBL  CONVDATE_J2R



					 003C 001C8 FORMAT_DATEOD1:

							    .WORD   Save R2,R3,R4,R5					      ; 0678

		         5E	       0C  C2 001CA 	    SUBL2   #12, SP						      ;

				  04   AC  DD 001CD 	    PUSHL   INPDT						      ; 0728

				  04   AE  9F 001D0 	    PUSHAB  DATA						      ;

		  0000G  CF	       02  FB 001D3 	    CALLS   #2, CONVDATE_J2R					      ;

		         1E	       50  E9 001D8 	    BLBC    R0, 1$						      ;

		         50	  08   AC  D0 001DB 	    MOVL    OUTPTR, R0						      ; 0731

		         60	       6E  B0 001DF 	    MOVW    DATA, (R0)						      ;

	   18	         00	  03   AE  F0 001E2 	    INSV    DATA+3, #0, #24, 2(R0)				      ; 0732

				  02   A0     001E7									      ;

		    05   A0	  09   AE  B0 001E9 	    MOVW    DATA+9, 5(R0)					      ; 0733

		         07	  0C   AC  E9 001EE 	    BLBC    TIME_REQUESTED, 1$					      ; 0735

	   30	         6E	       00  2C 001F2 	    MOVC5   #0, (SP), #48, #6, 7(R0)				      ;

		    07   A0	       06     001F6									      ;

					   04 001F9 1$:     RET     							      ; 0678



; Routine Size:  50 bytes







; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 6

; Digital Equipment Corporation

;

;	0737	GLOBAL ROUTINE FORMAT_FID(BUFFER) : COMMON_CALL NOVALUE  =

;	0738	

;	0739	!++

;	0740	!

;	0741	! FUNCTIONAL DESCRIPTION:

;	0742	!	THIS ROUTINE FORMATS THE BINARY FILE ID

;	0743	!

;	0744	! CALLING SEQUENCE:

;	0745	!	FORMAT_FID(ARG1)

;	0746	!

;	0747	! INPUT PARAMETERS:

;	0748	!	ARG1 - ADDRESS OF BUFFER TO RECEIVE 4 BYTE BINARY FILE ID

;	0749	!

;	0750	! IMPLICIT INPUTS:

;	0751	!	HDR1 IN LABEL AREA

;	0752	!

;	0753	! OUTPUT PARAMETERS:

;	0754	!	ARG1 - ADDRESS OF BUFFER TO RECEIVED BINARY FILE ID

;	0755	!

;	0756	! IMPLICIT OUTPUTS:

;	0757	!	NONE

;	0758	!

;	0759	! ROUTINE VALUE:

;	0760	!	NONE

;	0761	!

;	0762	! SIDE EFFECTS:

;	0763	!	BUFFER RECEIVES BINARY FILE ID

;	0764	!	1 WORD FILE NUMBER (HDR1 SECTION NUMBER)

;	0765	!	1 WORD FILE SEQUENCE NUMBER (HDR1 SEQUENCE NUMBER)

;	0766	!

;	0767	!--

;	0768	

;	0769	BEGIN

;	0770	

;	0771	EXTERNAL REGISTER

;	0772		COMMON_REG;

;	0773	

;	0774	EXTERNAL

;	0775		HDR1:		REF BBLOCK;	!ADDRESS OF HDR1(EOF1) LABEL

;	0776	

;	0777	LOCAL

;	0778		RESULT;				!LONG WORD WORK AREA FOR CONVERSIONS

;	0779	

;	0780	EXTERNAL ROUTINE

;	0781		LIB$CVT_DTB:	ADDRESSING_MODE(ABSOLUTE);	!CONVERT DECIMAL TO BINARY

;	0782	

;	0783	! CONVERT FILE NUMBER FIRST

;	0784	IF NOT LIB$CVT_DTB(HD1$S_FILESEQNO,HDR1[HD1$T_FILESEQNO],RESULT)

;	0785	THEN RESULT = 0;

;	0786	

;	0787	! STORE FILE NUMBER

;	0788	(.BUFFER)<0,16> = .RESULT<0,16>;

;	0789	

;	0790	! CONVERT FILE SEQUENCE NUMBER

;	0791	IF NOT LIB$CVT_DTB(HD1$S_FILESECNO,HDR1[HD1$T_FILESECNO],RESULT) THEN RESULT = 0;



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 6-1

; Digital Equipment Corporation

;

;	0792	

;	0793	! STORE FILE SEQUENCE NUMBER

;	0794	(.BUFFER)<16,16> = .RESULT<0,16>;

;	0795	

;	0796	END;					!END OF ROUTINE











					 0400 001FA 	    .ENTRY  FORMAT_FID, Save R10				      ; 0737

		         5A 00000000G  9F  9E 001FC 	    MOVAB   @#LIB$CVT_DTB, R10					      ;

		         5E	       04  C2 00203 	    SUBL2   #4, SP						      ;

				       5E  DD 00206 	    PUSHL   SP							      ; 0784

	   7E	  0000G  CF	       1F  C1 00208 	    ADDL3   #31, HDR1, -(SP)					      ;

				       04  DD 0020E 	    PUSHL   #4							      ;

		         6A	       03  FB 00210 	    CALLS   #3, LIB$CVT_DTB					      ;

		         02	       50  E8 00213 	    BLBS    R0, 1$						      ;

				       6E  D4 00216 	    CLRL    RESULT						      ; 0785

		    04   BC	       6E  B0 00218 1$:     MOVW    RESULT, @BUFFER					      ; 0788

				       5E  DD 0021C 	    PUSHL   SP							      ; 0791

	   7E	  0000G  CF	       1B  C1 0021E 	    ADDL3   #27, HDR1, -(SP)					      ;

				       04  DD 00224 	    PUSHL   #4							      ;

		         6A	       03  FB 00226 	    CALLS   #3, LIB$CVT_DTB					      ;

		         02	       50  E8 00229 	    BLBS    R0, 2$						      ;

				       6E  D4 0022C 	    CLRL    RESULT						      ;

	   10	         10	       6E  F0 0022E 2$:     INSV    RESULT, #16, #16, @BUFFER				      ; 0794

				  04   BC     00232									      ;

					   04 00234 	    RET     							      ; 0737



; Routine Size:  59 bytes





;	0797	



; Bliss-32 7.352	Saturday 21-AUG-1978 23:33:34	DBB3:[MTAACP.SRC]FRMOD1.B32;24					Page 7

; Digital Equipment Corporation

;

;	0798	END

;	0799	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  $CODE$         	   565  NOWRT,  RD ,  EXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)









;				LIBRARY STATISTICS

;

;					     -------- Symbols --------    Blocks

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]LIB.L32;1		      5582        41         0       245











; Size:		530 code + 35 data bytes

; Run Time:	00:17.7

; Elapsed Time:	00:37.6

; Memory Used:	347 pages

; Compilation Complete

