TITLE BITMAP FOR COBOL PROGRAMS T1=1 T2=2 T3=3 T4=4 J=16 P=17 DSK==0 ;LAST CHANNEL TO BE OPENED BY LIBOL ENTRY BITSET,BITTST ;BITSET USING TABLE. ;01 TABLE. ; 02 X PIC 99 COMP. ; 02 Y PIC 999 COMP. ; 02 BIT PIC 9. (1 OR 0) BITSET: PUSH P,T1 PUSH P,T2 PUSH P,T3 PUSH P,T4 PUSHJ P,GETARG MOVE T3,BITMAP(T1) ;GET MAP WORD SKIPN 2(16) ;RESET? TDZ T3,T4 SKIPE 2(16) ;SET? TDO T3,T4 MOVEM T3,BITMAP(T1) JRST DONE GETARG: MOVE 16,(16) MOVE 16,(16) MOVE T1,(16) ;GET X CAIL T1,^D100 JRST BAD MOVE T2,1(16) ;GET Y CAIL T2,^D1000 JRST BAD SOJ T2, IMULI T2,^D100 ADD T1,T2 IDIVI T1,^D36 MOVEI T4,1 ;MASK LSH T4,(T2) ;BIT OF WORD POPJ P, BITTST: PUSH P,T1 PUSH P,T2 PUSH P,T3 PUSH P,T4 PUSHJ P,GETARG MOVEI T3,1 MOVEM T3,2(16) ;ASSUME BIT ON MOVE T3,BITMAP(T1) TDNN T3,T4 ;BIT ON? SETZM 2(16) ;OF COURSE NOT DONE: POP P,T4 POP P,T3 POP P,T2 POP P,T1 POPJ P, BAD: OUTSTR [ASCIZ/ ? INVALID BITMAP ARG /] JRST DONE ENTRY CLRMAP ; ENTER MACRO CLRMAP (TO ZERO OUT MAP) CLRMAP: PUSH P,T1 MOVE T1,[BITMAP,,BITMAP+1] SETZM BITMAP ;CLEAR 1ST WORD BLT T1,MAPEND ;REPLICATE THRU MAP POP P,T1 POPJ P, ENTRY GETMAP,PUTMAP ;GETMAP TO LOAD BITMAP FROM DSK:NNNMAP.TMP , THEN DELETE ;PUTMAP TO WRITE BITMAP GETMAP: PUSHJ P,OPNDSK ;SETUP FILE LOOKUP DSK,FILE ;GET FILE JRST NOFILE INPUT DSK,DMPLST ;LOAD TABLE RENAME DSK,DELETE ;DELETE FILE RELEAS DSK, ;RELEASE CHANNEL POPJ P, ;RETURN NOFILE: OUTSTR [ASCIZ/? BITMAP FILE NOT ON DSK! /] POPJ P, PUTMAP: PUSHJ P,OPNDSK ;SETUP FILE ENTER DSK,FILE ;OPEN FILE JRST ENTERR ;PROBLEMS OUTPUT DSK,DMPLST ;OUTPUT TABLE RELEAS DSK, ;RELEASE FILE POPJ P, ;RETURN ENTERR: OUTSTR [ASCIZ/? CANNOT ENTER BITMAP FILE! /] POPJ P, OPNDSK: OPEN DSK,DSKSPC ;OPEN DEVICE EXIT ;NO GOOD PUSH P,T1 ;SAVE AC'S PUSH P,T2 PUSH P,T3 PJOB T1, ;GET JOB # SETZ T3, IDIVI T1,^D10 ;GET DIGIT ORI T2,20 ;TO SIXBIT LSHC T2,-6 ;SHIFT INTO LH OF T3 TLNN T3,77 ;DONE? JRST .-4 ;NO HLLM T3,FILE MOVEI T3,'MAP' HRRM T3,FILE MOVSI T3,'TMP' MOVEM T3,FILE+1 SETZM FILE+2 SETZM FILE+3 MOVE T1,[IOWD ^D2800,BITMAP] MOVEM T1,DMPLST POP P,T3 POP P,T2 POP P,T1 POPJ P, DSKSPC: 17 SIXBIT /DSK/ 0 ;DUMP MODE REQUIRES NO BUFFERS FILE: EXP 0,0,0,0 DELETE: EXP 0,0,0,0 DMPLST: 0 0 ;END OF COMMAND LIST BITMAP: BLOCK ^D2800 MAPEND: 0 END