/* BEGIN INCLUDE FILE ... tsoapl_dcls.incl.pl1 ... Written by PG and BSG 10/77 */

/* automatic */

dcl	(aplsv_ws_ptr, aplsv_symtab_ptr, symptr, aplsv_function_ptr, aplsv_value_ptr, code_ptr) ptr;
dcl	(aplsv_group_ptr) ptr;
dcl	symlen fixed bin (21);
dcl	symtbep ptr;
dcl	array_ptr ptr,
	data_elements fixed bin,
	code_len fixed bin;

/* based */

dcl	1 aplsv_ws	based (aplsv_ws_ptr) aligned,
	2 pad1 (32)	bit (36),
	2 qr13stk		bit (36),
	2 qsymbot		bit (36),
	2 mx		bit (36),
	2 svi		bit (36),
	2 pad2 (21)	bit (36),
	2 library_number	bit (36),
	2 wsname		aligned,
	  3 len		fixed bin (8) unal,
	  3 chars		char (11) unal,
	2 man_number	bit (36),
	2 password	char (8) unal,		/* encoded */
	2 date_saved	char (8) unal,
	2 time_saved	bit (36),			/* in 1/300 secs since date */
	2 pad4 (8)	bit (36),
	2 fuzz		bit (36),
	2 pad5 (2)	bit (36),
	2 index_origin	bit (36),
	2 seed		bit (36),
	2 pad6 (5)	bit (36),
	2 digits		bit (36),
	2 pad7 (126)	bit (36),
	2 printing_width	bit (18) unal;

dcl	1 aplsv_symtab (1:1024) aligned based (aplsv_symtab_ptr),
	2 type		bit (9) unal,
	2 value_offset	bit (27) unal,
	2 size		fixed bin (8) unal,
	2 name_or_offset	bit (27) unal;

dcl	1 symbol_struc aligned based (symptr),
	2 pad	bit (36) unal,
	2 size	fixed bin (8) unal,
	2 name	char (1 refer (symbol_struc.size)) unal;

dcl	1 symtbe aligned based (symtbep) like aplsv_symtab;

dcl	1 aplsv_function	aligned based (aplsv_function_ptr),
	2 pad1 (2)	bit (36),
	2 pad2		bit (18) unal,
	2 nlines		fixed bin (17) unal,
	2 nlocalvars	fixed bin (17) unal,
	2 nlabels_w_nargs	fixed bin (17) unal,	/* 14 bits of nlabels, 4 bits of nargs */
	2 pad3		bit (9) unal,
	2 header_offset	bit (27) unal,
	2 line (1024)	aligned,
	  3 flags		bit (9) unal,
	  3 offset	bit (27) unal;

dcl	1 aplsv_value	aligned based (aplsv_value_ptr),
	2 pad1 (2)	bit (36) unal,
	2 type		bit (9) unal,
	2 pad2		bit (9) unal,
	2 rhorho_x4	fixed bin (17) unal,
	2 rho (1:32)	bit (36);

dcl	1 aplsv_group	aligned based (aplsv_group_ptr),
	2 pad1 (2)	bit (36) aligned,
	2 pad2 (2)	bit (9) unaligned,
	2 count		fixed bin (17) unal,
	2 symbp		(0 refer (aplsv_group.count)) bit (36) aligned;

dcl	1 fun_code	aligned based (code_ptr),
	2 pad (2) bit (36) aligned,
	2 size		fixed bin (17) unal,
	2 code (code_len refer (fun_code.size)) bit (9) unal;

dcl     1 bit_array based (array_ptr) aligned,
        2 integral_elements dimension (data_elements/8) unaligned,
	3 eight_nine_loss bit (1) unaligned,
	3 data bit (8) unaligned,
        2 tail bit (mod (data_elements, 8)) unal,
	fixed_array bit (36) dim (data_elements) based (array_ptr) aligned,
	float_array bit (72) dim (data_elements) based (array_ptr) aligned,
	char_array char (data_elements) based (array_ptr);

/* internal static */

