card_codes_.alm 11/15/82 1807.9rew 11/15/82 1532.4 40428 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " CARD_CODES_ - Reader/Punch Card Code Translation Tables. " redesigned 6/25/75 by Noel I. Morris " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " The reader translation table is referenced by computing an index " from 12-11-0 rows, 1-2-3-4-5-6-7 rows, and 8-9 rows. Only one punch " may be found in the 1-2-3-4-5-6-7 rows. " " The punch translation table is referenced by using the ASCII character " as an index. name card_codes_ segdef mcc_reader_codes segdef mcc_punch_codes " mcc_reader_codes: vfd o9/040,o9/071,o9/070,o9/777,o9/067,o9/004,o9/042,o9/032 vfd o9/066,o9/777,o9/075,o9/777,o9/065,o9/777,o9/047,o9/025 vfd o9/064,o9/777,o9/100,o9/024,o9/063,o9/777,o9/043,o9/777 vfd o9/062,o9/026,o9/072,o9/777,o9/061,o9/777,o9/140,o9/777 vfd o9/060,o9/132,o9/131,o9/777,o9/130,o9/033,o9/077,o9/007 vfd o9/127,o9/027,o9/076,o9/006,o9/126,o9/777,o9/137,o9/005 vfd o9/125,o9/777,o9/045,o9/777,o9/124,o9/777,o9/054,o9/777 vfd o9/123,o9/777,o9/777,o9/777,o9/057,o9/777,o9/777,o9/777 vfd o9/055,o9/122,o9/121,o9/030,o9/120,o9/777,o9/136,o9/037 vfd o9/117,o9/010,o9/073,o9/036,o9/116,o9/012,o9/051,o9/035 vfd o9/115,o9/777,o9/052,o9/034,o9/114,o9/023,o9/044,o9/777 vfd o9/113,o9/022,o9/041,o9/777,o9/112,o9/021,o9/777,o9/031 vfd o9/175,o9/172,o9/171,o9/777,o9/170,o9/777,o9/777,o9/777 vfd o9/167,o9/777,o9/777,o9/777,o9/166,o9/777,o9/777,o9/777 vfd o9/165,o9/777,o9/777,o9/777,o9/164,o9/777,o9/777,o9/777 vfd o9/163,o9/777,o9/777,o9/777,o9/176,o9/777,o9/777,o9/777 vfd o9/046,o9/111,o9/110,o9/777,o9/107,o9/777,o9/174,o9/017 vfd o9/106,o9/777,o9/053,o9/016,o9/105,o9/011,o9/050,o9/015 vfd o9/104,o9/777,o9/074,o9/014,o9/103,o9/003,o9/056,o9/013 vfd o9/102,o9/002,o9/134,o9/777,o9/101,o9/001,o9/777,o9/777 vfd o9/173,o9/151,o9/150,o9/777,o9/147,o9/777,o9/777,o9/777 vfd o9/146,o9/777,o9/777,o9/777,o9/145,o9/777,o9/133,o9/777 vfd o9/144,o9/777,o9/777,o9/777,o9/143,o9/777,o9/777,o9/777 vfd o9/142,o9/777,o9/777,o9/777,o9/141,o9/777,o9/777,o9/000 vfd o9/777,o9/162,o9/161,o9/777,o9/160,o9/777,o9/777,o9/777 vfd o9/157,o9/777,o9/777,o9/777,o9/156,o9/777,o9/135,o9/777 vfd o9/155,o9/777,o9/777,o9/777,o9/154,o9/777,o9/777,o9/777 vfd o9/153,o9/777,o9/777,o9/777,o9/152,o9/777,o9/777,o9/020 vfd o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777 vfd o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777 vfd o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777 vfd o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777,o9/777 " mcc_punch_codes: vfd o12/5403,o12/4401,o12/4201,o12/4101,o12/0005,o12/1023 vfd o12/1013,o12/1007,o12/2011,o12/4021,o12/2021,o12/4103 vfd o12/4043,o12/4023,o12/4013,o12/4007,o12/6403,o12/2401 vfd o12/2201,o12/2101,o12/0043,o12/0023,o12/0201,o12/1011 vfd o12/2003,o12/2403,o12/0007,o12/1005,o12/2043,o12/2023 vfd o12/2013,o12/2007,o12/0000,o12/2202,o12/0006,o12/0102 vfd o12/2102,o12/1042,o12/4000,o12/0022,o12/4022,o12/2022 vfd o12/2042,o12/4012,o12/1102,o12/2000,o12/4102,o12/1400 vfd o12/1000,o12/0400,o12/0200,o12/0100,o12/0040,o12/0020 vfd o12/0010,o12/0004,o12/0002,o12/0001,o12/0202,o12/2012 vfd o12/4042,o12/0012,o12/1012,o12/1006,o12/0042,o12/4400 vfd o12/4200,o12/4100,o12/4040,o12/4020,o12/4010,o12/4004 vfd o12/4002,o12/4001,o12/2400,o12/2200,o12/2100,o12/2040 vfd o12/2020,o12/2010,o12/2004,o12/2002,o12/2001,o12/1200 vfd o12/1100,o12/1040,o12/1020,o12/1010,o12/1004,o12/1002 vfd o12/1001,o12/5022,o12/4202,o12/6022,o12/2006,o12/1022 vfd o12/0402,o12/5400,o12/5200,o12/5100,o12/5040,o12/5020 vfd o12/5010,o12/5004,o12/5002,o12/5001,o12/6400,o12/6200 vfd o12/6100,o12/6040,o12/6020,o12/6010,o12/6004,o12/6002 vfd o12/6001,o12/3200,o12/3100,o12/3040,o12/3020,o12/3010 vfd o12/3004,o12/3002,o12/3001,o12/5000,o12/4006,o12/3000 vfd o12/3400,o12/0000 end  card_dim.pl1 11/15/82 1807.9rew 11/15/82 1458.6 30438 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* CARD_DIM - This the the common code for all card I/O DIMs. */ /* modified from earlier code by Noel I. Morris, June 1975. */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ card_attach: proc (ioname, type, ioname2, mode, iostatus, sdb_ptr); dcl ioname char (*), /* name used in attachment */ type char (*), /* name of DIM being attached */ ioname2 char (*), /* name of DIM being attached to */ mode char (*), /* mode of attachment */ iostatus bit (72) aligned; /* status bits */ dcl barea area ((16374)) based (areaptr), /* allocation area */ ap ptr; /* automatic pointer to area */ dcl error_table_$ionmat fixed bin (35) ext, error_table_$no_room_for_dsb fixed bin (35) ext; dcl get_system_free_area_ entry (ptr), ios_$setsize entry (char (*) aligned, fixed bin, bit (72) aligned), ios_$order entry (char (*) aligned, char (*), ptr, bit (72) aligned), ios_$changemode entry (char (*) aligned, char (*), char (*), bit (72) aligned); dcl (addr, null, substr, unspec) builtin; /* */ % include card_sdb; /* */ /* This is the "attach" entry point for all card pseudo-DIMs (i.e. raw, mcc, viipunch, & flipper). */ iostatus = "0"b; if sdb_ptr ^= null () then do; /* previous attachment indicated */ substr (iostatus, 1, 36) = unspec (error_table_$ionmat); return; end; call get_system_free_area_ (ap); allocate SDB in (ap -> barea) set (sdb_ptr); if sdb_ptr = null () then do; substr (iostatus, 1, 36) = unspec (error_table_$no_room_for_dsb); return; end; outer_module_name = type; attachment_list_ptr = addr (stream_name); next_stream_ptr = null (); name_size = 32; stream = ioname2; areaptr = ap; modes = "0"b; /* Clear all mode settings. */ call ios_$setsize (stream, 972, iostatus); /* Insure element is one card. */ return; /* This is the "detach" entry point for all card pseudo-DIMs. */ card_detach: entry (sdb_ptr, ioname2, mode, iostatus); free SDB in (areaptr -> barea); substr (iostatus, 52, 1) = "1"b; /* Your detach bit */ return; /* */ card_order: entry (sdb_ptr, order, infop, iostatus); dcl order char (*), /* order to be executed */ infop ptr; /* pointer to info for order */ call ios_$order (stream, order, infop, iostatus);/* Relay the call. */ return; card_changemode: entry (sdb_ptr, new_mode, old_mode, iostatus); dcl new_mode char (*), /* new mode setting */ old_mode char (*); /* previous mode setting */ call ios_$changemode (stream, new_mode, old_mode, iostatus); /* Relay the call. */ return; end card_attach;  card_util_.pl1 11/15/82 1807.9rew 11/15/82 1458.6 43524 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ card_util_: proc; /* This procedure implements the mapping of mode names to a compact bit string. */ /* The bit string is used when calling the translate entry to set the operations which are performed. */ /* Created by DRV in 1977 */ /* Modified by J. C. Whitmore, Feb 1980, to remove the punch_nl and binary modes (unused) and to increase the */ /* size of the orig_string variable to 2000 chars for HASP records */ dcl test_mode char (*); dcl new_modes char (*); dcl old_modes char (*); dcl mode_bits bit (36); dcl a_code fixed bin (35); dcl string char (*) var; dcl last_char fixed bin; dcl char char (1); dcl orig_len fixed bin; dcl orig_string char (2000) aligned; /* our copy of the card image */ dcl pos fixed bin; dcl i fixed bin; dcl n fixed bin; dcl mode_len fixed bin; dcl val bit (1); dcl mode char (32) var; dcl ret_modes char (256) var; dcl 1 modes based (addr (mode_bits)), 2 trim bit (1) unal, 2 lower_case bit (1) unal, 2 add_nl bit (1) unal, 2 contin bit (1) unal, 2 pad bit (30) unal; dcl space char (1) int static init (" "); dcl lower_case char (26) int static init ("abcdefghijklmnopqrstuvwxyz"); dcl upper_case char (26) int static init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); dcl NL char (1) int static init (" "); dcl error_table_$bad_mode ext fixed bin (35); dcl (substr, rtrim, ltrim, search, verify, reverse, length, translate, copy) builtin; modes: entry (new_modes, mode_bits, old_modes, a_code); a_code = 0; if modes.lower_case then ret_modes = "lower_case,"; else ret_modes = "^lower_case,"; if modes.add_nl then ret_modes = ret_modes || "add_nl,"; else ret_modes = ret_modes || "^add_nl,"; if modes.contin then ret_modes = ret_modes || "contin,"; else ret_modes = ret_modes || "^contin,"; if modes.trim then ret_modes = ret_modes || "trim."; else ret_modes = ret_modes || "^trim."; old_modes = ret_modes; n = verify (reverse (new_modes), " .,;"); /* any thing there? */ if n = 0 then return; /* guess not */ mode_len = length (new_modes) - n + 1; do i = 1 repeat i + n while (i < mode_len); n = search (substr (new_modes, i), ",;."); if n = 0 then n = mode_len - i + 2; /* no breaks, take remaining */ mode = ltrim (rtrim (substr (new_modes, i, n - 1))); /* get mode */ if substr (mode, 1, 1) = "^" then do; val = "0"b; pos = 2; end; else do; val = "1"b; pos = 1; end; if substr (mode, pos) = "trim" then modes.trim = val; else if substr (mode, pos) = "lower_case" then modes.lower_case = val; else if substr (mode, pos) = "add_nl" then modes.add_nl = val; else if substr (mode, pos) = "contin" then modes.contin = val; else a_code = error_table_$bad_mode; end; return; translate: entry (mode_bits, string); orig_len = length (string); /* save the original string length */ last_char = length (rtrim (string)); /* find last non-blank */ if modes.lower_case & last_char > 0 then do; orig_string = string; /* copy the string */ string = ""; /* we will rebuild it */ do i = 1 to last_char; /* look at each char given */ char = substr (orig_string, i, 1); /* get the next char */ if char = "\" & i < last_char then do; /* don't convert a trailing \ */ i = i + 1; char = substr (orig_string, i, 1); /* skip the escape char */ if char = "<" then char = "["; else if char = ">" then char = "]"; else if char = "(" then char = "{"; else if char = ")" then char = "}"; end; else char = translate (char, lower_case, upper_case); string = string || char; /* add to the input string */ end; string = string || copy (" ", orig_len - length (string)); /* pad out to orig length */ end; if modes.trim then string = rtrim (string); if modes.contin then do; i = length (rtrim (string)); /* find last non-blank char */ if i > 0 then do; if substr (string, i, 1) ^= "\" & modes.add_nl then string = string || NL; else if substr (string, i, 1) = "\" then string = substr (string, 1, i - 1); /* drop contin mark */ end; else if modes.add_nl then string = string || NL; end; else if modes.add_nl then string = string || NL; return; test_mode: entry (mode_bits, test_mode) returns (bit (1)); return ("0"b); end card_util_;  check_cd.alm 11/15/82 1807.9rew 11/15/82 1532.1 11601 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " This routine will compute the full word logical checksum " of a binary card image pointed to by P. " T.P. Skinner April 1968. " Modified 7/7/75 by Noel I. Morris " " bit36 = check_cd (p); " " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** name check_cd segdef check_cd check_cd: eppbp ap|2,* get ptr to data eppbp bp|0,* lda bp|0 start with word 0 eax1 0 initialize index ldi =o4000,dl turn on overflow mask rpt 22,1 awca bp|2,1 add words 2 thru 23 awca 0,dl add in last carry sta ap|4,* return computed checksum short_return end  cpz.alm 11/15/82 1807.9rew 11/15/82 1532.2 9747 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the cpz outer module. " " " " " " " " " " name cpz entry cpzmodule segref cpz_dim,cpz_attach,cpz_detach,cpz_write,cpz_order,cpz_setsize,cpz_getsize segref ios_,no_entry cpzmodule: tra *+1,6 tra cpz_attach tra cpz_detach tra no_entry tra cpz_write tra no_entry tra cpz_order tra no_entry tra no_entry tra cpz_setsize tra cpz_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end cpzmodule  cpz_status_table_.alm 09/12/83 1116.2rew 09/12/83 1023.8 22320 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " CPZ_STATUS_TABLE_ - Status Tables for the Card Punch. " coded 12/5/74 by Noel I. Morris " modified 4/79 by R.J.C. Kissel to add major status 0. " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** include status_table bool alert,000001 punch alert flag " status_table cpz,(1,1,1,1,0,1,0,0,0,0,1,1,0,1,0,0) " status_entry 1,(Channel Ready) substat_entry 1,000000,,(Ready) " status_entry 2,(Device Busy) " status_entry 3,(Device Attention) substat_entry 3,000000,in+rp+hlt,(Device off line) substat_entry 3,XXXXX1,in+rp+hlt,(Hopper empty or Stacker full) substat_entry 3,XXXX1X,in+rp+hlt,(Manual Halt) substat_entry 3,0XX1XX,in+rp+hlt,(Chad box full) substat_entry 3,0X1XXX,in+rp+hlt,(Feed Failure) substat_entry 3,X1XXXX,bk+rp+hlt,(Card jam) " status_entry 4,(Device Data Alert) substat_entry 4,000XX1,bk+rp+hlt,(Transfer timing error) substat_entry 4,000X1X,bk+rp+hlt,(Transmission parity alert) substat_entry 4,0001XX,alert+bk+rp+hlt,(Punch alert) " status_entry 6,(Command Reject) substat_entry 6,0000X1,bk+rp+hlt,(Invalid op code) substat_entry 6,00001X,bk+rp+hlt,(Invalid device code) substat_entry 6,000100,bk+rp+hlt,(IDCW parity error) " status_entry 11,(MPC Attention) substat_entry 11,000001,in+rp+hlt,(IAI error) substat_entry 11,000010,in+rp+hlt,(DAI error) substat_entry 11,000100,in+rp+hlt,(DA Transfer error) " status_entry 12,(MPC Data Alert) substat_entry 12,000001,bk+rp+hlt,(Transmission parity error) substat_entry 12,000101,bk+rp+hlt,(DAI error) " status_entry 14,(MPC Command Reject) substat_entry 14,000001,bk+rp+hlt,(Illegal procedure) substat_entry 14,000010,bk+rp+hlt,(Illegal logical channel) substat_entry 14,001000,bk+rp+hlt,(Device reserved) end  crz.alm 11/15/82 1807.9rew 11/15/82 1532.2 10377 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the crz outer module. " " " " " " " " " " name crz entry crzmodule segref crz_dim,crz_attach,crz_detach,crz_read,crz_setsize,crz_getsize,crz_changemode segref crz_dim,crz_order segref crz_dim,crz_resetread segref ios_,no_entry crzmodule: tra *+1,6 tra crz_attach tra crz_detach tra crz_read tra no_entry tra no_entry tra crz_order tra crz_resetread tra no_entry tra crz_setsize tra crz_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra crz_changemode tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end crzmodule  crz_status_table_.alm 09/12/83 1116.2rew 09/12/83 1023.8 23769 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " CRZ_STATUS_TABLE_ - Status Tables for the Card Reader. " coded 12/1/74 by Noel I. Morris " modified 4/79 by R.J.C. Kissel to add major status 0. " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** include status_table " status_table crz,(1,1,1,1,0,1,0,0,0,0,1,1,0,1,0,0) " status_entry 1,(Channel Ready) substat_entry 1,000001,,(51-column cards) " status_entry 2,(Device Busy) " status_entry 3,(Device Attention) substat_entry 3,000000,in+rp+hlt,(Device off line) substat_entry 3,XXXXX1,in+rp+hlt,(Hopper empty or Stacker full) substat_entry 3,XXXX1X,in+rp+hlt,(Manual Halt) substat_entry 3,XXX1X1,in+rp+hlt,(Last batch finished) substat_entry 3,0X1XXX,in+rp+hlt,(Feed Alert) substat_entry 3,1X1XXX,in+rp+hlt,(Sneak Feed) substat_entry 3,X1XXXX,bk+rp+hlt,(Card jam) substat_entry 3,1X0XXX,bk+rp+hlt,(Read Alert) " status_entry 4,(Device Data Alert) substat_entry 4,000001,bk+rp+hlt,(Transfer timing error) substat_entry 4,000X10,bk+rp+hlt,(Validity check) substat_entry 4,0001X0,bk+rp+hlt,(Dual read alert) substat_entry 4,001000,bk+rp+hlt,(Feed without read) " status_entry 6,(Command Reject) substat_entry 6,0000X1,bk+rp+hlt,(Invalid op code) substat_entry 6,00001X,bk+rp+hlt,(Invalid device code) substat_entry 6,000100,bk+rp,(IDCW parity error) " status_entry 11,(MPC Attention) substat_entry 11,000001,in+rp+hlt,(IAI error) substat_entry 11,000010,in+rp+hlt,(DAI error) substat_entry 11,000100,in+rp+hlt,(DA Transfer error) substat_entry 11,001000,in+rp+hlt,(Invalid Punch) " status_entry 12,(MPC Data Alert) substat_entry 12,000001,bk+rp+hlt,(Transmission parity error) substat_entry 12,000101,bk+rp+hlt,(DAI error) " status_entry 14,(MPC Command Reject) substat_entry 14,000001,bk+rp+hlt,(Illegal procedure) substat_entry 14,000010,bk+rp+hlt,(Illegal logical channel) substat_entry 14,001000,bk+rp+hlt,(Device reserved) end  crzcpz_dim.pl1 07/18/86 1502.0rew 07/18/86 1235.1 247644 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-06-04,Hartogs), approve(86-06-04,MCR7383), audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098): Changed to user version constant in rcp_device_info.incl.pl1 END HISTORY COMMENTS */ crzcpz_dim: procedure; /* Originally coded by Ammons and Ohlin, June 1971 */ /* Modified 8/74 by Noel I. Morris for I/O Interfacer operation. */ /* Modified to combine reader & punch functions, 12/74 by Noel I. Morris */ /* Modified by J. C. Whitmore, 6/78, to delay printing messages until blocking */ dcl stream_name char (*), /* Name of current stream */ crzcpz char (*), /* Name of DIM being attached */ device char (*), /* Name of device being attached */ (mode, new_mode, old_mode) char (*), /* Device attributes */ iostatus bit (72) aligned, /* Status */ element_size fixed bin (17), /* Number of bits in element */ offset fixed bin (17), /* Offset from wkspptr */ nelem fixed bin (17), /* Number of elements requested */ nelemt fixed bin (17), /* Number of elements actually transmitted */ sdb_ptr pointer, /* Pointer to stream data block */ (xwkspptr, wkspptr) pointer, /* Pointer to workspace */ dvname char (6); /* name of device type */ dcl error_table_$ionmat ext fixed bin (35), /* Error code - IOname already attached */ error_table_$no_room_for_dsb ext fixed bin (35), /* Error code - No room available for dsb */ error_table_$invalid_elsize ext fixed bin (35), /* Error code - Invalid element size */ error_table_$invalid_read ext fixed bin (35), /* Error code - Invalid read */ error_table_$invalid_write ext fixed bin (35), /* Error code - Invalid write */ error_table_$net_timeout ext fixed bin (35), /* Error code - Connect timed out */ error_table_$no_operation ext fixed bin (35), /* Error code - io operation not done */ error_table_$undefined_order_request ext fixed bin (35), /* Error code - it is obvious, right? */ error_table_$eof_record ext fixed bin (35); /* Error code - eof found */ dcl crz_status_table_$crz_status_table_ ext; dcl cpz_status_table_$cpz_status_table_ ext; dcl (addr, addrel, bin, bit, divide, mod, null, rel, substr, unspec) builtin; dcl 1 sdb aligned based (sdb_ptr), /* Declare stream data block */ 2 outer_module_name char (32) aligned, 2 device_name_list_ptr pointer, 2 device_name, 3 next_device_ptr pointer, 3 name_size fixed bin (17), 3 name char (32) aligned, 2 ev_list aligned, /* Event list for ipc_ */ 3 count fixed bin (17), /* Event count = Always one */ 3 evchan fixed bin (71), /* Event evchan name */ 2 devx fixed bin, /* Device index returned by IOI */ 2 punch bit (1), /* "0"b => reader; "1"b => punch */ 2 rcp_id bit (36), /* ID for RCP attachment */ 2 areap ptr, /* pointer to sdb allocation area */ 2 wsegp ptr, /* pointer to IOI working segment */ 2 stat_tablep ptr, /* pointer to status analysis table */ 2 running bit (1), /* "1"b if channel running */ 2 eof_flag bit (1), /* EOF recogntion - "1" = on - See order call */ 2 iobegin fixed bin (18), /* index for starting up I/O */ 2 iocur fixed bin (18), /* index for queuing next I/O record */ 2 movecur fixed bin (18), /* index for copying next record */ 2 movestop fixed bin (18), /* index for stopping data copy */ 2 term_idcw bit (36), /* IDCW for stopping channel */ 2 io_idcw bit (36), /* IDCW for reading or punching binary card */ 2 wait_flag bit (1) aligned, /* waiting for special interrupt flag */ 2 marker_count fixed bin, /* counter for setting marker interrupts */ 2 error_count fixed bin, /* count of errors */ 2 card_count fixed bin, /* number of cards read/punched since last reset */ 2 last_iom_stat bit (72), /* last useful status bits reported */ 2 print_message bit (1), /* print the following message before blocking */ 2 message char (256) var; /* last error message not reported */ dcl workspace (27) bit (36) based (wkspptr) aligned; /* Workspace allocated by caller */ dcl 1 wseg based (wsegp) aligned, /* working segment for I/O Interfacer */ 2 dcwlist (0:33), /* DCW list */ 3 idcw bit (36), /* Instruction DCW */ 3 dcw bit (36), /* data transfer DCW */ 2 tdcw bit (36), /* TDCW to beginning of list */ 2 pad bit (36), 2 buffer (0:33), /* card image buffer */ 3 words (27) bit (36); dcl i fixed bin (17), /* Do loop position indicator */ iostop fixed bin (18), /* place to stop queuing I/O */ ionext fixed bin (18), /* index for terminate IDCW */ rcode fixed bin (35), /* IOI error code - 0 = OK */ ev_done fixed bin, /* ipc_: 0 = no event yet, 1 = event occured */ area_ptr pointer, wksp_max fixed bin (19), /* max size of IOI workspace buffer */ time_max fixed bin (52), /* max time for IOI connect to complete */ rcp_state fixed bin, /* state variable from check_attach */ temp_iom_stat bit (72) aligned, /* Space to hold iom status on error */ listen_based_area area ((16374)) based (area_ptr); /* Area in listen_ to allocate sdb */ dcl punch_alert_flag bit (18) aligned static options (constant) init ("000000000000000001"b); dcl dev_stat_bits bit (72) aligned int static options (constant) /* bits used by analyze_device_stat_ */ init ("377700770000"b3 || (12) "0"b3); dcl get_system_free_area_ ext entry (ptr), ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35)), ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)), ipc_$create_ev_chn ext entry (fixed bin (71), fixed bin (35)), ipc_$drain_chn ext entry (fixed bin (71), fixed bin (35)), ipc_$delete_ev_chn ext entry (fixed bin (71), fixed bin (35)), ipc_$block ext entry (ptr, ptr, fixed bin (35)), ipc_$read_ev_chn entry (fixed bin (71), fixed bin, ptr, fixed bin (35)), rcp_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35)), rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (52), fixed bin, fixed bin (35)), rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35)), analyze_system_fault_ entry (char (*) aligned, bit (72) aligned), analyze_device_stat_$rs entry (char (*) var, ptr, bit (72) aligned, bit (18) aligned), convert_ipc_code_ entry (fixed bin (35)), com_err_ entry options (variable); dcl 1 rcp_info like device_info aligned auto; /* automatic copy of RCP info structure */ dcl 1 ipc_message aligned, 2 chname fixed bin (71), /* Chan over which message arrived */ 2 message fixed bin (71), /* 2-word event message */ 2 sender bit (36), /* Sending process */ 2 origin, /* Origin of event message */ 3 devsignal bit (18), /* 1 = device signal */ 3 ring bit (18), /* Senders ring number */ 2 channel_index fixed bin; /* Index in wait list */ /* */ % include rcp_device_info; % include status_flags; /* */ % include ioi_stat; /* */ % include iom_pcw; /* */ % include iom_dcw; %include prt_order_info; /* */ crz_attach: entry (stream_name, crzcpz, device, mode, iostatus, sdb_ptr); /* Attach entry */ cpz_attach: entry (stream_name, crzcpz, device, mode, iostatus, sdb_ptr); /* Attach entry */ iostatus = "0"b; /* Zero iostatus string */ if sdb_ptr ^= null () then do; /* Check for multiple attachments */ substr (iostatus, 1, 36) = unspec (error_table_$ionmat); /* If multiple attachment return code */ go to exit; end; /* End sdb_ptr not null do group */ call get_system_free_area_ (area_ptr); /* Get ptr to area in listen_ before alloc */ allocate sdb in (listen_based_area) set (sdb_ptr); /* Create stream data block */ if sdb_ptr = null () then do; /* If this - then no room for sdb */ substr (iostatus, 1, 36) = unspec (error_table_$no_room_for_dsb); /* Send message */ go to exit; /* Exit */ end; /* End sdb_ptr null do group */ sdb.areap = area_ptr; /* Save area pointer for freeing sdb. */ outer_module_name = crzcpz; /* Put name this outer module in sdb */ device_name_list_ptr = addr (sdb.device_name); /* Set pointer */ next_device_ptr = null; /* Only one device allowed */ name_size = 32; /* Set name size */ name = device; /* Put attached device name in sdb */ if outer_module_name = "cpz" then do; /* If punch ... */ punch = "1"b; /* Set indicator to say punch attached. */ dvname = "punch"; sdb.stat_tablep = addr (cpz_status_table_$cpz_status_table_); end; /* Set pointer to punch status interpretation table. */ else do; /* If reader ... */ punch = "0"b; /* Set indicator to say reader attached. */ dvname = "reader"; sdb.stat_tablep = addr (crz_status_table_$crz_status_table_); end; /* Set pointer to reader status interpretation table. */ call ipc_$create_ev_chn (evchan, rcode); /* Create event channel so that the supervisor */ if rcode ^= 0 then do; /* knows who to wake when we are blocked */ call convert_ipc_code_ (rcode); go to free; /* to free sdb */ end; ev_list.count = 1; /* Initialize event list count */ device_info_ptr = addr (rcp_info); /* Get pointer to RCP info for device. */ rcp_info.version_num = DEVICE_INFO_VERSION_1; /* Set up the RCP info structure. */ rcp_info.usage_time = 0; /* Don't know how long we'll use device. */ rcp_info.wait_time = 0; /* We are not willing to wait. */ rcp_info.system_flag = "0"b; /* Not system process. */ rcp_info.device_name = name; /* Set appropriate device name. */ call rcp_$attach (dvname, device_info_ptr, evchan, "", rcp_id, rcode); if rcode ^= 0 then go to free; /* Attempt to attach the device. */ check: call rcp_$check_attach (rcp_id, device_info_ptr, "", devx, wksp_max, time_max, rcp_state, rcode); /* Check on progress of attachment. */ if rcode ^= 0 then go to free; go to attach_state (rcp_state); /* Dispatch on state variable. */ attach_state (1): /* Short wait needed */ call ipc_$block (addr (sdb.ev_list), addr (ipc_message), rcode); if rcode ^= 0 then do; /* Wait for attachment to complete. */ call convert_ipc_code_ (rcode); go to free; end; go to check; /* Perform check again. */ attach_state (2): /* long wait */ attach_state (3): /* error occurrence */ go to free; /* This is an error condition. */ attach_state (0): /* Successful attachment */ call ioi_$workspace (devx, wsegp, 1024, rcode); /* Get working segment. */ if rcode ^= 0 then go to free; /* Check error code */ do i = 0 to 33; /* Insert DCWs into working segment */ dcwp = addr (dcwlist (i).dcw); /* Get pointer to place for IOTD. */ dcw.address = rel (addr (buffer (i))); /* Set offset of data buffer. */ dcw.tally = bit (bin (27, 12)); /* Set DCW tally. */ end; idcwp = addr (sdb.term_idcw); /* Get pointer to template terminate IDCW. */ sdb.term_idcw = "0"b; /* Clear IDCW. */ idcw.command = "100000"b; /* Command is RSS. */ idcw.device = "000001"b; idcw.code = "111"b; idcw.chan_cmd = "000010"b; idcw.count = bit (bin (1, 6)); idcwp = addr (sdb.io_idcw); /* Get pointer to template read/punch IDCW. */ sdb.io_idcw = "0"b; /* Clear IDCW. */ if punch then /* If punch ... */ idcw.command = "001001"b; /* Command is punch card binary. */ else /* If reader ... */ idcw.command = "000001"b; /* Command is read card binary. */ idcw.device = "000001"b; idcw.code = "111"b; idcw.control = "10"b; tdcwp = addr (wseg.tdcw); /* Get pointer to transfer DCW. */ wseg.tdcw = "0"b; /* Clear the DCW. */ tdcw.address = bit (bin (0, 18)); /* Transfer back to beginning of list. */ tdcw.type = "10"b; /* Set type bits. */ sdb.running = "0"b; /* Indicate channel not running. */ sdb.wait_flag = "0"b; /* Turn off waiting for special flag. */ sdb.eof_flag = "1"b; /* Turn on EOF recognition mode */ sdb.iobegin, /* Set indices for I/O and data copying. */ sdb.iocur, sdb.movecur = 0; if punch then sdb.movestop = 32; else sdb.movestop = 0; sdb.marker_count = 0; /* Reset marker flag count. */ sdb.error_count = 0; /* Reset error count. */ sdb.card_count = 0; /* reset usage counter */ sdb.last_iom_stat = ""b; /* Reset last reported status */ sdb.print_message = "0"b; /* say no message to print */ sdb.message = ""; /* and clear the status message */ call ipc_$drain_chn (evchan, rcode); return; /* Return to caller */ free: substr (iostatus, 1, 36) = unspec (rcode); /* Return error code. */ go to detach_it; /* Now drop into detach code. */ crz_detach: entry (sdb_ptr, device, mode, iostatus); /* Detach entry point */ cpz_detach: entry (sdb_ptr, device, mode, iostatus); /* Detach entry point */ iostatus = ""b; /* clear the status */ detach_it: call ipc_$delete_ev_chn (evchan, rcode); /* Delete event channel */ call rcp_$detach (rcp_id, "0"b, error_count, "", rcode); if rcode ^= 0 then /* Attempt to detach the device. */ if substr (iostatus, 1, 36) = ""b then /* if not aborting an attach */ substr (iostatus, 1, 36) = unspec (rcode); /* Put error code in return iostatus */ area_ptr = sdb.areap; /* Get back pointer to allocation area. */ free sdb in (listen_based_area); /* Free-up allocated sdb */ exit: substr (iostatus, 52, 1) = "1"b; /* Set ioname detached bit */ substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ return; /* */ crz_read: entry (sdb_ptr, xwkspptr, offset, nelem, nelemt, iostatus); /* Read entry point */ /* This is the read loop for the Ohlin - Ammons card reader DIM */ rcode = 0; /* Clear error code. */ nelemt = 0; /* Zero elements transmitted to start */ wkspptr = addrel (xwkspptr, offset * 27); /* Copy pointer, and add in offset */ sdb.last_iom_stat = ""b; /* reset for each read */ sdb.wait_flag = "0"b; /* cancel last wait */ sdb.print_message = "0"b; /* and pending message */ do while (nelemt < nelem); /* Read as many cards as caller asked for */ iostop = mod (sdb.movecur - 1, 34); /* Compute stopping place for DCW list. */ if sdb.iocur ^= iostop then /* If more DCW's can be queued ... */ call set_io; /* Queue up some more I/O. */ else if sdb.movecur ^= sdb.movestop then do; /* If we have cards to move ... */ if eof_flag then /* Check if EOF recognition is turned on */ if wseg.buffer (movecur).words (1) = /* Check for multiple 5-7 punch in column 1 */ "002400000000"b3 | (wseg.buffer (movecur).words (1) = "401240124020"b3 /* Check for ++FOF */ & wseg.buffer (movecur).words (2) = "201040100000"b3) | (wseg.buffer (movecur).words (1) = "401240125020"b3 /* Check for ++eof */ & wseg.buffer (movecur).words (2) = "601050100000"b3) then do; substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ if nelemt = 0 then do; /* First time through, don't give EOF status. */ substr (iostatus, 46, 1) = "1"b; /* Set end-of-data bit */ movecur = mod (movecur + 1, 34); /* Now throw card away */ end; /* Note that EOF card is looked at twice */ substr (iostatus, 1, 36) = unspec (error_table_$eof_record); return; /* Return to caller */ end; /* End EOF recognized */ wkspptr -> workspace = /* Address where we are putting it */ addr (wseg.buffer (movecur)) -> workspace; /* Where it is in buffer */ wkspptr = addrel (wkspptr, 27); /* Update workspace pointer */ nelemt = nelemt + 1; /* Keep track of number of cards moved */ sdb.card_count = sdb.card_count + 1; /* and total cards */ movecur = mod (movecur + 1, 34); /* Increment data copy index. */ end; else call wait_io; /* Otherwise, wait for I/O completion. */ if rcode ^= 0 then do; substr (iostatus, 1, 36) = unspec (rcode); substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated. */ return; /* Return to caller immediately. */ end; end; return; /* Return to caller of crzcpz_read */ /* */ cpz_write: entry (sdb_ptr, xwkspptr, offset, nelem, nelemt, iostatus); /* Write entry point */ /* This is the write loop for the card punch DIM */ rcode = 0; /* Clear the error code. */ nelemt = 0; /* Zero elements transmitted to start */ wkspptr = addrel (xwkspptr, offset * 27); /* Copy pointer, and add in offset */ sdb.last_iom_stat = ""b; sdb.wait_flag = "0"b; /* cancel last wait */ sdb.print_message = "0"b; /* and pending message */ do while (nelemt < nelem); /* Write as many cards as caller asked for */ if movecur ^= movestop then do; /* If room for more cards ... */ addr (wseg.buffer (movecur)) -> workspace = /* Where data is going in buffer */ wkspptr -> workspace; /* Address where we are getting it from */ wkspptr = addrel (wkspptr, 27); /* Update workspace pointer */ nelemt = nelemt + 1; /* Keep track of number of cards moved */ sdb.card_count = sdb.card_count + 1; /* and total cards */ iocur = movecur; /* Set up DCW list for card just copied. */ call set_io; /* Patch new element into DCW list. */ movecur = iocur; /* Copy next card into next slot for I/O. */ end; else call wait_io; /* Otherwise, wait for I/O to complete. */ if rcode ^= 0 then do; substr (iostatus, 1, 36) = unspec (rcode); substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated. */ return; /* Return to caller immediately. */ end; end; return; /* Return to caller of cpz_write */ /* */ set_io: proc; /* procedure to set IDCW's to perform I/O */ ionext = mod (iocur + 1, 34); /* Compute place for terminate IDCW. */ dcwlist (ionext).idcw = term_idcw; /* Insert stopper first. */ dcwlist (iocur).idcw = io_idcw; /* Now insert I/O IDCW. */ if running then do; /* If channel is running ... */ marker_count = marker_count + 1; /* Bump the marker count. */ if marker_count >= 17 then do; /* Place a marker at half-way point. */ idcwp = addr (dcwlist (iocur).idcw); /* Get pointer to current IDCW. */ idcw.control = "11"b; /* Make IDCW store marker status. */ marker_count = 0; /* Reset the marker counter. */ end; end; iocur = ionext; /* Set index for next slot for I/O. */ if ^running then call start_io; /* Fire up the IOM. */ return; end set_io; /* */ start_io: proc; /* procedure to start up card I/O */ if ^wait_flag then if iocur ^= iobegin then do; /* If something to do ... */ marker_count = 0; /* Reset the marker count. */ running = "1"b; /* Turn on running flag. */ call ioi_$connect (devx, 2*iobegin, rcode); /* Fire up the IOM. */ end; return; end start_io; wait_io: proc; /* procedure to wait for card I/O */ if ^sdb.running then /* If channel is idle ... */ call start_io; /* Give it something to do. */ call ipc_$read_ev_chn (sdb.evchan, ev_done, addr (ipc_message), rcode); if rcode ^= 0 then do; bad_ipc: call convert_ipc_code_ (rcode); return; end; if ev_done = 0 then do; /* no event yet, print pending message and block */ if sdb.print_message then do; /* if waiting, tell why once */ call com_err_ (0, name, sdb.message); sdb.print_message = "0"b; end; call ipc_$block (addr (sdb.ev_list), addr (ipc_message), rcode); if rcode ^= 0 then go to bad_ipc; end; call stat_check; /* Examine status. */ return; end wait_io; /* */ stat_check: proc; /* Card I/O status check entry */ dcl lx fixed bin, flags bit (18) aligned; flags = "0"b; /* Clear flags. */ imp = addr (ipc_message.message); /* Get address of ioi status message */ if imess.level = "111"b then do; /* If this is a special interupt... */ wait_flag = "0"b; /* Reset this in case waiting for special */ return; /* And all done */ end; if imess.st then do; /* If status is really present */ if imess.time_out then do; /* if termination caused by a time out */ rcode = error_table_$net_timeout; /* this is a reasonable error */ running = "0"b; /* not running any more */ return; end; temp_iom_stat = imess.status; /* make a double word iom_stat */ if bin (imess.level) <= 5 then do; /* If system fault, terminate, or marker ... */ if imess.er then /* If error occurred ... */ if imess.level = "001"b then do; /* If system fault ... */ call analyze_system_fault_ (name, temp_iom_stat); sdb.message = "Waiting for interrupt after last system fault error."; sdb.print_message = "0"b; /* print this later if needed */ sdb.last_iom_stat = ""b; sdb.error_count = sdb.error_count + 1; /* add them up */ sdb.wait_flag = "1"b; /* wait for special status */ end; else do; /* Must be terminate status. */ call analyze_device_stat_$rs (sdb.message, stat_tablep, temp_iom_stat, flags); /* Analyze the status. */ sdb.wait_flag = (flags & halt_flag) ^= "0"b; /* Set wait flag based on examined status. */ if flags & report_flag then do; /* should we report this */ sdb.error_count = sdb.error_count + 1; if (temp_iom_stat & dev_stat_bits) ^= sdb.last_iom_stat then do; sdb.last_iom_stat = (temp_iom_stat & dev_stat_bits); /* save a message */ if ^sdb.wait_flag then do; call com_err_ (0, name, sdb.message); sdb.print_message = "0"b; /* say message was printed */ end; else sdb.print_message = "1"b; /* print message unless returning */ end; end; else sdb.print_message = "0"b; /* suppress the message */ end; lx = bin (imess.offset); /* Copy list index for this status */ if flags & backup_flag then lx = lx - mod (lx, 2); /* If backup flag ON, go back to IDCW. */ iobegin = mod (divide (lx + 1, 2, 17, 0), 34); /* Compute place to start next block of I/O. */ if punch then do; /* If running punch ... */ movestop = mod (iobegin - 2, 34); /* Set place for stopping data copy. */ if flags & punch_alert_flag then /* If punch alert ... */ iobegin = mod (iobegin - 1, 34); /* Back up still one more card. */ end; else movestop = iobegin; /* For reader, set place for stopping data copy. */ running = imess.run; /* Indicate if channel still running. */ end; end; return; end stat_check; crz_setsize: entry (sdb_ptr, element_size, iostatus); /* Set size entry point */ cpz_setsize: entry (sdb_ptr, element_size, iostatus); /* Set size entry point */ if element_size ^= 972 then /* 972 bits equals 27 words */ substr (iostatus, 1, 36) = unspec (error_table_$invalid_elsize); /* Send message */ else substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ return; /* Return to caller */ crz_getsize: entry (sdb_ptr, element_size, iostatus); /* Get size entry point */ cpz_getsize: entry (sdb_ptr, element_size, iostatus); /* Get size entry point */ element_size = 972; /* Set element size */ iostatus = "0"b; /* Zero iostatus string */ substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ return; /* Return to caller */ crz_changemode: entry (sdb_ptr, new_mode, old_mode, iostatus); /* Change mode entry point */ old_mode = "r"; /* Set old mode */ iostatus = "0"b; /* Zero iostatus string */ substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ if new_mode ^= "" & new_mode ^= "r" then /* Check for legal mode */ substr (iostatus, 1, 36) = unspec (error_table_$invalid_write); return; /* Return to caller */ cpz_changemode: entry (sdb_ptr, new_mode, old_mode, iostatus); /* Change mode entry point */ old_mode = "w"; /* Set old mode */ iostatus = "0"b; /* Zero iostatus string */ substr (iostatus, 41, 1) = "1"b; /* Set transaction terminated bit */ if new_mode ^= "" & new_mode ^= "w" then /* Check for legal mode */ substr (iostatus, 1, 36) = unspec (error_table_$invalid_read); return; /* Return to caller */ crz_resetread: entry (sdb_ptr, iostatus); /* Resetread entry point. */ iostatus = "0"b; do while (running); /* Wait until channel stops. */ call wait_io; end; wait_flag = "0"b; /* Now, reset the waiting for special flag. */ iobegin, /* Reset all indices. */ iocur, movestop, movecur = 0; return; crz_order: entry (sdb_ptr, request, orderp, iostatus); /* Order entry point */ dcl request char (*); /* order request */ iostatus = "0"b; if request = "eof_off" | request = "off" then /* Check for off message */ do; eof_flag = "0"b; /* Turn off the flag */ out: substr (iostatus, 41, 1) = "1"b; /* Set terminate iostatus */ return; end; if request = "eof_on" | request = "on" then do; eof_flag = "1"b; /* Turn the flag on */ goto out; end; /* If we get here - "request" was not valid */ substr (iostatus, 1, 36) = unspec (error_table_$undefined_order_request); go to out; cpz_order: entry (sdb_ptr, request, orderp, iostatus); /* Order entry point */ iostatus = "0"b; if request = "runout" then do; /* To run out the remaining cards in buffer. */ wait_flag = "0"b; /* Turn off wait flag. */ do while (iocur ^= iobegin); /* Try until all remaining cards are punched. */ call wait_io; if rcode ^= 0 then do; substr (iostatus, 1, 36) = unspec (rcode); go to out; end; end; go to out; end; if request = "get_error_count" then do; if orderp = null then do; /* bad news for this entry */ substr (iostatus, 1, 36) = unspec (error_table_$no_operation); go to out; end; ret_error_count = sdb.error_count; /* give it to the caller */ go to out; /* and we are done */ end; if request = "reset" then do; /* reset the card counter */ sdb.card_count = 0; go to out; end; if request = "get_count" then do; /* report the number of cards punched */ if orderp = null then do; /* bad news for this entry */ substr (iostatus, 1, 36) = unspec (error_table_$no_operation); go to out; end; unspec (counts) = ""b; /* clear everything */ counts.line_count = sdb.card_count; /* assume one card equals one line */ go to out; end; /* if we pass here, the order is not defined */ substr (iostatus, 1, 36) = unspec (error_table_$undefined_order_request); go to out; end;  flipper_.alm 11/15/82 1807.9rew 11/15/82 1531.8 10782 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the flipper outer module. " " " " " " " " " " name flipper_ entry flipper_module,flippermodule segref card_dim,card_attach,card_detach segref card_dim,card_changemode,card_order segref flipper_dim,flipper_write,flipper_getsize segref ios_,no_entry flipper_module: flippermodule: tra *+1,6 tra card_attach tra card_detach tra no_entry tra flipper_write tra no_entry tra card_order tra no_entry tra no_entry tra no_entry tra flipper_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra card_changemode tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end flipper_  flipper_dim.pl1 11/15/82 1807.9rew 11/15/82 1458.4 35343 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* Flip cards "outer module". Assumes card_out_stream attached to punch and creates and punches flip card(s) for specified number of characters coded by MAP, 3/70 */ /* Modified by J. Stern on 7/29/71 to add standard SDB declaration and to delete "flipper_attach" and "flipper_detach" entry points. Common attach and detach entry points for all card pseudo-DIMs are now in card_dim. */ /* Last modified 6/27/75 by Noel I. Morris */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ flipper_write: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); dcl wksp ptr, /* pointer to caller's workspace */ off fixed bin, /* offset of caller's data */ nel fixed bin, /* number of elements to transmit */ nelt fixed bin, /* number of elements actually transmitted */ iostatus bit (72) aligned; /* status bits */ dcl nleft fixed bin, /* number of elements remaining to transmit */ in ptr, /* input pointer */ out ptr, /* output pointer */ len fixed bin, /* length of data on each iteration */ pos fixed bin, /* cell position on flip card */ num fixed bin (9), /* numeric value of ASCII character */ i fixed bin, /* character index */ j fixed bin; /* cell index */ dcl ios_$write ext entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl card (0:159) bit (6) unal; /* flip card cells */ dcl wks char (nleft) based unal; /* caller's workspace */ dcl fliptab$flip_codes (0:127, 0:5) bit (6) ext unaligned; dcl (addr, bin, min, substr, unspec) builtin; /* */ % include card_sdb; /* */ iostatus = "0"b; /* Clear status bits. */ out = addr (card); /* Get pointer to flip card image. */ in = addr (substr (wksp -> wks, off+1)); /* Get pointer to caller's data. */ nelt = 0; /* Initialize count of elements transmitted. */ do nleft = nel by -22 while (nleft > 0); /* Process 22 characters at a time. */ card = "0"b; /* Clear the card image. */ card (1), card (159) = "000101"b; /* Insert 7-9 punches in columns 1 and 80. */ pos = 154; /* Set position of first cell. */ len = min (22, nleft); /* Take up to 22 characters. */ do i = 0 to len - 1; /* Process each character. */ num = bin (unspec (substr (in -> wks, i+1, 1)), 9); /* Grab a character and convert to binary. */ do j = 0 to 5; /* Fill in cells to make flip character. */ card (pos) = fliptab$flip_codes (num, j); pos = pos - 2; /* Chars go from right to left so card can be flipped. */ end; pos = pos - 2; /* Leave some blank space. */ if pos <= 0 then pos = pos + 155; /* After 11 characters, do bottom row. */ end; call ios_$write (stream, out, 0, 1, j, iostatus); if substr (iostatus, 1, 36) then return; nelt = nelt + len; /* Increment elements transmitted. */ in = addr (substr (in -> wks, len+1)); /* Step input pointer. */ end; return; /* */ flipper_getsize: entry (sdb_ptr, size, iostatus); dcl size fixed bin; iostatus = "0"b; size = 9; /* Works with 9-bit elements only */ return; end flipper_write;  fliptab.alm 11/15/82 1807.9rew 11/15/82 1532.3 25767 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** name fliptab segdef flip_codes flip_codes: oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 000000000000 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 000004102000 oct 000412210000 oct 002112040000 oct 777777777700 oct 777777777700 oct 777777777700 oct 000404040000 oct 000303030000 oct 010204102000 oct 162121211600 oct 001000370000 oct 232525253500 oct 212525253700 oct 340404043700 oct 352525252200 oct 370505050700 oct 202122243000 oct 122525251200 oct 342424243700 oct 777777777700 oct 777777777700 oct 040012002100 oct 777777777700 oct 210012000400 oct 777777777700 oct 777777777700 oct 372424243700 oct 372525251200 oct 372121212100 oct 372121211600 oct 372525252100 oct 372424242000 oct 372121252700 oct 370404043700 oct 212137212100 oct 030101013700 oct 370404122100 oct 370101010100 oct 371004103700 oct 371004023700 oct 372121213700 oct 372424243400 oct 372125233700 oct 372424263500 oct 352525252700 oct 202037202000 oct 370101013700 oct 300601063000 oct 370204023700 oct 211204122100 oct 201007102000 oct 212725352100 oct 372121000000 oct 777777777700 oct 000021213700 oct 777777777700 oct 010101010100 oct 777777777700 oct 372424243700 oct 372525251200 oct 372121212100 oct 372121211600 oct 372525252100 oct 372424242000 oct 372121252700 oct 370404043700 oct 212137212100 oct 030101013700 oct 370404122100 oct 370101010100 oct 371004103700 oct 371004023700 oct 372121213700 oct 372424243400 oct 372125233700 oct 372424263500 oct 352525252700 oct 202037202000 oct 370101013700 oct 300601063000 oct 370204023700 oct 211204122100 oct 201007102000 oct 212725352100 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 oct 777777777700 end  mcc_.alm 11/15/82 1807.9rew 11/15/82 1531.9 10557 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the mcc outer module. " " " " " " " " " " name mcc_ entry mcc_module,mccmodule segref card_dim,card_attach,card_detach segref card_dim,card_order segref mcc_dim,mcc_read,mcc_write segref mcc_dim,mcc_changemode,mcc_getsize segref ios_,no_entry mcc_module: mccmodule: tra *+1,6 tra card_attach tra card_detach tra mcc_read tra mcc_write tra no_entry tra card_order tra no_entry tra no_entry tra no_entry tra mcc_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra mcc_changemode tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end mcc_  mcc_dim.pl1 11/15/82 1807.9rew 11/15/82 1458.5 73269 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* "Outer module" to read Multics card codes. Major facelifting of a Ken Thompson original by MAP, 12/69. Deals only with character (9 bit) elements; if 80 or less requested, will read one card; if >80 requested, will read number of cards necessary to get nel. Assumes reader attached. . */ /* Last modified by J. Stern on 7/29/71 to add standard SDB declaration and to delete "mcc_attach" and "mcc_detach" entry points. Common attach and detach entry points for all card pseudo-DIMs are now in raw_dim. */ /* Rewritten 6/27/75 by Noel I. Morris */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ mcc_read: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); dcl wksp ptr, /* ptr to caller's workspace */ off fixed bin, /* offset of data */ nel fixed bin, /* number of elements to transmit */ nelt fixed bin, /* number actually transmitted */ iostatus bit (72) aligned; /* status bits */ dcl i fixed bin, /* index */ code fixed bin (35), /* error code */ j fixed bin, /* count of cards punched or read */ cardx fixed bin, in ptr, /* input pointer */ out ptr, /* output pointer */ len fixed bin, /* length of caller's string */ nleft fixed bin, /* number of characters left to transmit */ character char (1) aligned, /* single ASCII character */ num fixed bin, /* translation table index */ zone fixed bin (3), /* zone bits */ one_seven bit (7) aligned, /* rows 1 thru 7 */ eight_nine fixed bin (2), /* rows 8 and 9 */ illeg_char bit (1) aligned, /* "1"b if illegal character code read */ NL char (1) static init (" "); dcl 1 raw aligned, /* raw column binary card image */ 2 col (1:80) bit (12) unal, /* 80 columns */ 2 pad bit (12) unal; /* padding to word boundary */ dcl card_image char (80) ; /* ASCII card image */ dcl wks char (nleft) based unal; /* used to reference caller's workspace */ dcl card_codes_$mcc_reader_codes (0:255) char (1) unal ext, /* reader translation table */ card_codes_$mcc_punch_codes (0:127) bit (12) unal ext, /* punch translation table */ error_table_$eof_record fixed bin (35) ext, error_table_$short_record fixed bin (35) ext; dcl ios_$read entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl (addr, bin, index, min, substr, unspec, length, divide) builtin; /* */ % include card_sdb; /* */ iostatus = "0"b; /* Clear status bits. */ in = addr (raw); /* Set input pointer. */ out = addr (substr (wksp -> wks, off+1)); /* Get pointer into caller's workspace. */ nelt = 0; /* Initialize number of chars xmitted. */ nleft = nel; do cardx = 1 to divide (nel + 79, 80, 17, 0); /* Read a card. */ call ios_$read (stream, in, 0, 1, j, iostatus); /* Read a card. */ if substr (iostatus, 1, 36) & substr (iostatus, 1, 36) ^= unspec (error_table_$eof_record) then do; bad_read: substr (iostatus, 46, 1) = "0"b; /* Make sure trouble is noticed */ return; end; if j = 0 then /* If nothing was read ... */ if substr (iostatus, 46, 1) then return; else go to bad_read; /* Convert column binary to ASCII card image. */ card_image = ""; /* initialize to all blank */ do i = 1 to 80; /* Process 80 columns. */ zone = bin (substr (raw.col (i), 1, 3), 3); /* Get zone bits. */ one_seven = substr (raw.col (i), 4, 7); /* Get rows 1 thru 7. */ eight_nine = bin (substr (raw.col (i), 11, 2)); /* Get rows 8 and 9. */ illeg_char = "0"b; /* Clear illegal punch flag. */ if one_seven then do; /* If any punches in rows 1 thru 7 ... */ num = index (one_seven, "1"b); /* Look for a punch. */ if substr (one_seven, num+1) then /* Must only be one punch. */ illeg_char = "1"b; /* Otherwise, punch is illegal. */ else num = 8 - num; /* Compute index from punch. */ end; else /* If no punches in rows 1 thru 7 ... */ num = 0; /* Index is 0. */ if illeg_char then /* If punch was illegal ... */ unspec (character) = (9)"1"b; /* Use ASCII 777 for this case. */ else do; num = (zone * 8 + num) * 4 + eight_nine; /* Compute index from punches. */ character = card_codes_$mcc_reader_codes (num); end; /* Get correct character from table. */ substr (card_image, i, 1) = character; /* Insert character in ASCII card image. */ end; len = length (card_image); /* Copy card image into caller's workspace. */ len = min (len, nleft); /* Copy as much as caller has room for. */ substr (out -> wks, 1, len) = card_image; /* Copy the card image. */ nelt = nelt + len; /* Count these chars as being transmitted. */ nleft = nleft - len; out = addr (substr (out -> wks, len+1)); /* Step output pointer. */ end; if nel ^= nelt then substr (iostatus, 1, 36) = unspec (error_table_$short_record); return; mcc_write: entry (sdb_ptr, wksp, off, nel, nelt, iostatus); iostatus = "0"b; /* Clear status bits. */ out = addr (raw); /* Set output pointer. */ in = addr (substr (wksp -> wks, off+1)); /* Get pointer into caller's workspace. */ nelt = 0; /* Clear count of chars transferred. */ raw.pad = "0"b; /* Clear padding in column binary card image. */ do nleft = nel repeat nleft - len while (nleft > 0); /* Process characters until exhausted. */ /* Examine input to get a line or 80 characters, whichever is shortest. */ i = index (in -> wks, NL); /* Search for end of line in input. */ if i = 0 then /* If no NL can be found ... */ i, len = min (80, nleft); /* Take up to 80 characters. */ else if i > 81 then /* If line too long ... */ i, len = 80; /* Take only 80 characters. */ else do; len = i; /* NL can be no further than 81 chars into string. */ i = len - 1; /* We do not copy the NL. */ end; /* Copy the input and convert to column binary card image. */ card_image = (81)" "; /* initialize to all blank */ card_image = substr (in -> wks, 1, i); /* Copy up to but not including NL. */ do i = 1 to 80; /* Process each column. */ character = substr (card_image, i, 1); /* Extract a character. */ num = bin (unspec (character), 9); /* Convert to binary integer. */ raw.col (i) = card_codes_$mcc_punch_codes (num); end; /* Look up and insert column binary punches. */ /* Write out the card and step to next one. */ call ios_$write (stream, out, 0, 1, j, iostatus); /* Write out the card. */ if substr (iostatus, 1, 36) ^= "0"b | j = 0 then do; /* If error ... */ substr (iostatus, 46, 1) = "0"b; return; end; nelt = nelt + len; /* Increment count of characters transferred. */ in = addr (substr (in -> wks, len+1)); /* Step pointer to next line. */ end; return; mcc_getsize: entry (sdb_ptr, el_size, iostatus); dcl el_size fixed bin; iostatus = "0"b; /* Clear status bits. */ el_size = 9; /* Size is 9 bits. */ return; mcc_changemode: entry (sdb_ptr, new_mode, old_mode, iostatus); dcl new_mode char (*), /* new mode setting */ old_mode char (*); /* old mode setting */ old_mode = ""; iostatus = "0"b; return; end mcc_read;  raw_.alm 11/15/82 1807.9rew 11/15/82 1532.0 10431 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the raw outer module. " " " " " " " " " " name raw_ entry raw_module,rawmodule segref card_dim,card_attach,card_detach segref card_dim,card_changemode,card_order segref raw_dim,raw_read,raw_write,raw_getsize segref ios_,no_entry raw_module: rawmodule: tra *+1,6 tra card_attach tra card_detach tra raw_read tra raw_write tra no_entry tra card_order tra no_entry tra no_entry tra no_entry tra raw_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra card_changemode tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end raw_  raw_dim.pl1 11/15/82 1807.9rew 11/15/82 1458.3 34776 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* "Outer module" of peripheral package to return "raw" (unconverted) data from the card reader. coded by MAP, 12/69. */ /* Last modified by J. Stern on 8/1/71 to add standard SDB declaration and to reject attempted multiple attachments. */ /* Last modifier 6/27/75 by Noel I. Morris */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ raw_read: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); dcl wksp ptr, /* pointer to caller's workspace */ off fixed bin, /* offset into caller's workspace */ nel fixed bin, /* number of elements to be transmitted */ nelt fixed bin, /* number of elements actually transmitted */ iostatus bit (72) aligned; /* status bits */ dcl nleft fixed bin, /* elements remaining to be transferred */ in ptr, /* input pointer */ out ptr, /* output pointer */ j fixed bin; /* elements transmitted from reader or to punch */ dcl raw_card bit (972) aligned; /* buffer for raw card */ dcl wks (0:1) bit (960) based unal; /* caller's workspace */ dcl error_table_$eof_record ext fixed bin(35); dcl ios_$read entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl (addr, substr) builtin; /* */ % include card_sdb; /* */ iostatus = "0"b; /* Clear status bits. */ in = addr (raw_card); /* Set input pointer. */ out = addr (wksp -> wks (off)); /* Set output pointer. */ nelt = 0; /* clear elements transmitted. */ do nleft = nel by -1 while (nleft > 0); /* Handle one elements at a time. */ call ios_$read (stream, in, 0, 1, j, iostatus); if substr (iostatus, 1, 36) & substr(iostatus, 1, 36) ^= unspec(error_table_$eof_record) then do; bad_read: substr (iostatus, 46, 1) = "0"b; return; end; if j = 0 then if substr (iostatus, 46, 1) then return; else go to bad_read; out -> wks (0) = raw_card; /* Copy the card. */ nelt = nelt + 1; /* Count one element transmitted. */ out = addr (out -> wks (1)); /* Step output pointer. */ end; return; /* */ raw_write: entry (sdb_ptr, wksp, off, nel, nelt, iostatus); iostatus = "0"b; /* Clear status bits. */ out = addr (raw_card); /* Set output pointer. */ in = addr (wksp -> wks (off)); /* Set input pointer. */ nelt = 0; /* Clear count of elements transmitted. */ do nleft = nel by -1 while (nleft > 0); /* Handle one element at a time. */ raw_card = in -> wks (0); /* Copy one element. */ call ios_$write (stream, out, 0, 1, j, iostatus); if substr (iostatus, 1, 36) ^= "0"b | j = 0 then do; substr (iostatus, 46, 1) = "0"b; return; end; nelt = nelt + 1; /* Count one element transmitted. */ in = addr (in -> wks (1)); /* Step input pointer. */ end; return; /* */ raw_getsize: entry (sdb_ptr, el_size, iostatus); dcl el_size fixed bin; /* element size */ iostatus = "0"b; el_size = 960; /* Element size is one raw card image. */ return; end raw_read;  viipunch_.alm 11/15/82 1807.9rew 11/15/82 1532.0 11250 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " This is the I/O switch transfer vector for the viipunch outer module. " " " " " " " " " " name viipunch_ entry viipunch_module,viipunchmodule segref card_dim,card_attach,card_detach segref card_dim,card_changemode,card_order segref viipunch_dim,viipunch_read,viipunch_write segref viipunch_dim,viipunch_getsize segref ios_,no_entry viipunch_module: viipunchmodule: tra *+1,6 tra card_attach tra card_detach tra viipunch_read tra viipunch_write tra no_entry tra card_order tra no_entry tra no_entry tra no_entry tra viipunch_getsize tra no_entry tra no_entry tra no_entry tra no_entry tra card_changemode tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry tra no_entry end viipunch_  viipunch_dim.pl1 11/15/82 1807.9rew 11/15/82 1458.4 99819 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* "Outer module" to read 7punch decks. Reads to EOF card, returns number of elements as bits. See CTSS manual for 7punch format. coded by MAP, 1/70 */ /* updated for new io switch, MAP, 3/70 */ /* Modified by B. Greenberg 3/73 for accepting previously mispunched decks, punching correct tag fields, and decimal sequence field in cols. 76-80 */ /* Modified by J. Stern on 7/29/71 to add standard SDB declaration and to delete "viipunch_attach" and "viipunch_detach" entry points. Common attach and detach entry points for all card pseudo-DIMs are now in card_dim. */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ viipunch_read: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); dcl dsb_ptr ptr, /* pointer to stream data block */ wksp ptr, /* pointer to caller's workspace */ off fixed bin (24), /* offset into caller's workspace */ nel fixed bin (24), /* number of elements to transmit */ nelt fixed bin (24), /* number of elements actually transmitted */ iostatus bit (72) aligned; /* IOS_ status bits */ dcl last_sw bit (1) aligned, /* non-zero after reading last card */ in ptr, /* input pointer */ out ptr, /* output pointer */ seqno fixed bin (15), /* card sequence number */ nleft fixed bin (24), /* number of elements left to transfer */ bad_tag_sw bit (1) aligned, /* to fix cards mangled by Padlipsky */ wdct bit (12) aligned, /* word count on card */ len fixed bin, /* data copy length */ i fixed bin, /* iteration variable */ j fixed bin, /* useful variable */ len2 fixed bin, /* used for repeated data */ bitcnt fixed bin (24), /* bit count of 7punch deck */ same_sw bit (1) aligned, /* used to detect repeated data */ number fixed bin, /* for computing sequence number field */ tenth fixed bin; /* for computing sequence number field */ dcl wks bit (nleft) unal based; /* caller's workspace */ dcl 1 card aligned, /* 7punch card declaration */ 2 w0, /* first word */ (3 seven bit (3), /* "111"b */ 3 cnthi bit (6), /* high-order word count */ 3 five bit (3), /* "101"b */ 3 cntlo bit (6), /* low-order word count */ 3 tag bit (3), /* non-zero on last card */ 3 seq bit (15)) unal, /* card sequence number */ 2 cksm bit (36), /* checksum */ 2 data bit (792), /* data words */ (2 blank (3) bit (12), /* blank field */ 2 id (5) bit (12)) unal; /* sequence number field */ dcl error_table_$eof_record ext fixed bin(35); dcl ios_$read entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), com_err_ entry options (variable), check_cd entry (ptr) returns (bit (36) aligned); dcl (addr, divide, bin, bit, length, min, string, substr, unspec) builtin; /* */ % include card_sdb; /* */ iostatus = "0"b; /* Clear status bits. */ in = addr (card); /* Set input pointer to card image. */ out = addr (substr (wksp -> wks, off+1)); /* Set output pointer into caller's workspace. */ nelt = 0; /* Initialize count of elements transmitted. */ last_sw = "0"b; /* Clear last card switch. */ seqno = 0; /* Initialize card sequence number. */ nleft = nel; /* Get number of elements remaining to be transmitted. */ do while (nleft > 0); /* Loop, reading cards. */ call read_7_card; /* Read and check a card. */ if seqno = 0 then if card.tag then /* If first card ... */ bad_tag_sw = "1"b; /* It should not have non-zero tag. */ else bad_tag_sw = "0"b; wdct = card.cnthi || card.cntlo; /* Get word count. */ len = min (bin (wdct, 12) * 36, nleft); /* Compute elements to be taken from card. */ if len = 0 then /* If zero word count ... */ if card.tag = "011"b then do; /* If this is a bit count card ... */ nelt = bin (substr (card.data, 1, 36), 35); last_sw = "1"b; /* Return correct element count and set switch. */ end; else if bad_tag_sw | (card.tag = "000"b) then do; call com_err_ (0, "viipunch_read", "Zero word count on card ^d.", seqno); go to error_return; /* Should never have zero word count otherwise. */ end; else; else if len <= length (card.data) then /* If data is on card ... */ substr (out -> wks, 1, len) = card.data;/* Copy it into caller's workspace. */ else do j = 0 to len by 36; /* Otherwise, copy repeated word. */ len2 = min (36, len - j); /* Compute elements to transfer. */ substr (out -> wks, j+1, len2) = card.data; end; /* Copy single word. */ nleft = nleft - len; /* Decrement count of elements left. */ out = addr (substr (out -> wks, len+1)); /* Bump pointer into caller's workspace. */ nelt = nelt + len; /* Return count of elements transmitted so far. */ if ^bad_tag_sw then /* If not ignoring bad tags ... */ if card.tag & "001"b then /* If card has non-zero tag ... */ last_sw = "1"b; /* Set last card switch. */ seqno = seqno + 1; /* Bump card sequence number. */ end; return; /* */ read_7_card: proc; call ios_$read (stream, in, 0, 1, j, iostatus); /* Read one card. */ if substr (iostatus, 1, 36) & substr(iostatus, 1, 36) ^= unspec(error_table_$eof_record) then do; bad_read: substr (iostatus, 46, 1) = "0"b; /* Clear this bit. */ go to error_return; /* And take error return. */ end; if j = 0 then /* If no elements were read ... */ if substr (iostatus, 46, 1) then /* Did we get an EOF? */ if last_sw then /* Was it expected? */ go to reof; /* If so, transfer. */ else do; /* Unexpected EOF. */ call com_err_ (0, "viipunch_read", "Premature EOF after card ^d.", seqno - 1); go to bad_read; end; else go to bad_read; /* Read zero cards. */ if last_sw then do; /* Should have gotten EOF after last read. */ call com_err_ (0, "viipunch_read", "Missing EOF after card ^d.", seqno - 1); go to bad_read; end; if card.seven ^= "111"b | card.five ^= "101"b then do; call com_err_ (0, "viipunch_read", "Non 7-punched card after card ^d.", seqno - 1); go to bad_read; end; if bin (card.seq, 15) ^= seqno then do; /* If sequence error ... */ call com_err_ (0, "viipunch_read", "Card sequence error. Expected ^d; read ^d.", seqno, bin (card.seq, 15)); go to bad_read; end; if card.cksm then /* If checksum is not blank ... */ if card.cksm ^= check_cd (in) then do; /* Compre against computed checksum. */ call com_err_ (0, "viipunch_read", "Checksum error on card ^d.", seqno); go to bad_read; end; return; end read_7_card; /* */ viipunch_write: entry (sdb_ptr, wksp, off, nel, nelt, iostatus); iostatus = "0"b; /* Clear status bits. */ out = addr (card); /* Set output pointer. */ in = addr (substr (wksp -> wks, off+1)); /* Set input pointer. */ nelt = 0; /* Initialize count of elements transmitted. */ string (card.w0) = "0"b; /* Clear first word in card image. */ card.seven = "111"b; /* Set 7punch bits. */ card.five = "101"b; /* Set 7-9 punch. */ string (card.blank) = "0"b; /* Clear blank field. */ seqno = 0; /* Initialize sequence number. */ bitcnt, nleft = nel; /* Set number of elements remaining to be transmitted. */ do while (nleft > 0); /* Iterate until all elements processed. */ len = min (length (card.data), nleft); /* Compute number of elements to process. */ card.data = substr (in -> wks, 1, len); /* Copy the data. */ in = addr (substr (in -> wks, len+1)); /* Bump input pointer. */ nleft = nleft - len; /* Decrement elements remaining to be transmitted. */ if substr (card.data, 1, length (card.data)-36) = substr (card.data, 37) then do; same_sw = "1"b; /* If data is replicated on card ... */ do while (same_sw & (nleft > 0)); /* Search to end of replication. */ len2 = min (36, nleft); /* Compute number of elements to test. */ if substr (in -> wks, 1, len2) = substr (card.data, 1, 36) then do; len = len + len2; /* Data still replicated. Skip over it. */ in = addr (substr (in -> wks, len2+1)); nleft = nleft - len2; end; else /* Data no longer replicated. */ same_sw = "0"b; /* Clear replication switch. */ end; end; wdct = bit (divide (len + 35, 36, 12, 0)); /* Compute word count for card. */ card.cnthi = wdct; /* Set high order part of word count. */ card.cntlo = substr (wdct, 7); /* And low order part. */ call write_7_card; /* Write out the card. */ nelt = nelt + len; /* Bump elements transmitted. */ end; card.cnthi, card.cntlo = "0"b; /* Clear word count. */ card.data = bit (bin (bitcnt, 36)); /* Set bitcount on card. */ card.tag = "011"b; /* Set tag indicating bitcount card. */ call write_7_card; /* Write out the bit count card. */ return; /* */ write_7_card: proc; card.seq = bit (bin (seqno, 15)); /* Set the sequence number on card. */ card.cksm = check_cd (out); /* Insert the checksum. */ number = seqno; /* Set sequence number for ID field. */ string (card.id) = "0"b; /* Clear the ID field. */ do i = 5 to 1 by -1; /* Convert each digit to column binary representation. */ tenth = divide (number, 10, 17, 0); /* Compute number of 10's. */ j = number - tenth * 10; /* Get a digit. */ substr (card.id (i), j+3, 1) = "1"b; /* Insert correct column binary bit. */ number = tenth; /* Iterate for next digit. */ end; call ios_$write (stream, out, 0, 1, j, iostatus); /* Write out the card image. */ if substr (iostatus, 1, 36) | j = 0 then do; /* Check for error. */ substr (iostatus, 46, 1) = "0"b; go to error_return; end; seqno = seqno + 1; /* Bump card sequence number. */ return; end write_7_card; /* */ error_return: reof: return; /* */ viipunch_getsize: entry (sdb_ptr, elsize, iostatus); dcl elsize fixed bin; /* element size */ iostatus = "0"b; /* Clear status bits. */ elsize = 1; /* Element size is 1 bit. */ return; end viipunch_read; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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