User Tools

Site Tools


cdc:nos2.source:opl871:ssbld

Table of Contents

SSBLD

Table Of Contents

  • [00001] PRGM SSBLD
  • [00004] SSBLD - MAIN ROUTINE OF SSBLD.
  • [00009] BUILD UDT FOR SSEXEC.
  • [00059] PROC ABORT
  • [00060] PROC BLTAB
  • [00061] PROC BZFILL
  • [00062] PROC GETPFP
  • [00063] PROC GETSPS
  • [00064] PROC MESSAGE
  • [00065] PROC NEXTLIN
  • [00066] PROC PFD
  • [00067] PROC RDSUDT
  • [00068] PROC RETERN
  • [00069] PROC RESTPFP
  • [00070] PROC WTBUDT
  • [00071] PROC XARG
  • [00263] PROC RDSUDT
  • [00266] RDSUDT - READ *SUDT* OR OTHER SPECIFIED FILE TO MEMORY.
  • [00271] RDSUDT - READ CONFIGURATION SOURCE FILE TO MEMORY.
  • [00353] PROC BZFILL
  • [00354] PROC MESSAGE
  • [00355] PROC NEXTLIN
  • [00356] PROC NEXTPRM
  • [00357] PROC READ
  • [00358] PROC READC
  • [00359] PROC READW
  • [00360] PROC RESTPFP
  • [00362] PROC RETERN
  • [00363] PROC REWIND
  • [00364] PROC UPDRDST
  • [00365] FUNC XDXB
  • [00366] PROC ZFILL
  • [00367] PROC ZSETFET
  • [01949] PROC NEXTLIN(DIRLINE,STAT,INDEX)
  • [01951] NEXTLIN - READ NEXT LINE OF CONFIGURATION SOURCE FILE.
  • [01983] PROC BZFILL
  • [01984] PROC MESSAGE
  • [01985] PROC READC
  • [01986] PROC RESTPFP
  • [01987] PROC ZFILL
  • [02099] PROC NEXTPRM(DIRLINE,SCOL,DEVTYPE,NUMCH,ORD,NCOL,STAT,TERMINATOR)
  • [02101] NEXTPRM - CRACK NEXT LINE OF SOURCE FILE DIRECTIVES.
  • [02155] PROC MESSAGE
  • [02156] PROC RESTPFP
  • [02157] FUNC XDXB
  • [02524] PROC UPDRDST(DRD,CONTORD)
  • [02526] UPDRDST - UPDATE DRD STATUS ACCORDING TO PATH STATUS
  • [02661] PROC WTBUDT
  • [02664] WTBUDT - WRITE SSBLD GENERATED UDT TO DISK FILE
  • [02694] PROC BZFILL
  • [02695] PROC MESSAGE
  • [02696] PROC RESTPFP
  • [02697] PROC RETERN
  • [02698] PROC REWIND
  • [02699] PROC WRITE
  • [02700] PROC WRITEF
  • [02701] PROC WRITER
  • [02702] PROC WRITEW
  • [02703] PROC ZFILL
  • [02704] PROC ZSETFET

Source Code