dcl	(CECONST		init ("023"b3),	/* fltg pt extended */
	CBCONST		init ("025"b3),	/* Boolean bits */
	CICONST		init ("027"b3),	/* Integers */
	CFCONST		init ("031"b3),	/* Float single */
	CCCONST		init ("033"b3),	/* Chars */
	CCEOT		init ("0"b)) bit (9) static options (constant);

dcl	(VARIABLE_TYPE	init ("005"b3),
	FUNCTION_TYPE	init ("022"b3),
	GROUP_TYPE	init ("025"b3),
	SYSTEM_VAR_TYPE	init ("027"b3),
	SYSTEM_FCN_TYPE	init ("220"b3),
	SUSP_TEMPVAR_TYPE	init ("004"b3),
	FUNCTIONZ_TYPE	init ("023"b3),
	UNUSED_TYPE	init ("000"b3),
	UNKNOWN1_TYPE	init ("032"b3),		/* hex 1A */
	UNKNOWN2_TYPE	init ("231"b3),		/* hex 99 */
	UNKNOWN3_TYPE	init ("026"b3)		/* hex 16 */
	) bit (9) aligned internal static options (constant);

dcl	type_names (0:4) char (7) varying aligned internal static options (constant) initial (
	"unknown", "bit", "fixed", "float", "char");

dcl	(BIT_TYPE		init ("001"b3),
	FIXED_TYPE	init ("002"b3),
	FLOAT_TYPE	init ("003"b3),
	CHAR_TYPE		init ("004"b3)
	) bit (9) aligned internal static options (constant);

/* Internal procedures to convert from APLSV formats to Multics formats */

cv_fb17:
	procedure (aplsv_fb17) returns (fixed bin (17));

/* parameters */

dcl	aplsv_fb17 fixed bin (17) unaligned;

/* automatic */

dcl	fb17 fixed bin (17);
dcl	word bit (36) aligned;

/* builtins */

declare	(binary, bit, substr, unspec) builtin;

/* program */

	unspec (word) = bit (binary (aplsv_fb17, 36), 36);
	word = pack (word);

	if substr (word, 5, 1) = "1"b		/* number is negative */
	then substr (word, 1, 4) = "1111"b;

	unspec (fb17) = word;
	return (fb17);

     end cv_fb17;

cv_b18:
	procedure (aplsv_b18) returns (bit (18));

/* parameters */

dcl	aplsv_b18 bit (18) unal;

/* automatic */

dcl	b18 bit (18) aligned;

/* program */

	b18 = "00"b || substr (aplsv_b18, 2, 8) || substr (aplsv_b18, 11, 8);
	return (b18);

     end cv_b18;

pack:
	procedure (aplsv_word) returns (bit (36) aligned);

/* parameters */

dcl	aplsv_word bit (36) aligned;

/* automatic */

dcl	word bit (36) aligned;

/* program */

	word = ""b;
	substr (word, 5, 8) = substr (aplsv_word, 2, 8);
	substr (word, 13, 8) = substr (aplsv_word, 11, 8);
	substr (word, 21, 8) = substr (aplsv_word, 20, 8);
	substr (word, 29, 8) = substr (aplsv_word, 29, 8);
	return (word);

     end pack;

cv_ascii:
	procedure (zcode_chars) returns (char(*));

/* parameters */

dcl	zcode_chars char (*) unaligned;

/* automatic */

dcl	ascii_chars char (length (zcode_chars));

/* builtins */

declare	length builtin;

/* entries */

dcl	ioa_ entry options (variable),
	apl_zcode_to_ascii_ entry (char (*), char (*));

/* program */

	if length (zcode_chars) > length (ascii_chars)
	then do;
		call ioa_ ("max zcode-to-ascii length of ^d exceeded.", length (ascii_chars));
	     end;

	call apl_zcode_to_ascii_ (zcode_chars, ascii_chars);
	return (ascii_chars);

     end cv_ascii;

byteptr:
	procedure (P_aplsv_byte_address) returns (ptr);

