C PROGRAM DOSUB.FT C ---------------- C C PETER LEMKIN C IMAGE PROCESSING UNIT, DCBD C NATIONAL CANCER INSTITUTE C NATIONAL INSTITUTES OF HEALTH C 9000 ROCKVILLE PIKE C BETHESDA, MD. 20014 C C FEB 11, 1977 C JAN 11, 1977 C JAN 10, 1977 C C INTRODUCTION C ------------ C DOSUB.FT IS A CHAINED PROGRAM USED WITH BMON2 C IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1 C IBM2,IHGH2, JBM, JHGH VARIABLES IN COMMON. COMMON IS RESTORED C FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS C EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON C IS SAVED AND BMON2 IS CHAINED BACK TO. C ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED C C DOSUB TAKES THE 2ND CD INPUT FILE (IN COMMON KINFILE(5)) C AND LOOKS IT UP AS A ".BI" FILE. IF IT EXITS, IT C GENERATES A CCL CALL C .SUB :.BI@ C IN THE CD AREA. C THEN CCL.SV IS CHAINED TO TO RUN BATCH ON THIS FILE. C OPDEFS C ------ S OPDEF KCC 6032 S OPDEF TFL 6040 S OPDEF TFC 6042 S OPDEF TADI 1400 S OPDEF DCAI 3400 C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C S OPDEF HPL 6360 S OPDEF HSR 6321 S OPDEF VPL 6362 S OPDEF VSR 6323 C [1] INITIALIZATION WRITE(1,995) 995 FORMAT('DOSUB 2/11/77 - 4:01PM') C C C [1.1] ZERO THE CD AREA S TAD (43 S DCA \ICOUNT S S TAD (7577 S DCA 11 C DO 111 IZ=1,ICOUNT S CPAGE 4 S DCA \IX S DCAI 11 111 CONTINUE C C INIT COUNTERS S TAD (7577 /CD AREA POINTER IN FIELD 1 S DCA 17 C ICOUNT=-32 C C C [2] GET THE FILE NAME AND SEE IF IT EXISTS DEVICE=GETDEVICE(KDEVIN(2)) IF(IO(DEVICE,KINFILE(5),'BI',1))999,300,999 C C C [3] SETUP THE CALL TO CCL 300 T='SUB ' S TAD \T S JMS OUTCD S TAD \T# S JMS OUTCD C C OUTPUT THE DEVICE NAME S TAD \DEVICE S JMS OUTCD S TAD \DEVICE# S JMS OUTCD C C OUTPUT THE ":" T=':' S TAD \T S JMS OUTCD C C OUTPUT THE FILE NAME DO 301 I=5,7 J=KINFILE(I) S TAD \J S JMS OUTCD 301 CONTINUE C C OUTPUT THE @ S TAD (0 S JMS PUSH C C C [4] CHAIN TO CCL C RESET USR S CPAGE 5 S 6212 S JMS 7700 /USR S 13 /RESET S CLA /DELETE TENTITIVE FILES. C C C C [5] DO THE CHAIN C*****DEBUG**** DO 1999 IX=1,40 S TAD (7577 S CPAGE 6 S TAD \IX S DCA 7 S TADI 7 S TLS S WW, TSF S JMP WW S CLA 1999 CONTINUE C******************** C S KCC S TFL CALL CHAIN('CCL') C C C [999] ERROR RETURN 999 WRITE(1,996) 996 FORMAT('BAD .SUBMIT FILE SPECIFICATION!') CALL CHAIN('BMON2') C ******************************************************** C *SUBROUTINE P U S H C ******************************************************** C PUSH UP TO 32 8-BIT (IN AC) CHARACTERS ==>CD AREA. C GOTO 999 IF> 32 CHARS. C S CPAGE 3 S RPUSH, JMP I PUSH S PUSH, 0 /ENTRY C C C [1] SAVE CHAR S DCA \IZ C C [2] TEST IF ROOM S ISZ \ICOUNT S SKP S JMP \999 /OVF C C [3] PUSH IT S CPAGE 4 S TAD \IZ S DCAI 17 S JMP RPUSH /RETURN C C ******************************************************** C *SUBROUTINE O U T C D C ******************************************************** C TAKE 2 CHARACTERS IN THE AC IN A2 FORMAT AND PUSH THEM C INTO CD AREA IF THEY ARE NOT "@" AND THERE ARE < 33 CHARACTERS. C THEY ARE CVTED TO 8-BIT FROM THE A2 6-BIT FORMAT. C S CPAGE 3 S ROUTCD, JMP I OUTCD S OUTCD, 0 /ENTRY C C C [1] SAVE CHAR S MQL C C [2] CVT A2 CHARS DO 1000 ICVT=1,2 S MQA S BSW S AND (0077 S SNA S JMP ROUTCD /FOUND @ ==>IGNORE OUTCD C S TAD (-40 /IF A:Z THEN ADD 300 ELSE ADD 200 S SPA S TAD (100 /A:Z S TAD (240 S JMS PUSH C C SWAP BYTES SO THAT NEXT TIME WORK ON THE OTHER BYTE S MQA S BSW S MQL 1000 CONTINUE S JMP ROUTCD C END