1000          LST 
1010 !
1020 ! Rewrote of UTIL/1 for VRAM64K and some bugs corrected
1030 ! (KEY$ without TAKE KEYBOARD)
1040 ! Some optimizations too: use real binary multiply, not add's
1050 ! Can be used on real hardware too
1060 bpgm#    EQU 026
1070 !
1080 ! control block
1090 !
1100          NAM 026,UTIL    
1110          DEF RUNTIM  
1120          DEF ASCIIS  
1130          DEF PARSE   
1140          DEF ERMSG   
1150          DEF INIT    
1160 RUNTIM   BYT 0,0
1170          DEF FastL.  
1180          DEF Awrite. 
1190          DEF Aread.  
1200          DEF TakeK.  
1210          DEF RelK.   
1220          DEF Sgcl.   
1230          DEF Linp.   
1240          DEF SCrt.   
1250          DEF Util1.  
1260          DEF Key$.   
1270          DEF Hgl?$.  
1280          DEF Msus$.  
1290          DEF Trim$.  
1300          DEF Rpt$.   
1310          DEF Linp2.  
1320 PARSE    BYT 0,0
1330          DEF FastL   
1340          DEF Awrite  
1350          DEF Aread   
1360          DEF TakeK   
1370          DEF TakeK   
1380          DEF Sgcl    
1390          DEF Linp    
1400          DEF SCrt    
1410          BYT 377,377
1420 ASCIIS   ASP "FAST LABEL"
1430          ASP "AWRITE"
1440          ASP "AREAD"
1450          ASP "TAKE KEYBOARD"
1460          ASP "RELEASE KEYBOARD"
1470          ASP "SGCLEAR"
1480          ASP "LINPUT"
1490          ASP "START CRT AT"
1500          ASP "UTIL/1"
1510          ASP "KEY$"
1520          ASP "HGL?$"
1530          ASP "MSUS$"
1540          ASP "TRIM$"
1550          ASP "RPT$"
1560 ERMSG    BYT 377,240
1570 !
1580 ! Init bpgm, call RelK. when necessary
1590 !
1600 INIT     BIN 
1610          LDMD R34,=ROMFL        ! ROM FLAG for initialization routines
1620          CMB R34,=013           ! program halt due to an error
1630          JZR I.00.0  
1640          CMB R34,=003           ! LOADBIN
1650          JZR I.00.0  
1660          CMB R34,=001           ! RESET KEY
1670          JNZ I.00.88 
1680 I.00.0   LDMD R34,=BINTAB       ! relative addressing
1690          JSB X34,RelK.   
1700 I.00.88  RTN 
1710 !
1720 ! Parse SGCLEAR x1,x2,y1,y2[,mask$]
1730 !
1740 Sgcl     PUBD R43,+R6
1750          JSB =NUMVA+            ! get x1
1760          JEN S.00.0  
1770 S.00.99  POBD R57,-R6
1780          JSB =ERROR+  
1790          BYT 130                ! ERROR : BAD STATEMENT
1800 S.00.0   JSB =GETCMA            ! ,
1810          JSB =NUMVAL            ! get x2
1820          JEZ S.00.99 
1830          JSB =GETCMA            ! ,
1840          JSB =NUMVAL            ! get y1
1850          JEZ S.00.99 
1860          JSB =GETCMA            ! ,
1870          JSB =NUMVAL            ! get y2
1880          JEZ S.00.99 
1890          CMB R14,=054           ! ','
1900          JNZ S.00.1  
1910          JSB =STREX+            ! get mask
1920          JEZ S.00.99 
1930 S.00.1   LDM R56,=bpgm#         ! put bpgm # and marker
1940          BYT 371
1950          POBD R55,-R6           ! put token
1960          STMI R55,=PTR2-        ! push all 3
1970          RTN 
1980 !
1990 ! Parse FAST LABEL x,y,str$,hilight
2000 !
2010 FastL    PUBD R43,+R6
2020          JSB =NUMVA+            ! get x
2030          JEZ F.00.99 
2040          JSB =GETCMA            ! ,
2050          JSB =NUMVAL            ! get y
2060          JEZ F.00.99 
2070          JSB =GETCMA            ! ,
2080          JSB =STREXP            ! get str
2090          JEZ F.00.99 
2100          JSB =GETCMA            ! ,
2110          JSB =NUMVAL            ! get hilight
2120          JEN pshtok  
2130 F.00.99  POBD R43,-R6
2140          JSB =ERROR+  
2150          BYT 131                ! ERROR : INVALID PARAMETER
2160 !
2170 ! Parse LINPUT var$
2180 !
2190 Linp     LDM R65,=007           ! put LINP. token
2200          VAL bpgm#   
2210          BYT 371
2220          STMI R65,=PTR2-        ! push it
2230          JSB =SCAN              !   GET NEXT TOKEN TO R14 AT PARSE TIME
2240          JSB =STRREF            ! get string variable reference
2250          JEZ F.00.99 
2260          LDM R65,=017           ! put LINP2. token
2270          VAL bpgm#   
2280          BYT 371
2290          STMI R65,=PTR2-        ! push it
2300          RTN 
2310 !
2320 ! Parse START CRT AT x
2330 !
2340 SCrt     PUBD R43,+R6
2350          JSB =NUMVA+            ! get line
2360          JEZ A.00.99 
2370 pshtok   LDB R53,=371           ! bpgm marker
2380          STBI R53,=PTR2-        ! push it
2390          LDB R53,=bpgm#         ! bpgm #
2400          STBI R53,=PTR2-        ! push it
2410          POBD R53,-R6           ! token #
2420          STBI R53,=PTR2-        ! push it
2430          RTN 
2440 !
2450 ! Parse AWRITE [col, row, str$]
2460 !
2470 Awrite   PUBD R43,+R6
2480          JSB =NUMVA+            ! get col
2490          JEZ pshtok  
2500          JSB =GETCMA            ! ,
2510          JSB =NUMVAL            ! get row
2520          JEN A.00.0  
2530 A.00.99  POBD R43,-R6
2540          JSB =ERROR+  
2550          BYT 130                ! ERROR : BAD STATEMENT
2560 A.00.0   CMB R14,=054           ! ','
2570          JNZ pshtok  
2580          JSB =STREX+            ! get str
2590          JEZ A.00.99 
2600          JMP pshtok  
2610 !
2620 ! Parse AREAD var$
2630 !
2640 Aread    PUBD R43,+R6
2650          JSB =SCAN              ! scan next token
2660          JSB =STRREF            ! get reference to str
2670          JMP pshtok  
2680 !
2690 ! PARSE TAKE KEYBOARD, RELEASE KEYBORD
2700 !
2710 TakeK    PUBD R43,+R6
2720          JSB =SCAN              ! scan next token
2730          JMP pshtok             ! nothing to do
2740 !
2750 ! UTIL/1 : return copyright
2760 !
2770          BYT 000,056            ! string function no parameters
2780 Util1.   BIN 
2790          LDM R43,=050,000       ! length
2800          DEF U-00.0             ! address
2810          BYT 0                  ! 3 bytes
2820          ADMD R45,=BINTAB       ! make it absolute
2830          PUMD R43,+R12          ! push it
2840          RTN 
2850          ASC "00.003:veR  4002 .oC temS eD reivilO )c("
2860 U-00.0   BSZ 0
2870 !
2880 ! Special key table for KEY$
2890 !
2900 speck    BYT 200                ! K1
2910          BYT 201                ! K2
2920          BYT 202                ! K3
2930          BYT 203                ! K4
2940          BYT 241                ! K5
2950          BYT 242                ! K6
2960          BYT 234                ! K7
2970          BYT 204                ! K8
2980          BYT 205                ! K9
2990          BYT 206                ! K10
3000          BYT 207                ! K11
3010          BYT 245                ! K12
3020          BYT 254                ! K13
3030          BYT 223                ! K14
3040          BYT 213                ! RESET
3050          BYT 377                ! end of invalid key table
3060 !
3070 ! FAST LABEL, no check on y
3080 !
3090          BYT 241                ! basic statement, legal after THEN
3100 FastL.   BIN 
3110          LDBD R37,=CRTSTS       ! get CRT status
3120          JNG F-00.0+            ! jif already GRAPH mode
3130          JSB =GRAPH.            ! force GRAPH mode
3140 F-00.0+  LDMD R14,=BINTAB       ! relative addressing
3150          JSB =ONEB              ! get hilight
3160          STBD R#,X14,flhi       ! store it
3170          POMD R45,-R12          ! get address of str
3180          STMD R45,X14,flstr     ! store it
3190          POMD R20,-R12          ! get lenght of str
3200          STMD R20,X14,fllen     ! store it
3210          JSB =ONEB              ! get y
3220          STM R#,R0              ! store it
3230          JSB =ONEB              ! get x
3240          CLB R32                ! prepare multiply
3250          LDMD R34,=GLINE        ! bytes per line of graphic
3260          LDB R33,R34            ! get LSB
3270          LLB R33                ! remove leading 0
3280          LDB R31,=7D            ! set counter      (7 bits)
3290          ARP R0                 ! set ARP on y     (9 bits)
3300 F-00.1   LLM R32                ! shift a bit
3310          JNC F-00.1+            ! jif not 1
3320          ADM R32,R#             ! add y
3330 F-00.1+  DCB R31                ! decrement counter
3340          JNZ F-00.1             ! loop
3350          ADM R46,R32            ! add to x
3360          ADM R46,=340,020       ! add start of screen
3370          LDBD R20,X14,flhi      ! get hilight
3380          BCD 
3390          ERB R20                ! put in E
3400          BIN 
3410          LDMD R20,X14,fllen     ! R20 len of string
3420          JZR F-00.88            ! jif done
3430          LDMD R75,X14,flstr     ! load address of str
3440          STMD R75,=PTR2         ! set it to PTR2
3450 F-00.2   LDBI R24,=PTR2-        ! get char
3460          ANM R24,=177,000       ! mask 8th bit
3470          LLM R24                ! x2
3480          LLM R24                ! x2
3490          LLM R24                ! x2
3500          ADM R24,=font          ! add FONT address
3510          ADM R24,R14            ! make it absolute
3520          LDB R26,=9D            ! set counter
3530          LDM R56,R46            ! load screen address
3540          CLB R27                ! first byte
3550 F-00.3   JSB =CHKSTS            ! wait for CRT controller not busy
3560          STMD R56,=CRTBAD       ! set CRT byte address
3570          ADM R56,R34            ! prepare next line
3580          JEZ F-00.3+            ! hilight ?
3590          NCB R27
3600 F-00.3+  STBD R27,=CRTDAT       ! put character on screen
3610          POBD R27,+R24          ! get next byte
3620          DCB R26                ! decrement counter
3630          JNZ F-00.3             ! loop
3640          ICM R46                ! increment start screen address
3650          DCM R20                ! decrement len
3660          JNZ F-00.2             ! loop
3670 F-00.88  RTN 
3680 !
3690 ! AWRITE
3700 !
3710          BYT 241                ! basic statement, legal after THEN
3720 Awrite.  BIN 
3730          LDBD R37,=CRTSTS       ! check CRT status
3740          JPS A-00.0+            ! jif already ALPHA mode
3750          JSB =ALPHA.            ! force ALPHA mode
3760 A-00.0+  CMMD R12,=TOS          ! anything on R12 stack
3770          JZR A-00.88            ! jif just AWRITE
3780          JSB =DECUR2            ! turn cursor off
3790          JSB =HMCURS            ! home cursor on current CRT page
3800          LDMD R14,=BINTAB       ! relative addressing
3810          CLM R43                ! zero string length
3820          LDM R20,R12            ! copy of R12
3830          SBM R20,=21D,0         ! minus 2 binary and 1 string (2*8+5)
3840          CMMD R20,=TOS          ! what's on R12
3850          JNZ A-00.1+            ! jif only x,y
3860          POMD R43,-R12          ! get length & address of string
3870 A-00.1+  STMD R43,X14,fllen     ! save length & address
3880          JSB =TWOB              ! get x and y
3890 A-00.2   DCM R56                ! decrement y
3900          JNG A-00.2+            ! jif negative
3910          ADM R46,=80D,0         ! add len of screen in byte
3920          JMP A-00.2             ! loop
3930 A-00.2+  STM R46,R24            ! copy offset
3940          JSB =MOVCRS            ! move cursor by specified amount
3950          LDMD R43,X14,fllen     ! get length & address
3960          LDM R56,R43            ! get length
3970          JZR A-00.88            ! jif zero
3980          STMD R45,=PTR2         ! set PTR2 to address
3990          LDM R36,R43            ! get length
4000 A-00.3   LDBI R32,=PTR2-        ! get a character
4010          JSB =CHKSTS            ! wait for CRT controller not busy
4020          STBD R32,=CRTDAT       ! put character on screen
4030          DCM R36                ! decrement counter
4040          JNZ A-00.3             ! loop
4050          JSB =CHKSTS            ! wait for CRT controller not busy
4060          LDMD R30,=CRTBYT       ! get initial CRTBYT address
4070          STMD R30,=CRTBAD       ! set CRTBAD
4080 A-00.88  RTN 
4090 !
4100 ! AREAD
4110 !
4120          BYT 241                ! basic statement, legal after THEN
4130 Aread.   BIN 
4140          LDBD R37,=CRTSTS       ! get CRT status
4150          JPS A-01.0+            ! jif allready in ALPHA mode
4160          JSB =ALPHA.            ! force ALPHA normal mode
4170 A-01.0+  JSB =DECUR2            ! turn cursor OFF
4180          POMD R73,-R12          ! get length & address of string
4190          STM R73,R55            ! copy length to R55
4200          PUMD R73,+R12          ! push it on R12 stack
4210          CLB R57                ! clear MSB
4220          JSB =RESMEM            ! reserve memory
4230          JEN A-01.89            ! jif no memory
4240          STM R55,R73            ! get length & address
4250          STM R65,R75            ! get memory address
4260          STMD R65,=PTR2         ! set PTR2 to it
4270          PUMD R73,+R12          ! push result string on R12 stack
4280          TSM R55                ! length of string
4290          JZR A-01.88            ! jif zero
4300          LDMD R34,=CRTBYT       ! get current CRT position
4310          PUMD R34,+R6           ! save it
4320          JSB =BYTCR!            ! set current position
4330 A-01.1   JSB =INCHR             ! get one character from CRT memory
4340          STBI R#,=PTR2-         ! store it
4350          DCM R55                ! decrement length
4360          JNZ A-01.1             ! loop
4370          POMD R34,-R6           ! get old CRTBYT
4380          JSB =BYTCR!            ! set current position
4390 A-01.88  JSB =STOST             ! store string (source, dest on R12 stack)
4400 A-01.89  RTN 
4410 !
4420 ! LINPUT
4430 !
4440          BYT 241                ! basic statement, legal after THEN
4450 Linp.    JSB =INPUT.            ! INPUT runtime routine
4460          RTN 
4470 !
4480 !
4490          BYT 044                ! invisible function
4500 Linp2.   BIN 
4510          LDMD R32,=INPTR        ! get input line pointer
4520          STM R32,R14            ! save a copy
4530          CLM R36                ! set length to 0
4540 L-00.0   POBD R35,+R32          ! get next byte
4550          CMB R35,=13D           ! is it a CR?
4560          JZR L-00.0+            ! jif CR?
4570          ICM R36                !   increment length
4580          JMP L-00.0             !   loop
4590 L-00.0+  TSM R36                ! test length
4600          JZR L-00.88            ! jif zero, return null string
4610          POBD R25,-R32          ! get last character (CR)
4620 L-00.1   POBD R25,-R32          ! get previous character
4630          CMB R25,=32D           ! test space
4640          JNZ L-00.1+            ! jif no, continue
4650          DCM R36                !   decrement length (trim blanks)
4660          JNZ L-00.1             !   jif length not zero
4670 L-00.1+  ICM R32                ! go to next byte (first space)
4680          STM R32,R65            ! save address in R65-66
4690          CLB R67                ! clear MSB
4700 L-00.2   CMM R14,R32            ! start of string >= end of string ?
4710          JCY L-00.88            ! jif yes, return string
4720          LDBD R30,R14           !   get byte from start
4730          POBD R31,-R32          !   get byte from end
4740          STBD R30,R32           !   store start in end
4750          PUBD R31,+R14          !   store end in start
4760          JMP L-00.2             !   loop
4770 L-00.88  PUMD R36,+R12          ! push length of string
4780          PUMD R65,+R12          ! push address of string
4790          JSB =STOST             ! store string
4800          RTN 
4810 !
4820 ! TAKE KEYBOARD
4830 !
4840          BYT 241                ! basic statement, legal after THEN
4850 TakeK.   LDMD R46,=BINTAB       ! relative addressing
4860          LDM R30,=keyhook       ! address of key hook
4870          ADM R30,R46            ! make it absolute
4880          STM R30,R43            ! copy to R43-44
4890          LDB R45,=236           ! R45 = 'RTN'
4900          LDB R42,=316           ! R42 = 'JSB'
4910 T-00.0*  STMD R42,=KYIDLE       ! set KYIDLE (and BINTAB copy R46-47)
4920          LDB R42,=377           ! invalid repeat flag
4930          STBD R30,X46,keychr    ! set it
4940          LDM R30,=keybuf        ! address of keyboard buffer
4950          ADM R30,R46            ! make it absolute
4960          STMD R30,X46,keyptr    ! initialize key pointer
4970          ADM R30,=80D,0         ! point to end of buffer
4980          STMD R30,X46,keyend    ! initialize KEYEND
4990          RTN 
5000 !
5010 ! RELEASE KEYBOARD
5020 !
5030          BYT 241                ! basic statement, legal after THEN
5040 RelK.    LDB R42,=236           ! one RTN
5050          LDM R43,R42            ! lots of RTN
5060          LDMD R46,=BINTAB       ! relative addressing
5070          JMP T-00.0* 
5080 !
5090 ! KYIDLE hook
5100 !
5110 keyhook  STBD R#,=GINTDS        ! disable global interrupt
5120          BIN 
5130          PUMD R2,+R6            ! save R2-3
5140          PUMD R40,+R6           ! save R40-47
5150          LDM R40,R20            ! save R20-27
5160          LDMD R26,=MYBTAB       ! relative addressing
5170          LDMD R20,X26,keyptr    ! get the key pointer
5180          LDMD R22,X26,keyend    ! address of end of buffer
5190          CMM R22,R20            ! buffer full?
5200          JZR K-00.3             ! jif yes
5210          LDBD R22,=KEYCOD       ! get the key code
5220          LDBD R25,=KEYSTS       ! get the keyboard status
5230          ANM R25,=010           ! mask for shift key
5240          JZR K-00.1             ! jif no shift
5250          CMB R22,=kUPCUR        ! up cursor key?
5260          JNZ K-00.0             ! jif not
5270          LDB R22,=kHOME         ! make it the home key
5280          JMP K-00.1             ! continue
5290 K-00.0   CMB R22,=kENDLINE      ! endline key?
5300          JNZ K-00.1             ! jif not
5310          LDB R22,=kSENDLIN      ! make it the shift endline key
5320 K-00.1   LDM R24,=speck         ! address of invalid keys
5330          ADM R24,R26            ! make it absolute
5340 K-00.2   POBD R23,+R24          ! get an invalide keycode
5350          CMB R23,=377           ! end of table?
5360          JZR K-00.2+            ! jif yes
5370          CMB R23,R22            ! is the key invalide
5380          JNZ K-00.2             ! jif not
5390          JSB X26,clrti          ! fix-up the stack
5400          JMP K-00.88            ! and let the system deal with the key
5410 K-00.2+  PUBD R22,+R20          ! append key to buffer
5420          STMD R20,X26,keyptr    ! update the pointer
5430 K-00.3   CLB R20
5440          ICB R20
5450          STBD R20,=KEYCOD       ! restart the keyboard scanner
5460          JSB X26,clrti          ! fix-up the stack
5470          SBM R6,=4,0            ! trash 2 returns
5480 drprti   BSZ 1                  ! force the DRP
5490          STBD R#,=GINTEN        ! re-enable global interrupts
5500          PAD                    ! restore the status
5510          RTN                    ! done
5520 K-00.88  STBD R#,=GINTEN        ! re-enable global interrupt
5530          RTN                    ! let the system deal with the key
5540 clrti    POMD R22,-R6           ! get the return address
5550          LDM R20,R6             ! copy of R6
5560          SBM R20,=16D,0         ! get down to middle of the SAD
5570          LDBD R20,R20           ! get the DRP byte
5580          ANM R20,=077,0         ! mask out
5590          ADB R20,=100           ! make it a DRP instruction
5600          STBD R20,X26,drprti    ! store it in place
5610          STM R40,R20            ! restore R20-27
5620          POMD R40,-R6           ! restore R40-47
5630          POMD R2,-R6            ! restore R2-3
5640          PUMD R22,+R6           ! put the return back
5650          RTN                    ! done
5660 !
5670 ! KEY$
5680 !
5690          BYT 000,056            ! string function with 0 parameter
5700 Key$.    STBD R#,=GINTDS        ! disable global interrupt
5710          BIN 
5720          LDMD R14,=BINTAB       ! relative addressing
5730          LDM R20,=keybuf        ! address of keyboard buffer
5740          ADM R20,R14            ! make it absolute
5750          LDMD R22,X14,keyptr    ! get pointer absolute
5760          CMM R22,R20            ! buffer empty?
5770          JZR K-01.2             ! jif yes
5780          LDM R30,R20            ! copy R20
5790          POBD R32,+R20          ! get a key
5800          STBD R32,X14,keychr    ! save last key for possible repeat
5810 K-01.0   CMM R22,R20            ! buffer empy?
5820          JZR K-01.0+            ! jif yes
5830          POBD R33,+R20          !   get a key
5840          PUBD R33,+R30          !   move it down
5850          JMP K-01.0             !   loop
5860 K-01.0+  DCM R22                ! adjust KEYPTR
5870          STMD R22,X14,keyptr    ! save it
5880 K-01.1   CLM R22
5890          ICM R22                ! length of 1
5900 K-01.88  PUMD R#,+R12           ! push the length
5910          LDM R55,=keychr        ! address of KEYCHR
5920          BYT 0                  ! MSB
5930          ADMD R55,=BINTAB       ! make it absolute.
5940          ICM R55                ! point after the key (reverse string)
5950          PUMD R55,+R12          ! push the address
5960          STBD R55,=GINTEN       ! re-enable global interrupt
5970          RTN                    ! done
5980 K-01.2   LDBD R32,X14,keychr    ! check last key
5990          CMB R32,=377           ! invalide repeat?
6000          JZR K-01.3             ! jif yes
6010          LDBD R32,=KEYSTS       ! get keyboard status
6020          LRB R32                ! get shift down flag
6030          JOD K-01.1             ! jif yes, send the key
6040 K-01.3   LDB R32,=377           ! invalid repeat flag
6050          STBD R32,X14,keychr    ! set it
6060          CLM R32                ! no repeat so 0 length
6070          JMP K-01.88            ! do it
6080 !
6090 ! MSUS$, DECODE make an error if not found
6100 !
6110          BYT 030,056            ! string function with 1 string parameter
6120 Msus$.   JSB =ROMJSB  
6130          DEF MSIN               ! initialize for MS rom routines
6140          VAL MSROM#  
6150          BIN 
6160          LDM R30,R6
6170          ADM R30,=7,0           ! prepare R6 stack
6180          STMD R30,=SAVER6       ! save it
6190          LDB R40,=002           ! MSUS only flag
6200          JSB =ROMJSB  
6210          DEF DECODE             ! fetch a name (here just a volume)
6220          VAL MSROM#  
6230          TSB R17                ! found it?
6240          JNG M-00.88            ! jif no, finish
6250          LDMD R44,=ACTMSU       ! get active MSUS
6260          CLB R44
6270          LDM R20,=6,0           ! length of string 6
6280          BIN 
6290          ADB R45,=3
6300          JNC M-00.0  
6310          ICB R44
6320          JMP M-00.1  
6330 M-00.0   DCB R20                ! length 5
6340          LDM R44,R45
6350 M-00.1   ADM R44,=060,060,060,060 ! '0000' as result
6360          LDMD R14,=BINTAB       ! relative addressing
6370          LDM R22,=msu$          ! address of string
6380          ADM R22,R14            ! make it absolute
6390          PUBD R47,+R22          ! fill it
6400          PUBD R46,+R22
6410          PUBD R45,+R22
6420          PUBD R44,+R22
6430          PUMD R20,+R12          ! push length of name
6440          LDM R45,=msuend$       ! address +1 of string
6450          BYT 0
6460          ADMD R45,=BINTAB       ! make it absolute
6470          PUMD R45,+R12          ! push it on stack
6480 M-00.88  RTN 
6490 !
6500 ! HGL?$
6510 !
6520          BYT 050,056            ! str func: str, num
6530 Hgl?$.   CLB R34                ! get flag
6540          JSB =ONEB              ! get flag
6550          JZR H-00.0             ! jif zero
6560          LDB R34,=200           ! mask = 128
6570 H-00.0   POMD R45,-R12          ! get address of string
6580          POMD R30,-R12          ! get length of string
6590          PUMD R30,+R12          ! push length of result string
6600          STM R30,R55            ! copy it
6610          CLB R57                ! clear MSB
6620          JSB =RESMEM            ! reserve memory
6630          JEN H-00.89            ! jif no memory
6640          PUMD R65,+R12          ! push address of result string
6650          STMD R65,=PTR2         ! set PTR2 as address string destination
6660          LDMD R55,=PTR1         ! save PTR1
6670          STMD R45,=PTR1         ! set PTR1 as address string source
6680 H-00.1   DCM R30                ! decrement length
6690          JNG H-00.1+            ! jif finished
6700          LDBI R20,=PTR1-        ! get character
6710          ORB R20,R34            ! mask it
6720          STBI R20,=PTR2-        ! put character
6730          JMP H-00.1  
6740 H-00.1+  STMD R55,=PTR1         ! restore PTR1
6750 H-00.89  RTN 
6760 !
6770 ! TRIM$
6780 !
6790          BYT 030,056            ! str func: str
6800 Trim$.   LDMD R45,=PTR1         ! get PTR1
6810          PUMD R45,+R6           ! save it
6820          POMD R45,-R12          ! get address of string
6830          STMD R45,=PTR2         ! set PTR2 address string
6840          POMD R30,-R12          ! get length of string
6850          STM R30,R55            ! copy it
6860          CLB R57                ! clear MSB
6870          JSB =RESMEM            ! reserve memory
6880          JEN T-01.89            ! jif no memory
6890          STMD R65,=PTR1         ! set PTR1 as result string address
6900 T-01.0   DCM R30                ! decrement counter
6910          STM R30,R32            ! copy as result length
6920          JNG T-01.88            !   jif length negative
6930          LDBI R20,=PTR2-        ! get character
6940          CMB R20,=040           ! is space?
6950          JZR T-01.0             ! jif yes
6960          CMB R20,=240           ! is inverse space?
6970          JZR T-01.0             ! jif yes
6980          STBI R20,=PTR1-        ! store first character
6990          ICM R30                ! correct counter
7000          STM R30,R32            ! copy as result length
7010 T-01.1   DCM R30                ! decrement counter
7020          JZR T-01.2             ! jif zero
7030          LDBI R20,=PTR2-        ! get character
7040          STBI R20,=PTR1-        ! store it
7050          JMP T-01.1             ! loop
7060 T-01.2   DCM R32                ! decrement length
7070          JNG T-01.88            ! jif negative, finished
7080          LDBI R20,=PTR2+        ! get previous character
7090          CMB R20,=040           ! is space?
7100          JZR T-01.2             ! jif yes
7110          CMB R20,=240           ! is inverse space?
7120          JZR T-01.2             ! jif yes
7130 T-01.88  ICM R32                ! correct length
7140          PUMD R32,+R12          ! push length
7150          PUMD R65,+R12          ! push address
7160 T-01.89  POMD R65,-R6           ! pop PTR1
7170          STMD R65,=PTR1         ! restore it
7180          RTN 
7190 !
7200 ! RPT$
7210 !
7220          BYT 050,056            ! str func: str, num
7230 Rpt$.    JSB =ONEB              ! get number
7240          STM R#,R22             ! copy it
7250          JZR R-00.88            ! jif zero, finished
7260          JNG R-00.88            ! jif negative, finished
7270          POMD R45,-R12          ! get address of string
7280          POMD R66,-R12          ! get length of string
7290          STM R66,R20            ! copy it
7300          STM R66,R24            ! same
7310          JSB =INTMUL            ! multiply two binary numbers
7320          LDM R56,R54            ! copy result
7330          PUMD R56,+R12          ! push length of result string
7340          STM R56,R55            ! prepare size
7350          CLB R57                ! clear MSB
7360          JSB =RESMEM            ! reserve memory
7370          JEN R-00.88            ! jif no memory
7380          PUMD R65,+R12          ! push address of result string
7390          STMD R65,=PTR2         ! set PTR2 as result string address
7400          LDMD R75,=PTR1         ! save PTR1
7410 R-00.0   STMD R45,=PTR1         ! set PTR1 as source string address
7420 R-00.1   LDBI R30,=PTR1-        ! get character
7430          STBI R30,=PTR2-        ! copy it
7440          DCM R20                ! decrement length counter
7450          JNZ R-00.1             !jif loop
7460          LDM R20,R24            ! reset length counter
7470          DCM R22                ! decrement number
7480          JNZ R-00.0             ! jif loop
7490          STMD R75,=PTR1         ! restore PTR1
7500 R-00.88  RTN 
7510 !
7520 ! START SCR AT
7530 !
7540          BYT 241                ! basic statement, legal after THEN
7550 SCrt.    JSB =ONEB              ! get line
7560          BCD 
7570          LLM R#                 ! *16
7580          BIN 
7590          STM R#,R#              ! copy it
7600          LLM R#                 ! *32
7610          LLM R#                 ! *64
7620          ADM R#,R#              ! *80
7630          STM R#,R#              ! copy to R46
7640          LDMD R#,=ASIZE         !   # of bytes in alpha (4K OR 16K)
7650          DRP R46                ! prepare MOD
7660          JSB =MOD               ! mod it
7670          STM R#,R34             ! copy result for SAD1
7680          JSB =SAD1              !   set CRT address start
7690          RTN 
7700 !
7710 ! SGCLEAR
7720 !
7730          BYT 241                ! basic statement, legal after THEN
7740 Sgcl.    BIN 
7750          LDMD R14,=BINTAB       ! for relative addressing
7760          CLM R50                ! mask
7770          LDMD R20,=PEN#         ! get pen index *3
7780          CMM R20,=3,0           ! is 3?
7790          JZR S-00.0+            ! jif yes
7800          DCM R50                ! invert mask
7810 S-00.0+  LDM R20,R12            ! R12 stack
7820          SBMD R20,=TOS     
7830          CMM R20,=45,0          ! full parameters?
7840          JNZ S-00.1+            ! jif no
7850          POMD R45,-R12          ! get mask address
7860          STMD R45,=PTR2         ! set PTR2
7870          POMD R36,-R12          ! get mask length
7880          LDB R0,=050            ! pointer to R50
7890 S-00.1   TSM R36                ! test length
7900          JZR S-00.1+            ! jif zero, finished
7910          LDBI R*,=PTR2-         ! get character mask
7920          DCM R36                ! decrement length
7930          ICB R0                 ! increment pointer
7940          CMB R0,=060            ! pointer is R60
7950          JNZ S-00.1             ! jif no, loop
7960 S-00.1+  STMD R50,X14,sgmask    ! save mask
7970          JSB =TWOB    
7980          STMD R56,X14,sgy1      ! save y1
7990          STMD R46,X14,sgy2      ! save y2
8000          JSB =TWOB    
8010          STMD R56,X14,sgx1      ! save x1
8020          STMD R46,X14,sgx2      ! save x2
8030          JSB =GRAPH             ! switch to GRAPH unless in ALPHALL
8040          LDMD R34,=GLINE        ! bytes per line of graphic
8050          LDM R46,=239D,0        ! ymax 239
8060          CMB R34,=127D          ! test new VRAM64K
8070          JNZ S-00.2+            ! jif no
8080          LDM R46,=223D,1        ! ymax 479
8090 S-00.2+  LDMD R56,X14,sgy2      ! get y2
8100          SBM R46,R56            ! compare y2
8110          JCY S-00.3+            ! jif lesser than
8120          CLM R46                ! y2 = 0
8130 S-00.3+  CLB R36                ! prepare multiply
8140          LDB R37,R34            ! get LSB
8150          LLB R37                ! remove leading 0
8160          LDB R31,=7D            ! set counter (7 bits)
8170          ARP R46                ! set ARP on y (9 bits)
8180 S-00.4   LLM R36                ! shift a bit
8190          JNC S-00.4+            ! jif not 1
8200          ADM R36,R#             ! add y
8210 S-00.4+  DCB R31                ! decrement counter
8220          JNZ S-00.4             ! loop
8230          ADM R36,=340,020       ! add start of screen
8240          LDMD R30,X14,sgx1      ! get x1
8250          LDMD R32,X14,sgx2      ! get x2
8260          SBM R32,R30            ! dx
8270          JNC S-00.88            ! jif dx <= 0
8280          LRM R31                ! x1/2
8290          LRM R31                ! x1/2
8300          LRM R31                ! x1/2
8310          ADM R36,R30            ! add x1/8 to address
8320          LRM R33                ! dx/2
8330          LRM R33                ! dx/2
8340          LRM R33                ! dx/2
8350          ICM R32                ! increment dx
8360          CMM R34,R32            ! compare to line length
8370          JCY S-00.5+            ! jif lesser
8380          STM R34,R32            ! dx = line length
8390 S-00.5+  LDMD R20,X14,sgy1      ! get y1
8400          LDMD R26,X14,sgy2      ! get y2
8410          SBM R26,R20            ! dy
8420          ICM R26                ! increment dy
8430          JNG S-00.88            ! jif negative, finished
8440          LDMD R70,X14,sgmask    ! get mask
8450          LDB R0,=070            ! set pattern pointer to R70
8460 S-00.6   JSB =CHKSTS            ! wait for CRT controller not busy
8470          STMD R36,=CRTBAD       ! set CRT address
8480          LDM R24,R32            ! set counter to dx
8490 S-00.7   DRP R20
8500 S-00.8-  LDBD R#,=CRTSTS        ! get CRT status
8510          JOD S-00.8-            ! jif busy
8520          STBD R*,=CRTDAT        ! put byte on screen
8530          DCM R24                ! decrement counter
8540          JNZ S-00.7             ! jif non-zero, loop
8550          ICB R0                 ! increment pattern pointer
8560          CMB R0,=100            ! compare to 100
8570          JNZ S-00.9+            ! jif non equal
8580          LDB R0,=070            ! reset pattern pointer
8590 S-00.9+  ADM R36,R34
8600          DCM R26
8610          JNZ S-00.6  
8620 S-00.88  RTN 
8630 !
8640 ! Font data (128 character * 8 bytes)
8650 !
8660 font     BYT 004,014,034,074,034,014,004,000
8670          BYT 010,000,010,020,042,042,034,000
8680          BYT 174,000,104,050,020,050,104,000
8690          BYT 174,000,104,144,124,114,104,000
8700          BYT 000,000,064,110,110,110,064,000
8710          BYT 070,104,104,170,104,104,170,000
8720          BYT 174,104,040,020,040,104,174,000
8730          BYT 000,000,020,050,050,104,174,000
8740          BYT 000,020,040,174,040,020,000,000
8750          BYT 000,000,074,110,110,110,060,000
8760          BYT 020,070,124,020,020,020,020,000
8770          BYT 100,040,020,050,104,104,104,000
8780          BYT 000,000,044,044,044,070,100,000
8790          BYT 000,000,000,000,000,000,000,000
8800          BYT 000,004,070,120,020,020,020,000
8810          BYT 000,004,070,150,050,050,050,000
8820          BYT 070,104,104,174,104,104,070,000
8830          BYT 074,120,120,170,120,120,174,000
8840          BYT 000,000,050,124,134,120,074,000
8850          BYT 020,070,104,104,174,104,104,000
8860          BYT 020,000,070,110,110,110,064,000
8870          BYT 050,070,104,104,174,104,104,000
8880          BYT 050,000,070,110,110,110,064,000
8890          BYT 050,070,104,104,104,104,070,000
8900          BYT 050,000,070,104,104,104,070,000
8910          BYT 050,104,104,104,104,104,070,000
8920          BYT 050,000,104,104,104,104,070,000
8930          BYT 100,100,100,174,100,100,100,000
8940          BYT 030,030,030,030,030,030,030,030
8950          BYT 000,000,000,377,377,000,000,000
8960          BYT 030,044,040,160,040,040,174,000
8970          BYT 030,030,030,377,377,030,030,030
8980          BYT 000,000,000,000,000,000,000,000
8990          BYT 010,010,010,010,010,000,010,000
9000          BYT 050,050,050,000,000,000,000,000
9010          BYT 050,050,174,050,174,050,050,000
9020          BYT 020,074,120,070,024,170,020,000
9030          BYT 140,144,010,020,040,114,014,000
9040          BYT 040,120,120,040,124,110,064,000
9050          BYT 010,010,010,000,000,000,000,000
9060          BYT 020,040,100,100,100,040,020,000
9070          BYT 020,010,004,004,004,010,020,000
9080          BYT 020,124,070,020,070,124,020,000
9090          BYT 000,020,020,174,020,020,000,000
9100          BYT 000,000,000,000,010,010,020,000
9110          BYT 000,000,000,174,000,000,000,000
9120          BYT 000,000,000,000,000,010,000,000
9130          BYT 000,004,010,020,040,100,000,000
9140          BYT 070,104,114,124,144,104,070,000
9150          BYT 020,060,020,020,020,020,070,000
9160          BYT 070,104,004,030,040,100,174,000
9170          BYT 174,004,010,030,004,104,070,000
9180          BYT 010,030,050,110,174,010,010,000
9190          BYT 174,100,170,004,004,104,070,000
9200          BYT 034,040,100,170,104,104,070,000
9210          BYT 174,004,010,020,040,040,040,000
9220          BYT 070,104,104,070,104,104,070,000
9230          BYT 070,104,104,074,004,010,160,000
9240          BYT 000,000,020,000,020,000,000,000
9250          BYT 000,000,020,000,020,020,040,000
9260          BYT 004,010,020,040,020,010,004,000
9270          BYT 000,000,174,000,174,000,000,000
9280          BYT 100,040,020,010,020,040,100,000
9290          BYT 070,104,104,010,020,000,020,000
9300          BYT 070,104,124,130,130,100,074,000
9310          BYT 070,104,104,174,104,104,104,000
9320          BYT 170,104,104,170,104,104,170,000
9330          BYT 070,104,100,100,100,104,070,000
9340          BYT 170,104,104,104,104,104,170,000
9350          BYT 174,100,100,170,100,100,174,000
9360          BYT 174,100,100,170,100,100,100,000
9370          BYT 074,100,100,100,114,104,074,000
9380          BYT 104,104,104,174,104,104,104,000
9390          BYT 070,020,020,020,020,020,070,000
9400          BYT 004,004,004,004,004,104,070,000
9410          BYT 104,110,120,140,120,110,104,000
9420          BYT 100,100,100,100,100,100,174,000
9430          BYT 104,154,124,124,104,104,104,000
9440          BYT 104,104,144,124,114,104,104,000
9450          BYT 070,104,104,104,104,104,070,000
9460          BYT 170,104,104,170,100,100,100,000
9470          BYT 070,104,104,104,124,110,064,000
9480          BYT 170,104,104,170,120,110,104,000
9490          BYT 070,104,100,070,004,104,070,000
9500          BYT 174,020,020,020,020,020,020,000
9510          BYT 104,104,104,104,104,104,070,000
9520          BYT 104,104,104,104,050,050,020,000
9530          BYT 104,104,104,124,124,154,104,000
9540          BYT 104,104,050,020,050,104,104,000
9550          BYT 104,104,050,020,020,020,020,000
9560          BYT 174,004,010,020,040,100,174,000
9570          BYT 174,140,140,140,140,140,174,000
9580          BYT 000,100,040,020,010,004,000,000
9590          BYT 174,014,014,014,014,014,174,000
9600          BYT 020,050,104,000,000,000,000,000
9610          BYT 000,000,000,000,000,000,174,000
9620          BYT 100,040,020,010,000,000,000,000
9630          BYT 000,000,070,004,074,104,074,000
9640          BYT 100,100,130,144,104,104,170,000
9650          BYT 000,000,074,100,100,100,074,000
9660          BYT 004,004,064,114,104,104,074,000
9670          BYT 000,000,070,104,174,100,070,000
9680          BYT 030,040,040,160,040,040,040,000
9690          BYT 000,000,074,104,104,074,004,070
9700          BYT 100,100,130,144,104,104,104,000
9710          BYT 020,000,060,020,020,020,070,000
9720          BYT 010,000,030,010,010,010,050,020
9730          BYT 040,040,044,050,060,050,044,000
9740          BYT 060,020,020,020,020,020,070,000
9750          BYT 000,000,150,124,124,124,124,000
9760          BYT 000,000,130,144,104,104,104,000
9770          BYT 000,000,070,104,104,104,070,000
9780          BYT 000,000,170,104,104,170,100,100
9790          BYT 000,000,070,110,110,070,010,014
9800          BYT 000,000,130,144,100,100,100,000
9810          BYT 000,000,074,100,070,004,170,000
9820          BYT 000,020,070,020,020,020,010,000
9830          BYT 000,000,104,104,104,114,064,000
9840          BYT 000,000,104,104,050,050,020,000
9850          BYT 000,000,104,104,124,124,050,000
9860          BYT 000,000,104,050,020,050,104,000
9870          BYT 000,000,104,104,104,074,004,030
9880          BYT 000,000,174,010,020,040,174,000
9890          BYT 020,040,040,100,040,040,020,000
9900          BYT 020,020,020,000,020,020,020,000
9910          BYT 020,010,010,004,010,010,020,000
9920          BYT 000,000,040,124,010,000,000,000
9930          BYT 124,050,124,050,124,050,124,000
9940 !
9950 ! variables
9960 !
9970 sgmask   BSZ 8D
9980 sgx1     BSZ 2
9990 sgx2     BSZ 2
10000 sgy1     BSZ 2
10010 sgy2     BSZ 2
10020 keychr   BSZ 1
10030 flhi     BSZ 1
10040 fllen    BSZ 2
10050 flstr    BSZ 3
10060 keybuf   BSZ 80D
10070 keyptr   BSZ 2
10080 keyend   BSZ 2
10090 msu$     BYT 0,0,0,0
10100          ASC "D:"
10110 msuend$  BSZ 0
10120 !
10130 ! system EQUs
10140 !
10150 kENDLINE EQU 232
10160 kHOME    EQU 230
10170 kSENDLIN EQU 227
10180 kUPCUR   EQU 243
10190 !
10200 ! rom EQUs
10210 !
10220 MSROM#   EQU 320
10230 !
10240 ! system routines
10250 !
10260 ALPHA.   DAD 12413
10270 BYTCR!   DAD 14003
10280 CHKSTS   DAD 13204
10290 DECUR2   DAD 13467
10300 ERROR+   DAD 10220
10310 GETCMA   DAD 23477
10320 GRAPH    DAD 12560
10330 GRAPH.   DAD 12574
10340 HMCURS   DAD 13661
10350 INCHR    DAD 14262
10360 INPUT.   DAD 16314
10370 INTMUL   DAD 53673
10380 MOD      DAD 14216
10390 MOVCRS   DAD 13771
10400 NUMVA+   DAD 22403
10410 NUMVAL   DAD 22406
10420 ONEB     DAD 12153
10430 RESMEM   DAD 31741
10440 ROMJSB   DAD 6223
10450 RTCUR.   DAD 13651
10460 SAD1     DAD 13723
10470 SCAN     DAD 21110
10480 STOST    DAD 46472
10490 STREX+   DAD 23721
10500 STREXP   DAD 23724
10510 STRREF   DAD 24056
10520 TWOB     DAD 56760
10530 !
10540 ! MS rom routines
10550 !
10560 DECODE   DAD 70766             ! MSROM fetch a name and find it
10570 MSIN     DAD 70652             ! MSROM routine runtime initialization
10580 !
10590 ! system variables
10600 !
10610 ACTMSU   DAD 103560
10620 ASIZE    DAD 104744
10630 BINTAB   DAD 104070
10640 CRTBYT   DAD 100206
10650 GLINE    DAD 104740
10660 INPTR    DAD 101143
10670 KYIDLE   DAD 103677
10680 MYBTAB   DAD 103703            ! in KYIDLE (after JSB hook RTN)
10690 PEN#     DAD 104535
10700 ROMFL    DAD 104065
10710 SAVER6   DAD 104066
10720 TOS      DAD 101744
10730 !
10740 ! I/O addresses
10750 !
10760 GINTEN   DAD 177400
10770 GINTDS   DAD 177401
10780 KEYSTS   DAD 177402
10790 KEYCOD   DAD 177403
10800 CRTBAD   DAD 177701
10810 CRTSTS   DAD 177702
10820 CRTDAT   DAD 177703
10830 PTR1     DAD 177710
10840 PTR1-    DAD 177711
10850 PTR1+    DAD 177712
10860 PTR1-+   DAD 177713
10870 PTR2     DAD 177714
10880 PTR2-    DAD 177715
10890 PTR2+    DAD 177716
10900 PTR2-+   DAD 177717
10910 !
10920 !
10930          FIN 