SSBLD.txt
  1. PRGM SSBLD;
  2.  
  3.  
  4. # TITLE SSBLD - MAIN ROUTINE OF SSBLD. #
  5.  
  6. BEGIN # SSBLD #
  7.  
  8. #
  9. *** SSBLD - BUILD UDT FOR SSEXEC.
  10. *
  11. * SSBLD ATTACHES THE FILE SPECIFIED BY THE CONTROL STATEMENT
  12. * CALL AND BUILDS A DIRECT ACCESS PERMANENT FILE - BUDT
  13. * UNDER USER INDEX 377760B.
  14. *
  15. *
  16. * SSBLD(PARAMETER1,PARAMTER2) - PARAMETERS ARE OPTIONAL.
  17. *
  18. * PARAMETER DESCRIPTION
  19. *
  20. * CF USE DIRECT ACCESS PERMANENT FILE *SUDT* UNDER
  21. * UI = 377760B AS INPUT FOR BUILDING THE UDT.
  22. *
  23. * CF=LFN USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER
  24. * UI = 377760B AS INPUT FOR BUILDING THE UDT.
  25. *
  26. * CF OMITTED SAME AS CF.
  27. *
  28. * BF USE DIRECT ACCESS PERMANENT FILE *BUDT* UNDER
  29. * UI = 377760B FOR DESTINATION BUDT FILE.
  30. *
  31. * BF=LFN USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER
  32. * UI = 377760B FOR DESTINATION BUDT FILE.
  33. *
  34. * BF OMITTED SAME AS BF.
  35. *
  36. * MESSAGES
  37. *
  38. * SSBLD ABORT - SYNTAX ERROR.
  39. * SSBLD - MUST BE SYSTEM ORIGIN.
  40. * SSBLD - CANNOT RE-ATTACH BUDT FILE.
  41. * SSBLD - NO SOURCE CONFIGURATION FILE.
  42. * SSBLD - SUDT FILE BUSY.
  43. * SSBLD - BUDT FILE BUSY.
  44. * SSBLD - UNABLE TO DEFINE BUDT FILE.
  45. * SSBLD - BUDT FILE PROBLEMS.
  46. * SSBLD - COMPLETE.
  47. *
  48. *
  49. *
  50. * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
  51. #
  52.  
  53. #
  54. **** PRGM SSBLD - XREF LIST BEGIN.
  55. #
  56.  
  57. XREF
  58. BEGIN
  59. PROC ABORT; # CALLS *ABORT* MACRO #
  60. PROC BLTAB; # SETS UP ARGUMENT LIST #
  61. PROC BZFILL; # BLANK OR ZERO FILL A BUFFER #
  62. PROC GETPFP; # GET USER INDEX AND FAMILY #
  63. PROC GETSPS; # GET SYSTEM ORIGIN PRIVILEDGES #
  64. PROC MESSAGE; # CALLS MESSAGE MACRO #
  65. PROC NEXTLIN; # READ NEXT LINE #
  66. PROC PFD; # *PFM* REQUEST INTERFACE #
  67. PROC RDSUDT; # READ CONFIGURATION FILE SOURCE #
  68. PROC RETERN; # RETURN A FILE #
  69. PROC RESTPFP; # RESTORE USER-S *PFP* #
  70. PROC WTBUDT; # WRITE UDT TO DISK FILE #
  71. PROC XARG; # CRACK PARAMETER LIST #
  72. END
  73.  
  74. #
  75. **** PRGM SSBLD - XREF LIST END.
  76. #
  77.  
  78. DEF SMMAX #"H"#; # MAXIMUM SM VALUE #
  79. DEF SMMIN #"A"#; # MINIMUM SM VALUE #
  80. DEF NOPARAM #-1#; # NO PARAMETER SPECIFIED #
  81. DEF PROCNAME #"SSBLD."#; # PROCEDURE NAME #
  82. DEF RSLEN #1#; # RETURN STATUS LENGTH #
  83. DEF SYNTAXOK #0#; # SYNTAX OK #
  84. DEF LISTCON #0#; # DO NOT LIST COMDECKS #
  85.  
  86. CONTROL PRESET;
  87. *CALL COMBFAS
  88. *CALL COMBBZF
  89. *CALL COMBCMD
  90. *CALL COMBCMS
  91. *CALL COMBPFP
  92. *CALL COMBUDT
  93. *CALL COMSPFM
  94. *CALL COMTBLD
  95. *CALL COMTBLP
  96.  
  97. ITEM ARGLIST U; # ADDRESS OF ARGUMENT TABLE #
  98. ITEM FLAG U; # ERROR FLAG FOR ASARG #
  99. ITEM OPTION I; # OPTION TO SKIP PROGRAM NAME #
  100.  
  101. ARRAY MSGDETAIL1 [0:0] P(4);
  102. BEGIN # ARRAY MSGDETAIL1 #
  103. ITEM LEAD1 C(00,00,01) = [" "]; # LEADING BLANK #
  104. ITEM MSGPFNH C(00,06,04) = ["PFN="]; # PFN= #
  105. ITEM MSGPFN C(00,30,07); # FILE NAME #
  106. ITEM MSGFAMH C(01,12,09) = [", FAMILY="]; # FAMILY = #
  107. ITEM MSGFAM C(02,06,08); # FAMILY AND COMMA #
  108. ITEM MSGZRO1 U(03,00,12) = [0]; # TERMINATOR #
  109. END # ARRAY MSGDETAIL1 #
  110.  
  111.  
  112. ARRAY SPSSTAT [0:0] S(RSLEN);
  113. BEGIN
  114. ITEM SPS$STATUS U(00,48,12); # RETURN STATUS #
  115. END
  116.  
  117. CONTROL EJECT;
  118.  
  119. #
  120. * GET SYSTEM ORIGIN PRIVILEDGES.
  121. #
  122.  
  123. GETSPS(SPSSTAT);
  124. IF SPS$STATUS NQ 0
  125. THEN
  126. BEGIN
  127. BLMSG$LN[0] = " SSBLD - MUST BE SYSTEM ORIGIN.";
  128. MESSAGE(BLMSG[0],SYSUDF1);
  129. ABORT; # ABORT #
  130. END
  131.  
  132. #
  133. * SAVE THE USER-S CURRENT FAMILY AND INDEX IN COMMON.
  134. #
  135.  
  136. GETPFP(PFP[0]);
  137. USER$FAM[0] = PFP$FAM[0];
  138. USER$UI[0] = PFP$UI[0];
  139.  
  140.  
  141. #
  142. * CRACK THE PARAMETERS ON THE *SSBLD* CALL.
  143. #
  144.  
  145. BLTAB(ARGLIST); # SET UP THE ARGUMENT LIST #
  146. OPTION = 0; # SKIP OVER PROGRAM NAME #
  147. XARG(ARGLIST,OPTION,FLAG); # CRACK THE PARAMETERS #
  148.  
  149. IF FLAG NQ SYNTAXOK
  150. THEN
  151. BEGIN
  152. BLMSG$LN[0] = " SSBLD ABORT - SYNTAX ERROR.";
  153. MESSAGE(BLMSG[0],SYSUDF1); # SYNTAX ERROR MESSAGE #
  154. RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
  155. END
  156.  
  157. #
  158. * ATTACH SSEXEC UDT SOURCE FILE.
  159. #
  160.  
  161. CFNAME = DARG$CF[0];
  162. BZFILL(CFNAME,TYPFILL"ZFILL",7); # ZERO FILL FILE NAME #
  163. BEGIN
  164. PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"NA",0,0);
  165. IF FLAG NQ OK
  166. THEN
  167. BEGIN # PROCESS ATTACH ERROR FLAG #
  168. IF FLAG EQ FBS
  169. THEN # SSEXEC UDT SOURCE FILE BUSY #
  170. BEGIN
  171. BLMSG$LN[0] = " SSBLD - SUDT FILE BUSY.";
  172. MESSAGE(BLMSG[0],SYSUDF1);
  173. RESTPFP(PFP$ABORT); # RETORE USER-S PFP AND ABORT #
  174. END
  175.  
  176. BEGIN
  177. BLMSG$LN[0] = " SSBLD - NO SOURCE CONFIGURATION FILE. ";
  178. MESSAGE(BLMSG[0],SYSUDF1);
  179. RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
  180. END
  181.  
  182. END # PROCESS ATTACH ERROR FLAG #
  183.  
  184. END
  185.  
  186. #
  187. * ATTACH SSEXEC UDT BINARY FILE.
  188. #
  189.  
  190. CFNAME = DARG$BF[0];
  191. BZFILL(CFNAME,TYPFILL"ZFILL",7);
  192. BEGIN
  193. PFD("ATTACH",CFNAME,0,"M","W","RC",FLAG,"NA",0,"PW",BUDTPW,0);
  194. IF FLAG NQ OK
  195. THEN
  196. BEGIN # PROCESS ATTACH ERROR FLAG #
  197. IF FLAG EQ FBS
  198. THEN # COMMUNICATION FILE BUSY #
  199. BEGIN
  200. BLMSG$LN[0] = " SSBLD - BUDT FILE BUSY.";
  201. MESSAGE(BLMSG[0],SYSUDF1);
  202. RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
  203. END
  204.  
  205. IF FLAG EQ FNF
  206. THEN # FILE DOES NOT EXIST #
  207. BEGIN
  208. PFD("DEFINE",CFNAME,0,"RC",FLAG,0,"PW",BUDTPW,0);
  209. IF FLAG NQ OK
  210. THEN # PROCESS DEFINE ERROR #
  211. BEGIN
  212. BLMSG$LN[0] = " SSBLD - UNABLE TO DEFINE BUDT FILE.";
  213. MESSAGE(BLMSG[0],SYSUDF1);
  214. RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
  215. END
  216.  
  217. END
  218.  
  219. ELSE # ABNORMAL TERMINATION #
  220. BEGIN
  221. BLMSG$LN[0] = " SSBLD - BUDT FILE PROBLEMS. ";
  222. MESSAGE(BLMSG[0],SYSUDF1);
  223. RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
  224. END
  225.  
  226. END # PROCESS ATTACH ERROR FLAG #
  227.  
  228. END
  229.  
  230. #
  231. * READ THE CONFIGURATION SOURCE FILE AND GENERATE UDT.
  232. #
  233.  
  234. RDSUDT;
  235.  
  236. #
  237. * WRITE THE UDT TO DISK.
  238. #
  239.  
  240. WTBUDT;
  241.  
  242. #
  243. * REATTACH UDT FILE, CLEANUP, AND EXIT.
  244. #
  245.  
  246. PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"PW",BUDTPW,0);
  247. IF FLAG NQ OK
  248. THEN # PERMANENT FILE PROBLEM #
  249. BEGIN
  250. BLMSG$LN[0] = " SSBLD - CANNOT RE-ATTACH BUDT FILE.";
  251. MESSAGE(BLMSG[0],SYSUDF1);
  252. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  253. END
  254.  
  255. RETERN(BL$FET[0],RCL);
  256. BLMSG$LN[0] = " SSBLD COMPLETE."; # SSBLD COMPLETE #
  257. MESSAGE(BLMSG[0],UDFL1);
  258. RESTPFP(PFP$END); # RESTORE USER-S *PFP* #
  259.  
  260. END # SSBLD #
  261.  
  262. TERM
  263. PROC RDSUDT;
  264.  
  265.  
  266. # TITLE RDSUDT - READ *SUDT* OR OTHER SPECIFIED FILE TO MEMORY. #
  267.  
  268. BEGIN # RDSUDT #
  269.  
  270. #
  271. ** RDSUDT - READ CONFIGURATION SOURCE FILE TO MEMORY.
  272. *
  273. * THIS PROCEDURE READS THE M860 CONFIGURATION SOURCE
  274. * FILE TO SSBLD-S MEMORY FOR INTERPRETATION PRIOR
  275. * TO SSBLD GENERATING THE *BUDT* FILE.
  276. * RDSUDT READS THE CONFIGURATION FILE ONE LINE AT
  277. * TIME. THESE STATEMENTS MUST APPEAR IN A SPECIFIED ORDER.
  278. * IF NOT, RDSUDT WILL ABORT THE JOB. THE ORDER IS:
  279. *
  280. * ALL *CU* STATEMENTS APPEAR FIRST.
  281. * ALL *CIF* STATEMENTS APPREAR NEXT.
  282. * ALL *DTI* STATEMENTS APPEAR NEXT.
  283. * ALL *DTO* STATEMENTS APPEAR NEXT.
  284. * ALL *DIF* STATEMENTS APPEAR NEXT.
  285. * ALL *DRC* STATEMENTS APPEAR NEXT.
  286. * ALL *DRD* STATEMENTS APPEAR NEXT.
  287. * ALL *AIF* STATEMENTS APPEAR NEXT.
  288. * ALL *SM* STATEMENTS APPEAR LAST.
  289. *
  290. * THE ABOVE STATEMENTS ARE THE ONLY LEGAL MNEMONIC
  291. * DESCRIPTORS ALLOWED. USE OF ANY OTHER DESCRIPTOR
  292. * WILL CAUSE *SSBLD* TO ABORT.
  293. *
  294. * AN ASTERISK (*) IN COLUMN ONE INDICATES A COMMENT
  295. * STATEMENT.
  296. *
  297. *
  298. * PROC RDSUDT.
  299. *
  300. * ENTRY NONE.
  301. *
  302. * EXIT CONFIGURATION SOURCE FILE READ TO MEMORY.
  303. * IT WILL BE SCANNED FOR SYNTACTICAL CORRECTNESS
  304. * AND CORRECT ORDER.
  305. *
  306. * MESSAGES
  307. *
  308. * RDSUDT - CONFIGURATION FILE EMPTY.
  309. * RDSUDT - INCORRECT *CU* COUNT.
  310. * RDSUDT - MISSING *SM* COUNT COMMAND.
  311. * RDSUDT - CAN-T CRACK *SM* COMMAND.
  312. * RDSUDT - CH/CIF CONFLICT.
  313. * RDSUDT - INCORRECT *SM* COUNT.
  314. * RDUSDT - NULL DIRECTIVE.
  315. * RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE.
  316. * RDSUDT - INCORRECT EST ORDINAL.
  317. * RDSUDT - *CU* ENTRY MISSING = SIGN.
  318. * RDSUDT - CHANNEL 0 NOT FIRST CHANNEL.
  319. * RDSUDT - MISSING CHANNELS ON *CU* COMMAND.
  320. * RDSUDT - *CIF* COMMAND MISSING = SIGN.
  321. * RDSUDT - *DTI* COMMAND MISSING = SIGN.
  322. * RDSUDT - *DTO* COMMAND MISSING = SIGN.
  323. * RDSUDT - *DIF* COMMAND MISSING = SIGN.
  324. * RDSUDT - *DRC* COMMAND MISSING = SIGN.
  325. * RDSUDT - *AIF* COMMAND MISSING = SIGN.
  326. * RDSUDT - *SM* COMMAND MISSING = SIGN.
  327. * RDSUDT - *SM* COMMAND MISSING COMMA.
  328. * RDSUDT - INCORRECT DEVICE ADDRESS.
  329. * RDSUDT - EXTRA ENTRIES ON DIRECTIVE.
  330. * RDSUDT - INCORRECT CONFIGURATION FILE HEADER.
  331. * RDSUDT - STATEMENT OUT OF ORDER.
  332. * RDSUDT - INCORRECT STATUS.
  333. * RDSUDT - INCORRECT COMMAND TERMINATOR.
  334. * RDSUDT - EXTRA PATHS TO *DRD*.
  335. * RDSUDT - EXTRA PATHS TO *SM*.
  336. * RDSUDT - SOURCE FILE STATEMENT CONFLICT.
  337. * RDSUDT - COMMAND SYNTAX ERROR.
  338. * RDSUDT - INCORRECT STATEMENT MNEMONIC.
  339. * RDSUDT - STATEMENT OUT OF ORDER.
  340. * RDSUDT - CONFIGURATION FILE STATEMENT CONFLICT.
  341. * RDSUDT - SM STATEMENT - INCORRECT DS VALUE.
  342. * RDSUDT - SM STATEMENT - INCORRECT ST VALUE.
  343. * RDSUDT - INVALID AIF PATHS.
  344. *
  345. #
  346.  
  347. #
  348. **** PROC RDSUDT - XREF LIST BEGIN.
  349. #
  350.  
  351. XREF
  352. BEGIN
  353. PROC BZFILL; # BLANK OR ZERO FILLS AN ITEM #
  354. PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE #
  355. PROC NEXTLIN; # READ NEXT LINE AND CHECK IT #
  356. PROC NEXTPRM; # GET NEXT PARAMETER, CHECK IT #
  357. PROC READ; # READS A FILE #
  358. PROC READC; # READ ONE LINE #
  359. PROC READW; # DATA TRANSFER ROUTINE #
  360. PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
  361.   OR RETURN #
  362. PROC RETERN; # RETURNS A FILE #
  363. PROC REWIND; # REWINDS A FILE #
  364. PROC UPDRDST; # UPDATE NODE STATUS #
  365. FUNC XDXB; # CONVERT DISPLAY CODE TO BINARY #
  366. PROC ZFILL; # ZERO FILLS A BUFFER #
  367. PROC ZSETFET; # SETS UP A FET #
  368. END
  369.  
  370.  
  371. #
  372. **** PROC RDSUDT - XREF LIST END.
  373. #
  374.  
  375. DEF MSG$BADEST #" RDSUDT - INCORRECT EST ORDINAL. "#;
  376. DEF MSG$BADADR #" RDSUDT - INCORRECT DEVICE ADDRESS. "#;
  377. DEF MSG$BADENT #" RDSUDT - EXTRA ENTRIES ON DIRECTIVE."#;
  378. DEF MSG$BADNUM #" RDSUDT - INCORRECT CONFIGURATION FILE HEADER."#;
  379. DEF MSG$BADST #" RDSUDT - INCORRECT STATEMENT MNEMONIC."#;
  380. DEF MSG$BDORD #" RDSUDT - STATEMENT OUT OF ORDER."#;
  381. DEF MSG$BDST #" RDSUDT - INCORRECT STATUS."#;
  382. DEF MSG$BDTERM #" RDSUDT - INCORRECT COMMAND TERMINATOR. "#;
  383. DEF MSG$EXDRD #" RDSUDT - EXTRA PATHS TO *DRD*."#;
  384. DEF MSG$EXPATH #" RDSUDT - EXTRA PATHS TO *SM*."#;
  385. DEF MSG$INCCU #" RDUSDT - INCORRECT *CU* COUNT."#;
  386. DEF MSG$INCSM #" RDSUDT - INCORRECT *SM* COUNT."#;
  387. DEF MSG$INVAIF #" RDSUDT - INVALID AIF PATHS."#;
  388. DEF MSG$SM$DS #" RDSUDT - SM STATEMENT - INCORRECT DS VALUE."#;
  389. DEF MSG$SM$ST #" RDSUDT - SM STATEMENT - INCORRECT ST VALUE."#;
  390. DEF MSG$STCON #" RDSUDT - SOURCE FILE STATEMENT CONFLICT"#;
  391. DEF MSG$SYNER #" RDSUDT - COMMAND SYNTAX ERROR"#;
  392. DEF PROCNAME #"RDSUDT."#; # PROC NAME #
  393. DEF ZERO #0#; # CONSTANT ZERO #
  394.  
  395. DEF LISTCON #0#; # DO NOT LIST COMDECKS #
  396. *CALL COMBFAS
  397. *CALL COMBBZF
  398. *CALL COMBFET
  399. *CALL COMBTDM
  400. *CALL COMBUDT
  401. *CALL COMSPFM
  402. *CALL COMTBLD
  403. *CALL COMTBLP
  404. *CALL COMTOUT
  405.  
  406. ITEM ACCESSOR I; # DEVICE ADDRESS OF M861 #
  407. ITEM ARGLIST I; # ARGUMENT LIST ADDRESS #
  408. ITEM BUFP I; # FWA OF BUFFER #
  409. ITEM CHAR1 C(1); # ONE CHARACTER #
  410. ITEM CHAR2 C(2); # TWO CHARACTERS #
  411. ITEM CHAR3 C(3); # THREE CHARACTERS #
  412. ITEM CUNUM I; # ORDINAL OF CURRENT *CU* #
  413. ITEM CUXX I; # ORDINAL OF PRIMARY *CU* #
  414. ITEM CUYY I; # ORDINAL OF SECONDARY *CU* #
  415. ITEM NCOL I; # NEXT COLUMN NUMBER #
  416. ITEM SCOL I; # STARTING COLUMN NUMBER #
  417. ITEM DEVTYPE C(3); # DEVICE NMEMONIC #
  418. ITEM DIRNUM I; # DIRECTIVE NUMBER #
  419. ITEM DIRLINE C(90); # DIRECTIVE TEXT LINE #
  420. ITEM DRDNUM I; # ORDINAL OF CURRENT *DRD* #
  421. ITEM EOR B; # END-OF-RECORD FLAG #
  422. ITEM FETP I; # FWA OF FET #
  423. ITEM FOUND B; # LOOP EXIT CONTROL #
  424. ITEM ARGKEY2 C(2); # ARGUMENT KEY - 2 CHARACTERS #
  425. ITEM ARGKEY3 C(3); # ARGUMENT KEY - 3 CHARACTERS #
  426. ITEM NKEY2 C(2); # DIRECTIVE KEY - 2 CHARACTER #
  427. ITEM OKEY2 C(2); # DIRECTIVE KEY - 2 CHARACTER #
  428. ITEM NKEY3 C(3); # DIRECTIVE KEY - 3 CHARACTER #
  429. ITEM OKEY3 C(3); # DIRECTIVE KEY - 3 CHARACTER #
  430. ITEM KEYOK B; # CONTROL VARIABLE #
  431. ITEM MASK I; # MASK FOR SPECIAL FILE NAMES #
  432. ITEM I I; # LOOP INDEX #
  433. ITEM J I; # LOOP INDEX #
  434. ITEM K I; # LOOP INDEX #
  435. ITEM LFN C(7); # FILE NAME #
  436. ITEM MAXARG I; # MAXIMUM NUMBER OF ARGUMENTS #
  437. ITEM LOOPC B; # LOOP CONTROL VARIABLE #
  438. ITEM LOOPK B; # LOOP CONTROL VARIABLE #
  439. ITEM LOOPL B; # LOOP CONTROL #
  440. ITEM NUMCH I; # NUMBER OF CHARACTERS #
  441. ITEM ORD I; # ORDINAL OF DEVICE TYPE #
  442. ITEM SAVEDORD I; # SAVED DRD ORDINAL #
  443. ITEM SMNUM I; # ORDINAL OF CURRENT *SM* #
  444. ITEM STAT I; # STATUS OF PROCEDURE CALL #
  445. ITEM TERMINATOR C(1); # TERMINATING CHARACTER #
  446. ITEM TMPI I; # INTEGER SCRATCH #
  447. ITEM TMPJ I; # INTEGER SCRATCH #
  448.  
  449. ARRAY MSG [1:2] S(2); # MESSAGES DISPLAYED #
  450. BEGIN
  451. ITEM MSGW C(00,00,20) = ##
  452. [ "CONFIGURATION FILE READ ",
  453. " " ];
  454. END
  455.  
  456.  
  457.  
  458. #
  459. * SWITCH STATEMENT
  460. #
  461.  
  462. SWITCH DIRECTIVE NULL,
  463. M862CTLR,
  464. CHANIF,
  465. DEVICETI,
  466. DEVICETO,
  467. DEVICEIF,
  468. DATARC,
  469. NULL,
  470. ACCIF,
  471. NULL,
  472. M861SM;
  473.  
  474.  
  475.  
  476. CONTROL EJECT;
  477.  
  478. #
  479. * SET UP FET FOR CONFIGURATION FILE AND REWIND IT.
  480. #
  481.  
  482. LFN = DARG$CF[0];
  483. FETP = LOC(BL$FET[0]);
  484. BUFP = LOC(BL$BUF[0]);
  485. ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL);
  486. READ(BL$FET[0],NRCL);
  487. EOR = FALSE;
  488.  
  489. #
  490. * READ FIRST 2 CARDS OF CONFIGURATION SOURCE FILE.
  491. * CARD 1 CONTAINS NUMBER OF CU-S (LEFT-JUSTIFIED)
  492. * CARD 2 CONTAINS NUMBER OF SM-S (LEFT-JUSTIFIED)
  493. #
  494.  
  495. READC(BL$FET[0],DIRLINE,9,STAT);
  496. BZFILL(DIRLINE,TYPFILL"BFILL",90);
  497. IF STAT NQ 0
  498. THEN
  499. BEGIN
  500. BLMSG$LN[0] = " RDSUDT - CONFIGURATION FILE EMPTY.";
  501. MESSAGE(BLMSG[0],SYSUDF1);
  502. END
  503.  
  504. STAT = XDXB(C<0,1>DIRLINE,1,NUM$CU);
  505. IF STAT NQ 0
  506. THEN
  507. BEGIN
  508. BLMSG$LN[0] = MSG$BADENT;
  509. MESSAGE(BLMSG[0],SYSUDF1);
  510. RESTPFP(PFP$ABORT);
  511. END
  512.  
  513. BLMSG$LN[0] = DIRLINE;
  514. MESSAGE(BLMSG[0],SYSUDF1);
  515. P<UDT$WORD> = LOC(BL$UDT$HDR);
  516. IF NUM$CU GR MAXCTN OR NUM$CU LQ ZERO
  517. THEN
  518. BEGIN
  519. BLMSG$LN[0] = MSG$INCCU;
  520. MESSAGE(BLMSG[0],SYSUDF1);
  521. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  522. END
  523.  
  524. #
  525. * SAVE COUNT OF M862-S
  526. #
  527.  
  528. UDT$LINE$CUN = NUM$CU;
  529.  
  530. READC(BL$FET[0],DIRLINE,9,STAT);
  531. BZFILL(DIRLINE,TYPFILL"BFILL",90);
  532. IF STAT NQ 0
  533. THEN
  534. BEGIN
  535. BLMSG$LN[0] = " MISSING *SM* COUNT COMMAND.";
  536. MESSAGE(BLMSG[0],SYSUDF1); # ERROR MESSAGE #
  537. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  538. END
  539.  
  540. STAT = XDXB(C<0,1>DIRLINE,1,NUM$SM);
  541. IF STAT NQ 0
  542. THEN
  543. BEGIN
  544. BLMSG$LN[0]= " RDSUDT - CAN-T CRACK *SM* COMMAND. ";
  545. MESSAGE(BLMSG[0],SYSUDF1);
  546. RESTPFP(PFP$ABORT);
  547. END
  548.  
  549. BLMSG$LN[0] = DIRLINE;
  550. MESSAGE(BLMSG[0],SYSUDF1);
  551. IF NUM$SM GR MAXSM OR NUM$SM LQ ZERO
  552. THEN
  553. BEGIN
  554. BLMSG$LN[0] = MSG$INCSM;
  555. MESSAGE(BLMSG[0],SYSUDF1);
  556. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  557. END
  558.  
  559. UDT$LINE$SMN = NUM$SM;
  560.  
  561. #
  562. * INITIALIZE *BUDT* POSITIONING COUNTERS.
  563. #
  564.  
  565. CUNUM = 0;
  566. SMNUM = 0;
  567.  
  568. #
  569. * READ DIRECTIVES FROM SOURCE FILE
  570. #
  571.  
  572.  
  573. EOR = FALSE;
  574. SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR
  575. DO
  576. BEGIN
  577.  
  578. NEXTLIN(DIRLINE,STAT,TMPI);
  579. IF STAT NQ 0
  580. THEN
  581. BEGIN
  582. EOR = TRUE;
  583. TEST DIRNUM;
  584. END
  585.  
  586. BLMSG$LN[0] = DIRLINE;
  587. MESSAGE(BLMSG[0],SYSUDF1);
  588.  
  589. GOTO DIRECTIVE[TMPI];
  590.  
  591. NULL:
  592. BLMSG$LN[0] = " RDSUDT - NULL DIRECTIVE. ";
  593. MESSAGE(BLMSG[0],SYSUDF1);
  594. RESTPFP(PFP$ABORT);
  595.  
  596. M862CTLR:
  597. CUNUM = CUNUM + 1;
  598. P<UDT$CN> = LOC(BL$UDT$M862[CUNUM]);
  599. ARGKEY2 = C<0,2>DIRLINE;
  600. ARGKEY3 = " ";
  601. IF ARGKEY2 NQ NM$KEY2[2]
  602. THEN
  603. BEGIN
  604. BLMSG$LN[0] = ##
  605. " RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE.";
  606. MESSAGE(BLMSG[0],SYSUDF1);
  607. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  608. END
  609.  
  610. STAT = XDXB(C<2,3>DIRLINE,0,TMPI); # ASSUME 3-CHAR EST ORD #
  611. SCOL = 5;
  612. IF STAT NQ 0
  613. THEN
  614. BEGIN
  615. STAT = XDXB(C<2,2>DIRLINE,0,TMPI); # ASSUME 2-CHAR EST ORD #
  616. SCOL = 4;
  617. IF STAT NQ 0
  618. THEN # BAD EST ORDINAL #
  619. BEGIN # EXIT #
  620. BLMSG$LN[0] = MSG$BADEST;
  621. MESSAGE(BLMSG[0],SYSUDF1);
  622. RESTPFP(PFP$ABORT);
  623. END # EXIT #
  624.  
  625. END
  626.  
  627. IF (TMPI LS O"10") OR (TMPI GR MAXEST)
  628. THEN
  629. BEGIN
  630. BLMSG$LN[0] = MSG$BADEST;
  631. MESSAGE(BLMSG[0],SYSUDF1);
  632. RESTPFP(PFP$ABORT);
  633. END
  634.  
  635. UD$ESTO[1] = TMPI;
  636. IF C<SCOL,1>DIRLINE NQ "="
  637. THEN
  638. BEGIN
  639. BLMSG$LN[0] = " RDSUDT - *CU* ENTRY MISSING = SIGN.";
  640. MESSAGE(BLMSG[0],SYSUDF1);
  641. RESTPFP(PFP$ABORT);
  642. END
  643.  
  644. SCOL = SCOL + 1;
  645. CHAR1 = C<SCOL,1>DIRLINE;
  646. STAT = XDXB(CHAR1,0,TMPI);
  647. IF STAT NQ 0
  648. THEN
  649. BEGIN
  650. BLMSG$LN[0] = MSG$BADEST;
  651. MESSAGE(BLMSG[0],SYSUDF1);
  652. RESTPFP(PFP$ABORT);
  653. END
  654.  
  655. IF (TMPI EQ 1) OR (TMPI EQ 3) OR (TMPI EQ 5) OR (TMPI EQ 7)
  656. THEN
  657. BEGIN
  658. BLMSG$LN[0] = MSG$BADEST;
  659. MESSAGE(BLMSG[0],SYSUDF1);
  660. RESTPFP(PFP$ABORT);
  661. END
  662.  
  663. SCOL = SCOL + 1;
  664. IF C<SCOL,1>DIRLINE NQ COMMA
  665. THEN # BAD SYNTAX #
  666. BEGIN # EXIT #
  667. BLMSG$LN[0] = MSG$SYNER;
  668. MESSAGE(BLMSG[0],SYSUDF1);
  669. RESTPFP(PFP$ABORT);
  670. END # EXIT #
  671.  
  672. #
  673. * STORE M862 DEVICE ADDRESS AND SET EXISTENCE FLAG.
  674. #
  675.  
  676. UD$CUDA[1] = TMPI;
  677. UD$EXIST[1] = TRUE;
  678. SCOL = SCOL + 1;
  679. DEVTYPE = "CH";
  680. NUMCH = 2;
  681. LOOPC = FALSE;
  682. SLOWFOR J = 1 STEP 1 WHILE ( NOT LOOPC )
  683. DO
  684. BEGIN
  685. NEXTPRM(DIRLINE,SCOL,DEVTYPE, ##
  686. NUMCH,ORD,NCOL,STAT,TERMINATOR);
  687.  
  688. #
  689. * INSERT *CH* DATA INTO BUDT
  690. #
  691.  
  692. IF ( ORD EQ 0 ) AND ( J NQ 1 ) AND ( STAT NQ 2 )
  693. THEN
  694. BEGIN
  695. BLMSG$LN[0] = " RDSUDT - CHANNEL 0 NOT FIRST CHANNEL.";
  696. MESSAGE(BLMSG[0],SYSUDF1);
  697. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  698. END
  699.  
  700. IF ( STAT NQ 2 ) AND ( J EQ 1 )
  701. THEN
  702. BEGIN
  703. UD$CHANA[1] = ORD;
  704. UD$CHEX0[1] = TRUE;
  705. IF STAT EQ 1
  706. THEN
  707. BEGIN
  708. UD$CHANA$O[1] = TRUE;
  709. END
  710.  
  711. ELSE
  712. BEGIN
  713. UD$CHANA$O[1] = FALSE;
  714. END
  715.  
  716. END
  717.  
  718. IF ( STAT EQ 2 ) AND ( J EQ 1 )
  719. THEN
  720. BEGIN
  721. UD$CHANA[1] = 0;
  722. UD$CHANA$O[1] = FALSE;
  723. END
  724.  
  725. IF ( STAT NQ 2 ) AND ( J EQ 2 )
  726. THEN
  727. BEGIN
  728. UD$CHANB[1] = ORD;
  729. UD$CHEX1[1] = TRUE;
  730. IF STAT EQ 1
  731. THEN
  732. BEGIN
  733. UD$CHANB$O[1] = TRUE;
  734. END
  735.  
  736. ELSE
  737. BEGIN
  738. UD$CHANB$O[1] = FALSE;
  739. END
  740.  
  741. END
  742.  
  743. IF ( STAT EQ 2 ) AND ( J EQ 2 )
  744. THEN
  745. BEGIN
  746. UD$CHANB[1] = 0;
  747. UD$CHANB$O[1] = FALSE;
  748. END
  749.  
  750. IF ( STAT NQ 2 ) AND ( J EQ 3 )
  751. THEN
  752. BEGIN
  753. UD$CHANC[1] = ORD;
  754. UD$CHEX2[1] = TRUE;
  755. IF STAT EQ 1
  756. THEN
  757. BEGIN
  758. UD$CHANC$O[1] = TRUE;
  759. END
  760.  
  761. ELSE
  762. BEGIN
  763. UD$CHANC$O[1] = FALSE;
  764. END
  765.  
  766. END
  767.  
  768. IF ( STAT EQ 2 ) AND ( J EQ 3 )
  769. THEN
  770. BEGIN
  771. UD$CHANC[1] = 0;
  772. UD$CHANC$O[1] = FALSE;
  773. END
  774.  
  775. IF ( STAT NQ 2 ) AND ( J EQ 4 )
  776. THEN
  777. BEGIN
  778. UD$CHAND[1] = ORD;
  779. UD$CHEX3[1] = TRUE;
  780. IF STAT EQ 1
  781. THEN
  782. BEGIN
  783. UD$CHAND$O[1] = TRUE;
  784. END
  785.  
  786. ELSE
  787. BEGIN
  788. UD$CHAND$O[1] = FALSE;
  789. END
  790.  
  791. END
  792.  
  793. IF ( STAT EQ 2 ) AND ( J EQ 4 )
  794. THEN
  795. BEGIN
  796. UD$CHAND[1] = 0;
  797. UD$CHAND$O[1] = FALSE;
  798. END
  799.  
  800. IF TERMINATOR EQ PERIOD
  801. THEN
  802. BEGIN
  803. LOOPC = TRUE;
  804. TEST J;
  805. END
  806.  
  807. IF J GR MAX$CH
  808. THEN
  809. BEGIN
  810. BLMSG$LN[0] = ##
  811. "RDSUDT - MISSING CHANNELS ON *CU* COMMAND.";
  812. MESSAGE(BLMSG[0],SYSUDF1);
  813. RESTPFP(PFP$ABORT);
  814. END
  815.  
  816. SCOL = NCOL;
  817. TEST J;
  818. END
  819.  
  820. TEST DIRNUM;
  821.  
  822. CHANIF:
  823. IF( ARGKEY2 NQ NM$KEY2[2] ) AND (ARGKEY3 NQ " ")
  824. THEN
  825. BEGIN
  826. BLMSG$LN[0] = MSG$BDORD;
  827. MESSAGE(BLMSG[0],SYSUDF1);
  828. RESTPFP(PFP$ABORT);
  829. END
  830.  
  831. ARGKEY3 = NM$KEY3[3];
  832.  
  833. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  834. IF STAT NQ 0
  835. THEN
  836. BEGIN
  837. BLMSG$LN[0] = MSG$BADADR;
  838. MESSAGE(BLMSG[0],SYSUDF1);
  839. RESTPFP(PFP$ABORT);
  840. END
  841.  
  842. IF TMPI LS 0 OR TMPI GR 3
  843. THEN
  844. BEGIN
  845. BLMSG$LN[0] = MSG$BADADR;
  846. MESSAGE(BLMSG[0],SYSUDF1);
  847. RESTPFP(PFP$ABORT);
  848. END
  849.  
  850. IF C<4,1>DIRLINE NQ "="
  851. THEN
  852. BEGIN
  853. BLMSG$LN[0] = " RDSUDT - *CIF* COMMAND MISSING = SIGN.";
  854. MESSAGE(BLMSG[0],SYSUDF1);
  855. RESTPFP(PFP$ABORT);
  856. END
  857.  
  858. SCOL = 5;
  859. DEVTYPE = NM$KEY3[4];
  860. NUMCH = 3;
  861. LOOPC = FALSE;
  862. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  863. DO
  864. BEGIN
  865. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  866. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  867. IF STAT NQ 2
  868. THEN
  869. BEGIN
  870.  
  871. #
  872. * CHECK FOR VALID CHANNELS AND CIF LASHUPS.
  873. #
  874.  
  875. IF ( ( TMPI EQ 0 ) ##
  876. AND ( UD$CHANA[1] EQ 0 ) ##
  877. AND ( UD$CHANB[1] NQ 0 ) ) ##
  878. OR ( ( TMPI EQ 1 ) ##
  879. AND ( UD$CHANB[1] EQ 0 ) ) ##
  880. OR ( ( TMPI EQ 2 ) ##
  881. AND ( UD$CHANC[1] EQ 0 ) ) ##
  882. OR ( ( TMPI EQ 3 ) ##
  883. AND ( UD$CHAND[1] EQ 0 ) ) ##
  884. THEN
  885. BEGIN
  886. BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. ";
  887. MESSAGE ( BLMSG[0] , SYSUDF1) ##
  888. ;
  889. RESTPFP ( PFP$ABORT ); # RESTORE USER-S PFP AND ABORT #
  890. END
  891.  
  892. CIFI ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  893. END
  894.  
  895. IF STAT EQ 1
  896. THEN
  897. BEGIN
  898. CIFI ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  899. END
  900.  
  901. IF TERMINATOR EQ PERIOD
  902. THEN
  903. BEGIN
  904. LOOPC = TRUE;
  905. TEST J;
  906. END
  907.  
  908. IF J EQ MAX$DTI
  909. THEN
  910. BEGIN
  911. LOOPC = TRUE;
  912. TEST J;
  913. END
  914.  
  915. SCOL = NCOL;
  916. END
  917.  
  918. SCOL = NCOL;
  919.  
  920. DEVTYPE = NM$KEY3[5];
  921. LOOPC = FALSE;
  922. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  923. DO
  924. BEGIN
  925. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  926. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  927. IF STAT NQ 2
  928. THEN
  929. BEGIN
  930.  
  931. #
  932. * CHECK FOR VALID CHANNELS AND CIF LASHUPS.
  933. #
  934.  
  935. IF ( ( TMPI EQ 0 ) ##
  936. AND ( UD$CHANA[1] EQ 0 ) ##
  937. AND ( UD$CHANB[1] NQ 0 ) ) ##
  938. OR ( ( TMPI EQ 1 ) ##
  939. AND ( UD$CHANB[1] EQ 0 ) ) ##
  940. OR ( ( TMPI EQ 2 ) ##
  941. AND ( UD$CHANC[1] EQ 0 ) ) ##
  942. OR ( ( TMPI EQ 3 ) ##
  943. AND ( UD$CHAND[1] EQ 0 ) ) ##
  944. THEN
  945. BEGIN
  946. BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. ";
  947. MESSAGE ( BLMSG[0] , SYSUDF1);
  948. RESTPFP ( PFP$ABORT ); # RESTORE USER-S PFP AND ABORT #
  949. END
  950.  
  951. CIFO ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  952. END
  953.  
  954. IF STAT EQ 1
  955. THEN
  956. BEGIN
  957. CIFO ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  958. END
  959.  
  960. IF TERMINATOR EQ PERIOD
  961. THEN
  962. BEGIN
  963. LOOPC = TRUE;
  964. TEST J;
  965. END
  966.  
  967. IF J EQ MAX$DTO
  968. THEN
  969. BEGIN
  970. LOOPC = TRUE;
  971. TEST J;
  972. END
  973.  
  974. SCOL = NCOL;
  975. END
  976.  
  977. TEST DIRNUM;
  978.  
  979. DEVICETI:
  980. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[3] )
  981. THEN
  982. BEGIN
  983. BLMSG$LN[0] = MSG$BDORD;
  984. MESSAGE(BLMSG[0],SYSUDF1);
  985. RESTPFP(PFP$ABORT);
  986. END
  987.  
  988. ARGKEY3 = NM$KEY3[4];
  989.  
  990. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  991. IF STAT NQ 0
  992. THEN
  993. BEGIN
  994. BLMSG$LN[0] = MSG$BADADR;
  995. MESSAGE(BLMSG[0],SYSUDF1);
  996. RESTPFP(PFP$ABORT);
  997. END
  998.  
  999. IF TMPI LS 0 OR TMPI GR 1
  1000. THEN
  1001. BEGIN
  1002. BLMSG$LN[0] = MSG$BADADR;
  1003. MESSAGE(BLMSG[0],SYSUDF1);
  1004. RESTPFP(PFP$ABORT);
  1005. END
  1006.  
  1007. IF C<4,1>DIRLINE NQ "="
  1008. THEN
  1009. BEGIN
  1010. BLMSG$LN[0] = " RDSUDT - *DTI* COMMAND MISSING = SIGN.";
  1011. MESSAGE(BLMSG[0],SYSUDF1);
  1012. RESTPFP(PFP$ABORT);
  1013. END
  1014.  
  1015. SCOL = 5;
  1016. DEVTYPE = NM$KEY3[6];
  1017. NUMCH = 3;
  1018. LOOPC = FALSE;
  1019. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  1020. DO
  1021. BEGIN
  1022. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1023. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  1024. IF STAT NQ 2
  1025. THEN
  1026. BEGIN
  1027. DTI01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  1028. END
  1029.  
  1030. IF STAT EQ 1
  1031. THEN
  1032. BEGIN
  1033. DTI01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  1034. END
  1035.  
  1036. IF TERMINATOR EQ PERIOD
  1037. THEN
  1038. BEGIN
  1039. LOOPC = TRUE;
  1040. TEST J;
  1041. END
  1042.  
  1043. IF J GR MAX$DIF
  1044. THEN
  1045. BEGIN
  1046. BLMSG$LN[0] = MSG$BADENT;
  1047. MESSAGE(BLMSG[0],SYSUDF1);
  1048. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1049. END
  1050.  
  1051. SCOL = NCOL;
  1052. END
  1053.  
  1054. TEST DIRNUM;
  1055. DEVICETO:
  1056. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[4] )
  1057. THEN
  1058. BEGIN
  1059. BLMSG$LN[0] = MSG$BDORD;
  1060. MESSAGE( BLMSG[0],SYSUDF1);
  1061. RESTPFP(PFP$ABORT);
  1062. END
  1063.  
  1064. ARGKEY3 = NM$KEY3[5];
  1065.  
  1066. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  1067. IF STAT NQ 0
  1068. THEN
  1069. BEGIN
  1070. BLMSG$LN[0] = MSG$BADADR;
  1071. MESSAGE(BLMSG[0],SYSUDF1);
  1072. RESTPFP(PFP$ABORT);
  1073. END
  1074.  
  1075. IF TMPI LS 0 OR TMPI GR 1
  1076. THEN
  1077. BEGIN
  1078. BLMSG$LN[0] = MSG$BADADR;
  1079. MESSAGE(BLMSG[0],SYSUDF1);
  1080. RESTPFP(PFP$ABORT);
  1081. END
  1082.  
  1083. IF C<4,1>DIRLINE NQ "="
  1084. THEN
  1085. BEGIN
  1086. BLMSG$LN[0] = " RDSUDT - *DTO* COMMAND MISSING = SIGN.";
  1087. MESSAGE(BLMSG[0],SYSUDF1);
  1088. RESTPFP(PFP$ABORT);
  1089. END
  1090.  
  1091. SCOL = 5;
  1092. DEVTYPE = NM$KEY3[6];
  1093. NUMCH = 3;
  1094. LOOPC = FALSE;
  1095. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  1096. DO
  1097. BEGIN
  1098. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1099. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  1100. IF STAT NQ 2
  1101. THEN
  1102. BEGIN
  1103. DTO01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  1104. END
  1105.  
  1106. IF STAT EQ 1
  1107. THEN
  1108. BEGIN
  1109. DTO01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  1110. END
  1111.  
  1112. IF TERMINATOR EQ PERIOD
  1113. THEN
  1114. BEGIN
  1115. LOOPC = TRUE;
  1116. TEST J;
  1117. END
  1118.  
  1119. IF J GR MAX$DIF
  1120. THEN
  1121. BEGIN
  1122. BLMSG$LN[0] = MSG$BADENT;
  1123. MESSAGE(BLMSG[0],SYSUDF1);
  1124. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1125. END
  1126.  
  1127. SCOL = NCOL;
  1128. END
  1129.  
  1130. TEST DIRNUM;
  1131. DEVICEIF:
  1132. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[5] )
  1133. THEN
  1134. BEGIN
  1135. BLMSG$LN[0] = MSG$BDORD;
  1136. MESSAGE(BLMSG[0],SYSUDF1);
  1137. RESTPFP(PFP$ABORT);
  1138. END
  1139.  
  1140. ARGKEY3 = NM$KEY3[6];
  1141.  
  1142. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  1143. IF STAT NQ 0
  1144. THEN
  1145. BEGIN
  1146. BLMSG$LN[0] = MSG$BADADR;
  1147. MESSAGE(BLMSG[0],SYSUDF1);
  1148. RESTPFP(PFP$ABORT);
  1149. END
  1150.  
  1151. IF TMPI LS 0 OR TMPI GR 1
  1152. THEN
  1153. BEGIN
  1154. BLMSG$LN[0] = MSG$BADEST;
  1155. MESSAGE(BLMSG[0],SYSUDF1);
  1156. RESTPFP(PFP$ABORT);
  1157. END
  1158.  
  1159. IF C<4,1>DIRLINE NQ "="
  1160. THEN
  1161. BEGIN
  1162. BLMSG$LN[0] = " RDSUDT - *DIF* COMMAND MISSING = SIGN.";
  1163. MESSAGE(BLMSG[0],SYSUDF1);
  1164. RESTPFP(PFP$ABORT);
  1165. END
  1166.  
  1167. SCOL = 5;
  1168. DEVTYPE = NM$KEY3[7];
  1169. NUMCH = 3;
  1170. LOOPC = FALSE;
  1171. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  1172. DO
  1173. BEGIN
  1174. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1175. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  1176. IF STAT NQ 2
  1177. THEN
  1178. BEGIN
  1179. DIF01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  1180. END
  1181.  
  1182. IF STAT EQ 1
  1183. THEN
  1184. BEGIN
  1185. DIF01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  1186. END
  1187.  
  1188. IF TERMINATOR EQ PERIOD
  1189. THEN
  1190. BEGIN
  1191. LOOPC = TRUE;
  1192. TEST J;
  1193. END
  1194.  
  1195. IF J GR MAX$DRC
  1196. THEN
  1197. BEGIN
  1198. BLMSG$LN[0] = MSG$BADENT;
  1199. MESSAGE(BLMSG[0],SYSUDF1);
  1200. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1201. END
  1202.  
  1203. SCOL = NCOL;
  1204. END
  1205.  
  1206. TEST DIRNUM;
  1207. DATARC:
  1208. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[6] )
  1209. THEN
  1210. BEGIN
  1211. BLMSG$LN[0] = MSG$BDORD;
  1212. MESSAGE(BLMSG[0],SYSUDF1);
  1213. RESTPFP(PFP$ABORT);
  1214. END
  1215.  
  1216. ARGKEY3 = NM$KEY3[7];
  1217.  
  1218. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  1219. IF STAT NQ 0
  1220. THEN
  1221. BEGIN
  1222. BLMSG$LN[0] = MSG$BADEST;
  1223. MESSAGE(BLMSG[0],SYSUDF1);
  1224. RESTPFP(PFP$ABORT);
  1225. END
  1226.  
  1227. IF TMPI LS 0
  1228. OR TMPI GR MAX$DRC
  1229. THEN
  1230. BEGIN
  1231. BLMSG$LN[0] = MSG$BADEST;
  1232. MESSAGE(BLMSG[0],SYSUDF1);
  1233. RESTPFP(PFP$ABORT);
  1234. END
  1235.  
  1236. IF C<4,1>DIRLINE NQ "="
  1237. THEN
  1238. BEGIN
  1239. BLMSG$LN[0] = " RDSUDT - *DRC* ENTRY MISSING = SIGN.";
  1240. MESSAGE(BLMSG[0],SYSUDF1);
  1241. RESTPFP(PFP$ABORT);
  1242. END
  1243.  
  1244. SCOL = 5;
  1245. DEVTYPE = NM$KEY3[8];
  1246. NUMCH = 3;
  1247. LOOPC = FALSE;
  1248. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  1249. DO
  1250. BEGIN
  1251. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1252. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  1253. IF STAT NQ 2
  1254. THEN
  1255. BEGIN
  1256. IF ((TMPI LQ 1) AND (ORD GR MAX$DRD))
  1257. # DRCS 0/1 ONLY GO TO DRDS 0-7 #
  1258. OR ((TMPI GQ 2) AND (ORD LQ MAX$DRD))
  1259. # DRC 2/3 ONLY GO TO DRDS 8-15 #
  1260. THEN # DRC-DRD PATHS NOT CORRECT #
  1261. BEGIN
  1262. BLMSG$LN[0] = MSG$BADADR;
  1263. MESSAGE(BLMSG[0],SYSUDF1);
  1264. RESTPFP(PFP$ABORT);
  1265. END
  1266.  
  1267. IF TMPI EQ 0
  1268. THEN
  1269. BEGIN
  1270. DRC00 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  1271. END
  1272.  
  1273. IF TMPI EQ 1
  1274. THEN
  1275. BEGIN
  1276. DRC01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
  1277. END
  1278.  
  1279. IF TMPI EQ 2
  1280. THEN
  1281. BEGIN
  1282. DRC02 ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1);
  1283. END
  1284.  
  1285. IF TMPI EQ 3
  1286. THEN
  1287. BEGIN
  1288. DRC03 ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1);
  1289. END
  1290.  
  1291. END
  1292.  
  1293. IF STAT EQ 1
  1294. THEN
  1295. BEGIN
  1296. IF TMPI EQ 0
  1297. THEN
  1298. BEGIN
  1299. DRC00 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  1300. END
  1301.  
  1302. IF TMPI EQ 1
  1303. THEN
  1304. BEGIN
  1305. DRC01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
  1306. END
  1307.  
  1308. IF TMPI EQ 2
  1309. THEN
  1310. BEGIN
  1311. DRC02 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 );
  1312. END
  1313.  
  1314. IF TMPI EQ 3
  1315. THEN
  1316. BEGIN
  1317. DRC03 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 );
  1318. END
  1319.  
  1320. END
  1321.  
  1322. IF J GR MAX$DRD
  1323. THEN
  1324. BEGIN
  1325. BLMSG$LN[0] = MSG$BADENT;
  1326. MESSAGE(BLMSG[0],SYSUDF1);
  1327. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1328. END
  1329.  
  1330. IF TERMINATOR EQ PERIOD
  1331. THEN
  1332. BEGIN
  1333. LOOPC = TRUE;
  1334. TEST J;
  1335. END
  1336.  
  1337. SCOL = NCOL;
  1338. END
  1339.  
  1340. TEST DIRNUM;
  1341.  
  1342. ACCIF:
  1343. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[7] )
  1344. THEN
  1345. BEGIN
  1346. BLMSG$LN[0] = MSG$BDORD;
  1347. MESSAGE(BLMSG[0],SYSUDF1);
  1348. RESTPFP(PFP$ABORT);
  1349. END
  1350.  
  1351. ARGKEY3 = NM$KEY3[9];
  1352.  
  1353. STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
  1354. IF STAT NQ 0
  1355. THEN
  1356. BEGIN
  1357. BLMSG$LN[0] = MSG$BADADR;
  1358. MESSAGE(BLMSG[0],SYSUDF1);
  1359. RESTPFP(PFP$ABORT);
  1360. END
  1361.  
  1362. IF TMPI LS 0 OR TMPI GR 1
  1363. THEN
  1364. BEGIN
  1365. BLMSG$LN[0] = MSG$BADEST;
  1366. MESSAGE(BLMSG[0],SYSUDF1);
  1367. RESTPFP(PFP$ABORT);
  1368. END
  1369.  
  1370. IF C<4,1>DIRLINE NQ "="
  1371. THEN
  1372. BEGIN
  1373. BLMSG$LN[0] = " RDSUDT - *AIF* ENTRY MISSING = SIGN.";
  1374. MESSAGE(BLMSG[0],SYSUDF1);
  1375. RESTPFP(PFP$ABORT);
  1376. END
  1377.  
  1378. SCOL = 5;
  1379. DEVTYPE = NM$KEY2[10];
  1380. NUMCH = 2;
  1381. LOOPC = FALSE;
  1382. SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
  1383. DO
  1384. BEGIN
  1385. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1386. NUMCH,ORD,NCOL,STAT,TERMINATOR );
  1387. IF STAT NQ 2
  1388. THEN # AIF PATH EXISTS #
  1389. BEGIN # EXISTS #
  1390. IF TMPI EQ 0
  1391. THEN # AIF0 PATH #
  1392. BEGIN # AIF0 #
  1393. AIF0(1,ORD,PATH$DF"U$EXISTS",ON);
  1394. END # AIF0 #
  1395.  
  1396. ELSE # AIF1 PATH #
  1397. BEGIN # AIF1 #
  1398. AIF1(1,ORD,PATH$DF"U$EXISTS",ON);
  1399. END # AIF1 #
  1400.  
  1401. END # EXISTS #
  1402.  
  1403. IF STAT EQ 1
  1404. THEN # AIF PATH TURNED ON #
  1405. BEGIN # ON #
  1406. IF TMPI EQ 0
  1407. THEN # AIF0 PATH #
  1408. BEGIN # AIF0 #
  1409. AIF0(1,ORD,PATH$DF"U$ON",ON);
  1410. END # AIF0 #
  1411.  
  1412. ELSE # AIF1 PATH #
  1413. BEGIN # AIF1 #
  1414. AIF1(1,ORD,PATH$DF"U$ON",ON);
  1415. END # AIF1 #
  1416.  
  1417. END # ON #
  1418.  
  1419. IF (UD$AIF003[1] NQ 0 AND UD$AIF047[1] NQ 0) ##
  1420. OR (UD$AIF103[1] NQ 0 AND UD$AIF147[1] NQ 0)
  1421. THEN # AIF GOES TO BOTH SETS OF SM-S #
  1422. BEGIN # EXIT #
  1423. BLMSG$LN[0] = MSG$INVAIF;
  1424. MESSAGE(BLMSG[0],SYSUDF1);
  1425. RESTPFP(PFP$ABORT);
  1426. END # EXIT #
  1427.  
  1428. IF TERMINATOR EQ PERIOD
  1429. THEN
  1430. BEGIN
  1431. LOOPC = TRUE;
  1432. TEST J;
  1433. END
  1434.  
  1435. IF J GR MAX$AC
  1436. THEN
  1437. BEGIN
  1438. BLMSG$LN[0] = MSG$BADENT;
  1439. MESSAGE(BLMSG[0],SYSUDF1);
  1440. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1441. END
  1442.  
  1443. SCOL = NCOL;
  1444. END
  1445.  
  1446. TEST DIRNUM;
  1447.  
  1448. M861SM:
  1449. SMNUM = SMNUM + 1;
  1450. P<UDT$SMA> = LOC(BL$UDT$M861[SMNUM]);
  1451. IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[9] )
  1452. THEN
  1453. BEGIN
  1454. BLMSG$LN[0] = MSG$BDORD;
  1455. MESSAGE(BLMSG[0],SYSUDF1);
  1456. RESTPFP(PFP$ABORT);
  1457. END
  1458.  
  1459. ARGKEY2 = NM$KEY2[11];
  1460.  
  1461. IF ( C<2,1>DIRLINE LS "A" ) OR ( C<2,1>DIRLINE GR "H" )
  1462. THEN
  1463. BEGIN
  1464. BLMSG$LN[0] = MSG$BADEST;
  1465. MESSAGE(BLMSG[0],SYSUDF1);
  1466. RESTPFP(PFP$ABORT);
  1467. END
  1468.  
  1469. SM$ID[1] = C<2,1>DIRLINE;
  1470. SM$EXIST[1] = TRUE;
  1471.  
  1472. #
  1473. * INITIALIZE DRD STAGE/DESTAGE DEFAULTS, SUBJECT TO LATER CHANGE
  1474. #
  1475.  
  1476. SM$STNUM[1] = 2;
  1477. SM$DSNUM[1] = 1;
  1478. IF C<3,1>DIRLINE NQ "="
  1479. THEN
  1480. BEGIN
  1481. BLMSG$LN[0] = " RDSUDT - *SM* ENTRY MISSING = SIGN.";
  1482. MESSAGE(BLMSG[0],SYSUDF1);
  1483. RESTPFP(PFP$ABORT);
  1484. END
  1485.  
  1486. IF ( C<4,2>DIRLINE NQ "ON" ) AND ( C<4,3>DIRLINE NQ "OFF" )
  1487. THEN
  1488. BEGIN
  1489. BLMSG$LN[0] = MSG$BDST;
  1490. MESSAGE(BLMSG[0],SYSUDF1);
  1491. RESTPFP(PFP$ABORT);
  1492. END
  1493.  
  1494. IF C<4,2>DIRLINE EQ "ON"
  1495. THEN
  1496. BEGIN
  1497. SCOL = 6;
  1498. SM$ON[1] = TRUE;
  1499. END
  1500.  
  1501. ELSE
  1502. BEGIN
  1503. SCOL = 7;
  1504. END
  1505.  
  1506. IF C<SCOL,1>DIRLINE NQ COMMA
  1507. THEN
  1508. BEGIN
  1509. BLMSG$LN[0] = "RDSUDT - *SM* COMMAND MISSING COMMA.";
  1510. MESSAGE(BLMSG[0],SYSUDF1);
  1511. RESTPFP(PFP$ABORT);
  1512. END
  1513.  
  1514. SCOL = SCOL +1;
  1515. IF C<SCOL,2>DIRLINE NQ NM$KEY2[10]
  1516. THEN
  1517. BEGIN
  1518. BLMSG$LN[0] = MSG$BADST;
  1519. MESSAGE(BLMSG[0],SYSUDF1);
  1520. RESTPFP(PFP$ABORT);
  1521. END
  1522.  
  1523. SCOL = SCOL+2;
  1524. CHAR1 = C<SCOL,1>DIRLINE;
  1525. STAT = XDXB(CHAR1,0,ACCESSOR);
  1526. IF STAT NQ 0
  1527. THEN
  1528. BEGIN
  1529. BLMSG$LN[0] = MSG$BADADR;
  1530. MESSAGE(BLMSG[0],SYSUDF1);
  1531. RESTPFP(PFP$ABORT);
  1532. END
  1533.  
  1534. IF ((ACCESSOR LS 0) OR (ACCESSOR GR 7))
  1535. THEN
  1536. BEGIN
  1537. BLMSG$LN[0] = MSG$BADADR;
  1538. MESSAGE(BLMSG[0],SYSUDF1);
  1539. RESTPFP(PFP$ABORT);
  1540. END
  1541.  
  1542. SCOL=SCOL+1;
  1543. IF C<SCOL,1>DIRLINE NQ COMMA
  1544. THEN
  1545. BEGIN
  1546. BLMSG$LN[0] = MSG$SYNER;
  1547. MESSAGE(BLMSG[0],SYSUDF1);
  1548. RESTPFP(PFP$ABORT);
  1549. END
  1550.  
  1551. SCOL = SCOL+1;
  1552.  
  1553. #
  1554. * LINK M862-S WITH M861-S
  1555. #
  1556.  
  1557. LOOPK = FALSE;
  1558. SLOWFOR J = 1 STEP 1 WHILE NOT LOOPK
  1559. DO
  1560. BEGIN
  1561. IF C<SCOL,1>DIRLINE EQ COMMA
  1562. THEN
  1563. BEGIN
  1564. SCOL = SCOL+1;
  1565. IF J GR MAX$SMCU
  1566. THEN
  1567. BEGIN
  1568. LOOPK = TRUE;
  1569. TEST J;
  1570. END
  1571.  
  1572. TEST J;
  1573. END
  1574.  
  1575. IF ( C<SCOL,2>DIRLINE NQ NM$KEY2[2] ) ##
  1576. AND ( C<SCOL,3>DIRLINE NQ NM$KEY3[8] )
  1577. THEN
  1578. BEGIN
  1579. BLMSG$LN[0] = MSG$STCON;
  1580. MESSAGE(BLMSG[0],SYSUDF1);
  1581. RESTPFP(PFP$ABORT);
  1582. END
  1583.  
  1584. IF C<SCOL,3>DIRLINE EQ NM$KEY3[8]
  1585. THEN
  1586. BEGIN
  1587. LOOPK = TRUE;
  1588. TEST J;
  1589. END
  1590.  
  1591. IF J GR MAX$SMCU
  1592. THEN
  1593. BEGIN
  1594. BLMSG$LN[0] = MSG$BADENT;
  1595. MESSAGE(BLMSG[0],SYSUDF1);
  1596. RESTPFP(PFP$ABORT);
  1597. END
  1598.  
  1599.  
  1600. SCOL = SCOL+2;
  1601. CHAR3 = C<SCOL,3>DIRLINE;
  1602. STAT = XDXB(CHAR3,0,ORD); # ASSUME 3-CHARACTER CU ORDINAL #
  1603. IF STAT NQ 0
  1604. THEN
  1605. BEGIN
  1606. CHAR2 = C<SCOL,2>DIRLINE;
  1607. STAT = XDXB(CHAR2,0,ORD); # ASSUME 2-CHARACTER CU ORDINAL #
  1608. SCOL = SCOL + 2;
  1609. IF STAT NQ 0
  1610. THEN # BAD CONTROLLER ORDINAL #
  1611. BEGIN # EXIT #
  1612. BLMSG$LN[0] = MSG$BADADR;
  1613. MESSAGE(BLMSG[0],SYSUDF1);
  1614. RESTPFP(PFP$ABORT);
  1615. END # EXIT #
  1616.  
  1617. END
  1618.  
  1619. ELSE # BUMP POSITION COUNTER #
  1620. BEGIN # BUMP #
  1621. SCOL = SCOL + 3;
  1622. END # BUMP #
  1623.  
  1624. IF C<SCOL,1>DIRLINE NQ COMMA
  1625. THEN # BAD SYNTAX #
  1626. BEGIN # EXIT #
  1627. BLMSG$LN[0] = MSG$SYNER;
  1628. MESSAGE(BLMSG[0],SYSUDF1);
  1629. RESTPFP(PFP$ABORT);
  1630. END # EXIT #
  1631.  
  1632. SCOL = SCOL + 1;
  1633. LOOPC = FALSE;
  1634. SLOWFOR K = 1 STEP 1 WHILE NOT LOOPC
  1635. DO
  1636. BEGIN
  1637. P<UDT$CN> = LOC(BL$UDT$M862[K]);
  1638. IF UD$ESTO[1] NQ ORD
  1639. THEN
  1640. BEGIN
  1641. IF K GQ MAXCTN
  1642. THEN
  1643. BEGIN
  1644. BLMSG$LN[0] = MSG$STCON;
  1645. MESSAGE(BLMSG[0],SYSUDF1);
  1646. RESTPFP(PFP$ABORT);
  1647. END
  1648.  
  1649. END
  1650.  
  1651. IF UD$ESTO[1] EQ ORD
  1652. THEN
  1653. BEGIN
  1654. LOOPC = TRUE;
  1655. TEST K;
  1656. END
  1657.  
  1658. TEST K;
  1659. END
  1660.  
  1661. #
  1662. * INSERT ACCESSOR DEVICE ADDRESS INTO M861 TABLE
  1663. #
  1664.  
  1665. SM$SUN[1] = ACCESSOR;
  1666.  
  1667. #
  1668. * MOVE ACCESSOR LINKAGE TO M861 TABLE
  1669. #
  1670.  
  1671. K = K-1;
  1672. IF ( SM$STS0[1] NQ 0 ) ##
  1673. AND ( SM$STS1[1] NQ 0 )
  1674. THEN
  1675. BEGIN
  1676. BLMSG$LN[0] = MSG$EXPATH;
  1677. MESSAGE(BLMSG[0],SYSUDF1); # ERROR IN CONFIGURATION FILE #
  1678. RESTPFP(PFP$ABORT);
  1679. END
  1680.  
  1681. IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF0[1] EQ ON
  1682. THEN # AIF-AC PATH FOUND #
  1683. BEGIN # SM #
  1684. B<ACCESSOR*6,6>UD$SMAIF[1] = SMNUM; # LINK SM TO CU #
  1685. END # SM #
  1686.  
  1687. IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF1[1] EQ ON
  1688. THEN # AIF-AC PATH FOUND #
  1689. BEGIN # SM #
  1690. B<ACCESSOR*6,6>UD$SMAIF[1] = SMNUM; # LINK SM TO CU #
  1691. END # SM #
  1692.  
  1693. IF SM$STS0[1] EQ 0
  1694. THEN
  1695. BEGIN
  1696. SM$STS0[1] = SM$FLAG[1];
  1697. SM$CUO0[1] = K;
  1698. TEST J;
  1699. END
  1700.  
  1701. IF SM$STS1[1] EQ 0
  1702. THEN
  1703. BEGIN
  1704. SM$STS1[1] = SM$FLAG[1];
  1705. SM$CUO1[1] = K;
  1706. TEST J;
  1707. END
  1708.  
  1709.  
  1710. END # TEST J #
  1711.  
  1712. #
  1713. * NOW CRACK DRD COMMANDS
  1714. #
  1715.  
  1716. DEVTYPE = NM$KEY3[8];
  1717. NUMCH = 3;
  1718. LOOPK = FALSE;
  1719. SLOWFOR J = 0 STEP 1 WHILE NOT LOOPK
  1720. DO
  1721. BEGIN
  1722. NEXTPRM( DIRLINE,SCOL,DEVTYPE, ##
  1723. NUMCH,ORD,NCOL,STAT,TERMINATOR);
  1724. SAVEDORD = ORD; # IN CASE DRD IS 8-15 #
  1725. IF ORD GR MAX$DRD
  1726. THEN # ALLOW FOR FULL CONFIGURATION #
  1727. BEGIN
  1728. ORD = ORD - MAX$DRD - 1;
  1729. END
  1730.  
  1731. IF STAT NQ 2
  1732. THEN
  1733. BEGIN
  1734. SMDRD ( 1 , ORD , PATH$DF"U$EXISTS" , 1 );
  1735.  
  1736.  
  1737. #
  1738. * VALIDATE ACCESSOR AND DRD DEVICE ADDRESSES
  1739. #
  1740.  
  1741. IF ( ( ACCESSOR EQ 0 ) ##
  1742. AND ( ORD GR 1 ) ) ##
  1743. OR ( ( ACCESSOR EQ 1 ) ##
  1744. AND ( ORD LS 2 OR ORD GR 3 ) ) ##
  1745. OR ( ( ACCESSOR EQ 2 ) ##
  1746. AND ( ORD LS 4 OR ORD GR 5 ) ) ##
  1747. OR ( ( ACCESSOR EQ 3 ) ##
  1748. AND ( ORD LS 6 ) ) ##
  1749. THEN
  1750. BEGIN
  1751. BLMSG$LN[0] = MSG$BADADR;
  1752. MESSAGE ( BLMSG[0] , SYSUDF1 ) ##
  1753. ;
  1754. RESTPFP ( PFP$ABORT );
  1755. END
  1756.  
  1757. #
  1758. * ASSOCIATE EVEN NUMBERED DRD-S WITH FIRST POSITION IN TABLE
  1759. #
  1760.  
  1761. IF ( ORD EQ 0 ) ##
  1762. OR ( ORD EQ 2 ) ##
  1763. OR ( ORD EQ 4 ) ##
  1764. OR ( ORD EQ 6 ) ##
  1765. THEN
  1766. BEGIN
  1767. D0$SUN[1] = SAVEDORD; # STORE TRUE NUMBER #
  1768. END
  1769.  
  1770. ELSE
  1771. BEGIN
  1772. D1$SUN[1] = SAVEDORD; # STORE TRUE NUMBER #
  1773. END
  1774.  
  1775. END
  1776.  
  1777. IF STAT EQ 2
  1778. THEN
  1779. BEGIN
  1780. SCOL = NCOL;
  1781. TEST J;
  1782. END
  1783.  
  1784.  
  1785. IF STAT EQ 1
  1786. THEN
  1787. BEGIN
  1788. SMDRD ( 1 , ORD , PATH$DF"U$ON" , 1 );
  1789. END
  1790.  
  1791.  
  1792. IF TERMINATOR EQ PERIOD
  1793. THEN
  1794. BEGIN
  1795. LOOPK = TRUE;
  1796. TEST J;
  1797. END
  1798.  
  1799. IF J GQ MAX$SMDRD - 1
  1800. THEN
  1801. BEGIN # SEARCH FOR DESTAGE AND STAGE PARAMETERS #
  1802. SCOL = NCOL;
  1803.  
  1804. #
  1805. * CHECK FOR STAGE/DESTAGE DRD PARAMETERS
  1806. #
  1807.  
  1808. IF C<SCOL,3>DIRLINE NQ "DS="
  1809. THEN
  1810. BEGIN # ERROR IN STATMENT #
  1811. BLMSG$LN[0] = MSG$SM$DS;
  1812. MESSAGE(BLMSG[0],SYSUDF1);
  1813. RESTPFP(PFP$ABORT);
  1814. END # ERROR IN STATEMENT #
  1815.  
  1816. SCOL = SCOL + 3;
  1817. CHAR1 = C<SCOL,1>DIRLINE; # GET NUMBER OF DESTAGING DRDS #
  1818. STAT = XDXB(CHAR1,0,TMPI);
  1819. IF STAT NQ 0
  1820. THEN
  1821. BEGIN # NOT A NUMBER #
  1822. BLMSG$LN[0] = MSG$SM$DS;
  1823. MESSAGE(BLMSG[0],SYSUDF1);
  1824. RESTPFP(PFP$ABORT);
  1825. END # NOT A NUMBER #
  1826.  
  1827. IF TMPI LS 1 ##
  1828. OR TMPI GR 2
  1829. THEN
  1830. BEGIN # NUMBER OUT OF RANGE #
  1831. BLMSG$LN[0] = MSG$SM$DS;
  1832. MESSAGE(BLMSG[0],SYSUDF1);
  1833. RESTPFP(PFP$ABORT);
  1834. END # NUMBER OUT OF RANGE #
  1835.  
  1836. SM$DSNUM[1] = TMPI; # NUMBER OF DRDS FOR DESTAGING #
  1837. SCOL = SCOL + 1;
  1838.  
  1839. IF C<SCOL,4>DIRLINE NQ ",ST="
  1840. THEN
  1841. BEGIN # ERROR IN STATEMENT #
  1842. BLMSG$LN[0] = MSG$SM$ST;
  1843. MESSAGE(BLMSG[0],SYSUDF1);
  1844. RESTPFP(PFP$ABORT);
  1845. END # ERROR IN STATEMENT #
  1846.  
  1847. SCOL = SCOL + 4;
  1848. CHAR1 = C<SCOL,1>DIRLINE; # GET NUMBER OF STAGING DRDS #
  1849. STAT = XDXB(CHAR1,0,TMPI);
  1850. IF STAT NQ 0
  1851. THEN
  1852. BEGIN # NOT A NUMBER #
  1853. BLMSG$LN[0] = MSG$SM$ST;
  1854. MESSAGE(BLMSG[0],SYSUDF1);
  1855. RESTPFP(PFP$ABORT);
  1856. END # NOT A NUMBER #
  1857.  
  1858. IF TMPI LS 1 ##
  1859. OR TMPI GR 2
  1860. THEN
  1861. BEGIN # NUMBER OUT OF RANGE #
  1862. BLMSG$LN[0] = MSG$SM$ST;
  1863. MESSAGE(BLMSG[0],SYSUDF1);
  1864. RESTPFP(PFP$ABORT);
  1865. END # NUMBER OUT OF RANGE #
  1866.  
  1867. SM$STNUM[1] = TMPI; # NUMBER OF DRDS FOR STAGING #
  1868. LOOPK = TRUE;
  1869. TEST J;
  1870. END # SEARCH FOR DESTAGE AND STAGE PARAMETERS #
  1871.  
  1872. SCOL = NCOL;
  1873. END # TEST J #
  1874.  
  1875. #
  1876. * MOVE DRC/DRD PATH STATUS TO DRD TABLE
  1877. #
  1878.  
  1879. #
  1880. * NOTE:
  1881. * IF THERE ARE TWO SEPERATE M862-S CONNECTED TO THE SAME M861 SM,
  1882. * THEN THE SECOND M862 ( FROM THE START OF THE BUDT ) INTO THE SM
  1883. * IS ( BY DEFINITION ) THE SECOND CU IN THE SM TABLE. HENCE, IT CAN
  1884. * ONLY INTERFACE TO THE *STSS* PATH IN THE *DRD* TABLES.
  1885. #
  1886. P<UDT$CN> = LOC(BL$UDT$M862[1]);
  1887. IF SM$CNT0[1] NQ 0
  1888. THEN
  1889. BEGIN # CU0/DRD LINKUP #
  1890. IF D0$EXIST[1]
  1891. THEN # UPPER DRD EXISTS #
  1892. BEGIN # UPPER #
  1893. B<PATH$DF"U$EXISTS",1>D0$STSP[1] = 1;
  1894. UPDRDST(D0$SUN[1],SM$CUO0[1]);
  1895. END # UPPER #
  1896.  
  1897. IF D1$EXIST[1]
  1898. THEN # LOWER DRD EXISTS #
  1899. BEGIN # LOWER #
  1900. B<PATH$DF"U$EXISTS",1>D1$STSP[1] = 1;
  1901. UPDRDST(D1$SUN[1],SM$CUO0[1]);
  1902. END # LOWER #
  1903.  
  1904. END # CU0/DRD LINKUP #
  1905.  
  1906. IF SM$CNT1[1] NQ 0
  1907. THEN
  1908. BEGIN # CU1/DRD LINKUP #
  1909. IF D0$EXIST[1]
  1910. THEN # UPPER DRD EXISTS #
  1911. BEGIN # UPPER #
  1912. B<PATH$DF"U$EXISTS",1>D0$STSS[1] = 1;
  1913. UPDRDST(D0$SUN[1],SM$CUO1[1]);
  1914. END # UPPER #
  1915.  
  1916. IF D1$EXIST[1]
  1917. THEN # LOWER DRD EXISTS #
  1918. BEGIN # LOWER #
  1919. B<PATH$DF"U$EXISTS",1>D1$STSS[1] = 1;
  1920. UPDRDST(D1$SUN[1],SM$CUO1[1]);
  1921. END # LOWER #
  1922.  
  1923. END # CU1/DRD LINKUP #
  1924.  
  1925. TEST DIRNUM;
  1926.  
  1927. END # TEST DIRNUM #
  1928.  
  1929. IF NUM$CU NQ CUNUM
  1930. THEN
  1931. BEGIN
  1932. BLMSG$LN[0] = MSG$INCCU;
  1933. MESSAGE(BLMSG[0],SYSUDF1);
  1934. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP ANF^D ABORT #
  1935. END
  1936.  
  1937. IF NUM$SM NQ SMNUM
  1938. THEN
  1939. BEGIN
  1940. BLMSG$LN[0] = MSG$INCSM;
  1941. MESSAGE(BLMSG[0],SYSUDF1);
  1942. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  1943. END
  1944.  
  1945. RETERN(BL$FET[0],RCL);
  1946. END # RDSUDT #
  1947.  
  1948. TERM
  1949. PROC NEXTLIN(DIRLINE,STAT,INDEX);
  1950.  
  1951. # TITLE NEXTLIN - READ NEXT LINE OF CONFIGURATION SOURCE FILE. #
  1952.  
  1953. BEGIN # NEXTLIN #
  1954.  
  1955.  
  1956. #
  1957. *** PROC TO READ ONE LINE OF DATA FROM DATA ALREADY IN A FET.
  1958. * *NEXTLIN* READS A LINE (WHICH IS AN *SSBLD* CONFIGURATION
  1959. * FILE DIRECTIVE). THE PROC READS CARDS UNTIL IT FINDS ONE THAT
  1960. * IS NOT A COMMENT CARD. IT CHECKS FOR END OF RECORD AND
  1961. * VALID CONFIGURATION FILE NMEMONIC.
  1962. *
  1963. * ENTRY - NONE.
  1964. *
  1965. * EXIT
  1966. *
  1967. * DIRLINE = CONFIGURATION FILE IMAGE
  1968. * STAT = STATUS RESPONSE FROM *READC*
  1969. * INDEX = INDEX INTO NM$KEY ARRAY ( DIRECTIVE ORDINAL )
  1970. *
  1971. * MESSAGES
  1972. *
  1973. * NEXTLIN - INCORRECT SSBLD MNEMONIC.
  1974. *
  1975. #
  1976.  
  1977. #
  1978. * PROC NEXTLIN - XREF LIST BEGIN.
  1979. #
  1980.  
  1981. XREF
  1982. BEGIN
  1983. PROC BZFILL; # BLANK ZERO FILL #
  1984. PROC MESSAGE; # ISSUE MESSAGE #
  1985. PROC READC; # READ ONE LINE #
  1986. PROC RESTPFP; # RESTORE USER-S PFP #
  1987. PROC ZFILL; # ZERO FILL PROC #
  1988. END
  1989.  
  1990. #
  1991. * PROC NEXTLIN - XREF LIST END.
  1992. #
  1993.  
  1994. ITEM DIRLINE C(90); # DIRECTIVE TEXT LINE #
  1995. ITEM STAT I; # RETURN STATUS #
  1996. ITEM INDEX I; # ARRAY INDEX #
  1997.  
  1998.  
  1999.  
  2000. DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
  2001. *CALL COMBFAS
  2002. *CALL COMBBZF
  2003. *CALL COMBFET
  2004. *CALL COMBUDT
  2005. *CALL COMSPFM
  2006. *CALL COMTBLD
  2007.  
  2008. ITEM COMMENT B; # COMMENT INDICATOR #
  2009. ITEM EOR B; # STATUS VARIABLE FOR *READC* #
  2010. ITEM I I; # LOOP VARIABLE #
  2011. ITEM KEYOK B; # CONTROL VARIABLE #
  2012. ITEM KEY2 C(2); # 2 CHARACTER DIRECTIVE KEYWORD #
  2013. ITEM KEY3 C(4); # 3 CHARACTER DIRECTIVE KEYWORD #
  2014. ITEM DIRNUM I; # LOOP INDEX #
  2015. CONTROL EJECT;
  2016.  
  2017. #
  2018. * READ ONE (NON-COMMENT) DIRECTIVE.
  2019. #
  2020.  
  2021. EOR = FALSE;
  2022.  
  2023. SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR
  2024. DO
  2025. BEGIN # PROCESS NEXT DIRECTIVE #
  2026. DIRLINE = " "; # ERASE PREVIOUS LINE #
  2027. READC(BL$FET[0],DIRLINE,9,STAT);
  2028. BZFILL(DIRLINE,TYPFILL"BFILL",90);
  2029. C<89,1>DIRLINE = PERIOD;
  2030. IF STAT NQ 0
  2031. THEN
  2032. BEGIN
  2033. EOR = TRUE;
  2034. RETURN;
  2035. END
  2036.  
  2037. IF C<0,1>DIRLINE NQ "*"
  2038. THEN # NOT COMMENT #
  2039. BEGIN
  2040. EOR = TRUE;
  2041. TEST DIRNUM;
  2042. BLMSG$LN=DIRNUM;
  2043. MESSAGE(BLMSG[0],SYSUDF1);
  2044. END
  2045.  
  2046. TEST DIRNUM;
  2047. END
  2048.  
  2049. KEY2 = C<0,2>DIRLINE;
  2050. KEY3 = C<0,3>DIRLINE;
  2051. KEYOK = FALSE;
  2052. SLOWFOR I=1 STEP 1 WHILE (NOT KEYOK) AND (I LQ BLLM)
  2053. DO
  2054. BEGIN
  2055. IF ( KEY2 EQ NM$KEY2[1] ) ##
  2056. OR ( KEY2 EQ NM$KEY2[2] ) ##
  2057. OR ( KEY2 EQ NM$KEY2[10] ) ##
  2058. OR ( KEY2 EQ NM$KEY2[11] ) ##
  2059. THEN
  2060. BEGIN
  2061. IF KEY2 EQ NM$KEY2[I]
  2062. THEN
  2063. BEGIN
  2064. INDEX=I-1;
  2065. KEYOK = TRUE;
  2066. TEST I;
  2067. END
  2068.  
  2069. END
  2070.  
  2071. ELSE
  2072. BEGIN
  2073. IF KEY3 EQ NM$KEY3[I]
  2074. THEN
  2075. BEGIN
  2076. INDEX = I-1;
  2077. KEYOK = TRUE;
  2078. TEST I;
  2079. END
  2080.  
  2081. END
  2082.  
  2083. TEST I;
  2084. END
  2085.  
  2086. IF NOT KEYOK
  2087. THEN
  2088. BEGIN
  2089. BLMSG$LN[0] = " NEXTLIN - INCORRECT SSBLD MNEMONIC.";
  2090. MESSAGE(BLMSG[0],SYSUDF1); # ERROR MESSAGE #
  2091. RESTPFP(PFP$ABORT); # RESTORE USER-S PFP AND ABORT #
  2092. END
  2093.  
  2094.  
  2095. END # NEXTLIN #
  2096.  
  2097. TERM
  2098.  
  2099. PROC NEXTPRM(DIRLINE,SCOL,DEVTYPE,NUMCH,ORD,NCOL,STAT,TERMINATOR);
  2100.  
  2101. # TITLE NEXTPRM - CRACK NEXT LINE OF SOURCE FILE DIRECTIVES. #
  2102.  
  2103. BEGIN # NEXTPRM #
  2104.  
  2105.  
  2106. #
  2107. *** PROC TO CRACK EVERYTHING TO THE RIGHT OF THE FIRST *=* SIGN
  2108. * IN A *SSBLD* SOURCE FILE DIRECTIVE.
  2109. *
  2110. * ENTRY
  2111. *
  2112. * DIRLINE = CONFIGURATION SOURCE FILE DIRECTIVE
  2113. * SCOL = COLUMN OF DIRECTIVE IN WHICH TO START SEARCH
  2114. * DEVTYPE = NMEMONIC BEING SEARCHED FOR
  2115. * NUMCH = NUMBER OF CHARACTERS IN DEVTYPE
  2116. *
  2117. * EXIT
  2118. *
  2119. * ORD = ORDINAL OF DEVTYPE ON SOURCE LINE
  2120. * NCOL = NUMBER OF THE NEXT COLUMN FOLLOWING TERMINATOR.
  2121. * STAT = STATUS OF DEVTYPE IN THE DIRECTIVE ( ON/OFF/NON-EXISTEXT )
  2122. * TERMINATOR = THE TERMINATOR FOUND ( EITHER *,* OR *.* )
  2123. *
  2124. * MESSAGES
  2125. *
  2126. * NEXTPRM - INCORRECT MNEMONIC.
  2127. * NEXTPRM - ORDINAL INCORRECT.
  2128. * NEXTPRM - INCORRECT DRD ORDINAL.
  2129. * NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE.
  2130. * NEXTPRM - INCORRECT CHANNEL NUMBER.
  2131. * NEXTPRM - INCORRECT *SM* ORDINAL.
  2132. * NEXTPRM - INCORRECT *CU* EST ORDINAL.
  2133. * NEXTPRM - MISSING EQUAL SIGN.
  2134. * NEXTPRM - INCORRECT DIRECTIVE STATUS.
  2135. * NEXTPRM - INCORRECT TERMINATOR.
  2136. *
  2137. #
  2138.  
  2139. ITEM DIRLINE C(90); # DIRECTIVE LINE INPUT #
  2140. ITEM SCOL I; # STARTING COLUMN #
  2141. ITEM DEVTYPE C(3); # DEVICE TYPE #
  2142. ITEM NUMCH I; # NUMBER OF CHARACTERS #
  2143. ITEM ORD I; # DEVTYPE ORDINAL #
  2144. ITEM NCOL I; # NEXT COLUMN #
  2145. ITEM STAT I; # STATUS
  2146.   -0=OFF,1=ON,2=NON-EXISTENT #
  2147. ITEM TERMINATOR C(1); # TERMINATING CHARACTER #
  2148.  
  2149. #
  2150. * PROC NEXTPRM - XREF LIST BEGIN.
  2151. #
  2152.  
  2153. XREF
  2154. BEGIN
  2155. PROC MESSAGE; # ISSUE MESSAGE #
  2156. PROC RESTPFP; # RESTORE USER-S PFP #
  2157. FUNC XDXB; # CONVERT DISPLAY CODE TO BINARY #
  2158. END
  2159.  
  2160. #
  2161. * PROC NEXTPRM - XREF LIST END.
  2162. #
  2163.  
  2164. DEF MSG$BADORD #" NEXTPRM - ORDINAL INCORRECT."#;
  2165. DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
  2166. *CALL COMBFAS
  2167. *CALL COMBUDT
  2168. *CALL COMTBLD
  2169.  
  2170.  
  2171. ITEM LOOPC B; # LOOP CONTROL #
  2172. ITEM I I; # LOOP INDEX #
  2173. ITEM TMPC C(2); # CHARACTER SCRATCH CELL #
  2174. ITEM TMPI I; # SCRATCH INTEGER #
  2175. CONTROL EJECT;
  2176.  
  2177. #
  2178. * GET NEXT NON-BLANK CHARACTER
  2179. #
  2180.  
  2181. LOOPC = FALSE;
  2182. SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
  2183. DO
  2184. BEGIN
  2185.  
  2186. IF C<SCOL,1>DIRLINE EQ " "
  2187. THEN
  2188. BEGIN
  2189. SCOL = SCOL+1;
  2190. TEST I;
  2191. END
  2192.  
  2193.  
  2194. LOOPC = TRUE;
  2195. TEST I;
  2196. END
  2197.  
  2198. #
  2199. * CHECK DIRECTIVE NMEMONIC
  2200. #
  2201.  
  2202. IF ( C<SCOL,NUMCH>DIRLINE NQ C<0,NUMCH>DEVTYPE ) ##
  2203. AND ( C<SCOL,1>DIRLINE NQ COMMA ) ##
  2204. AND ( C<SCOL,1>DIRLINE NQ PERIOD ) ##
  2205. THEN
  2206. BEGIN
  2207. BLMSG$LN[0] = " NEXTPRM - INCORRECT MNEMONIC.";
  2208. GOTO ERRORPRM;
  2209. END
  2210.  
  2211. #
  2212. * CHECK FOR COMMA OR PERIOD( IMPLIES NON-EXISTENT ENTRY ).
  2213. #
  2214.  
  2215. IF( C<SCOL,1>DIRLINE EQ COMMA ) ##
  2216. OR ( C<SCOL,1>DIRLINE EQ PERIOD )
  2217. THEN
  2218. BEGIN
  2219. STAT = 2;
  2220. ORD = 0;
  2221. GOTO TERMINATE;
  2222. END
  2223.  
  2224. #
  2225. * REMOVE EMBEDDED BLANKS
  2226. #
  2227.  
  2228. SCOL = SCOL+NUMCH;
  2229. LOOPC = FALSE;
  2230. SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
  2231. DO
  2232. BEGIN
  2233. IF C<SCOL,1>DIRLINE EQ " "
  2234. THEN
  2235. BEGIN
  2236. SCOL = SCOL+1;
  2237. TEST I;
  2238. END
  2239.  
  2240. LOOPC = TRUE;
  2241. TEST I;
  2242. END
  2243.  
  2244. #
  2245. * GET AND VALIDATE ORDINAL
  2246. #
  2247.  
  2248.  
  2249. IF( C<0,NUMCH>DEVTYPE NQ NM$KEY2[2] ) ##
  2250. AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[10] ) ##
  2251. AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[1] ) ##
  2252. THEN
  2253. BEGIN
  2254. TMPC = C<3,1>DIRLINE;
  2255. STAT = XDXB(TMPC,1,ORD);
  2256. IF C<0,3>DIRLINE EQ NM$KEY3[7]
  2257. AND ORD GQ 2
  2258. THEN
  2259. BEGIN # EXPANDED DRD CONFIGURATION #
  2260. TMPC = C<SCOL,1>DIRLINE;
  2261. STAT = XDXB(TMPC,1,ORD);
  2262. IF STAT NQ 0
  2263. THEN
  2264. BEGIN
  2265. BLMSG$LN[0] = MSG$BADORD;
  2266. GOTO ERRORPRM;
  2267. END
  2268.  
  2269. IF ORD EQ 1
  2270. THEN
  2271. BEGIN # DRD DEVICE ADDRESS IS 2 DIGITS #
  2272. TMPC = C<SCOL,2>DIRLINE;
  2273. STAT = XDXB(TMPC,1,ORD);
  2274. IF STAT NQ 0
  2275. THEN
  2276. BEGIN
  2277. BLMSG$LN[0] = MSG$BADORD;
  2278. GOTO ERRORPRM;
  2279. END
  2280.  
  2281. SCOL = SCOL + 1;
  2282. END # DRD DEVICE ADDRESS IS 2 DIGITS #
  2283.  
  2284. END # EXPANDED DRD CONFIGURATION #
  2285.  
  2286. ELSE
  2287. BEGIN # STANDARD DRD CONFIGURATION #
  2288. TMPC = C<SCOL+1,1>DIRLINE;
  2289. STAT = XDXB(TMPC,1,ORD);
  2290. IF STAT NQ 0
  2291. THEN # ORDINAL IS 1 DIGIT LONG #
  2292. BEGIN # ONE #
  2293. TMPC = C<SCOL,1>DIRLINE;
  2294. END # ONE #
  2295.  
  2296. ELSE # ORDINAL IS 2 DIGITS LONG #
  2297. BEGIN # TWO #
  2298. TMPC = C<SCOL,2>DIRLINE;
  2299. SCOL = SCOL + 1; # PRESET FOR NEXT CHARACTER #
  2300. END # TWO #
  2301.  
  2302. STAT = XDXB(TMPC,1,ORD); # GET DRD ORDINAL #
  2303. IF STAT NQ 0
  2304. THEN
  2305. BEGIN
  2306. BLMSG$LN[0] = MSG$BADORD;
  2307. GOTO ERRORPRM;
  2308. END
  2309.  
  2310. END # STANDARD DRD CONFIGURATION #
  2311.  
  2312. IF NUMCH EQ 3
  2313. THEN
  2314. BEGIN
  2315. IF C<0,3>DEVTYPE EQ NM$KEY3[8]
  2316. THEN
  2317. BEGIN
  2318. IF ( ORD LS 0 ) OR ( ORD GR MAX$DRDDA )
  2319. THEN
  2320. BEGIN
  2321. BLMSG$LN[0] = " NEXTPRM - INCORRECT DRD ORDINAL.";
  2322. GOTO ERRORPRM;
  2323. END
  2324.  
  2325. END
  2326.  
  2327. END
  2328.  
  2329. IF ( ( ORD LS 0 ) OR ( ORD GR MAX$DRC ) ) ##
  2330. AND ( C<0,3>DEVTYPE NQ NM$KEY3[8] )
  2331. THEN
  2332. BEGIN
  2333. BLMSG$LN[0] = " NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE.";
  2334. GOTO ERRORPRM;
  2335. END
  2336.  
  2337. SCOL = SCOL+1;
  2338.  
  2339. END
  2340.  
  2341. ELSE
  2342. BEGIN
  2343. IF C<0,2>DEVTYPE EQ NM$KEY2[1]
  2344. THEN
  2345. BEGIN
  2346. TMPC = C<SCOL,2>DIRLINE;
  2347. STAT = XDXB(TMPC,0,ORD);
  2348. IF STAT NQ 0
  2349. THEN
  2350. BEGIN
  2351. BLMSG$LN[0] = MSG$BADORD;
  2352. GOTO ERRORPRM;
  2353. END
  2354.  
  2355. IF (( ORD GR O"13" ) AND ( ORD LS O"20" )) ##
  2356. OR ( ORD GR O"33")
  2357. THEN
  2358. BEGIN
  2359. BLMSG$LN[0] = " NEXTPRM - INCORRECT CHANNEL NUMBER.";
  2360. GOTO ERRORPRM;
  2361. END
  2362.  
  2363. SCOL = SCOL+2;
  2364. END
  2365.  
  2366. IF C<0,2>DEVTYPE EQ NM$KEY2[10]
  2367. THEN
  2368. BEGIN
  2369. TMPC = C<SCOL,1>DIRLINE;
  2370. STAT = XDXB(TMPC,0,ORD);
  2371. IF STAT NQ 0
  2372. THEN
  2373. BEGIN
  2374. BLMSG$LN[0] = MSG$BADORD;
  2375. GOTO ERRORPRM;
  2376. END
  2377.  
  2378. IF (ORD LS 0) OR (ORD GR 7)
  2379. THEN
  2380. BEGIN
  2381. BLMSG$LN[0] = "NEXTPRM - INCORRECT *SM* ORDINAL.";
  2382. GOTO ERRORPRM;
  2383. END
  2384.  
  2385. SCOL = SCOL+1;
  2386. END
  2387.  
  2388. IF C<0,2>DEVTYPE EQ NM$KEY2[2]
  2389. THEN
  2390. BEGIN
  2391. TMPC = C<SCOL,2>DIRLINE;
  2392. STAT = XDXB(TMPC,0,ORD);
  2393. IF STAT NQ 0
  2394. THEN
  2395. BEGIN
  2396. BLMSG$LN[0] = MSG$BADORD;
  2397. GOTO ERRORPRM;
  2398. END
  2399.  
  2400. IF (ORD LS 10 ) OR ( ORD GR O"77" )
  2401. THEN
  2402. BEGIN
  2403. BLMSG$LN[0] = " NEXTPRM - INCORRECT *CU* ORDINAL.";
  2404. GOTO ERRORPRM;
  2405. END
  2406.  
  2407. SCOL = SCOL + 2;
  2408. END
  2409.  
  2410. IF ( C<0,2>DEVTYPE EQ "ON" ) ##
  2411. OR ( C<0,3>DEVTYPE EQ "OFF" )
  2412. THEN
  2413. BEGIN
  2414. GOTO TERMINATE;
  2415. END
  2416.  
  2417. END
  2418.  
  2419. #
  2420. * FIND NEXT NON-BLANK CHARACTER
  2421. #
  2422.  
  2423. LOOPC = FALSE;
  2424. SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
  2425. DO
  2426. BEGIN
  2427. IF C<SCOL,1>DIRLINE EQ " "
  2428. THEN
  2429. BEGIN
  2430. SCOL = SCOL + 1;
  2431. TEST I;
  2432. END
  2433.  
  2434. LOOPC = TRUE;
  2435. TEST I;
  2436. END
  2437.  
  2438. IF C<SCOL,1>DIRLINE NQ "="
  2439. THEN
  2440. BEGIN
  2441. BLMSG$LN[0] = " NEXTPRM - MISSING EQUAL SIGN.";
  2442. GOTO ERRORPRM;
  2443. END
  2444.  
  2445. SCOL = SCOL + 1;
  2446.  
  2447. #
  2448. * FIND NEXT NON-BLANK CHARACTER
  2449. #
  2450.  
  2451. LOOPC = FALSE;
  2452. SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
  2453. DO
  2454. BEGIN
  2455. IF C<SCOL,1>DIRLINE EQ " "
  2456. THEN
  2457. BEGIN
  2458. SCOL = SCOL +1;
  2459. TEST I;
  2460. END
  2461.  
  2462. LOOPC = TRUE;
  2463. TEST I;
  2464. END
  2465.  
  2466. IF( C<SCOL,2>DIRLINE NQ "ON" ) ##
  2467. AND ( C<SCOL,3>DIRLINE NQ "OFF" )
  2468. THEN
  2469. BEGIN
  2470. BLMSG$LN[0] = " NEXTPRM - INCORRECT DIRECTIVE STATUS.";
  2471. GOTO ERRORPRM;
  2472. END
  2473.  
  2474. IF C<SCOL,2>DIRLINE EQ "ON"
  2475. THEN
  2476. BEGIN
  2477. STAT = 1;
  2478. SCOL = SCOL+2;
  2479. END
  2480.  
  2481. ELSE
  2482. BEGIN
  2483. STAT = 0;
  2484. SCOL = SCOL + 3;
  2485. END
  2486.  
  2487.  
  2488. TERMINATE:
  2489.  
  2490. LOOPC = FALSE;
  2491. SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
  2492. DO
  2493. BEGIN
  2494. IF C<SCOL,1>DIRLINE EQ " "
  2495. THEN
  2496. BEGIN
  2497. SCOL = SCOL + 1;
  2498. TEST I;
  2499. END
  2500.  
  2501. LOOPC = TRUE;
  2502. TEST I;
  2503. END
  2504.  
  2505. IF( C<SCOL,1>DIRLINE NQ COMMA ) ##
  2506. AND ( C<SCOL,1>DIRLINE NQ PERIOD )
  2507. THEN
  2508. BEGIN
  2509. BLMSG$LN[0] = " NEXTPRM - INCORRECT TERMINATOR.";
  2510. GOTO ERRORPRM;
  2511. END
  2512.  
  2513. TERMINATOR = C<SCOL,1>DIRLINE;
  2514. NCOL = SCOL+1;
  2515. RETURN;
  2516.  
  2517. ERRORPRM:
  2518. MESSAGE(BLMSG[0],SYSUDF1);
  2519. RESTPFP(PFP$ABORT);
  2520.  
  2521. END # NEXTPRM #
  2522.  
  2523. TERM
  2524. PROC UPDRDST(DRD,CONTORD);
  2525.  
  2526. # TITLE UPDRDST - UPDATE DRD STATUS ACCORDING TO PATH STATUS #
  2527.  
  2528. BEGIN # UPDRDST #
  2529.  
  2530. #
  2531. *** UPDATE TRUE STATUS OF A DRD
  2532. *
  2533. * THE TRUE STATUS OF A DRD (ON/OFF) AT INITIALIZATION
  2534. * TIME DEPENDS ON THE STATUS OF THE PATHS LEADING TO
  2535. * IT FROM THE DIF-S AND DRC-S. IF ALL PATHS LEADING TO THE DRD
  2536. * ARE OFF, THEN THIS PROC WILL SET THE INITIAL STATUS
  2537. * OF THE DRD TO BE OFF REGARDLESS OF WHAT THE SSBLD
  2538. * DIRECTIVE SAYS.
  2539. *
  2540. * ENTRY DRD = DRD ORDINAL.
  2541. * CONTORD = CONTROLLER ORDINAL TO SCAN FOR PATH.
  2542. *
  2543. * EXIT DRD STATUS UPDATED IF NECESSARY.
  2544. *
  2545. * MESSAGES NONE.
  2546. #
  2547.  
  2548. ITEM CONTORD U; # CONTROLLER ORDINAL #
  2549. ITEM DRD U; # DRD NUMBER #
  2550.  
  2551. DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
  2552.  
  2553. *CALL,COMBFAS
  2554. *CALL,COMBUDT
  2555.  
  2556. ITEM FIRSTDRC U; # FIRST DRC TO SCAN FOR PATH #
  2557. ITEM I U; # LOOP INDEX #
  2558. ITEM J U; # LOOP INDEX #
  2559.  
  2560. CONTROL EJECT;
  2561. CONTROL INERT;
  2562.  
  2563. #
  2564. * ONLY DRC-S 0 AND 1 CAN CONNECT TO DRD-S 0-7.
  2565. * ONLY DRC-S 2 AND 3 CAN CONNECT TO DRD-S 8-15.
  2566. #
  2567.  
  2568. FIRSTDRC = 0; # ASSUME CHECKING DRC-S 0 AND 1 #
  2569. IF DRD GQ 8
  2570. THEN # DRD CONNECTED TO OTHER DRC PAIR #
  2571. BEGIN # RESET #
  2572. FIRSTDRC = 2; # CHECK DRC-S 2 AND 3 #
  2573. END # RESET #
  2574.  
  2575. #
  2576. * SET THE PASSED DRD AS ON WITH RESPECT TO THE PASSED CONTROLLER
  2577. * IF A DIF-DRC-DRD PATH CAN BE FOUND THAT IS ON FROM A
  2578. * DIF IN THE PASSED CU TO THE PASSED DRD.
  2579. *
  2580. * NOTE: ALL CONTROLLERS ARE SEARCHED FOR A VALID DRC-DRD
  2581. * PATH, SINCE DRC-S ARE INDEPENDENT OF THE CONTROLLERS
  2582. * THEY RESIDE IN.
  2583. *
  2584. #
  2585.  
  2586. SLOWFOR I = 1 STEP 1 UNTIL MAXCTN
  2587. DO # SEARCH ALL CU-S FOR DRC-S #
  2588. BEGIN # CU #
  2589. SLOWFOR J = FIRSTDRC STEP 1 UNTIL (FIRSTDRC + 1)
  2590. DO # CHECK BOTH DRC-S #
  2591. BEGIN # DRC #
  2592. P<PTHSTAT> = LOC(UD$DRCP0[I]) + J; # LOCATE DRC #
  2593. IF PATHBIT(B<57,3>DRD,PATH$DF"U$EXISTS") EQ 1 ##
  2594. AND PATHBIT(B<57,3>DRD,PATH$DF"U$ON") EQ 1 # DRC-DRD ON #
  2595. AND ((B<J*6+PATH$DF"U$EXISTS",1>UD$DIF0[CONTORD] EQ 1 ##
  2596. AND B<J*6+PATH$DF"U$ON",1>UD$DIF0[CONTORD] EQ 1)
  2597. # DIF0-DRC PATH FOUND ON #
  2598. OR (B<J*6+PATH$DF"U$EXISTS",1>UD$DIF1[CONTORD] EQ 1 ##
  2599. AND B<J*6+PATH$DF"U$ON",1>UD$DIF1[CONTORD] EQ 1))
  2600. # DIF1-DRC PATH FOUND ON #
  2601. THEN # DRD CONFIRMED ON TO CONTROLLER #
  2602. BEGIN # DRD ON #
  2603. IF CONTORD EQ SM$CUO0[1]
  2604. THEN # SET DRD ON TO PRIMARY CU #
  2605. BEGIN # PRIMARY #
  2606. IF B<59,1>DRD EQ 0 AND D0$ON[1]
  2607. THEN # EVEN-NUMBERED DRD CHECKED #
  2608. BEGIN # EVEN #
  2609. B<PATH$DF"U$ON",1>D0$STSP[1] = 1;
  2610. END # EVEN #
  2611.  
  2612. IF B<59,1>DRD EQ 1 AND D1$ON[1]
  2613. THEN # ODD-NUMBERED DRD CHECKED #
  2614. BEGIN # ODD #
  2615. B<PATH$DF"U$ON",1>D1$STSP[1] = 1;
  2616. END # ODD #
  2617.  
  2618. END # PRIMARY #
  2619.  
  2620. ELSE # SET DRD ON TO SECONDARY CU #
  2621. BEGIN # SECONDARY #
  2622. IF B<59,1>DRD EQ 0 AND D0$ON[1]
  2623. THEN # EVEN-NUMBERED DRD CHECKED #
  2624. BEGIN # EVEN #
  2625. B<PATH$DF"U$ON",1>D0$STSS[1] = 1;
  2626. END # EVEN #
  2627.  
  2628. IF B<59,1>DRD EQ 1 AND D1$ON[1]
  2629. THEN # ODD-NUMBERED DRD CHECKED #
  2630. BEGIN # ODD #
  2631. B<PATH$DF"U$ON",1>D1$STSS[1] = 1;
  2632. END # ODD #
  2633.  
  2634. END # SECONDARY #
  2635.  
  2636. RETURN; # SEARCH COMPLETE #
  2637. END # DRD ON #
  2638.  
  2639. END # DRC #
  2640.  
  2641. END # CU #
  2642.  
  2643. CONTROL REACTIVE;
  2644.  
  2645. IF B<59,1>DRD EQ 0
  2646. THEN # EVEN-NUMBERED DRD FOUND OFF #
  2647. BEGIN # OFF #
  2648. D0$FLAG[1] = D0$STSP[1] LOR D0$STSS[1]; # IN CASE OFF TO BOTH #
  2649. END # OFF #
  2650.  
  2651. ELSE # ODD-NUMBERED DRD FOUND OFF #
  2652. BEGIN # OFF #
  2653. D1$FLAG[1] = D1$STSP[1] LOR D1$STSS[1]; # IN CASE OFF TO BOTH #
  2654. END # OFF #
  2655.  
  2656. CONTROL INERT;
  2657.  
  2658. END # UPDRDST #
  2659.  
  2660. TERM
  2661. PROC WTBUDT;
  2662.  
  2663.  
  2664. # TITLE WTBUDT - WRITE SSBLD GENERATED UDT TO DISK FILE #
  2665.  
  2666. BEGIN # WTBUDT #
  2667.  
  2668. #
  2669. *** WTBUDT - WRITE UDT TO PERMANENT FILE.
  2670. *
  2671. * TWTBUDT WRITES THE SSBLD GENERATED UDT TO THE SSEXEC
  2672. * ACCESSIBLE PERMANENT FILE. THE DEFAULT FLIE NAME IS *BUDT*.
  2673. *
  2674. * PROC WTBUDT.
  2675. *
  2676. * ENTRY - NONE.
  2677. *
  2678. * EXIT - UDT WRITTEN TO THE PERMANENT FILE.
  2679. *
  2680. * MESSAGES
  2681. *
  2682. * WTBUDT - CIO ERROR.
  2683. * WTBUDT - DEVICE FULL FOR UDT FILE.
  2684. *
  2685. * NOTES
  2686. #
  2687.  
  2688. #
  2689. **** PROC WTBUDT - XREF LIST BEGIN.
  2690. #
  2691.  
  2692. XREF
  2693. BEGIN
  2694. PROC BZFILL; # BLANK OR ZERO FILL AN ITEM #
  2695. PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE #
  2696. PROC RESTPFP; # RESTORE USER-S PFP AND ABORT #
  2697. PROC RETERN; # RETURNS A FILE #
  2698. PROC REWIND; # REWINDS A FILE #
  2699. PROC WRITE; # WRITE DATA TO DISK #
  2700. PROC WRITEF; # WRITE EOF ON DISK FILE #
  2701. PROC WRITER; # WRITES EOR ON A FILE #
  2702. PROC WRITEW; # DATA TRANSFER ROUTINE #
  2703. PROC ZFILL; # ZERO FILLS A BUFFER #
  2704. PROC ZSETFET; # SETS UP A FET #
  2705. END
  2706.  
  2707. #
  2708. **** PROC WTBUDT - XREF LIST END.
  2709. #
  2710.  
  2711. DEF MSG$CIOERR #"WTBUDT - CIO ERROR."#;
  2712. DEF MSG$DSKFULL #"WTBUDT - DEVICE FULL FOR UDT FILE."#;
  2713.  
  2714. DEF LISTCON #0#; # DO NOT LIST THE COMMON DECKS #
  2715. *CALL,COMBFAS
  2716. *CALL,COMBBZF
  2717. *CALL,COMBFET
  2718. *CALL,COMBUDT
  2719. *CALL,COMSPFM
  2720. *CALL,COMTBLD
  2721. *CALL,COMTBLP
  2722. *CALL,COMTOUT
  2723.  
  2724. ITEM BUFP I; # FWA OF BUFFER #
  2725. ITEM FETP I; # FET POINTER #
  2726. ITEM TMPI I;
  2727. ITEM TMPJ I;
  2728. ITEM TMPK I;
  2729. ITEM LFN C(7); # FILE NAME #
  2730. ITEM STAT I; # INTEGER STATUS VARIABLE #
  2731.  
  2732. CONTROL EJECT;
  2733.  
  2734. #
  2735. * SET UP THE FET FOR UDT BINARY AND REWIND IT.
  2736. #
  2737.  
  2738. LFN = DARG$BF[0];
  2739. BZFILL(LFN,TYPFILL"ZFILL",7);
  2740. FETP = LOC(BL$FET[0]);
  2741. BUFP = LOC(BL$BUF[0]);
  2742. ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL);
  2743. REWIND(BL$FET[0],RCL);
  2744. P<BL$UDT$LOC> = LOC(BL$UDT$HDR);
  2745.  
  2746. #
  2747. * WRITE THE FILE TO *CIO* BUFFER
  2748. #
  2749.  
  2750. WRITEW(BL$FET[0],BL$UDT$LOC[0],LARCUDTLTM,STAT);
  2751.  
  2752. #
  2753. * WRITE UDT TO DISK
  2754. #
  2755.  
  2756. WRITE(BL$FET[0],RCL);
  2757. WRITER(BL$FET[0],RCL);
  2758. WRITEF(BL$FET[0],RCL);
  2759. REWIND(BL$FET[0],RCL);
  2760. RETERN(BL$FET[0],RCL);
  2761.  
  2762. END # WTBUDT #
  2763.  
  2764. TERM
cdc/nos2.source/opl871/ssbld.txt ยท Last modified: 2023/08/05 17:24 by Site Administrator