/* parameters */

dcl	P_aplsv_byte_address bit (36) aligned;

/* automatic */

dcl	aplsv_byte_address bit (36) aligned,
	virtual_address ptr;

/* based */

dcl	bytearray char (1) dim (0:1044479) based unaligned;


/* program */

/* Just like the 360, we must ignore the top byte. */

	aplsv_byte_address = P_aplsv_byte_address & "000777777777"b3;
	virtual_address = addr (aplsv_ws_ptr -> bytearray (binary (pack (aplsv_byte_address))));
	return (virtual_address);

     end byteptr;

cv_float:
     procedure (aplsv_float) returns (float bin (63));

	go to xx;

cv_floatx:  entry (aplsv_float) returns (float bin (63));

	word1 = "0000"b || substr (aplsv_float, 1, 32);
	word2 = "0000"b || substr (aplsv_float, 33, 32);
	go to yyy;

/* parameters */

dcl	aplsv_float bit (72) aligned;

/* auto */

dcl	float_result float bin (63);
dcl	exponent fixed bin;
dcl	1 mfloat aligned auto,
	2 exp fixed bin (7) unal,
	2 mantissa bit (64) unal;

dcl       s360mant bit (56), s360exp bit (7);
dcl	s360mantf fixed bin (56), s360expf fixed bin (7);

dcl	(word1, word2) bit (36) aligned;

/* builtins */

declare	float builtin;

/* program */

xx:
	word1 = pack (substr (aplsv_float, 1, 36));
	word2 = pack (substr (aplsv_float, 37, 36));

yyy:
	s360mant =substr (word1, 5 + 8) || substr (word2, 5);
	s360mantf = fixed (s360mant, 56);
	float_result = float (s360mantf);
	if float_result = 0e0 then return (0e0);	/* For any rep of zero, give 0 before barfs out */
	if substr (word1, 5, 1) then float_result = - float_result;
	s360exp = substr (word1, 6, 7);
	s360expf = fixed (s360exp, 7);
	exponent = (s360expf -64) * 4 - 56;
	unspec (mfloat) = unspec (float_result);
	if mfloat.exp + exponent > 127 then do;
		call ioa_ ("Number too large. ^f supplied.", TheBiggestNumberWeveGot);
		call print_losing_flonum;
		float_result = TheBiggestNumberWeveGot;
	end;
	else if mfloat.exp +exponent < -128 then do;
		call ioa_ ("Number too small. ^f supplied.", TheSmallestNumberWeveGot);
		call print_losing_flonum;
		float_result = TheSmallestNumberWeveGot;
	end;
	else do;
		mfloat.exp = mfloat.exp + exponent;
		unspec (float_result) = unspec (mfloat);
	end;
	return (float_result);

print_losing_flonum: proc;

dcl   flt_exponent float bin (63),
      int_exponent fixed bin;
dcl  (float, floor, log10) builtin;

	flt_exponent = (s360expf - 64) * log10 (16e0);
	int_exponent = floor (flt_exponent);
	flt_exponent = flt_exponent - float (int_exponent);

	call ioa_ ("Losing number = .^3.4b*16**^d = ^.5fe^d",
	     substr (s360mant, 1, 12), s360expf - 64,
	     float_result * (2e0 ** -56) * 10 ** flt_exponent,
	     int_exponent);
	return;

end print_losing_flonum;
     end cv_float;

cvf32: proc (bits32) returns (fixed bin (35));

	dcl bits32 bit (32);
	dcl  f35 fixed bin (35) aligned;
	if substr (bits32, 1, 1) then unspec (f35) = "1111"b || bits32;
	else unspec (f35) = "0000"b || bits32;
	return (f35);

end cvf32;

cvb36f32: proc (bits36) returns (fixed bin (35));

dcl  bits36 bit (36) aligned;

	return (fixed (pack (bits36), 35));

end cvb36f32;

/* END INCLUDE FILE ... tsoapl_dcls.incl.pl1 */


*/
                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems 
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved

*/